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 |
# |