#!/usr/local/bin/perl-latest # A processor to assist in making blog posts. # # Takes no options, reads from stdin, writes to stdout. # # The only invisible / automatic action is: if the first # line does not start with . or < and is non-blank, it # will be wrapped with
aragraph # .p TYPE start a
# ./p end a paragraph # .pp [TYPE] like a "./p" ".p [TYPE]" pair # .d start a
, .pre or ``` at the start of a line, input is copied # to output until seeing a start-of-line, ./pre, or ```. The # start .pre or ``` line can have a class name. # # Regular html
]*>)%% ) {
$o .= $1;
} else {
# include rest of line; properly we should remember
# we are in a block for not interpreting * or _
# on next line(s), but qzpostfilt is works only with
# around single line state for inline formatting
$o .= $l;
$l = '';
}
next;
}
}
# consume all markup-free content to first <, then restart loop
if ( $l =~ s/^([^*_`<]+) ) {
$o .= $1;
next;
}
# consume all markup-free content on a line with no <
if ( $l =~ s/^([^*_`]+)// ) {
$o .= $1;
}
# line is empty or starts with *, _, or ` now
# code should be higher priority than * or _ and not recurse
if ( $l =~ s/^`// ) {
if ($l =~ s%^([^`]+)`%% ) {
# found end, real code block
$o .= "$1
";
} else {
$o .= '`';
}
next;
}
if ( $l =~ s/^\*// ) {
if ($l =~ s%^([^*]+)\*%$1% ) {
1; # substitution worked!
} else {
$o .= '*';
}
next;
}
if ( $l =~ s/^_// ) {
if ($l =~ s%^([^_]+)_%$1% ) {
1; # substitution worked!
} else {
$o .= '_';
}
next;
}
# break infinite loops
$safety --;
if($safety == 0) {
if ($save eq $l) {
warn "Save is: $save\n";
die "$0: forever loop in consume, line $.\n";
}
$save = $l;
$safety = 100;
}
} # consume loop
print "$nl$o";
} # end &consume
sub preblock {
my $where = shift;
my $rest = shift;
# maybe use line numbers someday
$in_pre ++;
if ($where eq 'start') {
if ($rest =~ s/^\s*(\w[-\w]+)//) {
print qq(\n);
} else {
print "\n";
}
return;
}
if ($rest =~ s%^(?:[.<]/pre>?|```)%%i) {
$in_pre = 0;
print '
';
if ($rest =~ /\S/) {
consume($rest);
}
return;
}
print $rest;
} # end &preblock
sub ahref {
my $rest = shift;
my $url;
my $text = '';
my $post = '';
($rest =~ s/\s*(\S+)//) or return;
$url = $1;
print qq(\nlink text.
if ($text =~ s/(\w)([.,;:!?])$/$1/) {
$post = $2;
}
}
}
if (0 == length($text)) {
$text = $url;
}
if ($rest =~ /=/) {
print $rest;
}
print '>';
consume($text, '');
print "$post";
} # end &ahref
sub image {
my $rest = shift;
my $img;
($rest =~ s/\s*(\S+)//) or return;
$img = $1;
$img =~ s/^http:/https:/;
if ($img !~ m%^(?:https:)?/%) {
# not an absolute path, prefix
$img = "$imgpath/$img";
}
print qq(\n';
} # end &image
sub tag {
my $tl = shift;
my $safety = 100;
my $save = '';
while( length($tl) ) {
# eat initial whitespace
$tl =~ s/^\s+//;
# peel off an initial "double quoted" tag
if ($tl =~ s/^"([^"]*)"//) {
if (length($1)) { $tags .= "\n$1"; }
}
# peel off an initial non-quoted tag
if ($tl =~ s/^([^\s"]\S*)//) {
$tags .= "\n$1";
}
# deal with chance of non-matching quotes
if ($tl =~ s/^"([^"]*)$//) {
if (length($1)) { $tags .= "\n$1"; }
}
# break infinite loops
$safety --;
if($safety == 0) {
if ($save eq $tl) {
die "$0: forever loop in tags, line $.\n";
}
$save = $tl;
$safety = 100;
}
}
} # end &tag
sub dealwithtags {
# Have tags, can't save them? ERROR
if (length($tags) and !defined($tagfile)) {
die "$0: no where to save tags\n";
}
# No tags with or without somewhere to save them? No problem.
if (!defined($tagfile) or $tags eq '') {
return;
}
if ($tagfile !~ m:[.][^./]+$:) {
$tagfile = "$tagfile.$tagsuf";
}
if ($tagfile !~ m:^/:) {
$tagfile = "$datadir/$tagfile";
}
$tags .= "\n";
$tags =~ s/^\n+//;
$tags =~ s/\n+/\n/g;
my $tf;
if (!open($tf, '>', $tagfile)) {
die "$0: cannot save tags to $tagfile: $!\n";
}
print $tf $tags;
close $tf;
} # end &dealwithtags
__END__