/XML-FeedPP-Plugin-DumpJSON/lib/XML/FeedPP/Plugin/DumpJSON.pm

  1=head1 NAME
  2
  3XML::FeedPP::Plugin::DumpJSON - FeedPP Plugin for generating JSON
  4
  5=head1 SYNOPSIS
  6
  7    use XML::FeedPP;
  8    my $feed = XML::FeedPP->new( 'index.rss' );
  9    $feed->limit_item( 10 );
 10    $feed->call( DumpJSON => 'index-rss.json' );
 11
 12=head1 DESCRIPTION
 13
 14This plugin generates a JSON data representation.
 15
 16=head1 FILE OR STRING
 17
 18If a JSON filename is C<undef> or C<''>, this module returns a JSON 
 19string instead of generating a JSON file.
 20
 21    $feed->call( DumpJSON => 'feed.json' );     # generates a JSON file
 22    my $json = $feed->call( 'DumpJSON' );       # returns a JSON string
 23
 24=head1 OPTIONS
 25
 26This plugin allows some optoinal arguments following:
 27
 28    my %opt = (
 29        slim             => 1,
 30        slim_element_add => [ 'media:thumbnail@url' ],
 31        slim_element     => [ 'link', 'title', 'pubDate' ],
 32    );
 33    my $json = $feed->call( DumpJSON => %opt );
 34
 35=head2 slim
 36
 37This plugin converts the whole feed into JSON format by default.
 38All elements and attribuets are included in a JSON generated.
 39If this boolean is true, some limited elements are only included.
 40
 41=head2 slim_element_add
 42
 43An array reference for element/attribute names
 44which is given by set()/get() method's format.
 45These elements/attributes are also appended for slim JSON.
 46
 47=head2 slim_element
 48
 49An array reference for element/attribute names.
 50The default list of limited elements is replaced by this value.
 51
 52=head1 MODULE DEPENDENCIES
 53
 54L<XML::FeedPP>, L<XML::TreePP> and L<JSON::Syck>
 55
 56=head1 SEE ALSO
 57
 58JSON, JavaScript Object Notation:
 59L<http://www.json.org/>
 60
 61=head1 AUTHOR
 62
 63Yusuke Kawasaki, http://www.kawa.net/
 64
 65=head1 COPYRIGHT AND LICENSE
 66
 67Copyright (c) 2006-2008 Yusuke Kawasaki. All rights reserved.
 68This program is free software; you can redistribute it 
 69and/or modify it under the same terms as Perl itself.
 70
 71=cut
 72# ----------------------------------------------------------------
 73package XML::FeedPP::Plugin::DumpJSON;
 74use strict;
 75use vars qw( @ISA );
 76@ISA = qw( XML::FeedPP::Plugin );
 77use Carp;
 78use Symbol;
 79require 5.008;
 80use JSON::Syck;
 81# use JSON::PP;
 82# use JSON::XS;
 83
 84use vars qw( $VERSION );
 85$VERSION = "0.33";
 86
 87*XML::FeedPP::to_json = \&to_json;
 88
 89my $SLIM_ELEM = [qw( 
 90    link title pubDate dc:date modified issued dc:subject category 
 91    image/url media:content@url media:thumbnail@url
 92)];
 93my $DEFAULT_OPTS = {
 94    slim_element    =>  undef,
 95    slim_element_add => undef,
 96    utf8_flag       =>  undef,
 97    use_json_syck   =>  1,
 98    use_json_pp     =>  undef,
 99};
