| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package Net::Gnats::Command::FTYP; | 
| 2 | 40 |  |  | 40 |  | 195 | use parent 'Net::Gnats::Command'; | 
|  | 40 |  |  |  |  | 70 |  | 
|  | 40 |  |  |  |  | 215 |  | 
| 3 | 40 |  |  | 40 |  | 2137 | use strictures; | 
|  | 40 |  |  |  |  | 72 |  | 
|  | 40 |  |  |  |  | 210 |  | 
| 4 |  |  |  |  |  |  | BEGIN { | 
| 5 | 40 |  |  | 40 |  | 8871 | $Net::Gnats::Command::FTYP::VERSION = '0.22'; | 
| 6 |  |  |  |  |  |  | } | 
| 7 | 40 |  |  | 40 |  | 203 | use vars qw($VERSION); | 
|  | 40 |  |  |  |  | 79 |  | 
|  | 40 |  |  |  |  | 1555 |  | 
| 8 |  |  |  |  |  |  |  | 
| 9 | 40 |  |  | 40 |  | 236 | use Net::Gnats::Constants qw(CODE_INFORMATION CODE_INVALID_FIELD_NAME); | 
|  | 40 |  |  |  |  | 85 |  | 
|  | 40 |  |  |  |  | 13826 |  | 
| 10 |  |  |  |  |  |  |  | 
| 11 |  |  |  |  |  |  | =head1 NAME | 
| 12 |  |  |  |  |  |  |  | 
| 13 |  |  |  |  |  |  | Net::Gnats::Command::FTYP | 
| 14 |  |  |  |  |  |  |  | 
| 15 |  |  |  |  |  |  | =head1 DESCRIPTION | 
| 16 |  |  |  |  |  |  |  | 
| 17 |  |  |  |  |  |  | Describes the type of data held in the field(s) specified with the | 
| 18 |  |  |  |  |  |  | command. | 
| 19 |  |  |  |  |  |  |  | 
| 20 |  |  |  |  |  |  | If multiple field names were given, multiple response lines will be | 
| 21 |  |  |  |  |  |  | sent, one for each field, using the standard continuation protocol; | 
| 22 |  |  |  |  |  |  | each response except the last will have a dash - immedately after | 
| 23 |  |  |  |  |  |  | the response code. | 
| 24 |  |  |  |  |  |  |  | 
| 25 |  |  |  |  |  |  | The currently defined data types are: | 
| 26 |  |  |  |  |  |  |  | 
| 27 |  |  |  |  |  |  | Text | 
| 28 |  |  |  |  |  |  |  | 
| 29 |  |  |  |  |  |  | A plain text field, containing exactly one line. | 
| 30 |  |  |  |  |  |  |  | 
| 31 |  |  |  |  |  |  | MultiText | 
| 32 |  |  |  |  |  |  |  | 
| 33 |  |  |  |  |  |  | A text field possibly containing multiple lines of text. | 
| 34 |  |  |  |  |  |  |  | 
| 35 |  |  |  |  |  |  | Enum | 
| 36 |  |  |  |  |  |  |  | 
| 37 |  |  |  |  |  |  | An enumerated data field; the value is restricted to one entry out | 
| 38 |  |  |  |  |  |  | of a list of values associated with the field. | 
| 39 |  |  |  |  |  |  |  | 
| 40 |  |  |  |  |  |  | MultiEnum | 
| 41 |  |  |  |  |  |  |  | 
| 42 |  |  |  |  |  |  | The field contains one or more enumerated values. Values are | 
| 43 |  |  |  |  |  |  | separated with spaces or colons :. | 
| 44 |  |  |  |  |  |  |  | 
| 45 |  |  |  |  |  |  | Integer | 
| 46 |  |  |  |  |  |  |  | 
| 47 |  |  |  |  |  |  | The field contains an integer value, possibly signed. | 
| 48 |  |  |  |  |  |  |  | 
| 49 |  |  |  |  |  |  | Date | 
| 50 |  |  |  |  |  |  |  | 
| 51 |  |  |  |  |  |  | The field contains a date. | 
| 52 |  |  |  |  |  |  |  | 
| 53 |  |  |  |  |  |  | TextWithRegex | 
| 54 |  |  |  |  |  |  |  | 
| 55 |  |  |  |  |  |  | The value in the field must match one or more regular expressions | 
| 56 |  |  |  |  |  |  | associated with the field. | 
| 57 |  |  |  |  |  |  |  | 
| 58 |  |  |  |  |  |  | =head1 PROTOCOL | 
| 59 |  |  |  |  |  |  |  | 
| 60 |  |  |  |  |  |  | FTYP [fields...] | 
| 61 |  |  |  |  |  |  |  | 
| 62 |  |  |  |  |  |  | =head1 RESPONSES | 
| 63 |  |  |  |  |  |  |  | 
| 64 |  |  |  |  |  |  | The possible responses are: | 
| 65 |  |  |  |  |  |  |  | 
| 66 |  |  |  |  |  |  | 350 (CODE_INFORMATION) | 
| 67 |  |  |  |  |  |  |  | 
| 68 |  |  |  |  |  |  | The normal response; the supplied text is the data type. | 
| 69 |  |  |  |  |  |  |  | 
| 70 |  |  |  |  |  |  | 410 (CODE_INVALID_FIELD_NAME) | 
| 71 |  |  |  |  |  |  |  | 
| 72 |  |  |  |  |  |  | The specified field does not exist. | 
| 73 |  |  |  |  |  |  |  | 
| 74 |  |  |  |  |  |  | =cut | 
| 75 |  |  |  |  |  |  |  | 
| 76 |  |  |  |  |  |  |  | 
| 77 |  |  |  |  |  |  | my $c = 'FTYP'; | 
| 78 |  |  |  |  |  |  |  | 
| 79 |  |  |  |  |  |  | sub new { | 
| 80 | 46 |  |  | 46 | 1 | 188 | my ( $class, %options ) = @_; | 
| 81 | 46 |  |  |  |  | 118 | my $self = bless \%options, $class; | 
| 82 | 46 |  |  |  |  | 321 | $self->{requests_multi} = 0; | 
| 83 | 46 | 100 |  |  |  | 189 | return $self if not defined $self->{fields}; | 
| 84 |  |  |  |  |  |  |  | 
| 85 | 45 | 100 |  |  |  | 208 | if (ref $self->{fields} eq 'ARRAY') { | 
| 86 | 42 | 100 |  |  |  | 91 | $self->{requests_multi} = 1 if scalar @{ $self->{fields} } > 1; | 
|  | 42 |  |  |  |  | 227 |  | 
| 87 |  |  |  |  |  |  | } | 
| 88 |  |  |  |  |  |  | else { | 
| 89 | 3 |  |  |  |  | 9 | $self->{fields} = [ $self->{fields} ]; | 
| 90 |  |  |  |  |  |  | } | 
| 91 | 45 |  |  |  |  | 173 | return $self; | 
| 92 |  |  |  |  |  |  | } | 
| 93 |  |  |  |  |  |  |  | 
| 94 |  |  |  |  |  |  | sub as_string { | 
| 95 | 97 |  |  | 97 | 1 | 164 | my ($self) = @_; | 
| 96 | 97 | 100 |  |  |  | 342 | return undef if not defined $self->{fields}; | 
| 97 | 96 |  |  |  |  | 208 | return $c . ' ' . join ( ' ', @{$self->{fields}} ); | 
|  | 96 |  |  |  |  | 666 |  | 
| 98 |  |  |  |  |  |  | } | 
| 99 |  |  |  |  |  |  |  | 
| 100 |  |  |  |  |  |  | # this command can take multiple fields, each getting their own response. | 
| 101 |  |  |  |  |  |  | # so, we check that 'everything' is okay by looking at the parent response. | 
| 102 |  |  |  |  |  |  | sub is_ok { | 
| 103 | 8 |  |  | 8 | 0 | 11 | my $self = shift; | 
| 104 | 8 | 100 |  |  |  | 26 | return 0 if not defined $self->response; | 
| 105 | 7 | 50 |  |  |  | 21 | return 0 if not defined $self->response->code; | 
| 106 |  |  |  |  |  |  |  | 
| 107 | 7 | 100 | 100 |  |  | 38 | if ( $self->{requests_multi} == 0 and | 
| 108 |  |  |  |  |  |  | $self->response->code == CODE_INFORMATION) { | 
| 109 | 4 |  |  |  |  | 17 | return 1; | 
| 110 |  |  |  |  |  |  | } | 
| 111 | 3 | 100 |  |  |  | 10 | return 1 if $self->response->code == CODE_INFORMATION; | 
| 112 | 1 |  |  |  |  | 12 | return 0; | 
| 113 |  |  |  |  |  |  | } | 
| 114 |  |  |  |  |  |  |  | 
| 115 |  |  |  |  |  |  |  | 
| 116 |  |  |  |  |  |  | 1; |