# Copyright 2002-2008 Josh Clark and Global Moxie, LLC. This code cannot be 
# redistributed without permission from globalmoxie.com.  For more
# information, consult your Big Medium license.
#
# $Id: JSON.pm 3043 2008-03-31 14:00:38Z josh $

package BigMed::JSON;
use strict;
use utf8;
use Carp;
use base qw(Exporter);
use JSON qw(jsonToObj);
$JSON::UnMapping = 1; #don't deal with blessed objects for null,true,false

use BigMed::Filter;
@BigMed::JSON::EXPORT = qw(objToJson jsonToObj json_object_info json_format_cols);

my %upload_type = ( document => 1, image_file => 1 );

sub objToJson {
    #the original doesn't handle this case, which can cause trouble
    #within html pages
    my $string = JSON::objToJson( $_[0] );
    $string =~ s{</}{<\\/}g;
    return $string;
}

sub json_object_info {
    my %args = @_;
    my ( $app, $rclasses, $robjects, $rinfo ) =
      @args{qw(app classes objects relation_info)};
    $app          or croak 'json_object_info requires app argument';

    #load class info and json field schema for each class
    my @classes = ref $rclasses eq 'ARRAY' ? @$rclasses : ();
    my %class_info;
    foreach my $class (@classes) {
        $class_info{$class} = prep_class_attributes( $app, $class );
    }
    
    #pointer info and meta data, if any
    my $rmeta = $rinfo->{metadata};
    my @meta_fields = ref $rmeta eq 'ARRAY' ? @$rmeta : ();
    my %rich_text_meta;
    my %json_relation;
    if ($rmeta) { #test for actual reference; empty array is okay too
        $json_relation{points} = 1;
        my @meta_refs =
          map { _process_schema_field( $app, $_ ) } @meta_fields;
        $json_relation{meta} = \@meta_refs;
        %rich_text_meta =
          map { index( $_->[0], 'rich_text' ) == 0 ? ( $_->[1], 1 ) : () }
          @meta_refs;
    }
    $json_relation{limit_num} = $rinfo->{limit_num} if $rinfo->{limit_num};
    $json_relation{required} = $rinfo->{required} if $rinfo->{required};

    my @objects =
        ref $robjects eq 'ARRAY' ? @$robjects
      : defined $robjects ? ($robjects)
      : ();
      
    #collect field values and metadata info for each object
    my %json_object;
    my %obj_props;
    foreach my $item (@objects) {
        my ( $pointer_id, $obj );
        if ( ref $item eq 'ARRAY' ) {    # pointer/object pair
            my $pointer;
            ( $pointer, $obj ) = @$item;
            $pointer_id = $pointer->id;
            $json_relation{points} = 1; #in case no metadata defined
            $json_relation{$pointer_id} =
              _JSON_pointer_obj( $app, $pointer, $obj, \@meta_fields,
                \%rich_text_meta );
        }
        else {                           #plain object for "has" relationship
            $obj = $item;
        }
        my $class           = ref $obj;
        $class_info{$class} ||= prep_class_attributes( $app, $class );
        $obj_props{$class} ||= { $class->properties };
        my %field_value =
          json_format_cols( $app, $obj, $class_info{$class}->{obj_cols},
            $obj_props{$class}, $class_info{$class}->{rich_text} );
        $field_value{can_edit} = 1 if $obj->stash('can_edit');
        $json_object{ $obj->data_label }->{ $obj->id } = \%field_value
          if %field_value;
    }

    #build schema, type info, and json object info for all classes
    my %json_schema;
    my $richtext;
    my @labels;
    my %objects;
    my %js_iframe;
    my %js_depend;
    foreach my $class (keys %class_info) {
        my $label = $class->data_label;
        my $js_label = $app->js_escape($label);
        push @labels, $js_label;
        $js_iframe{$js_label} = 1 if $class_info{$class}->{iframe};
        $richtext = 1 if $class_info{$class}->{rich_text};
        $json_schema{$label} = [@{ $class_info{$class}->{schema_fields} }];
        if ($json_object{$label}) {
            $objects{$js_label} = objToJson( $json_object{$label} );
        }
        
        my %dependency;
        foreach my $dep ('can_hotlink', 'can_link') {
            $dependency{$dep} = 1 if $class->can($dep) && $class->$dep;
        }
        $js_depend{$js_label} = objToJson( \%dependency );
    }
    $json_relation{types} = [(sort keys %json_schema)];

    return (
        labels    => [sort @labels],
        schema    => objToJson( \%json_schema ),
        relation  => objToJson( \%json_relation ),
        objects   => \%objects,
        iframe    => \%js_iframe,
        rich_text => $richtext,
        dependency => \%js_depend,
    );
}

 sub json_format_cols {
    my ($app, $obj, $rcols, $rprops, $rrichtext) = @_;
    my %field_value;
    
    foreach my $col (@$rcols) {
        if ( $rrichtext->{$col} ) {
            my ( $filter, $text ) =
              BigMed::Filter->extract_filter_and_text( $obj->$col );
            $filter = BigMed::Filter->browser_filter( $app, $filter );
            $field_value{$col} = "$filter:$text";
        }
        elsif (
            $rprops->{$col}->{multiple}
            || BigMed::Elements->property(
                $rprops->{$col}->{type}, 'array'
            )
          )
        {
            $field_value{$col} = [$obj->$col];
        }
        else {
            $field_value{$col} = $obj->$col;
        }
    }

    %field_value;
}


