File Coverage

blib/lib/XAS/Service/Resource.pm

Criterion	Covered	Total	%
statement	24	193	12.4
branch	0	34	0.0
condition	0	7	0.0
subroutine	8	40	20.0
pod	29	31	93.5
total	61	305	20.0

package XAS::Service::Resource;

use strict;
use warnings;

use XAS::Factory;
use Data::Dumper;
use Hash::MultiValue;
use parent 'Web::Machine::Resource';
use Web::Machine::Util 'create_header';

# -------------------------------------------------------------------------
# Web::Machine::Resource overrides
# ------------------------------------------------------------------------

sub init {
    my $self = shift;
    my $args = shift;

    $self->{'tt'} = exists $args->{'template'}
      ? $args->{'template'}
      : undef;

    $self->{'json'} = exists $args->{'json'}
      ? $args->{'json'}
      : undef;

    $self->{'app_name'} = exists $args->{'app_name'}
      ? $args->{'app_name'}
      : 'Test App';

    $self->{'app_description'} = exists $args->{'app_description'}
      ? $args->{'app_description'}
      : 'Testing Testing 1 2 3';

    $self->{'alias'} = exists $args->{'alias'}
      ? $args->{'alias'}
      : 'resource';

    $self->errcode(0);
    $self->errstr('');

    $self->{'env'} = XAS::Factory->module('environment');
    $self->{'log'} = XAS::Factory->module('logger');

}

sub is_authorized {
    my $self = shift;
    my $auth = shift;

    my $stat = 0;

    if ($auth) {

        warn "is_authorized - override this please\n";
        warn sprintf("username: %s, password: %s\n", $auth->username, $auth->password);

        $stat = 1;

        return $stat;

    }

    return create_header('WWWAuthenticate' => [ 'Basic' => ( realm => 'XAS Rest' ) ] );

}

sub options {
    my $self = shift;

    my $options;
    my @accepted;
    my @provided;
    my $allowed = $self->allowed_methods;

    foreach my $hash (@{$self->content_types_accepted}) {

        my ($key) = keys %$hash;
        push(@accepted, $key);

    }

    foreach my $hash (@{$self->content_types_provided}) {

        my ($key) = keys %$hash;
        push(@provided, $key);

    }

    $options->{'allow'}    = join(',', @$allowed);
    $options->{'accepted'} = join(',', @accepted);
    $options->{'provides'} = join(',', @provided);

    return $options;

}

sub allowed_methods { [qw[ OPTIONS GET HEAD ]] }

sub post_is_create {

    # uses "content_types_accepted" methods for procssing

    return 1;

}

sub content_types_accepted {

    return [
        { 'application/json'                  => 'from_json' },
        { 'application/x-www-form-urlencoded' => 'from_html' },
    ];

}

sub content_types_provided {

    return [
        { 'text/html'            => 'to_html' },
        { 'application/hal+json' => 'to_json' },
    ];

}

sub charset_provided { return ['UTF-8']; }

sub finish_request {
    my $self     = shift;
    my $metadata = shift;

    my $alias  = $self->alias;
    my $user   = $self->request->user || 'unknown';
    my $uri    = $self->request->uri;
    my $method = $self->request->method;
    my $code   = $self->response->code;
    my $path   = $uri->path;

    my $fixup = sub {
        my $status = shift;
        my $format = shift;
        my $data   = shift;

        my $output;

        if ($format eq 'json') {

            $output = $self->format_json($data);
            $self->response->content_type('application/hal+json');

        } else {

            $output = $self->format_html($data);
            $self->response->content_type('text/html');

        }

        $self->response->body($output);
        $self->response->header('Location' => $uri->path);
        $self->response->status($status);

        {
            use bytes;
            $self->response->header('Content-Length' => length($output));
        }

    };

    $self->log->info(
        sprintf('%s: %s requested a %s for %s with a status of %s',
            $alias, $user, $method, $path, $code)
    );

    if (defined($metadata->{'exception'})) {

        my $data;
        my $ex     = $metadata->{'exception'};
        my $ref    = ref($metadata->{'exception'});
        my $status = $self->errcode || 403;
        my $type   = $self->request->header('accept');
        my $format = ($type =~ /json/) ? 'json' : 'html';

        $data->{'_links'}     = $self->get_links();
        $data->{'navigation'} = $self->get_navigation();

        if (($ref eq 'XAS::Exception') or ($ref eq 'Badger::Exception')) {

            $data->{'_embedded'}->{'errors'} = [{
                title  => $self->errstr,
                status => $status,
                code   => $ex->type,
                detail => $ex->info
            }];

        } else {

            $data->{'_embedded'}->{'errors'} = [{
                title  => $self->errstr,
                status => $status,
                code   => 'unknown error',
                detail => sprintf('%s', $ex)
            }];

        }

        $fixup->($status, $format, $data);

    } elsif ($self->response->status >= 400) {

        my $data;
        my $body   = join('', @{$self->response->body});
        my $code   = ($self->response->status >= 500) ? 'http internal server error' : 'http client error';
        my $status = $self->response->status;
        my $type   = $self->request->header('accept');
        my $format = ($type =~ /json/) ? 'json' : 'html';

        $data->{'_links'}     = $self->get_links();
        $data->{'navigation'} = $self->get_navigation();

        $data->{'_embedded'}->{'errors'} = [{
            title  => sprintf('HTTP Error: %s', $self->response->status),
            status => $self->response->status,
            code   => $code,
            detail => $body,
        }];

        $fixup->($status, $format, $data);

    }

}

