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.18'; # VERSION
5              
6 8     8   59956 use warnings;
  8         23  
  8         240  
7 8     8   37 use strict;
  8         17  
  8         149  
8              
9 8     8   34 use Carp qw(croak confess);
  8         13  
  8         399  
10              
11 8     8   43 use Exporter qw(import);
  8         29  
  8         2923  
12              
13             our @EXPORT_OK = qw(extract_option copy_option assert_options_empty);
14              
15             # Blessed empty hash.
16             sub new {
17 5     5 0 14 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 133     133 0 3855 my $obj = shift;
40 133         161 my $opts = shift;
41 133         183 my $name = shift;
42 133         201 my $has_default = @_;
43 133         176 my $default = shift;
44              
45 133 100       268 if (not exists $obj->{$name}) {
    100          
46 131 100       264 if (exists $opts->{$name}) {
    100          
47 16         32 my $value = delete $opts->{$name};
48 16 100       35 if (defined($value)) {
    50          
49 15         44 $obj->{$name} = $value;
50             }
51             elsif ($has_default) {
52 0         0 $obj->{$name} = $default;
53             }
54             else {
55 1         61 croak("'$name' is required, cannot be undef");
56             }
57             }
58             elsif ($has_default) {
59 114         301 $obj->{$name} = $default;
60             }
61             else {
62 1         61 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         156 confess("Refusing to copy '$name' that is already in hash");
68             }
69             }
70              
71             sub assert_options_empty {
72 2     2 0 1126 my ($obj, $opts) = @_;
73 2         7 my @keys = sort keys %$opts;
74 2 100       10 if (1 == @keys) {
    50          
75 1         95 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__