#!/usr/bin/perl

use strict;
use warnings;
use AppConfig::Std;
use Carp qw(croak carp confess cluck);
use Cwd;
use HTML::Seamstress;
use File::Basename;
use File::Spec;
use Data::Dumper;

our $VERSION = 1.0;



my $config;
my $program;
my @scalars;

my $file_regexp = qr/[.]html?/;

my @file = initialize();

my $CWD = cwd;

for my $file (@file) {

  chdir $CWD;

  _verbose("Input File: $file");
  _debug  ("cwd: " . cwd());

  my $abs  = File::Spec->rel2abs($file);
  my $tree = HTML::Seamstress->new_from_file($file) ;
  my ($name, $path, $suffix) = fileparse($abs, $file_regexp);
  _verbose("$name, $path, $suffix) = fileparse($abs, $file_regexp);");
  my $docroot = calc_docroot($path);

  _verbose("Document Root: $docroot");
  my $module_file = "$path$name.pm";
  my $module_path = module_path($path, $docroot);

  _debug('modpath is ' . $module_path);
  my $module_pkg  = "$module_path$name";


  _verbose("Compiling\n\tfile: $file\n\tto module: $module_pkg\n\tin file $module_file\n\tin directory $path");
  my ($content_subs, $content_look_downs) = find_content_subs($tree);
  my ($highlander_subs, $highlander_look_downs) = find_highlander_klass($tree);
  my ($iter_subs, $iter_look_downs) = find_iter_klass($tree);
  my ($dual_iter_subs, $dual_iter_look_downs) = find_dual_iter_klass($tree);

  #my $serial = serialize_html_parse($tree);
  my $scalars = sprintf 'my (%s);', join ',', map { '$'.$_ } @scalars;

  save_module($module_file,
	      $tree, $module_pkg, $scalars, $abs, $content_look_downs, $highlander_look_downs, $iter_look_downs, 
	      $dual_iter_look_downs, $content_subs, $highlander_subs, $iter_subs, $dual_iter_subs
	     );

}

exit;

# subs ------------------------------------------------------------------ 

sub save_module {

  my $module_file = shift or die 'must supply module file';

  my ($tree, $module_pkg, $scalars, $abs, $content_look_downs, $highlander_look_downs, $iter_look_downs, $dual_iter_look_downs, $content_subs, $highlander_subs, $iter_subs, $dual_iter_subs  ) = @_;
  open D, ">$module_file" or die $!;
  print D pkg($tree, $module_pkg, $scalars, $abs, $content_look_downs, $highlander_look_downs, $iter_look_downs, $dual_iter_look_downs, $content_subs, $highlander_subs, $iter_subs, $dual_iter_subs  ) ;
}

sub initialize {

  my $config_file;
  my $HOME;
  ($program = $0) =~ s!^.*/!!;

  $HOME = $ENV{'HOME'} || (getpwuid($<))[7];
  $config = AppConfig::Std->new();


  $config->define('debug!');

  $config->args
    or die sprintf "run %s -help to see valid options\n", $program ;


  #  $docroot = cwd; #File::Spec->rel2abs()

  _verbose(sprintf "$program v%.2f", $VERSION);

  my @file = @ARGV;
  for (@file) {
    /$file_regexp/ or die "$_ does not match $file_regexp";
  }

  _debug("Files to compile: @file");

  @file;
}

sub module_path {

  my ($html_file_path, $docroot) = @_;

  _debug("substr($html_file_path, length $docroot) ;");
  my $mp = substr($html_file_path, length $docroot) ;

  return undef unless $mp;

  _debug("mp: $mp");
  $mp =~ s!/!::!g;
  $mp;
}

sub _verbose
{
    return unless $config->verbose or $config->debug;
    warn join('', @_);
    warn "\n";
}

sub _debug
{
    return unless $config->debug;
    warn join('', @_);
    warn "\n";
}



sub serialize_html_parse {
  my $tree = shift;
  my $module_pkg = shift or die;
  $Data::Dumper::Purity = 1;
  our $serial = Data::Dumper->Dump([$tree], ['tree']);
  $serial =~ s/HTML::Seamstress/$module_pkg/;
  $serial;
}


sub find_content_subs {
  my $tree = shift;
  my @content_sub;
  my @klass_content = $tree->look_down(klass => 'content') ;
  _verbose( "found " . @klass_content . ' content nodes ' );

  my @scalar = map { 
    my $id = $_->attr('id');
    push @content_sub, make_content_sub($id);
    $id
  } @klass_content;

  my $content_subs = join "\n", @content_sub;

  my $look_downs = join ";\n",
    map { 
      sprintf '$%s = $tree->look_down(id => q/%s/)', $_, $_ 
    } @scalar;
  
  push @scalars, @scalar;

  ($content_subs, $look_downs)
}

