File Coverage

lib/LWP/Authen/OAuth2/Args.pm
Criterion Covered Total %
statement 31 43 72.0
branch 14 20 70.0
condition n/a
subroutine 7 8 87.5
pod 0 4 0.0
total 52 75 69.3


line stmt bran cond sub pod time code
1             package LWP::Authen::OAuth2::Args;
2              
3             # ABSTRACT: Args
4             our $VERSION = '0.19'; # VERSION
5              
6 9     9   61563 use warnings;
  9         26  
  9         273  
7 9     9   39 use strict;
  9         19  
  9         181  
8              
9 9     9   38 use Carp qw(croak confess);
  9         17  
  9         481  
10              
11 9     9   48 use Exporter qw(import);
  9         14  
  9         3346  
12              
13             our @EXPORT_OK = qw(extract_option copy_option assert_options_empty);
14              
15             # Blessed empty hash.
16             sub new {
17 6     6 0 18 return bless {}, shift;
18             }
19              
20             sub extract_option {
21 0     0 0 0 my $obj = shift;
22 0         0 my $opts = shift;
23 0         0 my $name = shift;
24 0         0 my $has_default = @_;
25 0         0 my $default = shift;
26              
27 0 0       0 if (exists $opts->{$name}) {
    0          
28 0         0 return delete $opts->{$name};
29             }
30             elsif ($has_default) {
31 0         0 return $default;
32             }
33             else {
34 0         0 croak("'$name' is required, cannot be missing");
35             }
36             }
37              
38             sub copy_option {
39 158     158 0 4068 my $obj = shift;
40 158         193 my $opts = shift;
41 158         201 my $name = shift;
42 158         202 my $has_default = @_;
43 158         203 my $default = shift;
44              
45 158 100       322 if (not exists $obj->{$name}) {
    100          
46 156 100       261 if (exists $opts->{$name}) {
    100          
47 19         38 my $value = delete $opts->{$name};
48 19 100       55 if (defined($value)) {
    50          
49 18         55 $obj->{$name} = $value;
50             }
51             elsif ($has_default) {
52 0         0 $obj->{$name} = $default;
53             }
54             else {
55 1         65 croak("'$name' is required, cannot be undef");
56             }
57             }
58             elsif ($has_default) {
59 136         320 $obj->{$name} = $default;
60             }
61             else {
62 1         65 croak("'$name' is required, cannot be missing");
63             }
64             }
65             elsif (exists $opts->{$name}) {
66             # This should not be hit, but if it was, it would be confusing
67 1         198 confess("Refusing to copy '$name' that is already in hash");
68             }
69             }
70              
71             sub assert_options_empty {
72 2     2 0 1123 my ($obj, $opts) = @_;
73 2         9 my @keys = sort keys %$opts;
74 2 100       8 if (1 == @keys) {
    50          
75 1         115 croak("Unexpected parameter: '$keys[0]'");
76             }
77             elsif (@keys) {
78 0           my $extra = "'" . (join "', '", @keys) . "'";
79 0           croak("Extra parameters: $extra");
80             }
81             }
82              
83             1;
84              
85             __END__