<commit_before>#!/usr/bin/env perl

use strict;
use warnings;
use Bio::TreeIO;
use Getopt::Long;
use File::Basename;
use Data::Dumper;
use Bio::DB::EUtilities;
use XML::LibXML;
use POSIX qw(strftime ceil floor);
use Date::Parse qw(str2time);
use Time::ParseDate qw/parsedate/;

$0=fileparse $0;
sub logmsg{print STDERR "$0: @_\n";};
exit main();
sub main{
  my $settings={};
  GetOptions($settings,qw(help map=s delimiter=s suffix=s tailSuffix=s daysRecent=i markup=s)) or die;
  die usage() if($$settings{help});
  my $mapFile=$$settings{map} || die "ERROR: need the map file\n".usage();
  $$settings{delimiter}||='|';
  $$settings{suffix}||="";
  $$settings{daysRecent}||=0;
  $$settings{markup}||='!!';
  my $inTree=$ARGV[0] || die "ERROR: need tree file\n".usage();
  
  my $map=readMap($mapFile,$settings);
  printNewTree($inTree,$map,$settings);
  return 0;
}

sub readMap{
  my($map,$settings)=@_;
  my $d=$$settings{delimiter} || die "ERROR: there is no delimiter\n".usage();
  my %map;
  open(MAP,$map) or die "ERROR: could not read map file $map: $!";
  logmsg "Reading $map";
  while(<MAP>){
    s/,//g; # don't let commas in the outbreak codes mess with the code for the tree
    chomp;
    my @F=split /\t/;
    my $numF=@F;
    if($numF<2){
      logmsg "Nothing found on this line. Will not convert for it.\n  $_";
      next;
    }
    $map{$F[0]}=join($d,@F[1..$numF-1]);
    #$map{$F[0]}=$F[1]; # DEBUG
  }
  close MAP;
  return \%map;
}

sub printNewTree{
  my($inTree,$map,$settings)=@_;
  my $d=$$settings{delimiter} || die "ERROR: there is no delimiter\n".usage();
  my $suffix=$$settings{suffix};
  my $in=Bio::TreeIO->new(-file=>$inTree);
  my $out=Bio::TreeIO->new(); # stdout
  my %seen;
  my $i=0;
  while(my $tree=$in->next_tree){
    for my $node($tree->get_nodes){
      #if ($i++>100){
      #  logmsg "DEBUG";
      #  last;
      #}
      my $oldid=$node->id || "";
      next if(!$oldid);
      $oldid=~s/^'+|'+$//g; # remove quotes from the ID
      $oldid=~s/^"+|"+$//g; # remove quotes from the ID
      $oldid=~s/^\Q$d\E//;  # remove any leading delimiters

      $oldid=(split /\Q$d\E/, $oldid)[0];
      $oldid=~s/\Q$suffix\E$// if($suffix);
      if(defined(my $tail=$$settings{tailSuffix})){
        $oldid=~s/\Q$tail\E.*$//;
      }
      my $newid; # what the node will be turned into
      if(!defined($oldid) || !defined($$map{$oldid})){
        # if it is defined but just not in the mappings, then produce a warning
        if($oldid && !defined($$map{$oldid})){
          # see if this identifier can be found on NCBI
          $newid=ncbiInfo($oldid,$settings);
          logmsg "Warning: I do not understand $oldid and it was left unconverted" if(!$newid);
        }
      } 
      # if the new node name can be found in the mappings then grab it.
      else {
        $newid=$$map{$oldid};
      }
      next if(!$newid);
      next if($seen{$oldid}++); # I think that somehow nodes were being parsed twice

      # make some kind of marking on this taxon if it's new-ish
      $newid=highlightIfNew($newid,$$settings{daysRecent},$settings);

      $node->id($newid);
    }
    $out->write_tree($tree);
    print "\n";
  }
  logmsg scalar(keys(%seen))." entries were converted";
  return 1;
}

# go onto NCBI and grab information pertaining to this identifier.
sub ncbiInfo{
  my($oldid,$settings)=@_;
  my $newid;
  if($oldid =~/^(SAMN|CFSAN)/){
    $newid=biosampleInfo($oldid,$settings);
  } elsif($oldid=~/^GC\w/){
    $newid=assemblyInfo($oldid,$settings);
  } else{
    logmsg "Warning: I do not know how to query $oldid.";
  }
  return $newid;
}

