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

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.6 by joko, Sun Nov 17 07:18:59 2002 UTC revision 1.10 by joko, Thu Dec 19 01:05:35 2002 UTC
# Line 3  Line 3 
3  #  $Id$  #  $Id$
4  #  #
5  #  $Log$  #  $Log$
6    #  Revision 1.10  2002/12/19 01:05:35  joko
7    #  + sub today
8    #
9    #  Revision 1.9  2002/12/05 13:54:00  joko
10    #  + fix: let 'deep_copy' print its message out (instead of die)
11    #
12    #  Revision 1.8  2002/12/01 22:11:35  joko
13    #  + sub cmd
14    #  + sub run_cmds
15    #
16    #  Revision 1.7  2002/11/29 04:44:53  joko
17    #  - sub array_getRelations
18    #  + sub getNewPerlObjectByPkgName
19    #
20  #  Revision 1.6  2002/11/17 07:18:59  joko  #  Revision 1.6  2002/11/17 07:18:59  joko
21  #  + sub deep_copy  #  + sub deep_copy
22  #  #
# Line 26  Line 40 
40    
41  package libp;  package libp;
42    
43    use strict;
44    use warnings;
45    
46  require Exporter;  require Exporter;
47  @ISA = qw( Exporter );  our @ISA = qw( Exporter );
48  @EXPORT = qw(  our @EXPORT_OK = qw(
49      Dumper      Dumper
50      md5 md5_hex md5_base64      md5 md5_hex md5_base64
51      ParseDate UnixDate      ParseDate UnixDate
# Line 39  require Exporter; Line 56  require Exporter;
56      getDirList      getDirList
57      now      now
58      deep_copy      deep_copy
59        getNewPerlObjectByPkgName
60        cmd
61        run_cmds
62        today
63  );  );
64    
 use strict;  
 use warnings;  
   
65  use Data::Dumper;  use Data::Dumper;
66  use Digest::MD5 qw(md5 md5_hex md5_base64);  use Digest::MD5 qw(md5 md5_hex md5_base64);
67    
# Line 111  sub stripHtml { Line 129  sub stripHtml {
129    return $result;    return $result;
130  }  }
131    
 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,  
   };  
132    
 }  
   
 sub array_getDifference {  
   my $res = array_getRelations(shift, shift);  
   return $res->{diff};  
 }  
133    
134    
135  # =============================================  # =============================================
# Line 216  sub now { Line 206  sub now {
206    return strftime("%Y-%m-%d %H:%M:%S", localtime);    return strftime("%Y-%m-%d %H:%M:%S", localtime);
207  }  }
208    
209    sub today {
210      return strftime("%Y-%m-%d", localtime);
211    }
212    
213    # ACK's go to ...
214  sub deep_copy {  sub deep_copy {
215    my $this = shift;    my $this = shift;
216    if (not ref $this) {    if (not ref $this) {
# Line 226  sub deep_copy { Line 221  sub deep_copy {
221      +{map { $_ => deep_copy($this->{$_}) } keys %$this};      +{map { $_ => deep_copy($this->{$_}) } keys %$this};
222    } elsif (ref $this eq "CODE") {    } elsif (ref $this eq "CODE") {
223      $this;      $this;
224    } else { die "what type is $_?" }    #} else { die "deep_copy asks: what type is $this?" }
225      } else { print "deep_copy asks: what type is $this?", "\n"; }
226    }
227    
228    sub getNewPerlObjectByPkgName {
229      my $pkgname = shift;
230      my $args = shift;
231      #$logger->debug( __PACKAGE__ . "->getNewPerlObjectByPkgName( pkgname $pkgname args $args )" );
232      my $evstring = "use $pkgname;";
233      eval($evstring);
234      #$@ && $logger->error( __PACKAGE__ . ':' . __LINE__ . " Error in eval $evstring: " .  $@ );
235      $@ && print( __PACKAGE__ . ':' . __LINE__ . " Error in eval \"$evstring\": " .  $@ );
236      return $pkgname->new($args);
237    }
238    
239    sub cmd ($) {
240      my $cmd = shift;
241      $cmd = 'perl ' . $cmd;
242      my $sep = "-" x 90;
243      print $sep, "\n";
244      print "  ", $cmd, "\n";
245      print $sep, "\n";
246      system($cmd);
247      print "\n";
248    }
249    
250    sub run_cmds {
251      foreach (@_) {
252        cmd($_);
253      }
254  }  }
255    
256  1;  1;
Legend:
Removed from v.1.6  
changed lines
  Added in v.1.10
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed