1#!/usr/local/bin/perl 2 3use lib './lib'; 4 5use Data::Dumper; 6use Sys::Hostname; 7use Net::Cassandra::Easy; 8use Getopt::Long; 9use POSIX; 10use Time::HiRes qw( gettimeofday usleep ); 11use Term::ReadLine; 12use Hash::Merge qw/merge/; 13use Modern::Perl; 14use Parse::RecDescent; 15 16my %options = 17 ( 18 verbose => 0, 19 quiet => 0, 20 server => $ENV{CASSANDRA_SERVER}, 21 port => $ENV{CASSANDRA_PORT}, 22 keyspace => $ENV{CASSANDRA_KEYSPACE}, 23 ); 24 25GetOptions ( 26 \%options, 27 "debug|d", 28 "quiet|q", 29 "server=s", 30 "port=i", 31 "keyspace=s", 32 ); 33 34$|=1; 35 36my $debug = $Net::Cassandra::Easy::DEBUG = $options{debug}; 37 38use constant MAX_LONG => Bit::Vector->new_Bin(64, '0' . '1'x63); 39 40use constant OFFSET_REGEX => qr/^[-+]\d+$/; # +1, +2, -1, -2, etc. 41 42use constant TYPE_NUMERIC => 'numeric'; 43use constant TYPE_NONNUMERIC => 'other'; 44 45use constant FULL_KEYRANGE => [ range => { end_key => '', start_key => '' } ]; 46 47use constant COMPLETION_DONE => 'done'; 48 49use constant COMMAND_GET => 'get'; 50use constant COMMAND_DEL => 'del'; 51use constant COMMAND_INS => 'ins'; 52use constant COMMAND_KEYS => 'keys'; 53use constant COMMAND_DESC => 'desc'; 54use constant COMMAND_DEFINE_KEYSPACE => 'kdefine'; 55use constant COMMAND_DEFINE_FAMILY => 'fdefine'; 56use constant COMMAND_RENAME_KEYSPACE => 'krename'; 57use constant COMMAND_RENAME_FAMILY => 'frename'; 58use constant COMMAND_DELETE_KEYSPACE => 'kdelete'; 59use constant COMMAND_DELETE_FAMILY => 'fdelete'; 60use constant COMMAND_ERROR => 'error'; 61 62use constant COMMANDS => [ COMMAND_DEFINE_KEYSPACE, COMMAND_DEFINE_FAMILY, COMMAND_DELETE_KEYSPACE, COMMAND_DELETE_FAMILY, COMMAND_RENAME_KEYSPACE, COMMAND_RENAME_FAMILY, COMMAND_GET, COMMAND_DEL, COMMAND_INS, COMMAND_KEYS, COMMAND_DESC ]; 63 64#die Dumper [matching_long_prefixes(shift @ARGV)]; # I haz test 65#die Dumper [Net::Cassandra::Easy::unpack_decimal(Net::Cassandra::Easy::pack_decimal(shift @ARGV))]; # I haz test 66 67my $quiet = $Net::Cassandra::Easy::QUIET = scalar @ARGV || $options{quiet}; # be quiet if this is non-interactive or if requested 68 69my $c = Net::Cassandra::Easy->new(server => $options{server}, port => $options{port}, keyspace => $options{keyspace}, credentials => { none => 1 });; 70$c->connect(); 71#die Dumper [run_command($c, shift @ARGV)]; # I haz test 72 73my %families; 74my @families; 75 76eval 77{ 78 %families = %{$c->describe()}; 79# $families{New} = {super => 1, cmp => 'Long'}; 80 @families = sort keys %families; 81 82 foreach my $family (@families) 83 { 84 next if $families{$family}->{super}; 85 say "Ignoring standard family $family (standard families are a TODO for a future version)" unless $quiet; 86 delete $families{$family}; 87 } 88 89 @families = sort keys %families; 90}; 91 92if ($@) 93{ 94 die "Startup error: " . Dumper($@); 95} 96 97my $grammar_text = <<'EOHIPPUS'; 98command: COMMANDS | <error> 99 100completing_COMMAND_DESC: <rulevar: local $expecting = ''> | COMMAND_DESC { ['COMPLETION_DONE', $item[1] ] } | { $expecting } 101COMMAND_DESC: <skip: ''> 'COMMAND_DESC' 102{ $return = ['describe', \&::dump_hash]; 1; } 103 104completing_COMMAND_GET: <rulevar: local $expecting = ''> | COMMAND_GET { $return = ['COMPLETION_DONE', $item[1] ] } | { $expecting } 105COMMAND_GET: <skip: ''> 'COMMAND_GET' 106 { $expecting = ['family', {}] } ws family 107 { $expecting = ['keys', { %{$item{family}} } ] } ws keys 108 { $expecting = ['getparams', { %{$item{keys}}, %{$item{family}} } ] } ws getparams 109{ $return = [ \&::internalPRD_get, \&::dump_hash, $item{family}, $item{keys}, $item{getparams} ]; } 110 111completing_COMMAND_DEL: <rulevar: local $expecting = ''> | COMMAND_DEL { ['COMPLETION_DONE', $item[1] ] } | { $expecting } 112COMMAND_DEL: <skip: ''> 'COMMAND_DEL' 113 { $expecting = ['family', {}] } ws family 114 { $expecting = ['keys', { %{$item{family}} } ] } ws keys 115 { $expecting = ['getparams', { %{$item{keys}}, %{$item{family}} } ] } ws getparams 116{ $return = [ \&::internalPRD_delete, \&::dump_hash, $item{family}, $item{keys}, $item{getparams} ]; } 117 118completing_COMMAND_INS: <rulevar: local $expecting = ''> | COMMAND_INS { ['COMPLETION_DONE', $item[1] ] } | { $expecting } 119COMMAND_INS: <skip: ''> 'COMMAND_INS' 120 { $expecting = ['family', {}] } ws family 121 { $expecting = ['keys', { %{$item{family}} } ] } ws keys 122 { $expecting = ['getparams', { %{$item{keys}}, %{$item{family}} } ] } ws getparams_nameonly 123 { $expecting = ['insparams', { %{$item{keys}}, %{$item{family}}, @{$item{getparams_nameonly}} } ] } ws insparams 124{ $return = [ \&::internalPRD_insert, \&::dump_hash, $item{family}, $item{keys}, $item{getparams_nameonly}, $item{insparams} ]; } 125 126completing_COMMAND_RENAME_KEYSPACE: <rulevar: local $expecting = ''> | COMMAND_RENAME_KEYSPACE { ['COMPLETION_DONE', $item[1] ] } | { $expecting } 127COMMAND_RENAME_KEYSPACE: <skip: ''> 'COMMAND_RENAME_KEYSPACE' 128 { $expecting = ['keyspace', {}] } ws keyspace 129 { $expecting = ['keyspace2', {}] } ws keyspace2 130{ $return = [ \&::internalPRD_rename_schema, \&::dump_hash, $item{keyspace}, $item{keyspace2} ]; } 131 132completing_COMMAND_RENAME_FAMILY: <rulevar: local $expecting = ''> | COMMAND_RENAME_FAMILY { ['COMPLETION_DONE', $item[1] ] } | { $expecting } 133COMMAND_RENAME_FAMILY: <skip: ''> 'COMMAND_RENAME_FAMILY' 134 { $expecting = ['family', {}] } ws family 135 { $expecting = ['family2', {}] } ws family2 136{ $return = [ \&::internalPRD_rename_schema, \&::dump_hash, $item{family}, $item{family2} ]; } 137 138completing_COMMAND_DELETE_KEYSPACE: <rulevar: local $expecting = ''> | COMMAND_DELETE_KEYSPACE { ['COMPLETION_DONE', $item[1] ] } | { $expecting } 139COMMAND_DELETE_KEYSPACE: <skip: ''> 'COMMAND_DELETE_KEYSPACE' 140 { $expecting = ['keyspace', {}] } ws keyspace 141{ $return = [ \&::internalPRD_delete_schema, \&::dump_hash, $item{keyspace} ]; } 142 143completing_COMMAND_DELETE_FAMILY: <rulevar: local $expecting = ''> | COMMAND_DELETE_FAMILY { ['COMPLETION_DONE', $item[1] ] } | { $expecting } 144COMMAND_DELETE_FAMILY: <skip: ''> 'COMMAND_DELETE_FAMILY' 145 { $expecting = ['family', {}] } ws family 146{ $return = [ \&::internalPRD_delete_schema, \&::dump_hash, $item{family} ]; } 147 148completing_COMMAND_DEFINE_KEYSPACE: <rulevar: local $expecting = ''> | COMMAND_DEFINE_KEYSPACE { ['COMPLETION_DONE', $item[1] ] } | { $expecting } 149COMMAND_DEFINE_KEYSPACE: <skip: ''> 'COMMAND_DEFINE_KEYSPACE' 150 { $expecting = ['keyspace', {}] } ws keyspace 151 { $expecting = ['strategy_class', { %{$item{keyspace}} } ] } ws strategy_class 152 { $expecting = ['replication_factor', { %{$item{strategy_class}}, %{$item{keyspace}} } ] } ws replication_factor 153 { $expecting = ['snitch_class', { %{$item{replication_factor}}, %{$item{strategy_class}}, %{$item{keyspace}} } ] } ws snitch_class 154{ $return = [ \&::internalPRD_define_keyspace, \&::dump_hash, $item{keyspace}, $item{strategy_class}, $item{replication_factor}, $item{snitch_class} ]; } 155 156completing_COMMAND_DEFINE_FAMILY: <rulevar: local $expecting = ''> | COMMAND_DEFINE_FAMILY { ['COMPLETION_DONE', $item[1] ] } | { $expecting } 157COMMAND_DEFINE_FAMILY: <skip: ''> 'COMMAND_DEFINE_FAMILY' 158 { $expecting = ['family', { } ] } ws family 159 { $expecting = ['column_type', { %{$item{family}} } ] } ws column_type 160 { $expecting = ['comparator_type', { %{$item{family}} } ] } ws comparator_type 161 { $expecting = ['subcomparator_type', { %{$item{family}}, %{$item{comparator_type}} } ] } ws subcomparator_type 162 { $expecting = ['family_parameters', { %{$item{family}}, %{$item{comparator_type}}, %{$item{subcomparator_type}} } ] } ws family_parameters 163{ $return = [ \&::internalPRD_define_family, \&::dump_hash, $item{family}, $item{column_type}, $item{comparator_type}, $item{subcomparator_type}, $item{family_parameters} ]; } 164 165completing_COMMAND_KEYS: <rulevar: local $expecting = ''> | COMMAND_KEYS { ['COMPLETION_DONE', $item[1] ] } | { $expecting } 166COMMAND_KEYS: <skip: ''> 'COMMAND_KEYS' 167 { $expecting = ['family', {}] } ws family 168{ $return = [ \&::internalPRD_keys, \&::dump_array, $item{family} ]; } 169 170family: /\S+/ { $return = { family => $item[1] }; } 171 172family2: /\S+/ { $return = { family2 => $item[1] }; } 173 174keyspace: /\S+/ { $return = { keyspace => $item[1] }; } 175 176keyspace2: /\S+/ { $return = { keyspace2 => $item[1] }; } 177 178snitch_class: /\S+/ { $return = { snitch_class => $item[1] }; } 179 180strategy_class: /\S+/ { $return = { strategy_class => $item[1] }; } 181 182column_type: /\S+/ { $return = { column_type => $item[1] }; } 183 184comparator_type: /\S+/ { $return = { comparator_type => $item[1] }; } 185 186subcomparator_type: /\S+/ { $return = { subcomparator_type => $item[1] }; } 187 188replication_factor: /\d+/ { $return = { replication_factor => $item[1] }; } 189 190family_parameters: insparams 191 192keys: key(s /,/) { $return = { keys => $item[1] }; } 193 194key: /[^\s,]+/ 195 196getparams: getparam(s /,/) 197getparams_nameonly: name(s /,/) 198 199insparams: insparam(s /,/) { my $out = {}; $out = ::merge($out, $_) foreach @{$item[1]}; $return = { insert => $out }; } 200 201insparam: inskey /=/ insvalue { $return = { $item{inskey} => $item{insvalue} }; } 202inskey: /[^\s,=]+/ 203insvalue: /[^\s,=]+/ 204 205getparam: position | name 206 207position: /[-+](\d+)/ { $return = { position => [$item[1]] }; } 208 209name: /[^\s,]+/ { $return = { name => [$item[1]] }; } 210 211ws: /\s+/ 212 213EOHIPPUS 214$grammar_text =~ s/$_/eval $_/eg foreach qw/COMMAND_DEFINE_KEYSPACE COMMAND_DEFINE_FAMILY COMMAND_DELETE_KEYSPACE COMMAND_DELETE_FAMILY COMMAND_RENAME_KEYSPACE COMMAND_RENAME_FAMILY COMMAND_GET COMMAND_DEL COMMAND_INS COMMAND_KEYS COMMAND_DESC COMPLETION_DONE/; 215$grammar_text =~ s/COMMANDS/join '|', @{COMMANDS()}/eg; 216 217print "Grammar: \n----\n$grammar_text\n----\n" if $debug; 218 219my $grammar = new Parse::RecDescent($grammar_text); 220 221#die Dumper $grammar->completing_get(shift); # I haz test 222 223{ 224 my @rotate = qw,| / - \\,; 225 sub next_rotate 226 { 227 my $rot = shift @rotate; 228 push @rotate, $rot; 229 return $rot; 230 } 231} 232 233my @given = @ARGV; 234 235my $term = new Term::ReadLine sprintf("Cassandra@%s:%s[%s]", @options{qw/server port keyspace/}) unless scalar @ARGV; 236# $term->ornaments(0,1); 237 238my $attribs = scalar @ARGV ? {} : $term->Attribs; 239 240$attribs->{attempted_completion_function} = \&cass_PRDcompletion; 241 242my $input; 243while (defined ($input = shift @given || $term->readline('> ')) ) 244{ 245 run_command($c, $input); 246 247 $term->addhistory($input) unless scalar @ARGV; 248 249 exit if scalar @ARGV && 0 == scalar @given; 250} 251 252sub run_command 253{ 254 my $c = shift @_; 255 my $i = shift @_; 256 257 my $parsed = $grammar->command($i); 258 259 if (ref $parsed eq 'ARRAY' && defined $parsed->[0] && defined $parsed->[1]) 260 { 261 my ($call, $print, @args) = @$parsed; 262 my $params = {}; 263 264 foreach my $p (@args) 265 { 266 $p = [$p] if ref $p ne 'ARRAY'; 267 268 foreach my $spec (@$p) 269 { 270 if (ref $spec eq 'ARRAY') 271 { 272 $params = merge($params, $_) foreach @$spec; 273 } 274 else 275 { 276 $params = merge($params, $spec); 277 } 278 } 279 } 280 281 eval 282 { 283 print "Calling $call with args ", Dumper($params) if $debug; 284 my $ret = ref $call eq 'CODE' ? $call->($c, $params) : $c->$call(%$params); 285 print "Calling $call returned ", Dumper($ret) if $debug; 286 print $print->($ret); 287 }; 288 289 if ($@) 290 { 291 warn "Error: " . Dumper($@); 292 } 293 } 294 else 295 { 296 warn "Input error: '$i' could not be parsed, " . Dumper($parsed); 297 } 298} 299 300sub cass_PRDcompletion 301{ 302 my ($text, $line, $start, $end) = @_; 303 304 my $given = substr($line, 0, $start); 305 my $prefix = substr($line, $start, $end); 306 307 my $completions = PRDcompletions($given, $prefix); 308 309 $completions = [' '] unless $completions; 310 311 $attribs->{completion_word} = $completions; 312 return $term->completion_matches($text, $attribs->{list_completion_function}); 313 314 # if (defined $parray) 315 # { 316 # $attribs->{completion_word} = [completions($command, $param, $text, $phash)]; 317 # return $term->completion_matches($text, $attribs->{list_completion_function}); 318 # } 319 320 # elsif (0) 321 # { 322 # return $term->completion_matches($text, $attribs->{username_completion_function}); 323 # } 324 # else # filename completion 325 # { 326 # return (); # filename completion 327 # } 328} 329 330sub PRDcompletions 331{ 332 my $given = shift @_; 333 my $prefix = shift @_; 334 335 $prefix =~ s/\s*$//; 336 337 if ($given =~ m/^\s*\S*$/) 338 { 339 return COMMANDS(); 340 } 341# my $at_end = $given =~ m/\s+$/; 342 343 my $parsed; 344 if ($given =~ m/^\s*(\S+)/) 345 { 346 my $method = "completing_$1"; 347 $parsed = $grammar->$method($given); 348 } 349 350 die "ERROR: could not parse input '$given'" unless defined $parsed; 351 352 my ($expected, $ret, @rest) = @$parsed; 353# warn "prefix '$prefix', " . Dumper $parsed; 354 return [ '' ] if $expected eq COMPLETION_DONE; 355 356 my %structure = %$ret; 357 358 given ($expected) 359 { 360 when ('keyspace') 361 { 362 return [ qw/Keyspace1/ ]; 363 } 364 365 when ('family') 366 { 367 return [ sort keys %families ]; 368 } 369 370 when ('family_parameters') 371 { 372 return ["comment=none,row_cache_size=0,key_cache_size=200000"]; 373 } 374 375 when (['comparator_type', 'subcomparator_type']) 376 { 377 return [qw/AsciiType BytesType LexicalUUIDType LongType TimeUUIDType UTF8Type/]; 378 } 379 380 when ('snitch_class') 381 { 382 return [map {"org.apache.cassandra.locator.$_" } qw/DatacenterEndPointSnitch EndPointSnitch/]; 383 } 384 385 when ('strategy_class') 386 { 387 return [map {"org.apache.cassandra.locator.$_" } qw/RackAwareStrategy DatacenterShardStategy RackUnawareStrategy/]; 388 } 389 390 when ('column_type') 391 { 392 return [qw/Super Standard/]; 393 } 394 395 when ('replication_factor') 396 { 397 return [ 1 .. 20 ]; 398 } 399 400 when ('keys') 401 { 402 my $family = $structure{family}; 403 return internalPRD_keys($c, { family => $family, prefix => $prefix }); 404 } 405 406 when ('insparams') 407 { 408 return ["key1=value1,key2=value2"]; 409 } 410 411 when ('getparams') 412 { 413 my $family = $structure{family}; 414 my $keys = $structure{keys}; 415 416 my $ranges = []; 417 my $bitmasks = []; 418 given(get_completion_type_for_family($family)) 419 { 420 when (TYPE_NUMERIC) 421 { 422 if ($prefix =~ m/([-+]?\d+)$/) 423 { 424 my $numeric_prefix = $1; 425 if ($numeric_prefix =~ m/^[-+]/) # we don't want a positional argument to match for completion so just return it as a valid completion 426 { 427 return [$numeric_prefix]; 428 } 429 else 430 { 431 $ranges = [map { { count => Net::Cassandra::Easy::THRIFT_MAX, startlong => $_->[0], endlong => $_->[1] } } matching_long_prefixes($numeric_prefix)]; 432 } 433 } 434 } 435 436 when (TYPE_NONNUMERIC) 437 { 438 $bitmasks = [ $prefix ]; 439 } 440 }; 441 442 my $positions = []; 443 $positions = [-100] unless scalar @$ranges || scalar @$bitmasks; 444 445 my $data = internalPRD_get($c, { family => $family, keys => $keys, ranges => $ranges, bitmasks => $bitmasks, position => $positions }); 446 return [sort keys %$data] if defined $data && ref $data eq 'HASH'; 447 } 448 } 449 450 return; 451} 452 453sub internalPRD_rename_schema 454{ 455 my $c = shift @_; 456 my $params = shift @_; 457 458 my @fam = grep { defined } ($params->{family}, $params->{family2}); 459 my @ksp = grep { defined } ($params->{keyspace}, $params->{keyspace2}); 460 461 eval 462 { 463 if (scalar @fam) 464 { 465 $c->configure( 466 renames => 467 { 468 $options{keyspace} => { @fam }, 469 } 470 ); 471 } 472 elsif (scalar @ksp) 473 { 474 $c->configure(renames => { @ksp } ); 475 } 476 else 477 { 478 die "Invalid rename parameters: " . Dumper($params); 479 } 480 }; 481 482 if ($@) 483 { 484 warn "Error: " . Dumper($@) if $debug; 485 return { error => Dumper($@) }; 486 } 487 488 return { success => Dumper(\@fam, \@ksp) }; 489} 490 491sub internalPRD_delete_schema 492{ 493 my $c = shift @_; 494 my $params = shift @_; 495 496 my $fam = $params->{family}; 497 my $ksp = $params->{keyspace}; 498 499 eval 500 { 501 if (defined $fam) 502 { 503 $c->configure( 504 deletions => 505 [ 506 { $options{keyspace} => [ $fam ] }, 507 ] 508 ); 509 } 510 elsif (defined $ksp) 511 { 512 $c->configure(deletions => [ $ksp ] ); 513 } 514 else 515 { 516 die "Invalid rename parameters: " . Dumper($params); 517 } 518 }; 519 520 if ($@) 521 { 522 warn "Error: " . Dumper($@) if $debug; 523 return { error => Dumper($@) }; 524 } 525 526 return { success => Dumper([$fam, $ksp]) }; 527} 528 529sub internalPRD_define_keyspace 530{ 531 my $c = shift @_; 532 my $params = shift @_; 533 534 $params->{families} ||= {}; 535 my $k = $params->{keyspace}; 536 delete $params->{keyspace}; 537 538 eval 539 { 540 $c->configure( insertions => { $k => $params } ); 541 }; 542 543 if ($@) 544 { 545 warn "Error: " . Dumper($@) if $debug; 546 return { error => Dumper($@) }; 547 } 548 549 return $params; 550} 551 552sub internalPRD_define_family 553{ 554 my $c = shift @_; 555 my $params = shift @_; 556 557 $params->{$_} = $params->{insert}->{$_} foreach keys %{$params->{insert}}; 558 delete $params->{insert}; 559 560 eval 561 { 562 $c->configure( 563 insertions => 564 { 565 $options{keyspace} => { families => { $params->{family} => $params } } 566 } 567 ); 568 }; 569 570 if ($@) 571 { 572 warn "Error: " . Dumper($@) if $debug; 573 return { error => Dumper($@) }; 574 } 575 576 return $params; 577 578} 579 580sub internalPRD_keys 581{ 582 my $c = shift @_; 583 my $params = shift @_; 584 585 my $families = [$params->{family}]; 586 my $prefix = $params->{prefix} || ''; 587 588 my @keys; 589 eval 590 { 591 my $ret; 592 593 $prefix =~ s/\s+//g; 594#say "prefix: $prefix"; 595 596 if (length $prefix) 597 { 598 # TODO: figure out how to do a range query right, 0.7.0 trunk doesn't seem to filter correctly with OPP, probably because of hashes 599 $ret = $c->keys($families, range => { end_key => '', start_key => $prefix }); 600 } 601 else 602 { 603 $ret = $c->keys($families, @{FULL_KEYRANGE()}); 604 } 605 606 foreach my $slice (@$ret) 607 { 608 push @keys, $_->key() foreach @$slice; 609 } 610 611 #printf "Got back %d keys not starting with $prefix\n", scalar grep { $_ !~ m/^$prefix/ } @keys; 612 }; 613 614 if ($@) 615 { 616 warn "Error: " . Dumper($@); 617 } 618 619 return \@keys; 620} 621 622sub internalPRD_delete 623{ 624 my $c = shift @_; 625 my $params = shift @_; 626 627 my $family = $params->{family}; 628 my $keys = $params->{keys} || []; 629 my $names = $params->{name} || []; 630 631 my $results = { }; 632 633 my $delete_spec = { 634 family => $family, 635 }; 636 637 638 $delete_spec->{deletions}->{family_byXYZ_specifier($family)} = $names; 639 640 print "mutate() query: " . Dumper $delete_spec if $debug; 641 642 eval 643 { 644 $results = $c->mutate($keys, %$delete_spec); 645 say "Successful deletion" unless $quiet; 646 }; 647 648 if ($@) 649 { 650 warn "Error: " . Dumper($@); 651 } 652 653 return $results; 654} 655 656sub internalPRD_insert 657{ 658 my $c = shift @_; 659 my $params = shift @_; 660 661 my $family = $params->{family}; 662 my $keys = $params->{keys} || []; 663 my $names = $params->{name} || []; 664 my $insert = $params->{insert} || {}; 665 666 my $results = { }; 667 668 my $insert_spec = { 669 family => $family, 670 }; 671 672 $insert_spec->{insertions}->{packer($family, $_)} = $insert 673 foreach @$names; 674 675 print "mutate() query: " . Dumper $insert_spec if $debug; 676 677 eval 678 { 679 $results = $c->mutate($keys, %$insert_spec); 680 say "Successful insertion" unless $quiet; 681 }; 682 683 if ($@) 684 { 685 warn "Error: " . Dumper($@); 686 } 687 688 return $results; 689} 690 691sub internalPRD_get 692{ 693 my $c = shift @_; 694 my $params = shift @_; 695 696 my $family = $params->{family}; 697 my $keys = $params->{keys} || []; 698 my $positions = $params->{position} || []; 699 my $names = $params->{name} || []; 700 my $ranges = $params->{ranges} || []; 701 my $bitmasks = $params->{bitmasks} || []; 702 703 my @queries; 704 foreach my $position (@$positions) 705 { 706 push @queries, [ family => $family, byoffset => { count => $position, start => '' } ] 707 } 708 709 foreach my $range (@$ranges) 710 { 711 push @queries, [ family => $family, byoffset => $range ] 712 } 713 714 push @queries, [ family => $family, family_byXYZ_specifier($family) => $names ] if @$names; 715 716 push @queries, [ family => $family, bitmasks => $bitmasks, byoffset => { count => Net::Cassandra::Easy::THRIFT_MAX, start => '' } ] if @$bitmasks; 717 718 my $results = {}; 719 print "get() queries: " . Dumper \@queries if $debug; 720 eval 721 { 722 foreach my $query (@queries) 723 { 724 my %q = @$query; 725 print next_rotate() unless $quiet; 726 my $qret = $c->get($keys, @$query); 727 print "\b \b" unless $quiet; 728 729 my @return = map { values %$_ } values %$qret; 730 my $ret = {}; 731 732 foreach my $r (@return) 733 { 734 foreach my $key (keys %$r) 735 { 736 $ret->{unpacker($q{family}, $key)} = $r->{$key}; 737 } 738 } 739 740 $qret = $ret; 741 742 printf "Query %s returned %s", Dumper($query), Dumper($qret) if $debug; 743 $results = merge($results, $qret); 744 } 745 }; 746 747 if ($@) 748 { 749 warn "Error: " . Dumper($@); 750 } 751 752 return $results; 753} 754 755# find all the Long (8 byte) values that can match a string prefix, e.g. "123" -> (123,123) + (1230,1239) + (12300,12399) + ... 756sub matching_long_prefixes 757{ 758 my $prefix = shift @_; 759 760 return [] if $prefix =~ OFFSET_REGEX; 761 762 $prefix =~ s/\D+//g; 763 $prefix ||= 0; 764 765 my $pd = sub 766 { 767 my $ret; 768 eval 769 { 770 $ret = Bit::Vector->new_Dec(64, shift) 771 }; 772 773 return $ret || MAX_LONG; 774 }; 775 776 my @ranges; 777 778 my $cur = $prefix; 779 my $curmax = $prefix; 780 my $curmin = $prefix; 781 782 while (MAX_LONG()->Compare($pd->($curmin)) > 0) 783 { 784 my $pdmax = $pd->($curmax); 785 my $pdmin = $pd->($curmin); 786 787 $pdmax = MAX_LONG if $pdmax->Sign() < 0; 788 $pdmin = MAX_LONG if $pdmin->Sign() < 0; 789 790 #warn "cur = $cur, max = $curmax, min = $curmin" . Dumper ([$pdmin->to_Dec(), $pdmax->to_Dec() ]); 791 push @ranges, [ $pdmin->to_Dec(), $pdmax->to_Dec() ]; 792 793 $cur .= 'x'; 794 $curmax = $curmin = $cur; 795 $curmax =~ s/x/9/g; 796 $curmin =~ s/x/0/g; 797 } 798 799 return @ranges; 800} 801 802sub get_completion_type_for_family 803{ 804 my $family = shift @_; 805 806 return unless exists $families{$family}; 807 808 return TYPE_NUMERIC if $families{$family}->{cmp} eq 'Long'; 809 810 return TYPE_NONNUMERIC; 811} 812 813sub family_byXYZ_specifier 814{ 815 given(get_completion_type_for_family(shift)) 816 { 817 when (TYPE_NUMERIC) 818 { 819 return 'bylong'; 820 } 821 822 when (TYPE_NONNUMERIC) 823 { 824 return 'byname'; 825 } 826 827 default 828 { 829 return "byname"; 830 } 831 } 832 833} 834 835sub family_packerunpacker 836{ 837 my $family = shift @_; 838 839 given(get_completion_type_for_family($family)) 840 { 841 when (TYPE_NUMERIC) 842 { 843 return [ 844 sub { return Net::Cassandra::Easy::pack_decimal(shift) }, 845 sub { return Net::Cassandra::Easy::unpack_decimal(shift) }, 846 ] 847 } 848 849 when (TYPE_NONNUMERIC) 850 { 851 return [ sub { shift }, sub { shift } ]; 852 } 853 } 854} 855 856sub packer 857{ 858 my $family = shift @_; 859 my $v = shift @_; 860 return family_packerunpacker($family)->[0]->($v); 861} 862 863sub unpacker 864{ 865 my $family = shift @_; 866 my $v = shift @_; 867 return family_packerunpacker($family)->[1]->($v); 868} 869 870sub dump_hash 871{ 872 my $h = shift @_; 873 my $phash = shift @_; 874 my $prefix = shift @_ || ''; 875 876 my $family = ''; 877 $family = "$phash->{family}:" if defined $phash && exists $phash->{family}; 878 879 foreach my $key (sort keys %$h) 880 { 881 if (ref $h->{$key} eq 'HASH') 882 { 883 dump_hash($h->{$key}, $phash, $key); 884 } 885 else 886 { 887 printf "%s%s.%s=%s\n", $family, $prefix, $key, $h->{$key}; 888 } 889 } 890} 891 892sub dump_array 893{ 894 my $a = shift @_; 895 my $phash = shift @_; 896 897 my $family = ''; 898 $family = $phash->{family} if defined $phash && exists $phash->{family}; 899 900 $family .= ':' if $family; 901 902 foreach my $key (sort @$a) 903 { 904 say $family, $key; 905 } 906} 907