path: root/debian/efetch

#!/usr/bin/perl -w
# Detect whether to run efetch.acedb or edirect -fetch.

use strict;

my $usage = <<EOF;
USAGE: efetch [<AceDB efetch options>] [<database>:]<query>
 -or-  efetch [<NCBI Entrez Direct efetch options>]

per, respectively,

    efetch.acedb -h (or man efetch.acedb)
    efetch.ncbi -help (or man efetch)
EOF

if ( !@ARGV  ||  ! -x '/usr/bin/efetch.acedb' ) {
    ExecNCBI();
} elsif (grep /--?help/, @ARGV) {
    print $usage;
    exit 0;
}

my $acedb_flags = 'afqHprmMbAxw';
my $acedb_keys  = 'seDdilBn';

my %ncbi_supported = (
    'db'          => 's',
    'id'          => 's',
    'input'       => 's',
    'format'      => 's',
    'docsum'      => undef,
    'style'       => 's',
    'mode'        => 's',
    'seq_start'   => 'i',
    'seq_stop'    => 'i',
    'strand'      => 's',
    'forward'     => undef,
    'plus'        => undef,
    'revcomp'     => undef,
    'reverse'     => undef,
    'minus'       => undef,
    'complexity'  => 'i',
    'chr_start'   => 'i',
    'chr_stop'    => 'i',
    'extend'      => 'i',
    'extrafeat'   => 'i',
    'showgaps'    => undef,
    'show-gaps'   => undef,
    'start'       => 'i',
    'stop'        => 'i',
    'raw'         => undef,
    'json'        => undef,
    'external'    => undef,
    'ext'         => undef,
    'email'       => 's',
    'tool'        => 's',
    'help'        => undef,
    'debug'       => undef,
    'oldmode'     => undef,
    'newmode'     => undef,
    'log'         => undef,
    'immediate'   => undef,
    'express'     => undef,
    'base'        => 's',
    'web'         => 's',
    'step'        => 'i',
    'label'       => 's',
    'timer'       => undef,
    'version'     => undef);

my %ncbi_abbrev = ();
{
    my @names = sort keys %ncbi_supported;
    unshift @names, '';
    push @names, '';
    my $i;
    my $j;
    for ($i = 1;  $i + 1 < @names;  ++$i) {
        my $name      = $names[$i];
        my $prev_name = $names[$i - 1];
        my $next_name = $names[$i + 1];
        for ($j = 1;  $j < length($name);  ++$j) {
            my $abbrev = substr($name, 0, $j);
            if ($abbrev ne substr($prev_name, 0, $j)
                &&  $abbrev ne substr($next_name, 0, $j)) {
                $ncbi_abbrev{$abbrev} = $name;
            }
        }
    }
}

my @acedb_red_flags;
my @acedb_yellow_flags;
my $acedb_value_expected;
my $acedb_query;
my @ncbi_red_flags;
my @ncbi_yellow_flags;
my $ncbi_value_expected;

for (@ARGV) {
    if (/^-\d+$/  ||  !/^-/) {
        if ( !defined $acedb_value_expected ) {
            if (defined $acedb_query) {
                push @acedb_yellow_flags, "$acedb_query $_";
            }
            $acedb_query = $_;
        }
        if ( !defined $ncbi_value_expected ) {
            push @ncbi_red_flags, $_;
        }
        undef $acedb_value_expected;
        undef $ncbi_value_expected;
    } else {
        my $acedb_type;
        if (defined $acedb_value_expected) {
            push @acedb_red_flags, "$acedb_value_expected $_";
            $acedb_type = 'nominal-value';
            undef $acedb_value_expected;
        } elsif (/^-[ho]$/  ||  /^-[$acedb_flags]*(?:[$acedb_keys].+)?$/) {
            $acedb_type = 'flag';
        } elsif (/^-[$acedb_flags]*([$acedb_keys])$/) {
            $acedb_type = 'key';
            $acedb_value_expected = "-$1";
        } else {
            $acedb_type = 'invalid';
            push @acedb_red_flags, $_;
        }

        my $ncbi_type;
        if (defined $ncbi_value_expected) {
            push @ncbi_red_flags, "$ncbi_value_expected $_";
            $ncbi_type = 'nominal-value';
            undef $ncbi_value_expected;
        } elsif (/^--?([^=]+)(=.*)?/) {
            my $base = lc($1);
            my $has_value = defined $2;
            if (exists $ncbi_abbrev{$base}) {
                $base = $ncbi_abbrev{$base};
                push @ncbi_yellow_flags, $_;
            }
            if ( !exists $ncbi_supported{$base}
                 ||  ($has_value  &&  !defined $ncbi_supported{$base})) {
                $ncbi_type = 'invalid';
                push @ncbi_red_flags, $_;
            } else {
                if (lc($1) eq $base  &&  $1 =~ /[A-Z]/) {
                    # Worry about capitalization only if otherwise OK
                    push @ncbi_yellow_flags, $_;
                }
                if (defined $ncbi_supported{$base}  &&  !$has_value) {
                    $ncbi_type = 'key';
                    $ncbi_value_expected = $_;
                } else {
                    $ncbi_type = 'flag';
                }
            }
        } else {
            $ncbi_type = 'invalid';
            push @ncbi_red_flags, $_;
        }

        if ($acedb_type =~ /^[fk]/  &&  $ncbi_type =~ /^[fk]/) {
            # Could technically be valid for efetch.acedb, but far likelier
            # to have been intended for edirect -fetch.
            push @acedb_yellow_flags, $_;
        }
    }
}

