prepare mergetopic/mdv-to-merge

13 files changed, 825 insertions, 0 deletions

diff --git a/lib/Youri/Submit/Test/ACL.pm b/lib/Youri/Submit/Test/ACL.pm
new file mode 100644
index 0000000..34bf48a
--- /dev/null
+++ b/lib/Youri/Submit/Test/ACL.pm
@@ -0,0 +1,71 @@
+# $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/Test/History.pm b/lib/Youri/Submit/Test/History.pm
new file mode 100644
index 0000000..326f2f1
--- /dev/null
+++ b/lib/Youri/Submit/Test/History.pm
@@ -0,0 +1,61 @@
+# $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/Test/Host.pm b/lib/Youri/Submit/Test/Host.pm
new file mode 100644
index 0000000..b2b392a
--- /dev/null
+++ b/lib/Youri/Submit/Test/Host.pm
@@ -0,0 +1,63 @@
+# $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/Test/Precedence.pm b/lib/Youri/Submit/Test/Precedence.pm
new file mode 100644
index 0000000..c73446b
--- /dev/null
+++ b/lib/Youri/Submit/Test/Precedence.pm
@@ -0,0 +1,58 @@
+# $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/Test/Queue_recency.pm b/lib/Youri/Submit/Test/Queue_recency.pm
new file mode 100644
index 0000000..42c4f42
--- /dev/null
+++ b/lib/Youri/Submit/Test/Queue_recency.pm
@@ -0,0 +1,40 @@
+# $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/Test/Recency.pm b/lib/Youri/Submit/Test/Recency.pm
new file mode 100644
index 0000000..f8aa5b7
--- /dev/null
+++ b/lib/Youri/Submit/Test/Recency.pm
@@ -0,0 +1,46 @@
+# $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/Test/Rpmlint.pm b/lib/Youri/Submit/Test/Rpmlint.pm
new file mode 100644
index 0000000..a38f2ba
--- /dev/null
+++ b/lib/Youri/Submit/Test/Rpmlint.pm
@@ -0,0 +1,89 @@
+# $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/Test/SVN.pm b/lib/Youri/Submit/Test/SVN.pm
new file mode 100644
index 0000000..10ab810
--- /dev/null
+++ b/lib/Youri/Submit/Test/SVN.pm
@@ -0,0 +1,79 @@
+# $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/Test/Section.pm b/lib/Youri/Submit/Test/Section.pm
new file mode 100644
index 0000000..4ff1675
--- /dev/null
+++ b/lib/Youri/Submit/Test/Section.pm
@@ -0,0 +1,58 @@
+# $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/Test/Source.pm b/lib/Youri/Submit/Test/Source.pm
new file mode 100644
index 0000000..ab64e6c
--- /dev/null
+++ b/lib/Youri/Submit/Test/Source.pm
@@ -0,0 +1,45 @@
+# $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/Test/Tag.pm b/lib/Youri/Submit/Test/Tag.pm
new file mode 100644
index 0000000..3fadfa3
--- /dev/null
+++ b/lib/Youri/Submit/Test/Tag.pm
@@ -0,0 +1,61 @@
+# $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/Test/Type.pm b/lib/Youri/Submit/Test/Type.pm
new file mode 100644
index 0000000..2c0be9b
--- /dev/null
+++ b/lib/Youri/Submit/Test/Type.pm
@@ -0,0 +1,54 @@
+# $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/Test/Version.pm b/lib/Youri/Submit/Test/Version.pm
new file mode 100644
index 0000000..289ffe0
--- /dev/null
+++ b/lib/Youri/Submit/Test/Version.pm
@@ -0,0 +1,100 @@
+# $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;
+