r15927 - /scripts/qa/rss_upload.cgi

[gregoa-guest at users.alioth.debian.org]

Author: gregoa-guest
Date: Fri Feb 29 00:04:39 2008
New Revision: 15927

URL: http://svn.debian.org/wsvn/?sc=1&rev=15927
Log:
very first pre-alpha proof-of-idea version of a cgi script that outputs an rss feed of the packages needing an upload

Added:
    scripts/qa/rss_upload.cgi   (with props)

Added: scripts/qa/rss_upload.cgi
URL: http://svn.debian.org/wsvn/scripts/qa/rss_upload.cgi?rev=15927&op=file
==============================================================================
--- scripts/qa/rss_upload.cgi (added)
+++ scripts/qa/rss_upload.cgi Fri Feb 29 00:04:39 2008
@@ -1,0 +1,127 @@
+#!/usr/bin/perl
+# vim:ts=4:sw=4:et:ai:sts=4
+# $Id: qareport.cgi 15241 2008-02-20 21:15:53Z tincho-guest $
+#
+# RSS feed for packages that need upload
+#
+# Copyright Martín Ferrari <martin.ferrari at gmail.com>, 2007
+# Copyright Damyan Ivanov <dmn at debian.org>, 2007
+# Copyright gregor herrmann <gregor+debian at comodo.priv.at>, 2008
+# Released under the terms of the GNU GPL 2
+
+use strict;
+use warnings;
+
+use DebianQA::Cache;
+use DebianQA::Classification;
+use DebianQA::Config qw(read_config %CFG);
+use DebianQA::Svn;
+use CGI ();
+use CGI::Carp qw(fatalsToBrowser);
+use POSIX qw(locale_h);
+use Template ();
+use Date::Parse ();
+use File::Find ();
+use List::Util qw(max);
+use XML::RSS;
+use Encode;
+
+read_config();
+
+my $cgi = new CGI;
+
+my $cache = read_cache(consolidated => "");
+
+my @modified;
+# Find recent template files
+File::Find::find( { wanted => sub {
+            my $mtime = (stat)[9];
+            push @modified, $mtime if(-f _);
+        } }, $CFG{qareport_cgi}{templates_path} );
+my $script_date = '$Date$';
+push @modified, Date::Parse::str2time(
+    join(' ', (split(/ /, $script_date))[1..3]));
+push @modified, (stat $CFG{common}{cache_dir} . "/consolidated")[9];
+
+my $last_modified = max @modified;
+my @pkglist = get_pkglist();
+my $cls = classify(@pkglist);
+
+my( @for_upload );
+
+foreach my $pkg (sort keys %$cls)
+{
+    my $data = $cls->{$pkg};
+
+    my $dest;   # like "destiny" :)
+    my $status = $data->{status};   # to save some typing
+
+    $dest ||= \@for_upload if($status->{needs_upload});
+
+    push @$dest, $data;
+}
+
+if( $ENV{GATEWAY_INTERFACE} )
+{
+    my $htmlp = $cgi->Accept("text/html");
+    my $xhtmlp = $cgi->Accept("application/xhtml+xml");
+
+    my $ims = $cgi->http('If-Modified-Since');
+    $ims = Date::Parse::str2time($ims) if $ims;
+
+    if( $ims and $ims >= $last_modified )
+    {
+        print $cgi->header('text/html', '304 Not modified');
+        exit 0;
+    }
+
+    my $old_locale = setlocale(LC_TIME);
+    setlocale(LC_TIME, "C");
+    print $cgi->header(
+        -content_type   => (
+                ($xhtmlp and $xhtmlp > $htmlp)
+                ? 'application/xhtml+xml; charset=utf-8'
+                : 'text/html; charset=utf-8'
+            ),
+        -last_modified   => POSIX::strftime(
+            "%a, %d %b %Y %T %Z",
+            localtime($last_modified),
+        ),
+        $cgi->param("refresh") ? (-refresh => $cgi->param("refresh")) : (),
+    );
+    setlocale(LC_TIME, $old_locale);
+}
+
+# use Data::Dumper; print Dumper @for_upload;
+
+my $rss = new XML::RSS (version => '2.0');
+
+$rss->channel(
+    title          => "$CFG{qareport_cgi}{group_name} -- ready for upload",
+    link           => "$CFG{qareport_cgi}{group_url}",
+    description    => "Packages in the pkg-perl repository that need an upload",
+    pubDate        => POSIX::strftime("%a, %d %b %Y %T %z", localtime()),
+    language       => "en",
+    webMaster      => "$CFG{common}{group_email} ($CFG{qareport_cgi}{group_name})",
+    copyright      => "Copyright " . POSIX::strftime("%Y", localtime()) . " $CFG{qareport_cgi}{group_name}",
+);
+
+foreach my $pkg ( @for_upload )
+{
+    $pkg->{svn}->{changer} =~ s/</&lt;/;
+    $pkg->{svn}->{changer} =~ s/>/&gt;/;
+    $rss->add_item(
+       title       => "$pkg->{name}",  
+       link        => sprintf($CFG{qareport_cgi}{wsvn_url}, $pkg->{name}),
+       description => "$pkg->{archive}->{most_recent} -> $pkg->{svn}->{version},\n" .
+                      decode_utf8($pkg->{svn}->{changer}) . ", $pkg->{svn}->{date}\n",
+       guid        => "$CFG{svn}{repository} revision $pkg->{svn}->{'/stamp'}",
+     );
+
+# use Data::Dumper; print Dumper $pkg;
+}
+
+print $rss->as_string;
+
+exit 0;
+

Propchange: scripts/qa/rss_upload.cgi
------------------------------------------------------------------------------
    svn:executable = *

Propchange: scripts/qa/rss_upload.cgi
------------------------------------------------------------------------------
    svn:keywords = Date