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