#!/usr/bin/perl

## Perl script to get quotes from the Canada-Post Sell-Online service -- by Eugene Reimer 2009-Jan17;
##
## Generates nopERcart-format lines, in 2 forms:
##	--single-rule form:  for simplicity;
##	--multiple rules:  better for Size-limits, and better for nonlinear pricing;  (see the Weight-increments used in fitline routine)
##
## See also: notes in nopercart.js  (for me, also /books/BookProject-POSTAGErates-2007-06.htm)
##
## After installing Business::CanadaPost, I modified <INSTALLDIR>/Business-CanadaPost-1.04/lib/Business/CanadaPost.pm as follows:
##	(1) in routine getrequest, revised both 206.191.4.228 and 216.191.36.73 to sellonline.canadapost.ca  (still using port :30000);
##	(2) in routine buildXML, line 838, replaced sprintf-statement with several statements  <--just to avoid warning-msgs (HARDLY WORTH MENTIONING);
##	REINSTALLED:  make; sudo make install;  see <INSTALLDIR>/Business-CanadaPost-1.04/README  (for me <INSTALLDIR> is /pix/pkg)
##
## Still gets Warning: Argument "www.canadapost.ca/?Lang=en" isn't numeric in numeric eq (==) at /usr/lib/perl5/site_perl/5.8.6/Business/CanadaPost.pm line 801
##	FIXME: in routine parseXML OR _getdaysbetween -- the output from CanadaPost has changed...
##	NOTE: add -w to first line of this script, in order to see the warning-msgs
##
## I tried merchantid => 'CPC_NATIVE_ORCHID'  (and it works, rather to my surprise);
##	Parcels become approx 7% cheaper;  and a 4th method (Expedited US Business) shows up, costing slightly more than the 3rd (Expedited US Commercial);
##	I went back to 'CPC_DEMO_XML', since I want to charge non-discounted rates, whereas CPC_NATIVE_ORCHID is getting the VentureOne discount;
##	hmm, is there any danger in letting other people know our "account-name"??
##	also the distinction between "Expedited US Business" and "Expedited US Commercial" seems anomalous rather than useful...
##
## NOTE: the Sell-Online lookup is only for SP + Parcel rates -- IS USELESS for OSL, LP Grumble, Grumble:-(
##
## NOTE: 2009 prices for OSL within Canada:  http://www.canadapost.ca/textonly/common/offerings/lettermail/can/rates-e.asp	<--without "/common" works too
## NOTE: 2009 prices for OSL to USA|Intl:    http://www.canadapost.ca/textonly/common/offerings/lettermail/int/rates-e.asp	<--without "/common" works too
##
## NOTE: 2009 prices for Parcel      |OSL in-CA:   http://www.canadapost.ca/textonly/tools/pg/prices/CPcanada-e.asp	<--Parcel in popup: SellOnline is  1% lower??
## NOTE: 2009 prices for Parcel|SP|LP|OSL to-USA:  http://www.canadapost.ca/textonly/tools/pg/prices/CPusa-e.asp	<--ExpeditedParcel: SellOnline is 10% lower??
## NOTE: 2009 prices for Parcel|SP|LP|OSL to-Int:  http://www.canadapost.ca/textonly/tools/pg/prices/CPinter-e.asp	<--         Parcel: SellOnline is  3% lower??
##
## To my surprise:  Parcel quotes with Size at the limit for SmallPacket were subject to the "volumetric weight" rules, ie: 1kg..4kg cost the same as 4.5kg==!!==
##	DEFINITION: Volumetric-Weight = volume * g/6cm**3;  eg: for 32x23x35cm the VolWt = 4.3kg  <--agrees with the 4.5kg observed;
##	==> Size-limit for parcel categories:  33.6x23.4xH  where H=Wt*6/(33.6*23.4)  so that L*W*H/6=Wt
##	Max-Size for Parcel: Length<=2m, Length+Girth<=2.74m, or L+2W+2H<=274cm  <--comes into play for 25kg and 30kg parcels;
##
## BUGGER-FACTORS needed to get quotes close to reality:
##	Canada: 1.0112;  USA: 1.1012;  International: 1.0292  (roughly 1% for Canada, 10% for USA, 3% for International);
##	these were derived 2009-01-20 using 1, 5 kg pkgs for Canada; 1.5, 5 kg for USA; 2.5, 5 kg for International;
##
## 2010-01-12:  reran for revised rates;  ==have not rechecked the Bugger-Factors (MULT-params) needed with 2010 rates;
##	NEW: Within-Canada, OSL now has 2 additional rates: for up-to-300g, up-to-400g;  have revised R-param from 3-->5 to make room for them;

use Business::CanadaPost;
use Statistics::OLS;

