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