| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package HTML::Display; |
|
2
|
6
|
|
|
5
|
|
3123
|
use strict; |
|
|
5
|
|
|
|
|
11
|
|
|
|
5
|
|
|
|
|
201
|
|
|
3
|
6
|
|
|
5
|
|
1959
|
use HTML::TokeParser; |
|
|
6
|
|
|
|
|
30332
|
|
|
|
6
|
|
|
|
|
174
|
|
|
4
|
6
|
|
|
5
|
|
43
|
use Carp qw( croak ); |
|
|
6
|
|
|
|
|
23
|
|
|
|
6
|
|
|
|
|
325
|
|
|
5
|
6
|
|
|
5
|
|
35
|
use vars qw( $VERSION ); |
|
|
6
|
|
|
|
|
51
|
|
|
|
6
|
|
|
|
|
386
|
|
|
6
|
|
|
|
|
|
|
$VERSION='0.40'; |
|
7
|
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
=head1 NAME |
|
9
|
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
HTML::Display - display HTML locally in a browser |
|
11
|
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
=head1 SYNOPSIS |
|
13
|
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
=for example |
|
15
|
|
|
|
|
|
|
my $html = "foo\n"; |
|
16
|
|
|
|
|
|
|
%HTML::Display::os_default = (); |
|
17
|
|
|
|
|
|
|
delete $ENV{PERL_HTML_DISPLAY_CLASS}; |
|
18
|
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
=for example begin |
|
20
|
|
|
|
|
|
|
|
|
21
|
1
|
|
|
1
|
|
34134
|
use strict; |
|
|
1
|
|
|
|
|
3
|
|
|
|
1
|
|
|
|
|
45
|
|
|
22
|
1
|
|
|
1
|
|
598
|
use HTML::Display; |
|
|
1
|
|
|
|
|
3
|
|
|
|
1
|
|
|
|
|
2543
|
|
|
23
|
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
# guess the best value from $ENV{PERL_HTML_DISPLAY_CLASS} |
|
25
|
|
|
|
|
|
|
# or $ENV{PERL_HTML_DISPLAY_COMMAND} |
|
26
|
|
|
|
|
|
|
# or the operating system, in that order |
|
27
|
|
|
|
|
|
|
my $browser = HTML::Display->new(); |
|
28
|
|
|
|
|
|
|
warn "# Displaying HTML using " . ref $browser; |
|
29
|
|
|
|
|
|
|
my $location = "http://www.google.com/"; |
|
30
|
|
|
|
|
|
|
$browser->display(html => $html, location => $location); |
|
31
|
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
# Or, for a one-off job : |
|
33
|
|
|
|
|
|
|
display("Hello world!"); |
|
34
|
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
=for example end |
|
36
|
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
=for example_testing |
|
38
|
|
|
|
|
|
|
is($::_STDOUT_,"foo\nHello world!"); |
|
39
|
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
=head1 DESCRIPTION |
|
41
|
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
This module abstracts the task of displaying HTML to the user. The |
|
43
|
|
|
|
|
|
|
displaying is done by launching a browser and navigating it to either |
|
44
|
|
|
|
|
|
|
a temporary file with the HTML stored in it, or, if possible, by |
|
45
|
|
|
|
|
|
|
pushing the HTML directly into the browser window. |
|
46
|
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
The module tries to automagically select the "correct" browser, but |
|
48
|
|
|
|
|
|
|
if it dosen't find a good browser, you can modify the behaviour by |
|
49
|
|
|
|
|
|
|
setting some environment variables : |
|
50
|
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
PERL_HTML_DISPLAY_CLASS |
|
52
|
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
If HTML::Display already provides a class for the browser you want to |
|
54
|
|
|
|
|
|
|
use, setting C to the name of the class will |
|
55
|
|
|
|
|
|
|
make HTML::Display use that class instead of what it detects. |
|
56
|
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
PERL_HTML_DISPLAY_COMMAND |
|
58
|
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
If there is no specialized class yet, but your browser can be controlled |
|
60
|
|
|
|
|
|
|
via the command line, then setting C to the |
|
61
|
|
|
|
|
|
|
string to navigate to the URL will make HTML::Display use a C |
|
62
|
|
|
|
|
|
|
call to the string. A C<%s> in the value will be replaced with the name |
|
63
|
|
|
|
|
|
|
of the temporary file containing the HTML to display. |
|
64
|
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
=cut |
|
66
|
|
|
|
|
|
|
|
|
67
|
6
|
|
|
5
|
|
711
|
use vars qw( @ISA @EXPORT %os_default ); |
|
|
6
|
|
|
|
|
28
|
|
|
|
6
|
|
|
|
|
2025
|
|
|
68
|
|
|
|
|
|
|
require Exporter; |
|
69
|
|
|
|
|
|
|
@ISA='Exporter'; |
|
70
|
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
@EXPORT = qw( display ); |
|
72
|
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
=head2 %HTML::Display::os_default |
|
74
|
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
The hash C<%HTML::Display::os_default> contains pairs of class names |
|
76
|
|
|
|
|
|
|
for the different operating systems and routines that test whether |
|
77
|
|
|
|
|
|
|
this script is currently running under it. If you you want to dynamically |
|
78
|
|
|
|
|
|
|
add a new class or replace a class (or the rule), modify C<%os_default> : |
|
79
|
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
=for example begin |
|
81
|
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
# Install class for MagicOS |
|
83
|
|
|
|
|
|
|
$HTML::Display::os_default{"HTML::Display::MagicOS"} |
|
84
|
|
|
|
|
|
|
= sub { $^O =~ qr/magic/i }; |
|
85
|
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
=for example end |
|
87
|
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
=cut |
|
89
|
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
%os_default = ( |
|
91
|
|
|
|
|
|
|
"HTML::Display::Win32::IE" => sub { |
|
92
|
|
|
|
|
|
|
my $have_ole; |
|
93
|
|
|
|
|
|
|
eval { |
|
94
|
|
|
|
|
|
|
require Win32::OLE; |
|
95
|
|
|
|
|
|
|
Win32::OLE->import(); |
|
96
|
|
|
|
|
|
|
$have_ole = 1; |
|
97
|
|
|
|
|
|
|
}; |
|
98
|
|
|
|
|
|
|
$have_ole and $^O =~ qr/mswin32/i |
|
99
|
|
|
|
|
|
|
}, |
|
100
|
|
|
|
|
|
|
"HTML::Display::Debian" => sub { -x "/usr/bin/x-www-browser" }, |
|
101
|
|
|
|
|
|
|
"HTML::Display::OSX" => sub { $^O =~ qr/darwin/i }, |
|
102
|
|
|
|
|
|
|
); |
|
103
|
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
=head2 __PACKAGE__->new %ARGS |
|
105
|
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
=cut |
|
107
|
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
sub new { |
|
109
|
9
|
|
|
8
|
1
|
2420
|
my $class = shift; |
|
110
|
8
|
|
|
|
|
24
|
my (%args) = @_; |
|
111
|
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
# First see whether the programmer or user specified a class |
|
113
|
8
|
|
66
|
|
|
178
|
my $best_class = delete $args{class} || $ENV{PERL_HTML_DISPLAY_CLASS}; |
|
114
|
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
# Now, did they specify a command? |
|
116
|
7
|
100
|
|
|
|
30
|
unless ($best_class) { |
|
117
|
3
|
|
33
|
|
|
21
|
my $command = delete $args{browsercmd} || $ENV{PERL_HTML_DISPLAY_COMMAND}; |
|
118
|
3
|
50
|
|
|
|
12
|
if ($command) { |
|
119
|
0
|
|
|
|
|
0
|
$best_class = "HTML::Display::TempFile"; |
|
120
|
0
|
|
|
|
|
0
|
$args{browsercmd} = $command; |
|
121
|
0
|
|
|
|
|
0
|
@_ = %args; |
|
122
|
|
|
|
|
|
|
}; |
|
123
|
|
|
|
|
|
|
}; |
|
124
|
|
|
|
|
|
|
|
|
125
|
7
|
100
|
|
|
|
30
|
unless ($best_class) { |
|
126
|
3
|
|
|
|
|
20
|
for my $class (sort keys %os_default) { |
|
127
|
3
|
50
|
|
|
|
6
|
$best_class = $class |
|
128
|
|
|
|
|
|
|
if $os_default{$class}->(); |
|
129
|
|
|
|
|
|
|
}; |
|
130
|
|
|
|
|
|
|
}; |
|
131
|
7
|
|
100
|
|
|
32
|
$best_class ||= "HTML::Display::Dump"; |
|
132
|
|
|
|
|
|
|
|
|
133
|
6
|
|
|
5
|
|
28
|
{ no strict 'refs'; |
|
|
6
|
|
|
|
|
12
|
|
|
|
6
|
|
|
|
|
1188
|
|
|
|
7
|
|
|
|
|
11
|
|
|
134
|
7
|
|
|
|
|
13
|
undef $@; |
|
135
|
7
|
|
|
|
|
67
|
eval "use $best_class;" |
|
136
|
3
|
|
|
|
|
29
|
unless ( @{"${best_class}::ISA"} |
|
137
|
3
|
|
|
|
|
238
|
or defined *{"${best_class}::new"}{CODE} |
|
138
|
5
|
50
|
66
|
4
|
|
2302
|
or defined *{"${best_class}::AUTOLOAD"}{CODE}); |
|
|
5
|
|
66
|
|
|
28
|
|
|
|
5
|
|
|
|
|
628
|
|
|
|
7
|
|
|
|
|
14
|
|
|
139
|
7
|
50
|
|
|
|
34
|
croak "While trying to load $best_class: $@" if $@; |
|
140
|
|
|
|
|
|
|
}; |
|
141
|
7
|
|
|
|
|
61
|
return $best_class->new(@_); |
|
142
|
|
|
|
|
|
|
}; |
|
143
|
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
=head2 $browser-Edisplay( %ARGS ) |
|
145
|
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
Will display the HTML. The following arguments are valid : |
|
147
|
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
base => Base to which all relative links will be resolved |
|
149
|
|
|
|
|
|
|
html => Scalar containing the HTML to be displayed |
|
150
|
|
|
|
|
|
|
file => Scalar containing the name of the file to be displayed |
|
151
|
|
|
|
|
|
|
This file will possibly be copied into a temporary file! |
|
152
|
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
location (synonymous to base) |
|
154
|
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
If only one argument is passed, then it is taken as if |
|
156
|
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
html => $_[0] |
|
158
|
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
was passed. |
|
160
|
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
=cut |
|
162
|
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
sub display { |
|
164
|
1
|
|
|
1
|
1
|
3
|
my %args; |
|
165
|
1
|
50
|
|
|
|
6
|
if (scalar @_ == 1) { |
|
166
|
1
|
|
|
|
|
7
|
%args = ( html => @_ ) |
|
167
|
|
|
|
|
|
|
} else { |
|
168
|
0
|
|
|
|
|
0
|
%args = @_ |
|
169
|
|
|
|
|
|
|
}; |
|
170
|
1
|
|
|
|
|
9
|
HTML::Display->new()->display( %args ); |
|
171
|
|
|
|
|
|
|
}; |
|
172
|
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
=head1 EXPORTS |
|
174
|
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
The subroutine C is exported by default |
|
176
|
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
=head1 COMMAND LINE USAGE |
|
178
|
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
Display some HTML to the user : |
|
180
|
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
perl -MHTML::Display -e "display 'Hello world'" |
|
182
|
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
Display a web page to the user : |
|
184
|
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
perl -MLWP::Simple -MHTML::Display -e "display get 'http://www.google.com'" |
|
186
|
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
Display the same page with the images also working : |
|
188
|
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
perl -MLWP::Simple -MHTML::Display -e "display html => get('http://www.google.com'), |
|
190
|
|
|
|
|
|
|
location => 'http://www.google.com'" |
|
191
|
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
=head1 AUTHOR |
|
193
|
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
Copyright (c) 2004-2007 Max Maischein C<< >> |
|
195
|
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
=head1 LICENSE |
|
197
|
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
This module is released under the same terms as Perl itself. |
|
199
|
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
=cut |
|
201
|
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
1; |