added latest version

This commit is contained in:
2024-01-03 10:49:02 +01:00
parent 61ff708728
commit 85c97c50b2
2 changed files with 290 additions and 0 deletions

66
README.pod Normal file
View File

@@ -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 <perl module>] [-t] -r 's/old/new/<flags>' [ -r '...', ...] [<file> ... | /regex/]
subst [-M <perl module>] [-tR] -m 's/old/new/<flags>' [ -m '...', ...] [<file|dir> ... | /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})#<a href="$a">link</a>#g' somefile
If <file> 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})#<a href="$a">link</a>#g' somefile
=head4 Installation
Copy L<subst> 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

224
subst Executable file
View File

@@ -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 <tom@vondein.org>
#
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 <perl module>] [-t] -r 's/old/new/<flags>' [ -r '...', ...] [<file> ... | /regex/]
$me [-M <perl module>] [-tR] -m 's/old/new/<flags>' [ -m '...', ...] [<file|dir> ... | /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})#<a href="\$a">link</a>#g' somefile
If <file> 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 <tom\@vondein.org>
~;
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 (<T>) {
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;
}