/[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.14 by joko, Sun Feb 9 04:49:09 2003 UTC
# Line 3  Line 3 
3  #  $Id$  #  $Id$
4  #  #
5  #  $Log$  #  $Log$
6    #  Revision 1.14  2003/02/09 04:49:09  joko
7    #  - purged lots of code and refactored into other modules
8    #  - sorry!
9    #
10    #  Revision 1.13  2002/12/23 04:25:13  joko
11    #  + sub bool2status
12    #
13    #  Revision 1.12  2002/12/22 14:15:02  joko
14    #  + sub mkObject
15    #
16    #  Revision 1.11  2002/12/19 16:27:17  joko
17    #  +- renamed 'cmd' to 'run_cmd'
18    #
19    #  Revision 1.10  2002/12/19 01:05:35  joko
20    #  + sub today
21    #
22    #  Revision 1.9  2002/12/05 13:54:00  joko
23    #  + fix: let 'deep_copy' print its message out (instead of die)
24    #
25    #  Revision 1.8  2002/12/01 22:11:35  joko
26    #  + sub cmd
27    #  + sub run_cmds
28    #
29    #  Revision 1.7  2002/11/29 04:44:53  joko
30    #  - sub array_getRelations
31    #  + sub getNewPerlObjectByPkgName
32    #
33  #  Revision 1.6  2002/11/17 07:18:59  joko  #  Revision 1.6  2002/11/17 07:18:59  joko
34  #  + sub deep_copy  #  + sub deep_copy
35  #  #
# Line 26  Line 53 
53    
54  package libp;  package libp;
55    
56    use strict;
57    use warnings;
58    
59  require Exporter;  require Exporter;
60  @ISA = qw( Exporter );  our @ISA = qw( Exporter );
61  @EXPORT = qw(  our @EXPORT_OK = qw(
     Dumper  
     md5 md5_hex md5_base64  
62      ParseDate UnixDate      ParseDate UnixDate
     strftime  
     stripHtml stripSpaces stripNewLines toReal trim  
     croak  
63      array_getDifference      array_getDifference
64      getDirList      bool2status
     now  
     deep_copy  
65  );  );
66    
 use strict;  
 use warnings;  
   
 use Data::Dumper;  
 use Digest::MD5 qw(md5 md5_hex md5_base64);  
   
67  $main::TZ = 'GMT';  $main::TZ = 'GMT';
68  use Date::Manip;  use Date::Manip;
69    
 require LWP::UserAgent;  
 use HTML::PullParser;  
   
 # $now_string = strftime "%a %b %e %H:%M:%S %Y", localtime;  
 # see "perldoc -f localtime"  
 use POSIX qw(strftime);  
   
 use Carp;  
   
 use DirHandle;  
   
70    
71  ########################################  ########################################
72    
 sub stripSpaces {  
   my $text = shift;  
   #print "text: $text", "\n";  
   #print "ord: ", ord(substr($text, 0, 1)), "\n";  
   $text =~ s/^\s*//g;  
   $text =~ s/\s*$//g;  
   return $text;  
 }  
   
 sub trim {  
   my $string = shift;  
   return stripSpaces($string);  
 }  
   
 sub stripNewLines {  
   my $text = shift;  
   #print "text: $text", "\n";  
   #print "ord: ", ord(substr($text, 0, 1)), "\n";  
   $text =~ s/\n//g;  
   #$text =~ s/\s*$//g;  
   return $text;  
 }  
   
 sub toReal {  
   my $string = shift;  
   $string =~ m/(\d+\.*\d+)/;  
   my $real = $1;  
   return $real;  
 }  
   
 sub stripHtml {  
   my $html = shift;  
   my $result = '';  
   #$html =~ s/<br>(.*)/ - ($1)/i;  
   my $p = HTML::PullParser->new(  
     doc => \$html,  
     text => 'text',  
     unbroken_text => 1,  
   );  
   while (my $token = $p->get_token()) {  
     my $text = join('', @{$token});  
     $result .= $text;  
   }  
   #$result =~ s/&nbsp;//g;  
   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};  
 }  
   
   
 # =============================================  
 # "global" vars used in directory-recursive-parsing  
 my $dirlist_buf;  
 my @dirlist_path;  
 my $dirlist_base;  
   
 sub entry_callback {  
   
   my $entry = shift;  
   
   # CHECKS  
   # 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;  
   }  
 }  
   
 sub getDirList {  
   
   $dirlist_base = shift;  
73    
   # reset vars  
   $dirlist_buf = '';  
   @dirlist_path = ();  
74    
   # start parsing file-structure  
   iterate_path($dirlist_base);  
75    
   # return complete list of directory-content including files and subdirs  
   # entries are newline (\n) - seperated  
   return $dirlist_buf;  
76    
 }  
77  # =============================================  # =============================================
78    
79    
80  sub now {  sub bool2status {
81    return strftime("%Y-%m-%d %H:%M:%S", localtime);    my $bool = shift;
82  }    return ($bool ? 'ok' : 'failed');
   
 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 "what type is $_?" }  
83  }  }
84    
85  1;  1;
Legend:
Removed from v.1.6  
changed lines
  Added in v.1.14
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed