package Skel::Data;

use warnings;
use strict;
# use Data::Dumper;

our(@ISA,@EXPORT);
our %k=();
our %default=();
our %sig=();
my $id = qr{[\w-]+};
our $VERSION = '0.01';
my $debug=0;
my ($OT,$CT);

BEGIN{
  require Exporter;
  @ISA = qw(Exporter);
  our @EXPORT = qw(skzip skzipl sk skinit sknew skimport mkskimport );
  $OT = qr{\[\%\s*};
  $CT = qr{\s*\%\]};
}

sub skzipl{ @{ skzip(@_)}} 
sub skzip{ my ($a,$b)=@_;
 if(ref($b) eq "ARRAY"){  [map {[$a->[$_],$b->[$_]]} 0..@$a-1] }
 else                  {  [map {[$a->[$_],$b]} 0..@$a-1] }
}

sub sk{
 my ($t,@handle)= @_;
 @handle =([]) unless @handle;

 my $res=""; 
 for my $han (@handle){
  my $temp=$k{$t};
  die("no Skell $t\n") unless defined $temp;
#  $han = +{ map { $_+1 => $han->[$_] } (0..@$han-1) } 
#     if ref($han) eq "ARRAY";
  if(not ref($han)){ $han = [$han] }
  if(ref($han) eq "ARRAY"){ $han = 
      +{ map { ($sig{$t}{_order}[$_]=>$han->[$_], $_+1=>$han->[$_]) } (0..@$han-1)}}
  
  my $nov=1;
  while($nov){
   $nov =0;
   $nov += ($temp =~ s/$OT!([\w-]+)$CT/$k{$1}/g);
   $nov += ($temp =~ s/${OT}INCLUDE\s+([\w-]+)$CT/$k{$1}/g);
##   $nov += ($temp =~ s/$OT([\w-]+):(.*?)$CT/_procdirect($1,$2)/ge);
   $nov += ($temp =~ s/$OT([\w-]+)$CT/_op($t,$1,$han)/ge);
   $nov += ($temp =~ s/$OT([\w-]+)\*([\w-]+)$CT/sk($2,@{_opstar($t,$1,$han)})/ge);
   $nov += ($temp =~ s/$OT([\w-]+)\*([\w-]+)\(sep:(.*?)\)$CT/
       join($3, map {sk($2,$_)} @{_opstar($t,$1,$han)})/ge);
  }
  $res .= $temp
 }
 $res;
}

## sub _procdirect{ my ($directive,$val)=@_; }

sub _opstar{ my $r = _op(@_);
  if(ref($r) eq "ARRAY") { return $r }
  #   if   ( @$r and ref($r->[0])) {return $r}
  #   elsif( @$r) {return [ map {[$_]} @$r] }
  #   else { return [] } }
  else                   { return [$r] }
}
sub _op{    ## templateId, varName, Handler
  my ($k,$n,$h)=@_;
##  print STDERR "=====\n$k/$n\n",Dumper($h);
  return $h->{$n}(_n => $n,%$h) if(defined $h->{$n} and ref($h->{$n}) eq "CODE");
  return $h->{$n}      if(defined $h->{$n} and ref($h->{$n}) eq "ARRAY");
  return $h->{$n}                if(defined $h->{$n}                          ); 
  return $default{$k}{$n}(_n=>$n,%$h) 
                                 if(defined $default{$k}{$n} and 
                                    ref($default{$k}{$n}) eq "CODE");
  return $default{$k}{$n}        if(defined $default{$k}{$n});
  return sk($n,$h)               if(defined $k{$n});
  return $h->{-default}(_n=>$n,%$h) if(ref $h->{-default} eq "CODE");
  return $h->{-default}          if(defined $h->{-default});
  return "$n???"             ;
}

sub _opl{
  my ($k1,$k2,%h)=@_;
  print STDERR "OPL:$k1,$k2","\n" if $debug ;
  return "$k1???*$k2"   if(not defined $h{$k1});
  return "$k1*$k2???"   if(not defined $k{$k2});
  return "$k1*$k2?2?"   if(ref($h{$k1}) ne "ARRAY");
  return join("", map { sk($k2, 1 => $_) } @{$h{$k1}});
}

