package CROSS::DMOSS;

use 5.006;
use strict;
use warnings;

=head1 NAME

CROSS::DMOSS - The great new CROSS::DMOSS!

=head1 VERSION

Version 0.01

=cut

our $VERSION = '0.01';

use File::Basename;
use CROSS::DMOSS::Oracle;
use CROSS::DMOSS::Processors;
use CROSS::DMOSS::PostProc;
use Storable qw/store retrieve dclone store_fd fd_retrieve/;
use Data::Dumper;

my $dispatcher = {
	README => {
		proc_readme => 1,
		proc_validate_links => 1,
		proc_check_spelling => 1,
	},
	MAN => {
		proc_man => 1,
		proc_validate_links => 1,
		proc_check_spelling => 1,
	}
};

my $postproc = {
	proc_validate_links => 'post_validate_links',
	proc_check_spelling => 'post_check_spelling',
	proc_verify_license => 'post_verify_license',
};

my $reporters = {
   proc_validate_links => 'report_validate_links',
   proc_check_spelling => 'report_check_spelling',
   proc_verify_license => 'report_verify_license',
   proc_lines => 'report_lines',
   proc_rel_id_doc => 'report_rel_id_doc',
   classify => 'report_classify',
};

=head1 SYNOPSIS

Quick summary of what the module does.

Perhaps a little code snippet.

    use CROSS::DMOSS;

    my $dmoss = CROSS::DMOSS->new($files, $basedir);
    $dmoss->process;
    ...

=head1 EXPORT

A list of functions that can be exported.  You can delete this section
if you don't export anything, such as for a purely object-oriented module.

=head1 METHODS

=head2 new

=cut

sub new {
	my ($class,$files,$basedir) = @_;
	my $self = bless({}, $class);
	$self->{typeof} = {};
	$self->{res} = {};
	$self->{meta} = {};
	
	my $dist = basename $basedir; # XXX

	$self->{meta}->{dist} = $dist;
	if ($dist =~ m/([\d\-\.]+)$/) {
		my $version = $1;
		$version =~ s/^[\-\.]+//;
		if ($version) {
			$self->{meta}->{version} = $version;
		}
	}

	# start with an empty tree
	$self->{tree} = {};

	# init files
	$self->__init_files($files, $basedir);

	return $self;
}

=head2 __init_files

=cut

sub __init_files {
   my ($self, $files, $basedir) = @_;

	my $ora = CROSS::DMOSS::Oracle->new();
   my $tmp = $files;

	foreach (keys %$tmp) {
		my $basename = basename $_;
		my $dirname = dirname $_;
		my $path = $_;
		$path =~ s/$basedir//g;
		$path =~ s/^\/+//g;
		$self->{files}->{$path} = {
				basename => $basename,
				dirname => $dirname,
				fullpath => $_,
				path => $path,
		};
		my $type = $ora->type($self->{files}->{$path});

		if ($type) {
			$self->{files}->{$path}->{typeof} = $type;
			$self->{typeof}->{$path} = $type;
		}

		$self->__add_tree($path, $_);
	}
}

sub __add_tree {
	my ($self, $path, $id) = @_;

	my @l = split /[\\\/]+/, $path; # XXX separator

	my $root = $self->{tree};
	my $next = shift @l;
	while (@l) {
		$root->{$next} = {} unless exists($root->{$next});
		$root = $root->{$next};
		$next = shift @l;
	}
	$root->{$path} = $id;
}

=head2 process

Execute processors.

=cut

sub process {
   my ($self) = @_;
	no strict 'refs';

	# run proceesors for each file
	foreach (keys %{$self->{files}}) {
		my $obj = $self->{files}->{$_};
		my $funcs = $dispatcher->{$obj->{typeof}} if $obj->{typeof};

		# processors for specific file types
		if ($obj->{typeof} and $funcs) {
			foreach my $f (keys %$funcs) {
				my $r = &{"CROSS::DMOSS::Processors::$f"}($self,$obj);
			}
		}

		# processors for all files
      foreach my $f (qw/proc_verify_license proc_lines proc_plain_text proc_func_id/) {
         my $r = &{"CROSS::DMOSS::Processors::$f"}($self,$obj);
      }
	}

	# run post processing functions
	$self->tree_process($self->{tree}, '');
}

=head2 tree_process

=cut

