#! c:/perl/bin/perl

use strict;
use UNIVERSAL qw(isa);
use HTML::TreeBuilder;
use vars qw(%htmlList $nodeNbr);
$" = "\n";

# Subroutine to create a list of nodes for a given file
sub retHtmlList {
my $fileName = shift; 
my $tree = HTML::TreeBuilder->new; # empty tree

    	
	#Initialize
	undef %htmlList;
	$nodeNbr = 0;
	
	# Parse the html file
	$tree->parse_file($fileName);

	# Listify the nodes 
	# The traversal of the tree is in a depth first fashion
	$tree->traverse(\&makeList,0);

	# Now that we're done with it, we must destroy it.
	$tree = $tree->delete;

	return %htmlList;
}

# Subroutine to create a list of nodes for a given tree
sub retHtmlListFromTree {
my ($tree) = @_;

	#Initialize
	undef %htmlList;
	$nodeNbr = 0;
	
	# Listify the nodes 
	# The traversal of the tree is in a depth first fashion
	$tree->traverse(\&makeList,0);

	# Now that we're done with it, we must destroy it.
	#$tree = $tree->delete;

	return %htmlList;
}

# Subroutine to create a tree for a given file
sub retHtmlTree {
my $file_name = shift; 
my $tree = HTML::TreeBuilder->new; # empty tree

	# Parse the html file
	$tree->parse_file($file_name);

	return $tree;
}

# Subroutine to create a list of nodes for a given document
sub retHtmlDocList {
my $document = shift; 
my $tree = HTML::TreeBuilder->new; # empty tree

	# Parse the html document 
	$tree->parse($document);

	# Listify the nodes 
	$tree->traverse(\&makeList,0);

	# Now that we're done with it, we must destroy it.
	$tree = $tree->delete;

	return %htmlList;
}

# Subroutine to create a tree for a given document
sub retHtmlDocTree {
my $document = shift; 
my $tree = HTML::TreeBuilder->new; # empty tree

	# Parse the html document
	$tree->parse($document);

	return $tree;
}
	
# Subroutine to display the tree 
sub showTree {
my ($node, $start, $depth ) = @_;

	$nodeNbr++;

	# Check to see if its an element
	if (ref $node)
	{
		# Process if its an entry node
		if ($start)
		{
			print "Nbr: $nodeNbr " . " " . $depth . " "  x $depth . $node->tag . "\n";
		}
		else
		{
			print "Nbr: $nodeNbr " . " " . $depth . " " x $depth . "\\" . $node->tag . "\n";
		}
	} 
	else
	{
		print "Nbr: $nodeNbr " . " " . $depth . " " x $depth . ":$node:\n"; 
	}
}

# Subroutine to create a list of nodes 
sub makeList {
my ($node, $start, $depth ) = @_;
	
	$nodeNbr++;

	# Check to see if its an element
	if (ref $node)
	{
		# Process if its an entry node
		if ($start) 
		{
			#$htmlList{$nodeNbr} =  " " x $depth . $node->tag . "\n";
			$htmlList{$nodeNbr} = $node->tag;
			
               	}
               	else
               	{
			#$htmlList{$nodeNbr} =  " " x $depth . "\\" . $node->tag . "\n";
			$htmlList{$nodeNbr} =  $node->tag;
		}
	}
	else
	{
		#$htmlList{$nodeNbr} =  " " x $depth . qq{$node\n}; 
		$htmlList{$nodeNbr} = qq{$node}; 
	}
}

# Subroutine print a list of nodes
sub showList {
my $totNodes = scalar (keys %htmlList);
my $i;

	for ($i=1; $i <= $totNodes; $i++)
	{
		print $htmlList{$i};
	}
}

