SHARE
TWEET

gpsr-update.pl

wwwtux Jan 2nd, 2013 93 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. #!/usr/bin/perl
  2.  
  3. use strict;
  4. use warnings;
  5.  
  6. use XML::Smart;
  7. use LWP::UserAgent;
  8. use HTTP::Request::Common;
  9.  
  10. =head1 NAME
  11.  
  12. gpsr-update -- Checks for software updates for GARMIN GPS handheld devices
  13. available on GARMIN web server and publishes appropriate notifications on
  14. Twitter.
  15.  
  16. =head1 DESCRIPTION
  17.  
  18. gpsr-update checks for software updates for GARMIN GPS handheld devices
  19. available on GARMIN web server and publishes appropriate notifications on
  20. Twitter. The script can handle various GARMIN devices, each has to be defined
  21. in a common XML file (devices.xml).
  22. Basically, gpsr-update immitates the communication of GARMINs software
  23. WebUpdater. The answer of the GARMIN server is checked for available software
  24. updates. Each software version is also stored in the XML file. If the script
  25. recognizes that a new software version, a new entry will be created in the XML
  26. file and a notification along with the links to the download and the release
  27. notes is published on Twitter. For the latter, the external program ttytter
  28. (http://www.floodgap.com/software/ttytter/) is used.
  29.  
  30. This work wouldn't be possible without the previous work of others.
  31. The basic functionality I copied from a bash script called "getgmn". The
  32. author is called "Paul". The script can be found here:
  33.   http://www.sbrk.co.uk/getgmn
  34.   https://gitorious.org/quickroute-git/gant/commit/36a8ba7/diffs
  35.  
  36. =cut
  37.  
  38. our $VERSION = '0.1';
  39.  
  40. =head1 VERSION
  41.  
  42. Version 0.1
  43.  
  44. =head1 SYNOPSIS
  45.  
  46. =cut
  47.  
  48. # Define some variables
  49. my $xml_file='devices.xml';
  50. my $LOG=1;
  51.  
  52. # Open the device configuration file
  53. my $xml=XML::Smart->new($xml_file);
  54. $xml=$xml->{devices};
  55.  
  56. # Create list of devices by part number
  57. my @devs=$xml->{device}('[@]','part_number');
  58.  
  59. # Loop through the devices
  60. foreach my $part_no (@devs)
  61. {
  62.     print "Device: $part_no\n";
  63.  
  64.     # If parameter active is set to 'yes' then go ahead polling
  65.     # Garmin for update of device software
  66.     my $active=$xml->{device}('part_number','eq',$part_no){'active'} || 'no';
  67.     if ($active=~ /yes/i)
  68.     {  
  69.         # Extract parameters for the HTTP request string
  70.         my $name=$xml->{device}('part_number','eq',$part_no)
  71.         {'name'} || '>>Unknown Device<<';
  72.         my $ttype=$xml->{device}('part_number','eq',$part_no)
  73.         {'parameter'}{'transfer_type'} || 'USB';
  74.         my $regid=$xml->{device}('part_number','eq',$part_no)
  75.         {'parameter'}{'region_id'} || '1';
  76.         my $vmaj=$xml->{device}('part_number','eq',$part_no)
  77.         {'parameter'}{'vmaj'} || '1';
  78.         my $vmin=$xml->{device}('part_number','eq',$part_no)
  79.         {'parameter'}{'vmin'} || '0';
  80.         my $btype=$xml->{device}('part_number','eq',$part_no)
  81.         {'parameter'}{'build_type'} || 'Release';
  82.  
  83.         print "Check for device $part_no ($name) ...\n" if ($LOG);
  84.  
  85.         # Extract a list of the software versions by MD5 already found
  86.         my @sw=$xml->{device}{software}('[@]','md5');
  87.  
  88.         # Build the HTTP request and submit to GARMIN server
  89.         my $ret=request($part_no, $ttype, $regid, $vmaj, $vmin, $btype);
  90.         my $md5=${$ret}{'md5'};
  91.  
  92.         # Now check the MD5. First, if there is a valid answer from GARMIN
  93.         # server, this entry in the data structure is not empty. Second,
  94.         # check, if we already have the software version. If not, then add
  95.         # to XML structure and compose a message for Twitter.
  96.         if (! $md5 eq '')
  97.         {
  98.             if (grep { $_ eq $md5 } @sw)
  99.             {
  100.                 print "  Software version ${$ret}{'vmaj'}.${$ret}{'vmin'} found. Already notified.\n"
  101.                     if ($LOG);
  102.             } else
  103.             {
  104.                 print "  Software version ${$ret}{'vmaj'}.${$ret}{'vmin'} found. Uh yeah, new version!\n"
  105.                     if ($LOG);
  106.                 my $new_sw={'vmaj'=>${$ret}{'vmaj'},
  107.                             'vmin'=>${$ret}{'vmin'},
  108.                             'file'=>${$ret}{'file'},
  109.                             'info'=>${$ret}{'info'},
  110.                             'size'=>${$ret}{'size'},
  111.                             'md5'=>$md5};
  112.                 push(@{$xml->{device}('part_number','eq',$part_no){'software'}}, $new_sw);
  113.                 $xml->save($xml_file);
  114.  
  115.                 twitter($name, ${$ret}{'file'}, ${$ret}{'info'});
  116.             }
  117.         }
  118.  
  119.     } else
  120.     {
  121.         print "Skip device $part_no\n" if ($LOG);
  122.     }
  123. }
  124.  
  125.  
  126. ################################################################################
  127.  
  128. =head1 SUBROUTINES/METHODS
  129.  
  130. =head2 request
  131.  
  132. Sends a request to check for the latest software version for a given device
  133. ($part_no) to the GARMIN server. Returns a structure reference with the
  134. appropriate information.  
  135.  
  136. =cut
  137.  
  138. sub request
  139. {
  140.     my ($part_no, $ttype, $regid, $vmaj, $vmin, $btype)=@_;
  141.  
  142.     # The request message
  143.     my $msg="req=<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"no\" ?>
  144.              <Requests xmlns=\"http://www.garmin.com/xmlschemas/UnitSoftwareUpdate/v3\">
  145.                <Request>
  146.                  <PartNumber>$part_no</PartNumber>
  147.                  <TransferType>$ttype</TransferType>
  148.                  <Region>
  149.                    <RegionId>$regid</RegionId>
  150.                    <Version>
  151.                      <VersionMajor>$vmaj</VersionMajor>
  152.                      <VersionMinor>$vmin</VersionMinor>
  153.                      <BuildType>$btype</BuildType>
  154.                    </Version>
  155.                  </Region>
  156.                </Request>
  157.              </Requests>";
  158.  
  159.     # Poll the GARMIN server
  160.     my $userAgent = LWP::UserAgent->new(agent => 'perl post');
  161.     my $url="http://www.garmin.com/support/WUSoftwareUpdate.jsp";
  162.     my $response = $userAgent->request(POST $url,
  163.       Content_Type => 'application/x-www-form-urlencoded',
  164.       Content => $msg);
  165.  
  166.     # Check the response and extract data when possible
  167.     my $ret;
  168.     if ($response->is_success && $response->as_string=~m/.*<Update>.+<\/Update>.*/)
  169.     {
  170.         my $ref = $response->as_string;
  171.  
  172.         my $vmaj=$1 if ($ref=~m/.*<VersionMajor>(\d+)<\/VersionMajor>.*/);
  173.         my $vmin=$1 if ($ref=~m/.*<VersionMinor>(\d+)<\/VersionMinor>.*/);
  174.         my $file=$1 if ($ref=~m/.*<Location>(.+)<\/Location>.*/);
  175.         my $info=$1 if ($ref=~m/.*<AdditionalInfo>(.+)<\/AdditionalInfo>.*/);
  176.         my $size=$1 if ($ref=~m/.*<Size>(\d+)<\/Size>.*/);
  177.         my $md5=$1 if ($ref=~m/.*<MD5Sum>([\w\d]+)<\/MD5Sum>.*/);
  178.  
  179.         $ret={'md5'=>$md5,
  180.               'vmaj'=>$vmaj,
  181.               'vmin'=>$vmin,
  182.               'file'=>$file,
  183.               'info'=>$info,
  184.               'size'=>$size};
  185.     } else
  186.     {
  187.         # Sorry :( no result from GARMIN server.
  188.         $ret={'md5'=>'',
  189.               'vmaj'=>'',
  190.               'vmin'=>'',
  191.               'file'=>'',
  192.               'info'=>'',
  193.               'size'=>''};
  194.     }
  195.  
  196.     return $ret;
  197. }
  198.  
  199. =head2 url_shortener
  200.  
  201. Accepts one URL, forwards it to the service http://is.gd and finally returns
  202. the shortened URL.
  203.  
  204. =cut
  205.  
  206. sub url_shortener
  207. {
  208.     my $long_url=shift;
  209.  
  210.     my $userAgent = LWP::UserAgent->new(agent => 'perl post');
  211.     my $serv_url="http://is.gd/api.php?longurl=$long_url";
  212.     my $response = $userAgent->request(POST $serv_url,
  213.       Content_Type => 'application/x-www-form-urlencoded',
  214.       Content => '');
  215.     my $short_url;
  216.     if ($response->is_success && $response->as_string=~m|.*(http://is.gd/.+)|)
  217.     {
  218.         $short_url=$1;
  219.     } else
  220.     {
  221.         $short_url='';
  222.     }
  223.  
  224.     return $short_url;
  225. }
  226.  
  227. =head2 twitter
  228.  
  229. Compiles and submits a update notification message to Twitter. As up to now,
  230. this routine uses the external program ttytter for the communication with the
  231. Twitter service. In a later version this will be replaced by using Net::Twitter
  232. or similar.
  233.  
  234. =cut
  235.  
  236. sub twitter
  237. {
  238.     my ($devname, $file, $info)=@_;
  239.  
  240.     # $file and $info contain URLs. Shorten them:
  241.     my $file_sh=url_shortener($file);
  242.     my $info_sh=url_shortener($info);
  243.  
  244.     my $msg="Update available for device $devname. Download: $file_sh. Change Log: $info_sh.";
  245.     my $len=length($msg);
  246.     #print "$msg ($len)\n" if ($LOG);
  247.  
  248.     print "  Send message to Twitter\n";
  249.     my $cmd="/usr/bin/ttytter -status=\"$msg\"";
  250.     system($cmd);
  251.    
  252. }
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!
 
Top