[dw-free] Move /interface/s2 into DW::Routing

[fu]

[commit: http://hg.dwscoalition.org/dw-free/rev/3d6b9b44d272]

http://bugs.dwscoalition.org/show_bug.cgi?id=2289

Add missing file.

Patch by fu.

Files modified:

• cgi-bin/DW/Controller/Interface/S2.pm

--------------------------------------------------------------------------------
diff -r e49268dcb070 -r 3d6b9b44d272 cgi-bin/DW/Controller/Interface/S2.pm
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/cgi-bin/DW/Controller/Interface/S2.pm	Tue Jul 06 02:34:20 2010 +0800
@@ -0,0 +1,121 @@
+#!/usr/bin/perl
+#
+# DW::Controller::Interface::S2
+#
+# This controller is for the s2 interface
+#
+# Authors:
+#      Afuna <coder.dw@afunamatata.com>
+#
+# Copyright (c) 2010 by Dreamwidth Studios, LLC.
+#
+# This program is free software; you may redistribute it and/or modify it under
+# the same terms as Perl itself. For a copy of the license, please reference
+# 'perldoc perlartistic' or 'perldoc perlgpl'.
+#
+
+package DW::Controller::Interface::S2;
+
+use strict;
+use warnings;
+use DW::Routing;
+
+# handle, even with no id, so that we can present an informative error message
+DW::Routing->register_regex( '^/interface/s2(?:/(\d+)?)?$', \&interface_handler, app => 1, format => 'plain' );
+
+# handles menu nav pages
+sub interface_handler {
+    my $r = DW::Request->get;
+    my $method = $r->method;
+
+    my $layerid = int( $_[0]->subpatterns->[0] || 0 ) || '';
+    return error( $r, $r->NOT_FOUND, 'No layerid', 'Must provide the layerid, e.g., /interface/s2/1234' )
+        unless $layerid;
+
+    my $lay = LJ::S2::load_layer( $layerid );
+    return error( $r, $r->NOT_FOUND, 'Layer not found', "There is no layer with id '$layerid' at this site" )
+        unless $lay;
+
+    LJ::auth_digest( $r );
+
+    my $remote = LJ::get_remote();
+    return error( $r, $r->HTTP_UNAUTHORIZED, 'Unauthorized', "You must send your $LJ::SITENAME username and password or a valid session cookie\n" )
+        unless $remote;
+
+    my $layeru = LJ::load_userid( $lay->{userid} );
+    return error( $r, $r->SERVER_ERROR, "Error", "Unable to find layer owner" )
+        unless $layeru;
+
+    if ( $method eq 'GET' ) {
+        return error( $r, $r->FORBIDDEN, 'Forbidden', "You are not authorized to retrieve this layer" )
+            unless $layeru->user eq "system" || $remote->can_manage( $layeru );
+
+        my $layerinfo = {};
+        LJ::S2::load_layer_info( $layerinfo, [ $layerid ] );
+        my $srcview = exists $layerinfo->{$layerid}->{source_viewable} ? $layerinfo->{$layerid}->{source_viewable} : 1;
+
+        # Disallow retrieval of protected system layers
+        return error( $r, $r->FORBIDDEN, 'Forbidden', "The requested layer is restricted" )
+            if $layeru->user eq "system" && ! $srcview;
+
+        my $s2code = LJ::S2::load_layer_source( $layerid );
+        $r->content_type( "application/x-danga-s2-layer" );
+        $r->print( $s2code );
+
+        return $r->OK;
+    } elsif ( $method eq 'PUT' ) {
+        return error( $r, $r->FORBIDDEN, 'Forbidden', 'You are not authorized to edit this layer' )
+            unless $remote->can_manage( $layeru );
+
+        return error( $r, $r->FORBIDDEN, 'Forbidden', 'Your account type is not allowed to edit layers' )
+            unless $remote->can_create_s2_styles;
+
+        # Read in the entity body to get the source
+        my $len = $r->header_in( "Content-length" ) + 0;
+
+        return error( $r, $r->HTTP_BAD_REQUEST, 'Bad Request', 'Supply S2 layer code in the request entity body and set Content-length' )
+            unless $len;
+
+        return error( $r, $r->HTTP_UNSUPPORTED_MEDIA_TYPE, 'Unsupported Media Type', 'Request body must be of type application/x-danga-s2-layer' )
+            unless lc( $r->header_in( 'Content-type' ) ) eq 'application/x-danga-s2-layer';
+
+        my $s2code;
+        $r->read( $s2code, $len );
+
+        my $error = "";
+        LJ::S2::layer_compile( $lay, \$error, { s2ref => \$s2code } );
+
+        if ( $error ) {
+            error( $r, $r->HTTP_INTERNAL_SERVER_ERROR, "Layer Compile Error", "An error was encountered while compiling the layer." );
+
+            ## Strip any absolute paths
+            $error =~ s/LJ::.+//s;
+            $error =~ s!, .+?(src/s2|cgi-bin)/!, !g;
+
+            $r->print( $error );
+            return $r->OK;
+        } else {
+            $r->status_line( "201 Compiled and Saved" );
+            $r->header_out( Location => "$LJ::SITEROOT/interface/s2/$layerid" );
+            $r->print( "Compiled and Saved\nThe layer was uploaded successfully.\n" );
+
+            return $r->OK;
+        }
+    } else {
+        # Return 'method not allowed' so that we can add methods in future
+        # and clients will get a sensible error from old servers.
+        return error( $r, $r->HTTP_METHOD_NOT_ALLOWED, 'Method Not Allowed', 'Only GET and PUT are supported for this resource' );
+    }
+}
+
+sub error {
+    my ( $r, $code, $string, $long ) = @_;
+    
+    $r->status_line( "$code $string" );
+    $r->print( "$string\n$long\n" );
+
+    # Tell Apache OK so it won't try to handle the error
+    return $r->OK;
+}
+
+1;
--------------------------------------------------------------------------------