r52940 - in /branches/upstream/libsvn-look-perl/current: Changes MANIFEST META.yml README lib/SVN/Look.pm t/01-commands.t t/perlcritic.t

jawnsy-guest at users.alioth.debian.org jawnsy-guest at users.alioth.debian.org
Wed Feb 17 02:41:44 UTC 2010


Author: jawnsy-guest
Date: Wed Feb 17 02:41:39 2010
New Revision: 52940

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=52940
Log:
[svn-upgrade] Integrating new upstream version, libsvn-look-perl (0.16)

Added:
    branches/upstream/libsvn-look-perl/current/t/perlcritic.t   (with props)
Modified:
    branches/upstream/libsvn-look-perl/current/Changes
    branches/upstream/libsvn-look-perl/current/MANIFEST
    branches/upstream/libsvn-look-perl/current/META.yml
    branches/upstream/libsvn-look-perl/current/README
    branches/upstream/libsvn-look-perl/current/lib/SVN/Look.pm
    branches/upstream/libsvn-look-perl/current/t/01-commands.t

Modified: branches/upstream/libsvn-look-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsvn-look-perl/current/Changes?rev=52940&op=diff
==============================================================================
--- branches/upstream/libsvn-look-perl/current/Changes (original)
+++ branches/upstream/libsvn-look-perl/current/Changes Wed Feb 17 02:41:39 2010
@@ -1,4 +1,12 @@
 Revision history for SVN-Look. -*- text -*-
+
+0.16	2010-02-16
+
+	Implements the methods: youngest, uuid, and lock.
+
+	Bypasses an issue in the testing of method author.
+
+	Croaks instead of dying.
 
 0.15	2009-10-24
 

Modified: branches/upstream/libsvn-look-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsvn-look-perl/current/MANIFEST?rev=52940&op=diff
==============================================================================
--- branches/upstream/libsvn-look-perl/current/MANIFEST (original)
+++ branches/upstream/libsvn-look-perl/current/MANIFEST Wed Feb 17 02:41:39 2010
@@ -8,6 +8,7 @@
 t/00-load.t
 t/01-commands.t
 t/kwalitee.t
+t/perlcritic.t
 t/pod-coverage.t
 t/pod.t
 t/test-functions.pl

Modified: branches/upstream/libsvn-look-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsvn-look-perl/current/META.yml?rev=52940&op=diff
==============================================================================
--- branches/upstream/libsvn-look-perl/current/META.yml (original)
+++ branches/upstream/libsvn-look-perl/current/META.yml Wed Feb 17 02:41:39 2010
@@ -1,6 +1,6 @@
 --- #YAML:1.0
 name:                SVN-Look
-version:             0.15
+version:             0.16
 abstract:            A caching wrapper aroung the svnlook command.
 license:             ~
 author:              

Modified: branches/upstream/libsvn-look-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsvn-look-perl/current/README?rev=52940&op=diff
==============================================================================
--- branches/upstream/libsvn-look-perl/current/README (original)
+++ branches/upstream/libsvn-look-perl/current/README Wed Feb 17 02:41:39 2010
@@ -1,6 +1,6 @@
 Name:    SVN-Look
 What:    A caching wrapper aroung the svnlook command.
-Version: 0.15
+Version: 0.16
 Author:  Gustavo Chaves <gnustavo at cpan.org>
 
 SVN-Look is a caching wrapper aroung the svnlook command.

Modified: branches/upstream/libsvn-look-perl/current/lib/SVN/Look.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsvn-look-perl/current/lib/SVN/Look.pm?rev=52940&op=diff
==============================================================================
--- branches/upstream/libsvn-look-perl/current/lib/SVN/Look.pm (original)
+++ branches/upstream/libsvn-look-perl/current/lib/SVN/Look.pm Wed Feb 17 02:41:39 2010
@@ -1,7 +1,8 @@
 package SVN::Look;
 
+use strict;
 use warnings;
-use strict;
+use Carp;
 use File::Spec::Functions qw/catfile path rootdir/;
 
 =head1 NAME
@@ -10,11 +11,11 @@
 
 =head1 VERSION
 
-Version 0.15
-
-=cut
-
-our $VERSION = '0.15';
+Version 0.16
+
+=cut
+
+our $VERSION = '0.16';
 
 =head1 SYNOPSIS
 
