#!/usr/bin/perl
# uconfig-tidy -- normalize the uconfig.txt files of a ucampas web tree
#
# https://www.cl.cam.ac.uk/local/sys/web/ucampas/
#
# Markus Kuhn -- https://www.cl.cam.ac.uk/~mgk25/
#
# Rewrites uconfig.txt files in the normalized form that NavTree::IO
# produces, so that a tree stays in a shape that a tool can safely edit
# and that a version-control diff stays readable.

# this software requires Perl 5.16 or newer
use 5.016;  # implies use strict;
use warnings;

# locate the ucampas library directory relative to this script
my $libdir;
BEGIN {
    use FindBin qw($RealBin);
    $libdir = $RealBin;
    $libdir =~ s|/bin\z|/share/ucampas|;  # for an installed copy
}
use lib $libdir, "$libdir/perl-PlexTree";
use NavTree;
use NavTree::IO;
use PlexTree;
use Cwd qw(abs_path);
use File::Temp ();

my $usage = <<'EOT';
uconfig-tidy -- normalize the uconfig.txt files of a ucampas web tree

Usage: uconfig-tidy [options] [file or directory ...]

Rewrites each uconfig.txt file in normalized form: one list element per
line, the {} set notation turned into (), attributes in the customary
reading order, and a line broken only where 78 columns will not hold it.
What a file says is unchanged, only how it is written.

With no argument, tidies ./uconfig.txt. A directory argument stands for
the uconfig.txt file in it.

Normal options:

  -r            Tidy every uconfig.txt file that the navigation tree
                below the argument reaches, rather than one file

  --pushdown    Also move each attribute and list element as deep into
                the tree as the existing subdirectories permit, which
                creates and removes uconfig.txt files (implies -r)

  --pushup      The opposite: move everything into the top-level
                uconfig.txt file and remove the others (implies -r)

  -f            With --pushdown or --pushup, rewrite every file, not only
                those whose parsed content the run would change

  --dump        Print the whole tree below the argument on standard
                output, as the single file --pushup would gather it
                into, and change nothing

  --orphans     Report the uconfig.txt files below the argument that the
                navigation tree never reaches, and change nothing.
                Exits 1 where it found any.

  --exclude RE  Do not descend into a directory whose path below the
                argument matches the Perl regular expression RE, as in
                --exclude '^teaching/2\d\d\d$'. Repeat for more of them.

  --verify      Read the navigation tree that ucampas builds, before and
                after the run, and refuse to call the run a success if
                the two differ. Keeps a backup of every file it rewrote
                or removed until the check has passed. Exits 1 where it
                did not.

  -n            Dry run: report what the run would change, and change
                nothing

  -v            Name every file the run changed, as "A" created,
                "M" modified, "D" removed. Without -v, only the created
                and removed ones are named.

  --diff        Print a unified diff of every change, on standard output
                (the reports above go to standard error). Combine with
                -n to see a change before making it.

  -b            Keep a "~" backup copy of every file rewritten or removed

  -q            Quiet mode, output only errors and warnings

  -h            Print this message

  --            Stop parsing options, any further argument is a filename

A file that already holds the bytes that would be written to it is left
alone, and so keeps its mtime. A subdirectory that is a symbolic link is
reported and not descended into, as the files behind it belong to
whatever tree they are stored in, not to this one.

Where the tree is kept under Subversion or git, and the run created or
removed a file, the commands that still have to be run to tell that
system about it are printed. They are printed, not run: what is under
version control is not for a tidy-up to decide.

WARNING: this rewrites uconfig.txt files in place. Only run it on a tree
that is under version control (or backed up with -b), so that you can
inspect and, if necessary, revert the resulting diff.

EOT

