##################################################################
# OBB::JSON::Blesser
##################################################################
package OBB::JSON::Blesser ;

use strict ;
use warnings ;

use Carp ;
use OBB ;
use OBB::Base ;

our @ISA = qw(OBB) ;

__PACKAGE__ -> Mk_methods ( [ qw(base name json key_map row_map type) ] ) ;

sub new_pack
  { my $self = shift ;
    my $type = shift ;
    my $kind = shift ;
    my $fmt  = "package %s ; use base 'OBB::JSON::Blesser' ;\n"
      . ( $kind and $kind eq 'ARRAY'
        ? 'sub New { my $self = shift ; bless [], $self ; }' . "\n"
	: ''
        ) ;
    my $pack = sprintf $fmt, $type ;
    print "$pack" if _debug ( __PACKAGE__ ) ;
    my $res = _eval "$pack ; 1 ;" ;
    confess "new_pack : $@" unless defined $res ;
    $pack ;
  }

sub Init
  { my $self = shift ;
    $self -> SUPER::Init ( @_ ) ;
    $self -> type ( $self -> _mk_model ) ;
    $self ;
  }

sub _key_map
  { my $self = shift ;
    my $rtyp = shift ;
    my $key  = shift ;
    $self -> key_map -> { "${rtyp}::${key}" } || $key ;
  }

sub _row_map
  { my $self = shift ;
    my $x = shift ;
    $self -> row_map -> { $x } || 'elem' ;
  }

sub _add
  { my $self = shift ;
    my $base = shift ;
    my $name = shift ;
    my $kind = shift ;
    my $attr = shift ;
    my $type = _unref $base ;
    my $tsub = $type ? "${type}::$name" : $name ;

    $type -> Mk_method ( $name, attr => $attr ) if $type ;
    $self -> new_pack ( $tsub, $kind ) if $kind ;
    my $res = bless {}, $tsub ;
    if ( ref $base )
      { $base -> { $name } = ( $kind ? $res : 'scalar' ) ; }
    $res ;
  }

#   printf "submodel : base ($base) name ($name) kind ($kind)\n" ;
sub _mk_sub_model ;
sub _mk_sub_model
  { my $self = shift ;
    my $base = shift ;
    my $name = shift ;
    my $json = shift ;
    my $attr = shift ;
    my $kind = ref $json ;

    my $type = $self -> _add ( $base, $name, $kind, $attr ) ;
    my $rtyp = _unref $type ;

    if ( $kind eq 'HASH' )
      { for my $key ( sort keys %$json )
          { my $name = $self -> _key_map ( $rtyp, $key ) ;
	    confess "non-alphanum key ($name) in $rtyp"
	      unless $name =~ /^[a-z]\w*$/i ;
            $self -> _mk_sub_model ( $type, $name, $json -> { $key }, $key ) ;
          }
      }
    elsif ( $kind eq 'ARRAY' )
      { if ( @$json )
          { my $elem = $json -> [ 0 ] ;
            my $name = $self -> _row_map ( $rtyp ) ;
            $self -> _mk_sub_model ( $type, $name, $elem, $name ) ;
          }
        else
	  { croak "Mk_model: array $rtyp should not be empty\n" ; }
      }

    $type ;
  }

sub _mk_model
  { my $self = shift ;
    my $base = $self -> base ;
    my $name = $self -> name ;
    my $json = $self -> json ;
    $self -> _mk_sub_model ( $base, $name, $json ) ;
  }

sub _bless
  { my $self = shift ;
    my $type = shift ;
    my $json = shift ;
    my $kind = ref $json ;
    my $rtyp = _unref $type ;

    bless $json, $rtyp if defined $json ;

    if ( $kind eq 'HASH' )
      { for my $key ( sort keys %$json )
          { my $name = $self -> _key_map ( $rtyp, $key ) ;
            if ( ref $type -> $name )
              { $self -> _bless ( $type -> $name, $json -> { $key } ) ; }
          }
      }
    elsif ( $kind eq 'ARRAY' and @$json and ref ( $json -> [ 0 ] ) )
      { my $name = $self -> _row_map ( _unref $type ) ;
        for my $elem ( @$json )
          { $self -> _bless ( $type -> $name, $elem ) ; }
      }

    $json ;
  }

sub Bless
  { my $self = shift ;
    my $json = shift ;
    $self -> _bless ( $self -> type, $json ) ;
  }

# BEGIN
  { OBB -> Mk_class_methods ( ) ;
  }

##################################################################
# OBB::JSON
##################################################################
package OBB::JSON ;

use strict ;
use warnings ;

use Carp ;
use OBB::Base ;
use OBB ;

use base qw(OBB) ;

sub mk_blesser
  { _args_minmax ( 3, 7, scalar @_ ) ;
    my $self = shift ;
    my $json = shift ;
    my $name = shift || '' ;
    my $base ;
    _args_even ( scalar @_ ) ;
    my %opts =
      ( key_map => {}
      , row_map => {}
      , @_
      ) ;
    confess "bad name '$name'" unless $name =~ /^[a-z]\w*(::[a-z]\w*)*$/i ;
    my $kmap = {} ;
    $kmap -> { "${name}::$_" } = $opts { key_map } { $_ }
      for keys %{ $opts { key_map } } ;
    my $rmap = {} ;
    $rmap -> { "${name}::$_" } = $opts { row_map } { $_ }
      for keys %{ $opts { row_map } } ;
    if ( $name =~ /::(\w+)$/ ) { $base = $` ; $name = $1 ; }
    OBB::JSON::Blesser -> Make
      ( base => $base
      , name => $name
      , json => $json
      , key_map => $kmap
      , row_map => $rmap
      ) ;
  }

sub OBB::Mk_blesser
  { my $self = shift ;
    OBB::JSON -> mk_blesser ( @_ ) ;
  }

sub _unbless ;
sub _unbless
  { my $obj = shift ;
    my $res ;
    if ( ! ref $obj or ! _blessed $obj )
      { $res = $obj ; }
    else
      { if ( _addr ( $obj ) =~ /=HASH\(/ )
          { $res  = {} ;
            for my $key ( sort keys %$obj )
              { my $val = $obj -> { $key } ;
                $res -> { $key } = _unbless $val ;
              }
          }
        elsif ( _addr ( $obj ) =~ /=ARRAY\(/ )
          { $res  = [ map { _unbless $_ } @$obj ] ; }
        else
          { die sprintf "can't unbless %s = %s", _addr ( $obj ), ref $obj ; }
      }
    $res ;
  }

sub OBB::Unbless
  { my $self = shift ;
    my $obj = shift ;
    OBB::JSON::_unbless ( $obj ) ;
  }

sub example_json
  { <<'EXAMPLE' ;
{ "recent" :
     [ { "epoch" : "1307095198.77243"
       , "path"  : "authors/RECENT-1h.yaml"
       , "type"  : "new"
       }
     ]
, "meta" :
    { "aggregator" : [ "1h", "6h", "1d", "1W", "1M", "1Q", "1Y", "Z" ]
    , "protocol"   : 1
    , "interval"   : "1d"
    , "Producers"  :
        { "time" : 1307095198.80471
        , "$0" : "/home/mirror/perl5/bin/rrr-server"
        , "File::Rsync::Mirror::Recentfile" : "0.0.8"
        }
    , "filenameroot" : "RECENT"
    , "minmax" :
         { "mtime" : 1307091586
         , "min"   : "1307009184.4988"
         , "max"   : "1307095198.77243"
         }
    , "merged" :
        { "into_interval" : "1W"
        , "epoch" : "1307077006.35826"
        , "time"  : 1307077006.43983
        }
    , "dirtymark"         : "1300184987.04785"
    , "serializer_suffix" : ".json"
    }
}
EXAMPLE
  }

sub example_key_map
  { { 'meta::Producers::$0' => 'dollar0'
    , 'meta::Producers::File::Rsync::Mirror::Recentfile' => 'FRMR'
    } ;
  }

sub example_row_map
  { { 'recent'           => 'event'
    , 'meta::aggregator' => 'interval'
    } ;
  } ;

1 ;