#!perl

# CommandInfoFile.pm

# 

# Copyright (c) 2010 Accenture. All rights reserved.

# This component and the accompanying materials are made available

# under the terms of the "Eclipse Public License v1.0"

# which accompanies this distribution, and is available

# at the URL "http://www.eclipse.org/legal/epl-v10.html".

# 

# Initial Contributors:

# Accenture - Initial contribution

#

# Description:

# A Perl implementation of the C++ class CCommandInfoFile (in ioutils.dll).

# Note, this code is intended to behave the same as the C++ version. It therefore used C++ like ways

# doing things rather than Perl-like ways to keep the code as similar are possible.

package CommandInfoFile;

use strict;

use IO::File;

use File::Basename;

#

# Public Interface.

#

sub New {

  my $pkg = shift;

  my $fileName = shift;

  my $self = _Construct($pkg);

  $self->_ReadFile($fileName);

  return $self;

}

sub Name($) {

  my $self = shift;

  return $self->{name};

}

sub FullName($) {

  my $self = shift;

  my $name = shift;

  if (defined $name) {

    $name = "$self->{name} $name";

  }

  else {

    $name = $self->{name};

  }

  if ($self->{parent}) {

    $name = $self->{parent}->FullName($name);

  }

  return $name;

}

sub ShortDescription($) {

  my $self = shift;

  return $self->{short_description};

}

sub LongDescription($) {

  my $self = shift;

  return $self->{long_description};

}

sub SeeAlso($) {

  my $self = shift;

  return $self->{see_also};

}

sub Copyright($) {

  my $self = shift;

  return $self->{copyright};

}

sub Arguments($) {

  my $self = shift;

  return $self->{arguments};

}

sub Options($) {

  my $self = shift;

  return $self->{options};

}

sub NumSubCommands($) {

  my $self = shift;

  my $numSubCommands = 0;

  if (defined $self->{sub_commands}) {

    $numSubCommands = scalar (@{$self->{sub_commands}});

  }

  return $numSubCommands;

}

sub SubCommand($$) {

  my $self = shift;

  my $index = shift;

  die unless (($index >= 0) and ($index < $self->NumSubCommands()));

  return $self->{sub_commands}->[$index];

}

#

# Private.

#

sub _ReadFile($$) {

  my $self = shift;

  my $fileName = shift;

  my $file = IO::File->new($fileName) or die "Error: Couldn't open '$fileName' for reading: $!\n";

  my $pos = 0;

  my $fileLength = -s $fileName;

  while ($pos < $fileLength) {

    if ($self->{process_include} or not defined $self->{current_child}) {

      $self->_ReadDetails($file, $fileName);

    }

    else {

      $self->{current_child}->_ReadDetails($file, $fileName);

    }

    $pos = $file->tell();

  }

  close ($file);

}

sub _ReadDetails($$$) {

  my $self = shift;

  my $file = shift;

  my $fileName = shift;

  my $pos = $file->tell();

  TextToNextCommand($file); # Ignore everything before the first '==' command.

  while (my $line = <$file>) {

    if ($line =~ /^==name\s+(\S+)/) {

      $self->{name} = $1;

    }

    elsif ($line =~ /^==short-description\s*$/) {

      $self->{short_description} = TextToNextCommand($file);

    }

    elsif ($line =~ /^==long-description\s*$/) {

      $self->{long_description} = TextToNextCommand($file);

    }

    elsif ($line =~ /^==see-also\s*$/) {

      $self->{see_also} = TextToNextCommand($file);

    }

    elsif ($line =~ /^==copyright\s*$/) {

      $self->{copyright} = TextToNextCommand($file);

    }

    elsif ($line =~ /^==argument\s+(.*)$/) {

      push (@{$self->{arguments}}, ReadArgument($file, $1));

    }

    elsif ($line =~ /^==option\s+(.*)$/) {

      push (@{$self->{options}}, ReadOption($file, $1));

    }

    elsif ($line =~ /^==include\s+(.*)$/) {

      if (not exists $self->{parent}) {

	$self->{process_include} = 0;

	my $includeFileName = dirname($fileName) . "/$1";

	$self->_ReadFile($includeFileName);

	last;

      }

      else {

	# We're a sub-command. Let control return to the root to handle the include.

	$self->{parent}->_ProcessInclude($self);

	$file->seek($pos, 0);

	last;

      }

    }

    elsif ($line =~ /^==sub-command\s+(.*)$/) {

      if (not exists $self->{parent}) {

	my @subCommandNames = split (/\s+/, $1);

	$self->_AddSubCommand(\@subCommandNames, $file, $fileName);

      }

      else {

	# We're a sub-command. Let control return to the root to handle the include.

	$self->{parent}->_ProcessNewChild();

	$file->seek($pos, 0);

	last;

      }

    }

    $pos = $file->tell();

  }

}

