File Coverage

blib/lib/CGI/Untaint/Twitter.pm
Criterion Covered Total %
statement 18 46 39.1
branch 1 20 5.0
condition 0 9 0.0
subroutine 7 9 77.7
pod 1 1 100.0
total 27 85 31.7


line stmt bran cond sub pod time code
1             package CGI::Untaint::Twitter;
2              
3 2     2   237437 use warnings;
  2         15  
  2         66  
4 2     2   11 use strict;
  2         6  
  2         37  
5 2     2   10 use Carp;
  2         4  
  2         100  
6              
7 2     2   12 use base 'CGI::Untaint::object';
  2         4  
  2         986  
8 2     2   1662 use Net::Twitter::Lite::WithAPIv1_1;
  2         104256  
  2         953  
9              
10             =head1 NAME
11              
12             CGI::Untaint::Twitter - Validate a Twitter ID in a CGI script
13              
14             =head1 VERSION
15              
16             Version 0.05
17              
18             =cut
19              
20             our $VERSION = '0.05';
21             our $consumer_key;
22             our $consumer_secret;
23             our $access_token;
24             our $access_token_secret;
25              
26             =head1 SYNOPSIS
27              
28             CGI::Untaint::Twitter is a subclass of CGI::Untaint used to
29             validate if the given Twitter ID is valid.
30              
31             use CGI::Info;
32             use CGI::Untaint;
33             use CGI::Untaint::Twitter;
34             # ...
35             my $info = CGI::Info->new();
36             my $params = $info->params();
37             # ...
38             my $u = CGI::Untaint->new($params);
39             my $tid = $u->extract(-as_Twitter => 'twitter');
40             # $tid will be lower case
41              
42             =head1 SUBROUTINES/METHODS
43              
44             =head2 is_valid
45              
46             Validates the data.
47             Returns a boolean if $self->value is a valid twitter ID.
48              
49             =cut
50              
51             sub _untaint_re {
52             # Only allow letters and digits
53             # Remove the leading @ if any - leading spaces and so on will be
54             # ignored
55 1     1   88 return qr/^\@?([a-zA-z0-9]+)$/;
56             }
57              
58             sub is_valid {
59 0     0 1 0 my $self = shift;
60              
61 0         0 my $value = $self->value;
62              
63 0 0       0 if(!defined($value)) {
64 0         0 return 0;
65             }
66 0 0 0     0 unless($consumer_key && $consumer_secret && $access_token && $access_token_secret) {
      0        
      0        
67 0         0 carp 'Access tokens are required';
68 0         0 return 0;
69             }
70              
71             # Ignore leading and trailing spaces
72 0         0 $value =~ s/\s+$//;
73 0         0 $value =~ s/^\s+//;
74              
75 0         0 my $known_user = 0;
76              
77 0         0 eval {
78 0         0 my $nt = Net::Twitter::Lite::WithAPIv1_1->new(
79             consumer_key => $consumer_key,
80             consumer_secret => $consumer_secret,
81             legacy_lists_api => 0,
82             access_token => $access_token,
83             access_token_secret => $access_token_secret,
84             ssl => 1,
85             );
86 0 0       0 if($nt->show_user({ screen_name => $value })) {
87 0         0 $known_user = 1;
88             }
89             };
90 0 0       0 if($@ =~ /exceeded/) {
91             # Rate limit exceeded. Clients may not make more than 150 requests per hour.
92             # Fall back assume it would have worked so as not to
93             # incovenience the user
94 0         0 return 1;
95             }
96 0         0 return $known_user;
97             }
98              
99             =head2 init
100              
101             Set various options and override default values.
102              
103             use CGI::Info;
104             use CGI::Untaint;
105             use CGI::Untaint::Twitter {
106             access_token => 'xxxxxx', access_token_secret => 'yyyyy',
107             consumer_key => 'xyzzy', consumer_secret => 'plugh',
108             };
109              
110             =cut
111              
112             sub _init {
113 0 0   0   0 my %params = (ref($_[0]) eq 'HASH') ? %{$_[0]} : @_;
  0         0  
114              
115             # Safe options - can be called at any time
116 0 0       0 if(defined($params{access_token})) {
117 0         0 $access_token = $params{access_token};
118             }
119 0 0       0 if(defined($params{access_token_secret})) {
120 0         0 $access_token_secret = $params{access_token_secret};
121             }
122 0 0       0 if(defined($params{consumer_key})) {
123 0         0 $consumer_key = $params{consumer_key};
124             }
125 0 0       0 if(defined($params{consumer_secret})) {
126 0         0 $consumer_secret = $params{consumer_secret};
127             }
128             }
129              
130             sub import {
131             # my $class = shift;
132 1     1   15 shift;
133              
134 1 50       14 return unless @_;
135              
136 0           _init(@_);
137             }
138              
139             =head1 AUTHOR
140              
141             Nigel Horne, C<< >>
142              
143             =head1 BUGS
144              
145             Twitter only allows 150 requests per hour. If you exceed that,
146             C won't validate and will assume all ID's are valid.
147              
148             Please report any bugs or feature requests to C, or through
149             the web interface at L. I will be notified, and then you'll
150             automatically be notified of progress on your bug as I make changes.
151              
152              
153             =head1 SEE ALSO
154              
155             CGI::Untaint
156              
157              
158             =head1 SUPPORT
159              
160             You can find documentation for this module with the perldoc command.
161              
162             perldoc CGI::Untaint::Twitter
163              
164              
165             You can also look for information at:
166              
167             =over 4
168              
169             =item * RT: CPAN's request tracker
170              
171             L
172              
173             =item * CPAN Ratings
174              
175             L
176              
177             =item * Search CPAN
178              
179             L
180              
181             =back
182              
183              
184             =head1 ACKNOWLEDGEMENTS
185              
186              
187             =head1 LICENSE AND COPYRIGHT
188              
189             Copyright 2012-2019 Nigel Horne.
190              
191             This program is released under the following licence: GPL
192              
193              
194             =cut
195              
196             1; # End of CGI::Untaint::Twitter