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