File Coverage

blib/lib/Reddit/Client/Comment.pm
Criterion Covered Total %
statement 18 70 25.7
branch 0 16 0.0
condition 0 6 0.0
subroutine 6 21 28.5
pod 7 15 46.6
total 31 128 24.2


line stmt bran cond sub pod time code
1             package Reddit::Client::Comment;
2              
3 5     5   36 use strict;
  5         10  
  5         141  
4 5     5   26 use warnings;
  5         13  
  5         116  
5 5     5   25 use Carp;
  5         10  
  5         367  
6              
7             require Reddit::Client::VotableThing;
8             # comments don't have over_18 and is_self, do they?
9 5     5   31 use base qw/Reddit::Client::VotableThing/;
  5         16  
  5         2130  
10 5         26 use fields qw/
11             approved_by
12             author
13             author_flair_css_class
14             author_flair_text
15             banned_by
16             body
17             body_html
18             can_mod_post
19             clicked
20             created
21             created_utc
22             domain
23             hidden
24             is_self
25             link_author
26             link_id
27             link_permalink
28             link_title
29             link_url
30             locked
31             media_embed
32             mod_reports
33             more
34             num_comments
35             num_reports
36             over_18
37             parent_id
38             permalink
39             quarantine
40             removed
41             replies
42             saved
43             selftext
44             selftext_html
45             spam
46             stickied
47             subreddit
48             subreddit_id
49             thumbnail
50             title
51             user_reports
52 5     5   35 /;
  5         9  
53              
54 5     5   1517 use constant type => "t1";
  5         13  
  5         4327  
55             # This is called by the magic in Thing.pm on creation
56             sub set_replies {
57 0     0 1   my ($self, $value) = @_;
58 0 0 0       if (ref $value && exists $value->{data}{children}) {
59 0           my $comments = $value->{data}{children};
60 0           my $return = [];
61              
62 0           for my $cmt (@$comments) {
63             # 'kind' is on same level as 'data'
64 0 0         if ($cmt->{kind} eq 't1') {
    0          
65 0           push @$return, Reddit::Client::Comment->new($self->{session}, $cmt->{data});
66             } elsif ($cmt->{kind} eq 'more') {
67 0           my $more = Reddit::Client::MoreComments->new($self->{session}, $cmt->{data});
68 0           $more->{link_id} = $self->{link_id};
69 0           $self->{more} = $more->{children};
70 0           push @$return, $more;
71             }
72             }
73            
74 0           $self->{replies} = $return;
75             } else {
76 0           $self->{replies} = [];
77             }
78             }
79             # need fix this
80             sub get_collapsed_comments {
81 0     0 0   my ($self, %param) = @_;
82 0 0 0       return undef if !$self->{more} or ref $self->{more} ne 'ARRAY';
83            
84             my %data = (
85             link_id => $self->{link_id},
86             children => $self->{more},
87 0           );
88 0 0         $data{sort} = $param{sort} if $param{sort};
89 0 0         $data{id} = $param{id} if $param{id};
90              
91 0           return $self->{session}->get_collapsed_comments( %data );
92             }
93              
94             sub reply {
95 0     0 1   my ($self, $text) = @_;
96 0           my $cmtid = $self->{session}->submit_comment(parent_id=>$self->{name}, text=>$text);
97 0           return $cmtid;
98             }
99             sub remove {
100 0     0 1   my $self = shift;
101 0           return $self->{session}->remove($self->{name});
102             }
103             sub spam {
104 0     0 1   my $self = shift;
105 0           return $self->{session}->spam($self->{name});
106             }
107             sub approve {
108 0     0 1   my $self = shift;
109 0           return $self->{session}->approve($self->{name});
110             }
111             sub ignore_reports {
112 0     0 1   my $self = shift;
113 0           return $self->{session}->ignore_reports($self->{name});
114             }
115             sub edit {
116 0     0 0   my ($self, $text) = @_;
117 0           my $cmtid = $self->{session}->edit($self->{name}, $text);
118 0 0         $self->{body} = $text if $cmtid;
119 0           return $cmtid;
120             }
121             sub delete {
122 0     0 0   my $self = shift;
123 0           my $cmtid = $self->{session}->delete($self->{name});
124 0           return $cmtid;
125             }
126             sub get_permalink { # deprecated. Duplicated instead of calling get_web_url
127 0     0 0   my $self = shift; # because this may (and probably will) change someday
128             return $self->{session}->get_origin().$self->{permalink}
129 0           }
130             sub get_web_url {
131 0     0 0   my $self = shift;
132             return $self->{session}->get_origin().$self->{permalink}
133 0           }
134             sub get_children {
135 0     0 0   my $self = shift;
136 0           my $cmts = $self->{session}->get_comments(permalink=>$self->{permalink});
137 0           $self->{replies} = $$cmts[0]->{replies}; # populate this comment's replies
138 0           return $$cmts[0]->{replies};
139             }
140             sub get_comments {
141 0     0 0   my $self = shift;
142 0           my $cmts = $self->{session}->get_comments(permalink=>$self->{permalink});
143 0           $self->{replies} = $$cmts[0]->{replies}; # populate this comment's replies
144 0           return $cmts;
145             }
146              
147             sub has_collapsed_children {
148 0     0 0   my $self = shift;
149 0 0         return $self->{more} ? 1 : 0;
150             }
151              
152             sub replies {
153 0     0 1   return shift->{replies};
154             }
155             1;
156              
157             __END__