diff -r 000000000000 -r 7f656887cf89 tools/CommandInfoFile.pm
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tools/CommandInfoFile.pm	Wed Jun 23 15:52:26 2010 +0100
@@ -0,0 +1,372 @@
+#!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;