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

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

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