my $recurse = 0;
my $pushdown = 0;
my $pushup = 0;
my $force = 0;
my $dump = 0;
my $orphans = 0;
my @exclude;
my $verify = 0;
my $dryrun = 0;
my $verbose = 0;
my $diff = 0;
my $backup = 0;
my $quiet = 0;
my $parse_options = 1;
my @args;
while (@ARGV) {
    $_ = shift @ARGV;
    if ($parse_options && /^-/) {
	if (/^-r\z/) {
	    $recurse = 1;
	} elsif (/^--pushdown\z/) {
	    $pushdown = 1;
	    $recurse = 1;
	} elsif (/^--pushup\z/) {
	    $pushup = 1;
	    $recurse = 1;
	} elsif (/^-f\z/ || /^--force\z/) {
	    $force = 1;
	} elsif (/^--dump\z/) {
	    $dump = 1;
	} elsif (/^--orphans\z/) {
	    $orphans = 1;
	} elsif (/^--exclude\z/ || /^--exclude=(.*)/s) {
	    my $pat = defined $1 ? $1 : shift @ARGV;
	    die("Missing pattern after --exclude.\n") unless defined $pat;
	    push @exclude, $pat;
	} elsif (/^--verify\z/) {
	    $verify = 1;
	} elsif (/^-n\z/ || /^--dry-run\z/) {
	    $dryrun = 1;
	} elsif (/^-v\z/ || /^--verbose\z/) {
	    $verbose = 1;
	} elsif (/^--diff\z/) {
	    $diff = 1;
	} elsif (/^-b\z/ || /^--backup\z/) {
	    $backup = 1;
	} elsif (/^-q\z/ || /^--quiet\z/) {
	    $quiet = 1;
	} elsif (/^-h/ || /^--help/) {
	    print $usage;
	    exit 0;
	} elsif (/^--\z/) {
	    $parse_options = 0;
	} else {
	    die("Unknown command line option '$_'!\n\n" . $usage);
	}
    } else {
	push @args, $_;
    }
}
die("--pushdown and --pushup ask for opposite things.\n")
    if $pushdown && $pushup;
die("--verify has nothing to check after -n, which changes nothing.\n")
    if $verify && $dryrun;
# --verify needs a way back where its check fails, so it keeps what -b keeps
# and gets rid of it again once the check has passed
my $verify_backup = $verify && !$backup;
$backup = 1 if $verify;
@args = ('.') unless @args;

# Print the difference between what $fn holds and what the run is about to
# write to it, as a unified diff. It goes to standard output, where it can be
# paged or saved while the reports on standard error still show. A file being
# created or removed has no side at one end, which is then /dev/null, as it
# conventionally is in a diff of such a file.
#
# The old side is the file itself, so only the new side needs a copy of its
# own, and that goes to a temporary file outside the tree: writing it beside
# its target, as the transaction later does, would be a change to the tree,
# and under -n there must not be one. Its name would then stand in the diff
# header, so both header lines are replaced by ones naming the file itself.
sub show_diff {
    my ($fn, $old, $new) = @_;
    my ($left, $right) = ('/dev/null', '/dev/null');
    my $tmp;

    $left = $fn if defined $old;
    if (defined $new) {
	$tmp = File::Temp->new(TEMPLATE => 'uconfig-tidy-XXXXXXXX', TMPDIR => 1);
	binmode($tmp);
	print $tmp $new;
	$tmp->flush;
	$right = $tmp->filename;
    }
    my $d;
    unless (open($d, '-|', 'diff', '-u', '--', $left, $right)) {
	warn("cannot run diff: $!\n");
	return;
    }
    binmode($d);
    my @out = <$d>;
    close($d);
    return unless @out;
    splice(@out, 0, 2)
	if @out >= 2 && $out[0] =~ /^--- / && $out[1] =~ /^\+\+\+ /;
    print '--- ', (defined $old ? $fn : '/dev/null'), "\n";
    print '+++ ', (defined $new ? $fn : '/dev/null'), "\n";
    print @out;
}

my $diffcb = $diff ? \&show_diff : undef;

# A predicate on a directory, true where one of the --exclude expressions
# matches its path below $root. Matching the path rather than the whole name
# is what lets an expression be anchored: '^teaching/2\d\d\d$' picks out five
# directories and nothing else, while 'archive' anywhere in it does for every
# archive in the tree, which is how a Perl regular expression normally reads.
#
# Returns undef where nothing is to be excluded, so that neither descent has
# to call a predicate that would only ever say no.
my %excluded;    # the directories left out, so that the run can say which
sub exclude_matcher {
    my ($root, @pat) = @_;

    return undef unless @pat;
    my @re = map {
	my $p = $_;
	eval { qr/$p/ } or die("--exclude '$p' is not a usable regular " .
			       "expression: $@");
    } @pat;
    (my $prefix = $root) =~ s{/+\z}{};
    return sub {
	my ($dir) = @_;
	my $rel = index($dir, "$prefix/") == 0
	    ? substr($dir, length($prefix) + 1) : $dir;

	return 0 unless grep { $rel =~ $_ } @re;
	$excluded{$dir} = 1;
	return 1;
    };
}

