-- introduce CommandContext, so management commands can be less

verbose when in config files (service/pool names can be left off when you just created them a couple lines before) git-svn-id: http://code.sixapart.com/svn/perlbal/trunk@341 6caf28e9-730f-0410-b62b-a31386fe13fb
xsawyerx · Jul 26, 2005 · 6cce2b9 · 6cce2b9
1 parent 93c52ee
commit 6cce2b9
Show file tree

Hide file tree

Showing 6 changed files with 67 additions and 20 deletions.
diff --git a/CHANGES b/CHANGES
@@ -1,3 +1,7 @@
+    -- introduce CommandContext, so management commands can be less
+       verbose when in config files (service/pool names can be left off
+       when you just created them a couple lines before)
+
     -- remove sendstats support
 
     -- exit with 0 vs non-zero when/if Perlbal crashes.  new command

diff --git a/conf/webserver.conf b/conf/webserver.conf
@@ -6,9 +6,9 @@
 #
 
 CREATE SERVICE docs
-  SET docs.listen = 0.0.0.0:80
-  SET docs.role = web_server
-  SET docs.docroot = /usr/share/doc/
-  SET docs.dirindexing = 1
-  SET docs.persist_client = on
+  SET listen         = 0.0.0.0:80
+  SET role           = web_server
+  SET docroot        = /usr/share/doc/
+  SET dirindexing    = 1
+  SET persist_client = on
 ENABLE docs
diff --git a/lib/Perlbal.pm b/lib/Perlbal.pm
@@ -44,6 +44,7 @@ use Perlbal::BackendHTTP;
 use Perlbal::ReproxyManager;
 use Perlbal::Pool;
 use Perlbal::ManageCommand;
