File Coverage

blib/lib/WWW/SPOJ/User.pm
Criterion Covered Total %
statement 40 41 97.5
branch 9 14 64.2
condition 2 8 25.0
subroutine 8 8 100.0
pod 1 1 100.0
total 60 72 83.3


line stmt bran cond sub pod time code
1             package WWW::SPOJ::User;
2              
3             =head1 NAME
4              
5             WWW::SPOJ::User - Object representation of a SPOJ user
6              
7             =head1 SYNOPSIS
8              
9             use WWW::SPOJ;
10            
11             my $user = new WWW::SPOJ::User('john_jones');
12              
13             =head1 DESCRIPTION
14              
15             See L for a description of this project.
16              
17             =cut
18              
19 2     2   23177 use 5.006;
  2         7  
  2         289  
20 2     2   13 use strict;
  2         4  
  2         157  
21 2     2   10 use warnings;
  2         4  
  2         53  
22              
23 2     2   10 use Carp;
  2         15  
  2         163  
24 2     2   2362 use Class::Accessor;
  2         8464  
  2         30  
25 2     2   2647 use HTML::TableExtract;
  2         51472  
  2         20  
26              
27 2     2   712 use WWW::SPOJ;
  2         6  
  2         1271  
28              
29             our @ISA = qw(Class::Accessor);
30              
31             my @user_data = qw(name username country institution email motto);
32             __PACKAGE__->mk_ro_accessors(@user_data);
33              
34             =head1 CONSTRUCTOR
35              
36             This module declares one constructor:
37              
38             =over 4
39              
40             =item WWW::SPOJ::User->new( USERNAME )
41              
42             Constructs a L to represent the user with the specified
43             username. Returns C if such a user doesn't exist, so you can
44             assume that all L objects are valid users.
45              
46             =back
47              
48             =cut
49              
50             sub new {
51 2     2 1 12451 my($class, $username) = @_;
52 2         7 my $self = undef;
53 2 100       19 if($username =~ /^[a-z][a-z0-9_]+$/si) {
54 1         4 $username = lc($username);
55 1         9 my $response = WWW::SPOJ::ua()->get(sprintf('%susers/%s/',
56             WWW::SPOJ::service(), $username));
57 1 50       511792 $response->is_success or croak $response->status_line;
58 1 50 33     29 my $content = $response->decoded_content || $response->content
59             or croak 'Problem reading page content';
60 1         36687 my $te = new HTML::TableExtract;
61 1         172 $te->parse($content);
62 1         212017 eval {
63 1         9 local %_ = map { $_->[0] =~ s/\/.*//;
  3         199  
64 3         111 lc(join('', $_->[0] =~ /[a-z]+/ig)) => $_->[1]
65             } $te->table(1, 1)->rows;
66 1 50       9 $_{name} = $1 if ($te->table(0, 0)->rows)[1]->[1]
67             =~ /^\s(.*)\'s user data/s;
68 1 50 0     220 $self = {map {$_ => $_{$_} || ''} @user_data}
  0   33     0  
69             if defined $_{username} && $_{username} eq $username;
70             };
71 1 50       4 croak 'Problem parsing page content' if $@;
72 1         957 $self->{email} =~ s/\[at\]/@/;
73             }
74 2 100       13 bless($self, $class) if $self;
75 2         15 return $self;
76             }
77              
78             =head1 METHODS
79              
80             =over 4
81              
82             =item $user->name( )
83              
84             Returns the user's real name (what the user gave for the "Your name:" field
85             on the user data update page).
86              
87             =item $user->username( )
88              
89             Returns the user's username. Should be the same as what was passed to the
90             constructor when this object was created, except for possible differences
91             in case.
92              
93             =item $user->country( )
94              
95             Returns the country the user has chosen to represent.
96              
97             =item $user->institution( )
98              
99             Returns the user's institution or the empty string if the user didn't specify
100             anything.
101              
102             =item $user->email( )
103              
104             Returns the user's e-mail address. I hope you're not checking this so you
105             can spam. Probability suggests you'll get the empty string from this method
106             because most users will likely choose not to make their e-mail address
107             publicly visible.
108              
109             =item $user->motto( )
110              
111             Returns the user's motto or the empty string if the user didn't specify
112             anything. Many users put a URL here.
113              
114             =back
115              
116             =cut
117              
118             1;
119              
120             __END__