#!/usr/bin/perl

use strict;
use warnings;
use AppConfig::Std;
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();

_verbose("Input File: $file");
my $abs  = File::Spec->rel2abs($file);
my $tree = HTML::Seamstress->new_from_file($file) ;
my ($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);
_debug('modpath is ' . $module_path);
my $module_pkg  = "$module_path$name";



_verbose("Compiling $file to $module_pkg in $name.pm in directory\n$path");


my ($content_subs, $content_look_downs) = find_content_subs();
my ($highlander_subs, $highlander_look_downs) = find_highlander_klass();
#my $serial = serialize_html_parse($tree);
my $scalars = sprintf 'my (%s);', join ',', map { '$'.$_ } @scalars;

save_module();
exit;

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

sub save_module {
  open D, ">$module_file" or die $!;
  print D pkg();
}

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 = shift(@ARGV);
  $file or die "must supply file to compile";
  $file =~ /$file_regexp/ or die "$file does not match $file_regexp";
  -e $file or die "$file does not exist";

  $file;
}

sub module_path {

  my ($html_file_path) = @_;

  _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;
    print join('', @_);
    print "\n";
}

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



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


sub find_content_subs {
  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_highlander_klass {
  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 '/') {
      _verbose("\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 pkg { sprintf <<'EOPKG', $module_pkg, $scalars, $abs, $content_look_downs, $highlander_look_downs, $content_subs, $highlander_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;

$tree;
}

# content subs
%s
# highlander 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