+use Perlbal::CommandContext;
 
 END {
     Linux::AIO::max_parallel(0)
@@ -162,7 +163,7 @@ sub pool {
 
 # returns 1 if command succeeded, 0 otherwise
 sub run_manage_command {
-    my ($cmd, $out, $verbose) = @_;  # $out is output stream closure
+    my ($cmd, $out, $verbose, $ctx) = @_;  # $out is output stream closure
 
     $cmd =~ s/\#.*//;
     $cmd =~ s/^\s+//;
@@ -174,6 +175,7 @@ sub run_manage_command {
     return 1 unless $cmd =~ /^\S/;
 
     $out ||= sub {};
+    $ctx ||= Perlbal::CommandContext->new;
 
     my $err = sub {
         $out->("ERROR: $_[0]");
@@ -187,22 +189,23 @@ sub run_manage_command {
     return $err->("invalid command") unless $cmd =~ /^(\w+)/;
     my $basecmd = $1;
 
-    my $mc = Perlbal::ManageCommand->new($basecmd, $cmd, $out, $ok, $err, $orig, $verbose);
+    my $mc = Perlbal::ManageCommand->new($basecmd, $cmd, $out, $ok, $err, $orig, $verbose, $ctx);
 
     # for testing auto crashing and recovery:
     if ($basecmd eq "crash") { die "Intentional crash." };
 
     no strict 'refs';
     if (my $handler = *{"MANAGE_$basecmd"}{CODE}) {
         my $rv = eval { $handler->($mc); };
-        return $err->($@) if $@;
+        return $mc->err($@) if $@;
         return $rv;
     }
 
     # if no handler found, look for plugins
 
     # call any hooks if they've been defined
     my $rval = eval { run_global_hook("manage_command.$basecmd", $mc); };
+    return $mc->err($@) if $@;
     if (defined $rval) {
         # commands may return boolean, or arrayref to mass-print
         if (ref $rval eq "ARRAY") {
@@ -212,7 +215,7 @@ sub run_manage_command {
         return $rval;
     }
 
-    return $err->("unknown command: $basecmd");
+    return $mc->err("unknown command: $basecmd");
 }
 
 sub MANAGE_obj {
@@ -745,6 +748,7 @@ sub MANAGE_create {
         return $mc->err("service '$name' already exists") if $service{$name};
         return $mc->err("pool '$name' already exists") if $pool{$name};
         $service{$name} = Perlbal::Service->new($name);
+        $mc->{ctx}{last_created} = $name;
         return $mc->ok;
     }
 
@@ -753,6 +757,7 @@ sub MANAGE_create {
         return $mc->err("service '$name' already exists") if $service{$name};
         $vivify_pools = 0;
         $pool{$name} = Perlbal::Pool->new($name);
+        $mc->{ctx}{last_created} = $name;
         return $mc->ok;
     }
 }
@@ -776,8 +781,13 @@ sub MANAGE_pool {
 }
 
 sub MANAGE_set {
-    my $mc = shift->parse(qr/^set (\w+)\.([\w\.]+) ?= ?(.+)$/);
+    my $mc = shift->parse(qr/^set (?:(\w+)[\. ])?([\w\.]+) ?= ?(.+)$/,
+                          "usage: SET [<service>] <param> = <value>");
     my ($name, $key, $val) = $mc->args;
+    unless ($name ||= $mc->{ctx}{last_created}) {
+        return $mc->err("omitted service/pool name not implied from context");
+    }
+
     if (my Perlbal::Service $svc = $service{$name}) {
         return $svc->set($key, $val, $mc);
     } elsif (my Perlbal::Pool $pl = $pool{$name}) {
@@ -835,12 +845,13 @@ sub load_config {
     my ($file, $writer) = @_;
     open (F, $file) or die "Error opening config file ($file): $!\n";
     my $verbose = 0;
+    my $ctx = Perlbal::CommandContext->new;
     while (<F>) {
         if ($_ =~ /^verbose (on|off)/i) {
             $verbose = (lc $1 eq 'on' ? 1 : 0);
             next;
         }
-        return 0 unless run_manage_command($_, $writer, $verbose);
+        return 0 unless run_manage_command($_, $writer, $verbose, $ctx);
     }
     close(F);
     return 1;

diff --git a/lib/Perlbal/CommandContext.pm b/lib/Perlbal/CommandContext.pm
@@ -0,0 +1,23 @@
+# keep track of the surrounding context for a ManageCommand, so commands
+# can be less verbose when in config files
+
+package Perlbal::CommandContext;
+use strict;
+use warnings;
+use fields (
+            'last_created', # the name of the last pool or service created
+            );
+
+sub new {
+    my $class = shift;
+    my $self = fields::new($class);
+    return $self;
+}
+
+1;
+
+# Local Variables:
+# mode: perl
+# c-basic-indent: 4
+# indent-tabs-mode: nil
+# End:
diff --git a/lib/Perlbal/ManageCommand.pm b/lib/Perlbal/ManageCommand.pm
@@ -1,7 +1,5 @@
-######################################################################
-# HTTP connection to backend node
-# possible states: connecting, bored, sending_req, wait_res, xfer_res
-######################################################################
+# class representing a one-liner management command.  all the responses
+# to a command should be done through this instance (out, err, ok, etc)
 
 package Perlbal::ManageCommand;
 use strict;
@@ -15,10 +13,11 @@ use fields (
             'verbose',
             'orig',
             'argn',
+            'ctx',
             );
 
 sub new {
-    my ($class, $base, $cmd, $out, $ok, $err, $orig, $verbose) = @_;
+    my ($class, $base, $cmd, $out, $ok, $err, $orig, $verbose, $ctx) = @_;
     my $self = fields::new($class);
 
     $self->{base} = $base;
@@ -27,6 +26,7 @@ sub new {
     $self->{err}  = $err;
     $self->{out}  = $out;
     $self->{orig} = $orig;
+    $self->{ctx}  = $ctx;
     $self->{verbose} = $verbose;
     $self->{argn}    = [];
     return $self;
@@ -41,7 +41,13 @@ sub loud_crasher {
 
 sub out   { my $mc = shift; return @_ ? $mc->{out}->(@_) : $mc->{out}; }
 sub ok    { my $mc = shift; return $mc->{ok}->(@_);  }
-sub err   { my $mc = shift; return $mc->{err}->(@_); }
+
+sub err   {
+    my ($mc, $err) = @_;
+    $err =~ s/\n$//;
+    $mc->{err}->($err);
+}
+
 sub cmd   { my $mc = shift; return $mc->{cmd};       }
 sub orig  { my $mc = shift; return $mc->{orig};      }
 sub end   { my $mc = shift; $mc->{out}->(".");    1; }
@@ -76,7 +82,7 @@ sub args {
 sub parse_error {
     my $mc = shift;
     my $usage = shift;
-
+    $usage .= "\n" unless $usage =~ /\n$/;
     die $usage || "Invalid syntax to '$mc->{base}' command\n"
 }
 

diff --git a/lib/Perlbal/Plugin/Vhosts.pm b/lib/Perlbal/Plugin/Vhosts.pm
@@ -20,9 +20,12 @@ sub load {
     my $class = shift;
 
     Perlbal::register_global_hook('manage_command.vhost', sub {
-        my $mc = shift->parse(qr/^vhost\s+(\w+)\s+(\S+)\s*=\s*(\w+)$/,
-                              "usage: VHOST <service> <host_or_pattern> = <dest_service>");
+        my $mc = shift->parse(qr/^vhost\s+(?:(\w+)\s+)?(\S+)\s*=\s*(\w+)$/,
+                              "usage: VHOST [<service>] <host_or_pattern> = <dest_service>");
         my ($selname, $host, $target) = $mc->args;
+        unless ($selname ||= $mc->{ctx}{last_created}) {
+            return $mc->err("omitted service name not implied from context");
+        }
 
         my $ss = Perlbal->service($selname);
         return $mc->err("Service '$selname' is not a selector service")