# Dancer2 plugin for creating  restfull web services
# Provides methods for authentication, persistant session data
#
# It convert user data structures between : JSON , XML , YAML, PERL , LIST
# You have to install the modules
#
#	cpanm XML::Hash
#	cpanm XML::Hash::XS
#	cpanm JSON::XS
#	cpanm YAML::XS
#	cpanm Data::Dumper
#
# Quick diffences between plugin and main program syntax
#
#   plugin                          main
#   --------------------------------------------
#   $plugin->app->DancerMethod      DancerMethod
#   $plugin->config->{key}          setting('Key')  ή  config->{Key}
#
# George Mpouras
# george.mpouras@yandex.com
# 25 Sep 2016 , Athens - Greece





package Dancer2::Plugin::WebService;
use	Dancer2::Plugin;
use	strict;
use	warnings;
use	Storable;
use	Crypt::CBC;
our	$VERSION = '3.001';

if ($^O=~/(?i)MSWin/) {warn "Sorry windows operating system is not supported\n"; exit 1}

# Make available the following functions to applications
plugin_keywords qw/

	RestReply
	get_data_user
	set_data_user
	del_data_user
	get_data_session
	set_data_session
	del_data_session
	/;

# Change rw properties later like   $plugin->SomeProperty('new value');
has dir_root             => (is=>'ro', default=> sub { ($_=$_[0]->{app}->{config}->{appdir}) =~s/\/*$//; if (-d $_) { $_ } else { warn "Could not define root directory\n"; exit 1 } } );
has dir_session          => (is=>'ro', from_config=>'Session directory',     default=> sub{$_[0]->dir_root .'/sessions'});
has from                 => (is=>'rw', from_config=>'Default input format',  default=> sub{ 'json' });
has to                   => (is=>'rw', from_config=>'Default output format', default=> sub{ 'json' });
has sudo                 => (is=>'ro', from_config=>'Command sudo',          default=> sub{ '/usr/bin/sudo' });
has rm                   => (is=>'ro', from_config=>'Command rm',            default=> sub{ '/usr/bin/rm' });
has groups               => (is=>'ro', from_config=>'User must belong to one or more of the groups', default=> sub{ [] });
has Session_idle_timout  => (is=>'ro', from_config=>'Session idle timout',   default=> sub{ 3600 } );
has ip_rules             => (is=>'ro', from_config=>'Allowed IP patterns',   default=> sub{ ['127*', '192.168.*', '10.*', '172.16.*'] });
has ip_rules_compiled    => (is=>'ro', default=> sub {my $array = [@{$_[0]->ip_rules}]; for (@{$array}) { s/([^?*]+)/\Q$1\E/g; s|\?|.|g; s|\*+|.*?|g; $_ = qr/^$_$/i } $array});
has ClientIP             => (is=>'rw', default=> '');
has __format_from        => (is=>'ro', default=> sub{[qw/json xml yaml perl human/]});
has __format_to          => (is=>'ro', default=> sub{[qw/json xml yaml perl human untouched/]});
has __format_from_regex  => (is=>'rw', default=> sub{$_=join '|', @{ $_[0]->__format_from }; $_ = qr/^($_)$/; $_});
has __format_to_regex    => (is=>'rw', default=> sub{$_=join '|', @{ $_[0]->__format_to   }; $_ = qr/^($_)$/; $_});
has method_name          => (is=>'rw', default=> '');
has error                => (is=>'rw', default=> 0);
has errormessage         => (is=>'rw', default=> 'ok');
has data_user            => (is=>'rw', default=> sub{ {} });	# hash holding the data user send to us at "data_from"
has data_session         => (is=>'rw', default=> sub{ {} });	# hash holding the session data
has data_from            => (is=>'rw', default=> '');		# string of user data
has data_to              => (is=>'rw', default=> '');		# string of user data rebuilded
has Authentication_method=> (is=>'rw', default=> '');
has auth_member_of       => (is=>'rw', default=> sub{ [] });
has auth_result          => (is=>'rw', default=> 0);
has auth_message         => (is=>'rw', default=> '');



my %TypeHeader		= (
json			=> 'application/json',
xml			=> 'text/xml',
yaml			=> 'text/x-yaml',
perl			=> 'text/html',
human			=> 'text/html',
untouched		=> 'text/html');




sub BUILD
{
my $plugin = shift;
__MKDIR($plugin->dir_session) or die 'Could not create the session directory '.$plugin->dir_session." because $!\n";
(my $module_dir =__FILE__) =~s/\/(?>[^\/]+)$//;
unless (-d $module_dir) {warn "Sorry could not define the Dancer2::Plugin::WebService installation directory\n"; exit 1}

# Find the active authentication method

	foreach (keys %{$plugin->config->{'Authentication method'}} ) {
	next unless $plugin->config->{'Authentication method'}->{$_}->{Active} =~/(?i)yes/;
	$plugin->config->{'Authentication method'}->{$_}->{Command} =~s/^MODULE_INSTALL_DIR/$module_dir/;
	if ( ! -f $plugin->config->{'Authentication method'}->{$_}->{Command} )	{ warn 'Sorry, could not found the external authorization utility : "'. $plugin->config->{'Authentication method'}->{$_}->{Command} ."\"\n"; exit 1 }
	if ( ! -x $plugin->config->{'Authentication method'}->{$_}->{Command} )	{ warn 'Sorry, the external authorization utility "'. $plugin->config->{'Authentication method'}->{$_}->{Command} .'" is not executable from user '.getpwuid($>) ."\n"; exit 1 }
	$plugin->Authentication_method($_);
	print STDOUT 'Authorization method  : ', "$_\n";
	print STDOUT 'Authorization command : ', $plugin->config->{'Authentication method'}->{$_}->{Command} ,"\n";
	last
	}

	if ( $plugin->Authentication_method eq '' ) {
	warn "\nCould not found any active authentication method, please check your configuration to activate at least one, and try again.\n";
	exit 1
	}

# Resume the stored sessions
$_ = $plugin->dir_session;
print STDOUT "Resuming sessions from: $_\n";
opendir __SESSIONDIR, $_ or die "Could not list session directory $_ because $!\n";

	foreach my $session (grep ! /^\.+$/, readdir __SESSIONDIR) {
	if (-f "$_/$session") {unlink "$_/$session"; next}

		if ((-f "$_/$session/__clientip") && (-f "$_/$session/__lastaccess") && (-f "$_/$session/__logintime") && (-f "$_/$session/__user")) {
		$plugin->data_session->{$session}->{__lastaccess} = Storable::retrieve "$_/$session/__lastaccess";
		$plugin->data_session->{$session}->{__lastaccess} = ${$plugin->data_session->{$session}->{__lastaccess}};

			if ( time - $plugin->data_session->{$session}->{__lastaccess} > $plugin->config->{'Session idle timout'} ) {
			print STDOUT "Delete expired session: $session\n";
			system $plugin->rm, '--recursive', '--force', "$_/$session";
			delete $plugin->data_session->{$session}
			}
			else {
			# Session is not expired update the __lastaccess and read the rest properties
			print STDOUT "Found stored session  : $session\n";
			$plugin->data_session->{$session}->{__lastaccess} = time;
			Storable::lock_store(\ time, "$_/$session/__lastaccess") or die "Could not store at session $session the property __lastaccess because $!\n"
			}
		}
		else {
		print STDERR "Delete corrupt session: $session\n";
		system $plugin->rm, '--recursive', '--force', "$_/$session"
		}
	}

closedir __SESSIONDIR;
#print STDERR "\n\nsession data\n". Data::Dumper::Dumper( $plugin->data_session ) ."\n\n";


# Define the built in methods
$plugin->config->{Methods}->{info  } = 'Public';
$plugin->config->{Methods}->{login } = 'Public';
$plugin->config->{Methods}->{logout} = 'Private';


	# <after hook> to reset the any posted or user data
	$plugin->app->add_hook( Dancer2::Core::Hook->new( name => 'after', code => sub
	{
	$plugin->data_user({})
	}));


	# <before hook>
	$plugin->app->add_hook( Dancer2::Core::Hook->new( name => 'before', code => sub
	{
	$plugin->app->request->path =~/^\/*([^\/]*)/;
	$plugin->method_name($^N);
	$plugin->config->{Methods}->{ $plugin->method_name } = 'Private' unless exists $plugin->config->{Methods}->{ $plugin->method_name }; # If a method (route) is not defined at the configuration file we will considered it as Private

	$plugin->from($plugin->app->request->query_parameters->{from} // $plugin->config->{'Default input format'} );
	$plugin->to(  $plugin->app->request->query_parameters->{to}   // $plugin->config->{'Default output format'});
	if ( $plugin->from !~ $plugin->__format_from_regex ) { $plugin->error(20); $plugin->errormessage('property from '.$plugin->from.' is not one of the supported : '. join(', ',@{$plugin->__format_from})); $plugin->to('json'); $plugin->app->halt( $plugin->RestReply ) }
	if ( $plugin->to   !~ $plugin->__format_to_regex   ) { $plugin->error(21); $plugin->errormessage('property to '.  $plugin->to.  ' is not one of the supported : '. join(', ',@{$plugin->__format_to}));   $plugin->to('json'); $plugin->app->halt( $plugin->RestReply ) }

	$plugin->app->request->header('Content-Type' => $TypeHeader{ $plugin->to }); # Define the header
	


		# Parse user posted/sent data
		if ( $plugin->app->request->body ) { 
		$plugin->data_from( $plugin->app->request->body );
		my $hash = $plugin->__CONVERT_STRING_TO_HASHREF;

			if ( $plugin->error ) {
			$plugin->to('json');
			$plugin->dump_user_properties( { error=>$plugin->error, errormessage=>$plugin->errormessage, description=>'Data conversion error from '.$plugin->from.' to '.$plugin->to } );
			$plugin->data_user( {} );
			die "DataStructure internal error : ". $plugin->errormessage."\n" if $plugin->error;
			$plugin->app->halt( $plugin->data_to )
			}

		$plugin->data_user($hash)
		}

	# Setup the remote IP address, even if the web service is running from a reverse proxy
	$plugin->ClientIP( defined $plugin->app->request->env->{HTTP_X_REAL_IP} ? $plugin->app->request->env->{HTTP_X_REAL_IP} : defined $plugin->app->request->address ? $plugin->app->request->address : 'localhost' );

	return if 'Public' eq $plugin->config->{Methods}->{ $plugin->method_name };
	# If the code gets to this line, we are sure, we are dealing with a private protected route

	# Check if the session is valid, and it is not expired due to inactivity
	# If the session is not expired update the __lastaccess
	unless (exists $plugin->data_user->{SessionID}                           ) { $plugin->error(2); $plugin->errormessage('You must login for using the private method '.$plugin->method_name); $plugin->data_user({description=>'Get SessionID via login method'});         $plugin->app->halt( $plugin->RestReply() ) }
	unless (exists $plugin->data_session->{ $plugin->data_user->{SessionID} }) { $plugin->error(3); $plugin->errormessage('invalid or expired SessionID '.$plugin->data_user->{SessionID});     $plugin->data_user({description=>'Get a valid SessionID via login method'}); $plugin->app->halt( $plugin->RestReply() ) }

		if ( time - $plugin->data_session->{ $plugin->data_user->{SessionID} }->{__lastaccess} > $plugin->config->{'Session idle timout'} ) {
		$plugin->error(4);
		$plugin->errormessage('Session '.$plugin->data_user->{SessionID}.' expired because its idle time '.(time - $plugin->data_session->{ $plugin->data_user->{SessionID} }->{__lastaccess}).' secs is more than the allowed '.$plugin->config->{'Session idle timout'}.' secs');
		$plugin->__Delete_session;
		$plugin->app->halt( $plugin->RestReply() )
		}
		else {
		$plugin->set_data_session(__lastaccess => time)
		}
	}));





	# Add built in routes
	$plugin->app->add_route(
	method => $_,
	regexp => '/info',
	code   => sub { $_[0]->forward('/info/version') }
	)foreach 'get', 'post', 'put', 'delete';


	# Add built in routes	
	$plugin->app->add_route(
	method => $_,
	regexp => '/info/:what',
	code   => sub
	{
	my $app = shift;

		if ( $app->request->param('what') =~/(?i)ver/ )
		{
		$plugin->RestReply(			
		Name			=> $plugin->app->{name},
		Application		=> $plugin->config->{Version},
		Dancer			=> $Dancer2::VERSION,
		Perl			=> $],
		'Linux kernel'		=> eval{$_ = qx/uname -r/; chomp $_; $_},
		'WebService library'	=> $VERSION)
		}
		elsif ( $app->request->param('what') =~/(?i)cl/ )
		{
		$plugin->RestReply(
		'Your IP address'	=> $plugin->ClientIP,
		'Your client'		=> $plugin->app->request->agent,
		'Your port'		=> $plugin->app->request->env->{REMOTE_PORT},
		'Is secure'		=> $plugin->app->request->secure,
		Protocol		=> $plugin->app->request->protocol,,
		'Http method'		=> $plugin->app->request->method,
		'Parameters route'	=> $plugin->app->request->params('route'),
		'Parameters url'	=> $plugin->app->request->params('query'),
		'Parameters body'	=> $plugin->app->request->params('body'),
		'Header accept'		=> $plugin->app->request->header('accept'),
		'Previous page'		=> $plugin->app->request->referer,
		'Server time'		=> scalar localtime time)
		}
		else
		{
		$plugin->RestReply(error=>5, errormessage=>'Not existing internal route \''.$app->request->param('what').'\' Please choose one of : version, about, client')
		} 
	}

	)foreach 'get', 'post', 'put', 'delete';


	# logout and delete the session	
	$plugin->app->add_route(
	method => $_,
	regexp => '/logout',
	code   => sub
		{
		my $app = shift;
		$plugin->error(0);
		$plugin->errormessage('logged out from session '. $plugin->data_user->{SessionID} );
		$plugin->__Delete_session;
		$plugin->RestReply
		}

	)foreach 'get', 'post', 'put', 'delete';




	#  curl -X GET --data '{"user":"Joe", "password":"MySecret" }' 'http://localhost:3000/login?from=json;to=json'
	#
	#  Authenticate users using external custom scripts or commands
	#  using the appropriate shell script you can easily have your
	#  LDAP, kerberus, Active Directory, SQL, or what ever mechanism you want
	#  Feel free to write your own scripts and define them at config.yml
	#
	#  The external custom shell authorization scripts/commands receives three arguments
	#
	#	1) user (as hex string)
	#	2) password (as hex string)
	#	3) comma delimited groups that the user should belong at least to one of them
	#
	#  we convert the user, pass arguments to hex strings to avoid shell attacks.
	#  Remember at linux the maximum length of a shell command is   getconf ARG_MAX
	#
	#  The result is stored at
	#
	#	$plugin->auth_result     1 for successful login, or 0 fail
	#	$plugin->auth_message    the reason why the login was failed e.g  "user do not exist"
	#	$plugin->auth_member_of  In case of successful login, the groups that the user belongs (from the ones we have specify)
	#
	$plugin->app->add_route(
	method => $_,
	regexp => '/login',
	code   => sub
	{
	my $app = shift;

		# Check client IP address against the access rules
		$plugin->error(13);
		for (my $i=0; $i<@{ $plugin->ip_rules_compiled }; $i++)
		{
			if ( $plugin->ClientIP =~ $plugin->ip_rules_compiled->[$i] ) {
			$plugin->error(0);		
			$plugin->errormessage('ok');
			$plugin->data_user->{'IP access'} = 'Match client IP '. $plugin->ClientIP .' from rule '. $plugin->ip_rules->[$i];
			last
			}
		}

		if ( $plugin->error ) {
		$plugin->errormessage('Client IP address '. $plugin->ClientIP .' is not allowed from any IP access rule');
		$plugin->app->halt( $plugin->RestReply('user') )
		}

	# Check the input parameters
	foreach ('user','password') {unless (exists $plugin->data_user->{$_}) { $plugin->error(6); $plugin->errormessage("Login failed, you did not pass the $_"); $plugin->app->halt( $plugin->RestReply ) }}
	if ( $plugin->data_user->{user} =~ /^\s*$/ ) { $plugin->error(7); $plugin->errormessage("Login failed because the user is blank");     $plugin->app->halt( $plugin->RestReply ) }
	if ( $plugin->data_user->{password} eq ''  ) { $plugin->error(8); $plugin->errormessage("Login failed because the password is blank"); $plugin->app->halt( $plugin->RestReply('user')  ) }
	if ( 0 == @{$plugin->groups }              ) { $plugin->error(9); $plugin->errormessage("Login failed because the required group list is empty"); $plugin->app->halt( $plugin->RestReply('user') ) }

	$plugin->auth_result(0);
	$plugin->auth_message('Unknown authentication error');
	$plugin->auth_member_of([]);

	my $user	= unpack 'H*',	$plugin->data_user->{user};
	my $password= unpack 'H*',	$plugin->data_user->{password};
	my $groups	= join   ',',	@{$plugin->groups};
	my $command	= $plugin->config->{'Authentication method'}->{$plugin->Authentication_method}->{'Command'};
	my @output	= ();
	$command	= "\Q$command\E $user $password \Q$groups\E";
	$command	= $plugin->sudo ." $command" if $plugin->config->{'Authentication method'}->{$plugin->Authentication_method}->{'Use sudo'} =~/(?i)y/;

	#print "arguments after pack: $user $password $groups\n";
	#print STDERR "\n*". $command   ,"*\n\n";
	
	# Execute the external authorization utility and capture its 3 lines output at @output array
	open    SHELL, '-|', "$command 2> /dev/null" or die "Could run auth shell command \"$command\" because \"$?\"\n";
	while (<SHELL>) { s/^\s*(.*?)\s*$/$1/; push @output, $_ }
	close   SHELL;

	$plugin->auth_result( $output[0]);
	$plugin->auth_message($output[1]);
	$plugin->auth_member_of( [ split /,/, $output[2] ] ) if $plugin->auth_result;

		if ($plugin->auth_result) {
		$plugin->auth_message('ok') if $plugin->auth_message eq '';
		$plugin->auth_member_of(['emptylist']) unless @{ $plugin->auth_member_of }
		}
		else {
		$plugin->auth_message('Unknown authentication error') if $plugin->auth_message eq '';
		$plugin->auth_member_of([])
		}

	$plugin->error( $plugin->auth_result == 0 ? 10 : 0 );
	$plugin->errormessage( $plugin->auth_message );
	$plugin->app->halt( $plugin->RestReply('user') ) if $plugin->error;

	# User authenticated successfully, now we must create his permanent session
	# and store there some built in properties
	my $SessionID = ''; $SessionID .= sprintf("%08x", int rand 800_000_000) for 1..4;

		if (-e $plugin->dir_session ."/$SessionID") {
		my $i=1;
		while ( -e $plugin->dir_session ."/$i.$SessionID" ) {$i++}
		$SessionID = "$i.$SessionID"
		}

		unless (mkdir $plugin->dir_session ."/$SessionID") {
		$plugin->error(12);
		$plugin->errormessage("Login failed . Could not create session directory $SessionID because $!");
		$plugin->app->halt( $plugin->RestReply('user') )
		}

	$plugin->data_user->{SessionID}		= $SessionID;
	$plugin->data_session->{$SessionID}	= {};
	$plugin->set_data_session('__clientip'=> $plugin->ClientIP, '__lastaccess'=> time, '__logintime'=> time, '__user'=> $plugin->data_user->{user});

	$plugin->RestReply(
	'IP access'			=> $plugin->data_user->{'IP access'},
	'user'				=> $plugin->data_user->{user},
	'SessionID'			=> $SessionID,
	'Max idle seconds'	=> $plugin->config->{'Session idle timout'},
	'auth_message'		=> $plugin->auth_message,
	'auth_member_of'	=> $plugin->auth_member_of )
	}

	)foreach 'get', 'post';


#print STDERR "\n*". Data::Dumper::Dumper(  $plugin )  ."*\n\n";
#print STDERR "\n*". Data::Dumper::Dumper(  $_->app->request )  ."*\n\n";
#print STDERR "$_\n" foreach @{$obj->{ip_rules}};
#print STDERR "\n*". $plugin->config->{Methods}  ."*\n\n";
}




use	JSON::XS;
	my $obj_json = JSON::XS->new;
	$obj_json->utf8(1);
	$obj_json->max_depth(1024);
	$obj_json->indent(1);
	$obj_json->pretty(1);
	$obj_json->space_before(0);
	$obj_json->space_after(0);
	$obj_json->max_size(0);
	$obj_json->relaxed(0);
	$obj_json->shrink(0);
	$obj_json->allow_tags(1);
	$obj_json->allow_nonref(0);
	$obj_json->allow_unknown(0);
	$obj_json->allow_blessed(1);
	$obj_json->convert_blessed(1);

use	XML::Hash::XS;
	$XML::Hash::XS::root='Data';
	$XML::Hash::XS::utf8=1;
	$XML::Hash::XS::encoding='utf8';
	$XML::Hash::XS::xml_decl=0;
	$XML::Hash::XS::indent=2;
	$XML::Hash::XS::canonical=1;
	$XML::Hash::XS::doc=0;
	$XML::Hash::XS::version='1.1';

use	YAML::XS;
	$YAML::XS::QuoteNumericStrings=1;

use	Data::Dumper;
	$Data::Dumper::Terse=1;
	$Data::Dumper::Purity=1;
	$Data::Dumper::Indent=2;
	$Data::Dumper::Deepcopy=1;
	$Data::Dumper::Trailingcomma=0;


#  This is my custom Perl Data Structures recursive walker
#  it is usefull when you want to view a Complex data structure at human format
my %Handler;
%Handler =
(
SCALAR => sub { $Handler{WALKER}->(${$_[0]}, $_[1], @{$_[2]} )},
ARRAY  => sub { $Handler{WALKER}->($_, $_[1], @{$_[2]}) for @{$_[0]} },
HASH   => sub { $Handler{WALKER}->($_[0]->{$_}, $_[1], @{$_[2]}, $_) for sort keys %{$_[0]} },
''     => sub { $_[1]->($_[0], @{$_[2]}) },
WALKER => sub { my $data = shift; $Handler{ref $data}->($data, shift, \@_) }
);






#   Convert a string ( data_from ) to a Perl hash reference 
#   as the $obj->{from} defines : json, xml, yaml, perl, human
#
sub __CONVERT_STRING_TO_HASHREF
{
my $obj = $_[0];
@{$obj}{qw/error errormessage/}=(0,'ok');

	if (( ! defined $obj->{data_from} ) || ( $obj->{data_from} =~/^\s*$/ )) {
	@{$obj}{qw/error errormessage/} = (1, "There are not any data to convert at property data_from");	
	return {}
	}

my $hash={};

	eval  {
	if    ( $obj->{from} eq 'json' ) { $hash = JSON::XS::decode_json   $obj->{data_from} }
	elsif ( $obj->{from} eq 'xml'  ) { $hash = XML::Hash::XS::xml2hash $obj->{data_from} }
	elsif ( $obj->{from} eq 'yaml' ) { $hash = YAML::XS::Load          $obj->{data_from} }
	elsif ( $obj->{from} eq 'perl' ) { $hash = eval                    $obj->{data_from} }
	elsif ( $obj->{from} eq 'human') { my $arrayref;

			while ( $obj->{data_from} =~/(.*)$/gm ) {
			my @array = split /\s*(?:\,| |\t|-->|==>|=>|->|=|;|\|)+\s*/, $1;
			next unless @array;

				if (@array % 2 == 0) {
				push @{$arrayref}, { @array }
				}
				else {
				push @{$arrayref}, { shift @array => [ @array ] }
				}
			}

		$hash = 1==scalar @{$arrayref} ? $arrayref->[0] : { 'Data' => $arrayref }
		}
	};

	if ($@) {
	$hash={};
	$obj->{error}=1;
	($obj->{errormessage}="The data parsing as $obj->{from} failed. Are you sure your data are at $obj->{from} format ? The low level error is : $@") =~s/[\v\h]+/ /g
	}
