File Coverage

blib/lib/Net/Safari.pm

Criterion	Covered	Total	%
statement	4	6	66.6
branch			n/a
condition			n/a
subroutine	2	2	100.0
pod			n/a
total	6	8	75.0

package Net::Safari;

=head1 NAME

Net::Safari - Wrapper for Safari Online Books API

=head1 SYNOPSIS

  use Net::Safari

  my $ua = Net::Safari->new(token => 'YOUR_SAFARI_TOKEN');

  my $response = $ua->search();

  if($response->is_success()) {
      print $response->as_string();
  }
  else {
      print "Error:" . $response->message();
  }


=head1 DESCRIPTION

You can read more about Safari webservices here:
http://safari.oreilly.com/affiliates/?p=web_services

=cut


use strict;
use XML::Simple;
use LWP::UserAgent;
use URI::Escape;
use Class::Accessor;
use Class::Fields;
use Data::Dumper;
use Net::Safari::Response;

our $VERSION     = 0.02;

# hash of search operators and operator/term seperators
our %SEARCH_OPS = (
        CODE      => ' ',
        NOTE      => ' ',
        TITLE     => ' ',
        BOOKTITLE => ' LIKE ',
        CATEGORY  => '=',
        AUTHOR    => '=',
        ISBN      => ' LIKE ',
        PUBLDATE  => ' ',
        PUBLISHER => '=',
        );

use base qw(Class::Accessor Class::Fields);
use fields qw(token base_url ua);
Net::Safari->mk_accessors( Net::Safari->show_fields('Public') );

=head1 METHODS

=head2 new()

  $agent = Net::Safari->new( token => 'MY_SAFARI_TOKEN' );

Construct a Safari object. Token seems optional.

=cut

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

	my $self = bless ({}, ref ($class) || $class);

    $self->token($args{token});
    $self->base_url("http://my.safaribooksonline.com/xmlapi/");
    $self->ua( LWP::UserAgent->new( agent => "Net::Safari $VERSION", ) );

	return ($self);
}

=head1 SEARCH

=head2 BOOKTITLE

  $res = $ua->search( BOOKTITLE => 'samba' );

  Search book titles. This is currently broken in Safari.
  See: http://safari.oreilly.com/xmlapi/?search=BOOKTITLE%20LIKE%20XML

=head2 TITLE

  $res = $ua->search( TITLE => 'samba' );

  Searches section titles. Will sometimes return book titles if it can't find
  any sections. I consider this a bug.

=head2 ISBN

  $res = $ua->search( ISBN  => '059600415X' );

  ISBN must be a complete ISBN, partial ISBN searches don't work.

=head2 CODE

  $res = $ua->search( CODE => 'Test::More' );

  Search within code fragments. This is usually a lot more than programlistings. Code snippets that appear within a sentence are usually semanticly tagged as code. So you're just as likely to get text as you are to get program listings with this search.

=head2 NOTE

  $res = $ua->search( NOTE => "web services" );

  The documentation says, "Finds matches within Tips and How-Tos." However the results seem to indicate hits in the content.

=head2 CATEGORY

  $res = $ua->search( CATEGORY => "itbooks.security" );

  Search within a category. The list of categories is here:
  http://safari.oreilly.com/affiliates/portals/safari/2004-07-30_Safari_Books_Category_Metadata_Abbreviations.doc

=head2 AUTHOR

  $res = $ua->search( AUTHOR => 'Wall' );
  $res = $ua->search( AUTHOR => 'Wall, Larry' );
  $res = $ua->search( AUTHOR => 'Larry Wall' );

  Search by author.

=head2 PUBLDATE

  $res = $ua->search( PUBLDATE => '> 20041001' );
  $res = $ua->search( PUBLDATE => '< 20030101' );

  Search before or after a given publish date. The comparison operator, > or < is required.

=head2 PUBLISHER

  $res = $ua->search( PUBLISHER => "O'Reilly" );

  Search by publisher.

=cut

sub search
{
    my $self = shift;
    my %args = @_;

    my $token = $self->token || "";

    my $url = $self->base_url ."?";
    $url .= "token=$token&" if $token;
    $url .= "search=" . $self->_build_search_string(%args);

    my $saf_resp = $self->ua->get($url);
    my $response = Net::Safari::Response->new(xml => $saf_resp->content);

    return $response;
}

sub _build_search_clause {
    my $self     = shift;
    my $boolean  = shift;
    my $operator = shift;
    my $terms    = shift;

    return join ( ' $boolean ',
                  map { $operator . $self->_quote_search_term($_) }
                      @$terms
                 );
}

sub _build_search_string {
    my $self = shift;
    my %args = @_;

    my $search_string;
    my $terms;

    foreach my $op (keys(%SEARCH_OPS)) {
        next unless $args{$op};

        if ($args{$op} && ( ref($args{$op}) eq "ARRAY" )) {
            $terms = $args{$op};
        }
        else {
            $terms = [$args{$op}];
        }
        $search_string .= $self->_build_search_clause(
                "OR",
                $op . $SEARCH_OPS{$op},
                $terms,
                );
    }
    my $uri = uri_escape($search_string);
    return $uri;
}

sub _quote_search_term {
    my $self = shift;
    my $term = shift;

    #$term =~ s/'//g;

    #$term = qq{"$term"} if $term =~ m/\s/;

    return $term;
}
=head1 BUGS



=head1 SUPPORT



=head1 AUTHOR

  Tony Stubblebine
  [e-mail]


=head1 COPYRIGHT

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

The full text of the license can be found in the
LICENSE file included with this module.


=head1 SEE ALSO


=cut


1;
__END__