@@ -1,7 +1,15 @@
Revision history for No-Worries:
+1.2 Tue Apr 8 2014
+ * No::Worries::PidFile: added a timeout option to pf_status().
+
+1.1 Fri Jan 10 2014
+ * No::Worries::String: added an "align" option to string_table().
+ * No::Worries::PidFile: added pf_sleep() to ease sleeping.
+ * No::Worries::String: added string_plural() and string_quantify().
+
1.0 Tue May 21 2013
- * Improved tests portability.
+ * Improved tests' portability.
* Promoted to 1.0 after successful testing.
* The API is now stable.
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: No-Worries
-version: 1.0
+version: 1.2
abstract: coding without worries
author:
- Lionel Cons <lionel.cons@cern.ch>
@@ -7,7 +7,7 @@ my(%param, $emv, $name);
%param = (
NAME => 'No::Worries',
AUTHOR => 'Lionel Cons <lionel.cons@cern.ch>',
- VERSION => '1.0',
+ VERSION => '1.2',
ABSTRACT_FROM => 'lib/No/Worries.pm',
LICENSE => 'perl',
PL_FILES => {},
@@ -34,7 +34,7 @@ perldoc command.
LICENSE AND COPYRIGHT
-Copyright (C) CERN 2012-2013
+Copyright (C) CERN 2012-2014
This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
@@ -13,7 +13,7 @@
package No::Worries::DN;
use strict;
use warnings;
-our $VERSION = "1.0";
+our $VERSION = "1.2";
our $REVISION = sprintf("%d.%02d", q$Revision: 1.6 $ =~ /(\d+)\.(\d+)/);
#
@@ -199,4 +199,4 @@ L<No::Worries>.
Lionel Cons L<http://cern.ch/lionel.cons>
-Copyright (C) CERN 2012-2013
+Copyright (C) CERN 2012-2014
@@ -14,7 +14,7 @@ package No::Worries::Date;
use strict;
use warnings;
use 5.005; # need the four-argument form of substr()
-our $VERSION = "1.0";
+our $VERSION = "1.2";
our $REVISION = sprintf("%d.%02d", q$Revision: 1.12 $ =~ /(\d+)\.(\d+)/);
#
@@ -170,4 +170,4 @@ L<No::Worries>.
Lionel Cons L<http://cern.ch/lionel.cons>
-Copyright (C) CERN 2012-2013
+Copyright (C) CERN 2012-2014
@@ -13,7 +13,7 @@
package No::Worries::Die;
use strict;
use warnings;
-our $VERSION = "1.0";
+our $VERSION = "1.2";
our $REVISION = sprintf("%d.%02d", q$Revision: 1.19 $ =~ /(\d+)\.(\d+)/);
#
@@ -216,4 +216,4 @@ L<No::Worries::Warn>.
Lionel Cons L<http://cern.ch/lionel.cons>
-Copyright (C) CERN 2012-2013
+Copyright (C) CERN 2012-2014
@@ -13,13 +13,14 @@
package No::Worries::Dir;
use strict;
use warnings;
-our $VERSION = "1.0";
-our $REVISION = sprintf("%d.%02d", q$Revision: 1.15 $ =~ /(\d+)\.(\d+)/);
+our $VERSION = "1.2";
+our $REVISION = sprintf("%d.%02d", q$Revision: 1.16 $ =~ /(\d+)\.(\d+)/);
#
# used modules
#
+use No::Worries qw($_IntegerRegexp);
use No::Worries::Die qw(dief);
use No::Worries::Export qw(export_control);
use Params::Validate qw(validate :types);
@@ -54,7 +55,7 @@ sub _mkdir ($$) {
# public interface
my %dir_ensure_options = (
- mode => { optional => 1, type => SCALAR, regex => qr/^\d+$/ },
+ mode => { optional => 1, type => SCALAR, regex => $_IntegerRegexp },
);
sub dir_ensure ($@) {
@@ -72,7 +73,7 @@ sub dir_ensure ($@) {
#
my %dir_make_options = (
- mode => { optional => 1, type => SCALAR, regex => qr/^\d+$/ },
+ mode => { optional => 1, type => SCALAR, regex => $_IntegerRegexp },
);
sub dir_make ($@) {
@@ -175,25 +176,25 @@ No::Worries::Dir - directory handling without worries
=head1 DESCRIPTION
-This module eases directory handling by providing convenient wrappers
-around standard directory functions. All the functions die() on error.
+This module eases directory handling by providing convenient wrappers around
+standard directory functions. All the functions die() on error.
=head1 FUNCTIONS
-This module provides the following functions (none of them being
-exported by default):
+This module provides the following functions (none of them being exported by
+default):
=over
=item dir_change(PATH)
-change the working directory to the given path; this is a safe thin
-wrapper on top of chdir()
+change the working directory to the given path; this is a safe thin wrapper on
+top of chdir()
=item dir_ensure(PATH[, OPTIONS])
-make sure the given path is an existing directory, creating it
-(including its parents) if needed; supported options:
+make sure the given path is an existing directory, creating it (including its
+parents) if needed; supported options:
=over
@@ -203,8 +204,8 @@ make sure the given path is an existing directory, creating it
=item dir_make(PATH[, OPTIONS])
-make the given directory; this is a safe thin wrapper on top of
-mkdir(); supported options:
+make the given directory; this is a safe thin wrapper on top of mkdir();
+supported options:
=over
@@ -219,13 +220,12 @@ return the parent directory of the given path
=item dir_read(PATH)
-read the given directory and return its list of entries except C<.>
-and C<..>
+read the given directory and return its list of entries except C<.> and C<..>
=item dir_remove(PATH)
-remove the given directory (that must exist and be empty); this is a
-safe thin wrapper on top of rmdir()
+remove the given directory (that must exist and be empty); this is a safe thin
+wrapper on top of rmdir()
=back
@@ -237,4 +237,4 @@ L<No::Worries>.
Lionel Cons L<http://cern.ch/lionel.cons>
-Copyright (C) CERN 2012-2013
+Copyright (C) CERN 2012-2014
@@ -13,7 +13,7 @@
package No::Worries::Export;
use strict;
use warnings;
-our $VERSION = "1.0";
+our $VERSION = "1.2";
our $REVISION = sprintf("%d.%02d", q$Revision: 1.7 $ =~ /(\d+)\.(\d+)/);
#
@@ -195,4 +195,4 @@ L<No::Worries>.
Lionel Cons L<http://cern.ch/lionel.cons>
-Copyright (C) CERN 2012-2013
+Copyright (C) CERN 2012-2014
@@ -13,13 +13,14 @@
package No::Worries::File;
use strict;
use warnings;
-our $VERSION = "1.0";
-our $REVISION = sprintf("%d.%02d", q$Revision: 1.15 $ =~ /(\d+)\.(\d+)/);
+our $VERSION = "1.2";
+our $REVISION = sprintf("%d.%02d", q$Revision: 1.16 $ =~ /(\d+)\.(\d+)/);
#
# used modules
#
+use No::Worries qw($_IntegerRegexp);
use No::Worries::Die qw(dief);
use No::Worries::Export qw(export_control);
use Params::Validate qw(validate :types);
@@ -86,7 +87,7 @@ sub _file_read_io ($$$$) {
my %file_read_options = (
binmode => { optional => 1, type => SCALAR, regex => qr/^(binary|utf8)$/ },
- bufsize => { optional => 1, type => SCALAR, regex => qr/^\d+$/ },
+ bufsize => { optional => 1, type => SCALAR, regex => $_IntegerRegexp },
data => { optional => 1, type => SCALARREF | CODEREF },
);
@@ -150,7 +151,7 @@ sub _file_write_io ($$$$) {
my %file_write_options = (
binmode => { optional => 1, type => SCALAR, regex => qr/^(binary|utf8)$/ },
- bufsize => { optional => 1, type => SCALAR, regex => qr/^\d+$/ },
+ bufsize => { optional => 1, type => SCALAR, regex => $_IntegerRegexp },
data => { optional => 0, type => SCALAR | SCALARREF | CODEREF },
);
@@ -210,20 +211,19 @@ No::Worries::File - file handling without worries
=head1 DESCRIPTION
-This module eases file handling by providing convenient wrappers
-around standard file functions. All the functions die() on error.
+This module eases file handling by providing convenient wrappers around
+standard file functions. All the functions die() on error.
=head1 FUNCTIONS
-This module provides the following functions (none of them being
-exported by default):
+This module provides the following functions (none of them being exported by
+default):
=over
=item file_read(PATH[, OPTIONS])
-read the file at the given path and return its contents; supported
-options:
+read the file at the given path and return its contents; supported options:
=over
@@ -231,15 +231,14 @@ options:
=item * C<bufsize>: buffer size to use for I/O operations
-=item * C<data>: return the file contents via this scalar reference or
-code reference (see below)
+=item * C<data>: return the file contents via this scalar reference or code
+reference (see below)
=back
=item file_write(PATH[, OPTIONS])
-write the given contents to the file at the given path; supported
-options:
+write the given contents to the file at the given path; supported options:
=over
@@ -247,8 +246,8 @@ options:
=item * C<bufsize>: buffer size to use for I/O operations
-=item * C<data>: provide the file contents via this scalar, scalar
-reference or code reference (see below)
+=item * C<data>: provide the file contents via this scalar, scalar reference
+or code reference (see below)
=back
@@ -256,33 +255,32 @@ reference or code reference (see below)
=head1 OPTIONS
-All the functions support a C<binmode> option specifying how the file
-should be accessed:
+All the functions support a C<binmode> option specifying how the file should
+be accessed:
=over
=item * C<binary>: binmode(FH) will be used to treat the file as binary
-=item * C<utf8>: binmode(FH, ":encoding(utf8)") will be used to select
-UTF-8 encoding
+=item * C<utf8>: binmode(FH, ":encoding(utf8)") will be used to select UTF-8
+encoding
=item * otherwise: binmode() will not be used (this is the default)
=back
-file_read() can be given a code reference via the C<data> option.
-Each time data is read via sysread(), the subroutine will be called
-with the read data. At the end of the file, the subroutine will be
-called with an empty string.
+file_read() can be given a code reference via the C<data> option. Each time
+data is read via sysread(), the subroutine will be called with the read
+data. At the end of the file, the subroutine will be called with an empty
+string.
-file_write() can be given a code reference via the C<data> option. It
-should return data in a way similar to sysread(), returning an empty
-string to indicate the end of the data to write to the file.
+file_write() can be given a code reference via the C<data> option. It should
+return data in a way similar to sysread(), returning an empty string to
+indicate the end of the data to write to the file.
=head1 GLOBAL VARIABLES
-This module uses the following global variables (none of them being
-exported):
+This module uses the following global variables (none of them being exported):
=over
@@ -301,4 +299,4 @@ L<No::Worries>.
Lionel Cons L<http://cern.ch/lionel.cons>
-Copyright (C) CERN 2012-2013
+Copyright (C) CERN 2012-2014
@@ -13,7 +13,7 @@
package No::Worries::Log;
use strict;
use warnings;
-our $VERSION = "1.0";
+our $VERSION = "1.2";
our $REVISION = sprintf("%d.%02d", q$Revision: 1.17 $ =~ /(\d+)\.(\d+)/);
#
@@ -888,4 +888,4 @@ L<No::Worries::Syslog>.
Lionel Cons L<http://cern.ch/lionel.cons>
-Copyright (C) CERN 2012-2013
+Copyright (C) CERN 2012-2014
@@ -13,14 +13,15 @@
package No::Worries::PidFile;
use strict;
use warnings;
-our $VERSION = "1.0";
-our $REVISION = sprintf("%d.%02d", q$Revision: 1.17 $ =~ /(\d+)\.(\d+)/);
+our $VERSION = "1.2";
+our $REVISION = sprintf("%d.%02d", q$Revision: 1.20 $ =~ /(\d+)\.(\d+)/);
#
# used modules
#
use Fcntl qw(:DEFAULT :flock :seek);
+use No::Worries qw($_IntegerRegexp $_NumberRegexp);
use No::Worries::Die qw(dief);
use No::Worries::Export qw(export_control);
use No::Worries::Proc qw(proc_terminate);
@@ -129,11 +130,60 @@ sub _kill ($$$%) {
}
#
+# check a process
+#
+
+sub _status ($%) {
+ my($path, %option) = @_;
+ my($fh, @stat, $data, $pid, $status, $message, $lsb);
+
+ $status = 0;
+ unless (sysopen($fh, $path, O_RDWR)) {
+ if ($! == ENOENT) {
+ ($message, $lsb) =
+ ("does not seem to be running (no pid file)", 3);
+ goto done;
+ }
+ dief("cannot sysopen(%s, O_RDWR): %s", $path, $!);
+ }
+ @stat = stat($fh)
+ or dief("cannot stat(%s): %s", $path, $!);
+ $data = _read($path, $fh);
+ if ($data eq "") {
+ # this can happen in pf_set(), between open() and lock()
+ ($message, $lsb) =
+ ("does not seem to be running yet (empty pid file)", 4);
+ goto done;
+ }
+ if ($data =~ /^(\d+)(\s+([a-z]+))?\s*$/s) {
+ $pid = $1;
+ } else {
+ dief("unexpected pid file contents in %s: %s", $path, $data);
+ }
+ unless (_alive($pid)) {
+ ($message, $lsb) =
+ ("(pid $pid) does not seem to be running anymore", 1);
+ goto done;
+ }
+ $data = localtime($stat[ST_MTIME]);
+ if ($option{freshness} and
+ $stat[ST_MTIME] < Time::HiRes::time() - $option{freshness}) {
+ ($message, $lsb) =
+ ("(pid $pid) does not seem to be running anymore since $data", 4);
+ goto done;
+ }
+ # so far so good ;-)
+ ($status, $message, $lsb) = (1, "(pid $pid) was active on $data", 0);
+ done:
+ return($status, $message, $lsb);
+}
+
+#
# set the pid file
#
my %pf_set_options = (
- pid => { optional => 1, type => SCALAR, regex => qr/^\d+$/ },
+ pid => { optional => 1, type => SCALAR, regex => $_IntegerRegexp },
);
sub pf_set ($@) {
@@ -152,7 +202,7 @@ sub pf_set ($@) {
#
my %pf_check_options = (
- pid => { optional => 1, type => SCALAR, regex => qr/^\d+$/ },
+ pid => { optional => 1, type => SCALAR, regex => $_IntegerRegexp },
);
sub pf_check ($@) {
@@ -207,51 +257,27 @@ sub pf_unset ($) {
#
my %pf_status_options = (
- freshness => { optional => 1, type => SCALAR, regex => qr/^\d+$/ },
+ freshness => { optional => 1, type => SCALAR, regex => $_NumberRegexp },
+ timeout => { optional => 1, type => SCALAR, regex => $_NumberRegexp },
);
sub pf_status ($@) {
- my($path, %option, $fh, @stat, $data, $pid, $status, $message, $lsb);
+ my($path, %option, $maxtime, $status, $message, $lsb);
$path = shift(@_);
%option = validate(@_, \%pf_status_options) if @_;
- $status = 0;
- unless (sysopen($fh, $path, O_RDWR)) {
- if ($! == ENOENT) {
- ($message, $lsb) =
- ("does not seem to be running (no pid file)", 3);
- goto done;
+ if ($option{timeout}) {
+ # check multiple times until success or timeout
+ $maxtime = Time::HiRes::time() + $option{timeout};
+ while (1) {
+ ($status, $message, $lsb) = _status($path, %option);
+ last if $status or Time::HiRes::time() > $maxtime;
+ Time::HiRes::sleep(0.1);
}
- dief("cannot sysopen(%s, O_RDWR): %s", $path, $!);
- }
- @stat = stat($fh)
- or dief("cannot stat(%s): %s", $path, $!);
- $data = _read($path, $fh);
- if ($data eq "") {
- # this can happen in pf_set(), between open() and lock()
- ($message, $lsb) =
- ("does not seem to be running yet (empty pid file)", 4);
- goto done;
- }
- if ($data =~ /^(\d+)(\s+([a-z]+))?\s*$/s) {
- $pid = $1;
} else {
- dief("unexpected pid file contents in %s: %s", $path, $data);
+ # check only once
+ ($status, $message, $lsb) = _status($path, %option);
}
- unless (_alive($pid)) {
- ($message, $lsb) =
- ("(pid $pid) does not seem to be running anymore", 1);
- goto done;
- }
- $data = localtime($stat[ST_MTIME]);
- if ($option{freshness} and $stat[ST_MTIME] < time() - $option{freshness}) {
- ($message, $lsb) =
- ("(pid $pid) does not seem to be running anymore since $data", 4);
- goto done;
- }
- # so far so good ;-)
- ($status, $message, $lsb) = (1, "(pid $pid) was active on $data", 0);
- done:
return($status, $message, $lsb) if wantarray();
return($status);
}
@@ -262,7 +288,7 @@ sub pf_status ($@) {
my %pf_quit_options = (
callback => { optional => 1, type => CODEREF },
- linger => { optional => 1, type => SCALAR, regex => qr/^\d+$/ },
+ linger => { optional => 1, type => SCALAR, regex => $_NumberRegexp },
kill => { optional => 1, type => SCALAR },
);
@@ -315,6 +341,37 @@ sub pf_quit ($@) {
}
#
+# sleep for some time, taking into account an optional pid file
+#
+
+my %pf_sleep_options = (
+ time => { optional => 1, type => SCALAR, regex => $_NumberRegexp },
+);
+
+sub pf_sleep ($@) {
+ my($path, %option, $end, $sleep);
+
+ $path = shift(@_);
+ %option = validate(@_, \%pf_sleep_options) if @_;
+ $option{time} = 1 unless defined($option{time});
+ if ($path) {
+ $end = Time::HiRes::time() + $option{time} if $option{time};
+ while (1) {
+ return(0) if pf_check($path) eq "quit";
+ pf_touch($path);
+ last unless $option{time};
+ $sleep = $end - Time::HiRes::time();
+ last if $sleep <= 0;
+ $sleep = 1 if $sleep > 1;
+ Time::HiRes::sleep($sleep);
+ }
+ } else {
+ Time::HiRes::sleep($option{time}) if $option{time};
+ }
+ return(1);
+}
+
+#
# export control
#
@@ -322,7 +379,8 @@ sub import : method {
my($pkg, %exported);
$pkg = shift(@_);
- grep($exported{$_}++, map("pf_$_", qw(set check touch unset status quit)));
+ grep($exported{$_}++, map("pf_$_",
+ qw(set check touch unset status quit sleep)));
export_control(scalar(caller()), $pkg, \%exported, @_);
}
@@ -336,7 +394,7 @@ No::Worries::PidFile - pid file handling without worries
=head1 SYNOPSIS
- use No::Worries::PidFile qw(pf_set pf_check pf_touch pf_unset pf_status pf_quit);
+ use No::Worries::PidFile qw(*);
# idiomatic daemon code
pf_set($pidfile);
@@ -349,6 +407,15 @@ No::Worries::PidFile - pid file handling without worries
}
pf_unset($pidfile);
+ # idiomatic daemon code with sleeping
+ pf_set($pidfile);
+ while (1) {
+ ...
+ pf_sleep($pidfile, time => 5) or last;
+ ...
+ }
+ pf_unset($pidfile);
+
# here is how to handle a --status option
if ($Option{status}) {
($status, $message, $code) = pf_status($pidfile, freshness => 10);
@@ -366,24 +433,22 @@ No::Worries::PidFile - pid file handling without worries
=head1 DESCRIPTION
-This module eases pid file handling by providing high level functions
-to set, check, touch and unset pid files. All the functions die() on
-error.
+This module eases pid file handling by providing high level functions to set,
+check, touch and unset pid files. All the functions die() on error.
-The pid file usually contains the process id on a single line,
-followed by a newline. However, it can also be followed by an optional
-I<action>, also followed by a newline. This allows some kind of
-inter-process communication: a process using pf_quit() will append the
-C<quit> I<action> to the pid file and the owning process will detect
-this via pf_check().
+The pid file usually contains the process id on a single line, followed by a
+newline. However, it can also be followed by an optional I<action>, also
+followed by a newline. This allows some kind of inter-process communication: a
+process using pf_quit() will append the C<quit> I<action> to the pid file and
+the owning process will detect this via pf_check().
All the functions properly handle concurrency. For instance, when two
-processes start at the exact same time and call pf_set(), only one
-will succeed and the other one will get an error.
+processes start at the exact same time and call pf_set(), only one will
+succeed and the other one will get an error.
-Since an existing pid file will make pf_set() fail, it is very
-important to remove the pid file in all situations, including
-errors. The recommended way to do so is to use an END block:
+Since an existing pid file will make pf_set() fail, it is very important to
+remove the pid file in all situations, including errors. The recommended way
+to do so is to use an END block:
# we need to know about transient processes
use No::Worries::Proc qw();
@@ -403,8 +468,8 @@ errors. The recommended way to do so is to use an END block:
=head1 FUNCTIONS
-This module provides the following functions (none of them being
-exported by default):
+This module provides the following functions (none of them being exported by
+default):
=over
@@ -421,8 +486,8 @@ options:
=item pf_check(PATH[, OPTIONS])
-check the pid file and make sure the given pid is present, also return
-the I<action> in the pid file or the empty string; supported options:
+check the pid file and make sure the given pid is present, also return the
+I<action> in the pid file or the empty string; supported options:
=over
@@ -430,42 +495,55 @@ the I<action> in the pid file or the empty string; supported options:
=back
+=item pf_unset(PATH)
+
+unset the pid file by removing the given path
+
=item pf_touch(PATH)
-touch the pid file (i.e. update the file modification time) to show
-that the owning process is alive
+touch the pid file (i.e. update the file modification time) to show that the
+owning process is alive
-=item pf_unset(PATH)
+=item pf_sleep(PATH[, OPTIONS])
-unset the pid file by removing the given path
+check and touch the pid file and eventually sleep for the givent amount of
+time, returning true if the program should continue or false if it has been
+told to stop via pf_quit(); supported options:
+
+=over
+
+=item * C<time>: the time to sleep (default: 1, can be fractional)
+
+=back
=item pf_status(PATH[, OPTIONS])
-use information from the pid file (including its last modification
-time) to guess the status of the corresponding process, return the
-status (true means that the process seems to be running); in list
-context, also return an informative message and an LSB compatible
-exit code; supported options:
+use information from the pid file (including its last modification time) to
+guess the status of the corresponding process, return the status (true means
+that the process seems to be running); in list context, also return an
+informative message and an LSB compatible exit code; supported options:
=over
=item * C<freshness>: maximum age allowed for an active pid file
+=item * C<timeout>: check multiple times until success or timeout
+
=back
=item pf_quit(PATH[, OPTIONS])
-tell the process corresponding to the pid file to quit (setting its
-I<action> to C<quit>), wait a bit to check that it indeed stopped and
-kill it using L<No::Worries::Proc>'s proc_terminate() is everything
-else fails; supported options:
+tell the process corresponding to the pid file to quit (setting its I<action>
+to C<quit>), wait a bit to check that it indeed stopped and kill it using
+L<No::Worries::Proc>'s proc_terminate() is everything else fails; supported
+options:
=over
=item * C<callback>: code that will be called with information to report
-=item * C<linger>: maximum time to wait after having told the process
-to quit (default: 5)
+=item * C<linger>: maximum time to wait after having told the process to quit
+(default: 5)
=item * C<kill>: kill specification to use when killing the process
@@ -483,4 +561,4 @@ L<No::Worries::Proc>.
Lionel Cons L<http://cern.ch/lionel.cons>
-Copyright (C) CERN 2012-2013
+Copyright (C) CERN 2012-2014
@@ -14,14 +14,15 @@ package No::Worries::Proc;
use strict;
use warnings;
use 5.005; # need the four-argument form of substr()
-our $VERSION = "1.0";
-our $REVISION = sprintf("%d.%02d", q$Revision: 1.21 $ =~ /(\d+)\.(\d+)/);
+our $VERSION = "1.2";
+our $REVISION = sprintf("%d.%02d", q$Revision: 1.23 $ =~ /(\d+)\.(\d+)/);
#
# used modules
#
use IO::Select qw();
+use No::Worries qw($_IntegerRegexp $_NumberRegexp);
use No::Worries::Die qw(dief);
use No::Worries::Dir qw(dir_change);
use No::Worries::Export qw(export_control);
@@ -62,20 +63,20 @@ sub _chk_cmd (@) {
# definition of the process structure
#
-my $nbre = "(\\d+\\.)?\\d+"; # number regexp
-my $ksre = "([A-Z]+\\/${nbre}\\s+)*[A-Z]+\\/${nbre}"; # kill spec. regexp
+my $nbre = "(\\d+\\.)?\\d+"; # fractional number pattern
+my $ksre = "([A-Z]+\\/${nbre}\\s+)*[A-Z]+\\/${nbre}"; # kill spec. pattern
my %proc_structure = (
# public
command => { optional => 0, type => ARRAYREF },
- pid => { optional => 0, type => SCALAR, regex => qr/^\d+$/ },
- start => { optional => 0, type => SCALAR, regex => qr/^${nbre}$/ },
- stop => { optional => 1, type => SCALAR, regex => qr/^${nbre}$/ },
+ pid => { optional => 0, type => SCALAR, regex => $_IntegerRegexp },
+ start => { optional => 0, type => SCALAR, regex => $_NumberRegexp },
+ stop => { optional => 1, type => SCALAR, regex => $_NumberRegexp },
status => { optional => 1, type => SCALAR, regex => qr/^-?\d+$/ },
- timeout => { optional => 1, type => SCALAR, regex => qr/^${nbre}$/ },
+ timeout => { optional => 1, type => SCALAR, regex => $_NumberRegexp },
# private
kill => { optional => 1, type => SCALAR, regex => qr/^${ksre}$/ },
- maxtime => { optional => 1, type => SCALAR, regex => qr/^${nbre}$/ },
+ maxtime => { optional => 1, type => SCALAR, regex => $_NumberRegexp },
fhin => { optional => 1, type => GLOBREF },
fhout => { optional => 1, type => GLOBREF },
fherr => { optional => 1, type => GLOBREF },
@@ -299,7 +300,7 @@ sub _redirect_io ($$$$) {
my %proc_create_options = (
command => { optional => 0, type => ARRAYREF },
cwd => { optional => 1, type => SCALAR },
- timeout => { optional => 1, type => SCALAR, regex => qr/^${nbre}$/ },
+ timeout => { optional => 1, type => SCALAR, regex => $_NumberRegexp },
kill => { optional => 1, type => SCALAR, regex => qr/^${ksre}$/ },
stdin => { optional => 1, type => SCALAR | SCALARREF },
stdout => { optional => 1, type => SCALAR | SCALARREF | CODEREF },
@@ -533,9 +534,9 @@ sub _monitor_termination ($$$$) {
#
my %proc_monitor_options = (
- timeout => { optional => 1, type => SCALAR, regex => qr/^${nbre}$/ },
- bufsize => { optional => 1, type => SCALAR, regex => qr/^\d+$/ },
- deaths => { optional => 1, type => SCALAR, regex => qr/^\d+$/ },
+ timeout => { optional => 1, type => SCALAR, regex => $_NumberRegexp },
+ bufsize => { optional => 1, type => SCALAR, regex => $_IntegerRegexp },
+ deaths => { optional => 1, type => SCALAR, regex => $_IntegerRegexp },
);
sub proc_monitor ($@) {
@@ -714,12 +715,12 @@ No::Worries::Proc - process handling without worries
=head1 DESCRIPTION
-This module eases process handling by providing high level functions
-to start, monitor and stop processes. All the functions die() on error.
+This module eases process handling by providing high level functions to start,
+monitor and stop processes. All the functions die() on error.
-It also provides the $No::Worries::Proc::Transient variable that
-indicates, after a fork(), which process is transient and is about to
-exec() or exit(). This is useful for instance in an END block:
+It also provides the $No::Worries::Proc::Transient variable that indicates,
+after a fork(), which process is transient and is about to exec() or exit().
+This is useful for instance in an END block:
END {
# remove our pid file unless we are transient
@@ -728,24 +729,24 @@ exec() or exit(). This is useful for instance in an END block:
=head1 FUNCTIONS
-This module provides the following functions (none of them being
-exported by default):
+This module provides the following functions (none of them being exported by
+default):
=over
=item proc_output(COMMAND...)
-execute the given command, capture its output (stdout only), check its
-exit code (report an error if it is not zero) and return the captured
-output; this is similar to Perl's qx() operator but bypassing the
-shell and always checking the exit code
+execute the given command, capture its output (stdout only), check its exit
+code (report an error if it is not zero) and return the captured output; this
+is similar to Perl's qx() operator but bypassing the shell and always checking
+the exit code
=item proc_create(OPTIONS)
-create a new process that will execute the given command and return a
-hash reference representing this process (see the L</"PROCESS
-STRUCTURE"> sections for more information), to be given to
-proc_monitor() or proc_terminate() afterwards; supported options:
+create a new process that will execute the given command and return a hash
+reference representing this process (see the L</"PROCESS STRUCTURE"> sections
+for more information), to be given to proc_monitor() or proc_terminate()
+afterwards; supported options:
=over
@@ -753,9 +754,9 @@ proc_monitor() or proc_terminate() afterwards; supported options:
=item * C<cwd>: the current working directory of the new process
-=item * C<timeout>: the maximum number of seconds that the process is
-allowed to take to run (can be fractional); after this, it may be
-killed by proc_monitor()
+=item * C<timeout>: the maximum number of seconds that the process is allowed
+to take to run (can be fractional); after this, it may be killed by
+proc_monitor()
=item * C<kill>: how to "gently" kill the process, see below
@@ -769,9 +770,9 @@ killed by proc_monitor()
=item proc_terminate(PROC[, OPTIONS])
-terminate the given process (PROC can be either a process structure or
-simply a process id) by sending signals and waiting for the process to
-finish; supported options:
+terminate the given process (PROC can be either a process structure or simply
+a process id) by sending signals and waiting for the process to finish;
+supported options:
=over
@@ -781,39 +782,37 @@ finish; supported options:
=item proc_monitor(PROCS[, OPTIONS])
-monitor the given process(es) (as created by proc_create()); PROCS can
-be either a single process or a reference to a list of processes;
-supported options:
+monitor the given process(es) (as created by proc_create()); PROCS can be
+either a single process or a reference to a list of processes; supported
+options:
=over
-=item * C<timeout>: the maximum number of seconds that proc_monitor()
-should take, can be fractional
+=item * C<timeout>: the maximum number of seconds that proc_monitor() should
+take, can be fractional
=item * C<bufsize>: the buffer size to use for I/O operations (default: 8192)
-=item * C<deaths>: the minimum number of process deaths that
-proc_monitor() will wait for before returning
+=item * C<deaths>: the minimum number of process deaths that proc_monitor()
+will wait for before returning
=back
=item proc_run(OPTIONS)
-execute the given process (i.e. create and monitor it until
-termination) and return its status (i.e. $?) in scalar context or the
-whole process structure in list context; supported options: the ones
-of proc_create()
+execute the given process (i.e. create and monitor it until termination) and
+return its status (i.e. $?) in scalar context or the whole process structure
+in list context; supported options: the ones of proc_create()
=item proc_detach([OPTIONS])
detach the current process so that it becomes a daemon running in the
-background (this implies forking and re-opening std*); supported
-options:
+background (this implies forking and re-opening std*); supported options:
=over
-=item * C<callback>: code reference that will be executed by the
-parent process just before exiting and will be given the child pid
+=item * C<callback>: code reference that will be executed by the parent
+process just before exiting and will be given the child pid
=back
@@ -821,8 +820,7 @@ parent process just before exiting and will be given the child pid
=head1 PROCESS STRUCTURE
-The process structure (hash) used in this module has the following
-fields:
+The process structure (hash) used in this module has the following fields:
=over
@@ -852,8 +850,8 @@ When using the C<stdin> option of proc_create(), the value can be:
=back
-When using the C<stdout> and C<stderr> options of proc_create(), the
-value can be:
+When using the C<stdout> and C<stderr> options of proc_create(), the value can
+be:
=over
@@ -861,23 +859,22 @@ value can be:
=item * a scalar reference: output will be stored in the scalar
-=item * a code reference: each time new output is available, the code
-will be called with two parameters: the process structure and the new
-output
+=item * a code reference: each time new output is available, the code will be
+called with two parameters: the process structure and the new output
=back
-In addition, C<stderr> can also be given an empty string that means
-that stderr should be merged with stdout.
+In addition, C<stderr> can also be given an empty string that means that
+stderr should be merged with stdout.
=head1 KILL SPECIFICATION
-Both proc_create() and proc_terminate() can be given a C<kill> option
-that specifies how the process should be killed.
+Both proc_create() and proc_terminate() can be given a C<kill> option that
+specifies how the process should be killed.
The specification is a string containing a space separated list of
-I<signal>/I<grace> couples, meaning: send the given signal and wait a
-bit for the process to finish.
+I<signal>/I<grace> couples, meaning: send the given signal and wait a bit for
+the process to finish.
If not specified, the default is C<TERM/1 INT/1 QUIT/1>, meaning:
@@ -895,16 +892,14 @@ If not specified, the default is C<TERM/1 INT/1 QUIT/1>, meaning:
=head1 GLOBAL VARIABLES
-This module uses the following global variables (none of them being
-exported):
+This module uses the following global variables (none of them being exported):
=over
=item $Transient
-true if the process is about to exec() or exit(), there is usually no
-need to perform any cleanup (e.g. in an END block) for this kind of
-process
+true if the process is about to exec() or exit(), there is usually no need to
+perform any cleanup (e.g. in an END block) for this kind of process
=back
@@ -916,4 +911,4 @@ L<No::Worries>.
Lionel Cons L<http://cern.ch/lionel.cons>
-Copyright (C) CERN 2012-2013
+Copyright (C) CERN 2012-2014
@@ -13,7 +13,7 @@
package No::Worries::Stat;
use strict;
use warnings;
-our $VERSION = "1.0";
+our $VERSION = "1.2";
our $REVISION = sprintf("%d.%02d", q$Revision: 1.12 $ =~ /(\d+)\.(\d+)/);
#
@@ -471,4 +471,4 @@ L<No::Worries>.
Lionel Cons L<http://cern.ch/lionel.cons>
-Copyright (C) CERN 2012-2013
+Copyright (C) CERN 2012-2014
@@ -13,8 +13,8 @@
package No::Worries::String;
use strict;
use warnings;
-our $VERSION = "1.0";
-our $REVISION = sprintf("%d.%02d", q$Revision: 1.6 $ =~ /(\d+)\.(\d+)/);
+our $VERSION = "1.2";
+our $REVISION = sprintf("%d.%02d", q$Revision: 1.9 $ =~ /(\d+)\.(\d+)/);
#
# used modules
@@ -28,7 +28,8 @@ use Params::Validate qw(validate validate_pos :types);
#
our(
- @_Map, # mapping of characters to escaped strings
+ @_Map, # mapping of characters to escaped strings
+ %_Plural, # pluralization cache
);
#
@@ -47,10 +48,46 @@ sub string_escape ($) {
}
#
+# return the plural form of the given noun
+#
+
+sub string_plural ($) {
+ my($noun) = @_;
+
+ unless ($_Plural{$noun}) {
+ if ($noun =~ /(ch|s|sh|x|z)$/) {
+ $_Plural{$noun} = $noun . "es";
+ } elsif ($noun =~ /[bcdfghjklmnpqrstvwxz]y$/) {
+ $_Plural{$noun} = substr($noun, 0, -1) . "ies";
+ } elsif ($noun =~ /f$/) {
+ $_Plural{$noun} = substr($noun, 0, -1) . "ves";
+ } elsif ($noun =~ /fe$/) {
+ $_Plural{$noun} = substr($noun, 0, -2) . "ves";
+ } elsif ($noun =~ /[bcdfghjklmnpqrstvwxz]o$/) {
+ $_Plural{$noun} = $noun . "es";
+ } else {
+ $_Plural{$noun} = $noun . "s";
+ }
+ }
+ return($_Plural{$noun});
+}
+
+#
+# quantify the given (count, noun) pair
+#
+
+sub string_quantify ($$) {
+ my($count, $noun) = @_;
+
+ return($count . " " . ($count == 1 ? $noun : string_plural($noun)));
+}
+
+#
# transform a table into a string
#
my %string_table_options = (
+ align => { optional => 1, type => ARRAYREF },
colsep => { optional => 1, type => SCALAR },
header => { optional => 1, type => ARRAYREF },
headsep => { optional => 1, type => SCALAR },
@@ -63,6 +100,7 @@ sub string_table ($@) {
# handle options
$lines = shift(@_);
%option = validate(@_, \%string_table_options) if @_;
+ $option{align} ||= [];
$option{colsep} = " | " unless defined($option{colsep});
$option{headsep} = "=" unless defined($option{headsep});
$option{indent} = "" unless defined($option{indent});
@@ -78,10 +116,17 @@ sub string_table ($@) {
}
# setup formatting
$length = length($option{colsep}) * (@length - 1);
+ $index = 0;
foreach my $colen (@length) {
$length += $colen;
+ if ($option{align}[$index] and $option{align}[$index] eq "right") {
+ $colen = "%" . $colen . "s";
+ } else {
+ $colen = "%-" . $colen . "s";
+ }
+ $index++;
}
- $format = join($option{colsep}, map("%-${_}s", @length)) . "\n";
+ $format = join($option{colsep}, @length) . "\n";
$result = "";
# format header
if ($option{header}) {
@@ -125,6 +170,15 @@ $_Map[ord("\n")] = "\\n";
$_Map[ord("\r")] = "\\r";
$_Map[ord("\e")] = "\\e";
$_Map[ord("\\")] = "\\\\";
+%_Plural = (
+ "child" => "children",
+ "data" => "data",
+ "foot" => "feet",
+ "index" => "indices",
+ "man" => "men",
+ "tooth" => "teeth",
+ "woman" => "women",
+);
#
# export control
@@ -134,7 +188,8 @@ sub import : method {
my($pkg, %exported);
$pkg = shift(@_);
- grep($exported{$_}++, map("string_$_", qw(escape table trim)));
+ grep($exported{$_}++, map("string_$_",
+ qw(escape plural quantify table trim)));
export_control(scalar(caller()), $pkg, \%exported, @_);
}
@@ -148,11 +203,14 @@ No::Worries::String - string handling without worries
=head1 SYNOPSIS
- use No::Worries::String qw(string_escape string_table string_trim);
+ use No::Worries::String qw(*);
# escape a string
printf("found %s\n", string_escape($data));
+ # produce a nice output (e.g "1 file" or "3 files")
+ printf("found %s\n", string_quantify($count, "file"));
+
# format a table
print(string_table([
[1, 1, 1],
@@ -165,29 +223,39 @@ No::Worries::String - string handling without worries
=head1 DESCRIPTION
-This module eases string handling by providing convenient string
-manipulation functions.
+This module eases string handling by providing convenient string manipulation
+functions.
=head1 FUNCTIONS
-This module provides the following functions (none of them being
-exported by default):
+This module provides the following functions (none of them being exported by
+default):
=over
=item string_escape(STRING)
-return a new string with all potentially non-printable characters
-escaped; this includes ASCII control characters, non-7bit ASCII and
-Unicode characters
+return a new string with all potentially non-printable characters escaped;
+this includes ASCII control characters, non-7bit ASCII and Unicode characters
+
+=item string_plural(STRING)
+
+assuming that STRING is an English noun, returns its plural form
+
+=item string_quantify(NUMBER, STRING)
+
+assuming that STRING is an English noun, returns a string saying how much of
+it there is; e.g. C<string_quantify(2, "foot")> is C<"2 feet">
=item string_table(TABLE[, OPTIONS])
-transform the given table (a reference to an array of arrays of strings)
-into a formatted multi-line string; supported options:
+transform the given table (a reference to an array of arrays of strings) into
+a formatted multi-line string; supported options:
=over
+=item * C<align>: array reference of alignment directions (default: left)
+
=item * C<colsep>: column separator string (default: " | ")
=item * C<header>: array reference of column headers (default: none)
@@ -212,4 +280,4 @@ L<No::Worries>.
Lionel Cons L<http://cern.ch/lionel.cons>
-Copyright (C) CERN 2012-2013
+Copyright (C) CERN 2012-2014
@@ -14,7 +14,7 @@ package No::Worries::Syslog;
use strict;
use warnings;
use 5.005; # need the four-argument form of substr()
-our $VERSION = "1.0";
+our $VERSION = "1.2";
our $REVISION = sprintf("%d.%02d", q$Revision: 1.24 $ =~ /(\d+)\.(\d+)/);
#
@@ -319,4 +319,4 @@ L<URI::Escape>.
Lionel Cons L<http://cern.ch/lionel.cons>
-Copyright (C) CERN 2012-2013
+Copyright (C) CERN 2012-2014
@@ -13,7 +13,7 @@
package No::Worries::Warn;
use strict;
use warnings;
-our $VERSION = "1.0";
+our $VERSION = "1.2";
our $REVISION = sprintf("%d.%02d", q$Revision: 1.21 $ =~ /(\d+)\.(\d+)/);
#
@@ -217,4 +217,4 @@ L<No::Worries::Syslog>.
Lionel Cons L<http://cern.ch/lionel.cons>
-Copyright (C) CERN 2012-2013
+Copyright (C) CERN 2012-2014
@@ -13,8 +13,8 @@
package No::Worries;
use strict;
use warnings;
-our $VERSION = "1.0";
-our $REVISION = sprintf("%d.%02d", q$Revision: 1.27 $ =~ /(\d+)\.(\d+)/);
+our $VERSION = "1.2";
+our $REVISION = sprintf("%d.%02d", q$Revision: 1.29 $ =~ /(\d+)\.(\d+)/);
#
# used modules
@@ -27,7 +27,7 @@ use No::Worries::Export qw(export_control);
# global variables
#
-our($HostName, $ProgramName);
+our($HostName, $ProgramName, $_IntegerRegexp, $_NumberRegexp);
#
# module initialization
@@ -42,6 +42,10 @@ $HostName =~ s/\..+$//;
$ProgramName = $0 || "<unknown-program-name>";
$ProgramName =~ s/^.*\///;
+# private global variables
+$_IntegerRegexp = qr/^\d+$/;
+$_NumberRegexp = qr/^(\d+\.)?\d+$/;
+
#
# export control
#
@@ -51,6 +55,7 @@ sub import : method {
$pkg = shift(@_);
grep($exported{$_}++, qw($HostName $ProgramName));
+ grep($exported{$_}++, qw($_IntegerRegexp $_NumberRegexp));
export_control(scalar(caller()), $pkg, \%exported, @_);
}
@@ -71,38 +76,38 @@ No::Worries - coding without worries
=head1 DESCRIPTION
-This module and its sub-modules ease coding by providing consistent
-convenient functions to perform frequently used programming tasks.
+This module and its sub-modules ease coding by providing consistent convenient
+functions to perform frequently used programming tasks.
This module also exposes the $HostName and $ProgramName variables that
-represent what the sub-modules think the host name or program name is.
-These variables can be changed, if needed.
+represent what the sub-modules think the host name or program name is. These
+variables can be changed, if needed.
=head1 PROGRAMMING STYLE
=head2 ERROR HANDLING
-All the functions die() on error so one does not have to worry about
-error checking: by default, any error will stop the code execution.
-The recommended way to catch errors is to use eval().
+All the functions die() on error so one does not have to worry about error
+checking: by default, any error will stop the code execution. The recommended
+way to catch errors is to use eval().
-For consistency, all the sub-modules use No::Worries::Die's dief() to
-report errors and No::Worries::Warn's warnf() to report warnings. The
-NO_WORRIES environment variable can be used to control how errors and
-warnings are reported (see L<No::Worries::Die> and L<No::Worries::Warn>).
+For consistency, all the sub-modules use No::Worries::Die's dief() to report
+errors and No::Worries::Warn's warnf() to report warnings. The NO_WORRIES
+environment variable can be used to control how errors and warnings are
+reported (see L<No::Worries::Die> and L<No::Worries::Warn>).
=head2 OPTION PASSING
-All the functions use the same consistent API with hashes to pass
-options like in:
+All the functions use the same consistent API with hashes to pass options like
+in:
dir_make("/tmp/some/path", mode => 0770);
-This is a bit overkill when only one option is supported but it allows
-adding options later without breaking old code.
+This is a bit overkill when only one option is supported but it allows adding
+options later without breaking old code.
-The options can also be passed via a hash reference (this can be
-useful to avoid data copying):
+The options can also be passed via a hash reference (this can be useful to
+avoid data copying):
dir_make("/tmp/some/path", { mode => 0770 });
@@ -110,14 +115,14 @@ All the options are checked using L<Params::Validate>.
=head2 SYMBOL IMPORTING
-All the modules are "clean" in the sense that they do not import any
-symbol into the caller's namespace. All the needed symbols (usually
-functions) have to be explicitly imported like in:
+All the modules are "clean" in the sense that they do not import any symbol
+into the caller's namespace. All the needed symbols (usually functions) have
+to be explicitly imported like in:
use No::Worries::Die qw(dief);
-In addition, all "normal" symbols can be imported at once using the
-asterisk character:
+In addition, all "normal" symbols can be imported at once using the asterisk
+character:
use No::Worries::Log qw(*);
@@ -279,6 +284,10 @@ Here are the relevant sub-modules and what they provide:
=item * string_escape(STRING)
+=item * string_plural(STRING)
+
+=item * string_quantify(NUMBER, STRING)
+
=item * string_table(TABLE[, OPTIONS])
=item * string_trim(STRING)
@@ -356,4 +365,4 @@ L<Params::Validate>.
Lionel Cons L<http://cern.ch/lionel.cons>
-Copyright (C) CERN 2012-2013
+Copyright (C) CERN 2012-2014
@@ -2,9 +2,9 @@
use strict;
use warnings;
-use Test::More tests => 12;
+use Test::More tests => 15;
-use No::Worries::String qw(string_escape string_trim);
+use No::Worries::String qw(string_escape string_plural string_trim);
is(string_escape(""), "", "string_escape()");
is(string_escape("x"), "x", "string_escape(x)");
@@ -13,6 +13,10 @@ is(string_escape("a\eb\nc\rd\te"), "a\\eb\\nc\\rd\\te", "string_escape(a\\eb\\nc
is(string_escape("<\x{263a}>"), "<\\x{263a}>", "string_escape(smiley)");
is(string_escape("<\x{26}\x{3a}>"), "<&:>", "string_escape(&:)");
+is(string_plural("foot"), "feet", "string_plural(foot)");
+is(string_plural("directory"), "directories", "string_plural(directory)");
+is(string_plural("file"), "files", "string_plural(file)");
+
is(string_trim(""), "", "string_trim()");
is(string_trim("x"), "x", "string_trim(x)");
is(string_trim(" x "), "x", "string_trim( x )");