File Coverage

blib/lib/WWW/Google/API/Base.pm

Criterion	Covered	Total	%
statement	19	21	90.4
branch			n/a
condition			n/a
subroutine	7	7	100.0
pod			n/a
total	26	28	92.8

package WWW::Google::API::Base;

use strict;
use warnings;

=head1 NAME

WWW::Google::API::Base - Perl client to the Google Base API C<<  >>

=head1 VERSION

version 0.001

  $Id$

=head1 SYNOPSIS

  use WWW::Google::API::Base;

  my $file_conf = LoadFile($ENV{HOME}.'/.gapi');

  my $api_key  = $ENV{gapi_key};
  my $api_user = $ENV{gapi_user};
  my $api_pass = $ENV{gapi_pass};

  my $gbase = WWW::Google::API::Base->new( { auth_type => 'ProgrammaticLogin',
                                             api_key   => $api_key,
                                             api_user  => $api_user,
                                             api_pass  => $api_pass  },
                                           { } );

=head1 METHODS

=cut

our $VERSION = '0.001';

use base qw(Class::Accessor);

use HTTP::Request;
use LWP::UserAgent;
use WWW::Google::API;
use XML::Atom::Entry;
use XML::Atom::Util qw( nodelist );

__PACKAGE__->mk_ro_accessors(qw(namespaces));
__PACKAGE__->mk_accessors(qw(client));

sub new {
  my $class = shift;

  my $client;
  eval {
    $client = WWW::Google::API->new('gbase', @_);
  };
  if ($@) {
    my $e = $@;
    warn $e;
  }
  my $self = { client     => $client,
               namespaces => {
                 gm    => XML::Atom::Namespace->new( gm    => 'http://base.google.com/ns-metadata/1.0'),
                 g     => XML::Atom::Namespace->new( g     => 'http://base.google.com/ns/1.0'         ),
                 batch => XML::Atom::Namespace->new( batch => 'http://schemas.google.com/gdata/batch' ),
               }
             };

  bless($self, $class);
  return $self;
}

sub _load_item_type {
  my $self = shift;
  my $type = shift;


  my $ua      = LWP::UserAgent->new( agent => 'WWW::Google::API' );

  my $response = $ua->get($type);

  die $response->status_line unless $response->is_success;

  my $entry = XML::Atom::Entry->new(\$response->content);

  $type = $entry->get($self->{namespaces}{gm}, 'item_type');
  my @attributes = nodelist($entry->elem, $self->{namespaces}{gm}{uri}, 'attribute');
  my $attribute_types;
  foreach my $attribute (@attributes) {
    my $name = $attribute->getAttribute('name');
    my $type = $attribute->getAttribute('type');
    $name =~ s/\s/_/g;
    $attribute_types->{$name} = $type;
  }
  $attribute_types->{'label'} = 'text';
  return $type, $attribute_types;
}

=head2 insert

  $insert_entry = $gbase->insert(
    'http://www.google.com/base/feeds/itemtypes/en_US/Recipes',
    { -title      => 'He Jingxian\'s chicken',
      -content    => "Delectable Sichuan specialty",
      -link       => [
        { rel  => 'alternate',
          type => 'text/html',
          href => 'http://localhost/uniqueid'
        },
      ],
      cooking_time    => 30,
      label           => [qw(foo bar baz)],
      main_ingredient => [qw(chicken chili peanuts)],
      servings        => 5,
    },
  );

  $new_id = $insert_entry->id;

=cut

sub insert {
  my $self       = shift;
  my $item_type  = shift;
  my $item_parts = shift;

  my ($type, $gpart_types) = $self->_load_item_type($item_type);

  $self->client->ua->default_header('content-type', 'application/atom+xml');

  my $xml = <


       xmlns:g='http://base.google.com/ns/1.0'>

  $type
EOF

  for my $key (keys %$item_parts) {
    if ($key =~ /^-/) {
      if ($key eq '-content') {
        $xml .= "\n";
        $xml .= "$item_parts->{$key}\n";
        $xml .= "\n";
      } elsif ($key eq '-link') {
        if (ref $item_parts->{$key} eq 'ARRAY') {
          foreach (@{$item_parts->{$key}}) {
            $xml .= "\n";
          }
        } else {
          $xml .= "\n";
        }
      } elsif (ref $item_parts->{$key} eq 'ARRAY') {
        for my $item (@{$item_parts->{$key}}) {
          $key =~ s/^-//;
          $xml .= "<$key type='text'>$item\n";
        }
      } else {
        $key =~ s/^-//;
        $xml .= "<$key type='text'>".$item_parts->{"-$key"}."\n";
      }
    } else {
      if (ref $item_parts->{$key} eq 'ARRAY') {
        for my $item (@{$item_parts->{$key}}) {
          $xml .= "$item\n";
        }
      } else {
        $xml .= "$item_parts->{$key}\n";
      }
    }
  }
  $xml .= "\n";

  my $insert_request = HTTP::Request->new( POST => 'http://www.google.com/base/feeds/items',
                                          $self->client->ua->default_headers,
                                          $xml);
  my $response;
  eval {
    $response = $self->client->do($insert_request);
  };
  if ($@) {
    my $error = $@;
    die $error;
  }

  my $atom = $response->content;

  my $entry = XML::Atom::Entry->new(\$atom);

  return $entry
}

