File Coverage

blib/lib/Mock/Populate.pm

Criterion	Covered	Total	%
statement	20	22	90.9
branch			n/a
condition			n/a
subroutine	8	8	100.0
pod			n/a
total	28	30	93.3

package Mock::Populate;
BEGIN {
  $Mock::Populate::AUTHORITY = 'cpan:GENE';
}

# ABSTRACT: Mock data creation

our $VERSION = '0.0901';

use strict;
use warnings;

use constant NDATA => 10;
use constant PREC  => 2;
use constant DOF   => 2;
use constant SIZE  => 8;

use Data::SimplePassword;
use Date::Range;
use Date::Simple qw(date today);
use Image::Dot;
use List::Util qw(shuffle);
use Mock::Person;
use Statistics::Distributions;
use Text::Password::Pronounceable;
use Text::Unidecode;
use Time::Local;


sub date_ranger {
    my %args = @_;
    # Set defaults.
    $args{start} ||= '2001-01-01';
    $args{end}   ||= today();
    $args{N}     ||= NDATA;

    # Convert the dates into a range.
    my $date1 = date($args{start});
    my $date2 = date($args{end});
    my $range = Date::Range->new($date1, $date2);

    # Declare the number of days in the range.
    my $offset = 0;

    # Bucket for our result list.
    my @results;

    for(1 .. $args{N}) {
        # Get a random number of days in the range.
        $offset = int(rand $range->length);

        # Save the stringified start date plus the offest.
        my $date = $date1 + $offset;
        push @results, "$date";
    }

    return \@results;
}


sub date_modifier {
    # Get the number of days in the future and the date list.
    my ($offset, @dates) = @_;

    # Bucket for our result list.
    my @results;

    for my $date (@dates) {
        # Cast the current date string as an object.
        my $current = date($date);

        # Get a random number of days in the future.
        my $m = int(rand $offset) + 1;

        # Save the stringified date plus the offest.
        $date = $current + $m;
        push @results, "$date";
    }

    return \@results;
}


sub time_ranger {
    my %args = @_;
    # Set defaults.
    $args{stamp} ||= 1;
    $args{start} ||= '00:00:00';
    $args{end}   ||= '';
    $args{N}     ||= NDATA;

    # Split the :-separated times.
    my @start = split ':', $args{start};
    my @end   = $args{end} ? split(':', $args{end}) : _now();
    #warn "S->E: @start -> @end\n";

    # Compute the number of seconds between start and end.
    my $start_time = timegm(@start[2, 1, 0], (localtime(time))[3, 4, 5]);
    my $end_time   = timegm(@end[2, 1, 0], (localtime(time))[3, 4, 5]);
    my $range = $end_time - $start_time;
    #warn "R: $end_time (@end) - $start_time (@start) = $range\n";

    # Declare the number of seconds.
    my $offset = 0;

    # Bucket for our result list.
    my @results;

    # Generate a time, N times.
    for(1 .. $args{N}) {
        # Get a random number of seconds in the range.
        $offset = int(rand $range);

        # Print the start time plus the offest seconds.
        if ($args{stamp}) {
            # In HH:MM::SS format.
            my $time = scalar localtime($start_time + $offset);
            push @results, (split / /, $time)[3];
        }
        else {
            # As a number of seconds from the "epoc."
            push @results, $start_time + $offset;
        }
    }

    return \@results;
}

sub _now { # Return hour, minute, second.
    return (localtime(time))[2, 1, 0];
}


sub number_ranger {
    my %args = @_;
    # Set defaults.
    $args{start}  ||= 0;
    $args{end}    ||= NDATA;
    $args{prec}   ||= PREC;
    $args{random} ||= 1;
    $args{N}      ||= NDATA;

    # Bucket for our result list.
    my @results;

    # Do we want random numbers?
    if ($args{random}) {
        # Roll!
        for(1 .. $args{N}) {
            # Get our random candidate.
            my $x = rand($args{end});
            # Make sure it is above the start value.
            while ($x < $args{start}) {
                $x = rand($args{end});
            }
            push @results, $x;
        }
    }
    else {
        # Use a simple sequence of integers.
        @results = ($args{start} .. $args{end});
    }

    return \@results;
}


sub name_ranger {
    my %args = @_;
    # Set defaults.
    $args{gender}  ||= 0;
    $args{names}   ||= 2;
    $args{country} ||= 'us';
    $args{N}       ||= NDATA;

    # Bucket for our result list.
    my @results;

    # Roll!
    for my $i (1 .. $args{N}) {
        # Get our random person.
        my $p = '';
        # If gender is 'both' alternate male-female.
        # Or if gender is not 'male' then ...female!
        if (($args{gender} eq 'b' && $i % 2) || $args{gender} eq 'f') {
            $p = Mock::Person::name(sex => 'female', country => $args{country});
        }
        else {
            $p = Mock::Person::name(sex => 'male', country => $args{country});
        }
        # Only use the requested number of names.
        my @names = split / /, $p;
        my $name = '';
        if ($args{names} == 1) {
            push @results, $names[-1];
        }
        elsif ($args{names} == 2) {
            push @results, "@names[0,-1]";
        }
        else {
            push @results, $p;
        }
    }

    return \@results;
}


