MEAD

MEAD_ADDONS_UTIL

Included libraries Package variables General documentation Methods
Package variables top
Privates (from my definitions)
$min_words = 1
%abbrevs = ()
$DTD_DIR = "/data0/projects/mead310/mead/dtd"
$html_or_body = "body"
$split_on = "span|option|hr|br|p|td|th"
$doc = ()
%inside = ()
$sentends = ''
Included modulestop
HTML::Parser
Inherit top
Exporter
Synopsistop
No synopsis!
Descriptiontop
No description!
Methodstop
convert_returnsNo descriptionCode
extract_text_from_htmlNo descriptionCode
extract_title_from_htmlNo descriptionCode
first_parseNo descriptionCode
get_cluster_headerNo descriptionCode
get_cluster_tailNo descriptionCode
get_docsent_headerNo descriptionCode
get_docsent_tailNo descriptionCode
load_abbrevsNo descriptionCode
sanitizeNo descriptionCode
split_sentencesNo descriptionCode
tagNo descriptionCode
textNo descriptionCode

Methods description

Methods code

convert_returnsdescriptiontopprevnext
sub convert_returns {
my $string = shift;
$string =~s/[\n]+/\r\n/g;
return $string;
}
extract_text_from_htmldescriptiontopprevnext
sub extract_text_from_html {
    my $string = shift;
    $doc = "";
    %inside = ();
    my $html = ();
  
  if (length $html_or_body > 0) {
     $string =~/<$html_or_body[^>]*?>(.+)<\/$html_or_body>/i;
     if($1){$html = $1;}
     else {$html = $string;}
  }

    else {$html = $string;}

&first_parse($html);
$doc = &sanitize($doc);
$doc = &convert_returns($doc);
return $doc;
}
extract_title_from_htmldescriptiontopprevnext
sub extract_title_from_html {
    my $html = shift;
    $html =~/<title[^>]*?>(.*?)<\/title>/i;
    my $title = $1;
    return &sanitize($title);
}
first_parsedescriptiontopprevnext
sub first_parse {
  my $html = shift;

  my $p = HTML::Parser->new(api_version => 3,
                   handlers    => [start => [\&tag, "tagname, '+1'"],
                                   end   => [\&tag, "tagname, '-1'"],
                                   text  => [\&text, "dtext"],
                                   ],
                   marked_sections => 1,
                   );
   $p->parse($html);
   $p->eof();
}
get_cluster_headerdescriptiontopprevnext
sub get_cluster_header {
my $lang = shift;

unless ($lang =~/./){$lang = "ENG";}

my $header = "<?xml version='1.0'?>
<CLUSTER LANG=\"$lang\">\n";

return $header;
}
get_cluster_taildescriptiontopprevnext
sub get_cluster_tail {
my $tail = "</CLUSTER>\n     ";

return $tail;
}
get_docsent_headerdescriptiontopprevnext
sub get_docsent_header {
my $filename = shift;

$filename =~s/\.docsent$//;

my $header =
"<?xml version='1.0'?>
<!DOCTYPE DOCSENT SYSTEM\" $DTD_DIR/docsent.dtd\">
 <DOCSENT DID='$filename'>
  <BODY>
   <TEXT>\n";

return $header;
}
get_docsent_taildescriptiontopprevnext
sub get_docsent_tail {
$tail = "   </TEXT>
  </BODY>
</DOCSENT>";

return $tail;
}
load_abbrevsdescriptiontopprevnext
sub load_abbrevs {
$abbrevs{A} = 1;
$abbrevs{a} = 1;
$abbrevs{Adm} = 1;
$abbrevs{al} = 1;
$abbrevs{Ala} = 1;
$abbrevs{Alta} = 1;
$abbrevs{'a.m'} = 1;
$abbrevs{Apr} = 1;
$abbrevs{Ariz} = 1;
$abbrevs{Ark} = 1;
$abbrevs{Assn} = 1;
$abbrevs{AST} = 1;
$abbrevs{Atty} = 1;
$abbrevs{Aug} = 1;
$abbrevs{Ave} = 1;
$abbrevs{B} = 1;
$abbrevs{Bancorp} = 1;
$abbrevs{Bankcorp} = 1;
$abbrevs{Bhd} = 1;
$abbrevs{bn} = 1;
$abbrevs{Bros} = 1;
$abbrevs{C} = 1;
$abbrevs{Calif} = 1;
$abbrevs{Capt} = 1;
$abbrevs{cent} = 1;
$abbrevs{Cia} = 1;
$abbrevs{Cie} = 1;
$abbrevs{Cmdr} = 1;
$abbrevs{co} = 1;
$abbrevs{Co} = 1;
$abbrevs{CO} = 1;
$abbrevs{Col} = 1;
$abbrevs{Colo} = 1;
$abbrevs{Conn} = 1;
$abbrevs{conv} = 1;
$abbrevs{Corp} = 1;
$abbrevs{CORP} = 1;
$abbrevs{Cos} = 1;
$abbrevs{D} = 1;
$abbrevs{Dec} = 1;
$abbrevs{Del} = 1;
$abbrevs{dept} = 1;
$abbrevs{Dept} = 1;
$abbrevs{Dist} = 1;
$abbrevs{Dr} = 1;
$abbrevs{Drs} = 1;
$abbrevs{E} = 1;
$abbrevs{ed} = 1;
$abbrevs{e} = 1;
$abbrevs{Elec} = 1;
$abbrevs{end} = 1;
$abbrevs{et} = 1;
$abbrevs{etc} = 1;
$abbrevs{Etc} = 1;
$abbrevs{F} = 1;
$abbrevs{Feb} = 1;
$abbrevs{Fla} = 1;
$abbrevs{Fri} = 1;
$abbrevs{G} = 1;
$abbrevs{g} = 1;
$abbrevs{Ga} = 1;
$abbrevs{Gen} = 1;
$abbrevs{Gov} = 1;
$abbrevs{H} = 1;
$abbrevs{hr} = 1;
$abbrevs{I} = 1;
$abbrevs{Ia} = 1;
$abbrevs{Ida} = 1;
$abbrevs{ie} = 1;
$abbrevs{Ill} = 1;
$abbrevs{in} = 1;
$abbrevs{inc} = 1;
$abbrevs{Inc} = 1;
$abbrevs{INC} = 1;
$abbrevs{Ind} = 1;
$abbrevs{J} = 1;
$abbrevs{Jan} = 1;
$abbrevs{Jr} = 1;
$abbrevs{Jul} = 1;
$abbrevs{Jun} = 1;
$abbrevs{K} = 1;
$abbrevs{Kans} = 1;
$abbrevs{Ken} = 1;
$abbrevs{Kft} = 1;
$abbrevs{km} = 1;
$abbrevs{L} = 1;
$abbrevs{La} = 1;
$abbrevs{lbs} = 1;
$abbrevs{Lt} = 1;
$abbrevs{Ltd} = 1;
$abbrevs{m} = 1;
$abbrevs{M} = 1;
$abbrevs{Maj} = 1;
$abbrevs{Mar} = 1;
$abbrevs{Mass} = 1;
$abbrevs{Md} = 1;
$abbrevs{Me} = 1;
$abbrevs{Mfg} = 1;
$abbrevs{mg} = 1;
$abbrevs{Mich} = 1;
$abbrevs{mill} = 1;
$abbrevs{min} = 1;
$abbrevs{Minn} = 1;
$abbrevs{Miss} = 1;
$abbrevs{Mo} = 1;
$abbrevs{Mon} = 1;
$abbrevs{Mont} = 1;
$abbrevs{mph} = 1;
$abbrevs{Mr} = 1;
$abbrevs{MR} = 1;
$abbrevs{Mrs} = 1;
$abbrevs{Ms} = 1;
$abbrevs{N} = 1;
$abbrevs{Nebr} = 1;
$abbrevs{Nev} = 1;
$abbrevs{Nfld} = 1;
$abbrevs{no} = 1;
$abbrevs{No} = 1;
$abbrevs{Nov} = 1;
$abbrevs{O} = 1;
$abbrevs{Oct} = 1;
$abbrevs{Ont} = 1;
$abbrevs{Ore} = 1;
$abbrevs{P} = 1;
$abbrevs{Pa} = 1;
$abbrevs{ParCorp} = 1;
$abbrevs{pct} = 1;
$abbrevs{Pct} = 1;
$abbrevs{pds} = 1;
$abbrevs{Penn} = 1;
$abbrevs{Pf} = 1;
$abbrevs{PLC} = 1;
$abbrevs{'p.m'} = 1;
$abbrevs{'P.M'} = 1;
$abbrevs{Prof} = 1;
$abbrevs{Pte} = 1;
$abbrevs{pts} = 1;
$abbrevs{Pty} = 1;
$abbrevs{Q} = 1;
$abbrevs{Que} = 1;
$abbrevs{R} = 1;
$abbrevs{rd} = 1;
$abbrevs{Rep} = 1;
$abbrevs{REP} = 1;
$abbrevs{Reps} = 1;
$abbrevs{Rev} = 1;
$abbrevs{"R-Wis"} = 1;
$abbrevs{s} = 1;
$abbrevs{S} = 1;
$abbrevs{SA} = 1;
$abbrevs{Sask} = 1;
$abbrevs{SCEcorp} = 1;
$abbrevs{Sen} = 1;
$abbrevs{Sep} = 1;
$abbrevs{Sept} = 1;
$abbrevs{Sgt} = 1;
$abbrevs{sq} = 1;
$abbrevs{Sr} = 1;
$abbrevs{SR} = 1;
$abbrevs{St} = 1;
$abbrevs{Sun} = 1;
$abbrevs{Supt} = 1;
$abbrevs{T} = 1;
$abbrevs{Tenn} = 1;
$abbrevs{Tex} = 1;
$abbrevs{th} = 1;
$abbrevs{Thu} = 1;
$abbrevs{Tue} = 1;
$abbrevs{U} = 1;
$abbrevs{Univ} = 1;
$abbrevs{Ur} = 1;
$abbrevs{v} = 1;
$abbrevs{V} = 1;
$abbrevs{Va} = 1;
$abbrevs{vol} = 1;
$abbrevs{Vol} = 1;
$abbrevs{vs} = 1;
$abbrevs{Vt} = 1;
$abbrevs{W} = 1;
$abbrevs{Wash} = 1;
$abbrevs{Wed} = 1;
$abbrevs{Wis} = 1;
$abbrevs{Wyo} = 1;
$abbrevs{X} = 1;
$abbrevs{Y} = 1;
$abbrevs{yr} = 1;
$abbrevs{Yr} = 1;
$abbrevs{Z} = 1;

}

