r1315@llin: dpavlin | 2007-08-23 22:52:10 +0200

 create on-disk JSON file

git-svn-id: svn+ssh://mjesec/home/dpavlin/svn/webpac2/trunk@883 07558da8-63fa-0310-ba24-9fe276d99e06

diff --git a/Makefile.PL b/Makefile.PL
index fc6f73d..c0bfcf9 100644 (file)
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -37,6 +37,7 @@ WriteMakefile(
        'XML::LibXML' => 0,
        'Pod::Usage' => 0,
        'Class::Accessor' => 0,
+       'JSON' => 0,
     },
     dist                => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
     clean               => { FILES => 'WebPAC-* pod2html Makefile tags' },

diff --git a/lib/WebPAC/Output/JSON.pm b/lib/WebPAC/Output/JSON.pm
index f395852..7cc4089 100644 (file)
--- a/lib/WebPAC/Output/JSON.pm
+++ b/lib/WebPAC/Output/JSON.pm
@@ -6,8 +6,10 @@ use strict;
 use base qw/WebPAC::Common Class::Accessor/;
 __PACKAGE__->mk_accessors(qw(path));
 
-use Encode qw/from_to/;
+#use Encode qw/from_to/;
 use Data::Dump qw/dump/;
+use JSON;
+use File::Slurp;
 
 =head1 NAME
 
@@ -55,6 +57,8 @@ sub init {
 
        $log->debug('init');
 
+       $self->{_data} = [];
+
        return 1;
 }
 
@@ -78,6 +82,22 @@ sub add {
 
        $log->debug("id: $id ds = ",dump($ds));
 
+       my $item;
+
+       foreach my $t ( keys %$ds ) {
+               my $name = lc($t);
+               $name =~ s/\W+/_/g;
+
+               # FIXME get rid of non hash values in data_structure for consistency?
+               next unless ref($ds->{$t}) eq 'HASH';
+
+               if ( defined( $ds->{$t}->{display} ) ) {
+                       $item->{$name} = $ds->{$t}->{display};
+               }
+       }
+
+       push @{ $self->{_data} }, $item;
+
        return 1;
 }
 
@@ -92,7 +112,8 @@ sub finish {
 
        my $log = $self->_get_logger();
 
-       $log->info("finish");
+       $log->info("writing JSON output to ", $self->path);
+       write_file( $self->path, objToJson( { items => $self->{_data} } ) );
 
 }
 

diff --git a/t/5-output-json.t b/t/5-output-json.t
index e85b191..778dfc8 100755 (executable)
--- a/t/5-output-json.t
+++ b/t/5-output-json.t
@@ -1,8 +1,11 @@
 #!/usr/bin/perl -w
 
-use Test::More tests => 7;
+use Test::More tests => 14;
 use Test::Exception;
 use Cwd qw/abs_path/;
+use JSON;
+use File::Slurp;
+use Data::Dump qw/dump/;
 use blib;
 use strict;
 
@@ -10,31 +13,28 @@ BEGIN {
 use_ok( 'WebPAC::Output::JSON' );
 }
 
+my $debug = shift @ARGV;
+
 ok(my $abs_path = abs_path($0), "abs_path");
 $abs_path =~ s#/[^/]*$#/#; #
 diag "abs_path: $abs_path";
+my $path = "$abs_path/out/test.js";
 
-ok(my $out = new WebPAC::Output::JSON({
-       path => "$abs_path/out/test.js",
-}), "new");
+ok(my $out = new WebPAC::Output::JSON({ path => $path }), "new");
 
 ok( $out->init, 'init' );
 
 my $ds = {
        'Source' => {
                'name' => 'Izvor: ',
-               'tag' => 'Source',
                'display' => [ 'foo' ]
-               },
+       },
        'ID' => {
-               'name' => 'ID',
-               'tag' => 'IDths',
-               'search' => [ 'bar' ],
-               'lookup_key' => [ 'bar' ]
-               },
-       'filename' => [ 'out/thes/001.html' ],
-       'name' => 'filename',
-       'tag' => 'filename'
+               'display' => 'id',
+       },
+       'Array' => {
+               'display' => [ qw/a1 a2 s3 a4 a5/ ],
+       },
 };
 
 throws_ok { $out->add( ) } qr/need id/, 'add without params';
@@ -42,4 +42,23 @@ throws_ok { $out->add( 42 ) } qr/need ds/, 'add without ds';
 
 ok( $out->add( 42, $ds ), 'add' );
 
+ok( $out->add( 99, { foo => { display => 'foo' } } ), 'add another' );
+
+ok( $out->finish );
+
+ok( -e $out->path, "created $path" );
+
+cmp_ok( $out->path, 'eq', $path, 'path' );
+
+ok( my $items = read_file( $path ), 'read_file' );
+
+ok( $items = jsonToObj( $items ), 'parse JSON' );
+
+diag dump( $items ) if $debug;
 
+is_deeply( $items, {
+       items => [
+               { array => ["a1", "a2", "s3", "a4", "a5"], id => "id", source => ["foo"] },
+               { foo => "foo" },
+       ],
+}, 'same' );