File Coverage

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

Criterion	Covered	Total	%
statement	68	117	58.1
branch	25	62	40.3
condition	8	15	53.3
subroutine	11	15	73.3
pod	0	9	0.0
total	112	218	51.3

=head1 NAME

XML::FeedPP::Plugin::DumpJSON - FeedPP Plugin for generating JSON

=head1 SYNOPSIS

    use XML::FeedPP;
    my $feed = XML::FeedPP->new( 'index.rss' );
    $feed->limit_item( 10 );
    $feed->call( DumpJSON => 'index-rss.json' );

=head1 DESCRIPTION

This plugin generates a JSON data representation.

=head1 FILE OR STRING

If a JSON filename is C or C<''>, this module returns a JSON
string instead of generating a JSON file.

    $feed->call( DumpJSON => 'feed.json' );     # generates a JSON file
    my $json = $feed->call( 'DumpJSON' );       # returns a JSON string

=head1 OPTIONS

This plugin allows some optoinal arguments following:

    my %opt = (
        slim             => 1,
        slim_element_add => [ 'media:thumbnail@url' ],
        slim_element     => [ 'link', 'title', 'pubDate' ],
    );
    my $json = $feed->call( DumpJSON => %opt );

=head2 slim

This plugin converts the whole feed into JSON format by default.
All elements and attribuets are included in a JSON generated.
If this boolean is true, some limited elements are only included.

=head2 slim_element_add

An array reference for element/attribute names
which is given by set()/get() method's format.
These elements/attributes are also appended for slim JSON.

=head2 slim_element

An array reference for element/attribute names.
The default list of limited elements is replaced by this value.

=head1 MODULE DEPENDENCIES

L, L and L

=head1 SEE ALSO

JSON, JavaScript Object Notation:
L

=head1 AUTHOR

Yusuke Kawasaki, http://www.kawa.net/

=head1 COPYRIGHT AND LICENSE

Copyright (c) 2006-2008 Yusuke Kawasaki. All rights reserved.
This program is free software; you can redistribute it
and/or modify it under the same terms as Perl itself.

=cut
# ----------------------------------------------------------------
package XML::FeedPP::Plugin::DumpJSON;
use strict;
use vars qw( @ISA );
@ISA = qw( XML::FeedPP::Plugin );
use Carp;
use Symbol;
require 5.008;
use JSON::Syck;
# use JSON::PP;
# use JSON::XS;

use vars qw( $VERSION );
$VERSION = "0.33";

*XML::FeedPP::to_json = \&to_json;

my $SLIM_ELEM = [qw(
    link title pubDate dc:date modified issued dc:subject category
    image/url media:content@url media:thumbnail@url
)];
my $DEFAULT_OPTS = {
    slim_element    =>  undef,
    slim_element_add => undef,
    utf8_flag       =>  undef,
    use_json_syck   =>  1,
    use_json_pp     =>  undef,
};

sub run {
    my $class = shift;
    my $feed = shift;
    &to_json( $feed, @_ );
}

sub to_json {
    my $data = shift;
    my $file = shift if scalar @_ % 2;   # odd arguments
    my $opts = { %$DEFAULT_OPTS, @_ };
    $file = $opts->{file} if exists $opts->{file};

    # cut some elements out
    if ( $opts->{slim} || $opts->{slim_element} || $opts->{slim_element_add} ) {
        $data = &slim_feed( $data, $opts->{slim_element}, $opts->{slim_element_add} );
    }

    # perl object to json
    my $json = &dump_json( $data, $opts );

    # json to file
    if ( $file ) {
        &write_file( $file, $json, $opts );
    }
    $json;
}

sub write_file {
    my $file = shift;
    my $fh   = Symbol::gensym();
    open( $fh, ">$file" ) or Carp::croak "$! - $file";
    print $fh @_;
    close($fh);
}