$hash
}



#  Convert hash reference $_[0] to text and store it at $obj->{data_to}
#  format of "data_to" is depended from "to" : json xml yaml perl human
#
#   __CONVERT_HASHREF_TO_STRING( $hash_reference )
#  print $obj->{error} ? "ERROR : $obj->{errormessage}" : $obj->{data_to};
#
sub __CONVERT_HASHREF_TO_STRING
{
my $obj=shift;
@{$obj}{qw/error errormessage/}=(0,'ok');
$obj->{data_to}='';

	eval  {	
	if    ($obj->{to} eq 'json' ) { $obj->{data_to} = $obj_json->encode($_[0]) }
	elsif ($obj->{to} eq 'xml'  ) { $obj->{data_to} = XML::Hash::XS::hash2xml $_[0] }
	elsif ($obj->{to} eq 'yaml' ) { $obj->{data_to} = YAML::XS::Dump $_[0] }
	elsif ($obj->{to} eq 'perl' ) { $obj->{data_to} = Data::Dumper::Dumper $_[0] }
	elsif ($obj->{to} eq 'human') { $Handler{WALKER}->($_[0], sub {my $val=shift; $val =~s/^\s*(.*?)\s*$/$1/; $obj->{data_to} .= join('.', @_) ." = $val\n"}) }
	};

	if ($@) {
	$obj->{data_to}		= '';
	$obj->{error}		= 1;
	($obj->{errormessage}	= "The encoding of data hash to $obj->{to} failed. The low level error is : $@") =~s/[\v\h]+/ /g
	}

$obj->{data_to}
}




