local-lib5/lib/perl5/XML/OPML/SimpleGen.pm

   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