sub _ProcessNewChild($) {

  my $self = shift;

  if ($self->{parent}) {

    $self->{parent}->_ProcessNewChild();

  }

  else {

    die if ($self->{process_include});

    undef $self->{current_child};

  }

}

sub _ProcessInclude($$) {

  my $self = shift;

  my $child = shift;

  if ($self->{parent}) {

    $self->{parent}->_ProcessInclude($child);

  }

  else {

    $self->{process_include} = 1;

    $self->{current_child} = $child;

  }

}

sub _AddSubCommand($$$$) {

  my $self = shift;

  my $subCommandNames = shift;

  my $file = shift;

  my $fileName = shift;

  my $subCommandName = shift @$subCommandNames;

  my $found = 0;

  for (my $i = ($self->NumSubCommands() - 1); $i >= 0; --$i) {

    if ($self->{sub_commands}->[$i]->{name} eq $subCommandName) {

      $self->{sub_commands}->[$i]->_AddSubCommand($subCommandNames, $file, $fileName);

      $found = 1;

      last;

    }

  }

  die unless ($found or (@$subCommandNames == 0));

  if (not $found) {

    my $newCif = _Construct('CommandInfoFile');

    $newCif->{name} = $subCommandName;

    $newCif->{parent} = $self;

    $newCif->_ReadDetails($file, $fileName);

    push (@{$self->{sub_commands}}, $newCif);

  }

}

sub _Construct($) {

  my $pkg = shift;

  my $self = {};

  bless $self, $pkg;

  push (@{$self->{options}}, {

			      type => 'bool',

			      short_name => 'h',

			      long_name => 'help',

			      description => 'Display help.'

			     });

  return $self;

}

sub ReadArgument($$) {

  my $file = shift;

  my @args = split (/\s+/, shift);

  my $argumentEntry = {};

  $argumentEntry->{type} = shift @args;

  $argumentEntry->{name} = shift @args;

  foreach my $arg (@args) {

    if ($arg eq 'optional') {

      $argumentEntry->{flags}->{optional} = 1;

    }

    elsif ($arg eq 'multiple') {

      $argumentEntry->{flags}->{multiple} = 1;

    }

    elsif ($arg eq 'last') {

      $argumentEntry->{flags}->{last} = 1;

    }

    else {

      $argumentEntry->{env_var} = $arg;

    }

  }

  die "Error: Argument missing type\n" unless defined $argumentEntry->{type};

  die "Error: Argument missing name\n" unless defined $argumentEntry->{name};

  $argumentEntry->{description} = TextToNextCommand($file);

  $argumentEntry->{description} =~ s/\s*$//;

  if ($argumentEntry->{type} eq 'enum') {

    $argumentEntry->{enum_values} = GetEnumValues($file);

  }

  return $argumentEntry;

}

sub ReadOption($$) {

  my $file = shift;

  my @args = split (/\s+/, shift);

  my $optionEntry = {};

  $optionEntry->{type} = shift @args;

  $optionEntry->{short_name} = shift @args;

  $optionEntry->{long_name} = shift @args;

  foreach my $arg (@args) {

    if ($arg eq 'multiple') {

      $optionEntry->{flags}->{multiple} = 1;

    }

    else {

      $optionEntry->{env_var} = $arg;

    }

  }

  die "Error: Option missing type\n" unless defined $optionEntry->{type};

  die "Error: Option missing short name\n" unless defined $optionEntry->{short_name};

  die "Error: Option short name not a single character\n" unless length ($optionEntry->{short_name}) == 1;

  die "Error: Option missing long name\n" unless defined $optionEntry->{long_name};

  $optionEntry->{description} = TextToNextCommand($file);

  if ($optionEntry->{type} eq 'enum') {

    $optionEntry->{enum_values} = GetEnumValues($file);

  }

  return $optionEntry;

}

sub GetEnumValues($) {

  my $file = shift;

  my @values;

  my $pos = $file->tell();

  while (my $line = <$file>) {

    if ($line =~ /^==enum-value\s+(\S+)/) {

      my $value = $1;

      my $description = TextToNextCommand($file);

      push (@values, {

		      value => $value,

		      description => $description

		     });

    }

    else {

      $file->seek ($pos, 0);

      last;

    }

    $pos = $file->tell();

  }

  return \@values;

}

sub TextToNextCommand($) {

  my $file = shift;

  my $text = '';

  my $pos = $file->tell();

  while (my $line = <$file>) {

    if ($line =~ /^==/) {

      $file->seek($pos, 0);

      last;

    }

    else {

      $text .= $line;

    }

    $pos = $file->tell();

  }

  return $text;

}

1;