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