File Coverage

blib/lib/Text/ParseAHD.pm

Criterion	Covered	Total	%
statement	1	3	33.3
branch			n/a
condition			n/a
subroutine	1	1	100.0
pod			n/a
total	2	4	50.0

package Text::ParseAHD;
#use base qw(BASE);
use Text::ParseAHD::Word;
use Text::ParseAHD::Definition;
use Class::Std;
use Class::Std::Utils;

use warnings;
use strict;
use Carp;

use version; our $VERSION = qv('0.0.2');

{
        my %html_of  :ATTR( :get   :set   :default<''>    :init_arg );
        my %word_of  :ATTR( :get   :set   :default<''>    :init_arg );
        my %pos_of  :ATTR( :get   :set   :default<''>    :init_arg );
        my %syllables_of  :ATTR( :get   :set   :default<''>    :init_arg );
        my %defs_of  :ATTR( :get   :set   :default<''>    :init_arg );
        my %text_of  :ATTR( :get   :set   :default<''>    :init_arg );
        my %word_obj_obj_of  :ATTR( :get   :set   :default<''>    :init_arg );


        sub START {
                my ($self, $ident, $arg_ref) = @_;
                #$html_of{$ident} = $arg_ref->{html};
		#$word_of{$ident} = $arg_ref->{word};
       		#$Word_of{$ident} = Text::ParseAHD::Word->new({'word',$word_of{$ident}});
       		$self->set_word_obj( Text::ParseAHD::Word->new({word => $self->get_word() }) );
		return;
        }

	sub parse_html {
	        my ( $self ) = @_;
		my $ident = ident $self;
		my $html = $html_of{$ident};
		while ( $html =~ m/(.*?)/gsix ) {
                        my $definition_text = $1;
                           $definition_text =~ s/(.*?)<\/b>//i;
                        my $word            = $self->clean_word( $1 );

#                       print "  STATUS: AHD4 definition " . ++$count . " found\n";

                        if ($word eq $word_of{$ident}) {
                                $definition_text =~ s/\n//g;                                      # Remove newlines
                                $definition_text =~ s/\ //g;                                 # Remove nbsp
                                $definition_text =~ s///g;                                 # Remove br
                                $definition_text =~ s/^(.*?)//six;  # Remove leading
                                $definition_text =~ s/<\/td>.*$//six;                             # Remove trailing

                                my @defs         = $self->split_defs( $definition_text );
				my $i=1;
				foreach my $def (@defs) {
					print $i . "\n\n" . $def . "\n\n\n\n";
					$self->parse_definition( $def );
					$i++;
				}
			}
			#print $definition_text."\n\n\n";
                }
		$self->report_word();
		return;
	}

	sub clean_word {
                my ($self, $word) = @_;
                my $A             = chr(194);
                my $bullet        = chr(183);
                   $word          =~ s/://g;
                   $word          =~ s/$A//g;
                   $word          =~ s/$bullet//g;
                   $word          =~ s/.*?<\/sup>//;          # RH 080719
                   $word          =~ s/^\s+//;                     # RH 080719
                   $word          =~ s/\s+$//;                     # RH 080719
                return $word;
        }

	sub split_defs {
                my ($self, $text) = @_;
                my @defs          = split(//, $text ); shift @defs;
                return @defs;
        }

	sub parse_definition {
		my ($self, $text)  = @_;
                my $ident          = ident $self;
                my $pos            = '';
                my @word_forms     = ();
                my @definitions    = ();
		$text           =~ s/(.*?)//six;
		$pos=$1;
		$text           =~ s/(.*?)//six;
                my $subhead        = $1;
		if (defined $subhead) {
                        #while ($subhead =~ m/(.*?)<\/b>/gisx) { push @word_forms, $self->syllables( $1 ); }
                        while ($subhead =~ m/(.*?)<\/b>/gisx) { push @word_forms, $1; }

			if    ($subhead =~ m/(.*?)<\/i>/i)    { $pos = $1;  $pos =~ s/\.//g; }    # Subtype
                }
		#print "WORD FORMS: " . join(' ', @word_forms) ."\n\n\n";
		while ($text =~ m/(.*?)/gsix) {
                        my $def_text = $1;
                        my $new_defs;
			if ($def_text =~ m/parse_list( $def_text, $pos ); }
                        else                     { $new_defs = [$self->parse_single( $def_text )]; }

                        foreach my $definition (@{ $new_defs }) {push @definitions, $definition; }
                }
		foreach my $definition (@definitions){
                        $self->get_word_obj()->add_definition($definition->{text}, $definition->{example}, $pos);
		}

 	}

	sub parse_list {
                my ($self, $text, $pos ) = @_;
                    $text  =~ s//\[/ig;
                    $text  =~ s/<\/ol>/]/ig;
                    $text  =~ s//{ text => '/ig;
                    $text  =~ s/<\/li>/'}, /ig;
                    $text  =~ s/'\[/\[/ig;
                    $text  =~ s/,\s]/]/ig;
                    $text  =~ s/]'/]/ig;
		    $text =~ s/Informal<\/i>//ig;#added by Nathan
		    $text =~ s/Slang<\/i>//ig;#added by Nathan
                    $text =~ s/text => '? ?\[{ text => '/text => '/ig;
		    $text =~ s/{ text => '.*<\/i> \[{ text/{ text/ig;
		    $text =~ s/}\]}/}/ig;
		    $text =~ s/({ text => '[-\.\w\s]*)'([-\.\w\s]*'},)/$1$2/ig;
		    #$text  =~ s///ig;
                    #$text  =~ s/<\/ol>/]/ig;
                    #$text  =~ s//{ text => '/ig;
                    #$text  =~ s/<\/li>/'}, /ig;
                    #$text  =~ s/'\[/\[/ig;
                    #$text  =~ s/,\s]/]/ig;
                    #$text  =~ s/]'/]/ig;

		print "LIST TEXT: $text\n";
                my $definitions = eval "return $text;";
                #my $definitions = [{ text => 'A domesticated carnivorous mammal (Canis familiaris) related to the foxes and wolves and raised in a wide variety of breeds.'}, { text => 'Any of various carnivorous mammals of the family Canidae, such as the dingo.'}, { text => 'A male animal of the family Canidae, especially of the fox or a domesticated breed.'}, { text => 'Any of various other animals, such as the prairie dog.'}, { text => 'Informal [{ text => 'A person: You won, you lucky dog.'}, { text => 'A person regarded as contemptible: You stole my watch, you dog.'}, { text => 'A person regarded as unattractive or uninteresting.'}, { text => 'Something of inferior or low quality: "The President had read the speech to some of his friends and they told him it was a dog" (John P. Roche).'}, { text => 'An investment that produces a low return or a loss.'}]}, { text => 'Slang [{ text => 'A person regarded as unattractive or uninteresting.'}, { text => 'Something of inferior or low quality: "The President had read the speech to some of his friends and they told him it was a dog" (John P. Roche).'}, { text => 'An investment that produces a low return or a loss.'}]}, { text => 'dogs Slang  The feet.'}, { text => 'See andiron.'}, { text => 'Slang  A hot dog; a wiener.'}, { text => 'Any of various hooked or U-shaped metallic devices used for gripping or holding heavy objects.'}, { text => 'Astronomy  A sun dog.'}];
		#while($text=~m/[

my @definitions;
                foreach my $definition ( @$definitions ) {
                #foreach my $definition ( @definitions ) {
                       #print "HELLO: $definition->{text}\n\n";
		       if ( $definition->{text} =~ m/^ARRAY/ ) {
                                foreach my $sub_list ( @{ $definition->{text} } ) {
                                        push @definitions, $self->parse_single( $sub_list->{text} );
                                }
                        } else {
                                push @definitions, $self->parse_single( $definition->{text} );
                        	#$self->get_word_obj()->add_definition($definitions[-1]{text}, $definitions[-1]{example}, $pos);
				#my $list= $self->get_word_obj()->get_defs();
			        #my @list2 = @$list;
				#$self->report_word(-1);
			}
                }

                return \@definitions;
        }

	sub report_word{
		my ($self, $i)=@_;
		my $word = $self->get_word_obj();

		print "WORD: " . $word->get_word() . "\n";
		my $list = $word->get_defs();
		my @list2 = @$list;
		if($i eq ''){
			$i=1;
			foreach my $def (@list2){
				print "DEF#$i:\n  text: " . $def->get_text() . "\n  example: " . $def->get_example() . "\n  pos: " . $def->get_pos() . "\n\n";
				$i++;
			}
		}else{
			my $def = $list2[$i];
			 print "DEF#$i:\n  text: " . $def->get_text() . "\n  example: " . $def->get_example() . "\n  pos: " . $def->get_pos() . "\n\n";
		}
	}

	sub parse_single {
                my ($self, $text ) = @_;
                my $ident          = ident $self;
                while ( $text      =~ m/(.*?)<\/b>(.*?)<\/i>/gi ) {
                        my ($word_form, $pos) = ($self->syllables( $1 ), $2);  $pos =~ s/\.//g;  $pos =~ s/ //g;
                        #$self->_insert_word_form( $word_form, $pos );
                }
                my (@keys)         = ();
                my (@roots)        = ();
                my (%word_forms)   = ();
                   $text           =~ s/(.*?)<\/tt>//i;
                my $root='';
		#$root           = $1;  if ($root eq $text) { $root = ''; }

                # Check for additional word forms
                while ( $text      =~ s/(.*?)<\/b>(.*?)<\/i>//gi ) {
                        my ($word_form, $pos) = ($self->syllables($1), $2);  $pos =~ s/\.//g;  $pos =~ s/ //g;
                        $word_forms{$word_form} = $pos;
                }
                if (keys %word_forms) {
                        foreach my $key (sort keys %word_forms) { $self->_insert_word_form( $key, $word_forms{$key} ); }
                } else {
                        # No word forms, parse definition, root, example
			#print "SINGLE TEXT: $text \n";
                        my $example = '';
			$text =~ m/()/ig; #resetting $1
			$text           =~ s/(.*?)<\/i>//i;
                        $example        = $1;

			#print "EXAMPLE: $example\n";

			if ($text eq $example)
					{ $example = ''; }
			   $example        =~ s/["']//i;
                           $example        =~ s/\.//i;
                           $text           =~ s/\[.*?]//i;

                        if ($root) {
                                if ($root =~ m/(.*?)<\/font>/g) { $root = $1; }
                                while ($root =~ m/(.*?)<\/b>/g) { push @roots, $1; }
                                if (@roots) { $root = join(',', @roots); }
                                $root =~ s/'/:/g; }
                           $text           =~ s/<\/font>//i;
                           $text           =~ s/(.*?)<\/i>//i;
                           $text           =~ s/.*?<\/sup>//i;
                           $text           =~ s/://i;
                           $text           =~ s/["']//i;
                           $text           =~ s/See Synonyms at .*?<\/a>\.//i;
                           $text           =~ s/See .*?<\/a>//i;
                           $text           =~ s/.*?<\/b>//i;
                           $text           =~ s/.*?<\/font>//i;
                           $text           =~ s/.*?<\/i>//i;
                           $text           =~ s/\.//i;

                       # push @keys, "word_id => '$word_id_of{$ident}'";
                        push @keys, "word    => '$word_of{$ident}'";
                        if ($pos_of{$ident} && !$root) { push @keys, "pos     => '$pos_of{$ident}'"; }
                        if    ( $root && $example)     { push @keys, "root    => '$root'"; push @keys, "root_def => '" . $self->_sql_escape($example) . "'"; $example = ''; }
                        elsif ( $root )                { push @keys, "root    => '$root'"; }
                        #if ($example)                  { push @keys, "example => '" . $self->_sql_escape($example) . "'"; }
                        if ($example)                  { push @keys, "example => '$example'"; }
                        #if ($text)                     { push @keys, "text    => '" . $self->_sql_escape($text) . "'"; }
                        if ($text)                     { push @keys, "text    => '$text'"; }
                }

                return eval "return { " . join(', ', @keys) . " };";
	}
}
1; # Magic true value required at end of module
__END__