/XML-OverHTTP/lib/XML/OverHTTP.pm

  1package XML::OverHTTP;
  2use strict;
  3use vars qw( $VERSION @ISA );
  4$VERSION = '0.08';
  5use XML::TreePP;
  6use CGI;
  7# use Data::Page;
  8# use Data::Pageset;
  9use base qw( Class::Accessor::Fast );
 10__PACKAGE__->mk_accessors(qw( xml tree code param ));
 11
 12if ( $XML::TreePP::VERSION < 0.26 ) {
 13    Carp::croak( 'XML::TreePP version 0.26 or later is required' );
 14}
 15
 16package XML::OverHTTP::Default;
 17use strict;
 18use vars qw( $VERSION );
 19$VERSION = $XML::OverHTTP::VERSION;
 20
 21sub http_method { 'GET'; }
 22sub url { undef; }
 23sub query_class { undef; }
 24sub default_param { {}; }
 25sub notnull_param { []; }
 26sub force_array { []; }
 27sub force_hash { []; }
 28sub attr_prefix { ''; }
 29sub text_node_key { '#text'; }
 30sub elem_class { undef; }
 31sub root_elem { undef; }
 32sub is_error { undef; }
 33sub total_entries { undef; }
 34sub entries_per_page { undef; }
 35sub current_page { undef; }
 36sub page_param { undef; }
 37
 38package XML::OverHTTP;  # again
 39use strict;
 40use base qw( XML::OverHTTP::Default );
 41
 42sub new {
 43    my $package = shift;
 44    my $self    = {};
 45    bless $self, $package;
 46    my $default = $self->default_param();
 47    $self->add_param( %$default ) if ref $default;
 48    $self->add_param( @_ ) if scalar @_;
 49    $self;
 50}
 51
 52sub new_param {
 53    my $self  = shift;
 54    my $class = $self->query_class();
 55    return {} unless defined $class;
 56    $class->new();
 57}
 58
 59sub add_param {
 60    my $self  = shift;
 61    my $param = $self->param() || $self->new_param();
 62    %$param = ( %$param, @_ ) if scalar @_;
 63    $self->param( $param );
 64}
 65
 66sub get_param {
 67    my $self  = shift;
 68    my $key   = shift;
 69    my $param = $self->param() or return;
 70    $param->{$key} if exists $param->{$key};
 71}
 72
 73sub treepp {
 74    my $self = shift;
 75    $self->{treepp} = shift if scalar @_;
 76    return $self->{treepp} if ref $self->{treepp};
 77    $self->{treepp} = XML::TreePP->new();
 78}
 79
 80sub init_treepp {
 81    my $self   = shift;
 82    my $treepp = $self->treepp();
 83
 84    my $force_array   = $self->force_array();
 85    my $force_hash    = $self->force_hash();
 86    my $attr_prefix   = $self->attr_prefix();
 87    my $text_node_key = $self->text_node_key();
 88#   my $base_class    = $self->base_class();
 89    my $elem_class    = $self->elem_class();
 90    $treepp->set( force_array   => $force_array );
 91    $treepp->set( force_hash    => $force_hash );
 92    $treepp->set( attr_prefix   => $attr_prefix );
 93    $treepp->set( text_node_key => $text_node_key );
 94#   $treepp->set( base_class    => $base_class );
 95    $treepp->set( elem_class    => $elem_class );
 96
 97    $treepp;
 98}
 99
