File Coverage

blib/lib/M3/ServerView.pm

Criterion	Covered	Total	%
statement	53	106	50.0
branch	5	34	14.7
condition	1	9	11.1
subroutine	16	23	69.5
pod	6	6	100.0
total	81	178	45.5

package M3::ServerView;

use 5.006;
use strict;
use warnings;

use Carp qw(croak carp);
use HTTP::Request;
use LWP::UserAgent;
use Scalar::Util qw(refaddr blessed);
use Time::HiRes qw(time);
use URI;

# Load views
use M3::ServerView::View;
use M3::ServerView::RootView;
use M3::ServerView::ServerView;
use M3::ServerView::FindJobView;

# Module version
our $VERSION = "0.04";

# Inside-out objects
my %Base_uri;
my %Password;
my %User;

sub connect_to {
    my ($pkg, $base_uri, %args) = @_;

    my $self = bless \do { my $v; }, $pkg;

    # Transform to URI object if necessary
    if (blessed $base_uri) {
        croak "URL is not an URI-instance" unless $base_uri->isa("URI");
    }
    else {
        $base_uri = URI->new($base_uri);
    }

    # Path must end with / because we append to it
    $base_uri->path("/") if $base_uri->path eq "";
    croak "Invalid URL '$base_uri' - must end with /" unless $base_uri->path =~ m|/$|;

    # Store object attributes
    $Base_uri{refaddr $self} = $base_uri;
    $User{refaddr $self} = $args{user};
    $Password{refaddr $self} = $args{password};

    return $self;
}

sub root {
    my ($self) = @_;
    my $view = $self->_load_view("");
    return $view;
}

sub find_jobs {
    my ($self, $in_query) = @_;

    croak "Missing query" unless ref $in_query eq "HASH";

    my %out_query = (
        name    => undef,
        owner   => undef,
        type    => undef,
        bjno    => undef,
        find => "Find",
    );

    if (exists $in_query->{name}) {
        $out_query{name} = $in_query->{name};
    }
    if (exists $in_query->{user}) {
        $out_query{owner} = $in_query->{user};
    }
    if (exists $in_query->{type}) {
        $out_query{type} = $in_query->{type};
    }
    if (exists $in_query->{batch_job_number}) {
        $out_query{bjno} = $in_query->{batch_job_number};
    }
    if ($in_query->{queued}) {
        $out_query{queued} = "on";
    }

    return $self->_load_view("/findjob", \%out_query);
}

# Loads the contents of an URL and measures the time it takes
sub _get_page_contents {
    my ($self, $uri) = @_;

    my $ua = LWP::UserAgent->new;
    my $req = HTTP::Request->new(GET => $uri);

    my $user = $self->user;
    my $password = $self->password;

    if (defined $user && defined $password) {
        $req->authorization_basic($user, $password);
    }

    my $t = time;

    my $res = $ua->request($req);
    unless ($res->is_success) {
        croak "Failed to get '$uri' because server returned: ", $res->status_line;
    }

    return wantarray ? ($res->content, time - $t) : $res->content;
}

# Clean up inside-out attriutes
sub DESTROY {
    my ($self) = @_;
    my $id = refaddr $self;
    delete $Base_uri{$id};
    delete $User{$id};
    delete $Password{$id};
}

sub base_uri {
    my ($self) = @_;
    return $Base_uri{refaddr $self};
}

sub user {
    my ($self) = @_;
    return undef unless ref $self;
    return $User{refaddr $self};
}

sub password {
    my ($self) = @_;
    return undef unless ref $self;
    return $Password{refaddr $self};
}


{
    # This table keeps the mapping between path and view class
    my %View_class = (
        "/"         => "M3::ServerView::RootView",
        "/server"   => "M3::ServerView::ServerView",
        "/findjob"  => "M3::ServerView::FindJobView",
    );

    sub _view_class_for_target {
        my $target = shift || "/";
        return $View_class{$target} || "";
    }
}

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

    my $target = $path || "/";
    my $view_class = _view_class_for_target($target);
    croak "Can't determinte view class for '${path}'" unless $view_class;

    my $uri = $self->base_uri->clone;
    $uri->path($path);

    if (ref $query) {
        $uri->query_form($query);
    }
    else {
        $uri->query($query);
    }

    my $view = $view_class->new($self, $uri);
    return $view;
}

1;
__END__