File Coverage

blib/lib/Net/Twitter/Role/InflateObjects.pm
Criterion Covered Total %
statement 34 38 89.4
branch 10 20 50.0
condition n/a
subroutine 16 17 94.1
pod n/a
total 60 75 80.0


line stmt bran cond sub pod time code
1             package Net::Twitter::Role::InflateObjects;
2             $Net::Twitter::Role::InflateObjects::VERSION = '4.01042';
3 2     2   1259 use Moose::Role;
  2         4  
  2         13  
4 2     2   6921 use namespace::autoclean;
  2         4  
  2         14  
5 2     2   101 use Data::Visitor::Callback;
  2         2  
  2         48  
6 2     2   7 use Digest::SHA;
  2         2  
  2         957  
7              
8             =head1 NAME
9            
10             Net::Twitter::Role::InflateObjects - Inflate Twitter API return values to Moose objects
11            
12             =head1 VERSION
13            
14             version 4.01042
15            
16             =cut
17              
18             requires qw/_inflate_objects/;
19              
20             has _class_map => (
21                 traits => ['Hash'],
22                 isa => 'HashRef',
23                 default => sub { {} },
24                 handles => {
25                    set_cached_class => 'set',
26                    get_cached_class => 'get',
27                 },
28             );
29              
30             override _inflate_objects => sub {
31                 my ($self, $datetime_parser, $obj) = @_;
32              
33                 return unless ref $obj;
34              
35                 my $visitor = Data::Visitor::Callback->new(
36                     hash => sub { $self->_hash_to_object($datetime_parser, $_[1]) },
37                 );
38              
39                 $visitor->visit($obj);
40             };
41              
42             sub _attribute_inflator {
43 4     4   7     my ($self, $datetime_parser, $name, $value) = @_;
44              
45 4 50       10     return URI->new($value) if $name =~ /url$/;
46 4 100       21     return $datetime_parser->parse_datetime($value) if $name =~ /^created_at|reset_time$/;
47              
48 2         7     return $value;
49             }
50              
51             sub _hash_to_object {
52 9     9   14     my ($self, $datetime_parser, $href) = @_;
53              
54 9         113     my $signature = Digest::SHA::sha1_hex(
55                     join ',' => sort keys %$href
56                 );
57              
58 9         377     my $class = $self->get_cached_class($signature);
59 9 100       19     unless ( $class ) {
60 4         28         $class = Moose::Meta::Class->create_anon_class;
61 4         3755         for my $name ( keys %$href ) {
62                         $class->add_attribute(
63                             $name,
64                             reader => {
65 4     4   806                     $name => sub { $self->_attribute_inflator($datetime_parser, $name, shift->{$name}) },
        4      
        4      
        4      
        4      
        4      
        4      
        4      
        0      
66                             },
67 10         4188             );
68                     }
69 4 100       2339         if ( exists $href->{created_at} ) {
70                         $class->add_method(relative_created_at => sub {
71 1     1   1018                 my $self = shift;
        1      
72              
73 1         4                 my $delta = time - $self->created_at->epoch;
74 1 50       511                 return "less than a minute ago" if $delta < 60;
75 1 50       3                 return "about a minute ago" if $delta < 120;
76 1 50       11                 return int($delta / 60) . " minutes ago" if $delta < 45 * 60;
77 0 0       0                 return "about an hour ago" if $delta < 120 * 60;
78 0 0       0                 return int($delta / 3600) . " hours ago" if $delta < 24 * 60 * 60;
79 0 0       0                 return "1 day ago" if $delta < 48 * 60 * 60;
80 0         0                 return int($delta / (3600*24)) . " days ago";
81 2         13             });
82                     }
83 4         70         $class->make_immutable;
84 4         1633         $self->set_cached_class($signature, $class);
85                 }
86              
87 9         50     bless $href, $class->name;
88             }
89              
90             1;
91              
92             __END__
93            
94             =head1 SYNOPSIS
95            
96             use Net::Twitter;
97             my $nt = Net::Twitter->new(traits => [qw/InflateObjects API::Rest/]);
98            
99             $nt->credentials($username, $password);
100            
101             $r = $nt->friends_timeline;
102            
103             $r->[0]->user->name; # return values are objects with read accessors
104             $r->[0]->created_at; # dates are inflated to DateTime objects
105             $r->[0]->relative_created_at; # "6 minutes ago"
106            
107             =head1 DESCRIPTION
108            
109             This role provides inflation of HASH refs, returned by the Twitter API, into
110             Moose objects. URLs are inflated to URI objects. Dates are inflated to
111             DateTime objects. Objects that have a C<created_at> attribute also have a
112             C<relative_created_at> method that prints times in the same style as the
113             Twitter web interface.
114            
115             All HASH members have read accessors, so
116            
117             $r->[0]->{user}{screen_name}
118            
119             Can be accessed as
120            
121             $r->[0]->user->screen_name
122            
123             =head1 CAVEATS
124            
125             An accessor is created for each HASH key returned by Twitter. As Twitter adds
126             new attributes, InflateObjects will create accessors for them. However,
127             InflateObjects will also drop accessors if Twitter drops the corresponding
128             HASH element. So, code that relies on HASH element will fail loudly if Twitter
129             drops support for it. (This may be a feature!)
130            
131             =head1 AUTHOR
132            
133             Marc Mims <marc@questright.com>
134            
135             =head1 LICENSE
136            
137             Copyright (c) 2016 Marc Mims
138            
139             The Twitter API itself, and the description text used in this module is:
140            
141             Copyright (c) 2009 Twitter
142            
143             This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
144            
145             =cut
146