sub dump_json {
    my $data = shift;
    my $opts = shift;

    my $usesyck = $opts->{use_json_syck};
    my $usepp   = $opts->{use_json_pp};
    $usesyck = 1 unless $usepp;
    $usepp   = 1 unless $usesyck;

    if ( $usesyck && defined $JSON::Syck::VERSION ) {
        return &dump_json_syck($data,$opts);
    }
    if ( $usepp && defined $JSON::VERSION ) {
        return &dump_json_pm($data,$opts);
    }
    if ( $usesyck ) {
        local $@;
        eval { require JSON::Syck; };
        return &dump_json_syck($data,$opts) unless $@;
    }
    if ( $usepp ) {
        local $@;
        eval { require JSON; };
        return &dump_json_pm($data,$opts) unless $@;
    }
    if ( $usepp ) {
        Carp::croak "JSON::PP or JSON::Syck is required";
    }
    else {
        Carp::croak "JSON::Syck is required";
    }
}

sub dump_json_syck {
    my $data = shift;
    my $opts = shift;
    # warn "[JSON::Syck $JSON::Syck::VERSION]\n";
    local $JSON::Syck::ImplicitUnicode = $opts->{utf8_flag} if exists $opts->{utf8_flag};
#   local $JSON::Syck::SingleQuote = 0;
    JSON::Syck::Dump($data);
}

sub dump_json_pm {
    my $data = shift;
    my $opts = shift;

    my $ver = ( $JSON::VERSION =~ /^([\d\.]+)/ )[0];
    Carp::croak "JSON::PP is not correctly loaded." unless $ver;
    return &dump_json_pp1($data,$opts) if ( $ver < 1.99 );
    return &dump_json_pp2($data,$opts);
}

sub dump_json_pp2 {
    my $data = shift;
    my $opts = shift;
    if ( ! defined $JSON::PP::VERSION ) {
        local $@;
        eval { require JSON::PP; };
        Carp::croak "JSON::PP is required" if $@;
    }
    # warn "[JSON::PP $JSON::PP::VERSION]\n";
    my $json = JSON::PP->new();
    my $utf8 = $opts->{utf8_flag} if exists $opts->{utf8_flag};
    my $bool = $utf8 ? 0 : 1;
    $json->utf8($bool);
    $json->allow_blessed(1);
    $json->as_nonblessed(1);
    $json->encode($data);
}

sub dump_json_pp1 {
    my $data = shift;
    my $opts = shift;
    # warn "[JSON $JSON::VERSION]\n";
    my $json = JSON->new();
    my $utf8 = $opts->{utf8_flag} if exists $opts->{utf8_flag};
    local $JSON::UTF8 = $utf8 ? 0 : 1;
    $json->convblessed(1);
    $json->objToJson($data)
}

sub slim_feed {
    my $feed = shift;
    my $list = shift || $SLIM_ELEM;
    my $add  = shift;
    my $slim = {};
    my $root = ( keys %$feed )[0];
    if ( ref $add ) {
        $list = [ @$list, @$add ];
    }
    my $channel = {};
    foreach my $key ( @$list ) {
        my $val = ( $key eq "link" ) ? $feed->link() : $feed->get($key);
        $channel->{$key} = $val if defined $val;
    }
    my $entries = [];
    foreach my $item ( $feed->get_item() ) {
        my $hash = {};
        foreach my $key ( @$list ) {
            my $val = ( $key eq "link" ) ? $item->link() : $item->get($key);
            $hash->{$key} = $val if defined $val;
        }
        push( @$entries, $hash );
    }
    my $data;
    if ( $root eq 'rss' ) {
        $channel->{item} = $entries;
        $data = { rss => { channel => $channel }};
    }
    elsif ( $root eq 'rdf:RDF' ) {
        $data = { 'rdf:RDF' => { channel => $channel, item => $entries }};
    }
    elsif ( $root eq 'feed' ) {
        $channel->{entry} = $entries;
        $data = { feed => $channel };
    }
    else {
        Carp::croak "Invalid feed type: $root";
    }
    $data;
}

# ----------------------------------------------------------------
1;
# ----------------------------------------------------------------