/[cvs]/nfo/perl/libs/libp.pm
ViewVC logotype

Annotation of /nfo/perl/libs/libp.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.10 - (hide annotations)
Thu Dec 19 01:05:35 2002 UTC (21 years, 10 months ago) by joko
Branch: MAIN
Changes since 1.9: +9 -1 lines
+ sub today

1 cvsjoko 1.1 #################################
2     #
3 joko 1.10 # $Id: libp.pm,v 1.9 2002/12/05 13:54:00 joko Exp $
4 cvsjoko 1.2 #
5     # $Log: libp.pm,v $
6 joko 1.10 # Revision 1.9 2002/12/05 13:54:00 joko
7     # + fix: let 'deep_copy' print its message out (instead of die)
8     #
9 joko 1.9 # Revision 1.8 2002/12/01 22:11:35 joko
10     # + sub cmd
11     # + sub run_cmds
12     #
13 joko 1.8 # Revision 1.7 2002/11/29 04:44:53 joko
14     # - sub array_getRelations
15     # + sub getNewPerlObjectByPkgName
16     #
17 joko 1.7 # Revision 1.6 2002/11/17 07:18:59 joko
18     # + sub deep_copy
19     #
20 joko 1.6 # Revision 1.5 2002/10/27 18:34:28 joko
21     # + sub now
22     #
23 joko 1.5 # Revision 1.4 2002/08/16 19:06:39 cvsjoko
24     # + sub getDirList
25     #
26 cvsjoko 1.4 # Revision 1.3 2002/07/19 18:13:50 cvsjoko
27     # no message
28     #
29 cvsjoko 1.3 # Revision 1.2 2002/06/27 02:14:22 cvsjoko
30     # + stripHtml stripSpaces stripNewLines toReal
31     #
32 cvsjoko 1.2 # Revision 1.1 2002/06/24 14:49:59 cvsjoko
33     # + new
34 cvsjoko 1.1 #
35     #
36     #################################
37    
38     package libp;
39    
40 joko 1.7 use strict;
41     use warnings;
42    
43 cvsjoko 1.1 require Exporter;
44 joko 1.7 our @ISA = qw( Exporter );
45     our @EXPORT_OK = qw(
46 cvsjoko 1.3 Dumper
47     md5 md5_hex md5_base64
48     ParseDate UnixDate
49     strftime
50     stripHtml stripSpaces stripNewLines toReal trim
51     croak
52     array_getDifference
53 cvsjoko 1.4 getDirList
54 joko 1.5 now
55 joko 1.6 deep_copy
56 joko 1.7 getNewPerlObjectByPkgName
57 joko 1.8 cmd
58     run_cmds
59 joko 1.10 today
60 cvsjoko 1.1 );
61    
62     use Data::Dumper;
63     use Digest::MD5 qw(md5 md5_hex md5_base64);
64    
65     $main::TZ = 'GMT';
66     use Date::Manip;
67 cvsjoko 1.2
68     require LWP::UserAgent;
69     use HTML::PullParser;
70    
71 cvsjoko 1.3 # $now_string = strftime "%a %b %e %H:%M:%S %Y", localtime;
72     # see "perldoc -f localtime"
73     use POSIX qw(strftime);
74    
75     use Carp;
76    
77 cvsjoko 1.4 use DirHandle;
78    
79 cvsjoko 1.2
80     ########################################
81    
82     sub stripSpaces {
83     my $text = shift;
84     #print "text: $text", "\n";
85     #print "ord: ", ord(substr($text, 0, 1)), "\n";
86     $text =~ s/^\s*//g;
87     $text =~ s/\s*$//g;
88     return $text;
89     }
90    
91 cvsjoko 1.3 sub trim {
92     my $string = shift;
93     return stripSpaces($string);
94     }
95    
96 cvsjoko 1.2 sub stripNewLines {
97     my $text = shift;
98     #print "text: $text", "\n";
99     #print "ord: ", ord(substr($text, 0, 1)), "\n";
100     $text =~ s/\n//g;
101     #$text =~ s/\s*$//g;
102     return $text;
103     }
104    
105     sub toReal {
106     my $string = shift;
107     $string =~ m/(\d+\.*\d+)/;
108     my $real = $1;
109     return $real;
110     }
111    
112     sub stripHtml {
113     my $html = shift;
114     my $result = '';
115     #$html =~ s/<br>(.*)/ - ($1)/i;
116     my $p = HTML::PullParser->new(
117     doc => \$html,
118     text => 'text',
119     unbroken_text => 1,
120     );
121     while (my $token = $p->get_token()) {
122     my $text = join('', @{$token});
123     $result .= $text;
124     }
125     #$result =~ s/&nbsp;//g;
126     return $result;
127 cvsjoko 1.3 }
128    
129    
130 cvsjoko 1.4
131    
132     # =============================================
133     # "global" vars used in directory-recursive-parsing
134     my $dirlist_buf;
135     my @dirlist_path;
136     my $dirlist_base;
137    
138     sub entry_callback {
139    
140     my $entry = shift;
141    
142     # CHECKS
143     # dont't use this:
144     if ($entry eq '.' || $entry eq '..') { return; }
145    
146     # PREPARE
147     # prepare path to current entry
148     my $cur_entry = join('/', @dirlist_path, $entry);
149     # prepare path to current entry (absolute)
150     my $cur_entry_abs = join('/', $dirlist_base, @dirlist_path, $entry);
151    
152     # ENTRY
153     # add current entry to buffer
154     $dirlist_buf .= $cur_entry . "\n";
155    
156     # (SUB-)DIRECTORY
157     # check if current entry is a (sub-)directory ...
158     if (-d $cur_entry_abs) {
159     push @dirlist_path, $cur_entry;
160     # ... and parse this (recursion here!!!)
161     iterate_path($cur_entry_abs);
162     pop @dirlist_path;
163     }
164     }
165    
166     sub iterate_path {
167    
168     my $path = shift;
169    
170     # create new "DirHandle"-object
171     my $d = new DirHandle $path;
172     if (defined $d) {
173    
174     # iterate through all entries in $path ($d->read) and call out entry-handler on each entry
175     while (defined(my $line = $d->read)) {
176     entry_callback($line);
177     }
178    
179     undef $d;
180     }
181     }
182    
183     sub getDirList {
184    
185     $dirlist_base = shift;
186    
187     # reset vars
188     $dirlist_buf = '';
189     @dirlist_path = ();
190    
191     # start parsing file-structure
192     iterate_path($dirlist_base);
193    
194     # return complete list of directory-content including files and subdirs
195     # entries are newline (\n) - seperated
196     return $dirlist_buf;
197    
198     }
199     # =============================================
200    
201 joko 1.5
202     sub now {
203     return strftime("%Y-%m-%d %H:%M:%S", localtime);
204 joko 1.10 }
205    
206     sub today {
207     return strftime("%Y-%m-%d", localtime);
208 joko 1.6 }
209    
210 joko 1.7 # ACK's go to ...
211 joko 1.6 sub deep_copy {
212     my $this = shift;
213     if (not ref $this) {
214     $this;
215     } elsif (ref $this eq "ARRAY") {
216     [map deep_copy($_), @$this];
217     } elsif (ref $this eq "HASH") {
218     +{map { $_ => deep_copy($this->{$_}) } keys %$this};
219     } elsif (ref $this eq "CODE") {
220     $this;
221 joko 1.9 #} else { die "deep_copy asks: what type is $this?" }
222     } else { print "deep_copy asks: what type is $this?", "\n"; }
223 joko 1.7 }
224    
225     sub getNewPerlObjectByPkgName {
226     my $pkgname = shift;
227     my $args = shift;
228     #$logger->debug( __PACKAGE__ . "->getNewPerlObjectByPkgName( pkgname $pkgname args $args )" );
229     my $evstring = "use $pkgname;";
230     eval($evstring);
231     #$@ && $logger->error( __PACKAGE__ . ':' . __LINE__ . " Error in eval $evstring: " . $@ );
232     $@ && print( __PACKAGE__ . ':' . __LINE__ . " Error in eval \"$evstring\": " . $@ );
233     return $pkgname->new($args);
234 joko 1.8 }
235    
236     sub cmd ($) {
237     my $cmd = shift;
238     $cmd = 'perl ' . $cmd;
239     my $sep = "-" x 90;
240     print $sep, "\n";
241     print " ", $cmd, "\n";
242     print $sep, "\n";
243     system($cmd);
244     print "\n";
245     }
246    
247     sub run_cmds {
248     foreach (@_) {
249     cmd($_);
250     }
251 joko 1.5 }
252 cvsjoko 1.1
253     1;

MailToCvsAdmin">MailToCvsAdmin
ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed