File Coverage

blib/lib/Reddit/Client/Thing.pm
Criterion Covered Total %
statement 18 44 40.9
branch 0 14 0.0
condition n/a
subroutine 6 11 54.5
pod 3 3 100.0
total 27 72 37.5


line stmt bran cond sub pod time code
1             package Reddit::Client::Thing;
2              
3 5     5   42 use strict;
  5         12  
  5         147  
4 5     5   26 use warnings;
  5         13  
  5         111  
5 5     5   23 use Carp;
  5         21  
  5         318  
6              
7 5     5   33 use List::Util qw/first/;
  5         10  
  5         876  
8              
9             # If a field is used by another class it must also be added to that class's
10             # fields
11             # Why does adding a field that exists in link but not comment (can_mod_post)
12             # break comments but not other types of things, like profiles?
13             # because can_mod_post DOES exist for comments. this would get to that field,
14             # which was previously ignored, but now it's in BOOL here, so it would try to
15             # set it, but the field didn't exist in Comment, so it would fail.
16             our @BOOL_FIELDS = qw/
17             can_mod_post
18             clicked
19             has_mail
20             has_mod_mail
21             has_verified_email
22             hidden
23             is_employee
24             is_gold
25             is_mod
26             is_original_content
27             is_self
28             likes
29             locked
30             new
31             over18
32             over_18
33             public_traffic
34             quarantine
35             removed
36             saved
37             spam
38             spoiler
39             stickied
40             verified
41             was_comment
42              
43             isAuto
44             isHighlighted
45             isInternal
46             isRepliable
47             /;
48              
49 5     5   40 use fields qw/session name id/;
  5         10  
  5         32  
50              
51             sub new {
52             # $reddit is a Reddit::Client object
53 0     0 1   my ($class, $reddit, $source_data) = @_;
54 0           my $self = fields::new($class);
55 0           $self->{session} = $reddit; # could this be called something more sensible
56 0 0         $self->load_from_source_data($source_data) if $source_data;
57 0           return $self;
58             }
59              
60             sub load_from_source_data {
61 0     0 1   require Reddit::Client;
62            
63 0           my ($self, $source_data) = @_;
64 0 0         if ($source_data) {
65             # Hack that allows us to set link_id reliably when creating a MoreCommen
66             # object from Comment. This ensures that link_id is always set before
67             # replies.
68             #foreach my $field (keys %$source_data) {
69 0           foreach my $field (sort keys %$source_data) {
70             # Set data fields
71 0           my $setter = sprintf 'set_%s', $field;
72 0 0         if ($self->can($setter)) {
    0          
73 0           $self->can($setter)->($self, $source_data->{$field});
74 0     0     } elsif (first {$_ eq $field} @BOOL_FIELDS) {
75 0           $self->set_bool($field, $source_data->{$field});
76             } else {
77 0           eval { $self->{$field} = $source_data->{$field} };
  0            
78 0 0         Reddit::Client::DEBUG("Field %s is missing from package %s\n", $field, ref $self)
79             if $@;
80             }
81              
82             # Add getter for field
83 0     0     my $getter = sub { $_[0]->{$field} };
  0            
84 0           my $class = ref $self;
85 0           my $method = sprintf '%s::get_%s', $class, $field;
86              
87 0 0         unless ($self->can($method)) {
88 5     5   1933 no strict 'refs';
  5         14  
  5         658  
89 0           *{$method} = \&$getter;
  0            
90             }
91             }
92             }
93             }
94              
95             sub set_bool {
96 0     0 1   my ($self, $field, $value) = @_;
97 0 0         $self->{$field} = $value ? 1 : 0;
98             }
99              
100             1;
101              
102             __END__