File Coverage

lib/Mojolicious/Plugin/XML/Loy.pm
Criterion Covered Total %
statement 64 69 92.7
branch 23 30 76.6
condition 6 11 54.5
subroutine 10 10 100.0
pod 1 1 100.0
total 104 121 85.9


line stmt bran cond sub pod time code
1             package Mojolicious::Plugin::XML::Loy;
2 1     1   586 use Mojo::Base 'Mojolicious::Plugin';
  1         2  
  1         8  
3 1     1   148 use Mojo::Loader qw/load_class/;
  1         1  
  1         42  
4 1     1   450 use XML::Loy;
  1         4418  
  1         5  
5              
6             our $VERSION = '0.13';
7              
8             my %base_classes;
9              
10             # Register Plugin
11             sub register {
12 2     2 1 6145 my ($plugin, $mojo, $param) = @_;
13              
14 2         3 my $namespace = 'XML::Loy::';
15 2         2 my $max_size = 1024 * 1024;
16              
17             # Load parameter from Config file
18 2 50       11 if (my $config_param = $mojo->config('XML-Loy')) {
19 0         0 $param = { %$param, %$config_param };
20             };
21              
22 2 100 66     39 if (exists $param->{max_size} && $param->{max_size} =~ /^\d+$/) {
23 1         3 $max_size = delete $param->{max_size};
24             };
25              
26             # Create new XML helpers
27 2         7 foreach my $helper (keys %$param) {
28              
29             # Already defined
30 5 100       73 if (exists $mojo->renderer->helpers->{$helper}) {
31 1         10 $mojo->log->debug("Helper '$helper' already defined");
32 1         21 next;
33             };
34              
35 4         34 my @helper = @{ $param->{ $helper } };
  4         9  
36 4         6 my $base = shift @helper;
37              
38 4 100       8 $base = 'XML::Loy' if $base eq '-Loy';
39              
40 4 100       11 if (index($base, '-') == 0) {
41 3         12 $base =~ s/^-//;
42 3 50       9 $base = ($base eq 'Loy' ? 'XML::Loy' : $namespace . "$base");
43             };
44              
45             # Load module if not loaded
46 4 100       9 unless (exists $base_classes{$base}) {
47              
48             # Load base class
49 3 50       7 if (my $e = load_class $base) {
50 0         0 for ($mojo->log) {
51 0 0       0 $_->error("Exception: $e") if ref $e;
52 0         0 $_->error(qq{Unable to load base class "$base"});
53             };
54 0         0 next;
55             };
56              
57 3         6061 my $mime = $base->mime;
58 3         25 my $prefix = $base->_prefix;
59              
60             # Establish mime types
61 3 100 66     19 if ($mime && $prefix) {
62              
63             # Apply mime type
64 2         9 $mojo->types->type($prefix => $mime);
65             };
66              
67             # module loaded
68 3         69 $base_classes{$base} = [$prefix => $mime];
69             };
70              
71             # Code generation for ad-hoc helper
72 4         6 my $code = 'sub { shift;' .
73             ' { use bytes; return if length("@_") > ' . $max_size . '} ' .
74             ' my $doc = ' . $base . '->new( @_ );';
75              
76             # Extend base class
77 4 100       9 if (@helper) {
78 3         10 $code .= '$doc->extension(' .
79             join(',', map( '"' . qq{$_"}, @helper)) .
80             ");";
81             };
82 4         3 $code .= 'return $doc };';
83              
84             # Eval code
85 1     1   5 my $code_ref = eval $code;
  1     1   1  
  1     1   6  
  1     1   4  
  1         1  
  1         3  
  1         4  
  1         1  
  1         3  
  1         4  
  1         0  
  1         3  
  4         208  
86              
87             # Evaluation error
88 4 50 0     12 $mojo->log->fatal($@ . ': ' . $!) and next if $@;
89              
90             # Create helper
91 4         14 $mojo->helper($helper => $code_ref);
92             };
93              
94             # Plugin wasn't registered before
95 2 100       20 unless (exists $mojo->renderer->helpers->{'new_xml'}) {
96              
97             # Default 'new_xml' helper
98             $mojo->helper(
99             new_xml => sub {
100 3     3   24968 shift;
101 3         17 return XML::Loy->new( @_ );
102 1         9 });
103              
104              
105             # Add 'render_xml' helper
106             $mojo->helper(
107             render_xml => sub {
108 5     5   3258 my ($c, $xml) = @_;
109 5         8 my $format = 'xml';
110              
111             # Check format based on mime type
112 5         8 my $class = ref $xml;
113 5 50       15 if ($base_classes{$class}) {
114 5 100 66     24 if ($base_classes{$class}->[0] && $base_classes{$class}->[1]) {
115 2         4 $format = $base_classes{$class}->[0];
116             };
117             };
118              
119             # render XML with correct mime type
120 5         20 return $c->render(
121             'data' => $xml->to_pretty_xml,
122             'format' => $format,
123             @_
124             );
125 1         15 });
126             };
127             };
128              
129              
130             1;
131              
132              
133             __END__