home *** CD-ROM | disk | FTP | other *** search
/ Chip 2000 May / Chip_2000-05_cd1.bin / zkuste / Perl / ActivePerl-5.6.0.613.msi / 䆊䌷䈹䈙䏵-䞅䞆䞀㡆䞃䄦䠥 / _54db2f6b288dffd670533209fccf7aae < prev    next >
Text File  |  2000-03-15  |  17KB  |  380 lines
  1. package PPM::SOAPClient;
  2.  
  3. ###############################################################################
  4. # Required inclusions.
  5. ###############################################################################
  6. use strict;                         # Activate compile-time syntax checking
  7. use SOAP::EnvelopeMaker;            # Needed for connecting to SOAP server
  8. use SOAP::Transport::HTTP::Client;  # Needed for connecting to SOAP server
  9. use SOAP::Parser;                   # Needed for parsing results from SOAP srvr
  10.  
  11. ###############################################################################
  12. # Get our version number out of the CVS revision number.
  13. ###############################################################################
  14. use vars qw( $VERSION );
  15. $VERSION = do { my @r = q$Revision: 1.1 $ =~ /\d+/g; sprintf '%d.'.'%02d'x$#r, @r };
  16.  
  17. ###############################################################################
  18. # Package-wide variables.
  19. ###############################################################################
  20.     ###########################################################################
  21.     # Specifies the URN to the information about the SOAP interface for PPM.
  22.     ###########################################################################
  23. # UNFINISHED -> We need a real URN for the SOAP interface for PPM.
  24. my $SOAP_URN = 'urn:localhost';
  25.  
  26. ###############################################################################
  27. # Subroutine:   new ($server)
  28. # Parameters:   $server     - URL to SOAP server
  29. ###############################################################################
  30. # Instantiates a new SOAP client, specifying the server that will be used for
  31. # all later connections.  '$server' should be provided as the URL to the SOAP
  32. # server that we're going to connect to and make queries against.
  33. #
  34. # Note, that this method accepts both "http://" and "soap://" server URLs
  35. # exactly the same way (we treat 'soap://' URLs as standard HTTP URLs).
  36. ###############################################################################
  37. sub new
  38. {
  39.     my ($class, $server) = @_;
  40.     my $self = {};
  41.     bless $self, $class;
  42.     $server =~ s/^soap:/http:/io;
  43.     $self->{'_server'} = $server;
  44.     $self->{'_urn'} = $SOAP_URN;
  45.     return $self;
  46. }
  47.  
  48. ###############################################################################
  49. # Subroutine:   version ()
  50. ###############################################################################
  51. # Gets the version number of the SOAP server that we're connected to.  If we're
  52. # unable to contact the server or its offline, this method returns 'undef'.
  53. ###############################################################################
  54. sub version ()
  55. {
  56.     my ($self) = @_;
  57.     my @response = $self->_makeSOAPRequest( 'version' );
  58.     return 0 if (scalar @response == 0);
  59.     return $response[0];
  60. }
  61.  
  62. ###############################################################################
  63. # Subroutine:   searchAbstract ($search)
  64. # Parameters:   $search     - Term to search for
  65. # Returns:      $results    - Hash of package information for matching pkgs
  66. ###############################################################################
  67. # Searches within the 'ABSTRACT' field within all of the packages held in the
  68. # repository on the server.  The value '$search' may be a regex that will be
  69. # used to match against the abstracts.  If no value for '$search' is provided,
  70. # the server treats the search to be for '.*' (everything).
  71. ###############################################################################
  72. sub searchAbstract ($)
  73. {
  74.     my ($self, $search) = @_;
  75.     my @matches = $self->_makeSOAPRequest( 'searchAbstract',
  76.                                            'search', $search );
  77.     my %pkgs;
  78.     map { $pkgs{$_->{'NAME'}} = $_ } @matches;
  79.     return %pkgs;
  80. }
  81.  
  82. ###############################################################################
  83. # Subroutine:   searchAuthor ($search)
  84. # Parameters:   $search     - Term to search for
  85. # Returns:      $results    - Hash of package information for matching pkgs
  86. ###############################################################################
  87. # Searches within the 'AUTHOR' field within all of the packages held in the
  88. # repository on the server.  The value '$search' may be a regex that will be
  89. # used to match against the authors.  If no value of '$search' is provided, the
  90. # server treats the search to be for '.*' (everything).
  91. ###############################################################################
  92. sub searchAuthor ($)
  93. {
  94.     my ($self, $search) = @_;
  95.     my @matches = $self->_makeSOAPRequest( 'searchAuthor',
  96.                                            'search', $search );
  97.     my %pkgs;
  98.     map { $pkgs{$_->{'NAME'}} = $_ } @matches;
  99.     return %pkgs;
  100. }
  101.  
  102. ###############################################################################
  103. # Subroutine:   searchTitle ($search)
  104. # Parameters:   $search     - Term to search for
  105. # Returns:      $results    - Hash of package information for matching pkgs
  106. ###############################################################################
  107. # Searches within the 'title' field within all of the packages held in the
  108. # repository on the server.  The value '$search' may be a regex that will be
  109. # used to match against the titles.  If no value of '$search' is provided, the
  110. # server treats the search to be for '.*' (everything).
  111. ###############################################################################
  112. sub searchTitle ($)
  113. {
  114.     my ($self, $search) = @_;
  115.     my @matches = $self->_makeSOAPRequest( 'searchTitle',
  116.                                            'search', $search );
  117.     my %pkgs;
  118.     map { $pkgs{$_->{'NAME'}} = $_ } @matches;
  119.     return %pkgs;
  120. }
  121.  
  122. ###############################################################################
  123. # Subroutine:   search ($search)
  124. # Parameters:   $search     - Term to search for
  125. # Returns:      $results    - Hash of package information for matching pkgs
  126. ###############################################################################
  127. # Searches through all of the fields within all of the packages held in the
  128. # repository on the server.  The value '$search' may be a regex that will be
  129. # used to match against the field values.  If no value of '$search' is
  130. # provided, the server treats the search to be for '.*' (everything).
  131. ###############################################################################
  132. sub search ($)
  133. {
  134.     my ($self, $search) = @_;
  135.     my @matches = $self->_makeSOAPRequest( 'search', 'search', $search );
  136.     my %pkgs;
  137.     map { $pkgs{$_->{'NAME'}} = $_ } @matches;
  138.     return %pkgs;
  139. }
  140.  
  141. ###############################################################################
  142. # Subroutine:   packages ()
  143. # Returns:      @packages   - List of packages available in the repository
  144. ###############################################################################
  145. # Generates a list of all of the packages currently available in the
  146. # repository.  The value returned to the caller is a list containing the names
  147. # of all of the packages in the repository.
  148. ###############################################################################
  149. sub packages ()
  150. {
  151.     my ($self) = @_;
  152.     my @stuff  = $self->_makeSOAPRequest( 'packages' );
  153.     my @return = map { $_->{'NAME'} } @stuff;
  154.     return @return;
  155. }
  156.  
  157. ###############################################################################
  158. # Subroutine:   fetch_ppd ($pkg)
  159. # Parameters:   $pkg        - Package to get PPD file for
  160. # Returns:      $ppd        - Full contents of PPD in XML as a scalar
  161. ###############################################################################
  162. # Fetches the PPD associated with a given package.  The full contents of the
  163. # PPD are returned to the caller in XML format as a scalar value.
  164. ###############################################################################
  165. sub fetch_ppd ($)
  166. {
  167.     my ($self, $pkg) = @_;
  168.     $pkg =~ s/\.ppd$//gio;      # Strip any leftover '.ppd' extension.
  169.     my @ppd = $self->_makeSOAPRequest( 'fetch_ppd', 'package', $pkg );
  170.     return undef if (scalar @ppd == 0);
  171.     return $ppd[0];
  172. }
  173.  
  174. ###############################################################################
  175. # Subroutine:   fetch_summary ()
  176. # Returns:      $summary    - Full summary of repository in XML as a scalar
  177. ###############################################################################
  178. # Fetches the full summary of all of the packages held in the repository.  The
  179. # full contents of the summary are returned to the caller in XML format as a
  180. # scalar value.
  181. ###############################################################################
  182. sub fetch_summary ()
  183. {
  184.     my ($self) = @_;
  185.     my @response = $self->_makeSOAPRequest( 'fetch_summary' );
  186.     return undef if (scalar @response == 0);
  187.     return $response[0];
  188. }
  189.  
  190. ###############################################################################
  191. # Subroutine:   _makeSOAPRequest ($method, $search)
  192. # Returns:      @results    - List of package information
  193. ###############################################################################
  194. # INTERNAL METHOD.  Makes the SOAP request to the server, doing the bulk of the
  195. # actual work for us.
  196. ###############################################################################
  197. sub _makeSOAPRequest
  198. {
  199.     my ($self, $method, @params) = @_;
  200.  
  201.     ###########################################################################
  202.     # Build up the SOAP envelope that we're going to use.
  203.     ###########################################################################
  204.     my $soap_request = '';
  205.     my $envelope = new SOAP::EnvelopeMaker( sub { $soap_request .= shift } );
  206.  
  207.     ###########################################################################
  208.     # Set the parameters that we're going to send along in the SOAP call, and
  209.     # put them into the envelope.
  210.     ###########################################################################
  211. # UNFINISHED -> Right now we've got a placeholder in here as the
  212. #               PPM::SOAPServer module needs one to be able to parse the
  213. #               request at its end.  This will need to be fixed before final
  214. #               release.
  215.     my $fcnparms = { 'placeholder' => undef, @params };
  216.     $envelope->set_body( $self->{'_urn'}, $method, 0, $fcnparms );
  217.  
  218.     ###########################################################################
  219.     # Create a SOAP client and do the call to the SOAP server.
  220.     ###########################################################################
  221.     my $soap   = new SOAP::Transport::HTTP::Client();
  222.     my $result = $soap->send_receive(
  223.                     $self->{'_server'},
  224.                     $self->{'_urn'},
  225.                     $method,
  226.                     $soap_request );
  227.  
  228.     ###########################################################################
  229.     # Create a parser to parse the response, and yank the response apart.
  230.     ###########################################################################
  231.     my $parser = new SOAP::Parser();
  232.     my $rc     = $parser->parsestring( $result );
  233.     my $body   = $parser->get_body();
  234.  
  235.     ###########################################################################
  236.     # Take the response body that we just got back, and put it into a _list_
  237.     # instead of the hash structure that we got back.  NOTE, that this is done
  238.     # solely because SOAP/Perl does not yet support the transport of list
  239.     # values; when it does this should be changed to use the list serialization
  240.     # instead.
  241.     ###########################################################################
  242.     my $return_val  = $body->{'return'};
  243.     my $num_results = $return_val->{'num_results'};
  244.     my @results;
  245.     foreach my $idx (1 .. $num_results)
  246.     {
  247.         #######################################################################
  248.         # Get the contents of this result item.
  249.         #######################################################################
  250.         my $key = "result_$idx";
  251.         my $val = $return_val->{$key};
  252.  
  253.         #######################################################################
  254.         # Remove any SOAP fields that were used during transport.
  255.         #######################################################################
  256.         if ((ref($val) eq 'HASH') && (exists $val->{'soap_typename'}))
  257.         {
  258.             delete $val->{'soap_typename'};
  259.         }
  260.  
  261.         #######################################################################
  262.         # Add this item to our return value.
  263.         #######################################################################
  264.         push( @results, $val );
  265.     }
  266.  
  267.     ###########################################################################
  268.     # All done, return the result set to the caller.
  269.     ###########################################################################
  270.     return @results;
  271. }
  272.  
  273. 1;
  274. __END__;
  275.  
  276. ###############################################################################
  277. # POD Documentation
  278. ###############################################################################
  279.  
  280. =head1 NAME
  281.  
  282. PPM::SOAPClient - SOAP client for PPM repository
  283.  
  284. =head1 SYNOPSIS
  285.  
  286.   use PPM::SOAPClient;
  287.   ...
  288.   my $client = new PPM::SOAPClient;
  289.   my @results = $client->search( 'sarathy' );
  290.  
  291. =head1 DESCRIPTION
  292.  
  293. C<PPM::SOAPClient> implements a SOAP client to be used to access a PPM
  294. repository through a SOAP interface.  All of the functionality for making
  295. and parsing the SOAP request is handled internally; simply access the
  296. provided methods and you'll be returned a data structure containing the
  297. actual response.
  298.  
  299. =head1 METHODS
  300.  
  301. =over 4
  302.  
  303. =item new ($server)
  304.  
  305. Instantiates a new SOAP client, specifying the server that will be used for
  306. all later connections. 'C<$server>' should be provided as the URL to the
  307. SOAP server that we're going to connect to and make queries against. 
  308.  
  309. Note, that this method accepts both "http://" and "soap://" server URLs
  310. exactly the same way (we treat 'C<soap://>' URLs as standard HTTP URLs). 
  311.  
  312. =item version ()
  313.  
  314. Gets the version number of the SOAP server that we're connected to. If
  315. we're unable to contact the server or its offline, this method returns
  316. 'C<undef>'. 
  317.  
  318. =item searchAbstract ($search)
  319.  
  320. Searches within the 'C<ABSTRACT>' field within all of the packages held in
  321. the repository on the server. The value 'C<$search>' may be a regex that
  322. will be used to match against the abstracts. If no value for 'C<$search>'
  323. is provided, the server treats the search to be for 'C<.*>' (everything). 
  324.  
  325. =item searchAuthor ($search)
  326.  
  327. Searches within the 'C<AUTHOR>' field within all of the packages held in
  328. the repository on the server. The value 'C<$search>' may be a regex that
  329. will be used to match against the authors. If no value of 'C<$search>' is
  330. provided, the server treats the search to be for 'C<.*>' (everything). 
  331.  
  332. =item searchTitle ($search)
  333.  
  334. Searches within the 'C<title>' field within all of the packages held in the
  335. repository on the server. The value 'C<$search>' may be a regex that will
  336. be used to match against the titles. If no value of 'C<$search>' is
  337. provided, the server treats the search to be for 'C<.*>' (everything). 
  338.  
  339. =item search ($search)
  340.  
  341. Searches through all of the fields within all of the packages held in the
  342. repository on the server. The value 'C<$search>' may be a regex that will
  343. be used to match against the field values. If no value of 'C<$search>' is
  344. provided, the server treats the search to be for 'C<.*>' (everything). 
  345.  
  346. =item packages ()
  347.  
  348. Generates a list of all of the packages currently available in the
  349. repository. The value returned to the caller is a list containing the names
  350. of all of the packages in the repository. 
  351.  
  352. =item fetch_ppd ($pkg)
  353.  
  354. Fetches the PPD associated with a given package. The full contents of the
  355. PPD are returned to the caller in XML format as a scalar value. 
  356.  
  357. =item fetch_summary ()
  358.  
  359. Fetches the full summary of all of the packages held in the repository. The
  360. full contents of the summary are returned to the caller in XML format as a
  361. scalar value. 
  362.  
  363. =item _makeSOAPRequest ($method, $search)
  364.  
  365. B<INTERNAL METHOD.> Makes the SOAP request to the server, doing the bulk of
  366. the actual work for us. 
  367.  
  368. =back
  369.  
  370. =head1 AUTHOR
  371.  
  372. Graham TerMarsch (gtermars@home.com)
  373.  
  374. =head1 SEE ALSO
  375.  
  376. L<PPM::SOAPServer>,
  377. L<SOAP>.
  378.  
  379. =cut
  380.