sub biosampleInfo{
  my($oldid,$settings)=@_;
  # UID is the identifier without SAMN
  my $uid=$oldid; $uid=~s/^SAMN//i;

  # make the query
  # e.g. http://eutils.ncbi.nlm.nih.gov/entrez/eutils/efetch.fcgi?db=biosample&id=02389791
  my $eutil=Bio::DB::EUtilities->new(
           -eutil => 'efetch',
           -db => 'biosample',
           -id=>$uid,
           -retmax => 10, # just in case it returns a huge amount when in reality it should be 1
           -email => "<EMAIL>",
  );
  my $xml=$eutil->get_Response->content;
  my $p=XML::LibXML->new;
  my $doc=$p->parse_string($xml);

  # set up key/value pairs from the XML attributes
  my %attr;
  foreach my $node($doc->findnodes("BioSampleSet/BioSample/Attributes/Attribute")){
    my $text=$node->textContent;
    #$text=~s/[,\s\|;\.:]+/_/g; # remove any offensive characters
    $text=~s/[^\w\d\-\/]+/_/g; # remove any offensive characters
    for my $attr($node->attributes){
      $attr{$attr->value}=$text;
    }
  }

  # not sure if all these headers are even in the attributes
  my @headers=('strain', 'strain', 'SAMN', 'collection date', 'geographic location (country and/or sea,region)', 'strain', 'isolation source', 'serovar', 'PFGE_PrimaryEnzyme_pattern', 'PFGE_SecondaryEnzyme_pattern', 'Outbreak'); 
  my $newid;
  #die Dumper [$xml,\%attr] if($uid eq 1125831); # see what's happening with GCA_000183845.1
  if(keys(%attr)<1){
    return $newid;
  }
  
  $attr{SAMN}=$oldid;
  $newid.=($attr{$_} || "").'|' for(@headers);
  $newid="" if($newid!~/[^\|]/); # if it's just pipe characters, then set it back to blank
  $newid=~s/\|$//; # remove trailing pipe
  logmsg "New ID found for $oldid through the BioSample API =>\n  $newid";

  return $newid;
}

sub assemblyInfo{<commit_msg>smarter querying of non-SAMN nodes<commit_after>#!/usr/bin/env perl

use strict;
use warnings;
use Bio::TreeIO;
use Getopt::Long;
use File::Basename;
use Data::Dumper;
use Bio::DB::EUtilities;
use XML::LibXML;
use POSIX qw(strftime ceil floor);
use Date::Parse qw(str2time);
use Time::ParseDate qw/parsedate/;

$0=fileparse $0;
sub logmsg{print STDERR "$0: @_\n";};
exit main();
sub main{
  my $settings={};
  GetOptions($settings,qw(help map=s delimiter=s suffix=s tailSuffix=s daysRecent=i markup=s)) or die;
  die usage() if($$settings{help});
  my $mapFile=$$settings{map} || die "ERROR: need the map file\n".usage();
  $$settings{delimiter}||='|';
  $$settings{suffix}||="";
  $$settings{daysRecent}||=0;
  $$settings{markup}||='!!';
  my $inTree=$ARGV[0] || die "ERROR: need tree file\n".usage();
  
  my $map=readMap($mapFile,$settings);
  printNewTree($inTree,$map,$settings);
  return 0;
}

sub readMap{
  my($map,$settings)=@_;
  my $d=$$settings{delimiter} || die "ERROR: there is no delimiter\n".usage();
  my %map;
  open(MAP,$map) or die "ERROR: could not read map file $map: $!";
  logmsg "Reading $map";
  while(<MAP>){
    s/,//g; # don't let commas in the outbreak codes mess with the code for the tree
    chomp;
    my @F=split /\t/;
    my $numF=@F;
    if($numF<2){
      logmsg "Nothing found on this line. Will not convert for it.\n  $_";
      next;
    }
    $map{$F[0]}=join($d,@F[1..$numF-1]);
    #$map{$F[0]}=$F[1]; # DEBUG
  }
  close MAP;
  return \%map;
}

sub printNewTree{
  my($inTree,$map,$settings)=@_;
  my $d=$$settings{delimiter} || die "ERROR: there is no delimiter\n".usage();
  my $suffix=$$settings{suffix};
  my $in=Bio::TreeIO->new(-file=>$inTree);
  my $out=Bio::TreeIO->new(); # stdout
  my %seen;
  my $i=0;
  while(my $tree=$in->next_tree){
    for my $node($tree->get_nodes){
      #if ($i++>100){
      #  logmsg "DEBUG";
      #  last;
      #}
      my $oldid=$node->id || "";
      next if(!$oldid);
      $oldid=~s/^'+|'+$//g; # remove quotes from the ID
      $oldid=~s/^"+|"+$//g; # remove quotes from the ID
      $oldid=~s/^\Q$d\E//;  # remove any leading delimiters

      $oldid=(split /\Q$d\E/, $oldid)[0];
      $oldid=~s/\Q$suffix\E$// if($suffix);
      if(defined(my $tail=$$settings{tailSuffix})){
        $oldid=~s/\Q$tail\E.*$//;
      }
      my $newid; # what the node will be turned into
      if(!defined($oldid) || !defined($$map{$oldid})){
        # if it is defined but just not in the mappings, then produce a warning
        if($oldid && !defined($$map{$oldid})){
          # see if this identifier can be found on NCBI
          $newid=ncbiInfo($oldid,$settings);
          logmsg "Warning: I do not understand $oldid and it was left unconverted" if(!$newid);
        }
      } 
      # if the new node name can be found in the mappings then grab it.
      else {
        $newid=$$map{$oldid};
      }
      next if(!$newid);
      next if($seen{$oldid}++); # I think that somehow nodes were being parsed twice

      # make some kind of marking on this taxon if it's new-ish
      $newid=highlightIfNew($newid,$$settings{daysRecent},$settings);

      $node->id($newid);
    }
    $out->write_tree($tree);
    print "\n";
  }
  logmsg scalar(keys(%seen))." entries were converted";
  return 1;
}

# go onto NCBI and grab information pertaining to this identifier.
sub ncbiInfo{
  my($oldid,$settings)=@_;
  my $newid;
  if($oldid=~/^GC\w/){
    $newid=assemblyInfo($oldid,$settings);
  } elsif($oldid=~/^SAMN/){
    $newid=biosampleInfo($oldid,$settings);
  } elsif($oldid!~/^\d+$/){ # if it's not just an integer
    $newid=biosampleInfo($oldid,$settings);
  } else{
    logmsg "Warning: I do not know how to query $oldid.";
  }
  return $newid;
}

sub biosampleInfo{
  my($oldid,$settings)=@_;
  # UID is the identifier without SAMN
  my $uid=$oldid; $uid=~s/^SAMN//i;

  # make the query
  # e.g. http://eutils.ncbi.nlm.nih.gov/entrez/eutils/efetch.fcgi?db=biosample&id=02389791
  my $eutil=Bio::DB::EUtilities->new(
           -eutil => 'efetch',
           -db => 'biosample',
           -id=>$uid,
           -retmax => 10, # just in case it returns a huge amount when in reality it should be 1
           -email => "<EMAIL>",
  );
  my $xml=$eutil->get_Response->content;
  my $p=XML::LibXML->new;
  my $doc=$p->parse_string($xml);

  # set up key/value pairs from the XML attributes
  my %attr;
  foreach my $node($doc->findnodes("BioSampleSet/BioSample/Attributes/Attribute")){
    my $text=$node->textContent;
    #$text=~s/[,\s\|;\.:]+/_/g; # remove any offensive characters
    $text=~s/[^\w\d\-\/]+/_/g; # remove any offensive characters
    for my $attr($node->attributes){
      $attr{$attr->value}=$text;
    }
  }

  # not sure if all these headers are even in the attributes
  my @headers=('strain', 'strain', 'SAMN', 'collection date', 'geographic location (country and/or sea,region)', 'strain', 'isolation source', 'serovar', 'PFGE_PrimaryEnzyme_pattern', 'PFGE_SecondaryEnzyme_pattern', 'Outbreak'); 
  my $newid;
  #die Dumper [$xml,\%attr] if($uid eq 1125831); # see what's happening with GCA_000183845.1

  # Nothing found; see if anything else matches.
  # Don't do this blanket-search on integer identifiers. They are probably SAMN identifiers and need to be treated differently.
  if(keys(%attr)<1 && $oldid !~/^\d+$/){
    $eutil=Bio::DB::EUtilities->new(
      -eutil => 'esearch',
      -db    => 'BioSample',
      -term  => $oldid,
      -email => "<EMAIL>",
      -retmax => 1, # just in case it returns a huge amount when in reality it should be 1
    );
    my $xml=$eutil->get_Response->content;
    my $p=XML::LibXML->new;
    my $doc=$p->parse_string($xml);
    my $uid;
    foreach my $node ($doc->findnodes("eSearchResult/IdList/Id")){
      $uid=$node->textContent;
    }
    # $uid is an integer which is a stand-in for SAMN. Find it through biosampleinfo
    die "Internal error: uid cannot be a non-integer but it is: $uid" if($uid=~/\D/);
    return biosampleInfo($uid,$settings);
  }

  # Nothing found
  if(keys(%attr)<1){
    return $newid;
  }
  
  $attr{SAMN}=$oldid;
  $newid.=($attr{$_} || "").'|' for(@headers);
  $newid="" if($newid!~/[^\|]/); # if it's just pipe characters, then set it back to blank
  $newid=~s/\|$//; # remove trailing pipe
  logmsg "New ID found for $oldid through the BioSample API =>\n  $newid";

  return $newid;
}

sub assemblyInfo{
{'fraction_non_alphanumeric': 0.18676082702288777, 'fraction_numerical': 0.008423381264358036, 'mean_word_length': 3.33566949465142, 'pattern_counts': {'":': 0, '<': 13, '<?xml version=': 0, '>': 68, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 8}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '763657', 'n_tokens_mistral': 4448, 'n_tokens_neox': 4244, 'n_words': 1111}