view release on metacpan or  search on metacpan

script/phoebe-ctl  view on Meta::CPAN

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

sub html_export {
  die "You need to provide a target directory for the HTML files using --target=directory\n" unless $target;
  for my $source (@sources) {
    my $source_dir = "$dir$source";
    die "Source directory $source_dir does not exist\n" unless -d $source_dir;
    my $target_dir = "$target$source";
    mkdir $target_dir or die "Cannot create target directory $target_dir: $!\n"
	unless -d $target_dir;
    for my $page (map { s/\.gmi$//; $_ } grep /\.gmi$/, read_dir("$source_dir/page")) {
      my $id = decode_utf8 $page;
      my $text = read_text("$source_dir/page/$page.gmi"); # fatal if it does not exist
      say "Converting $id";
      my $filename = "$target_dir/$page";
      $filename .= ".html" unless $no_extension;
      open(my $fh, ">:utf8", $filename)
	  or die "Cannot write $filename: $!\n";
      say $fh "<!DOCTYPE html>";
      say $fh "<html>";
      say $fh "<head>";
      say $fh "<meta charset=\"utf-8\">";
      say $fh "<title>" . quote_html($id) . "</title>";
      say $fh "<link type=\"text/css\" rel=\"stylesheet\" href=\"/default.css\"/>";
      say $fh "<meta name=\"viewport\" content=\"width=device-width, initial-scale=1\">";
      say $fh "</head>";