/[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.4 by cvsjoko, Fri Aug 16 19:06:39 2002 UTC
# Line 3  Line 3 
3  #  $Id$  #  $Id$
4  #  #
5  #  $Log$  #  $Log$
6    #  Revision 1.4  2002/08/16 19:06:39  cvsjoko
7    #  + sub getDirList
8    #
9    #  Revision 1.3  2002/07/19 18:13:50  cvsjoko
10    #  no message
11    #
12    #  Revision 1.2  2002/06/27 02:14:22  cvsjoko
13    #  + stripHtml stripSpaces stripNewLines toReal
14    #
15  #  Revision 1.1  2002/06/24 14:49:59  cvsjoko  #  Revision 1.1  2002/06/24 14:49:59  cvsjoko
16  #  + new  #  + new
17  #  #
# Line 14  package libp; Line 23  package libp;
23  require Exporter;  require Exporter;
24  @ISA = qw( Exporter );  @ISA = qw( Exporter );
25  @EXPORT = qw(  @EXPORT = qw(
26    Dumper      Dumper
27    md5 md5_hex md5_base64      md5 md5_hex md5_base64
28    ParseDate UnixDate      ParseDate UnixDate
29        strftime
30        stripHtml stripSpaces stripNewLines toReal trim
31        croak
32        array_getDifference
33        getDirList
34  );  );
35    
36  use strict;  use strict;
# Line 28  use Digest::MD5 qw(md5 md5_hex md5_base6 Line 42  use Digest::MD5 qw(md5 md5_hex md5_base6
42  $main::TZ = 'GMT';  $main::TZ = 'GMT';
43  use Date::Manip;  use Date::Manip;
44    
45    require LWP::UserAgent;
46    use HTML::PullParser;
47    
48    # $now_string = strftime "%a %b %e %H:%M:%S %Y", localtime;
49    # see "perldoc -f localtime"
50    use POSIX qw(strftime);
51    
52    use Carp;
53    
54    use DirHandle;
55    
56    
57    ########################################
58    
59    sub stripSpaces {
60      my $text = shift;
61      #print "text: $text", "\n";
62      #print "ord: ", ord(substr($text, 0, 1)), "\n";
63      $text =~ s/^\s*//g;
64      $text =~ s/\s*$//g;
65      return $text;
66    }
67    
68    sub trim {
69      my $string = shift;
70      return stripSpaces($string);
71    }
72    
73    sub stripNewLines {
74      my $text = shift;
75      #print "text: $text", "\n";
76      #print "ord: ", ord(substr($text, 0, 1)), "\n";
77      $text =~ s/\n//g;
78      #$text =~ s/\s*$//g;
79      return $text;
80    }
81    
82    sub toReal {
83      my $string = shift;
84      $string =~ m/(\d+\.*\d+)/;
85      my $real = $1;
86      return $real;
87    }
88    
89    sub stripHtml {
90      my $html = shift;
91      my $result = '';
92      #$html =~ s/<br>(.*)/ - ($1)/i;
93      my $p = HTML::PullParser->new(
94        doc => \$html,
95        text => 'text',
96        unbroken_text => 1,
97      );
98      while (my $token = $p->get_token()) {
99        my $text = join('', @{$token});
100        $result .= $text;
101      }
102      #$result =~ s/&nbsp;//g;
103      return $result;
104    }
105    
106    sub array_getRelations {
107      my $a_ref = shift;
108      my $b_ref = shift;
109      my @a = @{$a_ref};
110      my @b = @{$b_ref};
111    
112      my @isect = my @diff = my @union = ();
113      my $e;
114      my %count;
115      
116      foreach $e (@a, @b) { $count{$e}++ }
117    
118      foreach $e (keys %count) {
119          push(@union, $e);
120          push @{ $count{$e} == 2 ? \@isect : \@diff }, $e;
121      }
122      
123      my $result = {
124        union => \@union,
125        isect => \@isect,
126        diff => \@diff,
127      };
128    
129    }
130    
131    sub array_getDifference {
132      my $res = array_getRelations(shift, shift);
133      return $res->{diff};
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  1;  1;
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.4
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed