Commit e8dac0fe authored by Xavier Guimard's avatar Xavier Guimard

Replace 'splice' by copy (Closes: #534)

parent 979b52fd
......@@ -8,12 +8,12 @@ our $VERSION = '1.4.0';
our $initDone;
sub Lemonldap::NG::Common::Conf::_lock {
my ( $self, $cfgNum ) = splice @_;
my ( $self, $cfgNum ) = @_;
return "$self->{dirName}/lmConf.lock";
}
sub Lemonldap::NG::Common::Conf::_file {
my ( $self, $cfgNum ) = splice @_;
my ( $self, $cfgNum ) = @_;
return "$self->{dirName}/lmConf-$cfgNum.js";
}
......
......@@ -111,7 +111,7 @@ sub initializeFromXML {
# SAML 2 description.
# @return string
sub serviceToXML {
my ( $self, $file, $conf ) = splice @_;
my ( $self, $file, $conf ) = @_;
my $template = HTML::Template->new(
filename => "$file",
......@@ -375,7 +375,7 @@ sub _toStruct {
# @param @files Array of filenames
# @return array of Metadata objects
sub load {
my @files = splice @_;
my @files = @_;
my @metadatas = ();
foreach (@files) {
my $metadata = new Lemonldap::NG::Common::Conf::SAML::Metadata();
......@@ -408,7 +408,7 @@ sub _loadFile {
# @param conf Configuration hash ref
# @return value
sub getValue {
my ( $self, $key, $conf ) = splice @_;
my ( $self, $key, $conf ) = @_;
# Get portal value
my $portal = $conf->{portal} || "http://auth.example.com/";
......
......@@ -16,7 +16,7 @@ BEGIN {
# @param value Input value
# @return normalized string
sub normalize {
my ( $self, $value ) = splice @_;
my ( $self, $value ) = @_;
# trim white spaces
$value =~ s/^\s*(.*?)\s*$/$1/;
......@@ -39,7 +39,7 @@ sub normalize {
# @param value Input value
# @return unnormalized string
sub unnormalize {
my ( $self, $value ) = splice @_;
my ( $self, $value ) = @_;
# Convert simple quotes
$value =~ s/&#?39;/'/g;
......@@ -59,7 +59,7 @@ sub unnormalize {
# @param conf Configuration
# @return fields
sub serialize {
my ( $self, $conf ) = splice @_;
my ( $self, $conf ) = @_;
my $fields;
# Data::Dumper options
......@@ -93,7 +93,7 @@ sub serialize {
# @param fields Fields
# @return configuration
sub unserialize {
my ( $self, $fields ) = splice @_;
my ( $self, $fields ) = @_;
my $conf;
# Parse fields
......
......@@ -23,7 +23,7 @@ our ( $msg, $parser );
# @param $storage same syntax as Lemonldap::NG::Common::Conf object
# @return Lemonldap::NG::Common::Notification object
sub new {
my ( $class, $storage ) = splice @_;
my ( $class, $storage ) = @_;
my $self = bless {}, $class;
(%$self) = (%$storage);
unless ( $self->{p} ) {
......@@ -54,7 +54,7 @@ sub new {
# @param $mess Text to log
# @param $level Level (debug|info|notice|error)
sub lmLog {
my ( $self, $mess, $level ) = splice @_;
my ( $self, $mess, $level ) = @_;
$self->{p}->lmLog( "[Notification] $mess", $level );
}
......@@ -64,7 +64,7 @@ sub lmLog {
# @param $portal Lemonldap::NG::Portal object that call
# @return HTML fragment containing form content
sub getNotification {
my ( $self, $portal ) = splice @_;
my ( $self, $portal ) = @_;
my ( @files, $form );
# Get user datas,
......@@ -196,7 +196,7 @@ sub getNotification {
# @param $portal Lemonldap::NG::Portal object that call
# @return true if all checkboxes have been checked
sub checkNotification {
my ( $self, $portal ) = splice @_, 0, 2;
my ( $self, $portal ) = @_, 0, 2;
my ( $refs, $checks );
# First, rebuild environment (cookies,...)
......@@ -340,7 +340,7 @@ sub checkNotification {
# @param $xml XML string containing notification
# @return number of notifications done
sub newNotification {
my ( $self, $xml ) = splice @_;
my ( $self, $xml ) = @_;
eval { $xml = $parser->parse_string($xml); };
if ($@) {
$self->lmLog( "Unable to read XML file : $@", 'error' );
......@@ -394,7 +394,7 @@ sub newNotification {
## @param $myref notification's reference
## @return number of deleted notifications
sub deleteNotification {
my ( $self, $uid, $myref ) = splice @_;
my ( $self, $uid, $myref ) = @_;
my @data;
# Check input parameters
......
......@@ -38,7 +38,7 @@ has syslog => (
# @param $mess Text to log
# @param $level Level (debug|info|notice|warn|error)
sub lmLog {
my ( $self, $msg, $level ) = splice @_;
my ( $self, $msg, $level ) = @_;
my $levels = {
error => 4,
warn => 3,
......@@ -95,7 +95,7 @@ sub userError {
# Responses methods
sub sendJSONresponse {
my ( $self, $req, $j, %args ) = splice @_;
my ( $self, $req, $j, %args ) = @_;
$args{code} ||= 200;
my $type = 'text/json';
if ( ref $j ) {
......@@ -105,7 +105,7 @@ sub sendJSONresponse {
}
sub sendError {
my ( $self, $req, $err, $code ) = splice @_;
my ( $self, $req, $err, $code ) = @_;
$err ||= $req->error;
$code ||= 500;
$self->lmLog( "Error $code: $err", $code > 499 ? 'error' : 'notice' );
......@@ -113,7 +113,7 @@ sub sendError {
}
sub abort {
my ( $self, $err ) = splice @_;
my ( $self, $err ) = @_;
$self->lmLog( $err, 'error' );
return sub {
$self->sendError( Lemonldap::NG::Common::PSGI::Request->new( $_[0] ),
......@@ -134,7 +134,7 @@ sub init { 1 }
sub router { _mustBeDefined(@_) }
sub sendHtml {
my ( $self, $req, $template ) = splice @_;
my ( $self, $req, $template ) = @_;
my $htpl;
$template = $self->templateDir . "/$template.tpl";
return $self->sendError( $req, "Unable to read $template", 500 )
......@@ -185,7 +185,7 @@ sub sendHtml {
###############
sub run {
my ( $self, $args ) = splice @_;
my ( $self, $args ) = @_;
unless ( ref $self ) {
$self = $self->new($args);
return $self->abort( $self->error ) unless ( $self->init($args) );
......@@ -217,7 +217,7 @@ Use Lemonldap::NG::Common::PSGI::Router for REST API.
use base Lemonldap::NG::Common::PSGI;
sub init {
my ($self,$args) = splice @_;
my ($self,$args) = @_;
# Will be called 1 time during startup
# Store debug level
......@@ -231,7 +231,7 @@ Use Lemonldap::NG::Common::PSGI::Router for REST API.
}
sub router {
my ( $self, $req ) = splice @_;
my ( $self, $req ) = @_;
# Do something and return a PSGI response
# NB: $req is a Lemonldap::NG::Common::PSGI::Request object
......
......@@ -75,7 +75,7 @@ has QUERY_STRING => (
);
sub params {
my ( $self, $key, $value ) = splice @_;
my ( $self, $key, $value ) = @_;
return $self->_params unless ($key);
$self->_params->{$key} = $value if ($value);
return $self->_params->{$key};
......@@ -158,7 +158,7 @@ PSGIs
...
sub router {
my ( $self, $req ) = splice @_;
my ( $self, $req ) = @_;
# Do something and return a PSGI response
# NB: $req is a Lemonldap::NG::Common::PSGI::Request object
if ( $req->accept eq 'text/plain' ) { ... }
......
......@@ -19,7 +19,7 @@ has 'defaultRoute' => ( is => 'rw', default => 'index.html' );
# Routes initialization
sub addRoute {
my ( $self, $word, $dest, $methods ) = splice(@_);
my ( $self, $word, $dest, $methods ) = (@_);
$methods ||= [qw(GET POST PUT DELETE)];
foreach my $method (@$methods) {
$self->genRoute( $self->routes->{$method}, $word, $dest );
......@@ -28,7 +28,7 @@ sub addRoute {
}
sub genRoute {
my ( $self, $routes, $word, $dest ) = splice @_;
my ( $self, $routes, $word, $dest ) = @_;
if ( ref $word eq 'ARRAY' ) {
foreach my $w (@$word) {
$self->genRoute( $routes, $w, $dest );
......@@ -78,11 +78,11 @@ sub genRoute {
}
sub routerAbort {
my ( $self, $path, $msg ) = splice @_;
my ( $self, $path, $msg ) = @_;
delete $self->routes->{$path};
$self->addRoute(
$path => sub {
my ( $self, $req ) = splice @_;
my ( $self, $req ) = @_;
return $self->sendError( $req, $msg, 500 );
}
);
......@@ -91,7 +91,7 @@ sub routerAbort {
# Methods that dispatch requests
sub router {
my ( $self, $req ) = splice @_;
my ( $self, $req ) = @_;
#print STDERR Dumper($self->routes);use Data::Dumper;
......@@ -124,7 +124,7 @@ sub router {
}
sub followPath {
my ( $self, $req, $routes, $path ) = splice @_;
my ( $self, $req, $routes, $path ) = @_;
if ( $path->[0] and defined $routes->{ $path->[0] } ) {
my $w = shift @$path;
if ( ref( $routes->{$w} ) eq 'CODE' ) {
......@@ -165,7 +165,7 @@ Lemonldap::NG::Common::PSGI::Router - Base library for REST APIs of Lemonldap::N
use base Lemonldap::NG::Common::PSGI::Router;
sub init {
my ($self,$args) = splice @_;
my ($self,$args) = @_;
# Will be called 1 time during startup
# Declare REST routes (could be HTML templates or methods)
......@@ -184,7 +184,7 @@ Lemonldap::NG::Common::PSGI::Router - Base library for REST APIs of Lemonldap::N
}
sub booksMethod {
my ( $self, $req, @otherPathInfo ) = splice @_;
my ( $self, $req, @otherPathInfo ) = @_;
my $book = $req->params('book');
my $method = $req->method;
...
......@@ -192,7 +192,7 @@ Lemonldap::NG::Common::PSGI::Router - Base library for REST APIs of Lemonldap::N
}
sub propertiesMethod {
my ( $self, $property, @otherPathInfo ) = splice @_;
my ( $self, $property, @otherPathInfo ) = @_;
my $method = $req->method;
...
$self->sendJSONresponse(...);
......
......@@ -19,7 +19,7 @@ our $self; # Safe cannot share a variable declared with my
# @param portal Lemonldap::NG::Portal::Simple object
# @return Lemonldap::NG::Common::Safe object
sub new {
my ( $class, $portal ) = splice @_;
my ( $class, $portal ) = @_;
my $self = {};
unless ( $portal->{useSafeJail} ) {
......@@ -47,7 +47,7 @@ sub new {
# @param e Expression to evaluate
sub reval {
local $self = shift;
my ($e) = splice @_;
my ($e) = @_;
my $result;
# Replace $date
......@@ -100,7 +100,7 @@ sub reval {
# @param vars Varibales
sub share_from {
local $self = shift;
my ( $pkg, $vars ) = splice(@_);
my ( $pkg, $vars ) = (@_);
# If Safe jail, call parent
if ( $self->{p}->{useSafeJail} ) {
......
......@@ -28,7 +28,7 @@ our $functions =
# @param $default_access optional what result to return for users without logons hours
# @return 1 if access allowed, 0 else
sub checkLogonHours {
my ( $logon_hours, $syntax, $time_correction, $default_access ) = splice @_;
my ( $logon_hours, $syntax, $time_correction, $default_access ) = @_;
# Active Directory - logonHours: $attr_src_syntax = octetstring
# Samba - sambaLogonHours: ???
......@@ -97,7 +97,7 @@ sub date {
# @param $default_access optional what result to return for users without start or end start
# @return 1 if access allowed, 0 else
sub checkDate {
my ( $start, $end, $default_access ) = splice @_;
my ( $start, $end, $default_access ) = @_;
# Get date in string
$start = substr( $start, 0, 14 );
......@@ -126,7 +126,7 @@ sub checkDate {
# @param password User password
# @return Authorization header content
sub basic {
my ( $login, $password ) = splice @_;
my ( $login, $password ) = @_;
# UTF-8 strings should be ISO encoded
$login = &unicode2iso($login);
......@@ -140,7 +140,7 @@ sub basic {
# @param string UTF-8 string
# @return ISO string
sub unicode2iso {
my ($string) = splice @_;
my ($string) = @_;
return encode( "iso-8859-1", decode( "utf-8", $string ) );
}
......@@ -150,7 +150,7 @@ sub unicode2iso {
# @param string ISO string
# @return UTF-8 string
sub iso2unicode {
my ($string) = splice @_;
my ($string) = @_;
return encode( "utf-8", decode( "iso-8859-1", $string ) );
}
......
......@@ -46,7 +46,7 @@ sub setServerSignature {
my ( $class, $sign ) = @_;
Apache2::ServerUtil->server->push_handlers(
PerlPostConfigHandler => sub {
my ( $c, $l, $t, $s ) = splice @_;
my ( $c, $l, $t, $s ) = @_;
$s->add_version_component($sign);
}
);
......
......@@ -39,7 +39,7 @@ sub newRequest {
# sets remote_user
# @param user string username
sub set_user {
my ( $class, $user ) = splice @_;
my ( $class, $user ) = @_;
# TODO
}
......
......@@ -52,7 +52,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 ) = splice @_;
my ( $self, $group ) = @_;
return ( $datas->{groups} =~ /\b$group\b/ );
}
......
......@@ -122,7 +122,7 @@ sub hideCookie {
# Encode URl in the format used by Lemonldap::NG::Portal for redirections.
# @return Base64 encoded string
sub encodeUrl {
my ( $class, $url ) = splice @_;
my ( $class, $url ) = @_;
$url = $class->_buildUrl($url) if ( $url !~ m#^https?://# );
return encode_base64( $url, '' );
}
......@@ -133,7 +133,7 @@ sub encodeUrl {
# @param $arg optionnal GET parameters
# @return Apache2::Const::REDIRECT
sub goToPortal {
my ( $class, $url, $arg ) = splice @_;
my ( $class, $url, $arg ) = @_;
Lemonldap::NG::Handler::Main::Logger->lmLog(
"Redirect "
. Lemonldap::NG::Handler::API->remote_ip
......@@ -464,7 +464,7 @@ sub grant {
# @param $s path
# @return URL
sub _buildUrl {
my ( $class, $s ) = splice @_;
my ( $class, $s ) = @_;
my $vhost = Lemonldap::NG::Handler::API->hostname;
my $portString =
$tsv->{port}->{$vhost}
......
......@@ -82,28 +82,28 @@ sub build_jail {
## @method reval
# Fake reval method if useSafeJail is off
sub reval {
my ( $self, $e ) = splice @_;
my ( $self, $e ) = @_;
return eval $e;
}
## @method wrap_code_ref
# Fake wrap_code_ref method if useSafeJail is off
sub wrap_code_ref {
my ( $self, $e ) = splice @_;
my ( $self, $e ) = @_;
return $e;
}
## @method share
# Fake share method if useSafeJail is off
sub share {
my ( $self, @vars ) = splice @_;
my ( $self, @vars ) = @_;
$self->share_from( scalar(caller), \@vars );
}
## @method share_from
# Fake share_from method if useSafeJail is off
sub share_from {
my ( $self, $pkg, $vars ) = splice @_;
my ( $self, $pkg, $vars ) = @_;
no strict 'refs';
foreach my $arg (@$vars) {
......@@ -126,7 +126,7 @@ sub share_from {
# Build and return restricted eval command with SAFEWRAP, if activated
# @return evaluation of $reval or $reval2
sub jail_reval {
my ( $self, $reval ) = splice @_;
my ( $self, $reval ) = @_;
# if nothing is returned by reval, add the return statement to
# the "no safe wrap" reval
......
......@@ -10,7 +10,7 @@ our $VERSION = '1.9.0';
has protection => ( is => 'rw', isa => 'Str' );
around init => sub {
my ( $method, $self, $args ) = splice @_;
my ( $method, $self, $args ) = @_;
Lemonldap::NG::Handler::SharedConf->init($self);
Lemonldap::NG::Handler::SharedConf->checkConf($self);
return $self->$method($args);
......@@ -94,14 +94,14 @@ sub _run {
## @method hashRef user()
# @return hash of user datas
sub user {
my ( $self, $req ) = splice @_;
my ( $self, $req ) = @_;
return $req->userData || { _whatToTrace => 'anonymous' };
}
## @method string userId()
# @return user identifier to log
sub userId {
my ( $self, $req ) = splice @_;
my ( $self, $req ) = @_;
return $req->userData->{_whatToTrace} || 'anonymous';
}
......@@ -109,7 +109,7 @@ sub userId {
# @param $group name of the Lemonldap::NG group to test
# @return boolean : true if user is in this group
sub group {
my ( $self, $req, $group ) = splice @_;
my ( $self, $req, $group ) = @_;
return () unless ( $req->userData->{groups} );
return ( $req->userData->{groups} =~ /\b$group\b/ );
}
......@@ -120,7 +120,7 @@ sub group {
# @param $err String to push
# @code int HTTP error code (default to 500)
sub sendError {
my ( $self, $req, $err, $code ) = splice @_;
my ( $self, $req, $err, $code ) = @_;
$err ||= $req->error;
$err = '[' . $self->userId($req) . "] $err";
return $self->SUPER::sendError( $req, $err, $code );
......@@ -143,7 +143,7 @@ Lemonldap::NG.
use base Lemonldap::NG::Handler;
sub init {
my ($self,$args) = splice @_;
my ($self,$args) = @_;
$self->protection('manager');
# See Lemonldap::NG::Common::PSGI for more
......@@ -160,7 +160,7 @@ Lemonldap::NG.
}
sub booksMethod {
my ( $self, $req, @otherPathInfo ) = splice @_;
my ( $self, $req, @otherPathInfo ) = @_;
# Will be called only if authorisated
my $userId = $self->userId;
......
......@@ -60,7 +60,7 @@ $UA->requests_redirectable( [] );
# Called for Apache response (PerlResponseHandler).
# @return Apache constant
sub run($$) {
( $class, $r ) = splice @_;
( $class, $r ) = @_;
my $url = Lemonldap::NG::Handler::API->uri_with_args($r);
# Uncomment this if you have lost of session problem with SAP.
......
......@@ -48,7 +48,7 @@ sub globalInit {
# Overload defaultValuesInit
# @param $args reference to the configuration hash
sub defaultValuesInit {
my ( $class, $args ) = splice @_;
my ( $class, $args ) = @_;
# Catch Secure Token parameters
$secureTokenMemcachedServers =
......@@ -182,7 +182,7 @@ sub run {
# Create Memcached connexion
# @return Cache::Memcached object
sub _createMemcachedConnection {
my ($class) = splice @_;
my ($class) = @_;
# Open memcached connexion
my $memd = new Cache::Memcached {
......@@ -201,7 +201,7 @@ sub _createMemcachedConnection {
# @param value Value
# @return Token key
sub _setToken {
my ( $class, $value ) = splice @_;
my ( $class, $value ) = @_;
my $key = Apache::Session::Generate::MD5::generate();
......@@ -226,7 +226,7 @@ sub _setToken {
# @param key Key
# @return result
sub _deleteToken {
my ( $class, $key ) = splice @_;
my ( $class, $key ) = @_;
my $res = $secureTokenMemcachedConnection->delete($key);
......@@ -247,7 +247,7 @@ sub _deleteToken {
# @param connection Cache::Memcached object
# @return result
sub _isAlive {
my ($class) = splice @_;
my ($class) = @_;
return 0 unless defined $secureTokenMemcachedConnection;
......
......@@ -35,7 +35,7 @@ sub globalInit {
# Overload defaultValuesInit
# @param $args reference to the configuration hash
sub defaultValuesInit {
my ( $class, $args ) = splice @_;
my ( $class, $args ) = @_;
# Sympa secret should be in configuration
$sympaSecret = $args->{'sympaSecret'} || $sympaSecret;
......
......@@ -36,7 +36,7 @@ sub globalInit {
# Overload defaultValuesInit
# @param $args reference to the configuration hash
sub defaultValuesInit {
my ( $class, $args ) = splice @_;
my ( $class, $args ) = @_;
# Catch Zimbra parameters
$zimbraPreAuthKey = $args->{'zimbraPreAuthKey'} || $zimbraPreAuthKey;
......@@ -118,7 +118,7 @@ sub run {
# @param by Account type
# @return Zimbra PreAuth URL
sub _buildZimbraPreAuthUrl {
my ( $class, $key, $url, $account, $by ) = splice @_;
my ( $class, $key, $url, $account, $by ) = @_;
# Expiration time is calculated with _utime and timeout
my $expires = $timeout ? ( $datas->{_utime} + $timeout ) * 1000 : $timeout;
......
......@@ -300,7 +300,7 @@ sub timeUp {
# @param $cat Category to display
# @param $max Number of lines to display
sub topByCat {
my ( $cat, $max ) = splice @_;
my ( $cat, $max ) = @_;
my $i = 0;
print "<pre>\n";
foreach (
......
......@@ -24,7 +24,7 @@ extends 'Lemonldap::NG::Handler::PSGI', 'Lemonldap::NG::Manager::Lib';
# @param $args hashref to merge with object
# @return 0 in case of error, 1 else
sub init {
my ( $self, $args ) = splice @_;
my ( $self, $args ) = @_;
$args ||= {};
foreach my $k ( keys %$args ) {
......
......@@ -252,7 +252,7 @@ $managerAttr}
}
sub mydump {
my ($obj, $subname) = splice @_;
my ($obj, $subname) = @_;
my $t = Dumper($obj);
$t =~ s/^\s*(?:use strict;|package .*?;|)\n//gm;
$t =~ s/^\$VAR1\s*=/sub $subname {\n return/;
......@@ -260,7 +260,7 @@ sub mydump {
}
sub scanTree {
my ( $self, $tree, $json, $prefix, $path ) = splice @_;
my ( $self, $tree, $json, $prefix, $path ) = @_;
unless ( ref($tree) eq 'ARRAY' ) {
die 'Not an array';
}
......
......@@ -22,7 +22,7 @@ has app => (
);
sub _get {
my ( $self, $path, $query ) = splice @_;
my ( $self, $path, $query ) = @_;
$query //= '';
return $self->app->(
{
......@@ -47,7 +47,7 @@ sub _get {
}
sub _post {
my ( $self, $path, $query, $body, $type, $len ) = splice @_;
my ( $self, $path, $query, $body, $type, $len ) = @_;
die "$body must be a IO::Handle"
unless ( ref($body) and $body->can('read') );
return $self->app->(
......@@ -77,7 +77,7 @@ sub _post {
}
sub _put {
my ( $self, $path, $query, $body, $type, $len ) = splice @_;
my ( $self, $path, $query, $body, $type, $len ) = @_;
die "$body must be a IO::Handle"
unless ( ref($body) and $body->can('read') );
return $self->app->(
......@@ -107,7 +107,7 @@ sub _put {
}
sub _del {
my ( $self, $path, $query ) = splice @_;
my ( $self, $path, $query ) = @_;
return $self->app->(
{
'HTTP_ACCEPT' => 'application/json, text/plain, */*',
......@@ -131,7 +131,7 @@ sub _del {
}
sub jsonResponse {
my ( $self, $path, $query ) = splice @_;
my ( $self, $path, $query ) = @