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

#############################################################################
#   $Author: markus $
#     $Date: 2009-11-12 17:13:23 +0100 (Thu, 12 Nov 2009) $
# $Revision: 1844 $
#############################################################################

package Bio::Grep::Root;

use strict;
use warnings;

use version; our $VERSION = qv('0.10.6');

use Bio::Root::Root;

use base 'Bio::Root::Root';

use File::Spec;
use File::Copy;
use Scalar::Util qw(reftype);

sub is_integer {
    my ( $self, $variable, $desc ) = @_;
    return $self->_check_variable(
        variable => $variable,
        desc     => $desc,
        regex    => 'int'
    );
}

sub is_word {
    my ( $self, $variable, $desc ) = @_;
    return $self->_check_variable(
        variable => $variable,
        desc     => $desc,
        regex    => 'word'
    );
}

sub is_path {
    my ( $self, $variable, $desc ) = @_;
    return $self->_check_variable(
        variable => $variable,
        desc     => $desc,
        regex    => 'path'
    );
}

sub is_sentence {
    my ( $self, $variable, $desc ) = @_;
    return $self->_check_variable(
        variable => $variable,
        desc     => $desc,
        regex    => 'sentence'
    );
}

sub is_arrayref_of_size {
    my ( $self, $a_ref, $size ) = @_;
    my $reftype = reftype $a_ref;
    if ( !defined $reftype || $reftype ne 'ARRAY' ) {
        $self->throw(
            -class => 'Bio::Root::BadParameter',
            -text  => 'Argument is not an array reference',
            -value => $reftype
        );
    }
    if ( scalar @{$a_ref} < $size ) {
        $self->throw(
            -class => 'Bio::Root::BadParameter',
            -text  => 'Size of argument is too small.',
            -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__

# vim: ft=perl sw=4 ts=4 expandtab