File Coverage

blib/lib/Metaweb.pm

Criterion	Covered	Total	%
statement	48	94	51.0
branch	4	18	22.2
condition	7	19	36.8
subroutine	9	12	75.0
pod	4	4	100.0
total	72	147	48.9

package Metaweb;

use warnings;
use strict;

use base qw(Class::Accessor);
use URI::Escape;
use LWP::UserAgent;
use JSON::XS;
use Metaweb::Result;

__PACKAGE__->mk_accessors(qw(
    username
    password
    server
    login_path
    read_path
    write_path
    credentials
    ua
    raw_query
    raw_result
    err_code
    err_message
));

=head1 NAME

Metaweb - Perl interface to the Metaweb/Freebase API

=head1 VERSION

Version 0.05

=cut

our $VERSION = '0.05';

=head1 SYNOPSIS

    use Metaweb;

    my $mw = Metaweb->new({
        username => $username,
        password => $password
    });
    $mw->login();

  my $result = $mw->query({
      name => 'my_query',
      query => \%query,
  });

=head1 DESCRIPTION

This is a Perl interface to the Metaweb database, best known through the
application Freebase (http://freebase.com).

If this is your first encounter with Metaweb/Freebase, chances are
you're confused about what the two terms mean.  In short, Metaweb is the
underlying database technology and Freebase is large, well-known
application that runs on it.  For comparison, consider Mediawiki
(software) and Wikipedia (website and data collection).

This means that you can use this Metaweb module to talk to Freebase or
- in future - any other website built on the Metaweb platform.

The Metaweb Query Language (MQL) is based on JSON and query-by-example.
The MQL and API documentation can be found on the Freebase website in
the developers' area.  There is also an online Query Editor tool, with
many examples of MQL, at http://www.freebase.com/view/queryeditor/

This CPAN module provides you with everything you need to build an
application around Freebase or any other Metaweb database.  It also
provides a command line client ('metaweb') for playing around with MQL.

=head1 IMPORTANT NOTES

=head2 Alpha release

Freebase is currently in alpha release, with world-readable data but
requiring an invitation and login to be able to update/write data.

This module is very much alpha code.  It has lots of stuff not
implemented and will undergo significant changes.  Breakage may occur
between versions, so consider yourself warned.

=head2 TMTOWTDI

Also note that Hayden Stainsby is working on a different Metaweb module
called L.  There's more than one way to do it.  I
encourage you to check out both modules and provide feedback/suggestions
to both of us, either directly or via the Freebase developers' mailing
list.

=head1 FUNCTIONS

=head2 new()

Instantiate a Metaweb client object.  Takes various options including:

=over 4

=item username

The username to login with

=item password

The password to login with

=item server

The server address

=item read_path

The URL path of the read service, relative to the server address

=item write_path

The URL path of the write service, relative to the server address

=item login_path

The URL path of the login service, relative to the server address

=back

None of these are actually required; the server and path options default
to Freebase's, and the username/login are only required for write
access.  Therefore, if you only want to read from Freebase, all you need
is:

    my $mw = Metaweb->new();

=cut

sub new {
    my ($class, $args) = @_;
    my $self = {};
    bless $self, $class;
    $self->username($args->{username});
    $self->password($args->{password});
    $self->server     ( $args->{server}     || 'http://www.freebase.com' );
    $self->read_path  ( $args->{read_path}  || '/api/service/mqlread'    );
    $self->write_path ( $args->{write_path} || '/api/service/mqlwrite'   );
    $self->login_path ( $args->{login_path} || '/api/account/login'      );
    return $self;
}

=head2 login()

Perform a login to the Metaweb server and pick up the necessary cookie.
Uses the username/password details provided to the constructor method,
or via the appropriately named accessor methods (see below).

=cut

sub login {
    my ($self, $args) = @_;

    my $username   = $self->username();
    my $password   = $self->password();
    my $server     = $self->server();
    my $login_path = $self->login_path();

    # warn "Server: $server\n";
    # warn "Login URL: $login_path\n";

    unless ($self->ua()) {
        $self->ua(LWP::UserAgent->new());
    }
    my $res = $self->ua->post("$server$login_path", {username=>$username,password=>$password});

    my $raw = $res->header('Set-Cookie');
    unless ($raw) {
        warn "Couldn't login to $server";
        return undef;
    }
    my @cookies = split(', ',$raw);        # Break cookies at commas

    # Each cookie is broken into fields with semicolons.
    # We want the only first field of each cookie
    my $credentials = ''; # We'll accumulate login credentials here
    for my $cookie (@cookies) {                        # Loop through cookies
        my @parts = split(";", $cookie);               # Split each one on ;
        $credentials = $credentials . $parts[0] . ';'; # Remember first part
    }
    chop($credentials);   # Remove trailing semicolon
    $self->credentials($credentials);
    $self->ua->default_header('Cookie' => $credentials);

    return 1;
}

=head2 query()

Perform a MQL query.  You must provide a name and a query hash as
arguments:

  my $result = $mw->query({
      name => 'my_query',
      query => { type => 'person', name => undef } # all people!
  });

The query is a a Perl data structure that's converted to JSON using the
L module's C method.  The MQL envelope will
automatically be put around the query, using the name you provide.

Currently this method only supports "read" queries.  If you want to
write/upload, use C.

The results of this method are returned as a Perl data structure (or
undef on failure); the following attributes are also set for diagnostic
purposes.

=over 4

=item raw_query

The raw JSON used in the query.

=item raw_result

The raw JSON returned.

=item err_code

Error code (only used if an error occurs).

=item err_message

Error message (only used if an error occurs).

=back

See the accessor methods (below) for how to access all these attributes.

=cut

sub query {
    my ($self, $args) = @_;

    warn "Query name not specified" unless $args->{name};
    warn "Query not specified"      unless $args->{query};

    $args->{query} = _add_envelope($args->{name}, to_json($args->{query}));

    my $raw_result = $self->json_query($args);
    my $outer = from_json($raw_result);
    my $inner = $outer->{$args->{name}};

    if ($inner->{code} !~ m|^/api/status/ok|) {  # If the query was not okay
        my $err = $inner->{messages}[0];
        $self->err_code($err->{code});
        $self->err_message($err->{message});
        return undef;
    } else {
        $self->err_code(undef);
        $self->err_message(undef);
    }

    my $result = Metaweb::Result->new($inner->{result});
    return $result;
}

=head2 json_query

This method sends and receives raw JSON to the Metaweb API.

Arguments are passed as a hashref and include:

=over 4

=item type

May be "read", "write", or "update".  Default is "read".

=item query

The query in JSON format.  You are expected to send the full JSON,
including the envelope.

=back

The raw JSON is returned.  No parsing whatsoever is done.

C and C are set as a side effect, same as for
C, but C and C are *not* set, as we'd
need to parse the JSON to get at it and the whole point of this is that
it's unparsed.

=cut

sub json_query {
    my ($self, $args) = @_;

    warn "Query not specified"      unless $args->{query};
    my $query = $args->{query};
    $self->raw_query($query);
    my $type = $args->{type} || "read";

    unless ($self->ua()) {
        $self->ua(LWP::UserAgent->new());
    }

    my $server  = $self->server() || warn "Server not specified";

    my $response;
    if ($type eq 'write') {
        $self->ua->default_header('X-Metaweb-Request' => 1);
        my $path = $self->write_path() || warn "Query URL not specified for write";
        my $url = $server . $path;
        $response = $self->ua->post($url, { queries => $query });
    } else {
        my $path = $self->read_path() || warn "Query URL not specified for read";
        $query = uri_escape($query);
        my $url = $server . $path . "?queries=" . $query;
        $response = $self->ua->get($url);
    }

    if ($response->is_success()) {
        my $raw = $response->content();
        $self->raw_result($raw);
        return $raw;
    } else {
        warn "Request failed";
        print $self->ua->content();
    }
}

sub _add_envelope {
    my ($name, $query) = @_;
    return qq({
      "$name": {
        "query": $query
      }
    });
}

=head1 ACCESSOR METHODS

You probably won't need these much in day-to-day use, but they're here
for you if you want them.

=head2 username()

Get/set default login username.

=head2 password()

Get/set default login password.

=head2 server()

Get/set server to login to.  Defaults to 'http://www.freebase.com'.

=head2 login_path()

Get/set the URL to login to, relative to the server.  Defaults to
'/api/account/login'.

=head2 read_path()

Get/set the URL to perform read queries, relative to the server.  Defaults to
'/api/service/mqlread'.

=head2 write_path()

Get/set the URL to perform write queries, relative to the server.  Defaults to
'/api/service/mqlwrite'.

=head2 raw_query()

The raw JSON of the last query made.  This is set by both C and
C.

=head2 raw_result()

The raw JSON from the response.  This is set by both C and
C.

=head2 err_code()

Set on error by C.  C doesn't set this; you need
to parse the JSON yourself.

=head2 err_message()

Set on error by C.  C doesn't set this; you need
to parse the JSON yourself.

=head1 SEE ALSO

L, L (command line client), L (alternative
interface).

=head1 AUTHOR

Kirrily Robert, C<<  >>

=head1 BUGS

Please report any bugs or feature requests to
C, or through the web interface at
L.
I will be notified, and then you'll automatically be notified of progress on
your bug as I make changes.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Metaweb

You can also look for information at:

=over 4

=item * AnnoCPAN: Annotated CPAN documentation

L

=item * CPAN Ratings

L

=item * RT: CPAN's request tracker

L

=item * Search CPAN

L

=back

=head1 ACKNOWLEDGEMENTS

Thanks to the following people with whom I have discussed Metaweb Perl
APIs recently...

    Hayden Stainsby (CPAN: HDS)
    Kirsten Jones (CPAN: SYNEDRA)

=head1 COPYRIGHT & LICENSE

Copyright 2007 Kirrily Robert, all rights reserved.

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

=cut

1; # End of Metaweb