# author: jamadam
# version:1.0.2
# updated: 2009-6-23
# updated: 2009-5-29
# updated: 2008-4-17
# created: 2006-9-28

use strict;
use warnings;
use utf8;
use English;
use Getopt::Long;
use File::stat;
use File::Copy;
use File::Path;

binmode(STDIN,	":utf8");
binmode(STDOUT,	":utf8");
binmode(STDERR,	":utf8");
use open IO  =>	":utf8";

use vars qw(%QUERY %stat_idx); # 設定
use vars qw($log $copy_count $file_count $symlink_count); # ログ関係変数
use vars qw($tgt_path $newdir $olddir); # ディレクトリ

main();

sub main {
    %stat_idx = ('mode' => 2, 'size' => 7, 'utime' => 9);
    
    %QUERY = ('mode' => 1, 'size' => 1, 'utime' => 1);
    GetOptions(\%QUERY, 'mode=s', 'size=s', 'utime=s');
    
    ### 引数の整備と検証
    $ARGV[0] = &fixPath($ARGV[0]);
    $ARGV[1] = &fixPath($ARGV[1]);
    -d $ARGV[0] or die "$ARGV[0] not found";
    -d $ARGV[1] or die "$ARGV[1] not found";
    
    ### 引数を分離
    ($tgt_path, my $tgt_dir) = ($ARGV[0] =~ m!(.*)?/([^/]+)$!);
    
    ### 前回バックアップの時刻ディレクトリ名を取得
    if (opendir(DIR, "$ARGV[1]")) {
        my @dirs = sort grep{ -d "$ARGV[1]/$_" && /^[^.]/} readdir( DIR );
        close(DIR);
        $olddir = "$ARGV[1]/". (pop(@dirs) or '');
    }
    
    ### 時刻ディレクトリの作成
    my ($sec, $min, $hour, $mday, $mon, $year) = localtime($BASETIME);
    my $new_time =
        sprintf('%04d%02d%02d%02d%02d%02d', $year+1900, $mon+1, $mday, $hour, $min, $sec);
    $newdir = "$ARGV[1]/$new_time~";
    umask 0;
    mkdir($newdir, 0755) or die "cannnot make $newdir";
    
    ### ログファイル生成
    open($log, ">>$newdir/ddumplog.txt") or die "cannnot make log file";
    print $log <<EOF;
-----------------------------------------------------------------
-- ddump -- $new_time
-----------------------------------------------------------------
EOF
    
    ### ログ記録用変数
    $copy_count = 0;
    $file_count = 0;
    $symlink_count = 0;
    
    ### バックアップ
    &backup($tgt_dir);
    
    ### ログファイルに結果出力
    print $log "$copy_count/$symlink_count/$file_count (Copyed/symlink/Total)\n";
    print $log (time() - $BASETIME). "sec passed\n";
    close($log);
    
    if (! $copy_count) {
        ### コピーなしならディレクトリ削除
        rmtree($newdir);
    } else {
        ### ファイル名確定
        rename($newdir, substr($newdir, 0 ,length($newdir) - 1));
    }
}

