1 |
dpavlin |
1 |
package Gedafe::Pearl; |
2 |
|
|
|
3 |
|
|
use strict; |
4 |
|
|
use Carp; |
5 |
|
|
use Exporter; |
6 |
|
|
use Text::Wrap; |
7 |
|
|
use Gedafe::GUI qw(GUI_WidgetRead); |
8 |
|
|
use POSIX qw(mktime strftime); |
9 |
|
|
use vars qw(@ISA @EXPORT_OK); |
10 |
|
|
@ISA = qw(Exporter); |
11 |
|
|
@EXPORT_OK = qw(format_desc date_print ); |
12 |
|
|
|
13 |
|
|
# at the moment the class we create is empty |
14 |
|
|
|
15 |
|
|
sub new($;@){ |
16 |
|
|
my $proto = shift; |
17 |
|
|
my %params = @_; |
18 |
|
|
my $class = ref($proto) || $proto; |
19 |
|
|
my $self = {}; |
20 |
|
|
bless $self, $class; |
21 |
|
|
} |
22 |
|
|
|
23 |
|
|
# get them to overwrite the base methods |
24 |
|
|
sub info($){ |
25 |
|
|
croak "ERROR: info method must be overwritten\n"; |
26 |
|
|
} |
27 |
|
|
sub template ($){ |
28 |
|
|
croak "ERROR: template method must be overwritten\n"; |
29 |
|
|
} |
30 |
|
|
|
31 |
|
|
sub run ($$){ |
32 |
|
|
my $self = shift; |
33 |
|
|
# $s is the gedafe state |
34 |
|
|
my $s = shift; |
35 |
|
|
|
36 |
|
|
# import first get the ones from the form, and then add the ones |
37 |
|
|
# defined in the url if there are any. |
38 |
|
|
$self->{param}={}; |
39 |
|
|
for (@{$self->template()}) { |
40 |
|
|
my ($field,$lable,$widget,$value,$test) = @$_; |
41 |
|
|
$self->{param}{$field} = GUI_WidgetRead($s, "field_$field",$widget); |
42 |
|
|
die "Pearl paramter $field='$self->{param}{$field}' does not match /^$test\$/". |
43 |
|
|
"<BR>You can use the back button to get back at your form\n" |
44 |
|
|
unless $self->{param}{$field} =~ /^$test$/; |
45 |
|
|
} |
46 |
|
|
# the rest is up to you :-) |
47 |
|
|
# you can access accessing parameters $self->{param}{$name} |
48 |
|
|
} |
49 |
|
|
|
50 |
|
|
|
51 |
|
|
# utility helpers |
52 |
|
|
sub date_print ($) { |
53 |
|
|
my $time = time; |
54 |
|
|
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = |
55 |
|
|
localtime($time); |
56 |
|
|
# mktime(sec, min, hour, mday, mon, year, wday = 0, yday = 0, isdst = 0) |
57 |
|
|
|
58 |
|
|
for (shift){ |
59 |
|
|
/month_first/ && do { $time = mktime 0,0,0,1,$mon,$year; |
60 |
|
|
next; }; |
61 |
|
|
/month_last/ && do { $time = mktime 0,0,0,0,$mon+1,$year; |
62 |
|
|
next; }; |
63 |
|
|
}; |
64 |
|
|
|
65 |
|
|
return strftime('%Y-%m-%d',localtime($time)); |
66 |
|
|
} |
67 |
|
|
|
68 |
|
|
sub format_desc { |
69 |
|
|
my $desc = shift; |
70 |
|
|
my $indent = shift; |
71 |
|
|
my $cols = shift; |
72 |
|
|
return "" unless $desc; |
73 |
|
|
$Text::Wrap::columns = $cols; |
74 |
|
|
$desc =~ s/^\s+//g; $desc =~ s/\s+$//g; |
75 |
|
|
$desc =~ s/\s+/ /g; |
76 |
|
|
|
77 |
|
|
$desc = wrap('','',$desc); |
78 |
|
|
my $indent_str = ' 'x$indent; |
79 |
|
|
$desc =~ s/\n/\n$indent_str/g; |
80 |
|
|
return $desc; |
81 |
|
|
} |
82 |
|
|
|
83 |
|
|
1; |
84 |
|
|
# Emacs Configuration |
85 |
|
|
# |
86 |
|
|
# Local Variables: |
87 |
|
|
# mode: cperl |
88 |
|
|
# eval: (cperl-set-style "PerlStyle") |
89 |
|
|
# mode: flyspell |
90 |
|
|
# mode: flyspell-prog |
91 |
|
|
# End: |
92 |
|
|
# |