File Coverage

blib/lib/WWW/Bugzilla/BugTree.pm
Criterion Covered Total %
statement 11 34 32.3
branch 0 8 0.0
condition n/a
subroutine 4 6 66.6
pod 2 2 100.0
total 17 50 34.0


line stmt bran cond sub pod time code
1             package WWW::Bugzilla::BugTree;
2              
3 3     3   44912 use strict;
  3         7  
  3         87  
4 3     3   17 use warnings;
  3         6  
  3         88  
5 3     3   73 use 5.012;
  3         11  
6 3     3   2669 use Moo;
  3         46852  
  3         19  
7              
8             # ABSTRACT: Fetch a tree of bugzilla bugs blocking a bug
9             our $VERSION = '0.06'; # VERSION
10              
11              
12             has ua => (
13             is => 'ro',
14             lazy => 1,
15             default => sub {
16             require LWP::UserAgent;
17             my $ua = LWP::UserAgent->new;
18             $ua->env_proxy;
19             $ua;
20             },
21             );
22              
23              
24             my $default_url = $ENV{BUG_TREE_URL} // "https://landfill.bugzilla.org/bugzilla-3.6-branch";
25              
26             has url => (
27             is => 'ro',
28             lazy => 1,
29             default => sub {
30             require URI;
31             URI->new($default_url);
32             },
33             coerce => sub {
34             ref $_[0] ? $_[0] : do { require URI; URI->new($_[0] // $default_url) },
35             },
36             );
37              
38             has _cache => (
39             is => 'ro',
40             default => sub { { } },
41             init_arg => undef,
42             );
43              
44              
45             sub fetch
46             {
47 0     0 1   my($self, $bug_id) = @_;
48            
49             return $self->_cache->{$bug_id}
50 0 0         if exists $self->_cache->{$bug_id};
51            
52 0           my $url = $self->url->clone;
53 0           $url->path((do { my $path = $url->path; $path =~ s{/$}{}; $path }) . "/show_bug.cgi");
  0            
  0            
  0            
54 0           $url->query_form(
55             id => $bug_id,
56             ctype => 'xml',
57             );
58            
59 0           my $res = $self->ua->get($url);
60            
61 0 0         die $url . " " . $res->status_line
62             unless $res->is_success;
63              
64 0           require WWW::Bugzilla::BugTree::Bug;
65 0           my $b = WWW::Bugzilla::BugTree::Bug->new(
66             url => $url,
67             res => $res,
68             id => $bug_id,
69             );
70            
71 0           $self->_cache->{$bug_id} = $b;
72            
73 0           my $dependson = $b->as_hashref->{bug}->{dependson};
74 0 0         $dependson = [] unless defined $dependson;
75 0 0         $dependson = [ $dependson ]
76             unless ref $dependson eq 'ARRAY';
77            
78 0           @{ $b->children } = map { $self->fetch($_) } sort @$dependson;
  0            
  0            
79            
80 0           $b;
81             }
82              
83              
84             sub clear_cache
85             {
86 0     0 1   my($self) = @_;
87 0           %{ $self->_cache } = ();
  0            
88             }
89              
90             1;
91              
92             __END__