view release on metacpan or  search on metacpan

lib/AnyEvent/WebService/Tracks.pm  view on Meta::CPAN

package AnyEvent::WebService::Tracks;

use strict;
use warnings;

use AnyEvent::HTTP qw(http_request);
use Carp qw(croak);
use DateTime;
use DateTime::Format::ISO8601;
use MIME::Base64 qw(encode_base64);
use URI;
use XML::Parser;
use XML::Writer;

use AnyEvent::WebService::Tracks::Context;
use AnyEvent::WebService::Tracks::Project;
use AnyEvent::WebService::Tracks::Todo;

our $VERSION = '0.02';

sub new {
    my ( $class, %params ) = @_;

    return bless {
        url      => URI->new($params{url}),
        username => $params{username},
        password => $params{password},
    }, $class;
}

sub parse_datetime {
    my ( $self, $str ) = @_;

    return DateTime::Format::ISO8601->parse_datetime($str);
}

sub format_datetime {
    my ( $self, $datetime ) = @_;

    my @fields = qw/year month day hour minute second/;
    my %attrs = map { $_ => $datetime->$_() } @fields;
    my $offset = DateTime::TimeZone->offset_as_string($datetime->offset);

    return sprintf '%04d-%02d-%02dT%02d:%02d:%02d%s', @attrs{@fields}, $offset;
}

sub handle_error {
    my ( $self, $body, $headers, $cb ) = @_;

    my $message;

    if($body) {
        # context creation serves errors in XML, but project creation in plain text,
        # even though the Content-Type is application/xml...
        if($body =~ /^\s*<\?xml/) {
            my $error = $self->parse_single(undef, $body);
            $message  = $error->{'error'};
        } else {
            $message = $body;
        }
    } else {
        $message = $headers->{'status'};
    }

    $cb->(undef, $message);
}

sub generate_xml {
    my ( $self, $root, $attrs ) = @_;

    my $xml  = '';
    my $w    = XML::Writer->new(OUTPUT => \$xml);
    my @keys = sort keys %$attrs;

    $w->startTag($root);
    foreach my $k (@keys) {
        my $v = $attrs->{$k};
        my @xml_attrs;

        push @xml_attrs, (nil => 'true') unless defined $v;
        if(ref($v) eq 'DateTime') {
            push @xml_attrs, (type => 'datetime');
            $v = $self->format_datetime($v);
        }

        my $nk = $k;
        $nk =~ tr/_/-/;

        $w->startTag($nk, @xml_attrs);
        $w->characters($v) if defined $v;
        $w->endTag($nk);
    }
    $w->endTag($root);
    $w->end;

    return $xml;
}

sub status_successful {
    my ( $self, $status ) = @_;

    return ($status >= 200 && $status < 300);
}

sub do_request {
    my ( $self, $http_method, $uri, $params, $method, $cb ) = @_;

    my ( $username, $password ) = @{$self}{qw/username password/};

    my $auth_token = encode_base64(join(':', $username, $password), '');
    $params->{'headers'} = {
        Authorization => "Basic $auth_token",
        Accept        => 'application/xml',
        Referer       => undef,
    };
    if($params->{'body'}) {
        $params->{'headers'}{'Content-Type'} = 'text/xml';
    }

    my $handle_result = sub {
        my ( $data, $headers ) = @_;

        if($self->status_successful($headers->{'Status'})) {
            $cb->($self->$method($data, $headers));
        } else {
            $self->handle_error($data, $headers, $cb);
        }
    };

    unless(ref($uri) eq 'URI') {
        if(ref($uri) eq 'ARRAY') {
            my $copy = $self->{url}->clone;
            $copy->path_segments($copy->path_segments, @$uri);
            $uri = $copy;
        }
    }

    http_request $http_method, $uri, %$params, $handle_result;
}

sub do_get {
    my ( $self, $uri, $method, $cb ) = @_;

    $self->do_request(GET => $uri, {}, $method, $cb);
}

sub do_delete {
    my ( $self, $uri, $method, $cb ) = @_;

    $self->do_request(DELETE => $uri, {}, $method, $cb);
}

sub do_post {
    my ( $self, $uri, $body, $method, $cb ) = @_;

    $self->do_request(POST => $uri, { body => $body }, $method, $cb);
}

sub do_put {
    my ( $self, $uri, $body, $method, $cb ) = @_;

    $self->do_request(PUT => $uri, { body => $body }, $method, $cb);
}

