[dh-make-perl] 01/02: Debian::Control::Stanza: add support for user-defined fields (X-Moon-Phase)
Damyan Ivanov
dmn at moszumanska.debian.org
Mon Dec 4 21:37:06 UTC 2017
This is an automated email from the git hooks/post-receive script.
dmn pushed a commit to branch master
in repository dh-make-perl.
commit e6e6767e0bdbd25106bd1584f724c034836b7129
Author: Damyan Ivanov <dmn at debian.org>
Date: Mon Dec 4 21:28:59 2017 +0000
Debian::Control::Stanza: add support for user-defined fields (X-Moon-Phase)
Closes: #883439
---
Build.PL | 1 +
debian/control | 2 ++
lib/Debian/Control/Stanza.pm | 60 ++++++++++++++++++++++++++++++++++++-
lib/Debian/Control/Stanza/Source.pm | 4 +--
t/Control.t | 18 +++++++++--
5 files changed, 79 insertions(+), 6 deletions(-)
diff --git a/Build.PL b/Build.PL
index 89e9a9c..ebdbbb5 100644
--- a/Build.PL
+++ b/Build.PL
@@ -50,6 +50,7 @@ my $builder = My::Builder->new(
'Parse::DebianChangelog' => 0,
'Software::License::Artistic_2_0' => 0,
'Storable' => 0,
+ 'Sub::Install' => 0,
'Sys::CPU' => 0,
'Text::Diff' => 0,
'Text::Wrap' => 0,
diff --git a/debian/control b/debian/control
index 6fd0103..709313c 100644
--- a/debian/control
+++ b/debian/control
@@ -29,6 +29,7 @@ Build-Depends-Indep: libapt-pkg-perl,
libparse-debcontrol-perl,
libparse-debianchangelog-perl,
libsoftware-license-perl,
+ libsub-install-perl,
libsys-cpu-perl,
libtest-compile-perl,
libtest-deep-perl,
@@ -107,6 +108,7 @@ Depends: ${misc:Depends},
libclass-accessor-perl,
liblist-moreutils-perl,
libparse-debcontrol-perl,
+ libsub-install-perl,
libtie-ixhash-perl,
libwww-mechanize-perl,
libwww-perl
diff --git a/lib/Debian/Control/Stanza.pm b/lib/Debian/Control/Stanza.pm
index 5a70fa9..996ba43 100644
--- a/lib/Debian/Control/Stanza.pm
+++ b/lib/Debian/Control/Stanza.pm
@@ -32,6 +32,7 @@ use base qw( Class::Accessor Tie::IxHash );
use Carp qw(croak);
use Debian::Control::Stanza::CommaSeparated;
use Debian::Dependencies;
+use Sub::Install;
=head1 FIELDS
@@ -44,6 +45,15 @@ Fields that are to contain dependency lists (as per L</is_dependency_list>
method below) are automatically converted to instances of the
L<Debian::Dependencies> class.
+=head2 User-defined fields
+
+User-defined fields are supported. These start with C<X>, optionally followed
+by C<S>, C<B> or C<C>, then C<_>, capital letter and other letters and digits.
+
+Examples: C<X_Moon_Phase>, C<XS_Hemisphere>.
+
+See L<https://www.debian.org/doc/debian-policy/#user-defined-fields>.
+
=cut
use constant fields => ();
@@ -98,6 +108,7 @@ sub new {
# translate field name into the accessor canonical name
$k = $canonical{ lc $k } || $k;
$self->can($k)
+ or $self->looks_like_an_x_field($k)
or croak "Invalid field given ($k)";
$self->$k($v);
}
@@ -117,6 +128,40 @@ sub new {
return $self;
}
+our $AUTOLOAD;
+sub AUTOLOAD {
+ my $self = shift;
+
+ ref($self) and eval { $self->isa(__PACKAGE__) }
+ or croak "Invalid method call";
+
+ my $field = $AUTOLOAD;
+ $field =~ s/.+:://;
+
+ if ( $field eq 'DESTROY' ) {
+ return eval { $self->SUPER::DESTROY(@_) };
+ }
+
+ $self->looks_like_an_x_field($field)
+ or croak "Invalid field '$field' requested";
+
+ Sub::Install::install_sub({
+ code => sub {
+ my $self = shift;
+ if (@_) {
+ $self->set( $field, @_ );
+ }
+ else {
+ $self->get($field);
+ }
+ },
+ into => ref($self),
+ as => $field,
+ });
+
+ $self->$field(@_);
+}
+
=head1 METHODS
=over
@@ -202,6 +247,19 @@ sub is_comma_separated {
return exists $comma_separated{$field};
}
+=item looks_like_an_x_field($field)
+
+Returns true if B<$field> is considered appropriate to name a user-defined
+field.
+
+=cut
+
+sub looks_like_an_x_field {
+ my ( $self, $field ) = @_;
+
+ return $field =~ /^X[SBC]?(?:_[A-Z][A-Za-z0-9]*)+$/;
+}
+
=item get($field)
Overrides the default get method from L<Class::Accessor> with L<Tie::IxHash>'s
@@ -322,7 +380,7 @@ sub as_string
=head1 COPYRIGHT & LICENSE
-Copyright (C) 2009 Damyan Ivanov L<dmn at debian.org>
+Copyright (C) 2009, 2017 Damyan Ivanov L<dmn at debian.org>
This program is free software; you can redistribute it and/or modify it under
the terms of the GNU General Public License version 2 as published by the Free
diff --git a/lib/Debian/Control/Stanza/Source.pm b/lib/Debian/Control/Stanza/Source.pm
index c219ad5..c7d815d 100644
--- a/lib/Debian/Control/Stanza/Source.pm
+++ b/lib/Debian/Control/Stanza/Source.pm
@@ -61,8 +61,6 @@ replaced with underscores.
=item Homepage
-=item XS_Autobuild
-
=item Testsuite
=item Rules_Requires_Root
@@ -87,7 +85,7 @@ use constant fields => qw (
Source Section Priority Maintainer Uploaders DM_Upload_Allowed
Build_Conflicts Build_Conflicts_Indep Build_Depends Build_Depends_Indep
Standards_Version Vcs_Browser Vcs_Bzr Vcs_CVS Vcs_Git Vcs_Svn Homepage
- XS_Autobuild Testsuite Rules_Requires_Root
+ Testsuite Rules_Requires_Root
);
=head1 CONSTRUCTOR
diff --git a/t/Control.t b/t/Control.t
index b27eec6..8dbff54 100644
--- a/t/Control.t
+++ b/t/Control.t
@@ -116,12 +116,26 @@ EOF
lives_ok { $s = Debian::Control::Stanza::Source->new({'Vcs_Git' => 'git://example.org'}) } 'Source constructor with Vcs_Git';
can_ok($s, qw(Vcs_Git));
ok($s->Vcs_Git eq 'git://example.org', 'Vcs_Git returns correct value');
-throws_ok { $s->vCs_GiT } qr/Can't locate object method "vCs_GiT" via package "Debian::Control::Stanza::Source"/, 'No method vCs_GiT';
+throws_ok { $s->vCs_GiT } qr/Invalid field 'vCs_GiT' requested/, 'No vCs_GiT field';
lives_ok { $s = Debian::Control::Stanza::Source->new({'vCs-GiT' => 'git://example.net'}) } 'Source constructor with vCs-GiT';
can_ok($s, qw(Vcs_Git));
ok($s->Vcs_Git eq 'git://example.net', 'Vcs_Git returns correct value');
-throws_ok { $s->vCs_GiT } qr/Can't locate object method "vCs_GiT" via package "Debian::Control::Stanza::Source"/, 'No method vCs_GiT';
+throws_ok { $s->vCs_GiT } qr/Invalid field 'vCs_GiT' requested/, 'No method vCs_GiT';
+ok( $s->looks_like_an_x_field('XS_Moon_Phase'),
+ "XS_Moon_Phase looks like an X_ field"
+);
+
+ok( $s->looks_like_an_x_field('X_Hemisphere'),
+ "X_emisphere looks like an X_ field"
+);
+
+ok( !$s->looks_like_an_x_field('XFail'),
+ "XFail doesn't look like an X_ field"
+);
+
+lives_ok { $s->XS_Moon_Phase("full") } "Can set XS_Moon_Phase";
+is( $s->XS_Moon_Phase, 'full', 'Moon is full' );
done_testing;
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/dh-make-perl.git
More information about the Pkg-perl-cvs-commits
mailing list