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 {