sub skinit{
 my $SKEL;
 if(@_){ for my $file(@_){
            open(F,"<",$file); 
            $SKEL.="\n__IGNORE__\n\n".join("",<F>);
            close F;}}
 else  {    $SKEL =join("",<main::DATA>);}

 $SKEL =~ s/\n__DATA__\n__/\n__DATA__\n\n__/; ## dirty hacking 

 while($SKEL =~ s/__(.*)__\n((.|\n)*?)(?:(?=\n__.*__)|$)//){
   next if $1 eq "DATA" || $1 eq "END" || $1 eq "IGNORE";
   $k{$1}=$2 
 }

 my $changes=1;
 while($changes){$changes=0;
   for(keys %k){ 
      $changes += ($k{$_} =~ s/$OT!($id)$CT/$k{$1}/g); 
      if($k{$_} =~ s/$OT(?:default:)(.*?)$CT//s){ $default{$_}=eval($1);}
   }
 }
 for my $k (keys %k){ 
   $sig{$k}{_order}=[];
   my $t=$k{$k};
#   for($t =~ m/$OT($id)$CT/g){ $sig{$k}{$_}="atomic" }
   while($t =~ m/$OT($id)$CT/g){ 
      push(@{$sig{$k}{_order}},$1) unless  $sig{$k}{$1};
      $sig{$k}{$1}="atomic";
   }
   while($t =~ m/$OT($id)\*($id)\(.*?\)$CT/g){ $sig{$k}{$1}="list($2)";}
   while($t =~ m/$OT($id)\*($id)$CT/g){ $sig{$k}{$1}="list($2)";}
 }
}

sub skimport{
 print STDERR "skimport : (",join(",",@_), ")=\n" if $debug;
 skinit(@_);
 my $class;
 print STDERR "skimport exporting : (",join(",",keys %k), ")=\n" if $debug;

 for my $fun(keys %k){
   no strict 'refs';  
   *$fun = sub{ sk($fun,@_) || undef; }; 
   push (@EXPORT,$fun);
 }
 print STDERR "skimport exporting : (",join(",",@EXPORT), ")=\n" if $debug;
 Skel::Data->export_to_level(1, $class, @EXPORT);
}

sub sknew{
 print STDERR "sknew : (",join(",",@_), ")=\n"  if $debug;
 skinit(@_);

 for my $fun(keys %k){ 
   no strict 'refs';  
   *$fun = sub{my $self=shift; sk($fun,@_) || undef; }; 
 }
 return  bless {} ;
}

sub mkskimport{
 my $r="";
 skinit(@_);
 for my $k(keys %k){
   next if $k eq "SK";
   $r .= "# $k({";
   for(keys %{$sig{$k}}){
       next if /_order/;
       if($sig{$k}{$_} eq "atomic") { 
          $r.= "\n#\t$_ => '__',";}
       elsif($sig{$k}{$_} =~ m{list\((.*?)\)} ) { 
          $r.= "\n#\t$_ => [['". join(", ",@{$sig{$1}{_order}})."'],[...]] ,";}
       else                        { $r.= "\n#\t$_ => [ '__$sig{$k}{$_}'] ,";}
     }
   $r.= "});\n";
   $r .= "## ".join(" ",@{$sig{$k}{_order}})."\n";
 }
 $r
}

1; # End of Skel::Data


__END__

=head1 NAME

Skel::Data - Build and use templates stored in __DATA__ (or file)

=head1 VERSION

Version 0.01



=head1 SYNOPSIS

    use Skel::Data;
    my $foo = skinit
    sk(Template1,...)
    ...
    __DATA__

    __Template1__

    __Template2__

    __END__

=head1 EXPORT

=head1 SUBROUTINES/METHODS

=head2 sk

 sk(templname,$handler* )

=head2 skinit

 skinit()     -- import templates from __DATA__  
 skinit(file) -- import templates from file

For each template use:

 sk(template, handler* ))

=head2 sknew

With C<sknew> you get a method for each template available

 $t = sknew()     -- import templates from __DATA__  
 $t = sknew(file) -- import templates from file 

for each template:

 $t->template(hander* )

=head2 skimport

With C<skimport> you get a function for each template available

 skimport()     -- import templates from __DATA__  
 skimport(file) -- import templates from file

for each template:

 template(handler*)

=head1 Handers

Each hander is HASH-ref mapping a id to a value, a CODE-ref

 [% title %]       is replaced by $handler->{title}
                   or             $handler->{title}()

Alternatively a handler can be a ARRAY-ref and it will correspond
the the field in the order they appear in the template.

=head1 Auxiliar functions

=head2 mkskimport

Generates a skeleton of the perl processor of a template
(see mkskimport script)

=head2 skzip

Zip 2 ARRAY in a single ARRAY of ARRAY

 skzip([1,2,3],[4,5,6]) ---> [[1,4],[2,5],[3,6]]
 skzip([1,2,3], 20) ---> [[1,20],[2,20],[3,20]]

=head2 skzipl

Zip 2 ARRAY in a single list of ARRAY

 skzipl($l1, $l2) = @{skzip($l1,$l2)}

=head1 Format of template

 __DATA__

 __Template1__

 ... [%title%]                   // expand with $handler{title}
 ... [%!Template2%]              // include template "Template2"
 ... [% INCLUDE Template2%]      // include template "Template2"
 ... [%line*Template3%]          // for all @handler{line} 
                 // aply template "Template3"
 ... [%line*Template3(sep:,)%]   // for all @ handler{line} 
                 // aply template "Template3" and join with ","
 ... [%default:{var=>value...}%] // define default values var; value can use
                 // the other values

 __Template2__

 __END__
 ...

The C<default> section is calculated (eval) at skimport time. So if a
calculation depends on the other values, a CODE ref should be used.
These functions receive the provided values as a parameter (HASH of values). 

Example: calculate a full_title, processing the title, author and date. This 
way if a full_title is provided, it is used directl; otherwise it is 
computed from title, author and date.

 [%default:{
   full_title => sub{ my %a=@_;
      my $d= $a{date}     || '\today';
      my $s= $a{author}   || '\mbox{}';
      qq{\\exametitle{$a{title}}{$s}{$d}}}
 }%]

=head1 AUTHOR

J.Joao, C<< <jj at di.uminho.pt> >>

=head1 BUGS

Please report any bugs or feature requests to C<bug-skel-data at rt.cpan.org>, or through
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Skel-Data>.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.


=head1 ACKNOWLEDGEMENTS


=head1 LICENSE AND COPYRIGHT

Copyright 2012 J.Joao.

This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.

See http://dev.perl.org/licenses/ for more information.


=cut