SF.net SVN: ledger-smb: [97] trunk/setup.pl

[..hidden..]

Revision: 97
          http://svn.sourceforge.net/ledger-smb/?rev=97&view=rev
Author:   einhverfr
Date:     2006-09-14 23:32:53 -0700 (Thu, 14 Sep 2006)

Log Message:
-----------
Adding some corrections to the setup.diff.  Will need to note that the setup.pl
is and will remain EXPERIMENTAL for the next version or two.

Modified Paths:
--------------
    trunk/setup.pl

Modified: trunk/setup.pl
===================================================================
--- trunk/setup.pl	2006-09-15 06:20:21 UTC (rev 96)
+++ trunk/setup.pl	2006-09-15 06:32:53 UTC (rev 97)
@@ -36,14 +36,15 @@
 #not sure how safe this is. If the browser sends a blank HTTP_USER_AGENT
 #will this script destroy part of the install? 
 #This script should probably be made inaccessible via HTTP until this feature is working
-if ($ENV{HTTP_USER_AGENT}) {
+if (($ENV{HTTP_USER_AGENT})||($ENV{HTTP_HOST})) {
 	print "Content-type: text/html\n\nThis does not work yet! use $0 from the command line";
 	exit;
 }
 
 # Make sure they have the required perl modules installed.
 # bin/mozilla/admin.pl needs Digest::MD5 for session handling
-my @req_modules=(qw(DBI DBD::Pg Digest::MD5 ));
+# HTML:LinkExtor is used by the setup program.
+my @req_modules=(qw(DBI DBD::Pg Digest::MD5 HTML::LinkExtor));
 
 foreach my $module(@req_modules){
   print "Checking for: $module ...\t";
@@ -70,12 +71,15 @@
   }
 }
 
+use HTML::LinkExtor;
+
+
 $lynx = `lynx -version`;      # if LWP is not installed use lynx
 $gzip = `gzip -V 2>&1`;            # gz decompression utility
 $tar = `tar --version 2>&1`;       # tar archiver
 $latex = `latex -version`;
 
-%checkversion = ( www => 3, abacus => 4, pluto => 5, neptune => 8 );
+my $versionurl ='http://prdownloads.sourceforge.net/ledger-smb';
 
 %source = (
 	    1 => { url => "http://voxel.dl.sourceforge.net/sourceforge/ledger-smb";, site => "New York, U.S.A", locale => 'us' },
@@ -113,7 +117,6 @@
 if ($filename) {
   # extract version
   die "Not a Ledger-SMB archive\n" if ($filename !~ /^ledger-smb/);
-  
   $version = $filename;
   $version =~ s/ledger-smb-(\d+\.\d+\.\d+).*$/$1/;
 
@@ -272,36 +275,26 @@
     print "skipping, filename supplied\n";
     return;
   }
-
+  my $urlresult = '';
   if ($lwp) {
-    foreach $source (qw(pluto www abacus neptune)) {
-      $url = $source{$checkversion{$source}}{url};
-      print "\n$source{$checkversion{$source}}{site} ... ";
-
-      $latest_version = LWP::Simple::get("$url/latest_version");
-      
-      if ($latest_version) {
-	last;
-      } else {
-	print "not found";
-      }
+    if ($urlresult = LWP::Simple::get("$versionurl")){
+      $latest_version = parse_links($urlresult);
+      last;
+    } else {
+      print "not found"; 
     }
   } else {
     if (!$lynx) {
       print "\nYou must have either lynx or LWP installed";
       exit 1;
     }
-
-    foreach $source (qw(pluto www abacus neptune)) {
-      $url = $source{$checkversion{$source}}{url};
-      print "\n$source{$checkversion{$source}}{site} ... ";
-      $ok = `lynx -dump -head $url/latest_version`;
-      if ($ok = ($ok =~ s/HTTP.*?200 //)) {
-	$latest_version = `lynx -dump $url/latest_version`;
-	last;
-      } else {
-	print "not found";
-      }
+    $ok = `lynx -dump -head $versionurl`;
+    if ($ok = ($ok =~ s/HTTP.*?200 //)) {
+      $urlresult = `lynx -dump $versionurl`;
+      $latest_version = parse_links($urlresult);
+      last;
+    } else {
+      print "not found";
     }
     die unless $ok;
   }
@@ -313,7 +306,29 @@
 
 }
 
+my @versions = ();
+sub parse_links{
+    # Take the html retrieved by lwp or lynx and look for the version numbers.
+    my $text = shift;
+    my $version = '';
+    my $p = HTML::LinkExtor->new(\&cb);
+    $p->parse($text) or die;
+    foreach (@versions){
+        my ($chkversion) = $_ =~ /^\/ledger-smb\/ledger-smb-(\d{1,3}\.\d{1,3}\.\d{1,3})\.tar\.gz$/;
+        $version = $chkversion if ($chkversion gt $version);
+    }
+    return $version;
+}
 
+sub cb {
+    # Callback function for LinkExtor
+    my($tag, %attr) = @_;
+    return if $tag ne 'a';
+    return unless $attr{href} =~ /^\/ledger-smb\/ledger-smb-\d{1,3}\.\d{1,3}\.\d{1,3}\.tar\.gz$/;
+    push(@versions, values %attr);
+
+}
+
 sub get_source_code {
 
   $err = 0;


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.