modules/GHSProjectCreator.pm

   1 package GHSProjectCreator;
   2
   3 # ************************************************************
   4 # Description   : A GHS project creator for version 4.x.
   5 #                 By default, this module assumes Multi will
   6 #                 be used on Windows.  If it is not, you must
   7 #                 set the MPC_GHS_UNIX environment variable.
   8 # Author        : Chad Elliott
   9 # Create Date   : 4/19/2002
  10 # ************************************************************
  11
  12 # ************************************************************
  13 # Pragmas
  14 # ************************************************************
  15
  16 use strict;
  17
  18 use ProjectCreator;
  19 use GHSPropertyBase;
  20
  21 use vars qw(@ISA);
  22 @ISA = qw(GHSPropertyBase ProjectCreator);
  23
  24 # ************************************************************
  25 # Data Section
  26 # ************************************************************
  27
  28 my $startre;
  29
  30 # ************************************************************
  31 # Subroutine Section
  32 # ************************************************************
  33
  34 sub convert_slashes {
  35   return (defined $ENV{$GHSPropertyBase::ghsunix} ? 0 : 1);
  36 }
  37
  38
  39 sub case_insensitive {
  40   return (defined $ENV{$GHSPropertyBase::ghsunix} ? 0 : 1);
  41 }
  42
  43
  44 sub use_win_compatibility_commands {
  45   return (defined $ENV{$GHSPropertyBase::ghsunix} ? 0 : 1);
  46 }
  47
  48
  49 sub post_file_creation {
  50   my $self = shift;
  51
  52   ## These special files are only used if it is a custom only project or
  53   ## there are no source files in the project.
  54   if ((defined $self->get_assignment('custom_only') ||
  55        !defined $self->get_assignment('source_files')) &&
  56       defined $self->get_assignment('custom_types')) {
  57     my $fh = new FileHandle();
  58     if (open($fh, '>.custom_build_rule')) {
  59       print $fh ".empty_html_file\n";
  60       close($fh);
  61     }
  62     if (open($fh, '>.empty_html_file')) {
  63       close($fh);
  64     }
  65   }
  66
  67   return undef;
  68 }
  69
  70 sub compare_output {
  71   #my $self = shift;
  72   return 1;
  73 }
  74
  75
  76 sub project_file_extension {
  77   #my $self = shift;
  78   return '.gpj';
  79 }
  80
  81
  82 sub fill_value {
  83   my($self, $name) = @_;
  84   my $value;
  85
  86   if (!defined $startre) {
  87     $startre = $self->escape_regex_special($self->getstartdir());
  88   }
  89
  90   ## The Green Hills project format is strange and needs all paths
  91   ## relative to the top directory, no matter where the source files
  92   ## reside.  The template uses reltop_ in front of the real project
  93   ## settings, so we get the value of the real keyword and then do some
  94   ## adjusting to get it relative to the top directory.
  95   if ($name =~ /^reltop_(\w+)/) {
  96     $value = $self->relative($self->get_assignment($1));
  97     if (defined $value) {
  98       my $part = $self->getcwd();
  99       $part =~ s/^$startre[\/]?//;
 100       if ($part ne '') {
 101         if ($value eq '.') {
 102           $value = $part;
 103         }
 104         else {
 105           $value = $part . '/' . $value;
 106         }
 107       }
 108     }
 109   }
 110   elsif ($name eq 'reltop') {
 111     $value = $self->getcwd();
 112     $value =~ s/^$startre[\/]?//;
 113     $value = '.' if ($value eq '');
 114   }
 115   elsif ($name eq 'slash') {
 116     ## We need to override the slash value so that we can give the right
 117     ## value for Windows or UNIX.
 118     $value = (defined $ENV{$GHSPropertyBase::ghsunix} ? '/' : '\\');
 119   }
 120   elsif ($name eq 'postmkdir') {
 121     ## If we're on Windows, we need an "or" command that will reset the
 122     ## errorlevel so that a mkdir on a directory that already exists
 123     ## doesn't cause the build to cease.
 124     $value = ' || type nul' if (!defined $ENV{$GHSPropertyBase::ghsunix});
 125   }
 126
 127   return $value;
 128 }
 129
 130 sub get_dll_exe_template_input_file {
 131   #my $self = shift;
 132   return 'ghsdllexe';
 133 }
 134
 135
 136 sub get_lib_exe_template_input_file {
 137   #my $self = shift;
 138   return 'ghslibexe';
 139 }
 140
 141
 142 sub get_lib_template_input_file {
 143   #my $self = shift;
 144   return 'ghslib';
 145 }
 146
 147
 148 sub get_dll_template_input_file {
 149   #my $self = shift;
 150   return 'ghsdll';
 151 }
 152
 153
 154 1;