WAIT/Document/Nroff.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: Sun Nov 22 18:44:48 1998
# Language        : CPerl
# Update Count    : 76
# Status          : Unknown, Use with caution!
# 
# Copyright (c) 1996-1997, Ulrich Pfeifer
# 

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

use IO::File;
use IO::Zlib;
use strict;
#use diagnostics;
use Carp;

sub TIEHASH {
  my $type    = shift;
  my $pipe    = shift;
  my @files   = grep -f $_, @_;
  
  my $self   = {
                Pipe   => $pipe || 'nroff',
                Files  => \@files
               };
  bless $self, ref($type) || $type;
}

#$ENV{PATH} .= ':/usr/local/groff-1.09/bin:/app/sun4_55/unido-inf/groff/1.10/bin';

use File::Basename;

sub catfile ($) {
  my $fullname = shift;
  my  ($name,$path) = fileparse($fullname);
  $path =~ s{man([^/]+)\/$}
            {cat$1/}; 
  "$path$name";
}

sub nroff {
  my $self = shift;
  my $path = shift;

  return undef unless -f $path;

  my $fh;
  if ($path =~ m/\.gz$/i) {
        $fh = new IO::Zlib("$path","rb");
  } else {
        $fh = new IO::File "< $path";
  }
  return undef unless defined $fh;
  my $first = <$fh>;
  $fh->close;
  return undef if $first =~ /^\.so man/;
  return undef unless defined $first;
  $first =~ /\'\\\"\s.*((e)|(t))+/;
  my @pre;
  my $pipe;
  if ($path =~ m/\.gz$/i) {
        $pipe .= 'gzip -cd';
  } else {
        $pipe .= 'cat';
  }
  $pipe .= " $path |";
  push @pre, 'eqn -Tascii' if $2;
  push @pre,  'tbl' if $3;
  push @pre, $self->{Pipe};
  if (@pre) {
    $pipe .=  join ('|', @pre) .  '|';;
  }
  local($/) = undef;
  $fh = new IO::File "$pipe";
  return unless defined $fh;
  <$fh>;
}

sub FETCH {
  my $self = shift;
  my $path = shift;
  my $catp = catfile $path;
  return undef unless defined $path;
  
  local($/) = undef;

  if (-e $catp) {
    my $fh;
    if ($path =~ m/\.gz$/) {
        $fh = new IO::Zlib("$path","rb");
    } else {
        $fh = new IO::File "< $path";
    }
    return <$fh>;
  }
  my $cont = $self->nroff($path);
  if ($cont) {
    my $fh = new IO::File "> $catp";
    if ($fh) {
      warn "Generating $catp\n";
      $fh->print($cont);
    }
  }
  $cont;
}

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	13	# -- Mode: Cperl --
2	ulpfr	10	# 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: Sun Nov 22 18:44:48 1998
8			# Language : CPerl
9			# Update Count : 76
10			# Status : Unknown, Use with caution!
11			#
12			# Copyright (c) 1996-1997, Ulrich Pfeifer
13			#
14
15			package WAIT::Document::Nroff;
16			@ISA = qw(WAIT::Document::Base);
17			require WAIT::Document::Base;
18
19	dpavlin	94	use IO::File;
20			use IO::Zlib;
21	ulpfr	10	use strict;
22			#use diagnostics;
23			use Carp;
24
25			sub TIEHASH {
26			my $type = shift;
27			my $pipe = shift;
28			my @files = grep -f $_, @_;
29
30			my $self = {
31			Pipe => $pipe \|\| 'nroff',
32			Files => \@files
33			};
34			bless $self, ref($type) \|\| $type;
35			}
36
37			#$ENV{PATH} .= ':/usr/local/groff-1.09/bin:/app/sun4_55/unido-inf/groff/1.10/bin';
38
39			use File::Basename;
40
41			sub catfile ($) {
42			my $fullname = shift;
43			my ($name,$path) = fileparse($fullname);
44			$path =~ s{man([^/]+)\/$}
45			{cat$1/};
46			"$path$name";
47			}
48
49			sub nroff {
50			my $self = shift;
51			my $path = shift;
52
53			return undef unless -f $path;
54
55	dpavlin	94	my $fh;
56			if ($path =~ m/\.gz$/i) {
57			$fh = new IO::Zlib("$path","rb");
58			} else {
59			$fh = new IO::File "< $path";
60			}
61	ulpfr	10	return undef unless defined $fh;
62			my $first = <$fh>;
63			$fh->close;
64			return undef if $first =~ /^\.so man/;
65			return undef unless defined $first;
66			$first =~ /\'\\\"\s.*((e)\|(t))+/;
67			my @pre;
68	dpavlin	94	my $pipe;
69			if ($path =~ m/\.gz$/i) {
70			$pipe .= 'gzip -cd';
71			} else {
72			$pipe .= 'cat';
73			}
74			$pipe .= " $path \|";
75	ulpfr	10	push @pre, 'eqn -Tascii' if $2;
76			push @pre, 'tbl' if $3;
77			push @pre, $self->{Pipe};
78			if (@pre) {
79			$pipe .= join ('\|', @pre) . '\|';;
80			}
81			local($/) = undef;
82	dpavlin	94	$fh = new IO::File "$pipe";
83	ulpfr	10	return unless defined $fh;
84			<$fh>;
85			}
86
87			sub FETCH {
88			my $self = shift;
89			my $path = shift;
90			my $catp = catfile $path;
91			return undef unless defined $path;
92
93			local($/) = undef;
94
95			if (-e $catp) {
96	dpavlin	94	my $fh;
97			if ($path =~ m/\.gz$/) {
98			$fh = new IO::Zlib("$path","rb");
99			} else {
100			$fh = new IO::File "< $path";
101			}
102	ulpfr	10	return <$fh>;
103			}
104			my $cont = $self->nroff($path);
105			if ($cont) {
106	dpavlin	94	my $fh = new IO::File "> $catp";
107	ulpfr	10	if ($fh) {
108			warn "Generating $catp\n";
109			$fh->print($cont);
110			}
111			}
112			$cont;
113			}
114
115			sub FIRSTKEY {
116			my $self = shift;
117			$self->{fno} = 0;
118			$self->NEXTKEY;
119			}
120
121			sub NEXTKEY {
122			my $self = shift;
123			return undef if ($self->{fno}++ > @{$self->{Files}});
124			$self->{Files}->[$self->{fno}-1];
125			}
126
127			sub close {
128			my $self = shift;
129
130			delete $self->{fno};
131			delete $self->{Files}; # no need at query time
132			}
133
134			1;