diff options
Diffstat (limited to 'lib/Youri/Submit/Test/Tag.pm')
-rw-r--r-- | lib/Youri/Submit/Test/Tag.pm | 58 |
1 files changed, 58 insertions, 0 deletions
diff --git a/lib/Youri/Submit/Test/Tag.pm b/lib/Youri/Submit/Test/Tag.pm new file mode 100644 index 0000000..59342e4 --- /dev/null +++ b/lib/Youri/Submit/Test/Tag.pm @@ -0,0 +1,58 @@ +# $Id: Tag.pm 1687 2007-06-28 22:44:07Z guillomovitch $ +package Youri::Submit::Test::Tag; + +=head1 NAME + +Youri::Submit::Test::Tag - Incorrect tag values test + +=head1 DESCRIPTION + +This test plugin rejects packages with incorrect tag values, based on regular +expressions. + +=cut + +use warnings; +use strict; +use Carp; +use base qw/Youri::Submit::Step/; + +sub _init { + my $self = shift; + my %options = ( + tags => undef, # expected tag values + @_ + ); + + croak "no tags to test" unless $options{tags}; + croak "tag should be an hashref" unless ref $options{tags} eq 'HASH'; + + $self->{_tags} = $options{tags}; +} + +sub process_packages { + my ($self, $packages, $repository, $target, $context) = @_; + croak "Not a class method" unless ref $self; + + my $errors; + + foreach my $package (@$packages) { + foreach my $tag (keys %{$self->{_tags}}) { + my $value = $package->get_tag($tag); + $errors .= "invalid value $value for tag $tag" + if $value !~ /$self->{_tags}->{$tag}/; + } + } + + croak $errors if $errors; +} + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2002-2006, YOURI project + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut + +1; |