package Skel::Data;

use warnings;
use strict;

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";
  
  my $nov=1;
  while($nov){
   $nov =0;
   $nov += ($temp =~ s/$OT!([\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,@{_op($t,$1,%$han)})/ge);
   $nov += ($temp =~ s/$OT([\w-]+)\*([\w-]+)\(sep:(.*?)\)$CT/
       join($3, map {sk($2,$_)} @{_op($t,$1,%$han)})/ge);
  }
  $res .= $temp
 }
 $res;
}

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

sub _op{
  my ($k,$n,%h)=@_;
  return $h{$n}(_n => $n,%h)     if(defined $h{$n} and ref($h{$n}) eq "CODE");
  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){ 
   my $t=$k{$k};
   for($t =~ m/$OT($id)$CT/g){ $sig{$k}{$_}="atomic" }
   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}}){
       if($sig{$k}{$_} eq "atomic"){ $r.= "\n#\t$_ => '__',";}
       else                        { $r.= "\n#\t$_ => [ '__$sig{$k}{$_}'] ,";}
     }
   $r.= "});\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}()

=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"
 ... [% line*Template3 %]   // for all @ handler{line} aply template "Template3"
 ... [% line*Template3(sep:,) %]    
      // for all @ handler{line} aply template "Template3" and them with join(",")
 ... [%default:{var=>value...}%]            // expand with $handler{title}

 __Template2__

 __END__
 ...

=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 2011 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