File Coverage

blib/lib/XML/EP.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

# -*- perl -*-

use strict;
use XML::EP::Config ();
use XML::EP::Control ();
use XML::EP::Error ();
use XML::EP::Response ();

package XML::EP;

$XML::EP::VERSION = '0.01';


sub new {
    my $proto = shift;
    my $self = (@_ == 1) ? \%{ shift() } : { @_ };
    bless($self, (ref($proto) || $proto));
}

sub MakeConfig {
    my $self = shift;
    my $request = $self->{request};
    my $config = ($self->{config} ||= $XML::EP::Config::config || []);
    my $cfg = {};
    foreach my $c (@$config) {
	if (my $vhost = $c->{"match_virtual_host"}) {
	    my $vh = $request->VirtualHost();
	    next if !$vh  ||  $vh !~ /$vhost/;
	}
	if (my $loc = $c->{"match_location"}) {
	    my $lc = $request->Location();
	    next if !$lc  ||  $lc !~ /$loc/;
	}
	if (my $client = $c->{"match_client"}) {
	    my $cl = $request->Client();
	    next if !$cl  ||  $cl !~ /$client/;
	}
	while (my($key, $var) = each %$c) {
	    $cfg->{$key} = $var;
	}
    }
    $self->{cfg} = $cfg;
}

sub Control {
    my $self = shift;
    my $class = $self->{cfg}->{Controller} || "XML::EP::Control";
    $class->new();
}

{
    my %loaded;
    sub Require {
	my $self = shift;  my $class = shift;
	return if $loaded{$class};
	my $cl = "$class.pm";
	$cl =~ s/\:\:/\//g;
	require $cl;
	$loaded{$class} = $cl;
    }
}

sub Handle {
    my $self = shift;  $self->{request} = shift;
    $self->{response} = XML::EP::Response->new();
    eval {
	$self->MakeConfig();
	my $control = $self->Control();
	my $xml = $control->CreatePipe($self);
	while (my $p = shift @{$self->{processors}}) {
	    if (!ref($p)) {
		$self->Require($p);
		$p = $p->new();
	    }
	    $xml = $p->Process($self, $xml);
	}
	my $formatter = $self->{formatter};
	$self->Require($formatter);
	$self->{formatter}->Format($self, $xml);
    };
    $@
}

sub Processors {
    my $self = shift;
    @_ ? ($self->{processors} = shift) : $self->{processors};
}

sub Formatter {
    my $self = shift;
    @_ ? ($self->{formatter} = shift) : $self->{formatter};
}

sub Request {
    my $self = shift;
    @_ ? ($self->{request} = shift) : $self->{request};
}

sub Response {
    my $self = shift;
    @_ ? ($self->{response} = shift) : $self->{response};
}


1;

__END__