/[cvs]/nfo/perl/libs/libp.pm

Diff of /nfo/perl/libs/libp.pm

Parent Directory | Revision Log | View Patch Patch

-revision 1.2 by cvsjoko,
Thu Jun 27 02:14:22 2002 UTC
+revision 1.11 by joko,
Thu Dec 19 16:27:17 2002 UTC
 Line 3
  #  $Id$
  #
  #  $Log$
+ #  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
+ #
+ #  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
  #
-Line 14
+Line 43
  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
+     croak
+     stripHtml stripSpaces stripNewLines toReal trim
+     array_getDifference
+     getDirList
+     now today
+     deep_copy
+     getNewPerlObjectByPkgName
+     run_cmd run_cmds
+ );
  use Data::Dumper;
  use Digest::MD5 qw(md5 md5_hex md5_base64);
-Line 36 
 use Date::Manip;
+Line 73 
 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;
  ########################################
-Line 48 
 sub stripSpaces {
+Line 93 
 sub stripSpaces {
    return $text;
  }
+ sub trim {
+   my $string = shift;
+   return stripSpaces($string);
+ }
  sub stripNewLines {
    my $text = shift;
    #print "text: $text", "\n";
-Line 81 
 sub stripHtml {
+Line 131 
 sub stripHtml {
    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 run_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 (@_) {
+     run_cmd($_);
+   }
+ }
 ;

 Legend:



Removed from v.1.2
 


changed lines


 
Added in v.1.11
 Legend:



Removed from v.1.2
 


changed lines


 
Added in v.1.11
-Removed from v.1.2
+Added in v.1.11

MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26