projectcreator.pm

这是广泛使用的通信开源项目,对于大容量,高并发的通讯要求完全能够胜任,他广泛可用于网络游戏医学图像网关的高qos要求.更详细的内容可阅读相应的材料

package ProjectCreator;

# ************************************************************
# Description   : Base class for all project creators
# Author        : Chad Elliott
# Create Date   : 3/13/2002
# ************************************************************

# ************************************************************
# Pragmas
# ************************************************************

use strict;
use FileHandle;
use File::Path;
use File::Compare;
use File::Basename;

use Creator;
use TemplateInputReader;
use TemplateParser;
use FeatureParser;

use vars qw(@ISA);
@ISA = qw(Creator);

# ************************************************************
# Data Section
# ************************************************************

my($BaseClassExtension)      = 'mpb';
my($ProjectCreatorExtension) = 'mpc';
my($TemplateExtension)       = 'mpd';
my($TemplateInputExtension)  = 'mpt';

## Valid names for assignments within a project
my(%validNames) = ('exename'         => 1,
                   'sharedname'      => 1,
                   'staticname'      => 1,
                   'libpaths'        => 1,
                   'install'         => 1,
                   'includes'        => 1,
                   'idlflags'        => 1,
                   'idlpreprocessor' => 1,
                   'defaultlibs'     => 1,
                   'after'           => 1,
                   'libs'            => 1,
                   'lit_libs'        => 1,
                   'pch_header'      => 1,
                   'pch_source'      => 1,
                   'ssl'             => 1,
                   'dllout'          => 1,
                   'libout'          => 1,
                   'dynamicflags'    => 1,
                   'staticflags'     => 1,
                   'version'         => 1,
                   'requires'        => 1,
                   'avoids'          => 1,
                   'compname'        => 1,
                   'comps'           => 1,
                   'tagname'         => 1,
                   'tagchecks'       => 1,
                   'core'            => 1,
                   'idlgendir'       => 1,
                   'macros'          => 1,
                  );

## Custom definitions only
## -1 means that it is always an array
##  0 means that it is an array that gets outputext converted to files
##  1 means that it is always scalar
my(%customDefined) = ('automatic'               => 1,
                      'command'                 => 1,
                      'commandflags'            => 1,
                      'inputext'                => -1,
                      'libpath'                 => 1,
                      'output_option'           => 1,
                      'pch_option'              => 1,
                      'pre_extension'           => 0,
                      'pre_filename'            => 0,
                      'source_outputext'        => 0,
                      'template_outputext'      => 0,
                      'header_outputext'        => 0,
                      'inline_outputext'        => 0,
                      'documentation_outputext' => 0,
                      'resource_outputext'      => 0,
                      'generic_outputext'       => 0,
                     );

## Custom sections as well as definitions
my(%custom) = ('commandflags'  => 1,
               'gendir'        => 1,
              );

## Deal with these components in a special way
my(@specialComponents) = ('header_files', 'inline_files');

## Valid component names within a project along with the valid file extensions
my(%vc) = ('source_files'        => [ "\\.cpp", "\\.cxx", "\\.cc", "\\.c", "\\.C", ],
           'template_files'      => [ "_T\\.cpp", "_T\\.cxx", "_T\\.cc", "_T\\.c", "_T\\.C", ],
           'header_files'        => [ "\\.h", "\\.hpp", "\\.hxx", "\\.hh", ],
           'inline_files'        => [ "\\.i", "\\.inl", ],
           'idl_files'           => [ "\\.idl", ],
           'documentation_files' => [ "README", "readme", "\\.doc", "\\.txt", ],
           'resource_files'      => [ "\\.rc", ],
          );

## Exclude these extensions when auto generating the component values
my(%ec) = ('source_files' => [ "_T\\.cpp", "_T\\.cxx", "_T\\.cc", "_T\\.C", ],
          );

## Match up assignments with the valid components
my(%ma) = ('idl_files'    => [ 'idlgendir', 'idlflags' ],
          );

my(%genext) = ('idl_files' => {'automatic'     => 1,
                               'pre_filename'  => [ '' ],
                               'pre_extension' => [ 'C', 'S' ],
                               'source_files'  => [ '\\.cpp', '\\.cxx', '\\.cc', '\\.C', ],
                               'inline_files'  => [ '\\.i', '\\.inl', ],
                               'header_files'  => [ '\\.h', '\\.hxx', '\\.hh', ],
                              },
              );

my($grouped_key) = 'grouped_';

# ************************************************************
# Subroutine Section
# ************************************************************

