view release on metacpan or  search on metacpan

Wabby.pm  view on Meta::CPAN

    else {
        %conf = @_;
    }

    # Set up the initial state of our data structures
    my %hash = ();
    my @list = ({ word => "(null)", num => []});
    my %data = ('hash' => \%hash, 'list' => \@list);

    # Go through each of the configuration options, and if they were not
    # explicitly set, assign to them the defaults.
    if (!exists($conf{'case_sensitive'})) {
        $conf{'case_sensitive'} = DEF_CASE;
    }
    if (!exists($conf{'min_len'})) {
        $conf{'min_len'} = DEF_MIN_LEN;
    }
    if (!exists($conf{'max_len'})) {
        $conf{'max_len'} = DEF_MAX_LEN;
    }
    if (!exists($conf{'max_attempts'})) {
        $conf{'max_attempts'} = DEF_MAX_ATTEMPTS;
    }
    if (!exists($conf{'punctuation'})) {
        $conf{'punctuation'} = DEF_PUNCTUATION;
    }
    if (!exists($conf{'hash_file'})) {
        $conf{'hash_file'} = DEF_HASH_FILE;
    }
    if (!exists($conf{'list_file'})) {
        $conf{'list_file'} = DEF_LIST_FILE;
    }
    if (!exists($conf{'autosave_on_destroy'})) {
        $conf{'autosave_on_destroy'} = DEF_AUTOSAVE;
    }

    # Do some simple sanity checks on the values that they sent us
    if ($conf{'min_len'} > $conf{'max_len'}) {
        die "min_len ($conf{'min_len'}) cannot be larger than"
            ."max_len ($conf{'max_len'})";
    }
    if ($conf{'min_len'} < 1) {
        die "Cannot be negative: min_len";
    }
    if ($conf{'max_len'} < 1) {
        die "Cannot be negative: max_len";
    }
    if ($conf{'max_attempts'} < 1) {
        die "Cannot be negative: max_attempts";
    }
    if (ref($conf{'punctuation'}) ne 'ARRAY') {
        die "Not an array reference: punctuation";
    }
    if (scalar(@{$conf{'punctuation'}}) < 1) {
        die "Array must contain at least one element: punctuation";
    }
    if ($conf{'list_file'} eq $conf{'hash_file'}) {
        die "list_file and hash_file cannot point to the same file";
    }

    # Return our blessed object
    return bless({ conf=>\%conf, data=>\%data}, __PACKAGE__);
}

# A destructor for the object, so that we get a chance to autosave the state
# if the caller so desired.
# Arguments: None.
# Returns:   Nothing.
sub DESTROY {
    my $self = shift;
    die "Invalid object" unless (ref($self) eq __PACKAGE__);

    if ($self->{'conf'}{'autosave_on_destroy'}) {
        $self->save;
    }
}

# A method for dumping the current state to files using Storable.
# Arguments: None.
# Returns:   undef on failure, true on success.
sub save {
    my $self = shift;
    die "Invalid object" unless (ref($self) eq __PACKAGE__);

    # Since Storable can die on serious errors, or simply return an undef,
    # we need to wrap these calls in evals
    eval {
        if (!store($self->{'data'}{'list'}, $self->{'conf'}{'list_file'})) {
            $@ = 1;
        }
    };
    if ($@) {
        return undef;
    }

    eval {
        if (!store($self->{'data'}{'hash'}, $self->{'conf'}{'hash_file'})) {
            $@ = 1;
        }
    };
    if ($@) {
        return undef;
    }

    return 1;
}

# A method for loading a previously saved state from files using Storable.
# Arguments: None.
# Returns:   undef on failure, true on success
sub load {
    my $self = shift;
    die "Invalid object" unless (ref($self) eq __PACKAGE__);

    # Since Storable can die on serious errors, or simply return an undef,
    # we need to wrap these calls in evals
    my $ref;
    eval {
        if (!($ref = retrieve($self->{'conf'}{'list_file'}))) {
            $@ = "Error retrieving list from " . $self->{'conf'}{'list_file'};
        }
    };