/[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.4 by cvsjoko, Fri Aug 16 19:06:39 2002 UTC revision 1.11 by joko, Thu Dec 19 16:27:17 2002 UTC
# Line 3  Line 3 
3  #  $Id$  #  $Id$
4  #  #
5  #  $Log$  #  $Log$
6    #  Revision 1.11  2002/12/19 16:27:17  joko
7    #  +- renamed 'cmd' to 'run_cmd'
8    #
9    #  Revision 1.10  2002/12/19 01:05:35  joko
10    #  + sub today
11    #
12    #  Revision 1.9  2002/12/05 13:54:00  joko
13    #  + fix: let 'deep_copy' print its message out (instead of die)
14    #
15    #  Revision 1.8  2002/12/01 22:11:35  joko
16    #  + sub cmd
17    #  + sub run_cmds
18    #
19    #  Revision 1.7  2002/11/29 04:44:53  joko
20    #  - sub array_getRelations
21    #  + sub getNewPerlObjectByPkgName
22    #
23    #  Revision 1.6  2002/11/17 07:18:59  joko
24    #  + sub deep_copy
25    #
26    #  Revision 1.5  2002/10/27 18:34:28  joko
27    #  + sub now
28    #
29  #  Revision 1.4  2002/08/16 19:06:39  cvsjoko  #  Revision 1.4  2002/08/16 19:06:39  cvsjoko
30  #  + sub getDirList  #  + sub getDirList
31  #  #
# Line 20  Line 43 
43    
44  package libp;  package libp;
45    
46    use strict;
47    use warnings;
48    
49  require Exporter;  require Exporter;
50  @ISA = qw( Exporter );  our @ISA = qw( Exporter );
51  @EXPORT = qw(  our @EXPORT_OK = qw(
52      Dumper      Dumper
53      md5 md5_hex md5_base64      md5 md5_hex md5_base64
54      ParseDate UnixDate      ParseDate UnixDate
55      strftime      strftime
     stripHtml stripSpaces stripNewLines toReal trim  
56      croak      croak
57    
58        stripHtml stripSpaces stripNewLines toReal trim
59      array_getDifference      array_getDifference
60      getDirList      getDirList
61        now today
62        deep_copy
63        getNewPerlObjectByPkgName
64        run_cmd run_cmds
65  );  );
66    
 use strict;  
 use warnings;  
   
67  use Data::Dumper;  use Data::Dumper;
68  use Digest::MD5 qw(md5 md5_hex md5_base64);  use Digest::MD5 qw(md5 md5_hex md5_base64);
69    
# Line 103  sub stripHtml { Line 131  sub stripHtml {
131    return $result;    return $result;
132  }  }
133    
 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,  
   };  
134    
 }  
   
 sub array_getDifference {  
   my $res = array_getRelations(shift, shift);  
   return $res->{diff};  
 }  
135    
136    
137  # =============================================  # =============================================
# Line 204  sub getDirList { Line 204  sub getDirList {
204  # =============================================  # =============================================
205    
206    
207    sub now {
208      return strftime("%Y-%m-%d %H:%M:%S", localtime);
209    }
210    
211    sub today {
212      return strftime("%Y-%m-%d", localtime);
213    }
214    
215    # ACK's go to ...
216    sub deep_copy {
217      my $this = shift;
218      if (not ref $this) {
219        $this;
220      } elsif (ref $this eq "ARRAY") {
221        [map deep_copy($_), @$this];
222      } elsif (ref $this eq "HASH") {
223        +{map { $_ => deep_copy($this->{$_}) } keys %$this};
224      } elsif (ref $this eq "CODE") {
225        $this;
226      #} else { die "deep_copy asks: what type is $this?" }
227      } else { print "deep_copy asks: what type is $this?", "\n"; }
228    }
229    
230    sub getNewPerlObjectByPkgName {
231      my $pkgname = shift;
232      my $args = shift;
233      #$logger->debug( __PACKAGE__ . "->getNewPerlObjectByPkgName( pkgname $pkgname args $args )" );
234      my $evstring = "use $pkgname;";
235      eval($evstring);
236      #$@ && $logger->error( __PACKAGE__ . ':' . __LINE__ . " Error in eval $evstring: " .  $@ );
237      $@ && print( __PACKAGE__ . ':' . __LINE__ . " Error in eval \"$evstring\": " .  $@ );
238      return $pkgname->new($args);
239    }
240    
241    sub run_cmd {
242      my $cmd = shift;
243      $cmd = 'perl ' . $cmd;
244      my $sep = "-" x 90;
245      print $sep, "\n";
246      print "  ", $cmd, "\n";
247      print $sep, "\n";
248      system($cmd);
249      print "\n";
250    }
251    
252    sub run_cmds {
253      foreach (@_) {
254        run_cmd($_);
255      }
256    }
257    
258  1;  1;

Legend:
Removed from v.1.4  
changed lines
  Added in v.1.11

MailToCvsAdmin">MailToCvsAdmin
ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed