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