#    RestReply()
#    RestReply()					all user data
#    RestReply('DATA_USER_SEND')	the data as user send them
#
#    This output your selected user properties as : json xml yaml perl human
#    Always add automatic the properties          : error errormessage
#
#    In order to get these user properties as reply we must add them at the array  $plugin->data_user
#   
sub  RestReply
{
my $plugin = shift;

	if (@_)
	{
		if (1 == @_)
		{
			if (('DATA_USER_SEND' eq $_[0]) || ('DATA_USER_ALL' eq $_[0]))
			{
			# user send DATA_BODY lets print out his original posted data
			$plugin->dump_user_properties($_[0])
			}
			else
			{
			$plugin->dump_user_properties( { error=> $plugin->error, errormessage=> $plugin->errormessage, $_[0]=> exists $plugin->data_user->{$_[0]} ? $plugin->data_user->{$_[0]} : 'NOT EXISTING DATA USER RECORD' } )
			}
		}
		else
		{
		# This the normal operation		
		$plugin->dump_user_properties( { error=> $plugin->error, errormessage=> $plugin->errormessage, @_ } )
		}
	}
	else
	{
	# if no argument passed then we return only error, errormessage and if exists description
	my $hash = { error=>$plugin->error, errormessage=>$plugin->errormessage };
	$hash->{description} = $plugin->data_user->{description} if exists $plugin->data_user->{description};
	$plugin->dump_user_properties($hash)
	}

	if ( $plugin->error ) {	
	$plugin->to('json');
	$plugin->dump_user_properties( { error=>$plugin->error, errormessage=>$plugin->errormessage, description=>'Data conversion error from '.$plugin->from.' to '.$plugin->to } );
	$plugin->data_user( {} );
	die "DataStructure internal error : ". $plugin->errormessage."\n" if $plugin->error;
	$plugin->app->halt( $plugin->data_to )
	}

$plugin->data_to
}




