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

[fu]

[commit: http://hg.dwscoalition.org/dw-free/rev/127048be3771]

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

Move out of Apache::LiveJournal and into a controller.

Patch by fu.

Files modified:

• cgi-bin/Apache/LiveJournal.pm
• cgi-bin/DW/Controller/Interface/Flat.pm

--------------------------------------------------------------------------------
diff -r a1e8af07039f -r 127048be3771 cgi-bin/Apache/LiveJournal.pm
--- a/cgi-bin/Apache/LiveJournal.pm	Mon May 16 22:36:08 2011 +0800
+++ b/cgi-bin/Apache/LiveJournal.pm	Mon May 16 23:24:25 2011 +0800
@@ -186,7 +186,7 @@
     my $r = shift;
     my $uri = $r->uri;
 
-    if ($uri =~ m!^/interface/flat! || $uri =~ m!^/cgi-bin/log\.cg!) {
+    if ($uri =~ m!^/cgi-bin/log\.cg!) {
         $r->content_type("text/plain");
         $r->print("success\nFAIL\nerrmsg\n$LJ::SERVER_DOWN_MESSAGE");
         return OK;
@@ -956,9 +956,9 @@
 
     # protocol support
     if ($uri =~ m!^/(?:interface/(\w+))|cgi-bin/log\.cgi!) {
-        my $int = $1 || "flat";
+        my $int = $1;
         $r->handler("perl-script");
-        if ($int =~ /^flat|xmlrpc|blogger|elsewhere_info$/) {
+        if ($int =~ /^xmlrpc|blogger|elsewhere_info$/) {
             $RQ{'interface'} = $int;
             $RQ{'is_ssl'} = $is_ssl;
             $r->push_handlers(PerlResponseHandler => \&interface_content);
@@ -1643,45 +1643,8 @@
         return OK;
     }
 
-    if ($RQ{'interface'} ne "flat") {
-        $r->content_type("text/plain");
-        $r->print("Unknown interface.");
-        return OK;
-    }
-
     $r->content_type("text/plain");
-
-    my ( %out, %FORM, $content );
-    $r->read($content, $r->headers_in->{"Content-Length"})
-        if $r->headers_in->{'Content-Length'};
-    LJ::decode_url_string($content, \%FORM);
-
-    # the protocol needs the remote IP in just one place, where tracking is done.
-    $ENV{'_REMOTE_IP'} = $r->connection()->remote_ip();
-    LJ::do_request(\%FORM, \%out);
-
-    if ($FORM{'responseenc'} eq "urlenc") {
-        foreach (sort keys %out) {
-            $r->print(LJ::eurl($_) . "=" . LJ::eurl($out{$_}) . "&");
-        }
-        return OK;
-    }
-
-    my $length = 0;
-    foreach (sort keys %out) {
-        $length += length($_)+1;
-        $length += length($out{$_})+1;
-    }
-
-    $r->headers_out->{"Content-length"} = $length;
-    foreach (sort keys %out) {
-        my $key = $_;
-        my $val = $out{$_};
-        $key =~ y/\r\n//d;
-        $val =~ y/\r\n//d;
-        $r->print($key, "\n", $val, "\n");
-    }
-
+    $r->print("Unknown interface.");
     return OK;
 }
 
diff -r a1e8af07039f -r 127048be3771 cgi-bin/DW/Controller/Interface/Flat.pm
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/cgi-bin/DW/Controller/Interface/Flat.pm	Mon May 16 23:24:25 2011 +0800
@@ -0,0 +1,64 @@
+#!/usr/bin/perl
+#
+# DW::Controller::Interface::Flat
+#
+# This controller is for the old flat interface
+#
+# Authors:
+#      Afuna <coder.dw@afunamatata.com>
+#
+# Copyright (c) 2011 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::Flat;
+
+use strict;
+use DW::Routing;
+
+DW::Routing->register_string( '/interface/flat', \&interface_handler, app => 1, format => 'plain',
+    methods => { GET => 1, POST => 1 } );
+
+sub interface_handler {
+    my $r = DW::Request->get;
+
+    my ( %out, %post );
+
+    my $post_args = $r->post_args;
+    $post_args->do( sub {
+        my ( $k, $v ) = @_;
+        $post{$k} = $v;
+        return 1;
+    } ) if $post_args;
+
+    LJ::do_request( \%post, \%out );
+
+    if ( "urlenc" eq ( $post{responseenc} || "" ) ) {
+        foreach ( sort keys %out ) {
+            $r->print( LJ::eurl( $_ ) . "=" . LJ::eurl( $out{$_} ) . "&" );
+        }
+        return $r->OK;
+    }
+
+    my $length = 0;
+    foreach ( sort keys %out ) {
+        $length += length( $_ ) + 1;
+        $length += length( $out{$_} ) + 1;
+    }
+    $r->header_out( "Content-Length", $length );
+
+    foreach ( sort keys %out ) {
+        my $key = $_;
+        my $val = $out{$_};
+        $key =~ y/\r\n//d;
+        $val =~ y/\r\n//d;
+        $r->print( $key, "\n", $val, "\n" );
+    }
+
+    return $r->OK;
+}
+
+1;
--------------------------------------------------------------------------------