File Coverage

blib/lib/Net/Gnats/Command/UNLK.pm
Criterion Covered Total %
statement 23 23 100.0
branch 6 6 100.0
condition n/a
subroutine 8 8 100.0
pod 2 3 66.6
total 39 40 97.5


line stmt bran cond sub pod time code
1             package Net::Gnats::Command::UNLK;
2 40     40   164 use parent 'Net::Gnats::Command';
  40         57  
  40         177  
3 40     40   2003 use strictures;
  40         53  
  40         171  
4             BEGIN {
5 40     40   3081 $Net::Gnats::Command::UNLK::VERSION = '0.20';
6             }
7 40     40   197 use vars qw($VERSION);
  40         51  
  40         1503  
8              
9 40     40   175 use Net::Gnats::Constants qw(CODE_OK CODE_PR_NOT_LOCKED);
  40         57  
  40         7265  
10              
11             =head1 NAME
12              
13             Net::Gnats::Command::UNLK
14              
15             =head1 DESCRIPTION
16              
17              
18             Unlocks PR. Any user may unlock a PR, as no checking is done to
19             determine if the requesting session owns the lock.
20              
21             =head1 PROTOCOL
22              
23             UNLK
24              
25             =head1 RESPONSES
26              
27              
28             The possible responses are:
29              
30             440 (CODE_CMD_ERROR)
31              
32             Insufficient or too many arguments were specified to the command.
33              
34             210 (CODE_OK)
35              
36             The PR was successfully unlocked.
37              
38             433 (CODE_PR_NOT_LOCKED)
39              
40             The PR was not locked.
41              
42             6xx (internal error)
43              
44             The PR could not be unlocked, usually because of permission or other
45             filesystem-related problems.
46              
47             =cut
48              
49             my $c = 'UNLK';
50              
51             sub new {
52 4     4 1 10 my ( $class, %options ) = @_;
53 4         10 my $self = bless \%options, $class;
54 4         13 return $self;
55             }
56              
57             sub as_string {
58 11     11 1 14 my $self = shift;
59 11 100       35 return undef if not defined $self->{pr_number};
60 10         32 return $c . ' ' . $self->{pr_number};
61             }
62              
63             sub is_ok {
64 6     6 0 7 my $self = shift;
65 6 100       17 return 0 if not defined $self->response;
66 5 100       11 return 1 if $self->response->code == CODE_OK;
67 2         9 return 0;
68             }
69              
70             1;