File Coverage

blib/lib/LibWeb/Core.pm

Criterion	Covered	Total	%
statement	36	47	76.6
branch	14	26	53.8
condition	4	9	44.4
subroutine	6	7	85.7
pod	0	1	0.0
total	60	90	66.6

#==============================================================================
# LibWeb::Core -- The core class for libweb modules.

package LibWeb::Core;

# Copyright (C) 2000  Colin Kong
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
#=============================================================================

# $Id: Core.pm,v 1.5 2000/07/18 06:33:30 ckyc Exp $

#-###############################
# Use standard library.
use SelfLoader;
use Carp;
use strict;
use vars qw($VERSION @ISA %RC $OS);
##require Config

#-###############################
# Use custom library.
require LibWeb::Class;
##require LibWeb::HTML::Error;
##require LibWeb::Crypt;
##require Mail::Sendmail;

#-###############################
# Version.
$VERSION = '0.02';

#-###############################
# Inheritance.
@ISA = qw(LibWeb::Class);

#-###############################
# Methods.
sub new {
    #
    # Params: $class [, $rc_file, $error_object]
    #
    # - $class is the class/package name of this package, be it a string
    #   or a reference.
    # - $rc_file is the absolute path to the rc file for LibWeb.
    # - $error_object is a reference to a perl object for printing out
    #   error/help message to users when error occurs.
    #
    # Usage: No, you don't use LibWeb::Core directly in client codes.
    #
    my ($class, $self, %rc);
    $class = shift;

    # Read the rc file if haven't done so in this CGI session.
    # Read rc and take care of portability issues only once for sake
    # of performance!  But the ``%rc = %RC'' is still an expensive way
    # to do that.  Any better approach?
    if (%RC) {
	%rc = %RC;
	bless(\%rc, ref($class) || $class);
    } else {
	eval { $self = do "$_[0]"; };
	croak "Couldn't read rc: $@\n" if ($@);
	$self->{HHTML} = $_[1] || eval { require LibWeb::HTML::Error; LibWeb::HTML::Error->new(); };
	croak "LibWeb::Core::new(): No HTML Error object detected!" unless $self->{HHTML};
	_make_portable($self);
	%RC = %{ $self };
	bless($self, ref($class) || $class);
    }
}

sub DESTROY {}

sub _make_portable {
    #
    # Some portability tricks stolen from CGI.pm 2.66.
    #
    my $self = shift;
    # FIGURE OUT THE OS WE'RE RUNNING UNDER
    # Some systems support the $^O variable.  If not
    # available then require() the Config library
    unless ($OS) {
	unless ($OS = $^O) {
	    require Config;
	    $OS = $Config::Config{'osname'};
	}
    }
    if ($OS=~/Win/i) {
	$OS = 'WINDOWS';
    } elsif ($OS=~/vms/i) {
	$OS = 'VMS';
    } elsif ($OS=~/bsdos/i) {
	$OS = 'UNIX';
    } elsif ($OS=~/dos/i) {
	$OS = 'DOS';
    } elsif ($OS=~/^MacOS$/i) {
	$OS = 'MACINTOSH';
    } elsif ($OS=~/os2/i) {
	$OS = 'OS2';
    } else {
	$OS = 'UNIX';
    }
    $self->{OS} = $OS;
    # The path separator is a slash, backslash or semicolon, depending
    # on the platform.
    $self->{PATH_SEP} = {
			 UNIX=>'/', OS2=>'\\', WINDOWS=>'\\', DOS=>'\\',
			 MACINTOSH=>':', VMS=>'/'
			}->{$OS};
    # Define the CRLF sequence.  I can't use a simple "\r\n" because the meaning
    # of "\n" is different on different OS's (sometimes it generates CRLF, sometimes
    # LF and sometimes CR).  The most popular VMS web server doesn't accept CRLF --
    # instead it wants a LR.  EBCDIC machines don't use ASCII, so \015\012 means
    # something different.  I find this all really annoying. -- Lincoln.
    my $EBCDIC = "\t" ne "\011";
    if ($OS eq 'VMS') {
	$self->{CRLF} = "\n";
    } elsif ($EBCDIC) {
	$self->{CRLF} = "\r\n";
    } else {
	$self->{CRLF} = "\015\012";
    }
}


# Selfloading methods declaration.
sub LibWeb::Core::_get_auth_info_from_cookie_for_admin ;
sub LibWeb::Core::_log_fatal ;
sub LibWeb::Core::alert_admin ;
sub LibWeb::Core::debug_print ;
sub LibWeb::Core::fatal ;
sub LibWeb::Core::sanitize ;
sub LibWeb::Core::send_cookie ;
sub LibWeb::Core::send_mail ;
1;
__DATA__