view release on metacpan or  search on metacpan

lib/Bio/Grep/Root.pm  view on Meta::CPAN

            -value => scalar @{$a_ref} . " vs. $size"
        );
    }
    return 1;
}

###############################################################################
# Usage      : $self->_check_variable(%args)
# Purpose    : make perl -T happy: get only "secure" symbols for system()
# Returns    : the specified variable if it is ok
# Parameters : ( variable => $v, regex => 'int', desc => $desc )
# Throws     : Bio::Root::BadParameter if variable is not ok
# Comments   : if variable is undef, then return value is undef
# See also   : http://gunther.web66.com/FAQS/taintmode.html

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

    if ( !%args || !defined $args{regex} ) {
        $self->throw(
            -class => 'Bio::Root::BadParameter',
            -text  => 'Missing arguments: require hash with keys "regex"'
                . '"variable" and optional "desc"',
        );
    }
    return if !defined $args{variable};

    if ( !defined $args{desc} ) {
        $args{desc} = 'Variable';
    }
    my $value;

    my %regexes = (
        'int'      => qr{ ( \A \d+ \z ) }xms,
        'word'     => qr{ ( \A [\w.\-]+ \z ) }xms,
        'path'     => qr{ ( \A [\w.\-/\\: ]+ \z ) }xms,
        'sentence' => qr{  \A ([\w.\-/|:(),;]+)  }xms,
    );

    if ( defined $regexes{ $args{regex} } ) {
        ($value) = $args{variable} =~ $regexes{ $args{regex} };
    }
    else {
        $self->throw(
            -class => 'Bio::Root::BadParameter',
            -text  => 'Unknown regex.',
            -value => $args{regex}
        );
    }

    if ( !defined $value ) {
        $self->throw(
            -class => 'Bio::Root::BadParameter',
            -text  => $args{desc} . ' looks not valid.',
            -value => $args{variable}
        );
    }
    return $value;
}

sub _cannot_print {
    my ( $self, $filename ) = @_;
    $self->throw(
        -class => 'Bio::Root::IOException',
        -text  => 'Cannot write to file',
        -value => $filename
    );
    return;
}

1;    # Magic true value required at end of module
__END__

=head1 NAME

Bio::Grep::Root - Superclass for all Bio::Grep* packages

=head1 DESCRIPTION

This superclass adds some useful methods to all Bio::Grep packages.

=head1 METHODS

See L<Bio::Root::Root> for inherited methods.

=head2 PACKAGE METHODS

=over

=item C<is_integer($var_to_check, 'Description')>

Returns the variable, but it is now not tainted anymore. Throws an exception
if the specified variable is not an integer. If a second argument is passed,
it will be used in the exception text.

=item C<is_word($var_to_check, 'Description')>

Returns the variable, but it is now not tainted anymore. Throws an exception
if the specified variable is not a word. If a second argument is passed,
it will be used in the exception text.

=item C<is_path($var_to_check, 'Description')>

Returns the variable, but it is now not tainted anymore. Throws an exception
if the specified variable is not a valid path (It is word but accepts also
'/'). If a second argument is passed, it will be used in the exception text.

=item C<is_sentence($var_to_check, 'Description')>

Returns the variable, but it is now not tainted anymore. Throws an exception
if the specified variable is not a valid sentence (It is word but accepts also
'/:,;|'). If a second argument is passed, it will be used in the exception text.

WARNING: make sure that command line arguments are quoted ( my $command = "...
 '$sentence' ") 

=item C<is_arrayref_of_size($a_ref, $size)>

Checks if $a_ref is an array reference and the array is of size $size or
larger.