package MedlineParse;

# Authors:      Miroslava Kaloper, Gail Binkley, Shuai Weng
# Date:        August 30, 2000
# Description: Contains subroutines for parsing NCBI PubMed references 
#              Input is a scalar ref consisting of the entire reference
#                in Medline text format

use strict;
use LWP::UserAgent;
use vars qw (@ISA @EXPORT_OK);
use Exporter;
@ISA = ('Exporter');
@EXPORT_OK = qw(GetMedlineContent ParseMeshTerms ParseTitle ParseAuthors ParseAbstract ParseDatePublished ParseEntryDate ParseYear ParseJournal ParseVolume ParsePages ParseIssue ParseMedlineID ParsePubMed ParsePubTypes ParsePST ParseLastRevision ParseUrl CreateCitation ParseCommentIn ParseCommentOn ParseErratumIn ParseCorrectedRepublishedIn ParseCorrectedRepublishedFrom ParseRetractionIn ParseRetractionOf ParseUpdateIn ParseUpdateOf);

####################################################################
sub GetMedlineContent {
####################################################################
    my ($pubmed) = @_;

    my $url = "http://www.ncbi.nlm.nih.gov/entrez/query.fcgi?cmd=Text&db=PubMed&uid=$pubmed&dopt=Medline";
    my $ua = new LWP::UserAgent;
    my $reqUrl = new HTTP::Request GET => $url;
    $reqUrl->content_type('application/x-www-form-urlencoded');
    my $resUrl = $ua->request($reqUrl);
    my $content;
    if ($resUrl->is_success) {
	$content = $resUrl->content;
    }
    return $content;

}

####################################################################
sub ParseMeshTerms{
####################################################################
  my ($contentRef) = @_;

  my (@MESHTerms, $MESHTerm, $whereStart, $whereEnd);
  my $position = 0;

  do {
      $whereStart = index($$contentRef, "MH  -", $position);

      $whereEnd = index($$contentRef, "\n", $whereStart);

      $MESHTerm = substr($$contentRef, $whereStart+6, $whereEnd-$whereStart-6);

      if ($whereStart != -1) {
         $MESHTerm =~ s/\n//g;
         push (@MESHTerms,$MESHTerm);
      }

      $position = $whereEnd + 1;

  } until ($whereStart == -1);

  return @MESHTerms;
}


####################################################################
sub ParseTitle{
####################################################################
  my ($contentRef) = @_;

  my ($whereStart, $whereEnd);

  $whereStart = index($$contentRef, "TI  -");
  if ($whereStart == -1){
     return;
  }
 
  my @endMark = ("PG  - ", "AB  - ");

  foreach my $endMark (@endMark) {
	$whereEnd = index($$contentRef, "\n$endMark", $whereStart); 
	if ($whereEnd != -1) {last;}
  } 

  my $title = substr($$contentRef, $whereStart+6, $whereEnd-$whereStart-6);

  #format title - have to remove 6 blanks...
  $title =~ s/\n//g;
		
  $title =~ s/      / /g;
  # $title =~ s/\n/ /g;
 
  return $title;
}


####################################################################
sub ParseAuthors{
####################################################################
  my $contentRef = shift;

  my (@authors, $author, $whereStart, $whereEnd);
  my $position = 0;

  #find authors i.e. look for AU  - author's_name 
  do {
      $whereStart = index($$contentRef, "AU  -", $position);

      $whereEnd = index($$contentRef, "\n", $whereStart);

      $author = substr($$contentRef, $whereStart+6, $whereEnd-$whereStart-6);

      if ($whereStart != -1) { 
	  $author =~ s/\n//g;
	  push (@authors,$author);
      }

      $position = $whereEnd + 1;

  } until ($whereStart == -1);
 
  return @authors;
}


#######################################################################
sub ParseAbstract{
#######################################################################
  my $contentRef = shift;

  my ($whereStart, $whereEnd, $abstract);

  $whereStart = index($$contentRef, "AB  -");
  if ($whereStart == -1){
     return $abstract; 
  }

  my @endMark = ("AD  - ", "FAU  - ", "AU  - ", "LA  - ", "PT  - ");
  foreach my $endMark (@endMark) {
	$whereEnd = index($$contentRef, "\n$endMark", $whereStart); 
	if ($whereEnd != -1) {last;}
  } 
  $abstract = substr($$contentRef, $whereStart+6, $whereEnd-$whereStart-7);

  #format abstract - have to remove 6 blanks...
  $abstract =~ s/\n//g;
  $abstract =~ s/      / /g;
  if ($abstract !~ /\.$/) { $abstract .= "\."; } 
  return $abstract;
}


