[OpenSPARC-T2-DV] / tools / perlmod / Midas / 3.32 / lib / site_perl / 5.8.0 / Midas / Interface.pm

# ========== Copyright Header Begin ==========================================
# 
# OpenSPARC T2 Processor File: Interface.pm
# Copyright (C) 1995-2007 Sun Microsystems, Inc. All Rights Reserved
# 4150 Network Circle, Santa Clara, California 95054, U.S.A.
#
# * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. 
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; version 2 of the License.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
# For the avoidance of doubt, and except that if any non-GPL license 
# choice is available it will apply instead, Sun elects to use only 
# the General Public License version 2 (GPLv2) at this time for any 
# software where a choice of GPL license versions is made 
# available with the language indicating that GPLv2 or any later version 
# may be used, or where a choice of which version of the GPL is applied is 
# otherwise unspecified. 
#
# Please contact Sun Microsystems, Inc., 4150 Network Circle, Santa Clara, 
# CA 95054 USA or visit www.sun.com if you need additional information or 
# have any questions. 
# 
# ========== Copyright Header End ============================================
# -*- perl -*-

package Midas::Interface;

use strict;
require Exporter;

our @ISA = qw(Exporter);
our @EXPORT = qw(midas);

use Getopt::Long;
use File::Spec;
use File::Find;
use File::Basename;
use FindBin '$Bin';
use Cwd;

use Midas::Globals;


use Midas::Command;

use Midas::Error;

# These modules are used, but they are brought in lazily if needed to speed
# up the case where they're not.

#use Midas::Configure;
#use Midas::Assembler;


###############################################################################
###############################################################################

our @Configurable_commands = qw(pal cpp m4 as ld gcc);

