File Coverage

blib/lib/MCE/Shared/Array.pm

Criterion	Covered	Total	%
statement	36	186	19.3
branch	6	84	7.1
condition	1	28	3.5
subroutine	11	46	23.9
pod	22	22	100.0
total	76	366	20.7

###############################################################################
## ----------------------------------------------------------------------------
## Array helper class.
##
###############################################################################

package MCE::Shared::Array;

use strict;
use warnings;

use 5.010001;

no warnings qw( threads recursion uninitialized numeric );

our $VERSION = '1.885';

## no critic (TestingAndDebugging::ProhibitNoStrict)

use MCE::Shared::Base ();
use base 'MCE::Shared::Base::Common';

use overload (
   q("")    => \&MCE::Shared::Base::_stringify,
   q(0+)    => \&MCE::Shared::Base::_numify,
   fallback => 1
);

###############################################################################
## ----------------------------------------------------------------------------
## Based on Tie::StdArray from Tie::Array.
##
###############################################################################

sub TIEARRAY {
   my $self = bless [], shift;
   @{ $self } = @_ if @_;

   $self;
}

sub EXTEND { }

sub FETCHSIZE { scalar @{ $_[0] } }
sub STORESIZE { $#{ $_[0] } = $_[1] - 1 }

sub STORE     { $_[0]->[ $_[1] ] = $_[2] }
sub FETCH     { $_[0]->[ $_[1] ] }
sub DELETE    { delete $_[0]->[ $_[1] ] }
sub EXISTS    { exists $_[0]->[ $_[1] ] }
sub CLEAR     { @{ $_[0] } = () }
sub POP       { pop @{ $_[0] } }
sub PUSH      { my $ob = shift; push @{ $ob }, @_ }
sub SHIFT     { shift @{ $_[0] } }
sub UNSHIFT   { my $ob = shift; unshift @{ $ob }, @_ }

# SPLICE ( offset [, length [, list ] ] )

sub SPLICE {
   my $ob  = shift;
   my $sz  = $ob->FETCHSIZE;
   my $off = @_ ? shift : 0;
   $off   += $sz if $off < 0;
   my $len = @_ ? shift : $sz-$off;

   splice @{ $ob }, $off, $len, @_;
}

###############################################################################
## ----------------------------------------------------------------------------
## _find, clone, flush, iterator, keys, pairs, values
##
###############################################################################

# _find ( { getkeys => 1 }, "query string" )
# _find ( { getvals => 1 }, "query string" )
# _find ( "query string" ) # pairs

sub _find {
   my $self   = shift;
   my $params = ref($_[0]) eq 'HASH' ? shift : {};
   my $query  = shift;

   MCE::Shared::Base::_find_array( $self, $params, $query );
}

# clone ( key [, key, ... ] )
# clone ( )

sub clone {
   my $self = shift;
   my $params = ref($_[0]) eq 'HASH' ? shift : {};
   my @data = ( @_ ) ? @{ $self }[ @_ ] : @{ $self };

   $self->clear() if $params->{'flush'};

   bless \@data, ref $self;
}

# flush ( key [, key, ... ] )
# flush ( )

sub flush {
   shift()->clone( { flush => 1 }, @_ );
}

# iterator ( key [, key, ... ] )
# iterator ( "query string" )
# iterator ( )

sub iterator {
   my ( $self, @keys ) = @_;

   if ( ! @keys ) {
      @keys = ( 0 .. $#{ $self } );
   }
   elsif ( @keys == 1 && $keys[0] =~ /^(?:key|val)[ ]+\S\S?[ ]+\S/ ) {
      @keys = $self->keys($keys[0]);
   }

   return sub {
      return unless @keys;
      my $key = shift @keys;
      return ( $key => $self->[ $key ] );
   };
}

# keys ( key [, key, ... ] )
# keys ( "query string" )
# keys ( )

sub keys {
   my $self = shift;

   if ( @_ == 1 && $_[0] =~ /^(?:key|val)[ ]+\S\S?[ ]+\S/ ) {
      $self->_find({ getkeys => 1 }, @_);
   }
   elsif ( wantarray ) {
      @_ ? map { exists $self->[ $_ ] ? $_ : undef } @_
         : ( 0 .. $#{ $self } );
   }
   else {
      scalar @{ $self };
   }
}

# pairs ( key [, key, ... ] )
# pairs ( "query string" )
# pairs ( )

sub pairs {
   my $self = shift;

   if ( @_ == 1 && $_[0] =~ /^(?:key|val)[ ]+\S\S?[ ]+\S/ ) {
      $self->_find(@_);
   }
   elsif ( wantarray ) {
      @_ ? map { $_ => $self->[ $_ ] } @_
         : map { $_ => $self->[ $_ ] } 0 .. $#{ $self };
   }
   else {
      scalar @{ $self };
   }
}

# values ( key [, key, ... ] )
# values ( "query string" )
# values ( )

sub values {
   my $self = shift;

   if ( @_ == 1 && $_[0] =~ /^(?:key|val)[ ]+\S\S?[ ]+\S/ ) {
      $self->_find({ getvals => 1 }, @_);
   }
   elsif ( wantarray ) {
      @_ ? @{ $self }[ @_ ]
         : @{ $self }
   }
   else {
      scalar @{ $self };
   }
}

###############################################################################
## ----------------------------------------------------------------------------
## assign, mdel, mexists, mget, mset, range, sort
##
###############################################################################

# assign ( value [, value, ... ] )

sub assign {
   $_[0]->clear; shift()->push(@_);
}

# mdel ( index [, index, ... ] )

sub mdel {
   my $self = shift;
   my ( $cnt, $key ) = ( 0 );

   while ( @_ ) {
      $key = shift;
      $cnt++, delete($self->[ $key ]) if ( exists $self->[ $key ] );
   }

   $cnt;
}

# mexists ( index [, index, ... ] )

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

   while ( @_ ) {
      $key = shift;
      return '' unless ( exists $self->[ $key ] );
   }

   1;
}

# mget ( index [, index, ... ] )

sub mget {
   my $self = shift;

   @_ ? @{ $self }[ @_ ] : ();
}

# mset ( index, value [, index, value, ... ] )

sub mset {
   my ( $self, $key ) = ( shift );

   while ( @_ ) {
      $key = shift, $self->[ $key ] = shift;
   }

   defined wantarray ? scalar @{ $self } : ();
}

# range ( start, stop )

sub range {
   my ( $self, $start, $stop ) = @_;

   if ( $start !~ /^\-?\d+$/ || $stop !~ /^\-?\d+$/ || $start > $#{ $self } ) {
      return ();
   }

   if ( $start < 0 ) {
      $start = @{ $self } + $start;
      $start = 0 if $start < 0;
   }

   if ( $stop < 0 ) {
      $stop = @{ $self } + $stop;
      $stop = 0 if $stop < 0;
   }
   else {
      $stop = $#{ $self } if $stop > $#{ $self };
   }

   @{ $self }[ $start .. $stop ];
}

# sort ( "BY val [ ASC | DESC ] [ ALPHA ]" )
# sort ( "[ ASC | DESC ] [ ALPHA ]" ) # same as "BY val ..."

sub sort {
   my ( $self, $request ) = @_;
   my ( $alpha, $desc ) = ( 0, 0 );

   if ( length $request ) {
      $alpha = 1 if ( $request =~ /\balpha\b/i );
      $desc  = 1 if ( $request =~ /\bdesc\b/i );
   }

   # Return sorted values, leaving the data intact.

   if ( defined wantarray ) {
      if ( $alpha ) { ( $desc )
         ? CORE::sort { $b cmp $a } @{ $self }
         : CORE::sort { $a cmp $b } @{ $self };
      }
      else { ( $desc )
         ? CORE::sort { $b <=> $a } @{ $self }
         : CORE::sort { $a <=> $b } @{ $self };
      }
   }

   # Sort values in-place otherwise, in void context.

   elsif ( $alpha ) { ( $desc )
      ? do { @{ $self } = CORE::sort { $b cmp $a } @{ $self } }
      : do { @{ $self } = CORE::sort { $a cmp $b } @{ $self } };
   }
   else { ( $desc )
      ? do { @{ $self } = CORE::sort { $b <=> $a } @{ $self } }
      : do { @{ $self } = CORE::sort { $a <=> $b } @{ $self } };
   }
}

###############################################################################
## ----------------------------------------------------------------------------
## Sugar API, mostly resembles https://redis.io/commands#string primitives.
##
###############################################################################

# append ( index, string )

sub append {
   length( $_[0]->[ $_[1] ] .= $_[2] // '' );
}

# decr    ( index )
# decrby  ( index, number )
# incr    ( index )
# incrby  ( index, number )
# getdecr ( index )
# getincr ( index )

sub decr    { --$_[0]->[ $_[1] ]               }
sub decrby  {   $_[0]->[ $_[1] ] -= $_[2] || 0 }
sub incr    { ++$_[0]->[ $_[1] ]               }
sub incrby  {   $_[0]->[ $_[1] ] += $_[2] || 0 }
sub getdecr {   $_[0]->[ $_[1] ]--        // 0 }
sub getincr {   $_[0]->[ $_[1] ]++        // 0 }

# getset ( index, value )

sub getset {
   my $old = $_[0]->[ $_[1] ];
   $_[0]->[ $_[1] ] = $_[2];

   $old;
}

# len ( index )
# len ( )

sub len {
   ( defined $_[1] )
      ? length $_[0]->[ $_[1] ]
      : scalar @{ $_[0] };
}

{
   no strict 'refs';

   *{ __PACKAGE__.'::new'     } = \&TIEARRAY;
   *{ __PACKAGE__.'::set'     } = \&STORE;
   *{ __PACKAGE__.'::get'     } = \&FETCH;
   *{ __PACKAGE__.'::delete'  } = \&DELETE;
   *{ __PACKAGE__.'::exists'  } = \&EXISTS;
   *{ __PACKAGE__.'::clear'   } = \&CLEAR;
   *{ __PACKAGE__.'::pop'     } = \&POP;
   *{ __PACKAGE__.'::push'    } = \&PUSH;
   *{ __PACKAGE__.'::shift'   } = \&SHIFT;
   *{ __PACKAGE__.'::unshift' } = \&UNSHIFT;
   *{ __PACKAGE__.'::splice'  } = \&SPLICE;
   *{ __PACKAGE__.'::del'     } = \&delete;
   *{ __PACKAGE__.'::merge'   } = \&mset;
   *{ __PACKAGE__.'::vals'    } = \&values;
}

1;

__END__