#! /usr/perl5/bin/perl -w
#
# ident   "@(#)RecDescentParser.pm 1.1     03/11/27 SMI"
# 
# Copyright 2003 Sun Microsystems, Inc.  All rights reserved.
# Use is subject to license terms.
#

#
# Module: ScSnapshot::RecDescentParser
#
# Subclasses the generated ScSnapshot::RecDescentParser::GeneratedParser in
# order to add some utility routines used for filling in the Internal Data 
# Representation while parsing the CCR data.
#

package ScSnapshot::RecDescentParser;
use strict; 
use ScSnapshot::GeneratedParser;

# Inheritance declaration
@ScSnapshot::RecDescentParser::ISA = qw(ScSnapshot::GeneratedParser Parse::RecDescent);

# Enable warnings within the Parse::RecDescent module.
$::RD_ERRORS = 1; # Make sure the parser dies when it encounters an error
$::RD_WARN   = 1; # Enable warnings. This will warn on unused rules.
$::RD_HINT   = 1; # Give out hints to help fix problems.
if($ENV{DEBUG_ACTIVATE_RECPARSER_TRACE}) {
  $::RD_TRACE  = 1; # Activate trace : very verbose
}
if($ENV{DEBUG_ACTIVATE_LINE_COUNT}) {
  $::DBG_LINE_COUNT = 1;
}

# Parser subroutines (called from the grammar's action blocks)
# ------------------------------------------------------------

#
# Fills ins a resource type name definition
# 
# Arguments:
# - The resource type name
#
sub _rtname {
  my $self = shift;
  push(@{$self->data()->{rtdefs}}, { 'name' => $_[0]});
}

