1package Net::Gnats::Command; 2use utf8; 3use strictures; 4use Scalar::Util 'reftype'; 5 6BEGIN { 7 $Net::Gnats::Command::VERSION = '0.22'; 8} 9use vars qw($VERSION); 10 11use Net::Gnats::Response; 12use Net::Gnats::Command::ADMV; 13use Net::Gnats::Command::APPN; 14use Net::Gnats::Command::CHDB; 15use Net::Gnats::Command::CHEK; 16use Net::Gnats::Command::DBLS; 17use Net::Gnats::Command::DBDESC; 18use Net::Gnats::Command::DELETE; 19use Net::Gnats::Command::EDIT; 20use Net::Gnats::Command::EDITADDR; 21use Net::Gnats::Command::EXPR; 22use Net::Gnats::Command::FDSC; 23use Net::Gnats::Command::FIELDFLAGS; 24use Net::Gnats::Command::FTYP; 25use Net::Gnats::Command::FTYPINFO; 26use Net::Gnats::Command::FVLD; 27use Net::Gnats::Command::INPUTDEFAULT; 28use Net::Gnats::Command::LIST; 29use Net::Gnats::Command::LKDB; 30use Net::Gnats::Command::LOCK; 31use Net::Gnats::Command::QFMT; 32use Net::Gnats::Command::QUER; 33use Net::Gnats::Command::REPL; 34use Net::Gnats::Command::RSET; 35use Net::Gnats::Command::SUBM; 36use Net::Gnats::Command::UNDB; 37use Net::Gnats::Command::UNLK; 38use Net::Gnats::Command::USER; 39use Net::Gnats::Command::VFLD; 40use Net::Gnats::Command::QUIT; 41 42=head1 NAME 43 44Net::Gnats::Command - Command factory and base class. 45 46=head1 VERSION 47 480.18 49 50=head1 DESCRIPTION 51 52Encapsulates all Gnats Daemon commands and their command processing 53codes. 54 55This module implements the factory pattern for retrieving specific 56commands. 57 58=cut 59 60our @EXPORT_OK = 61 qw(admv appn chdb chek dbdesc dbls delete_pr edit editaddr expr fdsc 62 fieldflags ftyp ftypinfo fvld inputdefault list lkdb lock_pr qfmt 63 quer quit repl rset subm undb unlk user vfld); 64 65=head1 CONSTRUCTOR 66 67=head2 new 68 69Instantiates a new L<Net::Gnats::Command> object. 70 71 $c = Net::Gnats::Command->new; 72 73This class is not instantiated directly; it is a superclass for all Gnats 74command objects. 75 76=cut 77 78sub new { 79 my ($class, %options) = @_; 80 81 my $self = bless {}, $class; 82 return $self; 83} 84 85=head1 ACCESSORS 86 87=head2 field 88 89Sets and retrieves a L<Net::Gnats::FieldInstance> to the command. 90 91=cut 92 93sub field { 94 my ( $self, $value ) = @_; 95 return $self->{field} if not defined $value; 96 return $self->{field} if not defined reftype($value); 97 return $self->{field} if not reftype($value) eq 'HASH'; 98 return $self->{field} if not $value->isa('Net::Gnats::FieldInstance'); 99 100 $self->{field} = $value; 101 return $self->{field}; 102} 103 104=head2 field_change_reason 105 106Sets and retrieves a L<Net::Gnats::FieldInstance> for Change Reasons to the 107command. 108 109This may be removed in the future given a FieldInstance now manages its own 110Change Reason. 111 112=cut 113 114sub field_change_reason { 115 my ( $self, $value ) = @_; 116 return $self->{field_change_reason} if not defined $value; 117 return $self->{field_change_reason} if not defined reftype($value); 118 return $self->{field_change_reason} if not reftype($value) eq 'HASH'; 119 return $self->{field_change_reason} 120 if not $value->isa('Net::Gnats::FieldInstance'); 121 122 $self->{field_change_reason} = $value; 123 return $self->{field_change_reason}; 124} 125 126=head2 pr 127 128For commands that must send a serialized PR, or serialized field, after issuing a command. 129 130=cut 131 132sub pr { 133 my ( $self, $value ) = @_; 134 return $self->{pr} if not defined $value; 135 return $self->{pr} if not defined reftype($value); 136 return $self->{pr} if not reftype($value) eq 'HASH'; 137 return $self->{pr} if not $value->isa('Net::Gnats::PR'); 138 139 $self->{pr} = $value; 140 return $self->{pr}; 141} 142 143=head2 error_codes 144 145Retrieves the valid error codes for the command. Not used yet. 146 147 my $codes = $c->error_codes; 148 149=cut 150 151sub error_codes { shift->{error_codes} } 152 153 154=head2 success_codes 155 156Retrieves the valid success codes for the command. Not used yet. 157 158 my $codes = $c->success_codes; 159 160=cut 161 162sub success_codes { shift->{success_codes} } 163 164=head2 response 165 166Manages the response outcome from the server encapsulated in a 167L<Net::Gnats::Response> object. 168 169When the command has not been issued yet, the value will be undef. 170 171 $response = $c->response; 172 $code = $c->response->code; 173 174=cut 175 176sub response { 177 my ($self, $value) = @_; 178 $self->{response} = $value if defined $value; 179 return $self->{response}; 180} 181 182=head2 requests_multi 183 184A flag for knowing if multiple responses are expected. Normally used and 185managed internally. May become a private method later. 186 187=cut 188 189sub requests_multi { 190 my $self = shift; 191 return $self->{requests_multi}; 192} 193 194 195=head1 METHODS 196 197=head2 as_string 198 199Returns the currently configured command as a string. 200 201=cut 202 203sub as_string { 204 my ( $self ) = @_; 205} 206 207=head2 from 208 209This method is used for commands where 1..n fields can be defined for a given 210command, and the issuer needs to match up field names to values. 211 212 $c = Net::Gnats::Command->fdsc( [ 'FieldA', 'FieldB' ]; 213 Net::Gnats->current_session->issue( $c ); 214 $value = $c->from( 'FieldA' ) unless not $c->is_ok; 215 216=cut 217 218sub from { 219 my ( $self, $value ) = @_; 220 # identify idx of value 221 my @fields = @{ $self->{fields} }; 222 my ( $index )= grep { $fields[$_] =~ /$value/ } 0..$#fields; 223 return @{ $self->response->as_list }[$index]; 224} 225 226=head1 EXPORTED METHODS 227 228The following exported methods are helpers for executing all Gnats 229protocol commands. 230 231=head2 admv 232 233 my $c = Net::Gnats::Command->admv; 234 235=cut 236 237sub admv { shift; return Net::Gnats::Command::ADMV->new( @_ ); } 238 239=head2 appn 240 241Manages the command for appending field content to an existing PR field. The 242field key is a L<Net::Gnats::FieldInstance> object. 243 244 $c = Net::Gnats::Command->appn( pr_number => 5, field => $field ); 245 246See L<Net::Gnats::Command::APPN> for details. 247 248=cut 249 250sub appn { shift; return Net::Gnats::Command::APPN->new( @_ ); } 251 252=head2 chdb 253 254Manages the command for changing databases within the same 255L<Net::Gnats::Session> instance. 256 257 $c = Net::Gnats::Command->chdb( database => 'external' ); 258 259See L<Net::Gnats::Command::CHDB> for details. 260 261=cut 262 263sub chdb { shift; return Net::Gnats::Command::CHDB->new( @_ ); } 264 265=head2 chek 266 267Manages the command for checking the validity of a PR before sending. 268 269 # New problem reports: 270 $c = Net::Gnats::Command->chek( type => 'initial', pr => $pr ); 271 272 # Existing problem reports: 273 $c = Net::Gnats::Command->chek( pr => $pr ); 274 275See L<Net::Gnats::Command::CHEK> for details. 276 277=cut 278 279sub chek { shift; return Net::Gnats::Command::CHEK->new( @_ ); } 280 281=head2 dbls 282 283Manages the command to list server databases. This command is the only command 284that typically does not require credentials. 285 286 $c = Net::Gnats::Command->dbls; 287 288See L<Net::Gnats::Command::DBLS> for details. 289 290=cut 291 292sub dbls { shift; return Net::Gnats::Command::DBLS->new( @_ ); } 293 294=head2 dbdesc 295 296Manages the command for returning the description of the databases existing on 297the server. 298 299 $c = Net::Gnats::Command->dbdesc; 300 301See L<Net::Gnats::Command::DBDESC> for details. 302 303=cut 304 305sub dbdesc { shift; return Net::Gnats::Command::DBDESC->new( @_ ); } 306 307=head2 delete_pr 308 309Manages the command for deleting a PR from the database. Only those with 310'admin' credentials can successfully issue this command. 311 312 $c = Net::Gnats::Command->delete_pr( pr => $pr ); 313 314See L<Net::Gnats::Command::DELETE> for details. 315 316=cut 317 318sub delete_pr { shift; return Net::Gnats::Command::DELETE->new( @_ ); } 319 320=head2 edit 321 322Manages the command for submitting an update to an existing PR to the database. 323 324 $c = Net::Gnats::Command->edit( pr => $pr ); 325 326See L<Net::Gnats::Command::EDIT> for details. 327 328=cut 329 330sub edit { shift; return Net::Gnats::Command::EDIT->new( @_ ); } 331 332=head2 editaddr 333 334Manages the command for setting the active email address for the session. This 335is most relevant when submitting or editing PRs. 336 337 $address = 'joe@somewhere.com'; 338 $c = Net::Gnats::Command->editaddr( address => $address ); 339 340See L<Net::Gnats::Command::EDITADDR> for details. 341 342=cut 343 344sub editaddr { shift; return Net::Gnats::Command::EDITADDR->new( @_ ); } 345 346=head2 expr 347 348Manages the command for setting the query expression for a PR. Query 349expressions AND together. 350 351This method may change in the future. 352 353 $c = Net::Gnats::Command->expr( expressions => ['foo="bar"', 'bar="baz"'] ); 354 355See L<Net::Gnats::Command::EXPR> for details. 356 357=cut 358 359sub expr { shift; return Net::Gnats::Command::EXPR->new( @_ ); } 360 361=head2 fdsc 362 363Manages the command for retrieving the description for one or more fields. 364 365 $c = Net::Gnats::Command->fdsc( fields => 'MyField' ); 366 $c = Net::Gnats::Command->fdsc( fields => [ 'Field1', 'Field2' ] ); 367 368See L<Net::Gnats::Command::FDSC> for details. 369 370=cut 371 372sub fdsc { shift; return Net::Gnats::Command::FDSC->new( @_ ); } 373 374=head2 fieldflags 375 376Manages the command for retrieving field flags for one or more fields. 377 378 $c = Net::Gnats::Command->fieldflags( fields => 'MyField' ); 379 $c = Net::Gnats::Command->fieldflags( fields => [ 'Field1', 'Field2' ] ); 380 381See L<Net::Gnats::Command::FIELDFLAGS> for details. 382 383=cut 384 385sub fieldflags { shift; return Net::Gnats::Command::FIELDFLAGS->new( @_ ); } 386 387=head2 ftyp 388 389Manages the command for retrieving the data type for one or more fields. 390 391 $c = Net::Gnats::Command->ftyp( fields => 'MyField' ); 392 $c = Net::Gnats::Command->ftyp( fields => [ 'Field1', 'Field2' ] ); 393 394See L<Net::Gnats::Command::FTYP> for details. 395 396=cut 397 398sub ftyp { shift; return Net::Gnats::Command::FTYP->new( @_ ); } 399 400=head2 ftypinfo 401 402Manages the command for retrieving the type information for a field. Relevant 403to MultiEnum fields only. 404 405 $c = Net::Gnats::Command->ftypinfo( field => 'MyField' ); 406 $c = Net::Gnats::Command->ftypinfo( field => 'MyField', 407 property => 'separators ); 408 409See L<Net::Gnats::Command::FTYPINFO> for details. 410 411=cut 412 413sub ftypinfo { shift; return Net::Gnats::Command::FTYPINFO->new( @_ ); } 414 415=head2 fvld 416 417Manages the command for retrieving the set field validators defined in the 418Gnats schema. 419 420 $c = Net::Gnats::Command->fvld( field => 'MyField' ); 421 422See L<Net::Gnats::Command::FVLD> for details. 423 424=cut 425 426sub fvld { shift; return Net::Gnats::Command::FVLD->new( @_ ); } 427 428=head2 inputdefault 429 430Manages the command for retrieving field default values. 431 432 $c = Net::Gnats::Command->inputdefault( fields => 'MyField' ); 433 $c = Net::Gnats::Command->inputdefault( fields => [ 'Field1', 'Field2' ] ); 434 435See L<Net::Gnats::Command::INPUTDEFAULT> for details. 436 437=cut 438 439sub inputdefault { shift; return Net::Gnats::Command::INPUTDEFAULT->new( @_ ); } 440 441=head2 list 442 443Manages the command for different lists that can be retrieved from Gnats. 444 445 $c = Net::Gnats::Command->list( subcommand => 'Categories' ); 446 $c = Net::Gnats::Command->list( subcommand => 'Submitters' ); 447 $c = Net::Gnats::Command->list( subcommand => 'Responsible' ); 448 $c = Net::Gnats::Command->list( subcommand => 'States' ); 449 $c = Net::Gnats::Command->list( subcommand => 'FieldNames' ); 450 $c = Net::Gnats::Command->list( subcommand => 'InitialInputFields' ); 451 $c = Net::Gnats::Command->list( subcommand => 'InitialRequiredFields' ); 452 $c = Net::Gnats::Command->list( subcommand => 'Databases' ); 453 454See L<Net::Gnats::Command::LIST> for details. 455 456=cut 457 458sub list { shift; return Net::Gnats::Command::LIST->new( @_ ); } 459 460=head2 lkdb 461 462Manages the command for locking the gnats main database. 463 464 $c = Net::Gnats::Command->lkdb; 465 466See L<Net::Gnats::Command::LKDB> for details. 467 468=cut 469 470sub lkdb { shift; return Net::Gnats::Command::LKDB->new( @_ ); } 471 472=head2 lock_pr 473 474Manages the command for locking a specific PR. Usually this occurs prior to 475updating a PR through the edit command. 476 477 $c = Net::Gnats::Command->lock_pr( pr => $pr, user => $user ); 478 $c = Net::Gnats::Command->lock_pr( pr => $pr, user => $user, pid => $pid ); 479 480See L<Net::Gnats::Command::LOCK> for details. 481 482=cut 483 484sub lock_pr { shift; return Net::Gnats::Command::LOCK->new( @_ ); } 485 486=head2 qfmt 487 488Manages the command for setting the PR output format. Net::Gnats parses 'full' 489format only. If you choose another format, you can retrieve the response via 490$c->response->as_string. 491 492 $c = Net::Gnats::Command->qfmt( format => 'full' ); 493 494See L<Net::Gnats::Command::QFMT> for details. 495 496=cut 497 498sub qfmt { shift; return Net::Gnats::Command::QFMT->new( @_ ); } 499 500=head2 quer 501 502Manages the command for querying Gnats. It assumes the expressions have 503already been set. If specific numbers are set, the command will query only 504those PR numbers. 505 506 $c = Net::Gnats::Command->quer; 507 $c = Net::Gnats::Command->quer( pr_numbers => ['10'] ); 508 $c = Net::Gnats::Command->quer( pr_numbers => ['10', '12'] ); 509 510See L<Net::Gnats::Command::QUER> for details. 511 512=cut 513 514sub quer { shift; return Net::Gnats::Command::QUER->new( @_ ); } 515 516=head2 quit 517 518Manages the command for disconnecting the current Gnats session. 519 520 $c = Net::Gnats::Command->quit; 521 522See L<Net::Gnats::Command::QUIT> for details. 523 524=cut 525 526sub quit { shift; return Net::Gnats::Command::QUIT->new( @_ ); } 527 528=head2 repl 529 530Manages the command for replacing field contents. 531 532 $c = Net::Gnats::Command->appn( pr_number => 5, field => $field ); 533 534See L<Net::Gnats::Command::REPL> for details. 535 536=cut 537 538sub repl { shift; return Net::Gnats::Command::REPL->new( @_ ); } 539 540=head2 rset 541 542Manages the command for resetting the index and any query expressions on the 543server. 544 545 $c = Net::Gnats::Command->rset; 546 547See L<Net::Gnats::Command::RSET> for details. 548 549=cut 550 551sub rset { shift; return Net::Gnats::Command::RSET->new( @_ ); } 552 553=head2 subm 554 555Manages the command for submitting a new PR to Gnats. If the named PR already 556has a 'Number', a new PR with the same field contents will be created. 557 558 $c = Net::Gnats::Command->subm( pr => $pr ); 559 560See L<Net::Gnats::Command::SUBM> for details. 561 562=cut 563 564sub subm { shift; return Net::Gnats::Command::SUBM->new( @_ ); } 565 566=head2 undb 567 568Manages the command for unlocking the Gnats main database. 569 570 $c = Net::Gnats::Command->undb; 571 572See L<Net::Gnats::Command::UNDB> for details. 573 574=cut 575 576sub undb { shift; return Net::Gnats::Command::UNDB->new( @_ ); } 577 578=head2 unlk 579 580Manages the command for unlocking a specific PR. 581 582 $c = Net::Gnats::Command->unlk( pr_number => $pr->get_field('Number')->value ); 583 584See L<Net::Gnats::Command::UNLK> for details. 585 586=cut 587 588sub unlk { shift; return Net::Gnats::Command::UNLK->new( @_ ); } 589 590=head2 user 591 592Manages the command for setting the security context for the session. 593 594 $c = Net::Gnats::Command->user( username => $username, password => $password ); 595 596See L<Net::Gnats::Command::USER> for details. 597 598=cut 599 600sub user { shift; return Net::Gnats::Command::USER->new( @_ ); } 601 602=head2 vfld 603 604Manages the command for validating a specific field. The field is a 605L<Net::Gnats::FieldInstance> object. 606 607 $c = Net::Gnats::Command->vfld( field => $field ); 608 $c = Net::Gnats::Command->vfld( field => $pr->get_field('Synopsis'); 609 610See L<Net::Gnats::Command::VFLD> for details. 611 612=cut 613 614sub vfld { shift; return Net::Gnats::Command::VFLD->new( @_ ); } 615 616 6171; 618