← Back to branch summary

~mitya57/pkg-kde-tools/0.15.16ubuntu1

« back to all changes in this revision

Viewing changes to perllib/Debian/PkgKde.pm

  • Committer: Bazaar Package Importer
  • Author(s): Modestas Vainius
  • Date: 2010-04-08 13:41:29 UTC
  • mfrom: (0.1.20 sid)
  • Revision ID: james.westby@ubuntu.com-20100408134129-bsr1dutc0fnb5192
Tags: 0.7.0.1
Remove perl from pkg-kde-tools Depends to workaround (and use to our own
advantage) brokeness in experimental buildds.

Show diffs side-by-side

added added

removed removed

Lines of Context:
perllib/Debian/PkgKde.pm
 
1
# Copyright (C) 2010 Modestas Vainius <modax@debian.org>
 
2
#
 
3
# This program is free software: you can redistribute it and/or modify
 
4
# it under the terms of the GNU General Public License as published by
 
5
# the Free Software Foundation, either version 3 of the License, or
 
6
# (at your option) any later version.
 
7
#
 
8
# This program is distributed in the hope that it will be useful,
 
9
# but WITHOUT ANY WARRANTY; without even the implied warranty of
 
10
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 
11
# GNU General Public License for more details.
 
12
#
 
13
# You should have received a copy of the GNU General Public License
 
14
# along with this program.  If not, see <http://www.gnu.org/licenses/>
 
15
 
 
16
package Debian::PkgKde;
 
17
 
 
18
use base qw(Exporter);
 
19
our @EXPORT = qw(get_program_name
 
20
    printmsg info warning errormsg error syserr usageerr);
 
21
our @EXPORT_OK = qw(find_datalibdir setup_datalibdir DATALIBDIR);
 
22
 
 
23
# Determine datalib for current script. It depends on the context the script
 
24
# was executed from.
 
25
use constant DATALIBDIR => '/usr/share/pkg-kde-tools/lib';
 
26
 
 
27
sub find_datalibdir {
 
28
    my @hintfiles = @_;
 
29
    my @dirs;
 
30
    if ($0 =~ m@^(.+)/[^/]+$@) {
 
31
        push @dirs, "$1/datalib";
 
32
    }
 
33
    push @dirs, DATALIBDIR;
 
34
 
 
35
    # Verify if the dir and hint files exist
 
36
    my $founddir;
 
37
    foreach my $dir (@dirs) {
 
38
        my $ok;
 
39
        if ($dir && -d $dir) {
 
40
            $ok = 1;
 
41
            foreach my $hint (@hintfiles) {
 
42
                unless (-e "$dir/$hint") {
 
43
                    $ok = 0;
 
44
                    last;
 
45
                }
 
46
            }
 
47
        }
 
48
        if ($ok) {
 
49
            $founddir = $dir;
 
50
            last;
 
51
        }
 
52
    }
 
53
 
 
54
    return $founddir;
 
55
}
 
56
 
 
57
# Add DATALIBDIR to @INC if the script is NOT being run from the source tree.
 
58
sub setup_datalibdir {
 
59
    my $dir = find_datalibdir(@_);
 
60
    if ($dir) {
 
61
        unshift @INC, DATALIBDIR if $dir eq DATALIBDIR;
 
62
    } else {
 
63
        error("unable to locate pkg-kde-tools library directory");
 
64
    }
 
65
    return $dir;
 
66
}
 
67
 
 
68
{
 
69
    my $progname;
 
70
    sub get_program_name {
 
71
        unless (defined $progname) {
 
72
            $progname = ($0 =~ m,/([^/]+)$,) ? $1 : $0;
 
73
        }
 
74
        return $progname;
 
75
    }
 
76
}
 
77
 
 
78
sub format_message {
 
79
    my $type = shift;
 
80
    my $format = shift;
 
81
 
 
82
    my $msg = sprintf($format, @_);
 
83
    return ((defined $type) ?
 
84
        get_program_name() . ": $type: " : "") . "$msg\n";
 
85
}
 
86
 
 
87
sub printmsg {
 
88
    print STDERR format_message(undef, @_);
 
89
}
 
90
 
 
91
sub info {
 
92
    print STDERR format_message("info", @_);
 
93
}
 
94
 
 
95
sub warning {
 
96
    warn format_message("warning", @_);
 
97
}
 
98
 
 
99
sub syserr {
 
100
    my $msg = shift;
 
101
    die format_message("error", "$msg: $!", @_);
 
102
}
 
103
 
 
104
sub errormsg {
 
105
    print STDERR format_message("error", @_);
 
106
}
 
107
 
 
108
sub error {
 
109
    die format_message("error", @_);
 
110
}
 
111
 
 
112
sub usageerr {
 
113
    die format_message("usage", @_);
 
114
}
 
115
 
 
116
1;