blob: 56f2ce2ab1d958e4581515b28a949972e00d3255 [file] [log] [blame]
Manuel Pégourié-Gonnard3385cf42015-04-02 17:59:30 +01001#!/usr/bin/perl
2
3use warnings;
4use strict;
5
6use utf8;
7use open qw(:std utf8);
8
9# apply substitutions from the table in the first arg to files
10# expected usage: via invoke-rename.pl
11
12die "Usage: $0 names-file [filenames...]\n" if( @ARGV < 1 or ! -r $ARGV[0] );
13
14open my $nfh, '<', shift or die;
15my @names = <$nfh>;
16close $nfh or die;
17
18my %subst;
19for my $name (@names) {
20 chomp $name;
21 my ($old, $new) = split / /, $name;
22 $subst{$old} = $new;
23}
24
25my $string = qr/".*?(?<!\\)"/;
26my $space = qr/\s+/;
27my $idnum = qr/[a-zA-Z0-9_]+/;
28my $symbols = qr/[!#%&'()*+,-.:;<=>?@^_`{|}~\$\/\[\\\]]+|"/;
29
30my %warnings;
31
32while( my $filename = shift )
33{
34 print STDERR "$filename... ";
35 if( -d $filename ) { print STDERR "skip (directory)"; next }
36
37 open my $rfh, '<', $filename or die;
38 my @lines = <$rfh>;
39 close $rfh or die;
40
41 my @out;
42 for my $line (@lines) {
43 my @words = ($line =~ /$string|$space|$idnum|$symbols/g);
44 my $checkline = join '', @words;
45 if( $checkline eq $line ) {
46 my @new = map { exists $subst{$_} ? $subst{$_} : $_ } @words;
47 push( @out, join '', @new );
48 } else {
49 $warnings{$filename} = [] unless $warnings{$filename};
50 push @{ $warnings{$filename} }, $line;
51 push( @out, $line );
52 }
53 }
54
55 open my $wfh, '>', $filename or die;
56 print $wfh $_ for @out;
57 close $wfh or die;
58 print STDERR "done\n";
59}
60
61if( %warnings ) {
62 print "\nWarning: lines skipped due to unexpected charaacters:\n";
63 for my $filename (sort keys %warnings) {
64 print "in $filename:\n";
65 print for @{ $warnings{$filename} };
66 }
67}