# The navigation tree that ucampas builds from $dir, as ucampas-navtest
# prints it. That has to happen in a process of its own, and not merely for
# tidiness: NavTree reads each uconfig.txt file at most once per run and keeps
# what it made of it, so a second reading here would hand back the tree as it
# stood before the rewrite, and every check would pass without looking at
# anything.
sub navdump {
    my ($dir) = @_;
    my $cmd = "$RealBin/ucampas-navtest";
    my $d;

    open($d, '-|', $cmd, '--dump', $dir)
	or die("Cannot run '$cmd': $!\n");
    binmode($d);
    my $out = do { local $/; <$d> };
    close($d)
	or die("'$cmd --dump $dir' failed, so nothing has been checked" .
	       ($? >> 8 ? sprintf(" (exit %d)", $? >> 8) : '') . "\n");
    return $out // '';
}

# Report how the navigation tree came to differ, as a unified diff of the two
# readings, which is a good deal easier to read than the files that produced
# it: what changed here is what the site says, and the file it is written in
# hardly matters.
sub show_view_diff {
    my ($before, $after) = @_;
    my @tmp = map {
	my $t = File::Temp->new(TEMPLATE => 'uconfig-tidy-XXXXXXXX', TMPDIR => 1);
	binmode($t);
	print $t $_;
	$t->flush;
	$t;
    } ($before, $after);
    my $d;

    open($d, '-|', 'diff', '-u', '--', map { $_->filename } @tmp)
	or return;
    binmode($d);
    my @out = <$d>;
    close($d);
    splice(@out, 0, 2)
	if @out >= 2 && $out[0] =~ /^--- / && $out[1] =~ /^\+\+\+ /;
    print STDERR "--- the navigation tree before the run\n";
    print STDERR "+++ and after it\n";
    print STDERR @out;
}

my $verify_failed = 0;

# Compare the navigation tree against the reading taken before the run. What
# the run is allowed to change is where the tree is written down, never what
# it says, so any difference at all is a failure.
sub verify_view {
    my ($dir, $before) = @_;

    my $after = navdump($dir);
    return if $after eq $before;
    $verify_failed = 1;
    print STDERR "\n$dir: the navigation tree is not what it was, so this " .
	"run has changed the site\n";
    show_view_diff($before, $after);
}

my $excluder;    # the predicate built from @exclude for the argument in hand
my %stopped;     # directories the descent left alone, marked stoprecursion

# Say what was left out, so that a run which covered less than the whole tree
# does not read as one that covered all of it. This goes for a dump as much
# as for a rewrite: a dump that quietly stops short is worse still, being
# read as the whole of what the tree says.
sub report_left_out {
    for my $left ([ \%excluded, 'that --exclude matched' ],
		  [ \%stopped,  'marked stoprecursion' ]) {
	my ($what, $why) = @$left;
	next unless %$what;
	printf STDERR "left out %d director%s %s\n", scalar keys %$what,
	    (keys %$what == 1 ? 'y' : 'ies'), $why;
	if ($verbose) {
	    print STDERR "  $_\n" for sort keys %$what;
	}
    }
}

my %total = (created => [], modified => [], removed => []);
my @kept;        # the "~" backup copies that -b has kept
my @orphaned;    # the files --orphans found the navigation tree does not reach

# Record what one save reported, and which backups it kept. The 'backup'
# option hash is per call, as each save fills in its own 'files' key.
sub tally {
    my ($changed, $opt) = @_;

    push @{$total{$_}}, @{$changed->{$_}} for keys %total;
    push @kept, @{$opt->{backup}{files}}
	if ref $opt->{backup} eq 'HASH' && $opt->{backup}{files};
}

# Rewrite the single file $fn in normalized form, moving nothing between
# files. change_check would here compare what was just read against itself,
# and so always decline; what keeps this from touching a file that is
# already normalized is the byte comparison inside commit_plan().
sub tidy_file {
    my ($fn) = @_;

    my $root = NavTree->new;
    $root->load_uconfig($fn) or die("'$fn': no such file\n");
    my %opt = (backup => $backup ? {} : 0, change_check => 0,
	       dryrun => $dryrun, diff => $diffcb);
    tally($root->save_uconfig($fn, \%opt), \%opt);
}