sub midas {
  my @argv = @_;

  my $startdir = getcwd;

  eval {

    local (@ARGV) = @argv;

    clear_globals();
    init_error();


    # set defaults
    my %opt =
      (
       h             => 0,
       verbose       => 2,
       stdinc        => 1,
       include_build => 0,
       include_start => 0,
       stddef        => 1,
       E             => 0,
       print_errors  => 1,
       dest_dir      => '.',

#       build_threads  => 3,
       copy_products  => 0,
       gen_all_tsbs   => 0,
	addphdr	      => 0,
      );


    my @options =
      qw(
	 h
	 stdinc!
	 stddef!
	 include_build!
	 include_start!
	 verbose|v:i
	 noverbose|nov
	 version
	 format
	 find
	 find_root=s
	 E
	 I=s@
	 D=s@
	 L=s@
	 C=s@
	 diag_root=s
	 build_dir=s
	 dest_dir=s
	 mmu=s
	 ttefmt=s
	 tsbtagfmt=s

	 addphdr!	

	 cleanup!
	 force_cleanup!
	 force_build|f!
	
	 build_threads=i
	 copy_products!
	 gen_all_tsbs!

	 file=s@

	 start_phase=s
	 phase=s@

	 print_errors!
	 allow_tsb_conflicts!
	 allow_empty_sections!
	 allow_illegal_page_sizes!
	 allow_duplicate_tags!
	 allow_misaligned_tsb_base!
	 compress_image!
	 env_zero!
	 default_radix=s
	 errcode=i
	 pal_diag_args=s@
	 config=s
	 project=s
	);

    foreach my $cmd (@Configurable_commands) {
      my $use_standard_option = "std_${cmd}_args";
      my $args_option         = "${cmd}_args";
      my $cmd_option          = "${cmd}_cmd";
      $opt{$use_standard_option} = 1;  # make standard the default
      push @options,
	"${use_standard_option}!", "${args_option}=s@", "${cmd_option}=s";
    }

    my @save_argv = @ARGV;

    # Make -D and -I options more palatable to GetOptions
    @ARGV = map { /^(-[DILC])(\S.*)/ ? ($1, $2) : $_ } @ARGV;

    GetOptions(\%opt, @options) or fatal("Command-line parsing failed.\n",
					 M_ARGERR);
    usage(-exitval => M_NOERROR, -verbose => 2) if $opt{h};

    if(defined $opt{version} and $opt{version}) {
      print "Location: $0\n";
      print "Version:  $Midas::VERSION\n";
      exit M_NOERROR;
    }

    if(defined $opt{errcode}) {
      my $string = errcode_to_string($opt{errcode});
      print "CODE \"$opt{errcode}\"= $string\n";
      exit M_NOERROR;
    }

    if($opt{print_errors} == 0) {
      suppress_error_messages();
    }

    if(defined $opt{format} and $opt{format}) {
      my $fmt = File::Spec->catfile($Bin, 'midasformat');
      die "Cannot find \"$fmt\"\n" unless -e $fmt;
      system($fmt);
      exit M_NOERROR;
    }


    $opt{verbose} = 0 if defined $opt{noverbose} && $opt{noverbose};

    my $diag = shift @ARGV;
    fatal "No diag specified!\n", M_ARGERR unless defined $diag;

    if(not defined $opt{diag_root}) {
      if(exists $ENV{DV_ROOT} and defined $ENV{DV_ROOT}) {
	$opt{diag_root} = $ENV{DV_ROOT};
      } else {
	bad_arg("No -diag_root specified and DV_ROOT not set!\n");
      }
    }

    $opt{find} = 1 if (defined $opt{find_root} and $opt{find_root} ne '');
    if(defined $opt{find}) {
      my $find_root = (defined $opt{find_root} and $opt{find_root} ne '') ?
	$opt{find_root} : File::Spec->catdir($opt{diag_root}, 'verif', 'diag');
      $diag = find_diag($diag, $find_root);
    }


    if(defined $opt{ttefmt} and $opt{ttefmt} ne 'sun4u' and 
       $opt{ttefmt} ne 'sun4v') {
      bad_arg("Illegal -ttefmt setting.  Legal values are sun4u and sun4v.\n");
    }

    if(defined $opt{tsbtagfmt} and $opt{tsbtagfmt} ne 'tagaccess' and
       $opt{tsbtagfmt} ne 'tagtarget') {
      bad_arg("Illegal -tsbtagfmt setting '$opt{tsbtagfmt}'.  ".
	      "Legal values are tagaccess and tagtarget.\n");
    }

    if(defined $opt{default_radix} and $opt{default_radix} ne 'decimal' and
       $opt{default_radix} ne 'hex') {
      bad_arg("Illegal -default_radix setting.\n".
	      "Legal values are 'decimal' and 'hex'.\n");
    }

    if($opt{project}) {
      $PROJECT = $opt{project};
    }

    if($opt{config}) {
      $CONFIG_FILE = $opt{config};
    }

    my %config_args;
    my @config_list =
      qw(
	 mmu build_dir addphdr cleanup force_cleanup force_build allow_tsb_conflicts
	 allow_empty_sections allow_illegal_page_sizes allow_duplicate_tags
	 allow_misaligned_tsb_base env_zero
	 compress_image ttefmt tsbtagfmt default_radix build_threads
	 copy_products gen_all_tsbs verbose
	);
    foreach my $key (@config_list) {
      $config_args{$key} = $opt{$key} if (exists $opt{$key} and
					  defined $opt{$key});
    }
    # special-case.  Config name different from option name
    if(exists $config_args{mmu}) {
      $config_args{mmu_type} = $config_args{mmu};
      delete $config_args{mmu};
    }

    ###########################################################################

    # Configure module

    ###########################################################################

    my %config;
    # Midas::Configure takes a while to load.  Only use it if necessary
    my $code = q{
		  use Midas::Configure;

		  init_config();

		  %config =
		  Midas::Configure::configure
		  ( %config_args );
		 };

    eval $code;
    die $@ if $@;

    chat "midas @argv\n", 1;


    ### Configure include paths

    if(not $opt{stdinc}) {
      my @build = ($opt{include_build} ? (builddir => ['.']) : ());
      my @start = ($opt{include_start} ? (startdir => ['.']) : ());
      %config =
	Midas::Configure::configure(
				    cpp_includes => { @build, @start },
				    m4_includes  => { @build, @start },
				    c_includes   => { @build, @start },
				   );
    }

    if(defined $opt{I} and @{$opt{I}}) {
      my $cwd = getcwd;
      my @incs = map { File::Spec->rel2abs($_, $cwd) } @{$opt{I}};
      Midas::Configure::add_cpp_includes(@incs);
      Midas::Configure::add_m4_includes(@incs);
    }

    if(defined $opt{L} and @{$opt{L}}) {
      my $cwd = getcwd;
      my @incs = map { File::Spec->rel2abs($_, $cwd) } @{$opt{L}};
      Midas::Configure::add_link_includes(@incs);
    }

    if(defined $opt{C} and @{$opt{C}}) {
      my $cwd = getcwd;
      my @incs = map { File::Spec->rel2abs($_, $cwd) } @{$opt{C}};
      Midas::Configure::add_csrc_includes(@incs);
    }

    if(defined $opt{pal_diag_args}) {
      Midas::Configure::add_pal_diag_args(@{$opt{pal_diag_args}});
    }

    ### Configure defines

    if(not $opt{stddef}) {
      %config =
	Midas::Configure::configure( cpp_defines => [] );
    }

    if(defined $opt{D} and @{$opt{D}}) {
      Midas::Configure::add_cpp_defines(@{$opt{D}});
    }

    ### Configure commands

    foreach my $command (@Configurable_commands) {
      configure_command_options($command,
				$opt{"std_${command}_args"},
				$opt{"${command}_args"},
				$opt{"${command}_cmd"},
				\%config);
    }

    ### Configure file names

    configure_file_names($opt{file}, \%config) if defined $opt{file};

    ###########################################################################
    # Call magic function
    ###########################################################################

    if($opt{E}) {
      push @{$opt{phase}}, qw(setup preprocess);
    }


    $code = q{
	       # Midas::Assembly takes a while to load.  Only parse
	       # it if necessary.
	       use Midas::Assembly;


	       assemble_diag($diag,
			     -dest_dir  => $opt{dest_dir},
			     -diag_root => $opt{diag_root},
			     (map { -phase => $_ } @{$opt{phase}}),
			     (defined $opt{start_phase} ?
			      (-start_phase => $opt{start_phase}) : ()
			     ),
			     -argv => "@argv",
			    );
	      };

    eval $code;
    die $@ if $@;  # Throw up any exceptions to next level handler

  };

  chdir $startdir;

  return handle_error($@);
}
###############################################################################
###############################################################################

