WAIT/Document/Ora.pm

#                              -*- Mode: Cperl -*- 
# Nroff.pm -- 
# ITIID           : $ITI$ $Header $__Header$
# Author          : Ulrich Pfeifer
# Created On      : Mon Sep 16 19:04:37 1996
# Last Modified By: Ulrich Pfeifer
# Last Modified On: Fri Jan  4 15:56:11 2002
# Language        : CPerl
# Update Count    : 86
# Status          : Unknown, Use with caution!
# 
# Copyright (c) 1996-1997, Ulrich Pfeifer
# 

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

use IO::File;
use strict;
use Carp;

sub TIEHASH {
  my $type    = shift;
  my $dir     = shift;
  my @files;

  opendir(DIR, $dir) or croak "Could not open '$dir': $!";
 DIRENT: for my $entry (readdir DIR) {
    if (-f "$dir/$entry/desc.html") {
      my $index = "$dir/$entry/index.html";
      open F, $index or Carp::confess("Could not open $index: $!");
      local $/;
      my $content = <F>;
      next DIRENT unless $content =~ m|<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"\s+"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">\s+<html xmlns="http://www.w3.org/1999/xhtml" lang="en-US" xml:lang="en-US">\s+<head>\s+<!-- product id:|s;
      push @files, $entry;
    }
  }
  closedir DIR;
  my $self   = {
                Dir    => $dir,
                Files  => \@files
               };
  bless $self, ref($type) || $type;
}

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

  local($/) = undef;

  my $fh = IO::File->new(join('/',$self->{Dir},$file,'desc.html'));
  my $desc = $fh->getline();
  $fh = IO::File->new(join('/',$self->{Dir},$file,'author.html'));
  my $author = $fh->getline() if $fh;
  $fh = IO::File->new(join('/',$self->{Dir},$file,'index.html'));
  my $index = $fh->getline() if $fh;
  $fh = IO::File->new(join('/',$self->{Dir},$file,'colophon.html'));
  my $colophon = $fh->getline() if $fh;
  return {
          desc => $desc,
          author => $author,
          index => $index,
          colophon => $colophon,
         };
}

sub FIRSTKEY {
  my $self = shift;
  $self->{fno} = 0;
  $self->NEXTKEY;
}

sub NEXTKEY {
  my $self = shift;
  return undef if ($self->{fno}++ > @{$self->{Files}});
  $self->{Files}->[$self->{fno}-1];
}

sub close {
  my $self = shift;

  delete $self->{fno};
  delete $self->{Files};        # no need at query time
}

1;
1	ulpfr	53	# -- Mode: Cperl --
2			# Nroff.pm --
3			# ITIID : $ITI$ $Header $__Header$
4			# Author : Ulrich Pfeifer
5			# Created On : Mon Sep 16 19:04:37 1996
6			# Last Modified By: Ulrich Pfeifer
7	ulpfr	60	# Last Modified On: Fri Jan 4 15:56:11 2002
8	ulpfr	53	# Language : CPerl
9	ulpfr	60	# Update Count : 86
10	ulpfr	53	# Status : Unknown, Use with caution!
11			#
12			# Copyright (c) 1996-1997, Ulrich Pfeifer
13			#
14
15			package WAIT::Document::Ora;
16			@ISA = qw(WAIT::Document::Base);
17			require WAIT::Document::Base;
18
19			use IO::File;
20			use strict;
21			use Carp;
22
23			sub TIEHASH {
24			my $type = shift;
25			my $dir = shift;
26			my @files;
27
28			opendir(DIR, $dir) or croak "Could not open '$dir': $!";
29	laperla	65	DIRENT: for my $entry (readdir DIR) {
30	ulpfr	53	if (-f "$dir/$entry/desc.html") {
31	laperla	65	my $index = "$dir/$entry/index.html";
32			open F, $index or Carp::confess("Could not open $index: $!");
33			local $/;
34			my $content = <F>;
35			next DIRENT unless $content =~ m\|<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"\s+"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">\s+<html xmlns="http://www.w3.org/1999/xhtml" lang="en-US" xml:lang="en-US">\s+<head>\s+<!-- product id:\|s;
36	ulpfr	53	push @files, $entry;
37			}
38			}
39	laperla	65	closedir DIR;
40	ulpfr	53	my $self = {
41			Dir => $dir,
42			Files => \@files
43			};
44			bless $self, ref($type) \|\| $type;
45			}
46
47			sub FETCH {
48			my $self = shift;
49			my $file = shift;
50
51			local($/) = undef;
52
53			my $fh = IO::File->new(join('/',$self->{Dir},$file,'desc.html'));
54			my $desc = $fh->getline();
55			$fh = IO::File->new(join('/',$self->{Dir},$file,'author.html'));
56	ulpfr	57	my $author = $fh->getline() if $fh;
57	ulpfr	60	$fh = IO::File->new(join('/',$self->{Dir},$file,'index.html'));
58			my $index = $fh->getline() if $fh;
59	laperla	65	$fh = IO::File->new(join('/',$self->{Dir},$file,'colophon.html'));
60			my $colophon = $fh->getline() if $fh;
61			return {
62			desc => $desc,
63			author => $author,
64			index => $index,
65			colophon => $colophon,
66			};
67	ulpfr	53	}
68
69			sub FIRSTKEY {
70			my $self = shift;
71			$self->{fno} = 0;
72			$self->NEXTKEY;
73			}
74
75			sub NEXTKEY {
76			my $self = shift;
77			return undef if ($self->{fno}++ > @{$self->{Files}});
78			$self->{Files}->[$self->{fno}-1];
79			}
80
81			sub close {
82			my $self = shift;
83
84			delete $self->{fno};
85			delete $self->{Files}; # no need at query time
86			}
87
88			1;