home *** CD-ROM | disk | FTP | other *** search
- ########################################################################
- #
- # #
- # __ __ ____ _____ ____ #
- # \ \ / /_ _/ ___|_ _|___ \ #
- # \ 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 ########################################
-