#!/usr/local/bin/perl
use strict;
use warnings;

use Text::Diff qw( diff );
use File::Find::Parallel;
use File::Spec::Functions qw( catfile rel2abs );
use File::Slurp qw( slurp );

die "usage: syncl SOURCE_ROOT DEST_ROOT"
    unless @ARGV == 2;

my $source_root = rel2abs( $ARGV[0] );
my $dest_root   = rel2abs( $ARGV[1] );
my ( $source_proj, $dest_proj );
if ( $source_root =~ m#/ks/|kino#i and $dest_root =~ /lucy/i ) {
    $source_proj = 'KinoSearch';
    $dest_proj   = 'Lucy';
}
elsif ( $source_root =~ /lucy/i and $dest_root =~ m#/ks/|kino#i ) {
    $source_proj = 'Lucy';
    $dest_proj   = 'KinoSearch';
}
else {
    die "Can't divine project identities from path names";
}

my %swaps = (
    KinoSearch => {
        prefix   => 'kino_',
        Prefix   => 'Kino_',
        PREFIX   => 'KINO_',
        lc_cnick => 'kino',
        parcel   => 'parcel KinoSearch cnick Kino',
        project  => 'KinoSearch',
    },
    Lucy => {
        prefix   => 'lucy_',
        Prefix   => 'Lucy_',
        PREFIX   => 'LUCY_',
        lc_cnick => 'lucy',
        parcel   => 'parcel Lucy',
        project  => 'Lucy',
    },
);
my $source_swap = $swaps{$source_proj};
my $dest_swap   = $swaps{$dest_proj};

my $exclude = qr/(svn|cvs|(^|\/)\.[^.]|\.o$)/;

my $file_finder = File::Find::Parallel->new( $source_root, $dest_root );
my $iterator = $file_finder->any_iterator;
FILE: while ( my $component = $iterator->() ) {
    next if $component =~ $exclude;

    my $source_path
        = -f $source_root
        ? $source_root
        : catfile( $source_root, $component );
    my $dest_path
        = -f $dest_root
        ? $dest_root
        : catfile( $dest_root, $component );
    $dest_path =~ s/$source_swap->{project}/$dest_swap->{project}/;

    # Warn and skip files that aren't common.
    for ( $source_path, $dest_path ) {
        if ( !-e $_ ) {
            print("Don't have $_ ... skipping...\n");
            next FILE;
        }
        next FILE unless -f $_;
        if ( !-T $_ ) {
            print("$_ isn't a text file... skipping...\n");
            next FILE;
        }
    }

    # Generate a diff if there are changes, otherwise skip.
    my $source_content = slurp($source_path);
    my $dest_content   = slurp($dest_path);
    my $edited         = modify( $source_content, $dest_content );

    # Search and replace prefixes, project name.
    for ($edited) {
        s/$source_swap->{parcel}/$dest_swap->{parcel}/g;
        s/$source_swap->{prefix}/$dest_swap->{prefix}/g;
        s/$source_swap->{Prefix}/$dest_swap->{Prefix}/g;
        s/$source_swap->{PREFIX}/$dest_swap->{PREFIX}/g;
        s/$source_swap->{lc_cnick}/$dest_swap->{lc_cnick}/g;
        s/\b$source_proj\b/$dest_proj/g;
    }

    if ( $edited eq $dest_content ) {
        print "No change to $dest_path\n";
        next;
    }

    # Confirm with user that the change worked as intended.
    my $diff = diff( \$dest_content, \$edited );
    print "\nFILE: $dest_path\n$diff\nApply? ";
    my $response = <STDIN>;
    next unless $response =~ /^y/i;

    print "Applying edit...\n";
    open( my $fh, ">", $dest_path )
        or die "Couldn't open '$dest_path' for writing: $!";
    print $fh $edited;
    close $fh or die "Couldn't close '$dest_path': $!";
}

sub modify {
    my ( $source_content, $dest_content ) = @_;

    # Swap out copyright notices.
    my @notices;
    my $mod_source = $source_content;
    my $mod_dest   = $dest_content;
    while (1) {
        my $source_copyright;
        ( $mod_source, $source_copyright ) = extract_copyright($mod_source);
        last unless $source_copyright;
    }
    while (1) {
        my $dest_copyright;
        ( $mod_dest, $dest_copyright ) = extract_copyright($mod_dest);
        last unless $dest_copyright;
        push @notices, $dest_copyright;
    }
    for my $notice (@notices) {
        $mod_source =~ s/COPYRIGHT_PLACEHOLDER/$notice/;
    }

    return $mod_source;
}

sub extract_copyright {
    my $content = shift;
    my $copy1   = qr/^==?head1 COPYRIGHT.*?(?=^=)/sm;
    my $copy2   = qr/^__COPYRIGHT__.*?(?=^__|\Z)/sm;
    my $copy3   = qr#/\*[\s*]*Copyright.*?\*/#sm;
    if ( $content =~ s/($copy1|$copy2|$copy3)/COPYRIGHT_PLACEHOLDER/sm ) {
        return ( $content, $1 );
    }
    return ( $content, "" );
}

__END__

=head1 NAME

syncl -- Sync Lucy to KinoSearch or vice versa

=head1 SYNOPSIS

    syncl --k2l SOURCE_ROOT DEST_ROOT

=head1 DESCRIPTION

KinoSearch and Lucy have a lot of files that are exactly the same except for
the copyright notice.  This utility facilitates syncronizing such files, by
stripping out the copyright, prefixes, and project names; diffing; verifying
with the user that the changes pass muster, then applying.

=head1 AUTHOR

Marvin Humphrey

=head1 COPYRIGHT & LICENSE

Copyright 2007-2010 Marvin Humphrey

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut