#!/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

...

. # # The syntax borrows from both the style of *roff and from # markdown. Common inline things like `code`, _italic_, and # *bold* use in-line markdown-style syntax. Markdown style # syntax does not cross line bondaries. So the "*roff" in # the first line renders as-is, it doesn't create a bolded # stretch to the word "*bold*". # # Block level syntax use [nt]roff style commands, where in # the examples [this] means "this" is an optional something. # # .p start a

aragraph # .p TYPE start a

# ./p end a paragraph # .pp [TYPE] like a "./p" ".p [TYPE]" pair # .d start a

# .d TYPE start a
# ./d end a
# .ol [TYPE] start an ordered list, with optional class # ./ol end an ordered list # .ul [TYPE] start an unordered list, with optional class # ./ul end an unordered list # .dl [TYPE] start an unordered list, with optional class # ./dl end an unordered list # * (space asterisk space) start
  • (like markdown) # /* (space slash asterisk space) end
  • # .dt (space asterisk space) start
    # ./dt (space slash asterisk space) end
    # .dd (space asterisk space) start
    # ./dd (space slash asterisk space) end
    # # In general, for block level commands, when the first thing on a line: # .FOO yeilds # .FOO BAR yeilds # .FOO BAR BAZ=QUX yeilds # ./FOO yeilds # # Closing ./FOO tags will "eat" one newline before them. # # Noteworthy exceptions (besides .d for div) # # .a linkurl "link _text_ here." [foo=bar] # yeilds # link text here. # (trailing punctuation moved outside automatically) # # .i filename "alt text" [foo=bar] # yeilds # alt text # .br yeilds
    # .t TAG [TAG ...] puts those tags in a tags file # tags can have spaces, "double quote" those # .tf path/name where to save those tags # # After 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 and &entities; are left alone, for complex # formatting. It is assumed the user is trusted. It's presumed that # for both regular typing and cellphone typing using .FOO is less # work to enter than , so the short cuts will be useful. Also # you can ":set paragraphs=p\ hrbri\ d" and the the { and } paragraph # motions will work using .p, .hr, .br, .i, and .d as paragraph starts. # (The setting is a list of character *pairs* that follow a . in the # first column. Made tricky by " starting a comment in the settings. # # 19 March 2020 use strict; use warnings; # config { # default directory for images (no final /) my $imgpath = '/qz/img'; # root directory for relative tags file path my $datadir = '/htdocs/userdirs/eli/qz/data/'; # tags suffix (if none provided on .tf line) my $tagsuf = '.tags'; # } end config my $tags = ''; my $tagfile; my $in_pre = 0; while(<>) { my $sol = "\n"; if ($in_pre) { preblock('in', $_); next; } # we print a newline before text to output # unless it is a "eat a newline" close tag chomp; # first line special if ($. == 1) { # if not starting with . or < and has content if (! /^[.<]/ and /\S/) { s%(.*)%

    $1

    %; print; next; } # fall-thru if those conditions not met $sol = ""; } # deal with a . line if (s%^\s*[.](/?\w+)%%) { my $action = $1; if (lc($action) eq 'pre') { preblock('start', $_); } else { dotline($1, $_, $sol); } next; } # deal with a ``` line if (s%^```%%) { preblock('start', $_); next; } # deal with
  • markers s/^\s+\*\s/
  • /; s%^\s+/\*(\s|$)%
  • %; # deal with the line piecemeal consume($_, $sol); } # main while loop # final newline print "\n"; dealwithtags(); exit; sub dotline { my $action = shift; my $rest = shift; my $nl = shift; my $end = '>'; if ($action eq 'a') { ahref($rest); return; } if ($action eq 'i') { image($rest); return; } if ($action eq 't') { tag($rest); return; } if ($action eq 'tf') { $tagfile = $rest; $tagfile =~ s/^\s+//; $tagfile =~ s/\s+$//; return; } if ($action eq 'd' ) { $action = 'div'; } if ($action eq '/d') { $action = '/div'; } if ($action eq 'pp') { $action = 'p'; print '

    '; } if ($action =~ m:^/:) { print "<$action>"; return; } if ($action eq 'hr' or $action eq 'br') { $end = ' />'; } print "$nl<$action"; if (s/\s+(\S+)//) { print qq( class="$1"); } if(/=/) { print $_; } print $end; } # end &dotline sub consume { my $l = shift; my $nl = shift; my $o = ''; my $safety = 100; my $save = ''; while( length($l) ) { # deal with leading
    eating newlines if ( $o eq '' and $l =~ s%^\s*(]*>)%% ) { my $found = $1; $o .= $found; if ( $found =~ /]*>)%% ) { $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/^([^*_`<]+)$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$1'; } # 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__