From 3dc59b2551784b3c244fe6131e53a7b152a5269c Mon Sep 17 00:00:00 2001 From: jasonjayr Date: Thu, 15 Feb 2007 22:37:06 +0000 Subject: 'Virtual URL' frontend, this will let us (eventually) encode the company name into the URI so we can go to /ledger-smb/lsmb.pl/acme/login.pl, and only have to admin and login to acme's database. Ideally index.html will point to the default company, and/or lsmb.pl/login.pl, but this initial commit will just be this self-contained code. git-svn-id: https://ledger-smb.svn.sourceforge.net/svnroot/ledger-smb/trunk@809 4979c152-3d1c-0410-bac9-87ea11338e46 --- lsmb.pl | 47 +++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 47 insertions(+) create mode 100755 lsmb.pl diff --git a/lsmb.pl b/lsmb.pl new file mode 100755 index 00000000..cdc4737c --- /dev/null +++ b/lsmb.pl @@ -0,0 +1,47 @@ +#!/usr/bin/perl -w +use warnings; +use strict; + +LedgerSMB::Handler->cgi_handle(); + +package LedgerSMB::Handler; +use LedgerSMB::Log; +use warnings; +use strict; +use CGI::Carp qw(fatalsToBrowser); + +sub cgi_handle { + my $self = shift; + + my $script = $ENV{PATH_INFO}; + + $script =~ s/^\///; + # TODO: we can parse out other information, such as + # Company Identifier, and what not here. + + #return $self->debug(); + + if($script =~ /\.pl$/) { + # perl scripts should be directly executed. + warn "[LedgerSMB::Handler] running $script"; + exec("./$script") or croak $!; + } else { + # redirect them back to the original url + + # infer the base URI, this fails unless the script is named lsmb.pl + my ($base_uri) = $ENV{SCRIPT_NAME} =~ m#^(.*?)/lsmb.pl#; + print "Status: 301\nLocation: $base_uri/$script\n\n"; + } +} + +sub debug { + my $self = shift; + + use Data::Dumper; + print "Content-type: text/plain\n\n"; + print "\$0 is $0\n"; + print Dumper(\%ENV); + +} + +1; -- cgit v1.2.3