root/lang/perl/XML-FeedWriter/trunk/lib/XML/FeedWriter/Base.pm @ 17143

Revision 17143, 4.9 kB (checked in by charsbar, 6 years ago)

XML-FeedWriter?: fixed pod glitches; 0.05 -> CPAN

  • Property svn:eol-style set to native
Line 
1package XML::FeedWriter::Base;
2
3use strict;
4use warnings;
5use Carp;
6use base qw( Class::Accessor::Fast Class::Data::Inheritable );
7use Encode;
8use DateTimeX::Web;
9use XML::Writer;
10
11__PACKAGE__->mk_accessors(qw(
12  xml dtx
13  _closed _output _encoding _use_cdata
14));
15
16__PACKAGE__->mk_classdata( _alias => {} );
17__PACKAGE__->mk_classdata( _requires => {} );
18__PACKAGE__->mk_classdata( _sort_order => {} );
19
20sub new {
21  my ($class, %options) = @_;
22
23  delete $options{version};  # this is for XML::FeedWriter only.
24
25  my $encoding = delete $options{encoding} || 'utf-8';
26
27  my $output;
28  my $self = bless {
29    xml => XML::Writer->new( OUTPUT => \$output ),
30    dtx => DateTimeX::Web->new,
31    _output    => \$output,
32    _encoding  => $encoding,
33    _closed    => 0,
34  }, $class;
35
36  $self->_extra_options( \%options );
37
38  my $modules = delete $options{modules} || {};
39  my %channel = $self->_canonize( \%options );
40
41  $self->_validate( channel => \%channel );
42
43  $self->xml->xmlDecl( $self->_encoding );
44
45  $self->_root_element( $modules );
46
47  $self->xml->setDataMode(1);
48  $self->xml->setDataIndent(2);
49
50  $self->_channel( \%channel );
51
52  return $self;
53}
54
55sub _extra_options {}
56sub _root_element {}
57sub _channel {}
58
59sub add_items {}
60
61sub close {}
62
63sub save {
64  my ($self, $file) = @_;
65
66  $self->close unless $self->_closed;
67
68  open my $fh, '>', $file;
69  binmode $fh;
70  print $fh encode( $self->_encoding, $self->as_string );
71  CORE::close $fh;
72}
73
74sub as_string { ${ shift->_output } }
75
76sub _data_element {
77  my ($self, $key, $data) = @_;
78
79  if ( ref $data eq 'ARRAY' ) {
80    $self->xml->dataElement( $key => @{ $data } );
81  }
82  elsif ( ref $data eq 'HASH' ) {
83    my %attr = %{ $data };
84    my $value = delete $attr{value};
85    $self->xml->dataElement( $key => $value, %attr );
86  }
87  else {
88    $self->xml->dataElement( $key => $data );
89  }
90}
91
92sub _cdata_element {
93  my ($self, $key, $data) = @_;
94
95  if ( $self->_use_cdata ) {
96    $self->xml->cdataElement( $key => $data );
97  }
98  else {
99    $self->_data_element( $key => $data );
100  }
101}
102
103sub _datetime_element {
104  my ($self, $key, $data) = @_;
105
106  my $datetime;
107  if ( ref $data eq 'ARRAY' ) {
108    $datetime = $self->dtx->for_rss20( @{ $data } );
109  }
110  if ( ref $data eq 'HASH' ) {
111    $datetime = $self->dtx->for_rss20( %{ $data } );
112  }
113  elsif ( ref $data ) {
114    $datetime = $self->dtx->for_rss20( $data );
115  }
116  elsif ( $data && $data =~ /^\d+$/ ) {
117    $datetime = $self->dtx->for_rss20( epoch => $data );
118  }
119  else {
120    $datetime = $self->dtx->for_rss20;
121  }
122
123  $self->_data_element( $key => $datetime );
124}
125
126sub _empty_element {
127  my ($self, $key, $hashref) = @_;
128
129  $self->_validate( $key => $hashref );
130  $self->xml->emptyTag( $key => %{ $hashref } );
131}
132
133sub _element_with_children {
134  my ($self, $key, $children) = @_;
135
136  $self->_validate( $key => $children );
137
138  $self->xml->startTag($key);
139  foreach my $subkey ( $self->_sort_keys( $children ) ) {
140    $self->_data_element( $subkey => $children->{$subkey} );
141  }
142  $self->xml->endTag($key);
143}
144
145sub _duplicable_elements {
146  my ($self, $key, $data) = @_;
147
148  if ( ref $data eq 'ARRAY' ) {
149    foreach my $item ( @{ $data } ) {
150      $self->_data_element( $key => $item );
151    }
152  }
153  else {
154    $self->_data_element( $key => $data );
155  }
156}
157
158sub _element_with_duplicable_children {
159  my ($self, $key, $data, $children_name) = @_;
160  my @items   = ( ref $data eq 'ARRAY' )
161    ? @{ $data }
162    : ( $data );
163
164  $self->xml->startTag($key);
165  foreach my $item ( @items ) {
166    $self->_data_element( $children_name => $item );
167  }
168  $self->xml->endTag($key);
169}
170
171sub _validate {
172  my ($self, $type, $hashref) = @_;
173
174  foreach my $req ( @{ $self->_requires->{$type} } ) {
175    if ( ref $req eq 'ARRAY' ) {
176      croak "$type: $req is required"
177        unless defined $hashref->{$req->[0]};
178      croak "$type: $req is too long"
179        unless length( $hashref->{$req->[0]} ) < $req->[1];
180    }
181    else {
182      croak "$type: $req is required"
183        unless defined $hashref->{$req};
184    }
185  }
186}
187sub _canonize {
188  my ($self, $hashref) = @_;
189
190  my %hash;
191  foreach my $key ( keys %{ $hashref } ) {
192    $hash{ $self->_alias->{$key} || $key } = $hashref->{$key};
193  }
194  return %hash;
195}
196
197sub _sort_keys {
198  my ($self, $hashref) = @_;
199
200  return map  { $_->{key} }
201         sort { $b->{order} <=> $a->{order} }
202         map  { +{
203           key   => $_,
204           order => $self->_sort_order->{$_} || 0,
205         }}
206         keys %{ $hashref };
207}
208
2091;
210
211__END__
212
213=head1 NAME
214
215XML::FeedWriter::Base
216
217=head1 DESCRIPTION
218
219This class is a base class for more specific feed writers. See appropriate pods for details.
220
221=head1 METHODS
222
223See L<XML::FeedWriter> for usage.
224
225=head2 new
226
227=head2 add_items
228
229=head2 close
230
231=head2 save
232
233=head2 as_string
234
235=head1 SEE ALSO
236
237L<XML::FeedWriter>, L<XML::FeedWriter::RSS20>
238
239=head1 AUTHOR
240
241Kenichi Ishigaki, E<lt>ishigaki@cpan.orgE<gt>
242
243=head1 COPYRIGHT AND LICENSE
244
245Copyright (C) 2008 by Kenichi Ishigaki.
246
247This program is free software; you can redistribute it and/or
248modify it under the same terms as Perl itself.
249
250=cut
Note: See TracBrowser for help on using the browser.