fork-distribution


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

#!/bin/env perl

# $Id$

use strict;
use warnings;
use Pod::Usage;
use Getopt::Long;
use MDV::Distribconf;
use Cwd;

GetOptions(
) or pod2usage(1);

my ($source,$dest) = @ARGV;

$dest or do {
    warn "No dest given";
    pod2usage(1);
};

# Constant:

{
    my @distribdir = find_distrib($source);
    warn join(' ', @distribdir);
    fork_tree($source, $dest);
}

sub find_distrib {
    my ($topdir) = @_;
    my @distpath;
    if (opendir(my $handle, $topdir)) {
        while (my $subdir = readdir($handle)) {
            $subdir eq '..' and next;
            my $d = MDV::Distribconf->new("$topdir/$subdir");
            if ($d->load){
                push(@distpath, $subdir);
            }
        }
        closedir($handle)
    } else {
        die "Cannot open $topdir: $!";
    }
    return @distpath;
}

sub fork_tree {
    my ($source, $dest) = @_;

    my $abs_source = Cwd::abs_path($source) || $source;
    my $abs_dest   = Cwd::abs_path($dest) || $dest;

    my @basecmd = (qw(rsync -avPHS), ("$abs_source/"), ("$abs_dest/"));
    my @cmd;

    @cmd = (@basecmd, qw(--exclude *.rpm));
    system(@cmd);
    @cmd = (@basecmd, '--link-dest', "$abs_source/");
    system(@cmd);
}