1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
|
package TestHighlight;
use warnings;
use Syntax::Highlight::Engine::Kate;
use File::Find;
use File::Spec::Functions 'catfile';
use Exporter 'import';
our @EXPORT_OK = qw(
get_highlighter
highlight_perl
slurp
get_sample_perl_files
);
our %EXPORT_TAGS = ( all => \@EXPORT_OK );
my ( $BEFORE, $HIGHLIGHTED ) = ( 't/perl/before', 't/perl/highlighted' );
=head1 EXPORT
=over 4
=item * get_highlighter
my $highlighter = get_highlighter($language);
Returns a new C<Syntax::Highlight::Engine::Kate> highlighter for testing.
Defaults to Perl if no language specified.
All tokens are wrapped in tags corresponding to the token type:
<keyword>my</keyword>
=item * slurp
Slurps and returns the contents of a file.
=teim * get_sample_perl_files
my $files = get_sample_perl_files();
while ( my ( $perl, $highlighted ) = each %$files ) {
...
}
Returns a hashref. Keys are the names of the raw Perl files in
F<t/perl/before> and values are the filenames of the highlighted versions
found in F<t/perl/highlighted>.
See F<bin/regen.pl> to understand how to regenerate these fixtures.
See F<t/perl_highlighting.t> for an example of testing with this.
=back
=cut
sub highlight_perl {
my $code = shift;
return get_highlighter('Perl')->highlightText($code);
}
sub get_highlighter {
my $syntax = shift || 'Perl';
return Syntax::Highlight::Engine::Kate->new(
language => $syntax,
format_table => {
map { _make_token($_) }
qw/
Alert
BaseN
BString
Char
Comment
DataType
DecVal
Error
Float
Function
IString
Keyword
Normal
Operator
Others
RegionMarker
Reserved
String
Variable
Warning
/
}
);
}
sub _make_token {
my $name = shift;
my $token = lc $name;
return $name => [ "<$token>" => "</$token>" ];
}
sub slurp {
my $file = shift;
open my $fh, '<', $file or die "Cannot open $file for reading: $!";
return do { local $/; <$fh> };
}
sub get_sample_perl_files {
my %highlighted_file_for;
find(
sub {
$highlighted_file_for{ catfile( $BEFORE, $_ ) } =
catfile( $HIGHLIGHTED, $_ )
if -f $_ && /\.pl$/;
},
$BEFORE
);
return \%highlighted_file_for;
}
1;
|
