File Coverage

blib/lib/Net/Twitter.pm
Criterion Covered Total %
statement 81 83 97.5
branch 21 28 75.0
condition 12 16 75.0
subroutine 16 16 100.0
pod 1 1 100.0
total 131 144 90.9


line stmt bran cond sub pod time code
1             package Net::Twitter;
2             $Net::Twitter::VERSION = '4.01042';
3 32     40   2193843 use Moose;
  32         9144685  
  32         195  
4 32     40   167660 use Carp::Clan qw/^(?:Net::Twitter|Moose|Class::MOP)/;
  32         43952  
  32         231  
5 32     32   15414 use JSON::MaybeXS;
  32         106305  
  32         1706  
6 32     32   12728 use Net::Twitter::Core;
  32         104  
  32         1572  
7 32     32   18705 use Digest::SHA qw/sha1_hex/;
  32         73125  
  32         2224  
8 32     32   194 use Class::Load ();
  32         49  
  32         581  
9              
10 32     32   124 use namespace::autoclean;
  32         43  
  32         288  
11              
12             has '_trait_namespace' => (
13                 Moose->VERSION >= '0.85' ? (is => 'bare') : (),
14                 default => 'Net::Twitter::Role',
15             );
16              
17             # See Net/Twitter.pod for documentation, Net/Twitter/Core.pm for implementation.
18             #
19             # For transparent back compat, Net::Twitter->new() creates a Net::Twitter::Core
20             # with the 'Legacy' trait.
21              
22             # transform_trait and resolve_traits stolen from MooseX::Traits
23             sub _transform_trait {
24 80     80   133     my ($class, $name) = @_;
25 80         408     my $namespace = $class->meta->find_attribute_by_name('_trait_namespace');
26 80         14147     my $base;
27 80 50       468     if($namespace->has_default){
28 80         701         $base = $namespace->default;
29 80 50       500         if(ref $base eq 'CODE'){
30 0         0             $base = $base->();
31                     }
32                 }
33              
34 80 50       195     return $name unless $base;
35 80 50       247     return $1 if $name =~ /^[+](.+)$/;
36 80         226     return "$base\::$name";
37             }
38              
39             sub _resolve_traits {
40 52     52   110     my ($class, @traits) = @_;
41              
42                 return map {
43 52 100       102         unless ( ref ) {
  84         225  
44 80         287             $_ = $class->_transform_trait($_);
45 80         313             Class::Load::load_class($_);
46                     }
47 84         2831         $_;
48                 } @traits;
49             }
50              
51             sub _isa {
52 90     90   236660     my $self = shift;
53 90         106     my $isa = shift;
54              
55 90   100     628     return $isa eq __PACKAGE__ || $self->SUPER::isa($isa)
56             };
57              
58             sub _create_anon_class {
59 57     57   116     my ($superclasses, $traits, $immutable, $package) = @_;
60              
61             # Do we already have a meta class?
62 57 100       613     return $package->meta if $package->can('meta');
63              
64 47         65     my $meta;
65                 $meta = Net::Twitter::Core->meta->create_anon_class(
66                     superclasses => $superclasses,
67                     roles => $traits,
68 47     42   400         methods => { meta => sub { $meta }, isa => \&_isa },
  42     42   39487  
        40      
69                     cache => 0,
70                     package => $package,
71                 );
72 47         1027733     $meta->make_immutable(inline_constructor => $immutable);
73              
74 47         14070     return $meta;
75             }
76              
77             {
78                 my $serial_number = 0;
79                 my %serial_for_params;
80              
81                 sub _name_for_anon_class {
82 52     52   90         my @t = @{$_[0]};
  52         148  
83              
84 52         74         my @comps;
85 52         144         while ( @t ) {
86 80         108             my $t = shift @t;
87 80 100       351             if ( ref $t[0] eq 'HASH' ) {
88 4         35                 my $params = shift @t;
89 4         17                 my $sig = sha1_hex(JSON->new->utf8->encode($params));
90 4   66     110                 my $sn = $serial_for_params{$sig} ||= ++$serial_number;
91 4         11                 $t .= "_$sn";
92                         }
93 80         601             $t =~ s/(?:::|\W)/_/g;
94 80         648             push @comps, $t;
95                     }
96              
97 52   50     318         my $ver = $Net::Twitter::Core::VERSION || 1;
98 52         198         $ver =~ s/\W/_/g;
99              
100 52         380         return __PACKAGE__ . "_v${ver}_" . join '__', 'with', sort @comps;
101                 }
102             }
103              
104             sub new {
105 52     52 1 266499     my $class = shift;
106              
107 52 50       347     croak '"new" is not an instance method' if ref $class;
108              
109 52 50 33     430     my %args = @_ == 1 && ref $_[0] eq 'HASH' ? %{$_[0]} : @_;
  0         0  
110              
111 52         117     my $traits = delete $args{traits};
112              
113 52 100       171     if ( defined (my $legacy = delete $args{legacy}) ) {
114 10 50       27         croak "Options 'legacy' and 'traits' are mutually exclusive. Use only one."
115                         if $traits;
116              
117 10 100       35         $traits = [ $legacy ? 'Legacy' : 'API::REST' ];
118                 }
119              
120 52   100     181     $traits ||= [ qw/Legacy/ ];
121              
122             # ensure we have the OAuth trait if we have a consumer key (unless we've
123             # specified AppAuth)
124 52 100 100     262     if ( $args{consumer_key} && !grep $_ eq 'AppAuth', @$traits ) {
125 9         34         $traits = [ (grep $_ ne 'OAuth', @$traits), 'OAuth' ];
126                 }
127              
128             # create a unique name for the created class based on trait names and parameters
129 52         283     my $anon_class_name = _name_for_anon_class($traits);
130              
131 52         206     $traits = [ $class->_resolve_traits(@$traits) ];
132              
133 52         146     my $superclasses = [ 'Net::Twitter::Core' ];
134 52         191     my $meta = _create_anon_class($superclasses, $traits, 1, $anon_class_name);
135              
136             # create a Net::Twitter::Core object with roles applied
137 52         1727     my $new = $meta->name->new(%args);
138              
139             # rebless it to include a superclass, if we're being subclassed
140 52 100       193     if ( $class ne __PACKAGE__ ) {
141 5         12         unshift @$superclasses, $class;
142 5         21         my $final_meta = _create_anon_class(
143                         $superclasses, $traits, 0, join '::', $class, $anon_class_name
144                     );
145 5         22         bless $new, $final_meta->name;
146                 }
147              
148 52         360     return $new;
149             }
150              
151             __PACKAGE__->meta->make_immutable(inline_constructor => 0);
152              
153             1;
154              
155             __END__
156            
157             =head1 NAME
158            
159             Net::Twitter - A perl interface to the Twitter API
160            
161             =head1 VERSION
162            
163             version 4.01042
164            
165             =head1 DESCRIPTION
166            
167             See Net/Twitter.pod
168