#! /usr/bin/perl

use strict ;
use warnings ;
use JSON ;
use YAML ;

my $DEF_JSON_FILE = 'projects.json' ;
my $DEF_YAML_FILE = 'attic.yaml' ;
my $OUT_JSON_FILE = 'attic.json' ;
my %tags  = () ;
  { my $cnt = 1 ;
    for my $tag ( qw(
    name  
    project  
    subproject  
    dist
    stem  
    retired  
    mailnames  
    tracker  
    scm  
    website  
    wiki
    nokeys  
    board  
    description  
    postlude  
  ) ) { $tags { $tag } = $cnt ++ ; }
  }
my %refs  ; $refs { $_ } ++ for qw( nokeys mailnames tracker postlude ) ;
my %arrs  = ( mailnames => 1, tracker => 1 ) ;
my @bools = qw( nokeys ) ;
my %fold = ( description => 1, postlude => 1 ) ;

my $prog = substr $0, rindex ( $0, '/' ) + 1 ;
my $Usage = <<USAGE ;
Usage: $prog [-v] [-q] [-d] [-f] [json [yaml]]
option v : be verbose
option q : be quiet
option d : show debug info
option f : action ; otherwise dry-run
argument json : JSON file ; default $DEF_JSON_FILE
argument yaml : YAML file ; default $DEF_YAML_FILE
writes : $OUT_JSON_FILE
----------------------------------------------------------
USAGE
sub Usage { die "$_[0]$Usage" ; }
sub Error { die "[error] $prog: $_[0]\n" ; }
sub Warn  { 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' ) ;
my %opt = () ; Usage '' unless GetOptions
  ( \%opt, qw(v q d f) ) ;
Usage "Arg count\n" if @ARGV > 1 ;

$opt{v} ||= $opt{d} ;

my $JSON_FILE = shift || $DEF_JSON_FILE ;
my $YAML_FILE = shift || $DEF_YAML_FILE ;

Error "no json file ($JSON_FILE)" unless -f $JSON_FILE ;

sub get_file ($)
  { my $file = shift ;
    open FILE, '<', $file or Error "can't open $file ($!)" ;
    my $res = join '', <FILE> ;
    close FILE ;
    $res ;
  }

sub put_file ($$)
  { my $file = shift ;
    my $text = shift ;
    open FILE, '>', $file or Error "can't write $file ($!)" ;
    print FILE $text ;
    close FILE ;
  }

sub get_json { my $res = from_json get_file $JSON_FILE ; $res ; }
sub get_yaml { my @res = YAML::LoadFile $YAML_FILE ; [ @res ] ; }

sub put_json
  { my $file = shift ;
    my $yaml = shift ;
    put_file $file, JSON::to_json
      ( [ map
            { my $r ; %$r = %$_ ;
              for my $t ( @bools )
                { $r -> { $t } = ( $_ -> { $t } ? JSON::true : JSON::false )
                    if exists $_ -> { $t } ;
                }
              $r ;
            } @$yaml
        ]
      , { pretty => 1, canonical => 1 }
      ) ;
  }

sub stringify ;
sub stringify
  { my $val = shift ;
    my $res = undef ;
    unless ( defined $val )
      { $res = undef ; }
    elsif ( not ref $val )
      { $res = "$val" }
    elsif ( ref $val eq 'ARRAY' )
      { $res = [ map { stringify $_ } @$val ] }
    elsif ( ref $val eq 'HASH' )
      { $res = { map { ( $_ => stringify $val -> { $_ } ) } keys %$val } ; }
    $res ;
  }

sub yaml
  { my $hash = shift ;
    my $res = "---\n" ;
    for my $key ( sort { $tags { $a } <=> $tags { $b } } keys %$hash )
      { my $val = $hash -> { $key } ;
        $val = join "\n", @$val if $key eq 'postlude' ;
        if ( $arrs { $key } )
          { if ( @$val )
              { $res .= sprintf "%s:\n%s"
                  , $key, join '', map { "  - $_\n" } @$val ;
              }
            else
              { $res .= sprintf "%s: []\n", $key ; }
          }
        elsif ( $fold { $key } )
          { my @val = () ;
            for my $val ( split "\n", $val )
              { my $l = '' ;
                my $i = $val =~ /<(li|tr)/ ? '  ' : '' ;
                for my $w ( split ' ', $val )
                  { if ( length "$l $w" > 70 )
                      { push @val, $l ; $l = $i ; }
                    $l .= ( $l eq '' ? '' : ' ' ) . $w ;
                  }
                push @val, $l if length $l ;
              }
            $res .= sprintf "%s: |-\n  %s\n", $key, join "\n  ", @val ;
          }
        else
          { $val = "''" if defined $val and $val eq '' ;
            $res .= sprintf "%s: %s\n", $key, $val ;
          }
      }
    $res ;
  }

my $json = get_json ;
my $yaml = '' ;

for my $hash ( @$json )
  { for my $t ( keys %$hash )
      { my $ref = ref ( $hash -> { $t } ) ;
        Error "unknown tag $t" unless $tags { $t } ;
        Error "unknown ref $t $ref" if $ref and not $refs { $t } ;
      }
    $yaml .= yaml $hash ;
  }

open OUT, '>', $YAML_FILE or Error "can't write $YAML_FILE ($!)" ;
print OUT $yaml ;
close OUT ;
my $YML = get_yaml $YAML_FILE ;
put_json $OUT_JSON_FILE, $YML ;