aboutsummaryrefslogtreecommitdiffstats
path: root/lib/Youri/Submit/Check
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Youri/Submit/Check')
-rw-r--r--lib/Youri/Submit/Check/ACL.pm71
-rw-r--r--lib/Youri/Submit/Check/History.pm61
-rw-r--r--lib/Youri/Submit/Check/Host.pm63
-rw-r--r--lib/Youri/Submit/Check/Precedence.pm58
-rw-r--r--lib/Youri/Submit/Check/Queue_recency.pm40
-rw-r--r--lib/Youri/Submit/Check/Recency.pm46
-rw-r--r--lib/Youri/Submit/Check/Rpmlint.pm89
-rw-r--r--lib/Youri/Submit/Check/SVN.pm79
-rw-r--r--lib/Youri/Submit/Check/Section.pm58
-rw-r--r--lib/Youri/Submit/Check/Source.pm45
-rw-r--r--lib/Youri/Submit/Check/Tag.pm61
-rw-r--r--lib/Youri/Submit/Check/Type.pm54
-rw-r--r--lib/Youri/Submit/Check/Version.pm100
13 files changed, 0 insertions, 825 deletions
diff --git a/lib/Youri/Submit/Check/ACL.pm b/lib/Youri/Submit/Check/ACL.pm
deleted file mode 100644
index 34bf48a..0000000
--- a/lib/Youri/Submit/Check/ACL.pm
+++ /dev/null
@@ -1,71 +0,0 @@
-# $Id$
-package Youri::Submit::Check::ACL;
-
-=head1 NAME
-
-Youri::Submit::Check::Tag - Incorrect tag values check
-
-=head1 DESCRIPTION
-
-This check plugin rejects packages with incorrect tag values, based on regular
-expressions.
-
-=cut
-
-use strict;
-use Carp;
-use base qw/Youri::Submit::Check/;
-my $acl;
-
-sub _init {
- my $self = shift;
- my %options = (
- acl_file => '',
- @_
- );
- $acl = get_acl($options{acl_file});
-}
-
-sub run {
- my ($self, $package, $repository, $target, $define) = @_;
- croak "Not a class method" unless ref $self;
- my $file = $package->get_full_name();
- my $arch = $package->get_arch();
- my $srpm = $package->get_canonical_name;
- my $section = $repository->_get_section($package, $target, $define);
- my $user = $define->{user};
- foreach my $t (keys %$acl) {
- next if $target !~ /$t/;
- foreach my $acl (@{$acl->{$t}}) {
- my ($a, $media, $r, $users) = @$acl;
- next if $arch !~ $a || $srpm !~ $r || $section !~ $media;
- if ($user =~ /$users/) {
- return
- } else {
- return "$user is not authorized to upload packages belonging to $srpm in section $section (authorized persons: " . join(', ', split '\|', $users) . ")";
- }
- }
- }
- return
-}
-
-sub get_acl {
- my ($file) = @_;
- my %acl;
- open my $f, $file;
- while (<$f>) {
- my ($dis, $arch, $media, $regexp, $users) = split ' ';
- push @{$acl{$dis}}, [ $arch , $media, $regexp, $users ]
- }
- \%acl
-}
-
-=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;
diff --git a/lib/Youri/Submit/Check/History.pm b/lib/Youri/Submit/Check/History.pm
deleted file mode 100644
index 326f2f1..0000000
--- a/lib/Youri/Submit/Check/History.pm
+++ /dev/null
@@ -1,61 +0,0 @@
-# $Id$
-package Youri::Submit::Check::History;
-
-=head1 NAME
-
-Youri::Submit::Check::History - Non-linear history check
-
-=head1 DESCRIPTION
-
-This check plugin rejects packages whose history does not include last
-available revision one.
-
-=cut
-
-use warnings;
-use strict;
-use Carp;
-use Youri::Package;
-use base qw/Youri::Submit::Check/;
-
-sub run {
- my ($self, $package, $repository, $target, $define) = @_;
- croak "Not a class method" unless ref $self;
-
- my @errors;
-
- my $last_revision =
- $repository->get_last_older_revision($package, $target, $define);
-
- if ($last_revision) {
- # skip the test if last revision has been produced from another source package, as it occurs during package split/merges
- return
- if $last_revision->get_canonical_name()
- ne $package->get_canonical_name();
-
- my ($last_revision_number) = $last_revision->get_last_change()->[Youri::Package::CHANGE_AUTHOR] =~ /(\S+)\s*$/;
- my %entries =
- map { $_ => 1 }
- map { /(\S+)\s*$/ }
- map { $_->[Youri::Package::CHANGE_AUTHOR] }
- $package->get_changes();
- unless ($entries{$last_revision_number}) {
- push(
- @errors,
- "Last changelog entry $last_revision_number from last revision " . $last_revision->get_full_name() . " missing from current changelog"
- );
- }
- }
-
- return @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;
diff --git a/lib/Youri/Submit/Check/Host.pm b/lib/Youri/Submit/Check/Host.pm
deleted file mode 100644
index b2b392a..0000000
--- a/lib/Youri/Submit/Check/Host.pm
+++ /dev/null
@@ -1,63 +0,0 @@
-# $Id$
-package Youri::Submit::Check::Host;
-
-=head1 NAME
-
-Youri::Submit::Check::Tag - Incorrect tag values check
-
-=head1 DESCRIPTION
-
-This check plugin rejects packages with incorrect tag values, based on regular
-expressions.
-
-=cut
-
-use strict;
-use Carp;
-use base qw/Youri::Submit::Check/;
-my $host;
-
-sub _init {
- my $self = shift;
- my %options = (
- host_file => '',
- @_
- );
- $host = get_host($options{host_file})
-}
-
-sub run {
- my ($self, $package, $repository, $target, $define) = @_;
- croak "Not a class method" unless ref $self;
- my $file = $package->get_file;
- my $arch = $package->get_arch;
- my $buildhost = $package->as_formated_string('%{buildhost}');
- foreach my $h (keys %$host) {
- next if $buildhost !~ $h;
- if ($arch =~ $host->{$h}) {
- return
- }
- }
- "Packages build on host $buildhost are not authorized";
-}
-
-sub get_host {
- my ($file) = @_;
- my %host;
- open my $f, $file;
- while (<$f>) {
- my ($host, $arch) = split ' ';
- $host{$host} = $arch
- }
- \%host
-}
-
-=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;
diff --git a/lib/Youri/Submit/Check/Precedence.pm b/lib/Youri/Submit/Check/Precedence.pm
deleted file mode 100644
index c73446b..0000000
--- a/lib/Youri/Submit/Check/Precedence.pm
+++ /dev/null
@@ -1,58 +0,0 @@
-# $Id$
-package Youri::Submit::Check::Precedence;
-
-=head1 NAME
-
-Youri::Submit::Check::Precedence - Release check against another check
-
-=head1 DESCRIPTION
-
-This check plugin rejects packages whose an older revision already exists for
-another upload target.
-
-=cut
-
-use warnings;
-use strict;
-use Carp;
-use base qw/Youri::Submit::Check/;
-
-sub _init {
- my $self = shift;
- my %options = (
- _target => undef, # mandatory targets
- @_
- );
-
- die "undefined target" unless $options{target};
-
- $self->{_target} = $options{target};
-}
-
-sub run {
- my ($self, $package, $repository, $target, $define) = @_;
- croak "Not a class method" unless ref $self;
-
- my @errors;
-
- my @older_revisions =
- $repository->get_older_revisions($package, $self->{_target}, $define);
- if (@older_revisions) {
- push(
- @errors,
- "Older revisions still exists for $self->{_target}: " . join(', ', @older_revisions)
- );
- }
-
- return @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;
diff --git a/lib/Youri/Submit/Check/Queue_recency.pm b/lib/Youri/Submit/Check/Queue_recency.pm
deleted file mode 100644
index 42c4f42..0000000
--- a/lib/Youri/Submit/Check/Queue_recency.pm
+++ /dev/null
@@ -1,40 +0,0 @@
-# $Id$
-package Youri::Submit::Check::Queue_recency;
-
-=head1 NAME
-
-Youri::Submit::Check::Recency - Release check against current target
-
-=head1 DESCRIPTION
-
-This check plugin rejects packages whose a current or newer revision already
-exists for current upload target.
-
-=cut
-
-use warnings;
-use strict;
-use Carp;
-use base qw/Youri::Submit::Check/;
-
-sub run {
- my ($self, $package, $repository, $target, $define) = @_;
- croak "Not a class method" unless ref $self;
-
- my @newer_revisions =
- $repository->get_upload_newer_revisions($package, $target, $define);
- if (@newer_revisions) {
- return "Newer revisions already exists for $target in upload queue: " . join(', ', @newer_revisions);
- }
- return
-}
-
-=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;
diff --git a/lib/Youri/Submit/Check/Recency.pm b/lib/Youri/Submit/Check/Recency.pm
deleted file mode 100644
index f8aa5b7..0000000
--- a/lib/Youri/Submit/Check/Recency.pm
+++ /dev/null
@@ -1,46 +0,0 @@
-# $Id$
-package Youri::Submit::Check::Recency;
-
-=head1 NAME
-
-Youri::Submit::Check::Recency - Release check against current target
-
-=head1 DESCRIPTION
-
-This check plugin rejects packages whose a current or newer revision already
-exists for current upload target.
-
-=cut
-
-use warnings;
-use strict;
-use Carp;
-use base qw/Youri::Submit::Check/;
-
-sub run {
- my ($self, $package, $repository, $target, $define) = @_;
- croak "Not a class method" unless ref $self;
-
- my @errors;
-
- my @revisions = $repository->get_revisions($package, $target, $define, undef, sub { return $_[0]->compare($package) >= 0 });
- if (@revisions) {
- push(
- @errors,
- "Current or newer revision(s) already exists for $target: " .
- join(', ', @revisions)
- );
- }
-
- return @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;
diff --git a/lib/Youri/Submit/Check/Rpmlint.pm b/lib/Youri/Submit/Check/Rpmlint.pm
deleted file mode 100644
index a38f2ba..0000000
--- a/lib/Youri/Submit/Check/Rpmlint.pm
+++ /dev/null
@@ -1,89 +0,0 @@
-# $Id$
-package Youri::Submit::Check::Rpmlint;
-
-=head1 NAME
-
-Youri::Submit::Check::Rpmlint - Rpmlint-based check
-
-=head1 DESCRIPTION
-
-This check plugin wraps rpmlint, and reject packages triggering results
-declared as fatal.
-
-=cut
-
-use warnings;
-use strict;
-use Carp;
-use base qw/Youri::Submit::Check/;
-
-=head2 new(%args)
-
-Creates and returns a new Youri::Submit::Check::Rpmlint object.
-
-Specific parameters:
-
-=over
-
-=item results $results
-
-List of rpmlint result id considered as fatal.
-
-=item path $path
-
-Path to the rpmlint executable (default: /usr/bin/rpmlint)
-
-=item config $config
-
-Specific rpmlint configuration.
-
-=back
-
-=cut
-
-
-sub _init {
- my $self = shift;
- my %options = (
- results => undef,
- path => '/usr/bin/rpmlint',
- config => '',
- @_
- );
-
- croak "no results to check" unless $options{results};
- croak "fatal should be an arrayref" unless ref $options{results} eq 'ARRAY';
-
- $self->{_config} = $options{config};
- $self->{_path} = $options{path};
- $self->{_pattern} = '^(?:' . join('|', @{$options{results}}) . ')$';
-}
-
-sub run {
- my ($self, $package, $repository, $target, $define) = @_;
- croak "Not a class method" unless ref $self;
-
- my @errors;
-
- my $command = "$self->{_path} -f $self->{_config} " . $package->as_file();
- open(RPMLINT, "$command |") or die "Can't run $command: $!";
- while (my $line = <RPMLINT>) {
- my ($id, $value) = $line =~ /^[EW]: \S+ (\S+)(.*)$/;
- $id or next;
- if ($id =~ /$self->{_pattern}/o) {
- push(@errors, "$id$value");
- }
- }
-
- return @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;
diff --git a/lib/Youri/Submit/Check/SVN.pm b/lib/Youri/Submit/Check/SVN.pm
deleted file mode 100644
index 10ab810..0000000
--- a/lib/Youri/Submit/Check/SVN.pm
+++ /dev/null
@@ -1,79 +0,0 @@
-# $Id$
-package Youri::Submit::Check::SVN;
-
-=head1 NAME
-
-Youri::Submit::Check::Tag - Incorrect tag values check
-
-=head1 DESCRIPTION
-
-This check plugin rejects packages with incorrect tag values, based on regular
-expressions.
-
-=cut
-
-use warnings;
-use strict;
-use Carp;
-use base qw/Youri::Submit::Check/;
-
-sub _init {
- my $self = shift;
- my %options = (
- svn => '',
- @_
- );
- $self->{_svn} = $options{svn};
-}
-
-sub run {
- my ($self, $package, $repository, $target, $define) = @_;
- croak "Not a class method" unless ref $self;
-
- my $section = $repository->_get_section($package, $target, $define);
- if ($section =~ /\/(testing|backport)$/) {
- # FIXME, right now ignore packages in SVN for testing and backports
- # we need to find a clean way to handle them
- return
- }
-
- $package->is_source or return;
- my $file = $package->get_file_name;
- my $srpm_name = $package->get_canonical_name;
- if ($repository->package_in_svn($srpm_name)) {
- if ($file !~ /(^|\/|$define->{prefix}_)@\d+:\Q$srpm_name/) {
- return "package $srpm_name is in the SVN, the uploaded SRPM must look like @<svn rev>:$srpm_name-<version>-<release>.src.rpm (created with getsrpm-mdk $srpm_name)";
- } else {
- print "Package $file is correct\n";
- }
- }
- return
-}
-
-sub simple_prompt {
- my $cred = shift;
- my $realm = shift;
- my $default_username = shift;
- my $may_save = shift;
- my $pool = shift;
-
- print "Enter authentication info for realm: $realm\n";
- print "Username: ";
- my $username = <>;
- chomp($username);
- $cred->username($username);
- print "Password: ";
- my $password = <>;
- chomp($password);
- $cred->password($password);
-}
-
-=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;
diff --git a/lib/Youri/Submit/Check/Section.pm b/lib/Youri/Submit/Check/Section.pm
deleted file mode 100644
index 4ff1675..0000000
--- a/lib/Youri/Submit/Check/Section.pm
+++ /dev/null
@@ -1,58 +0,0 @@
-# $Id: Precedence.pm 1707 2006-10-16 16:26:42Z warly $
-package Youri::Submit::Check::Section;
-
-=head1 NAME
-
-Youri::Submit::Check::Section - Check if package was submitted to the right section
-
-=head1 DESCRIPTION
-
-This check plugin rejects packages which were submitted to a section
-different than the one where an older version already exists.
-
-=cut
-
-use warnings;
-use strict;
-use Carp;
-use base qw/Youri::Submit::Check/;
-
-sub run {
- my ($self, $package, $repository, $target, $define) = @_;
- croak "Not a class method" unless ref $self;
-
- my @errors;
-
- my $submitted_main_section = $repository->_get_main_section($package, $target, $define);
-
- # undefine section, so that Repository::_get_section() of Mandriva_upload.pm
- # finds the section from existing packages
- my $defined_section = $define->{section};
- undef $define->{section};
-
- my $old_main_section = $repository->_get_main_section($package, $target, $define);
- my @older_revisions = $repository->get_older_revisions($package, $target, $define);
-
- # restore defined section
- $define->{section} = $defined_section;
-
- if (@older_revisions && $submitted_main_section ne $old_main_section) {
- push(
- @errors,
- "Section should be $old_main_section, not $submitted_main_section."
- );
- }
-
-
- return @errors;
-}
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright (C) 2007, Mandriva
-
-This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
-
-=cut
-
-1;
diff --git a/lib/Youri/Submit/Check/Source.pm b/lib/Youri/Submit/Check/Source.pm
deleted file mode 100644
index ab64e6c..0000000
--- a/lib/Youri/Submit/Check/Source.pm
+++ /dev/null
@@ -1,45 +0,0 @@
-# $Id$
-package Youri::Submit::Check::Source;
-
-=head1 NAME
-
-Youri::Submit::Check::Tag - Incorrect tag values check
-
-=head1 DESCRIPTION
-
-This check plugin rejects packages with incorrect tag values, based on regular
-expressions.
-
-=cut
-
-use warnings;
-use strict;
-use Carp;
-use base qw/Youri::Submit::Check/;
-
-sub _init {
- my $self = shift;
- my %options = (
- @_
- );
-}
-
-sub run {
- my ($self, $package, $repository, $target, $define) = @_;
- croak "Not a class method" unless ref $self;
- my $file = $package->as_file();
- if (!$package->is_source()) {
- return "Package $file is not a source rpm";
- }
- return
-}
-
-=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;
diff --git a/lib/Youri/Submit/Check/Tag.pm b/lib/Youri/Submit/Check/Tag.pm
deleted file mode 100644
index 3fadfa3..0000000
--- a/lib/Youri/Submit/Check/Tag.pm
+++ /dev/null
@@ -1,61 +0,0 @@
-# $Id$
-package Youri::Submit::Check::Tag;
-
-=head1 NAME
-
-Youri::Submit::Check::Tag - Incorrect tag values check
-
-=head1 DESCRIPTION
-
-This check plugin rejects packages with incorrect tag values, based on regular
-expressions.
-
-=cut
-
-use warnings;
-use strict;
-use Carp;
-use base qw/Youri::Submit::Check/;
-
-sub _init {
- my $self = shift;
- my %options = (
- tags => undef, # expected tag values
- @_
- );
-
- croak "no tags to check" unless $options{tags};
- croak "tag should be an hashref" unless ref $options{tags} eq 'HASH';
-
- $self->{_tags} = $options{tags};
-}
-
-sub run {
- my ($self, $package, $repository, $target, $define) = @_;
- croak "Not a class method" unless ref $self;
-
- my @errors;
-
- foreach my $tag (keys %{$self->{_tags}}) {
- my $value = $package->get_tag($tag);
- if ($value !~ /$self->{_tags}->{$tag}/) {
- push(
- @errors,
- "invalid value $value for tag $tag"
- );
- }
- }
-
- return @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;
diff --git a/lib/Youri/Submit/Check/Type.pm b/lib/Youri/Submit/Check/Type.pm
deleted file mode 100644
index 2c0be9b..0000000
--- a/lib/Youri/Submit/Check/Type.pm
+++ /dev/null
@@ -1,54 +0,0 @@
-# $Id$
-package Youri::Submit::Check::Type;
-
-=head1 NAME
-
-Youri::Submit::Check::Type - Type check
-
-=head1 DESCRIPTION
-
-This check plugin rejects packages with incorrect type.
-
-=cut
-
-use warnings;
-use strict;
-use Carp;
-use base qw/Youri::Submit::Check/;
-
-sub _init {
- my $self = shift;
- my %options = (
- type => undef, # expected type
- @_
- );
-
- croak "no type to check" unless $options{type};
- croak "invalid type value" unless $options{type} =~ /^(?:source|binary)$/;
-
- $self->{_type} = $options{type};
-}
-
-sub run {
- my ($self, $package, $repository, $target, $define) = @_;
- croak "Not a class method" unless ref $self;
-
- my @errors;
-
- my $type = $package->get_type();
- if ($type ne $self->{_type}) {
- push(@errors, "invalid type $type");
- }
-
- return @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;
diff --git a/lib/Youri/Submit/Check/Version.pm b/lib/Youri/Submit/Check/Version.pm
deleted file mode 100644
index 289ffe0..0000000
--- a/lib/Youri/Submit/Check/Version.pm
+++ /dev/null
@@ -1,100 +0,0 @@
-# $Id$
-package Youri::Submit::Check::Version;
-
-=head1 NAME
-
-Youri::Submit::Check::Version - Check if older version already exist in cooker (used in freeze period)
-
-=head1 DESCRIPTION
-
-This check plugin rejects new version of packages if they are not mentioned as authorized
-in the configuration file or in a non frozen section.
-
-=cut
-
-use warnings;
-use strict;
-use Carp;
-use URPM;
-use base qw/Youri::Submit::Check/;
-
-sub _init {
- my $self = shift;
- my %options = (
- @_
- );
-
- foreach my $target (keys %options) {
- $self->{$target} = $options{$target}
- }
-}
-
-sub run {
- my ($self, $package, $repository, $target, $define) = @_;
- croak "Not a class method" unless ref $self;
- my $opt = $self->{$target};
- return if $opt->{mode} eq 'normal';
- my $section = $repository->_get_section($package, $target, $define);
- my $name = $package->get_canonical_name;
- return if $name =~ /$opt->{authorized_packages}/;
- my $arch = $repository->get_arch($package, $target, $define);
- return if $arch =~ /$opt->{authorized_arches}/;
- if ($opt->{mode} eq 'version_freeze') {
- return if $section =~ /$opt->{authorized_sections}/;
- my $user = $define->{user};
- return if $user =~ /$opt->{authorized_users}/;
- my ($package_version) = $package =~ /-([^-]+)-[^-]+\.src$/;
- $define->{arch} = 'src';
- my @revisions = $repository->get_revisions($package, $target, $define, undef,
- sub {
- my ($version) = $_[0] =~ /-([^-]+)-[^-]+\.src$/;
- URPM::ranges_overlap("== $version", "< $package_version")
- }
- );
- $define->{arch} = '';
- if (@revisions) {
- return "FREEZE, package @revisions of different versions exist in $target\n";
- }
- }
- # FIXME: The following code is not working and must be reviewed.
- elsif ($opt->{mode} eq 'freeze') {
- # XXX: So freeze mode really only check for this exceptions?
- if ($section !~ /$opt->{authorized_sections}/) {
- return "FREEZE: repository $target section $section is frozen, you can still submit your packages in testing\nTo do so use your.devel --define section=<section> $target <package 1> <package 2> ... <package n>";
- }
- } else {
- # FIXME: Calls to get_source_package seems invalid nowadays.
- # This results on $source having a null content.
- my $source = $package->get_source_package;
- my ($package_version) = $source =~ /-([^-]+)-[^-]+\.src\.rpm$/;
- $define->{arch} = 'src';
- # FIXME: get_revisions now expects the filter as the 5th element, and not the 4th.
- my @revisions = $repository->get_revisions($package, $target, $define,
- sub {
- # FIXME: Calls to get_source_package seems invalid nowadays.
- # This results on $source_package having a null content.
- my $source_package = $_[0]->get_source_package;
- my ($version) = $source_package =~ /-([^-]+)-[^-]+\.src\.rpm$/;
- print STDERR "Found version $version\n";
- URPM::ranges_overlap("== $version", "< $package_version")
- }
- );
- $define->{arch} = '';
- if (@revisions) {
- return "FREEZE, package @revisions of different versions exist in $target\n";
- }
- }
- return
-}
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright (C) 2006, YOURI project
-Copyright (C) 2006, Mandriva
-
-This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
-
-=cut
-
-1;
-