| 1 | package Zeal::Feed; |
| 2 | |
| 3 | use 5.014000; |
| 4 | use strict; |
| 5 | use warnings; |
| 6 | use re '/s'; |
| 7 | |
| 8 | our $VERSION = '0.001001'; |
| 9 | |
| 10 | use parent qw/Class::Accessor::Fast/; |
| 11 | __PACKAGE__->mk_ro_accessors(qw/version/); |
| 12 | |
| 13 | use Cwd qw/getcwd/; |
| 14 | use File::Spec::Functions qw/catfile rel2abs/; |
| 15 | use HTTP::Tiny; |
| 16 | |
| 17 | use Archive::Tar; |
| 18 | use File::Slurp qw/read_file/; |
| 19 | use File::Which; |
| 20 | use XML::Rules; |
| 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 | $file = rel2abs $file; |
| 62 | my $oldwd = getcwd; |
| 63 | chdir $dir; |
| 64 | my $tar = which 'tar' or which 'gtar'; |
| 65 | |
| 66 | # uncoverable branch true |
| 67 | # uncoverable condition false |
| 68 | local $ENV{ZEAL_USE_INTERNAL_TAR} = 1 if $file =~ /gz$|bz2$/ && $^O eq 'solaris'; |
| 69 | |
| 70 | if ($tar && !$ENV{ZEAL_USE_INTERNAL_TAR}) { |
| 71 | my $arg = '-xf'; |
| 72 | $arg = '-xzf' if $file =~ /[.]t?gz$/; |
| 73 | $arg = '-xjf' if $file =~ /[.]bz2$/; |
| 74 | system $tar, $arg => $file |
| 75 | } else { |
| 76 | Archive::Tar->extract_archive($file); |
| 77 | } |
| 78 | chdir $oldwd; |
| 79 | } |
| 80 | |
| 81 | sub download { |
| 82 | my ($self, $path) = @_; |
| 83 | my ($name) = $self->url =~ /([^\/])+$/; |
| 84 | my $file = catfile $path, $name; |
| 85 | HTTP::Tiny->new->mirror($self->url, $file); |
| 86 | _unpack_tar_to_dir $file, $path; |
| 87 | unlink $file; |
| 88 | } |
| 89 | |
| 90 | 1; |
| 91 | __END__ |
| 92 | |
| 93 | =encoding utf-8 |
| 94 | |
| 95 | =head1 NAME |
| 96 | |
| 97 | Zeal::Feed - Class representing a Dash/Zeal documentation feed |
| 98 | |
| 99 | =head1 SYNOPSIS |
| 100 | |
| 101 | use Zeal::Feed; |
| 102 | my $feed = Zeal::Feed->new('http://example.com/feed.xml'); |
| 103 | say $feed->version; # 12.2.3 |
| 104 | say $feed->url; # http://another.example.com/file.tar.gz |
| 105 | |
| 106 | # Download to /home/mgv/docsets/file.docset |
| 107 | $feed->download('/home/mgv/docsets/'); |
| 108 | |
| 109 | =head1 DESCRIPTION |
| 110 | |
| 111 | Dash is an offline API documentation browser. Zeal::Feed is a class |
| 112 | representing a Dash/Zeal documentation feed. |
| 113 | |
| 114 | A documentation feed is an XML file describing a docset. It contains |
| 115 | the version of the docset and one or more URLs to a (typically |
| 116 | .tar.gz) archive of the docset. |
| 117 | |
| 118 | Available methods: |
| 119 | |
| 120 | =over |
| 121 | |
| 122 | =item Zeal::Feed->B<new>(I<$url>) |
| 123 | |
| 124 | Create a Zeal::Feed object from an HTTP URL. |
| 125 | |
| 126 | =item Zeal::Feed->B<new_from_file>(I<$file>) |
| 127 | |
| 128 | Create a Zeal::Feed object from a file. |
| 129 | |
| 130 | =item Zeal::Feed->B<new_from_content>(I<$xml>) |
| 131 | |
| 132 | Create a Zeal::Feed object from a string. |
| 133 | |
| 134 | =item $feed->B<version> |
| 135 | |
| 136 | The version of this feed. |
| 137 | |
| 138 | =item $feed->B<urls> |
| 139 | |
| 140 | A list of URLs to this docset. |
| 141 | |
| 142 | =item $feed->B<url> |
| 143 | |
| 144 | An URL to this docset, randomly chosen from the list returned by B<urls>. |
| 145 | |
| 146 | =item $feed->B<download>(I<$path>) |
| 147 | |
| 148 | Download and unpack the docset inside the I<$path> directory. |
| 149 | |
| 150 | Uses the F<tar> binary for unpacking if availablem, L<Archive::Tar> |
| 151 | otherwise. You can set the ZEAL_USE_INTERNAL_TAR environment variable |
| 152 | to a true value to force the use of L<Archive::Tar>. |
| 153 | |
| 154 | =back |
| 155 | |
| 156 | =head1 ENVIRONMENT |
| 157 | |
| 158 | =over |
| 159 | |
| 160 | =item ZEAL_USE_INTERNAL_TAR |
| 161 | |
| 162 | If true, B<download> will always use L<Archive::Tar>. |
| 163 | |
| 164 | =back |
| 165 | |
| 166 | =head1 SEE ALSO |
| 167 | |
| 168 | L<Zeal>, L<http://kapeli.com/dash>, L<http://zealdocs.org> |
| 169 | |
| 170 | =head1 AUTHOR |
| 171 | |
| 172 | Marius Gavrilescu, E<lt>marius@ieval.roE<gt> |
| 173 | |
| 174 | =head1 COPYRIGHT AND LICENSE |
| 175 | |
| 176 | Copyright (C) 2014-2015 by Marius Gavrilescu |
| 177 | |
| 178 | This library is free software; you can redistribute it and/or modify |
| 179 | it under the same terms as Perl itself, either Perl version 5.20.1 or, |
| 180 | at your option, any later version of Perl 5 you may have available. |
| 181 | |
| 182 | |
| 183 | =cut |