Ycp.pm

   1 # $Id$
   2 #
   3
   4 # ------------------------------------------------------------------
   5 #
   6 #    Copyright (C) 2002-2005 Novell/SUSE
   7 #
   8 #    This program is free software; you can redistribute it and/or
   9 #    modify it under the terms of version 2 of the GNU General Public
  10 #    License published by the Free Software Foundation.
  11 #
  12 # ------------------------------------------------------------------
  13
  14 package Immunix::Ycp;
  15
  16 use strict;
  17 use warnings;
  18 #use Data::Dumper;
  19
  20 require Exporter;
  21 our @ISA    = qw(Exporter);
  22 our @EXPORT = qw(y2milestone y2debug ParseCommand Return ycpReturn ycpReturnSkalarAsString ycpReturnHashAsMap ycpGetCommand ycpGetArgType);
  23
  24 sub y2milestone {
  25
  26         my $mesg = shift;
  27         my $logFile = '/var/log/YaST2/imx-log';
  28
  29         if ( open(LOG, ">>$logFile") ) {
  30                 my $date = localtime;
  31                 print LOG "$date: $mesg\n";
  32                 close LOG;
  33         }
  34
  35 }
  36
  37 sub y2error {
  38
  39         my $mesg = shift;
  40         my $logFile = '/var/log/YaST2/imx-errors';
  41
  42         if ( open(LOG, ">>$logFile") ) {
  43                 my $date = localtime;
  44                 print LOG "$date: ERROR: $mesg\n";
  45                 close LOG;
  46         }
  47 }
  48
  49 sub y2debug {
  50
  51         my $mesg = shift;
  52         my $logFile = '/var/log/YaST2/imx-debug';
  53
  54         if ( open(LOG, ">>$logFile") ) {
  55                 my $date = localtime;
  56                 print LOG "$date: DEBUG: $mesg\n";
  57                 close LOG;
  58         }
  59 }
  60
  61 sub ycpGetCommand { }
  62 sub ycpGetArgType { }
  63
  64 sub perlToYcp {
  65
  66   my $ref = shift;
  67
  68   my $string;
  69
  70   if(ref($ref) eq "HASH") {
  71     $string = '$[';
  72     for my $key (keys %$ref) {
  73       if($key =~ m/^\d+$/) {
  74         $string .= "$key:" . perlToYcp($ref->{$key}) . ",";
  75       } else {
  76         $string .= "\"$key\":" . perlToYcp($ref->{$key}) . ",";
  77       }
  78     }
  79     $string .= '] ';
  80   } elsif(ref($ref) eq "ARRAY") {
  81     $string = '[';
  82     for my $element (@$ref) {
  83       $string .= perlToYcp($element) . ',';
  84     }
  85     $string .= '] ';
  86   } elsif(defined $ref) {
  87
  88     if($ref =~ m/^(true|false|nil|\d+)$/) {
  89       $string = "$ref";
  90     } else {
  91       $string = "\"$ref\"";
  92     }
  93   } else {
  94     $string = "nil";
  95   }
  96   return $string;
  97 }
  98
  99 sub Return {
 100   my $data = shift;
 101
 102   return ycpReturn($data);
 103 }
 104
 105 sub ycpReturn {
 106   my $data = shift;
 107
 108   my $string;
 109   if(ref($data)) {
 110     $string = perlToYcp($data);
 111   } else {
 112     $string = "(" . perlToYcp($data) . ")";
 113   }
 114   $| = 1;
 115   print $string;
 116 }
 117
 118 sub ycpReturnHashAsMap {
 119   my %hash = @_;
 120
 121   return ycpReturn(\%hash);
 122 }
 123
 124 sub ycpReturnSkalarAsString {
 125   my $scalar = shift;
 126
 127   return ycpReturn($scalar);
 128 }
 129
 130 #my $data = { foo => [ "one", "two", "three" ], bar => "foobar" };
 131 #my $data = [ "foo", [ "one", "two", "three" ], "bar", "foobar" ];
 132 #Return($data);
 133
 134 sub ycpToPerl {
 135   my $string = shift || "";
 136
 137   my $original_string = $string;
 138
 139   my @stack = ( "TOPOFSTACK" );
 140
 141   my $tree;
 142   my $where;
 143   my $key = "";
 144
 145   # strip leading whitespace
 146   $string =~ s/^\s+//;
 147   # strip trailing comma or whitespace if they exist
 148   $string =~ s/,?\s*$//;
 149
 150   while($string) {
 151     if($string =~ s/^\$\[//s) {                          # beginning of a hash
 152
 153       # create a new hash ref
 154       my $hash = { };
 155
 156       # insert it into the tree at our current location
 157       if(not $tree) {
 158         # if tree hasn't been set up yet, create it now as a hash
 159         $tree = $hash;
 160         $where = $tree;
 161       } elsif(ref($where) eq "ARRAY") {
 162         push @$where, $hash;
 163       } elsif(ref($where) eq "HASH") {
 164         if($key) {
 165           $where->{$key} = $hash;
 166         } else {
 167           die  "ERROR: trying to insert hash value without a key: $_";
 168         }
 169       } else {
 170         die "ERROR: clowns ate my brain: $_";
 171       }
 172
 173       # zero out out the key for the new hash...
 174       $key = "";
 175
 176       # push the parent onto the stack
 177       push @stack, $where;
 178
 179       # our new "current" location is the newly created hash
 180       $where = $hash;
 181
 182     } elsif($string =~ s/^\[//s) {                     # beginning of an array
 183
 184       # create a new array ref
 185       my $array = [ ];
 186
 187       # insert it into the tree at our current location
 188       if(not $tree) {
 189         # if tree hasn't been set up yet, create it now as an array
 190         $tree = $array;
 191         $where = $tree;
 192       } elsif(ref($where) eq "ARRAY") {
 193         push @$where, $array;
 194       } elsif(ref($where) eq "HASH") {
 195         if($key) {
 196           $where->{$key} = $array;
 197         } else {
 198           die "ERROR: trying to insert hash value without a key: $_";
 199         }
 200       } else {
 201         die "ERROR: Can't identify var for translation: $_";
 202       }
 203
 204       $key = "";
 205
 206       # push the parent onto the stack
 207       push @stack, $where;
 208
 209       # our new "current" location is the newly created array
 210       $where = $array;
 211
 212     } elsif($string =~ s/^(true|false|nil)(?=[,:\]])//s) {            # true/false
 213       my $value = $1;
 214
 215       my $realvalue;
 216       $realvalue = 1     if $value eq "true";
 217       $realvalue = 0     if $value eq "false";
 218       $realvalue = undef if $value eq "nil";
 219
 220       # shove it into the right place
 221       if(ref($where) eq "HASH") {
 222         if($key) {
 223           $where->{$key} = $realvalue;
 224           $key = "";
 225         } else {
 226           $key = $value;
 227         }
 228       } elsif(ref($where) eq "ARRAY") {
 229         push @$where, $realvalue;
 230       } else {
 231         die "ERROR: awoooga!  awooooga!: $string";
 232       }
 233     } elsif($string =~ s/^"([^"]*)"//s) {            # normal string
 234       my $value = $1;
 235
 236       # shove it into the right place
 237       if(not $tree) {
 238         $tree = $value;
 239       } elsif(ref($where) eq "HASH") {
 240         if($key) {
 241           $where->{$key} = $value;
 242           $key = "";
 243         } else {
 244           $key = $value;
 245         }
 246       } elsif(ref($where) eq "ARRAY") {
 247         push @$where, $value;
 248       } else {
 249         die "ERROR: dogs don't know it's not bacon: $string";
 250       }
 251     } elsif($string =~ s/^(\d+)(?=[,:\]])//s) {               # normal integer
 252       my $value = $1;
 253
 254       # shove it into the right place
 255       if(ref($where) eq "HASH") {
 256         if($key) {
 257           $where->{$key} = $value;
 258           $key = "";
 259         } else {
 260           $key = $value;    # ??? - can we use a bare integer as a hash key?
 261         }
 262       } elsif(ref($where) eq "ARRAY") {
 263         push @$where, $value;
 264       } else {
 265         die "ERROR: one by one the penguins steal my sanity: $string";
 266       }
 267     } elsif($string =~ s/^\]//) {
 268       # hit the end of this containing block, move back up a level
 269       $where = pop @stack;
 270       if($where eq "TOPOFSTACK") {
 271         die "ERROR: popped off top of stack: $string";
 272       }
 273     } else {
 274       y2error("ERROR: failed to parse: '$original_string'");
 275       die "ERROR: failed to parse: '$original_string'";
 276     }
 277
 278     # strip trailing : or , and any whitespace
 279     $string=~ s/^[,:]\s*//s;
 280   }
 281
 282   if(pop(@stack) ne "TOPOFSTACK") {
 283     die "ERROR: stack depth mismatch";
 284   }
 285
 286   return $tree;
 287 }
 288
 289 sub ParseCommand {
 290   my $string = shift;
 291
 292   chomp $string;
 293   my $original_string = $string;
 294
 295   if($string=~ m/^`?(\S+)\s*\((.+)\)\s*$/) {
 296     my ($cmd, $params) = ($1, $2);
 297
 298     if($params =~ m/^(\.\S*),\s*(.+)\s*$/) {
 299       my ($path, $args) = ($1, ycpToPerl($2));
 300
 301       return ($cmd, $path, $args);
 302     } elsif($params =~ m/^(\.\S*)$/) {
 303       my $path = $1;
 304
 305       return ($cmd, $path, "");
 306     } elsif($cmd eq "result" && $params eq "nil") {
 307       return ($cmd, "", "");
 308     } elsif($params eq "") {
 309       return ($cmd, "", "");
 310     } else {
 311       die "ERROR: failed to parse params: $params - $original_string\n";
 312     }
 313   } else {
 314     die "ERROR: failed to parse command: $string";
 315   }
 316
 317 }
 318
 319
 320 #my $foo = ycpToPerl('$["one":"1one", "two":"2two", "three":["foo", $["holy":"catfish", "bacon":"cheese"], "baz"]]');
 321
 322 #my ($ycommand, $ypath, $yargument) = ParseCommand('Read(.foobar, $["one":"1one", "two":"2two", "three":["foo", $["holy":"catfish", "bacon":false], "baz"]])');
 323
 324 #print Data::Dumper->Dump([$ycommand, $ypath, $yargument], [qw(*ycommand *ypath *yargument)]);
 325 #print Data::Dumper->Dump([$foo]);
 326
 327 1;
 328