1 |
ulpfr |
13 |
# -*- Mode: Cperl -*- |
2 |
ulpfr |
10 |
# Split.pm -- |
3 |
|
|
# ITIID : $ITI$ $Header $__Header$ |
4 |
|
|
# Author : Ulrich Pfeifer |
5 |
|
|
# Created On : Sun Sep 15 14:42:09 1996 |
6 |
|
|
# Last Modified By: Ulrich Pfeifer |
7 |
|
|
# Last Modified On: Sun Nov 22 18:44:47 1998 |
8 |
|
|
# Language : CPerl |
9 |
|
|
# Update Count : 66 |
10 |
|
|
# Status : Unknown, Use with caution! |
11 |
|
|
# |
12 |
|
|
# Copyright (c) 1996-1997, Ulrich Pfeifer |
13 |
|
|
# |
14 |
|
|
|
15 |
|
|
package WAIT::Document::Split; |
16 |
|
|
@ISA = qw(WAIT::Document::Base); |
17 |
|
|
require WAIT::Document::Base; |
18 |
|
|
|
19 |
|
|
use FileHandle; |
20 |
|
|
use strict; |
21 |
|
|
#use diagnostics; |
22 |
|
|
use Carp; |
23 |
|
|
|
24 |
|
|
sub TIEHASH { |
25 |
|
|
my $type = shift; |
26 |
|
|
my $mode = shift; |
27 |
|
|
my $regexp = shift; |
28 |
|
|
my @files = grep -f $_, @_; |
29 |
|
|
|
30 |
|
|
my $self = {Regexp => $regexp, |
31 |
|
|
Mode => $mode, |
32 |
|
|
Files => \@files}; |
33 |
|
|
bless $self, ref($type) || $type; |
34 |
|
|
} |
35 |
|
|
|
36 |
|
|
sub FETCH { |
37 |
|
|
my $self = shift; |
38 |
|
|
my $key = shift; |
39 |
|
|
|
40 |
|
|
# cached ? |
41 |
|
|
if (defined $self->{Key} and $self->{Key} eq $key) { |
42 |
|
|
return $self->{Value}; |
43 |
|
|
} |
44 |
|
|
my ($file, $start, $length) = split ' ', $key; |
45 |
|
|
unless (defined $self->{File} and $self->{File} eq $file) { |
46 |
|
|
$self->openfile($file) or return; |
47 |
|
|
} |
48 |
|
|
#$fh->seek($start, 0); #SEEK_SET); |
49 |
|
|
$self->seek($start); |
50 |
|
|
$self->{Key} = $key; |
51 |
|
|
$self->{Value} = ''; |
52 |
|
|
$length = $self->{Fh}->read($self->{Value}, $length); |
53 |
|
|
$self->{_pos} += $length; |
54 |
|
|
$self->{Value}; |
55 |
|
|
} |
56 |
|
|
|
57 |
|
|
# Emulate seek on gziped files. |
58 |
|
|
sub seek { |
59 |
|
|
my $self = shift; |
60 |
|
|
my $pos = shift; |
61 |
|
|
|
62 |
|
|
if ($self->{File} =~ /\.gz$/) { |
63 |
|
|
my $buf = ''; |
64 |
|
|
if ($self->{_pos} < $pos) { |
65 |
|
|
$self->{Fh}->read($buf,$pos - $self->{_pos}); |
66 |
|
|
$self->{_pos} = $pos; |
67 |
|
|
} elsif ($self->{_pos} > $pos) { |
68 |
|
|
my $file = $self->{File}; |
69 |
|
|
$self->closefile; |
70 |
|
|
$self->openfile($file); |
71 |
|
|
$self->{Fh}->read($buf,$pos); |
72 |
|
|
$self->{_pos} = $pos; |
73 |
|
|
} else { |
74 |
|
|
1; |
75 |
|
|
} |
76 |
|
|
} else { |
77 |
|
|
$self->{Fh}->seek($pos, 0); #SEEK_SET); |
78 |
|
|
} |
79 |
|
|
|
80 |
|
|
} |
81 |
|
|
|
82 |
|
|
sub FIRSTKEY { |
83 |
|
|
my $self = shift; |
84 |
|
|
|
85 |
|
|
|
86 |
|
|
$self->{have} = [@{$self->{Files}}]; |
87 |
|
|
return undef unless $self->nextfile(); |
88 |
|
|
$self->NEXTKEY; |
89 |
|
|
} |
90 |
|
|
|
91 |
|
|
sub isopen { |
92 |
|
|
my $self = shift; |
93 |
|
|
|
94 |
|
|
exists $self->{Fh}; |
95 |
|
|
} |
96 |
|
|
|
97 |
|
|
sub closefile { |
98 |
|
|
my $self = shift; |
99 |
|
|
|
100 |
|
|
if ($self->{Line}) { |
101 |
|
|
delete $self->{Line}; |
102 |
|
|
} |
103 |
|
|
if ($self->{Fh}) { |
104 |
|
|
$self->{Fh}->close; |
105 |
|
|
delete $self->{Fh}; |
106 |
|
|
delete $self->{File}; |
107 |
|
|
$self->{_pos} = 0; |
108 |
|
|
} |
109 |
|
|
} |
110 |
|
|
|
111 |
|
|
sub openfile { |
112 |
|
|
my $self = shift; |
113 |
|
|
my $file = shift; |
114 |
|
|
my $fh; |
115 |
|
|
|
116 |
|
|
$self->closefile; |
117 |
|
|
|
118 |
|
|
if ($file =~ /\.gz$/) { |
119 |
|
|
$fh = new FileHandle "gzip -cd $file|"; |
120 |
|
|
} else { |
121 |
|
|
$fh = new FileHandle "< $file"; |
122 |
|
|
} |
123 |
|
|
|
124 |
|
|
unless (defined $fh) { |
125 |
|
|
return undef; |
126 |
|
|
} |
127 |
|
|
$self->{_pos} = 0; |
128 |
|
|
$self->{File} = $file; |
129 |
|
|
$self->{Fh} = $fh; |
130 |
|
|
} |
131 |
|
|
|
132 |
|
|
sub close { |
133 |
|
|
my $self = shift; |
134 |
|
|
|
135 |
|
|
$self->closefile; |
136 |
|
|
for (qw(have Key Value File)) { |
137 |
|
|
delete $self->{$_} if exists $self->{$_}; |
138 |
|
|
} |
139 |
|
|
} |
140 |
|
|
|
141 |
|
|
sub nextfile { |
142 |
|
|
my $self = shift; |
143 |
|
|
my $file = shift @{$self->{have}}; |
144 |
|
|
|
145 |
|
|
return undef unless defined $file; |
146 |
|
|
$self->openfile($file); |
147 |
|
|
} |
148 |
|
|
|
149 |
|
|
sub NEXTKEY { |
150 |
|
|
my $self = shift; |
151 |
|
|
my $line; |
152 |
|
|
my $match; |
153 |
|
|
|
154 |
|
|
$self->isopen || $self->nextfile || return(undef); |
155 |
|
|
|
156 |
|
|
my $start = $self->{Fh}->tell; |
157 |
|
|
if (defined $self->{Line}) { |
158 |
|
|
$start -= length($self->{Line}); |
159 |
|
|
$self->{Value} = $self->{Line}; |
160 |
|
|
} else { |
161 |
|
|
$self->{Value} = ''; |
162 |
|
|
} |
163 |
|
|
|
164 |
|
|
my $fh = $self->{Fh}; |
165 |
|
|
while (defined($line = <$fh>)) { |
166 |
|
|
if ($line =~ /$self->{Regexp}/) { |
167 |
|
|
$match = 1; |
168 |
|
|
if ($self->{Mode} =~ /end/i) { |
169 |
|
|
$self->{Value} .= $line; |
170 |
|
|
} elsif ($self->{Mode} =~ /start/i) { |
171 |
|
|
$self->{Line} = $line; |
172 |
|
|
} |
173 |
|
|
last; |
174 |
|
|
} |
175 |
|
|
$self->{Value} .= $line; |
176 |
|
|
} |
177 |
|
|
my $length = length($self->{Value}); |
178 |
|
|
$self->{Key} = "$self->{File} $start $length"; |
179 |
|
|
unless ($match) { # EOF |
180 |
|
|
$self->closefile; |
181 |
|
|
} |
182 |
|
|
$self->{Key}; |
183 |
|
|
} |
184 |
|
|
|
185 |
|
|
1; |