File Coverage

blib/lib/Catmandu/AlephX/Op/BorInfo.pm
Criterion Covered Total %
statement 9 39 23.0
branch 0 4 0.0
condition 0 4 0.0
subroutine 3 5 60.0
pod 0 2 0.0
total 12 54 22.2


line stmt bran cond sub pod time code
1             package Catmandu::AlephX::Op::BorInfo;
2 1     1   103933 use Catmandu::Sane;
  1         198056  
  1         7  
3 1     1   313 use Catmandu::Util qw(:check :is);
  1         2  
  1         434  
4 1     1   10 use Moo;
  1         2  
  1         5  
5              
6             our $VERSION = "1.072";
7              
8             extends('Catmandu::AlephX::Op::BorAuth');
9             with('Catmandu::AlephX::Response');
10              
11             has item_l => (
12             is => 'ro',
13             lazy => 1,
14             isa => sub { check_array_ref($_[0]); },
15             default => sub {
16             []
17             }
18             );
19             has item_h => (
20             is => 'ro',
21             lazy => 1,
22             isa => sub { check_array_ref($_[0]); },
23             default => sub {
24             []
25             }
26             );
27              
28             has balance => (
29             is => 'ro'
30             );
31             has sign => (
32             is => 'ro'
33             );
34             has fine => (
35             is => 'ro',
36             lazy => 1,
37             isa => sub {
38             check_array_ref($_[0]);
39             },
40             default => sub {
41             []
42             }
43             );
44              
45 0     0 0   sub op { 'bor-info' }
46              
47             my $config = {
48             fine => [qw(z31 z30 z13)],
49             'item-h' => [qw(z37 z30 z13)]
50             };
51              
52             sub parse {
53 0     0 0   my($class,$str_ref) = @_;
54 0           my $xpath = xpath($str_ref);
55              
56 0           my $op = op();
57              
58 0           my $args = {};
59              
60 0           for my $zkey(qw(z303 z304 z305)){
61 0           my($l) = $xpath->find("/$op/$zkey")->get_nodelist();
62 0 0         $args->{$zkey} = $l ? get_children($l,1) : {};
63             }
64              
65 0           for my $child($xpath->find("/$op/item-l")->get_nodelist()){
66 0   0       $args->{'item_l'} //= [];
67              
68 0           my $item_l = {};
69 0           $item_l->{due_date} = $child->findvalue('./due-date');
70 0           $item_l->{due_hour} = $child->findvalue('./due-hour');
71              
72 0           for my $key(qw(z36 z30 z13)){
73 0           for my $data($child->find("./$key")->get_nodelist()){
74 0           $item_l->{ $key } = get_children($data,1);
75             }
76             }
77              
78 0           push @{ $args->{'item_l'} },$item_l;
  0            
79              
80             }
81              
82              
83 0           for my $key(keys %$config){
84 0           for my $child($xpath->find("/$op/$key")->get_nodelist()){
85 0           my $n = $key;
86 0           $n =~ s/-/_/go;
87 0   0       $args->{$n} //= [];
88              
89             my %result = map {
90 0           my($l) = $child->find("./$_")->get_nodelist();
91 0 0         $l ? ($_ => get_children($l,1 )) : ($_ => {});
92 0           } @{ $config->{ $key } };
  0            
93              
94 0           push @{ $args->{$n} },\%result;
  0            
95             }
96             }
97              
98             __PACKAGE__->new(
99 0           %$args,
100             balance => $xpath->findvalue("/$op/balance"),
101             sign => $xpath->findvalue("/$op/sign"),
102             session_id => $xpath->findvalue("/$op/session-id"),
103             errors => $class->parse_errors($xpath),
104             content_ref => $str_ref
105             );
106              
107             }
108              
109             1;