view release on metacpan or  search on metacpan

examples/definitionlists  view on Meta::CPAN

#!/usr/bin/env perl

# Copyright (c) 2015-2020 Christian Jaeger, copying@christianjaeger.ch
# This is free software. See the file COPYING.md that came bundled
# with this file.

use strict;
use warnings;
use warnings FATAL => 'uninitialized';
use experimental "signatures";

#use Sub::Call::Tail;

# find modules from functional-perl working directory (not installed)
use Cwd 'abs_path';
our ($mydir, $myname);

BEGIN {
    my $location = (-l $0) ? abs_path($0) : $0;
    $location =~ /(.*?)([^\/]+?)_?\z/s or die "?";
    ($mydir, $myname) = ($1, $2);
}
use lib "$mydir/../lib";

sub usage {
    print "usage: $myname inputfile.txt output.xhtml

  Turn markdown kind of list syntax into something that htmldoc will
  show right.

";
    exit 1;
}

use Getopt::Long;
our $verbose = 0;
GetOptions("verbose" => \$verbose, "help" => sub {usage},) or exit 1;
usage unless @ARGV == 2;

my ($infile, $outfile) = @ARGV;

use FP::Predicates qw(is_string);
use FP::List qw(mixed_flatten);
use FP::PureArray;
use Chj::TEST ":all";
use Chj::xIOUtil qw(xgetfile_utf8 xputfile_utf8);
use PXML::XHTML ":all";
use PXML::Serialize qw(puthtmlfile);
use PXML qw(is_pxml_element);    # XX: why does it not complain when
                                 # trying to import from PXML::Element?
use FP::Ops qw(the_method);

#debug
use FP::Ops ":all";              #qw(the_method);
use FP::Combinators ":all";
use Chj::ruse;

use FP::Struct
    'definitionlists::Match' => ["value"],
    'FP::Struct::Show';
use FP::Struct
    'definitionlists::NonMatch' => ["value"],
    'FP::Struct::Show';
use FP::Struct
    'definitionlists::Link' => ["txt", "url"],
    'FP::Struct::Show';
import definitionlists::Link::constructors;
import definitionlists::Match::constructors;
import definitionlists::NonMatch::constructors;

sub parselinks ($str, $processmatch = \&Link, $processnonmatch = \&NonMatch) {
    my $pos = 0;
    my @res;
    while ($str =~ /\[([^\[\]]+)\]\(([^()]+)\)/sgc) {
        my $len  = length($1) + length($2) + 4;
        my $pos1 = pos($str);
        my $pos0 = $pos1 - $len;
        if ($pos < $pos0) {
            push @res, &$processnonmatch(substr($str, $pos, $pos0 - $pos));
        }
        push @res, &$processmatch($1, $2);    # aheh difference
        $pos = $pos1;
    }
    my $pos1         = length($str);          #end.
    my $lenremainder = $pos1 - $pos;
    if ($lenremainder) {
        push @res, &$processnonmatch(substr($str, $pos, $pos1 - $pos));
    }
    array_to_purearray \@res
}

TEST {
    parselinks "foo"
}
purearray(NonMatch('foo'));

TEST {
    parselinks "[fun](World)"
}
purearray(Link('fun', 'World'));

TEST {
    parselinks "a [fun](World) world"
}
purearray(NonMatch("a "), Link('fun', 'World'), NonMatch(" world"));

sub parse ($str, $processmatch, $processnonmatch) {