<commit_before>=head1 LICENSE

Copyright [1999-2015] Wellcome Trust Sanger Institute and the EMBL-European Bioinformatics Institute
Copyright [2016-2019] EMBL-European Bioinformatics Institute

Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at

     http://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.

=cut

package XrefParser::DBASSParser;

use strict;
use warnings;

use DBI;
use Carp;

use parent qw( XrefParser::BaseParser );

# This parser will read direct xrefs from a comma-delimited file downloaded from the DBASS Web site.
# The columns of the file should be the following:
#
# 1)    DBASS Gene ID
# 2)    DBASS Gene Name
# 3)    Ensembl Gene ID
#
# where 2) can be either a single name, a 'name/synonym' pair, or a 'name (synonym)' pair.
# Column values, including empty strings, can be surrounded by pairs of double quotes.


sub run {
  my ( $self, $ref_arg ) = @_;
  my $source_id  = $ref_arg->{source_id};
  my $species_id = $ref_arg->{species_id};
  my $files      = $ref_arg->{files};
  my $verbose    = $ref_arg->{verbose};
  my $dbi        = $ref_arg->{dbi};

  if ( ( !defined $source_id ) or
       ( !defined $species_id ) or
       ( !defined $files ) )
  {
    croak 'Need to pass source_id, species_id and files as pairs';
  }
  $verbose //= 0;
  $dbi //= $self->dbi;

  my $filename = @{$files}[0];

  my $file_io = $self->get_filehandle($filename);
  if ( !defined($file_io) ) {
    return 1;
  }

  my $parsed_count = 0;

  # Skip the header line
  $file_io->getline();

  while ( defined( my $line = $file_io->getline() ) ) {

    # strip trailing whitespace
    $line =~ s/\s*$//x;
    # csv format can come with quoted columns, remove them. Note that this
    # assumes actual column values will never contain commas, which while
    # true at present brings into question why bother quoting them in the
    # first place.
    $line =~ s/"//gx;

    my ( $dbass_gene_id, $dbass_gene_name, $ensembl_id, @split_overflow ) =
      split( /,/x, $line );

    # If Ensembl ID is the last column and quotation marks have already
    # been stripped, split() will leave $ensembl_id undefined for unmapped
    # entries. Therefore, only check the first two columns.
    # Conversely, if Ensembl ID is *not* the last column split() will set
    # $ensembl_id to an empty string for unmapped entries and correctly
    # assigns further tokens to the overflow array.
    if ( !defined($dbass_gene_id) || !defined($dbass_gene_name) ) {
      printf {*STDERR} ( "Line %d has fewer than two columns.\n",
                      1 + $parsed_count );
      print {*STDERR} ("The parsing failed\n");
      return 1;
    }
    elsif ( scalar @split_overflow > 0 ) {
      printf {*STDERR} ( "Line %d has more than three columns.\n",
                      1 + $parsed_count );
      print {*STDERR} ("The parsing failed\n");
      return 1;
    }

    # Do not attempt to create unmapped xrefs. Checking truthiness is good
    # enough here because the only non-empty string evaluating as false is
    # not a valid Ensembl stable ID.
    if ( $ensembl_id ) {

      # FIXME: .* is seriously inefficient because here it results in massive
      # amounts of backtracking. Could we be more specific, i.e. assume
      # some specific format of DBASS names?
      my ( $first_gene_name, $second_gene_name );
      if ( ( $dbass_gene_name =~ m{
                                    (.*)
                                    \s?\/\s?  # typically no ws here but just in case
                                    (.*)
                                  }x ) ||
           ( $dbass_gene_name =~ m{
                                    (.*)
                                    \s?  # typically there IS a space before the ( here
                                    [(] (.*) [)]
                                  }x ) ) {
        $first_gene_name  = $1;
        $second_gene_name = $2;
      }
      else {
        $first_gene_name = $dbass_gene_name;
        $second_gene_name = undef;
      }

      ++$parsed_count;

      my $label       = $first_gene_name;
      my $synonym     = $second_gene_name;
      my $type        = 'gene';
      my $version     = '1';

      my $xref_id =
        $self->get_xref( $dbass_gene_id, $source_id, $species_id, $dbi );

      if ( !defined($xref_id) || $xref_id eq q{} ) {
        $xref_id = $self->add_xref(
                                   { acc        => $dbass_gene_id,
                                     version    => $version,
                                     label      => $label,
                                     desc       => undef,
                                     source_id  => $source_id,
                                     dbi        => $dbi,
                                     species_id => $species_id,
                                     info_type  => "DIRECT" } );
      }

      if ( defined($synonym) ) {<commit_msg>DBASSParser: add /ms to all regular expressions<commit_after>=head1 LICENSE

Copyright [1999-2015] Wellcome Trust Sanger Institute and the EMBL-European Bioinformatics Institute
Copyright [2016-2019] EMBL-European Bioinformatics Institute

Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at

     http://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.

=cut

package XrefParser::DBASSParser;

use strict;
use warnings;

use DBI;
use Carp;

use parent qw( XrefParser::BaseParser );

# This parser will read direct xrefs from a comma-delimited file downloaded from the DBASS Web site.
# The columns of the file should be the following:
#
# 1)    DBASS Gene ID
# 2)    DBASS Gene Name
# 3)    Ensembl Gene ID
#
# where 2) can be either a single name, a 'name/synonym' pair, or a 'name (synonym)' pair.
# Column values, including empty strings, can be surrounded by pairs of double quotes.


sub run {
  my ( $self, $ref_arg ) = @_;
  my $source_id  = $ref_arg->{source_id};
  my $species_id = $ref_arg->{species_id};
  my $files      = $ref_arg->{files};
  my $verbose    = $ref_arg->{verbose};
  my $dbi        = $ref_arg->{dbi};

  if ( ( !defined $source_id ) or
       ( !defined $species_id ) or
       ( !defined $files ) )
  {
    croak 'Need to pass source_id, species_id and files as pairs';
  }
  $verbose //= 0;
  $dbi //= $self->dbi;

  my $filename = @{$files}[0];

  my $file_io = $self->get_filehandle($filename);
  if ( !defined($file_io) ) {
    return 1;
  }

  my $parsed_count = 0;

  # Skip the header line
  $file_io->getline();

  while ( defined( my $line = $file_io->getline() ) ) {

    # strip trailing whitespace
    $line =~ s{\s*\z}{}msx;
    # csv format can come with quoted columns, remove them. Note that this
    # assumes actual column values will never contain commas, which while
    # true at present brings into question why bother quoting them in the
    # first place.
    $line =~ s{"}{}gmsx;

    my ( $dbass_gene_id, $dbass_gene_name, $ensembl_id, @split_overflow ) =
      split( qr{,}msx, $line );

    # If Ensembl ID is the last column and quotation marks have already
    # been stripped, split() will leave $ensembl_id undefined for unmapped
    # entries. Therefore, only check the first two columns.
    # Conversely, if Ensembl ID is *not* the last column split() will set
    # $ensembl_id to an empty string for unmapped entries and correctly
    # assigns further tokens to the overflow array.
    if ( !defined($dbass_gene_id) || !defined($dbass_gene_name) ) {
      printf {*STDERR} ( "Line %d has fewer than two columns.\n",
                      1 + $parsed_count );
      print {*STDERR} ("The parsing failed\n");
      return 1;
    }
    elsif ( scalar @split_overflow > 0 ) {
      printf {*STDERR} ( "Line %d has more than three columns.\n",
                      1 + $parsed_count );
      print {*STDERR} ("The parsing failed\n");
      return 1;
    }

    # Do not attempt to create unmapped xrefs. Checking truthiness is good
    # enough here because the only non-empty string evaluating as false is
    # not a valid Ensembl stable ID.
    if ( $ensembl_id ) {

      # FIXME: .* is seriously inefficient because here it results in massive
      # amounts of backtracking. Could we be more specific, i.e. assume
      # some specific format of DBASS names?
      my ( $first_gene_name, $second_gene_name );
      if ( ( $dbass_gene_name =~ m{
                                    (.*)
                                    \s?\/\s?  # typically no ws here but just in case
                                    (.*)
                                  }msx ) ||
           ( $dbass_gene_name =~ m{
                                    (.*)
                                    \s?  # typically there IS a space before the ( here
                                    [(] (.*) [)]
                                  }msx ) ) {
        $first_gene_name  = $1;
        $second_gene_name = $2;
      }
      else {
        $first_gene_name = $dbass_gene_name;
        $second_gene_name = undef;
      }

      ++$parsed_count;

      my $label       = $first_gene_name;
      my $synonym     = $second_gene_name;
      my $type        = 'gene';
      my $version     = '1';

      my $xref_id =
        $self->get_xref( $dbass_gene_id, $source_id, $species_id, $dbi );

      if ( !defined($xref_id) || $xref_id eq q{} ) {
        $xref_id = $self->add_xref(
                                   { acc        => $dbass_gene_id,
                                     version    => $version,
                                     label      => $label,
                                     desc       => undef,
                                     source_id  => $source_id,
                                     dbi        => $dbi,
                                     species_id => $species_id,
                                     info_type  => "DIRECT" } );
      }

      if ( defined($synonym) ) {
{'fraction_non_alphanumeric': 0.1008151410100253, 'fraction_numerical': 0.00693338330366345, 'mean_word_length': 1.914004914004914, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 43, 'https://': 0, 'lorem ipsum': 0, 'www.': 2, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 42, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '2135913', 'n_tokens_mistral': 3320, 'n_tokens_neox': 3091, 'n_words': 1072}