File Coverage

blib/lib/Tk/TextHighlight/HTML.pm
Criterion Covered Total %
statement 9 84 10.7
branch 0 42 0.0
condition 0 12 0.0
subroutine 3 5 60.0
pod 1 2 50.0
total 13 145 8.9


line stmt bran cond sub pod time code
1             package Tk::TextHighlight::HTML;
2              
3 1     1   21386 use vars qw($VERSION);
  1         2  
  1         58  
4             $VERSION = '0.2';
5              
6 1     1   6 use strict;
  1         1  
  1         24  
7 1     1   6 use base('Tk::TextHighlight::Template');
  1         2  
  1         662  
8              
9             sub new {
10 0     0 0   my ($proto, $rules) = @_;
11 0   0       my $class = ref($proto) || $proto;
12 0 0         if (not defined($rules)) {
13 0           $rules = [
14             ['Text'],
15             ['Tag', -foreground => 'brown'],
16             ['Attr', -foreground => 'darkblue'],
17             ['Comment', -foreground => 'lightblue'],
18             ['Value', -foreground => 'orange'],
19             ['String', -foreground => 'red'],
20             ['SpChar', -foreground => 'magenta'],
21             ];
22             };
23 0           my $self = $class->SUPER::new($rules);
24 0           $self->stackPush('Text');
25 0           bless ($self, $class);
26 0           return $self;
27             }
28              
29             sub highlight {
30 0     0 1   my $hlt = shift;
31 0           my @in = split //, shift;
32 0           $hlt->snippetParse;
33 0           my $out = $hlt->out;
34 0           @$out = ();
35 0           foreach my $c (@in) {
36 0 0         if ($c eq '<') {
    0          
    0          
    0          
    0          
    0          
    0          
    0          
37 0 0         if ($hlt->stackTop eq 'Text') {
38             # print "opening Tag\n";
39 0           $hlt->snippetParse;
40 0           $hlt->snippetAppend($c);
41 0           $hlt->stackPush('Tag');
42             } else {
43 0           $hlt->snippetAppend($c)
44             }
45             } elsif ($c eq '>') {
46 0 0 0       if ($hlt->stackTop eq 'Tag') {
    0 0        
47             # print "closing Tag\n";
48 0           $hlt->snippetAppend($c);
49 0           $hlt->snippetParse;
50 0           $hlt->stackPull;
51             } elsif (($hlt->stackTop eq 'Value') or ($hlt->stackTop eq 'Attr') or ($hlt->stackTop eq 'Comment')) {
52             # print "closing Tag\n";
53 0           $hlt->snippetParse;
54 0           $hlt->stackPull;
55 0           $hlt->snippetAppend($c);
56 0           $hlt->snippetParse;
57 0           $hlt->stackPull;
58             } else {
59 0           $hlt->snippetAppend($c);
60             }
61             } elsif ($c eq '"') {
62 0 0 0       if (($hlt->stackTop eq 'Value') or ($hlt->stackTop eq 'Comment')) {
    0          
63             # print "opening String\n";
64 0           $hlt->snippetParse;
65 0           $hlt->snippetAppend($c);
66 0           $hlt->stackPush('String');
67             } elsif ($hlt->stackTop eq 'String') {
68             # print "closing String\n";
69 0           $hlt->snippetAppend($c);
70 0           $hlt->snippetParse;
71 0           $hlt->stackPull;
72             } else {
73 0           $hlt->snippetAppend($c);
74             }
75             } elsif ($c eq '!') {
76 0 0         if ($hlt->stackTop eq 'Tag') {
77             # print "opening Comment\n";
78 0           $hlt->snippetParse;
79 0           $hlt->snippetAppend($c);
80 0           $hlt->stackPush('Comment');
81             } else {
82 0           $hlt->snippetAppend($c);
83             }
84             } elsif ($c eq '&') {
85 0 0         if ($hlt->stackTop eq 'Text') {
86             # print "opening SpChar\n";
87 0           $hlt->snippetParse;
88 0           $hlt->snippetAppend($c);
89 0           $hlt->stackPush('SpChar');
90             } else {
91 0           $hlt->snippetAppend($c);
92             }
93             } elsif ($c eq ';') {
94 0 0         if ($hlt->stackTop eq 'SpChar') {
95             # print "closing SpChar\n";
96 0           $hlt->snippetAppend($c);
97 0           $hlt->snippetParse;
98 0           $hlt->stackPull;
99             } else {
100 0           $hlt->snippetAppend($c);
101             }
102             } elsif ($c eq '=') {
103 0 0         if ($hlt->stackTop eq 'Attr') {
104             # print "opening Value\n";
105 0           $hlt->snippetParse;
106 0           $hlt->stackPull;
107 0           $hlt->snippetAppend($c);
108 0           $hlt->snippetParse;
109 0           $hlt->stackPush('Value');
110             } else {
111 0           $hlt->snippetAppend($c);
112             }
113             } elsif ($c =~ /\s/) {
114 0 0         if ($hlt->stackTop eq 'Tag') {
    0          
    0          
115             # print "opening Attr\n";
116 0           $hlt->snippetParse;
117 0           $hlt->snippetAppend($c);
118 0           $hlt->stackPush('Attr');
119             } elsif ($hlt->stackTop eq 'Value') {
120 0           $hlt->snippetParse;
121 0           $hlt->snippetAppend($c);
122 0           $hlt->stackPull;
123 0           $hlt->stackPush('Attr');
124             } elsif ($hlt->stackTop eq 'SpChar') {
125 0           $hlt->snippetParse;
126 0           $hlt->snippetAppend($c);
127 0           $hlt->stackPull;
128             } else {
129 0           $hlt->snippetAppend($c);
130             }
131             } else {
132 0           $hlt->snippetAppend($c);
133             }
134             }
135 0           $hlt->snippetParse;
136 0           return @$out;
137             }
138              
139             1;
140              
141             __END__