File Coverage

blib/lib/Rex/Args.pm
Criterion Covered Total %
statement 87 104 83.6
branch 15 26 57.6
condition 12 21 57.1
subroutine 20 20 100.0
pod 0 5 0.0
total 134 176 76.1


line stmt bran cond sub pod time code
1             #
2             # (c) Jan Gehring
3             #
4              
5             package Rex::Args;
6              
7 106     106   1172067 use v5.12.5;
  106         537  
8 106     106   623 use warnings;
  106         205  
  106         4954  
9              
10             our $VERSION = '1.14.2.3'; # TRIAL VERSION
11              
12 106     106   638 use vars qw(%rex_opts);
  106         249  
  106         5167  
13 106     106   8852 use Rex::Logger;
  106         258  
  106         1133  
14 106     106   13719 use Data::Dumper;
  106         122874  
  106         109226  
15              
16             our $CLEANUP = 1;
17              
18             sub args_spec {
19             return (
20 1     1 0 43 a => {},
21             C => {},
22             c => {},
23             q => {},
24             Q => {},
25             F => {},
26             T => {},
27             h => {},
28             v => {},
29             d => {},
30             s => {},
31             m => {},
32             y => {},
33             w => {},
34             S => { type => "string" },
35             E => { type => "string" },
36             o => { type => "string" },
37             f => { type => "string" },
38             M => { type => "string" },
39             b => { type => "string" },
40             e => { type => "string" },
41             H => { type => "string" },
42             u => { type => "string" },
43             p => { type => "string" },
44             P => { type => "string" },
45             K => { type => "string" },
46             G => { type => "string" },
47             g => { type => "string" },
48             z => { type => "string" },
49             O => { type => "string" },
50             t => { type => "string" },
51             );
52             }
53              
54             sub parse_rex_opts {
55 1     1 0 143 my ($class) = @_;
56              
57 1         5 my %args = $class->args_spec;
58              
59             #### clean up @ARGV
60 1         4 my $runner = 0;
61 1         4 for (@ARGV) {
62 17 50 100     59 if ( /^\-[A-Za-z]+/ && length($_) > 2 && $CLEANUP ) {
      66        
63 1         13 my @args = map { "-$_" } split( //, substr( $_, 1 ) );
  2         9  
64 1         4 splice( @ARGV, $runner, 1, @args );
65             }
66              
67 17         25 $runner++;
68             }
69              
70             #### parse rex options
71 1         7 my @params = @ARGV;
72 1         3 for my $p (@params) {
73              
74             # shift off @ARGV
75 10         17 my $shift = shift @ARGV;
76              
77 10 100 66     45 if ( length($p) >= 2 && substr( $p, 0, 1 ) eq "-" ) {
78 9         18 my $name_param = substr( $p, 1, 2 );
79              
80             # found a parameter
81              
82 9 50       18 if ( exists $args{$name_param} ) {
83 9         33 Rex::Logger::debug("Option found: $name_param ($p)");
84 9         15 my $type = "Single";
85              
86 9 100       25 if ( exists $args{$name_param}->{type} ) {
    50          
87 5         8 $type = $args{$name_param}->{type};
88              
89 5         15 Rex::Logger::debug(" is a $type");
90 5         7 shift @params; # remove the next parameter, because it must be an option
91              
92 5 0 33     20 if (
      33        
      33        
93             !exists $ARGV[0]
94             || ( length( $ARGV[0] ) == 2
95             && exists $args{ substr( $ARGV[0], 1, 2 ) }
96             && substr( $ARGV[0], 0, 1 ) eq "-" )
97             )
98             {
99             # this is a typed parameter without an option!
100 0         0 Rex::Logger::debug(" but there is no parameter");
101 0         0 Rex::Logger::debug( Dumper( \@params ) );
102 0         0 print("No parameter for $name_param\n");
103 0         0 CORE::exit 1;
104             }
105             }
106             elsif ( exists $args{$name_param}->{func} ) {
107 0         0 Rex::Logger::debug(" is a function - executing now");
108 0         0 $args{$name_param}->{func}->();
109             }
110              
111 9         30 my $c = "Rex::Args::\u$type";
112 9     1   441 eval "use $c";
  1     1   419  
  1     1   3  
  1     1   19  
  1     1   367  
  1     1   3  
  1     1   21  
  1     1   6  
  1     1   2  
  1         11  
  1         5  
  1         3  
  1         12  
  1         5  
  1         3  
  1         10  
  1         6  
  1         2  
  1         10  
  1         5  
  1         2  
  1         10  
  1         5  
  1         2  
  1         10  
  1         6  
  1         2  
  1         10  
113 9 50       28 if ($@) {
114 0         0 die("No Argumentclass $type found!");
115             }
116              
117 9 50 66     27 if ( exists $rex_opts{$name_param} && $type eq "Single" ) {
118 0         0 $rex_opts{$name_param}++;
119             }
120             else {
121             # multiple params defined, create an array
122 9 100       19 if ( exists $rex_opts{$name_param} ) {
123 1 50       6 if ( !ref $rex_opts{$name_param} ) {
124 1         3 $rex_opts{$name_param} = [ $rex_opts{$name_param} ];
125             }
126 1         2 push @{ $rex_opts{$name_param} }, $c->get;
  1         5  
127             }
128             else {
129 8         20 $rex_opts{$name_param} = $c->get;
130             }
131             }
132             }
133             else {
134 0         0 Rex::Logger::debug("Option not known: $name_param ($p)");
135 0         0 next;
136             }
137             }
138             else {
139             # unshift the last parameter
140 1         3 unshift @ARGV, $shift;
141 1         12 last;
142             }
143             }
144             }
145              
146 224     224 0 1412 sub getopts { return %rex_opts; }
147              
148             sub is_opt {
149 65     65 0 692 my ( $class, $opt ) = @_;
150 65 50       673 if ( exists $rex_opts{$opt} ) {
151 0         0 return $rex_opts{$opt};
152             }
153             }
154              
155             sub get {
156 16     16 0 490 my ($class) = @_;
157              
158 16         516 my $task = Rex::TaskList->create->current_task;
159 16 100       166 if ($task) {
160 13         102 return $task->get_opts();
161             }
162             else {
163 3         9 return _read_old_way();
164             }
165             }
166              
167             sub _read_old_way {
168             #### parse task options
169 3     3   5 my %task_opts;
170              
171 3         15 for my $p (@ARGV) {
172 0         0 my ( $key, $val ) = split( /=/, $p, 2 );
173              
174 0         0 $key =~ s/^--//;
175              
176 0 0       0 if ( defined $val ) { $task_opts{$key} = $val; next; }
  0         0  
  0         0  
177 0         0 $task_opts{$key} = 1;
178             }
179              
180 3         20 return %task_opts;
181             }
182              
183             1;