Commit 8bfee41e authored by Birte Kristina Friesel's avatar Birte Kristina Friesel
Browse files

Add remaining error classes, sort of

parent fec4f0d8

bin/efa

+4 −4
Original line number Diff line number Diff line
@@ -114,11 +114,11 @@ else { 
	);

}



$efa->parse();

my $err = $efa->parse();





$efa->check_ambiguous();

$efa->check_no_connections();

if ($err and $err->isa('WWW::Efa::Error')) {

	die $err->as_string();

}



my @connections = $efa->connections();

lib/WWW/Efa.pm

+29 −15
Original line number Diff line number Diff line
@@ -40,8 +40,10 @@ use 5.010; 
use base 'Exporter';



use XML::LibXML;

use WWW::Efa::Error::Setup;

use WWW::Efa::Error::Ambiguous;

use WWW::Efa::Error::Backend;

use WWW::Efa::Error::NoData;

use WWW::Efa::Error::Setup;

use WWW::Mechanize;



our @EXPORT_OK = ();
@@ -213,7 +215,7 @@ sub parse_initial { 


	my $con_part = 0;

	my $con_no;

	my $cons;

	my $cons = [];



	my $xp_td = XML::LibXML::XPathExpression->new('//table//table/tr/td');

	my $xp_img = XML::LibXML::XPathExpression->new('./img');
@@ -253,15 +255,8 @@ sub parse_initial { 
		}

	}



	if (defined $con_no) {

	return $cons;

}

	else {

		return WWW::Efa::Error::Backend->new(

			'no data'

		);

	}

}