sub getquote {my ($Ln,$Wd,$Ht,$Wt,$FromZip,$City,$State,$Zip,$Cntry) = @_;			##Ln,Wd,Ht in cm; Wt in g; need Zip in Canada; State in Canada|USA
   my $shiprequest = Business::CanadaPost->new(	merchantid	=> 'CPC_DEMO_XML',		##use CPC_NATIVE_ORCHID to get VentureOne-discounted prices
						frompostalcode	=> $FromZip,
						language	=> 'en',
						turnaroundtime	=> 0,
						totalprice	=> 0.00,
						testing		=> 1		);
   
   $shiprequest->additem(			quantity	=> 1,
						length		=> $Ln,
						width		=> $Wd,
						height		=> $Ht,
						weight		=> $Wt/1000,			##CanadaPost gets weight in kg
						description	=> 'box of stuff',
						readytoship	=> 1		);

   $shiprequest->settocity(		$City	);
   $shiprequest->setprovstate(		$State	);
   $shiprequest->settopostalzip(	$Zip	);
   $shiprequest->setcountry(		$Cntry	);

   $shiprequest->getrequest() || printf("Failed: %s\n", $shiprequest->geterror());		##get quote from Canada-Post

   my $PkgDesc = sprintf("%-17s %5dg  from %s  to %-19.19s", sprintf("%.1fx%.1fx%.1fcm",$Ln,$Wd,$Ht), $Wt, $FromZip, $City." ".$State." ".($Zip?$Zip:$Cntry));
   #for($J=1; $J<=$shiprequest->getoptioncount(); ++$J) {printf("%d: shipname:%-30s shiprate:%.2f\n", $J, $shiprequest->getshipname($J), $shiprequest->getshiprate($J));}
   my $K=1;
   for($J=2; $J<=$shiprequest->getoptioncount(); ++$J) {if($shiprequest->getshiprate($J)<$shiprequest->getshiprate($K)) {$K=$J;}}	##find K index of lowest price
   return ($PkgDesc, $shiprequest->getshipname($K), $shiprequest->getshiprate($K));
}