# Rewrite every uconfig.txt file the navigation tree below $dir reaches,
# each on its own. Reading the tree is what establishes which files those
# are; nothing then moves between them, so each file is its own
# transaction, which is the granularity at which they are independent.
sub tidy_tree {
    my ($dir) = @_;

    my %load = (exclude => $excluder, stopped => \%stopped);
    NavTree->new->load_uconfigs($dir, \%load);
    tidy_file($_) for @{$load{files}};
}

# Print the whole tree below $dir as one file would hold it: the text that
# --pushup writes, without writing it. Reading the tree and rendering it are
# all that mode does besides, so this is the same text, ordered the same way.
# It is not what ucampas-navtest --dump prints, which is the tree ucampas
# builds -- with the trailing slashes it puts on directory names, the fpath
# attributes it works out, the *glob() entries it expands and the global
# settings it inherits. This is only what the files themselves say.
sub dump_tree {
    my ($dir) = @_;

    my $root = NavTree->new;
    $root->load_uconfigs($dir, { exclude => $excluder, stopped => \%stopped });
    print $root->order_keys->print_uconfig;
}

# Read the whole tree below $dir and write it back out as the one file it
# started from, removing those that held the rest of it. Useful to see a
# whole tree at once, and as the other half of a round trip: pushed up and
# then down again, a tree should come back to what it was.
sub pushup_tree {
    my ($dir) = @_;

    my $root = NavTree->new;
    my %opt = (backup => $backup ? {} : 0, change_check => !$force,
	       dryrun => $dryrun, diff => $diffcb, exclude => $excluder,
	       stopped => \%stopped);
    # the load says which files are the tree's, and so which ones the write
    # may remove: a uconfig.txt below $dir that the tree never reaches is
    # none of its business
    $root->load_uconfigs($dir, \%opt);
    tally($root->save_uconfig_flat($dir, \%opt), \%opt);
}

# Read the whole tree below $dir and write it back out with save_uconfigs(),
# which moves each attribute and list element as deep into the existing
# subdirectories as it can. That is what creates a uconfig.txt in a
# directory which had none, and removes one left with nothing to say. The
# whole tree is rewritten as a single transaction, since content moves
# between its files and a partial rewrite could lose some of it.
sub pushdown_tree {
    my ($dir) = @_;

    my $root = NavTree->new;
    my %opt = (backup => $backup ? {} : 0, change_check => !$force,
	       dryrun => $dryrun, diff => $diffcb, exclude => $excluder,
	       stopped => \%stopped);
    # one option hash for both ends, so that the reading and the writing
    # descent are bound to leave out the very same directories
    $root->load_uconfigs($dir, \%opt);
    tally($root->save_uconfigs($dir, \%opt), \%opt);
}

# The version-control system that $dir is kept in, or undef. Both Subversion
# and git keep one marker at the root of a working copy, so look there and in
# every directory above; abs_path() because $dir may well be '.' or below it,
# which cannot be walked upwards as it stands.
sub vcs_of {
    my ($dir) = @_;
    my $path = abs_path($dir);

    while (defined $path && $path ne '') {
	return 'svn' if -e "$path/.svn";
	return 'git' if -e "$path/.git";
	$path =~ s{/[^/]*\z}{};
    }
    return undef;
}

# The commands that would tell the version-control system about the files
# this run created and removed, which is what it cannot work out for itself:
# a rewritten file it notices, an appeared or disappeared one it does not.
# They are only printed. Whether a file belongs under version control is the
# caller's decision and not a tidy-up's, and this tool is often pointed at a
# tree in mid-edit, where running them would sweep up more than the caller
# meant.
#
# "svn add --parents" also adds any directory on the way that is not yet
# under version control, which is what a uconfig.txt created in a newly
# listed directory needs, and which does nothing extra where they are all
# versioned already. It adds those directories alone, not what else they
# hold. git tracks files rather than directories and needs no counterpart.
my %vcs_cmd = (svn => { add => 'add --parents', rm => 'rm' },
	       git => { add => 'add',           rm => 'rm' });

