perl/libs/libp.pm

#################################
#
#  $Id: libp.pm,v 1.10 2002/12/19 01:05:35 joko Exp $
#
#  $Log: libp.pm,v $
#  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
#
#  Revision 1.5  2002/10/27 18:34:28  joko
#  + sub now
#
#  Revision 1.4  2002/08/16 19:06:39  cvsjoko
#  + sub getDirList
#
#  Revision 1.3  2002/07/19 18:13:50  cvsjoko
#  no message
#
#  Revision 1.2  2002/06/27 02:14:22  cvsjoko
#  + stripHtml stripSpaces stripNewLines toReal
#
#  Revision 1.1  2002/06/24 14:49:59  cvsjoko
#  + new
#
#
#################################

package libp;

use strict;
use warnings;

require Exporter;
our @ISA = qw( Exporter );
our @EXPORT_OK = qw( 
    Dumper
    md5 md5_hex md5_base64
    ParseDate UnixDate
    strftime
    croak

    stripHtml stripSpaces stripNewLines toReal trim
    array_getDifference
    getDirList
    now today
    deep_copy
    getNewPerlObjectByPkgName
    run_cmd run_cmds
);

use Data::Dumper;
use Digest::MD5 qw(md5 md5_hex md5_base64);

$main::TZ = 'GMT';
use Date::Manip;

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;


########################################

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;
}


# =============================================
# "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;

  # reset vars
  $dirlist_buf = '';
  @dirlist_path = ();

  # start parsing file-structure
  iterate_path($dirlist_base);

  # return complete list of directory-content including files and subdirs
  # entries are newline (\n) - seperated
  return $dirlist_buf;

}
# =============================================


