1############################################################################### 2## ---------------------------------------------------------------------------- 3## Base package for helper classes. 4## 5############################################################################### 6 7use strict; 8use warnings; 9 10use 5.010001; 11 12no warnings qw( threads recursion uninitialized numeric ); 13 14package MCE::Shared::Base; 15 16our $VERSION = '1.874'; 17 18## no critic (BuiltinFunctions::ProhibitStringyEval) 19## no critic (Subroutines::ProhibitExplicitReturnUndef) 20 21use Scalar::Util qw( looks_like_number ); 22 23## 24# Several methods in MCE::Shared::{ Array, Cache, Hash, Minidb, and Ordhash } 25# take a query string for an argument. The format of the string is described 26# below. The _compile function is where the query string is evaluated and 27# expanded into Perl code. 28# 29# In the context of sharing, the query mechanism is beneficial for the 30# shared-manager process. The shared-manager runs the query where the data 31# resides versus sending data in whole to the client process for traversing. 32# Only the data found is sent back. 33# 34# o Basic demonstration 35# 36# @keys = $oh->keys( "query string given here" ); 37# @keys = $oh->keys( "val =~ /pattern/" ); 38# 39# o Supported operators: =~ !~ eq ne lt le gt ge == != < <= > >= 40# o Multiple expressions delimited by :AND or :OR, mixed case allowed 41# 42# "key eq 'some key' :or (val > 5 :and val < 9)" 43# "key eq some key :or (val > 5 :and val < 9)" 44# "key =~ /pattern/i :And field =~ /pattern/i" 45# "key =~ /pattern/i :And index =~ /pattern/i" 46# "index eq 'foo baz' :OR key !~ /pattern/i" # 9 eq 'foo baz' 47# "index eq foo baz :OR key !~ /pattern/i" # 9 eq foo baz 48# 49# MCE::Shared::{ Array, Cache, Hash, Ordhash } 50# * key matches on keys in the hash or index in the array 51# * likewise, val matches on values 52# 53# MCE::Shared::{ Minidb } 54# * key matches on primary keys in the hash (H)oH or (H)oA 55# * field matches on HoH->{key}{field} e.g. address 56# * index matches on HoA->{key}[index] e.g. 9 57# 58# o Quoting is optional inside the string 59# 60# "key =~ /pattern/i :AND field eq 'foo bar'" # address eq 'foo bar' 61# "key =~ /pattern/i :AND field eq foo bar" # address eq foo bar 62# 63# o See respective module in section labeled SYNTAX for QUERY STRING 64# for demonstrations 65## 66 67sub _compile { 68 my ( $query ) = @_; 69 my ( $len, @p ) = ( 0 ); 70 71 $query =~ s/^[\t ]+//; # strip white-space 72 $query =~ s/[\t ]+$//; 73 $query =~ s/\([\t ]+/(/g; 74 $query =~ s/[\t ]+\)/)/g; 75 76 for ( split( /[\t ]:(?:and|or)[\t ]/i, $query ) ) { 77 $len += length; 78 79 if ( /([\(]*)([^\(]+)[\t ]+(=~|!~)[\t ]+(.*)/ ) { 80 push @p, "$1($2 $3 $4)" 81 } 82 elsif ( /([\(]*)([^\(]+)[\t ]+(==|!=|<|<=|>|>=)[\t ]+([^\)]+)(.*)/ ) { 83 push @p, "$1($2 $3 q($4) && looks_like_number($2))$5"; 84 } 85 elsif ( /([\(]*)([^\(]+)[\t ]+(eq|ne|lt|le|gt|ge)[\t ]+([^\)]+)(.*)/ ) { 86 ( $4 eq 'undef' ) 87 ? push @p, "$1(!ref($2) && $2 $3 undef)$5" 88 : push @p, "$1(!ref($2) && $2 $3 q($4))$5"; 89 } 90 else { 91 push @p, $_; 92 } 93 94 $len += 6, push @p, " && " if ( lc ( substr $query, $len, 3 ) eq " :a" ); 95 $len += 5, push @p, " || " if ( lc ( substr $query, $len, 3 ) eq " :o" ); 96 } 97 98 $query = join('', @p); 99 $query =~ s/q\([\'\"]([^\(\)]*)[\'\"]\)/q($1)/g; 100 101 $query; 102} 103 104############################################################################### 105## ---------------------------------------------------------------------------- 106## Find items in ARRAY. Called by MCE::Shared::Array. 107## 108############################################################################### 109 110sub _find_array { 111 my ( $data, $params, $query ) = @_; 112 my $q = _compile( $query ); 113 114 # array key 115 $q =~ s/key[ ]+(==|!=|<|<=|>|>=|eq|ne|lt|le|gt|ge|=~|!~)/\$_ $1/gi; 116 $q =~ s/(looks_like_number)\(key\)/$1(\$_)/gi; 117 $q =~ s/(!ref)\(key\)/$1(\$_)/gi; 118 119 # array value 120 $q =~ s/val[ ]+(==|!=|<|<=|>|>=|eq|ne|lt|le|gt|ge|=~|!~)/\$data->[\$_] $1/gi; 121 $q =~ s/(looks_like_number)\(val\)/$1(\$data->[\$_])/gi; 122 $q =~ s/(!ref)\(val\)/$1(\$data->[\$_])/gi; 123 124 local $SIG{__WARN__} = sub { 125 print {*STDERR} "\nfind error: $_[0]\n query: $query\n eval : $q\n"; 126 }; 127 128 # wants keys 129 if ( $params->{'getkeys'} ) { 130 eval qq{ map { ($q) ? (\$_) : () } 0 .. \@{ \$data } - 1 }; 131 } 132 # wants values 133 elsif ( $params->{'getvals'} ) { 134 eval qq{ map { ($q) ? (\$data->[\$_]) : () } 0 .. \@{ \$data } - 1 }; 135 } 136 # wants pairs 137 else { 138 eval qq{ map { ($q) ? (\$_ => \$data->[\$_]) : () } 0 .. \@{ \$data } - 1 }; 139 } 140} 141 142############################################################################### 143## ---------------------------------------------------------------------------- 144## Find items in HASH. 145## Called by MCE::Shared::{ Cache, Hash, Minidb, Ordhash }. 146## 147############################################################################### 148 149sub _find_hash { 150 my ( $data, $params, $query, $obj ) = @_; 151 my $q = _compile( $query ); 152 my $grepvals = 0; 153 154 # hash key 155 $q =~ s/key[ ]+(==|!=|<|<=|>|>=|eq|ne|lt|le|gt|ge|=~|!~)/\$_ $1/gi; 156 $q =~ s/(looks_like_number)\(key\)/$1(\$_)/gi; 157 $q =~ s/(!ref)\(key\)/$1(\$_)/gi; 158 159 # Minidb (HoH) field 160 if ( exists $params->{'hfind'} ) { 161 $q =~ s/\$_ /:%: /g; # preserve $_ from hash key mods above 162 $q =~ s/([^:%\(\t ]+)[ ]+(==|!=|<|<=|>|>=|eq|ne|lt|le|gt|ge|=~|!~)/\$data->{\$_}{'$1'} $2/gi; 163 $q =~ s/:%: /\$_ /g; # restore hash key mods 164 $q =~ s/(looks_like_number)\(([^\$\)]+)\)/$1(\$data->{\$_}{'$2'})/gi; 165 $q =~ s/(!ref)\(([^\$\)]+)\)/$1(\$data->{\$_}{'$2'})/gi; 166 } 167 168 # Minidb (HoA) field 169 elsif ( exists $params->{'lfind'} ) { 170 $q =~ s/\$_ /:%: /g; # preserve $_ from hash key mods above 171 $q =~ s/([^:%\(\t ]+)[ ]+(==|!=|<|<=|>|>=|eq|ne|lt|le|gt|ge|=~|!~)/\$data->{\$_}['$1'] $2/gi; 172 $q =~ s/:%: /\$_ /g; # restore hash key mods 173 $q =~ s/(looks_like_number)\(([^\$\)]+)\)/$1(\$data->{\$_}['$2'])/gi; 174 $q =~ s/(!ref)\(([^\$\)]+)\)/$1(\$data->{\$_}['$2'])/gi; 175 } 176 177 # Cache/Hash/Ordhash value 178 elsif ( $params->{'getvals'} && $q !~ /\(\$_/ ) { 179 $grepvals = 1; 180 $q =~ s/val[ ]+(==|!=|<|<=|>|>=|eq|ne|lt|le|gt|ge|=~|!~)/\$_ $1/gi; 181 $q =~ s/(looks_like_number)\(val\)/$1(\$_)/gi; 182 $q =~ s/(!ref)\(val\)/$1(\$_)/gi; 183 } 184 else { 185 $q =~ s/val[ ]+(==|!=|<|<=|>|>=|eq|ne|lt|le|gt|ge|=~|!~)/\$data->{\$_} $1/gi; 186 $q =~ s/(looks_like_number)\(val\)/$1(\$data->{\$_})/gi; 187 $q =~ s/(!ref)\(val\)/$1(\$data->{\$_})/gi; 188 } 189 190 local $SIG{__WARN__} = sub { 191 print {*STDERR} "\nfind error: $_[0]\n query: $query\n eval : $q\n"; 192 }; 193 194 # wants keys 195 if ( $params->{'getkeys'} ) { 196 eval qq{ 197 map { ($q) ? (\$_) : () } 198 ( \$obj ? \$obj->keys : CORE::keys \%{\$data} ) 199 }; 200 } 201 # wants values 202 elsif ( $params->{'getvals'} ) { 203 $grepvals 204 ? eval qq{ 205 grep { ($q) } 206 ( \$obj ? \$obj->vals : CORE::values \%{\$data} ) 207 } 208 : eval qq{ 209 map { ($q) ? (\$data->{\$_}) : () } 210 ( \$obj ? \$obj->keys : CORE::keys \%{\$data} ) 211 }; 212 } 213 # wants pairs 214 else { 215 eval qq{ 216 map { ($q) ? (\$_ => \$data->{\$_}) : () } 217 ( \$obj ? \$obj->keys : CORE::keys \%{\$data} ) 218 }; 219 } 220} 221 222############################################################################### 223## ---------------------------------------------------------------------------- 224## Miscellaneous. 225## 226############################################################################### 227 228sub _stringify { no overloading; "$_[0]" } 229sub _numify { no overloading; 0 + $_[0] } 230 231# Croak handler. 232 233sub _croak { 234 if ( $INC{'MCE.pm'} ) { 235 goto &MCE::_croak; 236 } 237 elsif ( $INC{'MCE::Signal.pm'} ) { 238 $SIG{__DIE__} = \&MCE::Signal::_die_handler; 239 $SIG{__WARN__} = \&MCE::Signal::_warn_handler; 240 241 $\ = undef; goto &Carp::croak; 242 } 243 else { 244 require Carp unless $INC{'Carp.pm'}; 245 246 $\ = undef; goto &Carp::croak; 247 } 248} 249 250############################################################################### 251## ---------------------------------------------------------------------------- 252## Common API for MCE::Shared::{ Array, Cache, Hash, Minidb, Ordhash }. 253## 254############################################################################### 255 256package MCE::Shared::Base::Common; 257 258# pipeline ( [ func1, @args ], [ func2, @args ], ... ) 259 260sub pipeline { 261 my $self = shift; 262 my $tmp; $tmp = pop if ( defined wantarray ); 263 264 while ( @_ ) { 265 my $cmd = shift; next unless ( ref $cmd eq 'ARRAY' ); 266 if ( my $code = $self->can(shift @{ $cmd }) ) { 267 $code->($self, @{ $cmd }); 268 } 269 } 270 271 if ( defined $tmp ) { 272 my $code; 273 return ( ref $tmp eq 'ARRAY' && ( $code = $self->can(shift @{ $tmp }) ) ) 274 ? $code->($self, @{ $tmp }) 275 : undef; 276 } 277 278 return; 279} 280 281# pipeline_ex ( [ func1, @args ], [ func2, @args ], ... ) 282 283sub pipeline_ex { 284 my $self = shift; 285 my $code; 286 287 map { 288 ( ref $_ eq 'ARRAY' && ( $code = $self->can(shift @{ $_ }) ) ) 289 ? $code->($self, @{ $_ }) 290 : undef; 291 } @_; 292} 293 2941; 295 296__END__ 297 298############################################################################### 299## ---------------------------------------------------------------------------- 300## Module usage. 301## 302############################################################################### 303 304=head1 NAME 305 306MCE::Shared::Base - Base package for helper classes 307 308=head1 VERSION 309 310This document describes MCE::Shared::Base version 1.874 311 312=head1 DESCRIPTION 313 314Common functions for L<MCE::Shared>. There is no public API. 315 316=head1 INDEX 317 318L<MCE|MCE>, L<MCE::Hobo>, L<MCE::Shared> 319 320=head1 AUTHOR 321 322Mario E. Roy, S<E<lt>marioeroy AT gmail DOT comE<gt>> 323 324=cut 325 326