sub vcs_hints {
    my @created = @{$total{created}};
    my @removed = @{$total{removed}};

    return () unless @created || @removed;
    (my $dir = ($created[0] // $removed[0])) =~ s{/[^/]*\z}{};
    my $vcs = vcs_of($dir eq '' ? '/' : $dir) or return ();
    return map { "$vcs $vcs_cmd{$vcs}{$_->[0]} " .
		     join(' ', map { shellquote($_) } @{$_->[1]}) }
	grep { @{$_->[1]} } ([ add => \@created ], [ rm => \@removed ]);
}

# $s as a single shell word, so that a path can be pasted as it is printed.
sub shellquote {
    my ($s) = @_;

    return $s if $s =~ m{\A[\w.,:+=%\@/-]+\z};
    $s =~ s/'/'\\''/g;
    return "'$s'";
}

for my $arg (@args) {
    my $dir = $arg;
    my $fn;
    if (-d $arg) {
	$dir =~ s|/+\z||;             # drop any trailing slash(es)
	$dir = '/' if $dir eq '';
	$fn = "$dir/uconfig.txt";
	die("no uconfig.txt found in '$dir'\n") unless -f $fn;
    } elsif (-f $arg) {
	$fn = $arg;
	$dir = $arg =~ m|(.*)/| ? $1 : '.';
    } else {
	die("'$arg': no such file or directory\n");
    }
    # the patterns describe a path below the argument, so each argument
    # needs a matcher of its own
    $excluder = exclude_matcher($dir, @exclude);
    # --dump and --orphans change nothing, and so have nothing for --verify
    # to check
    my $before = ($verify && !$orphans && !$dump) ? navdump($dir) : undef;
    if ($dump) {
	dump_tree($dir);
    } elsif ($orphans) {
	push @orphaned, NavTree::orphan_uconfigs($dir, { exclude => $excluder });
    } elsif ($pushup) {
	pushup_tree($dir);
    } elsif ($pushdown) {
	pushdown_tree($dir);
    } elsif ($recurse) {
	tidy_tree($dir);
    } else {
	tidy_file($fn);
    }
    verify_view($dir, $before) if defined $before;
}

# the backups --verify asked for have done their job once it has passed
if ($verify_backup && !$verify_failed) {
    unlink(@kept);
    @kept = ();
}

# --dump has said all it has to say on standard output; -q leaves that alone,
# as it does a diff, and silences only the note about what was left out
if ($dump) {
    report_left_out() unless $quiet;
    exit 0;
}

# --orphans changes nothing and so has nothing of the below to report. An
# empty one is a leftover to be deleted; one with content is more likely a
# page that was meant to be reachable, so say which is which. Under -q the
# exit status carries the answer on its own.
if ($orphans) {
    unless ($quiet) {
	printf STDERR "%d uconfig.txt file%s that the navigation tree does " .
	    "not reach\n", scalar @orphaned, (@orphaned == 1 ? '' : 's');
	print STDERR "  $_", (-s $_ ? '' : '   (empty)'), "\n" for @orphaned;
    }
    exit(@orphaned ? 1 : 0);
}

exit($verify_failed ? 1 : 0) if $quiet;

printf STDERR $dryrun ? "%d to create, %d to modify, %d to remove\n"
			: "%d created, %d modified, %d removed\n",
    map { scalar @{$total{$_}} } qw(created modified removed);
# Name the files, in the letters a version-control system uses for them:
# with -v every one that changed, and otherwise only those that appeared
# and disappeared, as those are the ones such a system still has to be told
# about. One file changes at most once per run, so a path names one letter.
my %letter = (created => 'A', modified => 'M', removed => 'D');
my %status;
for my $what ($verbose ? qw(created modified removed) : qw(created removed)) {
    $status{$_} = $letter{$what} for @{$total{$what}};
}
print STDERR "$status{$_}  $_\n" for sort keys %status;
printf STDERR "kept %d backup file%s (*~)\n", scalar @kept,
    (@kept == 1 ? '' : 's') if @kept;
report_left_out();

# Spell out what the version-control system still has to be told. Not after a
# dry run, where nothing has appeared or disappeared yet and the commands
# would only fail if they were pasted.
my @hint = $dryrun ? () : vcs_hints();
if (@hint) {
    print STDERR "\nstill to tell the version-control system:\n";
    print STDERR "  $_\n" for @hint;
}

# Where the check failed the tree has already been rewritten, so say where
# the version it replaced has been left. Nothing is put back automatically:
# which of the two trees is the one to keep is not for this to decide.
if ($verify_failed) {
    print STDERR "\nthe files this run rewrote or removed are kept beside " .
	"them, as *~\n" if @kept;
    print STDERR "the files it created are named above and are not " .
	"backed up anywhere\n" if @{$total{created}};
}
exit($verify_failed ? 1 : 0);
