Current File : //usr/share/perl5/File/MimeInfo/Rox.pm
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.34';
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__
=head1 NAME
File::MimeInfo::Rox - Open files by mimetype "Rox style"
=head1 SYNOPSIS
use File::MimeInfo::Magic;
use File::MimeInfo::Rox qw/:magic/;
# open some file with the appropriate program
mime_system($somefile);
# more verbose version
my $mt = mimetype($somefile)
|| die "Could not find mimetype for $somefile\n";
mime_system($somefile, $mt)
|| die "No program to open $somefile available\n";
=head1 DESCRIPTION
This module tries to mimic the behaviour of the rox file
browser L<http://rox.sf.net> when "opening" data files.
It determines the mime type and searches in rox's C<Choices>
directories for a program to handle that mimetype.
See the rox documentation for an extensive discussion of this
mechanism.
=head1 EXPORT
The methods C<mime_exec> and C<mime_system> are exported,
if you use the export tag C<:magic> you get the same methods
but L<File::MimeInfo::Magic> will be used for mimetype lookup.
=head1 ENVIRONMENT
The environment variable C<CHOICESPATH> is used when searching
for rox's config dirs. It defaults to
C<$ENV{HOME}/Choices:/usr/local/share/Choices:/usr/share/Choices>
=head1 METHODS
=over 4
=item C<mime_system($file)>
=item C<mime_system($file, $mimetype, @_)>
Try to open C<$file> with the appropriate program for files of
it's mimetype. You can use C<$mimetype> to force the mimetype.
Also if you already know the mimetype it saves a lot of time
to just tell it.
If either the mimetype couldn't be determined or
no appropriate program could be found C<undef> is returned.
If the actual L<system> fails an exception is raised.
All remaining arguments are passed on to the handler.
=item C<mime_exec($file)>
=item C<mime_exec($file, $mimetype, @_)>
Like C<mime_system()> but uses L<exec> instead of L<system>,
so it B<never returns> if successful.
=item C<suggest_script_name($mimetype)>
Returns the list C<($dir, $file)> for the suggested place
to write new script files (or symlinks) for mimetype C<$mimetype>.
The suggested dir doesn't need to exist.
=back
=head1 AUTHOR
Jaap Karssenberg E<lt>pardus@cpan.orgE<gt>
Maintained by Michiel Beijen E<lt>mb@x14.nlE<gt>
=head1 COPYRIGHT
Copyright (c) 2003, 2012 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 itself.
=head1 SEE ALSO
L<File::MimeInfo>,
L<File::MimeInfo::Magic>,
L<http://rox.sourceforce.net>
=cut
Mini Shell