File Coverage

blib/lib/Duadua/CLI.pm
Criterion Covered Total %
statement 54 54 100.0
branch 9 10 90.0
condition 4 4 100.0
subroutine 15 15 100.0
pod 4 4 100.0
total 86 87 98.8


line stmt bran cond sub pod time code
1             package Duadua::CLI;
2 7     7   179314 use strict;
  7         12  
  7         330  
3 7     7   43 use warnings;
  7         11  
  7         337  
4 7     7   3177 use Duadua;
  7         22  
  7         324  
5 7     7   5670 use Getopt::Long qw/GetOptionsFromArray/;
  7         125935  
  7         41  
6 7     7   6005 use JSON qw/encode_json/;
  7         78799  
  7         44  
7              
8             sub new {
9 8     8 1 11547141 my $class = shift;
10              
11 8         137 return bless {
12             _d => Duadua->new('', { version => 1 }),
13             _opt => $class->_get_opt(@_),
14             }, $class;
15             }
16              
17 3     3 1 682 sub d { shift->{_d} }
18              
19 4     4 1 44 sub opt { $_[0]->{_opt}{$_[1]} }
20              
21             sub run {
22 3     3 1 3085 my ($self) = @_;
23              
24 3         14 my @results;
25              
26 3 100       14 if (my $ua_list = $self->opt('ua_list')) {
27 1         2 for my $ua (@{$ua_list}) {
  1         6  
28 1         8 push @results, $self->_parse($ua);
29             }
30             }
31              
32 3 100       12 if ($self->_is_opened_stdin) {
33 1         10 while (my $ua = ) {
34 1         3 chomp $ua;
35 1         4 push @results, $self->_parse($ua);
36             }
37             }
38              
39 3 100       11 if (scalar @results == 0) {
40 1         15 _show_usage(1);
41             }
42             else {
43 2 50       188 print encode_json(scalar @results == 1 ? $results[0] : \@results);
44             }
45             }
46              
47 2     2   32 sub _is_opened_stdin { -p STDIN }
48              
49             sub _parse {
50 2     2   9 my ($self, $ua) = @_;
51              
52 2         39 $ua =~ s!^"!!g;
53 2         12 $ua =~ s!"$!!g;
54              
55 2         10 my $r = $self->d->reparse($ua);
56              
57 2   100     7 my $v = {
58             ua => $r->ua,
59             name => $r->name,
60             version => $r->version || '-',
61             };
62              
63 2         7 for my $k (qw/
64             is_bot
65             is_ios
66             is_android
67             is_linux
68             is_windows
69             is_chromeos
70             /) {
71 12   100     45 $v->{$k} = $r->$k || 0;
72             }
73              
74 2         10 return $v;
75             }
76              
77             sub _get_opt {
78 8     8   65 my ($class, @argv) = @_;
79              
80 8         18 my $opt = {};
81              
82             GetOptionsFromArray(
83             \@argv,
84             'help' => sub {
85 2     2   1569 $class->_show_usage(1);
86             },
87             'version' => sub {
88 2     2   2086 print "$0 $Duadua::VERSION\n";
89 2         0 exit 1;
90             },
91 8         175 );
92              
93 4 100       2016 if (scalar @argv > 0) {
94 2         4 push @{$opt->{ua_list}}, @argv;
  2         26  
95             }
96              
97 4         46 return $opt;
98             }
99              
100             sub _show_usage {
101 4     4   189968 my ($class, $exitval) = @_;
102              
103 4         2665 require Pod::Usage;
104 4         200127 Pod::Usage::pod2usage(-exitval => $exitval);
105             }
106              
107             1;
108              
109             __END__