| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package WebService::Braintree::Xml; | 
| 2 |  |  |  |  |  |  | $WebService::Braintree::Xml::VERSION = '0.94'; | 
| 3 | 20 |  |  | 20 |  | 406 | use 5.010_001; | 
|  | 20 |  |  |  |  | 69 |  | 
| 4 | 20 |  |  | 20 |  | 113 | use strictures 1; | 
|  | 20 |  |  |  |  | 156 |  | 
|  | 20 |  |  |  |  | 837 |  | 
| 5 |  |  |  |  |  |  |  | 
| 6 | 20 |  |  | 20 |  | 2118 | use vars qw(@ISA @EXPORT_OK); | 
|  | 20 |  |  |  |  | 43 |  | 
|  | 20 |  |  |  |  | 960 |  | 
| 7 | 20 |  |  | 20 |  | 110 | use Exporter; | 
|  | 20 |  |  |  |  | 32 |  | 
|  | 20 |  |  |  |  | 1123 |  | 
| 8 |  |  |  |  |  |  | our @ISA = qw(Exporter); | 
| 9 |  |  |  |  |  |  | our @EXPORT_OK = qw(hash_to_xml xml_to_hash); | 
| 10 |  |  |  |  |  |  |  | 
| 11 | 20 |  |  | 20 |  | 10133 | use XML::Simple; | 
|  | 20 |  |  |  |  | 134610 |  | 
|  | 20 |  |  |  |  | 127 |  | 
| 12 |  |  |  |  |  |  |  | 
| 13 | 20 |  |  | 20 |  | 6697 | use DateTime::Format::Atom; | 
|  | 20 |  |  |  |  | 61886 |  | 
|  | 20 |  |  |  |  | 621 |  | 
| 14 | 20 |  |  | 20 |  | 139 | use WebService::Braintree::Util qw(is_arrayref is_hashref); | 
|  | 20 |  |  |  |  | 45 |  | 
|  | 20 |  |  |  |  | 988 |  | 
| 15 | 20 |  |  | 20 |  | 34153 | use XML::LibXML; | 
|  | 0 |  |  |  |  |  |  | 
|  | 0 |  |  |  |  |  |  | 
| 16 |  |  |  |  |  |  |  | 
| 17 |  |  |  |  |  |  | sub hash_to_xml { | 
| 18 |  |  |  |  |  |  | my $hash = shift; | 
| 19 |  |  |  |  |  |  | my $doc = XML::LibXML::Document->createDocument('1.0', 'UTF-8'); | 
| 20 |  |  |  |  |  |  | my $root_key = (keys %$hash)[0]; | 
| 21 |  |  |  |  |  |  | my $element = XML::LibXML::Element->new($root_key); | 
| 22 |  |  |  |  |  |  |  | 
| 23 |  |  |  |  |  |  | my $value = $hash->{$root_key}; | 
| 24 |  |  |  |  |  |  | my $node = add_node($element, $value); | 
| 25 |  |  |  |  |  |  | $doc->setDocumentElement($element); | 
| 26 |  |  |  |  |  |  |  | 
| 27 |  |  |  |  |  |  | return $doc->toString(1); | 
| 28 |  |  |  |  |  |  | } | 
| 29 |  |  |  |  |  |  |  | 
| 30 |  |  |  |  |  |  | sub add_node { | 
| 31 |  |  |  |  |  |  | my ($parent, $value) = @_; | 
| 32 |  |  |  |  |  |  | if (is_hashref($value)) { | 
| 33 |  |  |  |  |  |  | build_from_hash($parent, $value); | 
| 34 |  |  |  |  |  |  | } elsif (is_arrayref($value)) { | 
| 35 |  |  |  |  |  |  | build_from_array($parent, $value); | 
| 36 |  |  |  |  |  |  | } else { | 
| 37 |  |  |  |  |  |  | $parent->appendText($value) if $value; | 
| 38 |  |  |  |  |  |  | } | 
| 39 |  |  |  |  |  |  | } | 
| 40 |  |  |  |  |  |  |  | 
| 41 |  |  |  |  |  |  | sub build_from_hash { | 
| 42 |  |  |  |  |  |  | my($parent, $value) = @_; | 
| 43 |  |  |  |  |  |  | while (my($key, $child_value) = each(%$value)) { | 
| 44 |  |  |  |  |  |  | build_node($key, $child_value, $parent); | 
| 45 |  |  |  |  |  |  | } | 
| 46 |  |  |  |  |  |  | } | 
| 47 |  |  |  |  |  |  |  | 
| 48 |  |  |  |  |  |  | sub build_from_array { | 
| 49 |  |  |  |  |  |  | my($parent, $value) = @_; | 
| 50 |  |  |  |  |  |  | $parent->setAttribute('type', 'array'); | 
| 51 |  |  |  |  |  |  | foreach my $child_value (@$value) { | 
| 52 |  |  |  |  |  |  | build_node('item', $child_value, $parent); | 
| 53 |  |  |  |  |  |  | } | 
| 54 |  |  |  |  |  |  | } | 
| 55 |  |  |  |  |  |  |  | 
| 56 |  |  |  |  |  |  | sub build_node { | 
| 57 |  |  |  |  |  |  | my($node_name, $child_value, $parent) = @_; | 
| 58 |  |  |  |  |  |  | my $child = XML::LibXML::Element->new($node_name); | 
| 59 |  |  |  |  |  |  | add_node($child, $child_value); | 
| 60 |  |  |  |  |  |  | $parent->appendChild($child); | 
| 61 |  |  |  |  |  |  | } | 
| 62 |  |  |  |  |  |  |  | 
| 63 |  |  |  |  |  |  | sub xml_to_hash { | 
| 64 |  |  |  |  |  |  | my $return = XMLin(shift, KeyAttr => [], KeepRoot => 1); | 
| 65 |  |  |  |  |  |  | return scrubbed($return); | 
| 66 |  |  |  |  |  |  | } | 
| 67 |  |  |  |  |  |  |  | 
| 68 |  |  |  |  |  |  | sub scrubbed { | 
| 69 |  |  |  |  |  |  | my $tree = shift; | 
| 70 |  |  |  |  |  |  | if (is_hashref($tree)) { | 
| 71 |  |  |  |  |  |  | return collect_from_hash($tree); | 
| 72 |  |  |  |  |  |  | } elsif (is_arrayref($tree)) { | 
| 73 |  |  |  |  |  |  | return collect_from_array($tree); | 
| 74 |  |  |  |  |  |  | } else { | 
| 75 |  |  |  |  |  |  | return $tree; | 
| 76 |  |  |  |  |  |  | } | 
| 77 |  |  |  |  |  |  | } | 
| 78 |  |  |  |  |  |  |  | 
| 79 |  |  |  |  |  |  | sub collect_from_array { | 
| 80 |  |  |  |  |  |  | my ($tree) = @_; | 
| 81 |  |  |  |  |  |  | my @new_array = (); | 
| 82 |  |  |  |  |  |  | foreach my $value (@$tree) { | 
| 83 |  |  |  |  |  |  | push(@new_array, scrubbed($value)); | 
| 84 |  |  |  |  |  |  | } | 
| 85 |  |  |  |  |  |  | return \@new_array; | 
| 86 |  |  |  |  |  |  | } | 
| 87 |  |  |  |  |  |  |  | 
| 88 |  |  |  |  |  |  | sub collect_from_hash { | 
| 89 |  |  |  |  |  |  | my ($tree) = @_; | 
| 90 |  |  |  |  |  |  | my $new_hash = {}; | 
| 91 |  |  |  |  |  |  |  | 
| 92 |  |  |  |  |  |  | my %types = ( | 
| 93 |  |  |  |  |  |  | array => \&array, | 
| 94 |  |  |  |  |  |  | boolean => \&boolean, | 
| 95 |  |  |  |  |  |  | integer => \&integer, | 
| 96 |  |  |  |  |  |  | datetime => \&datetime, | 
| 97 |  |  |  |  |  |  | date => \&date | 
| 98 |  |  |  |  |  |  | ); | 
| 99 |  |  |  |  |  |  |  | 
| 100 |  |  |  |  |  |  | foreach my $type (keys %types) { | 
| 101 |  |  |  |  |  |  | return $types{$type}->($tree) if is_of_type($type, $tree); | 
| 102 |  |  |  |  |  |  | } | 
| 103 |  |  |  |  |  |  | return $tree->{'content'} if exists($tree->{'content'}); | 
| 104 |  |  |  |  |  |  | return undef if is_nil($tree); | 
| 105 |  |  |  |  |  |  | while (my ($key, $subtree) = each(%$tree)) { | 
| 106 |  |  |  |  |  |  | $new_hash->{sub_dashes($key)} = scrubbed($subtree); | 
| 107 |  |  |  |  |  |  | } | 
| 108 |  |  |  |  |  |  | return $new_hash; | 
| 109 |  |  |  |  |  |  | } | 
| 110 |  |  |  |  |  |  |  | 
| 111 |  |  |  |  |  |  | sub is_of_type { | 
| 112 |  |  |  |  |  |  | my ($type, $tree) = @_; | 
| 113 |  |  |  |  |  |  | no warnings; | 
| 114 |  |  |  |  |  |  | return 0 unless $tree->{'type'}; | 
| 115 |  |  |  |  |  |  | return $tree->{'type'} eq $type; | 
| 116 |  |  |  |  |  |  | } | 
| 117 |  |  |  |  |  |  |  | 
| 118 |  |  |  |  |  |  | sub is_nil { | 
| 119 |  |  |  |  |  |  | my $tree = shift; | 
| 120 |  |  |  |  |  |  | return 0 unless $tree->{'nil'}; | 
| 121 |  |  |  |  |  |  | return $tree->{'nil'} eq "true"; | 
| 122 |  |  |  |  |  |  | } | 
| 123 |  |  |  |  |  |  |  | 
| 124 |  |  |  |  |  |  | sub boolean { | 
| 125 |  |  |  |  |  |  | return shift->{'content'} eq 'true' ? 1 : 0; | 
| 126 |  |  |  |  |  |  | } | 
| 127 |  |  |  |  |  |  |  | 
| 128 |  |  |  |  |  |  | sub integer { | 
| 129 |  |  |  |  |  |  | return shift->{'content'}; | 
| 130 |  |  |  |  |  |  | } | 
| 131 |  |  |  |  |  |  |  | 
| 132 |  |  |  |  |  |  | my $f = DateTime::Format::Atom->new(); | 
| 133 |  |  |  |  |  |  |  | 
| 134 |  |  |  |  |  |  | sub datetime { | 
| 135 |  |  |  |  |  |  | my $dt = $f->parse_datetime(shift->{'content'}); | 
| 136 |  |  |  |  |  |  | } | 
| 137 |  |  |  |  |  |  |  | 
| 138 |  |  |  |  |  |  | sub date { | 
| 139 |  |  |  |  |  |  | my $date = shift->{'content'}; | 
| 140 |  |  |  |  |  |  | $date .= 'T00:00:00Z'; | 
| 141 |  |  |  |  |  |  | my $dt = $f->parse_datetime($date); | 
| 142 |  |  |  |  |  |  | } | 
| 143 |  |  |  |  |  |  |  | 
| 144 |  |  |  |  |  |  | sub array { | 
| 145 |  |  |  |  |  |  | my $tree = shift; | 
| 146 |  |  |  |  |  |  |  | 
| 147 |  |  |  |  |  |  | delete $tree->{type}; | 
| 148 |  |  |  |  |  |  | my $subtree = (values %$tree)[0]; | 
| 149 |  |  |  |  |  |  | if (is_hashref($subtree)) { | 
| 150 |  |  |  |  |  |  | return [scrubbed($subtree)]; | 
| 151 |  |  |  |  |  |  | } elsif (is_arrayref($subtree)) { | 
| 152 |  |  |  |  |  |  | return scrubbed($subtree); | 
| 153 |  |  |  |  |  |  | } elsif (defined($subtree)) { | 
| 154 |  |  |  |  |  |  | return [$subtree]; | 
| 155 |  |  |  |  |  |  | } else { | 
| 156 |  |  |  |  |  |  | return []; | 
| 157 |  |  |  |  |  |  | } | 
| 158 |  |  |  |  |  |  | } | 
| 159 |  |  |  |  |  |  |  | 
| 160 |  |  |  |  |  |  | sub sub_dashes { | 
| 161 |  |  |  |  |  |  | my $string = shift; | 
| 162 |  |  |  |  |  |  | $string =~ s/-/_/g; | 
| 163 |  |  |  |  |  |  | return $string; | 
| 164 |  |  |  |  |  |  | } | 
| 165 |  |  |  |  |  |  |  | 
| 166 |  |  |  |  |  |  | 1; | 
| 167 |  |  |  |  |  |  | __END__ |