#!/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 $file = initialize();
_verbose("Input File: $file");
my $abs  = File::Spec->rel2abs($file);
my $tree = HTML::Seamstress->new_from_file($file) ;
my $docroot = calc_docroot();
_verbose("Document Root: $docroot");
my ($name, $path, $suffix) = fileparse($abs, qr/[.]html?/);
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$abs");


my ($content_subs, $look_downs) = find_content_subs();
my $serial = serialize_html_parse($tree);


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);
  -e $file or die "$file does not exist";
  $file;
}

sub module_path {

  my ($html_file_path) = @_;

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

  return undef unless $mp;

  my @piece = split '/', $mp;
  shift @piece;
  my $module_path = join '::', @piece;
  $module_path .= '::';
}

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 'my $%s = $tree->look_down(id => q/%s/)', $_, $_ 
    } @scalar;
  

  ($content_subs, $look_downs)
}

sub calc_docroot {

  _verbose('Calculating docroot');

  my $cfg = 'seamc.cfg';

  my $cwd = 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_content_sub { sprintf <<'EOK', ($_[0]) x 4 }

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

}

EOK
  

sub pkg { sprintf <<'EOPKG', $module_pkg, $look_downs, $content_subs, $abs, $serial }
package %s;
use strict;
use warnings;
use base qw(HTML::Seamstress);

use vars qw($tree);
tree();

# content_accessors;
%s;

# content subs
%s

# the html file %s
sub tree {
# serial
%s
}


1;

EOPKG

=head1 NAME

seamc - compile HTML files for HTML::Seamstress manipulation

=head1 SYNOPSIS

 seamc [options] html_file

=head1 OPTIONS

=over

=item * 

=back