#  $plugin->dump_user_properties( [ 'k1', 'k2' ] );		# selected keys of    $plugin->data_user
#  $plugin->dump_user_properties();						# user's posted data stored at $plugin->data_from
#
#  $plugin->error ? print $plugin->errormessage : print  $obj->data_to;
#
#  Returns the selected user properties as string
#  formatted as (to)  : json , xml , yaml , perl , human , untouched
#  The result is at  $plugin->data_to
#
#  $plugin->from(json|yaml|xml|perl|human|untouched);
#  $plugin->to(  json|yaml|xml|perl|human);
#
sub dump_user_properties
{
my $plugin = shift;
my $hash   = {};
$plugin->data_to('');

	# specific user data
	if ('HASH' eq ref $_[0])
	{
	$plugin->__CONVERT_HASHREF_TO_STRING($_[0])
	}

	# user data (all)
	elsif ('DATA_USER_ALL' eq $_[0])
	{		
	$hash->{error}			= $plugin->error;
	$hash->{errormessage}	= $plugin->errormessage;
 	map { $hash->{$_}		= $plugin->data_user->{$_} } keys %{ $plugin->data_user };
	$plugin->__CONVERT_HASHREF_TO_STRING($hash)
	}

	elsif ('DATA_USER_SEND' eq $_[0])
	{
	# only the posted data

		if ($plugin->from eq $plugin->to)
		{
		$_= $plugin->data_from;
		s/^\s*(.*?)\s*$/$1/s;
		$plugin->data_to($_)
		}
		else
		{
		$hash = $plugin->__CONVERT_STRING_TO_HASHREF;	# whatever exists in $plugin->data_from in any format make it hash
		        $plugin->__CONVERT_HASHREF_TO_STRING($hash)
		}
	}

$plugin->data_to
}


