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