@@ -52,8 +53,8 @@
 ) {
     my $f = catfile($d, 'svnlook');
     if (-x $f) {
-	$SVNLOOK = $f;
-	last;
+        $SVNLOOK = $f;
+        last;
     }
 }
 die "Aborting because I couldn't find the svnlook executable.\n"
@@ -84,23 +85,23 @@
 sub new {
     my ($class, $repo, $what, $txn_or_rev) = @_;
     my $self = {
-	repo     => $repo,
-	what     => [$what, $txn_or_rev],
-	txn      => undef,
-	rev      => undef,
-	author   => undef,
-	log      => undef,
-	changed  => undef,
-	proplist => undef,
+        repo     => $repo,
+        what     => [$what, $txn_or_rev],
+        txn      => undef,
+        rev      => undef,
+        author   => undef,
+        log      => undef,
+        changed  => undef,
+        proplist => undef,
     };
     if ($what eq '-t') {
-	$self->{txn} = $txn_or_rev;
+        $self->{txn} = $txn_or_rev;
     }
     elsif ($what eq '-r') {
-	$self->{rev} = $txn_or_rev;
+        $self->{rev} = $txn_or_rev;
     }
     else {
-	die "Look::new: third argument must be -t or -r, not ($what)";
+        croak "Look::new: third argument must be -t or -r, not ($what)";
     }
     bless $self, $class;
     return $self;
@@ -108,20 +109,22 @@
 
 sub _svnlook {
     my ($self, $cmd, @args) = @_;
-    open my $fd, '-|', $SVNLOOK, $cmd, $self->{repo}, @{$self->{what}}, @args
-	or die "Can't exec svnlook $cmd: $!\n";
+    my @cmd = ($SVNLOOK, $cmd, $self->{repo});
+    push @cmd, @{$self->{what}} unless $cmd =~ /^(?:youngest|uuid|lock)$/;
+    open my $fd, '-|', @cmd, @args
+        or die "Can't exec svnlook $cmd: $!\n";
     if (wantarray) {
-	my @lines = <$fd>;
-	close $fd or die "Failed closing svnlook $cmd: $!\n";
-	chomp foreach @lines;
-	return @lines;
+        my @lines = <$fd>;
+        close $fd or die "Failed closing svnlook $cmd: $!\n";
+        chomp foreach @lines;
+        return @lines;
     }
     else {
-	local $/ = undef;
-	my $line = <$fd>;
-	close $fd or die "Failed closing svnlook $cmd: $!\n";
-	chomp $line;
-	return $line;
+        local $/ = undef;
+        my $line = <$fd>;
+        close $fd or die "Failed closing svnlook $cmd: $!\n";
+        chomp $line;
+        return $line;
     }
 }
 
@@ -169,7 +172,7 @@
 sub author {
     my $self = shift;
     unless ($self->{author}) {
-	chomp($self->{author} = $self->_svnlook('author'));
+        chomp($self->{author} = $self->_svnlook('author'));
     }
     return $self->{author};
 }
@@ -183,7 +186,7 @@
 sub log_msg {
     my $self = shift;
     unless ($self->{log}) {
-	$self->{log} = $self->_svnlook('log');
+        $self->{log} = $self->_svnlook('log');
     }
     return $self->{log};
 }
@@ -197,7 +200,7 @@
 sub date {
     my $self = shift;
     unless ($self->{date}) {
-	$self->{date} = ($self->_svnlook('info'))[1];
+        $self->{date} = ($self->_svnlook('info'))[1];
     }
     return $self->{date};
 }
@@ -211,11 +214,11 @@
 sub proplist {
     my ($self, $path) = @_;
     unless ($self->{proplist}{$path}) {
-	my $text = $self->_svnlook('proplist', '--verbose', $path);
-	my @list = split /^\s\s(\S+)\s:\s/m, $text;
-	shift @list;		# skip the leading empty field
-	chomp(my %hash = @list);
-	$self->{proplist}{$path} = \%hash;
+        my $text = $self->_svnlook('proplist', '--verbose', $path);
+        my @list = split /^\s\s(\S+)\s:\s/m, $text;
+        shift @list;            # skip the leading empty field
+        chomp(my %hash = @list);
+        $self->{proplist}{$path} = \%hash;
     }
     return $self->{proplist}{$path};
 }
@@ -256,36 +259,36 @@
 sub changed_hash {
     my $self = shift;
     unless ($self->{changed_hash}) {
-	my (@added, @deleted, @updated, @prop_modified, %copied);
-	foreach ($self->_svnlook('changed', '--copy-info')) {
-	    next if length($_) <= 4;
-	    chomp;
-	    my ($action, $prop, undef, undef, $changed) = unpack 'AAAA A*', $_;
-	    if    ($action eq 'A') {
-		push @added,   $changed;
-	    }
-	    elsif ($action eq 'D') {
-		push @deleted, $changed;
-	    }
-	    elsif ($action eq 'U') {
-		push @updated, $changed;
-	    }
-	    else {
-		if ($changed =~ /^\(from (.*?):r(\d+)\)$/) {
-		    $copied{$added[-1]} = [$1 => $2];
-		}
-	    }
-	    if ($prop eq 'U') {
-		push @prop_modified, $changed;
-	    }
-	}
-	$self->{changed_hash} = {
-	    added         => \@added,
-	    deleted       => \@deleted,
-	    updated       => \@updated,
-	    prop_modified => \@prop_modified,
-	    copied        => \%copied,
-	};
+        my (@added, @deleted, @updated, @prop_modified, %copied);
+        foreach ($self->_svnlook('changed', '--copy-info')) {
+            next if length($_) <= 4;
+            chomp;
+            my ($action, $prop, undef, undef, $changed) = unpack 'AAAA A*', $_;
+            if    ($action eq 'A') {
+                push @added,   $changed;
+            }
+            elsif ($action eq 'D') {
+                push @deleted, $changed;
+            }
+            elsif ($action eq 'U') {
+                push @updated, $changed;
+            }
+            else {
+                if ($changed =~ /^\(from (.*?):r(\d+)\)$/) {
+                    $copied{$added[-1]} = [$1 => $2];
+                }
+            }
+            if ($prop eq 'U') {
+                push @prop_modified, $changed;
+            }
+        }
+        $self->{changed_hash} = {
+            added         => \@added,
+            deleted       => \@deleted,
+            updated       => \@updated,
+            prop_modified => \@prop_modified,
+            copied        => \%copied,
+        };
     }
     return $self->{changed_hash};
 }
@@ -346,7 +349,7 @@
     my $self = shift;
     my $hash = $self->changed_hash();
     unless (exists $hash->{changed}) {
-	$hash->{changed} = [@{$hash->{added}}, @{$hash->{updated}}, @{$hash->{deleted}}, @{$hash->{prop_modified}}];
+        $hash->{changed} = [@{$hash->{added}}, @{$hash->{updated}}, @{$hash->{deleted}}, @{$hash->{prop_modified}}];
     }
     return @{$hash->{changed}};
 }
