diff --git a/Changelog b/Changelog index 6f9f7746c6..369e6d289f 100644 --- a/Changelog +++ b/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 diff --git a/LedgerSMB/PSGI.pm b/LedgerSMB/PSGI.pm new file mode 100644 index 0000000000..774c11db25 --- /dev/null +++ b/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;