view release on metacpan or  search on metacpan

lib/App/redisp.pm  view on Meta::CPAN

  lazy => 1,
  default => sub {
    my($self) = @_;
    tie my %h, 'Tie::Redis',
      host => $self->host, port => $self->port, use_recv => 1;
    tied %h;
  }
);

sub debug {
  $ENV{DEBUG} && print "-- ", colored(['green'], @_), "\n";
}

# Special handling code
my %special = (
  keyword => sub {
    my($param) = @_;
    if($param =~ /^\s*(\w+)\s+([^\%\@\$].*)/) {
      $param = "redis(q{$1}, $2)";
      debug "Replaced with '$param'\n";
    }
    return $param;
  }
);

# Handle these commands specially
my %redis_special_commands = (
  keys => $special{keyword},
  exists => $special{keyword},
);

my %util_cmds = (
  encoding => sub {

  },
);

sub BUILD {
  my($self) = @_;

  $self->_install_commands;
}

sub usage {
  my($class, $verbosity) = @_;

  pod2usage(
    -verbose => $verbosity == 1 ? (99, -sections => 'USAGE') : $verbosity,
    -input => __FILE__
  );
}

sub run {
  my($self) = @_;

  my $short_server = $self->host =~ /[0-9]$/
    ? $self->host # IP address
    : ($self->host =~ /^([^.]+)/)[0];

  my $read = Term::ReadLine->new($short_server);
  my $prompt = "$short_server> ";

  while(1) {
    my $line = $read->readline($prompt);
    exit unless defined $line;
    $read->addhistory($line) if $line =~ /\S/;

    if($line =~ /^(?:\?|help)$/) {
      print <DATA>;
      next;
    } elsif($line =~ /^\.(\w+)(?:\s+(.*))?/) {
      ($util_cmds{$1} || sub { warn "Unknown command\n" })->($2);
      next;
    } elsif($line =~ /^\s*(\w+)/ && exists $redis_special_commands{$1}) {
      $line = $redis_special_commands{$1}->($line);
    }

    # TODO: Consider Parse::Perl, but I like no-non-core XS deps for now.
    my $code = ::eval_ctx $line;
    unless(ref $code eq 'CODE') {
      chomp $@;
      print colored(['red'], $@), "\n";
      next;
    }

    $self->_setup_ties_for_code($code);

    $self->eval($line);
  }
}

sub eval {
  my($self, $line) = @_;

  Term::ReadKey::ReadMode(0) if HAVE_READKEY;
  my @ret;
  eval {
    local $SIG{INT} = sub { die "Interrupt\n" };
    @ret = $self->eval_with_lexicals->eval($line);
    1;
  } or do {
    chomp $@;
    print colored(['red'], $@), "\n";
    return;
  };
  Term::ReadKey::ReadMode(1) if HAVE_READKEY;
  pp @ret;
}

sub _setup_ties_for_code {
  my($self, $code) = @_;
  no strict 'refs';

  for my $var(_find_referenced($code)) {
    # Avoid special variables
    next if $var->[0] =~ /^(?:.*::|[\x01-\x1f].*|\W|[0-9]+|_|ENV|SIG)$/;

    if($var->[1] eq 'sv') {
      next if tied ${"::" . $var->[0]};
      debug qq{Tie \${\"$var->[0]\"}};
      tie ${"::" . $var->[0]}, 'Tie::Redis::Scalar',
        redis => $self->redis, key => $var->[0];

    } elsif($var->[1] eq 'hv') {