ActiveResource

 view release on metacpan or  search on metacpan

lib/ActiveResource.pm  view on Meta::CPAN

This document describes ActiveResource version 0.01

=head1 SYNOPSIS

    # A class for redmine issue
    package Issue;
    use  parent 'ActiveResource::Base';
    __PACKAGE__->site("http://localhost:3000");
    __PACKAGE__->user("admin");
    __PACKAGE__->password("admin");

    package main;

    # Find existing ticket
    my $issue = Issue->find(42);

    # Create
    my $issue = Issue->create(
        project_id => 1,
        subject => "OHAI",

lib/ActiveResource/Base.pm  view on Meta::CPAN

package ActiveResource::Base;
use common::sense;
use parent qw(Class::Accessor::Lvalue::Fast Class::Data::Inheritable);
use Hash::AsObject;
use Lingua::EN::Inflect qw(PL);
use URI;
use ActiveResource::Connection;
use ActiveResource::Formats::XmlFormat;

__PACKAGE__->mk_classdata($_) for qw(site user password);
__PACKAGE__->mk_accessors(qw(attributes));

__PACKAGE__->mk_classdata(
    format => 'ActiveResource::Formats::XmlFormat'
);

__PACKAGE__->mk_classdata(
    connection => ActiveResource::Connection->new
);

sub find {
    my ($class, $id) = @_;

    $class->connection->$_ = $class->$_ for qw(site user password);

    my $path = $class->element_path($id);
    my $response = $class->connection->get($path);
    unless ($response->is_success) {
        die "${class}->find FAIL. With HTTP Status: @{[ $response->status_line ]}\n";
    }

    my $record = $class->new;
    $record->load_attributes_from_response( $response );
    return $record;
}

sub create {
    my ($class, %args) = @_;
    my $resource_name = lc($class);
    $class->connection->$_ = $class->$_ for qw(site user password);

    my $body = $class->format->encode({ $resource_name => \%args });

    my $response = $class->connection->post($class->collection_path, $body);
    unless ($response->is_success) {
        die "${class}->create FAIL. With HTTP Status: @{[ $response->status_line ]}\n";
    }

    my $record = $class->new;
    $record->load_attributes_from_response($response);
    return $record;
}

sub save {
    my ($self) = @_;
    my $class = ref($self);

    my $resource_name = lc($class);
    $class->connection->$_ = $class->$_ for qw(site user password);

    my $body = $class->format->encode({ $resource_name => $self->attributes });

    my $response;
    if ($self->id) {
        $response = $class->connection->put($class->element_path($self->id), $body);
    }
    else {
        $response = $class->connection->post($class->collection_path, $body);
    }

lib/ActiveResource/Connection.pm  view on Meta::CPAN

package ActiveResource::Connection;
use common::sense;
use parent qw(Class::Accessor::Lvalue::Fast);
use LWP::UserAgent;
use HTTP::Request;

__PACKAGE__->mk_accessors(qw(site user password));

sub ua {
    LWP::UserAgent->new
}

sub url {
    my $self = shift;
    my $path = shift;

    my $user = $self->user;
    my $pass = $self->password;
    my $url = URI->new($self->site);

    if ($user && $pass) {
        $url->userinfo("${user}:${pass}");
    }
    $url->path($path);

    return $url;
}

t/base.t  view on Meta::CPAN

#!/usr/bin/env perl
use strict;

package Stuff;
use parent 'ActiveResource::Base';

package main;
use Test::More;

subtest "Stuff should respond to certain class methods" => sub {
    for my $method (qw(new site user password find create connection)) {
        ok(Stuff->can($method), "There is a Stuff->$method");
    }

    done_testing;
};

subtest "Stuff->site is default to be the same as ActiveResource::Base->site" => sub {
    ActiveResource::Base->site("http://example.com");
    is(ActiveResource::Base->site, "http://example.com");
    is(Stuff->site, "http://example.com");

t/simple.t  view on Meta::CPAN

#!/usr/bin/env perl
use common::sense;

package Issue;
use parent 'ActiveResource::Base';

package main;
use Test::More;

for my $method (qw(site user password)) {
    ok(Issue->can($method));
}

done_testing;

xt/redmine-localhost-issue-create.t  view on Meta::CPAN

#!/usr/bin/env perl
use common::sense;

package Issue;
use parent 'ActiveResource::Base';

__PACKAGE__->site("http://localhost:3000");
__PACKAGE__->user("admin");
__PACKAGE__->password("admin");

package main;
use Test::More;

my $issue = Issue->create(
    project_id => 1,
    subject => "Created from $$, " . __FILE__,
    description => "Lipsum"
);

xt/redmine-localhost-issue-save.t  view on Meta::CPAN

#!/usr/bin/env perl
use common::sense;

package Issue;
use parent 'ActiveResource::Base';

__PACKAGE__->site("http://localhost:3000");
__PACKAGE__->user("admin");
__PACKAGE__->password("admin");

package main;
use Test::More;

subtest "Save a new record" => sub {
    my $issue = Issue->new;
    $issue->project_id(1);
    $issue->subject("OHAI from " . __FILE__);
    my $d = "Updated by $$, " . __FILE__ . ", " . localtime;
    $issue->description($d);

xt/redmine-localhost.t  view on Meta::CPAN

package Issue;
use parent 'ActiveResource::Base';

package main;
use common::sense;
use Test::More;

ActiveResource::Base->site("http://localhost:3000");
ActiveResource::Base->user("admin");
ActiveResource::Base->password("admin");

subtest "Some simple matter of finding" => sub {
    my $project = Project->find(1);
    is $project->name, "test";

    my $issue = Issue->find(1);
    is $issue->id, 1;
    is $issue->project->id, 1;
    is $issue->project->name, "test";
    is $issue->status->name, "Resolved";