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