view Lib/Engine/Output/JSON.pm @ 148:e6447ad85cb4

DOM objects now have a schema and schemaSource properties RegExp now can launder data Improved post to DOM transformation (multiple values a now supported) Added new axes to navigation queries: ancestor and descendant minor changes and bug fixes
author wizard
date Mon, 16 Aug 2010 08:26:44 +0400
parents 16ada169ca75
children
line wrap: on
line source

package Configuration;
our $HtDocsDir;

package Engine;
our $Encoding;

package Engine::Output::JSON;
use strict;
use warnings;

use Encode;
use PerlIO;
use IMPL::Exception;
use JSON;

sub CTX_TEMPLATE()  { 1 }
sub CTX_DATA()      { 2 }

my $context = CTX_DATA;
our $Data;

sub template() { $context = CTX_TEMPLATE }
sub data() { $context = CTX_DATA }

sub Print {
    my ($class,$query,$action) = @_;
    
    my @path = $action->RequestURI->path_segments;
    shift @path;
    
    my $result;
    
    undef $@;
    $Data = $action->Result;
    eval {
        my $fname = $HtDocsDir . join '/', @path;
        if ($context == CTX_DATA) {
            my $dummy = '';
            open my $hstd, ">>", \$dummy or die new IMPL::Exception('Failed to create inmemory stream');
            local (*STDIN,*STDOUT) = ($hstd,$hstd);
            local ${^ENCODING};
            $result = do $fname or die new IMPL::Exception('Failed to evalute the file', $@, $!,$fname);
        } else {
            die new IMPL::Exception('JSON templates not implemented');
        }
    };
    if ($@) {
        $result = { errorCode => 1, errorMessage => "$@"};
    }
    
    print $query->header(-status => 200, -type => 'text/javascript');
    print to_json({ errorCode => 0, result => $result });
}


1;