view release on metacpan or  search on metacpan

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

            |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: $!";
        IW: while (my $f = readdir $DIR){
            # ignore symbolic links and non-Readable files:
            next IW if (-l $f);
            # if we consider . and .., we loop infinetly.
            # and while we are at ignoring, we can ignore a few
            # other things as well ;-)
            if (
                       $f eq '..'
                    or $f eq '.'
                    or $f eq  '.svn'
                    or $f eq  '.git'
                    or $f =~ m{(?:~|\.swp)$}){
                next;
            }
            $f = $fn . $f;
            if (-d $f){
                push @todo, $f;
                process_dir($f);
            } else {
                process_file($f);
            }
        }
        closedir $DIR;
    }
}

sub process_dir {
    my $fn = shift;
    my $new_fn = get_online_fn($fn);
    mkdir $new_fn;
}

# strip leading and trailing whitespaces from a string 
sub strip_ws {
    my $s = shift;
    $s =~ s/^\s+//g;
    $s =~ s/\s+$//g;
    return $s;
}

sub escape {
    my $str = shift;
    my %esc = (
        "\\"    => '\\\\',
        "\t"    => '\t',
        "\n"    => '\n',
    );
    my $re = join '|', map quotemeta, keys %esc;
    $str =~ s/($re)/$esc{$1}/g;
    return $str;
}

sub parse_error {
    my $message = shift;
    my @filenames = @{shift()};
    my $token = shift;
    my $str = "Parse error in file '$filenames[0]': $message\n";
    if ($token) {
        $str .= "in line $token->[3] near'" . escape($token->[0]) ."'\n";
    }
    for (@filenames[0..$#filenames]) {
       $str .= "    ...included from file '$_'\n";
    }
    confess $str;
    exit 1;
}

# parse sub: anything is treated as normal text that does not start or end a
# command
# the second (optional) arg contains a hash of additional tokens that are
# treated as plain text
sub p_text {
    my $tokens = shift;
    my %a;
    %a = %{$_[0]} if ($_[0]);
    my $str = "";
    my %allowed_tokens = (
            KEYWORD => 1,
            UNMATCHED => 1,
            );

    while (     $tokens
            and $tokens->[0]
            and $tokens->[0]->[0]
            and ($allowed_tokens{$tokens->[0]->[0]}
                or $a{$tokens->[0]->[0]})){

        $str .= $tokens->[0]->[1];
        shift @$tokens;
    }
    return $str;
}

# parse sub: parse an include statement.
# note that TAG_START and the keyword "include" are already stripped
sub p_include {
    my $tokens = shift;
    my $meta = shift;
    # normally we'd expect an UNMATCHED token, but the user might choose
    # a keyword as well as file name
    my $fn = strip_ws(slurp_upto_token($tokens, 'TAG_END', $meta));
    $fn = get_include_filename('include', $fn, $meta->{FILES}->[-1]);
#    print Dumper $tokens;
    my $m = my_dclone($meta);
    unshift @{$m->{FILES}}, $fn;
    return parse_file($fn, $m);
}

# parse sub: parse a system statement.
sub p_system {
    my $tokens = shift;
    my $meta = shift;
    my $fn = strip_ws(slurp_upto_token($tokens, 'TAG_END', $meta));
    print STDERR "Executing external command '$fn'\n" unless $config{quiet};
    my $tmp = `$fn`;
    return ($tmp);
}

# parse sub: parse a 'menu' statement.

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

    for (keys %$meta){
        if ($_ eq 'VARS'){
            my %vs = %{$meta->{VARS}};
            for my $v (keys %vs){
                if (blessed $vs{$v}){
                    $result{VARS}{$v} = $vs{$v};
                } else {
                    $result{VARS}{$v} = ref $vs{$v} ? dclone($vs{$v}) : $vs{$v};
                }
            }
        } else {
            $result{$_} = ref $meta->{$_} ? dclone($meta->{$_}) : $meta->{$_};
        }
    }

    return \%result;
}

sub p_braces {
    my $tokens = shift;
    my $meta = shift;
    my $str = "";
    p_expect($tokens,"BRACES_START", $meta);
    if ($meta->{CURRENT_ITEM}){
#       print "using text inside braces\n";
        $str .= parse_tokens($tokens, $meta);
    } else {
        # discard the text between opening {{ and closing }} braces
#       print "discarding text inside braces\n";
        parse_tokens($tokens, $meta);
    }
    p_expect($tokens, "BRACES_END", $meta);
    return $str;
}

