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