sub _JSON_pointer_obj {
    my ( $app, $pointer, $obj, $rmeta_fields, $rrich_text ) = @_;
    my @fields = @$rmeta_fields;

    my %metadata_value = $pointer->metadata;
    $metadata_value{'__OBJ'}  = $obj->id;
    $metadata_value{'__TYPE'} = $obj->data_label;
    my %meta_field = map {
        my $id = $_->{id};
        if ( $rrich_text->{$id} ) {
            my ( $filter, $text ) =
              BigMed::Filter->extract_filter_and_text( $metadata_value{$id} );
            $filter = BigMed::Filter->browser_filter( $app, $filter );
            ( $id, "$filter:$text" );
        }
        else {
            ( $id, $metadata_value{$id} );
        }
    } @fields;
    return [$obj->data_label, $obj->id, \%meta_field];
}

sub prep_class_attributes {
    my ( $app, $class, $reditor_fields ) = @_;
    $class->isa('BigMed::Content') or $class->isa('BigMed::MiniContent')
      or croak "$class is not a BigMed::Content or MiniContent subclass";
    my @editor_fields =
      $reditor_fields ? @{$reditor_fields} : $class->editor_abbr();
    @editor_fields = $class->editor_fields() if !@editor_fields;

    
    #special case here ... if we run into more like this, should add
    #an attribute to minicontent to let each class specify its own
    #custom javascript
    if ( $class->isa('BigMed::Media::Image') ) {
        $app->js_add_code('BM.canThumbnail=true;') if $class->can_thumbnail;
        my $site = $app->can('current_site') ? $app->current_site : undef;
        my @formats = $class->image_formats($site);
        $app->js_add_code('BM.imageFormats = ' . objToJson(\@formats) . ';');
    }

    my %rich_text_field;
    my $upload;
    my @schema_fields;
    my @obj_cols;
    foreach my $field (@editor_fields) {
        my %attr = %$field;

        my %append = ( data_class => $class );
        if ( ref $attr{labels} eq 'HASH' ) {    #localize labels
            my %labels;
            while ( my ( $key, $value ) = each( %{ $attr{labels} } ) ) {
                $labels{$key} = $app->language($value);
            }
            $append{labels} = \%labels;
        }
        while ( my ( $k, $v ) = each(%append) ) {
            $attr{$k} = $v;
        }

        my $fieldref = _process_schema_field( $app, \%attr, $class );
        push @schema_fields, $fieldref;
        push @obj_cols,      $attr{column} if $attr{column};
        my $type = $fieldref->[0];
        $rich_text_field{ $attr{column} } = 1
          if $attr{column}
          && ( $type eq 'rich_text' || $type eq 'rich_text_brief' );
        $upload = 1 if $upload_type{$type};
    }
    return {
        obj_cols      => \@obj_cols,
        schema_fields => \@schema_fields,
        rich_text     => \%rich_text_field,
        iframe        => $upload,
    };
}