100
101sub run {
102    my $class = shift;
103    my $feed = shift;
104    &to_json( $feed, @_ );
105}
106
107sub to_json {
108    my $data = shift;
109    my $file = shift if scalar @_ % 2;   # odd arguments
110    my $opts = { %$DEFAULT_OPTS, @_ };
111    $file = $opts->{file} if exists $opts->{file};
112
113    # cut some elements out
114    if ( $opts->{slim} || $opts->{slim_element} || $opts->{slim_element_add} ) {
115        $data = &slim_feed( $data, $opts->{slim_element}, $opts->{slim_element_add} );
116    }
117
118    # perl object to json
119    my $json = &dump_json( $data, $opts );
120
121    # json to file
122    if ( $file ) {
123        &write_file( $file, $json, $opts );
124    }
125    $json;
126}
127
128sub write_file {
129    my $file = shift;
130    my $fh   = Symbol::gensym();
131    open( $fh, ">$file" ) or Carp::croak "$! - $file";
132    print $fh @_;
133    close($fh);
134}
135
136sub dump_json {
137    my $data = shift;
138    my $opts = shift;
139
140    my $usesyck = $opts->{use_json_syck};
141    my $usepp   = $opts->{use_json_pp};
142    $usesyck = 1 unless $usepp;
143    $usepp   = 1 unless $usesyck;
144
145    if ( $usesyck && defined $JSON::Syck::VERSION ) {
146        return &dump_json_syck($data,$opts);
147    }
148    if ( $usepp && defined $JSON::VERSION ) {
149        return &dump_json_pm($data,$opts);
150    }
151    if ( $usesyck ) {
152        local $@;
153        eval { require JSON::Syck; };
154        return &dump_json_syck($data,$opts) unless $@;
155    }
156    if ( $usepp ) {
157        local $@;
158        eval { require JSON; };
159        return &dump_json_pm($data,$opts) unless $@;
160    }
161    if ( $usepp ) {
162        Carp::croak "JSON::PP or JSON::Syck is required";
163    }
164    else {
165        Carp::croak "JSON::Syck is required";
166    }
167}
168
169sub dump_json_syck {
170    my $data = shift;
171    my $opts = shift;
172    # warn "[JSON::Syck $JSON::Syck::VERSION]\n";
173    local $JSON::Syck::ImplicitUnicode = $opts->{utf8_flag} if exists $opts->{utf8_flag};
174#   local $JSON::Syck::SingleQuote = 0;
175    JSON::Syck::Dump($data);
176}
177
178sub dump_json_pm {
179    my $data = shift;
180    my $opts = shift;
181
182    my $ver = ( $JSON::VERSION =~ /^([\d\.]+)/ )[0];
183    Carp::croak "JSON::PP is not correctly loaded." unless $ver;
184    return &dump_json_pp1($data,$opts) if ( $ver < 1.99 );
185    return &dump_json_pp2($data,$opts);
186}
187
188sub dump_json_pp2 {
189    my $data = shift;
190    my $opts = shift;
191    if ( ! defined $JSON::PP::VERSION ) {
192        local $@;
193        eval { require JSON::PP; };
194        Carp::croak "JSON::PP is required" if $@;
195    }
196    # warn "[JSON::PP $JSON::PP::VERSION]\n";
197    my $json = JSON::PP->new();
198    my $utf8 = $opts->{utf8_flag} if exists $opts->{utf8_flag};
199    my $bool = $utf8 ? 0 : 1;
200    $json->utf8($bool);
201    $json->allow_blessed(1);
202    $json->as_nonblessed(1);
203    $json->encode($data);
204}
205
206sub dump_json_pp1 {
207    my $data = shift;
208    my $opts = shift;
209    # warn "[JSON $JSON::VERSION]\n";
210    my $json = JSON->new();
211    my $utf8 = $opts->{utf8_flag} if exists $opts->{utf8_flag};
212    local $JSON::UTF8 = $utf8 ? 0 : 1;
213    $json->convblessed(1);
214    $json->objToJson($data)
215}
216
217sub slim_feed {
218    my $feed = shift;
219    my $list = shift || $SLIM_ELEM;
220    my $add  = shift;
221    my $slim = {};
222    my $root = ( keys %$feed )[0];
223    if ( ref $add ) {
224        $list = [ @$list, @$add ];
225    }
226    my $channel = {};
227    foreach my $key ( @$list ) {
228        my $val = ( $key eq "link" ) ? $feed->link() : $feed->get($key);
229        $channel->{$key} = $val if defined $val;
230    }
231    my $entries = [];
232    foreach my $item ( $feed->get_item() ) {
233        my $hash = {};
234        foreach my $key ( @$list ) {
235            my $val = ( $key eq "link" ) ? $item->link() : $item->get($key);
236            $hash->{$key} = $val if defined $val;
237        }
238        push( @$entries, $hash );
239    }
240    my $data;
241    if ( $root eq 'rss' ) {
242        $channel->{item} = $entries;
243        $data = { rss => { channel => $channel }};
244    }
245    elsif ( $root eq 'rdf:RDF' ) {
246        $data = { 'rdf:RDF' => { channel => $channel, item => $entries }};
247    }
248    elsif ( $root eq 'feed' ) {
249        $channel->{entry} = $entries;
250        $data = { feed => $channel };
251    }
252    else {
253        Carp::croak "Invalid feed type: $root";
254    }
255    $data;
256}
257
258# ----------------------------------------------------------------
2591;
260# ----------------------------------------------------------------