diff options
| -rwxr-xr-x | dgit | 42 |
1 files changed, 26 insertions, 16 deletions
@@ -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'; |