sub now {
  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) {
    $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 "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 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;
1	cvsjoko	1.1	#################################
2			#
3	joko	1.11	# $Id: libp.pm,v 1.10 2002/12/19 01:05:35 joko Exp $
4	cvsjoko	1.2	#
5			# $Log: libp.pm,v $
6	joko	1.11	# Revision 1.10 2002/12/19 01:05:35 joko
7			# + sub today
8			#
9	joko	1.10	# Revision 1.9 2002/12/05 13:54:00 joko
10			# + fix: let 'deep_copy' print its message out (instead of die)
11			#
12	joko	1.9	# Revision 1.8 2002/12/01 22:11:35 joko
13			# + sub cmd
14			# + sub run_cmds
15			#
16	joko	1.8	# Revision 1.7 2002/11/29 04:44:53 joko
17			# - sub array_getRelations
18			# + sub getNewPerlObjectByPkgName
19			#
20	joko	1.7	# Revision 1.6 2002/11/17 07:18:59 joko
21			# + sub deep_copy
22			#
23	joko	1.6	# Revision 1.5 2002/10/27 18:34:28 joko
24			# + sub now
25			#
26	joko	1.5	# Revision 1.4 2002/08/16 19:06:39 cvsjoko
27			# + sub getDirList
28			#
29	cvsjoko	1.4	# Revision 1.3 2002/07/19 18:13:50 cvsjoko
30			# no message
31			#
32	cvsjoko	1.3	# Revision 1.2 2002/06/27 02:14:22 cvsjoko
33			# + stripHtml stripSpaces stripNewLines toReal
34			#
35	cvsjoko	1.2	# Revision 1.1 2002/06/24 14:49:59 cvsjoko
36			# + new
37	cvsjoko	1.1	#
38			#
39			#################################
40
41			package libp;
42
43	joko	1.7	use strict;
44			use warnings;
45
46	cvsjoko	1.1	require Exporter;
47	joko	1.7	our @ISA = qw( Exporter );
48			our @EXPORT_OK = qw(
49	cvsjoko	1.3	Dumper
50			md5 md5_hex md5_base64
51			ParseDate UnixDate
52			strftime
53	joko	1.11	croak
54
55	cvsjoko	1.3	stripHtml stripSpaces stripNewLines toReal trim
56			array_getDifference
57	cvsjoko	1.4	getDirList
58	joko	1.11	now today
59	joko	1.6	deep_copy
60	joko	1.7	getNewPerlObjectByPkgName
61	joko	1.11	run_cmd run_cmds
62	cvsjoko	1.1	);
63
64			use Data::Dumper;
65			use Digest::MD5 qw(md5 md5_hex md5_base64);
66
67			$main::TZ = 'GMT';
68			use Date::Manip;
69	cvsjoko	1.2
70			require LWP::UserAgent;
71			use HTML::PullParser;
72
73	cvsjoko	1.3	# $now_string = strftime "%a %b %e %H:%M:%S %Y", localtime;
74			# see "perldoc -f localtime"
75			use POSIX qw(strftime);
76
77			use Carp;
78
79	cvsjoko	1.4	use DirHandle;
80
81	cvsjoko	1.2
82			########################################
83
84			sub stripSpaces {
85			my $text = shift;
86			#print "text: $text", "\n";
87			#print "ord: ", ord(substr($text, 0, 1)), "\n";
88			$text =~ s/^\s*//g;
89			$text =~ s/\s*$//g;
90			return $text;
91			}
92
93	cvsjoko	1.3	sub trim {
94			my $string = shift;
95			return stripSpaces($string);
96			}
97
98	cvsjoko	1.2	sub stripNewLines {
99			my $text = shift;
100			#print "text: $text", "\n";
101			#print "ord: ", ord(substr($text, 0, 1)), "\n";
102			$text =~ s/\n//g;
103			#$text =~ s/\s*$//g;
104			return $text;
105			}
106
107			sub toReal {
108			my $string = shift;
109			$string =~ m/(\d+\.*\d+)/;
110			my $real = $1;
111			return $real;
112			}
113
114			sub stripHtml {
115			my $html = shift;
116			my $result = '';
117			#$html =~ s/<br>(.*)/ - ($1)/i;
118			my $p = HTML::PullParser->new(
119			doc => \$html,
120			text => 'text',
121			unbroken_text => 1,
122			);
123			while (my $token = $p->get_token()) {
124			my $text = join('', @{$token});
125			$result .= $text;
126			}
127			#$result =~ s/ //g;
128			return $result;
129	cvsjoko	1.3	}
130
131
132	cvsjoko	1.4
133
134			# =============================================
135			# "global" vars used in directory-recursive-parsing
136			my $dirlist_buf;
137			my @dirlist_path;
138			my $dirlist_base;
139
140			sub entry_callback {
141
142			my $entry = shift;
143
144			# CHECKS
145			# dont't use this:
146			if ($entry eq '.' \|\| $entry eq '..') { return; }
147
148			# PREPARE
149			# prepare path to current entry
150			my $cur_entry = join('/', @dirlist_path, $entry);
151			# prepare path to current entry (absolute)
152			my $cur_entry_abs = join('/', $dirlist_base, @dirlist_path, $entry);
153
154			# ENTRY
155			# add current entry to buffer
156			$dirlist_buf .= $cur_entry . "\n";
157
158			# (SUB-)DIRECTORY
159			# check if current entry is a (sub-)directory ...
160			if (-d $cur_entry_abs) {
161			push @dirlist_path, $cur_entry;
162			# ... and parse this (recursion here!!!)
163			iterate_path($cur_entry_abs);
164			pop @dirlist_path;
165			}
166			}
167
168			sub iterate_path {
169
170			my $path = shift;
171
172			# create new "DirHandle"-object
173			my $d = new DirHandle $path;
174			if (defined $d) {
175
176			# iterate through all entries in $path ($d->read) and call out entry-handler on each entry
177			while (defined(my $line = $d->read)) {
178			entry_callback($line);
179			}
180
181			undef $d;
182			}
183			}
184
185			sub getDirList {
186
187			$dirlist_base = shift;
188
189			# reset vars
190			$dirlist_buf = '';
191			@dirlist_path = ();
192
193			# start parsing file-structure
194			iterate_path($dirlist_base);
195
196			# return complete list of directory-content including files and subdirs
197			# entries are newline (\n) - seperated
198			return $dirlist_buf;
199
200			}
201			# =============================================
202
203	joko	1.5
204			sub now {
205			return strftime("%Y-%m-%d %H:%M:%S", localtime);
206	joko	1.10	}
207
208			sub today {
209			return strftime("%Y-%m-%d", localtime);
210	joko	1.6	}
211
212	joko	1.7	# ACK's go to ...
213	joko	1.6	sub deep_copy {
214			my $this = shift;
215			if (not ref $this) {
216			$this;
217			} elsif (ref $this eq "ARRAY") {
218			[map deep_copy($_), @$this];
219			} elsif (ref $this eq "HASH") {
220			+{map { $_ => deep_copy($this->{$_}) } keys %$this};
221			} elsif (ref $this eq "CODE") {
222			$this;
223	joko	1.9	#} else { die "deep_copy asks: what type is $this?" }
224			} else { print "deep_copy asks: what type is $this?", "\n"; }
225	joko	1.7	}
226
227			sub getNewPerlObjectByPkgName {
228			my $pkgname = shift;
229			my $args = shift;
230			#$logger->debug( __PACKAGE__ . "->getNewPerlObjectByPkgName( pkgname $pkgname args $args )" );
231			my $evstring = "use $pkgname;";
232			eval($evstring);
233			#$@ && $logger->error( __PACKAGE__ . ':' . __LINE__ . " Error in eval $evstring: " . $@ );
234			$@ && print( __PACKAGE__ . ':' . __LINE__ . " Error in eval \"$evstring\": " . $@ );
235			return $pkgname->new($args);
236	joko	1.8	}
237
238	joko	1.11	sub run_cmd {
239	joko	1.8	my $cmd = shift;
240			$cmd = 'perl ' . $cmd;
241			my $sep = "-" x 90;
242			print $sep, "\n";
243			print " ", $cmd, "\n";
244			print $sep, "\n";
245			system($cmd);
246			print "\n";
247			}
248
249			sub run_cmds {
250			foreach (@_) {
251	joko	1.11	run_cmd($_);
252	joko	1.8	}
253	joko	1.5	}
254	cvsjoko	1.1
255			1;
MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26