diff options
Diffstat (limited to 'macros/generic/memoize/memoize-clean.pl')
-rwxr-xr-x | macros/generic/memoize/memoize-clean.pl | 163 |
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"; +} |