WAIT/Document/Split.pm

#                              -*- Mode: Cperl -*- 
# Split.pm -- 
# ITIID           : $ITI$ $Header $__Header$
# Author          : Ulrich Pfeifer
# Created On      : Sun Sep 15 14:42:09 1996
# Last Modified By: Ulrich Pfeifer
# Last Modified On: Sun Nov 22 18:44:47 1998
# Language        : CPerl
# Update Count    : 66
# Status          : Unknown, Use with caution!
# 
# Copyright (c) 1996-1997, Ulrich Pfeifer
# 

package WAIT::Document::Split;
@ISA = qw(WAIT::Document::Base);
require WAIT::Document::Base;

use FileHandle;
use strict;
#use diagnostics;
use Carp;

sub TIEHASH {
  my $type   = shift;
  my $mode   = shift;
  my $regexp = shift;
  my @files  = grep -f $_, @_;

  my $self   = {Regexp => $regexp,
                Mode   => $mode,
                Files  => \@files};
  bless $self, ref($type) || $type;
}

sub FETCH {
  my $self = shift;
  my $key  = shift;

  # cached ?
  if (defined $self->{Key} and $self->{Key} eq $key) {
    return $self->{Value};
  }
  my ($file, $start, $length) = split ' ', $key;
  unless (defined $self->{File} and $self->{File} eq $file) {
    $self->openfile($file) or return;
  }
  #$fh->seek($start, 0); #SEEK_SET);
  $self->seek($start);
  $self->{Key}   = $key;
  $self->{Value} = '';
  $length = $self->{Fh}->read($self->{Value}, $length);
  $self->{_pos} += $length;
  $self->{Value};
}

# Emulate seek on gziped files.
sub seek {
  my $self = shift;
  my $pos  = shift;

  if ($self->{File} =~ /\.gz$/) {
    my $buf = '';
    if ($self->{_pos} < $pos) {
      $self->{Fh}->read($buf,$pos - $self->{_pos});
      $self->{_pos} = $pos;
    } elsif ($self->{_pos} > $pos) {
      my $file = $self->{File};
      $self->closefile;
      $self->openfile($file);
      $self->{Fh}->read($buf,$pos);
      $self->{_pos} = $pos;
    } else {
      1;
    }
  } else {
    $self->{Fh}->seek($pos, 0); #SEEK_SET);
  }
  
}

sub FIRSTKEY {
  my $self = shift;


  $self->{have} = [@{$self->{Files}}];
  return undef unless $self->nextfile();
  $self->NEXTKEY;
}

sub isopen {
  my $self = shift;

  exists $self->{Fh};
}

sub closefile {
  my $self = shift;

  if ($self->{Line}) {
    delete $self->{Line};
  }
  if ($self->{Fh}) {
    $self->{Fh}->close;
    delete $self->{Fh};
    delete $self->{File};
    $self->{_pos} = 0;
  }
}

sub openfile {
  my $self = shift;
  my $file = shift;
  my $fh;

  $self->closefile;

  if ($file =~ /\.gz$/) {
    $fh = new FileHandle "gzip -cd $file|";
  } else {
    $fh = new FileHandle "< $file";
  }

  unless (defined $fh) {
    return undef;
  }
  $self->{_pos} = 0;
  $self->{File} = $file;
  $self->{Fh}   = $fh;
}

sub close {
  my $self = shift;

  $self->closefile;
  for (qw(have Key Value File)) {
    delete $self->{$_} if exists $self->{$_};
  }
}

sub nextfile {
  my $self = shift;
  my $file = shift @{$self->{have}};

  return undef unless defined $file;
  $self->openfile($file);
}

sub NEXTKEY {
  my $self = shift;
  my $line;
  my $match;
  
  $self->isopen || $self->nextfile || return(undef);

  my $start = $self->{Fh}->tell;
  if (defined $self->{Line}) {
    $start -= length($self->{Line});
    $self->{Value} = $self->{Line};
  } else {
    $self->{Value} = '';
  }

  my $fh = $self->{Fh};
  while (defined($line = <$fh>)) {
    if ($line =~ /$self->{Regexp}/) {
      $match = 1;
      if ($self->{Mode} =~ /end/i) {
        $self->{Value} .= $line;
      } elsif ($self->{Mode} =~ /start/i) {
        $self->{Line}   = $line;
      }
      last;
    }
    $self->{Value} .= $line;
  }
  my $length = length($self->{Value});
  $self->{Key} = "$self->{File} $start $length";
  unless ($match) {             # EOF
    $self->closefile;
  }
  $self->{Key};
}

1;
1	dpavlin	106	# -- 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;