File: | lib/HTML/Display.pm |
Coverage: | 100.0% |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
1 | package HTML::Display; | ||||||
2 | use strict; | ||||||
3 | use HTML::TokeParser; | ||||||
4 | use Carp qw( croak ); | ||||||
5 | use vars qw( $VERSION ); | ||||||
6 | $VERSION='0.37'; | ||||||
7 | |||||||
8 - 63 | =head1 NAME HTML::Display - display HTML locally in a browser =head1 SYNOPSIS =for example my $html = "foo\n"; %HTML::Display::os_default = (); =for example begin use strict; use HTML::Display; # guess the best value from $ENV{PERL_HTML_DISPLAY_CLASS} # or $ENV{PERL_HTML_DISPLAY_COMMAND} # or the operating system, in that order my $browser = HTML::Display->new(); my $location = "http://www.google.com/"; $browser->display(html => $html, location => $location); # Or, for a one-off job : display("<html><body><h1>Hello world!</h1></body></html>"); =for example end =for example_testing is($::_STDOUT_,"foo\n<html><body><h1>Hello world!</h1></body></html>"); =head1 DESCRIPTION This module abstracts the task of displaying HTML to the user. The displaying is done by launching a browser and navigating it to either a temporary file with the HTML stored in it, or, if possible, by pushing the HTML directly into the browser window. The module tries to automagically select the "correct" browser, but if it dosen't find a good browser, you can modify the behaviour by setting some environment variables : PERL_HTML_DISPLAY_CLASS If HTML::Display already provides a class for the browser you want to use, setting C<PERL_HTML_DISPLAY_CLASS> to the name of the class will make HTML::Display use that class instead of what it detects. PERL_HTML_DISPLAY_COMMAND If there is no specialized class yet, but your browser can be controlled via the command line, then setting C<PERL_HTML_DISPLAY_COMMAND> to the string to navigate to the URL will make HTML::Display use a C<system()> call to the string. A C<%s> in the value will be replaced with the name of the temporary file containing the HTML to display. =cut | ||||||
64 | |||||||
65 | use vars qw( @ISA @EXPORT %os_default ); | ||||||
66 | require Exporter; | ||||||
67 | @ISA='Exporter'; | ||||||
68 | |||||||
69 | @EXPORT = qw( display ); | ||||||
70 | |||||||
71 - 86 | =head2 %HTML::Display::os_default The hash C<%HTML::Display::os_default> contains pairs of class names for the different operating systems and routines that test whether this script is currently running under it. If you you want to dynamically add a new class or replace a class (or the rule), modify C<%os_default> : =for example begin # Install class for MagicOS $HTML::Display::os_default{"HTML::Display::MagicOS"} = sub { $^O =~ qr/magic/i }; =for example end =cut | ||||||
87 | |||||||
88 | %os_default = ( | ||||||
89 | "HTML::Display::Win32::IE" => sub { | ||||||
90 | my $have_ole; | ||||||
91 | eval { | ||||||
92 | require Win32::OLE; | ||||||
93 | Win32::OLE->import(); | ||||||
94 | $have_ole = 1; | ||||||
95 | }; | ||||||
96 | $have_ole and $^O =~ qr/mswin32/i | ||||||
97 | }, | ||||||
98 | 5 | 10 | "HTML::Display::Debian" => sub { -x "/usr/bin/x-www-browser" }, | ||||
99 | "HTML::Display::OSX" => sub { $^O =~ qr/darwin/i }, | ||||||
100 | ); | ||||||
101 | |||||||
102 - 104 | =head2 __PACKAGE__->new %ARGS =cut | ||||||
105 | |||||||
106 | sub new { | ||||||
107 | my $class = shift; | ||||||
108 | my (%args) = @_; | ||||||
109 | |||||||
110 | # First see whether the programmer or user specified a class | ||||||
111 | my $best_class = delete $args{class} || $ENV{PERL_HTML_DISPLAY_CLASS}; | ||||||
112 | |||||||
113 | # Now, did they specify a command? | ||||||
114 | unless ($best_class) { | ||||||
115 | my $command = delete $args{browsercmd} || $ENV{PERL_HTML_DISPLAY_COMMAND}; | ||||||
116 | if ($command) { | ||||||
117 | $best_class = "HTML::Display::TempFile"; | ||||||
118 | $args{browsercmd} = $command; | ||||||
119 | @_ = %args; | ||||||
120 | }; | ||||||
121 | }; | ||||||
122 | |||||||
123 | unless ($best_class) { | ||||||
124 | for my $class (sort keys %os_default) { | ||||||
125 | $best_class = $class | ||||||
126 | if $os_default{$class}->(); | ||||||
127 | }; | ||||||
128 | }; | ||||||
129 | $best_class ||= "HTML::Display::Dump"; | ||||||
130 | |||||||
131 | { no strict 'refs'; | ||||||
132 | undef $@; | ||||||
133 | eval "use $best_class;" | ||||||
134 | unless ( @{"${best_class}::ISA"} | ||||||
135 | or defined *{"${best_class}::new"}{CODE} | ||||||
136 | or defined *{"${best_class}::AUTOLOAD"}{CODE}); | ||||||
137 | croak "While trying to load $best_class: $@" if $@; | ||||||
138 | }; | ||||||
139 | return $best_class->new(@_); | ||||||
140 | }; | ||||||
141 | |||||||
142 - 159 | =head2 $browser-E<gt>display( %ARGS ) Will display the HTML. The following arguments are valid : base => Base to which all relative links will be resolved html => Scalar containing the HTML to be displayed file => Scalar containing the name of the file to be displayed This file will possibly be copied into a temporary file! location (synonymous to base) If only one argument is passed, then it is taken as if html => $_[0] was passed. =cut | ||||||
160 | |||||||
161 | sub display { | ||||||
162 | my %args; | ||||||
163 | if (scalar @_ == 1) { | ||||||
164 | %args = ( html => @_ ) | ||||||
165 | } else { | ||||||
166 | %args = @_ | ||||||
167 | }; | ||||||
168 | HTML::Display->new()->display( %args ); | ||||||
169 | }; | ||||||
170 | |||||||
171 - 190 | =head1 EXPORTS The subroutine C<display> is exported by default =head1 COMMAND LINE USAGE Display some HTML to the user : perl -MHTML::Display -e "display '<html><body><h1>Hello world</body></html>'" Display a web page to the user : perl -MLWP::Simple -MHTML::Display -e "display get 'http://www.google.com'" Display the same page with the images also working : perl -MLWP::Simple -MHTML::Display -e "display html => get('http://www.google.com'), location => 'http://www.google.com'" =cut | ||||||
191 | |||||||
192 | 1; |