File Coverage

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[
  • $esc_label
  • \n];
    90             push @codes, qq[
    $post_code
    ];
    91             }
    92              
    93             return
    94             qq{
    \n}
    95             . qq{
      \n}
    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__