blib/lib/HTML/TabbedExamples/Generate.pm | |||
---|---|---|---|
Criterion | Covered | Total | % |
statement | 16 | 18 | 88.8 |
branch | n/a | ||
condition | n/a | ||
subroutine | 6 | 6 | 100.0 |
pod | n/a | ||
total | 22 | 24 | 91.6 |
line | stmt | bran | cond | sub | pod | time | code | |||||||
---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
1 | package HTML::TabbedExamples::Generate; | |||||||||||||
2 | ||||||||||||||
3 | 1 | 1 | 40018 | use strict; | ||||||||||
1 | 2 | |||||||||||||
1 | 45 | |||||||||||||
4 | 1 | 1 | 6 | use warnings; | ||||||||||
1 | 1 | |||||||||||||
1 | 34 | |||||||||||||
5 | ||||||||||||||
6 | 1 | 1 | 26 | use 5.014; | ||||||||||
1 | 2 | |||||||||||||
1 | 48 | |||||||||||||
7 | ||||||||||||||
8 | our $VERSION = '0.0.6'; | |||||||||||||
9 | ||||||||||||||
10 | 1 | 1 | 630 | use MooX 'late'; | ||||||||||
1 | 17692 | |||||||||||||
1 | 6 | |||||||||||||
11 | ||||||||||||||
12 | 1 | 1 | 43133 | use CGI (); | ||||||||||
1 | 15736 | |||||||||||||
1 | 40 | |||||||||||||
13 | 1 | 1 | 1447 | use Text::VimColor; | ||||||||||
0 | ||||||||||||||
0 | ||||||||||||||
14 | ||||||||||||||
15 | use Carp (); | |||||||||||||
16 | ||||||||||||||
17 | has _default_syntax => (is => 'ro', isa => 'Str', init_arg => 'default_syntax'); | |||||||||||||
18 | has _main_pre_css_classes => (is => 'ro', isa => 'ArrayRef[Str]', | |||||||||||||
19 | default => sub { | |||||||||||||
20 | return [qw(code)]; | |||||||||||||
21 | }, | |||||||||||||
22 | init_arg => 'main_pre_css_classes', | |||||||||||||
23 | ); | |||||||||||||
24 | ||||||||||||||
25 | sub _calc_post_code | |||||||||||||
26 | { | |||||||||||||
27 | my $self = shift; | |||||||||||||
28 | my $ex_spec = shift; | |||||||||||||
29 | ||||||||||||||
30 | my $pre_code = $ex_spec->{code}; | |||||||||||||
31 | ||||||||||||||
32 | if ($ex_spec->{no_syntax}) | |||||||||||||
33 | { | |||||||||||||
34 | return "\n" . CGI::escapeHTML($pre_code) . "\n"; |
|||||||||||||
35 | } | |||||||||||||
36 | else | |||||||||||||
37 | { | |||||||||||||
38 | my $syntax = ($ex_spec->{syntax} || $self->_default_syntax); | |||||||||||||
39 | ||||||||||||||
40 | my $code = <<"EOF"; | |||||||||||||
41 | #!/usr/bin/perl | |||||||||||||
42 | ||||||||||||||
43 | use strict; | |||||||||||||
44 | use warnings; | |||||||||||||
45 | ||||||||||||||
46 | $pre_code | |||||||||||||
47 | EOF | |||||||||||||
48 | ||||||||||||||
49 | my $tvc = Text::VimColor->new( | |||||||||||||
50 | string => \$code, | |||||||||||||
51 | filetype => $syntax, | |||||||||||||
52 | ); | |||||||||||||
53 | ||||||||||||||
54 | return | |||||||||||||
55 | qq|56 |
. join(' ', map { CGI::escapeHTML($_) } | ||||||||||||
57 | @{$self->_main_pre_css_classes}, $syntax | |||||||||||||
58 | ) | |||||||||||||
59 | . qq|">\n| | |||||||||||||
60 | . ($tvc->html() =~ s{(class=")syn}{$1}gr) | |||||||||||||
61 | . qq|\n\n| | |||||||||||||
62 | ; | |||||||||||||
63 | ||||||||||||||
64 | } | |||||||||||||
65 | } | |||||||||||||
66 | ||||||||||||||
67 | sub render | |||||||||||||
68 | { | |||||||||||||
69 | my ($self, $args) = @_; | |||||||||||||
70 | ||||||||||||||
71 | my $examples = $args->{'examples'}; | |||||||||||||
72 | my $id_base = $args->{'id_base'}; | |||||||||||||
73 | ||||||||||||||
74 | my $ret_string = ''; | |||||||||||||
75 | ||||||||||||||
76 | my @lis; | |||||||||||||
77 | my @codes; | |||||||||||||
78 | ||||||||||||||
79 | foreach my $ex_spec (@$examples) | |||||||||||||
80 | { | |||||||||||||
81 | my $id = $id_base . '__' . $ex_spec->{id}; | |||||||||||||
82 | my $label = $ex_spec->{label}; | |||||||||||||
83 | ||||||||||||||
84 | my $esc_id = CGI::escapeHTML($id); | |||||||||||||
85 | my $esc_label = CGI::escapeHTML($label); | |||||||||||||
86 | ||||||||||||||
87 | my $post_code = $self->_calc_post_code($ex_spec); | |||||||||||||
88 | ||||||||||||||
89 | push @lis, qq[ |
|||||||||||||
90 | push @codes, qq[ $post_code ]; |
|||||||||||||
91 | } | |||||||||||||
92 | ||||||||||||||
93 | return | |||||||||||||
94 | qq{ \n} |
|||||||||||||
95 | . qq{
|
|||||||||||||
96 | . join("\n", @lis) | |||||||||||||
97 | . qq{\n\n} | |||||||||||||
98 | . join("\n", @codes) . | |||||||||||||
99 | qq{\n} | |||||||||||||
100 | ; | |||||||||||||
101 | } | |||||||||||||
102 | ||||||||||||||
103 | sub html_with_title | |||||||||||||
104 | { | |||||||||||||
105 | my ($self, $args) = @_; | |||||||||||||
106 | ||||||||||||||
107 | my $id_base = $args->{'id_base'} | |||||||||||||
108 | or Carp::confess("id_base not specified."); | |||||||||||||
109 | my $title = $args->{'title'} | |||||||||||||
110 | or Carp::confess("title not specified."); | |||||||||||||
111 | ||||||||||||||
112 | return | |||||||||||||
113 | qq[114 |
. qq[">] . CGI::escapeHTML($title) . qq[\n\n] | ||||||||||||
115 | . $self->render($args) | |||||||||||||
116 | ; | |||||||||||||
117 | } | |||||||||||||
118 | ||||||||||||||
119 | 1; | |||||||||||||
120 | ||||||||||||||
121 | __END__ |