sub new {
  my($class)     = shift;
  my($global)    = shift;
  my($inc)       = shift;
  my($template)  = shift;
  my($ti)        = shift;
  my($dynamic)   = shift;
  my($static)    = shift;
  my($relative)  = shift;
  my($addtemp)   = shift;
  my($addproj)   = shift;
  my($progress)  = shift;
  my($toplevel)  = shift;
  my($baseprojs) = shift;
  my($gfeature)  = shift;
  my($feature)   = shift;
  my($hierarchy) = shift;
  my($exclude)   = shift;
  my($makeco)    = shift;
  my($nmod)      = shift;
  my($applypj)   = shift;
  my($self)      = Creator::new($class, $global, $inc,
                                $template, $ti, $dynamic, $static,
                                $relative, $addtemp, $addproj,
                                $progress, $toplevel, $baseprojs,
                                $feature, $hierarchy, $nmod, $applypj,
                                'project');

  $self->{$self->{'type_check'}}   = 0;
  $self->{'feature_defined'}       = 0;
  $self->{'project_info'}          = [];
  $self->{'reading_parent'}        = [];
  $self->{'feature_definitions'}   = [];
  $self->{'dexe_template_input'}   = undef;
  $self->{'lexe_template_input'}   = undef;
  $self->{'lib_template_input'}    = undef;
  $self->{'dll_template_input'}    = undef;
  $self->{'flag_overrides'}        = {};
  $self->{'special_supplied'}      = {};
  $self->{'pctype'}                = $self->extractType("$self");
  $self->{'verbatim'}              = {};
  $self->{'verbatim_accessed'}     = {$self->{'pctype'} => {}};
  $self->{'type_specific_assign'}  = {};
  $self->{'defaulted'}             = {};
  $self->{'custom_types'}          = {};
  $self->{'parents_read'}          = {};
  $self->{'feature_parser'}        = new FeatureParser($gfeature, $feature);
  $self->{'convert_slashes'}       = $self->convert_slashes();
  $self->{'sort_files'}            = $self->sort_files();
  $self->{'source_callback'}       = undef;
  $self->{'dollar_special'}        = $self->dollar_special();
  $self->{'exclude'}               = $exclude;
  $self->reset_generating_types();

  return $self;
}


sub read_global_configuration {
  my($self)   = shift;
  my($input)  = $self->get_global_cfg();
  my($status) = 1;

  if (defined $input) {
    $self->{'reading_global'} = 1;
    $status = $self->parse_file($input);
    $self->{'reading_global'} = 0;
  }

  return $status;
}


sub process_assignment {
  my($self)   = shift;
  my($name)   = shift;
  my($value)  = shift;
  my($assign) = shift;

  ## Support the '*' mechanism as in the project name, to allow
  ## the user to correctly depend on another project within the same
  ## directory.
  if ($name eq 'after' && $value =~ /\*/) {
    my($def) = $self->get_default_project_name();
    $value = $self->fill_type_name($value, $def);
  }
  if (defined $value && !$self->{'dollar_special'} && $value =~ /\$\$/) {
    $value =~ s/\$\$/\$/g;
  }
  $self->SUPER::process_assignment($name, $value, $assign);
}


