# $Id: Archive.pm 1689 2007-06-28 22:44:24Z guillomovitch $ package Youri::Submit::Action::Archive; =head1 NAME Youri::Submit::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::Submit::Step/; sub _init { my $self = shift; my %options = ( perms => 644, @_ ); $self->{_perms} = $options{perms}; } sub process_packages { my ($self, $packages, $repository, $target, $context) = @_; croak "Not a class method" unless ref $self; foreach my $package (@$packages) { foreach my $replaced_package ( $repository->get_replaced_packages($package, $target, $context) ) { my $file = $replaced_package->as_file(); my $dest = $repository->get_archive_dir($package, $target, $context); print "archiving file $file to $dest\n" if $self->{_verbose}; unless ($self->{_test}) { # create destination dir if needed if (! -d $dest) { eval { mkpath($dest, 0, ($self->{_perms} + 111)); }; if ($@) { croak "Unable to create directory $dest: $@"; } } # copy file to new location copy($file, $dest) or croak "Unable to copy file $file to $dest: $!"; # set permissions chmod oct($self->{_perms}), $dest . '/' . basename($file) or croak "Unable to set perms of file $file to $self->{_perms}: $!"; } } } } =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;