/usr/share/perl5/Tk/Pod/Util.pm is in libtk-pod-perl 0.9943-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 | # -*- perl -*-
#
# Author: Slaven Rezic
#
# Copyright (C) 2003,2004,2012 Slaven Rezic. All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
# Mail: slaven@rezic.de
# WWW: http://www.rezic.de/eserte/
#
package Tk::Pod::Util;
use strict;
use vars qw($VERSION @EXPORT_OK);
$VERSION = '5.05';
use base qw(Exporter);
@EXPORT_OK = qw(is_in_path is_interactive detect_window_manager start_browser);
# REPO BEGIN
# REPO NAME is_in_path /home/e/eserte/src/repository
# REPO MD5 1b42243230d92021e6c361e37c9771d1
sub is_in_path {
my($prog) = @_;
require Config;
my $sep = $Config::Config{'path_sep'} || ':';
foreach (split(/$sep/o, $ENV{PATH})) {
if ($^O eq 'MSWin32') {
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
sub is_interactive {
if ($^O eq 'MSWin32' || !eval { require POSIX; 1 }) {
# fallback
return -t STDIN && -t STDOUT;
}
# from perlfaq8 (with glitches)
open(TTY, "/dev/tty") or return 0;
my $tpgrp = POSIX::tcgetpgrp(fileno(*TTY));
my $pgrp = getpgrp();
if ($tpgrp == $pgrp) {
1;
} else {
0;
}
}
sub detect_window_manager {
my $top = shift;
if ($Tk::platform eq 'MSWin32') {
return "win32";
}
if ( get_property($top, "GNOME_NAME_SERVER")) {
return "gnome";
}
if ( get_property($top, "KWM_RUNNING") # KDE 1
|| get_property($top, "KWIN_RUNNING") # KDE 2
) {
return "kde";
}
"x11"; # generic X11 window manager
}
sub get_property {
my($top, $prop) = @_;
my @ret;
if ($top->property('exists', $prop, 'root')) {
@ret = $top->property('get', $prop, 'root');
shift @ret; # get rid of property name
}
@ret;
}
sub start_browser {
my($url) = @_;
if (!defined &Tk::Pod::WWWBrowser::start_browser && !eval { require Tk::Pod::WWWBrowser }) {
*Tk::Pod::WWWBrowser::start_browser = sub {
my $url = shift;
if ($^O eq 'MSWin32') {
system(qq{start explorer "$url"});
} elsif ($^O eq 'cygwin') {
system(qq{explorer "$url" &});
} elsif (is_in_path("firefox")) {
system(qq{firefox "$url" &});
} else { # last fallback
system(qq{mozilla "$url" &});
}
};
}
Tk::Pod::WWWBrowser::start_browser($url);
}
1;
__END__
=head1 NAME
Tk::Pod::Util - Tk::Pod specific utility functions
=head1 DESCRIPTION
This module contains a collection of utility functions for Tk::Pod and
is not meant for public use.
=cut
|