File Coverage

blib/lib/File/MimeInfo/Rox.pm

Criterion	Covered	Total	%
statement	27	52	51.9
branch	3	30	10.0
condition	0	3	0.0
subroutine	8	12	66.6
pod	3	3	100.0
total	41	100	41.0

package File::MimeInfo::Rox;

use strict;
use warnings;
use Carp;
use File::BaseDir qw/config_home data_dirs/;
use File::Spec;
require Exporter;

our @ISA = qw(Exporter);
our @EXPORT = qw(mime_exec mime_system);
our @EXPORT_OK = qw(suggest_script_name);
our %EXPORT_TAGS = (magic => \@EXPORT);
our $VERSION = '0.33';
our @choicespath = (
    config_home('rox.sourceforge.net'),
    File::Spec->catdir($ENV{HOME}, 'Choices'),
    data_dirs('Choices'),
);
our ($DEBUG);

sub import {
    my $parent = (grep {$_ eq q/:magic/} @_)
        ? q/File::MimeInfo::Magic/
        : q/File::MimeInfo/;
    eval "use $parent";
    die $@ if $@;
    goto \&Exporter::import;
}

sub mime_system { _do_mime('system', @_) }
sub mime_exec   { _do_mime('exec',   @_) }

sub _do_mime {
    my ($act, $file, $mimet) = (shift, shift, shift);

    $mimet ||= mimetype($file);
    return undef unless $mimet;
    print "Using mimetype: $mimet\n" if $DEBUG;

    my $script = _locate_script($mimet);
    return undef unless $script;

    print "Going to $act: $script $file\n" if $DEBUG;
    ($act eq 'exec')
        ? exec($script, $file, @_)
        : (system($script, $file, @_) == 0)
            or croak "couldn't $act: $script $file";
    42;
}

sub _locate_script {
    my $mime = shift;
    $mime =~ /^(\w+)/;
    my $media = $1;
    $mime =~ s#/#_#;
    my @p = $ENV{CHOICESPATH}
        ? split(/:/, $ENV{CHOICESPATH})
        : (@choicespath);
    my $script;
    for (
        map("$_/MIME-types/$mime", @p),
        map("$_/MIME-types/$media", @p)
    ) {
        print "looking for: $_\n" if $DEBUG;
        next unless -e $_;
        $script = $_;
        last;
    }
    return undef unless $script;
    $script = "$script/AppRun" if -d $script;
    return -f $script ? $script : undef;
}

sub suggest_script_name {
    my $m = pop;
    $m =~ s#/#_#;
    my @p = $ENV{CHOICESPATH}
        ? split(/:/, $ENV{CHOICESPATH})
        : (@choicespath);
    return "$p[0]/MIME-types", $m;
}

1;

__END__