Commit | Line | Data |
3fea05b9 |
1 | ######################################################################## |
2 | # |
3 | # XML::OPML::SimpleGen |
4 | # |
5 | # Copyright 2005, Marcus Thiesen (marcus@thiesen.org) All rights reserved. |
6 | # |
7 | # This program is free software; you can redistribute it and/or modify |
8 | # it under the terms of either: |
9 | # |
10 | # a) the GNU General Public License as published by the Free Software |
11 | # Foundation; either version 1, or (at your option) any later |
12 | # version, or |
13 | # |
14 | # b) the "Artistic License" which comes with Perl. |
15 | # |
16 | # On Debian GNU/Linux systems, the complete text of the GNU General |
17 | # Public License can be found in `/usr/share/common-licenses/GPL' and |
18 | # the Artistic Licence in `/usr/share/common-licenses/Artistic'. |
19 | # |
20 | # This program is distributed in the hope that it will be useful, |
21 | # but WITHOUT ANY WARRANTY; without even the implied warranty of |
22 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. |
23 | # |
24 | ######################################################################## |
25 | |
26 | package XML::OPML::SimpleGen; |
27 | |
28 | use strict; |
29 | use warnings; |
30 | |
31 | use base 'Class::Accessor'; |
32 | use POSIX qw(strftime); |
33 | |
34 | __PACKAGE__->mk_accessors(qw|groups xml_options outline group xml_head xml_outlines xml|); |
35 | |
36 | our $VERSION; |
37 | use version; $VERSION = version->new(0.04); |
38 | |
39 | sub new { |
40 | my $class = shift; |
41 | my @args = @_; |
42 | |
43 | my $args = { |
44 | groups => {}, |
45 | |
46 | xml => { |
47 | version => '1.1', |
48 | @args, |
49 | }, |
50 | |
51 | # XML::Simple options |
52 | xml_options => { |
53 | RootName => 'opml', |
54 | XMLDecl => '<?xml version="1.0" encoding="utf-8" ?>', |
55 | AttrIndent => 1, |
56 | }, |
57 | |
58 | # default values for nodes |
59 | outline => { |
60 | type => 'rss', |
61 | version => 'RSS', |
62 | text => '', |
63 | title => '', |
64 | description => '', |
65 | }, |
66 | |
67 | group => { |
68 | isOpen => 'true', |
69 | }, |
70 | |
71 | xml_head => {}, |
72 | xml_outlines => [], |
73 | |
74 | id => 1, |
75 | }; |
76 | |
77 | my $self = bless $args, $class; |
78 | |
79 | $self->head( |
80 | title => '', |
81 | dateCreated => strftime( "%a, %e %b %Y %H:%M:%S %z", localtime ), |
82 | dateModified => strftime( "%a, %e %b %Y %H:%M:%S %z", localtime ), |
83 | ); |
84 | |
85 | return $self; |
86 | } |
87 | |
88 | sub id { |
89 | my $self = shift; |
90 | |
91 | return $self->{id}++; |
92 | } |
93 | |
94 | sub head { |
95 | my $self = shift; |
96 | my $data = {@_}; |
97 | |
98 | #this is necessary, otherwise XML::Simple will just generate attributes |
99 | while (my ($key,$value) = each %{ $data }) { |
100 | $self->xml_head->{$key} = [ $value ]; |
101 | } |
102 | } |
103 | |
104 | sub add_group { |
105 | my $self = shift; |
106 | my %defaults = %{$self->group}; |
107 | my $data = { |
108 | id => $self->id, |
109 | %defaults, |
110 | @_ }; |
111 | |
112 | die "Need to define 'text' attribute" unless defined $data->{text}; |
113 | |
114 | $data->{outline} = []; |
115 | |
116 | push @{$self->xml_outlines}, $data; |
117 | $self->groups->{$data->{text}} = $data->{outline}; |
118 | } |
119 | |
120 | sub insert_outline { |
121 | my $self = shift; |
122 | my %defaults = %{$self->outline}; |
123 | my $data = { |
124 | id => $self->id, |
125 | %defaults, |
126 | @_}; |
127 | |
128 | my $parent = $self->xml_outlines; |
129 | |
130 | if (exists $data->{group}) { |
131 | if (exists $self->groups->{$data->{group}}) { |
132 | $parent = $self->groups->{$data->{group}}; |
133 | delete($data->{group}); |
134 | } |
135 | else { |
136 | $self->add_group('text' => $data->{group}); |
137 | $self->insert_outline(%$data); |
138 | return; |
139 | } |
140 | } |
141 | |
142 | push @{$parent}, $data; |
143 | } |
144 | |
145 | sub add_outline { |
146 | my $self = shift; |
147 | $self->insert_outline(@_); |
148 | } |
149 | |
150 | sub as_string { |
151 | my $self = shift; |
152 | |
153 | require XML::Simple; |
154 | my $xs = new XML::Simple(); |
155 | |
156 | return $xs->XMLout( $self->_mk_hashref, %{$self->xml_options} ); |
157 | } |
158 | |
159 | sub _mk_hashref { |
160 | my $self = shift; |
161 | |
162 | my $hashref = { |
163 | %{$self->xml}, |
164 | head => $self->xml_head, |
165 | body => { outline => $self->xml_outlines }, |
166 | }; |
167 | |
168 | return $hashref; |
169 | } |
170 | |
171 | sub save { |
172 | my $self = shift; |
173 | my $filename = shift; |
174 | |
175 | require XML::Simple; |
176 | my $xs = new XML::Simple(); |
177 | |
178 | $xs->XMLout( $self->_mk_hashref, %{$self->xml_options}, OutputFile => $filename ); |
179 | } |
180 | |
181 | 1; |
182 | |
183 | =pod |
184 | |
185 | =head1 NAME |
186 | |
187 | XML::OPML::SimpleGen - create OPML using XML::Simple |
188 | |
189 | =head1 SYNOPSIS |
190 | |
191 | require XML::OPML::SimpleGen; |
192 | |
193 | my $opml = new XML::OPML::SimpleGen(); |
194 | |
195 | $opml->head( |
196 | title => 'FIFFS Subscriptions', |
197 | ); |
198 | |
199 | $opml->insert_outline( |
200 | group => 'news', # groups will be auto generated |
201 | text => 'some feed', |
202 | xmlUrl => 'http://www.somepage.org/feed.xml', |
203 | ); |
204 | |
205 | # insert_outline and add_outline are the same |
206 | |
207 | $opml->add_group( text => 'myGroup' ); # explicitly create groups |
208 | |
209 | print $opml->to_string; |
210 | |
211 | $opml->save('somefile.opml'); |
212 | |
213 | $opml->xml_options( $hashref ); # XML::Simple compatible options |
214 | |
215 | # See XML::OPML's synopsis for more knowledge |
216 | |
217 | |
218 | =head1 DESCRIPTION |
219 | |
220 | XML::OPML::SimpleGen lets you simply generate OPML documents |
221 | without having too much to worry about. |
222 | It is a drop-in replacement for XML::OPML |
223 | in regards of generation. |
224 | As this module uses XML::Simple it is rather |
225 | generous in regards of attribute or element names. |
226 | |
227 | =head1 COMMON METHODS |
228 | |
229 | =over |
230 | |
231 | =item new( key => value ) |
232 | |
233 | Creates a new XML::OPML::SimpleGen instance. All key values will be |
234 | used as attributes for the <atom> element. The only thing you might |
235 | want to use here is the version => '1.1', which is default anyway. |
236 | |
237 | =item head( key => value ) |
238 | |
239 | XML::OPML compatible head method to change header values. |
240 | |
241 | =item id ( ) |
242 | |
243 | Returns (and increments) a counter. |
244 | |
245 | =item add_group ( text => 'name' ) |
246 | |
247 | Method to explicitly create a group which can hold multiple outline |
248 | elements. |
249 | |
250 | =item insert_outline ( key => value ) |
251 | |
252 | XML::OPML compatible method to add an outline element. See |
253 | L<XML::OPML> for details. The group key is used to put elements in a |
254 | certain group. Non existent groups will be created automagically. |
255 | |
256 | =item add_outline ( key => value ) |
257 | |
258 | Alias to insert_outline for XML::OPML compatibility. |
259 | |
260 | =item as_string |
261 | |
262 | Returns the given OPML XML data as a string |
263 | |
264 | =item save ( $filename ) |
265 | |
266 | Saves the OPML data to a file |
267 | |
268 | =back |
269 | |
270 | =head1 ADVANCED METHODS |
271 | |
272 | =over |
273 | |
274 | =item xml_options ( $hashref ) |
275 | |
276 | $hashref may contain any XML::Simple options. |
277 | |
278 | =item outline ( $hashref ) |
279 | |
280 | The outline method defines the 'template' for any new outline |
281 | element. You can preset key value pairs here to be used |
282 | in all outline elements that will be generated by XML::OPML::SimpleGen. |
283 | |
284 | =item group ( $hashref ) |
285 | |
286 | This method is similar to outline, it defines the template for a |
287 | grouping outline element. |
288 | |
289 | =back |
290 | |
291 | =head1 AUTHOR |
292 | |
293 | Marcus Thiesen, C<< <marcus@thiesen.org> >> |
294 | |
295 | =head1 BUGS |
296 | |
297 | Please report any bugs or feature requests to |
298 | C<bug-xml-opml-simlegen@rt.cpan.org>, or through the web interface at |
299 | L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=XML-OPML-SimleGen>. |
300 | I will be notified, and then you'll automatically be notified of progress on |
301 | your bug as I make changes. |
302 | |
303 | =head1 SEE ALSO |
304 | |
305 | L<XML::OPML> L<XML::Simple> |
306 | |
307 | =head1 COPYRIGHT & LICENSE |
308 | |
309 | Copyright 2005-2007 Marcus Thiesen, All Rights Reserved. |
310 | |
311 | This program is free software; you can redistribute it and/or modify it |
312 | under the same terms as Perl itself. |
313 | |
314 | =head1 CVS |
315 | |
316 | $Id: SimpleGen.pm,v 1.9 2008/02/08 10:33:43 stephenca Exp $ |
317 | |
318 | =cut |