sub usage {
  my @args = @_;

  my $code = q{

		use Pod::Usage;

		pod2usage(@args);

	       };

  eval $code;
  die "Can't load Pod::Usage!: $@\n" if $@;
}

###############################################################################

sub bad_arg {
  my $message = shift;
  fatal $message, M_ARGERR;
}

##############################################################################

sub configure_command_options {
  my $command      = shift;
  my $use_standard = shift;
  my $add_args     = shift;
  my $cmd_option   = shift;
  my $configref    = shift;

  if(not defined $configref) {
    my %c = Midas::Configure::configure() unless defined $configref;
    $configref = \%c;
  }

  my $opt_config_key = "${command}_opt";
  my $cmd_config_key = "${command}_cmd";

  bad_arg("No such command \"$command\".\n")
    unless exists $configref->{$opt_config_key};

  if(not $use_standard) {
    Midas::Configure::configure($opt_config_key => []);
  }
  if(defined $add_args and @$add_args) {
    Midas::Configure::append_configuration($opt_config_key => $add_args);
  }
  if(defined $cmd_option) {
    Midas::Configure::configure($cmd_config_key => $cmd_option);
  }
}

##############################################################################

sub configure_file_names {
  my $file_list = shift;
  my $configref = shift;

  if(not defined $configref) {
    my %c = Midas::Configure::configure() unless defined $configref;
    $configref = \%c;
  }

  my @config;
  foreach my $spec (@$file_list) {
    bad_arg("-file argument is tag=name.\n")
      unless $spec =~ /^(\S+)=(\S.*)$/;
    my ($file, $name) = ($1, $2);
    my $config_tag = "local_$file";
    bad_arg("File tag \"$file\" is not a configurable file.\n")
      unless exists $configref->{$config_tag};
    push @config, $config_tag, $name;
  }
  Midas::Configure::configure(@config) if @config;

}