#   Create nested directories like the  mdkir -p ...
#
sub __MKDIR {
my @Mkdir = split /(?:\\|\/)+/, $_[0];
return $_[0] unless @Mkdir;
splice(@Mkdir, 0, 2, "/$Mkdir[1]") if (($Mkdir[0] eq '') && (scalar @Mkdir > 0));
my $i;

	for($i=$#Mkdir; $i>=0; $i--) {
	last if -d join '/', @Mkdir[0..$i]
	}

	for(my $j=$i+1; $j<=$#Mkdir; $j++) {
	mkdir join('/', @Mkdir[0 .. $j]) or return undef
	}
$_[0]
} 


#   Delete session directory and property
#
sub __Delete_session {
my $plugin	= shift;
my $id		= $plugin->data_user->{SessionID};
my $dir		= $plugin->dir_session."/$id";
delete $plugin->data_session->{$id} if exists $plugin->data_session->{$id};

	if (-d $dir) {
	my $exit_code = system $plugin->rm, '--recursive', '--force', $dir;
	if ($exit_code) { $plugin->error(11); $plugin->errormessage("Could not delete session $id because $!") }
	}
}


#   Returns the posted or sent data 
#
#   my ($var1, $var2) = get_data_user('k1', 'k2');    # returns the selected keys
#   my %hash          = get_data_user();              # returns all data as hash
#
sub get_data_user
{
my $plugin = shift;

	if (@_)
	{
	map {exists $plugin->data_user->{$_} ?  $plugin->data_user->{$_} : 'NOT EXISTING DATA USER RECORD'} @_
	}
	else
	{
	%{ $plugin->data_user }
	}
}



