--- nfo/perl/libs/libp.pm	2002/06/27 02:14:22	1.2
+++ nfo/perl/libs/libp.pm	2002/12/19 01:05:35	1.10
@@ -1,8 +1,34 @@
 #################################
 #
-#  $Id: libp.pm,v 1.2 2002/06/27 02:14:22 cvsjoko Exp $
+#  $Id: libp.pm,v 1.10 2002/12/19 01:05:35 joko Exp $
 #
 #  $Log: libp.pm,v $
+#  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
+#
+#  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
 #
@@ -14,19 +40,28 @@
 
 package libp;
 
-require Exporter;
-@ISA = qw( Exporter );
-@EXPORT = qw( 
-  Dumper 
-  md5 md5_hex md5_base64
-  ParseDate UnixDate
-  
-  stripHtml stripSpaces stripNewLines toReal 
-);
-
 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
+    today
+);
+
 use Data::Dumper;
 use Digest::MD5 qw(md5 md5_hex md5_base64);
 
@@ -36,6 +71,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 +91,11 @@
   return $text;
 }
 
+sub trim {
+  my $string = shift;
+  return stripSpaces($string);
+}
+
 sub stripNewLines {
   my $text = shift;
   #print "text: $text", "\n";
@@ -81,4 +129,128 @@
   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);
+}
+
+sub today {
+  return strftime("%Y-%m-%d", 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;