##############################################################################

sub find_diag {
  my $diag = shift;
  my $root = shift;

  my $diag_base = basename $diag;
  bad_arg("When -find is used, diag \"$diag\" should be a name, ".
	  "not a path.\n") if ($diag ne $diag_base);

  bad_arg("Can't find with root \"$root\": No such directory.\n")
    unless -d $root;

  my $found;
  my $found_ref = \$found;
  my $wanted = sub {
    if($diag_base eq $_) {
      $$found_ref = $File::Find::name;
    }
  };

  find($wanted, $root);

  bad_arg("Could not find file \"$diag\" in root \"$root\".\n")
    unless defined $found;

  return $found;
}

###############################################################################
###############################################################################
1;
Commit	Line	Data
86530b38 AT	1	# ========== Copyright Header Begin ==========================================
	2	#
	3	# OpenSPARC T2 Processor File: Interface.pm
	4	# Copyright (C) 1995-2007 Sun Microsystems, Inc. All Rights Reserved
	5	# 4150 Network Circle, Santa Clara, California 95054, U.S.A.
	6	#
	7	# * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
	8	#
	9	# This program is free software; you can redistribute it and/or modify
	10	# it under the terms of the GNU General Public License as published by
	11	# the Free Software Foundation; version 2 of the License.
	12	#
	13	# This program is distributed in the hope that it will be useful,
	14	# but WITHOUT ANY WARRANTY; without even the implied warranty of
	15	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	16	# GNU General Public License for more details.
	17	#
	18	# You should have received a copy of the GNU General Public License
	19	# along with this program; if not, write to the Free Software
	20	# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
	21	#
	22	# For the avoidance of doubt, and except that if any non-GPL license
	23	# choice is available it will apply instead, Sun elects to use only
	24	# the General Public License version 2 (GPLv2) at this time for any
	25	# software where a choice of GPL license versions is made
	26	# available with the language indicating that GPLv2 or any later version
	27	# may be used, or where a choice of which version of the GPL is applied is
	28	# otherwise unspecified.
	29	#
	30	# Please contact Sun Microsystems, Inc., 4150 Network Circle, Santa Clara,
	31	# CA 95054 USA or visit www.sun.com if you need additional information or
	32	# have any questions.
	33	#
	34	# ========== Copyright Header End ============================================
	35	# -- perl --
	36
	37	package Midas::Interface;
	38
	39	use strict;
	40	require Exporter;
	41
	42	our @ISA = qw(Exporter);
	43	our @EXPORT = qw(midas);
	44
	45	use Getopt::Long;
	46	use File::Spec;
	47	use File::Find;
	48	use File::Basename;
	49	use FindBin '$Bin';
	50	use Cwd;
	51
	52	use Midas::Globals;
	53
	54
	55	use Midas::Command;
	56
	57	use Midas::Error;
	58
	59	# These modules are used, but they are brought in lazily if needed to speed
	60	# up the case where they're not.
	61
	62	#use Midas::Configure;
	63	#use Midas::Assembler;
	64
