File Coverage

File:Dpkg/Package.pm
Coverage:94.5%

linestmtbrancondsubpodtimecode
1# Copyright © 2006 Frank Lichtenheld <djpig@debian.org>
2# Copyright © 2007-2009, 2012-2013 Guillem Jover <guillem@debian.org>
3# Copyright © 2007 Raphaël Hertzog <hertzog@debian.org>
4#
5# This program is free software; you can redistribute it and/or modify
6# it under the terms of the GNU General Public License as published by
7# the Free Software Foundation; either version 2 of the License, or
8# (at your option) any later version.
9#
10# This program is distributed in the hope that it will be useful,
11# but WITHOUT ANY WARRANTY; without even the implied warranty of
12# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
13# GNU General Public License for more details.
14#
15# You should have received a copy of the GNU General Public License
16# along with this program.  If not, see <https://www.gnu.org/licenses/>.
17
18=encoding utf8
19
20 - 30
=head1 NAME

Dpkg::Package - package properties handling

=head1 DESCRIPTION

This module provides functions to parse and validate package properties.

B<Note>: This is a private module, its API can change at any time.

=cut
31
32package Dpkg::Package 0.01;
33
34
3
3
3
3
43
6
177
use strict;
35
3
3
3
3
17
4
242
use warnings;
36
37our @EXPORT = qw(
38    pkg_name_is_illegal
39
40    get_source_name
41    set_source_name
42);
43
44
3
3
3
3
9
4
90
use Exporter qw(import);
45
46
3
3
3
3
1071
3
134
use Dpkg::ErrorHandling;
47
3
3
3
3
9
1
580
use Dpkg::Gettext;
48
49sub pkg_name_is_illegal($) {
50
30
100
30
0
53
    my $name = shift // '';
51
52
30
100
35
    if ($name eq '') {
53
6
7
        return g_('may not be empty string');
54    }
55
24
100
47
    if ($name =~ m/[^-+.0-9a-z]/op) {
56
9
10
        return sprintf(g_("character '%s' not allowed"), ${^MATCH});
57    }
58
15
100
40
    if ($name !~ m/^[0-9a-z]/o) {
59
3
3
        return g_('must start with an alphanumeric character');
60    }
61
62
12
16
    return;
63}
64
65# XXX: Eventually the following functions should be moved as methods for
66# Dpkg::Source::Package.
67
68my $source_name;
69
70sub get_source_name {
71
9
9
0
13
    return $source_name;
72}
73
74sub set_source_name {
75
12
12
0
16
    my $name = shift;
76
77
12
12
    my $err = pkg_name_is_illegal($name);
78
12
100
14
    error(g_("source package name '%s' is illegal: %s"), $name, $err) if $err;
79
80
9
100
100
17
    if (not defined $source_name) {
81
3
2
        $source_name = $name;
82    } elsif ($name ne $source_name) {
83
3
13
        error(g_('source package has two conflicting values - %s and %s'),
84              $source_name, $name);
85    }
86}
87
88 - 94
=head1 CHANGES

=head2 Version 0.xx

This is a private module.

=cut
95
961;