rmadison

diff --git a/TODO b/TODO
index 8c617a2f8ec14a70ae07f435869e2a12fc3189a4..53298b5f4dcffa6334e85a7e9b86cfe217c14802 100644 (file)
--- a/TODO
+++ b/TODO
@@ -1,4 +1,6 @@
-Do not screenscrape p.d.o use rmadison ?
+Cope with outside-main things (rmadison does not print pool path)
+
+Cope with non-Debian archives

 
 Make it possible to do dgit clone / fetch anonymously
 
 
 Make it possible to do dgit clone / fetch anonymously
 

diff --git a/dgit b/dgit
index fef71e5493355de0410b046a190245e8e3d65408..7b5803aa82c1f641695743e2529019247a8f67d8 100755 (executable)
--- a/dgit
+++ b/dgit
@@ -10,8 +10,7 @@ use POSIX;
 
 open DEBUG, ">&STDERR" or die $!;
 
 
 open DEBUG, ">&STDERR" or die $!;
 

-our $pdo = 'http://packages.debian.org/';
-#our $mirror = 'http://mirror.relativity.greenend.org.uk/mirror/debian-ftp/';
+our $mirror = 'http://mirror.relativity.greenend.org.uk/mirror/debian-ftp/';

 our $suite = 'sid';
 our $package;
 
 our $suite = 'sid';
 our $package;
 


@@ -65,17 +64,18 @@ sub parsecontrol {
 }
 
 sub get_archive_dsc () {
 }
 
 sub get_archive_dsc () {

-    my $pdourl = "$pdo/source/$suite/$package";
-    my $pdodata = url_get($pdourl);
-    # FFS.  The Debian archive has no sane way to find what 
-    # version is currently the tip in any branch (aka, what
-    # is the current version in any suite).
-    $pdodata =~ m{
-        Download\ \Q$package\E .*
-        \<a\ href=\"([^"&]+([^"/]+\.dsc))\"\>\2\</a\>
-    }msx
-        or die "screenscraping of $pdourl failed :-(\n";
-    $dscurl = $1;
+    my $rmad = cmdoutput qw(rmadison -asource),"-s$suite",$package;
+    $rmad =~ m/^ \s*( [^ \t|]+ )\s* \|
+                 \s*( [^ \t|]+ )\s* \|
+                 \s*( [^ \t|]+ )\s* \|
+                 \s*( [^ \t|]+ )\s* /x or die "$rmad $?";
+    $1 eq $package or die "$rmad $package ?";
+    my $vsn = $2;
+    $3 eq $suite or die "$rmad $suite ?";
+    $4 eq 'source' or die "$rmad ?";
+    # fixme it does not show us the component ?
+    my $prefix = substr($package, 0, $package =~ m/^l/ ? 4 : 1);
+    $dscurl = "$mirror/pool/main/$prefix/$package/${package}_$vsn.dsc";

 #print DEBUG Dumper($pdodata, $&, $dscurl);
     $dscdata = url_get($dscurl);
     my $dscfh = new IO::File \$dscdata, '<' or die $!;
 #print DEBUG Dumper($pdodata, $&, $dscurl);
     $dscdata = url_get($dscurl);
     my $dscfh = new IO::File \$dscdata, '<' or die $!;