File Coverage

blib/lib/SPOPS/Utility.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

package SPOPS::Utility;

# $Id: Utility.pm,v 3.5 2004/06/02 00:48:22 lachoy Exp $

use strict;
use Log::Log4perl qw( get_logger );
use SPOPS;

my $log = get_logger();

$SPOPS::Utility::VERSION  = sprintf("%d.%02d", q$Revision: 3.5 $ =~ /(\d+)\.(\d+)/);


# initialize limit tracking vars -- the limit passed in can be:
# limit => 'x,y'  --> 'offset = x, max = y'
# limit => 'x'    --> 'max = x'

sub determine_limit {
    my ( $class, $limit ) = @_;
    return ( 0, 0 ) unless ( $limit );
    if ( $limit =~ /,/ ) {
        my ( $offset, $max ) = split /\s*,\s*/, $limit;
        $max += $offset;
        $log->is_info &&
            $log->info( "Limit set: Start $offset to $max" );
        return ( $offset, $max );
    }
    else {
        $log->is_info &&
            $log->info( "Limit set: Start 0 to $limit" );
        return ( 0, $limit );
    }
}


# Return a random code of length $length. If $opt is 'mixed', then the
# code is filled with both lower- and upper-case charaters.
#
# Signature: $code = $class->generate_random_code( $length, [ 'mixed' ] );

sub generate_random_code {
    my ( $class, $length, $opt ) = @_;
    $opt ||= '';
    return undef unless ( $length );
    if ( $opt eq 'mixed' ) {
        return join '', map { ( $_ % 2 == 0 )
                              ? chr( int( rand(26) ) + 65 )
                              : chr( int( rand(26) ) + 97 ) } ( 1 .. $length );
    }
    return join '', map { chr( int( rand(26) ) + 65 ) } ( 1 .. $length );
}


# Return a 'crypt'ed version of $text
#
# Signature: $crypted = $class->crypt_it( $text );

sub crypt_it {
    my ( $class, $text ) = @_;
    return undef unless ( $text );
    my $salt = $class->generate_random_code( 2 );
    return crypt( $text, $salt );
}


########################################
# DATE/TIME
########################################

# Return a { time } (or the current time) formatted with { format }
#
# Signature: $time_string = $class->now( [ { format => $strftime_format,
#                                            time   => $time_in_seconds } ] );

sub now {
    my ( $class, $p ) = @_;
    require Class::Date;
    $p->{format} ||= '%Y-%m-%d %T';
    $p->{time}   ||= time;
    return Class::Date->new( $p->{time} )->strftime( $p->{format} );
}


# Return the current time formatted 'yyyy-mm-dd'
#
# Signature: $date_string = $class->today();

sub today { return $_[0]->now( { format => '%Y-%m-%d' } ); }


# Return a true value if right now is between two other dates

# Signature:
#   DATE_FORMAT is [ yyyy,mm,dd ] or 'yyyy-mm-dd'
#   $rv = $class->date_between_dates( { begin => DATE_FORMAT,
#                                       end   => DATE_FORMAT } );

sub now_between_dates {
    my ( $class, $p ) = @_;
    return undef unless ( $p->{begin} or $p->{end} );

    require Class::Date;
    my $now = Class::Date->now;
    my ( $begin_date, $end_date );

    if ( $p->{begin} ) {
        if ( ref $p->{begin} eq 'ARRAY' ) {
            $begin_date = Class::Date->new( $p->{begin} );
        }
        else {
            $begin_date = Class::Date->new([ split /\D+/, $p->{begin} ]);
        }
        return undef if ( $now < $begin_date );
    }

    if ( $p->{end} ) {
        if ( ref $p->{end} eq 'ARRAY' ) {
            $end_date = Class::Date->new( $p->{end} );
        }
        else {
            $end_date = Class::Date->new([ split /\D+/, $p->{end} ]);
        }
        return undef if ( $now > $end_date );
    }
    return 1;
}


# Pass in \@existing and \@new and get back a hashref with:
#   add    => \@: items in \@new but not in \@existing,
#   keep   => \@: items in \@new and in \@existing,
#   remove => \@: items not in \@new but in \@existing

sub list_process {
    my ( $class, $exist, $new ) = @_;

    # Create a hash of the existing items

    my %existing = map { $_ => 1 } @{ $exist };
    my ( @k, @a );

    # Go through the new items...

    foreach my $new_id ( @{ $new } ) {

        #... if it's existing, track it as a keeper and remove it
        # from the existing pile

        if ( $existing{ $new_id } ) {
            delete $existing{ $new_id };
            push @k, $new_id;
        }

        # otherwise, track it as an add

        else {
            push @a, $new_id;
        }
    }

    # now, the only items left in %existing are the ones
    # that were not specified in the new list; therefore,
    # these should be removed

    return { add => \@a, keep => \@k, remove => [ keys %existing ] };
}

1;

__END__