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 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 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. If a command is found, returns the exit code of the execution attempt, 0 for success. See the C 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. =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. =head1 AUTHOR Pedro Melo, C<< >> =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