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);
use WAIT::Document::Base;

use IO::File;
use Encode;
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|<div|s;
      push @files, $entry;
    }
  }
  closedir DIR;
  my $self   = {
                Dir    => $dir,
                Files  => \@files
               };
  bless $self, ref($type) || $type;
}

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

  local($/) = undef;

  return {
          desc => $self->conv_getline("$id/desc.html"),
          author => $self->conv_getline("$id/author.html"),
          index => $self->conv_getline("$id/index.html"),
          colophon => $self->conv_getline("$id/colophon.html"),
          translator => $self->conv_getline("$id/translator.html"),
          toc => $self->conv_getline("$id/toc.html"),
          inx => $self->conv_getline("$id/inx.html"),
         };
}

# WAIT::Document::Ora::conv_getline
sub conv_getline {
  my($self) = shift;
  my($file) = shift;
  my $fh = IO::File->new("$self->{Dir}/$file") or return "";

  local $/ = "\n";
  my $firstline = <$fh>;
  my $src_enc;
  # \042 is double quote, \047 is single quote. I avoid single quotes
  # here just for easier copy and paste to the terminal (I need to
  # debug here frequently)
  if ($firstline =~ /<\?xml[^>]+encoding\s*=([\042\047])([\w\-]+)\1/) {
    $src_enc = $2;
  } else {
    $src_enc = "ISO-8859-1";
  }
  seek $fh, 0, 0;
  undef $/;
  my $content = <$fh>;
  $content =~ s/\s+/ /gs; # eliminate TABs and CRs for easier debugging
  my $dcontent = Encode::decode($src_enc,$content);
  $dcontent;
}

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	# -- 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	# Last Modified On: Fri Jan 4 15:56:11 2002
8	# Language : CPerl
9	# Update Count : 86
10	# 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	use WAIT::Document::Base;
18
19	use IO::File;
20	use Encode;
21	use strict;
22	use Carp;
23
24	sub TIEHASH {
25	my $type = shift;
26	my $dir = shift;
27	my @files;
28
29	opendir(DIR, $dir) or croak "Could not open '$dir': $!";
30	DIRENT: for my $entry (readdir DIR) {
31	if (-f "$dir/$entry/desc.html") {
32	my $index = "$dir/$entry/index.html";
33	open F, $index or Carp::confess("Could not open $index: $!");
34	local $/;
35	my $content = <F>;
36	next DIRENT unless $content =~ m\|<div\|s;
37	push @files, $entry;
38	}
39	}
40	closedir DIR;
41	my $self = {
42	Dir => $dir,
43	Files => \@files
44	};
45	bless $self, ref($type) \|\| $type;
46	}
47
48	sub FETCH {
49	my $self = shift;
50	my $id = shift;
51
52	local($/) = undef;
53
54	return {
55	desc => $self->conv_getline("$id/desc.html"),
56	author => $self->conv_getline("$id/author.html"),
57	index => $self->conv_getline("$id/index.html"),
58	colophon => $self->conv_getline("$id/colophon.html"),
59	translator => $self->conv_getline("$id/translator.html"),
60	toc => $self->conv_getline("$id/toc.html"),
61	inx => $self->conv_getline("$id/inx.html"),
62	};
63	}
64
65	# WAIT::Document::Ora::conv_getline
66	sub conv_getline {
67	my($self) = shift;
68	my($file) = shift;
69	my $fh = IO::File->new("$self->{Dir}/$file") or return "";
70
71	local $/ = "\n";
72	my $firstline = <$fh>;
73	my $src_enc;
74	# \042 is double quote, \047 is single quote. I avoid single quotes
75	# here just for easier copy and paste to the terminal (I need to
76	# debug here frequently)
77	if ($firstline =~ /<\?xml[^>]+encoding\s*=([\042\047])([\w\-]+)\1/) {
78	$src_enc = $2;
79	} else {
80	$src_enc = "ISO-8859-1";
81	}
82	seek $fh, 0, 0;
83	undef $/;
84	my $content = <$fh>;
85	$content =~ s/\s+/ /gs; # eliminate TABs and CRs for easier debugging
86	my $dcontent = Encode::decode($src_enc,$content);
87	$dcontent;
88	}
89
90	sub FIRSTKEY {
91	my $self = shift;
92	$self->{fno} = 0;
93	$self->NEXTKEY;
94	}
95
96	sub NEXTKEY {
97	my $self = shift;
98	return undef if ($self->{fno}++ > @{$self->{Files}});
99	$self->{Files}->[$self->{fno}-1];
100	}
101
102	sub close {
103	my $self = shift;
104
105	delete $self->{fno};
106	delete $self->{Files}; # no need at query time
107	}
108
109	1;