view release on metacpan or  search on metacpan

script/phoebe-ctl  view on Meta::CPAN

This will create HTML files in F</home/alex/transjovian.org>,
F</home/alex/transjovian.org/phoebe>, F</home/alex/transjovian.org/gemini>, and
F</home/alex/transjovian.org/titan>.

Note that the I<links> in these HTML files do not include the F<.html> extension
(e.g. C</test>), so this relies on your web server doing the right thing: if a
visitor requests C</test> the web server must serve F</test.html>. If that
doesn't work, perhaps using C<--no-extension> is your best bet: the HTML files
will be written without the F<.html> extension. This should also work for local
browsing, although it does look strange, all those pages with the F<.html>
extension.

=cut

package Gemini::Wiki::Control;
use Modern::Perl '2018';
use File::Slurper qw(read_dir read_lines read_text 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";
my @sources;
my $target;
my $no_extension;
GetOptions (
  "log=i" => \$log,
  "wiki_dir=s" => \$dir,
  "source=s" => \@sources,
  "target=s" => \$target,
  "no-extension" => \$no_extension, );
@sources = ("") unless @sources;

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

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") {