######################################################################
sub ParseDatePublished{
######################################################################
  my $contentRef = shift;

  my ($whereStart, $whereEnd);

  $whereStart = index($$contentRef, "DP  -");
  if ($whereStart == -1){
     return;
  }

  $whereEnd = index($$contentRef, "\n", $whereStart);
  my $pubdate = substr($$contentRef, $whereStart+6, $whereEnd-$whereStart-6);

  $pubdate =~ s/\n//g;

  return $pubdate;
}


######################################################################
sub ParseEntryDate{
######################################################################
  my $contentRef = shift;

  my ($whereStart, $whereEnd);

  $whereStart = index($$contentRef, "DA  -");
  if ($whereStart == -1){
     return;
  }

  $whereEnd = index($$contentRef, "\n", $whereStart);
  my $entrydate = substr($$contentRef, $whereStart+6, $whereEnd-$whereStart-6);

  $entrydate =~ s/\n//g;

  return $entrydate;
}


######################################################################
sub ParseYear{
######################################################################
  my $contentRef = shift;

  my ($whereStart, $whereEnd, $year);

  $whereStart = index($$contentRef, "DP  -");
  if ($whereStart == -1){ 
     return;
  }

  $whereEnd = index($$contentRef, "\n", $whereStart);
  my $date = substr($$contentRef, $whereStart+6, $whereEnd-$whereStart-6);

  #extract year from: year month day
  ($year) = split(/ /,$date);

  $year =~ s/\n//g;
 
  return $year;
}


########################################################################
sub ParseJournal{
########################################################################
  my $contentRef = shift;

  my ($whereStart, $whereEnd);

  $whereStart = index($$contentRef, "TA  -");
  if ($whereStart == -1){ 
     return;
  }

  $whereEnd = index($$contentRef, "\n", $whereStart);
  my $journal = substr($$contentRef, $whereStart+6, $whereEnd-$whereStart-6);

  $journal =~ s/\n//g;

  return $journal;
}


########################################################################
sub ParseVolume{
########################################################################
  my $contentRef = shift;

  my ($whereStart, $whereEnd);

  $whereStart = index($$contentRef, "VI  -");
  if ($whereStart == -1){ 
     return;
  }

  $whereEnd = index($$contentRef, "\n", $whereStart);
  my $volume = substr($$contentRef, $whereStart+6, $whereEnd-$whereStart-6);

  $volume =~ s/\n//g;

  return $volume;
}


########################################################################
sub ParseIssue{
########################################################################
  my $contentRef = shift;

  my ($whereStart, $whereEnd);

  $whereStart = index($$contentRef, "IP  -");
  if ($whereStart == -1){ 
     return;
  }

  $whereEnd = index($$contentRef, "\n", $whereStart);
  my $issue = substr($$contentRef, $whereStart+6, $whereEnd-$whereStart-6);

  $issue =~ s/\n//g;

  return $issue;
}


########################################################################
sub ParsePages{
########################################################################
  my $contentRef = shift;

  my ($whereStart, $whereEnd);

  $whereStart = index($$contentRef, "PG  -");
  if ($whereStart == -1){ 
     return;
  }

  $whereEnd = index($$contentRef, "\n", $whereStart);
  my $pages = substr($$contentRef, $whereStart+6, $whereEnd-$whereStart-6);

  $pages =~ s/\n//g;

  return $pages;
}


########################################################################
sub ParseMedlineID{
########################################################################
  my $contentRef = shift;

  my ($whereStart, $whereEnd);

  $whereStart = index($$contentRef, "UI  -");
  if ($whereStart == -1){ 
     return;
  }

  $whereEnd = index($$contentRef, "\n", $whereStart);
  my $medline = substr($$contentRef, $whereStart+6, $whereEnd-$whereStart-6);

  $medline =~ s/\n//g;

  return $medline;
}

