r8238 - in /branches/upstream/libwwwbrowser-perl: ./ current/ current/Changes current/MANIFEST current/Makefile.PL current/README current/WWWBrowser.pm current/anybrowser current/test.html current/test.pl
segre at users.alioth.debian.org
segre at users.alioth.debian.org
Sat Oct 13 17:06:26 UTC 2007
Author: segre
Date: Sat Oct 13 17:06:26 2007
New Revision: 8238
URL: http://svn.debian.org/wsvn/?sc=1&rev=8238
Log:
[svn-inject] Installing original source of libwwwbrowser-perl
Added:
branches/upstream/libwwwbrowser-perl/
branches/upstream/libwwwbrowser-perl/current/
branches/upstream/libwwwbrowser-perl/current/Changes
branches/upstream/libwwwbrowser-perl/current/MANIFEST
branches/upstream/libwwwbrowser-perl/current/Makefile.PL
branches/upstream/libwwwbrowser-perl/current/README
branches/upstream/libwwwbrowser-perl/current/WWWBrowser.pm (with props)
branches/upstream/libwwwbrowser-perl/current/anybrowser (with props)
branches/upstream/libwwwbrowser-perl/current/test.html
branches/upstream/libwwwbrowser-perl/current/test.pl (with props)
Added: branches/upstream/libwwwbrowser-perl/current/Changes
URL: http://svn.debian.org/wsvn/branches/upstream/libwwwbrowser-perl/current/Changes?rev=8238&op=file
==============================================================================
--- branches/upstream/libwwwbrowser-perl/current/Changes (added)
+++ branches/upstream/libwwwbrowser-perl/current/Changes Sat Oct 13 17:06:26 2007
@@ -1,0 +1,2 @@
+Revision history for Perl extension WWWBrowser.
+
Added: branches/upstream/libwwwbrowser-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/branches/upstream/libwwwbrowser-perl/current/MANIFEST?rev=8238&op=file
==============================================================================
--- branches/upstream/libwwwbrowser-perl/current/MANIFEST (added)
+++ branches/upstream/libwwwbrowser-perl/current/MANIFEST Sat Oct 13 17:06:26 2007
@@ -1,0 +1,8 @@
+Changes
+MANIFEST
+Makefile.PL
+WWWBrowser.pm
+test.pl
+test.html
+anybrowser
+README
Added: branches/upstream/libwwwbrowser-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/branches/upstream/libwwwbrowser-perl/current/Makefile.PL?rev=8238&op=file
==============================================================================
--- branches/upstream/libwwwbrowser-perl/current/Makefile.PL (added)
+++ branches/upstream/libwwwbrowser-perl/current/Makefile.PL Sat Oct 13 17:06:26 2007
@@ -1,0 +1,15 @@
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+
+my $prereq = {};
+if ($^O eq 'MSWin32') {
+ $prereq->{'Win32Util'} = undef;
+}
+
+WriteMakefile(
+ 'NAME' => 'WWWBrowser',
+ 'VERSION_FROM' => 'WWWBrowser.pm',
+ 'PREREQ_PM' => $prereq,
+ 'EXE_FILES' => ['anybrowser'],
+);
Added: branches/upstream/libwwwbrowser-perl/current/README
URL: http://svn.debian.org/wsvn/branches/upstream/libwwwbrowser-perl/current/README?rev=8238&op=file
==============================================================================
--- branches/upstream/libwwwbrowser-perl/current/README (added)
+++ branches/upstream/libwwwbrowser-perl/current/README Sat Oct 13 17:06:26 2007
@@ -1,0 +1,16 @@
+WWWBrowser.pm
+
+Start a WWW browser in a platform-independent manner.
+
+Installation:
+
+ perl Makefile.PL
+ make all test install
+
+
+There is also an script included:
+
+ anybrowser http://anyurl
+
+Comments to: slaven at rezic.de
+
Added: branches/upstream/libwwwbrowser-perl/current/WWWBrowser.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libwwwbrowser-perl/current/WWWBrowser.pm?rev=8238&op=file
==============================================================================
--- branches/upstream/libwwwbrowser-perl/current/WWWBrowser.pm (added)
+++ branches/upstream/libwwwbrowser-perl/current/WWWBrowser.pm Sat Oct 13 17:06:26 2007
@@ -1,0 +1,445 @@
+#!/usr/bin/env perl
+# -*- perl -*-
+
+#
+# $Id: WWWBrowser.pm,v 2.23 2003/02/05 16:39:10 eserte Exp $
+# Author: Slaven Rezic
+#
+# Copyright (C) 1999,2000,2001,2003 Slaven Rezic. All rights reserved.
+# This package is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+#
+# Mail: slaven at rezic.de
+# WWW: http://www.rezic.de/eserte/
+#
+
+package WWWBrowser;
+
+use strict;
+use vars qw(@unix_browsers $VERSION $initialized $os $fork
+ $got_from_config $ignore_config);
+
+$VERSION = sprintf("%d.%02d", q$Revision: 2.23 $ =~ /(\d+)\.(\d+)/);
+
+ at unix_browsers = qw(_default_gnome _default_kde
+ mozilla galeon konqueror netscape Netscape kfmclient
+ dillo w3m lynx
+ mosaic Mosaic
+ chimera arena tkweb
+ explorer) if !@unix_browsers;
+
+init();
+
+sub init {
+ if (!$initialized) {
+ if (!defined $main::os) {
+ $os = ($^O eq 'MSWin32' ? 'win' : 'unix');
+ } else {
+ $os = $main::os;
+ }
+ if (!defined &main::status_message) {
+ eval 'sub status_message { warn $_[0] }';
+ } else {
+ eval 'sub status_message { main::status_message(@_) }';
+ }
+ $fork = 1;
+ $initialized++;
+ get_from_config();
+ }
+}
+
+sub start_browser {
+ my $url = shift;
+ my(%args) = @_;
+
+ if ($os eq 'win') {
+ if (!eval 'require Win32Util;
+ Win32Util::start_html_viewer($url)') {
+ # if this fails, just try to start explorer
+ system("start explorer $url");
+ # otherwise croak
+ if ($?/256 != 0) {
+ status_message("Can't find HTML viewer.", "err");
+ return 0;
+ }
+ }
+ return 1;
+ }
+
+ my @browsers = @unix_browsers;
+ if ($args{-browser}) {
+ unshift @browsers, delete $args{-browser};
+ }
+
+ foreach my $browser (@browsers) {
+ next if (!is_in_path($browser));
+ if ($browser =~ /^(lynx|w3m)$/) { # text-orientierte Browser
+ if (defined $ENV{DISPLAY} && $ENV{DISPLAY} ne "") {
+ foreach my $term (qw(xterm kvt gnome-terminal)) {
+ if (is_in_path($term)) {
+ exec_bg($term,
+ ($term eq 'gnome_terminal' ? '-x' : '-e'),
+ $browser, $url);
+ return 1;
+ }
+ }
+ } else {
+ # without X11: not in background!
+ system($browser, $url);
+ return 1;
+ }
+ next;
+ }
+
+ if ((!defined $ENV{DISPLAY} || $ENV{DISPLAY} eq '') &&
+ $^O ne 'cygwin') {
+ next;
+ }
+ # After this point only X11 browsers or cygwin as a special case
+
+ my $url = $url;
+ if ($browser eq '_default_gnome') {
+ eval {
+ my $cmdline = _get_cmdline_for_url_from_Gnome($url);
+ exec_bg($cmdline);
+ return 1;
+ };
+ } elsif ($browser eq '_default_kde') {
+ # NYI
+ } elsif ($browser eq 'konqueror') {
+ return 1 if open_in_konqueror($url, %args);
+ } elsif ($browser eq 'galeon') {
+ return 1 if open_in_galeon($url, %args);
+ } elsif ($browser eq 'mozilla') {
+ return 1 if open_in_mozilla($url, %args);
+ } elsif ($browser =~ /^mosaic$/i &&
+ $url =~ /^file:/ && $url !~ m|file://|) {
+ $url =~ s|file:/|file://localhost/|;
+ } elsif ($browser eq 'kfmclient') {
+ # kfmclient loads kfm, which loads and displays all KDE icons
+ # on the desktop, even if KDE is not running at all.
+ exec_bg("kfmclient", "openURL", $url);
+ return 1 if (!$?)
+ } elsif ($browser eq 'netscape') {
+ if ($os eq 'unix') {
+ my $lockfile = "$ENV{HOME}/.netscape/lock";
+ if (-l $lockfile) {
+ my($host,$pid) = readlink($lockfile) =~ /^(.*):(\d+)$/;
+ # XXX check $host
+ # Check whether Netscape stills lives:
+ if (defined $pid && kill 0 => $pid) {
+ if ($args{-oldwindow}) {
+ exec_bg("netscape", "-remote", "openURL($url)");
+ } else {
+ exec_bg("netscape", "-remote", "openURL($url,new)");
+ }
+ # XXX further options: mailto(to-adresses)
+ # XXX check return code?
+ return 1;
+ }
+ }
+ exec_bg("netscape", $url);
+ return 1;
+ }
+ } else {
+ exec_bg($browser, $url);
+ return 1;
+ }
+ }
+
+ status_message("Can't find HTML viewer.", "err");
+
+ return 0;
+}
+
+sub open_in_konqueror {
+ my $url = shift;
+ my(%args) = @_;
+ if (is_in_path("dcop") && is_in_path("konqueror")) {
+
+ # first try old window (if requested)
+ if ($args{-oldwindow}) {
+ my $konq_name;
+ foreach my $l (split /\n/, `dcop konqueror KonquerorIface getWindows`) {
+ if ($l =~ /(konqueror-mainwindow\#\d+)/) {
+ $konq_name = $1;
+ last;
+ }
+ }
+
+ if (defined $konq_name) {
+ system(qw/dcop konqueror/, $konq_name, qw/openURL/, $url);
+ return 1 if ($?/256 == 0);
+ }
+ }
+
+ # then try to send to running konqueror process:
+ system(qw/dcop konqueror KonquerorIface openBrowserWindow/, $url);
+ return 1 if ($?/256 == 0);
+
+ # otherwise start a new konqueror
+ exec_bg("konqueror", $url);
+ return 1; # if ($?/256 == 0);
+ }
+ 0;
+}
+
+sub open_in_galeon {
+ my $url = shift;
+ my(%args) = @_;
+ if (is_in_path("galeon")) {
+
+ $url = _guess_and_expand_url($url) if $args{-expandurl};
+
+ # first try old window (if requested)
+ if ($args{-oldwindow}) {
+ system("galeon", "-x", $url);
+ return 1 if ($?/256 == 0);
+ }
+
+ exec_bg("galeon", "-n", $url);
+ return 1 if ($?/256 == 0);
+ return 0;
+ }
+ 0;
+}
+
+sub open_in_mozilla {
+ my $url = shift;
+ my(%args) = @_;
+ if (is_in_path("mozilla")) {
+ if ($args{-oldwindow}) {
+ system("mozilla", "-remote", "openURL($url)");
+ } else {
+ system("mozilla", "-remote", "openURL($url,new-tab)");
+ }
+ return 1 if ($?/256 == 0);
+
+ # otherwise start a new mozilla process
+ exec_bg("mozilla", $url);
+ return 1; # if ($?/256 == 0);
+ }
+ 0;
+}
+
+sub exec_bg {
+ my(@cmd) = @_;
+ if ($os eq 'unix') {
+ eval {
+ if (!$fork || fork == 0) {
+ exec @cmd;
+ die "Can't exec @cmd: $!";
+ }
+ };
+ } else {
+ # XXX use Spawn
+ system(join(" ", @cmd) . ($fork ? "&" : ""));
+ }
+}
+
+sub _get_cmdline_for_url_from_Gnome {
+ my($url) = @_;
+ (my $url_scheme = $url) =~ s/^([^:]+).*/$1/; # use URI.pm?
+ my $curr_section;
+ my $default_cmdline;
+ my $cmdline;
+ if (open(GNOME, "$ENV{HOME}/.gnome/Gnome")) {
+ while(<GNOME>) {
+ chomp;
+ if (/^\[(.*)\]/) {
+ $curr_section = $1;
+ } elsif (defined $curr_section && $curr_section eq 'URL Handlers' && /^(default|\Q$url_scheme\E)-show=(.*)/) {
+ if ($1 eq 'default') {
+ $default_cmdline = $2;
+ } else {
+ $cmdline = $2;
+ }
+ }
+ }
+ close GNOME;
+ }
+ if (!defined $cmdline) {
+ $cmdline = $default_cmdline;
+ }
+ if (!defined $cmdline) {
+ die "Can't find command for scheme $url_scheme";
+ }
+ $cmdline =~ s/%s/$url/g;
+ $cmdline;
+}
+
+# XXX document get_from_config, $ignore_config, ~/.wwwbrowser
+sub get_from_config {
+ if (!$got_from_config && !$ignore_config && $ENV{HOME} && open(CFG, "$ENV{HOME}/.wwwbrowser")) {
+ my @browser;
+ while(<CFG>) {
+ chomp;
+ push @browser, $_;
+ }
+ close CFG;
+ $got_from_config++;
+ unshift @unix_browsers, @browser;
+ }
+}
+
+sub _guess_and_expand_url {
+ my $url = shift;
+ if ($url =~ m|^[a-z]+://|) {
+ $url;
+ } elsif ($url =~ m|^www|) {
+ "http://$url";
+ } elsif ($url =~ m|^ftp|) {
+ "ftp://$url";
+ } else {
+ $url;
+ }
+}
+
+# REPO BEGIN
+# REPO NAME file_name_is_absolute /home/e/eserte/src/repository
+# REPO MD5 89d0fdf16d11771f0f6e82c7d0ebf3a8
+BEGIN {
+ if (eval { require File::Spec; defined &File::Spec::file_name_is_absolute }) {
+ *file_name_is_absolute = \&File::Spec::file_name_is_absolute;
+ } else {
+ *file_name_is_absolute = sub {
+ my $file = shift;
+ my $r;
+ if ($^O eq 'MSWin32') {
+ $r = ($file =~ m;^([a-z]:(/|\\)|\\\\|//);i);
+ } else {
+ $r = ($file =~ m|^/|);
+ }
+ $r;
+ };
+ }
+}
+# REPO END
+
+# REPO BEGIN
+# REPO NAME is_in_path /home/e/eserte/src/repository
+# REPO MD5 81c0124cc2f424c6acc9713c27b9a484
+sub is_in_path {
+ my($prog) = @_;
+ return $prog if (file_name_is_absolute($prog) and -f $prog and -x $prog);
+ require Config;
+ my $sep = $Config::Config{'path_sep'} || ':';
+ foreach (split(/$sep/o, $ENV{PATH})) {
+ if ($^O eq 'MSWin32') {
+ # maybe use $ENV{PATHEXT} like maybe_command in ExtUtils/MM_Win32.pm?
+ return "$_\\$prog"
+ if (-x "$_\\$prog.bat" ||
+ -x "$_\\$prog.com" ||
+ -x "$_\\$prog.exe" ||
+ -x "$_\\$prog.cmd");
+ } else {
+ return "$_/$prog" if (-x "$_/$prog" && !-d "$_/$prog");
+ }
+ }
+ undef;
+}
+# REPO END
+
+1;
+
+__END__
+
+=head1 NAME
+
+WWWBrowser - platform independent mean to start a WWW browser
+
+=head1 SYNOPSIS
+
+ use WWWBrowser;
+ WWWBrowser::start_browser($url, -oldwindow => 1);
+
+=head1 DESCRIPTION
+
+=head2 start_browser($url [, %args])
+
+Start a web browser with the specified URL. The process is started in
+background.
+
+The following optional parameters are recognized:
+
+=over 4
+
+=item -oldwindow => $bool
+
+Normally, the URL is loaded into a new window, if possible. With
+C<-oldwindow> set to a false window, C<WWWBrowser> will try to re-use
+a browser window.
+
+=item -browser => $browser
+
+Use (preferebly) the named browser C<$browser>. See L</CONFIGURATION>
+for a some browser specialities. This option will only work for unix.
+
+=back
+
+=head1 CONFIGURATION
+
+For unix, the global variable C<@WWWBrowser::unix_browsers> can be set
+to a list of preferred web browsers. The following browsers are
+handled specially:
+
+=over 4
+
+=item lynx, w3m
+
+Text oriented browsers, which are opened in an C<xterm>, C<kvt> or
+C<gnome-terminal> (if running under X11). If not running under X11,
+then no background process is started.
+
+=item kfmclient
+
+Use C<openURL> method of kfm.
+
+=item netscape
+
+Use C<-remote> option to re-use a running netscape process, if
+possible.
+
+=item _default_gnome
+
+Look into the C<~/.gnome/Gnome> configuration file for the right browser.
+
+=item _default_kde
+
+NYI.
+
+=back
+
+The following variables can be defined globally in the B<main>
+package:
+
+=over 4
+
+=item C<$os>
+
+Short name of operating system (C<win>, C<mac> or C<unix>).
+
+=item C<&status_messages>
+
+Error handling function (instead of default C<warn>).
+
+=back
+
+=head1 REQUIREMENTS
+
+For Windows, the L<Win32Util|Win32Util> module should be installed in
+the path.
+
+=head1 AUTHOR
+
+Slaven Rezic <slaven at rezic.de>
+
+=head1 COPYRIGHT
+
+Copyright (c) 1999,2000,2001,2003 Slaven Rezic. All rights reserved.
+This module is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=head1 SEE ALSO
+
+L<Win32Util|Win32Util>.
Propchange: branches/upstream/libwwwbrowser-perl/current/WWWBrowser.pm
------------------------------------------------------------------------------
svn:executable =
Added: branches/upstream/libwwwbrowser-perl/current/anybrowser
URL: http://svn.debian.org/wsvn/branches/upstream/libwwwbrowser-perl/current/anybrowser?rev=8238&op=file
==============================================================================
--- branches/upstream/libwwwbrowser-perl/current/anybrowser (added)
+++ branches/upstream/libwwwbrowser-perl/current/anybrowser Sat Oct 13 17:06:26 2007
@@ -1,0 +1,30 @@
+#!/usr/bin/env perl
+# -*- perl -*-
+
+#
+# $Id: anybrowser,v 1.2 2003/02/05 16:41:10 eserte Exp $
+# Author: Slaven Rezic
+#
+# Copyright (C) 2002 Slaven Rezic. All rights reserved.
+# This package is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+#
+# Mail: slaven at rezic.de
+# WWW: http://www.rezic.de/eserte/
+#
+
+use WWWBrowser;
+
+require Getopt::Long;
+my @extra_args;
+if (!Getopt::Long::GetOptions
+ ("-browser=s" => sub { push @extra_args, -browser => $_[1] },
+ "-fork!" => \$WWWBrowser::fork,
+ "-oldwindow!" => sub { push @extra_args, -oldwindow => 1 },
+ )) {
+ die "usage: $^X $0 [-browser browser] [-[no]fork] [-oldwindow]\n"
+}
+
+WWWBrowser::start_browser($ARGV[0], @extra_args);
+
+__END__
Propchange: branches/upstream/libwwwbrowser-perl/current/anybrowser
------------------------------------------------------------------------------
svn:executable =
Added: branches/upstream/libwwwbrowser-perl/current/test.html
URL: http://svn.debian.org/wsvn/branches/upstream/libwwwbrowser-perl/current/test.html?rev=8238&op=file
==============================================================================
--- branches/upstream/libwwwbrowser-perl/current/test.html (added)
+++ branches/upstream/libwwwbrowser-perl/current/test.html Sat Oct 13 17:06:26 2007
@@ -1,0 +1,8 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN"> <!-- -*-html-*- -->
+<html><head>
+<title>Test page</title>
+<link rev=made href="mailto:slaven at rezic.de">
+</head>
+<body>
+This is a small html test page for WWWBrowser.pm
+</body></html>
Added: branches/upstream/libwwwbrowser-perl/current/test.pl
URL: http://svn.debian.org/wsvn/branches/upstream/libwwwbrowser-perl/current/test.pl?rev=8238&op=file
==============================================================================
--- branches/upstream/libwwwbrowser-perl/current/test.pl (added)
+++ branches/upstream/libwwwbrowser-perl/current/test.pl Sat Oct 13 17:06:26 2007
@@ -1,0 +1,31 @@
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl test.pl'
+
+######################### We start with some black magic to print on failure.
+
+# Change 1..1 below to 1..last_test_to_print .
+# (It may become useful if the test is moved to ./t subdirectory.)
+
+BEGIN { $| = 1; print "1..1\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use WWWBrowser;
+$loaded = 1;
+print "ok 1\n";
+
+######################### End of black magic.
+
+# Insert your test code below (better if it prints "ok 13"
+# (correspondingly "not ok 13") depending on the success of chunk 13
+# of the test code):
+
+use Cwd qw(cwd);
+use Sys::Hostname qw(hostname);
+use File::Spec;
+
+if (!$ENV{BATCH}) {
+ WWWBrowser::start_browser("file:" . File::Spec->catfile(cwd, "test.html"));
+}
+
+if (hostname eq 'vran.herceg.de') {
+ WWWBrowser::start_browser("www.herceg.de", -expandurl => 1);
+}
Propchange: branches/upstream/libwwwbrowser-perl/current/test.pl
------------------------------------------------------------------------------
svn:executable =
More information about the Pkg-perl-cvs-commits
mailing list