1 |
# -*- Mode: Cperl -*- |
2 |
# 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; |