aboutsummaryrefslogtreecommitdiffstats
path: root/lib/Youri/Upload
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Youri/Upload')
-rw-r--r--lib/Youri/Upload/Action.pm94
-rw-r--r--lib/Youri/Upload/Action/Archive.pm60
-rw-r--r--lib/Youri/Upload/Action/Bugzilla.pm81
-rw-r--r--lib/Youri/Upload/Action/CVS.pm135
-rw-r--r--lib/Youri/Upload/Action/Clean.pm40
-rw-r--r--lib/Youri/Upload/Action/Install.pm58
-rw-r--r--lib/Youri/Upload/Action/Link.pm63
-rw-r--r--lib/Youri/Upload/Action/Mail.pm115
-rw-r--r--lib/Youri/Upload/Action/RSS.pm102
-rw-r--r--lib/Youri/Upload/Action/Sign.pm56
-rw-r--r--lib/Youri/Upload/Check.pm107
-rw-r--r--lib/Youri/Upload/Check/History.pm56
-rw-r--r--lib/Youri/Upload/Check/Precedence.pm54
-rw-r--r--lib/Youri/Upload/Check/Recency.pm48
-rw-r--r--lib/Youri/Upload/Check/Tag.pm56
-rw-r--r--lib/Youri/Upload/Check/Type.pm53
16 files changed, 1178 insertions, 0 deletions
diff --git a/lib/Youri/Upload/Action.pm b/lib/Youri/Upload/Action.pm
new file mode 100644
index 0000000..e7908c4
--- /dev/null
+++ b/lib/Youri/Upload/Action.pm
@@ -0,0 +1,94 @@
+# $Id: Base.pm 631 2006-01-26 22:22:23Z guillomovitch $
+package Youri::Upload::Action;
+
+=head1 NAME
+
+Youri::Upload::Action - Abstract action plugin
+
+=head1 DESCRIPTION
+
+This abstract class defines action plugin interface.
+
+=cut
+
+use warnings;
+use strict;
+use Carp;
+
+=head1 CLASS METHODS
+
+=head2 new(%args)
+
+Creates and returns a new Youri::Upload::Action object.
+
+No generic parameters (subclasses may define additional ones).
+
+Warning: do not call directly, call subclass constructor instead.
+
+=cut
+
+sub new {
+ my $class = shift;
+ croak "Abstract class" if $class eq __PACKAGE__;
+
+ my %options = (
+ id => '', # object id
+ test => 0, # test mode
+ verbose => 0, # verbose mode
+ @_
+ );
+
+
+ my $self = bless {
+ _id => $options{id},
+ _test => $options{test},
+ _verbose => $options{verbose},
+ }, $class;
+
+ $self->_init(%options);
+
+ return $self;
+}
+
+sub _init {
+ # do nothing
+}
+
+=head1 INSTANCE METHODS
+
+=head2 get_id()
+
+Returns plugin identity.
+
+=cut
+
+sub get_id {
+ my ($self) = @_;
+ croak "Not a class method" unless ref $self;
+
+ return $self->{_id};
+}
+
+=head2 run($package, $repository, $target, $define)
+
+Execute action on given L<Youri::Package> object.
+
+=head1 SUBCLASSING
+
+The following methods have to be implemented:
+
+=over
+
+=item run
+
+=back
+
+=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/Upload/Action/Archive.pm b/lib/Youri/Upload/Action/Archive.pm
new file mode 100644
index 0000000..7bf397a
--- /dev/null
+++ b/lib/Youri/Upload/Action/Archive.pm
@@ -0,0 +1,60 @@
+# $Id: Archive.pm 867 2006-04-11 20:34:56Z guillomovitch $
+package Youri::Upload::Action::Archive;
+
+=head1 NAME
+
+Youri::Upload::Action::Archive - Old revisions archiving
+
+=head1 DESCRIPTION
+
+This action plugin ensures archiving of old package revisions.
+
+=cut
+
+use warnings;
+use strict;
+use Carp;
+use base qw/Youri::Upload::Action/;
+
+sub _init {
+ my $self = shift;
+ my %options = (
+ perms => 644,
+ @_
+ );
+
+ $self->{_perms} = $options{perms};
+}
+
+sub run {
+ my ($self, $package, $repository, $target, $define) = @_;
+ croak "Not a class method" unless ref $self;
+
+ foreach my $replaced_package (
+ $repository->get_replaced_packages($package, $target, $define)
+ ) {
+ my $file = $replaced_package->get_file();
+ my $dest = $repository->get_archive_dir($package, $target, $define);
+
+ print "archiving file $file to $dest\n" if $self->{_verbose};
+
+ unless ($self->{_test}) {
+ # create destination dir if needed
+ system("install -d -m " . ($self->{_perms} + 111) . " $dest")
+ unless -d $dest;
+
+ # install file to new location
+ system("install -m $self->{_perms} $file $dest");
+ }
+ }
+}
+
+=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/Upload/Action/Bugzilla.pm b/lib/Youri/Upload/Action/Bugzilla.pm
new file mode 100644
index 0000000..0f43e09
--- /dev/null
+++ b/lib/Youri/Upload/Action/Bugzilla.pm
@@ -0,0 +1,81 @@
+# $Id: Bugzilla.pm 867 2006-04-11 20:34:56Z guillomovitch $
+package Youri::Upload::Action::Bugzilla;
+
+=head1 NAME
+
+Youri::Upload::Action::Bugzilla - Bugzilla synchronisation
+
+=head1 DESCRIPTION
+
+This action plugin ensures synchronisation with Bugzilla.
+
+=cut
+
+use warnings;
+use strict;
+use Carp;
+use Youri::Bugzilla;
+use base qw/Youri::Upload::Action/;
+
+sub _init {
+ my $self = shift;
+ my %options = (
+ host => '',
+ base => '',
+ user => '',
+ pass => '',
+ contact => '',
+ @_
+ );
+
+ $self->{_bugzilla} = Youri::Bugzilla->new(
+ $options{host},
+ $options{base},
+ $options{user},
+ $options{pass}
+ );
+ $self->{_contact} = $options{contact};
+}
+
+sub run {
+ my ($self, $package, $repository, $target, $define) = @_;
+ croak "Not a class method" unless ref $self;
+
+ return unless $package->is_source();
+
+ my $name = $package->get_name();
+ my $version = $package->get_version();
+ my $summary = $package->get_summary();
+ my $packager = $package->get_packager();
+ $packager =~ s/.*<(.*)>/$1/;
+
+ if ($self->{_bugzilla}->has_package($name)) {
+ my %versions =
+ map { $_ => 1 }
+ $self->{_bugzilla}->get_versions($name);
+ unless ($versions{$version}) {
+ print "adding version $version to bugzilla\n" if $self->{_verbose};
+ $self->{_bugzilla}->add_version($name, $version)
+ unless $self->{_test};
+ }
+ } else {
+ print "adding package $name to bugzilla\n" if $self->{_verbose};
+ $self->{_bugzilla}->add_package(
+ $name,
+ $summary,
+ $version,
+ $packager,
+ $self->{_contact}
+ ) unless $self->{_test};
+ }
+}
+
+=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/Upload/Action/CVS.pm b/lib/Youri/Upload/Action/CVS.pm
new file mode 100644
index 0000000..6957e78
--- /dev/null
+++ b/lib/Youri/Upload/Action/CVS.pm
@@ -0,0 +1,135 @@
+# $Id: CVS.pm 867 2006-04-11 20:34:56Z guillomovitch $
+package Youri::Upload::Action::CVS;
+
+=head1 NAME
+
+Youri::Upload::Action::CVS - CVS versionning
+
+=head1 DESCRIPTION
+
+This action plugin ensures CVS versionning of package sources.
+
+=cut
+
+use warnings;
+use strict;
+use Carp;
+use Cwd;
+use File::Temp qw/tempdir/;
+use base qw/Youri::Upload::Action/;
+
+sub _init {
+ my $self = shift;
+ my %options = (
+ exclude => '\.(tar(\.(gz|bz2))?|zip)$',
+ perms => 644,
+ @_
+ );
+
+ $self->{_exclude} = $options{exclude};
+ $self->{_perms} = $options{perms};
+}
+
+sub run {
+ my ($self, $package, $repository, $target, $define) = @_;
+ croak "Not a class method" unless ref $self;
+
+ return unless $package->is_source();
+
+ my $name = $package->get_name();
+ my $version = $package->get_version();
+ my $release = $package->get_release();
+
+ my $root = $repository->get_version_root();
+ my $path = $repository->get_version_path($package, $target, $define);
+
+ # remember original directory
+ my $original_dir = cwd();
+
+ # get a safe temporary directory
+ my $dir = tempdir( CLEANUP => 1 );
+ chdir $dir;
+
+ # first checkout base directory only
+ system("cvs -Q -d $root co -l $path");
+
+ # try to checkout package directory
+ my $dest = $path . '/' . $name;
+ system("cvs -Q -d $root co $dest");
+
+ # create directory if previous import failed
+ unless (-d $dest) {
+ print "adding directory $dest\n" if $self->{_verbose};
+ system("install -d -m " . ($self->{_perms} + 111) . " $dest");
+ system("cvs -Q -d $root add $dest");
+ }
+
+ chdir $dest;
+
+ # remove all files
+ unlink grep { -f } glob '*';
+
+ # extract all rpm files locally
+ $package->extract();
+
+ # remove excluded files
+ if ($self->{_exclude}) {
+ unlink grep { -f && /$self->{_exclude}/ } glob '*';
+ }
+
+ # uncompress all compressed files
+ system("bunzip2 *.bz2 2>/dev/null");
+ system("gunzip *.gz 2>/dev/null");
+
+ my (@to_remove, @to_add, @to_add_binary);
+ foreach my $line (`cvs -nq update`) {
+ if ($line =~ /^\? (\S+)/) {
+ if (-B $1) {
+ push(@to_add_binary, $1);
+ } else {
+ push(@to_add, $1);
+ }
+ }
+ if ($line =~ /^U (\S+)/) {
+ push(@to_remove, $1);
+ }
+ }
+ if (@to_remove) {
+ my $to_remove = join(' ', @to_remove);
+ print "removing file(s) $to_remove\n" if $self->{_verbose};
+ system("cvs -Q remove $to_remove");
+ }
+ if (@to_add) {
+ my $to_add = join(' ', @to_add);
+ print "adding text file(s) $to_add\n" if $self->{_verbose};
+ system("cvs -Q add $to_add");
+ }
+ if (@to_add_binary) {
+ my $to_add_binary = join(' ', @to_add_binary);
+ print "adding binary file(s) $to_add_binary\n" if $self->{_verbose};
+ system("cvs -Q add -kb $to_add_binary");
+ }
+
+ print "committing current directory\n" if $self->{_verbose};
+ system("cvs -Q commit -m $version-$release") unless $self->{_test};
+
+ # tag new release
+ my $tag = "r$version-$release";
+ $tag =~ s/\./_/g;
+ print "tagging current directory as $tag\n" if $self->{_verbose};
+ system("cvs -Q tag $tag") unless $self->{_test};
+
+ # get back to original directory
+ chdir $original_dir;
+
+}
+
+=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/Upload/Action/Clean.pm b/lib/Youri/Upload/Action/Clean.pm
new file mode 100644
index 0000000..8564756
--- /dev/null
+++ b/lib/Youri/Upload/Action/Clean.pm
@@ -0,0 +1,40 @@
+# $Id: /local/youri/soft/trunk/lib/Youri/Upload/Action/Backup.pm 867 2006-01-29T20:47:27.830648Z guillaume $
+package Youri::Upload::Action::Clean;
+
+=head1 NAME
+
+Youri::Upload::Action::Clean - Old revisions cleanup
+
+=head1 DESCRIPTION
+
+This action plugin ensures cleanup of old package revisions.
+
+=cut
+
+use warnings;
+use strict;
+use Carp;
+use base qw/Youri::Upload::Action/;
+
+sub run {
+ my ($self, $package, $repository, $target, $define) = @_;
+ croak "Not a class method" unless ref $self;
+
+ foreach my $replaced_package (
+ $repository->get_replaced_packages($package, $target, $define)
+ ) {
+ my $file = $replaced_package->get_file();
+ print "deleting file $file\n" if $self->{_verbose};
+ unlink $file unless $self->{_test};
+ }
+}
+
+=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/Upload/Action/Install.pm b/lib/Youri/Upload/Action/Install.pm
new file mode 100644
index 0000000..56fc09c
--- /dev/null
+++ b/lib/Youri/Upload/Action/Install.pm
@@ -0,0 +1,58 @@
+# $Id: Install.pm 867 2006-04-11 20:34:56Z guillomovitch $
+package Youri::Upload::Action::Install;
+
+=head1 NAME
+
+Youri::Upload::Action::Install - Package installation
+
+=head1 DESCRIPTION
+
+This action plugin ensures installation of new package revisions.
+
+=cut
+
+use warnings;
+use strict;
+use Carp;
+use base qw/Youri::Upload::Action/;
+
+sub _init {
+ my $self = shift;
+ my %options = (
+ perms => 644,
+ @_
+ );
+
+ $self->{_perms} = $options{perms};
+
+ return $self;
+}
+
+sub run {
+ my ($self, $package, $repository, $target, $define) = @_;
+ croak "Not a class method" unless ref $self;
+
+ my $file = $package->get_file();
+ my $dest = $repository->get_install_dir($package, $target, $define);
+
+ print "installing file $file to $dest\n" if $self->{_verbose};
+
+ unless ($self->{_test}) {
+ # create destination dir if needed
+ system("install -d -m " . ($self->{_perms} + 111) . " $dest")
+ unless -d $dest;
+
+ # install file to new location
+ system("install -m $self->{_perms} $file $dest");
+ }
+}
+
+=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/Upload/Action/Link.pm b/lib/Youri/Upload/Action/Link.pm
new file mode 100644
index 0000000..eaadec1
--- /dev/null
+++ b/lib/Youri/Upload/Action/Link.pm
@@ -0,0 +1,63 @@
+# $Id: /local/youri/soft/trunk/lib/Youri/Upload/Action/Sign.pm 1543 2006-03-21T20:22:54.334939Z guillaume $
+package Youri::Upload::Action::Link;
+
+=head1 NAME
+
+Youri::Upload::Action::Link - Noarch packages linking
+
+=head1 DESCRIPTION
+
+This action plugin ensures linking of noarch packages between arch-specific
+directories.
+
+=cut
+
+use warnings;
+use strict;
+use Carp;
+use File::Spec;
+use base qw/Youri::Upload::Action/;
+
+sub _init {
+ my $self = shift;
+ my %options = (
+ symbolic => 0, # use symbolic linking
+ @_
+ );
+
+ $self->{_symbolic} = $options{symbolic};
+}
+
+sub run {
+ my ($self, $package, $repository, $target, $define) = @_;
+ croak "Not a class method" unless ref $self;
+
+ # only needed for noarch packages
+ return unless $package->get_arch() eq 'noarch';
+
+ my $dest_dir = $repository->get_install_dir($package, $target, $define);
+ my (undef, $parent_dir, $relative_dir) = File::Spec->splitpath($dest_dir);
+ my $file = $package->get_file_name();
+
+ foreach my $other_dir (grep { -d } <$parent_dir/*>) {
+ next if $other_dir eq $dest_dir;
+ chdir $other_dir;
+ my $source_file = "../$relative_dir/$file";
+ if ($self->{_symbolic}) {
+ symlink $source_file, $file unless $self->{_test};
+ } else {
+ link $source_file, $file unless $self->{_test};
+ }
+ chdir '..';
+ }
+}
+
+=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/Upload/Action/Mail.pm b/lib/Youri/Upload/Action/Mail.pm
new file mode 100644
index 0000000..c895ec7
--- /dev/null
+++ b/lib/Youri/Upload/Action/Mail.pm
@@ -0,0 +1,115 @@
+# $Id: Mail.pm 901 2006-04-21 21:35:10Z guillomovitch $
+package Youri::Upload::Action::Mail;
+
+=head1 NAME
+
+Youri::Upload::Action::Mail - Mail notification
+
+=head1 DESCRIPTION
+
+This action plugin ensures mail notification of new package revisions.
+
+=cut
+
+use warnings;
+use strict;
+use MIME::Entity;
+use Encode qw/from_to/;
+use Carp;
+use Youri::Package;
+use base qw/Youri::Upload::Action/;
+
+sub _init {
+ my $self = shift;
+ my %options = (
+ mta => '/usr/sbin/sendmail',
+ to => '',
+ from => '',
+ cc => '',
+ prefix => '',
+ encoding => 'quoted-printable',
+ charset => 'iso-8859-1',
+ @_
+ );
+
+ croak "undefined mail MTA" unless $options{mta};
+ croak "invalid mail MTA $options{mta}" unless -x $options{mta};
+ croak "undefined to" unless $options{to};
+ if ($options{cc}) {
+ croak "cc should be an hashref" unless ref $options{cc} eq 'HASH';
+ }
+ croak "invalid charset $options{charset}"
+ unless Encode::resolve_alias($options{charset});
+
+ $self->{_mta} = $options{mta};
+ $self->{_to} = $options{to};
+ $self->{_from} = $options{from};
+ $self->{_cc} = $options{cc};
+ $self->{_prefix} = $options{prefix};
+ $self->{_encoding} = $options{encoding};
+ $self->{_charset} = $options{charset};
+}
+
+sub run {
+ my ($self, $package, $repository, $target, $define) = @_;
+ croak "Not a class method" unless ref $self;
+
+ return unless $package->is_source();
+
+ my $from = $package->get_packager();
+
+ # force from adress if defined
+ $from =~ s/<.*>/<$self->{_from}>/ if $self->{_from};
+
+ my $subject =
+ ($self->{_prefix} ? '[' . $self->{_prefix} . '] ' : '' ) .
+ $package->get_revision_name();
+ my $information = $package->get_information();
+ my $last_change = $package->get_last_change();
+ my $content =
+ $information . "\n" .
+ $last_change->[Youri::Package::CHANGE_AUTHOR] . ":\n" .
+ join(
+ '', map { "- $_\n" } @{$last_change->[Youri::Package::CHANGE_TEXT]}
+ );
+
+ # ensure proper codeset conversion
+ # for informations coming from package
+ my $charset = $repository->get_package_charset();
+ from_to($content, $charset, $self->{_charset});
+ from_to($subject, $charset, $self->{_charset});
+
+ my $mail = MIME::Entity->build(
+ Type => 'text/plain',
+ Charset => $self->{_charset},
+ Encoding => $self->{_encoding},
+ From => $from,
+ To => $self->{_to},
+ Subject => $subject,
+ Data => $content,
+ );
+
+ if ($self->{_cc}) {
+ my $cc = $self->{_cc}->{$package->get_name()};
+ $mail->head()->add('cc', $cc) if $cc;
+ }
+
+ if ($self->{_test}) {
+ $mail->print(\*STDOUT);
+ } else {
+ open(MAIL, "| $self->{_mta} -t -oi -oem") or die "Can't open MTA program: $!";
+ $mail->print(\*MAIL);
+ close MAIL;
+ }
+
+}
+
+=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/Upload/Action/RSS.pm b/lib/Youri/Upload/Action/RSS.pm
new file mode 100644
index 0000000..2624199
--- /dev/null
+++ b/lib/Youri/Upload/Action/RSS.pm
@@ -0,0 +1,102 @@
+# $Id: RSS.pm 901 2006-04-21 21:35:10Z guillomovitch $
+package Youri::Upload::Action::RSS;
+
+=head1 NAME
+
+Youri::Upload::Action::RSS - RSS notification
+
+=head1 DESCRIPTION
+
+This action plugin ensures RSS notification of new package revisions.
+
+=cut
+
+use warnings;
+use strict;
+use XML::RSS;
+use Encode qw/from_to/;
+use Carp;
+use base qw/Youri::Upload::Action/;
+
+sub _init {
+ my $self = shift;
+ my %options = (
+ file => '',
+ title => '',
+ link => '',
+ description => '',
+ charset => 'iso-8859-1',
+ max_items => 10,
+ @_
+ );
+
+ croak "undefined rss file" unless $options{file};
+ croak "invalid charset $options{charset}"
+ unless Encode::resolve_alias($options{charset});
+
+ $self->{_file} = $options{file};
+ $self->{_title} = $options{title};
+ $self->{_link} = $options{link};
+ $self->{_description} = $options{description};
+ $self->{_charset} = $options{charset};
+ $self->{_max_items} = $options{max_items};
+}
+
+sub run {
+ my ($self, $package, $repository, $target, $define) = @_;
+ croak "Not a class method" unless ref $self;
+
+ return unless $package->is_source();
+
+ my $subject = $package->get_revision_name();
+ my $content = $package->get_information();
+
+ $content =~ s/$/<br\/>/mg;
+
+ # ensure proper codeset conversion
+ # for informations coming from package
+ my $charset = $repository->get_package_charset();
+ from_to($content, $charset, $self->{_charset});
+ from_to($subject, $charset, $self->{_charset});
+
+ my $rss = XML::RSS->new(
+ encoding => $self->{_charset},
+ encode_output => 1
+ );
+
+ my $file = $self->{_file};
+ if (-e $file) {
+ $rss->parsefile($file);
+ splice(@{$rss->{items}}, $self->{_max_items})
+ if @{$rss->{items}} >= $self->{_max_items};
+ } else {
+ $rss->channel(
+ title => $self->{_title},
+ link => $self->{_link},
+ description => $self->{_description},
+ language => 'en'
+ );
+ }
+
+ $rss->add_item(
+ title => $subject,
+ description => $content,
+ mode => 'insert'
+ );
+
+ if ($self->{_test}) {
+ print $rss->as_string();
+ } else {
+ $rss->save($file);
+ }
+}
+
+=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/Upload/Action/Sign.pm b/lib/Youri/Upload/Action/Sign.pm
new file mode 100644
index 0000000..468e3cc
--- /dev/null
+++ b/lib/Youri/Upload/Action/Sign.pm
@@ -0,0 +1,56 @@
+# $Id: Sign.pm 867 2006-04-11 20:34:56Z guillomovitch $
+package Youri::Upload::Action::Sign;
+
+=head1 NAME
+
+Youri::Upload::Action::Sign - GPG signature
+
+=head1 DESCRIPTION
+
+This action plugin ensures GPG signature of packages.
+
+=cut
+
+use warnings;
+use strict;
+use Carp;
+use base qw/Youri::Upload::Action/;
+
+sub _init {
+ my $self = shift;
+ my %options = (
+ name => '',
+ path => $ENV{HOME} . '/.gnupg',
+ passphrase => '',
+ @_
+ );
+
+ croak "undefined name" unless $options{name};
+ croak "undefined path" unless $options{path};
+ croak "invalid path $options{path}" unless -d $options{path};
+
+ $self->{_name} = $options{name};
+ $self->{_path} = $options{path};
+ $self->{_passphrase} = $options{passphrase};
+}
+
+sub run {
+ my ($self, $package, $repository, $target, $define) = @_;
+ croak "Not a class method" unless ref $self;
+
+ $package->sign(
+ $self->{_name},
+ $self->{_path},
+ $self->{_passphrase}
+ ) unless $self->{_test};
+}
+
+=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/Upload/Check.pm b/lib/Youri/Upload/Check.pm
new file mode 100644
index 0000000..312c4a6
--- /dev/null
+++ b/lib/Youri/Upload/Check.pm
@@ -0,0 +1,107 @@
+# $Id: Base.pm 631 2006-01-26 22:22:23Z guillomovitch $
+package Youri::Upload::Check;
+
+=head1 NAME
+
+Youri::Upload::Check - Abstract check plugin
+
+=head1 DESCRIPTION
+
+This abstract class defines check plugin interface.
+
+=cut
+
+use warnings;
+use strict;
+use Carp;
+
+=head1 CLASS METHODS
+
+=head2 new(%args)
+
+Creates and returns a new Youri::Upload::Check object.
+
+No generic parameters (subclasses may define additional ones).
+
+Warning: do not call directly, call subclass constructor instead.
+
+=cut
+
+sub new {
+ my $class = shift;
+ croak "Abstract class" if $class eq __PACKAGE__;
+
+ my %options = (
+ id => '', # object id
+ test => 0, # test mode
+ verbose => 0, # verbose mode
+ @_
+ );
+
+
+ my $self = bless {
+ _id => $options{id},
+ _test => $options{test},
+ _verbose => $options{verbose},
+ }, $class;
+
+ $self->_init(%options);
+
+ return $self;
+}
+
+sub _init {
+ # do nothing
+}
+
+=head1 INSTANCE METHODS
+
+=head2 get_id()
+
+Returns plugin identity.
+
+=cut
+
+sub get_id {
+ my ($self) = @_;
+ croak "Not a class method" unless ref $self;
+
+ return $self->{_id};
+}
+
+=head2 run($package, $repository, $target, $define)
+
+Check given L<Youri::Package> object, and returns success as a boolean.
+
+=head2 get_error()
+
+Returns exact error message if check failed.
+
+=cut
+
+sub get_error {
+ my ($self) = @_;
+ croak "Not a class method" unless ref $self;
+
+ return $self->{_error};
+}
+
+=head1 SUBCLASSING
+
+The following methods have to be implemented:
+
+=over
+
+=item run
+
+=back
+
+=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/Upload/Check/History.pm b/lib/Youri/Upload/Check/History.pm
new file mode 100644
index 0000000..81d65bd
--- /dev/null
+++ b/lib/Youri/Upload/Check/History.pm
@@ -0,0 +1,56 @@
+# $Id: History.pm 965 2006-07-27 09:38:18Z guillomovitch $
+package Youri::Upload::Check::History;
+
+=head1 NAME
+
+Youri::Upload::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::Upload::Check/;
+
+sub run {
+ my ($self, $package, $repository, $target, $define) = @_;
+ croak "Not a class method" unless ref $self;
+
+ 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 1
+ 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}) {
+ $self->{_error} = "Last changelog entry $last_revision_number from last revision " . $last_revision->get_full_name() . " missing from current changelog";
+ return 0;
+ }
+ }
+
+ return 1;
+}
+
+=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/Upload/Check/Precedence.pm b/lib/Youri/Upload/Check/Precedence.pm
new file mode 100644
index 0000000..b03c2ad
--- /dev/null
+++ b/lib/Youri/Upload/Check/Precedence.pm
@@ -0,0 +1,54 @@
+# $Id: Precedence.pm 873 2006-04-15 17:04:27Z guillomovitch $
+package Youri::Upload::Check::Precedence;
+
+=head1 NAME
+
+Youri::Upload::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::Upload::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 @older_revisions =
+ $repository->get_older_revisions($package, $self->{_target}, $define);
+ if (@older_revisions) {
+ $self->{_error} = "Older revisions still exists for $self->{_target}: " . join(', ', @older_revisions);
+ return 0;
+ }
+
+ return 1;
+}
+
+=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/Upload/Check/Recency.pm b/lib/Youri/Upload/Check/Recency.pm
new file mode 100644
index 0000000..d6fc920
--- /dev/null
+++ b/lib/Youri/Upload/Check/Recency.pm
@@ -0,0 +1,48 @@
+# $Id: Recency.pm 873 2006-04-15 17:04:27Z guillomovitch $
+package Youri::Upload::Check::Recency;
+
+=head1 NAME
+
+Youri::Upload::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::Upload::Check/;
+
+sub run {
+ my ($self, $package, $repository, $target, $define) = @_;
+ croak "Not a class method" unless ref $self;
+
+ my $file = $repository->get_install_file($package, $target, $define);
+ if (-f $file) {
+ $self->{_error} = "Current revision already exists for $target";
+ return 0;
+ }
+
+ my @newer_revisions =
+ $repository->get_newer_revisions($package, $target, $define);
+ if (@newer_revisions) {
+ $self->{_error} = "Newer revisions already exists for $target: " . join(', ', @newer_revisions);
+ return 0;
+ }
+
+ return 1;
+}
+
+=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/Upload/Check/Tag.pm b/lib/Youri/Upload/Check/Tag.pm
new file mode 100644
index 0000000..ef89ff6
--- /dev/null
+++ b/lib/Youri/Upload/Check/Tag.pm
@@ -0,0 +1,56 @@
+# $Id: Tag.pm 867 2006-04-11 20:34:56Z guillomovitch $
+package Youri::Upload::Check::Tag;
+
+=head1 NAME
+
+Youri::Upload::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::Upload::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;
+
+ foreach my $tag (keys %{$self->{_tags}}) {
+ my $value = $package->get_tag($tag);
+ if ($value !~ /$self->{_tags}->{$tag}/) {
+ $self->{_error} = "invalid value $value for tag $tag";
+ return 0;
+ }
+ }
+
+ return 1;
+}
+
+=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/Upload/Check/Type.pm b/lib/Youri/Upload/Check/Type.pm
new file mode 100644
index 0000000..e03fa80
--- /dev/null
+++ b/lib/Youri/Upload/Check/Type.pm
@@ -0,0 +1,53 @@
+# $Id: /local/youri/soft/trunk/lib/Youri/Upload/Check/Tag.pm 1642 2006-03-29T06:49:43.840267Z guillaume $
+package Youri::Upload::Check::Type;
+
+=head1 NAME
+
+Youri::Upload::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::Upload::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 $type = $package->get_type();
+ if ($type ne $self->{_type}) {
+ $self->{_error} = "invalid type $type";
+ return 0;
+ }
+
+ return 1;
+}
+
+=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;
generated by cgit v1.2.1 (git 2.21.0) at 2024-08-30 18:51:20 +0000