r22209 - in /trunk/libscriptalicious-perl: ./ debian/ lib/ t/ t/missing/
eloy at users.alioth.debian.org
eloy at users.alioth.debian.org
Fri Jun 27 08:57:51 UTC 2008
Author: eloy
Date: Fri Jun 27 08:57:51 2008
New Revision: 22209
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=22209
Log:
* New upstream release
* debian/control:
+ Uploaders: added me
+ Build-Depends: debhelpers dependency changed to (>= 7)
+ Standards-Version: increased to 3.8.0 (no other changes)
* debian/compat: changed value to 7 (no other changes)
* debian/copyright: updated copyright info
Added:
trunk/libscriptalicious-perl/MANIFEST.SKIP
- copied unchanged from r22208, branches/upstream/libscriptalicious-perl/current/MANIFEST.SKIP
trunk/libscriptalicious-perl/t/06-anydump.t
- copied unchanged from r22208, branches/upstream/libscriptalicious-perl/current/t/06-anydump.t
trunk/libscriptalicious-perl/t/07-tsay.t
- copied unchanged from r22208, branches/upstream/libscriptalicious-perl/current/t/07-tsay.t
trunk/libscriptalicious-perl/t/08-unit.t
- copied unchanged from r22208, branches/upstream/libscriptalicious-perl/current/t/08-unit.t
trunk/libscriptalicious-perl/t/09-noyaml.t
- copied unchanged from r22208, branches/upstream/libscriptalicious-perl/current/t/09-noyaml.t
trunk/libscriptalicious-perl/t/dump.pl
- copied unchanged from r22208, branches/upstream/libscriptalicious-perl/current/t/dump.pl
trunk/libscriptalicious-perl/t/missing/
- copied from r22208, branches/upstream/libscriptalicious-perl/current/t/missing/
trunk/libscriptalicious-perl/t/tsay.pl
- copied unchanged from r22208, branches/upstream/libscriptalicious-perl/current/t/tsay.pl
Removed:
trunk/libscriptalicious-perl/Build.PL
Modified:
trunk/libscriptalicious-perl/Changes.pod
trunk/libscriptalicious-perl/MANIFEST
trunk/libscriptalicious-perl/META.yml
trunk/libscriptalicious-perl/Makefile.PL
trunk/libscriptalicious-perl/debian/changelog
trunk/libscriptalicious-perl/debian/compat
trunk/libscriptalicious-perl/debian/control
trunk/libscriptalicious-perl/debian/copyright
trunk/libscriptalicious-perl/lib/Scriptalicious.pm
trunk/libscriptalicious-perl/lib/Scriptalicious.pod
trunk/libscriptalicious-perl/t/01-mmmdelicious.t
trunk/libscriptalicious-perl/t/02-script.t
trunk/libscriptalicious-perl/t/03-yaml.t
trunk/libscriptalicious-perl/t/04-fork.t
Modified: trunk/libscriptalicious-perl/Changes.pod
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libscriptalicious-perl/Changes.pod?rev=22209&op=diff
==============================================================================
--- trunk/libscriptalicious-perl/Changes.pod (original)
+++ trunk/libscriptalicious-perl/Changes.pod Fri Jun 27 08:57:51 2008
@@ -1,11 +1,82 @@
=head1 WHATS NEW IN SCRIPTALICIOUS
+
+=head2 VERSION 1.15
+
+=over
+
+=item Add missing copyright notices and license.
+
+Gah, sorry about this. Note that it is a retrospective license, so
+you don't need to 'upgrade' to this version to copy the software.
+
+=item Clear PERL5OPT before invoking $^X in tests
+
+To hopefully resolve some false failures
+
+=back
+
+=head2 VERSION 1.14
+
+=over
+
+=item 5.6.x compat: fix missed instance of unquoted filehandle in test suite
+
+=back
+
+=head2 VERSION 1.13
+
+=over
+
+=item 5.6.x compat: don't use readline FH; use <FH> instead
+
+=item Don't die if getconf is called without YAML installed; warn instead
+
+=item Make YAML config test conditional on YAML being installed
+
+=item Fix incorrectly written e-mail address in Makefile.PL
+
+=item Remove TODO file; these features have been added!
+
+=back
+
+=head2 VERSION 1.12
+
+=over
+
+=item Add getopt_lenient()
+
+=item Add time_unit() function
+
+=item Use time_unit instead of sci_unit in show_elapsed/show_delta
+
+=item Fix test that was still testing for µ
+
+=back
+
+=head2 VERSION 1.11
+
+=over
+
+=item Drop C<Module::Build> dependency
+
+Go back to C<ExtUtils::MakeMaker>.
+
+=item Fix various problems with prompt_*
+
+=item Add C<hush_exec> and C<unhush_exec> functions
+
+=item Make C<getopt()> optional for getting verbosity right
+
+=item Functions don't clobber $_ (Gerard Goosen)
+
+=back
=head2 VERSION 1.10
Add prompt_file from an earlier branch.
-Fix Build.PL so a compatibility Makefile.PL is generated.
+Fix F<Build.PL> so a compatibility Makefile.PL is generated.
=head2 VERSION 1.09
Modified: trunk/libscriptalicious-perl/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libscriptalicious-perl/MANIFEST?rev=22209&op=diff
==============================================================================
--- trunk/libscriptalicious-perl/MANIFEST (original)
+++ trunk/libscriptalicious-perl/MANIFEST Fri Jun 27 08:57:51 2008
@@ -1,19 +1,28 @@
-MANIFEST
+Changes.pod
+lib/Scriptalicious.pm
+lib/Scriptalicious.pod
+Makefile.PL
+MANIFEST This list of files
+MANIFEST.SKIP
README
-Changes.pod
-META.yml
-lib/Scriptalicious.pm Mmm, Scriptalicious
-lib/Scriptalicious.pod POD's what it's all about, baby!
t/01-mmmdelicious.t
t/02-script.t
t/03-yaml.t
t/04-fork.t
t/05-prompt.t
-t/pu.pl
+t/06-anydump.t
+t/07-tsay.t
+t/08-unit.t
+t/09-noyaml.t
+t/dump.pl
+t/eg.conf
t/fork.pl
t/loopback.pl
+t/missing/Pod/Constants.pm
+t/missing/Template.pm
+t/missing/YAML.pm
t/prompter.pl
+t/pu.pl
+t/tsay.pl
t/Util.pm
-t/eg.conf
-Build.PL
-Makefile.PL
+META.yml Module meta-data (added by MakeMaker)
Modified: trunk/libscriptalicious-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libscriptalicious-perl/META.yml?rev=22209&op=diff
==============================================================================
--- trunk/libscriptalicious-perl/META.yml (original)
+++ trunk/libscriptalicious-perl/META.yml Fri Jun 27 08:57:51 2008
@@ -1,24 +1,15 @@
----
-name: Scriptalicious
-version: 1.10
-author: ~
-abstract: ~
-license: perl
-recommends:
- Term::ReadKey: 0
- Text::Wrap: 0
- Time::HiRes: 0
- YAML: 0
-build_requires:
- Test::More: 0
-provides:
- Scriptalicious:
- file: lib/Scriptalicious.pm
- version: 1.10
- Scriptalicious::DataLoad:
- file: lib/Scriptalicious.pm
- version: 1.10
- Scriptalicious::Template:
- file: lib/Scriptalicious.pm
- version: 1.10
-generated_by: Module::Build version 0.2611
+--- #YAML:1.0
+name: Scriptalicious
+version: 1.15
+abstract: Make scripts more delicious to SysAdmins
+license: ~
+author:
+ - Sam Vilain <samv at cpan.org>
+generated_by: ExtUtils::MakeMaker version 6.42
+distribution_type: module
+requires:
+ Term::ReadKey: 0
+ Test::More: 0
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.3.html
+ version: 1.3
Modified: trunk/libscriptalicious-perl/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libscriptalicious-perl/Makefile.PL?rev=22209&op=diff
==============================================================================
--- trunk/libscriptalicious-perl/Makefile.PL (original)
+++ trunk/libscriptalicious-perl/Makefile.PL Fri Jun 27 08:57:51 2008
@@ -1,31 +1,27 @@
-# Note: this file was auto-generated by Module::Build::Compat version 0.03
-
- unless (eval "use Module::Build::Compat 0.02; 1" ) {
- print "This module requires Module::Build to install itself.\n";
-
- require ExtUtils::MakeMaker;
- my $yn = ExtUtils::MakeMaker::prompt
- (' Install Module::Build now from CPAN?', 'y');
-
- unless ($yn =~ /^y/i) {
- die " *** Cannot install without Module::Build. Exiting ...\n";
- }
-
- require Cwd;
- require File::Spec;
- require CPAN;
-
- # Save this 'cause CPAN will chdir all over the place.
- my $cwd = Cwd::cwd();
- my $makefile = File::Spec->rel2abs($0);
-
- CPAN::Shell->install('Module::Build::Compat')
- or die " *** Cannot install without Module::Build. Exiting ...\n";
-
- chdir $cwd or die "Cannot chdir() back to $cwd: $!";
+#!/usr/bin/perl
+#
+use ExtUtils::MakeMaker;
+# See perldoc Module::Build for details of how this works
+
+my @recommends = qw(Text::Wrap Time::HiRes YAML Pod::Constants);
+
+for my $module ( @recommends ) {
+ eval "use $module";
+ if ( $@ ) {
+ warn "Failed to load optional dependency $module ($@)";
}
- eval "use Module::Build::Compat 0.02; 1" or die $@;
- use lib '_build/lib';
- Module::Build::Compat->run_build_pl(args => \@ARGV);
- require Module::Build;
- Module::Build::Compat->write_makefile(build_class => 'Module::Build');
+}
+
+WriteMakefile
+ ( NAME => 'Scriptalicious',
+ VERSION_FROM => "lib/Scriptalicious.pm",
+ ( ( $] >= 5.005 ) ?
+ ( ABSTRACT => "Make scripts more delicious to SysAdmins",
+ AUTHOR => "Sam Vilain <samv\@cpan.org>",
+ ) : () ),
+ PREREQ_PM => {
+ 'Test::More' => 0,
+ 'Term::ReadKey' => 0,
+ },
+ NO_META => 0,
+ );
Modified: trunk/libscriptalicious-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libscriptalicious-perl/debian/changelog?rev=22209&op=diff
==============================================================================
--- trunk/libscriptalicious-perl/debian/changelog (original)
+++ trunk/libscriptalicious-perl/debian/changelog Fri Jun 27 08:57:51 2008
@@ -1,5 +1,15 @@
-libscriptalicious-perl (1.10-2) UNRELEASED; urgency=low
+libscriptalicious-perl (1.15-1) UNRELEASED; urgency=low
+ [ Krzysztof Krzyżaniak (eloy) ]
+ * New upstream release
+ * debian/control:
+ + Uploaders: added me
+ + Build-Depends: debhelpers dependency changed to (>= 7)
+ + Standards-Version: increased to 3.8.0 (no other changes)
+ * debian/compat: changed value to 7 (no other changes)
+ * debian/copyright: updated copyright info
+
+ [ gregor herrmann ]
* Take over for the Debian Perl Group with maintainer's permission
(http://lists.debian.org/debian-perl/2008/06/msg00039.html)
* debian/control: Added: Vcs-Svn field (source stanza); Vcs-Browser
@@ -9,8 +19,8 @@
<rafl at debianforum.de>); Florian Ragwitz <rafl at debianforum.de> moved
to Uploaders.
* Add debian/watch.
-
- -- gregor herrmann <gregoa at debian.org> Sun, 15 Jun 2008 17:03:46 +0200
+
+ -- Krzysztof Krzyżaniak (eloy) <eloy at debian.org> Fri, 27 Jun 2008 10:43:59 +0200
libscriptalicious-perl (1.10-1) unstable; urgency=low
Modified: trunk/libscriptalicious-perl/debian/compat
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libscriptalicious-perl/debian/compat?rev=22209&op=diff
==============================================================================
--- trunk/libscriptalicious-perl/debian/compat (original)
+++ trunk/libscriptalicious-perl/debian/compat Fri Jun 27 08:57:51 2008
@@ -1,1 +1,1 @@
-4
+7
Modified: trunk/libscriptalicious-perl/debian/control
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libscriptalicious-perl/debian/control?rev=22209&op=diff
==============================================================================
--- trunk/libscriptalicious-perl/debian/control (original)
+++ trunk/libscriptalicious-perl/debian/control Fri Jun 27 08:57:51 2008
@@ -1,11 +1,12 @@
Source: libscriptalicious-perl
Section: perl
Priority: optional
-Build-Depends: debhelper (>= 4.0.2), libmodule-build-perl
+Build-Depends: debhelper (>= 7), libmodule-build-perl
Build-Depends-Indep: perl (>= 5.8.0-7), libyaml-perl
Maintainer: Debian Perl Group <pkg-perl-maintainers at lists.alioth.debian.org>
-Uploaders: Florian Ragwitz <rafl at debianforum.de>
-Standards-Version: 3.6.2
+Uploaders: Florian Ragwitz <rafl at debianforum.de>,
+ Krzysztof Krzyżaniak (eloy) <eloy at debian.org>
+Standards-Version: 3.8.0
Homepage: http://search.cpan.org/dist/Scriptalicious/
Vcs-Svn: svn://svn.debian.org/pkg-perl/trunk/libscriptalicious-perl/
Vcs-Browser: http://svn.debian.org/wsvn/pkg-perl/trunk/libscriptalicious-perl/
Modified: trunk/libscriptalicious-perl/debian/copyright
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libscriptalicious-perl/debian/copyright?rev=22209&op=diff
==============================================================================
--- trunk/libscriptalicious-perl/debian/copyright (original)
+++ trunk/libscriptalicious-perl/debian/copyright Fri Jun 27 08:57:51 2008
@@ -5,9 +5,19 @@
The upstream author is: Sam Vilain <samv at cpan.org>
-This module is licensed under the same license as perl.
+Copyright 2005-2008, Sam Vilain. All rights reserved.
-Perl is distributed under your choice of the GNU General Public License or
-the Artistic License. On Debian GNU/Linux systems, the complete text of the
-GNU General Public License can be found in `/usr/share/common-licenses/GPL'
-and the Artistic Licence in `/usr/share/common-licenses/Artistic'.
+This program is free software, you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+Perl is distributed under licenses:
+
+ a) the GNU General Public License as published by the Free Software
+ Foundation; either version 1, or (at your option) any later
+ version, or
+
+ b) the "Artistic License" which comes with Perl.
+
+ On Debian GNU/Linux systems, the complete text of the GNU General
+ Public License can be found in /usr/share/common-licenses/GPL' and
+ the Artistic Licence in /usr/share/common-licenses/Artistic'.
Modified: trunk/libscriptalicious-perl/lib/Scriptalicious.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libscriptalicious-perl/lib/Scriptalicious.pm?rev=22209&op=diff
==============================================================================
--- trunk/libscriptalicious-perl/lib/Scriptalicious.pm (original)
+++ trunk/libscriptalicious-perl/lib/Scriptalicious.pm Fri Jun 27 08:57:51 2008
@@ -1,3 +1,11 @@
+
+# Copyright 2005-2008, Sam Vilain. All rights reserved. This program
+# is free software; you can use it and/or distribute it under the same
+# terms as Perl itself; either the latest stable release of Perl when
+# the module was written, or any subsequent stable release.
+#
+# Please note that this applies retrospectively to all Scriptalicious
+# releases; apologies for the lack of an explicit license.
package Scriptalicious;
@@ -6,7 +14,7 @@
use warnings;
use Carp qw(croak);
-our $VERSION = "1.10";
+our $VERSION = "1.15";
use Getopt::Long;
use base qw(Exporter);
@@ -19,16 +27,19 @@
start_timer show_delta show_elapsed getconf
getconf_f sci_unit prompt_for prompt_passwd
prompt_yn prompt_Yn prompt_yN prompt_string
+ prompt_nY prompt_Ny prompt_ny
prompt_int tsay anydump prompt_regex prompt_sub
- prompt_file
+ prompt_file hush_exec unhush_exec
+ getopt_lenient time_unit
);
}
# define this in subclasses where appropriate
sub __package__ { __PACKAGE__ }
-our ($VERBOSE, $closure);
+our ($VERBOSE, $closure, $SHOW_CMD_VERBOSE, $gotconf);
$VERBOSE = 0;
+$SHOW_CMD_VERBOSE = 1;
#---------------------------------------------------------------------
# parse import arguments and export symbols
@@ -62,10 +73,10 @@
END { $closure->() if $closure }
-sub getopt {
-
+sub getopt_lenient {
local($closure) = \&show_usage;
+ $gotconf = 1;
Getopt::Long::GetOptions
(
'help|h' => \&show_help,
@@ -81,18 +92,28 @@
shift @ARGV, return if $#ARGV >= 0 and $ARGV[0] eq "--";
+}
+
+sub getopt {
+ local($closure) = \&show_usage;
+
+ getopt_lenient(@_);
+
abort("unrecognised option: $ARGV[0]")
if $#ARGV >= 0 and $ARGV[0] =~ m/^-/;
}
-sub say { print "$PROGNAME: @_\n" unless $VERBOSE < 0 }
+sub say { _autoconf() unless $gotconf;
+ print "$PROGNAME: @_\n" unless $VERBOSE < 0 }
sub mutter { say @_ if $VERBOSE }
sub whisper { say @_ if $VERBOSE > 1 }
-sub _err_say { print STDERR "$PROGNAME: @_\n" }
+sub _err_say { _autoconf() unless $gotconf;
+ print STDERR "$PROGNAME: @_\n" }
sub abort { _err_say "aborting: @_"; &show_usage; }
sub moan { _err_say "warning: @_" }
sub protest { _err_say "error: @_" }
sub barf { if($^S){die @_}else{ _err_say "ERROR: @_"; exit(1); } }
+sub _autoconf { getopt_lenient( eval{ my @x = getconf(@_); @x } ) }
#---------------------------------------------------------------------
# helpers for running commands and/or capturing their output
@@ -108,6 +129,15 @@
s/[\0-\031"\s\177-\377]/$map{$&}/eg;
$_ = "\"$_\"";
}; $_ } map { $_ } @_);
+}
+
+our @SHOW_CMD_VERBOSE;
+sub hush_exec {
+ push @SHOW_CMD_VERBOSE, $SHOW_CMD_VERBOSE;
+ $SHOW_CMD_VERBOSE=2;
+}
+sub unhush_exec {
+ $SHOW_CMD_VERBOSE = pop @SHOW_CMD_VERBOSE;
}
our @last_cmd;
@@ -122,7 +152,7 @@
(($? >> 8)
? "exited with error code ".($?>>8)
: "killed by signal $?")
- .(($VERBOSE >= 1 or $next_cmd_no_hide) ? ""
+ .(($VERBOSE >= $SHOW_CMD_VERBOSE or $next_cmd_no_hide) ? ""
: (($start != 0
? "\nlast lines of output:\n"
: "\nprogram output:\n")
@@ -136,7 +166,7 @@
sub do_fork {
@output = ();
if (not $next_cmd_capture and
- ( $VERBOSE >= 1 or $next_cmd_no_hide )) {
+ ( $VERBOSE >= $SHOW_CMD_VERBOSE or $next_cmd_no_hide )) {
return fork()
} else {
my $pid = open CHILD, "-|";
@@ -151,11 +181,11 @@
my $pid = shift;
if (not $next_cmd_capture and
- ($VERBOSE >= 1 or $next_cmd_no_hide)) {
+ ($VERBOSE >= $SHOW_CMD_VERBOSE or $next_cmd_no_hide)) {
waitpid($pid, 0);
} else {
- while (<CHILD>) {
- push @output, $_;
+ while (my $line = <CHILD>) {
+ push @output, $line;
}
close CHILD;
}
@@ -181,12 +211,14 @@
$fd_desc .= ($fd_desc ? ", " : "") . "fd$fd=$mode$fds{$fd}";
}
@last_cmd = @_;
- mutter("running `".shellquote(@last_cmd)."'"
- .($next_cmd_capture
- ? " (captured)"
- : "")
- .($fd_desc?"($fd_desc)":"")
- ) unless ref($_[0]);
+ if ( $VERBOSE >= $SHOW_CMD_VERBOSE ) {
+ say("running `".shellquote(@last_cmd)."'"
+ .($next_cmd_capture
+ ? " (captured)"
+ : "")
+ .($fd_desc?"($fd_desc)":"")
+ ) unless ref($_[0]);
+ }
_load_hires;
my $start = start_timer();
@@ -209,8 +241,10 @@
barf "exec failed; $!";
}
}
- mutter sprintf("command completed in ".show_elapsed($start))
- if $VERBOSE > 0;
+
+ if ( $VERBOSE >= $SHOW_CMD_VERBOSE ) {
+ say sprintf("command completed in ".show_elapsed($start))
+ }
return $?
@@ -430,17 +464,61 @@
sub show_elapsed {
my $e = tv_interval($_[0]||$start, [gettimeofday()]);
- return sci_unit($e, "s", 3);
+ return time_unit($e, 3);
}
sub show_delta {
my $now;
my $e = tv_interval($_[0]||$last, $now = [gettimeofday()]);
$last = $now;
- return sci_unit($e, "s", 3);
+ return time_unit($e, 3);
}
use POSIX qw(ceil);
+my @time_mul = (["w", 7*86400], ["d", 86400, " "], ["h", 3600, ":"],
+ ["m", 60, ":" ], ["s", 1, 0],
+ [ "ms", 0.001 ], [ "us", 1e-6 ], ["ns", 1e-9]);
+sub time_unit {
+ my $scalar = shift;
+ my $d = (shift) || 4;
+ if ($scalar == 0) {
+ return "0s";
+ }
+ my $quanta = exp(log($scalar)-2.3025851*$d);
+ my $rem = $scalar+0;
+ my $rv = "";
+ for my $i (0..$#time_mul) {
+ my $unit = $time_mul[$i];
+ if ($rv or $unit->[1] <= $rem ) {
+ my $x = int($rem/$unit->[1]);
+ my $new_rem = ($x ? $rem - ($x*$unit->[1]) : $rem);
+ my $last = ($time_mul[$i+1][1]<$quanta);
+ if ($last and $new_rem >= $unit->[1]/2) {
+ $x++;
+ }
+ if (!$last and $unit->[2]) {
+ $rv .= $x.$unit->[0].$unit->[2];
+ }
+ elsif (defined $unit->[2] and !$unit->[2]) {
+ # stop at seconds
+ my $prec = ceil(-log($quanta)/log(10)-1.01);
+ if ( $prec >= 1 ) {
+ $rv .= sprintf("%.${prec}f", $rem).$unit->[0];
+ }
+ else {
+ $rv .= sprintf("%d", $rem).$unit->[0];
+ }
+ last;
+ }
+ else {
+ $rv .= $x.$unit->[0];
+ }
+ last if $last;
+ $rem = $new_rem;
+ }
+ }
+ $rv;
+}
my %prefixes=(18=>"E",15=>"P",12=>"T",9=>"G",6=>"M",3=>"k",0=>"",
-3=>"m",-6=>"u",-9=>"n",-12=>"p",-15=>"f",-18=>"a");
@@ -468,7 +546,12 @@
sub getconf {
my $conf_obj;
- eval 'use YAML'; barf "failed to include YAML; $@" if $@;
+ eval 'use YAML';
+ if ($@) {
+ local($gotconf) = 1;
+ moan "failed to include YAML; not able to load config";
+ return @_;
+ }
for my $loc ( "$ENV{HOME}/.${PROGNAME}rc",
"/etc/perl/$PROGNAME.conf",
"/etc/$PROGNAME.conf",
@@ -497,8 +580,12 @@
sub getconf_f {
my $filename = shift;
- eval 'use YAML'; barf "failed to include YAML; $@" if $@;
-
+ eval 'use YAML';
+ if ($@) {
+ local($gotconf) = 1;
+ moan "failed to include YAML; not able to load config";
+ return @_;
+ }
my $conf_obj;
if ( $filename eq "POD" ) {
@@ -727,7 +814,7 @@
my $prompt = shift;
my $default = shift;
prompt_sub($prompt.(defined($default)?" [$default]":""),
- sub { $_ || $default });
+ sub { $_ || $default || $_ });
}
sub prompt_int {
@@ -741,23 +828,26 @@
sub prompt_nY { prompt_Yn(@_) }
sub prompt_Yn {
prompt_sub ($_[0]." [Yn]",
- sub {( /^\s*(?: (?:(y.*))? | (n.*))\s*$/ix &&
- ($2 ? 0 : (defined($1) ? 1 : undef))
- )} );
-}
+ sub { ( /^\s*(?: (?:(y.*))? | (n.*))\s*$/ix
+ ? ($2 ? 0 : 1)
+ : undef )},
+ );
+}
+sub prompt_ny { prompt_yn(@_) }
sub prompt_yn {
prompt_sub ($_[0]." [yn]",
- sub {( /^\s*(?: (y.*) | (n.*))\s*$/ix &&
- ($2 ? 0 : ($1 ? 1 : undef))
- )},
- "please enter `yes', or `no'" );
+ sub {( /^\s*(?: (y.*) | (n.*))\s*$/ix
+ ? ($2 ? 0 : ($1 ? 1 : undef))
+ : undef
+ )},
+ "please enter `yes', or `no'" );
}
sub prompt_Ny { prompt_yN(@_) }
sub prompt_yN {
prompt_sub ($_[0]." [Ny]",
- sub {( /^\s*(?: (y.*)? | (?:(n.*))? )\s*$/ix &&
- ($1 ? 1 : (defined($2) ? 0 : undef))
- )} );
+ sub {( /^\s*(?: (y.*)? | (?:(n.*))? )\s*$/ix
+ ? ($1 ? 1 : 0)
+ : undef )} );
}
sub prompt_file {
@@ -1003,6 +1093,7 @@
my @data;
if ( open(my $script, $0) ) {
"" =~ m{()}; # clear $1
+ local(*_);
while ( <$script> ) {
if ( m{^__\Q$name\E__$} .. (m{^__(?!\Q$name\E)(\w+)__$}||eof $script) ) {
$found++ or next;
Modified: trunk/libscriptalicious-perl/lib/Scriptalicious.pod
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libscriptalicious-perl/lib/Scriptalicious.pod?rev=22209&op=diff
==============================================================================
--- trunk/libscriptalicious-perl/lib/Scriptalicious.pod (original)
+++ trunk/libscriptalicious-perl/lib/Scriptalicious.pod Fri Jun 27 08:57:51 2008
@@ -137,6 +137,11 @@
configuration of B<Getopt::Long>. To alter the configuration, simply
call C<Getopt::Long::config>. See L<Getopt::Long> for more
information.
+
+=item B<getopt_lenient(@getopt_args)>
+
+Just like C<getopt()>, but doesn't cause a fatal error if there are
+any unknown options.
=item B<getconf(@getopt_args)>
@@ -328,6 +333,16 @@
my ($rc, @output) = capture_err("somecommand", @args);
+=item B<hush_exec()>
+
+=item B<unhush_exec()>
+
+C<hush_exec> is used to indicate that the programs you are running are
+only of interest to someone debugging the script. So, the messages
+showing commands run and giving execution timings will not be printed
+without C<-vv> (double verbose) or C<-d> (debug, which is the same
+thing).
+
=item B<start_timer()>
=item B<show_delta()>
@@ -348,6 +363,25 @@
From Scriptalicious 1.08, the "u" character is used in place of the
Greek "mu" due to encoding compatibility issues.
+=item B<time_unit($num, [$precision])>
+
+Converts a floating point number of seconds to a human-readable time,
+the precision specifies the number of significant decimal digits,
+which is used to compute a "quanta" for the value given, values below
+which are not displayed. $precision defaults to 4.
+
+examples:
+
+ time_unit(10.1) => "10.10s"
+ time_unit(1) => "1.000s"
+ time_unit(0.1) => "100ms"
+ time_unit(86401,2) => "1d 0h"
+ time_unit(86401,3) => "1d 0h"
+ time_unit(86401) => "1d 0h:0m"
+ time_unit(86400+3600/2) => "1d 0h:30m"
+ time_unit(86401,5) => "1d 0h:0m:1s"
+ time_unit(7*86400) => "1w0d 0h"
+
=item B<prompt_regex($prompt, qr/(.*)/)>
Prompts for something, using the prompt "C<$prompt>", matching the
@@ -390,6 +424,8 @@
=item B<prompt_yN([$prompt])>
prompts for yes or no, presuming yes and no, respectively.
+
+You can also spell these as C<prompt_nY> and C<prompt_Ny>.
=item B<anydump($ref)>
@@ -454,13 +490,23 @@
contrasting to this module's approach of elegant simplicity (quiet in
the cheap seats!).
+L<Getopt::EUCLID> is Damian Conway's take on this.
+
If you have solved this problem in a new and interesting way, or even
rehashed it in an old, boring and inelegant way and want your module
to be listed here, please contact the
-=head1 AUTHOR
-
-Sam Vilain, samv at cpan.org
+=head1 AUTHOR AND LICENSE
+
+Sam Vilain, L<samv at cpan.org>
+
+Copyright 2005-2008, Sam Vilain. All rights reserved. This program
+is free software; you can use it and/or distribute it under the same
+terms as Perl itself; either the latest stable release of Perl when
+the module was written, or any subsequent stable release.
+
+Please note that this applies retrospectively to all Scriptalicious
+releases; apologies for the lack of an explicit license.
=cut
Modified: trunk/libscriptalicious-perl/t/01-mmmdelicious.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libscriptalicious-perl/t/01-mmmdelicious.t?rev=22209&op=diff
==============================================================================
--- trunk/libscriptalicious-perl/t/01-mmmdelicious.t (original)
+++ trunk/libscriptalicious-perl/t/01-mmmdelicious.t Fri Jun 27 08:57:51 2008
@@ -33,5 +33,5 @@
is($error, 0, "capture_err() - error code");
is($output, `head -5 $0`, "capture_err() - output");
-like(show_delta, qr/^\d+(\.\d+)?[mµ]?s$/, "show_delta");
-like(show_elapsed, qr/^\d+(\.\d+)?[mµ]?s$/, "show_elapsed");
+like(show_delta, qr/^\d+(\.\d+)?[mu]?s$/, "show_delta");
+like(show_elapsed, qr/^\d+(\.\d+)?[mu]?s$/, "show_elapsed");
Modified: trunk/libscriptalicious-perl/t/02-script.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libscriptalicious-perl/t/02-script.t?rev=22209&op=diff
==============================================================================
--- trunk/libscriptalicious-perl/t/02-script.t (original)
+++ trunk/libscriptalicious-perl/t/02-script.t Fri Jun 27 08:57:51 2008
@@ -1,4 +1,6 @@
#!/usr/bin/perl -w
+
+for (qw|readonly|) {
use strict;
@@ -25,3 +27,5 @@
= capture_err($^X, "-Mlib=$path", "t/pu.pl", "--version");
$output = join "", @output;
like($output, qr/^This is pu, version 1.00/m, "spots invalid arguments");
+
+}
Modified: trunk/libscriptalicious-perl/t/03-yaml.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libscriptalicious-perl/t/03-yaml.t?rev=22209&op=diff
==============================================================================
--- trunk/libscriptalicious-perl/t/03-yaml.t (original)
+++ trunk/libscriptalicious-perl/t/03-yaml.t Fri Jun 27 08:57:51 2008
@@ -1,6 +1,16 @@
# -*- perl -*-
-use Test::More tests => 9;
+use Test::More;
+
+BEGIN {
+ eval { require YAML; YAML->import };
+ if ($@) {
+ plan skip_all => "YAML not installed";
+ }
+ else {
+ plan tests => 9;
+ }
+}
BEGIN {
use_ok( 'Scriptalicious', -progname => "myscript" );
Modified: trunk/libscriptalicious-perl/t/04-fork.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libscriptalicious-perl/t/04-fork.t?rev=22209&op=diff
==============================================================================
--- trunk/libscriptalicious-perl/t/04-fork.t (original)
+++ trunk/libscriptalicious-perl/t/04-fork.t Fri Jun 27 08:57:51 2008
@@ -1,4 +1,9 @@
#!/usr/bin/perl
+
+# Copyright 2005-2008, Sam Vilain. All rights reserved. This program
+# is free software; you can use it and/or distribute it under the same
+# terms as Perl itself; either the latest stable release of Perl when
+# the module was written, or any subsequent stable release.
use warnings;
use strict;
@@ -42,7 +47,7 @@
$output = slurp $testfile;
like($output, qr/:.*Loop this!/, "run -out => 'FILENAME'");
-$output = capture( -out => sub { my $foo = readline STDIN;
+$output = capture( -out => sub { my $foo = <STDIN>;
slop $testfile, $foo;
},
-in => sub { print "slopslopslop\n" },
@@ -76,7 +81,7 @@
# last out!
$output = capture( -in5 => sub { print "slurpamunchalot\n" },
- -out4 => sub { my $foo = readline STDIN;
+ -out4 => sub { my $foo = <STDIN>;
slop $testfile, $foo },
$^X, "-Mlib=lib", "t/loopback.pl", qw(-o 4 -i 5));
is($output, "", "run -out4 => CODE, -in4 => CODE (no output from capture)");
More information about the Pkg-perl-cvs-commits
mailing list