sub email_modifier {
    my @people = @_;

    # Bucket for our results.
    my @results = ();

    # Generate email addresses if requested.
    my @tld = qw( com net org edu );

    for my $p (@people) {
        # Break up the name.
        my @name = split / /, $p;

        # Turn any unicode characters into something ascii.
        $_ = unidecode($_) for @name;

        # Add an email address for the person.
        my $email = lc($name[0]);
        $email .= '.'. lc($name[-1]) if @name > 1;
        $email .= '@example.' . $tld[rand @tld];
        push @results, $email;
    }

    return \@results;
}


sub distributor {
    my %args = @_;
    # Set defaults.
    $args{type} ||= 'u';
    $args{prec} ||= PREC;
    $args{dof}  ||= DOF;
    $args{N}    ||= NDATA;

    # Separate numerator/denominator for F degs-of-freedm.
    my $e = 1;
    ($args{dof}, $e) = split(/\//, $args{dof}) if $args{type} eq 'f';

    # Bucket for our result list.
    my @results;

    # Roll!
    for(1 .. $args{N}) {
        # Select distribution.
        if ($args{type} eq 'c') {
            # Chi-squared
            push @results, Statistics::Distributions::chisqrdistr($args{dof}, rand);
        }
        elsif ($args{type} eq 's') {
            # Student's T
            push @results, Statistics::Distributions::tdistr($args{dof}, rand);
        }
        elsif ($args{type} eq 'f') {
            # F distribution
            push @results, Statistics::Distributions::fdistr($args{dof}, $e, rand);
        }
        else {
            # Normal
            push @results, Statistics::Distributions::udistr(rand);
        }
    }

    return \@results;
}


sub shuffler {
    # Get the desired number of data-points.
    my $n = defined $_[0] ? shift : 9;
    # Get the items to shuffle.
    my @items = @_ ? @_ : ('a' .. 'j');
    return [ shuffle(@items) ];
}


sub string_ranger {
    my %args = @_;
    # Set defaults.
    $args{length} ||= SIZE;
    $args{type}   ||= 'default';
    $args{N}      ||= NDATA;

    # Declare a pw instance.
    my $sp = Data::SimplePassword->new;

    # Declare the types (lifted directly from rndpassword).
    my $chars = {
        default => [ 0..9, 'a'..'z', 'A'..'Z' ],
        ascii   => [ map { sprintf "%c", $_ } 33 .. 126 ],
        base64  => [ 0..9, 'a'..'z', 'A'..'Z', qw(+ /) ],
        path    => [ 0..9, 'a'..'z', 'A'..'Z', qw(. /) ],
        simple  => [ 0..9, 'a'..'z' ],
        alpha   => [ 'a'..'z' ],
        digit   => [ 0..9 ],
        binary  => [ qw(0 1) ],
        morse   => [ qw(. -) ],
        hex     => [ 0..9, 'a'..'f' ],
        pron    => [],
    };
    # Set the chars based on the given type.
    $sp->chars( @{ $chars->{$args{type}} } );

    # Declare a bucket for our results.
    my @results = ();

    # Roll!
    for(1 .. $args{N}) {
        if ($args{type} eq 'pron') {
            push @results, Text::Password::Pronounceable->generate(
                $args{length}, $args{length});
        }
        else {
            push @results, $sp->make_password($args{length});
        }
    }

    return \@results;
}


sub image_ranger {
    my %args = @_;
    # Set defaults.
    $args{size} ||= SIZE;
    $args{N}    ||= NDATA;

    # Declare a bucket for our results.
    my @results = ();

    # Start with a 1x1 pixel image.
    my $img = dot_PNG_RGB(0, 0, 0);

    # XXX This is naive and sad:
    # Pull-apart the image data.
    (my $head = $img) =~ s/^(.*?IDAT).*$/$1/ms;
    (my $tail = $img) =~ s/^.*?(IEND.*)$/$1/ms;
    $img =~ s/^.*?IDAT(.*?)IEND.*$/$1/ms;

    for (1 .. $args{N}) {
        # Increase the byte size (not dimension).
        my $i = $head . ($img x int(rand $args{size})) . $tail;
        #warn "L: ",length($i), "\n";

        # Save the result.
        push @results, $i;
    }

    return \@results;
}


sub collate {
    # Accept any number of columns.
    my @columns = @_;

    # Make a copy of the columns to peel off.
    my @lists = @columns;

    # Declare the bucket for our arrayrefs.
    my @results = ();

    # Add each list item to rows of collated.
    for my $list (@columns) {
        for my $i (0 .. @$list - 1) {
            push @{ $results[$i] }, $list->[$i];
        }
    }

    return \@results;
}

1;

__END__