########################################################################
#
#                                                                    #
#                    __   __    ____ _____ ____                      #
#                    \ \ / /_ _/ ___|_   _|___ \                     #
#                     \ V / _` \___ \ | |   __) |                    #
#                      | | (_| |___) || |  / __/                     #
#                      |_|\__,_|____/ |_| |_____|                    #
#                                                         -o)
#------------------------------------------------------   /\\  --------
#                                                        _\_v
#
#   Author:        Michael Hager <mike@suse.de>
#		   Martin Vidner <mvidner@suse.cz>
#
#   Description:   perl interface for YCP
#
#   Purpose:       Call a perl script within a YCP script
#
#----------------------------------------------------------------------
# $Id: ycp.pm 32969 2006-09-19 12:21:30Z mvidner $

package ycp;

=head1 NAME

ycp - a Perl module for parsing and writing the YaST2 Communication Protocol

=head1 SYNOPSIS

C<($symbol, @config) = ycp::ParseTerm ('MyAgentConfig ("/etc/file", false, true, $["a":1, "b":2])');>

C<($command, $path, $arg) = ycp::ParseCommand ('Write (.magic.path, "abacadabra")');>

C<ycp::Return (["arbitrarily", "complex", "data"]);>

=head1 DATA

=head2 PerlYCPValue

PerlYCPValue is a convention for storing a YCP value in a Perl variable.
L</ParseYcp> parses YCP string representation into PerlYCPValues.

A PerlYCPValue cannot represent a term but only a term is allowed
to initialize an agent in a .scr file. Therefore L</ParseTerm> is provided.

=over 4

=item string, integer, boolean

Stored as a scalar.

=item list

Stored as a reference to a list of PerlYCPValues.

=item map

Stored as a reference to a map  of PerlYCPValues.

=item path

Stored as a reference to a string (starting with a "." as expected).

=item nil (void)

Stored as an undef.

=back

=head1 PARSING

=cut

use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION);
use Exporter;
use diagnostics;
use strict;
use Time::localtime;
use Sys::Hostname;

@ISA     = qw(Exporter);


my @e_io = qw(
	       ParseTerm
	       ParseCommand
	       PathComponents
	       Return
	       );

@EXPORT_OK = @e_io;

my @e_logging = qw(y2debug y2milestone y2warning y2error y2security y2internal);
my @e_obsolete  = qw(
	       ycpDoVerboseLog
	       ycpInit
	       ycpArgIsMap
	       ycpArgIsList
	       ycpArgIsInteger
	       ycpArgIsString
	       ycpArgIsNil
	       ycpArgIsNone
	       ycpGetArgMap
	       ycpGetArgList
	       ycpGetArgString
	       ycpGetArgInteger
	       ycpReturnSkalarAsInt
	       ycpReturnArrayAsList
	       ycpReturnSkalarAsBoolean
	       ycpReturnHashAsMap
	       ycpReturnSkalarAsString
	       ycpCommandIsDir
	       ycpCommandIsRead
	       ycpCommandIsWrite
	       ycpCommandIsExecute
	       ycpCommandIsResult
	       ycpGetCommand
	       ycpGetPath
	       ycpGetArgType
	       ycpReturn );

@EXPORT = (@e_logging, @e_obsolete);

our %EXPORT_TAGS = (IO => [@e_io],
		    LOGGING => [@e_logging],
		    OBSOLETE => [@e_obsolete]);

my $ycpcommand    = "";
my $ycppath       = "";

my $type          = "unknown";
my $ismap         = 0;
my $islist        = 0;
my $isinteger     = 0;
my $isstring      = 0;
my $isknown       = 0;
my $isnil         = 0;
my $isnone        = 0;

my %arghash;
my @argarray;
my $argskalar;

my $verbose = 0;
my $againstcompileerror = 1;

my $hostname = hostname();


################################################################################
# Parsing
################################################################################

=head2 ParseCommand

ParseComand $line

C<($command, $path, $arg) = ParseCommand ('Write (.moria.gate, "mellon")');>

Parse a SCR command of the form Command (.some.path, optional_argument)

Returns a three element list ("Command", ".some.path", $argument)
where the argument is a L</PerlYCPValue> and will be undef
if it was not specified.
Note that the path is converted to a string.

If there was a parse error, the command or path will be the empty string.

=cut

sub ParseCommand ($)
{
    my @term = ParseTerm (shift);

    my $command = shift @term || "";

    my $path = "";
    my $pathref = shift @term;
    if (defined $pathref)
    {
	if (ref($pathref) eq "SCALAR" && $$pathref =~ /^\./)
	{
	    $path = $$pathref;
	}
	# 'result (nil)' is a standard command
	elsif ($command ne "result")
	{
	    y2error ("The first argument is not a path. ('$pathref')");
	}
    }

    my $argument = shift @term;
    y2warning ("Superfluous command arguments ignored") if (@term > 0);

    return ($command, $path, $argument);
}

=head2 ParseTerm

ParseTerm $line

C<($symbol, @config) = ParseTerm ('MyAgentConfig ("/etc/file", false, true, $["a":1, "b":2])');>

Parse a YCP term. Note that there can be no other term inside.

Returns a list whose first element is the term symbol as a string
(or C<""> in case of an error) and the remaining elements are the term
arguments (L</PerlYCPValue>)

=cut

