diff --git a/README.pod b/README.pod new file mode 100644 index 0000000..223e7a1 --- /dev/null +++ b/README.pod @@ -0,0 +1,66 @@ +=head4 subst - commandline tool to replace file contents or file names + +This script can be used to replace something in a file or filename by using perl +regular expressions. It can also be used to rename files based on regexes. + +=head4 Usage + + Usage: subst [-M ] [-t] -r 's/old/new/' [ -r '...', ...] [ ... | /regex/] + subst [-M ] [-tR] -m 's/old/new/' [ -m '...', ...] [ ... | /regex/] + + Options: + -r replace contents of file(s) + -m rename file(s) + -R recursive (only used in conjunction with -m) + -M load additional perl module to enhance /e functionality. + -t test mode, do not overwrite file(s) + + Samples: + - replace "tom" with "mac" in all *.txt files: + subst -r 's/tom/mac/g' *.txt + + - rename all jpg files containing whitespaces: + subst -m 's/ /_/g' '/.jpg/' + + - decode base64 encoded contents + subst -M MIME::Base64 -r 's/([a-zA-Z0-9]*)$/decode_base64($1)/gem' somefile + + - turn every uri into a link + subst -M "Regexp::Common qw /URI/" -r 's#($RE{URI}{HTTP})#link#g' somefile + + If is -, STDIN will be used as input file, results will be printed + to STDOUT. -t does not apply for STDIN input. + + Substitution regex must be perlish. See 'perldoc perlre' for details. + +=head4 Samples + +replace "tom" with "mac" in all *.txt files: + + subst -r 's/tom/mac/g' *.txt + +rename all jpg files containing whitespaces: + + subst -m 's/ /_/g' '/.jpg/' + +decode base64 encoded contents + + subst -M MIME::Base64 -r 's/([a-zA-Z0-9]*)$/decode_base64($1)/gem' somefile + +turn every uri into a link + + subst -M "Regexp::Common qw /URI/" -r 's#($RE{URI}{HTTP})#link#g' somefile + +=head4 Installation + +Copy L to B<$HOME/bin/subst>, that's all. +No additional perl modules are required. + +=head4 Version + +1.1.5. + +Copyright (c) 2002-2021 - T.v. Dein + +=cut + diff --git a/subst b/subst new file mode 100755 index 0000000..290eef3 --- /dev/null +++ b/subst @@ -0,0 +1,224 @@ +#!/usr/bin/perl +# +# subst - replace strings in one or more files using +# perl regular expressions (~= s/// syntax). +# Files will be edited inline (perl -i). +# +# Copyright (c) 2002-2021 - Thomas von Dein +# + +use strict; +use Getopt::Long; +use Data::Dumper; +use vars qw($VERSION $test $usage $version $me); +my (@m, @r, @files, @M, $recursive); + +$VERSION = "1.1.5"; +$me = $0; +$me =~ s(^.*/)(); + +Getopt::Long::Configure( qw(no_ignore_case)); +if (! GetOptions ( + "regex|r=s" => \@r, + "moveregex|m=s" => \@m, + "recursive|R" => \$recursive, + "module|M=s" => \@M, + "test|t" => \$test, + "help|h" => \$usage, + "version|v" => \$version + ) ) { + $usage = 1; +} + +if ($version) { + print STDERR "$me $VERSION\n"; + exit; +} + +if ($usage || (! @r && ! @m)) { + print qq~ +Usage: $me [-M ] [-t] -r 's/old/new/' [ -r '...', ...] [ ... | /regex/] + $me [-M ] [-tR] -m 's/old/new/' [ -m '...', ...] [ ... | /regex/] + +Options: + -r replace contents of file(s) + -m rename file(s) + -R recursive (only used in conjunction with -m) + -M load additional perl module to enhance /e functionality. + -t test mode, do not overwrite file(s) + +Samples: + - replace "tom" with "mac" in all *.txt files: + subst -r 's/tom/mac/g' *.txt + + - rename all jpg files containing whitespaces: + subst -m 's/ /_/g' '/\.jpg/' + + - decode base64 encoded contents + subst -M MIME::Base64 -r 's/([a-zA-Z0-9]*)\$/decode_base64(\$1)/gem' somefile + + - turn every uri into a link + subst -M "Regexp::Common qw /URI/" -r 's#(\$RE{URI}{HTTP})#link#g' somefile + +If is -, STDIN will be used as input file, results will be printed +to STDOUT. -t does not apply for STDIN input. + +Substitution regex must be perlish. See 'perldoc perlre' for details. + +Version: $VERSION. Copyright (c) 2002-2021 - Thomas von Dein +~; + exit; +} + +# load modules, if any +foreach my $module (@M) { + eval "use $module"; + if ($@) { + die $@; + } +} + + +# check regex's +local $_= ""; +foreach my $regex (@r, @m) { + eval $regex; + if ($@) { + print STDERR "ERROR: failed to compile regex \'$regex\':\n $@\n"; + exit; + } +} + +# see if files arg is a regex +if ($ARGV[0] =~ /^\/(.*)\/$/) { + my $freg = $1; + opendir LOC, "."; + while (my $file = readdir(LOC)) { + next if ($file eq '.' || $file eq '..'); + if ($file =~ /$freg/) { + push @files, $file; + } + } + closedir LOC; +} +else { + @files = @ARGV; +} + + +if (@r) { + # actually, do the substitute + foreach my $file (@files) { + next if (-l $file); + next if (! -e $file); + my $tmpfile = &gettemp(); + if ($file eq '-') { + *T = *STDIN; + *F = *STDOUT; + } + else { + next if (-l $file); + next if (! -e $file); + if ($test) { + open T, "<$file" or die "Could not read file \'$file\': $!\n"; + } + else { + system("cp", $file, $tmpfile) and die "Could not make copy of \'$file\': $!\n"; + open T, "<$tmpfile" or die "Could not read file \'$tmpfile\': $!\n"; + open F, ">$file" or die "Could not write file \'$file\': $!\n"; + } + print STDOUT "$file:\n"; + } + + select F; + my %matches; + while () { + foreach my $regex (@r) { + $matches{$regex} += eval $regex; + } + if ($file eq '-' || !$test) { + print; + } + } + if ($file ne '-') { + foreach my $regex (keys %matches) { + print STDOUT " \'$regex\' --- " . $matches{$regex} . " matches\n"; + } + } + close T; + close F; + unlink $tmpfile; + } +} +else { + &recurse(@files); +} + +sub recurse { + my @files = @_; + + foreach my $file (@files) { + next if (-l $file); + next if (! -e $file); + + if (-d $file) { + if ($recursive) { + opendir DIR, $file or die "Could not enter directory $file: $!\n"; + my @inside = map { "$file/$_" } grep { $_ ne '.' && $_ ne '..' } readdir(DIR); + closedir(DIR); + &recurse(@inside); + } + } + + &rename($file); + } +} + + +sub rename { + my $dirent = shift; + my $dir = `dirname "$dirent"`; + my $file = `basename "$dirent"`; + chomp $dir; + chomp $file; + + local $_ = $file; + my $number; + foreach my $regex (@m) { + $number += eval $regex; + } + + return unless "$dir/$file" ne "$dir/$_"; + + if ($test) { + print "t: mv \"$dir/$file\" \"$dir/$_\"\n"; + return; + } + + my $sys = system("mv", "$dir/$file", "$dir/$_"); + + if (! $sys) { + # system() reverses return codes + print "moved '$dir/$file' => '$dir/$_' ($number matches)\n"; + } + else { + print "failed to move '$dir/$file' => '$dir/$_'\n"; + } +} + + +sub gettemp { + my($random, @range); + @range=('0'..'9','a'..'z','A'..'Z'); + srand(time||$$); + for (0..10) { + $random .= $range[rand(int($#range)+1)]; + } + my $tempfile = "/tmp/.subst-" . $random; + if (-e $tempfile) { + # avoid race conditions! + unlink $tempfile; + } + return $tempfile; +} +