<commit_before>package EnsEMBL::Web::Cache;

## This module overwrites several subroutines from Cache::Memcached
## to be able to track and monitor memcached statistics better
## this applies only when debug mode is on

use strict;
use Data::Dumper;
use SiteDefs;
use base 'Cache::Memcached';
use fields qw(default_exptime flags hm_stats);

no warnings;

sub new {
  my $class  = shift;
  my $caller = caller;
  my $memcached    = $SiteDefs::ENSEMBL_MEMCACHED;
  
  return undef
    unless $memcached && %$memcached;

  my $flags = $memcached->{flags} || [ qw(PLUGGABLE_PATHS TMP_IMAGES) ];

  my %flags = map { $_ => 1 } @$flags;
     
  return undef if $caller->isa('EnsEMBL::Web::Apache::Handlers')
                  && !$flags{PLUGGABLE_PATHS};
  return undef if $caller->isa('EnsEMBL::Web::Apache::SendDecPage')
                  && !$flags{STATIC_PAGES_CONTENT};
  return undef if $caller->isa('EnsEMBL::Web::DBSQL::UserDBConnection')
                  && !$flags{USER_DB_DATA};
  return undef if $caller->isa('EnsEMBL::Web::DBSQL::WebDBConnection')
                  && !$flags{WEBSITE_DB_DATA};
  return undef if $caller->isa('EnsEMBL::Web::File::Driver::Memcached')
                  && !$flags{TMP_IMAGES};
  return undef if $caller->isa('EnsEMBL::Web::Apache::Image')
                  && !$flags{TMP_IMAGES};
  return undef if $caller->isa('EnsEMBL::Web::Magic')
                  && !$flags{DYNAMIC_PAGES_CONTENT};
  return undef if $caller->isa('EnsEMBL::Web::Configuration')
                  && !$flags{ORDERED_TREE};
  return undef if $caller->isa('EnsEMBL::Web::Object')
                  && !$flags{OBJECTS_COUNTS};
  return undef if $caller->isa('EnsEMBL::Web::ImageConfig')
                  && !$flags{IMAGE_CONFIG};

  my %args = (
    servers         => $memcached->{servers},
    debug           => $memcached->{debug},
    hm_stats        => $memcached->{hm_stats},
    default_exptime => $memcached->{default_exptime},
    namespace       => $SiteDefs::ENSEMBL_BASE_URL,
    @,
  );

  my $default_exptime = delete $args{default_exptime};

  my $self = $class->SUPER::new(\%args);
  $self->enable_compress(0) unless $args{enable_compress};

  $self->{default_exptime} = $default_exptime;
  $self->{flags}           = \%flags;
  $self->{hm_stats}        = delete $args{hm_stats};
  
  return $self;
}

sub flags :lvalue { $_[0]->{'flags'}; }

sub add_tags {
  my $self = shift;
  my $key  = shift;
  my @tags = @_;

  _warn("MEMCACHED->add_tags( $key, ".join(', ', @tags).')');

  my $sock = $self->get_sock($key);
  foreach my $tag (@tags) {
    my $cmd = "tag_add $tag $self->{namespace}$key\r\n";
    my $res = $self->_write_and_read($sock, $cmd);
    return 0 unless $res eq "TAG_STORED\r\n";
  }

  return 1;
}


##
## delete_by_tags(@tags)
## deletes all and only items which have ALL tags specified
##
sub delete_by_tags {
  my $self = shift;
  my @tags = (@_, $self->{namespace});

  _warn('MEMCACHED->delete_by_tags( '.join(', ', @tags).')');

  my $cmd = 'tags_delete '.join(' ', @tags)."\r\n";
  my $items_deleted = 0;

  my @hosts = @{$self->{'buckets'}};
  foreach my $host (@hosts) {
      my $sock = $self->sock_to_host($host);
      my $res = $self->_write_and_read($sock, $cmd);
      if ($res =~ /^(\d+) ITEMS_DELETED/) {
        $items_deleted += $1;
      }
  }

  _warn("MEMCACHED: $items_deleted items deleted");
  
  return $items_deleted;

  #  } else { ## just 1 tag, better use tag_delete (faster)
  #    my $cmd = 'tag_delete '.$tags[0]."\r\n";
  #    my $res = $self->_write_and_read($sock, $cmd);
  #    return $res eq "TAG_DELETED\r\n";
  #  }
}

