File Coverage

lib/Mojolicious/Plugin/XML/Loy.pm

Criterion	Covered	Total	%
statement	71	76	93.4
branch	22	30	73.3
condition	6	11	54.5
subroutine	12	12	100.0
pod	1	1	100.0
total	112	130	86.1

package Mojolicious::Plugin::XML::Loy;
use Mojo::Base 'Mojolicious::Plugin';
use Mojo::Loader qw/load_class/;
use Mojo::Util qw!deprecated!;
use XML::Loy;

our $VERSION = '0.14';

my %base_classes;

# Register Plugin
sub register {
  my ($plugin, $mojo, $param) = @_;

  my $namespace = 'XML::Loy::';
  my $max_size = 1024 * 1024;

  # Load parameter from Config file
  if (my $config_param = $mojo->config('XML-Loy')) {
    $param = { %$param, %$config_param };
  };

  if (exists $param->{max_size} && $param->{max_size} =~ /^\d+$/) {
    $max_size = delete $param->{max_size};
  };

  # Create new XML helpers
  foreach my $helper (keys %$param) {

    # Already defined
    if (exists $mojo->renderer->helpers->{$helper}) {
      $mojo->log->debug("Helper '$helper' already defined");
      next;
    };

    my @helper = @{ $param->{ $helper } };
    my $base = shift @helper;

    $base = 'XML::Loy' if $base eq '-Loy';

    if (index($base, '-') == 0) {
      $base =~ s/^-//;
      $base = ($base eq 'Loy' ? 'XML::Loy' : $namespace . "$base");
    };

    # Load module if not loaded
    unless (exists $base_classes{$base}) {

      # Load base class
      if (my $e = load_class $base) {
	for ($mojo->log) {
	  $_->error("Exception: $e")  if ref $e;
	  $_->error(qq{Unable to load base class "$base"});
	};
	next;
      };

      my $mime   = $base->mime;
      my $prefix = $base->_prefix;

      # Establish mime types
      if ($mime && $prefix) {

	# Apply mime type
	$mojo->types->type($prefix => $mime);
      };

      # module loaded
      $base_classes{$base} = [$prefix => $mime];
    };

    # Code generation for ad-hoc helper
    my $code = 'sub { shift;' .
      ' { use bytes; return if length("@_") > ' . $max_size . '} ' .
      ' my $doc = ' . $base . '->new( @_ );';

    # Extend base class
    if (@helper) {
      $code .= '$doc->extension(' .
	join(',', map( '"' . qq{$_"}, @helper)) .
      ");";
    };
    $code .= 'return $doc };';

    # Eval code
    my $code_ref = eval $code;

    # Evaluation error
    $mojo->log->fatal($@ . ': ' . $!) and next if $@;

    # Create helper
    $mojo->helper($helper => $code_ref);
  };

  # Plugin wasn't registered before
  unless (exists $mojo->renderer->helpers->{'new_xml'}) {

    # Default 'new_xml' helper
    $mojo->helper(
      new_xml => sub {
	shift;
	return XML::Loy->new( @_ );
      });

    my $reply_xml = sub {
      my ($c, $xml) = @_;
      my $format = 'xml';

      # Check format based on mime type
      my $class = ref $xml;
      if ($base_classes{$class}) {
	if ($base_classes{$class}->[0] && $base_classes{$class}->[1]) {
	  $format = $base_classes{$class}->[0];
	};
      };

      # render XML with correct mime type
      return $c->render(
	'data'   => $xml->to_pretty_xml,
	'format' => $format,
	@_
      );
    };

    # Add 'render_xml' helper
    $mojo->helper(
      render_xml => sub {
	deprecated 'render_xml is deprecated in favor of reply->xml';
	$reply_xml->(@_);
      }
    );

    # Add 'reply->xml' helper
    $mojo->helper('reply.xml' => $reply_xml);
  };
};


1;


__END__