file-reorg-by-yyyymmdd

#!/usr/bin/env perl
use v5.18;
use strict;
use warnings;

use File::Copy qw(move);
use File::Basename qw(fileparse);
use File::Path qw(make_path);
use File::Spec::Functions qw(catfile catdir);
use File::Next;
use Getopt::Long;
use Digest::SHA1;

sub sha1_digest {
    my ($file) = @_;
    open my $fh, "<", $file;
    my $sha1 = Digest::SHA1->new;
    $sha1->addfile($fh);
    return $sha1->hexdigest;
}

sub is_same_inode {
    my ($file1, $file2) = @_;
    my @s1 = stat($file1);
    my @s2 = stat($file2);
    return ($s1[0] == $s2[0] and $s1[1] eq $s2[1])
}

sub looks_identical {
    my ($file1, $file2) = @_;
    my $file1_size = (stat($file1))[7];
    return 0 unless $file1_size == (stat($file2))[7];

    open my $fh1, "<", $file1;
    open my $fh2, "<", $file2;
    my ($block1, $block2) = ("", "");
    my $offset = 0;
    my $block_size = 512 * 1024;
    while(($offset < $file1_size) && ($block1 eq $block2)) {
        read $fh1, $block1, $block_size;
        read $fh2, $block2, $block_size;
        $offset += $block_size;
    }
    return 0 if $offset < $file1_size;

    return 1;
}

sub main {
    my ($opts, $args) = @_;
    my @input = grep { -f || -d } @{ $opts->{i} };
    my $iter = File::Next::files(@input);
    my %plan;
    while (defined( my $file = $iter->() )) {
        next if $file =~ / \.DS_Store \z/x;

        my $mtime = (stat($file))[9];
        my ($year, $month, $day) = ( localtime($mtime) )[5,4,3];
        $year += 1900; $month += 1;
        my $yyyy     = sprintf('%04d', $year);
        my $yyyymmdd = sprintf('%04d%02d%02d', $year, $month, $day);
        my $filename = fileparse($file);

        my $new_dir;
        if (defined($opts->{d}) && $opts->{d} ne "") {
            $new_dir = catdir($yyyy, $yyyymmdd, $opts->{d});
        } else {
            $new_dir = catdir($yyyy, $yyyymmdd);
        }
        my $new_path = catfile($new_dir, $filename);

        if (-e $new_path) {
            if (is_same_inode($file, $new_path)) {
                say("ignore # 1. identical\t$file\t$new_path");
            }
            elsif (looks_identical($file, $new_path)) {
                say("rm $file # 2. duplicate\t$file\t$new_path");
                unlink($file);
            }
            else {
                my $msg = "File already exists: $new_path (from $file)";

                if ($opts->{'ignore-existing'}) {
                    warn $msg;

                } elsif ($opts->{'keep-both'}) {
                    my $sha1 = sha1_digest($file);
                    my ($filename, $dir, $ext) = fileparse($new_path, qr/\.[^.]*/);
                    $new_path = catfile($dir, "${filename}-${sha1}${ext}");
                    if (-e $new_path) {
                        if (is_same_inode($file, $new_path)) {
                            say("ignore # 3. identical\t$file\t$new_path");
                        }
                        elsif (looks_identical($file, $new_path)) {
                            say("rm $file # 4. duplicate\t$file\t$new_path");
                            unlink($file);
                        }
                        else {
                            warn "File already exists: $new_path (from $file)";
                        }
                    }
                } else {
                    die $msg;
                }
            }
        }

        unless (-e $new_path) {
            if (exists $plan{$new_path}) {
                my $msg = "File name Conflict:\n\t -> " . join("\n\t -> ", @{$plan{$new_path}}) . "\n\t <- $file\n";
                if ($opts->{'ignore-existing'}) {
                    $msg =~ s/:/ (Ignored):/;
                    warn $msg;
                } else {
                    die $msg;
                }
            } else {
                $plan{$new_path} = [$file, $new_dir];
            }
        }
    }

    for my $k (keys %plan) {
        my ($file, $new_dir) = @{ $plan{$k} };
        if ($opts->{n}) {
            say "mv $file $k";
        } else {
            make_path($new_dir) unless -d $new_dir;
            say "mv $file $k";
            move($file, $k);
        }
    }
}

my %opts;
GetOptions(
    \%opts,
    'i=s@',
    'd=s',
    'n',
    'ignore-existing',
    'keep-both'
);
main(\%opts, [@ARGV]);