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/&/&/g;
$html =~ s/</</g;
$html =~ s/>/>/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) = /^=>\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 (/^>\s*(.*)/) { # quoted HTML!
push @lines, "</ul>" if $list;
$list = 0;
( run in 0.675 second using v1.01-cache-2.11-cpan-39bf76dae61 )