sub tree_process {
	my ($self, $root, $path) = @_;
	no strict 'refs';

	foreach my $k (keys %$root) {
		if (ref($root->{$k}) eq 'HASH') {
			my $curr = $path ? "$path/$k" : $k;
			$self->tree_process($root->{$k}, $curr);
		}
	}

	my $found;
	my @values;
	my $tmp = dclone($self->{res}); # XXX
	foreach my $k (keys %$root) {
		foreach (keys %{$tmp->{$k}}) {
			push @{$found->{$_}}, $tmp->{$k}->{$_} if $tmp->{$k}->{$_};
		}
	}
	foreach (keys %$found) {
		next unless (@{$found->{$_}});
		# TODO
		#next if ($found->{$_}[0]->{__post} and ($found->{$_}[0]->{__post} == 0));
		#print $found->{$_}[0]->{__post}  if ($found->{$_}[0]->{__post} and ($found->{$_}[0]->{__post} == 0));
		my $type = $found->{$_}[0]->{__type};

		my $r;

		my $f = $postproc->{$_};
		if ($f) {
			$r = &{"CROSS::DMOSS::PostProc::$f"}(@{$found->{$_}});
      }
		else {
			if ($type eq 'TERM') {
				$r = &{"CROSS::DMOSS::PostProc::term_join"}($_,@{$found->{$_}});
			}
		}

		my $key_res = $path ? $path : '__PACKAGE__';
      if ($r and %$r) {
         unless ($self->{res}->{$key_res}) {
            $self->{res}->{$key_res} = $r;
         }
         else {
            $self->{res}->{$key_res} = {%{$self->{res}->{$key_res}},  %$r};
         }
		}
	}

}

=head2 addFact

add a new fact

=cut

sub addFact {
	my ($self,$obj,$rel,$value) = @_;

	my $new;
	if (ref($value) eq 'HASH') {
		$new = { __value=>$value, __type=>'ANY', __name=>$rel };
	}
	else {
		$new = { __value=>$value, __type=>'TERM', __name=>$rel };
	}

    #unless ($self->{res}->{$obj->{path}}) {
    #   $self->{res}->{$obj->{path}} = $r;
    #}
    #else {
    #   $self->{res}->{$obj->{path}} = { %{$self->{res}->{$obj->{path}}}, %$r };
    #}

	$self->{res}->{$obj->{path}}->{$rel} = $new if $new;
}

=head2 reporters

=cut

sub reporters {
	my ($self) = @_;

	return $reporters;
}

=head2 dt

down translate

=cut

sub dt {
	my ($self, $f) = @_;

	$self->__dt($self->{tree}, '', $f);
}

sub __dt {
	my ($self, $root, $path, $f) = @_; 
   no strict 'refs';

   foreach my $k (keys %$root) {
      if (ref($root->{$k}) eq 'HASH') {
         my $curr = $path ? "$path/$k" : $k;
         $self->__dt($root->{$k}, $curr, $f);
      }
   }

   my $tmp = dclone($self->{res}); # XXX
   foreach my $k (keys %$root) {
		&$f(dclone($self), $k);
   }

}

=head2 save

store

=cut

sub save {
	my ($self, $file) = @_;
	$file = 'dmoss.data' unless $file;

	store $self, $file;

	return $file;
}

sub to_stdout {
  my ($self) = @_;

  store_fd($self, *STDOUT);
}

=head2 load

load

=cut

sub load {
  my ($file) = @_;
  $file = 'dmoss.data' unless $file;
	
  my $ref = retrieve($file);
  my $self = bless($ref, 'CROSS::DMOSS');

  return $self;
}

sub from_stdout {
  my $ref = fd_retrieve(*STDIN);
  my $self = bless($ref, 'CROSS::DMOSS');
  
  return $self;
}

=head1 AUTHOR

Nuno Carvalho, C<< <smash at cpan.org> >>

=head1 BUGS

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




=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc CROSS::DMOSS


You can also look for information at:

=over 4

=item * RT: CPAN's request tracker (report bugs here)

L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=CROSS-DMOSS>

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/CROSS-DMOSS>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/CROSS-DMOSS>

=item * Search CPAN

L<http://search.cpan.org/dist/CROSS-DMOSS/>

=back


=head1 ACKNOWLEDGEMENTS


=head1 LICENSE AND COPYRIGHT

Copyright 2012 Nuno Carvalho.

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

1; # End of CROSS::DMOSS