| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | #!/usr/bin/perl -w | 
| 2 |  |  |  |  |  |  |  | 
| 3 |  |  |  |  |  |  | package eBay::API::XML::BaseCall; | 
| 4 |  |  |  |  |  |  |  | 
| 5 | 4 |  |  | 4 |  | 35457 | use strict; | 
|  | 4 |  |  |  |  | 8 |  | 
|  | 4 |  |  |  |  | 134 |  | 
| 6 | 4 |  |  | 4 |  | 19 | use warnings; | 
|  | 4 |  |  |  |  | 9 |  | 
|  | 4 |  |  |  |  | 124 |  | 
| 7 |  |  |  |  |  |  |  | 
| 8 |  |  |  |  |  |  | ############################################################################### | 
| 9 |  |  |  |  |  |  | # | 
| 10 |  |  |  |  |  |  | # Module: ............... eBay/API/XML | 
| 11 |  |  |  |  |  |  | # File: ................. BaseCall.pm | 
| 12 |  |  |  |  |  |  | # Original Author: ...... Milenko Milanovic | 
| 13 |  |  |  |  |  |  | # Last Modified By: ..... Robert Bradley / Jeff Nokes | 
| 14 |  |  |  |  |  |  | # Last Modified: ........ 03/06/2007 @ 16:28 | 
| 15 |  |  |  |  |  |  | # | 
| 16 |  |  |  |  |  |  | # Description: This is a super class for all eBay API calls. | 
| 17 |  |  |  |  |  |  | # | 
| 18 |  |  |  |  |  |  | #   It contains properties common for all calls. | 
| 19 |  |  |  |  |  |  | #   It assembles request based on properties set. | 
| 20 |  |  |  |  |  |  | #   It submitis the HTTP request to the API server. | 
| 21 |  |  |  |  |  |  | #   It handles call retries (if retries are enabled by a programmer). | 
| 22 |  |  |  |  |  |  | #   It parses received HTTP response. | 
| 23 |  |  |  |  |  |  | #   It handles both HTTP connection errors and API errors. | 
| 24 |  |  |  |  |  |  | # | 
| 25 |  |  |  |  |  |  | ############################################################################### | 
| 26 |  |  |  |  |  |  |  | 
| 27 |  |  |  |  |  |  | =head1 NAME | 
| 28 |  |  |  |  |  |  |  | 
| 29 |  |  |  |  |  |  | eBay::API::XML::BaseCall | 
| 30 |  |  |  |  |  |  |  | 
| 31 |  |  |  |  |  |  | =head1 INHERITANCE | 
| 32 |  |  |  |  |  |  |  | 
| 33 |  |  |  |  |  |  | eBay::API::XML::BaseCall inherits from the L class | 
| 34 |  |  |  |  |  |  |  | 
| 35 |  |  |  |  |  |  | =cut | 
| 36 |  |  |  |  |  |  |  | 
| 37 |  |  |  |  |  |  | # Need to sub the Exporter class, to use the EXPORT* arrays below. | 
| 38 | 4 |  |  | 4 |  | 17 | use Exporter; | 
|  | 4 |  |  |  |  | 7 |  | 
|  | 4 |  |  |  |  | 173 |  | 
| 39 | 4 |  |  | 4 |  | 1851 | use eBay::API::XML::BaseCallGen;   # parent class | 
|  | 0 |  |  |  |  |  |  | 
|  | 0 |  |  |  |  |  |  | 
| 40 |  |  |  |  |  |  | our @ISA = ('Exporter' | 
| 41 |  |  |  |  |  |  | ,'eBay::API::XML::BaseCallGen');  # Parent class | 
| 42 |  |  |  |  |  |  |  | 
| 43 |  |  |  |  |  |  | use LWP::UserAgent; | 
| 44 |  |  |  |  |  |  | use HTTP::Request; | 
| 45 |  |  |  |  |  |  | use HTTP::Headers; | 
| 46 |  |  |  |  |  |  | #use XML::Simple qw(:strict); | 
| 47 |  |  |  |  |  |  | #  Do not use XML::Simple 'strict' mode because if you use it, | 
| 48 |  |  |  |  |  |  | #  it gets global for the | 
| 49 |  |  |  |  |  |  | #  whole application within apache. Most often we do not use | 
| 50 |  |  |  |  |  |  | #    forcearray and keyattr attributes in XML::Simple | 
| 51 |  |  |  |  |  |  | #           $rhXmlSimple = XMLin ( $sRawXml | 
| 52 |  |  |  |  |  |  | #	                  , forcearray => [] | 
| 53 |  |  |  |  |  |  | #	  	          , keyattr => [] | 
| 54 |  |  |  |  |  |  | #	           ); | 
| 55 |  |  |  |  |  |  | use XML::Simple; | 
| 56 |  |  |  |  |  |  | use Data::Dumper; | 
| 57 |  |  |  |  |  |  | use Time::HiRes qw(sleep); | 
| 58 |  |  |  |  |  |  | use Compress::Zlib; | 
| 59 |  |  |  |  |  |  | use XML::Tidy; | 
| 60 |  |  |  |  |  |  |  | 
| 61 |  |  |  |  |  |  | use eBay::API; | 
| 62 |  |  |  |  |  |  | use eBay::API::XML::DataType::XMLRequesterCredentialsType; | 
| 63 |  |  |  |  |  |  | use eBay::API::XML::DataType::ErrorType; | 
| 64 |  |  |  |  |  |  | use eBay::API::XML::DataType::Enum::SeverityCodeType; | 
| 65 |  |  |  |  |  |  | use eBay::API::XML::DataType::Enum::ErrorClassificationCodeType; | 
| 66 |  |  |  |  |  |  |  | 
| 67 |  |  |  |  |  |  | # Variable Declarations | 
| 68 |  |  |  |  |  |  | # # ----------------------------------------------------------------------- | 
| 69 |  |  |  |  |  |  | # # Constants | 
| 70 |  |  |  |  |  |  | # | 
| 71 |  |  |  |  |  |  |  | 
| 72 |  |  |  |  |  |  | use constant _TRUE_  => scalar 1; | 
| 73 |  |  |  |  |  |  | use constant _FALSE_ => scalar 0; | 
| 74 |  |  |  |  |  |  |  | 
| 75 |  |  |  |  |  |  | use constant HTTP_ERRORCODE_PREFIX => scalar 'HTTP';                 #API001 | 
| 76 |  |  |  |  |  |  | use constant XML_PARSE_ERROR       => scalar 'XML_PARSE_ERROR';      #API004 | 
| 77 |  |  |  |  |  |  | use constant NO_RESPONSE_CONTENT    => scalar 'NO_RESPONSE_CONTENT';   # API002 | 
| 78 |  |  |  |  |  |  | use constant BAD_API_GATAWAY        => scalar 'BAD_API_GATAWAY';       # API003 | 
| 79 |  |  |  |  |  |  | use constant XML_PARSE_RESULT_EMPTY => scalar 'XML_PARSE_RESULT_EMPTY';# API005 | 
| 80 |  |  |  |  |  |  |  | 
| 81 |  |  |  |  |  |  | use constant XML_OLD_TYPE_RESPONSE => scalar 'XML_OLD_TYPE_RESPONSE'; | 
| 82 |  |  |  |  |  |  |  | 
| 83 |  |  |  |  |  |  | =head1 Methods | 
| 84 |  |  |  |  |  |  |  | 
| 85 |  |  |  |  |  |  | =head2 new() | 
| 86 |  |  |  |  |  |  |  | 
| 87 |  |  |  |  |  |  | See the parent constructor for detailed docs about object instantiation | 
| 88 |  |  |  |  |  |  |  | 
| 89 |  |  |  |  |  |  | =cut | 
| 90 |  |  |  |  |  |  |  | 
| 91 |  |  |  |  |  |  | sub new($;$;) { | 
| 92 |  |  |  |  |  |  |  | 
| 93 |  |  |  |  |  |  | my $classname = shift; | 
| 94 |  |  |  |  |  |  | my $arg_hash = shift; | 
| 95 |  |  |  |  |  |  | my $self = $classname->SUPER::new($arg_hash); | 
| 96 |  |  |  |  |  |  |  | 
| 97 |  |  |  |  |  |  | # this allow me to introduce a "reset" method | 
| 98 |  |  |  |  |  |  | #  which will allow as to reuse a call instance | 
| 99 |  |  |  |  |  |  | $self->_init(); | 
| 100 |  |  |  |  |  |  |  | 
| 101 |  |  |  |  |  |  | return $self; | 
| 102 |  |  |  |  |  |  | } | 
| 103 |  |  |  |  |  |  |  | 
| 104 |  |  |  |  |  |  | sub _init { | 
| 105 |  |  |  |  |  |  |  | 
| 106 |  |  |  |  |  |  | my $self = shift; | 
| 107 |  |  |  |  |  |  |  | 
| 108 |  |  |  |  |  |  | $self->{'pRequest'}  = undef; | 
| 109 |  |  |  |  |  |  | $self->{'pResponse'} = undef; | 
| 110 |  |  |  |  |  |  |  | 
| 111 |  |  |  |  |  |  | $self->{'pHttpResponse'}      = undef; | 
| 112 |  |  |  |  |  |  | $self->{'isResponseValidXml'} = undef; | 
| 113 |  |  |  |  |  |  | $self->{'rhXmlSimple'}        = undef; | 
| 114 |  |  |  |  |  |  | # if externalySetRequestXml is defined | 
| 115 |  |  |  |  |  |  | #    then use it to submit the call | 
| 116 |  |  |  |  |  |  | $self->{'externalySetRequestXml'} = undef; | 
| 117 |  |  |  |  |  |  | # if 'hasForcedError' is set then do not execute the call | 
| 118 |  |  |  |  |  |  | #   just return the error set with 'forcedError' method | 
| 119 |  |  |  |  |  |  | $self->{'hasForcedError'} = undef; | 
| 120 |  |  |  |  |  |  |  | 
| 121 |  |  |  |  |  |  |  | 
| 122 |  |  |  |  |  |  | $self->_initRequest(); | 
| 123 |  |  |  |  |  |  | $self->_initResponse(); | 
| 124 |  |  |  |  |  |  | } | 
| 125 |  |  |  |  |  |  |  | 
| 126 |  |  |  |  |  |  | =head2 reset() | 
| 127 |  |  |  |  |  |  |  | 
| 128 |  |  |  |  |  |  | Use 'reset' method in cases when you want to reuse a Call instance | 
| 129 |  |  |  |  |  |  |  | 
| 130 |  |  |  |  |  |  | =cut | 
| 131 |  |  |  |  |  |  |  | 
| 132 |  |  |  |  |  |  | sub reset { | 
| 133 |  |  |  |  |  |  | my $self = shift; | 
| 134 |  |  |  |  |  |  | $self->_init(); | 
| 135 |  |  |  |  |  |  | } | 
| 136 |  |  |  |  |  |  |  | 
| 137 |  |  |  |  |  |  |  | 
| 138 |  |  |  |  |  |  | =head2 execute() | 
| 139 |  |  |  |  |  |  |  | 
| 140 |  |  |  |  |  |  | Executes the current API call | 
| 141 |  |  |  |  |  |  |  | 
| 142 |  |  |  |  |  |  | =cut | 
| 143 |  |  |  |  |  |  |  | 
| 144 |  |  |  |  |  |  | sub execute { | 
| 145 |  |  |  |  |  |  |  | 
| 146 |  |  |  |  |  |  | my $self = shift; | 
| 147 |  |  |  |  |  |  |  | 
| 148 |  |  |  |  |  |  | # | 
| 149 |  |  |  |  |  |  | #  1. create HTTP::Request | 
| 150 |  |  |  |  |  |  | my $objRequest = $self->_getHttpRequestObject(); | 
| 151 |  |  |  |  |  |  |  | 
| 152 |  |  |  |  |  |  | # | 
| 153 |  |  |  |  |  |  | #  2. create UserAgent | 
| 154 |  |  |  |  |  |  | my $objUserAgent = LWP::UserAgent->new(); | 
| 155 |  |  |  |  |  |  |  | 
| 156 |  |  |  |  |  |  | # Purposely overwrite the UserAgent property, with one identifying | 
| 157 |  |  |  |  |  |  | # eBay Perl SDK. | 
| 158 |  |  |  |  |  |  | $objUserAgent->agent( | 
| 159 |  |  |  |  |  |  | $objUserAgent->agent . ' / ' . | 
| 160 |  |  |  |  |  |  | 'eBay API Perl SDK (Version: ' . $eBay::API::VERSION . ')' | 
| 161 |  |  |  |  |  |  | ); | 
| 162 |  |  |  |  |  |  |  | 
| 163 |  |  |  |  |  |  | # timeout in seconds | 
| 164 |  |  |  |  |  |  | my $timeout = $self->getTimeout(); | 
| 165 |  |  |  |  |  |  | if ( defined $timeout ) { | 
| 166 |  |  |  |  |  |  | $objUserAgent->timeout($timeout); | 
| 167 |  |  |  |  |  |  | } | 
| 168 |  |  |  |  |  |  |  | 
| 169 |  |  |  |  |  |  | $self->_submitHttpRequest( $objUserAgent, $objRequest ); | 
| 170 |  |  |  |  |  |  |  | 
| 171 |  |  |  |  |  |  | } | 
| 172 |  |  |  |  |  |  |  | 
| 173 |  |  |  |  |  |  | sub _getHttpRequestObject { | 
| 174 |  |  |  |  |  |  |  | 
| 175 |  |  |  |  |  |  | my $self = shift; | 
| 176 |  |  |  |  |  |  |  | 
| 177 |  |  |  |  |  |  | # 1. what URL the call will be submitted to | 
| 178 |  |  |  |  |  |  | my $sApiUrl = $self->getApiUrl(); | 
| 179 |  |  |  |  |  |  | # | 
| 180 |  |  |  |  |  |  | #  2. create HTTP::Request object and fill it with all parameters | 
| 181 |  |  |  |  |  |  | my $objHeader = $self->_getRequestHeader(); | 
| 182 |  |  |  |  |  |  |  | 
| 183 |  |  |  |  |  |  | #  3. get XML string that will be sent to the URL | 
| 184 |  |  |  |  |  |  | my $requestRawXml = $self->getRequestRawXml(); | 
| 185 |  |  |  |  |  |  |  | 
| 186 |  |  |  |  |  |  | #  4. create request that will be submitted to the URL | 
| 187 |  |  |  |  |  |  | my $objRequest = | 
| 188 |  |  |  |  |  |  | HTTP::Request->new("POST" | 
| 189 |  |  |  |  |  |  | , $sApiUrl | 
| 190 |  |  |  |  |  |  | , $objHeader, $requestRawXml); | 
| 191 |  |  |  |  |  |  |  | 
| 192 |  |  |  |  |  |  | return $objRequest; | 
| 193 |  |  |  |  |  |  | } | 
| 194 |  |  |  |  |  |  |  | 
| 195 |  |  |  |  |  |  | =head2 getHttpRequestAsString() | 
| 196 |  |  |  |  |  |  |  | 
| 197 |  |  |  |  |  |  | Arguments: 1 [O] - isPrettyPrint - if set then XML is pretty printed | 
| 198 |  |  |  |  |  |  |  | 
| 199 |  |  |  |  |  |  | Returns: string | 
| 200 |  |  |  |  |  |  | Method returning a textual representation of the request | 
| 201 |  |  |  |  |  |  | (request type, url, query string, header and content). | 
| 202 |  |  |  |  |  |  |  | 
| 203 |  |  |  |  |  |  | =cut | 
| 204 |  |  |  |  |  |  |  | 
| 205 |  |  |  |  |  |  | sub getHttpRequestAsString { | 
| 206 |  |  |  |  |  |  | my $self = shift; | 
| 207 |  |  |  |  |  |  | my $isPrettyPrint = shift || 0; | 
| 208 |  |  |  |  |  |  |  | 
| 209 |  |  |  |  |  |  | my $pHttpRequest = $self->_getHttpRequestObject(); | 
| 210 |  |  |  |  |  |  |  | 
| 211 |  |  |  |  |  |  | my $str = undef; | 
| 212 |  |  |  |  |  |  | if ( $isPrettyPrint ) { | 
| 213 |  |  |  |  |  |  | $str = $self->_prettyPrintFormat( $pHttpRequest ); | 
| 214 |  |  |  |  |  |  | } else { | 
| 215 |  |  |  |  |  |  | $str = $pHttpRequest->as_string(); | 
| 216 |  |  |  |  |  |  | } | 
| 217 |  |  |  |  |  |  | return $str; | 
| 218 |  |  |  |  |  |  | } | 
| 219 |  |  |  |  |  |  |  | 
| 220 |  |  |  |  |  |  | sub _submitHttpRequest($$$;) { | 
| 221 |  |  |  |  |  |  |  | 
| 222 |  |  |  |  |  |  | my $self         = shift; | 
| 223 |  |  |  |  |  |  | my $objUserAgent = shift; | 
| 224 |  |  |  |  |  |  | my $objRequest   = shift; | 
| 225 |  |  |  |  |  |  |  | 
| 226 |  |  |  |  |  |  | ### | 
| 227 |  |  |  |  |  |  | # | 
| 228 |  |  |  |  |  |  | #  We use this complex LOOP IN ORDER TO BE ABLE TO HANDLE RETRIES | 
| 229 |  |  |  |  |  |  | # | 
| 230 |  |  |  |  |  |  | ### | 
| 231 |  |  |  |  |  |  |  | 
| 232 |  |  |  |  |  |  | my $maxNumberOfTries = 1; | 
| 233 |  |  |  |  |  |  | my $pCallRetry = $self->getCallRetry(); | 
| 234 |  |  |  |  |  |  | if ( defined $pCallRetry ) { | 
| 235 |  |  |  |  |  |  | $maxNumberOfTries =  $pCallRetry->getMaximumRetries() + 1; | 
| 236 |  |  |  |  |  |  | } | 
| 237 |  |  |  |  |  |  |  | 
| 238 |  |  |  |  |  |  | my $currentTry = 0; | 
| 239 |  |  |  |  |  |  | my $exitLoop = _FALSE_; | 
| 240 |  |  |  |  |  |  |  | 
| 241 |  |  |  |  |  |  | # | 
| 242 |  |  |  |  |  |  | # If forced error is set, do not execute the call. See 'forceError' method. | 
| 243 |  |  |  |  |  |  | # This is used only for test purposes. | 
| 244 |  |  |  |  |  |  | # | 
| 245 |  |  |  |  |  |  | if ( $self->hasForcedError() ) { | 
| 246 |  |  |  |  |  |  | $self->logMessage(eBay::API::BaseApi::LOG_DEBUG | 
| 247 |  |  |  |  |  |  | ,"Error forced, request has not been sent to the API server\n"); | 
| 248 |  |  |  |  |  |  | return; | 
| 249 |  |  |  |  |  |  | } | 
| 250 |  |  |  |  |  |  |  | 
| 251 |  |  |  |  |  |  | while ( ! $exitLoop ) {   ## START retry LOOP | 
| 252 |  |  |  |  |  |  |  | 
| 253 |  |  |  |  |  |  | #  1. send request to the URL ( API server ) | 
| 254 |  |  |  |  |  |  | my $objHttpResponse = $objUserAgent->request($objRequest); | 
| 255 |  |  |  |  |  |  |  | 
| 256 |  |  |  |  |  |  | #  2.  process response | 
| 257 |  |  |  |  |  |  | $self->processResponse ( $objHttpResponse ); | 
| 258 |  |  |  |  |  |  |  | 
| 259 |  |  |  |  |  |  | #  3. check whether we should retry the call | 
| 260 |  |  |  |  |  |  | # Exit loop if | 
| 261 |  |  |  |  |  |  | #    a) maxNumberOfTries has been reached | 
| 262 |  |  |  |  |  |  | #         - meaning that all tries failed | 
| 263 |  |  |  |  |  |  | #    b) pCallRetry is not defined | 
| 264 |  |  |  |  |  |  | #         - meaning that call is supposed to be execute only once | 
| 265 |  |  |  |  |  |  |  | 
| 266 |  |  |  |  |  |  | $currentTry++; | 
| 267 |  |  |  |  |  |  |  | 
| 268 |  |  |  |  |  |  | if ( ($currentTry >= $maxNumberOfTries) | 
| 269 |  |  |  |  |  |  | || (! $self->hasErrors() && ! $self->hasWarnings()) | 
| 270 |  |  |  |  |  |  | || (! defined $pCallRetry) ) { | 
| 271 |  |  |  |  |  |  |  | 
| 272 |  |  |  |  |  |  | $exitLoop = _TRUE_; | 
| 273 |  |  |  |  |  |  | } else { | 
| 274 |  |  |  |  |  |  |  | 
| 275 |  |  |  |  |  |  | my $shouldRetry = $pCallRetry->shouldRetry( | 
| 276 |  |  |  |  |  |  | # ref to an array of ErrorDataType objects | 
| 277 |  |  |  |  |  |  | #  check out both, errors and warnings | 
| 278 |  |  |  |  |  |  | 'raErrors' => $self->getErrorsAndWarnings() | 
| 279 |  |  |  |  |  |  | ); | 
| 280 |  |  |  |  |  |  |  | 
| 281 |  |  |  |  |  |  | if ( $shouldRetry ) { | 
| 282 |  |  |  |  |  |  |  | 
| 283 |  |  |  |  |  |  | my $pause = $pCallRetry->getDelayTime(); | 
| 284 |  |  |  |  |  |  | sleep $pause/1000;   ## Time::HiRes sleep  in miliseconds | 
| 285 |  |  |  |  |  |  |  | 
| 286 |  |  |  |  |  |  | $exitLoop = _FALSE_; | 
| 287 |  |  |  |  |  |  |  | 
| 288 |  |  |  |  |  |  | $pCallRetry->incNumberOfRetries(); | 
| 289 |  |  |  |  |  |  | } else { | 
| 290 |  |  |  |  |  |  | $exitLoop = _TRUE_; | 
| 291 |  |  |  |  |  |  | } | 
| 292 |  |  |  |  |  |  | } | 
| 293 |  |  |  |  |  |  | }   ## END retry LOOP | 
| 294 |  |  |  |  |  |  | } | 
| 295 |  |  |  |  |  |  |  | 
| 296 |  |  |  |  |  |  | sub _getRequestHeader { | 
| 297 |  |  |  |  |  |  |  | 
| 298 |  |  |  |  |  |  | my $self = shift; | 
| 299 |  |  |  |  |  |  | my $sCallName = $self->getApiCallName(); | 
| 300 |  |  |  |  |  |  | if ( ! defined $sCallName ) { | 
| 301 |  |  |  |  |  |  | print "\nAPI call not set!!!\n"; | 
| 302 |  |  |  |  |  |  | print "'GetApiCallName' method must be implemented in " | 
| 303 |  |  |  |  |  |  | . ref($self) . ".pm!\n\n"; | 
| 304 |  |  |  |  |  |  | return; | 
| 305 |  |  |  |  |  |  | } | 
| 306 |  |  |  |  |  |  |  | 
| 307 |  |  |  |  |  |  | # common call properties | 
| 308 |  |  |  |  |  |  | my $sSiteId   = $self->getSiteID(); | 
| 309 |  |  |  |  |  |  |  | 
| 310 |  |  |  |  |  |  | my $sClLevel  = $self->getCompatibilityLevel(); | 
| 311 |  |  |  |  |  |  | my $sDevName  = $self->getDevID(); | 
| 312 |  |  |  |  |  |  | my $sAppName  = $self->getAppID(); | 
| 313 |  |  |  |  |  |  | my $sCertName = $self->getCertID(); | 
| 314 |  |  |  |  |  |  |  | 
| 315 |  |  |  |  |  |  |  | 
| 316 |  |  |  |  |  |  | # | 
| 317 |  |  |  |  |  |  | #  set header values | 
| 318 |  |  |  |  |  |  | my $objHeader = HTTP::Headers->new(); | 
| 319 |  |  |  |  |  |  |  | 
| 320 |  |  |  |  |  |  | $objHeader->push_header('X-EBAY-API-COMPATIBILITY-LEVEL' => $sClLevel); | 
| 321 |  |  |  |  |  |  | $objHeader->push_header('X-EBAY-API-SESSION-CERTIFICATE' => | 
| 322 |  |  |  |  |  |  | "$sDevName;$sAppName;$sCertName"); | 
| 323 |  |  |  |  |  |  | $objHeader->push_header('X-EBAY-API-DEV-NAME' => $sDevName); | 
| 324 |  |  |  |  |  |  | $objHeader->push_header('X-EBAY-API-APP-NAME' => $sAppName); | 
| 325 |  |  |  |  |  |  | $objHeader->push_header('X-EBAY-API-CERT-NAME' => $sCertName); | 
| 326 |  |  |  |  |  |  | $objHeader->push_header('X-EBAY-API-CALL-NAME' => $sCallName); | 
| 327 |  |  |  |  |  |  | $objHeader->push_header('X-EBAY-API-SITEID' => $sSiteId); | 
| 328 |  |  |  |  |  |  | $objHeader->push_header('Content-Type' => 'text/xml'); | 
| 329 |  |  |  |  |  |  | if ($self->isCompression()) { | 
| 330 |  |  |  |  |  |  | $objHeader->push_header('Accept-Encoding' => 'gzip'); | 
| 331 |  |  |  |  |  |  | } | 
| 332 |  |  |  |  |  |  |  | 
| 333 |  |  |  |  |  |  | return $objHeader; | 
| 334 |  |  |  |  |  |  | } | 
| 335 |  |  |  |  |  |  |  | 
| 336 |  |  |  |  |  |  | sub _setRequestDataType { | 
| 337 |  |  |  |  |  |  | my $self = shift; | 
| 338 |  |  |  |  |  |  | $self->{'pRequest'} = shift; | 
| 339 |  |  |  |  |  |  | } | 
| 340 |  |  |  |  |  |  |  | 
| 341 |  |  |  |  |  |  | =head2 getRequestDataType() | 
| 342 |  |  |  |  |  |  |  | 
| 343 |  |  |  |  |  |  | Returns the RequestDataType object, | 
| 344 |  |  |  |  |  |  |  | 
| 345 |  |  |  |  |  |  | =cut | 
| 346 |  |  |  |  |  |  |  | 
| 347 |  |  |  |  |  |  | sub getRequestDataType { | 
| 348 |  |  |  |  |  |  | my $self = shift; | 
| 349 |  |  |  |  |  |  | return $self->{'pRequest'}; | 
| 350 |  |  |  |  |  |  | } | 
| 351 |  |  |  |  |  |  |  | 
| 352 |  |  |  |  |  |  | sub _setResponseDataType { | 
| 353 |  |  |  |  |  |  | my $self = shift; | 
| 354 |  |  |  |  |  |  | $self->{'pResponse'} = shift; | 
| 355 |  |  |  |  |  |  | } | 
| 356 |  |  |  |  |  |  |  | 
| 357 |  |  |  |  |  |  | =head2 getResponseDataType() | 
| 358 |  |  |  |  |  |  |  | 
| 359 |  |  |  |  |  |  | Returnst the ResponseDataType object | 
| 360 |  |  |  |  |  |  | =cut | 
| 361 |  |  |  |  |  |  |  | 
| 362 |  |  |  |  |  |  | sub getResponseDataType { | 
| 363 |  |  |  |  |  |  | my $self = shift; | 
| 364 |  |  |  |  |  |  | return $self->{'pResponse'}; | 
| 365 |  |  |  |  |  |  | } | 
| 366 |  |  |  |  |  |  |  | 
| 367 |  |  |  |  |  |  | sub _setHttpResponseObject { | 
| 368 |  |  |  |  |  |  | my $self = shift; | 
| 369 |  |  |  |  |  |  | $self->{'pHttpResponse'} = shift; | 
| 370 |  |  |  |  |  |  | } | 
| 371 |  |  |  |  |  |  |  | 
| 372 |  |  |  |  |  |  | sub _getHttpResponseObject { | 
| 373 |  |  |  |  |  |  | my $self = shift; | 
| 374 |  |  |  |  |  |  | return $self->{'pHttpResponse'}; | 
| 375 |  |  |  |  |  |  | } | 
| 376 |  |  |  |  |  |  |  | 
| 377 |  |  |  |  |  |  | =head2 isHttpRequestSubmitted() | 
| 378 |  |  |  |  |  |  |  | 
| 379 |  |  |  |  |  |  | Tells to a programmer whether a request has been submitted or not. | 
| 380 |  |  |  |  |  |  | This method is mainly used in Session in sequential mode. | 
| 381 |  |  |  |  |  |  |  | 
| 382 |  |  |  |  |  |  | =cut | 
| 383 |  |  |  |  |  |  |  | 
| 384 |  |  |  |  |  |  | sub isHttpRequestSubmitted { | 
| 385 |  |  |  |  |  |  | my $self = shift; | 
| 386 |  |  |  |  |  |  | my $objHttpResponse = $self->_getHttpResponseObject(); | 
| 387 |  |  |  |  |  |  | if ( defined $objHttpResponse ) { | 
| 388 |  |  |  |  |  |  | return 1; | 
| 389 |  |  |  |  |  |  | } | 
| 390 |  |  |  |  |  |  | return 0; | 
| 391 |  |  |  |  |  |  | } | 
| 392 |  |  |  |  |  |  |  | 
| 393 |  |  |  |  |  |  | =head2 getHttpResponseAsString() | 
| 394 |  |  |  |  |  |  |  | 
| 395 |  |  |  |  |  |  | Method returning a textual representation of the response | 
| 396 |  |  |  |  |  |  |  | 
| 397 |  |  |  |  |  |  | Arguments: 1 [O] - isPrettyPrint - if set then XML is pretty printed | 
| 398 |  |  |  |  |  |  | Returns: string | 
| 399 |  |  |  |  |  |  |  | 
| 400 |  |  |  |  |  |  | =cut | 
| 401 |  |  |  |  |  |  |  | 
| 402 |  |  |  |  |  |  | sub getHttpResponseAsString { | 
| 403 |  |  |  |  |  |  |  | 
| 404 |  |  |  |  |  |  | my $self = shift; | 
| 405 |  |  |  |  |  |  | my $isPrettyPrint = shift || 0; | 
| 406 |  |  |  |  |  |  |  | 
| 407 |  |  |  |  |  |  | my $objHttpResponse = $self->_getHttpResponseObject(); | 
| 408 |  |  |  |  |  |  |  | 
| 409 |  |  |  |  |  |  | my $str = undef; | 
| 410 |  |  |  |  |  |  | if ( defined $objHttpResponse ) { | 
| 411 |  |  |  |  |  |  | if ( $isPrettyPrint ) { | 
| 412 |  |  |  |  |  |  | $str = $self->_prettyPrintFormat( $objHttpResponse ); | 
| 413 |  |  |  |  |  |  | } else { | 
| 414 |  |  |  |  |  |  | $str = $objHttpResponse->as_string(); | 
| 415 |  |  |  |  |  |  | } | 
| 416 |  |  |  |  |  |  | } else { | 
| 417 |  |  |  |  |  |  | $str = "HttpResponseAsString is not available since the API call " . | 
| 418 |  |  |  |  |  |  | "has not been executed yet!"; | 
| 419 |  |  |  |  |  |  | if ($self->hasForcedError()) { | 
| 420 |  |  |  |  |  |  | $str .= "\nError forced, request has not been sent to the API server."; | 
| 421 |  |  |  |  |  |  | } | 
| 422 |  |  |  |  |  |  | } | 
| 423 |  |  |  |  |  |  | return $str; | 
| 424 |  |  |  |  |  |  | } | 
| 425 |  |  |  |  |  |  |  | 
| 426 |  |  |  |  |  |  | =head2 getResponseRawXml() | 
| 427 |  |  |  |  |  |  |  | 
| 428 |  |  |  |  |  |  | Method returning the raw XML reponse | 
| 429 |  |  |  |  |  |  |  | 
| 430 |  |  |  |  |  |  | =cut | 
| 431 |  |  |  |  |  |  |  | 
| 432 |  |  |  |  |  |  | sub getResponseRawXml { | 
| 433 |  |  |  |  |  |  | my $self = shift; | 
| 434 |  |  |  |  |  |  | my $pHttpResponse = $self->_getHttpResponseObject(); | 
| 435 |  |  |  |  |  |  |  | 
| 436 |  |  |  |  |  |  | my $str = ''; | 
| 437 |  |  |  |  |  |  | if ( defined $pHttpResponse ) { | 
| 438 |  |  |  |  |  |  | $str = $pHttpResponse->content(); | 
| 439 |  |  |  |  |  |  | my $contentEncoding = $pHttpResponse->content_encoding; | 
| 440 |  |  |  |  |  |  | if ( defined $contentEncoding && $contentEncoding =~ /gzip/i) { | 
| 441 |  |  |  |  |  |  | $str = Compress::Zlib::memGunzip($str); | 
| 442 |  |  |  |  |  |  | } | 
| 443 |  |  |  |  |  |  | } | 
| 444 |  |  |  |  |  |  | return $str; | 
| 445 |  |  |  |  |  |  | } | 
| 446 |  |  |  |  |  |  |  | 
| 447 |  |  |  |  |  |  | sub _setXmlSimpleDataStructure { | 
| 448 |  |  |  |  |  |  | my $self = shift; | 
| 449 |  |  |  |  |  |  | $self->{'rhXmlSimple'} = shift; | 
| 450 |  |  |  |  |  |  | } | 
| 451 |  |  |  |  |  |  |  | 
| 452 |  |  |  |  |  |  | =head2 getXmlSimpleDataStructure() | 
| 453 |  |  |  |  |  |  |  | 
| 454 |  |  |  |  |  |  | Returns XML::Simple data structure for a given path. | 
| 455 |  |  |  |  |  |  | Path is defined as a reference to an array of node names, starting with | 
| 456 |  |  |  |  |  |  | the top level node and ending with lowest level node. | 
| 457 |  |  |  |  |  |  |  | 
| 458 |  |  |  |  |  |  | Path IS NOT an XPATH string!!!! | 
| 459 |  |  |  |  |  |  |  | 
| 460 |  |  |  |  |  |  | Path examples for VerifyAddItem call: | 
| 461 |  |  |  |  |  |  |  | 
| 462 |  |  |  |  |  |  | @path = ( 'Fees','Fee' );   # Returns fees as an XML::Simple data structure | 
| 463 |  |  |  |  |  |  | @path = ( 'Errors' );       # Returns Response errors as an XML::Simple | 
| 464 |  |  |  |  |  |  | #    data structure | 
| 465 |  |  |  |  |  |  | @path = ( 'Errors-xxxx' );  # Will not find anything | 
| 466 |  |  |  |  |  |  |  | 
| 467 |  |  |  |  |  |  | Notice that root node is not being specified. The reason for that is that | 
| 468 |  |  |  |  |  |  | we XML::Simple is configured not to put root node into its data structure | 
| 469 |  |  |  |  |  |  | (that is a default behaviour for XML::Simple). | 
| 470 |  |  |  |  |  |  |  | 
| 471 |  |  |  |  |  |  | If path is not submitted return the whole XML::Simple data structure | 
| 472 |  |  |  |  |  |  |  | 
| 473 |  |  |  |  |  |  | =cut | 
| 474 |  |  |  |  |  |  |  | 
| 475 |  |  |  |  |  |  | sub getXmlSimpleDataStructure { | 
| 476 |  |  |  |  |  |  | my $self   = shift; | 
| 477 |  |  |  |  |  |  | my $raPath = shift; | 
| 478 |  |  |  |  |  |  |  | 
| 479 |  |  |  |  |  |  | my $rhXmlSimple = $self->{'rhXmlSimple'}; | 
| 480 |  |  |  |  |  |  | if ( ! defined $raPath ) { | 
| 481 |  |  |  |  |  |  | return $rhXmlSimple; | 
| 482 |  |  |  |  |  |  | } | 
| 483 |  |  |  |  |  |  |  | 
| 484 |  |  |  |  |  |  | my $rhNode = $rhXmlSimple; | 
| 485 |  |  |  |  |  |  | foreach my $key (@$raPath) { | 
| 486 |  |  |  |  |  |  | $rhNode = $rhNode->{$key}; | 
| 487 |  |  |  |  |  |  | if ( ! defined $rhNode ) { | 
| 488 |  |  |  |  |  |  | last; | 
| 489 |  |  |  |  |  |  | } | 
| 490 |  |  |  |  |  |  | } | 
| 491 |  |  |  |  |  |  |  | 
| 492 |  |  |  |  |  |  | return $rhNode; | 
| 493 |  |  |  |  |  |  | } | 
| 494 |  |  |  |  |  |  |  | 
| 495 |  |  |  |  |  |  | # _setResponseValidXml() | 
| 496 |  |  |  |  |  |  | # Sets whether a response is a valid XML document or not. | 
| 497 |  |  |  |  |  |  |  | 
| 498 |  |  |  |  |  |  | sub _setResponseValidXml { | 
| 499 |  |  |  |  |  |  | my $self = shift; | 
| 500 |  |  |  |  |  |  | $self->{'isResponseValidXml'} = shift; | 
| 501 |  |  |  |  |  |  | } | 
| 502 |  |  |  |  |  |  |  | 
| 503 |  |  |  |  |  |  | =head2 isResponseValidXml() | 
| 504 |  |  |  |  |  |  |  | 
| 505 |  |  |  |  |  |  | Access: public | 
| 506 |  |  |  |  |  |  | Returns: true (1) if a response is a valid XML document or not. | 
| 507 |  |  |  |  |  |  | false (0) if a response is NOT a valid XML document or not. | 
| 508 |  |  |  |  |  |  | Note: | 
| 509 |  |  |  |  |  |  | It allows us to differentiate cases the following cases: | 
| 510 |  |  |  |  |  |  | a) Response is a valid XML with API errors | 
| 511 |  |  |  |  |  |  | b) Response is not a valid XML document at all | 
| 512 |  |  |  |  |  |  | or HTTP connection failed. | 
| 513 |  |  |  |  |  |  | Most likely it should not be used a lot. | 
| 514 |  |  |  |  |  |  |  | 
| 515 |  |  |  |  |  |  | =cut | 
| 516 |  |  |  |  |  |  |  | 
| 517 |  |  |  |  |  |  | sub isResponseValidXml { | 
| 518 |  |  |  |  |  |  | my $self = shift; | 
| 519 |  |  |  |  |  |  |  | 
| 520 |  |  |  |  |  |  | my $value = $self->{'isResponseValidXml'}; | 
| 521 |  |  |  |  |  |  | if ( defined $value && $value == 1 ) { | 
| 522 |  |  |  |  |  |  | return _TRUE_; | 
| 523 |  |  |  |  |  |  | } | 
| 524 |  |  |  |  |  |  | return _FALSE_; | 
| 525 |  |  |  |  |  |  | } | 
| 526 |  |  |  |  |  |  |  | 
| 527 |  |  |  |  |  |  | sub _addError { | 
| 528 |  |  |  |  |  |  | my $self = shift; | 
| 529 |  |  |  |  |  |  | my $pError = shift; | 
| 530 |  |  |  |  |  |  |  | 
| 531 |  |  |  |  |  |  | my $pResponse = $self->getResponseDataType(); | 
| 532 |  |  |  |  |  |  | my $raErrors = $pResponse->getErrors(); | 
| 533 |  |  |  |  |  |  |  | 
| 534 |  |  |  |  |  |  | if ( ! defined $raErrors ) { | 
| 535 |  |  |  |  |  |  | $raErrors = []; | 
| 536 |  |  |  |  |  |  | } | 
| 537 |  |  |  |  |  |  | push @$raErrors, $pError; | 
| 538 |  |  |  |  |  |  | $pResponse->setErrors( $raErrors ); | 
| 539 |  |  |  |  |  |  | } | 
| 540 |  |  |  |  |  |  |  | 
| 541 |  |  |  |  |  |  | =head2 hasErrors() | 
| 542 |  |  |  |  |  |  |  | 
| 543 |  |  |  |  |  |  | If an API call return errors (API, HTTP connection or XML parsing errors) | 
| 544 |  |  |  |  |  |  | the application should stop normal processing and return a "system error" | 
| 545 |  |  |  |  |  |  | message to an application user. The only things that it makes sense to read | 
| 546 |  |  |  |  |  |  | from ResponseDataType objects are: errors and rawResponse (which in this case | 
| 547 |  |  |  |  |  |  | might not even be a valid XML document). | 
| 548 |  |  |  |  |  |  |  | 
| 549 |  |  |  |  |  |  | =cut | 
| 550 |  |  |  |  |  |  |  | 
| 551 |  |  |  |  |  |  | sub hasErrors { | 
| 552 |  |  |  |  |  |  | my $self = shift; | 
| 553 |  |  |  |  |  |  | return $self->_hasErrorsForSeverityCode( | 
| 554 |  |  |  |  |  |  | eBay::API::XML::DataType::Enum::SeverityCodeType::Error); | 
| 555 |  |  |  |  |  |  | } | 
| 556 |  |  |  |  |  |  |  | 
| 557 |  |  |  |  |  |  | =head2 hasWarnings() | 
| 558 |  |  |  |  |  |  |  | 
| 559 |  |  |  |  |  |  | Return true if the API has errors. | 
| 560 |  |  |  |  |  |  |  | 
| 561 |  |  |  |  |  |  | =cut | 
| 562 |  |  |  |  |  |  |  | 
| 563 |  |  |  |  |  |  | sub hasWarnings { | 
| 564 |  |  |  |  |  |  | my $self = shift; | 
| 565 |  |  |  |  |  |  | return $self->_hasErrorsForSeverityCode( | 
| 566 |  |  |  |  |  |  | eBay::API::XML::DataType::Enum::SeverityCodeType::Warning); | 
| 567 |  |  |  |  |  |  | } | 
| 568 |  |  |  |  |  |  |  | 
| 569 |  |  |  |  |  |  | =head2 getErrors() | 
| 570 |  |  |  |  |  |  |  | 
| 571 |  |  |  |  |  |  | Returns: a reference to an array of errors (it can retu | 
| 572 |  |  |  |  |  |  | This method overrides BaseCallGen::getErrors method, while _getResponseErrors is basically | 
| 573 |  |  |  |  |  |  | the same method that exists in BaseCallGen | 
| 574 |  |  |  |  |  |  |  | 
| 575 |  |  |  |  |  |  | =cut | 
| 576 |  |  |  |  |  |  |  | 
| 577 |  |  |  |  |  |  | sub getErrors { | 
| 578 |  |  |  |  |  |  | my $self = shift; | 
| 579 |  |  |  |  |  |  | return $self->_getErrorsForSeverityCode( | 
| 580 |  |  |  |  |  |  | eBay::API::XML::DataType::Enum::SeverityCodeType::Error); | 
| 581 |  |  |  |  |  |  | } | 
| 582 |  |  |  |  |  |  |  | 
| 583 |  |  |  |  |  |  | =head2 getWarnings() | 
| 584 |  |  |  |  |  |  |  | 
| 585 |  |  |  |  |  |  | Return a reference to an array of warnings | 
| 586 |  |  |  |  |  |  |  | 
| 587 |  |  |  |  |  |  | =cut | 
| 588 |  |  |  |  |  |  |  | 
| 589 |  |  |  |  |  |  | sub getWarnings { | 
| 590 |  |  |  |  |  |  | my $self = shift; | 
| 591 |  |  |  |  |  |  | return $self->_getErrorsForSeverityCode( | 
| 592 |  |  |  |  |  |  | eBay::API::XML::DataType::Enum::SeverityCodeType::Warning); | 
| 593 |  |  |  |  |  |  | } | 
| 594 |  |  |  |  |  |  |  | 
| 595 |  |  |  |  |  |  | # _hasErrorsForSeverityCode() | 
| 596 |  |  |  |  |  |  | sub _hasErrorsForSeverityCode { | 
| 597 |  |  |  |  |  |  |  | 
| 598 |  |  |  |  |  |  | my $self = shift; | 
| 599 |  |  |  |  |  |  | my $severityCode = shift; | 
| 600 |  |  |  |  |  |  |  | 
| 601 |  |  |  |  |  |  | my $raErrors = $self->_getResponseErrors(); | 
| 602 |  |  |  |  |  |  |  | 
| 603 |  |  |  |  |  |  | my $hasErrors = 0; | 
| 604 |  |  |  |  |  |  | if ( defined $raErrors ) { | 
| 605 |  |  |  |  |  |  | foreach my $pError (@$raErrors) { | 
| 606 |  |  |  |  |  |  |  | 
| 607 |  |  |  |  |  |  | my @keys = keys ( %$pError ); | 
| 608 |  |  |  |  |  |  | if ( (scalar @keys) == 0 ) { | 
| 609 |  |  |  |  |  |  | $hasErrors = 1; | 
| 610 |  |  |  |  |  |  | last; | 
| 611 |  |  |  |  |  |  | } | 
| 612 |  |  |  |  |  |  |  | 
| 613 |  |  |  |  |  |  | if ( $pError->getSeverityCode() eq $severityCode ) { | 
| 614 |  |  |  |  |  |  | $hasErrors = 1; | 
| 615 |  |  |  |  |  |  | last; | 
| 616 |  |  |  |  |  |  | } | 
| 617 |  |  |  |  |  |  | } | 
| 618 |  |  |  |  |  |  | } | 
| 619 |  |  |  |  |  |  | return $hasErrors; | 
| 620 |  |  |  |  |  |  | } | 
| 621 |  |  |  |  |  |  |  | 
| 622 |  |  |  |  |  |  | # _getErrorsForSeverityCode() | 
| 623 |  |  |  |  |  |  | sub _getErrorsForSeverityCode { | 
| 624 |  |  |  |  |  |  |  | 
| 625 |  |  |  |  |  |  | my $self = shift; | 
| 626 |  |  |  |  |  |  | my $severityCode = shift; | 
| 627 |  |  |  |  |  |  |  | 
| 628 |  |  |  |  |  |  | my $raErrors = $self->_getResponseErrors(); | 
| 629 |  |  |  |  |  |  |  | 
| 630 |  |  |  |  |  |  | my @aErrors = (); | 
| 631 |  |  |  |  |  |  | if ( defined $raErrors ) { | 
| 632 |  |  |  |  |  |  | foreach my $pError (@$raErrors) { | 
| 633 |  |  |  |  |  |  | if ( $pError->getSeverityCode() eq $severityCode ) { | 
| 634 |  |  |  |  |  |  | push @aErrors, $pError; | 
| 635 |  |  |  |  |  |  | } | 
| 636 |  |  |  |  |  |  | } | 
| 637 |  |  |  |  |  |  | } | 
| 638 |  |  |  |  |  |  | return wantarray ? @aErrors : \@aErrors; | 
| 639 |  |  |  |  |  |  | } | 
| 640 |  |  |  |  |  |  |  | 
| 641 |  |  |  |  |  |  | =head2 getErrorsAndWarnings() | 
| 642 |  |  |  |  |  |  |  | 
| 643 |  |  |  |  |  |  | Returns: reference to an array | 
| 644 |  |  |  |  |  |  |  | 
| 645 |  |  |  |  |  |  | Array contains all errors returned by API call, regardless of SeverityCode | 
| 646 |  |  |  |  |  |  | Includes both SeverityCodes: 'Error' and 'Warning' | 
| 647 |  |  |  |  |  |  |  | 
| 648 |  |  |  |  |  |  | =cut | 
| 649 |  |  |  |  |  |  |  | 
| 650 |  |  |  |  |  |  | sub getErrorsAndWarnings() { | 
| 651 |  |  |  |  |  |  | my $self = shift; | 
| 652 |  |  |  |  |  |  | return $self->_getResponseErrors(); | 
| 653 |  |  |  |  |  |  | } | 
| 654 |  |  |  |  |  |  |  | 
| 655 |  |  |  |  |  |  | =head2 hasError() | 
| 656 |  |  |  |  |  |  |  | 
| 657 |  |  |  |  |  |  | Arguments: [0] [R] - errorCode | 
| 658 |  |  |  |  |  |  |  | 
| 659 |  |  |  |  |  |  | Returns:    1 - if an error with the given error code is found | 
| 660 |  |  |  |  |  |  | 0 - if no error with the given error code is returned | 
| 661 |  |  |  |  |  |  |  | 
| 662 |  |  |  |  |  |  | my $boolean = $self->hasError( '304' ); | 
| 663 |  |  |  |  |  |  |  | 
| 664 |  |  |  |  |  |  | =cut | 
| 665 |  |  |  |  |  |  |  | 
| 666 |  |  |  |  |  |  | sub hasError { | 
| 667 |  |  |  |  |  |  |  | 
| 668 |  |  |  |  |  |  | my $self = shift; | 
| 669 |  |  |  |  |  |  | my $sErrorCode = shift; | 
| 670 |  |  |  |  |  |  |  | 
| 671 |  |  |  |  |  |  | my $yes = 0; | 
| 672 |  |  |  |  |  |  | my $raErrors = $self->getErrorsAndWarnings(); | 
| 673 |  |  |  |  |  |  | foreach my $pError ( @$raErrors ) { | 
| 674 |  |  |  |  |  |  | if ( $sErrorCode eq $pError->getErrorCode() ) { | 
| 675 |  |  |  |  |  |  | $yes = 1; | 
| 676 |  |  |  |  |  |  | last; | 
| 677 |  |  |  |  |  |  | } | 
| 678 |  |  |  |  |  |  | } | 
| 679 |  |  |  |  |  |  |  | 
| 680 |  |  |  |  |  |  | return $yes; | 
| 681 |  |  |  |  |  |  | } | 
| 682 |  |  |  |  |  |  |  | 
| 683 |  |  |  |  |  |  | ############################################################################### | 
| 684 |  |  |  |  |  |  | # Response getters(only): output values | 
| 685 |  |  |  |  |  |  | ############################################################################### | 
| 686 |  |  |  |  |  |  |  | 
| 687 |  |  |  |  |  |  | # _getResponsErrors() | 
| 688 |  |  |  |  |  |  | # | 
| 689 |  |  |  |  |  |  | # type: 'ns:ErrorType' | 
| 690 |  |  |  |  |  |  | #    setter expects: array or reference to an array | 
| 691 |  |  |  |  |  |  | #    getter returns: reference to an array | 
| 692 |  |  |  |  |  |  | #                     of 'ns:ErrorType' | 
| 693 |  |  |  |  |  |  | # | 
| 694 |  |  |  |  |  |  | sub _getResponseErrors { | 
| 695 |  |  |  |  |  |  | my $self = shift; | 
| 696 |  |  |  |  |  |  | return $self->getResponseDataType()->getErrors(); | 
| 697 |  |  |  |  |  |  | } | 
| 698 |  |  |  |  |  |  |  | 
| 699 |  |  |  |  |  |  |  | 
| 700 |  |  |  |  |  |  | =head2 getEBayOfficialTime() | 
| 701 |  |  |  |  |  |  |  | 
| 702 |  |  |  |  |  |  | Returns the officaial eBay time. | 
| 703 |  |  |  |  |  |  |  | 
| 704 |  |  |  |  |  |  | 2008-07-03T23:46:36.234Z | 
| 705 |  |  |  |  |  |  |  | 
| 706 |  |  |  |  |  |  | =cut | 
| 707 |  |  |  |  |  |  |  | 
| 708 |  |  |  |  |  |  | # | 
| 709 |  |  |  |  |  |  | # type: 'xs:dateTime' | 
| 710 |  |  |  |  |  |  | # | 
| 711 |  |  |  |  |  |  | # | 
| 712 |  |  |  |  |  |  | sub getEBayOfficialTime { | 
| 713 |  |  |  |  |  |  | my $self = shift; | 
| 714 |  |  |  |  |  |  | return $self->getResponseDataType()->getTimestamp(); | 
| 715 |  |  |  |  |  |  | } | 
| 716 |  |  |  |  |  |  |  | 
| 717 |  |  |  |  |  |  | ############################################################################### | 
| 718 |  |  |  |  |  |  | # Methods | 
| 719 |  |  |  |  |  |  | ############################################################################### | 
| 720 |  |  |  |  |  |  |  | 
| 721 |  |  |  |  |  |  | # _prettyPrintFormat() | 
| 722 |  |  |  |  |  |  | # | 
| 723 |  |  |  |  |  |  | # Arguments: 1 [R] pHttpR - either an HTTP::Request or HTTP:Response object | 
| 724 |  |  |  |  |  |  | # Description: Formats HTTP::Request/HTTP::Response as a string. | 
| 725 |  |  |  |  |  |  | #            Includes: header and content. | 
| 726 |  |  |  |  |  |  | #            XML content is pretty printed. | 
| 727 |  |  |  |  |  |  |  | 
| 728 |  |  |  |  |  |  | sub _prettyPrintFormat { | 
| 729 |  |  |  |  |  |  |  | 
| 730 |  |  |  |  |  |  | my $self = shift; | 
| 731 |  |  |  |  |  |  | my $pHttpR = shift;     # either HTTP::Request or HTTP::Response object | 
| 732 |  |  |  |  |  |  |  | 
| 733 |  |  |  |  |  |  | my $sContent    = $pHttpR->content(); | 
| 734 |  |  |  |  |  |  | my $sEverything = $pHttpR->as_string(); | 
| 735 |  |  |  |  |  |  |  | 
| 736 |  |  |  |  |  |  | my $str = ''; | 
| 737 |  |  |  |  |  |  | my $pTidy = XML::Tidy->new('xml' => $sContent); | 
| 738 |  |  |  |  |  |  | my $tidyStrContent = ''; | 
| 739 |  |  |  |  |  |  | eval { | 
| 740 |  |  |  |  |  |  | $pTidy->tidy(); | 
| 741 |  |  |  |  |  |  | $tidyStrContent = $pTidy->toString(); | 
| 742 |  |  |  |  |  |  | }; | 
| 743 |  |  |  |  |  |  | my $ndx = index($sEverything, ' | 
| 744 |  |  |  |  |  |  | my $sHeader = ''; | 
| 745 |  |  |  |  |  |  | if ( $ndx >= 0) { | 
| 746 |  |  |  |  |  |  | $sHeader = substr($sEverything, 0, $ndx); | 
| 747 |  |  |  |  |  |  | } | 
| 748 |  |  |  |  |  |  | $str = $sHeader . $tidyStrContent; | 
| 749 |  |  |  |  |  |  | return $str; | 
| 750 |  |  |  |  |  |  | } | 
| 751 |  |  |  |  |  |  |  | 
| 752 |  |  |  |  |  |  | =head2 setRequestRawXml() | 
| 753 |  |  |  |  |  |  |  | 
| 754 |  |  |  |  |  |  | Method for setting some raw xml content to be used for the request. | 
| 755 |  |  |  |  |  |  |  | 
| 756 |  |  |  |  |  |  | my $call = new eBay::API::XML::Call::FetchToken( | 
| 757 |  |  |  |  |  |  | site_id => 0, | 
| 758 |  |  |  |  |  |  | proxy   => __API_URL__, | 
| 759 |  |  |  |  |  |  | dev_id  => __DEVELOPER_ID__, | 
| 760 |  |  |  |  |  |  | app_id  => __APPLICATION_ID__, | 
| 761 |  |  |  |  |  |  | cert_id => __CERT_ID__, | 
| 762 |  |  |  |  |  |  | user_auth_token => __AUTH_TOKEN__, | 
| 763 |  |  |  |  |  |  | ); | 
| 764 |  |  |  |  |  |  |  | 
| 765 |  |  |  |  |  |  | $call->setRequestRawXml(' | 
| 766 |  |  |  |  |  |  |  | 
| 767 |  |  |  |  |  |  |  | 
| 768 |  |  |  |  |  |  | R2n6MQr@LDMAABeDFY8.1025449191.1198127665.563330 | 
| 769 |  |  |  |  |  |  |  | 
| 770 |  |  |  |  |  |  | __USERNAME__ | 
| 771 |  |  |  |  |  |  |  | 
| 772 |  |  |  |  |  |  | ' | 
| 773 |  |  |  |  |  |  | ); | 
| 774 |  |  |  |  |  |  |  | 
| 775 |  |  |  |  |  |  | $call->execute(); | 
| 776 |  |  |  |  |  |  | print $call->getResponseRawXml(); | 
| 777 |  |  |  |  |  |  |  | 
| 778 |  |  |  |  |  |  | =cut | 
| 779 |  |  |  |  |  |  |  | 
| 780 |  |  |  |  |  |  | sub setRequestRawXml { | 
| 781 |  |  |  |  |  |  | my $self = shift; | 
| 782 |  |  |  |  |  |  | $self->{'externalySetRequestXml'} = shift; | 
| 783 |  |  |  |  |  |  | } | 
| 784 |  |  |  |  |  |  |  | 
| 785 |  |  |  |  |  |  | =head2 getRequestRawXml() | 
| 786 |  |  |  |  |  |  |  | 
| 787 |  |  |  |  |  |  | Method returning the raw XML request content | 
| 788 |  |  |  |  |  |  |  | 
| 789 |  |  |  |  |  |  | =cut | 
| 790 |  |  |  |  |  |  |  | 
| 791 |  |  |  |  |  |  | sub getRequestRawXml { | 
| 792 |  |  |  |  |  |  |  | 
| 793 |  |  |  |  |  |  | my $self = shift; | 
| 794 |  |  |  |  |  |  |  | 
| 795 |  |  |  |  |  |  | # | 
| 796 |  |  |  |  |  |  | # externaly set Request Xml should be used only for testing purposes | 
| 797 |  |  |  |  |  |  | # | 
| 798 |  |  |  |  |  |  | my $sExternalySetRequestXml = $self->{'externalySetRequestXml'}; | 
| 799 |  |  |  |  |  |  | if ( defined $sExternalySetRequestXml ) { | 
| 800 |  |  |  |  |  |  | return $sExternalySetRequestXml; | 
| 801 |  |  |  |  |  |  | } | 
| 802 |  |  |  |  |  |  |  | 
| 803 |  |  |  |  |  |  | # Assemble Request Xml | 
| 804 |  |  |  |  |  |  | my $pRequest = $self->getRequestDataType(); | 
| 805 |  |  |  |  |  |  |  | 
| 806 |  |  |  |  |  |  | # 1. START set credentials | 
| 807 |  |  |  |  |  |  | my $pRequesterCredentials = | 
| 808 |  |  |  |  |  |  | eBay::API::XML::DataType::XMLRequesterCredentialsType->new(); | 
| 809 |  |  |  |  |  |  |  | 
| 810 |  |  |  |  |  |  |  | 
| 811 |  |  |  |  |  |  | # We should always be submitting either token or (username, password) pair, NEVER BOTH | 
| 812 |  |  |  |  |  |  | # The default (username, password) values should be used for anonymous calls only! | 
| 813 |  |  |  |  |  |  | my $sAuthToken = $self->getAuthToken(); | 
| 814 |  |  |  |  |  |  | if ( defined $sAuthToken && $sAuthToken ne '' ) { | 
| 815 |  |  |  |  |  |  | $pRequesterCredentials->setEBayAuthToken($sAuthToken); | 
| 816 |  |  |  |  |  |  | } else { | 
| 817 |  |  |  |  |  |  | $pRequesterCredentials->setUsername($self->getUserName()); | 
| 818 |  |  |  |  |  |  | $pRequesterCredentials->setPassword($self->getUserPassword()); | 
| 819 |  |  |  |  |  |  | } | 
| 820 |  |  |  |  |  |  |  | 
| 821 |  |  |  |  |  |  | $pRequest->setRequesterCredentials($pRequesterCredentials); | 
| 822 |  |  |  |  |  |  |  | 
| 823 |  |  |  |  |  |  | # 1. END set credentials | 
| 824 |  |  |  |  |  |  |  | 
| 825 |  |  |  |  |  |  | my $sCallName = $self->getApiCallName() . 'Request'; | 
| 826 |  |  |  |  |  |  | my $strXml    = $self->{'pRequest'}->serialize($sCallName); | 
| 827 |  |  |  |  |  |  |  | 
| 828 |  |  |  |  |  |  | return $strXml; | 
| 829 |  |  |  |  |  |  | } | 
| 830 |  |  |  |  |  |  |  | 
| 831 |  |  |  |  |  |  | # _initRequest() | 
| 832 |  |  |  |  |  |  | sub _initRequest { | 
| 833 |  |  |  |  |  |  |  | 
| 834 |  |  |  |  |  |  | my $self = shift; | 
| 835 |  |  |  |  |  |  |  | 
| 836 |  |  |  |  |  |  | my $sRequestDataFullPackage = $self->getRequestDataTypeFullPackage(); | 
| 837 |  |  |  |  |  |  | if ( ! defined $sRequestDataFullPackage ) { | 
| 838 |  |  |  |  |  |  | # Errors like this one should be cought during the development. | 
| 839 |  |  |  |  |  |  | print "requestDataTypeFullPackage not set!!!\n"; | 
| 840 |  |  |  |  |  |  | print "'getRequestDataTypeFullPackage' method must be implemented in " | 
| 841 |  |  |  |  |  |  | . ref($self) . ".pm!\n\n"; | 
| 842 |  |  |  |  |  |  | return; | 
| 843 |  |  |  |  |  |  | } | 
| 844 |  |  |  |  |  |  | my $pRequest = $sRequestDataFullPackage->new(); | 
| 845 |  |  |  |  |  |  |  | 
| 846 |  |  |  |  |  |  | $self->_setRequestDataType($pRequest); | 
| 847 |  |  |  |  |  |  | } | 
| 848 |  |  |  |  |  |  |  | 
| 849 |  |  |  |  |  |  | # _initResponse() | 
| 850 |  |  |  |  |  |  | sub _initResponse { | 
| 851 |  |  |  |  |  |  |  | 
| 852 |  |  |  |  |  |  | my $self = shift; | 
| 853 |  |  |  |  |  |  |  | 
| 854 |  |  |  |  |  |  | my $sResponseDataFullPackage = $self->getResponseDataTypeFullPackage(); | 
| 855 |  |  |  |  |  |  | if ( ! defined $sResponseDataFullPackage ) { | 
| 856 |  |  |  |  |  |  | # Errors like this one should be cought during the development. | 
| 857 |  |  |  |  |  |  | print "responseDataTypeFullPackage not set!!!\n"; | 
| 858 |  |  |  |  |  |  | print "'getResponseDataTypeFullPackage' method must be implemented in " | 
| 859 |  |  |  |  |  |  | . ref($self) . ".pm!\n\n"; | 
| 860 |  |  |  |  |  |  | return; | 
| 861 |  |  |  |  |  |  | } | 
| 862 |  |  |  |  |  |  | my $pResponse = $sResponseDataFullPackage->new(); | 
| 863 |  |  |  |  |  |  |  | 
| 864 |  |  |  |  |  |  | $self->_setResponseDataType($pResponse); | 
| 865 |  |  |  |  |  |  | } | 
| 866 |  |  |  |  |  |  |  | 
| 867 |  |  |  |  |  |  | =head2 forceError() | 
| 868 |  |  |  |  |  |  |  | 
| 869 |  |  |  |  |  |  | This method is used to force a given error when a call is being executed. | 
| 870 |  |  |  |  |  |  | If the forced error is set, then that error is being returned by the call | 
| 871 |  |  |  |  |  |  | without executing the call (sending request to the API Server and receiving | 
| 872 |  |  |  |  |  |  | the response. | 
| 873 |  |  |  |  |  |  |  | 
| 874 |  |  |  |  |  |  | This method is used for test purposes when a programmer wants to test | 
| 875 |  |  |  |  |  |  | how the application handles an API error. | 
| 876 |  |  |  |  |  |  |  | 
| 877 |  |  |  |  |  |  | Arguments: This method uses named argument calling style that looks like this: | 
| 878 |  |  |  |  |  |  |  | 
| 879 |  |  |  |  |  |  | $self->forceError ( sErrorCode => '1025', sShortMsg => 'Test API error', ... ); | 
| 880 |  |  |  |  |  |  |  | 
| 881 |  |  |  |  |  |  | Required arguments | 
| 882 |  |  |  |  |  |  | 1 - sErrorCode - API error code | 
| 883 |  |  |  |  |  |  | 2 - sShortMsg  - short error message | 
| 884 |  |  |  |  |  |  | 3 - sLongMsg   - long error message | 
| 885 |  |  |  |  |  |  | Optional arguments | 
| 886 |  |  |  |  |  |  | 4 - sSeverityCode - severity code | 
| 887 |  |  |  |  |  |  | default severity code: | 
| 888 |  |  |  |  |  |  | eBay::API::XML::DataType::Enum::SeverityCodeType::Error | 
| 889 |  |  |  |  |  |  | 5 - sErrorClassificationCode - error classification code | 
| 890 |  |  |  |  |  |  | default error classification code | 
| 891 |  |  |  |  |  |  | eBay::API::XML::DataType::Enum::ErrorClassificationCodeType::SystemError | 
| 892 |  |  |  |  |  |  |  | 
| 893 |  |  |  |  |  |  | Example: | 
| 894 |  |  |  |  |  |  |  | 
| 895 |  |  |  |  |  |  | $call->forceError ( | 
| 896 |  |  |  |  |  |  | 'sErrorCode' => '1025' | 
| 897 |  |  |  |  |  |  | ,'sShortMsg' => 'Test error short message' | 
| 898 |  |  |  |  |  |  | ,'sLongMsg' => 'Test error long message' | 
| 899 |  |  |  |  |  |  | ); | 
| 900 |  |  |  |  |  |  |  | 
| 901 |  |  |  |  |  |  | =cut | 
| 902 |  |  |  |  |  |  |  | 
| 903 |  |  |  |  |  |  | sub forceError { | 
| 904 |  |  |  |  |  |  | my $self = shift; | 
| 905 |  |  |  |  |  |  | my %args = @_; | 
| 906 |  |  |  |  |  |  |  | 
| 907 |  |  |  |  |  |  | my $sErrorCode = $args{'sErrorCode'}; | 
| 908 |  |  |  |  |  |  | my $sShortMsg  = $args{'sShortMsg'}; | 
| 909 |  |  |  |  |  |  | my $sLongMsg   = $args{'sLongMsg'}; | 
| 910 |  |  |  |  |  |  | my $sSeverityError = | 
| 911 |  |  |  |  |  |  | $args{'sSeverityCode'} | 
| 912 |  |  |  |  |  |  | || eBay::API::XML::DataType::Enum::SeverityCodeType::Error; | 
| 913 |  |  |  |  |  |  | my $sErrorClassificationCode = | 
| 914 |  |  |  |  |  |  | $args{'sErrorClassificationCode'} | 
| 915 |  |  |  |  |  |  | || eBay::API::XML::DataType::Enum::ErrorClassificationCodeType::SystemError; | 
| 916 |  |  |  |  |  |  |  | 
| 917 |  |  |  |  |  |  | my $pError = eBay::API::XML::DataType::ErrorType->new(); | 
| 918 |  |  |  |  |  |  | $pError->setShortMessage ( $sShortMsg ); | 
| 919 |  |  |  |  |  |  | $pError->setErrorParameters ( [] ); | 
| 920 |  |  |  |  |  |  | $pError->setErrorCode( $sErrorCode ); | 
| 921 |  |  |  |  |  |  | $pError->setSeverityCode( $sSeverityError ); | 
| 922 |  |  |  |  |  |  | $pError->setLongMessage ( $sLongMsg ); | 
| 923 |  |  |  |  |  |  | $pError->setErrorClassification ( $sErrorClassificationCode ); | 
| 924 |  |  |  |  |  |  |  | 
| 925 |  |  |  |  |  |  | $self->_addError( $pError ); | 
| 926 |  |  |  |  |  |  | # signal that we want to force an error. | 
| 927 |  |  |  |  |  |  | $self->{'hasForcedError'} = 1; | 
| 928 |  |  |  |  |  |  | } | 
| 929 |  |  |  |  |  |  |  | 
| 930 |  |  |  |  |  |  | sub hasForcedError { | 
| 931 |  |  |  |  |  |  | my $self = shift; | 
| 932 |  |  |  |  |  |  | return $self->{'hasForcedError'}; | 
| 933 |  |  |  |  |  |  | } | 
| 934 |  |  |  |  |  |  |  | 
| 935 |  |  |  |  |  |  | =head2 processResponse() | 
| 936 |  |  |  |  |  |  |  | 
| 937 |  |  |  |  |  |  | Method resonsible for process the http response when it arrives. | 
| 938 |  |  |  |  |  |  |  | 
| 939 |  |  |  |  |  |  | =cut | 
| 940 |  |  |  |  |  |  |  | 
| 941 |  |  |  |  |  |  | sub processResponse { | 
| 942 |  |  |  |  |  |  | my $self = shift; | 
| 943 |  |  |  |  |  |  | my $objHttpResponse = shift; | 
| 944 |  |  |  |  |  |  |  | 
| 945 |  |  |  |  |  |  | # 1. retrieve response content | 
| 946 |  |  |  |  |  |  | #    if gziped - unzip it | 
| 947 |  |  |  |  |  |  | my $contentEncoding = $objHttpResponse->content_encoding; | 
| 948 |  |  |  |  |  |  | my $sRawXml= $objHttpResponse->content(); | 
| 949 |  |  |  |  |  |  | if (defined $contentEncoding && $contentEncoding =~ /gzip/i) { | 
| 950 |  |  |  |  |  |  | $sRawXml = Compress::Zlib::memGunzip ( $sRawXml ); | 
| 951 |  |  |  |  |  |  | } | 
| 952 |  |  |  |  |  |  |  | 
| 953 |  |  |  |  |  |  | $self->_setHttpResponseObject( $objHttpResponse ); | 
| 954 |  |  |  |  |  |  |  | 
| 955 |  |  |  |  |  |  | #print $sRawXml; | 
| 956 |  |  |  |  |  |  |  | 
| 957 |  |  |  |  |  |  | my $pResponse = $self->getResponseDataType(); | 
| 958 |  |  |  |  |  |  |  | 
| 959 |  |  |  |  |  |  | my $isHttpError = $objHttpResponse->is_error; | 
| 960 |  |  |  |  |  |  |  | 
| 961 |  |  |  |  |  |  | # 3. process response | 
| 962 |  |  |  |  |  |  |  | 
| 963 |  |  |  |  |  |  | if (! $isHttpError ) {    # 3.1. process HTTP response when when we | 
| 964 |  |  |  |  |  |  | #      DO NOT HAVE HTTP connection errors | 
| 965 |  |  |  |  |  |  |  | 
| 966 |  |  |  |  |  |  | my $ok = 1; | 
| 967 |  |  |  |  |  |  | $ok = $self->_handleNoResponseContent ( \$sRawXml ); | 
| 968 |  |  |  |  |  |  | if ( ! $ok ) { | 
| 969 |  |  |  |  |  |  | $self->_setResponseValidXml( _FALSE_); | 
| 970 |  |  |  |  |  |  | return; | 
| 971 |  |  |  |  |  |  | } | 
| 972 |  |  |  |  |  |  |  | 
| 973 |  |  |  |  |  |  | $ok = $self->_handleApiBadGataway ( \$sRawXml ); | 
| 974 |  |  |  |  |  |  | if ( ! $ok ) { | 
| 975 |  |  |  |  |  |  | $self->_setResponseValidXml( _FALSE_); | 
| 976 |  |  |  |  |  |  | return; | 
| 977 |  |  |  |  |  |  | } | 
| 978 |  |  |  |  |  |  |  | 
| 979 |  |  |  |  |  |  | my $rhXmlSimple; | 
| 980 |  |  |  |  |  |  |  | 
| 981 |  |  |  |  |  |  | # I.1. parse the raw response | 
| 982 |  |  |  |  |  |  | eval { | 
| 983 |  |  |  |  |  |  | $rhXmlSimple = XMLin ( $sRawXml | 
| 984 |  |  |  |  |  |  | , forcearray => [] | 
| 985 |  |  |  |  |  |  | , keyattr => [] | 
| 986 |  |  |  |  |  |  | ); | 
| 987 |  |  |  |  |  |  | }; | 
| 988 |  |  |  |  |  |  |  | 
| 989 |  |  |  |  |  |  | if ( $@ ) {     # I.2. OOPS, parsing failed - response is not | 
| 990 |  |  |  |  |  |  | #                            a valid XML document | 
| 991 |  |  |  |  |  |  | $self->_setResponseValidXml( _FALSE_); | 
| 992 |  |  |  |  |  |  |  | 
| 993 |  |  |  |  |  |  | #print Dumper($sRawXml); | 
| 994 |  |  |  |  |  |  | my $longMsg   = "error [$@] while parsing response xml [$sRawXml]"; | 
| 995 |  |  |  |  |  |  | my $shortMsg  = $!; | 
| 996 |  |  |  |  |  |  | my $errorCode = XML_PARSE_ERROR; | 
| 997 |  |  |  |  |  |  |  | 
| 998 |  |  |  |  |  |  | $self->_addHTTP_XMLParse_Error ( | 
| 999 |  |  |  |  |  |  | 'shortMsg'  => $shortMsg | 
| 1000 |  |  |  |  |  |  | ,'longMsg'   => $longMsg | 
| 1001 |  |  |  |  |  |  | ,'errorCode' => $errorCode | 
| 1002 |  |  |  |  |  |  | ); | 
| 1003 |  |  |  |  |  |  | } else {        # I.3. raw response is a valid XML document, | 
| 1004 |  |  |  |  |  |  | #      deserialize it to the response | 
| 1005 |  |  |  |  |  |  |  | 
| 1006 |  |  |  |  |  |  | $self->_setResponseValidXml( _TRUE_); | 
| 1007 |  |  |  |  |  |  |  | 
| 1008 |  |  |  |  |  |  | $ok = $self->_handleResposeParsedButStructureEmpty ( | 
| 1009 |  |  |  |  |  |  | \$sRawXml, $rhXmlSimple ); | 
| 1010 |  |  |  |  |  |  | if ( ! $ok ) { | 
| 1011 |  |  |  |  |  |  | return; | 
| 1012 |  |  |  |  |  |  | } | 
| 1013 |  |  |  |  |  |  |  | 
| 1014 |  |  |  |  |  |  | $self->_setResponseValidXml( _TRUE_); | 
| 1015 |  |  |  |  |  |  |  | 
| 1016 |  |  |  |  |  |  | $self->_setXmlSimpleDataStructure( $rhXmlSimple ); | 
| 1017 |  |  |  |  |  |  |  | 
| 1018 |  |  |  |  |  |  | #print Dumper $rhXmlSimple; | 
| 1019 |  |  |  |  |  |  | $pResponse->deserialize('rhXmlSimple' => $rhXmlSimple ); | 
| 1020 |  |  |  |  |  |  | #print Dumper $pResponse; | 
| 1021 |  |  |  |  |  |  |  | 
| 1022 |  |  |  |  |  |  | #            I.3.1 OLD TYPE XML RESPONSE | 
| 1023 |  |  |  |  |  |  | #   see method description | 
| 1024 |  |  |  |  |  |  | # | 
| 1025 |  |  |  |  |  |  |  | 
| 1026 |  |  |  |  |  |  | $self->_handleIfItIsOldStyle(); | 
| 1027 |  |  |  |  |  |  | } | 
| 1028 |  |  |  |  |  |  | } else {                  # 3.2. process HTTP response when we HAVE | 
| 1029 |  |  |  |  |  |  | #      HTTP connection errors | 
| 1030 |  |  |  |  |  |  | # since this was a connectin error, raw response cannot be | 
| 1031 |  |  |  |  |  |  | # a valid XML document | 
| 1032 |  |  |  |  |  |  | $self->_setResponseValidXml( _FALSE_); | 
| 1033 |  |  |  |  |  |  |  | 
| 1034 |  |  |  |  |  |  | #print $objHttpResponse->error_as_HTML; | 
| 1035 |  |  |  |  |  |  | #print Dumper( $objHttpResponse); | 
| 1036 |  |  |  |  |  |  |  | 
| 1037 |  |  |  |  |  |  | my $shortMsg = $objHttpResponse->status_line(); | 
| 1038 |  |  |  |  |  |  | my $longMsg  = $shortMsg; | 
| 1039 |  |  |  |  |  |  | my $errorCode = HTTP_ERRORCODE_PREFIX . $objHttpResponse->code(); | 
| 1040 |  |  |  |  |  |  |  | 
| 1041 |  |  |  |  |  |  | $self->_addHTTP_XMLParse_Error ( | 
| 1042 |  |  |  |  |  |  | 'shortMsg'  => $shortMsg | 
| 1043 |  |  |  |  |  |  | ,'longMsg'   => $longMsg | 
| 1044 |  |  |  |  |  |  | ,'errorCode' => $errorCode | 
| 1045 |  |  |  |  |  |  | ); | 
| 1046 |  |  |  |  |  |  | } | 
| 1047 |  |  |  |  |  |  | } | 
| 1048 |  |  |  |  |  |  |  | 
| 1049 |  |  |  |  |  |  | # _handleNoResponseContent() | 
| 1050 |  |  |  |  |  |  | sub _handleNoResponseContent { | 
| 1051 |  |  |  |  |  |  |  | 
| 1052 |  |  |  |  |  |  | my $self     = shift; | 
| 1053 |  |  |  |  |  |  | my $rsRawXml = shift; | 
| 1054 |  |  |  |  |  |  |  | 
| 1055 |  |  |  |  |  |  | my $sRawXml = $$rsRawXml; | 
| 1056 |  |  |  |  |  |  |  | 
| 1057 |  |  |  |  |  |  | my $ok = 1; | 
| 1058 |  |  |  |  |  |  | if ( ! $sRawXml ) { | 
| 1059 |  |  |  |  |  |  |  | 
| 1060 |  |  |  |  |  |  | my $longMsg   = 'No response content !'; | 
| 1061 |  |  |  |  |  |  | my $shortMsg  = $longMsg; | 
| 1062 |  |  |  |  |  |  | my $errorCode = NO_RESPONSE_CONTENT; | 
| 1063 |  |  |  |  |  |  | $self->_addHTTP_XMLParse_Error ( | 
| 1064 |  |  |  |  |  |  | 'shortMsg'  => $shortMsg | 
| 1065 |  |  |  |  |  |  | ,'longMsg'   => $longMsg | 
| 1066 |  |  |  |  |  |  | ,'errorCode' => $errorCode | 
| 1067 |  |  |  |  |  |  | ); | 
| 1068 |  |  |  |  |  |  | $ok = 0; | 
| 1069 |  |  |  |  |  |  | } | 
| 1070 |  |  |  |  |  |  | return $ok; | 
| 1071 |  |  |  |  |  |  | } | 
| 1072 |  |  |  |  |  |  |  | 
| 1073 |  |  |  |  |  |  | # _handleApiBadGataway() | 
| 1074 |  |  |  |  |  |  | sub _handleApiBadGataway { | 
| 1075 |  |  |  |  |  |  |  | 
| 1076 |  |  |  |  |  |  | my $self     = shift; | 
| 1077 |  |  |  |  |  |  | my $rsRawXml = shift; | 
| 1078 |  |  |  |  |  |  |  | 
| 1079 |  |  |  |  |  |  | my $sRawXml = $$rsRawXml; | 
| 1080 |  |  |  |  |  |  |  | 
| 1081 |  |  |  |  |  |  | #  'Bad Gataway' ERROR | 
| 1082 |  |  |  |  |  |  | #    Check for error HTML response from the gateway. | 
| 1083 |  |  |  |  |  |  | #    If it begins with DOCTYPE or it begins with an html block | 
| 1084 |  |  |  |  |  |  |  | 
| 1085 |  |  |  |  |  |  | my $isBadApiGateway = 0; | 
| 1086 |  |  |  |  |  |  | if ( $sRawXml =~ m{^\s* | 
| 1087 |  |  |  |  |  |  | $isBadApiGateway = 1 | 
| 1088 |  |  |  |  |  |  | } | 
| 1089 |  |  |  |  |  |  |  | 
| 1090 |  |  |  |  |  |  | my $ok = 1; | 
| 1091 |  |  |  |  |  |  | if ( $isBadApiGateway ) { | 
| 1092 |  |  |  |  |  |  |  | 
| 1093 |  |  |  |  |  |  | my $longMsg   = "Bad API gateway, [$sRawXml] !"; | 
| 1094 |  |  |  |  |  |  | my $shortMsg  = 'Bad API gateway'; | 
| 1095 |  |  |  |  |  |  | my $errorCode = BAD_API_GATAWAY; | 
| 1096 |  |  |  |  |  |  | $self->_addHTTP_XMLParse_Error ( | 
| 1097 |  |  |  |  |  |  | 'shortMsg'  => $shortMsg | 
| 1098 |  |  |  |  |  |  | ,'longMsg'   => $longMsg | 
| 1099 |  |  |  |  |  |  | ,'errorCode' => $errorCode | 
| 1100 |  |  |  |  |  |  | ); | 
| 1101 |  |  |  |  |  |  | $ok = 0; | 
| 1102 |  |  |  |  |  |  | } | 
| 1103 |  |  |  |  |  |  | return $ok; | 
| 1104 |  |  |  |  |  |  | } | 
| 1105 |  |  |  |  |  |  |  | 
| 1106 |  |  |  |  |  |  | # _handleResposeParsedButStructureEmpty() | 
| 1107 |  |  |  |  |  |  | sub _handleResposeParsedButStructureEmpty { | 
| 1108 |  |  |  |  |  |  |  | 
| 1109 |  |  |  |  |  |  | my $self        = shift; | 
| 1110 |  |  |  |  |  |  | my $rsRawXml    = shift; | 
| 1111 |  |  |  |  |  |  | my $rhXmlSimple = shift; | 
| 1112 |  |  |  |  |  |  |  | 
| 1113 |  |  |  |  |  |  | my $sRawXml = $$rsRawXml; | 
| 1114 |  |  |  |  |  |  |  | 
| 1115 |  |  |  |  |  |  | # xml contains no useful data ( everything is comment?? | 
| 1116 |  |  |  |  |  |  | #                               try that as a test case ) | 
| 1117 |  |  |  |  |  |  |  | 
| 1118 |  |  |  |  |  |  | my $ok = 1; | 
| 1119 |  |  |  |  |  |  | my $isEmpty =  (! $rhXmlSimple) | 
| 1120 |  |  |  |  |  |  | || (! ref($rhXmlSimple)); | 
| 1121 |  |  |  |  |  |  | if ( ! $isEmpty ) { | 
| 1122 |  |  |  |  |  |  |  | 
| 1123 |  |  |  |  |  |  | if ( ref($rhXmlSimple) eq 'HASH' ) { | 
| 1124 |  |  |  |  |  |  | my @keys = keys %$rhXmlSimple; | 
| 1125 |  |  |  |  |  |  | if ( (scalar @keys) == 0 ) { | 
| 1126 |  |  |  |  |  |  | $isEmpty = 1; | 
| 1127 |  |  |  |  |  |  | } | 
| 1128 |  |  |  |  |  |  | } | 
| 1129 |  |  |  |  |  |  | } | 
| 1130 |  |  |  |  |  |  |  | 
| 1131 |  |  |  |  |  |  | if ( $isEmpty ) { | 
| 1132 |  |  |  |  |  |  |  | 
| 1133 |  |  |  |  |  |  | my $longMsg   = "no data from response xml [$sRawXml]"; | 
| 1134 |  |  |  |  |  |  | my $shortMsg  = 'no data from response xml'; | 
| 1135 |  |  |  |  |  |  | my $errorCode = XML_PARSE_RESULT_EMPTY; | 
| 1136 |  |  |  |  |  |  | $self->_addHTTP_XMLParse_Error ( | 
| 1137 |  |  |  |  |  |  | 'shortMsg'  => $shortMsg | 
| 1138 |  |  |  |  |  |  | ,'longMsg'   => $longMsg | 
| 1139 |  |  |  |  |  |  | ,'errorCode' => $errorCode | 
| 1140 |  |  |  |  |  |  | ); | 
| 1141 |  |  |  |  |  |  | $ok = 0; | 
| 1142 |  |  |  |  |  |  | } | 
| 1143 |  |  |  |  |  |  |  | 
| 1144 |  |  |  |  |  |  | return $ok; | 
| 1145 |  |  |  |  |  |  | } | 
| 1146 |  |  |  |  |  |  |  | 
| 1147 |  |  |  |  |  |  | # _addHTTP_XMLParse_Error() | 
| 1148 |  |  |  |  |  |  | sub _addHTTP_XMLParse_Error { | 
| 1149 |  |  |  |  |  |  | my $self = shift; | 
| 1150 |  |  |  |  |  |  | my %args = @_; | 
| 1151 |  |  |  |  |  |  |  | 
| 1152 |  |  |  |  |  |  | my $shortMsg  = $args{'shortMsg'}; | 
| 1153 |  |  |  |  |  |  | my $longMsg   = $args{'longMsg'}; | 
| 1154 |  |  |  |  |  |  | my $errorCode = $args{'errorCode'}; | 
| 1155 |  |  |  |  |  |  |  | 
| 1156 |  |  |  |  |  |  | my $pError = eBay::API::XML::DataType::ErrorType->new(); | 
| 1157 |  |  |  |  |  |  | _populateHTTP_XMLParse_Error( | 
| 1158 |  |  |  |  |  |  | 'pError'    => $pError | 
| 1159 |  |  |  |  |  |  | ,'shortMsg'  => $shortMsg | 
| 1160 |  |  |  |  |  |  | ,'longMsg'   => $longMsg | 
| 1161 |  |  |  |  |  |  | ,'errorCode' => $errorCode | 
| 1162 |  |  |  |  |  |  | ); | 
| 1163 |  |  |  |  |  |  | $self->_addError( $pError ); | 
| 1164 |  |  |  |  |  |  | } | 
| 1165 |  |  |  |  |  |  |  | 
| 1166 |  |  |  |  |  |  | # _populateHTTP_XMLParse_Error() | 
| 1167 |  |  |  |  |  |  | sub _populateHTTP_XMLParse_Error { | 
| 1168 |  |  |  |  |  |  |  | 
| 1169 |  |  |  |  |  |  | my %args = @_; | 
| 1170 |  |  |  |  |  |  |  | 
| 1171 |  |  |  |  |  |  | my $pError    = $args{'pError'}; | 
| 1172 |  |  |  |  |  |  | my $shortMsg  = $args{'shortMsg'}; | 
| 1173 |  |  |  |  |  |  | my $longMsg   = $args{'longMsg'}; | 
| 1174 |  |  |  |  |  |  | my $errorCode = $args{'errorCode'}; | 
| 1175 |  |  |  |  |  |  |  | 
| 1176 |  |  |  |  |  |  | $pError->setShortMessage ( $shortMsg ); | 
| 1177 |  |  |  |  |  |  | $pError->setErrorParameters ( [] ); | 
| 1178 |  |  |  |  |  |  | $pError->setErrorCode( $errorCode ); | 
| 1179 |  |  |  |  |  |  | $pError->setSeverityCode( | 
| 1180 |  |  |  |  |  |  | eBay::API::XML::DataType::Enum::SeverityCodeType::Error | 
| 1181 |  |  |  |  |  |  | ); | 
| 1182 |  |  |  |  |  |  | $pError->setLongMessage ( $longMsg ); | 
| 1183 |  |  |  |  |  |  | $pError->setErrorClassification ( | 
| 1184 |  |  |  |  |  |  | eBay::API::XML::DataType::Enum::ErrorClassificationCodeType::SystemError | 
| 1185 |  |  |  |  |  |  | ); | 
| 1186 |  |  |  |  |  |  | } | 
| 1187 |  |  |  |  |  |  |  | 
| 1188 |  |  |  |  |  |  | # _handleIfItIsOldStyle() | 
| 1189 |  |  |  |  |  |  | sub _handleIfItIsOldStyle { | 
| 1190 |  |  |  |  |  |  |  | 
| 1191 |  |  |  |  |  |  | my $self = shift; | 
| 1192 |  |  |  |  |  |  |  | 
| 1193 |  |  |  |  |  |  | #            I.3.1 OLD TYPE XML RESPONSE | 
| 1194 |  |  |  |  |  |  | #  If an empty XML string is submitted, then an old type | 
| 1195 |  |  |  |  |  |  | #   XML response is returned. Such response returns errors | 
| 1196 |  |  |  |  |  |  | #   which are in the old format. Those errors do not make any | 
| 1197 |  |  |  |  |  |  | #   sense anyways so just replace them with a new one which really | 
| 1198 |  |  |  |  |  |  | #   says what has happend. | 
| 1199 |  |  |  |  |  |  | # | 
| 1200 |  |  |  |  |  |  | my $ok = 1; | 
| 1201 |  |  |  |  |  |  | my $raErrors = $self->_getResponseErrors(); | 
| 1202 |  |  |  |  |  |  | if ( defined $raErrors ) { | 
| 1203 |  |  |  |  |  |  |  | 
| 1204 |  |  |  |  |  |  | foreach my $pError (@$raErrors) { | 
| 1205 |  |  |  |  |  |  |  | 
| 1206 |  |  |  |  |  |  | my @keys = keys ( %$pError ); | 
| 1207 |  |  |  |  |  |  | # If we have errors but such errors do not have keys | 
| 1208 |  |  |  |  |  |  | # that means that an old style response is returned. | 
| 1209 |  |  |  |  |  |  | #  Add a new error message | 
| 1210 |  |  |  |  |  |  | if ( (scalar @keys) == 0 ) { | 
| 1211 |  |  |  |  |  |  |  | 
| 1212 |  |  |  |  |  |  | my $shortMsg = 'old type XML response'; | 
| 1213 |  |  |  |  |  |  | my $longMsg = <<"OLD_TYPE"; | 
| 1214 |  |  |  |  |  |  |  | 
| 1215 |  |  |  |  |  |  | Old type response, most likely: | 
| 1216 |  |  |  |  |  |  | a) an empty string sent as a request | 
| 1217 |  |  |  |  |  |  | b) a very incomplete XML string sent as a request | 
| 1218 |  |  |  |  |  |  | Please check both, raw request string and raw response!! | 
| 1219 |  |  |  |  |  |  | OLD_TYPE | 
| 1220 |  |  |  |  |  |  | my $errorCode = XML_OLD_TYPE_RESPONSE; | 
| 1221 |  |  |  |  |  |  |  | 
| 1222 |  |  |  |  |  |  | _populateHTTP_XMLParse_Error( | 
| 1223 |  |  |  |  |  |  | 'pError'    => $pError | 
| 1224 |  |  |  |  |  |  | ,'shortMsg'  => $shortMsg | 
| 1225 |  |  |  |  |  |  | ,'longMsg'   => $longMsg | 
| 1226 |  |  |  |  |  |  | ,'errorCode' => $errorCode | 
| 1227 |  |  |  |  |  |  | ); | 
| 1228 |  |  |  |  |  |  | } | 
| 1229 |  |  |  |  |  |  |  | 
| 1230 |  |  |  |  |  |  | $ok = 0; | 
| 1231 |  |  |  |  |  |  | # Just check out the first error message | 
| 1232 |  |  |  |  |  |  | # If first error message is not an old style error message | 
| 1233 |  |  |  |  |  |  | # then none is. | 
| 1234 |  |  |  |  |  |  | last; | 
| 1235 |  |  |  |  |  |  | } | 
| 1236 |  |  |  |  |  |  | } | 
| 1237 |  |  |  |  |  |  |  | 
| 1238 |  |  |  |  |  |  | return $ok; | 
| 1239 |  |  |  |  |  |  | } | 
| 1240 |  |  |  |  |  |  |  | 
| 1241 |  |  |  |  |  |  | =head1 ABSTRACT METHODS | 
| 1242 |  |  |  |  |  |  |  | 
| 1243 |  |  |  |  |  |  | Methods that HAVE TO BE IMPLEMENTED IN each specific API CALL | 
| 1244 |  |  |  |  |  |  |  | 
| 1245 |  |  |  |  |  |  | =head2 getApiCallName() | 
| 1246 |  |  |  |  |  |  |  | 
| 1247 |  |  |  |  |  |  | An abstract method - it has to be implemented in a class extending BaseCall class | 
| 1248 |  |  |  |  |  |  |  | 
| 1249 |  |  |  |  |  |  | =cut | 
| 1250 |  |  |  |  |  |  |  | 
| 1251 |  |  |  |  |  |  | sub getApiCallName { | 
| 1252 |  |  |  |  |  |  | return undef; | 
| 1253 |  |  |  |  |  |  | } | 
| 1254 |  |  |  |  |  |  |  | 
| 1255 |  |  |  |  |  |  | =head2 getRequestDataTypeFullPackage() | 
| 1256 |  |  |  |  |  |  |  | 
| 1257 |  |  |  |  |  |  | An abstract method - it has to be implemented in a class extending BaseCall class | 
| 1258 |  |  |  |  |  |  |  | 
| 1259 |  |  |  |  |  |  | =cut | 
| 1260 |  |  |  |  |  |  |  | 
| 1261 |  |  |  |  |  |  | sub getRequestDataTypeFullPackage { | 
| 1262 |  |  |  |  |  |  | return undef; | 
| 1263 |  |  |  |  |  |  | } | 
| 1264 |  |  |  |  |  |  |  | 
| 1265 |  |  |  |  |  |  | =head2 getResponseDataTypeFullPackage() | 
| 1266 |  |  |  |  |  |  |  | 
| 1267 |  |  |  |  |  |  | An abstract method - it has to be implemented in a class extending BaseCall class | 
| 1268 |  |  |  |  |  |  |  | 
| 1269 |  |  |  |  |  |  | =cut | 
| 1270 |  |  |  |  |  |  |  | 
| 1271 |  |  |  |  |  |  | sub getResponseDataTypeFullPackage { | 
| 1272 |  |  |  |  |  |  | return undef; | 
| 1273 |  |  |  |  |  |  | } | 
| 1274 |  |  |  |  |  |  |  | 
| 1275 |  |  |  |  |  |  | 1; |