65
66	###############################################################################
67	###############################################################################
68
69	our @Configurable_commands = qw(pal cpp m4 as ld gcc);
70
71	sub midas {
72	my @argv = @_;
73
74	my $startdir = getcwd;
75
76	eval {
77
78	local (@ARGV) = @argv;
79
80	clear_globals();
81	init_error();
82
83
84	# set defaults
85	my %opt =
86	(
87	h => 0,
88	verbose => 2,
89	stdinc => 1,
90	include_build => 0,
91	include_start => 0,
92	stddef => 1,
93	E => 0,
94	print_errors => 1,
95	dest_dir => '.',
96
97	# build_threads => 3,
98	copy_products => 0,
99	gen_all_tsbs => 0,
100	addphdr => 0,
101	);
102
103
104	my @options =
105	qw(
106	h
107	stdinc!
108	stddef!
109	include_build!
110	include_start!
111	verbose\|v:i
112	noverbose\|nov
113	version
114	format
115	find
116	find_root=s
117	E
118	I=s@
119	D=s@
120	L=s@
121	C=s@
122	diag_root=s
123	build_dir=s
124	dest_dir=s
125	mmu=s
126	ttefmt=s
127	tsbtagfmt=s
128
129	addphdr!
130
131	cleanup!
132	force_cleanup!
133	force_build\|f!
134
135	build_threads=i
136	copy_products!
137	gen_all_tsbs!
138
139	file=s@
140
141	start_phase=s
142	phase=s@
143
144	print_errors!
145	allow_tsb_conflicts!
146	allow_empty_sections!
147	allow_illegal_page_sizes!
148	allow_duplicate_tags!
149	allow_misaligned_tsb_base!
150	compress_image!
151	env_zero!
152	default_radix=s
153	errcode=i
154	pal_diag_args=s@
155	config=s
156	project=s
157	);
158
159	foreach my $cmd (@Configurable_commands) {
160	my $use_standard_option = "std_${cmd}_args";
161	my $args_option = "${cmd}_args";
162	my $cmd_option = "${cmd}_cmd";
163	$opt{$use_standard_option} = 1; # make standard the default
164	push @options,
165	"${use_standard_option}!", "${args_option}=s@", "${cmd_option}=s";
166	}
167
168	my @save_argv = @ARGV;
169
170	# Make -D and -I options more palatable to GetOptions
171	@ARGV = map { /^(-[DILC])(\S.*)/ ? ($1, $2) : $_ } @ARGV;
172
173	GetOptions(\%opt, @options) or fatal("Command-line parsing failed.\n",
174	M_ARGERR);
175	usage(-exitval => M_NOERROR, -verbose => 2) if $opt{h};
176
177	if(defined $opt{version} and $opt{version}) {
178	print "Location: $0\n";
179	print "Version: $Midas::VERSION\n";
180	exit M_NOERROR;
181	}
182
183	if(defined $opt{errcode}) {
184	my $string = errcode_to_string($opt{errcode});
185	print "CODE \"$opt{errcode}\"= $string\n";
186	exit M_NOERROR;
187	}
188
189	if($opt{print_errors} == 0) {
190	suppress_error_messages();
191	}
192
193	if(defined $opt{format} and $opt{format}) {
194	my $fmt = File::Spec->catfile($Bin, 'midasformat');
195	die "Cannot find \"$fmt\"\n" unless -e $fmt;
196	system($fmt);
197	exit M_NOERROR;
198	}
199
200
201	$opt{verbose} = 0 if defined $opt{noverbose} && $opt{noverbose};
202
203	my $diag = shift @ARGV;
204	fatal "No diag specified!\n", M_ARGERR unless defined $diag;
205
206	if(not defined $opt{diag_root}) {
207	if(exists $ENV{DV_ROOT} and defined $ENV{DV_ROOT}) {
208	$opt{diag_root} = $ENV{DV_ROOT};
209	} else {
210	bad_arg("No -diag_root specified and DV_ROOT not set!\n");
211	}
212	}
213
214	$opt{find} = 1 if (defined $opt{find_root} and $opt{find_root} ne '');
215	if(defined $opt{find}) {
216	my $find_root = (defined $opt{find_root} and $opt{find_root} ne '') ?
217	$opt{find_root} : File::Spec->catdir($opt{diag_root}, 'verif', 'diag');
218	$diag = find_diag($diag, $find_root);
219	}
220
221
222
223	if(defined $opt{ttefmt} and $opt{ttefmt} ne 'sun4u' and
224	$opt{ttefmt} ne 'sun4v') {
225	bad_arg("Illegal -ttefmt setting. Legal values are sun4u and sun4v.\n");
226	}
227
228	if(defined $opt{tsbtagfmt} and $opt{tsbtagfmt} ne 'tagaccess' and
229	$opt{tsbtagfmt} ne 'tagtarget') {
230	bad_arg("Illegal -tsbtagfmt setting '$opt{tsbtagfmt}'. ".
231	"Legal values are tagaccess and tagtarget.\n");
232	}
233
234	if(defined $opt{default_radix} and $opt{default_radix} ne 'decimal' and
235	$opt{default_radix} ne 'hex') {
236	bad_arg("Illegal -default_radix setting.\n".
237	"Legal values are 'decimal' and 'hex'.\n");
238	}
239
240	if($opt{project}) {
241	$PROJECT = $opt{project};
242	}
243
244	if($opt{config}) {
245	$CONFIG_FILE = $opt{config};
246	}
247
248	my %config_args;
249	my @config_list =
250	qw(
251	mmu build_dir addphdr cleanup force_cleanup force_build allow_tsb_conflicts
252	allow_empty_sections allow_illegal_page_sizes allow_duplicate_tags
253	allow_misaligned_tsb_base env_zero
254	compress_image ttefmt tsbtagfmt default_radix build_threads
255	copy_products gen_all_tsbs verbose
256	);
257	foreach my $key (@config_list) {
258	$config_args{$key} = $opt{$key} if (exists $opt{$key} and
259	defined $opt{$key});
260	}
261	# special-case. Config name different from option name
262	if(exists $config_args{mmu}) {
263	$config_args{mmu_type} = $config_args{mmu};
264	delete $config_args{mmu};
265	}
266
267	###########################################################################
268
269	# Configure module
270
271	###########################################################################
272
273	my %config;
274	# Midas::Configure takes a while to load. Only use it if necessary
275	my $code = q{
276	use Midas::Configure;
277
278	init_config();
279
280	%config =
281	Midas::Configure::configure
282	( %config_args );
283	};
284
285	eval $code;
286	die $@ if $@;
287
288	chat "midas @argv\n", 1;
289
290
291	### Configure include paths
292
293	if(not $opt{stdinc}) {
294	my @build = ($opt{include_build} ? (builddir => ['.']) : ());
295	my @start = ($opt{include_start} ? (startdir => ['.']) : ());
296	%config =
297	Midas::Configure::configure(
298	cpp_includes => { @build, @start },
299	m4_includes => { @build, @start },
300	c_includes => { @build, @start },
301	);
302	}
303
304	if(defined $opt{I} and @{$opt{I}}) {
305	my $cwd = getcwd;
306	my @incs = map { File::Spec->rel2abs($_, $cwd) } @{$opt{I}};
307	Midas::Configure::add_cpp_includes(@incs);
308	Midas::Configure::add_m4_includes(@incs);
309	}
310
311	if(defined $opt{L} and @{$opt{L}}) {
312	my $cwd = getcwd;
313	my @incs = map { File::Spec->rel2abs($_, $cwd) } @{$opt{L}};
314	Midas::Configure::add_link_includes(@incs);
315	}
316
317	if(defined $opt{C} and @{$opt{C}}) {
318	my $cwd = getcwd;
319	my @incs = map { File::Spec->rel2abs($_, $cwd) } @{$opt{C}};
320	Midas::Configure::add_csrc_includes(@incs);
321	}
322
323	if(defined $opt{pal_diag_args}) {
324	Midas::Configure::add_pal_diag_args(@{$opt{pal_diag_args}});
325	}
326
327	### Configure defines
328
329	if(not $opt{stddef}) {
330	%config =
331	Midas::Configure::configure( cpp_defines => [] );
332	}
333
334	if(defined $opt{D} and @{$opt{D}}) {
335	Midas::Configure::add_cpp_defines(@{$opt{D}});
336	}
337
338	### Configure commands
339
340	foreach my $command (@Configurable_commands) {
341	configure_command_options($command,
342	$opt{"std_${command}_args"},
343	$opt{"${command}_args"},
344	$opt{"${command}_cmd"},
345	\%config);
346	}
347
348	### Configure file names
349
350	configure_file_names($opt{file}, \%config) if defined $opt{file};
351
352	###########################################################################
353	# Call magic function
354	###########################################################################
355
356	if($opt{E}) {
357	push @{$opt{phase}}, qw(setup preprocess);
358	}
359
360
361	$code = q{
362	# Midas::Assembly takes a while to load. Only parse
363	# it if necessary.
364	use Midas::Assembly;
365
366
367	assemble_diag($diag,
368	-dest_dir => $opt{dest_dir},
369	-diag_root => $opt{diag_root},
370	(map { -phase => $_ } @{$opt{phase}}),
371	(defined $opt{start_phase} ?
372	(-start_phase => $opt{start_phase}) : ()
373	),
374	-argv => "@argv",
375	);
376	};
377
378	eval $code;
379	die $@ if $@; # Throw up any exceptions to next level handler
380
381	};
382
383	chdir $startdir;
384
385	return handle_error($@);
386	}
387	###############################################################################
388	###############################################################################
389
390	sub usage {
391	my @args = @_;
392
393	my $code = q{
394
395	use Pod::Usage;
396
397	pod2usage(@args);
398
399	};
400
401	eval $code;
402	die "Can't load Pod::Usage!: $@\n" if $@;
403	}
404
405	###############################################################################
406
407	sub bad_arg {
408	my $message = shift;
409	fatal $message, M_ARGERR;
410	}
411
412	##############################################################################
413
414	sub configure_command_options {
415	my $command = shift;
416	my $use_standard = shift;
417	my $add_args = shift;
418	my $cmd_option = shift;
419	my $configref = shift;
420
421	if(not defined $configref) {
422	my %c = Midas::Configure::configure() unless defined $configref;
423	$configref = \%c;
424	}
425
426	my $opt_config_key = "${command}_opt";
427	my $cmd_config_key = "${command}_cmd";
428
429	bad_arg("No such command \"$command\".\n")
430	unless exists $configref->{$opt_config_key};
431
432	if(not $use_standard) {
433	Midas::Configure::configure($opt_config_key => []);
434	}
435	if(defined $add_args and @$add_args) {
436	Midas::Configure::append_configuration($opt_config_key => $add_args);
437	}
438	if(defined $cmd_option) {
439	Midas::Configure::configure($cmd_config_key => $cmd_option);
440	}
441	}
442
443	##############################################################################
444
445	sub configure_file_names {
446	my $file_list = shift;
447	my $configref = shift;
448
449	if(not defined $configref) {
450	my %c = Midas::Configure::configure() unless defined $configref;
451	$configref = \%c;
452	}
453
454	my @config;
455	foreach my $spec (@$file_list) {
456	bad_arg("-file argument is tag=name.\n")
457	unless $spec =~ /^(\S+)=(\S.*)$/;
458	my ($file, $name) = ($1, $2);
459	my $config_tag = "local_$file";
460	bad_arg("File tag \"$file\" is not a configurable file.\n")
461	unless exists $configref->{$config_tag};
462	push @config, $config_tag, $name;
463	}
464	Midas::Configure::configure(@config) if @config;
465
466	}
467
468	##############################################################################
469
470	sub find_diag {
471	my $diag = shift;
472	my $root = shift;
473
474	my $diag_base = basename $diag;
475	bad_arg("When -find is used, diag \"$diag\" should be a name, ".
476	"not a path.\n") if ($diag ne $diag_base);
477
478	bad_arg("Can't find with root \"$root\": No such directory.\n")
479	unless -d $root;
480
481	my $found;
482	my $found_ref = \$found;
483	my $wanted = sub {
484	if($diag_base eq $_) {
485	$$found_ref = $File::Find::name;
486	}
487	};
488
489	find($wanted, $root);
490
491	bad_arg("Could not find file \"$diag\" in root \"$root\".\n")
492	unless defined $found;
493
494	return $found;
495	}
496
497	###############################################################################
498	###############################################################################
499	1;