SF.net SVN: ledger-smb:[5113] branches/1.3/LedgerSMB/Auth.pm

[..hidden..]

Revision: 5113
          http://ledger-smb.svn.sourceforge.net/ledger-smb/?rev=5113&view=rev
Author:   einhverfr
Date:     2012-08-17 10:23:40 +0000 (Fri, 17 Aug 2012)
Log Message:
-----------
Moving error headers to CGI::Simple, as this avoids problems in Plack and other non-Apache/CGI environments

Modified Paths:
--------------
    branches/1.3/LedgerSMB/Auth.pm

Modified: branches/1.3/LedgerSMB/Auth.pm
===================================================================
--- branches/1.3/LedgerSMB/Auth.pm	2012-08-17 10:21:54 UTC (rev 5112)
+++ branches/1.3/LedgerSMB/Auth.pm	2012-08-17 10:23:40 UTC (rev 5113)
@@ -62,6 +62,9 @@
 package LedgerSMB::Auth;
 
 use LedgerSMB::Sysconfig;
+use CGI::Simple;
+use strict;
+use warnings;
 
 if ( !${LedgerSMB::Sysconfig::auth} ) {
     ${LedgerSMB::Sysconfig::auth} = 'DB';
@@ -71,6 +74,7 @@
 
 sub http_error {
     my ($errcode, $msg_plus) = @_;
+    my $cgi = CGI::Simple->new();
 
     my $err = {
 	'500' => {status  => '500 Internal Server Error', 
@@ -89,28 +93,20 @@
         '454' => {status  => '454 Database Does Not Exist',
                   message => 'Database Does Not Exist' },
     };
-    # Ordinarily I would use $cgi->header to generate the headers
-    # but this doesn't seem to be working.  Although it is generally desirable
-    # to create the headers using the package, I think we should print them
-    # manually.  -CT
-    my $status;
-    if ($err->{$errcode}->{status}){
-        $status = $err->{$errcode}->{status};
-    } elsif ($errcode) {
-        $status = $errcode;
-   } else {
-	print STDERR "Tried to generate http error without code!\n";
-        http_error('500');
+    if ($errcode eq '401'){
+        print $cgi->header(
+           -type               => 'text/text',
+           -status             => $err->{'401'}->{status},
+           "-WWW-Authenticate" => $err->{'401'}->{others}->{'WWW-Authenticate'}
+        );
+    } else {
+        print $cgi->header(
+           -type   => 'text/text',
+           -status => $err->{$errcode}->{status},
+        );
     }
-    print "Status: $status\n";
-    for my $h (keys %{$err->{$errcode}->{others}}){
-         print "$h: $err->{$errcode}->{others}->{$h}\n";
-    }
-    print "Content-Type: text/plain\n\n";
-    print "Status: $status\n$err->{$errcode}->{message}\n";
-    exit; 
-    
-
+    print $err->{$errcode}->{message};
+    return;
 }
 
 =head1 COPYRIGHT

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.