File Coverage

blib/lib/XML/Handler/ExtOn/Context.pm
Criterion Covered Total %
statement 52 54 96.3
branch 5 6 83.3
condition 6 10 60.0
subroutine 13 14 92.8
pod 0 8 0.0
total 76 92 82.6


line stmt bran cond sub pod time code
1             package XML::Handler::ExtOn::Context;
2 8     8   41297 use strict;
  8         15  
  8         361  
3 8     8   50 use warnings;
  8         15  
  8         201  
4 8     8   127 use Data::Dumper;
  8         14  
  8         408  
5 8     8   6738 use Tie::UnionHash;
  8         11971  
  8         321  
6             ### install get/set accessors for this object.
7             for my $key ( qw/ __changes_hash __context_map _parent/ ) {
8 8     8   51 no strict 'refs';
  8         24  
  8         4361  
9             *{ __PACKAGE__ . "::$key" } = sub {
10 48     48   58 my $self = shift;
11 48 100       152 $self->{$key} = $_[0] if @_;
12 48         118 return $self->{$key};
13             }
14             }
15             sub new {
16 7     7 0 112 my $class = shift;
17 7 50       25 $class = ref $class if ref $class;
18 7         27 my $self = bless( {}, $class );
19 7         20 my %args = @_;
20 7   100     49 my $map = $args{parent_map} || {xmlns=>'http://www.w3.org/2000/xmlns/'};
21 7         15 my %changes = ();
22 7         27 $self->__changes_hash(\%changes);
23 7         13 my %new_map = ();
24 7         56 tie %new_map, 'Tie::UnionHash', $map, \%changes;
25 7         323 $self->__context_map(\%new_map);
26             #save parent
27 7         27 $self->_parent( $args{parent});
28 7         28 return $self;
29             }
30             =head2 sub_context
31              
32             create sub_context
33              
34             =cut
35             sub sub_context {
36 2     2 0 6 my $self = shift;
37 2         5 return __PACKAGE__->new( parent_map=>$self->get_map, parent=>$self )
38              
39             }
40             sub parent {
41 0     0 0 0 my $self = shift;
42 0   0     0 return $self->_parent || $self;
43             }
44             =head2 get_changes
45              
46             Get changed items hash
47              
48             =cut
49              
50             sub get_changes {
51 1     1 0 1305 my $self = shift;
52 1         4 return $self->__changes_hash;
53             }
54              
55             sub get_map {
56 26     26 0 43 my $self = shift;
57 26         50 return $self->__context_map;
58             }
59              
60             sub get_uri {
61 11     11 0 21 my $self = shift;
62 11   100     56 my $prefix = shift||'';
63 11         42 my $map = $self->get_map;
64 11 100       39 unless ( $prefix) {
65 9   66     47 return $map->{$prefix} || $map->{xmlns}
66             }
67 2         6 return $map->{$prefix};
68             }
69              
70             sub get_prefix {
71 1     1 0 2 my $self = shift;
72 1         1 my $uri = shift;
73 1         2 return { reverse %{ $self->get_map } }->{$uri};
  1         3  
74            
75             }
76             sub declare_prefix {
77 8     8 0 807 my $self = shift;
78 8         18 my %map = @_;
79 8         21 my $current_map = $self->get_map;
80 8         36 while (my ( $prefix, $uri) = each %map ) {
81 8         43 $current_map->{$prefix} = $uri;
82             }
83 8         202 $current_map;
84             }
85              
86             1;