X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=dgit;h=2e67eb5be574b26115d412101be1956c314d9bfb;hp=088c5a23385018e093bf35db792c1f4a0fffef97;hb=b839e9edc77dde4c40f2a8479e1b42223852daee;hpb=1c6183785fa3a9f6fe60a55bb9ff200963b4e791 diff --git a/dgit b/dgit index 088c5a23..2e67eb5b 100755 --- a/dgit +++ b/dgit @@ -773,6 +773,25 @@ sub must_getcwd () { return $d; } +our %rmad; + +sub archive_query ($) { + my ($method) = @_; + my $query = access_cfg('archive-query','RETURN-UNDEF'); + $query =~ s/^(\w+):// or badcfg "invalid archive-query method \`$query'"; + my $proto = $1; + my $data = $'; #'; + { no strict qw(refs); &{"${method}_${proto}"}($proto,$data); } +} + +sub pool_dsc_subpath ($$) { + my ($vsn,$component) = @_; # $package is implict arg + my $prefix = substr($package, 0, $package =~ m/^l/ ? 4 : 1); + return "/pool/$component/$prefix/$package/".dscfn($vsn); +} + +#---------- `ftpmaster-api' archive query method (nascent) ---------- + sub archive_api_query_cmd ($) { my ($subpath) = @_; my @cmd = qw(curl -sS); @@ -794,22 +813,7 @@ sub archive_api_query_cmd ($) { return @cmd; } -our %rmad; - -sub archive_query ($) { - my ($method) = @_; - my $query = access_cfg('archive-query','RETURN-UNDEF'); - $query =~ s/^(\w+):// or badcfg "invalid archive-query method \`$query'"; - my $proto = $1; - my $data = $'; #'; - { no strict qw(refs); &{"${method}_${proto}"}($proto,$data); } -} - -sub pool_dsc_subpath ($$) { - my ($vsn,$component) = @_; # $package is implict arg - my $prefix = substr($package, 0, $package =~ m/^l/ ? 4 : 1); - return "/pool/$component/$prefix/$package/".dscfn($vsn); -} +#---------- `madison' archive query method ---------- sub archive_query_madison { return map { [ @$_[0..1] ] } madison_get_parse(@_); @@ -857,6 +861,8 @@ sub canonicalise_suite_madison { return $r[0][2]; } +#---------- `sshpsql' archive query method ---------- + sub sshpsql ($$$) { my ($data,$runeinfo,$sql) = @_; if (!length $data) { @@ -930,6 +936,8 @@ END return $rows[0]; } +#---------- `dummycat' archive query method ---------- + sub canonicalise_suite_dummycat ($$) { my ($proto,$data) = @_; my $dpath = "$data/suite.$isuite"; @@ -969,6 +977,8 @@ sub archive_query_dummycat ($$) { return sort { -version_compare($a->[0],$b->[0]); } @rows; } +#---------- archive query entrypoints and rest of program ---------- + sub canonicalise_suite () { return if defined $csuite; fail "cannot operate on $isuite suite" if $isuite eq 'UNRELEASED';