File Coverage

blib/lib/Browser/Open.pm

Criterion	Covered	Total	%
statement	33	39	84.6
branch	11	22	50.0
condition	9	15	60.0
subroutine	9	10	90.0
pod	3	3	100.0
total	65	89	73.0

package Browser::Open;
our $VERSION = '0.04';



use strict;
use warnings;
use Carp;
use File::Spec::Functions qw( catfile );

use parent 'Exporter';

@Browser::Open::EXPORT_OK = qw(
  open_browser
  open_browser_cmd
  open_browser_cmd_all
);

my @known_commands = (
  ['', $ENV{BROWSER}],
  ['darwin',  '/usr/bin/open', 1],
  ['cygwin',  'start'],
  ['MSWin32', 'start', undef, 1],
  ['solaris', 'xdg-open'],
  ['solaris', 'firefox'],
  ['linux',   'sensible-browser'],
  ['linux',   'xdg-open'],
  ['linux',   'x-www-browser'],
  ['linux',   'www-browser'],
  ['linux',   'htmlview'],
  ['linux',   'gnome-open'],
  ['linux',   'gnome-moz-remote'],
  ['linux',   'kfmclient'],
  ['linux',   'exo-open'],
  ['linux',   'firefox'],
  ['linux',   'seamonkey'],
  ['linux',   'opera'],
  ['linux',   'mozilla'],
  ['linux',   'iceweasel'],
  ['linux',   'netscape'],
  ['linux',   'galeon'],
  ['linux',   'opera'],
  ['linux',   'w3m'],
  ['linux',   'lynx'],
  ['freebsd', 'xdg-open'],
  ['freebsd', 'gnome-open'],
  ['freebsd', 'gnome-moz-remote'],
  ['freebsd', 'kfmclient'],
  ['freebsd', 'exo-open'],
  ['freebsd', 'firefox'],
  ['freebsd', 'seamonkey'],
  ['freebsd', 'opera'],
  ['freebsd', 'mozilla'],
  ['freebsd', 'netscape'],
  ['freebsd', 'galeon'],
  ['freebsd', 'opera'],
  ['freebsd', 'w3m'],
  ['freebsd', 'lynx'],
  ['',        'open'],
  ['',        'start'],
);

##################################

sub open_browser {
  my ($url, $all) = @_;
  croak('Missing required parameter $url, ') unless $url;

  my $cmd = $all ? open_browser_cmd_all() : open_browser_cmd();
  return unless $cmd;

  return system($cmd, $url);
}

sub open_browser_cmd {
  return _check_all_cmds($^O);
}

sub open_browser_cmd_all {
  return _check_all_cmds('');
}


##################################

sub _check_all_cmds {
  my ($filter) = @_;

  foreach my $spec (@known_commands) {
    my ($osname, $cmd, $exact, $no_search) = @$spec;
    next unless $cmd;
    next if $osname && $filter && $osname ne $filter;
    next if $no_search && !$filter && $osname ne $^O;

    return $cmd if $exact && -x $cmd;
    return $cmd if $no_search;
    $cmd = _search_in_path($cmd);
    return $cmd if $cmd;
  }
  return;
}

sub _search_in_path {
  my $cmd = shift;

  for my $path (split(/:/, $ENV{PATH})) {
    next unless $path;
    my $file = catfile($path, $cmd);
    return $file if -x $file;
  }
  return;
}


1;
__END__

=head1 NAME

Browser::Open - open a browser in a given URL


=head1 VERSION

version 0.03

=head1 SYNOPSIS

    use Browser::Open qw( open_browser );

    ### Try commands specific to the current Operating System
    my $ok = open_browser($url);
    # ! defined($ok): no recognized command found
    # $ok == 0: command found and executed
    # $ok != 0: command found, error while executing

    ### Try all known commands
    my $ok = open_browser($url, 1);


=head1 DESCRIPTION

The functions optionaly exported by this module allows you to open URLs
in the user browser.

A set of known commands per OS-name is tested for presence, and the
first one found is executed. With an optional parameter, all known
commands are checked.

The L<"open_browser"> uses the C<system()> function to execute the
command. If you want more control, you can get the command with the
L<"open_browser_cmd"> or L<"open_browser_cmd_all"> functions and then
use whatever method you want to execute it.


=head1 API

All functions are B<not> exported by default. You must ask for them
explicitly.


=head2 open_browser

    my $ok = open_browser($url, $all);

Find an appropriate command and executes it with your C<$url>. If
C<$all> is false, the default, only commands that match the current OS
will be tested. If true, all known commands will be tested.

If no command was found, returns C<undef>.

If a command is found, returns the exit code of the execution attempt, 0
for success. See the C<system()> for more information about this
exit code.

If no C<$url> is given, an exception will be thrown:
C<< Missing required parameter $url >>.


=head2 open_browser_cmd

    my $cmd = open_browser_cmd();

Returns the best command found to open a URL on your system.

If no command was found, returns C<undef>.


=head2 open_browser_cmd_all

    my $cmd = open_browser_cmd_all();

Returns the first command found to open a URL.

If no command was found, returns C<undef>.


=head1 AUTHOR

Pedro Melo, C<< <melo at cpan.org> >>


=head1 COPYRIGHT & LICENSE

Copyright 2009 Pedro Melo.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut