The Perl and Raku Conference 2025: Greenville, South Carolina - June 27-29 Learn more

ULPFR / WAIT-1.800 / script / pod 

            

              
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
—
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138

              
#!/usr/bin/perl -w
######################### -*- Mode: Cperl -*- #########################
##
## $Basename: pod $
## $Revision: 1.8 $
##
## Author           : Ulrich Pfeifer
## Created On       : Mon Dec 16 09:46:40 1996
##
## Last Modified By : Ulrich Pfeifer
## Last Modified On : Fri Apr  7 13:43:09 2000
## 
## Copyright (c) 1996-1997, Ulrich Pfeifer
## 
## 
######################################################################
use strict;
package Foo;
use WAIT::Parse::Pod;
use strict;
use vars qw(@ISA);
@ISA = qw (WAIT::Parse::Pod);
# ANSI color stuff snarfed from Term::ANSI_Color by Zenin (zenin@best.com)
sub GREEN       () { return "\e[32m"}
sub BLUE        () { return "\e[34m"}
sub RED         () { return "\e[31m"}
sub BOLD        () { return "\e[1m" }
sub REVERSE     () { return "\e[7m" }
sub UNDERLINE   () { return "\e[4m" }
sub BLACK       () { return "\e[30m"}
sub YELLOW      () { return "\e[33m"}
sub MAGENTA     () { return "\e[35m"}
sub CYAN        () { return "\e[36m"}
sub WHITE       () { return "\e[37m"}
sub onBLACK     () { return "\e[40m"}
sub onRED       () { return "\e[41m"}
sub onGREEN     () { return "\e[42m"}
sub onYELLLOW   () { return "\e[43m"}
sub onBLUE      () { return "\e[44m"}
sub onMAGENTA   () { return "\e[45m"}
sub onCYAN      () { return "\e[46m"}
sub onWHITE     () { return "\e[47m"}
sub BLINK       () { return "\e[5m" }
sub CLEAR       () { return "\e[0m" }
sub output {
  my $self = shift;
  my $out = $self->{OUTPUT};
   
  while (@_) {
    my $tags = shift;
    my $text = shift;
    if ($tags->{_b}) {
      $out->print(BOLD);
    } elsif ($tags->{_i}) {
      $out->print(UNDERLINE);
    } elsif ($tags->{_c}) {
      $out->print(BLUE);
    }
    $out->print($text, CLEAR);
  }
}
package main;
use IO::File;
use Config;
sub try {                 
  my $pod = shift;
  for ('', qw(.pod .pm)) {
    return "$pod$_" if -f "$pod$_";
  }
}
sub locate {
  my $pod = shift;
  my $result;
   
  return $result if $result = try($pod);
  $pod =~ s{::}{/}g;
  for ("$Config{privlibexp}/pod", @INC) {
    return $result if $result = try("$_/$pod");
  }
}
my ($pod) = @ARGV;
my $file = locate($pod);
die "Could not locate '$pod'" unless $file;
my $in = new IO::File "<$file";
die "Could not open '$file': $!" unless $in;
my $out = new IO::File "|less -r";
die "Could not run 'less': $!" unless $out;
undef $/;
my $text = <$in>;
my $parser = new Foo;
$parser->{OUTPUT} = $out;
$parser->tag($text)
__END__
## ###################################################################
## pod
## ###################################################################
=head1 NAME
pod - display POD documentation using colors
=head1 SYNOPSIS
B<pod> F<file>
=head1 DESCRIPTION
Pretty prints POD documentation on terminals. Finds pod in modules
as well as F<.pod>files.
=head1 EXAMPLES
  pod IO::File
  pod IO/File
yield the same result.
=head1 AUTHOR
Ulrich Pfeifer E<lt>F<pfeifer@ls6.informatik.uni-dortumund.de>E<gt>