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	# -- 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: 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	use IO::File;
20	use IO::Zlib;
21	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	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	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	my $pipe;
69	if ($path =~ m/\.gz$/i) {
70	$pipe .= 'gzip -cd';
71	} else {
72	$pipe .= 'cat';
73	}
74	$pipe .= " $path \|";
75	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	$fh = new IO::File "$pipe";
83	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	my $fh;
97	if ($path =~ m/\.gz$/) {
98	$fh = new IO::Zlib("$path","rb");
99	} else {
100	$fh = new IO::File "< $path";
101	}
102	return <$fh>;
103	}
104	my $cont = $self->nroff($path);
105	if ($cont) {
106	my $fh = new IO::File "> $catp";
107	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;