#!/usr/bin/perl

#
# glastree -- build dated, versioned tree of sourcedir, usually per diem
#
#  Jeremy Wohl (http://igmus.org/code)
#  Public domain; no warranty, no responsibility, etc.
#
#

require 5.004;

use English;
use Getopt::Long;
use DirHandle;
use File::Copy;
use File::stat;
use Cwd qw(getcwd);
use Date::Calc qw(Today Add_Delta_Days);
use strict;

# some globals & option vars
use vars qw/ $source $target $today $yesterday @prunedirs /;

use vars qw/ $opt_usehourminute $opt_today $opt_yesterday /;
use vars qw/ $opt_help $opt_version /;

my $version = "glastree v1.05 stable, http://igmus.org\n";

main();

sub main
{
    #
    # handle options
    #

    GetOptions('today=s', 'yesterday=s', 'version', 'help'); #, 'usehourminute!');
    
    if ($opt_version)  { print STDERR $version; exit 1; }

    if ($opt_help or not @ARGV or scalar @ARGV != 2)
    {
        print STDERR "usage: glastree [options] sourcedir backupdir\n\n";
        print STDERR "options:\n";
        #print STDERR "  --usehourminute      Use hour/minute in directory names, suppress per diem\n";
        print STDERR "  --today=path         Use path instead of today's date (YYYYMM/DD)\n";
        print STDERR "  --yesterday=path     Use path instead of yesterday's date (YYYYMM/DD)\n";
        print STDERR "  --version            Display version and exit\n";
        print STDERR "  --help               Display this message and exit\n";
        exit 1;
    }

    $source = $ARGV [0];
    $target = $ARGV [1];

    if (not defined $opt_today) {
        $today = sprintf "%4d%02d/%02d", Today();
    } else {
        $today = $opt_today;

        die "fatal: manually set 'today' parameter is not valid YYYYMM/DD"
            if $today !~ m!^\d{6}/\d\d$!;
    }

    if (not defined $opt_yesterday) {
        $yesterday = findyesterday($target);
    } else {
        $yesterday = $opt_yesterday;

        die "fatal: manually set 'yesterday' parameter is not valid YYYYMM/DD"
            if $yesterday !~ m!^\d{6}/\d\d$!;
    }

    #
    # make basic checks
    #
    
    my ($ym) = $today =~ /^(\d{6})/;

    die "fatal: $target or $source does not exist"                if not -e $target or not -e $source;
    die "fatal: $target or $source is not a directory"            if not -d $target or not -d $source;
    die "fatal: you do not have read permission in $source"       if not -r $source;
    die "fatal: you do not have write permission in $target"      if not -w $target;
    die "fatal: you do not have write permission in $target/$ym"  if     -e "$target/$ym" and not -w "$target/$ym";
    die "fatal: backupdir is the same as sourcedir"               if $target eq $source;

    #
    # get to it
    #

    rmkdir(cleanpath("$target/$today"));

    recurse($source);
}


sub recurse
{
    my ($cwd) = shift;
    my ($dir, @list, @dirs, @files);
    my ($file, $num);
    my ($now_stat, $yes_stat);


    mkdirstat("$target/$today", $cwd);
    
    return if ($dir = new DirHandle($cwd)) == undef;

    @list  = $dir->read;
    @dirs  = grep { -d "$cwd/$_" and not -l "$cwd/$_" and $_ ne '.' and $_ ne '..' } @list;
    @files = grep { -f "$cwd/$_" or      -l "$cwd/$_" } @list;
    undef $dir;

    # for all files in the source tree
    #   if the file is a link, make the link
    #   else if the file is a dir, make the dir
    #   else if the file is a normal file
    #     if yesterday does not exist or today is newer, copy the file
    #     else hard link the file to yesterday
    #   else: no logic to handle file type
    # end

    foreach $file (@files)
    {
        my $new_path       = "$cwd/$file";
        my $today_path     = "$target/$today/$cwd/$file";
        my $yesterday_path = "$target/$yesterday/$cwd/$file";

        if (-l $new_path) {
            symlink(readlink($new_path), $today_path);
        }

        elsif (-f $new_path)
        {
            my $new_stat       = stat $new_path;
            my $yesterday_stat = stat $yesterday_path;

            if (not defined($yesterday_stat)
                or $new_stat->mtime != $yesterday_stat->mtime
                or $new_stat->size  != $yesterday_stat->size)
            {
                copystat($new_path, $today_path, $new_stat);
            }
            else {
                link($yesterday_path, $today_path);
            }
        }	    

        else {
            print STDERR "warning: no logic to handle $cwd/$file; skipping\n";
        }
    }

    foreach (@dirs) { recurse("$cwd/$_"); }
}


#
# Make path (recursively, if necessary) $prefix/$path, with $path owner/perms/mtime
#  if $path == undef, we set perms as user-only
#
sub mkdirstat
{
    my ($prefix, $path) = @_;
    my ($piece, $olddir, $newdir, $fulldir, $stat);

    foreach $piece (split '/', $path)
    {
        $olddir .= ($piece eq "" ? "/" : "") . $piece . "/";
        $newdir .= $piece . "/";
        $fulldir = "$prefix/$newdir";

        if (not -e $fulldir)
        {
            $stat = stat $olddir;

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


#
# Copy $frompath to $topath, with $stat owner/perms/mtime
#
#
sub copystat
{
    my ($frompath, $topath, $stat) = @_;

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


#
# Make all segments of $path that do not exist
#
#
sub rmkdir
{
    my ($path) = shift;
    my ($piece, $newdir);

    $newdir = "/" if $path =~ m!^/!;

    foreach $piece (split '/', $path) {
        next if $piece eq "";
        $newdir .= $piece . "/";
        mkdir $newdir, 0755 if not -e $newdir;
    }
}


#
# Match most recent backup directory in the past sixty days, or yesterday if none
#
#
sub findyesterday
{
    my ($target) = shift;
    my ($yesterday, $span, $testdir);


    $span = 1;

    $yesterday = sprintf "%4d%02d/%02d", Add_Delta_Days(Today(), -1);

    while ($span < 60)
    {
        $testdir = sprintf "%4d%02d/%02d", Add_Delta_Days(Today(), -$span);

        if (-d "$target/$testdir")  { $yesterday = $testdir;  last; }

        $span++;
    }

    return $yesterday;
}


sub cleanpath
{
    my ($path) = shift;

    $path =~ s!^\./!!g;
    $path =~ s!([^\.])\./!$1!g;
    $path =~ s!//!/!g;

    return $path;
}
