mexsetup.pm

此程序是本人编写的在MFC环境下调用Matlab函数进行编程的实例

package mexsetup;

=head1 NAME

mexsetup - Handle setting up a default options file for mex or mbuild

=head1 SYNOPSIS

 use mexsetup;
 &setup($tool_name, # "mex" or "mbuild"
        $opts_dir,  # The directory containing the .stp setup files and .bat opts files
        $desired_languages, # An array reference containing uppercase strings of the 
                            # desired programming language for which to set up. All 
                            # compilers are listed if any of these strings are 'ANY'.
        $automode   # if true, automatically search for compilers, and if only one is 
                    # found, install it without bothering the user
        );

=head1 DESCRIPTION

Scans the directory $opts_dir for files with the .stp extension. Dynamically runs the 
perl code in those files to gather information about supported compilers. Uses this 
information to present a list to the user of supported compilers. Copies the template 
options file (also in $opts_dir) corresponding to the user selected compiler to the 
user's Profile directory.

A .stp file should contain one function, whose name is the same as the .stp file, minus
the ".stp". The function will be passed one input, a hash reference with at least the 
following fields:

    matlab_bin      => a string containing the location <MATLAB>\bin\win32.
    registry_lookup => a reference to a function which takes two input strings, 
                       a key and a name, and looks them up in the HKEY_LOCAL_MACHINE
                       portion of the Windows Registry. The function returns a string
                       containing the queried data, or an empty string if the data could
                       not be found.
    search_path     => a reference to a function which takes one input string, a 
                       filename, and searches for it on the DOS path. The function 
                       returns a string containing the directory in which the filename 
                       was found, or an empty string if the file could not be found.

The function returns a second hash reference, containing at least the following fields:

    vendor_name      => The full (vendored) name of the compiler 
                        (e.g. "Microsoft Visual C/C++").
    version          => The version of the compiler, as a string (e.g. "6.0")
    group_id         => A string containing the group to which this setup file belongs.
                        Usually, each vendor has its own group id. If the vendor changes
                        the name of the compiler (e.g. Borland C++ changed to Borland 
                        C++Builder), one can have mexsetup treat the two differently
                        named compilers as just different versions of the same compiler 
                        by having their .stp files contain the same group_id. The user
                        never sees the group_id.
    serial           => A serial number. Each .stp file with a given group_id must 
                        have a unique serial number. The serial number should increase
                        with each new version of the compiler. (e.g. MSVC 4.2 has a
                        serial number of 1.0, MSVC 5.0 has a serial number of 2.0, and
                        MSVC 6.0 has a serial number of 3.0.)
    optfile_name     => The base name of the template options file to copy to the 
                        user's Profile directory. This file must reside in $opts_dir as
                        well. (e.g. "msvc60opts.bat".)
    default_location => A string containing the location where the compiler's installer
                        installs the compiler by default.         
    language_handled => A reference to a function which accepts a string containing a
                        language and returns true if the language is handled by the 
                        compiler and false if it isn't. Current inputs can be "C", 
                        "CPP", and "FORTRAN".
    locate           => A reference to a function with no inputs, which returns a 
                        reference to an array of strings, each of which represents a 
                        directory where the compiler is located. The array can legally
                        have zero, one, or more entries. Setup() considers the leftmost
                        entry which has not also been returned by a locate function from
                        a .stp file with a higher serial number to be the directory 
                        where the compiler is located. This allows setup() to locate
                        multiple versions of the same compiler.
    root_var         => The name of the environment variable in the template options 
                        file which setup() will burn with the location of the compiler. 
                        When setup() copies the template options file from $opts_dir to
                        the user's Profile directory, it will search for a line of the 
                        form:
                         
                        set <root_var>=%<anystring>%
                      
                        It will replace %<anystring>% with the output of the root_val 
                        entry actual (see below), which usually is the location of the 
                        compiler.
    root_val         => A reference to a function which takes one string input, 
                        containing the base location of the compiler, and returns a 
                        string, containing the value to burn into the options file 
                        copied to the user's Profile directory. Under most circumstances
                        this function can simply return its input as its output. 
                        However, see msvc60opts.stp for an example of a .stp file where
                        it does not.
    post_setup_fcn   => (optional) A reference to a function with no inputs or outputs. 
                        If this entry exists, it is called by setup() after copying the 
                        template options file to the user's Profile directory.

Many .stp files are provided in <MATLAB>/bin/win32/mexopts and 
<MATLAB>/bin/win32/mbuildopts. These can be used as examples for creating .stp files 
for other (non-MathWorks supported) compilers.

=head1 COPYRIGHT

Copyright (c) 1999-2000 The MathWorks, Inc. All rights reserved.

=cut

# $Revision: 1.7 $

use Exporter ();
@ISA = qw(Exporter);

@EXPORT = qw(setup);

use Win32::Registry;
use strict;
use getprofiledir;

# Sort routine to sort compiler setup records by vendor name,
# with serial number as a secondary key.
sub by_vendor_and_serial
{
    if ($a->{"vendor_name"} lt $b->{"vendor_name"})
    {
        return -1;
    } 
    elsif ($a->{"vendor_name"} eq $b->{"vendor_name"})
    {
        return $b->{"serial"} <=> $a->{"serial"};
    }
    else
    {
        return 1;
    }
}