sub parse_entities {
    my ( $self, $xml, $type, $target_depth ) = @_;

    my @entities;
    my $current_entity;
    my $current_tag;

lib/AnyEvent/WebService/Tracks.pm  view on Meta::CPAN

    if(@_ == 2) {
        if(ref($_[1]) eq 'AnyEvent::WebService::Tracks::Project') {
            ( @params{qw/description project/} ) = @_;
        } else {
            ( @params{qw/description context/} ) = @_;
        }
    } else {
        %params = @_;
    }
    if(my $context = delete $params{'context'}) {
        unless(ref($context) eq 'AnyEvent::WebService::Tracks::Context') {
            croak "Parameter 'context' is not an AnyEvent::WebService::Tracks::Context";
        }
        $params{'context_id'} = $context->id;
    }
    if(my $project = delete $params{'project'}) {
        unless(ref($project) eq 'AnyEvent::WebService::Tracks::Project') {
            croak "Parameter 'project' is not an AnyEvent::WebService::Tracks::Project";
        }
        $params{'project_id'} = $project->id;
        # naughty...violation of privacy
        if(! exists($params{'context_id'}) && defined($project->{'default_context_id'})) {
            $params{'context_id'} = $project->{'default_context_id'};
        }
    }
    unless(exists $params{'context_id'} || exists $params{'project_id'}) {
        croak "Required parameters 'context' and 'project' not found; you must specify at least one of them";
    }

    if(my $project = delete $params{'project'}) {
        unless(ref($project) eq 'AnyEvent::WebService::Tracks::Project') {
            croak "Parameter 'project' is not an AnyEvent::WebService::Tracks::Project";
        }
        $params{'project_id'} = $project->id;
    }

    $self->create('todos', 'AnyEvent::WebService::Tracks::Todo',
        todo => \%params, $cb);
}

1;

__END__

=head1 NAME

AnyEvent::WebService::Tracks - Access Tracks' API from AnyEvent

=head1 VERSION

0.02

=head1 SYNOPSIS

  use AnyEvent::WebService::Tracks;

  my $tracks = AnyEvent::WebService::Tracks->new(
    url      => 'http://my.tracks.instance/',
    username => 'user',
    password => 'pa55w0rd',
  );

  $tracks->projects(sub {
    my ( $projects ) = @_;

    say foreach @$projects;
  });

  AnyEvent->condvar->recv;

=head1 DESCRIPTION

AnyEvent::WebService::Tracks talks to Tracks' API from an AnyEvent loop, using
AnyEvent::HTTP.

Before you go ahead and use this module, please make sure you run the test suite
against the Tracks version you'll be using; I developed this module against Tracks
1.7.2, so I can't really guarantee it'll work with any other version.  If you find
a bug when running against another version, please let me know and I'll try to fix
it as long as it doesn't break other versions.

=head1 METHODS

=head2 AnyEvent::WebService::Tracks->new(%params)

Creates a new AnyEvent::WebService::Tracks object.  C<%params> must contain
the url, username, and password parameters.

=head2 $tracks->projects($callback)

Retrieves the list of projects in the given Tracks installation and provides
them to the given callback.  If the call fails, then a falsy value and the
error message are provided to the callback.

=head2 $tracks->create_project($name, $callback)
=head2 $tracks->create_project(%params, $callback)

Creates a new project with the given name (a hash of parameters can be
provided instead of just a scalar name if more flexibility is desired) and
passes the new project object to the given callback.  If the call fails, then
a falsy value and the error message are provided to the callback.

=head2 $tracks->contexts($callback)

Retrieves the list of contexts in the given Tracks installation and provides
them to the given callback.  If the call fails, then a falsy value and the
error message are provided to the callback.

=head2 $tracks->create_context($name, $callback)
=head2 $tracks->create_context(%params, $callback)

Creates a new context with the given name (a hash of parameters can be
provided instead of just a scalar name if more flexibility is desired) and
passes the new context object to the given callback.  If the call fails, then
a falsy value and the error message are provided to the callback.

=head2 $tracks->todos($callback)

Retrieves the list of todos in the given Tracks installation and provides
them to the given callback.  If the call fails, then a falsy value and the
error message are provided to the callback.

=head2 $tracks->create_todo($name, $context, $callback)
=head2 $tracks->create_todo(%params, $callback)

Creates a new todo with the given name and context (a hash of parameters can
be provided instead of just two scalars if more flexibility is desired) and
passes the new todo object to the given callback.  If the call fails, then
a falsy value and the error message are provided to the callback.

=head1 AUTHOR

Rob Hoelz, C<< rob at hoelz.ro >>

=head1 BUGS

Please report any bugs or feature requests to C<bug-AnyEvent-WebService-Tracks at rt.cpan.org>, or through
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=AnyEvent-WebService-Tracks>. I will
be notified, and then you'll automatically be notified of progress on your bug as I make changes.

=head1 COPYRIGHT & LICENSE

Copyright 2011 Rob Hoelz.

This module is free software; you can redistribute it and/or modify it under
the same terms as Perl itself.