if ( !defined $acedb_query ) {
    push @acedb_red_flags, "no query";
}
if (defined $acedb_value_expected) {
    push @acedb_red_flags, "$acedb_value_expected with no value";
}
if (defined $ncbi_value_expected) {
    push @ncbi_red_flags, "$ncbi_value_expected with no value";
}

my $acedb_red  = @acedb_red_flags;
my $acedb_ylw  = @acedb_yellow_flags;
my $ncbi_red   = @ncbi_red_flags;
my $ncbi_ylw   = @ncbi_yellow_flags;

if ($acedb_red  &&  !$ncbi_red) {
    # clear-cut, even if there happen to be NCBI yellow flags
    ExecNCBI();
} elsif ($ncbi_red  &&  !$acedb_red) {
    ExecAceDB();
}

my $acedb_misgivings = "AceDB misgivings ($acedb_red major, $acedb_ylw minor):";
my $ncbi_misgivings  = "NCBI misgivings ($ncbi_red major, $ncbi_ylw minor):";

for (@acedb_red_flags) {
    $acedb_misgivings .= "\n  $_ (major)";
}
for (@acedb_yellow_flags) {
    $acedb_misgivings .= "\n  $_ (minor)";
}
for (@ncbi_red_flags) {
    $ncbi_misgivings .= "\n  $_ (major)";
}
for (@ncbi_yellow_flags) {
    $ncbi_misgivings .= "\n  $_ (minor)";
}

if ($ncbi_red > $acedb_red
    ||  ($ncbi_red == $acedb_red  &&  $ncbi_ylw > $acedb_ylw)) {
    if ($acedb_red  ||  $acedb_ylw) {
        warn <<EOF;
Launching AceDB efetch rather than NCBI efetch despite misgivings,
due to more severe misgivings about NCBI syntax compatibility.  If you
meant to run NCBI efetch, please explicitly run it via edirect -fetch.
$ncbi_misgivings
$acedb_misgivings
EOF
    }
    ExecAceDB();
}

if ($acedb_red > $ncbi_red
    ||  ($acedb_red == $ncbi_red  &&  $acedb_ylw > $ncbi_ylw)) {
    if ($ncbi_red  ||  $ncbi_ylw) {
        warn <<EOF;
Launching NCBI efetch rather than AceDB efetch despite misgivings,
due to more severe misgivings about AceDB syntax compatibility.  If you
meant to run AceDB efetch, please explicitly run it via efetch.acedb.
$acedb_misgivings
$ncbi_misgivings
EOF
    }
    ExecNCBI();
}

if ($acedb_red) {
    die <<EOF;
Usage equally bad for both AceDB efetch and NCBI efetch.  Please double
check your usage or explicitly run efetch.acedb or edirect -fetch.
$acedb_misgivings
$ncbi_misgivings

$usage
EOF
} elsif ($acedb_ylw) {
    die <<EOF;
Usage equally suspect (but still technically valid, at least to first
approximation) for both AceDB efetch and NCBI efetch.  Please double
check your usage or explicitly run efetch.acedb or edirect -fetch.
$acedb_misgivings
$ncbi_misgivings

$usage
EOF
} else {
    die <<EOF;
Usage apparently valid (at least to first approximation) for both
AceDB efetch and NCBI efetch.  Please disambiguate your usage or
explicitly run efetch.acedb or edirect -fetch.
EOF
}

sub ExecAceDB
{
    # exec {'/usr/bin/efetch.acedb'} ('/usr/bin/efetch', @ARGV);
    exec('/usr/bin/efetch.acedb', @ARGV);
}
sub ExecNCBI
{
    exec('/usr/bin/efetch.ncbi', @ARGV);
}