view release on metacpan or  search on metacpan

lib/Acme/Shotgun.pm  view on Meta::CPAN

package Acme::Shotgun;

# ABSTRACT: Shoots holes in files

use strict;
use warnings;

our $VERSION = '0.03';

sub new {
    my ($class, %args) = @_;

    my $self = {
        type       => 'double',
        load       => 'bird',
        shots      => undef,
        quiet      => 0,
        debug      => 0,
        verbose    => 1,
        num_rounds => 0,
        %args,
    };

    die "Invalid shotgun type '$self->{type}'! Must be 'double' or 'pump'.\n"
        unless $self->{type} =~ /^(?:double|pump)$/;

    die "Invalid ammo type '$self->{load}'! Must be 'bird', 'buck', or 'slug'.\n"
        unless $self->{load} =~ /^(?:bird|buck|slug)$/;

    $self->{verbose}++ if $self->{debug};
    $self->{verbose} = 0 if $self->{quiet};

    bless $self, $class;
    $self->reload();

    return $self;
}

sub reload {
    my $self = shift;

    my $num_rounds = $self->{type} eq 'pump' ? 5 : 2;
    $num_rounds = $self->{shots}
        if $self->{shots} && $self->{shots} < $num_rounds;

    $self->{num_rounds} = $num_rounds;

    print "Loading $num_rounds round(s)...\n" if $self->{verbose};
    print "Shotgun reloaded!\n";
    $self->check() if $self->{verbose};

    return $self;
}

sub check {
    my $self = shift;
    printf "type: %s  load: %s  rounds: %d\n",
        $self->{type}, $self->{load}, $self->{num_rounds};
    return $self;
}

sub fire {
    my ($self, %args) = @_;

    my $target = $args{target}
        or die "No target specified!\n";

    die "Target file does not exist: $target\n"       unless -e $target;
    die "Target file must be a plain file: $target\n"  unless -f $target;
    die "Target file must be under 1 GB: $target\n"
        if -s $target > (1024 * 1024);

    if ($self->{num_rounds} == 0) {
        print "Mag empty, you'll need to reload!\n";
        return $self;
    }

    while ($self->{num_rounds} > 0) {
        $self->_shoot($target);
        $self->{num_rounds}--;
    }

    return $self;
}

## Private methods

sub _shoot {
    my ($self, $target) = @_;

    if ($self->{debug}) {
        print "POW! (debug - no file modified)\n";
        return;