Benchmark-Perl-Formance-Cargo

 view release on metacpan or  search on metacpan

share/P6STD/std_hilite/STD_syntax_highlight  view on Meta::CPAN

        my $text = highlight_perl6_ansi();
        write_output $ansi_text, $text;
    }
    if($mirc_text) {
        my $text = highlight_perl6_mirc();
        write_output $mirc_text, $text;
    }
    if($yaml) {
        my $text = highlight_perl6_yaml();
        write_output $yaml, $text;
    }
}

=item highlight_perl6_full

Generates the Perl6 highlighted HTML string for STD parse tree provided. 
The resources can be inlined (by default) or externalized (--clean-html). 
=cut
sub highlight_perl6_full {
    my $str = "";

    # slurp libraries and javascript to inline them
    my ($JQUERY_JS,$JS,$CSS) = (
        'jquery-1.4.2.min.js', 
        'STD_syntax_highlight.js',
        'STD_syntax_highlight.css');
    my %colors = ();
    my $line;
    open CSS_FILE, "std_hilite/$CSS"
        or die "Could not open $CSS: $OS_ERROR\n";
    while($line = <CSS_FILE>) {
        if($line =~ /^\s*\.(\w+)\s*{\s*color\s*:\s*(\w+)/) {
            $colors{$1} = $2;
        }
    }
    close CSS_FILE;

    my $jquery_js = qq{<script type="text/javascript" src="../$JQUERY_JS"></script>};
    my $js = qq{<script type="text/javascript" src="../$JS"></script>};
    my $css = qq{<link href="../$CSS" rel="stylesheet" type="text/css">};
    if(!$clean_html) {
        $jquery_js = read_file("std_hilite/$JQUERY_JS") 
            or die "Error while slurping file: $OS_ERROR\n";    
        $js = read_file("std_hilite/$JS") 
            or die "Error while slurping file: $OS_ERROR\n";
        $css = read_file("std_hilite/$CSS")
            or die "Error while slurping file: $OS_ERROR\n";
        $jquery_js = qq{<script type="text/javascript">\n$jquery_js\n</script>};
        $js = qq{<script type="text/javascript">\n$js\n</script>};
        $css = qq{<style type="text/css">\n$css\n</style>};
    }

    my $timestamp = localtime;
    $str .= <<"HTML";
<html>
<head>
    <title>$file</title>
<!--
    Generated by $PROGRAM_NAME at $timestamp
-->
    <meta http-equiv="Content-Type" content="text/html; charset=UTF-8"/> 
    $css
    $jquery_js
    $js
</head>
<body>
    <div id="parse_tree">
        <button id="parse_tree_expand">Show Syntax Tree</button>
        <button id="parse_tree_collapse">Hide it</button>
        <button id="parse_tree_help">Help</button>
        <div id="parse_tree_output"></div>
    </div>
    <pre>
HTML

    local *spit_full_html = sub {
        my ($i, $buffer, $rule, $tree) = @ARG;
        $buffer = escape_html($buffer);
        $str .= qq{<span id="tree_$i" style="display:none;">$tree</span>};
        if($rule) {
            $str .= qq{<span id="node_$i" class="$rule">$buffer</span>};
        } else {
            $str .= $buffer;
        }
    };

    redspans_traverse(\&spit_full_html,%colors); 

    $str .= <<"HTML";
    </pre>
</body>
</html>
HTML

    $str;
}

=item highlight_perl6_simple

This is same as C<highlight_perl6_full> when --simple-html is used.
No more javascript tree viewer or anything fancy. 
Only nodes that have a color are printed. Not optimal but works ;-)
=cut
sub highlight_perl6_simple {
    my $str = "";
    my %colors = ();

    my $CSS = "STD_syntax_highlight.css";
    open CSS_FILE, "std_hilite/$CSS"
        or die "Could not open $CSS: $OS_ERROR\n";
    my $line;
    while($line = <CSS_FILE>) {
        if($line =~ /^\s*\.(\w+)\s*{\s*color\s*:\s*(\w+)/) {
            $colors{$1} = $2;
        }
    }
    close CSS_FILE;

    # slurp css inline it
    my $css = qq{<link href="../$CSS" rel="stylesheet" type="text/css">};
    if(!$clean_html) {



( run in 2.908 seconds using v1.01-cache-2.11-cpan-39bf76dae61 )