modules/CommandHelper.pm

   1 package CommandHelper;
   2
   3 # ************************************************************
   4 # Description   : Base class and factory for all command helpers.
   5 #
   6 #                 The get() method converts the define custom type
   7 #                 provided to uppercase, removes the '_FILES' portion and
   8 #                 adds 'Helper' to the end.  If a module is found matching
   9 #                 that name, it will be used to assist the ProjectCreator
  10 #                 in determining which output files will be generated by
  11 #                 the command given the file name and command options.
  12 #
  13 # Author        : Chad Elliott
  14 # Create Date   : 6/30/2008
  15 # ************************************************************
  16
  17 # ************************************************************
  18 # Pragmas
  19 # ************************************************************
  20
  21 use strict;
  22 use File::Basename;
  23
  24 # ************************************************************
  25 # Data Section
  26 # ************************************************************
  27
  28 my %required;
  29 my %notfound;
  30
  31 # ************************************************************
  32 # Subroutine Section
  33 # ************************************************************
  34
  35 sub get {
  36   ## Create the helper name
  37   my $type = uc(shift);
  38   $type =~ s/_FILES$/Helper/;
  39
  40   ## Don't search the filesystem again if we didn't find one the first
  41   ## time we looked.
  42   return undef if ($notfound{$type});
  43
  44   ## Return the helper if we've already created one
  45   return $required{$type} if (defined $required{$type});
  46
  47   ## Assist users in figuring out why their helper isn't being picked up.
  48   OutputMessage::debug(undef, "Searching @INC for $type.pm");
  49
  50   ## If we can find a helper with this name, we will
  51   ## create a singleton of that type and return it.
  52   foreach my $inc (@INC) {
  53     if (-r "$inc/$type.pm") {
  54       OutputMessage::debug(undef, "Found $type.pm in $inc");
  55       require "$type.pm";
  56       $required{$type} = $type->new();
  57       return $required{$type};
  58     }
  59   }
  60
  61   ## We didn't find a helper.  Keep track of that fact and return undef.
  62   $notfound{$type} = 1;
  63   return undef;
  64 }
  65
  66 sub new {
  67   my $class = shift;
  68   return bless {}, $class;
  69 }
  70
  71 sub get_output {
  72   ## This method is called with the filename and command options and
  73   ## returns an array reference containing filenames that will be
  74   ## generated but can not be described using the normal Define_Custom
  75   ## syntax.  An optional second return value is a hash reference
  76   ## describing additional dependencies as {type => {file => [deps]}}.
  77   ## It's used to tell MPC that 'file' (one of the outputs) belongs to
  78   ## 'type' and has additional dependencies 'deps'.
  79   return [];
  80 }
  81
  82 sub get_outputexts {
  83   ## This method is expected to return an array reference containing the
  84   ## extensions for files returned by the get_output() method.  They will
  85   ## be used as regular expressions so regular expression characters
  86   ## (such as '.', '[', ']', etc.) must be escaped.  This can be done by
  87   ## calling $self->Parser::escape_regex_special($str);
  88   return [];
  89 }
  90
  91 sub get_tied {
  92   ## This method is called with a file name and an array reference of
  93   ## files.  The first expected return value is an array reference of those
  94   ## files listed in the passed array reference that are in some way tied
  95   ## to the file name passed in.  The second is a component name to help
  96   ## MPC figure out a way to tie the files together.  The result of "tied"
  97   ## files is that they may be compiled after the file name passed in.
  98   return [], undef;
  99 }
 100
 101 sub set_creator {
 102   my($self, $creator) = @_;
 103   $self->{'creator'} = $creator;
 104 }
 105
 106 1;