r11876 - /scripts/qa/DebianQA/Svn.pm

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

Author: tincho-guest
Date: Mon Dec 31 06:10:37 2007
New Revision: 11876

URL: http://svn.debian.org/wsvn/?sc=1&rev=11876
Log:
Patch made by gwolf to start capturing data from debian/control.

Modified:
    scripts/qa/DebianQA/Svn.pm

Modified: scripts/qa/DebianQA/Svn.pm
URL: http://svn.debian.org/wsvn/scripts/qa/DebianQA/Svn.pm?rev=11876&op=diff
==============================================================================
--- scripts/qa/DebianQA/Svn.pm (original)
+++ scripts/qa/DebianQA/Svn.pm Mon Dec 31 06:10:37 2007
@@ -27,6 +27,7 @@
 use DebianQA::Common;
 use DebianQA::Config '%CFG';
 use DebianQA::DebVersions;
+use Parse::DebControl;
 use SVN::Client;
 
 # Returns the list of changed directories
@@ -66,6 +67,7 @@
         info(scalar @dirlist, " directories to process");
     }
     my(%changed, %svn);
+
     if($force) {
         %changed = map({ $_ => 1 } @dirlist);
     } else {
@@ -90,7 +92,7 @@
             $svn->log([ $pkghome ], $cache_vers{$dir}, "HEAD", 1, 1,
                 sub {
                     foreach (keys %{$_[0]}) {
-                        $changed{$dir} = 1 if(m{/debian/(changelog|watch)$});
+                        $changed{$dir} = 1 if(m{/debian/(changelog|control|watch)$});
                     }
                 });
         }
@@ -102,21 +104,48 @@
     my @changed = keys %changed;
     foreach my $dir (@changed) {
         $dir =~ s{^/*(.*?)/*$}{$1};
+        my $debdir = "$svnpath/$dir$svnpostpath/debian";
         $svn{$dir} = {};
+
+        info("Retrieving control information for $dir");
+        my $control = get_svn_file($svn, "$debdir/control");
+
+        unless($control) {
+            $svn{$dir}{error} = "MissingControl";
+            next;
+        }
+
         info("Retrieving changelog for $dir");
-        my $changelog = get_svn_file($svn,
-            "$svnpath/$dir$svnpostpath/debian/changelog");
+        my $changelog = get_svn_file($svn, "$debdir/changelog");
 
         unless($changelog) {
-            $svn{$dir}{error} = "Missing";
-            next;
-        }
+            $svn{$dir}{error} = "MissingChangelog";
+            next;
+        }
+
+        # Parse::DebControl hands back a strange structure... A hash-like
+        # thing, where [0] includes the debian/control fields for the
+        # source package and [1] for the first binary package (and, were 
+        # they to exist, [2] and on for the other binary packages - which 
+        # we will wisely ignore)
+        my ($ctrl_data, $short, $long);
+        $ctrl_data = Parse::DebControl->new->parse_mem($control);
+        ($short, $long) = split_description($ctrl_data->[1]{Description});
+
+        $svn{$dir}{uploaders} = $ctrl_data->[0]{Uploaders};
+        $svn{$dir}{maintainer} = $ctrl_data->[0]{Maintainer};
+        $svn{$dir}{std_version} = $ctrl_data->[0]{'Standards-Version'};
+        $svn{$dir}{b_d} = $ctrl_data->[0]{'Build-Depends'};
+        $svn{$dir}{b_d_i} = $ctrl_data->[0]{'Build-Depends-Indep'};
+        $svn{$dir}{short_descr} = $short;
+        $svn{$dir}{long_descr} = $long;
+
         my $parser = Parse::DebianChangelog->init({
                 instring => $changelog });
         my $error = $parser->get_error() or $parser->get_parse_errors();
         if($error) {
             error($error);
-            $svn{$dir}{error} = "Invalid";
+            $svn{$dir}{error} = "InvalidChangelog";
             next;
         }
 
@@ -131,7 +160,7 @@
             }
         }
         unless($lastchl or $unfinishedchl) {
-            $svn{$dir}{error} = "Invalid";
+            $svn{$dir}{error} = "InvalidChangelog";
             next;
         }
         if($lastchl) {
@@ -155,8 +184,7 @@
         $svn{$dir}{pkgname} = $parser->dpkg()->{Source};
 
         info("Retrieving watchfile for $dir");
-        my $watchdata = get_svn_file($svn,
-            "$svnpath/$dir$svnpostpath/debian/watch");
+        my $watchdata = get_svn_file($svn, "$debdir/watch");
         unless($watchdata) {
             if($svn{$dir}{version} and $svn{$dir}{version} !~ /-/) {
                 $svn{$dir}{watch_error} = "Native";
@@ -202,7 +230,9 @@
         # Shallow copy, it's enough here, but can't be used for anything else
         $svn2{$pkgname} = { %{$cdata->{$_}} };
         $svn2{$pkgname}{dir} = $_;
-        delete $svn2{$pkgname}{$_} foreach(qw(watch pkgname text un_text));
+        delete $svn2{$pkgname}{$_} foreach(
+            qw(watch pkgname text un_text long_descr)
+        );
     }
     update_cache("consolidated", \%svn2, "svn", 1, 0);
     unlock_cache("svn");
@@ -327,4 +357,21 @@
     }
     return $data;
 }
+
+sub split_description($) {
+    # The 'description' field in debian/control is, IMHO, wrongly handled - Its
+    # first line is the short description, and the rest (second to last lines)
+    # is the long description. So... Here we just split it, for proper 
+    # handling. 
+    # 
+    # Gets the full description as its only parameter, returns the short and 
+    # the long descriptions.
+    my ($str, $offset, $short, $long);
+    $str = shift;
+    $offset = index($str, "\n");
+    $short = substr($str, 0, $offset);
+    $long = substr($str, $offset+1);
+    return ($short, $long);
+}
+
 1;