--- nfo/perl/libs/libp.pm 2002/06/27 02:14:22 1.2 +++ nfo/perl/libs/libp.pm 2002/11/17 07:18:59 1.6 @@ -1,8 +1,20 @@ ################################# # -# $Id: libp.pm,v 1.2 2002/06/27 02:14:22 cvsjoko Exp $ +# $Id: libp.pm,v 1.6 2002/11/17 07:18:59 joko Exp $ # # $Log: libp.pm,v $ +# Revision 1.6 2002/11/17 07:18:59 joko +# + sub deep_copy +# +# Revision 1.5 2002/10/27 18:34:28 joko +# + sub now +# +# 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 +29,16 @@ 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 + now + deep_copy ); use strict; @@ -36,6 +53,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 +73,11 @@ return $text; } +sub trim { + my $string = shift; + return stripSpaces($string); +} + sub stripNewLines { my $text = shift; #print "text: $text", "\n"; @@ -81,4 +111,122 @@ 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; + +} +# ============================================= + + +sub now { + return strftime("%Y-%m-%d %H:%M:%S", localtime); +} + +sub deep_copy { + my $this = shift; + if (not ref $this) { + $this; + } elsif (ref $this eq "ARRAY") { + [map deep_copy($_), @$this]; + } elsif (ref $this eq "HASH") { + +{map { $_ => deep_copy($this->{$_}) } keys %$this}; + } elsif (ref $this eq "CODE") { + $this; + } else { die "what type is $_?" } +} + 1;