# Subroutine to get information of the nodes from the tree
sub getNodeInfo {
my ($tree, $nodeNum) = @_;
my $nodeParent;
my $nodeParentDepth;
my $nodePtr;
my $nodeDepth;
my $tagSeq;
my $levels = 0;
my $fanout;
	
	
	$nodeNbr=0;
	

	$tree->traverse(sub { 
				my ($node, $start, $depth ) = @_; 
				$nodeNbr++; 
				if ($nodeNbr < $nodeNum)
				{
				      # convert any text in the node's content list into node
				      if ( $start )
				      {
					$node->objectify_text();
				      }
				      else
				      {
				      	if ( ($node->tag) eq '~text')
				      	{
				      	  $nodeNbr--;
				      	}
				      }
				}
				if ($nodeNbr == $nodeNum) 
				{
				   my $done = 0;
				   my $h = $node->parent;
				   my $first = 1;
				  			
				  	# get the fan-out of the parent with fanout > 1
					while (!($done))
					{
						my @children = $h->content_list;
						my $numChildren = $#children+1;
						
						if ( $numChildren <= 1)
						{
						  if ( $first )
						  {
						  	$first = 0;
						  }
						  $h = $h->parent;    
						  $levels++;
						}
						else
						{
						  $done = 1;
						  $fanout = $numChildren;
						}
					}
					
					print" ";
				}
					
				if (ref $node && $nodeNbr < $nodeNum)
				{
					$nodeParentDepth=$depth;
					$nodeParent=\$node;
					
				}
				else 
				{
					if ($nodeNbr == $nodeNum)
					{
						$nodeDepth=$depth;
					}
				}
			},0);

	# Check to see if the parent we chose is a false parent
	if ($nodeParentDepth == $nodeDepth) 
	{
		$nodeParent=\$$nodeParent->parent;
	} 

	# Get the tag sequence
	$tagSeq = $$nodeParent->tag;
	$nodePtr = \$$nodeParent->parent;
	while (ref $$nodePtr) 
	{
		$tagSeq=$$nodePtr->tag . ";" . $tagSeq;	
		$nodePtr=\$$nodePtr->parent;
	} 	

	return $tagSeq, $nodeDepth, $fanout, $levels;
	
}

sub oldidentifyNode {
	my ($tree, $targetDepth, $targetTagSeq, $type, $keywords, $omitwords) = @_;
	my @nodeHashRefs;
	my $nodeHashRef;
	my $nodeNum;
	my $nodeRef;
	my $nodePtr;
	my $tagSeq;
	my $keywordPresent;
	my @keywords;
	my $omitwordPresent;
	my @omitwords;
	my @children;
	my @extractedNodes;
	my $isDesiredType;
	$nodeNbr=0;

	# Get all the parent nodes in a hash of (targetDepth-1)
	$tree->traverse(sub { 
							my ($node, $start, $depth ) = @_;
							$nodeNbr++;
							if (ref $node && $start && $depth == ($targetDepth-1) )
							{
								my %nodeHash;
								$nodeHash{"NodeNbr"}=$nodeNbr;
								$nodeHash{"NodeRef"}=\$node;
								push @nodeHashRefs, \%nodeHash;
							}
							else
							{
								print "";
							}
						},0);

	
	# Now identify the child node using the tag sequence
	foreach $nodeHashRef (@nodeHashRefs) {
		$nodeNum=$nodeHashRef->{"NodeNbr"};
		$nodeRef=$nodeHashRef->{"NodeRef"};
		$tagSeq="";
		$tagSeq=$$nodeRef->tag;
		$nodePtr=\$$nodeRef->parent;
		while (ref $$nodePtr) {
			$tagSeq=$$nodePtr->tag . ";" . $tagSeq;	
			$nodePtr=\$$nodePtr->parent;
		} 	

		if ($tagSeq eq $targetTagSeq) {
			$nodeNbr=($nodeNum-1);

			# Get the correct node number of the child
			$$nodeRef->traverse(sub { 
									my ($node, $start, $depth ) = @_; 
									$nodeNbr++;
									$keywordPresent=1;
									$omitwordPresent=0;
									$isDesiredType=1;
									if (!ref $node && $depth == 1 ) {

										# Check for the desired type
										if ($type eq 'N') {
											$isDesiredType = 0 if not ($node =~ /^[\d|'.']+$/);
											#printf ("In N Type=%s, Text=:%s: Passed=%d\n",$type, $node, $isDesiredType);
										} elsif ($type eq 'A') {
											$isDesiredType = 0 if not ($node =~ /^[a-z|A-Z|' ']+$/);
											#printf ("In A Type=%s, Text=:%s: Passed=%d\n",$type, $node, $isDesiredType);
										}
											
										# Check for the presence of keywords
										if (length $keywords > 0) {
											$keywordPresent = 0;
											@keywords=split /;/, $keywords;

											foreach (@keywords) {
												# Handle keywords with $ character 
												$_ =~ s/\$/\\\$/;
												if (length $_ > 0 and $node =~ /$_/) {
													$keywordPresent=1;	
												}

												last if $keywordPresent == 1;
											}
										}

										# Check for the presence of omitwords
										if (length $omitwords > 0) {
											$omitwordPresent = 0;
											@omitwords=split /;/, $omitwords;

											foreach (@omitwords) {
												# Handle omitwords with $ character 
												$_ =~ s/\$/\\\$/;
												if (length $_ > 0 and $node =~ /$_/) {
													$omitwordPresent=1;	
												}

												last if $omitwordPresent == 1;
											}
										}

										# Accept the node only if the keywords are 
										# present and omitwords are absent and
										# the text of the node is of the desired type
										if ($keywordPresent == 1 && 
											$omitwordPresent == 0 &&
											$isDesiredType == 1) {	
											my %extractedNode;
											$extractedNode{"NodeNum"}=$nodeNbr;
											$extractedNode{"Text"}=$node;
											push @extractedNodes, \%extractedNode;
										}

									} else {
										print "";
									}
								},0);
		}
	}

	return @extractedNodes;
} 