sub ParseTerm ($)
{
    my $input = shift;

    my $symbol;
    my @ret;

    $input =~ s/^\s*`?(\w*)\s*//; # allow both Term and `Term (for the NI)
    $symbol = $1;
    if (! $symbol)
    {
	y2error ("No term symbol");
    }
    push @ret, $symbol;

    if ($input !~ m/^\(/)
    {
	y2error ("No term parentheses");
    }

    my ($argref, $err, $rest) = ParseYcpTermBody ($input);
    if ($err)
    {
	y2error ("$err ('$rest')");
    }
    else
    {
	push @ret, @$argref;
    }

    return @ret;
}

# ------------------------------------------------------------
# Internal parsing functions start here.

# PerlYCPParserResult is a triple:
# ($result, $error, $rest_of_input)
# where
#   $result is a PerlYCPValue.
#   $error is either "" or an error description.
#        In that case, $result is not specfied.
#   $rest_of_input is the unmatched part of the input.
#        On success, parsing can go on, on error, the ofending input is there.

# this is how it looks like in lex:
# PATHSEGMENT [[:alnum:]_-]+|\"([^\\"]*(\\.)*)+\"
my $lex_pathsegment = qr{
		(?:				# outer group
		[[:alnum:]_-]+			# ordinary segment
		|
		"
		(?:
		[^\\"]*				# any-except-bkls-quot
		(?: \\ . )*			# bksl, any
		)+
		"
		)
		}x;		# enable whitespace and comments in regex

# Internal
# Parses a YCP value. See PerlYCPValue. Notably terms are not supported.
# Returns PerlYCPParserResult.
sub ParseYcp ($)
{
    my $ycp_value = shift;

    #remove leading whitespace;
    $ycp_value =~ s/^\s+//;


    if ($ycp_value =~ /^nil(.*)/)
    {
	return (undef, "", $1);
    }
    elsif ($ycp_value =~ /^false(.*)/)
    {
	return (0, "", $1);
    }
    elsif ($ycp_value =~ /^true(.*)/)
    {
	return (1, "", $1);
    }
    # numbers. TODO not only integers: floats
    elsif ($ycp_value =~ /^(-?\d+)(.*)/)
    {
	my $num = $1;
	my $rest = $2;
	$num = oct ($num) if $num =~ /^0/;
	return ($num, "", $rest);
    }
    elsif ($ycp_value =~ /^\"/) #"
    {
	return ParseYcpString ($ycp_value);
    }
    elsif ($ycp_value =~ /^((?:\.${lex_pathsegment})+|\.)(.*)/)
    {
	my $path = $1; # must be a "my" variable, not \$1.
	return (\$path, "", $2);
    }
    elsif ($ycp_value =~ /^\[/)
    {
	return ParseYcpList ($ycp_value);
    }
    elsif ($ycp_value =~ /^\$\[/)
    {
	return ParseYcpMap ($ycp_value);
    }
    elsif ($ycp_value =~ /^\#\[/)
    {
	return ParseYcpByteblock ($ycp_value);
    }
    elsif ($ycp_value =~ /^$/)
    {
	return ("", "Unexpected end of input.", $ycp_value);
    }
    else
    {
	return ("", "Construct not supported.", $ycp_value);
    }
}

# Internal
# Parses a YCP string. The input must start with a double quote.
# Returns PerlYCPParserResult.

# we limit ourselves to parsing the output of YCPStringRep::toString()
# (see YCPString.cc in libycp)
sub ParseYcpString ($)
{
    my $ycp_value = shift;
    my $ret = "";

    #remove the leading quote
    $ycp_value =~ s/^"//; #";

    while (1)
    {
	# ordinary characters
	if ($ycp_value =~ s/^([^\"\\]+)//) #" #newline?
	{
	    $ret .= $1;
	}
	# octal escapes
	elsif ($ycp_value =~ s/^\\([0-7]{3})//)
	{
	    $ret .= chr (oct ($1));
	}
	# weird behavior for 1 or 2 digits
	elsif ($ycp_value =~ s/^\\([0-7]{1,2})//)
	{
	    $ret .= $1;
	}
	# other escapes
	elsif ($ycp_value =~ s/^\\([^0-7])//)
	{
	    if ($1 eq "n")
	    {
		$ret .= "\n";
	    }
	    elsif ($1 eq "t")
	    {
		$ret .= "\t";
	    }
	    elsif ($1 eq "r")
	    {
		$ret .= "\r";
	    }
	    elsif ($1 eq "f")
	    {
		$ret .= "\f";
	    }
	    elsif ($1 eq "b")
	    {
		$ret .= "\b";
	    }
	    elsif ($1 eq "\\")
	    {
		$ret .= "\\";
	    }
	    elsif ($1 eq "\"")
	    {
		$ret .= "\"";
	    }
	    else
	    {
		$ret .= $1;
	    }
	}
	elsif ($ycp_value =~ /^"(.*)/) #");
	{
	    return ($ret, "", $1);
	}
	elsif ($ycp_value =~ /^$/)
	{
	    return ("", "Unexpected end of input.", $ycp_value);
	}
	else
	{
	    #can't happen
	    return ("", "Can't happen in ParseYcpString", $ycp_value);
	}
    }
}

=head2 PathComponents

PathComponents $path_ref

 ($cmd, $path) = ParseCommand ('`Read (.foo."%gconf.d"."gernel")'
 @c = PathComponents (\$path);
 if ($c[0] eq '%gconf.d' && $c[1] eq "gernel") {...}

Converts a path (a string reference, L</PerlYCPValue>) to a list
of its components. It deals with the nontrivial parts of path syntax.
On error it returns undef.

 .			-> ()
 .foo.bar		-> ('foo', 'bar')
 ."foo"			-> ('foo')
 ."double\"quote"	-> ('double"quote')
 ."a.dot"		-> ('a.dot')

=cut

sub PathComponents ($)
{
    my $path_ref = shift;
    if (ref ($path_ref) ne "SCALAR") {
	y2error ("Expecting a reference to a scalar");
	return undef;
    }
    my $path = $$path_ref;

    return undef if $path eq "";
    return () if $path eq ".";

    my @result = ();

    while ($path =~ s/^\.(${lex_pathsegment})(.*)/$2/o) {
	my $segment = $1;
	if ($segment =~ /^"/) {
	    # FIXME check whether paths are like strings, unify
	    my ($parsed, $err, $rest) = ParseYcpString ($segment);
	    if ($err ne "") {
		y2error ("Bad complex path component: '$err'");
		return undef;
	    }
	    elsif ($rest ne "") {
		y2error ("Extra characters in path component: '$rest'");
		return undef;
	    }
	    $segment = $parsed;
	}
	push @result, $segment;
    }
    if ($path ne "") {
	y2error ("Extra characters in path: '$path'");
	return undef;
    }
    return @result;
}

# Internal
# Parses a YCP list. The input must start with "["
# A comma after the last element is permitted.
# Returns PerlYCPParserResult.
sub ParseYcpList ($)
{
    return ParseYcpGenericList (shift, "list", qr/\[/, qr/\]/);
}

# Internal
# Parses a term argument list. The input must start with "("
# A comma after the last element is permitted.
# Returns PerlYCPParserResult.
sub ParseYcpTermBody ($)
{
    return ParseYcpGenericList (shift, "term", qr/\(/, qr/\)/);
}

# Internal
# Parses a comma delimited list introduced by $open and terminated by $close.
# A comma after the last element is permitted.
# Returns PerlYCPParserResult.
sub ParseYcpGenericList ($$$$)
{
    my ($ycp_value, $description, $open, $close) = @_;
    my $ret = [];
    my $elem;
    my $err;

    #remove leading bracket and whitespace;
    if ($ycp_value !~ s/^$open\s*//)
    {
	return ("", "Expecting /$open/ in a $description",$ycp_value);
    }

    my $seen_comma = 0;
    my $seen_elem = 0;

    # if there's a bracket, eat it and return
    until ($ycp_value =~ s/^$close\s*//)
    {
	if ($seen_elem && ! $seen_comma)
	{
	    return ("", "Expecting /$close/ or a comma in a $description",$ycp_value);
	}

	($elem, $err, $ycp_value) = ParseYcp ($ycp_value);
	return ("", $err, $ycp_value) if $err;
	push @{$ret}, $elem;
	$seen_elem = 1;

	# skip spaces and comma
	$ycp_value =~ s/^\s*(,)?\s*//;
	$seen_comma = defined $1;
    }
    return ($ret, "", $ycp_value);
}

# Internal
# Parses a YCP map. The input must start with "$["
# A comma after the last element is permitted.
# Returns PerlYCPParserResult.
sub ParseYcpMap ($)
{
    my $ycp_value = shift;
    my $ret = {};
    my $key;
    my $value;
    my $err;

    #remove leading dollar-bracket and whitespace;
    $ycp_value =~ s/^\$\[\s*//;

    my $seen_comma = 0;
    my $seen_elem = 0;

    # if there's a bracket, eat it and return
    until ($ycp_value =~ s/^\]\s*//)
    {
	if ($seen_elem && ! $seen_comma)
	{
	    return ("", "Expecting a bracket or a comma in a map",$ycp_value);
	}

	($key, $err, $ycp_value) = ParseYcp ($ycp_value);
	return ("", $err, $ycp_value) if $err;

	# skip spaces, match a colon
	if ($ycp_value !~ s/^\s*:\s*//)
	{
	    return ("", "Expecting a colon in a map", $ycp_value);
	}

	($value, $err, $ycp_value) = ParseYcp ($ycp_value);
	return ("", $err, $ycp_value) if $err;

	$ret->{$key} = $value;
	$seen_elem = 1;

	# skip spaces and comma
	$ycp_value =~ s/^\s*(,)?\s*//;
	$seen_comma = defined $1;
    }
    return ($ret, "", $ycp_value);
}

# Internal
# Parses a YCP byteblock. The input must start with "#["
# Returns PerlYCPParserResult.
sub ParseYcpByteblock ($)
{
    my $ycp_value = shift;
    my $ret = "";
    my $err;

    #remove leading hash-bracket and whitespace;
    $ycp_value =~ s/^\#\[\s*//;

    # if there's a bracket, eat it and return
    until ($ycp_value =~ s/^\]\s*//)
    {
	if ($ycp_value =~ s/^(([[:xdigit:]][[:xdigit:]])+)(\s|\n)*//)
	{
	    $ret .= pack ('H*', $1);
	}
	else
	{
	    return ("", "Unexpected characters in byteblock",$ycp_value);
	}
    }
    return ($ret, "", $ycp_value);
}


################################################################################
#                         R E T U R N                                          #
################################################################################
# Function which return a ycp value to the calling YCP-Server

=head1 WRITING

=cut

# Autoflush output, otherwise the caller would not get the answer.
$| = 1;

=head2 Return

C<Return (["arbitrarily", "complex", "data"]);>

Sends a L</PerlYCPValue> to the partner YCP component.

If there's just one argment, scalars are interpreted this way:
"true" or "false" are sent as
booleans, integers or strings of digits are sent as integers, otherwise as
strings.
If a second argument exists and is true, all scalars are written as strings.
If a second argument exists and is false, all scalars are written as byteblocks.

To send a list, call Return(\@list), not Return(@list).
Similarly for a map. You can use references to anonymous lists [] and hashes {}.

The difference from L</ycpReturn> is that Return can return scalars directly,
strings are properly escaped if needeed and paths can be returned.

=cut

sub Return ($;$);
sub Return ($;$)
{
    my ($val, $quote_everything) = @_;

    my $reftype = ref ($val);
    if (! defined ($val))
    {
	print "(nil)";
    }
    elsif (! $reftype)
    {
	if (! defined $quote_everything)
	{
	    if ($val =~ /^(true|false|\s*-?\d+\s*)$/)
	    {
		print "($val)";
	    }
	    else
	    {
		print WriteYcpString($val);
	    }
	}
	elsif ($quote_everything)
	{
	    print WriteYcpString($val);
	}
	else
	{
	    print WriteYcpByteblock($val);
	}
    }
    elsif ($reftype eq "SCALAR")
    {
	# a path
	print "($$val)";
    }
    elsif ($reftype eq "ARRAY")
    {
	print "[";
	foreach my $elem (@$val)
	{
	    Return ($elem, $quote_everything);
	    print ","; # trailing comma is allowed
	}
	print "] "; # no "]:"
    }
    elsif ($reftype eq "HASH")
    {
	print "\$[";
	while (my ($key, $value) = each %$val)
	{
	    Return ($key, $quote_everything);
	    print ":";
	    Return ($value, $quote_everything);
	    print ","; # trailing comma is allowed
	}
	print "] "; # no "]:"
    }
    else
    {
	y2error ("Cannot pass $reftype to YCP");
	print "(nil)";
    }
}

# Internal
# Returns a properly escaped string.
# (Double quotes, backslashes and control characters are handled)
#
# 'qux'				-> '"qux"'
# 'with "quotes"'		-> '"with \"quotes\""'
sub WriteYcpString ($)
{
    my $string = shift;
    my @substrings = split /\\/, $string, -1;
    foreach my $substring (@substrings)
    {
	$substring =~ s/"/\\"/g;# escape quotes
	# escape control chars except newline (easier to debug a parse error)
	$substring =~ s/([\000-\011\013-\027])/sprintf "\\%03o",ord($1)/eg;
    }
    return '"'. join ("\\\\", @substrings) .'"';
}

# Internal
# Returns a byteblock.
sub WriteYcpByteblock ($)
{
    my $bb = shift;
    return "#[". unpack ("H*", $bb) ."] ";
}


################################################################################
#                         L O G G I N G                                        #
################################################################################

=head1 LOGGING

If you are running in the main yast process and thus can afford to import
YaST::YCP, it is better to use its logging functions because they use log.conf
and logging just works. In such case, you should not need to use ycp.pm at all.
Instead, C<use YaST::YCP (":LOGGING")>.

The log output can now be redirected, which will be useful for test suites.
If the first command-line option is "-l", the second argument is taken as
the log file. A hyphen "-" designates standard output.

Otherwise, F</var/log/YaST2/y2log> and F<$HOME/.y2log> are tried, in that order.

=cut

my $Y2DEBUG;
my $log_good;

# Constructor: open the log and set the two above variables
# so that y2logger has small overhead.
sub BEGIN
{
    $Y2DEBUG = $ENV{"Y2DEBUG"};

    my @names = ( "/var/log/YaST2/y2log", "$ENV{HOME}/.y2log" );
    if (defined ($ARGV[0]) && $ARGV[0] =~ /^(-l|--log)$/)
    {
	@names = ( $ARGV[1] );
    }

    foreach my $name (@names)
    {
	$log_good = open (LOG, ">>$name");
	if ($log_good)
	{
	    my $old_handle = select (LOG);
	    $| = 1;		# autoflush
	    select ($old_handle);
	    return;
	}
    }

    # no log?! cry to STDERR.
    print STDERR "Could not open log file: '", join("' nor '", @names), "'.\n";
}

sub END
{
    close LOG;
}

##--------------------------------------
# @perlapi y2debug
# Logs debug messages to /var/log/YaST2/y2log.
# Other then ycp-y2debug the output is <b>always</b> logt
# to /var/log/YaST2/y2log
# and usually you <b>have to root</b> to do this
# @example ..;  y2debug( "In the script: param1:", myarray, " param2: ", hash2 );
##--------------------------------------

=head2 y2debug

y2debug,
y2milestone,
y2warning,
y2error,
y2security,
y2internal

Logs debug messages to F</var/log/YaST2/y2log> or F<$HOME/.y2log>

Note a B<semantic change> in y2debug: now the environment variable
Y2DEBUG is honored so y2debug will not produce output unless this
variable is set. This is for compatibility with the logging system in libycp.

=cut

my $log_component = $0;		# use program name as the log component
$log_component =~ s:.*/::;	# strip path part

sub y2debug	{ y2logger (0, @_); }
sub y2milestone	{ y2logger (1, @_); }
sub y2warning	{ y2logger (2, @_); }
sub y2error	{ y2logger (3, @_); }
sub y2security	{ y2logger (4, @_); }
sub y2internal	{ y2logger (5, @_); }

# Internal
sub y2logger ($@)
{
    my $level = shift;
    if (!$log_good || ($level == 0 && ! defined ($Y2DEBUG)))
    {
	return;
    }

    my $tm = localtime;
    my $datestr = sprintf( "%04d-%02d-%02d %02d:%02d:%02d <%d> %s(%d) [%s]",
			   $tm->year+1900, $tm->mon+1, $tm->mday,
			   $tm->hour, $tm->min, $tm->sec,
			   $level, $hostname, $$, $log_component);

    print LOG "$datestr ", join(" ", @_), "\n";
}

##--------------------------------------
# @perlapi ycpDoVerboseLog
# Turns on verbose logging of this the perl interface lib
# Logging output is ALWAYS send to /var/log/YaST2/y2log
# and usually you <b>have to be root</b> to do this
# @example ..;  ycpDoVerboseLog;
##--------------------------------------

=head2 ycpDoVerboseLog

Enables output of y2verbose which is used in some of the obsolete functions.

=cut

sub ycpDoVerboseLog
{
   $verbose = 1;
}

# Internal
sub y2verbose
{
    if ( $verbose )
    {
	y2debug( @_ );
    }
}


################################################################################
# Old functions
################################################################################

=head1 OBSOLETE FUNCTIONS

=cut

#########################################
## Check type of the given Argument
#########################################
#

##--------------------------------------
# @perlapi ycpArgIsMap -> 0 or 1
# Checks, if the given argument is a map.
# requirements: a call of  ycpInit()
# @example if ( ycpArgIsMap ) \n { my %arg_hash =  ycpGetArgMap;  }
##--------------------------------------

=head2 ycpArgIsMap

Obsolete. Use (ref($arg) eq "HASH") instead.

=cut

sub ycpArgIsMap
{
   return( $ismap );
}


##--------------------------------------
# @perlapi ycpArgIsList -> 0 or 1
# Checks, if the given argument is a list.
# requirements: a call of  ycpInit()
# @example if ( ycpArgIsList ) \n { my @arg_array = ycpGetArgList;  }
##--------------------------------------

=head2 ycpArgIsList

Obsolete. Use (ref($arg) eq "ARRAY") instead.

=cut

sub ycpArgIsList
{
   return( $islist );
}

##--------------------------------------
# @perlapi ycpArgIsInteger -> 0 or 1
# Checks, if the given argument is a Integer.
# requirements: a call of  ycpInit()
# @example if ( ycpArgIsInteger ) \n { my $arg_int =  ycpGetArgInteger; }
##--------------------------------------

=head2 ycpArgIsInteger

Not really obsolete because the new parser simply treats
integers, booleans and strings as scalars. But who cares,
nobody used this anyway.

=cut

sub ycpArgIsInteger
{
   return( $isinteger );
}

##--------------------------------------
# @perlapi ycpArgIsString -> 0 or 1
# Checks, if the given argument is a String.
# requirements: a call of  ycpInit()
# @example if ( ycpArgIsString ) \n { my $new_string =  ycpGetArgString; }
##--------------------------------------

=head2 ycpArgIsString

Not really obsolete because the new parser simply treats
integers, booleans and strings as scalars. But who cares,
nobody used this anyway.

=cut

sub ycpArgIsString
{
   return( $isstring );
}

##--------------------------------------
# @perlapi ycpArgIsNil -> 0 or 1
# Checks, if the given argument is a nil.
# requirements: a call of  ycpInit()
# @example if ( ycpArgIsNil ) \n { ... }
##--------------------------------------

=head2 ycpArgIsNil

Obsolete. Use (ref($arg) eq "SCALAR" && $$arg eq "nil") instead.

=cut

sub ycpArgIsNil
{
   return( $isnil );
}

##--------------------------------------
# @perlapi ycpArgIsNone -> 0 or 1
# Checks, if the given argument is a None.
# requirements: a call of  ycpInit()
# @example if ( ycpArgIsNone ) \n { ... }
##--------------------------------------

=head2 ycpArgIsNone

Obsolete. Use (defined ($arg)) instead.

=cut

sub ycpArgIsNone
{
   return( $isnone );
}

##--------------------------------------
# @perlapi ycpCommandIsDir -> 0 or 1
# Checks, if the given command is a <tt>Dir</tt>.
# requirements: a call of  ycpInit()
# @example if ( ycpCommandIsDir ) \n { ... }
##--------------------------------------

=head2 ycpCommandIsDir

Obsolete. Use ($command eq "Dir")

=cut

sub ycpCommandIsDir
{
   return( $ycpcommand =~ /Dir/i );
}

##--------------------------------------
# @perlapi ycpCommandIsRead -> 0 or 1
# Checks, if the given command is a <tt>Read</tt>.
# requirements: a call of  ycpInit()
# @example if ( ycpCommandIsRead ) \n { ... }
##--------------------------------------

=head2 ycpCommandIsRead

Obsolete. Use ($command eq "Read")

=cut

sub ycpCommandIsRead
{
   return( $ycpcommand =~ /Read/i );
}

##--------------------------------------
# @perlapi ycpCommandIsWrite -> 0 or 1
# Checks, if the given command is a <tt>Write</tt>.
# requirements: a call of  ycpInit()
# @example if ( ycpCommandIsWrite ) \n { ... }
##--------------------------------------

=head2 ycpCommandIsWrite

Obsolete. Use ($command eq "Write")

=cut

sub ycpCommandIsWrite
{
   return( $ycpcommand =~ /Write/i );
}

##--------------------------------------
# @perlapi ycpCommandIsExecute -> 0 or 1
# Checks, if the given command is a <tt>Execute</tt>.
# requirements: a call of  ycpInit()
# @example if ( ycpCommandIsExecute ) \n { ... }
##--------------------------------------

=head2 ycpCommandIsExecute

Obsolete. Use ($command eq "Execute")

=cut

sub ycpCommandIsExecute
{
   return( $ycpcommand =~ /Execute/i );
}

##--------------------------------------
# @perlapi ycpCommandIsResult -> 0 or 1
# Checks, if the given command is a <tt>result</tt>.
# requirements: a call of  ycpInit()
# @example if ( ycpCommandIsResult ) \n { ... }
##--------------------------------------

=head2 ycpCommandIsResult

Obsolete. Use ($command eq "result"), note the lowercase 'r'.

=cut

sub ycpCommandIsResult
{
   return( $ycpcommand =~ /result/i );
}


########################################
# Return the argument, converted to perl
# datatype
########################################


##--------------------------------------
# @perlapi ycpGetCommand -> "Read" or "Write" or "Execute" or "Dir"
# Returns the current command.
# requirements: a call of  ycpInit()
##--------------------------------------

=head2 ycpGetCommand

Obsolete. Use the return value of L</ParseCommand>.

=cut

sub ycpGetCommand
{
   return( $ycpcommand );
}

##--------------------------------------
# @perlapi ycpGetPath -> <string>
# Returns the current <b>sub</b>path of the current call.
# If the script is mounted on <tt>.ping</tt> and the agent is called
# with <tt>.ping.suse</tt> the subpath is <tt>.suse</tt>
# requirements: a call of  ycpInit()
##--------------------------------------

=head2 ycpGetPath

Obsolete. Use the return value of L</ParseCommand>.

=cut

sub ycpGetPath
{
   return( $ycppath );
}

##--------------------------------------
# @perlapi ycpGetArgType -> <string>
# Returns the type of the current argument.
# At the moment "string", "integer", "list" and "map" are supported.
# requirements: a call of  ycpInit()
##--------------------------------------

=head2 ycpGetArgType

Obsolete. Use ref on a return value of L</ParseCommand>.

Umm, string/integer/boolean?

=cut

sub ycpGetArgType
{
   return( $type );
}

##--------------------------------------
# @perlapi ycpGetArgMap -> <hash>
# Returns the curren argument as a hash, if the argument was a map.
# Otherwise the return value is not defined.
# requirements: a call of  ycpInit()
# @example if ( ycpArgIsMap ) \n { my %arg_hash =  ycpGetArgMap;  }
##--------------------------------------

=head2 ycpGetArgMap

Obsolete. See L</PerlYCPValue>.

=cut

sub ycpGetArgMap
{
   return( %arghash );
}

##--------------------------------------
# @perlapi ycpGetArgList -> <array>
# Returns the current argument as an arry, if the argument was a list.
# Otherwise the return value is not defined.
# requirements: a call of  ycpInit()
# @example if ( ycpArgIsList ) \n { my @arg_array =  ycpGetArgList;  }
##--------------------------------------

=head2 ycpGetArgList

Obsolete. See L</PerlYCPValue>.

=cut

sub ycpGetArgList
{
   return( @argarray );
}

##--------------------------------------
# @perlapi ycpGetArgString -> <string>
# Returns the current argument as a string, if the argument was a string
# Otherwise the return value is not defined.
# requirements: a call of  ycpInit()
# @example if ( ycpArgIsString ) \n { my $arg_string =  ycpGetArgString;  }
##--------------------------------------

=head2 ycpGetArgString

Obsolete. See L</PerlYCPValue>.

=cut

sub ycpGetArgString
{
   return( $argskalar );
}

##--------------------------------------
# @perlapi ycpGetArgInteger -> <integer>
# Returns the current argument as an integer, if the argument was an integer
# Otherwise the return value is not defined.
# requirements: a call of  ycpInit()
# @example if ( ycpArgIsInteger ) \n { my $arg_string =  ycpGetArgInteger;  }
##--------------------------------------

=head2 ycpGetArgInteger

Obsolete. See PerlYCPValue.

Umm, string/integer/boolean?

=cut

sub ycpGetArgInteger
{
   return( $argskalar );
}


# OBSOLETE WRITING


##--------------------------------------
# @perlapi ycpReturnSkalarAsInt
# Sends a scalar as a YCP-Integer to the calling server, the SCR
# Attention: It is very important to send in <b>ANY</b> case
# exactly one YCP value to the server. So you must take care, that
# for every call of the server, your script calls exactly one ycpReturn<..>
# function-
# @example ycpReturnSkalarAsInt( 17 ) -> Returns a
##--------------------------------------

=head2 ycpReturnSkalarAsInt

Obsolete. Use L</Return>.

=cut

sub ycpReturnSkalarAsInt( $ )
{
    my ( $entry ) = @_;

    printf( "(%d)", $entry );
}

##--------------------------------------
# @perlapi ycpReturnSkalarAsBoolean
# Sends a scalar as a YCP-Boolean to the calling server, the SCR
# Attention: It is very important to send in <b>ANY</b> case
# exactly one YCP value to the server. So you must take care, that
# for every call of the server, your script calls exactly one ycpReturn<..>
# function-
# @example ycpReturnSkalarAsBoolean( 1 ) -> Returns a true
# @example ycpReturnSkalarAsBoolean( 0 ) -> Returns a false
##--------------------------------------

=head2 ycpReturnSkalarAsBoolean

Obsolete. Use L</Return>("true" or "false")

=cut

sub ycpReturnSkalarAsBoolean( $ )
{
    my ( $entry ) = @_;

    printf( "(%s)", $entry ? "true" : "false");
}

##--------------------------------------
# @perlapi ycpReturnSkalarAsString
# Sends a scalar as a YCP-String to the calling server, the SCR
# Attention: It is very important to send in <b>ANY</b> case
# exactly one YCP value to the server. So you must take care, that
# for every call of the server, your script calls exactly one ycpReturn<..>
# function
# @example ycpReturnSkalarAsString( "ok" )
##--------------------------------------

=head2 ycpReturnSkalarAsString

Obsolete. Works only on strings not containing backslashes and quotes
that would need escaping.

Use L</Return>.

=cut

sub ycpReturnSkalarAsString( $ )
{
    my ( $entry ) = @_;
    y2verbose( "assk: ", $entry );
    printf( "(\"%s\")", $entry );
}

##--------------------------------------
# @perlapi ycpReturnArrayAsList
# Sends a array as a YCP-List to the calling server, the SCR
# Attention: It is very important to send in <b>ANY</b> case
# exactly one YCP value to the server. So you must take care, that
# for every call of the server, your script calls exactly one ycpReturn<..>
# function
# @example my @array = ( 1,2,3); ycpReturnSkalarAsString( array )
##--------------------------------------

=head2 ycpReturnArrayAsList

Obsolete. Works only on list of strings not containing backslashes and quotes
that would need escaping.

Use L</Return>.

=cut

sub ycpReturnArrayAsList( @ )
{
    my ( @entry ) = @_;

    # starting the List
    printf ( "[ " );

    if ( @entry > 0 )
    {
	printf( "\"%s\"", shift( @entry ));

	foreach my $elem ( @entry )
	{
	   printf( ", \"%s\"", $elem);
	}
    }

    # end of list
    printf ( " ] " ); # no "]:"
}


##--------------------------------------
# @perlapi ycpReturnHashAsMap
# Sends a hash as a YCP-List to the calling server, the SCR
# Attention: It is very important to send in <b>ANY</b> case
# exactly one YCP value to the server. So you must take care, that
# for every call of the server, your script calls exactly one ycpReturn<..>
# function
# @example my %myhash; ...; ycpReturnSkalarAsString( myhash );
##--------------------------------------

=head2 ycpReturnHashAsMap

Obsolete. Works only on maps of strings not containing backslashes and quotes
that would need escaping.

Use L</Return>.

=cut

sub ycpReturnHashAsMap
{
    my ( %entry ) = @_;

    my $first = 1;

    # starting the Map
    printf ( " \$\[ " );


    foreach my $key (keys (%entry))
    {
	if ( $first )
	{
	    $first = 0;
	}
	else
	{
	    printf( ", " );
	}

	printf( "\"%s\":\"%s\"", $key, $entry{$key});
    }

    printf ( " ] " ); # no "]:"
}


##--------------------------------------
# @perlapi ycpReturnSkalarAsIntSub
# Private function to return a ycp-formatted int.
##--------------------------------------

sub ycpReturnSkalarAsIntSub( $ )
{
    my ( $entry ) = @_;

    return sprintf( "(%d)", $entry );
}

##--------------------------------------
# @perlapi ycpReturnSkalarAsBooleanSub
# Private function to return a ycp-formatted boolean.
##--------------------------------------

sub ycpReturnSkalarAsBooleanSub( $ )
{
    my ( $entry ) = @_;

    return sprintf( "(%s)", $entry ? "true" : "false");
}



##--------------------------------------
# @perlapi ycpReturnSkalarAsStringSub
# Private function to return a ycp-formatted string.
##--------------------------------------

sub ycpReturnSkalarAsStringSub( $ )
{
    my ( $entry ) = @_;
    y2verbose( "assk: ", $entry );
    return sprintf( "(\"%s\")", $entry );
}


##--------------------------------------
# @perlapi ycpReturnArrayAsListSub
# Sends a array as a YCP-List to the calling server, the SCR
# Attention: It is very important to send in <b>ANY</b> case
# exactly one YCP value to the server. So you must take care, that
# for every call of the server, your script calls exactly one ycpReturn<..>
# function
# @example my @array = ( 1,2,3); ycpReturnSkalarAsString( array )
##--------------------------------------

sub ycpReturnArrayAsListSub( @ )
{
    my ( @entry ) = @_;
    my $ret;

    # starting the List
    $ret =  "[ ";

    if ( @entry > 0 )
    {
	$ret .= sprintf( "\"%s\"", shift( @entry ));

	foreach my $elem ( @entry )
	{
	   $ret .= sprintf( ", \"%s\"", $elem);
	}
    }

    # end of list
    $ret .= " ] "; # no "]:"
    return $ret;
}

##--------------------------------------
# @perlapi ycpReturn
# sends a complex data structure to the calling server, the SCR.
# Attention: It is very important to send in <b>ANY</b> case
# exactly one YCP value to the server. So you must take care, that
# for every call of the server, your script calls exactly one ycpReturn<..>
# function
# The complex data structure is build in perl using references. A perl array
# is transformed to a ycp list, a perl hash will become a ycp map and a scalar
# will be a simple string, integer or boolean.
# This function takes one refernce to one of the mentioned data
# types. It easily can be a refernce to a tree of refernces to all valid data types.
# For example: To build a map, containing a list, in perl, you do:
#
# @example my @list_of_values = ( 'l1', 'l2', 'l3', 'l4' );
# @example my %maphash = { "key1" => "value1", "key2" => \@list_of_values };
# @example ycpReturn( \%maphash );
##--------------------------------------

=head2 ycpReturn

Obsolete. Use L</Return>

=cut

sub ycpReturn
{
    print ycpReturnSub(@_);
}

##--------------------------------------
# @perlapi ycpReturnSub
# private function to provide the functionality for ycpReturn
##--------------------------------------
sub ycpReturnSub
{
    my ($itemref) = @_;
    my $ret = "";
    unless( ref($itemref) ) {
	# Error: Not a reference at all !
	# Was tun ?
	return "[] "; # no "]:"
    }

    if( ref( $itemref ) eq "SCALAR" )
    {
	$ret = formatItem( $$itemref );
    }
    elsif( ref( $itemref ) eq "ARRAY" )
    {
	my $docomma = 0;
	my $list = "[ ";
	foreach my $item ( @$itemref )
	{
	    my $append = "";
	    if( $docomma ) {
		$append .= ", ";
	    } else {
		$docomma = 1;
	    }

	    if( ref( $item ) )
	    {
		$append .= &ycpReturnSub( $item );
	    }
	    else
	    {
		$append .= formatItem( $item );
	    }
	    $list .= $append;
	}
	$list .= " ] "; # no "]:"
	$ret = $list;
    }
    elsif( ref( $itemref ) eq "HASH" )
    {
	my $docomma = 0;
	$ret = "\$\[ ";
	my $oneMapItem;
	while ( my ($key, $value) = each %$itemref )
	{
	    if( ref( $key ) )
	    {
		# Error - darf keine referenz sein, oder ?
	    }
	    else
	    {
		if( $docomma )
		{
		    $ret .= ", ";
		}
		else
		{
		    $docomma = 1;
		}

		$oneMapItem = formatItem( $key ) . ":";
		my $expanded = "";
		if( ref( $value ) )
		{
		    $expanded = &ycpReturnSub( $value );
		}
		else
		{
		    $expanded = formatItem( $value );
		}
		$oneMapItem .= $expanded;
	    }
	    $ret .= $oneMapItem;
	}
	$ret .= " \] "; # no "]:"
    }
    return $ret;
}

##--------------------------------------
# @perlapi formatItem
# private function that formats exactly one item according to it's type.
# It handles boolean, integers and Strings.
# needed by ycpReturn, this function is not exported.
##--------------------------------------
sub formatItem( $ )
{
    my ($item) = @_;

    # Format boolean, must be true or false literally.
    if( $item =~ /true|false/i )
    {
	return sprintf( "%s", lc $item );
    }

    # Format integers
    if( $item =~ /^\s*\d+\s*$/ )
    {
	return( sprintf( "%d", $item ) );
    }

    # Format strings
    return( sprintf( "\"%s\"", $item ));
}


# OBSOLETE PARSING

##############################
# String or Integer or Boolean to Skalar
##############################

sub ycpSIBtoSkalar
{
    my ( $entry ) = @_;
    if( $entry =~ /^\s*\$\[.*\]\s*$/ )
    {
	# It is unintentional a map -> not handled yet -> TODO
	$entry = "Unhandled";
    }
    elsif ( $entry =~ /^\s*\"(.*)\"\s*$/ )
    {
	# "
	$entry = $1;
    }
    else
    {
	if ( $entry =~ /^\s+(.*)$/ )
	{
	    $entry = $1;
	}
	if ( $entry =~ /^(.*?)\s+$/ )
	{
	    $entry = $1;
	}

    }

    return( $entry );
}

sub ycpmap
{
    my @input = @_;

    chop @input if( $input[0] =~ /\n$/ );

    my $wholeline = join( "", @input );

    my %result;

    if( $wholeline =~ /^\s*\$\[(.+)\]\s*$/ )
    {
	my $mapcont = $1;
	# Killing all lists etc inside the map. TODO !!!!
	$mapcont =~ s/\$\[.+\]//g;

	my @mapentries = split( /\s*,\s*/, $mapcont );

	foreach my $mentry ( @mapentries )
	{
	    if( $mentry =~ /(.+?):(.+)$/ )
	    {
		# " fill the hash
		my $key = ycpSIBtoSkalar($1);
		my $val = ycpSIBtoSkalar($2);
		$result{$key} = $val;

		y2verbose( "new hashentry key:-$key- Value:-$val- ");
	    }
	}
    }
    return( %result );
}

sub ycplist
{
    my @input = @_;

    chop @input if( $input[0] =~ /\n$/ );
    my $wholeline = join( "", @input );

    my @result;

    if( $wholeline =~ /^\s*\[(.+)\]\s*$/ )
    {
	my $mapcont = $1;

	my @mapentries = split( /\s*,\s*/, $mapcont );

	foreach my $mentry ( @mapentries )
	{
	    $mentry = ycpSIBtoSkalar( $mentry );

	    push( @result, $mentry );
	    y2verbose( "listentry: -$mentry-");
	}

	@result = @mapentries;
    }
    return( @result );
}

##--------------------------------------
# @perlapi ycpInit
# Initializes a call of the server. Therefor this function reads a YCP Value
# from <tt>stdin</tt>. To use this value, call the convenice functions:
# ycpArgIs<..>, ycpGetArg<..>, ycpCommandIs<..>, ycpGetCommand, ycpGetPath
# As parameter, you have to insert $_
# @example ycpInit( $_ );
##--------------------------------------

=head2 ycpInit

Obsolete. Use L</ParseCommand>.

=cut

sub ycpInit
{
    my @input = @_;

    chop @input if( $input[0] =~ /\n$/ );

    my $wholeline = join( "", @input );

    y2verbose( "call: <", $wholeline, ">" );

    my %result;

    if( $wholeline =~ /^(.*)\((.*?),(.*)\)\s*$/)
    {
	y2verbose( "work: <", $wholeline, ">" );

	$ycpcommand    = $1;
	$ycppath       = $2;
	my $parameter  = $3;

	y2verbose( "com:", $ycpcommand, " path:", $ycppath, " param:", $parameter);

	$type     = "unknown";

	$ismap     = 0;
	$islist    = 0;
	$isinteger = 0;
	$isstring  = 0;
	$isknown   = 0;
	$isnil     = 0;
	$isnone    = 0;


	# is a map?
	if( $parameter =~ /^\s*\$\[.*\]\s*$/ )
	{
	    y2verbose( "Is a map", $parameter );
	    %arghash  = ycpmap(  $parameter );
	    $ismap    = 1;
	    $type     = "map";
	}

	# is a list?
	elsif( $parameter =~ /^\s*\[.*\]\s*$/ )
	{
	    y2verbose(   "Is a list", $parameter);
	    @argarray  = ycplist( $parameter );
	    $islist    = 1;
	    $type      = "list";
	}

	# is a integer?
	elsif( $parameter =~ /^\s*([0-9]+)\s*$/ )
	{
	    y2verbose(   "Is a integer", $parameter);
	    $argskalar = $1;
	    $isinteger = 1;
	    $type      = "integer";
	}

	# is a string?
	elsif( $parameter =~ /^\s*\"(.*)\"\s*$/ )
	{
	    y2verbose(   "Is a string", $parameter);
	    $argskalar = $1;
	    $isstring  = 1;
	    $type      = "string";
	}

	# is a string?
	elsif( $parameter =~ /^\s*nil\s*$/ )
	{
	    y2verbose(   "Is a nil", $parameter);
	    $isnil     = 1;
	    $type      = "nil";
	}
	else
	{
	    $isknown = 1;
	    $type    = "unknown";
	}
    }
    elsif ($wholeline =~ /^(.*)\((.*?)\)\s*$/) {

	y2verbose( "work: <", $wholeline, ">" );

	$ycpcommand    = $1;
	$ycppath       = $2;

	y2verbose( "com:", $ycpcommand, " path:", $ycppath, " param: none" );

	$type     = "unknown";

	$ismap     = 0;
	$islist    = 0;
	$isinteger = 0;
	$isstring  = 0;
	$isknown   = 0;
	$isnil     = 0;
	$isnone    = 1;

    }
    return( %result );
}

1;

################################## EOF ########################################