sub set {
  my $self = shift;
  my ($key, $value, $exptime, @tags) = @_;
  return unless $value;
  
  _warn("MEMCACHED->set($self->{namespace}$key)");
  
  ## TMP workaround: add extra tag for everything except user upload data
  push @tags, 'no_user_upload'
    unless 'EnsEMBL::Web::File::Driver::Memcached' eq caller;
  
  my $result = $self->SUPER::set($key, $value, $exptime || $self->{default_exptime});

  $self->add_tags($key, $self->{namespace}, @tags)
    if $result;
    
  return $result;
}

sub get {
  my $self = shift;
  my $key  = shift;
  my @tags = @_;

  _warn("MEMCACHED->get($key)");
  
  my $result = $self->SUPER::get($key);

  ## Hits & Misses statistics
  if ($self->{hm_stats} && @tags) {
    my $suffix = $result ? '::HITS' : '::MISSES';
    $self->incr("$_$suffix") for ($self->{namespace}, @tags);
  }

  return $result;
}

sub incr {
  my $self = shift;
  my $key  = shift;

  warn("MEMCACHED->incr($key)");

  $self->set($key, 1, undef, 'STATS')
    unless $self->SUPER::incr($key);
  
#  $self->set($key, 0, undef, 'STATS')
#    unless $self->SUPER::incr($key);
}

