| 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__ |