--- nfo/perl/libs/libp.pm 2002/11/17 07:18:59 1.6 +++ nfo/perl/libs/libp.pm 2002/12/22 14:15:02 1.12 @@ -1,8 +1,28 @@ ################################# # -# $Id: libp.pm,v 1.6 2002/11/17 07:18:59 joko Exp $ +# $Id: libp.pm,v 1.12 2002/12/22 14:15:02 joko Exp $ # # $Log: libp.pm,v $ +# 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 # @@ -26,24 +46,28 @@ package libp; +use strict; +use warnings; + require Exporter; -@ISA = qw( Exporter ); -@EXPORT = qw( +our @ISA = qw( Exporter ); +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 + now today deep_copy + getNewPerlObjectByPkgName + run_cmd run_cmds + mkObject ); -use strict; -use warnings; - use Data::Dumper; use Digest::MD5 qw(md5 md5_hex md5_base64); @@ -111,35 +135,7 @@ 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}; -} # ============================================= @@ -216,6 +212,11 @@ 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) { @@ -226,7 +227,47 @@ +{map { $_ => deep_copy($this->{$_}) } keys %$this}; } elsif (ref $this eq "CODE") { $this; - } else { die "what type is $_?" } + #} 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 mkObject { + 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(@_); +} + +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($_); + } } 1;