sub parse_line {
  my($self)   = shift;
  my($ih)     = shift;
  my($line)   = shift;
  my($status,
     $errorString,
     @values) = $self->parse_known($line);

  ## parse_known() passes back an array of values
  ## that make up the contents of the line parsed.
  ## The array can have 0 to 3 items.  The first,
  ## if defined, is always an identifier of some
  ## sort.

  if ($status && defined $values[0]) {
    if ($values[0] eq $self->{'grammar_type'}) {
      my($name)      = $values[1];
      my($typecheck) = $self->{'type_check'};
      if (defined $name && $name eq '}') {
        ## Project Ending
        my($rp) = $self->{'reading_parent'};
        if (!defined $$rp[0] && !$self->{'reading_global'}) {
          ## Fill in all the default values
          $self->generate_defaults();

          ## Fill in type specific assignments
          $self->process_type_specific_assignments();

          ## Perform any additions, subtractions
          ## or overrides for the project values.
          my($addproj) = $self->get_addproj();
          foreach my $ap (keys %$addproj) {
            if (defined $validNames{$ap}) {
              my($val) = $$addproj{$ap};
              if ($$val[0] > 0) {
                $self->process_assignment_add($ap, $$val[1]);
              }
              elsif ($$val[0] < 0) {
                $self->process_assignment_sub($ap, $$val[1]);
              }
              else {
                $self->process_assignment($ap, $$val[1]);
              }
            }
            else {
              $errorString = 'ERROR: Invalid ' .
                             "assignment modification name: $ap";
              $status = 0;
            }
          }

          if ($status) {
            ## End of project; Write out the file.
            ($status, $errorString) = $self->write_project();

            ## Check for unused verbatim markers
            foreach my $key (keys %{$self->{'verbatim'}}) {
              if (defined $self->{'verbatim_accessed'}->{$key}) {
                foreach my $ikey (keys %{$self->{'verbatim'}->{$key}}) {
                  if (!defined $self->{'verbatim_accessed'}->{$key}->{$ikey}) {
                    print "WARNING: Marker $ikey does not exist.\n";
                  }
                }
              }
            }

            ## Reset all of the project specific data
            foreach my $key (keys %{$self->{'valid_components'}}) {
              delete $self->{$key};
              $self->{'defaulted'}->{$key} = 0;
            }
            $self->{'assign'}               = {};
            $self->{'verbatim'}             = {};
            $self->{'verbatim_accessed'}    = {$self->{'pctype'} => {}};
            $self->{'special_supplied'}     = {};
            $self->{'type_specific_assign'} = {};
            $self->{'flag_overrides'}       = {};
            $self->{'parents_read'}         = {};
            $self->{'feature_definitions'}  = [];
            $self->reset_generating_types();
          }
        }
        $self->{$typecheck} = 0;
      }
      else {
        ## Project Beginning
        ## Deal with the inheritance hiearchy first
        my($parents) = $values[2];

        ## Add in the base projects from the command line
        if (!$self->{'reading_global'} &&
            !defined $self->{'reading_parent'}->[0]) {
          my($baseprojs) = $self->get_baseprojs();

          if (defined $parents) {
            foreach my $base (@$baseprojs) {
              my($found) = 0;
              foreach my $parent (@$parents) {
                if ($base eq $parent) {
                  $found = 1;
                  last;
                }
              }
              if (!$found) {
                push(@$parents, $base);
              }
            }
          }
          else {
            $parents = $baseprojs;
          }
        }

        if (defined $parents) {
          foreach my $parent (@$parents) {
            ## Read in the parent onto ourself
            my($file) = $self->search_include_path(
                                 "$parent.$BaseClassExtension");
            if (!defined $file) {
              $file = $self->search_include_path(
                                   "$parent.$ProjectCreatorExtension");
            }

            if (defined $file) {
              foreach my $currently (@{$self->{'reading_parent'}}) {
                if ($currently eq $file) {
                  $status = 0;
                  $errorString = 'ERROR: Cyclic inheritance detected: ' .
                                 $parent;
                }
              }

              if ($status) {
                if (!defined $self->{'parents_read'}->{$file}) {
                  $self->{'parents_read'}->{$file} = 1;
                  ## Begin reading the parent
                  push(@{$self->{'reading_parent'}}, $file);
                  $status = $self->parse_file($file);
                  pop(@{$self->{'reading_parent'}});

                  if (!$status) {
                    $errorString = "ERROR: Invalid parent: $parent";
                  }
                }
              }
            }
            else {
              $status = 0;
              $errorString = "ERROR: Unable to locate parent: $parent";
            }
          }
        }

        ## Set up some initial values
        if (defined $name) {
          if ($name =~ /[\/\\]/) {
            $status = 0;
            $errorString = 'ERROR: Projects can not have a slash ' .
                           'or a back slash in the name';
          }
          else {
            $name =~ s/^\(\s*//;
            $name =~ s/\s*\)$//;
            $name = $self->transform_file_name($name);

            ## Replace any *'s with the default name
            my($def) = $self->get_default_project_name();
            $name = $self->fill_type_name($name, $def);

            $self->set_project_name($name);
          }
        }
        $self->{$typecheck} = 1;

        ## Copy each value from global_assign into assign
        if (!$self->{'reading_global'}) {
          foreach my $key (keys %{$self->{'global_assign'}}) {
            if (!defined $self->{'assign'}->{$key}) {
              $self->{'assign'}->{$key} = $self->{'global_assign'}->{$key};
            }
          }
        }
      }
    }
    elsif ($values[0] eq 'assignment') {
      my($name)  = $values[1];
      my($value) = $values[2];
      if (defined $validNames{$name}) {
        $self->process_assignment($name, $value);
      }
      else {
        $errorString = "ERROR: Invalid assignment name: $name";
        $status = 0;
      }
    }
    elsif ($values[0] eq 'assign_add') {
      my($name)  = $values[1];
      my($value) = $values[2];
      if (defined $validNames{$name}) {
        $self->process_assignment_add($name, $value);
      }
      else {
        $errorString = "ERROR: Invalid addition name: $name";
        $status = 0;
      }
    }
    elsif ($values[0] eq 'assign_sub') {
      my($name)  = $values[1];
      my($value) = $values[2];
      if (defined $validNames{$name}) {
        $self->process_assignment_sub($name, $value);
      }
      else {
        $errorString = "ERROR: Invalid subtraction name: $name";
        $status = 0;
      }
    }
    elsif ($values[0] eq 'component') {
      my($comp) = $values[1];
      my($name) = $values[2];
      if (defined $name) {
        $name =~ s/^\(\s*//;
        $name =~ s/\s*\)$//;
      }
      else {
        $name = $self->get_default_component_name();