scripts/Dpkg/Package.pm

   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 =head1 NAME
  21
  22 Dpkg::Package - package properties handling
  23
  24 =head1 DESCRIPTION
  25
  26 This module provides functions to parse and validate package properties.
  27
  28 B<Note>: This is a private module, its API can change at any time.
  29
  30 =cut
  31
  32 package Dpkg::Package 0.01;
  33
  34 use strict;
  35 use warnings;
  36
  37 our @EXPORT = qw(
  38     pkg_name_is_illegal
  39
  40     get_source_name
  41     set_source_name
  42 );
  43
  44 use Exporter qw(import);
  45
  46 use Dpkg::ErrorHandling;
  47 use Dpkg::Gettext;
  48
  49 sub pkg_name_is_illegal($) {
  50     my $name = shift // '';
  51
  52     if ($name eq '') {
  53         return g_('may not be empty string');
  54     }
  55     if ($name =~ m/[^-+.0-9a-z]/op) {
  56         return sprintf(g_("character '%s' not allowed"), ${^MATCH});
  57     }
  58     if ($name !~ m/^[0-9a-z]/o) {
  59         return g_('must start with an alphanumeric character');
  60     }
  61
  62     return;
  63 }
  64
  65 # XXX: Eventually the following functions should be moved as methods for
  66 # Dpkg::Source::Package.
  67
  68 my $source_name;
  69
  70 sub get_source_name {
  71     return $source_name;
  72 }
  73
  74 sub set_source_name {
  75     my $name = shift;
  76
  77     my $err = pkg_name_is_illegal($name);
  78     error(g_("source package name '%s' is illegal: %s"), $name, $err) if $err;
  79
  80     if (not defined $source_name) {
  81         $source_name = $name;
  82     } elsif ($name ne $source_name) {
  83         error(g_('source package has two conflicting values - %s and %s'),
  84               $source_name, $name);
  85     }
  86 }
  87
  88 =head1 CHANGES
  89
  90 =head2 Version 0.xx
  91
  92 This is a private module.
  93
  94 =cut
  95
  96 1;