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 FileHandle;
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 = new FileHandle "< $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;
  push @pre, 'eqn -Tascii' if $2;
  push @pre,  'tbl' if $3;
  push @pre, $self->{Pipe};
  my $pipe = pop(@pre) . " $path |";
  if (@pre) {
    $pipe .=  join ('|', @pre) .  '|';;
  }
  local($/) = undef;
  $fh = new FileHandle "$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 = new FileHandle "< $catp";
    return <$fh>;
  }
  my $cont = $self->nroff($path);
  if ($cont) {
    my $fh = new FileHandle "> $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 FileHandle;
20	use strict;
21	#use diagnostics;
22	use Carp;
23
24	sub TIEHASH {
25	my $type = shift;
26	my $pipe = shift;
27	my @files = grep -f $_, @_;
28
29	my $self = {
30	Pipe => $pipe \|\| 'nroff',
31	Files => \@files
32	};
33	bless $self, ref($type) \|\| $type;
34	}
35
36	#$ENV{PATH} .= ':/usr/local/groff-1.09/bin:/app/sun4_55/unido-inf/groff/1.10/bin';
37
38	use File::Basename;
39
40	sub catfile ($) {
41	my $fullname = shift;
42	my ($name,$path) = fileparse($fullname);
43	$path =~ s{man([^/]+)\/$}
44	{cat$1/};
45	"$path$name";
46	}
47
48	sub nroff {
49	my $self = shift;
50	my $path = shift;
51
52	return undef unless -f $path;
53
54	my $fh = new FileHandle "< $path";
55	return undef unless defined $fh;
56	my $first = <$fh>;
57	$fh->close;
58	return undef if $first =~ /^\.so man/;
59	return undef unless defined $first;
60	$first =~ /\'\\\"\s.*((e)\|(t))+/;
61	my @pre;
62	push @pre, 'eqn -Tascii' if $2;
63	push @pre, 'tbl' if $3;
64	push @pre, $self->{Pipe};
65	my $pipe = pop(@pre) . " $path \|";
66	if (@pre) {
67	$pipe .= join ('\|', @pre) . '\|';;
68	}
69	local($/) = undef;
70	$fh = new FileHandle "$pipe";
71	return unless defined $fh;
72	<$fh>;
73	}
74
75	sub FETCH {
76	my $self = shift;
77	my $path = shift;
78	my $catp = catfile $path;
79	return undef unless defined $path;
80
81	local($/) = undef;
82
83	if (-e $catp) {
84	my $fh = new FileHandle "< $catp";
85	return <$fh>;
86	}
87	my $cont = $self->nroff($path);
88	if ($cont) {
89	my $fh = new FileHandle "> $catp";
90	if ($fh) {
91	warn "Generating $catp\n";
92	$fh->print($cont);
93	}
94	}
95	$cont;
96	}
97
98	sub FIRSTKEY {
99	my $self = shift;
100	$self->{fno} = 0;
101	$self->NEXTKEY;
102	}
103
104	sub NEXTKEY {
105	my $self = shift;
106	return undef if ($self->{fno}++ > @{$self->{Files}});
107	$self->{Files}->[$self->{fno}-1];
108	}
109
110	sub close {
111	my $self = shift;
112
113	delete $self->{fno};
114	delete $self->{Files}; # no need at query time
115	}
116
117	1;