# subroutine to identify nodes satisfying learnt rules
sub identifyNode {
my ($tree, $depthRef, $tagSeqRef, $type, $keywords, $omitwords, $fanout, $treeLevel, $fanoutAdj, $beginsWith, $endsWith, $preceededBy, $followedBy) = @_;
my @depth = @$depthRef;
my @tagSeq = @$tagSeqRef;
my $targetDepth;
my $targetTagSeq;
my @nodeHashRefs;
my $nodeHashRef;
my $nodeNum;
my $nodeRef;
my $nodePtr;
my $tagSeq;
my $keywordPresent;
my @keywords;
my $omitwordPresent;
my @omitwords;
my @children;
my @extractedNodes;
my $isDesiredType;
my @levels;
my @fanout;
my $i;
my $key;
my $saveNode = 0;
my $done = 0;
my $j = 0;
my $found = 0;
my $modifiedNode;

	$nodeNbr=0;
		
	# Get the level values
	@levels = split /;/, $treeLevel;
			
	# delete duplicate level values
	my @sortLevels = sort @levels;
	foreach $i (0..$#sortLevels )
	{
	  if ( ($i+1) <= $#sortLevels)
	  {
	     $done = 0;
	     my $j = $i+1;
	        while (!($done))
	        {
	  		if ( $sortLevels[$i] == $sortLevels[$j] )
	  		{
	  		   
	  		    #delete $levels[$i+1];
	  		    undef $sortLevels[$i+1];
	  		    $j++;
	  		    
	  		    if (!( ($j) <= $#sortLevels))
	  		    {
	  		    	$done = 1;
	  		    }
	  		}
	  		else
	  		{
	  		   $done = 1;
	  		}
	  	}
	    }
		
	}
	
		
	# Get all the parent nodes in a hash of (targetDepth-1)
	my %nodeNbrHash;
	my $treeToTraverse;
	
	$nodeNbr = 0;
	$j = 0;
	foreach (@depth)
	{
	   $targetDepth = $depth[$j];
	   $targetTagSeq = $tagSeq[$j];
		foreach $i (0..$#sortLevels)
		{
		  my $level = $sortLevels[$i];
		  if ( defined $level )
		  {

		      $nodeNbr = 0;
		      $treeToTraverse = $tree;
		      $treeToTraverse->traverse(sub { 
				my ($node, $start, $depth ) = @_;
				
					$nodeNbr++;
					
					# mark the node at this level to be saved
					my $depthCmp = $targetDepth-$level-1;
					if (ref $node && $start && $depth == $depthCmp) 
					{
					      	my $h = $node;
						my @children = $h->content_list;
						my $numChildren = $#children + 1;
						if ($numChildren >= $fanout and $numChildren <= ($fanout + $fanoutAdj) )
						{
							$saveNode = 1;
							
						}
						else
						{
							$saveNode = 0;
						}
					  }
					  
					  if ( ref $node && $start && ($depth == ($targetDepth-1)) && $saveNode ) 
					  {
						my %nodeHash;
						my $h = $node;
						
							$nodeHash{"NodeNbr"} = $nodeNbr;
							$nodeHash{"NodeRef"} = \$h;
							if (not exists $nodeNbrHash{$nodeNbr})
							{
							       $nodeNbrHash{$nodeNbr} = \%nodeHash;
							       push @nodeHashRefs, \%nodeHash;
							}
							return 1;

					  }
					  else 
					  {
					  	return 1; 
					  }
					  
					
				},0);
				
		}#if defined
	    }#end foreach $i
	    
	# Now identify the child node using the tag sequence
	foreach $nodeHashRef (@nodeHashRefs)
	{
		$nodeNum = $nodeHashRef->{"NodeNbr"};
		$nodeRef = $nodeHashRef->{"NodeRef"};
		$tagSeq = "";
		$tagSeq = $$nodeRef->tag;
		$nodePtr = \$$nodeRef->parent;
		while (ref $$nodePtr)
		{
			$tagSeq=$$nodePtr->tag . ";" . $tagSeq;	
			$nodePtr=\$$nodePtr->parent;
		} 	

                $found = 0;
                $modifiedNode = " ";
		if ($tagSeq eq $targetTagSeq)
		{
		  	$nodeNbr = ($nodeNum - 1);

			# Get the correct node number of the child
			$$nodeRef->traverse(sub { 
							my ($node, $start, $depth ) = @_; 
							$nodeNbr++;
							$keywordPresent=1;
							$omitwordPresent=0;
							$isDesiredType=1;
							if (!ref $node && $depth == 1 )
							{

								# Check for the desired type
								if ($type eq 'N') 
								{
									$isDesiredType = 0 if not ($node =~ /^[\d|'.']+$/);
								}
								elsif ($type eq 'A') 
								{
									$isDesiredType = 0 if not ($node =~ /^[a-z|A-Z|' ']+$/);
								}

								# Check for the presence of keywords
								if (length $keywords > 0)
								{
									$keywordPresent = 0;
									@keywords = &separateConditions($keywords);

									foreach (@keywords) 
									{
										# Handle keywords with $, ( character 
										$_ = &handleSpecialCharacters($_);
																				
										if (length $_ > 0 and $node =~ /$_/) 
										{
											$keywordPresent=1;	
										}

										last if $keywordPresent == 1;
									}
								}

								# Check for the presence of omitwords
								if (length $omitwords > 0)
								{
									$omitwordPresent = 0;
									@omitwords = &separateConditions($omitwords);

									foreach (@omitwords)
									{
										# Handle omitwords with $ character 
										$_ = &handleSpecialCharacters($_);
																				
										if (length $_ > 0 and $node =~ /$_/)
										{
											$omitwordPresent=1;	
										}

										last if $omitwordPresent == 1;
									}
								}

								# Accept the node only if the keywords are 
								# present and omitwords are absent and
								# the text of the node is of the desired type
								if ($keywordPresent == 1 && 
									$omitwordPresent == 0 &&
									$isDesiredType == 1)
									{	
										# check for additional conditions
										($found, $modifiedNode) = &checkNode($node, $beginsWith, $endsWith, $preceededBy, $followedBy);
									
										# save node
										if ( $found )
										{
											my %extractedNode;
											$extractedNode{"NodeNum"} = $nodeNbr;
											$extractedNode{"Text"} = $modifiedNode;
											push @extractedNodes, \%extractedNode;
										}
									}

							} 
							else

							{
								print "";
							}
						},0);
		}
	}
	
		
	$j++;
    }#end @depth

	return @extractedNodes;
}

#sub routine to remove text formatting tags from tree
sub removeTextFormatingTags {
my ($tree) = @_;
my @tags;
my $tag;
my @tagNodes;
my $node;
my $parent;
my @tags = ('B','FONT','BIG','SMALL','BASEFONT', 'BLINK', 'CITE', 'CODE',
              'EM', 'I', 'KBD', 'PLAINTEXT', 'S', 'STRIKE','STRONG',
               'SUB', 'SUP', 'TT','U', 'VAR');
 			
 		print("\n Removing text formatting tags from the tree");
 		foreach $tag (@tags)
 		{
 		   my @nodes;
			@nodes = $tree->find_by_tag_name($tag);
			push (@tagNodes, @nodes);
		
		}
		
		foreach $node (@tagNodes)
		{
			$parent = $node->parent;
			
			# replace the child in the parents contents list
			# with the content list of the child
			$node->replace_with_content;
			
			# concatenates any adjacent text nodes together
			$parent->normalize_content;
		}
		
		
       return $tree;
   
}#end sub removeTextFormatingTags 

#Subroutine to check the node content
sub checkNode {
my ($node, $beginsWith, $endsWith, $preceededBy, $followedBy) = @_;
my @beginsWith;
my @endsWith;
my @preceededBy;
my @followedBy;
my $found = 0;
my $pb = 0;
my $fb = 0;
my $bw = 0;
my $ew = 0;
my $i;
my $text = $node;
my $nothing = "Nothing";


	@beginsWith = &separateConditions($beginsWith);
	@endsWith = &separateConditions($endsWith);
	@preceededBy = &separateConditions($preceededBy);
	@followedBy = &separateConditions($followedBy);
	
	#Take care of special characters
	foreach ( @preceededBy )
	{
		$_ = &handleSpecialCharacters($_);
	}
	foreach ( @followedBy )
	{
		$_ = &handleSpecialCharacters($_);
	}
	
	
	
	for ($text)
	{
		s/^\s+//;
		s/\s+$//;
	}
		
	
	
	if( ( $#preceededBy + 1 ) > 0 )
	{
		LOOP1:foreach $i (@preceededBy)
		{
			if ( not defined $i )
		        {
			       next LOOP1;
		        }
			if ( $i eq  $nothing )
		        {
		        	$pb = 1;
		        	last LOOP1;
		        }
		        
		        # check if the precededby text is contained in the text of the node
		 	if ( $text =~ m/($i){1}/ )
			{
			    my $pattern = $1;
			    my $replacement = "";
			    my $index = index $text, $pattern;
			    
			    if ($index)
			    {
			    	my $substring = substr $text, 0, ($index);
			    	$substring = &handleSpecialCharacters($substring);
			    	
			    	# delete any text from the beginning till precededby text from the text of the node
			    	$text =~ s/$substring/$replacement/;
			    }
			    
			    	$pattern = &handleSpecialCharacters($pattern);
			    	
			    	# delete precededby text from the text of the node
			    	$text =~ s/$pattern/$replacement/;
			 	for ($text)
				{
					s/^\s+//;
					s/\s+$//;
				}
			   $pb = 1;
			   last LOOP1;
			}
		}#end foreach $i
	}#end if
	else
	{
		$pb = 1;
	}
	
	
	if( ( $#followedBy + 1 ) > 0 )
	{
		LOOP2:foreach $i (@followedBy)
		{
			if ( not defined $i )
		        {
			       next LOOP2;
		        }
		        if ( $i eq  $nothing )
		        {
		        	$fb = 1;
		        	last LOOP2;
		        }
		        
		        # check if the followedby text is contained in the text of the node
			if ( $text =~ m/($i){1}/ )
			{
			    my $pattern = $1;
			    my $replacement = '';
			    my $len = length $pattern;
			    my $index = index $text, $pattern;
			    my $offset = $len + $index;
			    my $substring = substr $text, $index;
			
				$substring = &handleSpecialCharacters($substring);
				$pattern = &handleSpecialCharacters($pattern);
				
			    
			    # delete any text from the end till followedby text from the text of the node
			    # delete followedby text from the text of the node
			    $text =~ s/$substring/$replacement/;
			    $text =~ s/$pattern/$replacement/;
			    
			    for ($text)
			    {
				s/^\s+//;
				s/\s+$//;
			    }
			   print " ";
			   $fb = 1;
			    last LOOP2;
			}
		}#end foreach $i
	}#end if
	else
	{
		$fb = 1;
	}
	
	if( ( $#beginsWith + 1 ) > 0 )
	{
	   print " ";
		LOOP3:foreach $i (@beginsWith)
		{
		  # check if any text exists before the beginswith text in the text of the node
		  # and delete such text
		  my $index = index $text, $i;
		  my $replacement = "";
		  if ( $index > 0)
		  {
		  	my $substring = substr $text, 0, $index;
			$substring = &handleSpecialCharacters($substring);
			$text =~ s/$substring/$replacement/;
		  
		  }
		  
		  for ($text)
		  {
			s/^\s+//;
			s/\s+$//;
		  }
		  
		  my $len = length $i;
		  my $substring = substr $text, 0, $len;
		  
		  # check if the remaining text begins with 'beginswith' text
		  if ( $i eq $substring )
		  {
		  	$bw = 1;
		  	last LOOP3;
		  }
		 }#end LOOP3
        }#end if
	else
	{
		$bw = 1;
	}
	
	if( ( $#endsWith + 1 ) > 0 )
	{
	  print " ";
		LOOP4:foreach $i (@endsWith)
		{
		  my $replacement = '';
		  my $len = length $i;
		  
		  # check if any text exists after the endswith text in the text of the node
		  # and delete such text
		  my $index = index $text, $i;
		  
		  if ( $index >= 0 )
		  {
		  	my $offset = $len + $index;
		  	my $substring = substr $text, $offset;
		  			    
		  	$substring = &handleSpecialCharacters($substring);
		  	$text =~ s/$substring/$replacement/;
				  
			for ($text)
			{
				s/^\s+//;
				s/\s+$//;
		  	}
		  }
		  my $len1 = length $i;
		  my $len2 = length $text;
		  my $substring = substr $text, ($len2-$len1), $len1;
			  
		  # check if the remaining text ends with 'endswith' text
		  if ( $i eq $substring )
		  {
		  	$ew = 1;
		  	last LOOP4;
		  }
	        }#end LOOP4
	 }#end if
	else
	{
		$ew = 1;
	}

	if ( $pb && $fb && $bw && $ew )
	{
		$found = 1;
	}
	

print " ";
	return ($found, $text);
}#end sub checkNode


#sub Routine to handle special characters
sub handleSpecialCharacters {
my ($value) = @_;

	$value =~ s/\$/\\\$/g;
	$value =~ s/\(/\\\(/g;
	$value =~ s/\)/\\\)/g;
	$value =~ s/\[/\\\[/g;
	$value =~ s/\]/\\\]/g;
	$value =~ s/\{/\\\{/g;
	$value =~ s/\}/\\\}/g;
	$value =~ s/\./\\\./g;
	
     return $value;
	
}#end sub handleSpecialCharacters


#sub routine to separate values for each condition
sub separateConditions {
my ($condition) = @_;
my $subPattern = ";;";
my $addSubPattern = 0;
my @condition;
my $i;
my $pushNothing = 0;

	if ( $condition =~ m/$subPattern/ )
	{
		$addSubPattern = 1;
	}
	
	@condition = split /;/, $condition;
		
	if ( $addSubPattern )
	{
		push (@condition, ";");
	}
	
	foreach $i (0 ..$#condition )
	{
		if ( $condition[$i] eq "Nothing" )
		{
			delete $condition[$i];
			$pushNothing = 1;
		}
	}
	
	if ( $pushNothing )
	{
		push ( @condition, "Nothing" );
	}
	
	
	return @condition;
}#end sub separateConditions

1;