sub _process_schema_field {
    my ( $app, $rattr, $class ) = @_;
    my %append = $class ? ( data_class => $class ) : ();
    if ( ref $rattr->{labels} eq 'HASH' ) {    #localize labels
        my %labels;
        while ( my ( $key, $value ) = each( %{ $rattr->{labels} } ) ) {
            $labels{$key} = $app->language($value);
        }
        $append{labels} = \%labels;
    }
    my $field = $app->prompt_field_ref( %$rattr, %append );
    my %param = %{ $field->[2] };
    $param{default} = $param{value} if defined $param{value};
    delete @param{ qw(query field_msg value prompt_callback parse_callback) };
    $field->[2] = \%param;
    $field;
}

1;

__END__


=head1 NAME

BigMed::JSON - JSON translation for Big Medium objects

=head1 DESCRIPTION

BigMed::JSON provides a wrapper to the JSON CPAN module along with methods
for translating Big Medium objects into JSON strings for transport.

=head1 EXPORTED METHODS

BigMed::JSON exports the following static methods.

=head2 C<< json_object_info(%arguments) >>

Returns a hash containing values useful in transporting BigMed::Content and
BigMed::MiniContent objects and field schema via JSON.

    #json info for three page objects
    my %json_info = json_object_info(
        app => $app,
        classes => [ BigMed::Page ],
        objects => [ $page1, $page2, $page3 ],
    );
    
    #json info for a page's related media objects
    my %relationship = $page->relationship_info('media')
    my %related_obj = json_object_info(
        app => $app,
        classes => [ $page->load_related_classes('media') ],
        objects => [ $page->load_related_objects('media') ],
        meta_fields => $relationship{metadata}
    );

The method accepts a hash with the following key/value pairs:

=over 4

=item * app => $app_object

Required. The Big Medium application object.

=item * objects => \@objects

The objects, if any, for which you would like JSON translations. For related
objects with "points_to" relationships, the pointer/object pair should be
represented as an array reference, with the BigMed::Pointer object as the
first element and the target object as the second. (This is the format
in which BigMed::Content's C<load_related_classes> method returns points_to
objects).

=item * classes => \@classes

The subclass(es) of BigMed::Content and/or BigMed::MiniContent for
which you would like JSON translations, including or in addition to
the classes included in the objects parameter (useful when you want
json field schema for classes even if you do not have objects for those
classes).

=item * relation_info => \%relationship_info

Hash reference to the relationship info for the site. This is the same
hash that you get via BigMed::Content's relationship_info method.

=back

The method returns a hash with the following values:

=over 4

=item * labels => \@labels,

A reference to an unsorted array of JavaScript-escaped data labels for all
of the classes submitted in the C<classes> argument.

=item * schema => $json_schema,

The JSON representation of a hash of data fields for each class in the
C<classes> argument. The keys of the JSON object are the same values as the
array elements in the labels value above. Each value is an array of field
references like those generated by the BigMed::App prompt_field_ref method.
The fields are determined by the classes' editor_fields methods.

=item * objects => \%json_for_each_class,

A reference to a hash where each key JSON representation of a hash of data
fields for each class in the C<classes> argument. The keys are the
JavaScript-escaped label of each class for which there is an object. The
value is a JSON representation of a hash of values where the key is the
ID of the object, and the value is a hash of column name and column value
for each of the fields in the class's schema.

=item * relation => $json_relation,

The JSON representation of an object describing this set of objects,
particularly geared to a content object's set of related objects. The
JSON string represents a hash with the following key/value pairs:

=over 4

=item * types => \@data_types

Same array as the labels array described above.

=item * meta => \@field_refs

The field schema for the metadata fields, if any.

=item * => \%pointer_data

For pointed objects, the key is the numeric value of the pointer ID,
and the value is a hash representing the pointer object data.

=item * required => 1

Present and true if the relationship is required for the content type.

=item * limit_num => $n

Present only when the relationship specifies a limit to the number of
items allowed for this relationship.

=back

=item * iframe => \%iframe_classes

A reference to a hash where the keys are the JavaScript-escaped data labels
of the classes that must submit via iframe for Ajax-enabled forms. All
keys have a true value.

=item * rich_text => $boolean

If true, indicates that one or more of the classes contains a rich text
field.

=item * dependency => \%dependency_info

A reference to a hash where the keys are the JavaScript-escaped data labels
of all the classes, and the values are hash references to keys with
BigMed::MiniContent dependency-related flags if applicable (currently
can_link and can_hotlink). The values are true if the dependency is true
for the class.

=back

=head2 C<<json_format_cols($app, $obj, \@cols, \%props, \%richtext)>>

A helper routine to get a hash of formatted column values for an object,
ready to be passed to objToJson. Deals with irritating issues like detecting
whether object columns should be treated as arrays or scalars.

    my %fields = json_format_cols(
        $app,
        $obj,
        ['id', 'title', 'formats', 'shared'],
        { $class->properties },
        \%richtext,
    );

Accepts these arguments:

=over 4

=item 1 Application object

=item 2 The content objects whose fields you want to format

=item 3 An array reference of column names to format

=item 4 The object's property hash ( same as { $obj->properties } )

=item 5 A hash reference whose keys contain column names with richtext
values. The values are all some true value.

=back

=head2 C<< objToJson($object_reference) >>

A wrapper for the objToJson method from the JSON CPAN module. Returns a string
containing a JSON representation of the argument object.

=head2 C<< jsonToObj($object_reference) >>

A wrapper for the jsonToObj method from the JSON CPAN module. Returns an
object reference corresponding to the JSON object in the argument string.

=head1 UNEXPORTED METHODS

Not exported but available as public methods

=head2 C<< BigMed::JSON::prep_class_attributes( $app, $class, $rfields )>>

Prepares and formats general class information; does no actual JSON
conversion but prepares editing-related data so that it's ready for
JSON conversion.

The method returns a hash reference with four key/value pairs:

=over

=item * obj_cols => \@column_names

Edit fields that are also column names.

=item * schema_fields => \@field_info

The prompt_field_ref values for the class's edit fields.

=item * rich_text_field = \%rich_text_fields

Keys are field names that are rich-text fields, values are true.

=item * iframe => $boolean

True if ajax instances should submit via iframe.

=back

The method accepts three arguments: An application object, the class
name to prepare and an optional array reference referring to the edit
fields to display. If no edit-field arrayref is provided, the class's
edit_fields method is used.

=head1 SEE ALSO

=over 4

=item * JSON

=item * BigMed::Content

=item * BigMed::MiniContent

=back

=head1 AUTHOR & COPYRIGHTS

This module and all Big Medium modules are copyright Josh Clark
and Global Moxie. All rights reserved.

Use of this module and the Big Medium content
management system are governed by Global Moxie's software licenses
and may not be used outside of the terms and conditions outlined
there.

For more information, visit the Global Moxie website at
L<http://globalmoxie.com/>.

Big Medium and Global Moxie are service marks of Global Moxie
and Josh Clark. All rights reserved.

=cut