@@ -360,8 +363,8 @@
 sub dirs_changed {
     my $self = shift;
     unless (exists $self->{dirs_changed}) {
-	my @dirs = $self->_svnlook('dirs-changed');
-	$self->{dirs_changed} = \@dirs;
+        my @dirs = $self->_svnlook('dirs-changed');
+        $self->{dirs_changed} = \@dirs;
     }
     return @{$self->{dirs_changed}};
 }
@@ -435,6 +438,75 @@
     return $self->_svnlook('diff', @opts);
 }
 
+=item B<youngest>
+
+Returns the repository's youngest revision number.
+
+=cut
+
+sub youngest {
+    my ($self) = @_;
+    return $self->_svnlook('youngest');
+}
+
+=item B<uuid>
+
+Returns the repository's UUID.
+
+=cut
+
+sub uuid {
+    my ($self) = @_;
+    return $self->_svnlook('uuid');
+}
+
+=item B<lock> PATH
+
+If PATH has a lock, returns a hash containing information about the lock, with the following keys:
+
+=over
+
+=item UUID Token
+
+A string with the opaque lock token.
+
+=item Owner
+
+The name of the user that has the lock.
+
+=item Created
+
+The time at which the lock was created, in a format like this: '2010-02-16 17:23:08 -0200 (Tue, 16 Feb 2010)'.
+
+=item Comment
+
+The lock comment.
+
+=back
+
+If PATH has no lock, returns undef.
+
+=cut
+
+sub lock {
+    my ($self, $path) = @_;
+    my %lock = ();
+    my @lock = $self->_svnlook('lock', $path);
+
+    while (my $line = shift @lock) {
+	chomp $line;
+	my ($key, $value) = split /:\s*/, $line, 2;
+	if ($key =~ /^Comment/) {
+	    $lock{Comment} = join('', @lock);
+	}
+	else {
+	    $lock{$key} = $value;
+	}
+    }
+
+    return %lock ? \%lock : undef;
+}
+
 =back
 
 =head1 AUTHOR
@@ -477,7 +549,7 @@
 
 =head1 COPYRIGHT & LICENSE
 
-Copyright 2008 CPqD, all rights reserved.
+Copyright 2008-2010 CPqD, all rights reserved.
 
 This program is free software; you can redistribute it and/or modify it
 under the same terms as Perl itself.

Modified: branches/upstream/libsvn-look-perl/current/t/01-commands.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsvn-look-perl/current/t/01-commands.t?rev=52940&op=diff
==============================================================================
--- branches/upstream/libsvn-look-perl/current/t/01-commands.t (original)
+++ branches/upstream/libsvn-look-perl/current/t/01-commands.t Wed Feb 17 02:41:39 2010
@@ -6,8 +6,12 @@
 
 require "test-functions.pl";
 
+my $nof_tests = 12;
+my $login = getlogin || getpwuid($<) || $ENV{USER};
+--$nof_tests unless $login;
+
 if (has_svn()) {
-    plan tests => 8;
+    plan tests => $nof_tests;
 }
 else {
     plan skip_all => 'Need svn commands in the PATH.';
@@ -26,7 +30,8 @@
 
 ok(defined $look, 'constructor');
 
-cmp_ok($look->author(), 'eq', $ENV{USER}, 'author');
+cmp_ok($look->author(), 'eq', $login, 'author')
+    if $login;
 
 cmp_ok($look->log_msg(), 'eq', "log\n", 'log_msg');
 
@@ -57,3 +62,23 @@
 ok(exists $pl->{'svn:mime-type'}, 'proplist finds the expected property');
 
 is($pl->{'svn:mime-type'}, 'text/plain', 'proplist finds the correct property value');
+
+my $youngest = eval { $look->youngest() };
+
+cmp_ok($youngest, '=~', qr/^\d+$/, 'youngest');
+
+my $uuid = eval { $look->uuid() };
+
+cmp_ok($uuid, '=~', qr/^[0-9a-f-]+$/, 'uuid');
+
+my $lock = eval { $look->lock('file') };
+
+ok(! defined $lock, 'no lock');
+
+system(<<"EOS");
+svn lock -m'lock comment' $t/wc/file >/dev/null
+EOS
+
+$lock = eval { $look->lock('file') };
+
+ok(defined $lock && ref $lock eq 'HASH', 'lock');

Added: branches/upstream/libsvn-look-perl/current/t/perlcritic.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsvn-look-perl/current/t/perlcritic.t?rev=52940&op=file
==============================================================================
--- branches/upstream/libsvn-look-perl/current/t/perlcritic.t (added)
+++ branches/upstream/libsvn-look-perl/current/t/perlcritic.t Wed Feb 17 02:41:39 2010
@@ -1,0 +1,20 @@
+use strict;
+use warnings;
+use File::Spec;
+use Test::More;
+use English qw(-no_match_vars);
+
+unless (-e 't/author.enabled') {
+    plan skip_all => "Author-only tests";
+    exit 0;
+}
+
+eval { require Test::Perl::Critic; };
+
+if ( $EVAL_ERROR ) {
+    my $msg = 'Test::Perl::Critic required to criticise code';
+    plan( skip_all => $msg );
+}
+
+Test::Perl::Critic->import( -verbose => 5 );
+all_critic_ok();

Propchange: branches/upstream/libsvn-look-perl/current/t/perlcritic.t
------------------------------------------------------------------------------
    svn:executable = *




More information about the Pkg-perl-cvs-commits mailing list