package ReDIF::Writer;

##  Copyright (c) 2002,2003 Ivan Kurmanov.  All rights reserved.
##
##  This code is free software; you can redistribute it and/or modify it
##  under the same terms as Perl itself.

##  It is part of ReDIF-perl kit.


use strict;
use Carp::Assert;

use Exporter;

use vars qw( @ISA @EXPORT_OK );

@ISA= qw( Exporter );
@EXPORT_OK = qw( &stringify_template );

=pod

=head1 NAME

ReDIF::Writer - A tool to convert in-memory template representation
into a parseable text string

=head1 SYNOPSIS

 use ReDIF::Writer qw( stringify_template );

 # read a template from somewhere
 my $template = redif_get_next_template ();

 # tweak a template
 $template->{note} = [ "This template has gone through special processing" ];

 # write it out
 my $string = stringify_template( $template );
 print $string;

=cut


use ReDIF::Parser;

my $spec = $ReDIF::Parser::Options{redif_specification};


sub stringify_template {
  my $template = shift;
#  my $special_attributes = shift || 0; # flag
  my $string;

  my $t = $template;

  my $tt = $t->{'template-type'}[0];

  $string = "Template-Type: $tt\n";

  my $tt_context = $spec -> template_type_context( lc $tt );

  assert( $tt_context );
  assert( $tt_context->{KEY} );

  foreach my $attr ( keys %$template ) {
    if(
       ( $attr eq 'template-type' ) 
       or ( $attr eq 'handle' ) 
      ) { next; }

    # rule out upper-case attributes
    if( $attr =~ /[A-Z]/ ) { next; }

    my $v = $t->{$attr};

    if( $tt_context->{SWITCHERS}->{$attr} ) {
     

      my $cluster_type = $tt_context->{SWITCHERS}->{$attr} ;
      my $cluster_context = $spec->context( $cluster_type );

      foreach ( @$v ) {
	$string .= stringify_cluster( $_, $attr, $cluster_context );
      }
    } elsif( $tt_context->{$attr} ) {

      foreach ( @$v ) {
	$string .= "$attr: $_\n";
      }

    } elsif( /^x\-/ ) {

      foreach ( @$v ) {
	$string .= "$attr: $_\n";
      }
      
    } else {
      warn "Unknown attribute '$attr' at a template";

    }

  }

  $string .= "Handle: " . $t->{'handle'}[0] . "\n";

  return $string;
}


sub stringify_cluster {

  my $data = shift;
  my $prefix = shift;
  my $context = shift;

  assert( $data );
  assert( ref( $data ) eq 'HASH' );

  my $string; 

  my $key_attr = $context->{KEY}; 
  assert( $key_attr );

  $string .= $prefix . "-" . $key_attr . ": ". $data->{$key_attr}[0] . "\n";

  foreach my $attr ( keys %$data ) {

    if(
       ( $attr eq $key_attr ) 
      ) { next; }

    my $v = $data->{$attr};

    # rule out upper-case attributes
    if( $attr =~ /[A-Z]/ ) { next; }

#########
    if( $context->{SWITCHERS}->{$attr} ) {

      my $cluster_type = $context->{SWITCHERS}->{$attr} ;
      my $cluster_context = $spec->context( $cluster_type );

      foreach ( @$v ) {
	$string .= stringify_cluster( $_, "$prefix-$attr", $cluster_context );
      }

    } else {

      foreach ( @$v ) {
	$string .= "$prefix-$attr: $_\n";
      }
    }
#########

  }

  return $string;

}




1;
