File Coverage

blib/lib/HTML/Display.pm
Criterion Covered Total %
statement 49 53 92.4
branch 9 14 64.2
condition 9 14 64.2
subroutine 11 11 100.0
pod 2 2 100.0
total 80 94 85.1


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\n

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