# Sort routine to sort compiler setup records by group id,
# with serial number as a secondary key.
sub by_group_and_serial
{
    if ($a->{"group_id"} lt $b->{"group_id"})
    {
        return -1;
    } 
    elsif ($a->{"group_id"} eq $b->{"group_id"})
    {
        return $b->{"serial"} <=> $a->{"serial"};
    }
    else
    {
        return 1;
    }
}

# Given a string S and a reference to an array of strings A, return
# true if any element of A equals S.
sub is_in
{
    my ($elem, $set_ref) = @_;
    my $set_elem;

    foreach $set_elem (@$set_ref)
    {
        if ($set_elem eq $elem)
        {
            return 1;
        }
    }
    
    return 0;
}    

sub query_info 
{
# queries and verifies that the 'var_value' is between the
# 'lower_limit' and the 'upper_limit'.  if not, then query for the
# 'request', citing the 'problem' as the reason.
# (this is used by 'setup')
    my ($lower_limit, $upper_limit, $problem, $request) = @_;
    my $var_value;

    chop($var_value=<STDIN>);
    # Verify that the value is with in the boundaries. It must be an integer.
    while (!($var_value =~ /[0-9]+/) ||
           $var_value<$lower_limit|$var_value>$upper_limit) {
	print "$problem\n";
	print "$request";
	chop($var_value=<STDIN>);
    }

    $var_value;
}

# This function looks up a string in the Windows registry. The first
# argument is a Registry key, and the second is a value name to
# look up under that key. The return argument is the corresponding
# value data, or an empty string if the key of value name are not
# found.
sub registry_lookup
{
    my ($key, $name) = @_;
    my ($value, %values, $hkey, $RegKey, $RegValue);
    my $data = "";

    if ($main::HKEY_LOCAL_MACHINE->Open($key, $hkey))
    {
        $hkey->GetValues(\%values);
        foreach $value (keys(%values))
        {
            $RegKey = $values{$value}->[0];
            $RegValue = $values{$value}->[2];
            if ($RegKey eq $name) {
                $data = $RegValue;
            }
        }
        $hkey->Close();
    }

    return($data);
} # registry_lookup

# Check for existence of a directory. If it doesn't exist, make it.
sub ensure_dir
{
    my ($dir) = @_;

    if (!(-d $dir))
    {
        my $parent_dir = $dir;
        $parent_dir =~ s/\\[^\\]+$//;
        &ensure_dir($parent_dir);
        if (mkdir($dir, 777) == 0)
        {
            die "Error: Cannot create directory \"$dir\"";
        }
    }
}

# Search DOS PATH environment variable for $binary_name.  Return
# the directory containing the binary if found on the path, or an
# empty path otherwise.
sub search_path 
{
    my ($binary_name) = @_;
    my (@path, $path_entry, $found);

    foreach ( split(/;/,$ENV{'PATH'}) ) 
    {
	if ( -e "$_\\$binary_name" ) 
        {
	    return $_;
	}
    }
    '';
} # search_path

# Copy a template mex or mbuild options file to the user's profile directory,
# "burning" into it the location of the selected compiler.
# If $ask_no_questions is true, no confirmation notice will be given.
sub install_options_file 
{
    my ($tool_name,       # "mex" or "mbuild"
        $record,          # Compiler setup record for selected compiler
        $opts_dir,        # Directory containing the .stp setup files and .bat opts files
        $chosen_location, # Directory containing the selected compiler
        $ask_no_questions # Don't confirm setup if true
        ) = @_;
    
    my $status;

    if (!$ask_no_questions)
    {
        # before making the edits, verify from the user all the information is correct
        print "\nPlease verify your choices:\n\n";
        print "Compiler: " . $record->{"vendor_name"} . " " . $record->{"version"} . "\n";
        print "Location: $chosen_location\n";
        print "\nAre these correct?([y]/n): ";
        chop($status=<STDIN>);
        if ($status eq "n" || $status eq "no")
        {
            print "\n  $tool_name: No compiler selected. No action taken.\n\n";
            return 1;
        }
    }
    my $root_val_fcn = $record->{"root_val"};
    my $root_val = &$root_val_fcn($chosen_location);

    # Get the target directory and make sure it exists:
    my $destOptsDir = &get_user_profile_dir;
    &ensure_dir($destOptsDir);

    my $destOptsFile;
    if ($tool_name eq "mex")
    {
	$destOptsFile="$destOptsDir\\mexopts.bat";
    }
    else
    {
    	$destOptsFile="$destOptsDir\\compopts.bat";
    }

    my $srcOptsFile = $opts_dir . "\\" . $record->{"optfile_name"};

    print "\nThe default options file:\n\"$destOptsFile\"\nis being updated " .
        "from $srcOptsFile...\n\n";

    # Open and read in the template options file.
    open (OPTIONSFILE, "<$srcOptsFile") || die "Error: Can't open $srcOptsFile";
    my @OptionsFile = <OPTIONSFILE>;
    close(OPTIONSFILE);

    # If the options file is read-only, ask if they want to overwrite it.
    if (-e $destOptsFile && ! -W $destOptsFile)
    {
        print "The options file $destOptsFile\nis read-only. Overwrite y/[n]? ";
	chop($status=<STDIN>);
	if ($status eq "y")
        {
            printf "Saving old options file in $destOptsFile.old\n";
            unlink("$destOptsFile.old");
            rename($destOptsFile,"$destOptsFile.old");
            unlink($destOptsFile);