File Coverage

blib/lib/Zeal/Feed.pm
Criterion Covered Total %
statement 34 36 94.4
branch n/a
condition n/a
subroutine 12 12 100.0
pod n/a
total 46 48 95.8


line stmt bran cond sub pod time code
1             package Zeal::Feed;
2              
3 1     1   15916 use 5.014000;
  1         3  
  1         30  
4 1     1   4 use strict;
  1         1  
  1         29  
5 1     1   3 use warnings;
  1         9  
  1         26  
6 1     1   4 use re '/s';
  1         1  
  1         77  
7              
8             our $VERSION = '0.001';
9              
10 1     1   435 use parent qw/Class::Accessor::Fast/;
  1         248  
  1         5  
11             __PACKAGE__->mk_ro_accessors(qw/version/);
12              
13 1     1   2928 use Cwd qw/getcwd/;
  1         2  
  1         64  
14 1     1   477 use File::Spec::Functions qw/catfile rel2abs/;
  1         655  
  1         67  
15 1     1   9602 use HTTP::Tiny;
  1         41420  
  1         39  
16              
17 1     1   670 use Archive::Tar;
  1         97816  
  1         73  
18 1     1   619 use File::Slurp qw/read_file/;
  1         3503  
  1         55  
19 1     1   413 use File::Which;
  1         739  
  1         46  
20 1     1   215 use XML::Rules;
  0            
  0            
21              
22             sub new {
23             my ($class, $url) = @_;
24             $class->new_from_content(HTTP::Tiny->new->get($url)->{content});
25             }
26              
27             sub new_from_file {
28             my ($class, $file) = @_;
29             $class->new_from_content(scalar read_file $file);
30             }
31              
32             sub new_from_content {
33             my ($class, $xml) = @_;
34             my ($version, @urls) = @_;
35              
36             my $self = XML::Rules->parse(
37             rules => {
38             _default => 'content',
39             entry => 'pass',
40             url => 'content array',
41             'other-versions' => undef,
42             },
43             stripspaces => 3|4,
44             )->($xml);
45             bless $self, $class
46             }
47              
48             sub urls {
49             my ($self) = @_;
50             @{$self->{url}}
51             }
52              
53             sub url {
54             my ($self) = @_;
55             my @urls = $self->urls;
56             $urls[int rand @urls]
57             }
58              
59             sub _unpack_tar_to_dir {
60             my ($file, $dir) = @_;
61             my $tar = which 'tar' or which 'gtar';
62             if ($tar && !$ENV{ZEAL_USE_INTERNAL_TAR}) {
63             my $arg = '-xf';
64             $arg = '-xzf' if $file =~ /[.]t?gz$/;
65             $arg = '-xjf' if $file =~ /[.]bz2$/;
66             system $tar, -C => $dir, $arg => $file
67             } else {
68             $file = rel2abs $file;
69             my $oldwd = getcwd;
70             chdir $dir;
71             Archive::Tar->extract_archive($file);
72             chdir $oldwd;
73             }
74             }
75              
76             sub download {
77             my ($self, $path) = @_;
78             my ($name) = $self->url =~ /([^\/])+$/;
79             my $file = catfile $path, $name;
80             HTTP::Tiny->new->mirror($self->url, $file);
81             _unpack_tar_to_dir $file, $path;
82             unlink $file;
83             }
84              
85             1;
86             __END__