r74054 - in /branches/upstream/libsysadm-install-perl/current: Changes META.yml README lib/Sysadm/Install.pm t/009snip.t t/010carp.t
angelabad-guest at users.alioth.debian.org
angelabad-guest at users.alioth.debian.org
Fri May 6 14:47:28 UTC 2011
Author: angelabad-guest
Date: Fri May 6 14:47:06 2011
New Revision: 74054
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=74054
Log:
[svn-upgrade] new version libsysadm-install-perl (0.36)
Modified:
branches/upstream/libsysadm-install-perl/current/Changes
branches/upstream/libsysadm-install-perl/current/META.yml
branches/upstream/libsysadm-install-perl/current/README
branches/upstream/libsysadm-install-perl/current/lib/Sysadm/Install.pm
branches/upstream/libsysadm-install-perl/current/t/009snip.t
branches/upstream/libsysadm-install-perl/current/t/010carp.t
Modified: branches/upstream/libsysadm-install-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsysadm-install-perl/current/Changes?rev=74054&op=diff
==============================================================================
--- branches/upstream/libsysadm-install-perl/current/Changes (original)
+++ branches/upstream/libsysadm-install-perl/current/Changes Fri May 6 14:47:06 2011
@@ -1,6 +1,12 @@
########################################
Revision history for Sysadm::Install
########################################
+
+0.36 (2011/05/01)
+ (ms) Added owner_cp() to copy uid and gid of a file or directory.
+ (ms) Added raise_error option for tap()
+ (ms) snip() now returns original string (with unprintables replaced)
+ if the data length is shorter than $maxlen.
0.35 (2010/04/13)
(ms) [RT 54885] Merged with github fork by Thomas Lenz, fixing
Modified: branches/upstream/libsysadm-install-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsysadm-install-perl/current/META.yml?rev=74054&op=diff
==============================================================================
--- branches/upstream/libsysadm-install-perl/current/META.yml (original)
+++ branches/upstream/libsysadm-install-perl/current/META.yml Fri May 6 14:47:06 2011
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: Sysadm-Install
-version: 0.35
+version: 0.36
abstract: Typical installation tasks for system administrators
author:
- Mike Schilli <m at perlmeister.com>
@@ -25,7 +25,7 @@
directory:
- t
- inc
-generated_by: ExtUtils::MakeMaker version 6.50
+generated_by: ExtUtils::MakeMaker version 6.55_02
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: 1.4
Modified: branches/upstream/libsysadm-install-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsysadm-install-perl/current/README?rev=74054&op=diff
==============================================================================
--- branches/upstream/libsysadm-install-perl/current/README (original)
+++ branches/upstream/libsysadm-install-perl/current/README Fri May 6 14:47:06 2011
@@ -1,5 +1,5 @@
######################################################################
- Sysadm::Install 0.35
+ Sysadm::Install 0.36
######################################################################
NAME
@@ -234,6 +234,16 @@
"ls" "/tmp/$VAR" 2>/tmp/sometempfile |
+ Another option is "utf8" which runs the command in a terminal set to
+ UTF8.
+
+ Error handling: By default, tap() won't raise an error if the
+ command's return code is nonzero, indicating an error reported by
+ the shell. If bailing out on errors is requested to avoid return
+ code checking by the script, use the raise_error option:
+
+ tap({raise_error => 1}, "ls", "doesn't exist");
+
"$quoted_string = qquote($string, [$metachars])"
Put a string in double quotes and escape all sensitive characters so
there's no unwanted interpolation. E.g., if you have something like
@@ -345,6 +355,19 @@
Read the $src file's user permissions and modify all $dst files to
reflect the same permissions.
+ "owner_cp($src, $dst, ...)"
+ Read the $src file/directory's owner uid and group gid and apply it
+ to $dst.
+
+ For example: copy uid/gid of the containing directory to a file
+ therein:
+
+ use File::Basename;
+
+ owner_cp( dirname($file), $file );
+
+ Usually requires root privileges, just like chown does.
+
"$perms = perm_get($filename)"
Read the $filename's user permissions and owner/group. Returns an
array ref to be used later when calling "perm_set($filename,
@@ -404,14 +427,18 @@
Format the data string in $data so that it's only (roughly) $maxlen
characters long and only contains printable characters.
- If $data contains unprintable character's they are replaced by "."
- (the dot). If $data is longer than $maxlen, it will be formatted
- like
+ If $data is longer than $maxlen, it will be formatted like
(22)[abcdef[snip=11]stuvw]
indicating the length of the original string, the beginning, the
end, and the number of 'snipped' characters.
+
+ If $data is shorter than $maxlen, it will be returned unmodified
+ (except for unprintable characters replaced, see below).
+
+ If $data contains unprintable character's they are replaced by "."
+ (the dot).
"password_read($prompt)"
Reads in a password to be typed in by the user in noecho mode. A
@@ -460,7 +487,7 @@
the CPAN modules, provides the function "def_or()" which can be used
like
- def_or($foo, $default);
+ def_or($foo, $default);
to accomplish the same as
Modified: branches/upstream/libsysadm-install-perl/current/lib/Sysadm/Install.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsysadm-install-perl/current/lib/Sysadm/Install.pm?rev=74054&op=diff
==============================================================================
--- branches/upstream/libsysadm-install-perl/current/lib/Sysadm/Install.pm (original)
+++ branches/upstream/libsysadm-install-perl/current/lib/Sysadm/Install.pm Fri May 6 14:47:06 2011
@@ -6,7 +6,7 @@
use strict;
use warnings;
-our $VERSION = '0.35';
+our $VERSION = '0.36';
use File::Copy;
use File::Path;
@@ -75,7 +75,7 @@
cp rmf mkd cd make
cdback download untar
pie slurp blurt mv tap
-plough qquote quote perm_cp
+plough qquote quote perm_cp owner_cp
perm_get perm_set
sysrun untar_in pick ask
hammer say
@@ -956,6 +956,16 @@
"ls" "/tmp/$VAR" 2>/tmp/sometempfile |
+Another option is "utf8" which runs the command in a terminal set to
+UTF8.
+
+Error handling: By default, tap() won't raise an error if the command's
+return code is nonzero, indicating an error reported by the shell. If
+bailing out on errors is requested to avoid return code checking by
+the script, use the raise_error option:
+
+ tap({raise_error => 1}, "ls", "doesn't exist");
+
=cut
###############################################
@@ -1010,6 +1020,10 @@
my $exit_code = $?;
+ if($opts->{raise_error}) {
+ LOGCROAK("tap $cmd | failed ($!)");
+ }
+
my $stderr = slurp($tmpfile, $options);
DEBUG "tap $cmd results: rc=$exit_code stderr=[$stderr] stdout=[$stdout]";
@@ -1193,6 +1207,51 @@
my $perms = perm_get($_[0]);
perm_set($_[1], $perms);
+}
+
+=pod
+
+=item C<owner_cp($src, $dst, ...)>
+
+Read the C<$src> file/directory's owner uid and group gid and apply
+it to $dst.
+
+For example: copy uid/gid of the containing directory to a file
+therein:
+
+ use File::Basename;
+
+ owner_cp( dirname($file), $file );
+
+Usually requires root privileges, just like chown does.
+
+=cut
+
+######################################
+sub owner_cp {
+######################################
+ my($src, @dst) = @_;
+
+ local $Log::Log4perl::caller_depth =
+ $Log::Log4perl::caller_depth + 1;
+
+ _confirm "owner_cp @_" or return 1;
+
+ LOGCROAK("usage: owner_cp src dst ...") if @_ < 2;
+
+ my($uid, $gid) = (stat($src))[4,5];
+
+ if(!defined $uid or !defined $gid ) {
+ LOGCROAK("stat of $src failed: $!");
+ return undef;
+ }
+
+ if(!chown $uid, $gid, @dst ) {
+ LOGCROAK("chown of ", join(" ", @dst), " failed: $!");
+ return undef;
+ }
+
+ return 1;
}
=pod
@@ -1514,14 +1573,19 @@
Format the data string in C<$data> so that it's only (roughly) $maxlen
characters long and only contains printable characters.
-If C<$data> contains unprintable character's they are replaced by
-"." (the dot). If C<$data> is longer than C<$maxlen>, it will be
+If C<$data> is longer than C<$maxlen>, it will be
formatted like
(22)[abcdef[snip=11]stuvw]
indicating the length of the original string, the beginning, the
end, and the number of 'snipped' characters.
+
+If C<$data> is shorter than $maxlen, it will be returned unmodified
+(except for unprintable characters replaced, see below).
+
+If C<$data> contains unprintable character's they are replaced by
+"." (the dot).
=cut
@@ -1531,7 +1595,7 @@
my($data, $maxlen) = @_;
if(length $data <= $maxlen) {
- return lenformat($data);
+ return printable($data);
}
$maxlen = 12 if $maxlen < 12;
Modified: branches/upstream/libsysadm-install-perl/current/t/009snip.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsysadm-install-perl/current/t/009snip.t?rev=74054&op=diff
==============================================================================
--- branches/upstream/libsysadm-install-perl/current/t/009snip.t (original)
+++ branches/upstream/libsysadm-install-perl/current/t/009snip.t Fri May 6 14:47:06 2011
@@ -2,12 +2,12 @@
# Tests for Sysadm::Install/s fs_read/write_open
#############################################
-use Test::More tests => 5;
+use Test::More tests => 7;
use Sysadm::Install qw(:all);
is(snip("abc", 5),
- "(3)[abc]", "snip full len");
+ "abc", "snip full len");
is(snip("abcdefghijklmn", 11),
"(14)[ab[snip=10]mn]", "snip minlen");
@@ -19,4 +19,11 @@
"(14)[a.[snip=10]m.]", "snip special char");
is(snip("a\tcdefghijklm\n", 14),
- "(14)[a.cdefghijklm.]", "exact len match")
+ "a.cdefghijklm.", "exact len match");
+
+is(snip("abc", 5, 1),
+ "abc", "snip full len and keep flag");
+
+is(snip("a\tc", 5),
+ "a.c", "snip full len with unprintable chars");
+
Modified: branches/upstream/libsysadm-install-perl/current/t/010carp.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsysadm-install-perl/current/t/010carp.t?rev=74054&op=diff
==============================================================================
--- branches/upstream/libsysadm-install-perl/current/t/010carp.t (original)
+++ branches/upstream/libsysadm-install-perl/current/t/010carp.t Fri May 6 14:47:06 2011
@@ -43,7 +43,7 @@
# cp
#################################
eval {
- cp "///", "//x";
+ cp "Ill/go/crazy/if/this/whacko/directory/actually/exists", "//x";
};
if($@) {
More information about the Pkg-perl-cvs-commits
mailing list