perl/libs/libp.pm

#################################
#
#  $Id: libp.pm,v 1.4 2002/08/16 19:06:39 cvsjoko Exp $
#
#  $Log: libp.pm,v $
#  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;

require Exporter;
@ISA = qw( Exporter );
@EXPORT = qw( 
    Dumper
    md5 md5_hex md5_base64
    ParseDate UnixDate
    strftime
    stripHtml stripSpaces stripNewLines toReal trim
    croak
    array_getDifference
    getDirList
    now
);

use strict;
use warnings;

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

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;

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

1;
1	cvsjoko	1.1	#################################
2			#
3	joko	1.5	# $Id: libp.pm,v 1.4 2002/08/16 19:06:39 cvsjoko Exp $
4	cvsjoko	1.2	#
5			# $Log: libp.pm,v $
6	joko	1.5	# Revision 1.4 2002/08/16 19:06:39 cvsjoko
7			# + sub getDirList
8			#
9	cvsjoko	1.4	# Revision 1.3 2002/07/19 18:13:50 cvsjoko
10			# no message
11			#
12	cvsjoko	1.3	# Revision 1.2 2002/06/27 02:14:22 cvsjoko
13			# + stripHtml stripSpaces stripNewLines toReal
14			#
15	cvsjoko	1.2	# Revision 1.1 2002/06/24 14:49:59 cvsjoko
16			# + new
17	cvsjoko	1.1	#
18			#
19			#################################
20
21			package libp;
22
23			require Exporter;
24			@ISA = qw( Exporter );
25			@EXPORT = qw(
26	cvsjoko	1.3	Dumper
27			md5 md5_hex md5_base64
28			ParseDate UnixDate
29			strftime
30			stripHtml stripSpaces stripNewLines toReal trim
31			croak
32			array_getDifference
33	cvsjoko	1.4	getDirList
34	joko	1.5	now
35	cvsjoko	1.1	);
36
37			use strict;
38			use warnings;
39
40			use Data::Dumper;
41			use Digest::MD5 qw(md5 md5_hex md5_base64);
42
43			$main::TZ = 'GMT';
44			use Date::Manip;
45	cvsjoko	1.2
46			require LWP::UserAgent;
47			use HTML::PullParser;
48
49	cvsjoko	1.3	# $now_string = strftime "%a %b %e %H:%M:%S %Y", localtime;
50			# see "perldoc -f localtime"
51			use POSIX qw(strftime);
52
53			use Carp;
54
55	cvsjoko	1.4	use DirHandle;
56
57	cvsjoko	1.2
58			########################################
59
60			sub stripSpaces {
61			my $text = shift;
62			#print "text: $text", "\n";
63			#print "ord: ", ord(substr($text, 0, 1)), "\n";
64			$text =~ s/^\s*//g;
65			$text =~ s/\s*$//g;
66			return $text;
67			}
68
69	cvsjoko	1.3	sub trim {
70			my $string = shift;
71			return stripSpaces($string);
72			}
73
74	cvsjoko	1.2	sub stripNewLines {
75			my $text = shift;
76			#print "text: $text", "\n";
77			#print "ord: ", ord(substr($text, 0, 1)), "\n";
78			$text =~ s/\n//g;
79			#$text =~ s/\s*$//g;
80			return $text;
81			}
82
83			sub toReal {
84			my $string = shift;
85			$string =~ m/(\d+\.*\d+)/;
86			my $real = $1;
87			return $real;
88			}
89
90			sub stripHtml {
91			my $html = shift;
92			my $result = '';
93			#$html =~ s/<br>(.*)/ - ($1)/i;
94			my $p = HTML::PullParser->new(
95			doc => \$html,
96			text => 'text',
97			unbroken_text => 1,
98			);
99			while (my $token = $p->get_token()) {
100			my $text = join('', @{$token});
101			$result .= $text;
102			}
103			#$result =~ s/ //g;
104			return $result;
105	cvsjoko	1.3	}
106
107			sub array_getRelations {
108			my $a_ref = shift;
109			my $b_ref = shift;
110			my @a = @{$a_ref};
111			my @b = @{$b_ref};
112
113			my @isect = my @diff = my @union = ();
114			my $e;
115			my %count;
116
117			foreach $e (@a, @b) { $count{$e}++ }
118
119			foreach $e (keys %count) {
120			push(@union, $e);
121			push @{ $count{$e} == 2 ? \@isect : \@diff }, $e;
122			}
123
124			my $result = {
125			union => \@union,
126			isect => \@isect,
127			diff => \@diff,
128			};
129
130			}
131
132			sub array_getDifference {
133			my $res = array_getRelations(shift, shift);
134			return $res->{diff};
135	cvsjoko	1.2	}
136	cvsjoko	1.4
137
138			# =============================================
139			# "global" vars used in directory-recursive-parsing
140			my $dirlist_buf;
141			my @dirlist_path;
142			my $dirlist_base;
143
144			sub entry_callback {
145
146			my $entry = shift;
147
148			# CHECKS
149			# dont't use this:
150			if ($entry eq '.' \|\| $entry eq '..') { return; }
151
152			# PREPARE
153			# prepare path to current entry
154			my $cur_entry = join('/', @dirlist_path, $entry);
155			# prepare path to current entry (absolute)
156			my $cur_entry_abs = join('/', $dirlist_base, @dirlist_path, $entry);
157
158			# ENTRY
159			# add current entry to buffer
160			$dirlist_buf .= $cur_entry . "\n";
161
162			# (SUB-)DIRECTORY
163			# check if current entry is a (sub-)directory ...
164			if (-d $cur_entry_abs) {
165			push @dirlist_path, $cur_entry;
166			# ... and parse this (recursion here!!!)
167			iterate_path($cur_entry_abs);
168			pop @dirlist_path;
169			}
170			}
171
172			sub iterate_path {
173
174			my $path = shift;
175
176			# create new "DirHandle"-object
177			my $d = new DirHandle $path;
178			if (defined $d) {
179
180			# iterate through all entries in $path ($d->read) and call out entry-handler on each entry
181			while (defined(my $line = $d->read)) {
182			entry_callback($line);
183			}
184
185			undef $d;
186			}
187			}
188
189			sub getDirList {
190
191			$dirlist_base = shift;
192
193			# reset vars
194			$dirlist_buf = '';
195			@dirlist_path = ();
196
197			# start parsing file-structure
198			iterate_path($dirlist_base);
199
200			# return complete list of directory-content including files and subdirs
201			# entries are newline (\n) - seperated
202			return $dirlist_buf;
203
204			}
205			# =============================================
206
207	joko	1.5
208			sub now {
209			return strftime("%Y-%m-%d %H:%M:%S", localtime);
210			}
211	cvsjoko	1.1
212			1;
MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26