package CROSS::DMOSS::Processors;

use 5.006;
use strict;
use warnings;

=head1 NAME

CROSS::DMOSS::Processors - processor functions

=head1 VERSION

Version 0.01

=cut

our $VERSION = '0.01';

use File::Basename;
use File::Slurp qw/read_file/;
use URI::Find;
use Data::Dumper;
use HTML::FormatText::Html2text;
use File::Comments;
use Text::Aspell;
use HTTP::Request;
use LWP::UserAgent;

=head1 SYNOPSIS

Quick summary of what the module does.

Perhaps a little code snippet.

    use CROSS::DMOSS;


=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 SUBROUTINES/METHODS

=head2 proc_readme

=cut

sub proc_readme {
	my ($dmoss,$obj) = @_;

	my $res = {};
	my $content = read_file $obj->{fullpath};

	my @words = ('offical site', 'website', 'homepage', 'web site','more information');
	my $website = __find_url([split /\n/, $content], \@words);
	if ($website) {
		$dmoss->addFact($obj,'website', $website);
	}

	return $res;
}

sub __find_url {
   my ($source, $words) = @_;

   my $url;
   my $finder = URI::Find->new(sub { $url = shift; });

   foreach my $i (@$source) {
      foreach my $j (@$words) {
         if ($i =~ m/$j/i) {
            $finder->find(\$i);
         }
      }
   }

   return $url;
}

=head2 proc_man

=cut

sub proc_man {
	my ($dmoss,$obj) = @_;

	my $res = {};
   my $content = `man $obj->{fullpath} | col -b`;

   #if ($content =~ m/(NOM|NAME)\n\s*(.*?)\n\n/s) {
   if ($content =~ m/(NAME)\n\s*(.*?)\n\n/s) {
   	my ($name, $abstract) = split /\s+\-\s+/, $2;
		$dmoss->addFact($obj,'name',$name);
		$dmoss->addFact($obj,'abstract',$abstract);
	}

   #if ($content =~ m/(SEE ALSO|VOIR AUSSI)\n\s*(.*?)\n\n/s) {
   if ($content =~ m/(SEE ALSO)\n\s*(.*?)\n\n/s) {
		my $l = $2;
		my @l;
		while ($l =~ m/(\w+)\(.*?\)/g) {
			push @l, $1;
		}
		$dmoss->addFact($obj,'see_also',[@l]);
	}
	
	if ($obj->{fullpath} =~ m/\d\.(\w\w)$/) {
		$dmoss->addFact($obj,'lang',$1);
	}

   return $res;
}

=head2 proc_html

=cut

sub proc_html {
   my ($dmoss,$obj) = @_;

	my $res = {};
	$res->{html} = read_file $obj->{fullpath};
	$res->{text} = HTML::FormatText::Html2text->format_file($obj->{fullpath});

	return $res;
}

=head2 proc_comments

=cut

sub proc_comments {
	my ($dmoss, $obj) = @_;

	my $snoop = File::Comments->new();

	my $res = {};
	#$res->{comments} = $snoop->comments($obj->{fullpath});
	$dmoss->addFact($obj,'comments',$snoop->comments($obj->{fullpath}));
	
	return $res;
}

=head2 proc_validate_links

=cut

sub proc_validate_links {
   my ($dmoss, $obj) = @_;
   my $content  = read_file $obj->{fullpath};

   my $res = {};
   my $finder = URI::Find->new(
         sub {
            my ($uri, $orig_uri) = @_;
				return if ($orig_uri =~ m/(localhost|hostname|localdomain)/i);
				$res->{$orig_uri} = __test_link($orig_uri);

         }
      );
   $finder->find(\$content);

   $dmoss->addFact($obj,'proc_validate_links',$res) if $res;
}

sub __test_link {
   my $url = shift;
return 1; # XXX

   my $request = HTTP::Request->new(GET => $url);
   my $ua = LWP::UserAgent->new;
   my $response = $ua->request($request);

   if ($response->is_success) { return 1; }
   else { return -1; }
}

=head2 proc_check_spelling

=cut

sub proc_check_spelling {
   my ($dmoss,$obj) = @_;
   my $content  = read_file $obj->{fullpath};
	return if ($obj->{basename} =~ m/fr$/i);

   my $speller = Text::Aspell->new;
   my $res = {};
	foreach (split /\s+/, $content) {
		$res->{total}++;
		$res->{ok}++ if $speller->check($_);
	}

   $dmoss->addFact($obj,'proc_check_spelling',$res) if $res;
}

=head2 proc_verify_license

=cut

sub proc_verify_license {
   my ($dmoss,$obj) = @_;
   my $content  = read_file $obj->{fullpath};

	return unless ($content =~ m/(license|license|copyright)/i);

	my $lic;
	if ($content =~ m/(GNU General Public License)/i) {
		$lic = 'GNU General Public License';
	}

   $dmoss->addFact($obj,'proc_verify_license',$lic) if $lic;
}

=head2 proc_lines

=cut

sub proc_lines {
   my ($dmoss,$obj) = @_;

   my $res = {};
   my $snoop = File::Comments->new;
	my $c = $snoop->comments($obj->{fullpath});

	my $total = 0;
	my $return = `wc -l $obj->{fullpath}`;
	if ($return =~ m/(\d+)/) { $total = $1 }
	my $comments = 0;
	$comments = @$c if $c;

	$res->{total} = $total;
	$res->{comments} = $comments;

   $dmoss->addFact($obj,'proc_lines',$res) if $res;
}

=head2 proc_plain_text

=cut

sub proc_plain_text {
   my ($dmoss,$obj) = @_;
	my $typeof = $obj->{typeof};
	return unless $typeof;

	open TARGET, '>>', '/tmp/full_plain_text.txt';
	if ($typeof =~ m/(readme|install)/i) {
   	my $content  = read_file $obj->{fullpath};
		print TARGET $content;
	}
	if ($typeof =~ m/html/i) {
		# XXX
	}

	close TARGET;
}

=head2 proc_func_id

=cut

sub proc_func_id {
   my ($dmoss,$obj) = @_;
   my $typeof = $obj->{typeof};
   return unless $typeof;

   open TARGET, '>>', '/tmp/full_func_id.txt';
   if ($typeof =~ m/c_source/i) {
		my $res = `conc_icollector $obj->{fullpath}`;
		my @l = split /\n/, $res;
		foreach (@l) {
			if ($_ =~ m/^P\((.*?)\)/) {
				print TARGET "$1\n";
			}
		}
   }

   close TARGET;
}

=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