sub delete {<commit_msg>*** empty log message ***<commit_after>package EnsEMBL::Web::Cache;

## This module overwrites several subroutines from Cache::Memcached
## to be able to track and monitor memcached statistics better
## this applies only when debug mode is on

use strict;
use Data::Dumper;
use SiteDefs;
use base 'Cache::Memcached';
use fields qw(default_exptime flags hm_stats);

no warnings;

sub new {
  my $class  = shift;
  my $caller = caller;
  my $memcached    = $SiteDefs::ENSEMBL_MEMCACHED;
  
  return undef
    unless $memcached && %$memcached;

  my $flags = $memcached->{flags} || [ qw(PLUGGABLE_PATHS TMP_IMAGES) ];

  my %flags = map { $_ => 1 } @$flags;
     
  return undef if $caller->isa('EnsEMBL::Web::Apache::Handlers')
                  && !$flags{PLUGGABLE_PATHS};
  return undef if $caller->isa('EnsEMBL::Web::Apache::SendDecPage')
                  && !$flags{STATIC_PAGES_CONTENT};
  return undef if $caller->isa('EnsEMBL::Web::DBSQL::UserDBConnection')
                  && !$flags{USER_DB_DATA};
  return undef if $caller->isa('EnsEMBL::Web::DBSQL::WebDBConnection')
                  && !$flags{WEBSITE_DB_DATA};
  return undef if $caller->isa('EnsEMBL::Web::File::Driver::Memcached')
                  && !$flags{TMP_IMAGES};
  return undef if $caller->isa('EnsEMBL::Web::Apache::Image')
                  && !$flags{TMP_IMAGES};
  return undef if $caller->isa('EnsEMBL::Web::Magic')
                  && !$flags{DYNAMIC_PAGES_CONTENT};
  return undef if $caller->isa('EnsEMBL::Web::Configuration')
                  && !$flags{ORDERED_TREE};
  return undef if $caller->isa('EnsEMBL::Web::Object')
                  && !$flags{OBJECTS_COUNTS};
  return undef if $caller->isa('EnsEMBL::Web::ImageConfig')
                  && !$flags{IMAGE_CONFIG};

  my %args = (
    servers         => $memcached->{servers},
    debug           => $memcached->{debug},
    hm_stats        => $memcached->{hm_stats},
    default_exptime => $memcached->{default_exptime},
    namespace       => $SiteDefs::ENSEMBL_BASE_URL,
    @,
  );

  my $default_exptime = delete $args{default_exptime};

  my $self = $class->SUPER::new(\%args);
  $self->enable_compress(0) unless $args{enable_compress};

  $self->{default_exptime} = $default_exptime;
  $self->{flags}           = \%flags;
  $self->{hm_stats}        = delete $args{hm_stats};
  
  return $self;
}

sub flags :lvalue { $_[0]->{'flags'}; }

sub add_tags {
  my $self = shift;
  my $key  = shift;
  my @tags = @_;

  _warn("MEMCACHED->add_tags( $key, ".join(', ', @tags).')');

  my $sock = $self->get_sock($key);
  foreach my $tag (@tags) {
    my $cmd = "tag_add $tag $self->{namespace}$key\r\n";
    my $res = $self->_write_and_read($sock, $cmd);
    return 0 unless $res eq "TAG_STORED\r\n";
  }

  return 1;
}


##
## delete_by_tags(@tags)
## deletes all and only items which have ALL tags specified
##
sub delete_by_tags {
  my $self = shift;
  my @tags = (@_, $self->{namespace});

  _warn('MEMCACHED->delete_by_tags( '.join(', ', @tags).')');

  my $cmd = 'tags_delete '.join(' ', @tags)."\r\n";
  my $items_deleted = 0;

  my @hosts = @{$self->{'buckets'}};
  foreach my $host (@hosts) {
      my $sock = $self->sock_to_host($host);
      my $res = $self->_write_and_read($sock, $cmd);
      if ($res =~ /^(\d+) ITEMS_DELETED/) {
        $items_deleted += $1;
      }
  }

  _warn("MEMCACHED: $items_deleted items deleted");
  
  return $items_deleted;

  #  } else { ## just 1 tag, better use tag_delete (faster)
  #    my $cmd = 'tag_delete '.$tags[0]."\r\n";
  #    my $res = $self->_write_and_read($sock, $cmd);
  #    return $res eq "TAG_DELETED\r\n";
  #  }
}

sub set {
  my $self = shift;
  my ($key, $value, $exptime, @tags) = @_;
  return unless $value;
  
  _warn("MEMCACHED->set($self->{namespace}$key)");
  
  ## TMP workaround: add extra tag for everything except user upload data
  push @tags, 'no_user_upload'
    unless 'EnsEMBL::Web::File::Driver::Memcached' eq caller;
  
  my $result = $self->SUPER::set($key, $value, $exptime || $self->{default_exptime});

  $self->add_tags($key, $self->{namespace}, @tags)
    if $result;
    
  return $result;
}

sub get {
  my $self = shift;
  my $key  = shift;
  my @tags = @_;

  _warn("MEMCACHED->get($key)");
  
  my $result = $self->SUPER::get($key);

  ## Hits & Misses statistics
  if ($self->{hm_stats} && @tags) {
    my $suffix = $result ? '::HITS' : '::MISSES';
    $self->incr("$_$suffix") for ($self->{namespace}, @tags);
  }

  return $result;
}

sub incr {
  my $self = shift;
  my $key  = shift;

  _warn("MEMCACHED->incr($key)");

  $self->set($key, 1, undef, 'STATS')
    unless $self->SUPER::incr($key);
}

sub delete {
{'fraction_non_alphanumeric': 0.1854812919731372, 'fraction_numerical': 0.002238567316917173, 'mean_word_length': 3.272313296903461, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 107, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, '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': '1656482', 'n_tokens_mistral': 3605, 'n_tokens_neox': 3468, 'n_words': 732}