sub p_setvar {
    my $tokens = shift;
    my $meta = shift;
    my $str = "";
    while ($tokens->[0]->[0] ne "TAG_END"){
        $str .= $tokens->[0]->[1];
        shift @$tokens;
    }
    p_expect($tokens, "TAG_END", $meta);
    $str = strip_ws($str);
    $str =~ m#^(\S+)\s#;
    my $name = $1;
    my $value = $str;
    $value =~ s/^\S+\s+//;
    $meta->{VARS}->{$name} = $value;
    return "";
}

sub p_readvar {
    my ($tokens, $meta) = @_;
    my $str = strip_ws(slurp_upto_token($tokens, 'TAG_END', $meta));
    my ($name, $rest) = split m/\s+/, $str, 2;
    my %options = parse_hash($rest, 'readvar', $meta);
    my $c = resolve_var($name, $meta);

    if (defined $options{escape} && lc $options{escape} eq 'html'){
        return encode_entities($c);
    }
    return $c if defined $c;
    return '';
}

sub p_syntaxfile {
    my $tokens = shift;
    my $meta = shift;
    my $tag_content = shift @$tokens;
    $tag_content = strip_ws($tag_content->[1]);
    p_expect($tokens, "TAG_END", $meta);
    my @t = split m/\s+/, $tag_content;
    if (scalar @t != 2){
        parse_error(
            "Usage of syntaxfile tag: [[[syntaxfile <filename> <language>",
            $meta->{FILES},
            $tokens->[0],
        );
    }

}

sub p_syntax {
    my $tokens = shift;
    my $meta = shift;
    my $lang = shift @$tokens;
    $lang = strip_ws($lang->[1]);
    p_expect($tokens, "TAG_END", $meta);
    my $str = "";
    while ($tokens->[0] and  not ($tokens->[0]->[0] eq "TAG_START" and $tokens->[1]->[1] eq "endsyntax" and $tokens->[2]->[0] eq "TAG_END")){
        $str .= $tokens->[0]->[1];
        shift @$tokens;
    }
    p_expect($tokens, "TAG_START", $meta);
    p_expect($tokens, "KEYWORD", $meta);
    p_expect($tokens, "TAG_END", $meta);

    return do_hilight($str, $lang, $meta);
}

sub do_hilight {
    my ($str, $lang, $meta) = @_;
    if ($lang eq 'escape'){
        return encode_entities($str);
    }
    eval {
        no warnings "all";
        require Text::VimColor;
    };
    if ($@){
        # require was not successfull 
        print STDERR " Not syntax hilighting, Text::VimColor not found\n" unless $config{quiet};
        # encode at least some special chars "by hand"
        return encode_entities($str);
    } else {
        print STDERR "." unless $config{quiet};
        # any encoding will do if vim automatically detects it
        my $vim_encoding = 'utf-8';
        my $BOM = "\x{feff}";
        my $syn = Text::VimColor->new(
                filetype    => $lang,
                string      => encode($vim_encoding, $BOM . $str),
                );
        $str = decode($vim_encoding, $syn->html);
        $str =~ s/^$BOM//;
        return $str;
    }
}

# parse sub: expect a specific token, return its content or die if the
# expectation was not met.
sub p_expect {
    my ($tokens, $expect, $meta) = splice @_, 0, 3;
    parse_error("Unexpected End of File, expected $expect", $meta->{FILES}) unless (@$tokens);
    confess("\$tokens not a array ref - this is most likely a programming error\n$internal_error_message") unless(ref($tokens) eq "ARRAY");
    if ($tokens->[0]->[0] eq $expect){
        my $e_val = shift;
        if (not defined($e_val) or $e_val eq $tokens->[0]->[1]){
            my $val =  $tokens->[0]->[1];
            shift @$tokens;
            return $val;
        } else {
            parse_error("Expected '$e_val', got $tokens->[0][1]\n",
                    $meta->{FILES}, $tokens->[0]);
        }
    }
    parse_error(
        "Expected token $expect, got $tokens->[0]->[0]\n",
        $meta->{FILES},
        $tokens->[0],
    );
}


sub lex_string {
    my $text = shift;
    my @tokens = lex($text, \@input_tokens);
#   print Data::Dumper->Dump(\@tokens);
    return @tokens;
}

sub parse_tokens {
    my $tokens = shift;