Commit 01785de7 authored by Xavier Guimard's avatar Xavier Guimard

* "SKIP" in SAML tests

* "= splice @_" instead of "= @_" avoid memory duplication
parent c0ab1344
debian/tmp/etc/lemonldap-ng/apps-list*
debian/tmp/usr/share/lemonldap-ng/bin/purgeCentralCache
debian/tmp/usr/share/lemonldap-ng/portal-skins
debian/tmp/usr/share/man/man3/Lemonldap::NG::Portal*
......
......@@ -38,7 +38,7 @@ BEGIN {
# @return Apache constant
sub run ($$) {
my $class;
( $class, $apacheRequest ) = @_;
( $class, $apacheRequest ) = splice @_;
if ( time() - $lastReload > $reloadTime ) {
unless ( my $tmp = $class->testConf(1) == OK ) {
$class->lmLog( "$class: No configuration found", 'error' );
......
......@@ -19,6 +19,7 @@ use base qw(Lemonldap::NG::Handler::SharedConf);
# @return Apache constant
sub run ($$) {
my $class;
( $class, $apacheRequest ) = splice @_;
$cda = 1;
return $class->SUPER::run($apacheRequest);
}
......
......@@ -35,7 +35,7 @@ sub new {
unless Lemonldap::NG::Handler::_CGI->testConf() == OK;
# Arguments
my @args = @_;
my @args = splice @_;
if ( ref( $args[0] ) ) {
%$self = ( %$self, %{ $args[0] } );
}
......@@ -143,7 +143,7 @@ sub user {
# @param $group name of the Lemonldap::NG group to test
# @return boolean : true if user is in this group
sub group {
my ( $self, $group ) = @_;
my ( $self, $group ) = splice @_;
return ( $datas->{groups} =~ /\b$group\b/ );
}
......@@ -203,7 +203,7 @@ sub lmLog {
# @param $vhost Virtual Host to test
# @return boolean : true if $vhost is available
sub vhostAvailable {
my ( $self, $vhost ) = @_;
my ( $self, $vhost ) = splice @_;
return defined( $defaultCondition->{$vhost} );
}
......@@ -212,7 +212,7 @@ sub vhostAvailable {
# @param $uri URI string
# @param $vhost Optional virtual host (default current virtual host)
sub grant {
my ( $self, $uri, $vhost ) = @_;
my ( $self, $uri, $vhost ) = splice @_;
$vhost ||= $ENV{SERVER_NAME};
$apacheRequest = Lemonldap::NG::Apache::Request->new(
{
......
......@@ -56,7 +56,7 @@ $UA->requests_redirectable( [] );
# Called for Apache response (PerlResponseHandler).
# @return Apache constant
sub run($$) {
( $class, $r ) = @_;
( $class, $r ) = splice @_;
my $url = $r->uri;
$url .= "?" . $r->args if ( $r->args );
......
......@@ -61,7 +61,7 @@ BEGIN {
# init is overloaded to call only localInit. globalInit is called later.
# @param $args hash containing parameters
sub init($$) {
my ( $class, $args ) = @_;
my ( $class, $args ) = splice @_;
# TODO reloadTime in defaultValuesInit ?
$reloadTime = $args->{reloadTime} || 600;
$class->localInit($args);
......@@ -72,7 +72,7 @@ sub init($$) {
# @param $args hash containing parameters
# @return boolean
sub defaultValuesInit {
my ( $class, $args ) = @_;
my ( $class, $args ) = splice @_;
# Local configuration overrides global configuration
my %h = ( %$args, %$localConfig );
......@@ -83,7 +83,7 @@ sub defaultValuesInit {
# Load parameters and build the Lemonldap::NG::Common::Conf object.
# @return boolean
sub localInit {
my ( $class, $args ) = @_;
my ( $class, $args ) = splice @_;
die(
"$class : unable to build configuration : $Lemonldap::NG::Common::Conf::msg"
)
......@@ -118,7 +118,7 @@ sub localInit {
# @param $r Apache2::RequestRec object
# @return Apache constant
sub run($$) {
my ( $class, $r ) = @_;
my ( $class, $r ) = splice @_;
if ( time() - $lastReload > $reloadTime ) {
unless ( my $tmp = $class->testConf(1) == OK ) {
$class->lmLog( "$class: No configuration found", 'error' );
......@@ -138,7 +138,7 @@ sub run($$) {
# @param $local boolean
# @return Apache constant
sub testConf {
my ( $class, $local ) = @_;
my ( $class, $local ) = splice @_;
my $conf = $lmConf->getConf( { local => $local } );
unless ( ref($conf) ) {
$class->lmLog(
......@@ -163,7 +163,7 @@ sub testConf {
# Local parameters have best precedence on configuration parameters.
# @return Apache constant
sub setConf {
my ( $class, $conf ) = @_;
my ( $class, $conf ) = splice @_;
# Local configuration overrides global configuration
$cfgNum = $conf->{cfgNum};
......@@ -183,7 +183,7 @@ sub setConf {
# @param $r current request
# @return Apache constant (OK or SERVER_ERROR)
sub refresh($$) {
my ( $class, $r ) = @_;
my ( $class, $r ) = splice @_;
$class->lmLog( "$class: request for configuration reload", 'notice' );
$r->handler("perl-script");
if ( $class->testConf(0) == OK ) {
......
......@@ -183,7 +183,7 @@ sub logout_mp2 : method {
# @param $mess message to log
# @param $level string (debug, info, warning or error)
sub lmLog {
my ( $class, $mess, $level ) = @_;
my ( $class, $mess, $level ) = splice @_;
die "Level is required" unless ($level);
if ( MP() == 2 ) {
Apache2::ServerRec->log->$level($mess);
......@@ -201,7 +201,7 @@ sub lmLog {
# @param $r current request
# @param $s string to use
sub lmSetApacheUser {
my ( $class, $r, $s ) = @_;
my ( $class, $r, $s ) = splice @_;
return unless ($s);
if ( MP() == 2 ) {
$r->user($s);
......@@ -216,7 +216,7 @@ sub lmSetApacheUser {
# @param $str string
# @return string
sub regRemoteIp {
my ( $class, $str ) = @_;
my ( $class, $str ) = splice @_;
if ( MP() == 2 ) {
$str =~ s/\$datas->\{ip\}/\$apacheRequest->connection->remote_ip/g;
}
......@@ -232,7 +232,7 @@ sub regRemoteIp {
# @param $h Name of the header
# @param $v Value of the header
sub lmSetHeaderIn {
my ( $r, $h, $v ) = @_;
my ( $r, $h, $v ) = splice @_;
if ( MP() == 2 ) {
return $r->headers_in->set( $h => $v );
}
......@@ -247,7 +247,7 @@ sub lmSetHeaderIn {
# @param $h Name of the header
# @return Value of the header
sub lmHeaderIn {
my ( $r, $h ) = @_;
my ( $r, $h ) = splice @_;
if ( MP() == 2 ) {
return $r->headers_in->{$h};
}
......@@ -262,7 +262,7 @@ sub lmHeaderIn {
# @param $h Name of the header
# @param $v Value of the header
sub lmSetErrHeaderOut {
my ( $r, $h, $v ) = @_;
my ( $r, $h, $v ) = splice @_;
if ( MP() == 2 ) {
return $r->err_headers_out->set( $h => $v );
}
......@@ -277,7 +277,7 @@ sub lmSetErrHeaderOut {
# @param $h Name of the header
# @param $v Value of the header
sub lmSetHeaderOut {
my ( $r, $h, $v ) = @_;
my ( $r, $h, $v ) = splice @_;
if ( MP() == 2 ) {
return $r->headers_out->set( $h => $v );
}
......@@ -292,7 +292,7 @@ sub lmSetHeaderOut {
# @param $h Name of the header
# @return Value of the header
sub lmHeaderOut {
my ( $r, $h, $v ) = @_;
my ( $r, $h, $v ) = splice @_;
if ( MP() == 2 ) {
return $r->headers_out->{$h};
}
......@@ -391,7 +391,7 @@ sub init($$) {
# (statusProcess()) in wanted and launch childInit().
# @param $args reference to the initialization hash
sub localInit($$) {
my ( $class, $args ) = @_;
my ( $class, $args ) = splice @_;
if ( $localStorage = $args->{localStorage} ) {
$localStorageOptions = $args->{localStorageOptions};
$localStorageOptions->{namespace} ||= "lemonldap";
......@@ -420,7 +420,7 @@ sub localInit($$) {
# - cleanLocalStorage() after each requests
# @return True
sub childInit {
my ( $class, $args ) = @_;
my ( $class, $args ) = splice @_;
return 1 if ($childInitDone);
# We don't initialise local storage in the "init" subroutine because it can
......@@ -436,7 +436,7 @@ sub childInit {
sub { return $class->initLocalStorage( $_[1], $_[0] ); } );
$s->push_handlers(
PerlPostConfigHandler => sub {
my ( $c, $l, $t, $s ) = @_;
my ( $c, $l, $t, $s ) = splice @_;
$s->add_version_component('Lemonldap::NG::Handler');
}
) unless ( $args->{hideSignature} );
......@@ -499,7 +499,7 @@ sub globalInit {
# - the list of the compiled functions (compiled with conditionSub())
# @param $args reference to the configuration hash
sub locationRulesInit {
my ( $class, $args ) = @_;
my ( $class, $args ) = splice @_;
$locationCount = 0;
# Pre compilation : both regexp and conditions
......@@ -527,7 +527,7 @@ sub locationRulesInit {
# locationRulesInit().
# @param $cond The boolean expression to use
sub conditionSub {
my ( $class, $cond ) = @_;
my ( $class, $cond ) = splice @_;
return sub { 1 }
if ( $cond =~ /^accept$/i );
return sub { 0 }
......@@ -581,7 +581,7 @@ sub conditionSub {
# Set default values for non-customized variables
# @param $args reference to the configuration hash
sub defaultValuesInit {
my ( $class, $args ) = @_;
my ( $class, $args ) = splice @_;
# Other values
$cookieName = $args->{cookieName} || $cookieName || 'lemonldap';
......@@ -603,7 +603,7 @@ sub defaultValuesInit {
# Verify that portal variable exists. Die unless
# @param $args reference to the configuration hash
sub portalInit {
my ( $class, $args ) = @_;
my ( $class, $args ) = splice @_;
die("portal parameter required") unless ( $args->{portal} );
if ( $args->{portal} =~ /[\$\(&\|"']/ ) {
my $portal = $class->conditionSub( $args->{portal} );
......@@ -620,7 +620,7 @@ sub portalInit {
# Initialize the Apache::Session::* module choosed to share user's variables.
# @param $args reference to the configuration hash
sub globalStorageInit {
my ( $class, $args ) = @_;
my ( $class, $args ) = splice @_;
$globalStorage = $args->{globalStorage} or die "globalStorage required";
eval "use $globalStorage;";
die($@) if ($@);
......@@ -632,7 +632,7 @@ sub globalStorageInit {
# headers into the HTTP request.
# @param $args reference to the configuration hash
sub forgeHeadersInit {
my ( $class, $args ) = @_;
my ( $class, $args ) = splice @_;
# Creation of the subroutine who will generate headers
my %tmp;
......@@ -663,7 +663,7 @@ sub forgeHeadersInit {
# Prepare local cache (if not done before by Lemonldap::NG::Common::Conf)
# @return Apache2::Const::DECLINED
sub initLocalStorage {
my ( $class, $r ) = @_;
my ( $class, $r ) = splice @_;
if ( $localStorage and not $refLocalStorage ) {
eval
"use $localStorage;\$refLocalStorage = new $localStorage(\$localStorageOptions);";
......@@ -676,7 +676,7 @@ sub initLocalStorage {
## @imethod protected void postUrlInit()
# Prepare methods to post form attributes
sub postUrlInit {
my ( $class, $args ) = @_;
my ( $class, $args ) = splice @_;
return unless ( $args->{post} );
eval 'use Apache2::Filter;use URI';
$transform = {};
......@@ -750,7 +750,7 @@ qq{<html><body onload="document.getElementById('f').submit()"><form id="f" metho
## @rmethod protected void updateStatus(string user,string url,string action)
# Inform the status process of the result of the request if it is available.
sub updateStatus {
my ( $class, $user, $url, $action ) = @_;
my ( $class, $user, $url, $action ) = splice @_;
eval {
print $statusPipe "$user => "
. $apacheRequest->hostname
......@@ -763,7 +763,7 @@ sub updateStatus {
# Grant or refuse client using compiled regexp and functions
# @return True if the user is granted to access to the current URL
sub grant {
my ( $class, $uri ) = @_;
my ( $class, $uri ) = splice @_;
for ( my $i = 0 ; $i < $locationCount ; $i++ ) {
return &{ $locationCondition->[$i] }($datas)
if ( $uri =~ $locationRegexp->[$i] );
......@@ -776,7 +776,7 @@ sub grant {
# Inform the status processus and call logForbidden().
# @return Apache2::Const::FORBIDDEN
sub forbidden {
my ( $class, $uri ) = @_;
my ( $class, $uri ) = splice @_;
if ( $datas->{_logout} ) {
$class->updateStatus( $datas->{$whatToTrace}, $_[0], 'LOGOUT' );
my $u = $datas->{_logout};
......@@ -796,7 +796,7 @@ sub forbidden {
# @param $uri uri asked
# @param $datas hash re to user's datas
sub logForbidden {
my ( $class, $uri, $datas ) = @_;
my ( $class, $uri, $datas ) = splice @_;
$class->lmLog(
'User "'
. $datas->{$whatToTrace}
......@@ -811,7 +811,7 @@ sub logForbidden {
# authorizated. This method has to be overloaded to use different logs systems
# @param $uri uri asked
sub logGranted {
my ( $class, $uri, $datas ) = @_;
my ( $class, $uri, $datas ) = splice @_;
$class->lmLog(
'User "'
. $datas->{$whatToTrace}
......@@ -834,7 +834,7 @@ sub hideCookie {
## @rmethod protected string encodeUrl(string url)
# Encode URl in the format used by Lemonldap::NG::Portal for redirections.
sub encodeUrl {
my ( $class, $url ) = @_;
my ( $class, $url ) = splice @_;
my $u = $url;
if ( $url !~ m#^https?://# ) {
my $portString = $port || $apacheRequest->get_server_port();
......@@ -857,7 +857,7 @@ sub encodeUrl {
# @param $arg optionnal GET parameters
# @return Apache2::Const::REDIRECT
sub goToPortal {
my ( $class, $url, $arg ) = @_;
my ( $class, $url, $arg ) = splice @_;
$class->lmLog(
"Redirect "
. $apacheRequest->connection->remote_ip
......@@ -896,7 +896,7 @@ sub fetchId {
# @return Apache2::Const value (OK, FORBIDDEN, REDIRECT or SERVER_ERROR)
sub run ($$) {
my $class;
( $class, $apacheRequest ) = @_;
( $class, $apacheRequest ) = splice @_;
return DECLINED unless ( $apacheRequest->is_initial_req );
my $args = $apacheRequest->args;
......@@ -1038,7 +1038,7 @@ sub localUnlog {
# @return Apache2::Const value returned by goToPortal()
sub unlog ($$) {
my $class;
( $class, $apacheRequest ) = @_;
( $class, $apacheRequest ) = splice @_;
$class->localUnlog;
$class->updateStatus( $apacheRequest->connection->remote_ip,
$apacheRequest->uri, 'LOGOUT' );
......@@ -1085,7 +1085,7 @@ sub redirectFilter {
# @param $r Current request
# @return Apache2::Const::OK
sub status($$) {
my ( $class, $r ) = @_;
my ( $class, $r ) = splice @_;
$class->lmLog( "$class: request for status", 'debug' );
unless ( $statusPipe and $statusOut ) {
$class->lmLog( "$class: status page can not be displayed", 'error' );
......
......@@ -242,7 +242,7 @@ sub timeUp {
# @param $cat Category to display
# @param $max Number of lines to display
sub topByCat {
my ( $cat, $max ) = @_;
my ( $cat, $max ) = splice @_;
my $i = 0;
print "<pre>\n";
foreach (
......
......@@ -24,7 +24,7 @@ our $VERSION = '0.55';
# virtual host
# @param $args reference to the configuration hash
sub locationRulesInit {
my ( $class, $args ) = @_;
my ( $class, $args ) = splice @_;
foreach my $vhost ( keys %{ $args->{locationRules} } ) {
$locationCount->{$vhost} = 0;
foreach ( sort keys %{ $args->{locationRules}->{$vhost} } ) {
......@@ -53,7 +53,7 @@ sub locationRulesInit {
# headers into the HTTP request.
# @param $args reference to the configuration hash
sub forgeHeadersInit {
my ( $class, $args ) = @_;
my ( $class, $args ) = splice @_;
# Creation of the subroutine who will generate headers
foreach my $vhost ( keys %{ $args->{exportedHeaders} } ) {
......@@ -98,7 +98,7 @@ sub sendHeaders {
# Grant or refuse client using compiled regexp and functions
# @return True if the user is granted to access to the current URL
sub grant {
my ( $class, $uri ) = @_;
my ( $class, $uri ) = splice @_;
my $vhost = $apacheRequest->hostname;
for ( my $i = 0 ; $i < $locationCount->{$vhost} ; $i++ ) {
if ( $uri =~ $locationRegexp->{$vhost}->[$i] ) {
......
......@@ -142,8 +142,7 @@ sub new {
# @param $modulename string
# @return boolean
sub displayModule {
my $self = shift;
my ($modulename) = @_;
my ( $self, $modulename ) = splice @_;
# Manage "0" and "1" rules
return 1 if ( $self->{modules}->{$modulename} eq "1" );
......@@ -237,8 +236,7 @@ sub appslistDescription {
# @param catlevel Category level
# @return HTML string
sub _displayConfCategory {
my $self = shift;
my ( $catname, $cathash, $catlevel ) = @_;
my ( $self, $catname, $cathash, $catlevel ) = splice @_;
my $html;
my $key;
......@@ -289,7 +287,7 @@ sub _displayConfCategory {
# @param $arg string to modify
# @return string modified
sub _userParam {
my ( $self, $arg ) = @_;
my ( $self, $arg ) = splice @_;
$arg =~ s/\$([\w]+)/$self->{portalObject}->{sessionInfo}->{$1}/g;
return $arg;
}
......@@ -385,8 +383,7 @@ sub _displayConfDescription {
# @param $apphash Menu elements
# @return filtered hash
sub _filter {
my $self = shift;
my ($apphash) = @_;
my ( $self, $apphash ) = splice @_;
my $filteredHash;
my $key;
......@@ -501,8 +498,7 @@ sub _isCategoryEmpty {
# @param $uri URL string
# @return True if granted
sub _grant {
my $self = shift;
my ($uri) = @_;
my ( $self, $uri ) = splice @_;
$uri =~ m{(\w+)://([^/:]+)(:\d+)?(/.*)?$} or return 0;
my ( $protocol, $vhost, $port );
( $protocol, $vhost, $port, $path ) = ( $1, $2, $3, $4 );
......@@ -562,8 +558,7 @@ sub _compileRules {
# @param $cond boolean expression
# @return Compiled routine
sub _conditionSub {
my $self = shift;
my ($cond) = @_;
my ( $self, $cond ) = splice @_;
return sub { 1 }
if ( $cond =~ /^accept$/i );
return sub { 0 }
......
......@@ -61,7 +61,7 @@ BEGIN {
# @param $storage same syntax as Lemonldap::NG::Common::Conf object
# @return Lemonldap::NG::Portal::Notification object
sub new {
my ( $class, $storage ) = @_;
my ( $class, $storage ) = splice @_;
my $self = bless {}, $class;
(%$self) = (%$storage);
unless ( $self->{p} ) {
......@@ -87,7 +87,7 @@ sub new {
# @param $mess Text to log
# @param $level Level (debug|info|notice|error)
sub lmLog {
my ( $self, $mess, $level ) = @_;
my ( $self, $mess, $level ) = splice @_;
$self->{p}->lmLog( "[Notification] $mess", $level );
}
......@@ -97,7 +97,7 @@ sub lmLog {
# @param $portal Lemonldap::NG::Portal object that call
# @return HTML fragment containing form content
sub getNotification {
my ( $self, $portal ) = @_;
my ( $self, $portal ) = splice @_;
my ( @notifs, $form );
# Get user datas,
......@@ -157,7 +157,7 @@ sub getNotification {
# @param $portal Lemonldap::NG::Portal object that call
# @return true if all checkboxes have been checked
sub checkNotification {
my ( $self, $portal ) = @_;
my ( $self, $portal ) = splice @_, 0, 2;
my ( $refs, $checks );
# First, rebuild environment (cookies,...)
......@@ -260,7 +260,7 @@ sub checkNotification {
# @param $xml XML string containing notification
# @return number of notifications done
sub newNotification {
my ( $self, $xml ) = @_;
my ( $self, $xml ) = splice @_;
eval { $xml = $parser->parse_string($xml); };
if ($@) {
$self->lmLog( "Unable to read XML file : $@", 'error' );
......
......@@ -90,7 +90,7 @@ sub search {
# '; ' separator
# @return Lemonldap::NG::Portal constant
sub setSessionInfo {
my ($self) = @_;
my $self = shift;
$self->{sessionInfo}->{dn} = $self->{dn};
unless ( $self->{exportedVars} ) {
foreach (qw(uid cn mail)) {
......@@ -121,7 +121,7 @@ sub setSessionInfo {
# Load all groups in $groups.
# @return Lemonldap::NG::Portal constant
sub setGroups {
my ($self) = @_;
my $self = shift;
my $groups = $self->{sessionInfo}->{groups};
$self->{ldapGroupObjectClass} ||= "groupOfNames";
......
......@@ -74,7 +74,7 @@ sub new {
sub bind {
my $self = shift;
my $mesg;
my ( $dn, %args ) = @_;
my ( $dn, %args ) = splice @_;
unless ($dn) {
$dn = $self->{portal}->{managerDn};
$args{password} = $self->{portal}->{managerPassword};
......@@ -186,9 +186,7 @@ sub userBind {
# @param $oldpassword Current password
# @return Lemonldap::NG::Portal constant
sub userModifyPassword {
my $self = shift;
my ( $dn, $newpassword, $confirmpassword, $oldpassword ) = @_;
my ( $self, $dn, $newpassword, $confirmpassword, $oldpassword ) = splice @_;
my $err;
my $mesg;
......
......@@ -19,7 +19,7 @@ our $VERSION = '0.11';
# @param $portal Lemonldap::NG::Portal::Simple object
# @return new Lemonldap::NG::Portal::_Multi object
sub new {
my ( $class, $portal ) = @_;
my ( $class, $portal ) = splice @_;
my $self = bless { p => $portal, res => PE_NOSCHEME }, $class;
my @stack = ( $portal->{authentication}, $portal->{userDB} );
for ( my $i = 0 ; $i < 2 ; $i++ ) {
......@@ -50,7 +50,7 @@ sub new {
# @param type 0 for authentication, 1 for userDB
# @return Lemonldap::NG::Portal error code returned by method $sub
sub try {
my ( $self, $sub, $type ) = @_;
my ( $self, $sub, $type ) = splice @_;
my $res;
my $s = $self->{stack}->[$type]->[0]->{m} . "::$sub";
my $old = $self->{stack}->[$type]->[0]->{n};
......@@ -91,7 +91,7 @@ sub try {
# @param type 0 for authentication, 1 for userDB
# return true if an other module is available
sub next {
my ( $self, $type ) = @_;
my ( $self, $type ) = splice @_;
if ( $self->{stack}->[$type]->[0]->{n} eq
$self->{stack}->[ 1 - $type ]->[0]->{n}
and $self->{stack}->[ 1 - $type ]->[1] )
......@@ -112,7 +112,7 @@ sub next {
# @param $sub name of the method who has failed
# @return Lemonldap::NG::Portal error code
sub replay {
my ( $self, $sub ) = @_;
my ( $self, $sub ) = splice @_;
my @subs = ();
foreach (
qw(authInit extractFormInfo setAuthSessionInfo userDBInit getUser
......
......@@ -112,7 +112,7 @@ _RETURN $getAttributesResponse Response
# @param $id Cookie value
# @return SOAP::Data sequence
sub getAttributes {
my ( $self, $id ) = @_;
my ( $self, $id ) = splice @_;
die 'id is required' unless ($id);
my $h = $self->getApacheSession( $id, 1 );
my @tmp = ();
......@@ -140,7 +140,7 @@ sub getAttributes {
# @param $args datas to store
# @return true if succeed
sub setAttributes {
my ( $self, $id, $args ) = @_;
my ( $self, $id, $args ) = splice @_;
die 'id is required' unless ($id);
my $h = $self->getApacheSession($id);
unless ($h) {
......@@ -178,7 +178,7 @@ sub lastCfg {
# Store a new session.
# @return Session datas
sub newSession {
my ( $self, $args ) = @_;
my ( $self, $args ) = splice @_;
my $h = $self->getApacheSession();
if ($@) {
$self->lmLog( "Unable to create session", 'error' );
......@@ -196,7 +196,7 @@ sub newSession {
## @method SOAP::Data deleteSession()
# Deletes an existing session
sub deleteSession {
my ( $self, $id ) = @_;
my ( $self, $id ) = splice @_;
die('id parameter is required') unless ($id);
my $h = $self->getApacheSession($id);
return 0 if ($@);
......@@ -353,9 +353,7 @@ sub _buildSoapHash {
# @param $cond boolean expression
# @return Compiled routine
sub _conditionSub {
my $self = shift;
my $id = shift;
my ($cond) = @_;
my ( $self, $id, $cond ) = splice @_;
my $h = $self->getApacheSession( $id, 1 );
return sub { 1 }
if ( $cond =~ /^accept$/i );
......
......@@ -15,7 +15,7 @@ our $VERSION = '0.5';
# @param $lang Language or Accepted-Language HTTP header string
# @return Error string for the $code in the $lang language
sub error {
my ( $error, $lang ) = @_;
my ( $error, $lang ) = splice @_;
$lang = lc($lang);
$lang =~ s/-/_/g;
$error = 0 if ( $error < 0 );
......@@ -37,7 +37,7 @@ sub error {
# @param $lang Language or Accepted-Language HTTP header string
# @return Error string for the $code in the $lang language
sub msg {
my ( $msg, $lang ) = @_;
my ( $msg, $lang ) = splice @_;
$lang = lc($lang);
$lang =~ s/-/_/g;
$msg = 0 if ( $msg < 0 );
......
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl Lemonldap-NG-Portal-SAMLIssuer.t'
#########################
# change 'tests => 1' to 'tests => last_test_to_print';
use Test::More tests => 1;
BEGIN { use_ok('Lemonldap::NG::Portal::IssuerDBSAML') };
#########################
# Insert your test code below, the Test::More module is use()ed here so read
# its man page ( perldoc Test::More ) for help writing this test script.
SKIP: {
eval "use Lasso;";
skip "Lasso is not installed, can't test SAML features", 1 if ($@);
use_ok('Lemonldap::NG::Portal::IssuerDBSAML');
}
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl Lemonldap-NG-Portal-AuthSAML.t'
#########################
# change 'tests => 1' to 'tests => last_test_to_print';
use Test::More tests => 1;
BEGIN { use_ok('Lemonldap::NG::Portal::AuthSAML') };
#########################
# Insert your test code below, the Test::More module is use()ed here so read
# its man page ( perldoc Test::More ) for help writing this test script.
SKIP: {
eval "use Lasso;";
skip "Lasso is not installed, can't test SAML features", 1 if ($@);
use_ok('Lemonldap::NG::Portal::AuthSAML');