Merge branch 'master' into oxfordshire-usability-recommendations

23 files changed, 911 insertions, 194 deletions

diff --git a/perllib/FixMyStreet.pm b/perllib/FixMyStreet.pm
index be488a796..6c664f1d1 100644
--- a/perllib/FixMyStreet.pm
+++ b/perllib/FixMyStreet.pm
@@ -7,6 +7,7 @@ use Path::Class;
 my $ROOT_DIR = file(__FILE__)->parent->parent->absolute->resolve;
 
 use Readonly;
+use Sub::Override;
 
 use mySociety::Config;
 use mySociety::DBHandle;
@@ -85,6 +86,41 @@ sub config {
     return exists $CONFIG{$key} ? $CONFIG{$key} : undef;
 }
 
+sub override_config($&) {
+    my $config = shift;
+    my $code = \&{shift @_};
+
+    mySociety::MaPit::configure($config->{MAPIT_URL}) if $config->{MAPIT_URL};
+
+    # For historical reasons, we have two ways of askig for config variables.
+    # Override them both, I'm sure we'll find time to get rid of one eventually.
+    my $override_guard1 = Sub::Override->new(
+        "FixMyStreet::config",
+        sub {
+            my ($class, $key) = @_;
+            return $config->{$key} if exists $config->{$key};
+            my $orig_config = mySociety::Config::load_default();
+            return $orig_config->{$key} if exists $orig_config->{$key};
+        }
+    );
+    my $override_guard2 = Sub::Override->new(
+        "mySociety::Config::get",
+        sub ($;$) {
+            my ($key, $default) = @_;
+            return $config->{$key} if exists $config->{$key};
+            my $orig_config = mySociety::Config::load_default();
+            return $orig_config->{$key} if exists $orig_config->{$key};
+            return $default if @_ == 2;
+        }
+    );
+
+    $code->();
+
+    $override_guard1->restore();
+    $override_guard2->restore();
+    mySociety::MaPit::configure() if $config->{MAPIT_URL};;
+}
+
 =head2 dbic_connect_info
 
     $connect_info = FixMyStreet->dbic_connect_info();
diff --git a/perllib/FixMyStreet/App/Controller/Admin.pm b/perllib/FixMyStreet/App/Controller/Admin.pm
index e2547019b..4973b7c4e 100644
--- a/perllib/FixMyStreet/App/Controller/Admin.pm
+++ b/perllib/FixMyStreet/App/Controller/Admin.pm
@@ -130,6 +130,8 @@ sub index : Path : Args(0) {
 
     $c->stash->{categories} = $c->cobrand->problems->categories_summary();
 
+    $c->stash->{total_bodies} = $c->model('DB::Body')->count();
+
     return 1;
 }
 
