[Bps-public-commit] r14362 - in Prophet/branches/history: . lib/Prophet lib/Prophet/Server
jesse at bestpractical.com
jesse at bestpractical.com
Tue Jul 22 02:58:13 EDT 2008
Author: jesse
Date: Tue Jul 22 02:58:12 2008
New Revision: 14362
Added:
Prophet/branches/history/lib/Prophet/Server.pm
- copied, changed from r14321, /Prophet/branches/history/lib/Prophet/Server/REST.pm
Prophet/branches/history/lib/Prophet/Server/View.pm
Removed:
Prophet/branches/history/lib/Prophet/Server/REST.pm
Modified:
Prophet/branches/history/ (props changed)
Prophet/branches/history/Makefile.PL
Prophet/branches/history/lib/Prophet/CLI/Command/Search.pm
Prophet/branches/history/lib/Prophet/CLI/Command/Server.pm
Prophet/branches/history/lib/Prophet/Record.pm
Log:
r40301 at 31b (orig r14346): sartak | 2008-07-21 16:23:15 -0700
r64649 at onn: sartak | 2008-07-21 19:22:14 -0400
Begin moving Prophet::Server::REST to Prophet::Server
r40302 at 31b (orig r14347): sartak | 2008-07-21 16:23:44 -0700
r64650 at onn: sartak | 2008-07-21 19:23:05 -0400
Finish moving Prophet::Server::REST to Prophet::Server
r40330 at 31b (orig r14348): sartak | 2008-07-21 17:07:27 -0700
r64694 at onn: sartak | 2008-07-21 20:07:05 -0400
Add a View for the server (currently just for the upcoming list --html)
r40331 at 31b (orig r14349): sartak | 2008-07-21 17:07:36 -0700
r64695 at onn: sartak | 2008-07-21 20:07:17 -0400
Add an --html option to list/search
r40332 at 31b (orig r14350): sartak | 2008-07-21 17:30:08 -0700
r64698 at onn: sartak | 2008-07-21 20:27:31 -0400
In list context, format_summary will just return the list of atoms
r40333 at 31b (orig r14351): sartak | 2008-07-21 17:30:16 -0700
r64699 at onn: sartak | 2008-07-21 20:29:55 -0400
Stick each atom into a table (don't groan, it's tabular data! :))
r40334 at 31b (orig r14352): sartak | 2008-07-21 19:55:15 -0700
r64702 at onn: sartak | 2008-07-21 22:55:08 -0400
Render templates from the web server
r40348 at 31b (orig r14354): sartak | 2008-07-21 23:25:36 -0700
r64704 at onn: sartak | 2008-07-22 01:54:26 -0400
Refactor parsing the format summary so we can get at the interesting bits
r40349 at 31b (orig r14355): sartak | 2008-07-21 23:25:44 -0700
r64705 at onn: sartak | 2008-07-22 02:02:19 -0400
Factor out getting the value out of an atom so we can use it elsewhere
r40350 at 31b (orig r14356): sartak | 2008-07-21 23:25:52 -0700
r64706 at onn: sartak | 2008-07-22 02:20:30 -0400
Finish the refactor, now we don't display extraneous crap on the display page
r40351 at 31b (orig r14357): sartak | 2008-07-21 23:26:08 -0700
r64707 at onn: sartak | 2008-07-22 02:25:19 -0400
Keep prop as the prop name, do the munging in the value
r40352 at 31b (orig r14358): sartak | 2008-07-21 23:26:23 -0700
r64708 at onn: sartak | 2008-07-22 02:25:30 -0400
Some semantic markup in the record table
Modified: Prophet/branches/history/Makefile.PL
==============================================================================
--- Prophet/branches/history/Makefile.PL (original)
+++ Prophet/branches/history/Makefile.PL Tue Jul 22 02:58:12 2008
@@ -28,7 +28,7 @@
requires('MooseX::ClassAttribute' => '0.04');
features(
- 'REST Server' => [
+ 'Web server' => [
-default => 1,
'HTTP::Server::Simple', # HTTP::Server::Simple::CGI
'Test::HTTP::Server::Simple',
@@ -36,6 +36,11 @@
'HTTP::Server::Simple'
],
+ 'HTML display' => [
+ -default => 1,
+ 'Template::Declare', # Template::Declare::Tags
+ ],
+
'Subversion replica support' => [
-default => 0,
Modified: Prophet/branches/history/lib/Prophet/CLI/Command/Search.pm
==============================================================================
--- Prophet/branches/history/lib/Prophet/CLI/Command/Search.pm (original)
+++ Prophet/branches/history/lib/Prophet/CLI/Command/Search.pm Tue Jul 22 02:58:12 2008
@@ -45,6 +45,7 @@
return sub {1}
}
}
+
sub run {
my $self = shift;
@@ -52,6 +53,25 @@
my $search_cb = $self->get_search_callback();
$records->matching($search_cb);
+ my $display_method = $self->has_arg('html')
+ ? 'display_html'
+ : 'display_terminal';
+ $self->$display_method($records);
+}
+
+sub display_html {
+ my $self = shift;
+ my $records = shift;
+
+ require Prophet::Server::View;
+ Template::Declare->init(roots => ['Prophet::Server::View']);
+ print Template::Declare->show('record_table' => $records);
+}
+
+sub display_terminal {
+ my $self = shift;
+ my $records = shift;
+
for ( sort { $a->luid <=> $b->luid } $records->items ) {
print $_->format_summary . "\n";
}
Modified: Prophet/branches/history/lib/Prophet/CLI/Command/Server.pm
==============================================================================
--- Prophet/branches/history/lib/Prophet/CLI/Command/Server.pm (original)
+++ Prophet/branches/history/lib/Prophet/CLI/Command/Server.pm Tue Jul 22 02:58:12 2008
@@ -2,12 +2,13 @@
use Moose;
extends 'Prophet::CLI::Command';
+use Prophet::Server;
+
sub run {
my $self = shift;
- require Prophet::Server::REST;
- my $server = Prophet::Server::REST->new( $self->arg('port') || 8080 );
+ my $server = Prophet::Server->new( $self->arg('port') || 8080 );
$server->prophet_handle( $self->app_handle->handle );
$server->run;
}
Modified: Prophet/branches/history/lib/Prophet/Record.pm
==============================================================================
--- Prophet/branches/history/lib/Prophet/Record.pm (original)
+++ Prophet/branches/history/lib/Prophet/Record.pm Tue Jul 22 02:58:12 2008
@@ -365,46 +365,82 @@
sub _default_summary_format { 'No summary format defined for this record type' }
-sub format_summary {
+sub _summary_format {
+ my $self = shift;
+ return $self->app_handle->config->get('summary_format_'.$self->type)
+ || $self->app_handle->config->get('default_summary_format')
+ || $self->_default_summary_format;
+}
+
+sub _atomize_summary_format {
+ my $self = shift;
+ my $format = shift || $self->_summary_format;
+ return split /\s*\|\s*/, $format;
+}
+
+sub _parse_format_summary {
my $self = shift;
+ my $format = shift;
- my $configured_format =
- $self->app_handle->config->get('summary_format_'.$self->type)
- || $self->app_handle->config->get('default_summary_format')
- || $self->_default_summary_format ;
my $props = $self->get_props;
my @out;
- foreach my $atom(split(/\s*\|\s*/,$configured_format)) {
- my ($format_string,$prop);
- if ($atom =~ /,/) {
- ($format_string,$prop) = split(/,/,$atom);
- $prop = ($props->{$prop} || "(no $prop)") unless ($prop =~ /^\$/);
- } else {
- $format_string = '%s';
- $prop = $atom;
+ foreach my $atom ($self->_atomize_summary_format) {
+ my %atom_data;
+ my ($format, $prop, $value);
+
+ if ($atom =~ /,/) {
+ ($format, $prop) = split /,/, $atom;
+
+ $value = $prop;
+
+ unless ($value =~ /^\$/) {
+ $value = $props->{$value}
+ || "(no $value)"
}
- push @out, $self->format_atom( $format_string => $prop);
+
+ } else {
+ $format = '%s';
+ $prop = $value = $atom;
+ }
+
+ @atom_data{'format', 'prop'} = ($format, $prop);
+ $atom_data{value} = $self->atom_value($value);
+ $atom_data{formatted} = $self->format_atom($format => $atom_data{value});
+
+ push @out, \%atom_data;
}
- return join(' ', @out);
+ return @out;
}
-sub format_atom {
+sub format_summary {
my $self = shift;
- my $string = shift;
+
+ my @out = $self->_parse_format_summary;
+ return @out if wantarray;
+ return join ' ', map { $_->{formatted} } @out;
+}
+
+sub atom_value {
+ my $self = shift;
my $value_in = shift;
- my $value;
+
if ($value_in =~ /^\$[gu]uid/) {
- $value = $self->uuid;
+ return $self->uuid;
} elsif ($value_in eq '$luid') {
- $value = $self->luid;
- } else {
- $value = $value_in;
+ return $self->luid;
}
- return sprintf($string, $value);
+
+ return $value_in;
}
+sub format_atom {
+ my $self = shift;
+ my $string = shift;
+ my $value = shift;
+ return sprintf($string, $self->atom_value($value));
+}
=head2 find_or_create_luid
Copied: Prophet/branches/history/lib/Prophet/Server.pm (from r14321, /Prophet/branches/history/lib/Prophet/Server/REST.pm)
==============================================================================
--- /Prophet/branches/history/lib/Prophet/Server/REST.pm (original)
+++ Prophet/branches/history/lib/Prophet/Server.pm Tue Jul 22 02:58:12 2008
@@ -1,7 +1,11 @@
-package Prophet::Server::REST;
+package Prophet::Server;
+use strict;
+use warnings;
+use base 'HTTP::Server::Simple::CGI';
+
+use Prophet::Server::View;
use Params::Validate qw/:all/;
use JSON;
-use base 'HTTP::Server::Simple::CGI';
sub prophet_handle {
my $self = shift;
@@ -9,8 +13,14 @@
return $self->{'_prophet_handle'};
}
+sub new {
+ my $class = shift;
+ Template::Declare->init(roots => ['Prophet::Server::View']);
+ return $class->SUPER::new(@_);
+}
+
sub handle_request {
- my ($self, $cgi) = validate_pos( @_, { isa => 'Prophet::Server::REST'} , { isa => 'CGI' } );
+ my ($self, $cgi) = validate_pos( @_, { isa => 'Prophet::Server'} , { isa => 'CGI' } );
my $http_status;
if ( my $sub = $self->can( 'handle_request_' . lc( $cgi->request_method ) ) ) {
$http_status = $sub->( $self, $cgi );
@@ -25,6 +35,15 @@
my ($cgi) = validate_pos( @_, { isa => 'CGI' } );
my $p = $cgi->path_info;
+ if (Template::Declare->has_template($p)) {
+ my $content = Template::Declare->show($p);
+
+ return $self->_send_content(
+ content_type => 'text/html',
+ content => $content,
+ );
+ }
+
if ( $p =~ m|^/records\.json$| ) {
$self->_send_content(
content_type => 'text/x-json',
Added: Prophet/branches/history/lib/Prophet/Server/View.pm
==============================================================================
--- (empty file)
+++ Prophet/branches/history/lib/Prophet/Server/View.pm Tue Jul 22 02:58:12 2008
@@ -0,0 +1,50 @@
+#!/usr/bin/env perl
+package Prophet::Server::View;
+use strict;
+use warnings;
+use base 'Template::Declare';
+use Template::Declare::Tags;
+
+template '/' => sub {
+ html {
+ body {
+ h1 { "Welcome!" }
+ }
+ }
+};
+
+template record_table => sub {
+ my $self = shift;
+ my $records = shift;
+
+ html {
+ body {
+ table {
+ my @items = $records ? $records->items : ();
+ for my $record (sort { $a->luid <=> $b->luid } @items) {
+ my $type = $record->type;
+ my $uuid = $record->uuid;
+ my @atoms = $record->format_summary;
+
+ row {
+ attr { id => "$type-$uuid", class => "$type" };
+
+ for (@atoms) {
+ my $prop = $_->{prop};
+ cell {
+ attr {
+ id => "$type-$uuid-$prop",
+ class => $prop,
+ };
+ outs $_->{value}
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+};
+
+1;
+
More information about the Bps-public-commit
mailing list