view release on metacpan or  search on metacpan

lib/App/Basis/ConvertText2.pm  view on Meta::CPAN

=head1 NAME

App::Basis::ConvertText2

=head1 SYNOPSIS

TO be used in conjuction with the supplied ct2 script, which is part of this distribution.
Not really to be used on its own.

=head1 DESCRIPTION

This is a perl module and a script that makes use of %TITLE%

This is a wrapper for [pandoc] implementing extra fenced code-blocks to allow the
creation of charts and graphs etc.
Documents may be created a variety of formats. If you want to create nice PDFs
then it can use [PrinceXML] to generate great looking PDFs or you can use [wkhtmltopdf] to create PDFs that are almost as good, the default is to use pandoc which, for me, does not work as well.

HTML templates can also be used to control the layout of your documents.

The fenced code block handlers are implemented as plugins and it is a simple process to add new ones.

There are plugins to handle

    * ditaa
    * mscgen
    * graphviz
    * uml
    * gnuplot
    * gle
    * sparklines
    * charts
    * barcodes and qrcodes
    * and many others

See 
https://github.com/27escape/App-Basis-ConvertText2/blob/master/README.md
for more information.

=head1 Todo

Consider adding plugins for 

    * http://blockdiag.com/en/index.html, 
    * https://metacpan.org/pod/Chart::Strip
    * https://metacpan.org/pod/Chart::Clicker

=head1 Public methods

=over 4

=cut

# ----------------------------------------------------------------------------

package App::Basis::ConvertText2;
$App::Basis::ConvertText2::VERSION = '0.4';
use 5.10.0;
use strict;
use warnings;
use feature 'state';
use Moo;
use Data::Printer;
use Try::Tiny;
use Path::Tiny;
use Digest::MD5 qw(md5_hex);
use Encode qw(encode_utf8);
use Text::Markdown qw(markdown);
use GD;
use MIME::Base64;
use Furl;
use Module::Pluggable
    require          => 1,
    on_require_error => sub {
    my ( $plugin, $err ) = @_;
    warn "$plugin, $err";
    };
use App::Basis;
use App::Basis::ConvertText2::Support;

# ----------------------------------------------------------------------------
# this contents string is to be replaced with the body of the markdown file
# when it has been converted
use constant CONTENTS => '_CONTENTS_';
use constant PANDOC   => 'pandoc';
use constant PRINCE   => 'prince';
use constant WKHTML   => 'wkhtmltopdf';

my %valid_tags;

# ----------------------------------------------------------------------------
my $TITLE = "%TITLE%";

# ----------------------------------------------------------------------------

has 'name'    => ( is => 'ro', );
has 'basedir' => ( is => 'ro', );

lib/App/Basis/ConvertText2.pm  view on Meta::CPAN

# _extract_args
sub _extract_args {
    my $buf = shift;
    my ( %attr, $eaten );
    return \%attr if ( !$buf );

    while ( $buf =~ s|^\s?(([a-zA-Z][a-zA-Z0-9\.\-_]*)\s*)|| ) {
        $eaten .= $1;
        my $attr = lc $2;
        my $val;

        # The attribute might take an optional value (first we
        # check for an unquoted value)
        if ( $buf =~ s|(^=\s*([^\"\'>\s][^>\s]*)\s*)|| ) {
            $eaten .= $1;
            $val = $2;

            # or quoted by " or '
        }
        elsif ( $buf =~ s|(^=\s*([\"\'])(.*?)\2\s*)||s ) {
            $eaten .= $1;
            $val = $3;

            # truncated just after the '=' or inside the attribute
        }
        elsif ($buf =~ m|^(=\s*)$|
            or $buf =~ m|^(=\s*[\"\'].*)|s )
        {
            $buf = "$eaten$1";
            last;
        }
        else {
            # assume attribute with implicit value
            $val = $attr;
        }
        $attr{$attr} = $val;
    }

    return \%attr;
}

# ----------------------------------------------------------------------------
# add into the replacements list
sub _add_replace {
    my $self = shift;
    my ( $key, $val ) = @_;

    $self->{replace}->{ uc($key) } = $val;
}

# ----------------------------------------------------------------------------
sub _do_replacements {
    my $self = shift;
    my ($content) = @_;

    foreach my $k ( keys %{ $self->replace() } ) {
        next if ( !$self->{replace}->{$k} );

        # in the text the variables to be replaced are surrounded by %
        # zero width look behind to make sure the variable name has
        # not been escaped _%VARIABLE% should be left alone
        $content =~ s/(?<!_)%$k%/$self->{replace}->{$k}/gsm;
    }

    return $content;
}

# ----------------------------------------------------------------------------
sub _call_function {
    my $self = shift;
    my ( $block, $params, $content, $linepos ) = @_;
    my $out;

    if ( !$valid_tags{$block} ) {
        debug( "ERROR:", "no valid handler for $block" );
    }
    else {
        try {

            # buffer is a special construct to allow us to hold output of content
            # for later, allows multiple use of content or adding things to
            # markdown tables that otherwise we could not do

            # over-ride content with buffered content
            my $from = $params->{from} || $params->{from_buffer};
            if ($from) {
                $content = $self->{replace}->{ uc($from) };
            }

            my $to = $params->{to} || $params->{to_buffer};

            if ( $block eq 'buffer' ) {
                if ($to) {
                    $self->_add_replace( $to, $content );
                }
            }
            else {
                # do any replacements we know about in the content block
                $content = $self->_do_replacements($content);

                # run the plugin with the data we have
                $out = $valid_tags{$block}->process( $block, $content, $params, $self->cache_dir() );

                if ( !$out ) {

                    # if we could not generate any output, lets put the block back together
                    $out .= "~~~~{.$block " . join( " ", map {"$_='$params->{$_}'"} keys %{$params} ) . " }\n" . "~~~~\n";
                }
                elsif ($to) {

                    # do we want to buffer the output?
                    $self->_add_replace( $to, $out );

                    # option not to show the output
                    $out = "" if ( $params->{no_output} );
                }
            }
            $self->_append_output("$out\n") if ( defined $out );
        }
        catch {
            debug( "ERROR", "failed processing $block near line $linepos, $_" );