#!/usr/bin/perl
our $VERSION = '0.15';
$|++;
my %args = ();
my %opts = (
'help' => ['h'],
'usage' => ['u'],
'version' => ['v'],
'stdin' => [''],
'dereference' => ['L'],
'debug' => ['D'],
'database' => ['', 1],
'magic-only' => ['M'],
'ask' => ['a'],
'ask-default' => ['d'],
'no-ask' => ['n'],
);
while ((@ARGV) && ($ARGV[0] =~ /^-/)) {
my $opt = shift @ARGV;
if ($opt =~ /^--?$/) {
last;
}
elsif ($opt =~ s/^--([\w-]+)(?:=(.*))?/$1/) {
if (exists $opts{$opt}) {
if ($opts{$opt}[1]) {
my $arg = $2 || shift @ARGV;
complain('--'.$opt, 2) unless defined $arg;
$args{$opt} .= ( $args{$opt} ? ' ' : '' ) . $arg;
}
else { $args{$opt}++ }
}
else { complain('--'.$opt) }
}
elsif ($opt =~ s/^-(?!-)//) {
foreach my $o (split //, $opt) {
my ($key) = grep { $opts{$_}[0] eq $o } keys %opts;
complain($o) unless $key;
if ($opts{$key}[1]) {
my $arg = shift @ARGV;
complain('-'.$o, 2) unless defined $arg;
$args{$key} .= ( $args{$key} ? ' ' : '' ).$arg;
}
else { $args{$key}++; }
}
}
else { complain($opt) }
}
if ($args{help} || $args{usage}) {
eval 'use Pod::Usage';
die "Could not find perl module Pod::Usage\n" if $@;
pod2usage( {
-verbose => 1,
-exitval => 0,
} );
}
if ($args{version}) {
print "mimeopen $VERSION\n\n", << 'EOV';
Copyright (c) 2005,2008 Jaap G Karssenberg. All rights reserved.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl.
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.
EOV
exit 0;
}
complain(undef, 4) unless scalar(@ARGV);
@File::MimeInfo::DIRS = split /:/, $args{database} if $args{database};
eval 'use File::MimeInfo::Magic qw/mimetype magic/;';
die $@ if $@;
eval 'use File::MimeInfo::Applications;';
die $@ if $@;
*default = \&File::MimeInfo::default;
if ($args{debug}) {
$File::MimeInfo::DEBUG++;
$File::MimeInfo::Magic::DEBUG++;
print '> Data dirs are: ', join( ', ',
$args{database}
? ( split /:/, $args{database} )
: (
File::BaseDir::xdg_data_home(),
File::BaseDir::xdg_data_dirs()
)
), "\n";
}
if ($args{dereference}) {
eval 'use File::Spec';
die "Could not find perl module File::Spec\n" if $@;
}
my $mimetype;
my $file = $ARGV[0];
my $f = ($args{dereference} && -l $file) ? resolvelink($file) : $file;
$mimetype = $args{'magic-only'}
? (magic($f) || default($f))
: mimetype($f) ;
unless (length $mimetype) {
print STDERR "Could not determine mimetype for file: $file\n";
exit 5;
}
my ($default, @other) = mime_applications_all($mimetype);
unless($default or @other) {
print STDERR "No applications found for mimetype: $mimetype\n";
exit 6;
}
if ($args{'no-ask'}) {
$default = defined($default) ? $default : $other[0];
}
elsif ($args{'ask'}) {
$default = choose($mimetype, 0, grep defined($_), $default, @other);
}
elsif ($args{'ask-default'}) {
$default = choose($mimetype, 1, grep defined($_), $default, @other);
}
elsif (! defined $default) {
($default) = (@other == 1) ? (@other) : choose($mimetype, 1, @other);
}
print 'Opening '.join(', ', map qq{"$_"}, @ARGV)
. ' with '.$default->get_value('Name')." ($mimetype)\n";
if (@ARGV == 1 or $default->wants_list) {
$default->exec(@ARGV);
}
else {
my $last = pop @ARGV;
fork or $default->exec($_) for @ARGV;
$default->exec($last);
}
exit 7;
sub choose {
my ($mime, $set_default, @app) = @_;
print $set_default ?
"Please choose a default application for files of type $mime\n\n" :
"Please choose an application\n\n" ;
my @done;
for my $i (0 .. $#app) {
my (undef, undef, $file) =
File::Spec->splitpath( $app[$i]->{file} );
$file =~ s/\.desktop$//;
if (grep {$_ eq $file} @done) {
$app[$i] = undef;
}
else {
push @done, $file;
print "\t", scalar(@done), ") ",
$app[$i]->get_value('Name'), " ($file)\n";
}
}
@app = grep defined($_), @app;
print "\t", scalar(@done)+1, ") Other...\n" if $set_default;
print "\nuse application #";
my $c = <STDIN>;
chomp $c;
unless ($c =~ /^\d+$/) {
print STDERR "Cancelled\n";
exit 8;
}
$c--;
if ($set_default and $c == scalar(@done)) {
print "use command: ";
my $cmd = <STDIN>;
chomp $cmd;
push @app,
eval { mime_applications_set_custom($mime => $cmd) };
warn $@ if $@;
}
elsif ($c > scalar(@app)) {
print STDERR "Cancelled\n";
exit 8;
}
elsif ($set_default) {
eval { mime_applications_set_default($mime => $app[$c]) };
warn $@ if $@;
}
return $app[$c];
}
sub complain {
my $opt = shift;
my $m = shift || 1;
my $bn = $0;
$bn =~ s|^(.*/)*||;
if ($m == 1) { print STDERR "$bn: unrecognized option '$opt'" }
elsif ($m == 2) { print STDERR "$bn: option '$opt' requires an argument" }
elsif ($m == 3) { print STDERR "$bn: $opt: No such file or directory\n" }
elsif ($m == 4) { print STDERR "usage: $bn [options] files" }
print "\nTry '$bn --help' for more information.\n" unless $m == 3;
exit $m;
}
sub resolvelink {
my $file = shift;
my $link = readlink($file) || return $file;
my (undef, $dir, undef) = File::Spec->splitpath($file);
$link = File::Spec->rel2abs($link, $dir);
$link = resolvelink($link) if -l $link;
return $link;
}