]>
Commit | Line | Data |
---|---|---|
320536b7 MG |
1 | package Zeal::Feed; |
2 | ||
3 | use 5.014000; | |
4 | use strict; | |
5 | use warnings; | |
6 | use re '/s'; | |
7 | ||
dded0d05 | 8 | our $VERSION = '0.001001'; |
320536b7 MG |
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) = @_; | |
a95f0a1f MG |
61 | $file = rel2abs $file; |
62 | my $oldwd = getcwd; | |
63 | chdir $dir; | |
320536b7 | 64 | my $tar = which 'tar' or which 'gtar'; |
ddea233d MG |
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 | ||
320536b7 MG |
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$/; | |
a95f0a1f | 74 | system $tar, $arg => $file |
320536b7 | 75 | } else { |
320536b7 | 76 | Archive::Tar->extract_archive($file); |
320536b7 | 77 | } |
a95f0a1f | 78 | chdir $oldwd; |
320536b7 MG |
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 | ||
b19d9e9c | 176 | Copyright (C) 2014-2015 by Marius Gavrilescu |
320536b7 MG |
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 |