]>
Commit | Line | Data |
---|---|---|
1 | package Zeal::Feed; | |
2 | ||
3 | use 5.014000; | |
4 | use strict; | |
5 | use warnings; | |
6 | use re '/s'; | |
7 | ||
8 | our $VERSION = '0.000_002'; | |
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 | 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__ | |
87 | ||
88 | =encoding utf-8 | |
89 | ||
90 | =head1 NAME | |
91 | ||
92 | Zeal::Feed - Class representing a Dash/Zeal documentation feed | |
93 | ||
94 | =head1 SYNOPSIS | |
95 | ||
96 | use Zeal::Feed; | |
97 | my $feed = Zeal::Feed->new('http://example.com/feed.xml'); | |
98 | say $feed->version; # 12.2.3 | |
99 | say $feed->url; # http://another.example.com/file.tar.gz | |
100 | ||
101 | # Download to /home/mgv/docsets/file.docset | |
102 | $feed->download('/home/mgv/docsets/'); | |
103 | ||
104 | =head1 DESCRIPTION | |
105 | ||
106 | Dash is an offline API documentation browser. Zeal::Feed is a class | |
107 | representing a Dash/Zeal documentation feed. | |
108 | ||
109 | A documentation feed is an XML file describing a docset. It contains | |
110 | the version of the docset and one or more URLs to a (typically | |
111 | .tar.gz) archive of the docset. | |
112 | ||
113 | Available methods: | |
114 | ||
115 | =over | |
116 | ||
117 | =item Zeal::Feed->B<new>(I<$url>) | |
118 | ||
119 | Create a Zeal::Feed object from an HTTP URL. | |
120 | ||
121 | =item Zeal::Feed->B<new_from_file>(I<$file>) | |
122 | ||
123 | Create a Zeal::Feed object from a file. | |
124 | ||
125 | =item Zeal::Feed->B<new_from_content>(I<$xml>) | |
126 | ||
127 | Create a Zeal::Feed object from a string. | |
128 | ||
129 | =item $feed->B<version> | |
130 | ||
131 | The version of this feed. | |
132 | ||
133 | =item $feed->B<urls> | |
134 | ||
135 | A list of URLs to this docset. | |
136 | ||
137 | =item $feed->B<url> | |
138 | ||
139 | An URL to this docset, randomly chosen from the list returned by B<urls>. | |
140 | ||
141 | =item $feed->B<download>(I<$path>) | |
142 | ||
143 | Download and unpack the docset inside the I<$path> directory. | |
144 | ||
145 | Uses the F<tar> binary for unpacking if availablem, L<Archive::Tar> | |
146 | otherwise. You can set the ZEAL_USE_INTERNAL_TAR environment variable | |
147 | to a true value to force the use of L<Archive::Tar>. | |
148 | ||
149 | =back | |
150 | ||
151 | =head1 ENVIRONMENT | |
152 | ||
153 | =over | |
154 | ||
155 | =item ZEAL_USE_INTERNAL_TAR | |
156 | ||
157 | If true, B<download> will always use L<Archive::Tar>. | |
158 | ||
159 | =back | |
160 | ||
161 | =head1 SEE ALSO | |
162 | ||
163 | L<Zeal>, L<http://kapeli.com/dash>, L<http://zealdocs.org> | |
164 | ||
165 | =head1 AUTHOR | |
166 | ||
167 | Marius Gavrilescu, E<lt>marius@ieval.roE<gt> | |
168 | ||
169 | =head1 COPYRIGHT AND LICENSE | |
170 | ||
171 | Copyright (C) 2014 by Marius Gavrilescu | |
172 | ||
173 | This library is free software; you can redistribute it and/or modify | |
174 | it under the same terms as Perl itself, either Perl version 5.20.1 or, | |
175 | at your option, any later version of Perl 5 you may have available. | |
176 | ||
177 | ||
178 | =cut |