--- nfo/perl/libs/libp.pm 2002/10/27 18:34:28 1.5 +++ nfo/perl/libs/libp.pm 2003/02/09 04:49:09 1.14 @@ -1,8 +1,38 @@ ################################# # -# $Id: libp.pm,v 1.5 2002/10/27 18:34:28 joko Exp $ +# $Id: libp.pm,v 1.14 2003/02/09 04:49:09 joko Exp $ # # $Log: libp.pm,v $ +# Revision 1.14 2003/02/09 04:49:09 joko +# - purged lots of code and refactored into other modules +# - sorry! +# +# Revision 1.13 2002/12/23 04:25:13 joko +# + sub bool2status +# +# Revision 1.12 2002/12/22 14:15:02 joko +# + sub mkObject +# +# Revision 1.11 2002/12/19 16:27:17 joko +# +- renamed 'cmd' to 'run_cmd' +# +# Revision 1.10 2002/12/19 01:05:35 joko +# + sub today +# +# 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 # @@ -23,193 +53,33 @@ package libp; +use strict; +use warnings; + require Exporter; -@ISA = qw( Exporter ); -@EXPORT = qw( - Dumper - md5 md5_hex md5_base64 +our @ISA = qw( Exporter ); +our @EXPORT_OK = qw( ParseDate UnixDate - strftime - stripHtml stripSpaces stripNewLines toReal trim - croak array_getDifference - getDirList - now + bool2status ); -use strict; -use warnings; - -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; -} - -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 bool2status { + my $bool = shift; + return ($bool ? 'ok' : 'failed'); } 1;