| Subject: | WWW::UPS::Detail doesn't work with current UPS site May 2012 |
Hi,
Firstly thanks for writing this module. I had a vague interest in
automating the tracking of a few parcels and was slightly disappointed
to find almost all the other modules require a UPS API account, and it
seems that requires a full blown UPS account, which is more hassle than
it's worth as I generally only receive rather than send parcels.
I looked at your WWW::UPS::Detail module, and also Business::UPS and
both currently fail, from the looks of things because UPS have tweaked
their site a bit. Yours looked easier to fix, less tied into the old
layout and perhaps a bit more rugged.
I've created a patch which seems to fix almost everything, although I
don't currently get "location" from delivered parcels, I'm not sure if
that's an error on my part, exactly which location it's supposed to
contain, or if it's something that's only relevant to parcels that are
in transit.
If you could apply this to the package if you're happy with it, that
would be great. Let me know if you need any more info from me.
Thanks and regards,
PN
---------------------------------------------------------
diff -urpN WWW/UPS/Detail.pm.orig WWW/UPS/Detail.pm
--- WWW/UPS/Detail.pm.orig 2010-11-05 06:29:43.000000000 +0000
+++ WWW/UPS/Detail.pm 2012-05-31 17:17:34.000000000 +0100
@@ -20,19 +20,28 @@ sub upscheck {
my $firstdata1 =
get("http://wwwapps.ups.com/ietracking/tracking.cgi?tracknum=$paketnummer&IATA=$language$lang");
my($loc) = ($firstdata1 =~ /<input type="hidden" name="loc"
value="([^"]*)"/);
my($hiddensession) = ($firstdata1 =~ /<INPUT
name="HIDDEN_FIELD_SESSION" type="HIDDEN" value="([^"]*)">/);
- my($detail) = ($firstdata1 =~ /<legend>Tracking
Information<\/legend>(.*)<form name="progressForm"
action="http:\/\/wwwapps.ups.com\/WebTracking\/detail" method="post">/s);
+ my($detail) = ($firstdata1 =~ /<h2>Tracking
Detail<\/h2>(.*)<form name="detailForm"
action="https?:\/\/wwwapps.ups.com\/WebTracking\/detail" method="post">/s);
$detail =~ s/[\n\r]//g;
$detail =~ s/\s\s*/ /g;
- my($paketnumber) = ($detail =~
/<dt><label>(?:Kontrollnummer|Tracking
Number):<\/label><\/dt>\s*<dd>(\w+)/);
- my($weight) = ($detail =~
/<dt><label>(?:Gewicht|Weight):<\/label><\/dt>\s*<dd>([\.\,\w\s]+)/);
- my($service) = ($detail =~
/<dt><label>Service:<\/label><\/dt>\s*<dd>([^<]*)<\/dd>/);
- my($type) = ($detail =~
/<dt><label>(?:Typ|Type):<\/label><\/dt>\s*<dd>([^<]*)<\/dd>/);
- my($deliveryto) = ($detail =~
/<dt><label>\s*(?:Ausgehändigt an|Delivered
To):\s*<\/label>\s*<\/dt>\s*<dd>([^<]*)<\/dd>/i);
+ my($paketnumber) = ($detail =~ /<dt><label(?>
for=""|)>(?:Kontrollnummer|Tracking Number):<\/label><\/dt>\s*<dd>(\w+)/);
+ if (!defined($paketnumber) || ($paketnumber eq "")) {
+ ($paketnumber) = ($detail =~ /<input type="hidden"
name="trackNums" value="([^"]+)">/i);
+ }
+ my($weight) = ($detail =~ /<dt><label(?>
for=""|)>(?:Gewicht|Weight):<\/label><\/dt>\s*<dd>([\.\,\w\s]+)/);
+ my($service) = ($detail =~ /<dt><label(?>
for=""|)>Service:<\/label><\/dt>\s*<dd>([^<]*)<\/dd>/);
+ if (!defined($service) || ($service eq "")) {
+ ($service) = ($detail =~ /<p><a href="[^"]*"
class="service">\s*([^<]*)\s*<\/a><\/p>/i);
+ }
+ $service =~ s/\xAE//g;
+ my($type) = ($detail =~ /<dt><label(?>
for=""|)>(?:Typ|Type):<\/label><\/dt>\s*<dd>([^<]*)<\/dd>/);
+ my($deliveryto) = ($detail =~ /<dt>\s*<label(?>
for=""|)>\s*(?:Ausgehändigt an|Delivered
To|To):\s*<\/label>\s*<\/dt>\s*<dd>\s*(?><strong>|)([^<]*)(?><\/strong>|)\s*<\/dd>/i);
+ $deliveryto =~ s/ / /g;
$deliveryto =~ s/^\s*//g;
$deliveryto =~ s/\s\s*/ /g;
$deliveryto =~ s/,\s*/, /g;
- my($location) = ($detail =~
/<dt><label>(?:Ort|Location):<\/label><\/dt>\s*<dd>([^<]*)<\/dd>/i);
- my($deliveryon) = ($detail =~ /<dt><label>\s*(?:Zugestellt
am|Delivered On):\s*<\/label>\s*<\/dt>\s*<dd>([^<]*)<\/dd>/i);
+ my($location) = ($detail =~ /<dt><label(?>
for=""|)>(?:Ort|Location):<\/label><\/dt>\s*<dd>([^<]*)<\/dd>/i);
+ my($deliveryon) = ($detail =~ /<dt><label(?>
for=""|)>\s*(?:Zugestellt am|Delivered
On):\s*<\/label>\s*<\/dt>\s*<dd>([^<]*)<\/dd>/i);
+ $deliveryon =~ s/ / /g;
$deliveryon =~ s/^\s*//g;
$deliveryon =~ s/\s\s*/ /g;
$deliveryon =~ s/,\s*/, /g;
@@ -40,8 +49,15 @@ sub upscheck {
$billedon =~ s/^\s*//g;
$billedon =~ s/\s\s*/ /g;
$billedon =~ s/,\s*/, /g;
- my($signedby) = ($detail =~ /(?:Unterschrieben von|Signed
By):\s*<\/label>\s*<\/dt>\s*<dd>([^<]*)<\/dd>/i);
+ my($signedby) = ($detail =~ /(?:Unterschrieben von|Signed
By):\s*<\/label>\s*<\/dt>\s*<d[dt]>([^<]*)<\/d[dt]>/i);
+ $signedby =~ s/[\n\r]//g;
+ $signedby =~ s/^\s*//g;
+ $signedby =~ s/\s\s*/ /g;
+ $signedby =~ s/,\s*/, /g;
my($laststatus) = ($detail =~
/"(?:st_del_de_de_pgx_hh_linkedText|st_del_en_us_pgx_hh_linkedText)"
class="pgx_hh_linkedText">\s*<b>\s*([^<]*)\s*<\/b>\s*<img/i);
+ if (!defined($laststatus) || ($laststatus eq "")) {
+ ($laststatus) = ($detail =~ /<div
id="ttc_tt_spStatus">\s*<!-- cms: id="[^">]*" actiontype="0"
-->\s*<h3>\s*([^<]*)\s*<\/h3>/i);
+ }
$laststatus =~ s/^\s*//g;
$laststatus =~ s/\s\s*/ /g;
$laststatus =~ s/,\s*/, /g;
@@ -71,7 +87,7 @@ sub upscheck {
while($data =~ /<tr(.*?)<\/tr>/ig){
my $detailone = $1;
- my($ort,$datum,$zeit,$daten) = ($detailone =~ /<td
nowrap VALIGN="top">([^<]*)<\/td>\s*<td nowrap
VALIGN="top">([^<]*)<\/td>\s*<td nowrap VALIGN="top">([^<]*)<\/td>\s*<td
VALIGN="top">([^<]*)<\/td>/);
+ my($ort,$datum,$zeit,$daten) = ($detailone =~
/<td[^>]*>([^<]*)<\/td>\s*<td[^>]*>([^<]*)<\/td>\s*<td[^>]*>([^<]*)<\/td>\s*<td[^>]*>([^<]*)<\/td>/);
next unless($daten);
$datum =~ s/\s\s*/ /g;
$datum =~ s/^\s*|\s*$//g;