#   Set new user data as if they were sent or posted
#   It returns the data like the get_user_data
#
#   my %data = set_data_user(   new1 => 'foo1', new2 => 'foo2'   );   # returns the keys
#   my %data = set_data_user( { new1 => 'foo1', new2 => 'foo2' } );   # returns the keys
#
sub set_data_user
{
my $plugin = shift;
my @keys;

	if (@_)
	{
	if (( 1 == @_ ) && ( 'HASH' eq ref $_[0] )) { @_ = %{ $_[0] } }

		for (my($i,$j)=(0,1); $i < scalar(@_) - (scalar(@_) % 2); $i+=2,$j+=2)
		{
		push @keys, $_[$i];
		$plugin->data_user->{$_[$i]} = $_[$j]
		}

	%{ $plugin->data_user }{ @keys }
	}
}


#   Deletion of user data
#
#     del_data_user( 'k1', 'k2', ... );    # delete only the selected keys
#     del_data_user();                     # delete all keys
#
sub del_data_user
{
my $plugin = shift;

	if (@_)
	{
		foreach (@_)
		{
		delete $plugin->data_user->{$_} if exists $plugin->data_user->{$_}
		}
	}
	else
	{
	$plugin->data_user({})
	}
}



#   Returns stores session data
#
#   my %data = get_data_session( 'k1', 'k2', ... );    # returns only the selected keys
#   my %data = get_data_session();		       # returs all keys
#
sub get_data_session
{
my $plugin = shift;
unless (exists $plugin->data_user->{SessionID}                           ) { $plugin->error(2); $plugin->errormessage('You must login for using persistent session data');              $plugin->data_user({description=>'Get SessionID via login method'});         $plugin->app->halt( $plugin->RestReply ) }
unless (exists $plugin->data_session->{ $plugin->data_user->{SessionID} }) { $plugin->error(3); $plugin->errormessage('invalid or expired SessionID '.$plugin->data_user->{SessionID}); $plugin->data_user({description=>'Get a valid SessionID via login method'}); $plugin->app->halt( $plugin->RestReply ) }
my $id  = $plugin->data_user->{SessionID};
my $dir	= $plugin->dir_session ."/$id";

	if (@_)
	{
		foreach (@_)
		{
		next if exists $plugin->data_session->{$id}->{$_};
		if ( ! -f "$dir/$_" ) { $plugin->data_session->{$id}->{$_} = 'NOT EXISTING SESSION RECORD'; next }

			if ( $plugin->data_session->{$id}->{$_} = Storable::retrieve "$dir/$_" )
			{
			$plugin->data_session->{$id}->{$_} = ${$plugin->data_session->{$id}->{$_}} if 'SCALAR' eq ref $plugin->data_session->{$id}->{$_}
			}
			else	
			{
			$plugin->error(1);
			$plugin->errormessage("Could not retrieve from session $id the property $_ because $!");
			$plugin->app->halt( $plugin->RestReply('error') )
			}
		}

	map { $plugin->data_session->{$id}->{$_} } @_
	}
	else
	{
	opendir __SESSIONDIR, $dir;

		foreach (grep ! /^\.+$/, readdir __SESSIONDIR)
		{
		next if exists $plugin->data_session->{$id}->{$_};
		next if -d "$dir/$_";

			if ( $plugin->data_session->{$id}->{$_} = Storable::retrieve "$dir/$_" )
			{
			$plugin->data_session->{$id}->{$_} = ${$plugin->data_session->{$id}->{$_}} if 'SCALAR' eq ref $plugin->data_session->{$id}->{$_}
			}
			else	
			{
			$plugin->error(1);
			$plugin->errormessage("Could not retrieve from session $id the property $_ because $!");
			$plugin->app->halt( $plugin->RestReply() )
			}
		}

	closedir __SESSIONDIR;
	%{ $plugin->data_session->{$id} }
	}
}




