HTML::Display::Common - routines common to all HTML::Display subclasses

HTML-Display documentation Contained in the HTML-Display distribution.

Index

Code Index:

NAME

Top

HTML::Display::Common - routines common to all HTML::Display subclasses

__PACKAGE__->new %ARGS

Creates a new object as a blessed hash. The passed arguments are stored within the hash. If you need to do other things in your constructor, remember to call this constructor as well :

  package HTML::Display::WhizBang;
  use parent 'HTML::Display::Common';

  sub new {
    my ($class) = shift;
    my %args = @_;
    my $self = $class->SUPER::new(%args);

    # do stuff

    $self;
  };

$display->display %ARGS

This is the routine used to display the HTML to the user. It takes the following parameters :

  html     => SCALAR containing the HTML
  file     => SCALAR containing the filename of the file to be displayed
  base     => optional base url for the HTML, so that relative links still work

  location    (synonymous to base)

Basic usage :

  my $html = "<html><body><h1>Hello world!</h1></body></html>";
  my $browser = HTML::Display->new();
  $browser->display( html => $html );

Location parameter :

If you fetch a page from a remote site but still want to display it to the user, the location parameter comes in very handy :

  my $html = '<html><body><img src="/images/hp0.gif"></body></html>';
  my $browser = HTML::Display->new();

  # This will display part of the Google logo
  $browser->display( html => $html, base => 'http://www.google.com' );

AUTHOR

Top

Copyright (c) 2004-2007 Max Maischein <corion@cpan.org>

LICENSE

Top

This module is released under the same terms as Perl itself.

HTML-Display documentation Contained in the HTML-Display distribution. 
package HTML::Display::Common;


use strict;
use HTML::TokeParser;
use URI::URL;
use vars qw($VERSION);
$VERSION='0.39';
use Carp qw( croak );


sub new {
  my ($class) = shift;
  #croak "Odd number" if @_ % 2;
  my $self = { @_ };
  bless $self,$class;
  $self;
};


sub display {
  my ($self) = shift;
  my %args;
  if (scalar @_ == 1) {
    %args = ( html => $_[0] );
  } else {
    %args = @_;
  };

  if ($args{file}) {
    my $filename = delete $args{file};
    local $/;
    local *FILE;
    open FILE, "<", $filename
      or croak "Couldn't read $filename";
    $args{html} = <FILE>;
  };

  $args{base} = delete $args{location}
    if (! exists $args{base} and exists $args{location});

  my $new_html;
  if (exists $args{base}) {
    # trim to directory create BASE HREF
    # We are carefull to not trim if we just have http://domain.com
    my $location = URI::URL->new( $args{base} );
    my $path = $location->path;
    $path =~ s%(?<!/)/[^/]*$%/%;
    $location = sprintf "%s://%s%s", $location->scheme, $location->authority , $path;

    require HTML::TokeParser::Simple;
    my $p = HTML::TokeParser::Simple->new(\$args{html}) || die 'could not create HTML::TokeParser::Simple object';
    my ($has_head,$has_base);
    while (my $token = $p->get_token) {
      if ( $token->is_start_tag('head') ) {
        $has_head++;
      } elsif ( $token->is_start_tag('base')) {
        $has_base++;
        last;
      };
    };

    # restart parsing
    $p = HTML::TokeParser::Simple->new(\$args{html}) || die 'could not create HTML::TokeParser::Simple object';
    while (my $token = $p->get_token) {
      if ( $token->is_start_tag('html') and not $has_head) {
        $new_html .= $token->as_is . qq{<head><base href="$location" /></head>};
      } elsif ( $token->is_start_tag('head') and not $has_base) {
        # handle an empty <head /> :
        if ($token->as_is =~ m!^<\s*head\s*/>$!i) {
          $new_html .= qq{<head><base href="$location" /></head>}
        } else {
          $new_html .= $token->as_is . qq{<base href="$location" />};
        };
      } elsif ( $token->is_start_tag('base') ) {
        # If they already have a <base href>, give up
        if ($token->return_attr->{href}) {
          $new_html = $args{html};
          last;
        } else {
          $token->set_attr('href',$location);
          $new_html .= $token->as_is;
        };
      } else {
        $new_html .= $token->as_is;
      }
    };
  } else {
    $new_html = $args{html};
  };

  $self->display_html($new_html);
};



1;