view release on metacpan or  search on metacpan

bin/fm_check_struct  view on Meta::CPAN

          print "Should not create path\n";
        }
        exit 1;
      }
      my $error;
      make_path($input, {error => \$error});
      if(@$error){
        testFailed($test);
        if($verbose > 0){
          print "Could not create path ". $input ."\n";
        }
        exit 1;
      }
    }
    $settings->{"defaultEnvironmentPath"} = $input;
    saveSettings($settings);
  }
  my $path = $settings->{"defaultEnvironmentPath"};
  my $extension = "";
  if($structUrl =~ m/[\\\/]?([^\\\/]+)[\\\/]?$/){
    $extension = $1 ."_". strftime("%Y%m%d-%H%M%S", localtime());
  }
  else{
    testFailed($test);
    if($verbose > 0){
      print "Could not extend environment path for current structure\n";
    }
    exit 1;
  }
  $path .= "/". $extension;

  # Copy all needed stuff into that environment
  if(!dircopy($structUrl, $path)){
    testFailed($test);
    if($verbose > 0){
      print "Could not copy ". $structUrl ." to ". $path ."\n";
    }
    exit 1;
  }
  # strip out all \.svn files
  cleanSvn($path);

  # adapt config.pro
  my $envCfg = $path ."/config.pro";
  my $oldCfg = $path ."/config.pro.orig";
  my %allowedRelativePaths = optionsToIngoreAtPathCheckings();
  my $fhOld;
  my $fhNew;
  # get current one
  if(!-e $cfgUrl){
    testFailed($test);
    if($verbose > 0){
      print "Could not find copied config.pro\n";
    }
    exit 1;
  }
  # move config.pro to create a new adapted one
  if(!move(getInstallationConfigPro($path), $oldCfg)){
    testFailed($test);
    if($verbose > 0){
      print "Could not backup ". $envCfg ."\n";
    }
    exit 1;
  }
  # adapt config
  if(!open($fhOld, "<", $oldCfg)){
    testFailed($test);
    if($verbose > 0){
      print "Could not open ". $oldCfg ." for reading\n";
    }
    exit 1;
  }
  if(!open($fhNew, ">", $envCfg)){
    testFailed($test);
    if($verbose > 0){
      print "Could not open ". $envCfg ." for reading\n";
    }
    exit 1;
  }
  while(<$fhOld>){
    my $line = strip($_);
    if($line =~ m/^([^\s]+)\s+([^!]+)/){
      my $opt = uc($1);
      if(!exists($allowedRelativePaths{$opt})){
        $line =~ s/\$PRO_DIRECTORY/$path/i;
      }
    }
    print $fhNew $line ."\n";
  }

  # move config.win
  my $newWin = $path ."/config.win";
  my $oldWin = $path ."/text/config.win";
  # move config.pro to create a new adapted one
  if(!move($oldWin, $newWin)){
    testFailed($test);
    if($verbose > 0){
      print "Could not move config.win in place (". $newWin .")\n";
    }
    exit 1;
  }

  # create shortcut
  # determine executable
  my $exe = "";
  if(-e $installPath ."\\bin\\proe.exe"){
    $exe = $installPath ."\\bin\\proe.exe";
  }
  if(-e $installPath ."\\..\\..\\Parametric\\bin\\parametric.exe"){
    $exe = $installPath ."\\..\\..\\Parametric\\bin\\parametric.exe";
  }
  # Creo 3 path structure
  if(-e $installPath ."\\..\\Parametric\\bin\\parametric.exe"){
    $exe = $installPath ."\\..\\Parametric\\bin\\parametric.exe";
  }
  if(!-e $exe){
    if($verbose > 0){
      print "Could not create shortcut\n";
    }
  }
  else{