/usr/share/perl5/Debian/PkgKde.pm is in pkg-kde-tools 0.15.20~ubuntu4.
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 | # Copyright (C) 2010 Modestas Vainius <modax@debian.org>
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>
package Debian::PkgKde;
use File::Spec;
use Cwd qw(realpath);
use base qw(Exporter);
our @EXPORT = qw(get_program_name
printmsg info warning errormsg error syserr usageerr);
our @EXPORT_OK = qw(find_exe_in_path);
sub find_exe_in_path {
my ($exe, @exclude) = @_;
my @realexclude;
# Canonicalize files to exclude
foreach my $exc (@exclude) {
if (my $realexc = realpath($exc)) {
push @realexclude, $realexc;
}
}
if (File::Spec->file_name_is_absolute($exe)) {
return $exe;
} elsif ($ENV{PATH}) {
foreach my $dir (split /:/, $ENV{PATH}) {
my $path = realpath(File::Spec->catfile($dir, $exe));
if (-x $path && ! grep({ $path eq $_ } @realexclude)) {
return $path;
}
}
}
return undef;
}
{
my $progname;
sub get_program_name {
unless (defined $progname) {
$progname = ($0 =~ m,/([^/]+)$,) ? $1 : $0;
}
return $progname;
}
}
sub format_message {
my $type = shift;
my $format = shift;
my $msg = sprintf($format, @_);
return ((defined $type) ?
get_program_name() . ": $type: " : "") . "$msg\n";
}
sub printmsg {
print STDERR format_message(undef, @_);
}
sub info {
print STDERR format_message("info", @_);
}
sub warning {
warn format_message("warning", @_);
}
sub syserr {
my $msg = shift;
die format_message("error", "$msg: $!", @_);
}
sub errormsg {
print STDERR format_message("error", @_);
}
sub error {
die format_message("error", @_);
}
sub usageerr {
die format_message("usage", @_);
}
1;
|