Merge pull request ledgersmb#418 from einhverfr/1.3

Plack support now works

Changelog

@@ -6,6 +6,7 @@ Changelog for 1.3.45
 * Cleaned up sql files so App::LedgerSMB::Admin (Chris T)
 * Fixed pricematrix prices not respected for vendors (Chris T, bug 1230)
 * Added tests for Sysconfig (Chris T, bug 1232)
+* Added first-rate starman/plack support (Chris T)
 
 Chris T is Chris Travers
 

LedgerSMB/PSGI.pm

@@ -0,0 +1,82 @@
+package LedgerSMB::PSGI;
+
+=head1 NAME
+
+PSGI wrapper functionality for LedgerSMB
+
+=head1 SYNOPSIS
+
+ use LedgerSMB::PSGI;
+ my $app = LedgerSMB::PSGI->get_app();
+
+=cut
+
+# Preloads
+use LedgerSMB;
+use LedgerSMB::Form;
+use LedgerSMB::Sysconfig;
+use LedgerSMB::Template;
+use LedgerSMB::Template::LaTeX;
+use LedgerSMB::Template::HTML;
+use LedgerSMB::Locale;
+use LedgerSMB::DBObject;
+use LedgerSMB::File;
+use Try::Tiny;
+
+use CGI::Emulate::PSGI;
+
+sub app {
+   return CGI::Emulate::PSGI->handler(
+     sub {
+       my $uri = $ENV{REQUEST_URI};
+       $ENV{SCRIPT_NAME} = $uri;
+       my $script = $uri;
+       $ENV{SCRIPT_NAME} =~ s/\?.*//; 
+       $script =~ s/.*[\\\/]([^\\\/\?=]+\.pl).*/$1/;
+
+       if (-f "scripts/$script"){
+         {
+         package main; 
+         do 'lsmb-request.pl'; 
+         }
+       } else {
+          _run_old($script);
+       }
+    }
+  );
+}
+
+my $pre_dispatch = undef;
+sub pre_dispatch {
+    $pre_dispatch = shift;
+}
+
+my $post_dispatch = undef;
+sub post_dispatch {
+    $pre_dispatch = shift;
+}
+
+sub _run_old {
+    if (my $cpid = fork()){
+       wait;
+    } else {
+       &$pre_dispatch() if $pre_dispatch;
+       { package main;
+       do 'old-handler.pl';
+       }
+       &$post_dispatch() if $post_dispatch;
+       exit;
+    }
+}
+
+sub _run_new {
+    my ($script) = @_;
+    &$pre_dispatch();
+    $uri = $ENV{REQUEST_URI};
+    $uri =~ s/\?.*//;
+
+    do "./$script";
+    &$post_dispatch();
+}
+
+1;