#! /usr/bin/perl -w

use strict ;
use lib '..' ;
use JSON ;
use Carp ;
use OBB ;

my $prog = substr($0,rindex($0,'/')+1) ;
my $Usage = <<USAGE ;
Usage: $prog [-v] [-q] [-d] infile outfile
option v : be verbose
option q : be quiet
option d : show debug info
option f : action ; otherwise dry-run
----------------------------------------
USAGE
sub Usage { die "$_[0]$Usage" ; }
sub Error { die "$prog: $_[0]\n" ; }
sub Warn  { warn "$prog: $_[0]\n" ; }

# usage: &GetOptions(ARG,ARG,..) defines $opt_ID as 1 or user spec'ed value
# usage: &GetOptions(\%opt,ARG,ARG,..) defines $opt{ID} as 1 or user value
# ARG = 'ID' | 'ID=SPC' | 'ID:SPC' for no-arg, required-arg or optional-arg
# ID  = perl identifier
# SPC = i|f|s for integer, fixedpoint real or string argument

use Getopt::Long ;
Getopt::Long::config('no_ignore_case') ;
our %opt = () ; Usage('') unless GetOptions
  ( \%opt, qw(v q d f c=s) ) ;
Usage("Arg count\n") unless @ARGV == 2 ;

my $SRC = shift ;
my $DST = shift ;
my $TMP = "$DST.tmp" ;
my $OLD = "$DST.old" ;

my @dels = qw(aggregator filenameroot merged dirtymark serializer_suffix) ;
my $json = JSON::decode_json ( OBB::JSON -> example_json ) ;
my $copy = JSON::decode_json ( OBB::JSON -> example_json ) ;
for my $pack ( $json, $copy )
  { delete $pack -> { meta } { $_ } for @dels ; }
my $key_map = OBB::JSON -> example_key_map ;
delete $key_map -> { 'File::Rsync::Mirror::Recentfile' } ;
my $row_map = OBB::JSON -> example_row_map ;
my $blesser = OBB::JSON -> Mk_blesser
  ( $json, 'Foo', key_map => $key_map, row_map => $row_map ) ;
$blesser -> Bless ( $copy ) ;

Error "can't find source $SRC" unless -f $SRC ;

@ARGV = ( $SRC ) ;

sub pref { my @res = map "  $_", @_ ; wantarray ? @res : join "" , @res ; }

open TMP, ">$TMP" or Error "can't write $TMP ($!)" ;

sub revision
  { my $CMD = "svn info -r head .." ;
    open CMD, "$CMD|" or return undef ;
    my $res ;
    while ( <CMD> ) { if ( /^Revision: (\d+)/ ) { $res = $1 ; last ; } }
    grep 0, <CMD> ;
    close CMD ;
    $res ;
  }

my @levels   = @{ OBB::DEF_LEVELS () } ;

my $version  = OBB -> Version ;
my $revision = revision ;
my $date     = gmtime $^T ;
my $years    = sprintf '2013-%d', ( gmtime ) [ 5 ] + 1900 ;
my $levels   = join ' ', @levels ;
my $level    = OBB::DEF_LEVEL  ;
my $reverse  = join ' → ', reverse @levels ;
my $r        = '→' ;
my $D        = '⇒' ;
my $Lopt     = '⟦' ;
my $Ropt     = '⟧' ;
my $OR       = '|' ;
my $Lgrp     = '❪' ;
my $Rgrp     = '❫' ;
my $DTAG     = OBB::Dumper -> DEF_TAG ;

OBB -> Terse ( 1 ) ;

my $dumper = OBB::Dumper -> Make ( prints => 0 ) ;
# print $dumper -> Text ( $dumper ) ;

sub indent
  { my $arg = shift ;
    my $sep = '  ' ;
    join "\n$sep", split /\n/, $arg ;
  }

sub text
  { my $obbj = shift ;
    my @opts = @_ ;
    my $txt = $dumper -> Text ( $obbj, @opts ) ;
    indent $txt ;
  }

sub args
  { my $args = shift ;
    print "text($args)\n" ;
    my $res = eval "text ($args)" ;
    confess $@ if $@ ;
    $res ;
  }

my $Exa0 = do
  { my $code = 'my $y = "aap" ;' ;
    my $val  = eval $code ; die "$code ; $@" if $@ ;
    my $tag  = 'my x' ;
    my $txt  = $dumper -> Text ( $val, tag => $tag ) ;
    indent "$code\n$txt" ;
  } ;

my $Exa1 = do
  { my $code = <<'CODE' ;
# $x -> { key } points to $x

my $x = {} ; $x -> { key } = $x ;
CODE
    my $val  = eval $code ; die "$code ; $@" if $@ ;
    my $tag  = 'my x' ;
    my $txt  = $dumper -> Text ( $val, tag => $tag ) ;
    my $com  = "# \$x -> Dump ( '$tag' )\n" ;
    indent "$code\n$com\n$txt" ;
  } ;

my $Exa2 = do
  { my $code = <<'CODE' ;
# $x points to $A and $B ; $A and $B point to each other

my ( $A, $B ) = ( {}, {} ) ;
$A -> { B } = $B ;
$B -> { A } = $A ;
my $x = { A => $A, B => $B } ;
CODE
    my $val  = eval $code ; die "$code ; $@" if $@ ;
    my $tag  = '$x' ;
    my $txt  = $dumper -> Text ( $val, tag => $tag ) ;
    my $com  = "# \$x -> Dump ( '$tag' )\n" ;
    indent "$code\n$com\n$txt" ;
  } ;

while ( defined ( my $line = <> ) )
  { $line =~ s/%%DUMP\((.*)\)%%/args $1/e ;

    $line =~ s/%VERSION%/$version/go ;
    $line =~ s/%REVISION%/$revision/go ;
    $line =~ s/%DATE%/$date/go ;
    $line =~ s/%YEARS%/$years/go ;
    $line =~ s/%LEVELS%/$levels/go ;
    $line =~ s/%DEF_LVL%/$level/go ;
    $line =~ s/%REVERSE%/$reverse/go ;
    $line =~ s/%DTAG%/$DTAG/go ;
    $line =~ s/%Exa0%/$Exa0/go ;
    $line =~ s/%Exa1%/$Exa1/go ;
    $line =~ s/%Exa2%/$Exa2/go ;
    $line =~ s/->/$r/go ;
    $line =~ s/=>/$D/go ;
    $line =~ s/\[\[/$Lopt/go ;
    $line =~ s/\]\]/$Ropt/go ;
    $line =~ s/\(\(/$Lgrp/go ;
    $line =~ s/\)\)/$Rgrp/go ;
    $line =~ s/\|\|/$OR/go ;
    $line =~ s/%AR%/->/go ;
    $line =~ s/%FC%/=>/go ;
    print TMP $line ;
  }
close TMP ;

unlink $OLD ;
rename $DST, $OLD ;
rename $TMP, $DST or Error "can't rename $TMP, $DST ($!)" ;