summaryrefslogtreecommitdiff
path: root/macros/generic/memoize/memoize-clean.pl
diff options
context:
space:
mode:
Diffstat (limited to 'macros/generic/memoize/memoize-clean.pl')
-rwxr-xr-xmacros/generic/memoize/memoize-clean.pl163
1 files changed, 163 insertions, 0 deletions
diff --git a/macros/generic/memoize/memoize-clean.pl b/macros/generic/memoize/memoize-clean.pl
new file mode 100755
index 0000000000..4e1334c695
--- /dev/null
+++ b/macros/generic/memoize/memoize-clean.pl
@@ -0,0 +1,163 @@
+#!/usr/bin/env perl
+
+# This file is a part of Memoize, a TeX package for externalization of
+# graphics and memoization of compilation results in general, available at
+# https://ctan.org/pkg/memoize and https://github.com/sasozivanovic/memoize.
+#
+# Copyright (c) 2020- Saso Zivanovic <saso.zivanovic@guest.arnes.si>
+#
+# This work may be distributed and/or modified under the conditions of the
+# LaTeX Project Public License, either version 1.3c of this license or (at
+# your option) any later version. The latest version of this license is in
+# https://www.latex-project.org/lppl.txt and version 1.3c or later is part of
+# all distributions of LaTeX version 2008 or later.
+#
+# This work has the LPPL maintenance status `maintained'.
+# The Current Maintainer of this work is Saso Zivanovic.
+#
+# The files belonging to this work and covered by LPPL are listed in
+# <texmf>/doc/generic/memoize/FILES.
+
+use strict;
+use Getopt::Long;
+# I intend to rewrite this script using Path::Class.
+use Cwd 'realpath';
+use File::Spec;
+use File::Basename;
+
+my $VERSION = '2023/10/10 v1.0.0';
+
+my $usage = "usage: memoize-clean.py [-h] [--yes] [--all] [--quiet] [--prefix PREFIX] [mmz ...]\n";
+my $Help = <<END;
+Remove (stale) memo and extern files.
+
+positional arguments:
+ mmz .mmz record files
+
+options:
+ -h, --help show this help message and exit
+ --version, -V show version and exit
+ --yes, -y Do not ask for confirmation.
+ --all, -a Remove *all* memos and externs.
+ --quiet, -q
+ --prefix PREFIX, -p PREFIX
+ A path prefix to clean; this option can be specified multiple times.
+
+For details, see the man page or the Memoize documentation.
+END
+
+my ($yes, $all, @prefixes, $quiet, $help, $print_version);
+GetOptions(
+ "yes|y" => \$yes,
+ "all|a" => \$all,
+ "prefix|p=s" => \@prefixes,
+ "quiet|q|?" => \$quiet,
+ "help|h|?" => \$help,
+ "version|V" => \$print_version,
+ ) or die $usage;
+$help and die "$usage\n$Help";
+if ($print_version) { print("memoize-clean.pl of Memoize $VERSION\n"); exit 0 }
+
+my (%keep, %prefixes);
+
+my $curdir = Cwd::getcwd();
+
+for my $prefix (@prefixes) {
+ $prefixes{Cwd::realpath(File::Spec->catfile(($curdir), $prefix))} = '';
+}
+
+my @mmzs = @ARGV;
+
+for my $mmz (@mmzs) {
+ my ($mmz_filename, $mmz_dir) = File::Basename::fileparse($mmz);
+ @ARGV = ($mmz);
+ my $endinput = 0;
+ my $empty = -1;
+ my $prefix = "";
+ while (<>) {
+ if (/^ *$/) {
+ } elsif ($endinput) {
+ die "Bailing out, \\endinput is not the last line of file $mmz.\n";
+ } elsif (/^ *\\mmzPrefix *{(.*?)}/) {
+ $prefix = $1;
+ $prefixes{Cwd::realpath(File::Spec->catfile(($curdir,$mmz_dir), $prefix))} = '';
+ $empty = 1 if $empty == -1;
+ } elsif (/^%? *\\mmz(?:New|Used)(?:CC?Memo|Extern) *{(.*?)}/) {
+ my $fn = $1;
+ if ($prefix eq '') {
+ die "Bailing out, no prefix announced before file $fn.\n";
+ }
+ $keep{Cwd::realpath(File::Spec->catfile(($mmz_dir), $fn))} = 1;
+ $empty = 0;
+ if (rindex($fn, $prefix, 0) != 0) {
+ die "Bailing out, prefix of file $fn does not match " .
+ "the last announced prefix ($prefix).\n";
+ }
+ } elsif (/^ *\\endinput *$/) {
+ $endinput = 1;
+ } else {
+ die "Bailing out, file $mmz contains an unrecognized line: $_\n";
+ }
+ }
+ die "Bailing out, file $mmz is empty.\n" if $empty && !$all;
+ die "Bailing out, file $mmz does not end with \\endinput; this could mean that " .
+ "the compilation did not finish properly. You can only clean with --all.\n"
+ if $endinput == 0 && !$all;
+}
+
+my @tbdeleted;
+sub populate_tbdeleted {
+ my ($basename_prefix, $dir, $suffix_dummy) = @_;
+ opendir(MD, $dir) or die "Cannot open directory '$dir'";
+ while( (my $fn = readdir(MD)) ) {
+ my $path = File::Spec->catfile(($dir),$fn);
+ if ($fn =~ /\Q$basename_prefix\E[0-9A-F]{32}(?:-[0-9A-F]{32})?(?:-[0-9]+)?(\.memo|(?:-[0-9]+)?\.pdf|\.log)/ and ($all || !exists($keep{$path}))) {
+ push @tbdeleted, $path;
+ }
+ }
+ closedir(MD);
+}
+for my $prefix (keys %prefixes) {
+ my ($basename_prefix, $dir, $suffix);
+ if (-d $prefix) {
+ populate_tbdeleted('', $prefix, '');
+ }
+ populate_tbdeleted(File::Basename::fileparse($prefix));
+}
+@tbdeleted = sort(@tbdeleted);
+
+my @allowed_dirs = ($curdir);
+my @deletion_not_allowed;
+for my $f (@tbdeleted) {
+ my $f_allowed = 0;
+ for my $dir (@allowed_dirs) {
+ if ($f =~ /^\Q$dir\E/) {
+ $f_allowed = 1;
+ last;
+ }
+ }
+ push(@deletion_not_allowed, $f) if ! $f_allowed;
+}
+die "Bailing out, I was asked to delete these files outside the current directory:\n" .
+ join("\n", @deletion_not_allowed) if (@deletion_not_allowed);
+
+if (scalar(@tbdeleted) != 0) {
+ my $a;
+ unless ($yes) {
+ print("I will delete the following files:\n" .
+ join("\n",@tbdeleted) . "\n" .
+ "Proceed (y/n)? ");
+ $a = lc(<>);
+ chomp $a;
+ }
+ if ($yes || $a eq 'y' || $a eq 'yes') {
+ foreach my $fn (@tbdeleted) {
+ print "Deleting ", $fn, "\n" unless $quiet;
+ unlink $fn;
+ }
+ } else {
+ die "Bailing out.\n";
+ }
+} elsif (!$quiet) {
+ print "Nothing to do, the directory seems clean.\n";
+}