* Add Debbugs::SOAP::Status

[debbugs.git] / cgi / common.pl

diff --git a/cgi/common.pl b/cgi/common.pl
index e497787ff1733ea9a288c51dd4d87457c4c7d156..a98a570805c5a1a4bf280acfda181f60840d5d73 100644 (file)
--- a/cgi/common.pl
+++ b/cgi/common.pl
@@ -12,9 +12,13 @@ $config_path = '/etc/debbugs';
 $lib_path = '/usr/lib/debbugs';
 require "$lib_path/errorlib";
 
-use Debbugs::Packages;
+use Debbugs::Packages qw(:versions :mapping);
 use Debbugs::Versions;
 use Debbugs::MIME qw(decode_rfc1522);
+use Debbugs::Common qw(:util);
+use Debbugs::Status qw(:read :versions);
+use Debbugs::CGI qw(:all);
+
 
 $MLDBM::RemoveTaint = 1;
 
@@ -258,34 +262,11 @@ sub splitpackages {
     return map lc, split /[ \t?,()]+/, $pkgs;
 }
 
-my %_parsedaddrs;
-sub getparsedaddrs {
-    my $addr = shift;
-    return () unless defined $addr;
-    return @{$_parsedaddrs{$addr}} if exists $_parsedaddrs{$addr};
-    @{$_parsedaddrs{$addr}} = Mail::Address->parse($addr);
-    return @{$_parsedaddrs{$addr}};
-}
-
 # Generate a comma-separated list of HTML links to each package given in
 # $pkgs. $pkgs may be empty, in which case an empty string is returned, or
 # it may be a comma-separated list of package names.
 sub htmlpackagelinks {
-    my $pkgs = shift;
-    return unless defined $pkgs and $pkgs ne '';
-    my $strong = shift;
-    my @pkglist = splitpackages($pkgs);
-
-    my $openstrong  = $strong ? '<strong>' : '';
-    my $closestrong = $strong ? '</strong>' : '';
-
-    return 'Package' . (@pkglist > 1 ? 's' : '') . ': ' .
-           join(', ',
-                map {
-                    '<a href="' . pkgurl($_) . '">' .
-                    $openstrong . htmlsanit($_) . $closestrong . '</a>'
-                } @pkglist
-           );
+     return htmlize_packagelinks(@_);
 }
 
 # Generate a comma-separated list of HTML links to each address given in
@@ -293,20 +274,7 @@ sub htmlpackagelinks {
 # $urlfunc should be a reference to a function like mainturl or submitterurl
 # which returns the URL for each individual address.
 sub htmladdresslinks {
-    my ($prefixfunc, $urlfunc, $addresses) = @_;
-    if (defined $addresses and $addresses ne '') {
-        my @addrs = getparsedaddrs($addresses);
-        my $prefix = (ref $prefixfunc) ? $prefixfunc->(scalar @addrs)
-                                       : $prefixfunc;
-        return $prefix .
-               join ', ', map { sprintf '<a href="%s">%s</a>',
-                                        $urlfunc->($_->address),
-                                        htmlsanit($_->format) || '(unknown)'
-                              } @addrs;
-    } else {
-        my $prefix = (ref $prefixfunc) ? $prefixfunc->(1) : $prefixfunc;
-        return sprintf '%s<a href="%s">(unknown)</a>', $prefix, $urlfunc->('');
-    }
+     htmlize_addresslinks(@_);
 }
 
 # Generate a comma-separated list of HTML links to each maintainer given in
@@ -366,7 +334,6 @@ sub htmlindexentrystatus {
                 . htmlsanit(join(", ", sort(split(/\s+/, $status{tags}))))
                 . "</strong>"
                        if (length($status{tags}));
-
     my @merged= split(/ /,$status{mergedwith});
     my $mseparator= ";\nmerged with ";
     for my $m (@merged) {
@@ -429,11 +396,11 @@ sub urlargs {
     return $args;
 }
 
-sub submitterurl { pkg_etc_url(emailfromrfc822($_[0] || ""), "submitter"); }
-sub mainturl { pkg_etc_url(emailfromrfc822($_[0] || ""), "maint"); }
-sub pkgurl { pkg_etc_url($_[0] || "", "pkg"); }
-sub srcurl { pkg_etc_url($_[0] || "", "src"); }
-sub tagurl { pkg_etc_url($_[0] || "", "tag"); }
+sub submitterurl { pkg_url(submitter => emailfromrfc822($_[0] || "")); }
+sub mainturl { pkg_url(maint => emailfromrfc822($_[0] || "")); }
+sub pkgurl { pkg_url(pkg => $_[0] || ""); }
+sub srcurl { pkg_url(src => $_[0] || ""); }
+sub tagurl { pkg_url(tag => $_[0] || ""); }
 
 sub pkg_etc_url {
     my $ref = shift;
@@ -467,15 +434,6 @@ sub htmlsanit {
     return $in;
 }
 
-sub maybelink {
-    my $in = shift;
-    if ($in =~ /^[a-zA-Z0-9+.-]+:/) { # RFC 1738 scheme
-       return qq{<a href="$in">} . htmlsanit($in) . '</a>';
-    } else {
-       return htmlsanit($in);
-    }
-}
-
 sub bugurl {
     my $ref = shift;
     my $params = "bug=$ref";
@@ -959,37 +917,6 @@ sub buggyversion {
     return $tree->buggy($ver, \@found, \@fixed);
 }
 
-my %_versions;
-sub getversions {
-    my ($pkg, $dist, $arch) = @_;
-    return () unless defined $debbugs::gVersionIndex;
-    $dist = 'unstable' unless defined $dist;
-
-    unless (tied %_versions) {
-        tie %_versions, 'MLDBM', $debbugs::gVersionIndex, O_RDONLY
-            or die "can't open versions index: $!";
-    }
-
-    if (defined $arch and exists $_versions{$pkg}{$dist}{$arch}) {
-        my $ver = $_versions{$pkg}{$dist}{$arch};
-        return $ver if defined $ver;
-        return ();
-    } else {
-        my %uniq;
-        for my $ar (keys %{$_versions{$pkg}{$dist}}) {
-            $uniq{$_versions{$pkg}{$dist}{$ar}} = 1 unless $ar eq 'source';
-        }
-        if (%uniq) {
-            return keys %uniq;
-        } elsif (exists $_versions{$pkg}{$dist}{source}) {
-            # Maybe this is actually a source package with no corresponding
-            # binaries?
-            return $_versions{$pkg}{$dist}{source};
-        } else {
-            return ();
-        }
-    }
-}
 
 sub getversiondesc {
     my $pkg = shift;