package wmboi;

require 5.005_62;
use strict;
use warnings;
use Data::Dumper;
#use LWP::Simple;

require Exporter;

our @ISA = qw(Exporter);
our %EXPORT_TAGS = ( 'all' => [ qw( ) ] );
our @EXPORT = qw( &wm  &encwm2 &encwm );
our $VERSION = '0.01';

my $some;

BEGIN{
   $some = '(?:.|\n)*?';
}

sub encwm2{
  my %opt=(verbose=>0);
  $Data::Dumper::Indent=2;
  $Data::Dumper::Terse=1;
  $Data::Dumper::Deepcopy=1;
  my $f=shift or die ("Configurations expected\n");
  %opt = (%opt , %{shift(@_)}) if (ref($_[0]) eq "HASH");
  my $r;
  my $o = do($f);
  die($@) if $@;
  for (@$o) {
     next unless $_->{wmboi};
     print("Wm of $_->{name}\{\n") if $opt{verbose};
     if(!-f $_->{wmboi}{file} || 
        (-M $_->{wmboi}{file}) > $_->{wmboi}{validfor}){
           $r=wm(\%opt, from => $_->{name}, %{$_->{wmboi}{conf}});
           open(F,"> $_->{wmboi}{file}") or die;
           print F  Dumper ($r);
           close(F);
     }
     else { print("$_->{wmboi}{file} In cache\n");}
     print("}\n") if $opt{verbose};
  }
}

sub encwm{
  my %opt=(verbose=>0);
  $Data::Dumper::Indent=2;
  $Data::Dumper::Terse=1;
  $Data::Dumper::Deepcopy=1;
  my $f=shift or die ("Configurations expected\n");
  %opt = (%opt , %{shift(@_)}) if (ref($_[0]) eq "HASH");
  my $r;
  my $o = do($f);
  die($@) if $@;
  for (@$o) {
     print("Wm of $_->{file}\{\n") if $opt{verbose};
     if(!-f $_->{file}  or (-M $_->{file}) > $_->{validfor}){
        $r=wm(\%opt, %{$_->{conf}});
        open(F,"> $_->{file}") or die;
        print F  Dumper ($r);
        close(F);
     }
     else { print("$_->{file} In cache\n");}
     print("}\n") if $opt{verbose};
  }
}

sub wm{
   my %opt=(verbose=>0);
   %opt = (%opt , %{shift(@_)}) if (ref($_[0]) eq "HASH");
   my %defaultopc=(tobeadded => {},);
   my %opc=(%defaultopc,@_);

   my @r=();
   for my $url ( ref($opc{url})
                 ?(@{$opc{url}})
                 :($opc{url})){
     
     print("... Wm of $url(\n") if $opt{verbose};
     my $file = getfile($url);
#    my $file = get($url); 
     $file =~ s/$some$opc{beginafter}// if $opc{beginafter};
     $file =~ s/$opc{endwith}$some$//   if $opc{endwith};

     my @inf = aExtract($file,$url);
  
     for(@inf){
        unless( $_->{name} =~ /\w/) { undef $_ ; next };
        my %add=%{$opc{tobeadded}};
        for(keys %{$opc{tobepropagated}}) {
          $add{$opc{tobepropagated}{$_}} = $opc{father}{$_} if $opc{father}{$_}
        }
        $_={%$_,%add};
        $_->{from} = $opc{from} if $opc{from};
        $_->{$opc{follow}{tag} || 'has'} = 
              wm(\%opt,POF=>$_->{name}, 
                     from => $opc{from},
                     father => $_,
                     %{$opc{follow}},
                     url=>$_->{url}) if ($opc{follow});
        push(@r,$_)
     }
     print("  )\n") if $opt{verbose};
   }

   [@r];
}

sub aExtract{            # extract A href=... of the same domain
   my $f = shift;
   my $baseUrl = shift;
   my @i=();

   while($f=~m{
      <a\s[^>]*?
      href=(['"])(.*?)\1
      $some>
      ($some)
      </a>
      }xig)
   { my $name=$3;
     my $url=$2;
     next if $url =~ m/mailto:/;
     next unless(samedom($url,$baseUrl)); 
     push(@i,{ name => normName($name),
               url  => normUrl($url,$baseUrl)});}
   @i;
}

sub dom{                 # returns the domain part of an URL
  my $u = shift;
  if($u =~ m!(https?|ftp)://([^/:]+)!){  $2 }
  else { "" }
}

sub samedom{                  #
  my ($u,$b)=@_;
  dom($u) eq dom($b) or ! dom($u) or  ! dom($b) 
}

sub normUrl{             # Normalise an URL
  my $n=shift;
  my $base=shift;
  $n = "http:$n" if($n =~ m!^//!); 
  unless($n =~ /^(http|ftp):/){ 
     $base =~ s!/[^/]+$!!;
     $n = "$base/$n";}
  $n}

sub normName{ my $n=shift;    # normalise a Name
    $n =~ s/<.*?>//sg; 
    $n =~ s/^\s*//; 
    $n =~ s/\s*$//; 
    $n =~ s/\s+/ /g; 
    $n}

sub getfile{
   my $url = shift;
   `lynx -source $url|recode html..latin1`;
}
1;
__END__

=head1 NAME

wmboi - Perl extension for web-mining based on indexes

=head1 SYNOPSIS

  use wmboi;
  wm( %opt );
  wm( {verbose => 1}, %opt );
  encwm( $conffile , {verbose => 1} );
  encwm( $conffile );
  

=head1 DESCRIPTION

C<Wmboi> was ment to extract structured knowledge from Web sites
with a good structure. The main approach is to traversal indexes and build
a feature-based representation of the item found, based on a configuration
structure.





=head1 EXPORT

 wm

=head1 Example

 @r = wm( url=>'http://alfarrabio.di.uminho.pt/zeca/disc.html', 
          tobeadded=>{
               pof=>'ZecaAfonso',
               isa=>['disco']
          },
          follow=>{ 
              tobeadded=>{
                 isa=>['poema'] 
              }
          }
        )

=head1 List of Wm options

=head1 AUTHOR

jj 

Scripting

=head1 SEE ALSO

perl(1).

=cut