100sub request {
101    my $self   = shift;
102    $self->{tree}    = undef;
103    $self->{xml}     = undef;
104    $self->{code}    = undef;
105    $self->{page}    = undef;
106    $self->{pageset} = undef;
107
108    $self->check_param();
109    my $req = $self->http_request();
110    my $treepp = $self->init_treepp();
111    my( $tree, $xml, $code ) = $treepp->parsehttp( @$req );
112
113    $self->{tree} = $tree;
114    $self->{xml}  = $xml;
115    $self->{code} = $code;
116    $tree;
117}
118
119sub http_request {
120    my $self   = shift;
121
122    my $method = $self->http_method();
123    my $url    = $self->url();
124    my $query  = $self->query_string();
125    Carp::croak( 'HTTP method is not defined' ) unless defined $method;
126    Carp::croak( 'Request url is not defined' ) unless defined $url;
127
128    my $req;
129    if ( uc($method) eq 'GET' ) {
130        $url .= '?'.$query if length($query);
131        $req = [ $method, $url ];
132    }
133    else {
134        $req = [ $method, $url, $query ];
135    }
136    $req;
137}
138
139sub root {
140    my $self = shift;
141    my $tree = $self->tree();
142    Carp::croak( 'Empty response' ) unless ref $tree;
143    my $root = $self->root_elem();
144    Carp::croak( 'Root element is not defined' ) unless defined $root;
145    Carp::croak( 'Root element seems empty' ) unless ref $tree->{$root};
146    $tree->{$root};
147}
148
149sub root_elem {
150    my $self = shift;
151    my $tree = $self->tree();
152    Carp::croak( 'Empty response' ) unless ref $tree;
153    Carp::croak( 'Multiple root elements found' ) if ( scalar keys %$tree > 1 );
154    # root element auto discovery by default
155    ( keys %$tree )[0];
156}
157
158sub query_string {
159    my $self  = shift;
160    my $param = $self->param() or return;
161    local $CGI::USE_PARAM_SEMICOLONS = 0;
162    my $hash = { %$param };                     # copy for blessed hash
163    CGI->new( $hash )->query_string();
164}
165
166sub check_param {
167    my $self  = shift;
168    my $param = $self->param() or return;
169    my $check = $self->notnull_param() or return;
170    my $error = [ grep {
171        ! exists $param->{$_}  || 
172        ! defined $param->{$_} || 
173        $param->{$_} eq '' 
174    } @$check ];
175    return unless scalar @$error;
176    my $join  = join( ' ' => @$error );
177    Carp::croak "Invalid request: empty parameters - $join\n";
178}
179
180sub page {
181    my $self = shift;
182    my $page = shift;
183    if ( ! defined $page ) {
184        return $self->{page} if ref $self->{page};
185        local $@;
186        eval { require Data::Page; } unless $Data::Page::VERSION;
187        Carp::croak( "Data::Page is required: $@" ) unless $Data::Page::VERSION;
188        $page = Data::Page->new();
189    }
190    my $total_entries    = $self->total_entries();
191    my $entries_per_page = $self->entries_per_page();
192    my $current_page     = $self->current_page();
193    $page->total_entries( $total_entries );
194    $page->entries_per_page( $entries_per_page );
195    $page->current_page( $current_page );
196    $self->{page} = $page;
197}
198
199sub pageset {
200    my $self = shift;
201    my $mode = shift;   # default 'fixed', or 'slide'
202    return $self->{pageset} if ref $self->{pageset};
203    my $total_entries    = $self->total_entries();
204    my $entries_per_page = $self->entries_per_page();
205    my $current_page     = $self->current_page();
206    my $hash = {
207        total_entries    => $total_entries,
208        entries_per_page => $entries_per_page,
209        current_page     => $current_page,
210        mode             => $mode,
211    };
212    local $@;
213    eval { require Data::Pageset; } unless $Data::Pageset::VERSION;
214    Carp::croak( "Data::Pageset is required: $@" ) unless $Data::Pageset::VERSION;
215    $self->{pageset} = Data::Pageset->new( $hash );
216}
217
218sub page_query {
219    my $self = shift;
220    my $param = $self->page_param( @_ );
221    local $CGI::USE_PARAM_SEMICOLONS = 0;
222    CGI->new( $param )->query_string();
223}
224
225=head1 NAME
226
227XML::OverHTTP - A base class for XML over HTTP-styled web service interface
228
229=head1 DESCRIPTION
230
231This module is not used directly from end-users. 
232As a child class of this, module authors can easily write own interface module 
233for XML over HTTP-styled web service.
234
235=head1 METHODS PROVIDED
236
237This module provides some methods and requires other methods overridden by child classes.
238The following methods are to be called in your module or by its users.
239
240=head2 new
241
242This constructor method returns a new object for your users.
243It accepts query parameters by hash.
244
245    my $api = MyAPI->new( %param );
246
247MyAPI.pm inherits this XML::OverHTTP modules.
248
249=head2 add_param
250
251This method adds query parameters for the request.
252
253    $api->add_param( %param );
254
255It does not validate key names.
256
257=head2 get_param
258
259This method returns a current query parameter.
260
261    $api->get_param( 'key' );
262
263=head2 treepp
264
265This method returns an L<XML::TreePP> object to make the request.
266
267    $api->treepp->get( 'key' );
268
269And you can set its object as well.
270
271    my $mytpp = XML::TreePP->new;
272    $api->treepp( $mytpp );
273
274total_entries, entries_per_page and current_page parameters 
275in C<$mytpp> are updated.
276
277=head2 request
278
279This method makes the request for the web service and returns its response tree.
280
281    my $tree = $api->request;
282
283After calling this method, the following methods are available.
284
285=head2 tree
286
287This method returns the whole of the response parsed by L<XML::TreePP> parser.
288
289    my $tree = $api->tree;
290
291Every element is blessed when L</elem_class> is defined.
292
293=head2 root
294
295This method returns the root element in the response.
296
297    my $root = $api->root;
298
299=head2 xml
300
301This method returns the response context itself.
302
303    print $api->xml, "\n";
304
305=head2 code
306
307This method returns the response status code.
308
309    my $code = $api->code; # usually "200" when succeeded
310
311=head2 page
312
313This method returns a L<Data::Page> object to create page navigation.
314
315    my $pager = $api->page;
316    print "Last page: ", $pager->last_page, "\n";
317
318And you can set its object as well.
319
320    my $pager = Data::Page->new;
321    $api->page( $pager );
322
323=head2 pageset
324
325This method returns a L<Data::Pageset> object to create page navigation.
326The paging mode is C<fixed> as default.
327
328    my $pager = $api->pageset;
329    $pager->pages_per_set( 10 );
330    print "First page of next page set: ",  $page_info->next_set, "\n";
331
332Or set it to C<slide> mode if you want.
333
334    my $pager = $api->pageset( 'slide' );
335
336=head2 page_param
337
338This method returns pair(s) of query key and value to set the page number 
339for the next request.
340
341    my $hash = $api->page_param( $page );
342
343The optional second argument specifies the number of entries per page.
344
345    my $hash = $api->page_param( $page, $size );
346
347The optional third argument incluedes some other query parameters.
348
349    my $newhash = $api->page_param( $page, $size, $oldhash );
350
351=head2 page_query
352
353This method returns a processed query string which is joined by '&' delimiter.
354
355    my $query = $api->page_query();                         # current page
356    my $query = $api->page_query( $page, $size, $hash );    # specified page
357
358=head1 METHOD YOU MUST OVERRIDE
359
360You B<MUST> override at least one method below:
361
362=head2 url
363
364This is a method to specify the url for the request to the web service.
365E.g.,
366
367    sub url { 'http://www.example.com/api/V1/' }
368
369=head1 METHODS YOU SHOULD OVERRIDE
370
371The methods that you B<SHOULD> override in your module are below:
372
373=head2 root_elem
374
375This is a method to specify a root element name in the response.
376E.g.,
377
378    sub root_elem { 'rdf:RDF' }
379
380=head2 is_error
381
382This is a method to return C<true> value when the response seems 
383to have error. This returns C<undef> when it succeeds.
384E.g.,
385
386    sub is_error { $_[0]->root->{status} != 'OK' }
387
388=head2 total_entries
389
390This is a method to return the number of total entries for C<Data::Page>.
391E.g.,
392
393    sub total_entries { $_[0]->root->{hits} }
394
395=head2 entries_per_page
396
397This is a method to return the number of entries per page for C<Data::Page>.
398E.g.,
399
400    sub entries_per_page { $_[0]->root->{-count} }
401
402=head2 current_page
403
404This is a method to return the current page number for C<Data::Page>.
405E.g.,
406
407    sub current_page { $_[0]->root->{-page} }
408
409=head2 page_param
410
411This is a method to return paging parameters for the next request.
412E.g.,
413
414    sub page_param {
415        my $self = shift;
416        my $page = shift || $self->current_page();
417        my $size = shift || $self->entries_per_page();
418        my $hash = shift || {};
419        $hash->{page}  = $page if defined $page;
420        $hash->{count} = $size if defined $size;
421        $hash;
422    }
423
424When your API uses SQL-like query parameters, offset and limit:
425
426    sub page_param {
427        my $self = shift;
428        my $page = shift || $self->current_page() or return;
429        my $size = shift || $self->entries_per_page() or return;
430        my $hash = shift || {};
431        $hash->{offset} = ($page-1) * $size;
432        $hash->{limit}  = $size;
433        $hash;
434    }
435
436=head1 METHODS YOU CAN OVERRIDE
437
438You B<CAN> override the following methods as well.
439
440=head2 http_method
441
442This is a method to specify the HTTP method, 'GET' or 'POST', for the request.
443This returns 'GET' as default.
444E.g.,
445
446    sub http_method { 'GET' }
447
448=head2 default_param
449
450This is a method to specify pairs of default query parameter and its value 
451for the request.
452E.g.,
453
454    sub default_param { { method => 'search', lang => 'perl' } }
455
456=head2 notnull_param
457
458This is a method to specify a list of query parameters which are required 
459by the web service.
460E.g.,
461
462    sub notnull_param { [qw( api_key secret query )] }
463
464These keys are checked before makeing a request for safe. 
465
466=head2 query_class
467
468This is a method to specify a class name for query parameters.
469E.g.,
470
471    sub elem_class { 'MyAPI::Query' }
472
473The default value is C<undef>, it means 
474a normal hash is used instead.
475
476=head2 attr_prefix
477
478This is a method to specify a prefix for each attribute 
479in the response tree. L<XML::TreePP> uses it.
480E.g.,
481
482    sub attr_prefix { '' }
483
484The default prefix is zero-length string C<""> which is recommended.
485
486=head2 text_node_key
487
488This is a method to specify a hash key for text nodes
489in the response tree. L<XML::TreePP> uses it.
490E.g.,
491
492    sub text_node_key { '_text' }
493
494The default key is C<"#text">.
495
496=head2 elem_class
497
498This is a method to specify a base class name for each element 
499in the response tree. L<XML::TreePP> uses it.
500E.g.,
501
502    sub elem_class { 'MyAPI::Element' }
503
504The default value is C<undef>, it means 
505each elements is a just hashref and not bless-ed.
506
507=head2 force_array
508
509This is a method to specify a list of element names which should always 
510be forced into an array representation in the response tree. 
511L<XML::TreePP> uses it.
512E.g.,
513
514    sub force_array { [qw( rdf:li item xmlns )] }
515
516=head2 force_hash
517
518This is a method to specify a list of element names which should always 
519be forced into an hash representation in the response tree. 
520L<XML::TreePP> uses it.
521E.g.,
522
523    sub force_hash { [qw( item image )] }
524
525=head1 SEE ALSO
526
527L<XML::TreePP>
528
529L<http://www.kawa.net/works/perl/overhttp/overhttp-e.html>
530
531=head1 AUTHOR
532
533Yusuke Kawasaki L<http://www.kawa.net/>
534
535=head1 COPYRIGHT AND LICENSE
536
537Copyright (c) 2007 Yusuke Kawasaki. All rights reserved.
538This program is free software; you can redistribute it and/or
539modify it under the same terms as Perl itself.
540
541=cut
5421;