/[gedafe]/trunk/lib/perl/Gedafe/Pearl.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Contents of /trunk/lib/perl/Gedafe/Pearl.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1 - (show annotations)
Mon Feb 14 18:52:26 2005 UTC (19 years, 1 month ago) by dpavlin
File size: 2243 byte(s)
import of Gedafe 1.2.2

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 #

  ViewVC Help
Powered by ViewVC 1.1.26