r6630 - /scripts/qa/versioncheck.pl
tincho-guest at users.alioth.debian.org
tincho-guest at users.alioth.debian.org
Wed Aug 15 04:14:31 UTC 2007
Author: tincho-guest
Date: Wed Aug 15 04:14:31 2007
New Revision: 6630
URL: http://svn.debian.org/wsvn/?sc=1&rev=6630
Log:
- Modified the svn calling to handle errors without eval+regex matching, as that is fragile and doesn't work with locales.
- Added initializers and a check on various variables to avoid errors if the changelog is missing.
- Prepared the args handling for upcoming changes :)
Modified:
scripts/qa/versioncheck.pl
Modified: scripts/qa/versioncheck.pl
URL: http://svn.debian.org/wsvn/scripts/qa/versioncheck.pl?rev=6630&op=diff
==============================================================================
--- scripts/qa/versioncheck.pl (original)
+++ scripts/qa/versioncheck.pl Wed Aug 15 04:14:31 2007
@@ -529,42 +529,49 @@
debugmsg( "Examining $dir\n" );
- my $pkg;
- my $changelog;
- my $changelog_fh = IO::Scalar->new( \$changelog );
+ my $pkg = "";
+ my $changelog = "";
my $in_svn = 'Unknown SVN version';
- my( $svn_changer, $svn_date );
- eval {
- $svn->cat(
+ my $svn_changer = "";
+ my $svn_date = "";
+ my $svn_error;
+ my $svn = SVN::Client->new();
+ {
+ my $changelog_fh = IO::Scalar->new( \$changelog );
+ local $SVN::Error::handler = undef;
+ ($svn_error) = $svn->cat(
$changelog_fh,
"$SVN_REPO/trunk/$dir/debian/changelog",
'HEAD',
);
- my $cl = Parse::DebianChangelog->init({instring=>$changelog});
- my @cl = $cl->data;
- foreach( @cl )
- {
- next unless $_->Distribution eq 'unstable';
- next if $_->Changes =~ /NOT RELEASED/;
-
- $in_svn = $_->Version;
- $svn_changer = $_->Maintainer;
- $svn_date = $_->Date;
- $pkg = $_->Source;
- last;
- }
- };
- if($@)
- {
- if( $@ =~ /^Filesystem has no item: / )
+ }
+ if(SVN::Error::is_error($svn_error))
+ {
+ if($svn_error->apr_err() == $SVN::Error::FS_NOT_FOUND)
{
$in_svn = 'Missing debian/changelog';
+ $svn_error->clear();
}
else
{
- die $@;
- }
+ SVN::Error::croak_on_error($svn_error);
+ }
+ }
+ my @cl;
+ if($changelog) {
+ @cl = Parse::DebianChangelog->init({instring=>$changelog})->data;
+ }
+ foreach( @cl )
+ {
+ next unless $_->Distribution eq 'unstable';
+ next if $_->Changes =~ /NOT RELEASED/;
+
+ $in_svn = $_->Version;
+ $svn_changer = $_->Maintainer;
+ $svn_date = $_->Date;
+ $pkg = $_->Source;
+ last;
}
my $in_archive = $packages{$pkg} || '';
@@ -585,68 +592,72 @@
my $in_cpan = '';
my $upstream_url;
my @watch;
- eval {
- my $watch;
+ my $watch;
+ {
my $watch_io = IO::Scalar->new(\$watch);
- $svn->cat(
+ local $SVN::Error::handler = undef;
+ ($svn_error) = $svn->cat(
$watch_io,
"$SVN_REPO/trunk/$dir/debian/watch",
'HEAD',
);
-
- $watch =~ s/\\\n//gs;
- my @watch_lines = split(/\n/, $watch) if $watch;
-
- @watch_lines = grep( (!/^#/ and !/^version=/ and !/^\s*$/), @watch_lines );
-
- foreach(@watch_lines)
- {
- debugmsg( " watch line $_\n" ) if 0;
- # opts either contain no spaces, or is enclosed in double-quotes
- my $opts = $1 if s!^\s*opts="([^"]*)"\s+!! or s!^\s*opts=(\S*)\s+!!;
- debugmsg( " watch options = $opts\n" ) if $opts;
- # several options are separated by comma and commas are not allowed within
- my @opts = split(/\s*,\s*/, $opts) if $opts;
- my %opts;
- foreach(@opts)
- {
- next if /^(?:active|passive|pasv)$/;
-
- /([^=]+)=(.*)/;
- debugmsg( " watch option $1 = $2\n" );
- if( $1 eq 'versionmangle' )
- {
- push @{ $opts{uversionmangle} }, $2;
- push @{ $opts{dversionmangle} }, $2;
- }
- else
- {
- push @{ $opts{$1} }, $2;
- }
- }
- s!^http://www.cpan.org/!$CPAN_MIRROR/!;
- s!^ftp://www.cpan.org/!$CPAN_MIRROR/!;
- s!^http://backpan.perl.org/authors/!$CPAN_MIRROR/authors/!;
- s!^http://mirrors.kernel.org/cpan/!$CPAN_MIRROR/!;
- s!^ftp://mirrors.kernel.org/cpan/!$CPAN_MIRROR/!;
-
- push @watch, [ $_, \%opts ];
- }
- };
- if($@)
- {
- if( $@ =~ /^Filesystem has no item: / )
+ $watch_io->close();
+ }
+ if(SVN::Error::is_error($svn_error))
+ {
+ if($svn_error->apr_err() == $SVN::Error::FS_NOT_FOUND)
{
$upstream = (
( $in_svn =~ /-.+$/ )
? 'Missing debian/watch'
: $in_svn # native package
);
+ $svn_error->clear();
+ $watch = "";
}
else
{
- die $@;
- }
+ SVN::Error::croak_on_error($svn_error);
+ }
+ }
+
+ $watch =~ s/\\\n//gs;
+ my @watch_lines = split(/\n/, $watch) if $watch;
+
+ @watch_lines = grep( (!/^#/ and !/^version=/ and !/^\s*$/), @watch_lines );
+
+ foreach(@watch_lines)
+ {
+ debugmsg( " watch line $_\n" ) if 0;
+ # opts either contain no spaces, or is enclosed in double-quotes
+ my $opts = $1 if s!^\s*opts="([^"]*)"\s+!! or s!^\s*opts=(\S*)\s+!!;
+ debugmsg( " watch options = $opts\n" ) if $opts;
+ # several options are separated by comma and commas are not allowed within
+ my @opts = split(/\s*,\s*/, $opts) if $opts;
+ my %opts;
+ foreach(@opts)
+ {
+ next if /^(?:active|passive|pasv)$/;
+
+ /([^=]+)=(.*)/;
+ debugmsg( " watch option $1 = $2\n" );
+ if( $1 eq 'versionmangle' )
+ {
+ push @{ $opts{uversionmangle} }, $2;
+ push @{ $opts{dversionmangle} }, $2;
+ }
+ else
+ {
+ push @{ $opts{$1} }, $2;
+ }
+ }
+ s!^http://www.cpan.org/!$CPAN_MIRROR/!;
+ s!^ftp://www.cpan.org/!$CPAN_MIRROR/!;
+ s!^http://backpan.perl.org/authors/!$CPAN_MIRROR/authors/!;
+ s!^http://mirrors.kernel.org/cpan/!$CPAN_MIRROR/!;
+ s!^ftp://mirrors.kernel.org/cpan/!$CPAN_MIRROR/!;
+
+ push @watch, [ $_, \%opts ];
}
my $up_svn = $in_svn;
@@ -765,14 +776,10 @@
return 0;
}
+my @pkgs_to_check;
if( @ARGV )
{
- foreach my $pkg( @ARGV )
- {
- $total++;
-
- $total_shown++ if check_package($pkg);
- }
+ @pkgs_to_check = @ARGV;
}
else
{
@@ -785,13 +792,13 @@
scalar(keys(%$svn_packages)),
),
);
-
- foreach my $pkg( sort(keys %$svn_packages) )
- {
- $total++;
-
- $total_shown++ if check_package($pkg);
- }
+ @pkgs_to_check = sort(keys %$svn_packages);
+}
+foreach my $pkg( @pkgs_to_check )
+{
+ $total++;
+
+ $total_shown++ if check_package($pkg);
}
my $date = gmtime;
More information about the Pkg-perl-cvs-commits
mailing list