--- nfo/perl/libs/libp.pm 2002/06/24 14:49:59 1.1 +++ nfo/perl/libs/libp.pm 2002/12/05 13:54:00 1.9 @@ -1,8 +1,34 @@ ################################# # -# $Id: libp.pm,v 1.1 2002/06/24 14:49:59 cvsjoko Exp $ +# $Id: libp.pm,v 1.9 2002/12/05 13:54:00 joko Exp $ # # $Log: libp.pm,v $ +# Revision 1.9 2002/12/05 13:54:00 joko +# + fix: let 'deep_copy' print its message out (instead of die) +# +# Revision 1.8 2002/12/01 22:11:35 joko +# + sub cmd +# + sub run_cmds +# +# Revision 1.7 2002/11/29 04:44:53 joko +# - sub array_getRelations +# + sub getNewPerlObjectByPkgName +# +# 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 +# # Revision 1.1 2002/06/24 14:49:59 cvsjoko # + new # @@ -11,21 +37,212 @@ package libp; -require Exporter; -@ISA = qw( Exporter ); -@EXPORT = qw( - Dumper - md5 md5_hex md5_base64 - ParseDate UnixDate -); - use strict; use warnings; +require Exporter; +our @ISA = qw( Exporter ); +our @EXPORT_OK = qw( + Dumper + md5 md5_hex md5_base64 + ParseDate UnixDate + strftime + stripHtml stripSpaces stripNewLines toReal trim + croak + array_getDifference + getDirList + now + deep_copy + getNewPerlObjectByPkgName + cmd + run_cmds +); + use Data::Dumper; use Digest::MD5 qw(md5 md5_hex md5_base64); $main::TZ = 'GMT'; use Date::Manip; +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; + + +######################################## + +sub stripSpaces { + my $text = shift; + #print "text: $text", "\n"; + #print "ord: ", ord(substr($text, 0, 1)), "\n"; + $text =~ s/^\s*//g; + $text =~ s/\s*$//g; + return $text; +} + +sub trim { + my $string = shift; + return stripSpaces($string); +} + +sub stripNewLines { + my $text = shift; + #print "text: $text", "\n"; + #print "ord: ", ord(substr($text, 0, 1)), "\n"; + $text =~ s/\n//g; + #$text =~ s/\s*$//g; + return $text; +} + +sub toReal { + my $string = shift; + $string =~ m/(\d+\.*\d+)/; + my $real = $1; + return $real; +} + +sub stripHtml { + my $html = shift; + my $result = ''; + #$html =~ s/
(.*)/ - ($1)/i; + my $p = HTML::PullParser->new( + doc => \$html, + text => 'text', + unbroken_text => 1, + ); + while (my $token = $p->get_token()) { + my $text = join('', @{$token}); + $result .= $text; + } + #$result =~ s/ //g; + return $result; +} + + + + +# ============================================= +# "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); +} + +# ACK's go to ... +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 "deep_copy asks: what type is $this?" } + } else { print "deep_copy asks: what type is $this?", "\n"; } +} + +sub getNewPerlObjectByPkgName { + my $pkgname = shift; + my $args = shift; + #$logger->debug( __PACKAGE__ . "->getNewPerlObjectByPkgName( pkgname $pkgname args $args )" ); + my $evstring = "use $pkgname;"; + eval($evstring); + #$@ && $logger->error( __PACKAGE__ . ':' . __LINE__ . " Error in eval $evstring: " . $@ ); + $@ && print( __PACKAGE__ . ':' . __LINE__ . " Error in eval \"$evstring\": " . $@ ); + return $pkgname->new($args); +} + +sub cmd ($) { + my $cmd = shift; + $cmd = 'perl ' . $cmd; + my $sep = "-" x 90; + print $sep, "\n"; + print " ", $cmd, "\n"; + print $sep, "\n"; + system($cmd); + print "\n"; +} + +sub run_cmds { + foreach (@_) { + cmd($_); + } +} + 1;