File Coverage

blib/lib/LibWeb/Class.pm

Criterion	Covered	Total	%
statement	25	28	89.2
branch	6	10	60.0
condition	2	6	33.3
subroutine	4	5	80.0
pod	1	2	50.0
total	38	51	74.5

#==============================================================================
# LibWeb::Class -- A base class for libweb modules.

package LibWeb::Class;

# 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: Class.pm,v 1.4 2000/07/18 06:33:30 ckyc Exp $

#-#############################
# Use standard library.
require 5.004;
use strict;
use vars qw($VERSION);

$VERSION = '0.02';

#-#############################
# Methods.
sub new {
    my $class = shift;
    bless( {}, ref($class) || $class );
}

sub DESTROY {}

sub rearrange {
    #
    # Stolen from CGI.pm and modified.
    #
    # Smart rearrangement of parameters to allow named parameter
    # calling.  We do the rearrangement if:
    # 1. The first parameter begins with a -
    #
    my($self,$order,@param) = @_;
    return () unless @param;

    if (ref($param[0]) eq 'HASH') {
	@param = %{$param[0]};
    } else {
	return @param
	    unless (defined($param[0]) && substr($param[0],0,1) eq '-');
    }

    # map parameters into positional indices
    my ($i,%pos);
    $i = 0;
    foreach (@$order) {
	foreach (ref($_) eq 'ARRAY' ? @$_ : $_) { $pos{$_} = $i; }
	$i++;
    }

    my (@result);                          #leave out %leftover.
    $#result = $#$order;                   #preextend
    while (@param) {
	my $key = uc(shift(@param));         #uc(shift(@param));
	$key =~ s/^\-//;
	$result[$pos{$key}] = shift(@param) if (exists $pos{$key});
	#} else {
	#    $leftover{$key} = shift(@param);
	#}
    }

    #push (@result,$self->make_attributes(\%leftover)) if %leftover;
    return @result;
}

1;
__DATA__