#   Set and store session data
#   Session data are not volatile as user data.
#   They are persistant between requests
#
#   my %data = set_data_session(   new1 => 'foo1', new2 => 'foo2'   );   # Set and return the defined session keys
#   my %data = set_data_session( { new1 => 'foo1', new2 => 'foo2' } );   # Set and return the defined session keys
#
sub set_data_session
{
my $plugin = shift;
unless (exists $plugin->data_user->{SessionID}                           ) { $plugin->error(2); $plugin->errormessage('You must login for using persistent session data');            $plugin->data_user({description=>'Get SessionID via login method'}); $plugin->app->halt( $plugin->RestReply ) }
unless (exists $plugin->data_session->{ $plugin->data_user->{SessionID} }) { $plugin->error(3); $plugin->errormessage('You can not store permanent data on the non existing session '.$plugin->data_user->{SessionID}); $plugin->data_user({description=>'Get a valid SessionID via login method'}); $plugin->app->halt( $plugin->RestReply ) }

my $id = $plugin->data_user->{SessionID};
my @keys;
if (( 1 == @_ ) && ( 'HASH' eq ref $_[0] )) { @_ = %{ $_[0] } }

	for (my($i,$j)=(0,1); $i < scalar(@_) - (scalar(@_) % 2); $i+=2,$j+=2)
	{	
	my $data = $_[$j];	
	$data = \ "$data" unless ref $data;

		if ( Storable::lock_store $data, $plugin->dir_session ."/$id/$_[$i]" )
		{
		$plugin->data_session->{$id}->{$_[$i]} = $_[$j];
		push @keys, $_[$i]
		}
		else
		{
		$plugin->error(1);
		$plugin->errormessage("Could not store at session $id the property $_[$i] because $!");
		$plugin->app->halt( $plugin->RestReply )
		}
	}

%{ $plugin->data_session->{$id} }{ @keys }
}