### --------------------------------------------
### 再帰的ディレクトリバックアップ
### --------------------------------------------
sub backup {

	my $cwd = shift;
	my $tgt_cwd = "$tgt_path/$cwd";
	my $old_cwd = "$olddir/$cwd";
	my $new_cwd = "$newdir/$cwd";

	### ディレクトリの作成
	&copydirstat($tgt_cwd, "/$new_cwd");

	### カレントディレクトリ内の全ファイルを配列に格納
	opendir(DIR, $tgt_cwd) or return 0;
	my @files_and_dirs = readdir(DIR);
	close(DIR);

	my @files = grep { -f "$tgt_cwd/$_" or -l "$tgt_cwd/$_" } @files_and_dirs;
    
	### @files_and_dirsのうち、ファイルを処理
	foreach my $a_file (@files) {
		my $old_file = "$old_cwd/$a_file";
		my $new_file = "$new_cwd/$a_file";
		my $tgt_file = "$tgt_cwd/$a_file";
		my $command = 1; # 0: nothing, 1: hard link 2: copy

		if (-l $tgt_file) {
			symlink(readlink($tgt_file), $new_file);
			$symlink_count++;
			$command = 0;
		}

		elsif (-f $old_file) {
			my $old_stat	= stat($old_file);
			my $crnt_stat	= stat($tgt_file);

			### 更新ありならコピー
			foreach my $key (keys %stat_idx) {
				if ($QUERY{$key} and
					$old_stat->[$stat_idx{$key}] ne $crnt_stat->[$stat_idx{$key}]) {

					$command = 2;
					last;
				}
			}
		} else { ### ファイルがなければコピー
			$command = 2;
		}

		### コピー
		if ($command == 2) {
			copystat($tgt_file, $new_file);

			$copy_count++;

			### ログ出力
			utf8::decode($new_file);
			print $log "$new_file\n";
		}

		### ハードリンク
		elsif ($command == 1) {
			link($old_file, $new_file);
		}

		$file_count++;
	}

	### @files_and_dirsのうち、ディレクトリを再帰処理
	my @dirs = grep { -d "$tgt_cwd/$_"
					and not -l "$tgt_cwd/$_"
					and $_ ne '.'
					and $_ ne '..' } @files_and_dirs;

	foreach my $a_dir (@dirs) {
		&backup("$cwd/$a_dir") or print "Error at $cwd/$a_dir\n";
	}

	return 1;
}

### --------------------------------------------
### 属性丸ごとファイルコピー
### --------------------------------------------
sub copystat {
	my ($from, $to) = @_;
	my $stat = stat $from;

	copy($from, $to);
	chown($stat->uid, $stat->gid, $to) if $EUID == 0;
	chmod($stat->mode, $to);
	utime($stat->mtime, $stat->mtime, $to);
}

### --------------------------------------------
### 属性真似てディレクトリ作成
### --------------------------------------------
sub copydirstat {

	my ($from, $to) = @_;
	my $stat = stat $from;

	mkdir $to, 0555;
	chown ($stat->uid, $stat->gid, $to) if $EUID == 0;
	chmod ($stat->mode, $to);
	utime ($stat->mtime, $stat->mtime, $to);
}

### --------------------------------------------
### ファイルパスの整備
### --------------------------------------------
sub fixPath {
	my $in = $_[0];
	$in =~ s!^!\./! unless ($in =~ m!^\.*/!);
	$in =~ s!/$!!;
	return $in;
}


__END__

=head1 NAME

ddump - 日々の差分バックアップ

=head1 DESCRIPTION

このスクリプトは、対象ディレクトリ構造の完全にバックアップします。前回のバックアップとの差分のみをコピーし、残りを前回ファイルへのハードリンクとすることで、ディスクスペースと時間の削減を実現します。

このスクリプトはpdumpfsやglastreeとよく似ています。主な相違点は、バックアップの管理が日付に依存しないため任意の頻度で実行できる点、差分ファイルのログを残す点です。

=head1 SYNOPSIS

    perl ddump.pl [バックアップ対象] [保存場所]

	バックアップディレクトリ名
	yyyymmddhhmmss

=head1 ARGUMENT

    mode=[01]
    パーミッションの変化を検出するかどうかを指定します。1の場合、変化した場合は差分としてコピーします。デフォルトは1です。
    size=[01]
    サイズの変化を検出するかどうかを指定します。1の場合、変化した場合は差分としてコピーします。デフォルトは1です。
    utime=[01]
    更新日付の変化を検出するかどうかを指定します。1の場合、変化した場合は差分としてコピーします。デフォルトは1です。

=head1 EXAMPLE

	perl ddump.pl ./data ./backup

=head1 AUTHOR

jamadam

=head1 SEE ALSO

=cut