#!/usr/bin/env perl
#
# $Id: copy-skype-shots 782 2010-12-03 16:03:30Z rp $

use warnings;
use strict;

use File::Copy;
use IPC::Open3;

sub skype_pix_dir
{
  my $skyped_data = $ENV{APPDATA} or die "no APPDATA set\n";
  chomp( $skyped_data = `cygpath '$skyped_data'` )
   or die "cannot run cygpath\n";
  $skyped_data;
}

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

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;

  if ( copy( $src, $copy ) )
  {
    warn "$src -> $copy\n";
    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 freedup,
# and returns the array of arrays of identical files
# (each of at least 2 different filenames)
{
  my ( $in_h, $out_h, $err_h );

  open3( $in_h, $out_h, 2, 'freedup', '-nv' )
   or die "cannot run freedup -nv: $@\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;
}