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; |