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
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
|
# $Id: /youri.mdv/trunk/lib/Youri/Upload/Action/Archive.pm 975 2006-08-05T08:30:57.188281Z warly $
package Youri::Upload::Pre::Rsync;
=head1 NAME
Youri::Upload::Pre::Rsync - 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::Pre/;
sub _init {
my $self = shift;
my %options = (
user => '',
host => '',
source => '',
destination => '',
@_
);
foreach my $var ('user', 'host', 'source', 'destination') {
$self->{"_$var"} = $options{$var};
}
}
sub run {
my ($self, $pre_packages, $repository, $target, $define) = @_;
croak "Not a class method" unless ref $self;
if (system("rsync --remove-sent-files -avlPHe 'ssh -xc arcfour' $self->{_user}\@$self->{_host}:$self->{_source}/$target/ $self->{_destination}/$target/")) {
$self->{_error} = "Rsync command failed ($!)";
return
}
my $queue = "$self->{_destination}/$target";
$self->{_error} = "Reading queue directory failed";
# now get the packages downloaded
my %packages;
opendir my $queuedh, "$self->{_destination}/$target/" or return;
opendir my $targetdh, $queue or return;
my $idx;
foreach my $media (readdir $targetdh) {
$media =~ /^\.{1,2}$/ and next;
print "$target - $media\n";
if (-d "$queue/$media") {
opendir my $submediadh, "$queue/$media" or return;
foreach my $submedia (readdir $submediadh) {
$submedia =~ /^\.{1,2}$/ and next;
print "$target - $media - $submedia\n";
opendir my $rpmdh, "$queue/$media/$submedia" or return;
foreach my $rpm (readdir $rpmdh) {
$rpm =~ /^\.{1,2}$/ and next;
print "$target - $media - $submedia : $rpm\n";
if ($rpm =~ /^(\d{14}\.\w+\.\w+\.\d+)_.*\.\.rpm$/) {
push @{$packages{$1}{rpms}}, { section => "$media/$submedia", file => "$queue/$media/$submedia/$rpm" };
} elsif ($rpm =~ /\.rpm$/) {
$idx++;
push @{$packages{"independant_$idx"}{rpms}}, { section => "$media/$submedia", file => "$queue/$media/$submedia/$rpm" }
}
}
}
}
}
foreach my $key (keys %packages) {
push @$pre_packages, $packages{$key}{rpms}
}
1
}
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2002-2006, Mandriva <warly@mandriva.com>
This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
=cut
1;
|
