Changeset 824

Timestamp:

09/25/09 08:08:32 (2 months ago)

Author:

hachi

Message:

Rudimentary dumpconfig command, 90% working.

This reverts commit c5dc669c6250b46f82a6cc4da38f45be7f45c296.

(Yes, that would be a double-revert that I am doing.)

Location:

trunk/lib

Files:

• Perlbal.pm (modified) (1 diff)
• Perlbal/Plugin/Vhosts.pm (modified) (1 diff)
• Perlbal/Pool.pm (modified) (1 diff)
• Perlbal/Service.pm (modified) (3 diffs)

trunk/lib/Perlbal.pm

@@ -975 +975 @@
 }
 
+sub MANAGE_dumpconfig {
+    my $mc = shift;
+
+    while (my ($name, $pool) = each %pool) {
+        $mc->out("CREATE POOL $name");
+
+        if ($pool->can("dumpconfig")) {
+            foreach my $line ($pool->dumpconfig) {
+                $mc->out("  $line");
+            }
+        } else {
+            my $class = ref($pool);
+            $mc->out("  # Pool class '$class' is unable to dump config.");
+        }
+    } continue {
+        $mc->out("");
+    }
+
+    while (my ($name, $service) = each %service) {
+        $mc->out("CREATE SERVICE $name");
+
+        if ($service->can("dumpconfig")) {
+            foreach my $line ($service->dumpconfig) {
+                $mc->out("  $line");
+            }
+        } else {
+            my $class = ref($service);
+            $mc->out("  # Service class '$class' is unable to dump config.");
+        }
+
+        my $state = $service->{enabled} ? "ENABLE" : "DISABLE";
+        $mc->out("$state $name");
+    } continue {
+        $mc->out("");
+    }
+
+    return $mc->ok
+}
+
 sub MANAGE_reproxy_state {
     my $mc = shift;

trunk/lib/Perlbal/Plugin/Vhosts.pm

@@ -74 +74 @@
     delete $Services{"$svc"};
     return 1;
+}
+
+sub dumpconfig {
+    my ($class, $svc) = @_;
+
+    my $vhosts = $svc->{extra_config}->{_vhosts};
+
+    return unless $vhosts;
+
+    my @return;
+
+    while (my ($vhost, $target) = each %$vhosts) {
+        push @return, "VHOST $vhost = $target";
+    }
+
+    return @return;
 }
 

trunk/lib/Perlbal/Pool.pm

@@ -95 +95 @@
 }
 
+sub dumpconfig {
+    my Perlbal::Pool $self = shift;
+    my $name = $self->{name};
+
+    my @return;
+
+    if (my $nodefile = $self->{'nodefile'}) {
+        push @return, "SET nodefile = $nodefile";
+    } else {
+        foreach my $node (@{$self->{nodes}}) {
+            my ($ip, $port) = @$node;
+            push @return, "POOL ADD $name $ip:$port";
+        }
+    }
+    return @return;
+}
+
 # returns string of balance method
 sub balance_method {

trunk/lib/Perlbal/Service.pm

@@ -403 +403 @@
             return $mc->ok;
         },
+        dumper => sub {
+            my ($self, $val) = @_;
+            return join(', ', @$val);
+        },
     },
 
@@ -449 +453 @@
             return $mc->ok;
         },
+        dumper => sub {
+            my ($self, $val) = @_;
+            return $val->name;
+        }
     },
 
@@ -639 +647 @@
     $ctx->{last_created} = $self->name;
     return Perlbal::run_manage_command($cmd, undef, $ctx);
+}
+
+sub dumpconfig {
+    my $self = shift;
+
+    my @return;
+
+    my %my_tunables = %$tunables;
+
+    my $dump = sub {
+        my $setting = shift;
+    };
+
+    foreach my $skip (qw(role listen pool)) {
+        delete $my_tunables{$skip};
+    }
+
+    my $role = $self->{role};
+
+    foreach my $setting ("role", "listen", "pool", sort keys %my_tunables) {
+        my $attrs = $tunables->{$setting};
+        my $value = $self->{$setting};
+
+        my $check_role = $attrs->{check_role};
+        my $check_type = $attrs->{check_type};
+        my $default    = $attrs->{default};
+        my $required   = $attrs->{required};
+
+        next if ($check_role && $check_role ne '*' && $check_role ne $role);
+
+        if ($check_type && $check_type eq 'size') {
+            $default = $1               if $default =~ /^(\d+)b$/i;
+            $default = $1 * 1024        if $default =~ /^(\d+)k$/i;
+            $default = $1 * 1024 * 1024 if $default =~ /^(\d+)m$/i;
+        }
+
+        if (!$required) {
+            next unless defined $value;
+            next if (defined $default && $value eq $default);
+        }
+
+        if (my $dumper = $attrs->{dumper}) {
+            $value = $dumper->($self, $value);
+        }
+
+        if ($check_type && $check_type eq 'bool') {
+            $value = 'on' if $value;
+        }
+
+        push @return, "SET $setting = $value";
+    }
+
+    my $plugins = $self->{plugins};
+
+    foreach my $plugin (keys %$plugins) {
+        local $@;
+
+        my $class = "Perlbal::Plugin::$plugin";
+        my $cv = $class->can('dumpconfig');
+
+        if ($cv) {
+            eval { push @return, $class->dumpconfig($self) };
+            if ($@) {
+                push @return, "# Plugin '$plugin' threw an exception while being dumped.";
+            }
+        } else {
+            push @return, "# Plugin '$plugin' isn't capable of dumping config.";
+        }
+    }
+
+    return @return;
 }