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

http://xml-treepp.googlecode.com/ · Perl · 542 lines · 383 code · 154 blank · 5 comment · 45 complexity · 9b7545077799cb98355bb20d3e1a7a08 MD5 · raw file

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