#!/usr/bin/env perl
# Copyright (C) 2017–2020  Alex Schroeder <alex@gnu.org>

# This program is free software: you can redistribute it and/or modify it under
# the terms of the GNU Affero General Public License as published by the Free
# Software Foundation, either version 3 of the License, or (at your option) any
# later version.
#
# This program is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
# FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
# details.
#
# You should have received a copy of the GNU Affero General Public License along
# with this program. If not, see <https://www.gnu.org/licenses/>.

=encoding utf8

=head1 Gemini Wiki Control

This script helps you maintain your Gemini Wiki installation.

=head2 Options

=over

=item C<--wiki_dir=./wiki>

This the wiki data directory to use; the default is either the value of the
C<GEMINI_WIKI_DATA_DIR> environment variable, or the C<./wiki> subdirectory. Use
it to specify a space, too.

=item C<--log=4>

This is the log level to use. 1 only prints errors; 2 also prints warnings (this
is the default); 3 prints any kind of information; 4 prints all sorts of info
the developer wanted to see as they were fixing bugs.

=back

=head2 Commands

=over

=item C<help>

This is what you're reading right now.

=item C<update-changes>

This command looks at all the pages in the F<page> directory and generates new
entries for your changes log into F<changes.log>.

=item C<erase-page>

This command removes pages from the F<page> directory, removes all the kept
revisions in the F<keep> directory, and all the mentions in the F<change.log>.
Use this if spammers and vandals created page names you want to eliminate.

=back

=cut

package Gemini::Wiki::Control;
use Modern::Perl '2018';
use File::Slurper qw(read_dir read_lines write_text);
use Encode qw(encode_utf8 decode_utf8);
use Getopt::Long;
use Pod::Text;
use File::Path qw(remove_tree);
use utf8;

binmode(STDOUT, ":utf8");

my $log = 2;
my $dir = "./wiki";
GetOptions (
  "log=i" => \$log,
  "wiki_dir=s" => \$dir, );

my $subcommands = {
  "help" => 0,
  "update-changes" => \&update_changes,
  "erase-page" => \&erase_page, };

my $subcommand;
$subcommand = shift(@ARGV) if @ARGV;
die "No subcommand\n" unless $subcommand;
$subcommand = $subcommands->{$subcommand};
die "No known subcommand\n" unless defined $subcommand;
if (not $subcommand) {
  my $parser = Pod::Text->new();
  $parser->parse_file($0);
  exit;
}

$subcommand->(@ARGV);

exit;

sub update_changes {
  my %pages;
  my $now = time;
  $pages{decode_utf8($_)} = modified("$dir/page/$_.gmi") for map { s/\.gmi$//; $_ } grep /\.gmi$/, read_dir("$dir/page");
  say "Read " . scalar(keys %pages) . " pages" if $log >= 3;
  say join("\n", map { $_ . "\t" . $pages{$_} } sort keys %pages) if $log >= 4;
  my %files;
  $files{decode_utf8($_)} = modified("$dir/file/$_") for read_dir("$dir/file");
  say "Read " . scalar(keys %files) . " files" if $log >= 3;
  say join("\n", map { $_ . "\t" . $files{$_} } sort keys %files) if $log >= 4;
  my %revisions;
  my %changes;
  for (read_lines("$dir/changes.log")) {
    my ($ts, $id, $revision) = split(/\x1f/);
    $revisions{$id} = $revision;
    if ($revision) {
      $changes{$id} = $ts;
    } else {
      $changes{$id . "\x1c"} = $ts;
    }
  };
  say "Read " . scalar(keys %changes) . " changes" if $log >= 3;
  say join("\n", map { $_ . "\t" . $changes{$_} } sort keys %changes) if $log >= 4;
  open(my $fh, ">>:encoding(UTF-8)", "$dir/changes.log") or die "Cannot write $dir/changes.log: $!";
  for (keys %pages) {
    if (not $changes{$_} or $pages{$_} > $changes{$_}) {
      say "Page $_ is added to changes" if $log >= 4;
      my $revision = $revisions{$_} || 0;
      say $fh join("\x1f", $now, $_, 1 + $revision, "0000");
      utime($now, $now, "$dir/page/$_.gmi") or warn "Could not set utime for $dir/page/$_.gmi\n";
    }
  }
  for (keys %files) {
    if (not $changes{$_ . "\x1c"} or $files{$_} > $changes{$_ . "\x1c"}) {
      say "File $_ is added to changes" if $log >= 4;
      say $fh join("\x1f", $now, $_, 0, "0000");
      utime($now, $now, "$dir/file/$_") or warn "Could not set utime for $dir/file/$_\n";
    }
  }
  close($fh);
}

sub modified {
  my $ts = (stat(shift))[9];
  return $ts;
}

sub erase_page {
  my @page = @_;
  die "You need to list the pages to erase\n" unless @page;
  for my $page (@page) {
    if (not -f "$dir/page/$page.gmi") {
      warn "$page does not exist\n";
      next;
    }
  }
  my $n = unlink map { "$dir/page/$_.gmi" } @page;
  warn "Deleted $n pages: $!\n" if $n < @page;
  my @dirs = grep { -d } map { "$dir/keep/$_" } @page;
  remove_tree(@dirs, { safe => 1});
  if (-f "$dir/changes.log") {
    my @log = grep {
      my ($ts, $id, $revision, $code) = split(/\x1f/);
      0 == grep { $id eq $_ } @page; # only keep log lines that are not mentioned
    } read_lines("$dir/changes.log");
    rename("$dir/changes.log", "$dir/changes.log~")
	or die "Cannot rename $dir/changes.log to changes.log~: $!";
    write_text("$dir/changes.log", join("\n", @log));
  }
  if (-f "$dir/index") {
    my @index = grep {
      my $id = $_;
      0 == grep { $id eq $_ } @page; # only keep index pages that are not mentioned
    } read_lines("$dir/index");
    rename("$dir/index", "$dir/index~")
	or die "Cannot rename $dir/index to index~: $!";
    write_text("$dir/index", join("\n", @index));
  }
}