=head2 update

  $update_entry = $gbase->update(
    $new_id,
    { -title      => 'He Jingxian\'s chicken',
      -content    => "Delectable Sichuan specialty",
      -link       => [
        { rel  => 'alternate',
          type => 'text/html',
          href => 'http://localhost/uniqueid'
        },
      ],
      cooking_time    => 60,
      label           => [qw(fio bir biz)],
      main_ingredient => [qw(chicken chili peanuts)],
      servings        => 15,
    },
  );

=cut

sub update {
  my $self       = shift;
  my $item_id    = shift;
  my $item_parts = shift;

  my $item = $self->select($item_id);

  my $item_type = 'http://www.google.com/base/feeds/itemtypes/en_US/';
  $item_type   .= $item->get($self->{namespaces}{g}, 'item_type');

  my ($type, $gpart_types) = $self->_load_item_type($item_type);

  $self->client->ua->default_header('content-type', 'application/atom+xml');

  my $xml = <


       xmlns:g='http://base.google.com/ns/1.0'>

  $type
EOF

  for my $key (keys %$item_parts) {
    if ($key =~ /^-/) {
      if ($key eq '-content') {
        $xml .= "\n";
        $xml .= "$item_parts->{$key}\n";
        $xml .= "\n";
      } elsif ($key eq '-link') {
        if (ref $item_parts->{$key} eq 'ARRAY') {
          foreach (@{$item_parts->{$key}}) {
            $xml .= "\n";
          }
        } else {
          $xml .= "\n";
        }
      } elsif (ref $item_parts->{$key} eq 'ARRAY') {
        for my $item (@{$item_parts->{$key}}) {
          $key =~ s/^-//;
          $xml .= "<$key type='text'>$item\n";
        }
      } else {
        $key =~ s/^-//;
        $xml .= "<$key type='text'>".$item_parts->{"-$key"}."\n";
      }

    } else {
      if (ref $item_parts->{$key} eq 'ARRAY') {
        for my $item (@{$item_parts->{$key}}) {
          $xml .= "$item\n";
        }
      } else {
        $xml .= "$item_parts->{$key}\n";
      }
    }
  }
  $xml .= "\n";

  my $update_request = HTTP::Request->new( PUT => $item_id,
                                          $self->client->ua->default_headers,
                                          $xml);
  my $response;
  eval {
    $response = $self->client->do($update_request);
  };
  if ($@) {
    my $error = $@;
    die $error;
  }

  my $atom = $response->content;

  my $entry = XML::Atom::Entry->new(\$atom);

  return $entry;
}

=head2 delete

  my $delete_response;
  eval {
    $delete_response =$gbase->delete($new_id);
  };
  if ($@) {
    my $e = $@;
    die $e->status_line;  # HTTP::Response
  }

  die "Successfully deleted if $delete_response->code == 200; # HTTP::Response

=cut

sub delete {
  my $self    = shift;
  my $item_id = shift;
  my $delete_request = HTTP::Request->new( DELETE => $item_id,
                                           $self->client->ua->default_headers );
  my $response;
  eval {
    $response = $self->client->do($delete_request);
  };
  if ($@) {
    my $error = $@;
    die $error;
  }
  return $response;
}

=head2 select

Currently only supports querying by id

  my $select_inserted_entry;
  eval {
    $select_inserted_entry =$gbase->select($new_id);
  };
  if ($@) {
    my $e = $@;
    die $e->status_line;  # HTTP::Response
  }

=cut

sub select {
  my $self    = shift;
  my $item_id = shift;

  my $select_request = HTTP::Request->new( GET => $item_id,
                                           $self->client->ua->default_headers );
  my $response;
  eval {
    $response = $self->client->do($select_request);
  };
  if ($@) {
    my $error = $@;
    die $error;
  }

  my $atom = $response->content;

  my $entry = XML::Atom::Entry->new(\$atom);

  return $entry;
}

1;