@@ -234,6 +236,7 @@ sub bodies : Path('bodies') : Args(0) {
 
     my $posted = $c->req->param('posted') || '';
     if ( $posted eq 'body' ) {
+        $c->forward('check_for_super_user');
         $c->forward('check_token');
 
         my $params = $c->forward('body_params');
@@ -296,6 +299,7 @@ sub body : Path('body') : Args(1) {
 
     $c->stash->{body_id} = $body_id;
 
+    $c->forward( 'check_for_super_user' );
     $c->forward( 'get_token' );
     $c->forward( 'lookup_body' );
     $c->forward( 'fetch_all_bodies' );
@@ -311,6 +315,13 @@ sub body : Path('body') : Args(1) {
     return 1;
 }
 
+sub check_for_super_user : Private {
+    my ( $self, $c ) = @_;
+    if ( $c->cobrand->moniker eq 'zurich' && $c->stash->{admin_type} ne 'super' ) {
+        $c->detach('/page_error_404_not_found', []);
+    }
+}
+
 sub update_contacts : Private {
     my ( $self, $c ) = @_;
 
@@ -377,6 +388,7 @@ sub update_contacts : Private {
 
         $c->stash->{updated} = _('Values updated');
     } elsif ( $posted eq 'body' ) {
+        $c->forward('check_for_super_user');
         $c->forward('check_token');
 
         my $params = $c->forward( 'body_params' );
@@ -401,7 +413,7 @@ sub update_contacts : Private {
 sub body_params : Private {
     my ( $self, $c ) = @_;
 
-    my @fields = qw/name endpoint jurisdiction api_key send_method send_comments suppress_alerts send_extended_statuses comment_user_id can_be_devolved parent/;
+    my @fields = qw/name endpoint jurisdiction api_key send_method send_comments suppress_alerts send_extended_statuses comment_user_id can_be_devolved parent deleted/;
     my %defaults = map { $_ => '' } @fields;
     %defaults = ( %defaults,
         send_comments => 0,
@@ -410,6 +422,7 @@ sub body_params : Private {
         send_extended_statuses => 0,
         can_be_devolved => 0,
         parent => undef,
+        deleted => 0,
     );
     my %params = map { $_ => $c->req->param($_) || $defaults{$_} } @fields;
     return \%params;
@@ -420,6 +433,7 @@ sub display_contacts : Private {
 
     my $contacts = $c->stash->{body}->contacts->search(undef, { order_by => [ 'category' ] } );
     $c->stash->{contacts} = $contacts;
+    $c->stash->{live_contacts} = $contacts->search({ deleted => 0 });
 
     if ( $c->req->param('text') && $c->req->param('text') == 1 ) {
         $c->stash->{template} = 'admin/council_contacts.txt';
@@ -1014,8 +1028,20 @@ sub flagged : Path('flagged') : Args(0) {
     $c->stash->{problems} = [ $problems->all ];
 
     my $users = $c->model('DB::User')->search( { flagged => 1 } );
+    my @users = $users->all;
+    my %email2user = map { $_->email => $_ } @users;
+    $c->stash->{users} = [ @users ];
 
-    $c->stash->{users} = $users;
+    my @abuser_emails = $c->model('DB::Abuse')->all();
+
+    foreach my $email (@abuser_emails) {
+        # Slight abuse of the boolean flagged value
+        if ($email2user{$email->email}) {
+            $email2user{$email->email}->flagged( 2 );
+        } else {
+            push @{$c->stash->{users}}, { email => $email->email, flagged => 2 };
+        }
+    }
 
     return 1;
 }
diff --git a/perllib/FixMyStreet/App/Controller/JSON.pm b/perllib/FixMyStreet/App/Controller/JSON.pm
index 1a7c1915b..17507a84b 100644
--- a/perllib/FixMyStreet/App/Controller/JSON.pm
+++ b/perllib/FixMyStreet/App/Controller/JSON.pm
@@ -8,6 +8,7 @@ use JSON;
 use DateTime;
 use DateTime::Format::ISO8601;
 use List::MoreUtils 'uniq';
+use FixMyStreet::App;
 
 =head1 NAME
 
@@ -80,11 +81,13 @@ sub problems : Local {
         $date_col = 'lastupdate';
     }
 
+    my $dt_parser = FixMyStreet::App->model('DB')->schema->storage->datetime_parser;
+
     my $one_day = DateTime::Duration->new( days => 1 );
     my $query = {
         $date_col => {
-            '>=' => $start_dt,
-            '<=' => $end_dt + $one_day,
+            '>=' => $dt_parser->format_datetime($start_dt),
+            '<=' => $dt_parser->format_datetime($end_dt + $one_day),
         },
         state => [ @state ],
     };
diff --git a/perllib/FixMyStreet/App/Controller/Photo.pm b/perllib/FixMyStreet/App/Controller/Photo.pm
index 8b00d1533..09afabecf 100644
--- a/perllib/FixMyStreet/App/Controller/Photo.pm
+++ b/perllib/FixMyStreet/App/Controller/Photo.pm
@@ -30,17 +30,19 @@ Display a photo
 
 =cut
 
-sub during :LocalRegex('^([0-9a-f]{40})\.temp\.jpeg$') {
+sub during :LocalRegex('^([0-9a-f]{40})\.(temp|fulltemp)\.jpeg$') {
     my ( $self, $c ) = @_;
-    my ( $hash ) = @{ $c->req->captures };
+    my ( $hash, $size ) = @{ $c->req->captures };
 
     my $file = file( $c->config->{UPLOAD_DIR}, "$hash.jpeg" );
     my $photo = $file->slurp;
 
-    if ( $c->cobrand->default_photo_resize ) {
-        $photo = _shrink( $photo, $c->cobrand->default_photo_resize );
-    } else {
-        $photo = _shrink( $photo, '250x250' );
+    if ( $size eq 'temp' ) {
+        if ( $c->cobrand->default_photo_resize ) {
+            $photo = _shrink( $photo, $c->cobrand->default_photo_resize );
+        } else {
+            $photo = _shrink( $photo, '250x250' );
+        }
     }
 
     $c->forward( 'output', [ $photo ] );
diff --git a/perllib/FixMyStreet/App/Controller/Report/New.pm b/perllib/FixMyStreet/App/Controller/Report/New.pm
index 3d3ddce1e..6018dfa80 100644
--- a/perllib/FixMyStreet/App/Controller/Report/New.pm
+++ b/perllib/FixMyStreet/App/Controller/Report/New.pm
@@ -956,6 +956,9 @@ sub check_for_errors : Private {
         delete $field_errors{name};
         my $report = $c->stash->{report};
         $report->title( Utils::cleanup_text( substr($report->detail, 0, 25) ) );
+        if ( ! $c->req->param('phone') ) {
+            $field_errors{phone} = _("This information is required");
+        }
     }
 
     # FIXME: need to check for required bromley fields here
diff --git a/perllib/FixMyStreet/Cobrand/FixMindelo.pm b/perllib/FixMyStreet/Cobrand/FixMindelo.pm
index 6f81bad84..59debf157 100644
--- a/perllib/FixMyStreet/Cobrand/FixMindelo.pm
+++ b/perllib/FixMyStreet/Cobrand/FixMindelo.pm
@@ -4,12 +4,12 @@ use base 'FixMyStreet::Cobrand::Default';
 use strict;
 use warnings;
 
-
 sub country {
     return 'CV';
 }
 
-sub language_domain { 'FixMindelo' }
+sub languages { [ 'pt-cv,Portuguese,pt_CV', 'en-gb,English,en_GB' ] }
+sub language_override { 'pt-cv' }
 
 sub disambiguate_location {
     return {
diff --git a/perllib/FixMyStreet/Cobrand/Zurich.pm b/perllib/FixMyStreet/Cobrand/Zurich.pm
index ffdc1feab..e15170721 100644
--- a/perllib/FixMyStreet/Cobrand/Zurich.pm
+++ b/perllib/FixMyStreet/Cobrand/Zurich.pm
@@ -8,6 +8,47 @@ use RABX;
 use strict;
 use warnings;
 
+=head1 NAME
+
+Zurich FixMyStreet cobrand
+
+=head1 DESCRIPTION
+
+This module provides the specific functionality for the Zurich FMS cobrand.
+
+=head1 DEVELOPMENT NOTES
+
+The admin for Zurich is different to the other cobrands. To access it you need
+to be logged in as a user associated with an appropriate body.
+
+You can create the bodies needed to develop by running the 't/cobrand/zurich.t'
+test script with the three C<$mech->delete...> lines at the end commented out.
+This should leave you with the bodies and users correctly set up.
+
+The entries will be something like this (but with different ids).
+
+    Bodies:
+         id |     name      | parent |         endpoint
+        ----+---------------+--------+---------------------------
+          1 | Zurich        |        |
+          2 | Division 1    |      1 | division@example.org
+          3 | Subdivision A |      2 | subdivision@example.org
+          4 | External Body |        | external_body@example.org
+
+    Users:
+         id |      email       | from_body
+        ----+------------------+-----------
+          2 | dm1@example.org  |         2
+          3 | sdm1@example.org |         3
+
+The passwords for the users is 'secret'.
+
+Note: the password hashes are salted with the user's id so cannot be easily
+changed. High ids have been used so that it should not conflict with anything
+you already have, and the countres set so that they shouldn't in future.
+
+=cut
+
 sub shorten_recency_if_new_greater_than_fixed {
     return 0;
 }
@@ -356,29 +397,51 @@ sub admin_report_edit {
 
     }
 
-    # Problem updates upon submission
+    # If super or sdm check that the token is correct before proceeding
     if ( ($type eq 'super' || $type eq 'dm') && $c->req->param('submit') ) {
         $c->forward('check_token');
+    }
+
+    # All types of users can add internal notes
+    if ( ($type eq 'super' || $type eq 'dm' || $type eq 'sdm') && $c->req->param('submit') ) {
+        # If there is a new note add it as a comment to the problem (with is_internal_note set true in extra).
+        if ( my $new_internal_note = $c->req->params->{new_internal_note} ) {
+            $problem->add_to_comments( {
+                text => $new_internal_note,
+                user => $c->user->obj,
+                state => 'hidden', # seems best fit, should not be shown publicly
+                mark_fixed => 0,
+                anonymous => 1,
+                extra => { is_internal_note => 1 },
+            } );
+        }
+    }
 
+    # Problem updates upon submission
+    if ( ($type eq 'super' || $type eq 'dm') && $c->req->param('submit') ) {
         # Predefine the hash so it's there for lookups
-        # XXX Note you need to shallow copy each time you set it, due to a bug? in FilterColumn.
         my $extra = $problem->extra || {};
-        $extra->{internal_notes} = $c->req->param('internal_notes');
         $extra->{publish_photo} = $c->req->params->{publish_photo} || 0;
         $extra->{third_personal} = $c->req->params->{third_personal} || 0;
         # Make sure we have a copy of the original detail field
         $extra->{original_detail} = $problem->detail if !$extra->{original_detail} && $c->req->params->{detail} && $problem->detail ne $c->req->params->{detail};
 
+        # Some changes will be accompanied by an internal note, which if needed
+        # should be stored in this variable.
+        my $internal_note_text = "";
+
         # Workflow things
         my $redirect = 0;
         my $new_cat = $c->req->params->{category};
         if ( $new_cat && $new_cat ne $problem->category ) {
             my $cat = $c->model('DB::Contact')->search( { category => $c->req->params->{category} } )->first;
+            my $old_cat = $problem->category;
             $problem->category( $new_cat );
             $problem->external_body( undef );
             $problem->bodies_str( $cat->body_id );
             $problem->whensent( undef );
             $extra->{changed_category} = 1;
+            $internal_note_text = "Weitergeleitet von $old_cat an $new_cat";
             $redirect = 1 if $cat->body_id ne $body->id;
         } elsif ( my $subdiv = $c->req->params->{body_subdivision} ) {
             $extra->{moderated_overdue} = $self->overdue( $problem );
@@ -396,12 +459,12 @@ sub admin_report_edit {
             $redirect = 1;
         } else {
             $problem->state( $c->req->params->{state} ) if $c->req->params->{state};
-            if ( $problem->state eq 'hidden' ) {
+            if ( $problem->state eq 'hidden' && $c->req->params->{send_rejected_email} ) {
                 _admin_send_email( $c, 'problem-rejected.txt', $problem );
             }
         }
 
-        $problem->extra( { %$extra } );
+        $problem->extra( $extra );
         $problem->title( $c->req->param('title') );
         $problem->detail( $c->req->param('detail') );
         $problem->latitude( $c->req->param('latitude') );
@@ -410,7 +473,7 @@ sub admin_report_edit {
         # Final, public, Update from DM
         if (my $update = $c->req->param('status_update')) {
             $extra->{public_response} = $update;
-            $problem->extra( { %$extra } );
+            $problem->extra( $extra );
             if ($c->req->params->{publish_response}) {
                 $problem->state( 'fixed - council' );
                 _admin_send_email( $c, 'problem-closed.txt', $problem );
@@ -424,9 +487,22 @@ sub admin_report_edit {
           '<p><em>' . _('Updated!') . '</em></p>';
 
         # do this here otherwise lastupdate and confirmed times
-        # do not display correctly
+        # do not display correctly (reloads problem from database, including
+        # fields modified by the database when saving)
         $problem->discard_changes;
 
+        # Create an internal note if required
+        if ($internal_note_text) {
+            $problem->add_to_comments( {
+                text => $internal_note_text,
+                user => $c->user->obj,
+                state => 'hidden', # seems best fit, should not be shown publicly
+                mark_fixed => 0,
+                anonymous => 1,
+                extra => { is_internal_note => 1 },
+            } );
+        }
+
         if ( $redirect ) {
             $c->detach('index');
         }
@@ -462,14 +538,6 @@ sub admin_report_edit {
                 $db_update = 1;
             }
 
-            my $extra = $problem->extra || {};
-            $extra->{internal_notes} ||= '';
-            if ($c->req->param('internal_notes') && $c->req->param('internal_notes') ne $extra->{internal_notes}) {
-                $extra->{internal_notes} = $c->req->param('internal_notes');
-                $problem->extra( { %$extra } );
-                $db_update = 1;
-            }
-
             $problem->update if $db_update;
 
             # Add new update from status_update
@@ -491,7 +559,7 @@ sub admin_report_edit {
             if ($c->req->param('no_more_updates')) {
                 my $extra = $problem->extra || {};
                 $extra->{subdiv_overdue} = $self->overdue( $problem );
-                $problem->extra( { %$extra } );
+                $problem->extra( $extra );
                 $problem->bodies_str( $body->parent->id );
                 $problem->whensent( undef );
                 $problem->state( 'planned' );
@@ -592,10 +660,31 @@ sub admin_stats {
     );
 
     if ( $c->req->params->{export} ) {
-        my $problems = $c->model('DB::Problem')->search( { %params }, { columns => [ 'id', 'created', 'latitude', 'longitude', 'cobrand', 'category' ] } );
-        my $body = "ID,Created,E,N,Category\n";
-        while (my $report = $problems->next) {
-            $body .= join( ',', $report->id, $report->created, $report->local_coords, $report->category ) . "\n";
+        my $problems = $c->model('DB::Problem')->search(
+            {%params},
+            {
+                columns => [
+                    'id',       'created',
+                    'latitude', 'longitude',
+                    'cobrand',  'category',
+                    'state',    'user_id',
+                    'external_body'
+                ]
+            }
+        );
+        my $body = "ID,Created,E,N,Category,Status,UserID,External Body\n";
+        while ( my $report = $problems->next ) {
+            my $external_body;
+            my $body_name = "";
+            if ( $external_body = $report->body($c) ) {
+                $body_name = $external_body->name;
+            }
+            $body .= join( ',',
+                $report->id,           $report->created,
+                $report->local_coords, $report->category,
+                $report->state,        $report->user_id,
+                "\"$body_name\"" )
+              . "\n";
         }
         $c->res->content_type('text/csv; charset=utf-8');
         $c->res->body($body);
diff --git a/perllib/FixMyStreet/DB/RABXColumn.pm b/perllib/FixMyStreet/DB/RABXColumn.pm
new file mode 100644
index 000000000..5f1583018
--- /dev/null
+++ b/perllib/FixMyStreet/DB/RABXColumn.pm
@@ -0,0 +1,98 @@
+package FixMyStreet::DB::RABXColumn;
+
+use strict;
+use warnings;
+
+use IO::String;
+use RABX;
+
+=head1 NAME
+
+FixMyStreet::DB::RABXColumn
+
+=head2 DESCRIPTION
+
+This is a helper component that will setup the RABX serialisation for some
+fields. This is useful for when you want to persist some data structure such as
+hashrefs etc.
+
+This code will also change the default FilterColumn behaviour so that whenever
+your set a column, or specify a RABX'd column in an ->update the value is saved
+to the database. The default behaviour is to check if the value is already set,
+and for hashrefs this means that changes to the contents are missed as it is
+still the same hashref.
+
+By putting all this code in one place there is also much less repetition.
+
+=cut
+
+# Store which columns are RABX cols.
+# $RABX_COLUMNS{$class}{$col} = 1
+my %RABX_COLUMNS = ();
+
+sub _get_class_identifier {
+    my $class = ref $_[0] || $_[0];
+    $class =~ s/.*?(\w+)$/$1/;
+    return $class;
+}
+
+=head1 METHODS
+
+=head2 rabx_column
+
+    # In one of your ::Result:: modules
+    __PACKAGE__->load_components("+FixMyStreet::DB::RABXColumn");
+    __PACKAGE__->rabx_column('data');
+
+This sets up the filtering to and from the database, and also changes the
+set_filtered_column behaviour to not trust the cache.
+
+=cut
+
+sub rabx_column {
+    my ($class, $col) = @_;
+
+    # Apply the filtering for this column
+    $class->filter_column(
+        $col => {
+            filter_from_storage => sub {
+                my $self = shift;
+                my $ser  = shift;
+                return undef unless defined $ser;
+                utf8::encode($ser) if utf8::is_utf8($ser);
+                my $h = new IO::String($ser);
+                return RABX::wire_rd($h);
+            },
+            filter_to_storage => sub {
+                my $self = shift;
+                my $data = shift;
+                my $ser  = '';
+                my $h    = new IO::String($ser);
+                RABX::wire_wr( $data, $h );
+                return $ser;
+            },
+        }
+    );
+
+    # store that this column is a RABX column.
+    $RABX_COLUMNS{ _get_class_identifier($class) }{$col} = 1;
+}
+
+
+sub set_filtered_column {
+    my ($self, $col, $val) = @_;
+
+    my $class = ref $self;
+
+    # because filtered objects may be expensive to marshall for storage there
+    # is a cache that attempts to detect if they have changed or not. For us
+    # this cache breaks things and our marshalling is cheap, so clear it when
+    # trying set a column.
+    delete $self->{_filtered_column}{$col}
+        if $RABX_COLUMNS{ _get_class_identifier($class) }{$col};
+
+    return $self->next::method($col, $val);
+}
+
+
+1;
diff --git a/perllib/FixMyStreet/DB/Result/Alert.pm b/perllib/FixMyStreet/DB/Result/Alert.pm
index fc84c8fd5..4ce72f873 100644
--- a/perllib/FixMyStreet/DB/Result/Alert.pm
+++ b/perllib/FixMyStreet/DB/Result/Alert.pm
@@ -48,7 +48,7 @@ __PACKAGE__->belongs_to(
   "alert_type",
   "FixMyStreet::DB::Result::AlertType",
   { ref => "alert_type" },
-  { is_deferrable => 1, on_delete => "CASCADE", on_update => "CASCADE" },
+  { is_deferrable => 0, on_delete => "NO ACTION", on_update => "NO ACTION" },
 );
 __PACKAGE__->has_many(
   "alerts_sent",
@@ -60,12 +60,12 @@ __PACKAGE__->belongs_to(
   "user",
   "FixMyStreet::DB::Result::User",
   { id => "user_id" },
-  { is_deferrable => 1, on_delete => "CASCADE", on_update => "CASCADE" },
+  { is_deferrable => 0, on_delete => "NO ACTION", on_update => "NO ACTION" },
 );
 
 
-# Created by DBIx::Class::Schema::Loader v0.07017 @ 2012-03-08 17:19:55
-# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:vump36YxUO4FQi5Do6DwvA
+# Created by DBIx::Class::Schema::Loader v0.07035 @ 2013-09-10 17:11:54
+# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:d9yIFiTGtbtFaULXZNKstQ
 
 # You can replace this text with custom code or comments, and it will be preserved on regeneration
 
diff --git a/perllib/FixMyStreet/DB/Result/AlertSent.pm b/perllib/FixMyStreet/DB/Result/AlertSent.pm
index a537c95cd..422e010a9 100644
--- a/perllib/FixMyStreet/DB/Result/AlertSent.pm
+++ b/perllib/FixMyStreet/DB/Result/AlertSent.pm
@@ -26,12 +26,12 @@ __PACKAGE__->belongs_to(
   "alert",
   "FixMyStreet::DB::Result::Alert",
   { id => "alert_id" },
-  { is_deferrable => 1, on_delete => "CASCADE", on_update => "CASCADE" },
+  { is_deferrable => 0, on_delete => "NO ACTION", on_update => "NO ACTION" },
 );
 
 
-# Created by DBIx::Class::Schema::Loader v0.07017 @ 2012-03-08 17:19:55
-# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:oN+36hDWJuc0hqkCW9BHOw
+# Created by DBIx::Class::Schema::Loader v0.07035 @ 2013-09-10 17:11:54
+# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:COwsprqRSNZS1IxJrPYgMQ
 
 
 # You can replace this text with custom code or comments, and it will be preserved on regeneration
diff --git a/perllib/FixMyStreet/DB/Result/Body.pm b/perllib/FixMyStreet/DB/Result/Body.pm
index 83704563a..c2b0555fb 100644
--- a/perllib/FixMyStreet/DB/Result/Body.pm
+++ b/perllib/FixMyStreet/DB/Result/Body.pm
@@ -20,6 +20,8 @@ __PACKAGE__->add_columns(
   },
   "name",
   { data_type => "text", is_nullable => 0 },
+  "parent",
+  { data_type => "integer", is_foreign_key => 1, is_nullable => 1 },
   "endpoint",
   { data_type => "text", is_nullable => 1 },
   "jurisdiction",
@@ -38,8 +40,8 @@ __PACKAGE__->add_columns(
   { data_type => "boolean", default_value => \"false", is_nullable => 0 },
   "send_extended_statuses",
   { data_type => "boolean", default_value => \"false", is_nullable => 0 },
-  "parent",
-  { data_type => "integer", is_foreign_key => 1, is_nullable => 1 },
+  "deleted",
+  { data_type => "boolean", default_value => \"false", is_nullable => 0 },
 );
 __PACKAGE__->set_primary_key("id");
 __PACKAGE__->has_many(
@@ -59,10 +61,10 @@ __PACKAGE__->belongs_to(
   "FixMyStreet::DB::Result::User",
   { id => "comment_user_id" },
   {
-    is_deferrable => 1,
+    is_deferrable => 0,
     join_type     => "LEFT",
-    on_delete     => "CASCADE",
-    on_update     => "CASCADE",
+    on_delete     => "NO ACTION",
+    on_update     => "NO ACTION",
   },
 );
 __PACKAGE__->has_many(
@@ -76,10 +78,10 @@ __PACKAGE__->belongs_to(
   "FixMyStreet::DB::Result::Body",
   { id => "parent" },
   {
-    is_deferrable => 1,
+    is_deferrable => 0,
     join_type     => "LEFT",
-    on_delete     => "CASCADE",
-    on_update     => "CASCADE",
+    on_delete     => "NO ACTION",
+    on_update     => "NO ACTION",
   },
 );
 __PACKAGE__->has_many(
@@ -90,8 +92,8 @@ __PACKAGE__->has_many(
 );
 
 
-# Created by DBIx::Class::Schema::Loader v0.07017 @ 2012-12-19 12:47:10
-# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:DdtXjMWRpz20ZHjtY3oP2w
+# Created by DBIx::Class::Schema::Loader v0.07035 @ 2013-09-10 18:11:23
+# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:hTOxxiiHmC8nmQK/p8dXhQ
 
 sub url {
     my ( $self, $c ) = @_;
diff --git a/perllib/FixMyStreet/DB/Result/BodyArea.pm b/perllib/FixMyStreet/DB/Result/BodyArea.pm
index 844a3277d..4447777dc 100644
--- a/perllib/FixMyStreet/DB/Result/BodyArea.pm
+++ b/perllib/FixMyStreet/DB/Result/BodyArea.pm
@@ -21,12 +21,12 @@ __PACKAGE__->belongs_to(
   "body",
   "FixMyStreet::DB::Result::Body",
   { id => "body_id" },
-  { is_deferrable => 1, on_delete => "CASCADE", on_update => "CASCADE" },
+  { is_deferrable => 0, on_delete => "NO ACTION", on_update => "NO ACTION" },
 );
 
 
-# Created by DBIx::Class::Schema::Loader v0.07017 @ 2012-12-19 12:47:10
-# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:aAr+Nadyu8IckZlK6+PTNg
+# Created by DBIx::Class::Schema::Loader v0.07035 @ 2013-09-10 17:11:54
+# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:+hzie6kHleUBoEt199c/nQ
 
  __PACKAGE__->set_primary_key(__PACKAGE__->columns);
 
diff --git a/perllib/FixMyStreet/DB/Result/Comment.pm b/perllib/FixMyStreet/DB/Result/Comment.pm
index eb9e52a65..2d5b6b2c3 100644
--- a/perllib/FixMyStreet/DB/Result/Comment.pm
+++ b/perllib/FixMyStreet/DB/Result/Comment.pm
@@ -54,6 +54,10 @@ __PACKAGE__->add_columns(
   { data_type => "boolean", default_value => \"false", is_nullable => 0 },
   "problem_state",
   { data_type => "text", is_nullable => 1 },
+  "external_id",
+  { data_type => "text", is_nullable => 1 },
+  "extra",
+  { data_type => "text", is_nullable => 1 },
   "send_fail_count",
   { data_type => "integer", default_value => 0, is_nullable => 0 },
   "send_fail_reason",
@@ -62,55 +66,32 @@ __PACKAGE__->add_columns(
   { data_type => "timestamp", is_nullable => 1 },
   "whensent",
   { data_type => "timestamp", is_nullable => 1 },
-  "external_id",
-  { data_type => "text", is_nullable => 1 },
-  "extra",
-  { data_type => "text", is_nullable => 1 },
 );
 __PACKAGE__->set_primary_key("id");
 __PACKAGE__->belongs_to(
   "problem",
   "FixMyStreet::DB::Result::Problem",
   { id => "problem_id" },
-  { is_deferrable => 1, on_delete => "CASCADE", on_update => "CASCADE" },
+  { is_deferrable => 0, on_delete => "NO ACTION", on_update => "NO ACTION" },
 );
 __PACKAGE__->belongs_to(
   "user",
   "FixMyStreet::DB::Result::User",
   { id => "user_id" },
-  { is_deferrable => 1, on_delete => "CASCADE", on_update => "CASCADE" },
+  { is_deferrable => 0, on_delete => "NO ACTION", on_update => "NO ACTION" },
 );
 
 
-# Created by DBIx::Class::Schema::Loader v0.07017 @ 2012-07-11 18:53:26
-# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:tSejJzLxHD/fMWjpa10lfA
-
-__PACKAGE__->filter_column(
-    extra => {
-        filter_from_storage => sub {
-            my $self = shift;
-            my $ser  = shift;
-            return undef unless defined $ser;
-            utf8::encode($ser) if utf8::is_utf8($ser);
-            my $h = new IO::String($ser);
-            return RABX::wire_rd($h);
-        },
-        filter_to_storage => sub {
-            my $self = shift;
-            my $data = shift;
-            my $ser  = '';
-            my $h    = new IO::String($ser);
-            RABX::wire_wr( $data, $h );
-            return $ser;
-        },
-    }
-);
+# Created by DBIx::Class::Schema::Loader v0.07035 @ 2013-09-10 17:11:54
+# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:D/+UWcF7JO/EkCiJaAHUOw
+
+__PACKAGE__->load_components("+FixMyStreet::DB::RABXColumn");
+__PACKAGE__->rabx_column('extra');
 
 use DateTime::TimeZone;
 use Image::Size;
 use Moose;
 use namespace::clean -except => [ 'meta' ];
-use RABX;
 
 with 'FixMyStreet::Roles::Abuser';
 
@@ -179,8 +160,8 @@ sub get_photo_params {
 
 =head2 meta_problem_state
 
-Returns a string suitable for display in the update meta section. 
-Mostly removes the '- council/user' bit from fixed states
+Returns a string suitable for display lookup in the update meta section.
+Removes the '- council/user' bit from fixed states.
 
 =cut
 
@@ -190,10 +171,6 @@ sub meta_problem_state {
     my $state = $self->problem_state;
     $state =~ s/ -.*$//;
 
-    $state = _("not the council's responsibility") 
-        if $state eq 'not responsible';
-    $state = _('duplicate report') if $state eq 'duplicate';
-
     return $state;
 }
 
diff --git a/perllib/FixMyStreet/DB/Result/Contact.pm b/perllib/FixMyStreet/DB/Result/Contact.pm
index 551bcd019..eca028c9b 100644
--- a/perllib/FixMyStreet/DB/Result/Contact.pm
+++ b/perllib/FixMyStreet/DB/Result/Contact.pm
@@ -53,32 +53,14 @@ __PACKAGE__->belongs_to(
   "body",
   "FixMyStreet::DB::Result::Body",
   { id => "body_id" },
-  { is_deferrable => 1, on_delete => "CASCADE", on_update => "CASCADE" },
+  { is_deferrable => 0, on_delete => "NO ACTION", on_update => "NO ACTION" },
 );
 
 
-# Created by DBIx::Class::Schema::Loader v0.07017 @ 2012-12-13 12:34:33
-# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:imXq3EtrC0FrQwj+E2xfBw
+# Created by DBIx::Class::Schema::Loader v0.07035 @ 2013-09-10 17:11:54
+# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:hq/BFHDEu4OUI4MSy3OyHg
 
-__PACKAGE__->filter_column(
-    extra => {
-        filter_from_storage => sub {
-            my $self = shift;
-            my $ser  = shift;
-            return undef unless defined $ser;
-            utf8::encode($ser) if utf8::is_utf8($ser);
-            my $h = new IO::String($ser);
-            return RABX::wire_rd($h);
-        },
-        filter_to_storage => sub {
-            my $self = shift;
-            my $data = shift;
-            my $ser  = '';
-            my $h    = new IO::String($ser);
-            RABX::wire_wr( $data, $h );
-            return $ser;
-        },
-    }
-);
+__PACKAGE__->load_components("+FixMyStreet::DB::RABXColumn");
+__PACKAGE__->rabx_column('extra');
 
 1;
diff --git a/perllib/FixMyStreet/DB/Result/Problem.pm b/perllib/FixMyStreet/DB/Result/Problem.pm
index ec15600b6..f14a29f56 100644
--- a/perllib/FixMyStreet/DB/Result/Problem.pm
+++ b/perllib/FixMyStreet/DB/Result/Problem.pm
@@ -120,12 +120,12 @@ __PACKAGE__->belongs_to(
   "user",
   "FixMyStreet::DB::Result::User",
   { id => "user_id" },
-  { is_deferrable => 1, on_delete => "CASCADE", on_update => "CASCADE" },
+  { is_deferrable => 0, on_delete => "NO ACTION", on_update => "NO ACTION" },
 );
 
 
-# Created by DBIx::Class::Schema::Loader v0.07017 @ 2012-12-13 15:13:48
-# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:H2P3Og37G569nQdQA1IWaA
+# Created by DBIx::Class::Schema::Loader v0.07035 @ 2013-09-10 17:11:54
+# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:U/4BT8EGfcCLKA/7LX+qyQ
 
 # Add fake relationship to stored procedure table
 __PACKAGE__->has_one(
@@ -135,54 +135,15 @@ __PACKAGE__->has_one(
   { cascade_copy => 0, cascade_delete => 0 },
 );
 
-__PACKAGE__->filter_column(
-    extra => {
-        filter_from_storage => sub {
-            my $self = shift;
-            my $ser  = shift;
-            return undef unless defined $ser;
-            utf8::encode($ser) if utf8::is_utf8($ser);
-            my $h = new IO::String($ser);
-            return RABX::wire_rd($h);
-        },
-        filter_to_storage => sub {
-            my $self = shift;
-            my $data = shift;
-            my $ser  = '';
-            my $h    = new IO::String($ser);
-            RABX::wire_wr( $data, $h );
-            return $ser;
-        },
-    }
-);
-
-__PACKAGE__->filter_column(
-    geocode => {
-        filter_from_storage => sub {
-            my $self = shift;
-            my $ser  = shift;
-            return undef unless defined $ser;
-            utf8::encode($ser) if utf8::is_utf8($ser);
-            my $h = new IO::String($ser);
-            return RABX::wire_rd($h);
-        },
-        filter_to_storage => sub {
-            my $self = shift;
-            my $data = shift;
-            my $ser  = '';
-            my $h    = new IO::String($ser);
-            RABX::wire_wr( $data, $h );
-            return $ser;
-        },
-    }
-);
+__PACKAGE__->load_components("+FixMyStreet::DB::RABXColumn");
+__PACKAGE__->rabx_column('extra');
+__PACKAGE__->rabx_column('geocode');
 
 use DateTime::TimeZone;
 use Image::Size;
 use Moose;
 use namespace::clean -except => [ 'meta' ];
 use Utils;
-use RABX;
 
 with 'FixMyStreet::Roles::Abuser';
 
diff --git a/perllib/FixMyStreet/DB/Result/Questionnaire.pm b/perllib/FixMyStreet/DB/Result/Questionnaire.pm
index fcaa17d99..7f9c79d9a 100644
--- a/perllib/FixMyStreet/DB/Result/Questionnaire.pm
+++ b/perllib/FixMyStreet/DB/Result/Questionnaire.pm
@@ -36,12 +36,12 @@ __PACKAGE__->belongs_to(
   "problem",
   "FixMyStreet::DB::Result::Problem",
   { id => "problem_id" },
-  { is_deferrable => 1, on_delete => "CASCADE", on_update => "CASCADE" },
+  { is_deferrable => 0, on_delete => "NO ACTION", on_update => "NO ACTION" },
 );
 
 
-# Created by DBIx::Class::Schema::Loader v0.07017 @ 2012-03-08 17:19:55
-# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:NGlSRjoBpDoIvK3EueqN6Q
+# Created by DBIx::Class::Schema::Loader v0.07035 @ 2013-09-10 17:11:54
+# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:oL1Hk4/bNG14CY74GA75SA
 
 use DateTime::TimeZone;
 use Moose;
diff --git a/perllib/FixMyStreet/DB/Result/Token.pm b/perllib/FixMyStreet/DB/Result/Token.pm
index 028300842..5525fe7a5 100644
--- a/perllib/FixMyStreet/DB/Result/Token.pm
+++ b/perllib/FixMyStreet/DB/Result/Token.pm
@@ -34,8 +34,6 @@ __PACKAGE__->set_primary_key("scope", "token");
 # use mySociety::DBHandle qw(dbh);
 
 use mySociety::AuthToken;
-use IO::String;
-use RABX;
 
 =head1 NAME
 
@@ -54,26 +52,9 @@ ms_current_timestamp.
 
 =cut
 
-__PACKAGE__->filter_column(
-    data => {
-        filter_from_storage => sub {
-            my $self = shift;
-            my $ser  = shift;
-            return undef unless defined $ser;
-            utf8::encode($ser) if utf8::is_utf8($ser);
-            my $h = new IO::String($ser);
-            return RABX::wire_rd($h);
-        },
-        filter_to_storage => sub {
-            my $self = shift;
-            my $data = shift;
-            my $ser  = '';
-            my $h    = new IO::String($ser);
-            RABX::wire_wr( $data, $h );
-            return $ser;
-        },
-    }
-);
+__PACKAGE__->load_components("+FixMyStreet::DB::RABXColumn");
+__PACKAGE__->rabx_column('data');
+
 
 sub new {
     my ( $class, $attrs ) = @_;
diff --git a/perllib/FixMyStreet/DB/Result/User.pm b/perllib/FixMyStreet/DB/Result/User.pm
index 481b654c9..523382670 100644
--- a/perllib/FixMyStreet/DB/Result/User.pm
+++ b/perllib/FixMyStreet/DB/Result/User.pm
@@ -58,10 +58,10 @@ __PACKAGE__->belongs_to(
   "FixMyStreet::DB::Result::Body",
   { id => "from_body" },
   {
-    is_deferrable => 1,
+    is_deferrable => 0,
     join_type     => "LEFT",
-    on_delete     => "CASCADE",
-    on_update     => "CASCADE",
+    on_delete     => "NO ACTION",
+    on_update     => "NO ACTION",
   },
 );
 __PACKAGE__->has_many(
@@ -72,8 +72,8 @@ __PACKAGE__->has_many(
 );
 
 
-# Created by DBIx::Class::Schema::Loader v0.07017 @ 2012-12-14 09:23:59
-# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:aw374WQraL5ysOvUmUIU3w
+# Created by DBIx::Class::Schema::Loader v0.07035 @ 2013-09-10 17:11:54
+# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:jRAtXRLRNozCmthAg9p0dA
 
 __PACKAGE__->add_columns(
     "password" => {
diff --git a/perllib/FixMyStreet/DB/ResultSet/Problem.pm b/perllib/FixMyStreet/DB/ResultSet/Problem.pm
index 07848d782..b00daab40 100644
--- a/perllib/FixMyStreet/DB/ResultSet/Problem.pm
+++ b/perllib/FixMyStreet/DB/ResultSet/Problem.pm
@@ -259,10 +259,14 @@ sub send_reports {
         }
 
         $cobrand->set_lang_and_domain($row->lang, 1);
-        if ( $row->is_from_abuser ) {
+        if ( $row->is_from_abuser) {
             $row->update( { state => 'hidden' } );
             debug_print("hiding because its sender is flagged as an abuser", $row->id) if $debug_mode;
             next;
+        } elsif ( $row->title =~ /app store test/i ) {
+            $row->update( { state => 'hidden' } );
+            debug_print("hiding because it is an app store test message", $row->id) if $debug_mode;
+            next;
         }
 
         # Template variables for the email
@@ -464,7 +468,8 @@ sub send_reports {
             send_fail_count => { '>', 0 }
         } );
         while (my $row = $unsent->next) {
-            $sending_errors .= "* http://www.fixmystreet.com/report/" . $row->id . ", failed "
+            my $base_url = mySociety::Config::get('BASE_URL');
+            $sending_errors .= "* " . $base_url . "/report/" . $row->id . ", failed "
                 . $row->send_fail_count . " times, last at " . $row->send_fail_timestamp
                 . ", reason " . $row->send_fail_reason . "\n";
         }
diff --git a/perllib/FixMyStreet/Map/OSM/MapQuest.pm b/perllib/FixMyStreet/Map/OSM/MapQuest.pm
index 4751679f5..ff314a4da 100644
--- a/perllib/FixMyStreet/Map/OSM/MapQuest.pm
+++ b/perllib/FixMyStreet/Map/OSM/MapQuest.pm
@@ -28,7 +28,7 @@ sub map_tiles {
 }
 
 sub base_tile_url {
-    return 'mqcdn.com/tiles/1.0.0/osm/';
+    return 'mqcdn.com/tiles/1.0.0/map/';
 }
 
 1;
diff --git a/perllib/FixMyStreet/TestMech.pm b/perllib/FixMyStreet/TestMech.pm
index e91c6a1d6..be8f004a5 100644
--- a/perllib/FixMyStreet/TestMech.pm
+++ b/perllib/FixMyStreet/TestMech.pm
@@ -87,8 +87,8 @@ sub log_in_ok {
 
     my $user = $mech->create_user_ok($email);
 
-    # store the old password and then change it
-    my $old_password = $user->password;
+    # remember the old password and then change it to a known one
+    my $old_password = $user->password || '';
     $user->update( { password => 'secret' } );
 
     # log in
@@ -99,7 +99,19 @@ sub log_in_ok {
     $mech->logged_in_ok;
 
     # restore the password (if there was one)
-    $user->update( { password => $old_password } ) if $old_password;
+    if ($old_password) {
+
+        # Use store_column and then make_column_dirty to bypass the filters that
+        # would hash the password, otherwise the password required ito log in
+        # would be the hash of the previous one.
+        $user->store_column("password", $old_password);
+        $user->make_column_dirty("password");
+        $user->update();
+
+        # Belt and braces, check that the password has been correctly saved.
+        die "password not correctly restored after log_in_ok"
+            if $user->password ne $old_password;
+    }
 
     return $user;
 }
@@ -296,7 +308,7 @@ sub extract_location {
 
     $meta = $mech->extract_problem_meta;
 
-Returns the problem meta information ( submitted by, at etc ) from a 
+Returns the problem meta information ( submitted by, at etc ) from a
 problem report page
 
 =cut
diff --git a/perllib/Open311/PopulateServiceList.pm b/perllib/Open311/PopulateServiceList.pm
index 7990abfbf..c5fc4a506 100644
--- a/perllib/Open311/PopulateServiceList.pm
+++ b/perllib/Open311/PopulateServiceList.pm
@@ -42,8 +42,9 @@ sub process_body {
     my $list = $open311->get_service_list;
     unless ( $list ) {
         my $id = $self->_current_body->id;
+        my $mapit_url = mySociety::Config::get('MAPIT_URL');
         my $areas = join( ",", keys %{$self->_current_body->areas} );
-        warn "Body $id for areas $areas - http://mapit.mysociety.org/areas/$areas.html - did not return a service list\n"
+        warn "Body $id for areas $areas - $mapit_url/areas/$areas.html - did not return a service list\n"
             if $self->verbose >= 1;
         return;
     }
diff --git a/perllib/Template/Document.pm b/perllib/Template/Document.pm
new file mode 100644
index 000000000..8fc66deea
--- /dev/null
+++ b/perllib/Template/Document.pm
@@ -0,0 +1,539 @@
+##============================================================= -*-Perl-*-
+#
+# Template::Document
+#
+# DESCRIPTION
+#   Module defining a class of objects which encapsulate compiled
+#   templates, storing additional block definitions and metadata 
+#   as well as the compiled Perl sub-routine representing the main
+#   template content.
+#
+# AUTHOR
+#   Andy Wardley   <abw@wardley.org>
+#
+# COPYRIGHT
+#   Copyright (C) 1996-2007 Andy Wardley.  All Rights Reserved.
+#
+#   This module is free software; you can redistribute it and/or
+#   modify it under the same terms as Perl itself.
+#
+#============================================================================
+
+package Template::Document;
+
+use strict;
+use warnings;
+use base 'Template::Base';
+use Template::Constants;
+
+our $VERSION = 2.79;
+our $DEBUG   = 0 unless defined $DEBUG;
+our $ERROR   = '';
+our ($COMPERR, $AUTOLOAD, $UNICODE);
+
+BEGIN {
+    # UNICODE is supported in versions of Perl from 5.008 onwards
+    if ($UNICODE = $] > 5.007 ? 1 : 0) {
+        if ($] > 5.008) {
+            # utf8::is_utf8() available from Perl 5.8.1 onwards
+            *is_utf8 = \&utf8::is_utf8;
+        }
+        elsif ($] == 5.008) {
+            # use Encode::is_utf8() for Perl 5.8.0
+            require Encode;
+            *is_utf8 = \&Encode::is_utf8;
+        }
+    }
+}
+
+
+#========================================================================
+#                     -----  PUBLIC METHODS -----
+#========================================================================
+
+#------------------------------------------------------------------------
+# new(\%document)
+#
+# Creates a new self-contained Template::Document object which 
+# encapsulates a compiled Perl sub-routine, $block, any additional 
+# BLOCKs defined within the document ($defblocks, also Perl sub-routines)
+# and additional $metadata about the document.
+#------------------------------------------------------------------------
+
+sub new {
+    my ($class, $doc) = @_;
+    my ($block, $defblocks, $variables, $metadata) = @$doc{ qw( BLOCK DEFBLOCKS VARIABLES METADATA ) };
+    $defblocks ||= { };
+    $metadata  ||= { };
+
+    # evaluate Perl code in $block to create sub-routine reference if necessary
+    unless (ref $block) {
+        local $SIG{__WARN__} = \&catch_warnings;
+        $COMPERR = '';
+
+        # DON'T LOOK NOW! - blindly untainting can make you go blind!
+        $block =~ /(.*)/s;
+        $block = $1;
+        
+        $block = eval $block;
+        return $class->error($@)
+            unless defined $block;
+    }
+
+    # same for any additional BLOCK definitions
+    @$defblocks{ keys %$defblocks } = 
+        # MORE BLIND UNTAINTING - turn away if you're squeamish
+        map { 
+            ref($_) 
+                ? $_ 
+                : ( /(.*)/s && eval($1) or return $class->error($@) )
+            } values %$defblocks;
+    
+    bless {
+        %$metadata,
+        _BLOCK     => $block,
+        _DEFBLOCKS => $defblocks,
+        _VARIABLES => $variables,
+        _HOT       => 0,
+    }, $class;
+}
+
+
+#------------------------------------------------------------------------
+# block()
+#
+# Returns a reference to the internal sub-routine reference, _BLOCK, 
+# that constitutes the main document template.
+#------------------------------------------------------------------------
+
+sub block {
+    return $_[0]->{ _BLOCK };
+}
+
+
+#------------------------------------------------------------------------
+# blocks()
+#
+# Returns a reference to a hash array containing any BLOCK definitions 
+# from the template.  The hash keys are the BLOCK nameand the values
+# are references to Template::Document objects.  Returns 0 (# an empty hash)
+# if no blocks are defined.
+#------------------------------------------------------------------------
+
+sub blocks {
+    return $_[0]->{ _DEFBLOCKS };
+}
+
+
+#-----------------------------------------------------------------------
+# variables()
+#
+# Returns a reference to a hash of variables used in the template.  
+# This requires the TRACE_VARS option to be enabled.
+#-----------------------------------------------------------------------
+
+sub variables {
+    return $_[0]->{ _VARIABLES };
+}
+
+#------------------------------------------------------------------------
+# process($context)
+#
+# Process the document in a particular context.  Checks for recursion,
+# registers the document with the context via visit(), processes itself,
+# and then unwinds with a large gin and tonic.
+#------------------------------------------------------------------------
+
+sub process {
+    my ($self, $context) = @_;
+    my $defblocks = $self->{ _DEFBLOCKS };
+    my $output;
+
+
+    # check we're not already visiting this template
+    return $context->throw(Template::Constants::ERROR_FILE, 
+                           "recursion into '$self->{ name }'")
+        if $self->{ _HOT } && ! $context->{ RECURSION };   ## RETURN ##
+
+    $context->visit($self, $defblocks);
+
+    $self->{ _HOT } = 1;
+    eval {
+        my $block = $self->{ _BLOCK };
+        $output = &$block($context);
+    };
+    $self->{ _HOT } = 0;
+
+    $context->leave();
+
+    die $context->catch($@)
+        if $@;
+        
+    return $output;
+}
+
+
+#------------------------------------------------------------------------
+# AUTOLOAD
+#
+# Provides pseudo-methods for read-only access to various internal 
+# members. 
+#------------------------------------------------------------------------
+
+sub AUTOLOAD {
+    my $self   = shift;
+    my $method = $AUTOLOAD;
+
+    $method =~ s/.*:://;
+    return if $method eq 'DESTROY';
+#    my ($pkg, $file, $line) = caller();
+#    print STDERR "called $self->AUTOLOAD($method) from $file line $line\n";
+    return $self->{ $method };
+}
+
+
+#========================================================================
+#                     -----  PRIVATE METHODS -----
+#========================================================================
+
+
+#------------------------------------------------------------------------
+# _dump()
+#
+# Debug method which returns a string representing the internal state
+# of the object.
+#------------------------------------------------------------------------
+
+sub _dump {
+    my $self = shift;
+    my $dblks;
+    my $output = "$self : $self->{ name }\n";
+
+    $output .= "BLOCK: $self->{ _BLOCK }\nDEFBLOCKS:\n";
+
+    if ($dblks = $self->{ _DEFBLOCKS }) {
+        foreach my $b (keys %$dblks) {
+            $output .= "    $b: $dblks->{ $b }\n";
+        }
+    }
+
+    return $output;
+}
+
+
+#========================================================================
+#                      ----- CLASS METHODS -----
+#========================================================================
+
+#------------------------------------------------------------------------
+# as_perl($content)
+#
+# This method expects a reference to a hash passed as the first argument
+# containing 3 items:
+#     METADATA   # a hash of template metadata
+#     BLOCK      # string containing Perl sub definition for main block
+#     DEFBLOCKS  # hash containing further subs for addional BLOCK defs
+# It returns a string containing Perl code which, when evaluated and 
+# executed, will instantiate a new Template::Document object with the 
+# above data.  On error, it returns undef with an appropriate error
+# message set in $ERROR.
+#------------------------------------------------------------------------
+
+sub as_perl {
+    my ($class, $content) = @_;
+    my ($block, $defblocks, $metadata) = @$content{ qw( BLOCK DEFBLOCKS METADATA ) };
+
+    #$block =~ s/\n(?!#line)/\n    /g;
+    $block =~ s/\s+$//;
+
+    $defblocks = join('', map {
+        my $code = $defblocks->{ $_ };
+     #   $code =~ s/\n(?!#line)/\n        /g;
+        $code =~ s/\s*$//;
+        "        '$_' => $code,\n";
+    } keys %$defblocks);
+    $defblocks =~ s/\s+$//;
+
+    $metadata = join('', map { 
+        my $x = $metadata->{ $_ }; 
+        $x =~ s/(['\\])/\\$1/g; 
+        "        '$_' => '$x',\n";
+    } keys %$metadata);
+    $metadata =~ s/\s+$//;
+
+    return <<EOF
+#------------------------------------------------------------------------
+# Compiled template generated by the Template Toolkit version $Template::VERSION
+#------------------------------------------------------------------------
+
+$class->new({
+    METADATA => {
+$metadata
+    },
+    BLOCK => $block,
+    DEFBLOCKS => {
+$defblocks
+    },
+});
+EOF
+}
+
+
+#------------------------------------------------------------------------
+# write_perl_file($filename, \%content)
+#
+# This method calls as_perl() to generate the Perl code to represent a
+# compiled template with the content passed as the second argument.
+# It then writes this to the file denoted by the first argument.
+#
+# Returns 1 on success.  On error, sets the $ERROR package variable
+# to contain an error message and returns undef.
+#------------------------------------------------------------------------
+
+sub write_perl_file {
+    my ($class, $file, $content) = @_;
+    my ($fh, $tmpfile);
+    
+    return $class->error("invalid filename: $file")
+        unless $file =~ /^(.+)$/s;
+
+    eval {
+        require File::Temp;
+        require File::Basename;
+        ($fh, $tmpfile) = File::Temp::tempfile( 
+            DIR => File::Basename::dirname($file) 
+        );
+        my $perlcode = $class->as_perl($content) || die $!;
+        
+        if ($UNICODE && is_utf8($perlcode)) {
+            $perlcode = "use utf8;\n\n$perlcode";
+            binmode $fh, ":utf8";
+        }
+        print $fh $perlcode;
+        close($fh);
+    };
+    return $class->error($@) if $@;
+    return rename($tmpfile, $file)
+        || $class->error($!);
+}
+
+
+#------------------------------------------------------------------------
+# catch_warnings($msg)
+#
+# Installed as
+#------------------------------------------------------------------------
+
+sub catch_warnings {
+    $COMPERR .= join('', @_); 
+}
+
+    
+1;
+
+__END__
+
+=head1 NAME
+
+Template::Document - Compiled template document object
+
+=head1 SYNOPSIS
+
+    use Template::Document;
+    
+    $doc = Template::Document->new({
+        BLOCK => sub { # some perl code; return $some_text },
+        DEFBLOCKS => {
+            header => sub { # more perl code; return $some_text },
+            footer => sub { # blah blah blah; return $some_text },
+        },
+        METADATA => {
+            author  => 'Andy Wardley',
+            version => 3.14,
+        }
+    }) || die $Template::Document::ERROR;
+    
+    print $doc->process($context);
+
+=head1 DESCRIPTION
+
+This module defines an object class whose instances represent compiled
+template documents.  The L<Template::Parser> module creates a
+C<Template::Document> instance to encapsulate a template as it is compiled
+into Perl code.
+
+The constructor method, L<new()>, expects a reference to a hash array
+containing the C<BLOCK>, C<DEFBLOCKS> and C<METADATA> items.  
+
+The C<BLOCK> item should contain a reference to a Perl subroutine or a textual
+representation of Perl code, as generated by the L<Template::Parser> module.
+This is then evaluated into a subroutine reference using C<eval()>. 
+
+The C<DEFLOCKS> item should reference a hash array containing further named
+C<BLOCK>s which may be defined in the template. The keys represent C<BLOCK>
+names and the values should be subroutine references or text strings of Perl
+code as per the main C<BLOCK> item. 
+
+The C<METADATA> item should reference a hash array of metadata items relevant
+to the document.
+
+The L<process()> method can then be called on the instantiated
+C<Template::Document> object, passing a reference to a L<Template::Context>
+object as the first parameter. This will install any locally defined blocks
+(C<DEFBLOCKS>) in the C<BLOCKS> cache in the context (via a call to
+L<visit()|Template::Context#visit()>) so that they may be subsequently
+resolved by the context. The main C<BLOCK> subroutine is then executed,
+passing the context reference on as a parameter. The text returned from the
+template subroutine is then returned by the L<process()> method, after calling
+the context L<leave()|Template::Context#leave()> method to permit cleanup and
+de-registration of named C<BLOCKS> previously installed.
+
+An C<AUTOLOAD> method provides access to the C<METADATA> items for the
+document. The L<Template::Service> module installs a reference to the main
+C<Template::Document> object in the stash as the C<template> variable. This allows
+metadata items to be accessed from within templates, including C<PRE_PROCESS>
+templates.
+
+header:
+
+    <html>
+    <head>
+    <title>[% template.title %]
+    </head>
+    ...
+
+C<Template::Document> objects are usually created by the L<Template::Parser>
+but can be manually instantiated or sub-classed to provide custom
+template components.
+
+=head1 METHODS
+
+=head2 new(\%config)
+
+Constructor method which accept a reference to a hash array containing the
+structure as shown in this example:
+
+    $doc = Template::Document->new({
+        BLOCK => sub { # some perl code; return $some_text },
+        DEFBLOCKS => {
+            header => sub { # more perl code; return $some_text },
+            footer => sub { # blah blah blah; return $some_text },
+        },
+        METADATA => {
+            author  => 'Andy Wardley',
+            version => 3.14,
+        }
+    }) || die $Template::Document::ERROR;
+
+C<BLOCK> and C<DEFBLOCKS> items may be expressed as references to Perl subroutines
+or as text strings containing Perl subroutine definitions, as is generated
+by the L<Template::Parser> module.  These are evaluated into subroutine references
+using C<eval()>.
+
+Returns a new C<Template::Document> object or C<undef> on error. The
+L<error()|Template::Base#error()> class method can be called, or the C<$ERROR>
+package variable inspected to retrieve the relevant error message.
+
+=head2 process($context)
+
+Main processing routine for the compiled template document. A reference to a
+L<Template::Context> object should be passed as the first parameter. The
+method installs any locally defined blocks via a call to the context
+L<visit()|Template::Context#visit()> method, processes its own template,
+(passing the context reference as a parameter) and then calls
+L<leave()|Template::Context#leave()> in the context to allow cleanup.
+
+    print $doc->process($context);
+
+Returns a text string representing the generated output for the template.
+Errors are thrown via C<die()>.
+
+=head2 block()
+
+Returns a reference to the main C<BLOCK> subroutine.
+
+=head2 blocks()
+
+Returns a reference to the hash array of named C<DEFBLOCKS> subroutines.
+
+=head2 variables()
+
+Returns a reference to a hash of variables used in the template.  
+This requires the L<TRACE_VARS|Template::Manual::Config#TRACE_VARS> 
+option to be enabled.
+
+=head2 AUTOLOAD
+
+An autoload method returns C<METADATA> items.
+
+    print $doc->author();
+
+=head1 CLASS METHODS
+
+These methods are used internally.
+
+=head2 as_perl($content)
+
+This method generate a Perl representation of the template.
+
+    my $perl = Template::Document->as_perl({
+        BLOCK     => $main_block,
+        DEFBLOCKS => {
+            foo   => $foo_block,
+            bar   => $bar_block,
+        },
+        METADATA  => {
+            name  => 'my_template',
+        }
+    });
+
+=head2 write_perl_file(\%config)
+
+This method is used to write compiled Perl templates to disk.  If the
+C<COMPILE_EXT> option (to indicate a file extension for saving compiled
+templates) then the L<Template::Parser> module calls this subroutine before
+calling the L<new()> constructor.  At this stage, the parser has a
+representation of the template as text strings containing Perl code.  We can
+write that to a file, enclosed in a small wrapper which will allow us to
+susequently C<require()> the file and have Perl parse and compile it into a
+C<Template::Document>.  Thus we have persistence of compiled templates.
+
+=head1 INTERNAL FUNCTIONS
+
+=head2 catch_warnings()
+
+This is a simple handler used to catch any errors that arise when the
+compiled Perl template is first evaluated (that is, evaluated by Perl to
+create a template subroutine at compile, rather than the template being
+processed at runtime).
+
+=head2 is_utf8()
+
+This is mapped to C<utf8::is_utf8> for versions of Perl that have it (> 5.008)
+or to C<Encode::is_utf8> for Perl 5.008.  Earlier versions of Perl are not 
+supported.
+
+=head1 AUTHOR
+
+Andy Wardley E<lt>abw@wardley.orgE<gt> L<http://wardley.org/>
+
+=head1 COPYRIGHT
+
+Copyright (C) 1996-2012 Andy Wardley.  All Rights Reserved.
+
+This module is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+=head1 SEE ALSO
+
+L<Template>, L<Template::Parser>
+
+=cut
+
+# Local Variables:
+# mode: perl
+# perl-indent-level: 4
+# indent-tabs-mode: nil
+# End:
+#
+# vim: expandtab shiftwidth=4: