mirror of
https://codeberg.org/scip/subst.git
synced 2025-12-17 04:31:02 +01:00
moved to codeberg
This commit is contained in:
@@ -1,24 +0,0 @@
|
|||||||
matrix:
|
|
||||||
include:
|
|
||||||
# - image: perl:5.36.0-slim-bullseye
|
|
||||||
# - image: perl:5.38.0-slim-bookworm
|
|
||||||
# - image: perl:5.40.0-slim-bookworm
|
|
||||||
# - image: perl:5.42.0-slim-bookworm
|
|
||||||
- image: perl:5.43.5-slim-bookworm
|
|
||||||
|
|
||||||
steps:
|
|
||||||
test:
|
|
||||||
when:
|
|
||||||
event: [push]
|
|
||||||
image: ${image}
|
|
||||||
commands:
|
|
||||||
- perl subst -r 's/2025/foobar/' t/file*
|
|
||||||
- grep foobar t/file*
|
|
||||||
- cp t/file1 t/huh.1
|
|
||||||
- cp t/file1 t/mor.2
|
|
||||||
- cd t
|
|
||||||
- perl ../subst -m 's/(huh|mor)/sub/g' '/.\d$/'
|
|
||||||
- cd ..
|
|
||||||
- ls -l t/sub.1 t/sub.2
|
|
||||||
- perl subst -R -m 's/sub/ord/g' t
|
|
||||||
- ls -l t/ord.1 t/ord.2
|
|
||||||
@@ -2,6 +2,10 @@
|
|||||||
|
|
||||||
## subst - commandline tool to replace file contents or file names
|
## subst - commandline tool to replace file contents or file names
|
||||||
|
|
||||||
|
> [!CAUTION]
|
||||||
|
> This software is now being maintained on [Codeberg](https://codeberg.org/scip/subst/).
|
||||||
|
|
||||||
|
|
||||||
This script can be used to replace something in a file or filename by using perl
|
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.
|
regular expressions. It can also be used to rename files based on regexes.
|
||||||
|
|
||||||
|
|||||||
224
subst
224
subst
@@ -1,224 +0,0 @@
|
|||||||
#!/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;
|
|
||||||
}
|
|
||||||
|
|
||||||
Reference in New Issue
Block a user