package Business::USPS::RateRequest;

use 5.008008;
use strict;
use warnings;

require Exporter;

use LWP::UserAgent;
use XML::Simple;
use Data::Dumper; 

our @ISA = qw(Exporter);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration	use Business::USPS::RateRequest ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'all' => [ qw(
	
) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw();

our $VERSION = '0.92';

# USPS Shipping notes
our %ship_note;
$ship_note{''} = '';


# Preloaded methods go here.

sub new {

    my $name = shift;
    my $class = ref($name) || $name;

    my %args = @_;
    $args{'uri'} = $args{'uri'} || 'http://production.shippingapis.com/ShippingAPI.dll';

    my $self  = {
                 uri => $args{'uri'},
                 usr_id => $args{'usr_id'},
                 err_msg =>    "",
                };

    my @rqd_lst = qw/usr_id/; 
    foreach my $param (@rqd_lst) { unless ( $args{$param} ) { $self->{'err_msg'}="$param required"; return 0; } }

    $self->{UA} = LWP::UserAgent->new(agent => 'perlworks');
    #$self->{REQ} = HTTP::Request->new(POST=>$self->{uri}); # Create a request

    bless ($self, $class);
}



# - - - - - - - - - - - - - - -
sub get_rates
{
	my $self = shift @_;
	my %args = @_;

   my @rqd_lst = qw/src_zip pounds/;    
   foreach my $param (@rqd_lst) { unless ( $args{$param} ) { $self->{'err_msg'}="$param required"; return 0; } }
   
   unless ( $args{'country'}  ) { $args{'country'} = 'United States' }
  
   unless ( $args{'length'}  ) { $args{'length'} = '5' } 
   unless ( $args{'width'}   ) { $args{'width'}  = '5' } 
   unless ( $args{'height'}  ) { $args{'height'} = '5' } 
   unless ( $args{'value'}   ) { $args{'value'} = 250 } 
   unless ( $args{'poboxflag'} ) { $args{'poboxflag'} = 'N' } 
   unless ( $args{'giftflag'}  ) { $args{'giftflag'} = 'N' } 
   unless ( $args{'size'}  ) { $args{'size'} = 'Regular' } 

   my $xml_snd_doc; 
   my $api; 
   if ( $args{'country'} =~ /united states/i ) 
   { 
      $xml_snd_doc = $self->gen_dom_rate_request_xml(\%args);
      $api = 'RateV3';  
   }
   else
   { 
      $xml_snd_doc = $self->gen_int_rate_request_xml(\%args); 
      $api = 'IntlRate';  
   }

	#print $xml_snd_doc; exit; 

   my $get_url = "$self->{'uri'}?API=$api&XML=$xml_snd_doc";
	my $response = $self->{UA}->get($get_url);

	unless ($response->is_success) 
	{
		$self->{'err_msg'} = "Error Request: " . $response->status_line;
      return 0; 
   }
  
   # Must be success let's parse this thing 

	my $rtn = $response->as_string;
 	$rtn =~ /(.*)\n\n(.*)/s;
   
	my $hdr = $1;  # Don't use for anything right now
   my $xml_rtn_doc = $2; # The object of this all.... 

	my $xml_obj  = new XML::Simple;    

   my $data = $xml_obj->XMLin($xml_rtn_doc); # Time consuming operation.  

   my @rtn_lst; # This will be returned
   if ( $api eq 'IntlRate' ) 
   {
      my $rate_lst_ref = $data->{'Package'}->{'Service'};

	   my $i = 0; 
		foreach my $detail_ref ( @{$rate_lst_ref} )
		{
         my $cost = $detail_ref->{'Postage'};
         my $tag  = $detail_ref->{'SvcDescription'};
			my $note = $detail_ref->{'SvcCommitments'};
         my $id   = $detail_ref->{'ID'}; 
	
	      $rtn_lst[$i] = {'id'=>$id, 'ship_cost'=>$cost, 'ship_tag'=>$tag, 'ship_note'=>$note};
	      $i++;
		}  
   }
   else
	{
      my $rate_lst_ref = $data->{'Package'}->{'Postage'};

	   my $i = 0; 
		foreach my $detail_ref ( @{$rate_lst_ref} )
		{
         my $cost = $detail_ref->{'Rate'};
         my $tag  = $detail_ref->{'MailService'};
         my $id   = $detail_ref->{'CLASSID'}; 
	
	      $rtn_lst[$i] = {'id'=>$id, 'ship_cost'=>$cost, 'ship_tag'=>$tag, 'ship_note'=>''};
	      $i++;
		}  
	}

   return wantarray ? @rtn_lst : \@rtn_lst;
}

# - - - - - - - - - - - - - - -
sub gen_int_rate_request_xml
{
   my $self = shift; 
	my $args = shift;

	my $rqst = <<END; 
<IntlRateRequest USERID="$self->{usr_id}">
    <Package ID="1">
        <Pounds>$args->{'pounds'}</Pounds>
        <Ounces>$args->{'oz'}</Ounces>
        <MailType>Package</MailType>
        <ValueOfContents>$args->{'value'}</ValueOfContents>
        <Country>$args->{'country'}</Country>
    </Package>
</IntlRateRequest>
END

  #$rqst =~ s/\n//g;
  return $rqst;
}

# - - - - - - - - - - - - - - -
sub gen_dom_rate_request_xml
{
   my $self = shift; 
	my $args = shift;
 
	my $rqst = <<END;
<RateV3Request USERID="$self->{usr_id}">
    <Package ID="1">
        <Service>ALL</Service>
        <ZipOrigination>$args->{'src_zip'}</ZipOrigination>
        <ZipDestination>$args->{'dst_zip'}</ZipDestination>
        <Pounds>$args->{'pounds'}</Pounds>
        <Ounces>$args->{'oz'}</Ounces>
        <Size>$args->{'size'}</Size>
        <Machinable>true</Machinable>
    </Package>
</RateV3Request>
END

  #$rqst =~ s/\n//g;
  return $rqst;
}


# - - - - - - - -
sub get_zip_test
{
   my $self = shift; 
	my $args = shift;

	my $rqst = <<END;
http://production.shippingapis.com/ShippingAPITest.dll?API=CityStateLookup
&XML=<CityStateLookupRequest USERID="$self->{usr_id}">
<ZipCode ID= "0"><Zip5>90210</Zip5></ZipCode></CityStateLookupRequest>
<?xml version="1.0"?>
<CityStateLookupResponse><ZipCode ID="0"><Zip5>90210</Zip5>
<City>BEVERLY HILLS</City><State>CA</State></ZipCode>
</CityStateLookupResponse>
END

  #$rqst =~ s/\n//g;
  return $rqst;
}

# - - - - - - 
sub err_msg
{
  my $self = shift @_; 
  return $self->{err_msg}; 
}


# Autoload methods go after =cut, and are processed by the autosplit program.

1;
__END__




# - - - - - - - - - - - - - - -
sub get_test
{
	my $self = shift @_;
	my %args = @_;

	my $xml_snd_doc = $self->get_zip_test();

	my $get_url = <<END;
http://testing.shippingapis.com/ShippingAPITest.dll?API=CityStateLookup
&XML=<CityStateLookupRequest USERID="$self->{usr_id}">
<ZipCode ID= "0"><Zip5>90210</Zip5></ZipCode>
</CityStateLookupRequest>

END
 
print $get_url; 

	my $response = $self->{UA}->get($get_url);

	unless ($response->is_success) 
	{
		$self->{'err_msg'} = "Error Request: " . $response->status_line;
      return 0; 
	}
  
	# Must be success let's parse 

	my $rtn = $response->as_string;
	print $rtn; 

	return 1;
 }


# - - - - - - - - - - - - - - -
sub gen_int_rate_request_xml_test
{
   my $self = shift; 
	my $args = shift;

	my $rqst = <<END;
<IntlRateRequest USERID="$self->{usr_id}">
    <Package ID="1ST">
        <Pounds>3</Pounds>
        <Ounces>3</Ounces>
        <Machinable>false</Machinable>
        <MailType>Envelope</MailType>
        <Country>Canada</Country>
    </Package>
    <Package ID="2ND">
        <Pounds>4</Pounds>
        <Ounces>3</Ounces>
        <MailType>Package</MailType>
        <GXG>
            <Length>46</Length>
            <Width>14</Width>
            <Height>15</Height>
            <POBoxFlag>N</POBoxFlag>
            <GiftFlag>N</GiftFlag>
        </GXG>
        <ValueOfContents>250</ValueOfContents>
        <Country>Japan</Country>
    </Package>
</IntlRateRequest>
END

  #$rqst =~ s/\n//g;
  return $rqst;
}




















# Below is stub documentation for your module. You'd better edit it!

=head1 NAME

Business::USPS::RateRequest - Perl extension for getting available rates from USPS using their Web Services API. 

=head1 SYNOPSIS

	use Business::USPS::RateRequest;

	use Data::Dumper;

	# Get your account/meter/key/password numbers from USPS 
	my %rate_args; 
	$rate_args{'account'}  = '_your_account_number_'; 
	$rate_args{'meter'}    = '_your_meter_number_';  
	$rate_args{'key'}      = '_your_key_';
	$rate_args{'password'} = '_your_password_';

	$rate_args{'uri'}      = 'https://gatewaybeta.USPS.com:443/xml/rate';

	my $Rate = new Business::USPS::RateRequest(%rate_args);

	my %ship_args;
	$ship_args{'src_zip'} = '83835'; 
	$ship_args{'dst_zip'} = '55411'; 
	$ship_args{'weight'} = 5; 

	my $rtn = $Rate->get_rates(%ship_args);

	if ( $rtn )	{ print Dumper $rtn }
	else        { print $Rate->err_msg() }  

Should return something like

	$VAR1 = [
          {
            'ship_cost' => '112.93',
            'ServiceType' => 'FIRST_OVERNIGHT'
          },
          {
            'ship_cost' => '48.91',
            'ServiceType' => 'PRIORITY_OVERNIGHT'
          },
          {
            'ship_cost' => '75.04',
            'ServiceType' => 'STANDARD_OVERNIGHT'
          },
          {
            'ship_cost' => '42.84',
            'ServiceType' => 'USPS_2_DAY'
          },
          {
            'ship_cost' => '28.81',
            'ServiceType' => 'USPS_EXPRESS_SAVER'
          },
          {
            'ship_cost' => '7.74',
            'ServiceType' => 'USPS_GROUND'
          }
        ];


=head1 DESCRIPTION

This object uses a simple XML/POST instead of the slower and more complex Soap based method to obtain 
available rates between two zip codes for a given package weight and size.  At the time of this writing 
USPS evidently encourages the use of Soap to get available rates and provides source code examples for 
Java, PHP, C# but no Perl. USPS doesn't provide non-Soap XML examples that I could find. Took me a 
while to develop the XML request but it returns results faster than the PHP Soap method.

The XML returned is voluminous, over 30k bytes to return a few rates, but is smaller 
than the comparable Soap results.

The URI's are not published anywhere I could find but I was successful in using  

Test:		https://gatewaybeta.USPS.com:443/xml/rate 
Production:	https://gateway.USPS.com:443/xml

Early Beta modules and notes may be available at:  

http://perlworks.com/cpan

If you use this module and have comments or suggestions please let me know.  

=head1 METHODS

=over 4

=item $obj->new(%hash)

The new method is the constructor.  

The input hash must include the following:

   uri 		=> USPS URI (test or production)      	  
   account 	=> USPS Account    
   meter 	=> USPS Meter Number     	  
	key 		=> USPS Key        
   password => USPS Password   

=item $obj->get_rates(%hash)

The input must include the following 

  	src_zip => Source Zip Code 
	dst_zip => Source Zip Code
	weight  => Package weight in lbs

However the following are optionally and can override the defaults as noted

   unless ( $args{'src_country'}  ) { $args{'src_country'} = 'US' }  
   unless ( $args{'dst_country'}  ) { $args{'dst_country'} = 'US' } 
   unless ( $args{'weight_units'} ) { $args{'weight_units'} = 'LB'} 
   unless ( $args{'size_units'}   ) { $args{'lnght_units'} = 'IN' } 
   unless ( $args{'length'}       ) { $args{'length'} = '5' } 
   unless ( $args{'width'}        ) { $args{'width'}  = '5' } 
   unless ( $args{'height'}       ) { $args{'height'} = '5' } 

=item $obj->err_msg()

=back

Returns last posted error message. Usually checked after a 
false return from one of the methods above. 

=head1 EXPORT

None by default.

=head1 SEE ALSO

Business::USPS::DirectConnect may work but I could not find the URI to use with this 
method and I found out that the Ship Manager API is depreciated and will be turned 
off in 2012 

=head1 AUTHOR

Steve Troxel, E<lt>troxel @ REMOVEMEperlworks.com E<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2010 by Steven Troxel 

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.8 or,
at your option, any later version of Perl 5 you may have available.


=cut