App-phoebe

 view release on metacpan or  search on metacpan

script/phoebe-ctl  view on Meta::CPAN

  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>";
      say $fh "<body>";
      say $fh "<h1>" . quote_html($id) . "</h1>";
      say $fh to_html($text);
      # skipping footers
      say $fh "</body>";
      say $fh "</html>";
    }
  }
}

sub quote_html {
  my $html = shift;
  $html =~ s/&/&amp;/g;
  $html =~ s/</&lt;/g;
  $html =~ s/>/&gt;/g;
  $html =~ s/[\x00-\x08\x0b\x0c\x0e-\x1f]/ /g; # legal xml: #x9 | #xA | #xD | [#x20-#xD7FF] | [#xE000-#xFFFD] | [#x10000-#x10FFFF]
  return $html;
}

# returns lines!
sub to_html {
  my $text = shift;
  my @lines;
  my $list;
  my $code;
  for (split /\n/, quote_html($text)) {
    if (/^```(?:type=([a-z]+))?/) {
      my $type = $1||"default";
      if ($code) {
	push @lines, "</pre>";
	$code = 0;
      } else {
	push @lines, "</ul>" if $list;
	$list = 0;
	push @lines, "<pre class=\"$type\">";
	$code = 1;
      }
    } elsif ($code) {
      push @lines, $_;
    } elsif (/^\* +(.*)/) {
      push @lines, "<ul>" unless $list;
      push @lines, "<li>$1";
      $list = 1;
    } elsif (my ($url, $text) = /^=&gt;\s*(\S+)\s*(.*)/) { # quoted HTML!
      push @lines, "<ul>" unless $list;
      $text ||= $url;
      push @lines, "<li><a href=\"$url\">$text</a>";
      $list = 1;
    } elsif (/^(#{1,6})\s*(.*)/) {
      push @lines, "</ul>" if $list;
      $list = 0;
      my $level = length($1);
      push @lines, "<h$level>$2</h$level>";
    } elsif (/^&gt;\s*(.*)/) { # quoted HTML!
      push @lines, "</ul>" if $list;
      $list = 0;



( run in 0.675 second using v1.01-cache-2.11-cpan-39bf76dae61 )