########################################################################
sub ParsePubMed {
########################################################################
  my $contentRef = shift;

  my ($whereStart, $whereEnd);

  $whereStart = index($$contentRef, "PMID-");
  if ($whereStart == -1){ 
     return;
  }

  $whereEnd = index($$contentRef, "\n", $whereStart);
  my $pubmed = substr($$contentRef, $whereStart+6, $whereEnd-$whereStart-6);

  $pubmed =~ s/\n//g;

  return $pubmed;
}


########################################################################
sub ParsePST{
########################################################################
  my $contentRef = shift;

  my ($whereStart, $whereEnd);

  $whereStart = index($$contentRef, "PST -");
  if ($whereStart == -1){ 
     return;
  }

  $whereEnd = index($$contentRef, "\n", $whereStart);
  my $pst = substr($$contentRef, $whereStart+6, $whereEnd-$whereStart-6);

  $pst =~ s/\n//g;

  return $pst;
}

########################################################################
sub ParseLastRevision{
########################################################################
  my $contentRef = shift;

  my ($whereStart, $whereEnd);

  $whereStart = index($$contentRef, "LR  -");
  if ($whereStart == -1){ 
     return;
  }

  $whereEnd = index($$contentRef, "\n", $whereStart);
  my $lr = substr($$contentRef, $whereStart+6, $whereEnd-$whereStart-6);

  $lr =~ s/\n//g;

  return $lr;
}

########################################################################
sub ParseUrl {
########################################################################
  my $contentRef = shift;

  my ($whereStart, $whereEnd);

  $whereStart = index($$contentRef, "URLF-");
  if ($whereStart == -1){ 
     return;
  }
  my @endMark = ("URLS", "PST", "EDAT", "MHDA", "SO");
  foreach my $endMark (@endMark) {
	$whereEnd = index($$contentRef, "\n$endMark", $whereStart); 
	if ($whereEnd != -1) {last;}
  }
  my $url = substr($$contentRef, $whereStart+6, $whereEnd-$whereStart-6);
  
  $url =~ s/[\n\f\r\t ]//g;
  return $url;
}


####################################################################
sub ParsePubTypes{
####################################################################
  my $contentRef = shift;

  my (@PubTypes, $pubType, $whereStart, $whereEnd);
  my $position = 0;

  do {
      $whereStart = index($$contentRef, "PT  -", $position);

      $whereEnd = index($$contentRef, "\n", $whereStart);

      $pubType = substr($$contentRef, $whereStart+6, $whereEnd-$whereStart-6);

      if ($whereStart != -1) {
         $pubType =~ s/\n//g;
         push (@PubTypes,$pubType);
      }

      $position = $whereEnd + 1;

  } until ($whereStart == -1);

  return @PubTypes;
}


#######################################################################
sub CreateCitation {
#######################################################################
# Creates a citation from already parsed data

  my ($yearRef, $titleRef, $journalRef, $volumeRef, $issueRef, $pagesRef, $authorsRef) = @_;

  my $citation;
  my $NoOfAuthors = @{$authorsRef};

  #when more than 2 authors
  #1st AU, et al. (Year) TA VI:PG.
  if ($NoOfAuthors >= 3){
     $citation = $$authorsRef[0] . ', et al.'; 
  } else {  
    if ($NoOfAuthors == 2){
       #when 2 authors:
       #1st AU & 2nd AU. (Year) TA VI:PG. 
       $citation = $$authorsRef[0] . ' and ' . $$authorsRef[1];
    } elsif ($NoOfAuthors ==1) {
      $citation = $$authorsRef[0];
    } else {
      #something is wrong - cannot have 0 authors...
      return $citation;
    }
  }

  $citation =~ s/\n//g;

  $citation .= ' (' . $$yearRef . ') '; 

  $citation .= $$titleRef . ' ';

  $citation .= $$journalRef;
  
  $citation .= ' ' . $$volumeRef . '(' . $$issueRef . '):' . $$pagesRef; 

  $citation =~ s/\n//g;

  $citation =~ s/\:+$//;

  return $citation;
}

#####################################################################
sub ParseCommentIn {
#####################################################################
  my $contentRef = shift;

  my ($whereStart, $whereEnd);

  $whereStart = index($$contentRef, "CIN -");
  if ($whereStart == -1){ 
     return;
  }

  $whereEnd = index($$contentRef, "\n", $whereStart);
  my $cin = substr($$contentRef, $whereStart+6, $whereEnd-$whereStart-6);

  $cin =~ s/\n//g;

  return $cin;
}

#####################################################################
sub ParseCommentOn {
#####################################################################
  my $contentRef = shift;

  my ($whereStart, $whereEnd);

  $whereStart = index($$contentRef, "CON -");
  if ($whereStart == -1){ 
     return;
  }

  $whereEnd = index($$contentRef, "\n", $whereStart);
  my $con = substr($$contentRef, $whereStart+6, $whereEnd-$whereStart-6);

  $con =~ s/\n//g;

  return $con;
}

#####################################################################
sub ParseErratumIn {
#####################################################################
  my $contentRef = shift;

  my ($whereStart, $whereEnd);

  $whereStart = index($$contentRef, "EIN -");
  if ($whereStart == -1){ 
     return;
  }
  $whereEnd = index($$contentRef, "\n", $whereStart);
  my $ein = substr($$contentRef, $whereStart+6, $whereEnd-$whereStart-6);
  $ein =~ s/\n//g;
  return $ein;
}

#####################################################################
sub ParseCorrectedRepublishedIn {
#####################################################################
  my $contentRef = shift;

  my ($whereStart, $whereEnd);

  $whereStart = index($$contentRef, "RPI -");
  if ($whereStart == -1){ 
     return;
  }
  $whereEnd = index($$contentRef, "\n", $whereStart);
  my $rpi = substr($$contentRef, $whereStart+6, $whereEnd-$whereStart-6);
  $rpi =~ s/\n//g;
  return $rpi;

}

#####################################################################
sub ParseCorrectedRepublishedFrom {
#####################################################################
  my $contentRef = shift;

  my ($whereStart, $whereEnd);

  $whereStart = index($$contentRef, "RPF -");
  if ($whereStart == -1){ 
     return;
  }
  $whereEnd = index($$contentRef, "\n", $whereStart);
  my $rpf = substr($$contentRef, $whereStart+6, $whereEnd-$whereStart-6);
  $rpf =~ s/\n//g;
  return $rpf;

}

#####################################################################
sub ParseRetractionIn {
#####################################################################
  my $contentRef = shift;

  my ($whereStart, $whereEnd);

  $whereStart = index($$contentRef, "RIN -");
  if ($whereStart == -1){ 
     return;
  }
  $whereEnd = index($$contentRef, "\n", $whereStart);
  my $rin = substr($$contentRef, $whereStart+6, $whereEnd-$whereStart-6);
  $rin =~ s/\n//g;
  return $rin;

}

#####################################################################
sub ParseRetractionOf {
#####################################################################
  my $contentRef = shift;

  my ($whereStart, $whereEnd);

  $whereStart = index($$contentRef, "ROF -");
  if ($whereStart == -1){ 
     return;
  }
  $whereEnd = index($$contentRef, "\n", $whereStart);
  my $rof = substr($$contentRef, $whereStart+6, $whereEnd-$whereStart-6);
  $rof =~ s/\n//g;
  return $rof;


}

#####################################################################
sub ParseUpdateIn {
#####################################################################
  my $contentRef = shift;

  my ($whereStart, $whereEnd);

  $whereStart = index($$contentRef, "UIN -");
  if ($whereStart == -1){ 
     return;
  }
  $whereEnd = index($$contentRef, "\n", $whereStart);
  my $uin = substr($$contentRef, $whereStart+6, $whereEnd-$whereStart-6);
  $uin =~ s/\n//g;
  return $uin;
}

#####################################################################
sub ParseUpdateOf {
#####################################################################
  my $contentRef = shift;

  my ($whereStart, $whereEnd);

  $whereStart = index($$contentRef, "UOF -");
  if ($whereStart == -1){ 
     return;
  }
  $whereEnd = index($$contentRef, "\n", $whereStart);
  my $uof = substr($$contentRef, $whereStart+6, $whereEnd-$whereStart-6);
  $uof =~ s/\n//g;
  return $uof;
}

#####################################################################
#####################################################################
#####################################################################