view release on metacpan or  search on metacpan

lib/Badger/Utils.pm  view on Meta::CPAN

#========================================================================
#
# Badger::Utils
#
# DESCRIPTION
#   Module implementing various useful utility functions.
#
# AUTHOR
#   Andy Wardley   <abw@wardley.org>
#
#========================================================================

package Badger::Utils;

use strict;
use warnings;
use base 'Badger::Exporter';
use File::Path;
use Scalar::Util qw( blessed );
use Badger::Constants 'HASH ARRAY PKG DELIMITER BLANK TRUE FALSE';
use Badger::Debug
    import  => ':dump',
    default => 0;
use overload;
use constant {
    UTILS  => 'Badger::Utils',
    CLASS  => 0,
    FILE   => 1,
    LOADED => 2,
};

our $VERSION  = 0.02;
our $ERROR    = '';
our $WARN     = sub { warn @_ };  # for testing - see t/core/utils.t
our $MESSAGES = { };
our $HELPERS  = {       # keep this compact in case we don't need to use it
    'Digest::MD5'        => 'md5 md5_hex md5_base64',
    'Scalar::Util'       => 'blessed dualvar isweak readonly refaddr reftype
                             tainted weaken isvstring looks_like_number
                             set_prototype',
    'List::Util'         => 'first max maxstr min minstr reduce shuffle sum',
    'List::MoreUtils'    => 'any all none notall true false firstidx
                             first_index lastidx last_index insert_after
                             insert_after_string apply after after_incl before
                             before_incl indexes firstval first_value lastval
                             last_value each_array each_arrayref pairwise
                             natatime mesh zip uniq minmax',
    'Hash::Util'         => 'lock_keys unlock_keys lock_value unlock_value
                             lock_hash unlock_hash hash_seed',
    'Badger::Date'       => 'DATE Date Today',
    'Badger::Timestamp'  => 'TIMESTAMP TS Timestamp Now',
    'Badger::Logic'      => 'LOGIC Logic',
    'Badger::Duration'   => 'DURATION Duration',
    'Badger::URL'        => 'URL',
    'Badger::Filter'     => 'FILTER Filter',
    'Badger::Filesystem' => 'FS File Dir Bin Cwd',
    'Badger::Filesystem::Virtual'
                         => 'VFS',
};
our $DELEGATES;         # fill this from $HELPERS on demand
our $RANDOM_NAME_LENGTH = 32;
our $TEXT_WRAP_WIDTH    = 78;


__PACKAGE__->export_any(qw(
    UTILS blessed is_object numlike textlike truelike falselike
    params self_params plural
    odd_params xprintf dotid random_name camel_case CamelCase wrap
    permute_fragments plurality inflect split_to_list extend merge merge_hash
    list_each hash_each join_uri resolve_uri
));

__PACKAGE__->export_fail(\&_export_fail);

# looks_like_number() is such a mouthful.  I prefer numlike() to go with textlike()
*numlike = \&Scalar::Util::looks_like_number;

# it would be too confusing not to have this alias
*CamelCase = \&camel_case;


sub _export_fail {
    my ($class, $target, $symbol, $more_symbols) = @_;
    $DELEGATES ||= _expand_helpers($HELPERS);
    my $helper = $DELEGATES->{ $symbol } || return 0;
    require $helper->[FILE] unless $helper->[LOADED];
    $class->export_symbol($target, $symbol, \&{ $helper->[CLASS].PKG.$symbol });
    return 1;
}

sub _expand_helpers {
    # invert { x => 'a b c' } into { a => 'x', b => 'x', c => 'x' }
    my $helpers = shift;
    return {
        map {
            my $name = $_;                      # e.g. Scalar::Util
            my $file = module_file($name);      # e.g. Scalar/Util.pm
            map { $_ => [$name, $file, 0] }     # third item is loaded flag
            split(DELIMITER, $helpers->{ $name })
        }
        keys %$helpers
    }
}

sub is_object($$) {
    blessed $_[1] && $_[1]->isa($_[0]);
}

sub textlike($) {
    !  ref $_[0]                        # check if $[0] is a non-reference
    || blessed $_[0]                    # or an object with an overloaded
    && overload::Method($_[0], '""');   # '""' stringification operator
}

sub truelike($) {
    falselike($_[0]) ? FALSE : TRUE;
}

sub falselike($) {
    (! $_[0] || $_[0] =~ /^(0|off|no|none|false)$/i) ? TRUE : FALSE;
}

