Author: gisle.aas
Date: Wed Oct 22 05:37:14 2008
New Revision: 539
Modified:
trunk/bin/nytprofhtml
Log:
Make 'nytprofhtml --open' work on machines that does not run Mac OS X.
Logic borrowed from the ActiveState::Browser module that ships with
ActivePerl.
Modified: trunk/bin/nytprofhtml
==============================================================================
--- trunk/bin/nytprofhtml (original)
+++ trunk/bin/nytprofhtml Wed Oct 22 05:37:14 2008
@@ -365,11 +365,7 @@
output_js_files($reporter);
-if ($opt{open}) {
- # only useful on systems with an 'open' command
- # XXX could get fancy and look for firefox -remote command etc
- system("open", "$opt{out}/index.html");
-}
+browse("$opt{out}/index.html") if $opt{open};
exit 0;
@@ -457,6 +453,65 @@
copy($src, "$opt{out}/$file")
or warn "Unable to copy $src to $opt{out}/$file: $!";
}
+}
+
+
+sub browse {
+ my $index = shift;
+ if (eval { require ActiveState::Browser; 1 }) {
+ ActiveState::Browser::open($index);
+ }
+ else {
+ my $BROWSER;
+ if ($^O eq "MSWin32") {
+ $BROWSER = "start %s";
+ }
+ elsif ($^O eq "darwin") {
+ $BROWSER = "/usr/bin/open %s";
+ }
+ else {
+ my @try = qw(xdg-open);
+ if ($ENV{BROWSER}) {
+ push(@try, split(/:/, $ENV{BROWSER}));
+ }
+ else {
+ push(@try, qw(firefox galeon mozilla opera netscape));
+ }
+ unshift(@try, "kfmclient") if $ENV{KDE_FULL_SESSION};
+ unshift(@try, "gnome-open") if $ENV{GNOME_DESKTOP_SESSION_ID};
+ for (@try) {
+ if (have_prog($_)) {
+ if ($_ eq "kfmclient") {
+ $BROWSER .= " openURL %s";
+ }
+ elsif ($_ eq "gnome-open" || $_ eq "opera") {
+ $BROWSER = "$_ %s";
+ }
+ else {
+ $BROWSER = "$_ %s &";
+ }
+ last;
+ }
+ }
+ }
+ if ($BROWSER) {
+ (my $cmd = $BROWSER) =~ s/%s/"$index"/;
+ #warn "Running $cmd\n";
+ system($cmd);
+ }
+ else {
+ warn "Don't know how to invoke your web browser.\nPlease visit
$index yourself!\n";
+ }
+ }
+}
+
+
+sub have_prog {
+ my $prog = shift;
+ for (split(":", $ENV{PATH})) {
+ return 1 if -x "$_/$prog";
+ }
+ return 0;
}
--~--~---------~--~----~------------~-------~--~----~
You've received this message because you are subscribed to
the Devel::NYTProf Development User group.
Group hosted at: http://groups.google.com/group/develnytprof-dev
Project hosted at: http://perl-devel-nytprof.googlecode.com
CPAN distribution: http://search.cpan.org/dist/Devel-NYTProf
To post, email: [email protected]
To unsubscribe, email: [EMAIL PROTECTED]
-~----------~----~----~----~------~----~------~--~---
