File Coverage

blib/lib/XML/Toolkit/Builder/NamespaceRegistry.pm
Criterion Covered Total %
statement 15 18 83.3
branch 1 2 50.0
condition n/a
subroutine 5 6 83.3
pod 0 3 0.0
total 21 29 72.4


line stmt bran cond sub pod time code
1             package XML::Toolkit::Builder::NamespaceRegistry;
2             {
3             $XML::Toolkit::Builder::NamespaceRegistry::VERSION = '0.15';
4             }
5 2     2   1278 use Moose::Role;
  2         4  
  2         11  
6 2     2   12581 use MooseX::Aliases;
  2         2345  
  2         12  
7 2     2   151742 use namespace::autoclean;
  2         5  
  2         24  
8              
9             has xmlns => (
10             isa => 'HashRef',
11             is => 'ro',
12             lazy => 1,
13             builder => 'default_xmlns',
14             traits => [qw(Hash MooseX::Aliases::Meta::Trait::Attribute)],
15             alias => ['namespace_map'],
16             handles => {
17             default_namespace => [ 'get', q[''] ],
18             set_default_namespace => [ 'set', q[''] ],
19             get_xmlns => ['get'],
20             set_xmlns => ['set'],
21             xmlns_pairs => ['kv'],
22             },
23             );
24              
25 0     0 0 0 sub default_xmlns { { 'MyApp' => '', } }
26              
27             has _unresolved_namespace_map => (
28             isa => 'HashRef',
29             accessor => 'unresolved_namespace_map',
30             lazy => 1,
31             default => sub { {} },
32             traits => [qw(Hash MooseX::Aliases::Meta::Trait::Attribute)],
33             alias => ['unresolved_xmln'],
34             handles => {
35             'no_unresolved_namespaces' => ['is_empty'],
36             'unresolved_namespaces' => ['keys'],
37             }
38             );
39              
40 7     7 0 1111 sub end_document { }
41              
42             after 'end_document' => sub {
43             my ($self) = @_;
44             unless ( $self->no_unresolved_namespaces ) {
45             warn "These XML namespaces have no mapping:\n"
46             . join( "\n", sort $self->unresolved_namespaces ) . "\n";
47             }
48             };
49              
50             sub get_class_name {
51 15     15 0 33 my ( $self, $el ) = @_;
52              
53             # Get values for element
54 15         41 my $xmlns = $el->{'NamespaceURI'};
55 15         93 my $namespace = $self->namespace_map->{$xmlns};
56              
57             # Add xmlns to unresolved list
58 15 50       57 unless ($namespace) {
59 0         0 $self->unresolved_namespace_map->{$xmlns} = 1;
60              
61             # Let's just return the local part here, even though it's wrong
62 0         0 return $self->default_namespace . '::' . ucfirst $el->{'LocalName'};
63             }
64              
65             # Construct class name
66 15         109 return $namespace . '::' . ucfirst $el->{'LocalName'};
67             }
68              
69             1;
70             __END__