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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.11 - (show annotations)
Thu Dec 19 16:27:17 2002 UTC (21 years, 10 months ago) by joko
Branch: MAIN
Changes since 1.10: +10 -8 lines
+- renamed 'cmd' to 'run_cmd'

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

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