File Coverage

lib/HTML/SummaryBasic.pm

Criterion	Covered	Total	%
statement	68	82	82.9
branch	21	36	58.3
condition	4	9	44.4
subroutine	7	7	100.0
pod	0	1	0.0
total	100	135	74.0

use strict;
use warnings;

package HTML::SummaryBasic;

our $VERSION = 0.2;

=head1 NAME

HTML::SummaryBasic - Basic summary info from HTML.

=head1 SYNOPSIS

	use HTML::SummaryBasic;
	my $p = new HTML::SummaryBasic  {
		PATH => "input.html",
		# or HTML => '...',
		NOT_AVAILABLE => undef,
	};
	foreach (keys %{$p->{SUMMARY}}){
		warn "$_ ... $p->{SUMMARY}->{$_}\n";
	}

=head1 DEPENDENCIES

	use HTML::TokeParser;
	use HTML::HeadParser;

=cut

use Carp;
use HTML::TokeParser;

=head1 DESCRIPTION

From a file or string of HTML, creates a hash of useful summary information from C and C elements of an HTML document.

=head1 GLOBAL VARIABLE

=item $NOT_AVAILABLE

Value for empty fields. Default is C<[Not Available]>. May be over-ridden directly by supplying the constructor with a field of the same name.
See L.

=cut

our $NOT_AVAILABLE = '[Not available]';

=head1 CONSTRUCTOR (new)

Accepts a hash-like structure...

=over 4

=item HTML or PATH

Ref to a scalar of HTML, or plain string that is the path to an HTML file to process.

=item SUMMARY

Filled after C is called (see L and
L).

=item FIELDS

An array of C tag Cs whose C value should be
placed into the respective slots of the C field after
C has been called.

=back

=head2 THE SUMMARY STRUCTURE

A field of the object which is a hash, with key/values as follows:

=over 4

=item AUTHOR

HTML C tag C.

=item TITLE

Text of the element of the same name.

=item DESCRIPTION

Content of the C tag named C.

=item LAST_MODIFIED_META, LAST_MODIFIED_FILE

Time since of the modification of the file,
respectively according to any C tag of the same name,
with a C prefix; failing that, according to the file system.

=item CREATED_META, CREATED_FILE

As above, but relating to the creation date of the file.

=item FIRST_PARA

The first HTML C element of the document.

=item HEADLINE

The first C tag; failing that, the first C; failing that,
the value of C<$NOT_AVAILABLE>.

=item PLUS...

Any meta-fields specified in the C field.

=back

=cut

sub new {
	my $class = shift;
	$class = ref($class)? ref($class) : $class;
	my $self = bless {}, $class;
	my $args = ref($_[0])? shift : {@_};

	# Defaults
	$self->{SUMMARY}	= {};

	# Load parameters
	$self->{uc $_} = $args->{$_} foreach keys %$args;
	croak "Required parameter field missing : $_" if not $self->{PATH};

	$self->_get_summary();
	return $self;
}


sub _get_summary {
	my ($self,$path) = @_;

	my ($p,$token, $html);

	if (defined $path){
		if (ref $path){
			$html = $path;
			delete $self->{PATH};
		} else {
			$self->{PATH} = $path;
		}
	}

	if ($self->{PATH}){
		$html = $self->_load_file()
			or return undef;
	}

	# Get first para
	if (not $p = new HTML::TokeParser( $html ) ){
		warn "HTML::TokeParser could not initiate: $!";
		return undef;
	}
	if ($token = $p->get_tag('h1')){
		$self->{SUMMARY}->{HEADLINE} = $p->get_trimmed_text;
	} else {
		$p = new HTML::TokeParser( $html );
		if ($token = $p->get_tag('h2')){
			$self->{SUMMARY}->{HEADLINE} = $p->get_trimmed_text;
		} else {
			$self->{SUMMARY}->{HEADLINE} = $self->{NOT_AVAILABLE};
		}
	}
	if (not $p = new HTML::TokeParser( $html ) ){
		warn "HTML::TokeParser could not initiate: $!";
		return undef;
	}
	if ($token = $p->get_tag('p')){
		$self->{SUMMARY}->{FIRST_PARA} = $p->get_trimmed_text;
	} else {
		$self->{SUMMARY}->{FIRST_PARA} = $self->{NOT_AVAILABLE}
	}

	$p = new HTML::TokeParser( $html );
	$p->get_tag('title');
	$self->{SUMMARY}->{TITLE} = $p->get_text('/title') || $self->{NOT_AVAILABLE};

	{
		my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
		   $atime,$mtime,$ctime,$blksize,$blocks) = stat $self->{PATH};

		$self->{SUMMARY}->{LAST_MODIFIED_FILE} = scalar localtime ( $mtime ) || $self->{NOT_AVAILABLE};
		$self->{SUMMARY}->{LAST_MODIFIED_FILE} =~ s/\s+/ /g;

		$self->{SUMMARY}->{CREATED_FILE} = scalar localtime ( $ctime ) || $self->{NOT_AVAILABLE};
		$self->{SUMMARY}->{CREATED_FILE} =~ s/\s+/ /g;
	}

	my $collect = {
		map {$_=>1} (
			keys %{$self->{FIELDS}},
			qw(
				AUTHOR DESCRIPTION
				LAST-MODIFIED CREATED
			)
		)
	};

	$self->{SUMMARY}->{$_} = $self->{NOT_AVAILABLE} foreach keys %$collect;

	$p = new HTML::TokeParser( $html );
	while (my $tag = $p->get_tag('meta') ){
		my $name = uc $tag->[1]->{name};
		I:
		for my $i (1..2){
			$name =~ s/^X-META-//i if $i == 2;
			if (exists $collect->{$name} ){
				$self->{SUMMARY}->{$name} = $tag->[1]->{content};
				last I;
			}
		}
	}

	$self->{SUMMARY}->{LAST_MODIFIED_META} = delete $self->{SUMMARY}->{"LAST-MODIFIED"};
	$self->{SUMMARY}->{CREATED_META} = delete $self->{SUMMARY}->{"CREATED"};

	return 1;
}


#  Return a reference to a scalar of HTML, or C on failure, setting C<$!> with an error message.

sub _load_file {
	my ($self,$path) = @_;
	local *IN;
	return $path if ref $path;

	if (defined $path){
		$self->{PATH} = $path
	}
	elsif (not $self->{PATH}){
		warn "load_file requires a path argument, or that the PATH field be set";
		return undef;
	}
	if (not open IN, $self->{PATH}){
		warn "load_file could not open $self->{PATH}";
		return undef;
	}
	read IN, $_, -s IN;
	close IN;
	return \$_;
}

1;

=head1 TODO

Maybe work on URI as well as file paths.

=head1 SEE ALSO

L, L.

=head1 AUTHOR

Lee Goddard ([e-mail])

=head1 COPYRIGHT

Copyright 2000-2001 Lee Goddard.

This library is free software; you may use and redistribute it or modify it
undef the same terms as Perl itself.