tv_find_grabbers not handling default symlinks in PATH and reports duplicates (/usr/bin /bin)

[multijohn]

Hello,
I have made two changes in script because in modern linux /bin is a symlink of /usr/bin and both by default are included in PATH.
Bellow is the updated script with changes in bold.
If you developers find it correct and useful please merge.
Thank you.

`#!/usr/bin/perl -w

use strict;
use File::Spec;
use Getopt::Long;
use Cwd 'abs_path';

use XMLTV;
use XMLTV::Version "$XMLTV::VERSION";

How long shall a grabber have to respond to our calls in seconds?

my $CMD_TIMEOUT = 15;

=pod

=head1 NAME

tv_find_grabbers - Find all XMLTV grabbers that are installed on the system.

=head1 SYNOPSIS

tv_find_grabbers --help

tv_find_grabbers [-I

] [--slow] [capability] ...

=head1 DESCRIPTION

tv_find_grabbers searches the PATH for XMLTV grabbers and returns a list
of all grabbers that it finds. The list contains one entry per line in the
format

/usr/bin/tv_grab_fr|France

i.e. the name of the executable and the region that it serves, separated by a
vertical bar.

=head1 OPTIONS

-I

Include a directory in the search for grabbers. May be used
multiple times. The default is to search the PATH.

--slow When checking grabbers, compile and run them instead of searching
their source code for capabilities and description

--verbose Print progress information to STDERR.

=head1 AUTHOR

Mattias Holmlund, mattias -at- holmlund -dot- se.

=cut
my $opt = { "include" => [],
help => 0,
verbose => 0,
slow => 0,
};

my $res = GetOptions( $opt, qw/
include|I=s
help|h
verbose|v
slow|s
/ );

if( (not $res) or $opt->{help} )
{
print << "EOHELP";
Usage: $0 [-I dir] [capability] ...

EOHELP

exit 1;

}

my( @req_cap ) = ("baseline", @argv);

my @paths = File::Spec->path();
push @paths, @{$opt->{include}};

Find only unique entries in PATH to avoid investigating the same

grabber twice. From "perldoc -q duplicate".

my %seen = ();
my @unique = grep { ! $seen{ abs_path($_) }++ } @paths;

foreach my $p (@unique)
{
print STDERR "Searching in $p\n" if $opt->{verbose};

next if (!opendir(DIR, $p));
my @grabbers = grep(/^tv_grab_/, readdir(DIR));
closedir(DIR);

foreach my $grabber (@grabbers)
{
    $grabber = File::Spec->catfile ($p, $grabber);
print STDERR "Investigating $grabber\n" if $opt->{verbose};

    my $cap = undef;
    my $cap_src = undef;
    open GRABBER, "<", $grabber;

    unless ($opt->{slow})
    {
        while (my $line = <GRABBER>)
        {
            # First read the grabber script and try to determine the capabilities
            # it supports - first for older grabbers using XMLTV::Capabilities
            if ($line =~ m{^use\s+XMLTV::Capabilities\s+qw/(.*)/;})
            {
                $cap = $1;
                $cap_src = "source";
                last;
            }
            # and second for newer grabbers using XMLTV::Options
            elsif ($line =~ m{capabilities\s+=>\s+\[qw/(.*)/\]})
            {
                $cap = $1;
                $cap_src = "source";
                last;
            }
        }
    }
    # Having not found the capabilities by checking the code directly, we
    # compile and run the grabber and capture the output
    if (not defined $cap)
    {
    $cap = run_capture( "$grabber --capabilities 2>/dev/null" );
        $cap_src = "run_capture";
    }

if (not defined $cap)
{
        close GRABBER;
        print STDERR "  No capabilities found...\n" if $opt->{verbose};
    next;
}
    else
    {
        print STDERR "  Found capabilities ($cap_src): $cap\n" if $opt->{verbose};
    }

my @capabilities = split( /\s+/, $cap );
my %capability;
foreach my $c (@capabilities)
{
    $capability{$c} = 1;
}

my $failed = 0;
foreach my $c (@req_cap)
{
    $failed=1
	if not defined( $capability{$c} );
}

if ($failed)
    {
        close GRABBER;
        next;
    }

    my $desc = undef;
    my $desc_src = undef;
    seek GRABBER, 0, 0; # reset to start of file

    unless ($opt->{slow})
    {
        while (my $line = <GRABBER>)
        {
            # Now read the grabber script and try to determine its description
            # - first for older grabbers using XMLTV::Description
            if ($line =~ m{^use\s+XMLTV::Description\s+["|'](.*)["|'];})
            {
                $desc = $1;
                $desc_src = "source";
                last;
            }
            # and second for newer grabbers using XMLTV::Options
            elsif ($line =~ m{description\s+=>\s+["|'](.*)["|']})
            {
                $desc = $1;
                $desc_src = "source";
                last;
            }
        }
    }
    # Having not found the description by checking the code directly, we
    # compile and run the grabber and capture the output
    if (not defined $desc)
    {
        $desc = run_capture( "$grabber --description 2>/dev/null" );
        $desc_src = "run_capture";
    }

if (not defined $desc)
{
        close GRABBER;
        print STDERR "  No description found...\n" if $opt->{verbose};
    next;
}
    else
    {
        print STDERR "  Found description ($desc_src): $desc\n" if $opt->{verbose};
    }

$desc =~  s/^\s+//;
$desc =~  s/\s+$//;
    print "$grabber|$desc\n";

    close GRABBER;
}

}

Run an external command and return the output. Exit if the command is

interrupted with ctrl-c.

sub run_capture {
my( $cmd ) = @_;

print "Running $cmd\n";

my $killed = 0;
my $result;

# Set a timer and run the real command.
eval {
local $SIG{ALRM} =
        sub {
	# ignore SIGHUP here so the kill only affects children.
	local $SIG{HUP} = 'IGNORE';
	kill 1,(-$$);
	$killed = 1;
    };
alarm $CMD_TIMEOUT;
$result = qx/$cmd/;
alarm 0;
};
$SIG{HUP} = 'DEFAULT';

if( $killed )
{
print STDERR "Timeout from: $cmd\n";
return undef;
}

if ($? == -1) {
return undef;
}
elsif ($? & 127) {
exit 1;
}

if( $? >> 8 )
{
return undef;
}
else
{
return $result;
}

}

=head1 COPYRIGHT

Copyright (C) 2005 Mattias Holmlund.

This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License
as published by the Free Software Foundation; either version 2
of the License, or (at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.

=cut

Setup indentation in Emacs

Local Variables:

perl-indent-level: 4

perl-continued-statement-offset: 4

perl-continued-brace-offset: 0

perl-brace-offset: -4

perl-brace-imaginary-offset: 0

perl-label-offset: -2

cperl-indent-level: 4

cperl-brace-offset: 0

cperl-continued-brace-offset: 0

cperl-label-offset: -2

cperl-extra-newline-before-brace: t

cperl-merge-trailing-else: nil

cperl-continued-statement-offset: 2

indent-tabs-mode: t

End:

`