/[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.7 by joko, Fri Nov 29 04:44:53 2002 UTC
# Line 3  Line 3 
3  #  $Id$  #  $Id$
4  #  #
5  #  $Log$  #  $Log$
6    #  Revision 1.7  2002/11/29 04:44:53  joko
7    #  - sub array_getRelations
8    #  + sub getNewPerlObjectByPkgName
9    #
10    #  Revision 1.6  2002/11/17 07:18:59  joko
11    #  + sub deep_copy
12    #
13    #  Revision 1.5  2002/10/27 18:34:28  joko
14    #  + sub now
15    #
16  #  Revision 1.4  2002/08/16 19:06:39  cvsjoko  #  Revision 1.4  2002/08/16 19:06:39  cvsjoko
17  #  + sub getDirList  #  + sub getDirList
18  #  #
# Line 20  Line 30 
30    
31  package libp;  package libp;
32    
33    use strict;
34    use warnings;
35    
36  require Exporter;  require Exporter;
37  @ISA = qw( Exporter );  our @ISA = qw( Exporter );
38  @EXPORT = qw(  our @EXPORT_OK = qw(
39      Dumper      Dumper
40      md5 md5_hex md5_base64      md5 md5_hex md5_base64
41      ParseDate UnixDate      ParseDate UnixDate
# Line 31  require Exporter; Line 44  require Exporter;
44      croak      croak
45      array_getDifference      array_getDifference
46      getDirList      getDirList
47        now
48        deep_copy
49        getNewPerlObjectByPkgName
50  );  );
51    
 use strict;  
 use warnings;  
   
52  use Data::Dumper;  use Data::Dumper;
53  use Digest::MD5 qw(md5 md5_hex md5_base64);  use Digest::MD5 qw(md5 md5_hex md5_base64);
54    
# Line 103  sub stripHtml { Line 116  sub stripHtml {
116    return $result;    return $result;
117  }  }
118    
 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,  
   };  
   
 }  
119    
 sub array_getDifference {  
   my $res = array_getRelations(shift, shift);  
   return $res->{diff};  
 }  
120    
121    
122  # =============================================  # =============================================
# Line 204  sub getDirList { Line 189  sub getDirList {
189  # =============================================  # =============================================
190    
191    
192    sub now {
193      return strftime("%Y-%m-%d %H:%M:%S", localtime);
194    }
195    
196    # ACK's go to ...
197    sub deep_copy {
198      my $this = shift;
199      if (not ref $this) {
200        $this;
201      } elsif (ref $this eq "ARRAY") {
202        [map deep_copy($_), @$this];
203      } elsif (ref $this eq "HASH") {
204        +{map { $_ => deep_copy($this->{$_}) } keys %$this};
205      } elsif (ref $this eq "CODE") {
206        $this;
207      } else { die "what type is $_?" }
208    }
209    
210    sub getNewPerlObjectByPkgName {
211      my $pkgname = shift;
212      my $args = shift;
213      #$logger->debug( __PACKAGE__ . "->getNewPerlObjectByPkgName( pkgname $pkgname args $args )" );
214      my $evstring = "use $pkgname;";
215      eval($evstring);
216      #$@ && $logger->error( __PACKAGE__ . ':' . __LINE__ . " Error in eval $evstring: " .  $@ );
217      $@ && print( __PACKAGE__ . ':' . __LINE__ . " Error in eval \"$evstring\": " .  $@ );
218      return $pkgname->new($args);
219    }
220    
221  1;  1;
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.7
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed