<commit_before>=head1 LICENSE

  Copyright (c) 1999-2013 The European Bioinformatics Institute and
  Genome Research Limited.  All rights reserved.

  This software is distributed under a modified Apache license.
  For license details, please see

   http://www.ensembl.org/info/about/code_licence.html

=head1 CONTACT

  Please email comments or questions to the public Ensembl
  developers list at <<EMAIL>>.

  Questions may also be sent to the Ensembl help desk at
  <<EMAIL>>.

=head1 NAME

Bio::EnsEMBL::Compara::DBSQL::TagAdaptor

=head1 DESCRIPTION

Generic adaptor that gives a database backend for tags / attributes (to
use with Bio::EnsEMBL::Compara::Taggable). There can be any number of
values for tags, but at most one for each attribute.

=head1 MAINTAINER

$Author$

=head VERSION

$Revision$

=head1 APPENDIX

The rest of the documentation details each of the object methods.
Internal methods are usually preceded with a _

=cut

package Bio::EnsEMBL::Compara::DBSQL::TagAdaptor;

use strict;


=head2 _tag_capabilities

  Description: returns the tag/attributes capabilities for the object. The
               return value is an array with 4 entries:
                - the name of the table to store tag
                - the name of the table to store attribute
                - the name of the key column in the tables
                - the name of the perl method to have the key value
  Arg [1]    : <scalar> reference object
  Example    : return ("species_set_tag", undef, "species_set_id", "dbID");
  Returntype : Array of 4 entries
  Exceptions : none
  Caller     : internal

=cut

sub _tag_capabilities {
    my ($self, $object) = @_;

    die "_tag_capabilities for $object must be redefined in $self (or a subclass)\n";
    #return ("protein_tree_tag", "protein_tree_attr", "node_id", "node_id");
}


=head2 _load_tagvalues

  Description: retrieves all the tags and attributes from the database and
               calls add_tag to store them in the PERL hash
  Arg [1]    : <scalar> reference object
  Example    : $genetree_adaptor->_load_tagvalues($tree);
  Returntype : none
  Exceptions : none
  Caller     : internal

=cut

sub _load_tagvalues {
    my $self = shift;
    my $object = shift;

    #print STDERR "CALL _load_tagvalues $self/$object\n";
    my ($db_tagtable, $db_attrtable, $db_keyname, $perl_keyname) = $self->_tag_capabilities($object);
    #print STDERR "_load_tagvalues = $db_tagtable/$db_attrtable\n";
 
    # Tags (multiple values are allowed)
    my $sth = $self->prepare("SELECT tag, value FROM $db_tagtable WHERE $db_keyname=?");
    $sth->execute($object->$perl_keyname);
    while (my ($tag, $value) = $sth->fetchrow_array()) {
        $object->add_tag($tag, $value, 1);
    }
    $sth->finish;
   
    # Attributes ?
    if (defined $db_attrtable) {
        # Attributes (multiple values are forbidden)
        $sth = $self->prepare("SELECT * FROM $db_attrtable WHERE $db_keyname=? LIMIT 1");
        $sth->execute($object->$perl_keyname);
        # Retrieve data
        my $attrs = $sth->fetchrow_hashref();
        if (defined $attrs) {
            foreach my $key (keys %$attrs) {
                if (($key ne $db_keyname) and defined(${$attrs}{$key})) {
                    $object->add_tag($key, ${$attrs}{$key});
                }
            }
        }
        $sth->finish;
    }
}


=head2 _load_tagvalues_multiple

  Description: similar to _load_tagvalues, but applies on a whole list
               of objects (assumed to be all of the same type)
  Arg [1..n] : <scalar> reference object
  Example    : $genetreenode_adaptor->_load_tagvalues_multiples($node1, $node2);
  Returntype : none
  Exceptions : none
  Caller     : internal

=cut

sub _load_tagvalues_multiple {
    my $self = shift;

    # Assumes that all the objects have the same type
    my ($db_tagtable, $db_attrtable, $db_keyname, $perl_keyname) = $self->_tag_capabilities($_[0]);

    map {$_->{'_tags'} = {}} (grep {not exists $_->{'_tags'}} @_);

    my %perl_keys = map {$_->$perl_keyname => $_} @_;
    my $where_constraint = join(',', keys %perl_keys);

    # Tags (multiple values are allowed)
    my $sth = $self->prepare("SELECT $db_keyname, tag, value FROM $db_tagtable WHERE $db_keyname IN ($where_constraint)");
    $sth->execute();
    while (my ($obj_id, $tag, $value) = $sth->fetchrow_array()) {
        $perl_keys{$obj_id}->add_tag($tag, $value, 1);
        #warn "adding $value to $tag of $obj_id";
    }
    $sth->finish;
   
    # Attributes ?
    if (defined $db_attrtable) {
        $sth = $self->prepare("SELECT * FROM $db_attrtable WHERE $db_keyname IN ($where_constraint)");
        $sth->execute();
        # Retrieve data
        while (my $attrs = $sth->fetchrow_hashref()) {
            my $object = $perl_keys{$attrs->{$db_keyname}};
            foreach my $key (keys %$attrs) {
                if (($key ne $db_keyname) and defined(${$attrs}{$key})) {
                    $object->add_tag($key, ${$attrs}{$key});
                }
            }<commit_msg>Introduces a -all_objects flag in _load_tagvalues_multiple()<commit_after>=head1 LICENSE

  Copyright (c) 1999-2013 The European Bioinformatics Institute and
  Genome Research Limited.  All rights reserved.

  This software is distributed under a modified Apache license.
  For license details, please see

   http://www.ensembl.org/info/about/code_licence.html

=head1 CONTACT

  Please email comments or questions to the public Ensembl
  developers list at <<EMAIL>>.

  Questions may also be sent to the Ensembl help desk at
  <<EMAIL>>.

=head1 NAME

Bio::EnsEMBL::Compara::DBSQL::TagAdaptor

=head1 DESCRIPTION

Generic adaptor that gives a database backend for tags / attributes (to
use with Bio::EnsEMBL::Compara::Taggable). There can be any number of
values for tags, but at most one for each attribute.

=head1 MAINTAINER

$Author$

=head VERSION

$Revision$

=head1 APPENDIX

The rest of the documentation details each of the object methods.
Internal methods are usually preceded with a _

=cut

package Bio::EnsEMBL::Compara::DBSQL::TagAdaptor;

use strict;


=head2 _tag_capabilities

  Description: returns the tag/attributes capabilities for the object. The
               return value is an array with 4 entries:
                - the name of the table to store tag
                - the name of the table to store attribute
                - the name of the key column in the tables
                - the name of the perl method to have the key value
  Arg [1]    : <scalar> reference object
  Example    : return ("species_set_tag", undef, "species_set_id", "dbID");
  Returntype : Array of 4 entries
  Exceptions : none
  Caller     : internal

=cut

sub _tag_capabilities {
    my ($self, $object) = @_;

    die "_tag_capabilities for $object must be redefined in $self (or a subclass)\n";
    #return ("protein_tree_tag", "protein_tree_attr", "node_id", "node_id");
}


=head2 _load_tagvalues

  Description: retrieves all the tags and attributes from the database and
               calls add_tag to store them in the PERL hash
  Arg [1]    : <scalar> reference object
  Example    : $genetree_adaptor->_load_tagvalues($tree);
  Returntype : none
  Exceptions : none
  Caller     : internal

=cut

sub _load_tagvalues {
    my $self = shift;
    my $object = shift;

    #print STDERR "CALL _load_tagvalues $self/$object\n";
    my ($db_tagtable, $db_attrtable, $db_keyname, $perl_keyname) = $self->_tag_capabilities($object);
    #print STDERR "_load_tagvalues = $db_tagtable/$db_attrtable\n";
 
    # Tags (multiple values are allowed)
    my $sth = $self->prepare("SELECT tag, value FROM $db_tagtable WHERE $db_keyname=?");
    $sth->execute($object->$perl_keyname);
    while (my ($tag, $value) = $sth->fetchrow_array()) {
        $object->add_tag($tag, $value, 1);
    }
    $sth->finish;
   
    # Attributes ?
    if (defined $db_attrtable) {
        # Attributes (multiple values are forbidden)
        $sth = $self->prepare("SELECT * FROM $db_attrtable WHERE $db_keyname=? LIMIT 1");
        $sth->execute($object->$perl_keyname);
        # Retrieve data
        my $attrs = $sth->fetchrow_hashref();
        if (defined $attrs) {
            foreach my $key (keys %$attrs) {
                if (($key ne $db_keyname) and defined(${$attrs}{$key})) {
                    $object->add_tag($key, ${$attrs}{$key});
                }
            }
        }
        $sth->finish;
    }
}


=head2 _load_tagvalues_multiple

  Description: similar to _load_tagvalues, but applies on a whole list
               of objects (assumed to be all of the same type)
  Arg [1..n] : <scalar> reference object
  Example    : $genetreenode_adaptor->_load_tagvalues_multiples($node1, $node2);
  Returntype : none
  Exceptions : none
  Caller     : internal

=cut

sub _load_tagvalues_multiple {
    my $self = shift;

    # Assumes that all the objects have the same type
    my ($db_tagtable, $db_attrtable, $db_keyname, $perl_keyname);

    my $use_where = 1;
    my %perl_keys = ();
    foreach my $val (@_) {
        if (ref $val) {
            unless (%perl_keys) {
                ($db_tagtable, $db_attrtable, $db_keyname, $perl_keyname) = $self->_tag_capabilities($val);
            }
            $val->{'_tags'} = {} unless exists $val->{'_tags'};
            $perl_keys{$val->$perl_keyname} = $val;
        } else {
            # This flag means that @_ contains all the objects from the database
            # In that case, we don't need to restrict the SELECT statements with a WHERE constraint
            if (lc $val eq '-all_objects') {
                $use_where = 0;
            }
        }
    };

    my $where_constraint = '';
    if ($use_where) {
        $where_constraint = "WHERE $db_keyname IN (".join(',', keys %perl_keys).")";
    }

    # Tags (multiple values are allowed)
    my $sth = $self->prepare("SELECT $db_keyname, tag, value FROM $db_tagtable $where_constraint");
    $sth->execute();
    while (my ($obj_id, $tag, $value) = $sth->fetchrow_array()) {
        next if not $use_where and not exists $perl_keys{$obj_id};
        $perl_keys{$obj_id}->add_tag($tag, $value, 1);
        #warn "adding $value to $tag of $obj_id";
    }
    $sth->finish;
   
    # Attributes ?
    if (defined $db_attrtable) {
        $sth = $self->prepare("SELECT * FROM $db_attrtable $where_constraint");
        $sth->execute();
        # Retrieve data
        while (my $attrs = $sth->fetchrow_hashref()) {
            my $object = $perl_keys{$attrs->{$db_keyname}};
            foreach my $key (keys %$attrs) {
                if (($key ne $db_keyname) and defined(${$attrs}{$key})) {
                    $object->add_tag($key, ${$attrs}{$key});
                }
            }
{'fraction_non_alphanumeric': 0.11799217731421122, 'fraction_numerical': 0.005308251070962935, 'mean_word_length': 2.806806097128678, 'pattern_counts': {'":': 0, '<': 17, '<?xml version=': 0, '>': 76, 'https://': 0, 'lorem ipsum': 0, 'www.': 2, 'xml': 0}, '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': '6263646', 'n_tokens_mistral': 3507, 'n_tokens_neox': 3385, 'n_words': 1034}