<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">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 =&gt; \@EXPORT);
our $VERSION = '0.34';
our @choicespath = (
    config_home('rox.sourceforge.net'),
    File::Spec-&gt;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 \&amp;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&lt;http://rox.sf.net&gt; when "opening" data files.
It determines the mime type and searches in rox's C&lt;Choices&gt;
directories for a program to handle that mimetype.

See the rox documentation for an extensive discussion of this
mechanism.

=head1 EXPORT

The methods C&lt;mime_exec&gt; and C&lt;mime_system&gt; are exported,
if you use the export tag C&lt;:magic&gt; you get the same methods
but L&lt;File::MimeInfo::Magic&gt; will be used for mimetype lookup.

=head1 ENVIRONMENT

The environment variable C&lt;CHOICESPATH&gt; is used when searching
for rox's config dirs. It defaults to
C&lt;$ENV{HOME}/Choices:/usr/local/share/Choices:/usr/share/Choices&gt;

=head1 METHODS

=over 4

=item C&lt;mime_system($file)&gt;

=item C&lt;mime_system($file, $mimetype, @_)&gt;

Try to open C&lt;$file&gt; with the appropriate program for files of
it's mimetype. You can use C&lt;$mimetype&gt; 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&lt;undef&gt; is returned.
If the actual L&lt;system&gt; fails an exception is raised.

All remaining arguments are passed on to the handler.

=item C&lt;mime_exec($file)&gt;

=item C&lt;mime_exec($file, $mimetype, @_)&gt;

Like C&lt;mime_system()&gt; but uses L&lt;exec&gt; instead of L&lt;system&gt;,
so it B&lt;never returns&gt; if successful.

=item C&lt;suggest_script_name($mimetype)&gt;

Returns the list C&lt;($dir, $file)&gt; for the suggested place
to write new script files (or symlinks) for mimetype C&lt;$mimetype&gt;.
The suggested dir doesn't need to exist.

=back

=head1 AUTHOR

Jaap Karssenberg E&lt;lt&gt;pardus@cpan.orgE&lt;gt&gt;
Maintained by Michiel Beijen E&lt;lt&gt;mb@x14.nlE&lt;gt&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&lt;File::MimeInfo&gt;,
L&lt;File::MimeInfo::Magic&gt;,
L&lt;http://rox.sourceforce.net&gt;

=cut
</pre></body></html>