File Coverage

blib/lib/Net/Gnats/Schema.pm
Criterion Covered Total %
statement 49 53 92.4
branch 3 4 75.0
condition n/a
subroutine 10 13 76.9
pod 5 7 71.4
total 67 77 87.0


line stmt bran cond sub pod time code
1             package Net::Gnats::Schema;
2 40     40   211 use strictures;
  40         72  
  40         286  
3             BEGIN {
4 40     40   3998 $Net::Gnats::Schema::VERSION = '0.21';
5             }
6 40     40   210 use vars qw($VERSION);
  40         69  
  40         1704  
7              
8 40     40   203 use Net::Gnats::Command;
  40         60  
  40         724  
9 40     40   15468 use Net::Gnats::Field;
  40         102  
  40         1142  
10 40     40   18420 use Net::Gnats::PR;
  40         123  
  40         19656  
11              
12              
13             sub new {
14 38     38 0 78 my ( $class, $session ) = @_;
15              
16 38         132 my $self = bless {}, $class;
17 38 50       248 $self->initialize($session) if defined $session;
18 38         333 return $self;
19             }
20              
21             =head2 initialize
22              
23             Initializes, or re-initializes, the schema for this session.
24              
25             =cut
26              
27             sub initialize {
28 38     38 1 75 my ( $self, $session ) = @_;
29              
30 38         236 my $c_f = Net::Gnats::Command->list(subcommand => 'fieldnames');
31 38         149 my $fields = $session->issue($c_f)->response->as_list;
32              
33 38         209 my $c_fr = Net::Gnats::Command->list(subcommand => 'initialrequiredfields');
34 38         163 my $c_fi = Net::Gnats::Command->list(subcommand => 'initialinputfields');
35              
36 38         186 $self->{initial} = $session->issue($c_fi)->response->as_list;
37 38         172 $self->{required} = $session->issue($c_fr)->response->as_list;
38              
39 38         250 my $c_types = Net::Gnats::Command->ftyp(fields => $fields);
40 38         219 my $c_descs = Net::Gnats::Command->fdsc(fields => $fields);
41 38         222 my $c_deflt = Net::Gnats::Command->inputdefault(fields => $fields);
42 38         189 my $c_flags = Net::Gnats::Command->fieldflags(fields => $fields);
43              
44 38         178 $session->issue($c_types);
45 38         197 $session->issue($c_descs);
46 38         189 $session->issue($c_deflt);
47 38         256 $session->issue($c_flags);
48              
49 38         86 foreach my $fname (@{ $fields }) {
  38         182  
50 912         2229 my $f = Net::Gnats::Field->new;
51 912         1911 $f->name($fname);
52 912         2194 $f->description($c_descs->from($fname));
53 912         2175 $f->type($c_types->from($fname));
54 912         2129 $f->default($c_deflt->from($fname));
55 912         2182 $f->flags($c_flags->from($fname));
56 912         6376 $self->{fields}->{$fname} = $f;
57             # $self->{db_meta}->{fields}->{$f}->{validators} = @{ $vldtr }[$i];
58             }
59             }
60              
61              
62             =head2 field
63              
64             Returns the field object for the named field.
65              
66             =cut
67              
68             sub field {
69 226     226 1 271 my ( $self, $name ) = @_;
70 226 100       759 return 0 if not defined $self->{fields}->{$name};
71 136         475 return $self->{fields}->{$name}
72             }
73              
74             =head2 fields
75              
76             Returns an anonymous array of all fields for this PR Schema.
77              
78             =cut
79              
80 198     198 1 163 sub fields { [ keys %{ shift->{fields} } ] }
  198         1509  
81              
82             =head2 initial
83              
84             Returns an anonymous array of initial input fields for this PR Schema.
85              
86             =cut
87              
88 0     0 1   sub initial { shift->{initial} }
89              
90             =head2 required
91              
92             Returns an anonymous array of required input fields for this PR Schema.
93              
94             =cut
95              
96 0     0 1   sub required { shift->{required} }
97              
98             sub new_pr {
99 0     0 0   my ($self) = @_;
100 0           return Net::Gnats::PR->new();
101             }
102              
103             1;