# -------------------------------------------------------------------------
# methods
# -------------------------------------------------------------------------

sub process_exception {
    my $self   = shift;
    my $title  = shift;
    my $status = shift;

    $self->{'errcode'} = $$status;
    $self->{'errstr'}  = $title;

}

sub process_params {
    my $self   = shift;
    my $params = shift;

    return 1;

}

sub get_navigation {
    my $self = shift;

    return [{
        link => '/',
        text => 'Root',
    }];

}

sub get_links {
    my $self = shift;

    return {
        self => {
            title => 'Root',
            href  => '/',
        },
    };

}

sub get_response {
    my $self = shift;

    my $data;

    $data->{'_links'}     = $self->get_links();
    $data->{'navigation'} = $self->get_navigation();

    return $data;

}

sub json_to_multivalue {
    my $self = shift;
    my $json = shift;

    my $decoded = $self->json->decode($json);
    my $params  = Hash::MultiValue->new();

    while (my ($key, $value) = each(%$decoded)) {

        $params->add($key, $value);

    }

    return $params;

}

sub from_json {
    my $self = shift;

    # get the post parameters

    my $content = $self->request->content;
    my $params  = $self->json_to_multivalue($content);

    return $self->process_params($params);

}

sub from_html {
    my $self = shift;

    # get the post parameters

    my $params = $self->request->parameters;

    return $self->process_params($params);

}

sub to_json {
    my $self = shift;

    my $data = $self->get_response();
    my $json = $self->format_json($data);

    return $json;

}

sub to_html {
    my $self = shift;

    my $data = $self->get_response();
    my $html = $self->format_html($data);

    return $html;

}

sub format_json {
    my $self = shift;
    my $data = shift;

    delete $data->{'navigation'};

    return $self->json->encode($data);

}

sub format_html {
    my $self = shift;
    my $data = shift;

    my $html;
    my $view = {
        view => {
            title       => $self->app_name,
            description => $self->app_description,
            template    => 'dispatcher.tt',
            data        => $data,
        }
    };

    $self->tt->process('wrapper.tt', $view, \$html);

    return $html;

}

sub format_body {
    my $self = shift;
    my $data = shift;

    my $body;
    my $type   = $self->request->header('accept');
    my $format = ($type =~ /json/) ? 'json' : 'html';;

    if ($format eq 'json') {

        $body = $self->format_json($data);

    } else {

        $body = $self->format_html($data);

    }

    return $body;

}

# -------------------------------------------------------------------------
# accessors
# -------------------------------------------------------------------------

sub app_name {
    my $self = shift;

    return $self->{'app_name'};

}

sub app_description {
    my $self = shift;

    return $self->{'app_description'};

}

sub json {
    my $self = shift;

    return $self->{'json'};

}

sub tt {
    my $self = shift;

    return $self->{'tt'};

}

sub env {
    my $self = shift;

    return $self->{'env'};

}

sub log {
    my $self = shift;

    return $self->{'log'};

}

sub alias {
    my $self = shift;

    return $self->{'alias'};

}

# -------------------------------------------------------------------------
# mutators
# -------------------------------------------------------------------------

sub errcode {
    my $self = shift;
    my $code = shift;

    $self->{'errcode'} = $code if (defined($code));

    return $self->{'errcode'};

}

sub errstr {
    my $self   = shift;
    my $string = shift;

    $self->{'errstr'} = $string if (defined($string));

    return $self->{'errstr'};

}

1;

__END__