/[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.9 - (show annotations)
Thu Dec 5 13:54:00 2002 UTC (21 years, 11 months ago) by joko
Branch: MAIN
Changes since 1.8: +7 -2 lines
+ fix: let 'deep_copy' print its message out (instead of die)

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

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