--- nfo/perl/libs/libp.pm 2002/06/27 02:14:22 1.2 +++ nfo/perl/libs/libp.pm 2002/08/16 19:06:39 1.4 @@ -1,8 +1,14 @@ ################################# # -# $Id: libp.pm,v 1.2 2002/06/27 02:14:22 cvsjoko Exp $ +# $Id: libp.pm,v 1.4 2002/08/16 19:06:39 cvsjoko Exp $ # # $Log: libp.pm,v $ +# Revision 1.4 2002/08/16 19:06:39 cvsjoko +# + sub getDirList +# +# Revision 1.3 2002/07/19 18:13:50 cvsjoko +# no message +# # Revision 1.2 2002/06/27 02:14:22 cvsjoko # + stripHtml stripSpaces stripNewLines toReal # @@ -17,11 +23,14 @@ require Exporter; @ISA = qw( Exporter ); @EXPORT = qw( - Dumper - md5 md5_hex md5_base64 - ParseDate UnixDate - - stripHtml stripSpaces stripNewLines toReal + Dumper + md5 md5_hex md5_base64 + ParseDate UnixDate + strftime + stripHtml stripSpaces stripNewLines toReal trim + croak + array_getDifference + getDirList ); use strict; @@ -36,6 +45,14 @@ require LWP::UserAgent; use HTML::PullParser; +# $now_string = strftime "%a %b %e %H:%M:%S %Y", localtime; +# see "perldoc -f localtime" +use POSIX qw(strftime); + +use Carp; + +use DirHandle; + ######################################## @@ -48,6 +65,11 @@ return $text; } +sub trim { + my $string = shift; + return stripSpaces($string); +} + sub stripNewLines { my $text = shift; #print "text: $text", "\n"; @@ -81,4 +103,105 @@ return $result; } +sub array_getRelations { + my $a_ref = shift; + my $b_ref = shift; + my @a = @{$a_ref}; + my @b = @{$b_ref}; + + my @isect = my @diff = my @union = (); + my $e; + my %count; + + foreach $e (@a, @b) { $count{$e}++ } + + foreach $e (keys %count) { + push(@union, $e); + push @{ $count{$e} == 2 ? \@isect : \@diff }, $e; + } + + my $result = { + union => \@union, + isect => \@isect, + diff => \@diff, + }; + +} + +sub array_getDifference { + my $res = array_getRelations(shift, shift); + return $res->{diff}; +} + + +# ============================================= +# "global" vars used in directory-recursive-parsing +my $dirlist_buf; +my @dirlist_path; +my $dirlist_base; + +sub entry_callback { + + my $entry = shift; + + # CHECKS + # dont't use this: + if ($entry eq '.' || $entry eq '..') { return; } + + # PREPARE + # prepare path to current entry + my $cur_entry = join('/', @dirlist_path, $entry); + # prepare path to current entry (absolute) + my $cur_entry_abs = join('/', $dirlist_base, @dirlist_path, $entry); + + # ENTRY + # add current entry to buffer + $dirlist_buf .= $cur_entry . "\n"; + + # (SUB-)DIRECTORY + # check if current entry is a (sub-)directory ... + if (-d $cur_entry_abs) { + push @dirlist_path, $cur_entry; + # ... and parse this (recursion here!!!) + iterate_path($cur_entry_abs); + pop @dirlist_path; + } +} + +sub iterate_path { + + my $path = shift; + + # create new "DirHandle"-object + my $d = new DirHandle $path; + if (defined $d) { + + # iterate through all entries in $path ($d->read) and call out entry-handler on each entry + while (defined(my $line = $d->read)) { + entry_callback($line); + } + + undef $d; + } +} + +sub getDirList { + + $dirlist_base = shift; + + # reset vars + $dirlist_buf = ''; + @dirlist_path = (); + + # start parsing file-structure + iterate_path($dirlist_base); + + # return complete list of directory-content including files and subdirs + # entries are newline (\n) - seperated + return $dirlist_buf; + +} +# ============================================= + + 1;