#!/usr/bin/perl -w use strict; use File::Basename; use Term::ReadLine; my (%new, %old, %oldtypes, %newtypes); die "Usage: prcs-ttyask-move " unless $#ARGV == 1; open OLD, "<" . $ARGV[0] or die "open: $!"; open NEW, ">" . $ARGV[1] or die "open: $!"; # index by basename for () { chomp; my @line = split (/\t/, $_); if ($line[0] eq 'ADDED') { $new{basename ($line[1])} = [] unless defined $new{basename ($line[1])}; push @{$new{basename ($line[1])}}, $line[1]; $newtypes{$line[1]} = $line[2]; } elsif ($line[1] eq 'DELETED') { $old{basename ($line[0])} = [] unless defined $old{basename ($line[0])}; push @{$old{basename ($line[0])}}, $line[0]; $oldtypes{$line[0]} = $line[2]; } } close OLD; my $term = new Term::ReadLine 'Simple Perl calc'; my $OUT = $term->OUT; # try to match by filename foreach my $name (keys %old) { if (defined $new{$name}) { foreach my $oldname (@{$old{$name}}) { print "\n File: $oldname\n"; print "0: DELETED\n"; # filter by type my @newnames; foreach my $newname (@{$new{$name}}) { push @newnames, $newname if $newtypes{$newname} eq $oldtypes{$oldname}; } # display choices my $i = 1; foreach my $newname (@newnames) { print "$i: $newname\n"; $i ++; } my $prompt = " your choice -> "; my $res; do { $_ = $term->readline($prompt); } until m/^[0-9]+$/ and ($_ >= 0) and ($_ < $i); my $choice = $_; if ($choice == 0) { print NEW "$oldname\tDELETED\t", $oldtypes{$oldname}, "\n"; } else { print NEW "$oldname\t", $newnames[$choice - 1], "\t", $oldtypes{$oldname}, "\n"; # remove the selected ADDED element for (my $i = 0; $i <= $#{$new{$name}}; $i++) { if ($new{$name}->[$i] eq $newnames[$choice - 1]) { splice (@{$new{$name}}, $i, 1); last; } } } } } else { # Found no candidate: keep DELETED line print NEW "$name\tDELETED\t", $oldtypes{$name}, "\n"; } } # Output ADDED files not selected as renamed foreach my $name (keys %new) { foreach my $newname (@{$new{$name}}) { print NEW "ADDED\t$newname\t", $newtypes{$newname}, "\n"; } }