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