#   Delete session data (not sessions)
#   It never deletes the built in records : __lastaccess, __logintime, __clientip, __user
#   
#     del_data_session( 'k1', 'k2', ... );    # delete only the selected keys
#     del_data_session();                     # delete all keys
#
sub del_data_session
{
my $plugin = shift;
unless (exists $plugin->data_user->{SessionID}                           ) { $plugin->error(2); $plugin->errormessage('You must login for using persistent session data');              $plugin->data_user({description=>'Get SessionID via login method'});         $plugin->app->halt( $plugin->RestReply ) }
unless (exists $plugin->data_session->{ $plugin->data_user->{SessionID} }) { $plugin->error(3); $plugin->errormessage('invalid or expired SessionID '.$plugin->data_user->{SessionID}); $plugin->data_user({description=>'Get a valid SessionID via login method'}); $plugin->app->halt( $plugin->RestReply ) }
my $id  = $plugin->data_user->{SessionID};
my $dir	= $plugin->dir_session ."/$id";

	if (@_) {

		foreach (@_) {
		next if /^__logintime|__lastaccess|__user|__clientip$/;
		delete $plugin->data_session->{$id}->{$_} if exists $plugin->data_session->{$id}->{$_};
		next unless -f "$dir/$_";
		unless (unlink "$dir/$_") { $plugin->error(5); $plugin->errormessage("Could not delete from session $id the record $_ because $!"); $plugin->app->halt( $plugin->RestReply ) }
		}
	}
	else {
	opendir __SESSIONDIR, $dir;

		foreach (grep ! /^\.+$/, readdir __SESSIONDIR) {
		next if /^__logintime|__lastaccess|__user|__clientip$/;
		delete $plugin->data_session->{$id}->{$_} if exists $plugin->data_session->{$id}->{$_};
		next unless -f "$dir/$_";
		unless (unlink "$dir/$_") { $plugin->error(5); $plugin->errormessage("Could not delete from session $id the record $_ because $!"); $plugin->app->halt( $plugin->RestReply ) }
		}

	closedir __SESSIONDIR
	}
}




1;# END OF MODULE