blob: db6ba59a2d02da8e0f743962b12205c1ffc141e3 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
|
# $Id: Recency.pm 1687 2007-06-28 22:44:07Z guillomovitch $
package Youri::Submit::Test::Recency;
=head1 NAME
Youri::Submit::Test::Recency - Release test against current target
=head1 DESCRIPTION
This test rejects packages whose a current or newer revision already exists for
current upload target. It assumes given set of package is canonical, and only
check first one.
=cut
use warnings;
use strict;
use Carp;
use base qw/Youri::Submit::Step/;
sub process_packages {
my ($self, $packages, $repository, $target, $context) = @_;
croak "Not a class method" unless ref $self;
my $errors;
my $package = $packages->[0];
my $file = $repository->get_install_file($package, $target, $context);
$errors .= "current revision already exists for $target\n"
if -f $file;
my @newer_revisions =
$repository->get_newer_revisions($package, $target, $define);
$errors .=
"newer revisions already exists for $target: "
. join(', ', @newer_revisions) . "\n"
if @newer_revisions;
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;
|