sub showquote {my ($Ln,$Wd,$Ht,$Wt,$FromZip,$City,$State,$Zip,$Cntry) = @_;			##Ln,Wd,Ht in cm; Wt in g; need Zip in Canada; need State in Canada|USA
   my ($PkgDesc,$Name,$Price) = getquote($Ln,$Wd,$Ht,$Wt,$FromZip,$City,$State,$Zip,$Cntry);
   printf("%s  as %-16.16s  costs %5.2f\n", $PkgDesc, $Name, $Price);
   return ($PkgDesc,$Name,$Price);
}
sub maxHt {my ($Wt,$Ln,$Wd) = @_;								##returns max-Height for specified Weight, Length, Width
   my $Ht=$Wt*6/$Ln/$Wd, $HtLim=274-2*$Ln-2*$Wd;						##Height-limit is Weight*6 over Length*Width,  but at most 274-2L-2W
   return $Ht<$HtLim ? $Ht : $HtLim;								##return max-Height
}
sub nW {my ($W) = @_;										##returns next Weight for an increasing-increment loop
   return $W<=3500 ?$W+500 : $W<=7000 ?$W+1000 : $W<=10000 ? $W+2000 : $W==12000 ? 15000 : $W+5000;	##500g incs to 4kg, 1kg to 8kg, 2kg to 12kg, then 15,20,25,30
}
sub fitline {my ($Ln,$Wd,$WtBeg,$WtEnd,$FromZip,$City,$State,$Zip,$Cntry,$MULT,$Z,$R) = @_;	##computes straight-line A+B*weight approximation, using Statistics::OLS
   ##==note: Ht is derived here, using maxHt routine
   ##==note: WtInc supplied here, using nW routine -- for increasing increments: 500g til 4kg, then 1kg, then 2kg, then 5kg...
   my @Wt=(),@De=(),@Nm=(),@Pr=(),$Ht,$E;
   for($I=0,$W=$WtBeg; $W<=$WtEnd; $W=nW($W),++$I) {$Wt[$I]=$W; ($De[$I],$Nm[$I],$Pr[$I])= getquote($Ln,$Wd,$Ht=maxHt($W,$Ln,$Wd),$W,$FromZip,$City,$State,$Zip,$Cntry);}
   for($I=0,$W=$WtBeg; $W<=$WtEnd; $W=nW($W),++$I) {$Pr[$I] *= $MULT;}								##==APPLY BUGGER-FACTOR==
   my $ls = Statistics::OLS->new;
   $ls->setData(\@Wt,\@Pr) or die($ls->error());  $ls->regress() or die($ls->error());  my ($A,$B) = $ls->coefficients();	##curve-fit a straight-line
   $B*=500;															##convert to weight in 500g chunks
  #printf("====TO %s: Shipping-cost = \$%.3f + \$%.3f per 500g:\n", $Cntry, $A, $B);
  #for($I=0,$W=$WtBeg; $W<=$WtEnd; $W=nW($W),++$I) {$E=$A+$W/500*$B; printf("%s  as %-16.16s  costs %5.2f  est %.2f (%+.2f)\n",$De[$I],$Nm[$I],$Pr[$I],$E,$E-$Pr[$I]);}
   ##
   ##==Generate NOPERCART-format lines -- this routine is now misnamed:-)
   ##==as one line, for the A+Bw approximation:
   printf("====TO %s: AS SINGLE RULE, where Shipping-cost = \$%.3f + \$%.3f per 500g:\n", $Cntry, $A, $B);
   printf("  ShipTable[%d].pkginfo[%2d]=new PkgClass(99999, new Size(33.6,23.4,999.9), %5.2f, %5.3f,500,'');\t//P parcel\t\t\t\t\tCOND-DEMO1-NOCI\n", $Z,$R,$A,$B);
   ##==as multiple lines, for same Weight-increments used in fitline:
   ##==adding extra rules for pricing as multiple max-size|weight parcels -- same approach could be used to improve the single rule...
   printf("AS MULTIPLE RULES:\n");
   for($I=0,$W=$WtBeg; $W<=$WtEnd; $W=nW($W),++$I){
      $Ht=maxHt($W,$Ln,$Wd);  my $P=$Pr[$I];  ##if($W<$WtEnd) {$B=($Pr[$I+1]-$A)/($Wt[$I+1]-$W)*500;}
      printf("  ShipTable[%d].pkginfo[%2d]=new PkgClass(%5d, new Size(%4.1f,%4.1f,%5.1f),%6.2f, 0.00, 1,  '');\t//P parcel\t\t\t\t\tCOND-DEMO1-NOCI\n",$Z,$R+$I,$W,$Ln,$Wd,$Ht,$P);
   }
   for($K=2; $W=$WtEnd*$K, $W<=90000; ++$K,++$I){
      printf("  ShipTable[%d].pkginfo[%2d]=new PkgClass(%5d, new Size(%4.1f,%4.1f,%5.1f),%6.2f, %5.3f,500,'');\t//P parcel\t\t\t\t\tCOND-DEMO1-NOCI\n",$Z,$R+$I,$W,$Ln,$Wd,$Ht*$K,$A*$K,$B);
   }
}
#showquote(60,60,15,7000,'R2M0X3', 'New York','NY',''      ,'USA'      );			##test-case from Business::CanadaPost;  zip:11726 not needed
#showquote(22,15,1.5,300,'R2M0X3', 'Halifax' ,'NS','B3M4N9','Canada'   );			##useless, since Oversized-Letter is omitted
#showquote(22,15,1.5,300,'R2M0X3', 'Miami'   ,'FL',''      ,'USA'      );			##useless, since Oversized-Letter + Light-Packet are omitted
#showquote(22,15,1.5,300,'R2M0X3', 'Perth'   ,'WA',''      ,'Australia');			##useless, since Oversized-Letter + Light-Packet are omitted
#printf("\n");
#for($I=0,$W=1000; $W<=5000; $W+=500,$I+=1) {($D[$I],$N[$I],$P[$I]) = showquote(30,22,3,$W,'R2M0X3', 'Halifax','NS','B3M4N9','Canada'   );}	##Canada  1.0kg..5kg
#for($I=0,$W=1500; $W<=5000; $W+=500,$I+=1) {($D[$I],$N[$I],$P[$I]) = showquote(30,22,3,$W,'R2M0X3', 'Miami'  ,'FL',''      ,'USA'      );}  	##USA     1.5kg..5kg
#for($I=0,$W=2500; $W<=5000; $W+=500,$I+=1) {($D[$I],$N[$I],$P[$I]) = showquote(30,22,3,$W,'R2M0X3', 'Perth'  ,'WA',''      ,'Australia');}	##Intnl   2.5kg..5kg

fitline(33.6,23.4, 1000,30000, 'R2M0X3', 'Halifax','NS','B3M4N9','CANADA'   ,1.0112, 0,5);	##within-Canada  1.0kg..30kg;  2010-01:last-param 3->5;
fitline(33.6,23.4, 1500,30000, 'R2M0X3', 'Miami'  ,'FL',''      ,'USA'      ,1.1012, 1,5);	##to-USA         1.5kg..30kg
fitline(33.6,23.4, 2500,10000, 'R2M0X3', 'Perth'  ,'WA',''      ,'AUSTRALIA',1.0292, 2,6);	##International  2.5kg..10kg  (to-Australia only to 10kg)