[Bps-public-commit] r13957 - in Prophet/trunk: .

[sartak at bestpractical.com]

Author: sartak
Date: Thu Jul 10 15:32:18 2008
New Revision: 13957

Modified:
   Prophet/trunk/   (props changed)
   Prophet/trunk/lib/Prophet/Record.pm

Log:
 r64060 at onn:  sartak | 2008-07-10 15:13:21 -0400
 Add support for coloring property names and values in show


Modified: Prophet/trunk/lib/Prophet/Record.pm
==============================================================================
--- Prophet/trunk/lib/Prophet/Record.pm	(original)
+++ Prophet/trunk/lib/Prophet/Record.pm	Thu Jul 10 15:32:18 2008
@@ -369,6 +369,12 @@
 Returns a stringified form of the properties suitable for displaying directly
 to the user. Also includes luid and uuid.
 
+You may define a "color_prop" method which transforms a property name and value
+(by adding color).
+
+You may also define a "color_prop_foo" method which transforms values of
+property "foo" (by adding color).
+
 =cut
 
 sub show_props {
@@ -376,24 +382,67 @@
     my %args = @_;
 
     my @fields;
+    my $max_length = 0;
+
+    # add a property to @fields
+    my $add_prop = sub {
+        my ($field, $value) = @_;
+
+        # color if we can (and should)
+        my ($color_field, $color_value) = ($field, $value);
+        if (!$args{batch}) {
+            if ($self->can("color_prop_$field")) {
+                my $method = "color_prop_$field";
+                $color_value = $self->$method($value);
+            }
+            else {
+                ($color_field, $color_value) = $self->color_prop($field, $value);
+            }
+        }
+
+        push @fields, [$field, $color_field, $color_value];
+
+        # don't check length($field) here, since coloring will increase the
+        # length but we only care about display length
+        $max_length = length($field)
+            if length($field) > $max_length;
+    };
 
-    push @fields, ["id", $self->luid ." (" . $self->uuid . ")"];
-    my $max_length = 2;
+    $add_prop->("id" => $self->luid ." (" . $self->uuid . ")");
 
     my $props = $self->get_props;
     for (keys %$props) {
-        push @fields, [$_, $props->{$_}];
-        $max_length = length($_)
-            if length($_) > $max_length;
+        $add_prop->($_ => $props->{$_});
     }
 
     $max_length = 0 if $args{batch};
 
-    my $out = join "\n",
-              map { sprintf '%*s %s', -($max_length+1), "$_->[0]:", $_->[1] }
-              @fields;
+    # this code is kind of ugly. we need to format based on uncolored length
+    return join '',
+           map {
+               my ($field, $color_field, $color_value) = @$_;
+               $color_field .= ':';
+               $color_field .= ' ' x ($max_length - length($field));
+               "$color_field $color_value\n"
+           }
+           @fields;
+}
+
+=head2 color_prop property, value
+
+Colorize the given property and/or value. Return the (property, value) pair.
+
+You should not alter the length of the property/value display. This will mess
+up the table display. You should only use coloring escape codes.
+
+=cut
+
+sub color_prop {
+    my $self     = shift;
+    my $property = shift;
+    my $value    = shift;
 
-    return $out;
+    return ($property, $value);
 }
 
 __PACKAGE__->meta->make_immutable;