#
# Fills in a resource type attribute definition.
#
# Arguments:
# - A string containing the attribute name
# - The value assigned to such attribute
#
sub _rtattribute {
  my $self = shift;
  $self->debug_ppc($_[0],$_[1]);
  my $rtdef = $self->data()->{rtdefs}->[$#{$self->data()->{rtdefs}}];
  $rtdef->{$self->_name($self->_extractname($_[0]))} = 
    (($_[1] eq $Parse::RecDescent::skip)?"":$self->_value($_[1])); 
}

#
# Fills in a resource type attribute definition. Specific function for
# list attribute: space are replaced with comma.
# 
# Arguments:
# - A string containing the attribute name
# - Attribute value
#
sub _rtlistattribute {
  my $self = shift;
  $self->debug_ppc($_[0],$_[1]);
  my $rtdef = $self->data()->{rtdefs}->[$#{$self->data()->{rtdefs}}];
  $rtdef->{$self->_name($self->_extractname($_[0]))} = 
    (($_[1] eq $Parse::RecDescent::skip)?"":$self->_tolist($self->_value($_[1]))); 
}

#
# Fills in a resource type method definition.
#
# Arguments:
# - A string containg the resource type method defintion name
# - Associated value
sub _rtmethod {
  my $self = shift;
  $self->debug_ppc($_[0],$_[1]);
  my $rtdef = $self->data()->{rtdefs}->[$#{$self->data()->{rtdefs}}];
  $rtdef->{methods}->{$self->_name($self->_extractname($_[0]))} = 
    (($_[1] eq $Parse::RecDescent::skip)?"":$self->_value($_[1])); 
}

#
# Create a new resource type parameter definition
#
# Arguments:
# - The name of the resource parameter to create
#
sub _rtparamname {
  my $self = shift;
  my $rtdef=$self->data()->{rtdefs}->[$#{$self->data()->{rtdefs}}];
  push(@{$rtdef->{params}}, { 'name' => $self->_name($_[0])});
}

#
# Fills in a resource type parameter attribute definition.
#
sub _rtparamattribute {
  my $self = shift;
  $self->debug_ppc($_[0],$_[1]);
  my $rtdef = $self->data()->{rtdefs}->[$#{$self->data()->{rtdefs}}];
  my $paramdef = $rtdef->{params}->[$#{$rtdef->{params}}];
  $paramdef->{$self->_name($self->_extractname($_[0]))} = 
    (($_[1] eq $Parse::RecDescent::skip)?"":$self->_value($_[1])); 
}

#
# Create a new resource group definition.
#
# Arguments:
# - The name of the resource group to create
#
sub _rgname {
  my $self = shift;
  push(@{$self->data()->{rgdefs}}, { 'name' => $_[0]});
}

#
# Fills in a resource group attribute definition.
#
sub _rgattribute {
  my $self = shift;
  $self->debug_ppc($_[0],$_[1]);
  my $rgdef = $self->data()->{rgdefs}->[$#{$self->data()->{rgdefs}}];
  $rgdef->{$self->_name($self->_extractname($_[0]))} = 
    (($_[1] eq $Parse::RecDescent::skip)?"":$self->_value($_[1])); 
}

#
# Fills in a resource group list attribute definition.
#
sub _rglistattribute {
  my $self = shift;
  $self->debug_ppc($_[0],$_[1]);
  my $rgdef = $self->data()->{rgdefs}->[$#{$self->data()->{rgdefs}}];
  $rgdef->{$self->_name($self->_extractname($_[0]))} = 
    (($_[1] eq $Parse::RecDescent::skip)?"":$self->_tolist($self->_value($_[1]))); 
}

#
# Fills in a resource attribute definition.
#
sub _rgresourceattribute {
  my $self = shift;
  $self->debug_ppc($_[0],$_[1]);
  my $rgdef = $self->data()->{rgdefs}->[$#{$self->data()->{rgdefs}}];
  my $resourcedef = $rgdef->{resources}->[$#{$rgdef->{resources}}];   
  $resourcedef->{$self->_name($self->_extractname($_[0]))} = 
    (($_[1] eq $Parse::RecDescent::skip)?"":$self->_value($_[1])); 
}

#
# Fills in a resource list attribute definition. 
#
sub _rgresourcelistattribute {
  my $self = shift;
  $self->debug_ppc($_[0],$_[1]);
  my $rgdef = $self->data()->{rgdefs}->[$#{$self->data()->{rgdefs}}];
  my $resourcedef = $rgdef->{resources}->[$#{$rgdef->{resources}}];   
  $resourcedef->{$self->_name($self->_extractname($_[0]))} = 
    (($_[1] eq $Parse::RecDescent::skip)?"":$self->_tolist($self->_value($_[1]))); 
}

#
# Create a new resource entry.
#
# Arguments:
# - The name of the resource to create
#
sub _rgresourcename {
  my $self = shift;
  my $rgdef=$self->data()->{rgdefs}->[$#{$self->data()->{rgdefs}}];
  push(@{$rgdef->{resources}}, { 'name' => $_[0]});
}

#
# Fills in a resource property name definition.
#
sub _rgresourcepropertyname {
  my $self = shift;
  $self->debug_ppc($_[0],$_[1]);
  my $rgdef=$self->data()->{rgdefs}->[$#{$self->data()->{rgdefs}}];
  my $resourcedef = $rgdef->{resources}->[$#{$rgdef->{resources}}];
  push(@{$resourcedef->{properties}}, {'name' => $self->_name($_[0]) });
}

#
# Fills in a resource property attribute definition.
#
sub _rgresourcepropertyattribute {
  my $self = shift;
  $self->debug_ppc($_[0],$_[1]);
  my $rgdef = $self->data()->{rgdefs}->[$#{$self->data()->{rgdefs}}];
  my $resourcedef = $rgdef->{resources}->[$#{$rgdef->{resources}}];
  my $propertydef = 
    $resourcedef->{properties}->[$#{$resourcedef->{properties}}];
  $propertydef->{$self->_name($self->_extractname($_[0]))} = 
    (($_[1] eq $Parse::RecDescent::skip)?"":$self->_value($_[1])); 
}

#
# Fills in a resource property attribute definition. List
#
sub _rgresourcepropertylistattribute {
  my $self = shift;
  $self->debug_ppc($_[0],$_[1]);
  my $rgdef = $self->data()->{rgdefs}->[$#{$self->data()->{rgdefs}}];
  my $resourcedef = $rgdef->{resources}->[$#{$rgdef->{resources}}];
  my $propertydef = 
    $resourcedef->{properties}->[$#{$resourcedef->{properties}}];
  $propertydef->{$self->_name($self->_extractname($_[0]))} = 
    (($_[1] eq $Parse::RecDescent::skip)?"":$self->_tolist($self->_value($_[1]))); 
}


# Utility routines
# ----------------

#
# Extract name coming from parser by removing the last character 
#
# Arguments:
# - The string to be formatted
#
# Returns:
# - The formated string
#
sub _extractname {
  my $self = shift;
  return substr($_[0], 0, -1);
}

#
# Formats property names by replacing spaces by underscores and changes 
# all letters to lowercase
# Arguments:
#   1) The string to be formatted.
#      Cannnot be undefined.
#
sub _name {
  my $self = shift;
  my $string = shift;
  $string =~ s/ /_/g;
  return lc($string);
}

#
# Formats property values by performing the following substitutions:
#     <All>  => *
#     <Null> => 
#     <unset> => 
# Arguments:
#   1) The string to be formatted.
#      Cannot be undefined.
#
sub _value {
  my $self = shift;
  my $string = shift;
  if (lc($string) eq "<all>") { return "*"; }
  elsif (lc($string) eq "<null>" || lc($string) eq "<unset>") { return ""; }
  return $string;
}

#
# Formats a received string as a valid list. Replcae the space with comma
# 
# Arguments:
#    1) The string to be formatted.
#
sub _tolist {
  my $self = shift;
  my $string = shift;
  $string =~ s/[ ]+/,/g;
  return $string;
}

#
# Customized method to print out a more readeable message on parsing error.
#
sub _parsingError {
  my $self = shift;
  my $errString = shift; 
  
  print gettext("FATAL INTERNAL ERROR: Invalid data error encontered while parsing the CCR data.");
  print "\n$errString\n";
}

# RecDescentParser object methods
# -------------------------------

#
# Constructor.
# Arguments:
#   1) The Internal Data Representation to be filled in during the parsing
#      Cannot be undefined.
#
sub new {
  my $proto = shift;
  my $class = ref($proto) || $proto;
  my $self = ScSnapshot::GeneratedParser->new();
  $self->{DATA} = shift;
  $self->{LINE_COUNTER} = 0;
  bless ($self, $class);
  return $self;
}

#
# Gets/Sets the Internal Data Representation which is filled in during the 
# parsing.
#
sub data {
  my $self = shift;
  if (@_) 
    { 
      $self->{DATA} = shift;
    }
  return $self->{DATA};
}

#
# FOR DEBUG ONLY: return the value of the production counter.       
#
sub debug_gpc {
  my $self = shift;
  return $self->{LINE_COUNTER};
}

#
# FOR DEBUG ONLY: increment successfull production countere
#
sub debug_ipc {
  my $self = shift;
  $self->{LINE_COUNTER}++;
}

# 
# FOR DEBUG ONLY: Prints out on standard error information on last successfull
#                 production
sub debug_ppc {
 my $self = shift;
 if(defined($::DBG_LINE_COUNT)) {
   $self->debug_ipc();
   print STDERR "---> Success production [" . $self->debug_gpc() 
     . "] : [1=" . ($_[0]?$_[0]:"") . "] [2=" . ($_[1]?$_[1]:"") . "]\n";
 }
}

# Return success for module load
1; 

