1 #!perl

     2 # CommandInfoFile.pm

     3 # 

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

     5 # This component and the accompanying materials are made available

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

     7 # which accompanies this distribution, and is available

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

     9 # 

    10 # Initial Contributors:

    11 # Accenture - Initial contribution

    12 #

    13 

    14 # Description:

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

    16 

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

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

    19 

    20 package CommandInfoFile;

    21 

    22 use strict;

    23 use IO::File;

    24 use File::Basename;

    25 

    26 

    27 #

    28 # Public Interface.

    29 #

    30 

    31 sub New {

    32   my $pkg = shift;

    33   my $fileName = shift;

    34   my $self = _Construct($pkg);

    35   $self->_ReadFile($fileName);

    36   return $self;

    37 }

    38 

    39 sub Name($) {

    40   my $self = shift;

    41   return $self->{name};

    42 }

    43 

    44 sub FullName($) {

    45   my $self = shift;

    46   my $name = shift;

    47 

    48   if (defined $name) {

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

    50   }

    51   else {

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

    53   }

    54 

    55   if ($self->{parent}) {

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

    57   }

    58 

    59   return $name;

    60 }

    61 

    62 sub ShortDescription($) {

    63   my $self = shift;

    64   return $self->{short_description};

    65 }

    66 

    67 sub LongDescription($) {

    68   my $self = shift;

    69   return $self->{long_description};

    70 }

    71 

    72 sub SeeAlso($) {

    73   my $self = shift;

    74   return $self->{see_also};

    75 }

    76 

    77 sub Copyright($) {

    78   my $self = shift;

    79   return $self->{copyright};

    80 }

    81 

    82 sub Arguments($) {

    83   my $self = shift;

    84   return $self->{arguments};

    85 }

    86 

    87 sub Options($) {

    88   my $self = shift;

    89   return $self->{options};

    90 }

    91 

    92 sub NumSubCommands($) {

    93   my $self = shift;

    94   my $numSubCommands = 0;

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

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

    97   }

    98   return $numSubCommands;

    99 }

   100 

   101 sub SubCommand($$) {

   102   my $self = shift;

   103   my $index = shift;

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

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

   106 }

   107 

   108 

   109 #

   110 # Private.

   111 #

   112 

   113 sub _ReadFile($$) {

   114   my $self = shift;

   115   my $fileName = shift;

   116 

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

   118   my $pos = 0;

   119   my $fileLength = -s $fileName;

   120 

   121   while ($pos < $fileLength) {

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

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

   124     }

   125     else {

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

   127     }

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

   129   }

   130   close ($file);

   131 }

   132 

   133 sub _ReadDetails($$$) {

   134   my $self = shift;

   135   my $file = shift;

   136   my $fileName = shift;

   137 

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

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

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

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

   142       $self->{name} = $1;

   143     }

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

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

   146     }

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

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

   149     }

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

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

   152     }

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

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

   155     }

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

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

   158     }

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

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

   161     }

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

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

   164 	$self->{process_include} = 0;

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

   166 	$self->_ReadFile($includeFileName);

   167 	last;

   168       }

   169       else {

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

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

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

   173 	last;

   174       }

   175     }

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

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

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

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

   180       }

   181       else {

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

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

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

   185 	last;

   186       }

   187     }

   188 

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

   190   }

   191 }

   192 

   193 sub _ProcessNewChild($) {

   194   my $self = shift;

   195 

   196   if ($self->{parent}) {

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

   198   }

   199   else {

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

   201     undef $self->{current_child};

   202   }

   203 }

   204 

   205 sub _ProcessInclude($$) {

   206   my $self = shift;

   207   my $child = shift;

   208 

   209   if ($self->{parent}) {

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

   211   }

   212   else {

   213     $self->{process_include} = 1;

   214     $self->{current_child} = $child;

   215   }

   216 }

   217 

   218 sub _AddSubCommand($$$$) {

   219   my $self = shift;

   220   my $subCommandNames = shift;

   221   my $file = shift;

   222   my $fileName = shift;

   223   my $subCommandName = shift @$subCommandNames;

   224 

   225   my $found = 0;

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

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

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

   229       $found = 1;

   230       last;

   231     }

   232   }

   233 

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

   235 

   236   if (not $found) {

   237     my $newCif = _Construct('CommandInfoFile');

   238     $newCif->{name} = $subCommandName;

   239     $newCif->{parent} = $self;

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

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

   242   }

   243 }

   244 

   245 sub _Construct($) {

   246   my $pkg = shift;

   247   my $self = {};

   248   bless $self, $pkg;

   249 

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

   251 			      type => 'bool',

   252 			      short_name => 'h',

   253 			      long_name => 'help',

   254 			      description => 'Display help.'

   255 			     });

   256 

   257   return $self;

   258 }

   259 

   260 sub ReadArgument($$) {

   261   my $file = shift;

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

   263 

   264   my $argumentEntry = {};

   265 

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

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

   268 

   269   foreach my $arg (@args) {

   270     if ($arg eq 'optional') {

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

   272     }

   273     elsif ($arg eq 'multiple') {

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

   275     }

   276     elsif ($arg eq 'last') {

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

   278     }

   279     else {

   280       $argumentEntry->{env_var} = $arg;

   281     }

   282   }

   283 

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

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

   286 

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

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

   289 

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

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

   292   }

   293 

   294   return $argumentEntry;

   295 }

   296 

   297 sub ReadOption($$) {

   298   my $file = shift;

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

   300 

   301   my $optionEntry = {};

   302 

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

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

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

   306 

   307   foreach my $arg (@args) {

   308     if ($arg eq 'multiple') {

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

   310     }

   311     else {

   312       $optionEntry->{env_var} = $arg;

   313     }

   314   }

   315 

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

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

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

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

   320 

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

   322 

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

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

   325   }

   326 

   327   return $optionEntry;

   328 }

   329 

   330 sub GetEnumValues($) {

   331   my $file = shift;

   332 

   333   my @values;

   334 

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

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

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

   338       my $value = $1;

   339       my $description = TextToNextCommand($file);

   340       push (@values, {

   341 		      value => $value,

   342 		      description => $description

   343 		     });

   344     }

   345     else {

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

   347       last;

   348     }

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

   350   }

   351 

   352   return \@values;

   353 }

   354 

   355 sub TextToNextCommand($) {

   356   my $file = shift;

   357   my $text = '';

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

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

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

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

   362       last;

   363     }

   364     else {

   365       $text .= $line;

   366     }

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

   368   }

   369   return $text;

   370 }

   371 

   372 1;