sub parse_pretty {

	my ($con_parts) = @_;
@@ -465,6 +460,7 @@ Parse the B<efa.vrr.de> reply 


sub parse {

	my ($self) = @_;

	my $err;



	my $tree = XML::LibXML->load_html(

		string => $self->{'html_reply'},
@@ -472,10 +468,28 @@ sub parse { 


	my $raw_cons = parse_initial($tree);



	if (@{$raw_cons} == 0) {

		$self->{'error'} = WWW::Efa::Error::NoData->new();

	}



	for my $raw_con (@{$raw_cons}) {

		push(@{$self->{'connections'}}, parse_pretty($raw_con));

	}

	$self->{'tree'} = $tree;



	if ($err = $self->check_ambiguous()) {

		$self->{'error'} = $err;

		return $err;

	}

	elsif ($err = $self->check_no_connections()) {

		$self->{'error'} = $err;

		return $err;

	}

	elsif ($self->{'error'}) {

		return $self->{'error'};

	}



	return $self->{'error'};

}



sub check_ambiguous {
@@ -487,15 +501,16 @@ sub check_ambiguous { 


	foreach my $select (@{$tree->findnodes($xp_select)}) {



		my @possible = ($select->getAttribute('name'));

		my $post_key = $select->getAttribute('name');

		my @possible;



		foreach my $val ($select->findnodes($xp_option)) {

			push(@possible, $val->textContent());

		}



		return WWW::Efa::Error::Backend->new(

			'ambiguous',

			\@possible

		return WWW::Efa::Error::Ambiguous->new(

			$post_key,

			@possible,

		);

	}

}
@@ -511,7 +526,6 @@ sub check_no_connections { 


	if ($err_node) {

		return WWW::Efa::Error::Backend->new(

			'error',

			$err_node->parentNode()->parentNode()->textContent()

		);

	}

lib/WWW/Efa/Error/Ambiguous.pm

0 → 100644
+69 −0
Original line number Diff line number Diff line 
package WWW::Efa::Error::Ambiguous;



=head1 NAME



WWW::Efa::Error::Ambiguous - WWW::Efa error, ambiguous to/from/via input



=head1 SYNOPSIS



    use WWW::Efa::Error::Ambiguous;



    my $error = WWW::Efa::Error::Ambiguous->new(

        'name_origin', 'Bredeney', 'Bredeney Friedhof'

    );



    die $error->as_string();

    # WWW::Efa error: ambiguous input for name_origin:

    #     Bredeney

    #     Bredeney Friedhof



=head1 DESCRIPTION



Class for all WWW::Efa-internal errors occuring during initialization. Usually

caused by missing or invalid setup arguments.



=cut



use strict;

use warnings;

use 5.010;



use base 'Exporter';



our @EXPORT_OK = qw{};

our @ISA = ('WWW::Efa::Error');



sub new {

	my ($obj, $key, @possible) = @_;

	my $ref = {};



	$ref->{'key'}      = $key;

	$ref->{'possible'} = \@possible;



	return bless($ref, $obj);

}



=head1 METHODS



=head2 $error->as_string()



Return the error as string, can directly be displayed to the user



=cut



sub as_string {

	my ($self) = @_;



	my $ret = sprintf(

		"WWW::Efa error: ambiguous input for %s:\n",

		$self->{'key'},

	);



	foreach my $value (@{$self->{'possible'}}) {

		$ret .= "\t$value\n";

	}



	return $ret;

}



1;

lib/WWW/Efa/Error/Backend.pm

+38 −26
Original line number Diff line number Diff line 
package WWW::Efa::Error::Backend;



=head1 NAME



WWW::Efa::Error::Backend - WWW::Efa unknown error from efa.vrr.de



=head1 SYNOPSIS



    use WWW::Efa::Error::Backend;



    my $error = WWW::Efa::Error::Backend->new(

        'Yadda Yadda'

    );



    die $error->as_string();

    # WWW::Efa error from efa.vrr.de:

    # Yadda Yadda



=head1 DESCRIPTION



Received an unknown error from efa.vrr.de



=cut



use strict;

use warnings;

use 5.010;
@@ -7,42 +29,32 @@ use 5.010; 
use base 'Exporter';



our @EXPORT_OK = qw{};

our @ISA = ('WWW::Efa::Error');



sub new {

	my ($obj, $type, $data) = @_;

	my ($obj, $msg) = @_;

	my $ref = {};



	$ref->{'type'}   = $type;

	$ref->{'data'}   = $data;

	$ref->{'message'} = $msg;



	return bless($ref, $obj);

}



=head1 METHODS



=head2 $error->as_string()



Return the error as string, can directly be displayed to the user



=cut



sub as_string {

	my ($self) = @_;

	my $ret;



	given ($self->{'type'}) {

		when ('no data') {

			$ret = "WWW::Efa: efa.vrr.de returned no data\n";

		}

		when ('ambiguous') {

			$ret = sprintf(

				"WWW::Efa: efa.vrr.de: Ambiguous input for %s:\n",

				shift(@{$self->{'data'}}),

	return sprintf(

		"WWW::Efa error from efa.vrr.de:\n%s\n",

		$self->{'message'},

	);

			foreach my $possible (@{$self->{'data'}}) {

				$ret .= "\t${possible}\n";

			}

		}

		when ('error') {

			$ret = sprintf(

				"WWW::Efa: efa.vrr.de error:\n%s\n",

				$self->{'data'},

			);

		}

	}

	return $ret;

}



1;

lib/WWW/Efa/Error/NoData.pm

0 → 100644
+50 −0
Original line number Diff line number Diff line 
package WWW::Efa::Error::NoData;



=head1 NAME



WWW::Efa::Error::NoData - WWW::Efa error, efa.vrr.de returned no data



=head1 SYNOPSIS



    use WWW::Efa::Error::Setup;



    my $error = WWW::Efa::Error::NoData->new();



    die $error->as_string();

    # WWW::Efa error: No data returned by efa.vrr.de



=head1 DESCRIPTION



efa.vrr.de returned no parsable data



=cut



use strict;

use warnings;

use 5.010;



use base 'Exporter';



our @EXPORT_OK = qw{};

our @ISA = ('WWW::Efa::Error');



sub new {

	my ($obj) = @_;

	my $ref = {};



	return bless($ref, $obj);

}



=head1 METHODS



=head2 $error->as_string()



Return the error as string, can directly be displayed to the user



=cut



sub as_string {

	return "WWW::Efa error: No data returned by efa.vrr.de\n";

}



1;