git.infodrom.org Git - infodrom/mirrordir/blob - src/mirrordir

   1 #! /usr/bin/perl
   2
   3 #   Copyright (c) 2016  Joey Schulze <joey@infodrom.org>
   4 #
   5 #   This program is free software; you can redistribute it and/or modify
   6 #   it under the terms of the GNU General Public License as published by
   7 #   the Free Software Foundation; either version 2 of the License, or
   8 #   (at your option) any later version.
   9 #
  10 #   This program is distributed in the hope that it will be useful,
  11 #   but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 #   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 #   GNU General Public License for more details.
  14 #
  15 #   You should have received a copy of the GNU General Public License
  16 #   along with this program; if not, write to the Free Software
  17 #   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA
  18
  19 use strict;
  20 use warnings;
  21
  22 use File::Copy;
  23 use File::Path;
  24 use File::DirCompare;
  25 use Getopt::Long;
  26
  27 my $opt_dry_run;
  28 my $opt_verbose;
  29 my $opt_source;
  30 my $opt_destination;
  31
  32 my @mirrordirs;
  33
  34 sub help
  35 {
  36     print <<EOT;
  37 mirrordir options sourcdir destdir
  38
  39 Options
  40 --help|-h         This help
  41 --verbose|-v      Verbose output
  42 --dry-run         Don\'t actually mirror
  43
  44 EOT
  45     exit;
  46 }
  47
  48 sub assert_directory
  49 {
  50     my $dir = shift;
  51     return 1 if -d $dir;
  52
  53     mkpath $dir;
  54 }
  55
  56 sub copy_file
  57 {
  58     my $src = shift;
  59     my $dst = shift;
  60
  61     return unless -f $src;
  62
  63     my $pos = rindex $dst, '/';
  64     assert_directory substr $dst, 0, $pos if $pos > 1;
  65
  66     if (!copy $src, $dst) {
  67         printf STDERR "copy %s %s failed\n", $src, $dst;
  68         return;
  69     }
  70
  71     my @stat_src = stat $src;
  72     my @stat_dst = stat $dst;
  73
  74     if ($stat_src[7] != $stat_dst[7]) {
  75         printf STDERR "copy %s %s failed (size mismatch)\n", $src, $dst;
  76         return;
  77     }
  78
  79     utime $stat_src[9], $stat_src[9], $dst;
  80 }
  81
  82 sub compare_process_item
  83 {
  84     my $a = shift;
  85     my $b = shift;
  86
  87     if (! $b) {
  88         my $dst = $opt_destination . substr($a, length $opt_source);
  89
  90         if (-d $a) {
  91             printf "mirror %s %s\n", $a, $dst if $opt_verbose;
  92             push @mirrordirs, [$a, $dst] unless $opt_dry_run;
  93         } else {
  94             printf "copy %s %s\n", $a, $dst if $opt_verbose;
  95             copy_file $a, $dst unless $opt_dry_run;
  96         }
  97     } elsif (! $a) {
  98         if (-d $b) {
  99             printf "rmdir %s\n", $b if $opt_verbose;
 100             rmtree $b unless $opt_dry_run;
 101         } else {
 102             printf "delete %s\n", $b if $opt_verbose;
 103             unlink $b unless $opt_dry_run;
 104         }
 105     } else {
 106         if (-f $a && -f $b) {
 107             printf "copy %s %s\n", $a, $b if $opt_verbose;
 108             copy_file $a, $b unless $opt_dry_run;
 109         } elsif (-d $b) {
 110             printf "rmdir %s\n", $b if $opt_verbose;
 111             rmtree $b unless $opt_dry_run;
 112
 113             printf "copy %s %s\n", $a, $b if $opt_verbose;
 114             copy_file $a, $b unless $opt_dry_run;
 115         } elsif (-d $a) {
 116             printf "delete %s\n", $b if $opt_verbose;
 117             unlink $b unless $opt_dry_run;
 118
 119             my $pos = rindex $b, '/';
 120             my $relpath = substr($b, $pos);
 121             printf "mirror %s %s\n", $opt_source.$relpath, $opt_destination.$relpath if $opt_verbose;
 122             push @mirrordirs, [$opt_source.$relpath, $opt_destination.$relpath] unless $opt_dry_run;
 123         }
 124     }
 125 }
 126
 127 sub mirror_directory
 128 {
 129     File::DirCompare->compare($opt_source, $opt_destination, \&compare_process_item);
 130 }
 131
 132 sub mirror_directories
 133 {
 134     mirror_directory;
 135
 136     while (my $item = shift @mirrordirs) {
 137         $opt_source = $item->[0];
 138         $opt_destination = $item->[1];
 139         mirror_directory;
 140     }
 141 }
 142
 143 GetOptions (
 144     'help|h' => \&help,
 145     'verbose|v' => \$opt_verbose,
 146     'dry-run|dryrun' => \$opt_dry_run,
 147 );
 148
 149 die "Not enough parameters\n" unless scalar @ARGV == 2;
 150
 151 $| = 1;
 152
 153 $opt_source = $ARGV[0];
 154 $opt_destination = $ARGV[1];
 155
 156 mirror_directories;