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   214 use strictures;
  40         76  
  40         248  
3             BEGIN {
4 40     40   9398 $Net::Gnats::Schema::VERSION = '0.22';
5             }
6 40     40   216 use vars qw($VERSION);
  40         75  
  40         1401  
7              
8 40     40   208 use Net::Gnats::Command;
  40         72  
  40         859  
9 40     40   21276 use Net::Gnats::Field;
  40         109  
  40         1089  
10 40     40   24120 use Net::Gnats::PR;
  40         134  
  40         21107  
11              
12              
13             sub new {
14 38     38 0 95 my ( $class, $session ) = @_;
15              
16 38         132 my $self = bless {}, $class;
17 38 50       237 $self->initialize($session) if defined $session;
18 38         243 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 81 my ( $self, $session ) = @_;
29              
30 38         211 my $c_f = Net::Gnats::Command->list(subcommand => 'fieldnames');
31 38         162 my $fields = $session->issue($c_f)->response->as_list;
32              
33 38         182 my $c_fr = Net::Gnats::Command->list(subcommand => 'initialrequiredfields');
34 38         166 my $c_fi = Net::Gnats::Command->list(subcommand => 'initialinputfields');
35              
36 38         176 $self->{initial} = $session->issue($c_fi)->response->as_list;
37 38         195 $self->{required} = $session->issue($c_fr)->response->as_list;
38              
39 38         291 my $c_types = Net::Gnats::Command->ftyp(fields => $fields);
40 38         220 my $c_descs = Net::Gnats::Command->fdsc(fields => $fields);
41 38         210 my $c_deflt = Net::Gnats::Command->inputdefault(fields => $fields);
42 38         190 my $c_flags = Net::Gnats::Command->fieldflags(fields => $fields);
43              
44 38         164 $session->issue($c_types);
45 38         151 $session->issue($c_descs);
46 38         172 $session->issue($c_deflt);
47 38         150 $session->issue($c_flags);
48              
49 38         82 foreach my $fname (@{ $fields }) {
  38         124  
50 912         2727 my $f = Net::Gnats::Field->new;
51 912         2506 $f->name($fname);
52 912         2551 $f->description($c_descs->from($fname));
53 912         2742 $f->type($c_types->from($fname));
54 912         2893 $f->default($c_deflt->from($fname));
55 912         2728 $f->flags($c_flags->from($fname));
56 912         4810 $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 346 my ( $self, $name ) = @_;
70 226 100       880 return 0 if not defined $self->{fields}->{$name};
71 136         503 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 214 sub fields { [ keys %{ shift->{fields} } ] }
  198         1682  
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;