#!/usr/bin/env perl
#
# $Id$

use warnings;
use strict;

use Getopt::Std;
use File::Copy;
use IPC::Open3;

sub first_directory_among
{
  foreach my $d (@_)
  {
    defined $d && -d $d && return $d;
  }

  return undef;
}

sub skype_pix_dir
{
  my $up = $ENV{USERPROFILE};
  my $ar =
   ( -d $up && -d $up . '\Appdata\Roaming' ) ? $up . '\Appdata\Roaming' : undef;
  my $skyped_data = first_directory_among( map { "$_/Skype" } $ar, $ENV{HOME} )
   // die
"cannot derive Skype picture directory from \$USERPROFILE or \$HOME, please set \$SKYPE_PIX\n";

  if ( $skyped_data =~ m#[\\:]# )
  {
    chomp( $skyped_data = `cygpath '$skyped_data'` )
     or die "cannot run cygpath\n";
  }

  first_directory_among( glob("$skyped_data/Pictures"),
    glob("$skyped_data/*/Pictures") )
   // die "Cannot find Skype Pictures directory in $skyped_data\n";
}

my $default_src = skype_pix_dir();
my $src         = $ENV{SKYPE_PIX} // $default_src;
my $dst         = $ENV{SKYPE_COPY} // '.';

my %opt;
getopts( 'h?nv', \%opt );
$opt{h} || $opt{'?'} and HELP_MESSAGE();

sub HELP_MESSAGE
{
  print STDERR <<ZZ;

Usage: $0 [-n] [-v]

  to copy images from directory

    $src

  to directory

    $dst

renaming them to 1.png, 2.png, ..., and skipping duplicates.

This script was written for archiving Skype screenshots,
possibly from various sources, to a central directory.

There are no options, but two environment variables can be used:

  \$SKYPE_PIX  specifies the source directory; it defaults to
              $default_src
  \$SKYPE_COPY specifies the destination directory; it defaults to
              the current working directory

Options:

  -n  Do everything except actually copying.
  -v  Print what would be copied.

ZZ

  exit(0);
}

my %n2src =
 by1stnum( indirmatching( $src, qr/^Video call snapshot \d+\.png$/ ) )
 or die "no files to copy\n";

my %n2dst = by1stnum( indirmatching( $dst, qr/^\d+\.png$/ ) );

my @ndst = sort { $a <=> $b } keys %n2dst;
if ( @ndst && ( $ndst[0] ne 1 || $ndst[$#ndst] ne ( $#ndst + 1 ) ) )
{
  die "aborting, destination filenames don't run from 1.png to "
   . ( $#ndst + 1 ) . "\n";
}

# we want to copy a file in keys %n2src to a *new* file in $dst
# iff no file in keys %n2dst is already identical to it

my %src2n = reverse %n2src;
my %dst2n = reverse %n2dst;

my %src2cpy;    # points every source file that has a copy to such a copy

warn sprintf(
  "%s source files, %d existing destination files\n",
  scalar( keys %n2src ),
  scalar( keys %n2dst )
);

foreach my $eqfiles ( identical_files( values %n2src, values %n2dst ) )
{
  my @src = grep { defined $src2n{$_} } @$eqfiles;
  my @dst = grep { defined $dst2n{$_} } @$eqfiles;

  if ( !@src )
  {
    # no source file to copy
    next;
  }

  my $src = shift(@src);

  if (@dst)
  {
    $src2cpy{$src} = $dst[0];
  }

  foreach my $src2 (@src)
  {
    $src2cpy{$src2} = $src;
  }
}

my $ndst = $#ndst + 2;

foreach my $src ( map { $n2src{$_} } sort { $a <=> $b } keys %n2src )
{
  my $copy = $src2cpy{$src};

  if ( defined $copy )
  {
    warn "$src = $copy\n";
    next;
  }

  $copy = "$dst/$ndst.png";
  ++$ndst;

  warn "$src -> $copy\n" if $opt{v};

  if ( $opt{n} )
  {
    # nothing
  }
  elsif ( copy( $src, $copy ) )
  {
    utime( ( stat($src) )[ 8, 9 ], $copy )
     or warn "cannot preserve time on $copy\n";
  }
  else
  {
    die "aborting, failed to copy $src -> $copy\n";
  }
}

exit(0);

#--- auxiliary functions ---#
#

sub indirmatching
{
  my ( $d, $pat ) = @_;
  -d $d or die "no directory $d\n";
  opendir( my $dh, $d ) or die "cannot open directory $d\n";
  #my @files = grep { if (/$pat/) { warn "$_ matches\n"; 1} else { warn "$_ does not match\n"; 0 } } readdir($dh);
  my @files = grep { /$pat/ } readdir($dh);
  close($dh);
  map { "$d/$_" } @files;
}

sub by1stnum
{
  map { m#(\d+)[^/]*$# ? ( $1 => $_ ) : () } @_;
}

sub reverse_hash
{
  my %h = @_;
  my %r;

  while ( my ( $k, $v ) = each %h )
  {
    push( @{ $r{$v} }, $k );
  }
  %r;
}

sub identical_files
# feeds a list of filenames to fdupes or freedup,
# and returns the array of arrays of identical files
# (each of at least 2 different filenames)
{
  my ( $in_h, $out_h, $err_h );

  eval     { open3( $in_h, $out_h, undef, 'fdupes',  '.' ) }
   or eval { open3( $in_h, $out_h, undef, 'freedup', '-nv' ) }
   or die "cannot deduplicate, both fdupes . and freedup -nv failed\n";

  foreach (@_)
  {
    print $in_h $_, "\n";
  }

  close($in_h);

  my @identical;
  my @all;

  my $nr_out = 0;

  while (<$out_h>)
  {
    chomp;

    if (length)
    {
      push( @identical, $_ );
      ++$nr_out;
    }
    elsif (@identical)
    {
      push( @all, [@identical] );
      @identical = ();
    }
  }

  close($out_h);

  push( @all, [@identical] ) if @identical;

  my $nr_in   = @_;
  my $nr_part = @all;
  warn "freedup: $nr_in files contain $nr_part groups of $nr_out equal files\n";

  @all;
}