1;
}
sanitizedescriptiontopprevnext
sub sanitize {
my $html = shift;

##these are necessary to convert files to xml

    $html =~s/&([^#])/\&amp\;$1/g; 
    $html =~s/</\&lt\;/g;  
    $html =~s/>/\&gt\;/g;  
    $html =~s/\&\#014[56]\;/'/g;
    $html =~s/\&\#014[78]\;/"/g;
    $html =~s/\&\#[\d]+\;//g;
    $html =~s/\256/\&copy\;/g;
    #$html =~s/é/e/;
    $html =~s/[^A-Za-z\:\/\\ \~\'\-\.\!\?0-9\@\,\;\"\'\_\&\#\n\r]/ /g;    
    $html =~s/[\t ]+/ /g;
    $html =~s/ ?[\n]+ ?/\n/g;
   
return $html;
}
split_sentencesdescriptiontopprevnext
sub split_sentences {
    my $text = shift;

    if ($text !~/[ \n\r]/){return $text;}
    
    unless (%abbrevs) {
        &load_abbrevs;
    }

##    my @split = &Text::Sentence::split_sentences($text);
    $text =~s/([.!?]+["']*)[ ]+([^a-z])/$1\n$2/g; 
    my @split = split /\n/, $text; 
    my @final;
    my $temp;
        
    while (@split) {
    my $s = shift @split;

        if ($temp) {
            $temp .= " " . $s;
        } else {
            $temp = $s;
        }
    
        ## get the last word (if the sentence ends in a period).
        $temp =~/([\w]+)\.\s*$/;##old
        my $lw = $1;

        if ($lw && $abbrevs{$lw} && $temp !~/\r/) {
            ## do nothing. 
            ##print "doing nothing with $lw\n";
        } elsif ($temp =~/[\w\d]+/) {
            push @final, $temp;
            $temp = "";
        }
    }
    
my @reallyfinal = ();

foreach $sent (@final)
 { 
    $sent =~s/\r//g;
    $sent =~s/[ ]+/ /g;
    $sent =~s/^ | $//g;
   my @words = split / /, $sent;
   ##print "$sent: $#words\n";
   if ($final_straw && $sent =~/$final_straw/){last;}
   if ($##words >= ($min_words - 1) && $sent =~/[$sentends]["']?$/){
      push @reallyfinal, $sent;
    }
}
tagdescriptiontopprevnext
sub tag {
   my($tag, $num) = @_; 
   $inside{$tag} += $num;
   if ($tag=~/^($split_on)$/){$doc .= "\n";}
   ##note that \r is added in convert_returns
   ##print "$tag $num\n";  # not for all tags
}
textdescriptiontopprevnext
sub text {
    return if $inside{script} || $inside{style};
    my $text = $_[0];
    ##print "text:>>$text<<\n";
    $doc .= " $text ";
}

General documentation

No general documentation available.