/usr/share/perl5/File/MimeInfo/Rox.pm is in libfile-mimeinfo-perl 0.26-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 | package File::MimeInfo::Rox;
use strict;
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.26';
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 apropriate 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>michiel.beijen@gmail.comE<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.sourceforge.net>
=cut
|