sub find_iter_klass {
  my $tree = shift;

  my @sub;
  my @klass_content = $tree->look_down(klass => 'iter') ;
  _verbose( "found " . @klass_content . ' iter nodes ' );

  my @scalar = map { 
    my $id = $_->attr('id');
    push @sub, make_iter_sub($id);
    $id
  } @klass_content;

  my $subs = join "\n", @sub;

  my $look_downs = join ";\n",
    map { 
      sprintf '$%s = $tree->look_down(id => q/%s/)', $_, $_ 
    } @scalar;
  
  push @scalars, @scalar;

  ($subs, $look_downs)
}

sub find_dual_iter_klass {
  my $tree = shift;

  my @sub;
  my @klass_content = $tree->look_down(klass => 'dual_iter') ;
  _verbose( "found " . @klass_content . ' dual iter nodes ' );

  my @scalar = map { 
    my $id = $_->attr('id');
    push @sub, make_dual_iter_sub($id);
    $id
  } @klass_content;

  my $subs = join "\n", @sub;

  my $look_downs = join ";\n",
    map { 
      sprintf '$%s = $tree->look_down(id => q/%s/)', $_, $_ 
    } @scalar;
  
  push @scalars, @scalar;

  ($subs, $look_downs)
}

sub find_highlander_klass {
  my $tree = shift;

  my @highlander_sub;
  my @klass_content = $tree->look_down(klass => 'highlander') ;
  _verbose( "found " . @klass_content . ' highlander nodes ' );

  my @scalar = map { 
    my $id = $_->attr('id');
    push @highlander_sub, make_highlander_sub($id);
    $id
  } @klass_content;

  my $highlander_subs = join "\n", @highlander_sub;

  my $look_downs = join ";\n",
    map { 
      sprintf '$%s = $tree->look_down(id => q/%s/)', $_, $_ 
    } @scalar;
  
  push @scalars, @scalar;

  ($highlander_subs, $look_downs)
}

sub calc_docroot {

  my $html_file_dir = shift;

  _verbose('Calculating docroot');

  my $cfg = 'seamc.cfg';

  my $cwd = $html_file_dir;

  chdir $cwd;

  {
    _verbose("\t" . cwd);
    if (-e $cfg) {
      _verbose("\t$cfg found in " . cwd);
      return cwd . '/';
    }

    if (cwd eq '/') {
      die ("\t$cfg not found");
      return $cwd . '/';
    }

    chdir '..';
    redo;
  }


}

sub make_highlander_sub { sprintf <<'EOK', ($_[0]) x 4 }

sub %s {
   my $class = shift;
   my $aref = shift;
   my $local_root_id = '%s';

   if ($aref) {
      $%s->highlander($local_root_id, $aref, @_);
      return $tree
   } else {
      return $%s
   }

}

EOK
  
sub make_content_sub { sprintf <<'EOK', ($_[0]) x 4 }

sub %s {
   my $self = shift;
   my $content = shift;
   if (defined($content)) {
      $%s->content_handler(%s => $content);
      return $tree
   } else {
      return $%s
   }

}

EOK

sub make_iter_sub { sprintf <<'EOK', ($_[0]) x 4 }

sub %s {
   my $tree = shift;
   if (@_) {
      $%s->iter(@_);
      return $tree
   } else {
      return $%s
   }

}

EOK

sub make_dual_iter_sub { sprintf <<'EOK', ($_[0]) x 3 }

sub %s {
   my $tree = shift;
   if (@_) {
      $%s->dual_iter(\@_);
      return $tree
   } else {
      return $%s
   }

}

EOK
  

sub pkg { my ($tree, $module_pkg, $scalars, $abs, $content_look_downs, $highlander_look_downs, $iter_look_downs, $dual_iter_look_downs, $content_subs, $highlander_subs, $iter_subs, $dual_iter_subs  ) = @_;
  sprintf <<'EOPKG', $module_pkg, $scalars, $abs, $content_look_downs, $highlander_look_downs, $iter_look_downs, $dual_iter_look_downs, $content_subs, $highlander_subs, $iter_subs, $dual_iter_subs  }
package %s;
#use strict;
use warnings;
use base qw(HTML::Seamstress);

my $tree;

#%s
sub new {
$tree = __PACKAGE__->new_from_file('%s');

# content_accessors
%s;

# highlander_accessors
%s;

# iter_accessors
%s;

# dual_iter_accessors
%s;

$tree;
}

# content subs
%s
# highlander subs
%s
# iter subs
%s

# dual_iter subs
%s

sub tree {
  $tree
}


1;

EOPKG

=head1 NAME

seamc - compile HTML files for HTML::Seamstress manipulation

=head1 SYNOPSIS

 seamc [options] html_file

=head1 OPTIONS

=over

=item * 

=back