sub params {
    # enable $DEBUG to track down calls to params() that pass an odd number
    # of arguments, typically when the rhs argument returns an empty list,
    # e.g. $obj->foo( x => this_returns_empty_list() )
    my @args = @_;
    local $SIG{__WARN__} = sub {
        odd_params(@args);
    } if DEBUG;

    @_ && ref $_[0] eq HASH ? shift : { @_ };
}

sub self_params {
    my @args = @_;

lib/Badger/Utils.pm  view on Meta::CPAN

    alternates('foo|bar');          # returns ['foo','bar']
    alternates('foo');              # returns ['','bar']

If the C<$text> doesn't contain the C<|> character then it is assumed to be
an optional item.  A list reference is returned containing the empty string
as the first element and the original C<$text> string as the second.

=head3 camel_case($string) / CamelCase($string)

Converts a lower case string where words are separated by underscores (e.g.
C<like_this_example>) into CamelCase where each word is capitalised and words
are joined together (e.g. C<LikeThisExample>).

According to Perl convention (and personal preference), we use the lower case
form wherever possible. However, Perl's convention also dictates that module
names should be in CamelCase.  This function performs that conversion.

=head3 dotid($text)

The function returns a lower case representation of the text passed as
an argument with all non-word character sequences replaced with dots.

    print dotid('Foo::Bar');            # foo.bar

=head3 inflect($n, $noun, $format, $none_word)

This uses the C<plurality()> function to construct an
appropriate string listing the number C<$n> of C<$noun> items.

    inflect(0, 'package');      # no packages
    inflect(1, 'package');      # 1 package
    inflect(2, 'package');      # 2 packages

Or:

    inflect($n, 'wo(men|man|men');

The third optional argument can be used to specify a format string for
L<xprintf> to generate the string.  The default value is C<%s %s>, expecting
the number (or word 'no') as the first parameter, followed by the relevant
noun as the second.

    inflect($n, 'item', 'There are <b>%s</b> %s in your basket');

The fourth optional argument can be used to provide a word other than 'no'
to be used when C<$n> is zero.

    inflect(
        $n, 'item',
        'You have %s %s in your basket',
        'none, none more'
    );

Please note that this function is intentionally limited.  It's sufficient to
generate simple headings, summary lines, etc., but isn't intended to be
comprehensive or work in languages other than English.

=head3 numlike($item)

This is an alias to the C<looks_like_number()> function defined in
L<Scalar::Util>.

=head3 permute_fragments($text)

This function permutes any optional or alternate fragments embedded in
parentheses. For example, C<Badger(X)> is permuted as (C<Badger>, C<BadgerX>)
and C<Badger(X|Y)> is permuted as (C<BadgerX>, C<BadgerY>).

    permute_fragments('Badger(X)');     # Badger, BadgerX
    permute_fragments('Badger(X|Y)');   # BadgerX, BadgerY

Multiple fragments may be embedded. They are expanded in order from left to
right, with the rightmost fragments changing most often.

    permute_fragments('A(1|2):B(3|4)')  # A1:B3, A1:B4, A2:B3, A2:B4

=head3 plural($noun)

The function makes a very naive attempt at pluralising the singular noun word
passed as an argument.

If the C<$noun> word ends in C<ss>, C<sh>, C<ch> or C<x> then C<es> will be
added to the end of it.

    print plural('class');      # classes
    print plural('hash');       # hashes
    print plural('patch');      # patches
    print plural('box');        # boxes

If it ends in C<y> then it will be replaced with C<ies>.

    print plural('party');      # parties

In all other cases, C<s> will be added to the end of the word.

    print plural('device');     # devices

It will fail miserably on many common words.

    print plural('woman');      # womans     FAIL!
    print plural('child');      # childs     FAIL!
    print plural('foot');       # foots      FAIL!

This function should I<only> be used in cases where the singular noun is known
in advance and has a regular form that can be pluralised correctly by the
algorithm described above. For example, the L<Badger::Factory> module allows
you to specify C<$ITEM> and C<$ITEMS> package variable to provide the singular
and plural names of the items that the factory manages.

    our $ITEM  = 'person';
    our $ITEMS = 'people';

If the singular noun is sufficiently regular then the C<$ITEMS> can be
omitted and the C<plural> function will be used.

    our $ITEM  = 'codec';       # $ITEMS defaults to 'codecs'

In this case we know that C<codec> will pluralise correctly to C<codecs> and
can safely leave C<$ITEMS> undefined.