File Coverage

blib/lib/WebFetch/Input/PerlStruct.pm

Criterion	Covered	Total	%
statement	6	6	100.0
branch			n/a
condition			n/a
subroutine	2	2	100.0
pod			n/a
total	8	8	100.0

# WebFetch::Input::PerlStruct.pm
# push a Perl structure with pre-parsed news into WebFetch
#
# Copyright (c) 1998-2009 Ian Kluft. This program is free software; you can
# redistribute it and/or modify it under the terms of the GNU General Public
# License Version 3. See  http://www.webfetch.org/GPLv3.txt

package WebFetch::Input::PerlStruct;

use strict;
use base "WebFetch";

# define exceptions/errors
use Exception::Class (
	"WebFetch::Input::PerlStruct::Exception::NoStruct" => {
		isa => "WebFetch::Exception",
		alias => "throw_nostruct",
		description => "no 'content' structure was provided",
	},

	"WebFetch::Input::PerlStruct::Exception::BadStruct" => {
		isa => "WebFetch::Exception",
		alias => "throw_badstruct",
		description => "content of 'content' was not recognizable",
	},

);

our @Options = ( );
our $Usage = "";

# configuration parameters

# no user-servicable parts beyond this point

# register capabilities with WebFetch
__PACKAGE__->module_register( "input:perlstruct" );

sub fetch
{
	my ( $self ) = @_;

	# get the content from the provided perl structure
	if ( !defined $self->{content}) {
		throw_nostruct "content struct does not exist";
	}
	if ( ref($self->{content})->isa( "WebFetch::Data::Store" )) {
		$self->{data} = $self->{content};
		return;
	} elsif ( ref($self->{content}) eq "HASH" ) {
		if (( exists $self->{content}{fields})
			and ( exists $self->{content}{records})
			and ( exists $self->{content}{wk_names}))
		{
			$self->data->{fields} = $self->{content}{fields};
			$self->data->{wk_names} = $self->{content}{wk_names};
			$self->data->{records} = $self->{content}{records};
			return;
		}
	}
	throw_badstruct "content should be a WebFetch::Data::Store";
}

1;
__END__