view release on metacpan or  search on metacpan

lib/App/Mowyw.pm  view on Meta::CPAN

package App::Mowyw;
use strict;
use warnings;
#use warnings FATAL => 'all';

our $VERSION = '0.8.0';

use App::Mowyw::Lexer qw(lex);
use App::Mowyw::Datasource;

use File::Temp qw(tempfile);
use File::Compare;
use Carp;
use Storable qw(dclone);
use Scalar::Util qw(reftype blessed);
use File::Copy;
use Encode qw(encode decode);
use Config::File qw(read_config_file);

use Exporter qw(import);
use Data::Dumper;
use Carp qw(confess);
binmode STDOUT, ':encoding(UTF-8)';

our @EXPORT_OK = qw(
        get_config
        parse_file
        process_dir
        process_file
        parse_str
        parse_all_in_dir
);

our %config = (
        default => {
            include => 'includes/',
            source  => 'source/',
            online  => 'online/',
            postfix => '',
        },
        encoding    => 'utf-8',
        file_filter => [
            [1, 10, qr{\..?htm}],
        ],
);
$config{default}{menu} = $config{default}{include} . 'menu-';

my $internal_error_message = "Please contact the Author at moritz\@faui2k3.org providing\nan example how to reproduce the error, including the complete error message";

my @input_tokens = (
        [ 'TAG_START',      qr/\[\[\[\s*/],
        [ 'TAG_START',      qr/\[\%\s*/],
        [ 'KEYWORD',        qr/(?:
             include
            |menu
            |system
            |option
            |item
            |endverbatim
            |verbatim
            |comment
            |setvar
            |readvar
            |synatxfile
            |syntax
            |endsyntax
            |bind
            |for
            |endfor
            |ifvar
            |endifvar
            )/x                         ],
        [ 'TAG_END',        qr/\s*\]\]\]/],
        [ 'TAG_END',        qr/\s*\%\]/],
        [ 'BRACES_START',   qr/\{\{/],
        [ 'BRACES_END',     qr/\}\}/],
    );

sub parse_all_in_dir {
    my @todo = @_;
    while (defined(my $fn = pop @todo)){
        $fn .= '/' unless ($fn =~ m#/$#);
        opendir my $DIR, $fn or die "Cannot opend directory '$fn' for reading: $!";

lib/App/Mowyw.pm  view on Meta::CPAN

#        warn "Reading global include file '$global_include_fn'\n";
        $meta->{FILES} = [$global_include_fn];
        # use parse_file for its side effects on meta
        my $g = parse_file($global_include_fn, $meta);
    }
    # replace call stack
    # otherwise all files seem to be included from the globl include file,
    # which is somewhat ugly
    $meta->{FILES} = [];
    return $meta;
}


sub process_file {
    my ($fn, $config) = @_;

    my $new_fn = get_online_fn($fn);

    # process file at all?
    my $process = 0;
#    use Data::Dumper;
#    print Dumper $App::Mowyw::config{file_filter};
    for my $f(@{$App::Mowyw::config{file_filter}}){
        my ($include, undef, $re) = @$f;
        if ($fn =~ m/$re/){
            $process = $include;
            last;
        }
    }

#    print +($process ? '' : 'not '), "processing file $fn\n";

    if ($process){

        if ($config{make_behaviour} and  -e $new_fn and (stat($fn))[9] < (stat($new_fn))[9]){
            return;
        }
        print STDERR "Processing File '$fn'..." unless $config{quiet};

        my $metadata = get_meta_data($fn);
        push @{$metadata->{FILES}}, $fn;
        my $str = parse_file($fn, $metadata);
#       print Data::Dumper->Dump([$metadata]);
        my $header = "";
        my $footer = "";

#       warn $str;
        unless (exists $metadata->{OPTIONS}{'no-header'}){
            my $m = my_dclone($metadata);
            my $header_fn = get_include_filename('include', 'header', $fn);
            unshift @{$m->{FILES}}, $header_fn;
            $header = parse_file($header_fn, $m);
        }
        unless (exists $metadata->{OPTIONS}{'no-footer'}){
            my $m = my_dclone($metadata);
            my $footer_fn = get_include_filename('include', 'footer', $fn);
            unshift @{$m->{FILES}}, $footer_fn;
            $footer = parse_file($footer_fn, $metadata);
        }
        my ($tmp_fh, $tmp_name) = tempfile( UNLINK => 1);
        binmode $tmp_fh, ":encoding($config{encoding})";
        print $tmp_fh $header, $str, $footer;
        close $tmp_fh;
        if (compare($new_fn, $tmp_name) == 0){
            print STDERR " not changed\n" unless $config{quiet};
        } else {
            copy($tmp_name, $new_fn);
            print STDERR " done\n" unless $config{quiet};
        }
    } else {
        if (compare($fn, $new_fn) == 0){
            # do nothing
        } else {
            copy($fn, $new_fn);
            print "Updated file $new_fn (not processed)\n";
        }
    }
}


sub get_online_fn {
    my $fn = shift;
    my $new_fn = $fn;
    $new_fn =~ s{^$config{default}{source}}{};
    {
        my $found = 0;
        for ( keys %{$config{per_fn}} ){
            if ( $new_fn =~ m/$_/ ){
                $found = 1;
                $new_fn = $config{per_fn}{$_}{online} . $new_fn;
                last
            }
        }
        if ($found == 0){
            $new_fn = $config{default}{online} . $new_fn;
        }
    }
    return $new_fn;

}

sub get_config {
    my $cfg_file = 'mowyw.conf';
    if (-e $cfg_file) {
        my $conf_hash = read_config_file($cfg_file); 
#       print Dumper $conf_hash;
        return transform_conf_hash($conf_hash);
    } else {
        print "No config file '$cfg_file'\n";
        return {};
    }
}

sub transform_conf_hash {
    my ($h) = @_;
    my %nh;
#   no warnings 'uninitialized';
    my %d = %{$config{default}};
    for (keys %{$h->{MATCH}}){
        my $key = $h->{MATCH}{$_};
        for my $feat (qw(include menu postfix online)){