line
stmt
bran
cond
sub
pod
time
code
1
package Pod::Usage::CGI;
2
3
1
1
947
use strict;
1
2
1
41
4
1
1
5
use Exporter;
1
2
1
37
5
1
1
14
use vars qw($VERSION @ISA @EXPORT);
1
1
1
578
6
$VERSION = sprintf'%d.%03d', q$Revision: 1.10 $ =~ /: (\d+)\.(\d+)/;
7
@ISA=qw(Exporter);
8
@EXPORT=qw(pod2usage);
9
10
sub pod2usage
11
{
12
0
0
1
my %options = @_;
13
0
0
my $message = ''._html_escape($options{message})."
\n" || $options{raw_message};
14
0
my $css = delete $options{css};
15
0
0
0
$css = [$css] if($css && ref $css ne 'array');
16
0
0
my $file = ($0 eq '-e')? undef : $0;
17
18
0
require Pod::Xhtml;
19
0
my $parser = new Pod::Xhtml(%options, StringMode => 1);
20
0
0
if($css) {
21
0
$parser->addHeadText(qq[
22
}
23
0
0
$parser->addBodyOpenText($message) if($message);
24
0
my $usage = "";
25
0
0
if($file) {
26
0
$parser->parse_from_file($file);
27
0
$usage = $parser->asString;
28
}
29
30
0
0
if($ENV{MOD_PERL}) {
31
# Although Apache::Registry would do this for us
32
# we do this to support any variants that may not
33
0
require Apache;
34
0
my $r = Apache->request;
35
0
$r->content_type("text/html");
36
0
$r->send_http_header;
37
0
$r->print($usage);
38
0
Apache::exit();
39
} else {
40
0
require CGI;
41
0
print CGI::header();
42
0
print $usage;
43
0
exit;
44
}
45
46
}
47
48
sub _html_escape
49
{
50
0
0
my $str = shift;
51
0
0
return '' unless length $str;
52
0
$str =~ s/&/&/g;
53
0
$str =~ s/
54
0
$str =~ s/>/>/g;
55
0
$str =~ s/'/'/g;
56
0
$str =~ s/\"/"/g;
57
0
return $str;
58
}
59
60
1;
61
62
=head1 NAME
63
64
Pod::Usage::CGI - generate usage message for CGI scripts
65
66
=head1 SYNOPSIS
67
68
use CGI;
69
use Pod::Usage::CGI;
70
71
#Message is HTML-escaped
72
my $necessary = CGI::param(foo) || pod2usage(message => "you forgot >>foo<<");
73
74
#Raw message is not escaped
75
my $another = CGI::param(bar) || pod2usage(raw_message => "you forgot bar ");
76
77
=head1 DESCRIPTION
78
79
Provides pod2usage exit from CGI scripts. You may optionally supply a message.
80
By default the message text is escaped to prevent cross-site scripting injection attacks and placed in a div container of class "message" that you can optionally format with a CSS.
81
You can use the C directive if you want to write HTML out into the page and manage your own escaping.
82
83
The module works fine under Apache::Registry but will not work in any environments where $0 is not defined.
84
85
=head1 FUNCTIONS
86
87
=over 4
88
89
=item pod2usage(%options)
90
91
Displays usage and exits. Valid options are:
92
93
message - message (will be automatically escaped)
94
raw_message - message (not escaped)
95
css - one or more CSS URLs to be applied to the page (either a scalar or an arrayref)
96
97
=back
98
99
=head1 DEPENDENCIES
100
101
L and either L or L are loaded on demand if required
102
103
=head1 SEE ALSO
104
105
=over 4
106
107
=item L
108
109
Generates usage messages for command line scripts
110
111
=back
112
113
=head1 VERSION
114
115
$Revision: 1.10 $ on $Date: 2005/07/15 11:25:22 $ by $Author: simonf $
116
117
=head1 AUTHOR
118
119
John Alden Ecpan _at_ bbc _dot_ co _dot_ ukE
120
121
=head1 COPYRIGHT
122
123
(c) BBC 2005. This program is free software; you can redistribute it and/or modify it under the GNU GPL.
124
See the file COPYING in this distribution, or http://www.gnu.org/licenses/gpl.txt
125
126
=cut