File Coverage

blib/lib/Net/IPMessenger/MessageCommand.pm
Criterion Covered Total %
statement 45 51 88.2
branch 15 22 68.1
condition n/a
subroutine 9 10 90.0
pod 4 4 100.0
total 73 87 83.9


line stmt bran cond sub pod time code
1             package Net::IPMessenger::MessageCommand;
2              
3 2     2   12 use warnings;
  2         15  
  2         81  
4 2     2   10 use strict;
  2         4  
  2         115  
5 2     2   4329 use overload '""' => \&get_command, fallback => 1;
  2         2429  
  2         20  
6 2     2   166 use Scalar::Util qw( looks_like_number );
  2         6  
  2         1588  
7              
8             our $AUTOLOAD;
9              
10             my %COMMAND = (
11             NOOPERATION => 0x00000000,
12             BR_ENTRY => 0x00000001,
13             BR_EXIT => 0x00000002,
14             ANSENTRY => 0x00000003,
15             BR_ABSENCE => 0x00000004,
16             BR_ISGETLIST => 0x00000010,
17             OKGETLIST => 0x00000011,
18             GETLIST => 0x00000012,
19             ANSLIST => 0x00000013,
20             BR_ISGETLIST2 => 0x00000018,
21             SENDMSG => 0x00000020,
22             RECVMSG => 0x00000021,
23             READMSG => 0x00000030,
24             DELMSG => 0x00000031,
25             ANSREADMSG => 0x00000032,
26             GETINFO => 0x00000040,
27             SENDINFO => 0x00000041,
28             GETABSENCEINFO => 0x00000050,
29             SENDABSENCEINFO => 0x00000051,
30             GETFILEDAT => 0x00000060,
31             RELEASEFIL => 0x00000061,
32             GETDIRFILE => 0x00000062,
33             GETPUBKEY => 0x00000072,
34             ANSPUBKEY => 0x00000073,
35             );
36              
37             my $MODE = 0x000000ff;
38             my %SEND_OPT = (
39             ABSENCE => 0x00000100,
40             SERVER => 0x00000200,
41             DIALUP => 0x00010000,
42             SENDCHECK => 0x00000100,
43             SECRET => 0x00000200,
44             BROADCAST => 0x00000400,
45             MULTICAST => 0x00000800,
46             NOPOPUP => 0x00001000,
47             AUTORET => 0x00002000,
48             RETRY => 0x00004000,
49             PASSWORD => 0x00008000,
50             NOLOG => 0x00020000,
51             NEWMUTI => 0x00040000,
52             NOADDLIST => 0x00080000,
53             READCHECK => 0x00100000,
54             FILEATTACH => 0x00200000,
55             ENCRYPT => 0x00400000,
56             );
57              
58             sub new {
59 20     20 1 55 my $class = shift;
60 20         26 my $name = shift;
61 20 50       121 return unless defined $name;
62              
63 20         22 my $command;
64 20 100       78 if ( looks_like_number($name) ) {
    50          
65 16         26 $command = $name;
66             }
67             elsif ( exists $COMMAND{$name} ) {
68 4         88 $command = $COMMAND{$name};
69             }
70             else {
71 0         0 return;
72             }
73              
74 20         123 my $self = { _command => $command };
75 20         182 bless $self, $class;
76             }
77              
78             sub AUTOLOAD {
79 14     14   23 my $self = shift;
80 14 50       34 return unless ref $self;
81              
82 14         80 my $command = $self->{_command};
83 14         20 my $name = $AUTOLOAD;
84 14         69 $name =~ s/.*://;
85              
86 14 100       279 if ( $name =~ /^get_(.+)/ ) {
    50          
87 12         35 my $opt = uc $1;
88 12 50       181 if ( exists $SEND_OPT{$opt} ) {
89 12 100       162 return ( $command & $SEND_OPT{$opt} ? 1 : 0 );
90             }
91             else {
92 0         0 return;
93             }
94             }
95             elsif ( $name =~ /^set_(.+)/ ) {
96 2         9 my $opt = uc $1;
97 2 50       8 if ( exists $SEND_OPT{$opt} ) {
98 2         7 $self->{_command} = $command | $SEND_OPT{$opt};
99 2         8 return $self;
100             }
101             else {
102 0         0 return;
103             }
104             }
105             else {
106 0         0 return;
107             }
108             }
109              
110             sub mode {
111 19     19 1 33 my $self = shift;
112 19         34 my $command = $self->{_command};
113              
114 19 50       44 return (0) unless defined $command;
115 19         45 return ( $command & $MODE );
116             }
117              
118             sub modename {
119 19     19 1 42 my $self = shift;
120 19         42 my $mode = $self->mode;
121              
122 19         100 for my $key ( keys %COMMAND ) {
123 237 100       982 if ( $mode eq $COMMAND{$key} ) {
124 19         95 return $key;
125             }
126             }
127 0         0 return $mode;
128             }
129              
130             sub get_command {
131 4     4 1 131 my $self = shift;
132 4         22 return $self->{_command};
133             }
134              
135 0     0     sub DESTROY {
136             }
137              
138             1;
139             __END__