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

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

Parent Directory | Revision Log | View Patch Patch

-revision 1.3 by cvsjoko,
Fri Jul 19 18:13:50 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
  #
-Line 17
+Line 43
  package libp;
+ use strict;
+ use warnings;
  require Exporter;
- @ISA = qw( Exporter );
+ our @ISA = qw( Exporter );
- @EXPORT = qw(
+ our @EXPORT_OK = qw(
      Dumper
      md5 md5_hex md5_base64
      ParseDate UnixDate
      strftime
-     stripHtml stripSpaces stripNewLines toReal trim
      croak
+     stripHtml stripSpaces stripNewLines toReal trim
      array_getDifference
+     getDirList
+     now today
+     deep_copy
+     getNewPerlObjectByPkgName
+     run_cmd run_cmds
  );
- use strict;
- use warnings;
  use Data::Dumper;
  use Digest::MD5 qw(md5 md5_hex md5_base64);
-Line 47 
 use POSIX qw(strftime);
+Line 79 
 use POSIX qw(strftime);
  use Carp;
+ use DirHandle;
  ########################################
-Line 97 
 sub stripHtml {
+Line 131 
 sub stripHtml {
    return $result;
  }
- sub array_getRelations {
-   my $a_ref = shift;
-   my $b_ref = shift;
-   my @a = @{$a_ref};
+ # =============================================
-   my @b = @{$b_ref};
+ # "global" vars used in directory-recursive-parsing
+ my $dirlist_buf;
-   my @isect = my @diff = my @union = ();
+ my @dirlist_path;
-   my $e;
+ my $dirlist_base;
-   my %count;
+ sub entry_callback {
-   foreach $e (@a, @b) { $count{$e}++ }
+   my $entry = shift;
-   foreach $e (keys %count) {
-       push(@union, $e);
+   # CHECKS
-       push @{ $count{$e} == 2 ? \@isect : \@diff }, $e;
+   # 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;
    }
+ }
-   my $result = {
-     union => \@union,
+ sub getDirList {
-     isect => \@isect,
-     diff => \@diff,
+   $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 array_getDifference {
+ sub now {
-   my $res = array_getRelations(shift, shift);
+   return strftime("%Y-%m-%d %H:%M:%S", localtime);
-   return $res->{diff};
+ }
+ 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.3
 


changed lines


 
Added in v.1.11
 Legend:



Removed from v.1.3
 


changed lines


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

MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26