tmake

这是用VB6.0写的一个通用的CPU卡操作程序,支持PC/SC接口 安装任何一个PC/SC驱动的IC读写器后,都可以使用此程序进行CPU卡的测试

    return join(" ",@a);
}

#
# list_moc(files,prefix,extension)
#
# Scans all files and selects all files that contain Q_OBJECT.
# Insert a prefix before the filename and replaces the filename extention.
#

sub list_moc {
    my($files,$pre,$ext) = @_;
    my(@v,@m,@lines,$contents,$n,$f,$t);
    @v = split(/\s+/,$files);
    undef $/;
    foreach $f ( @v ) {
	if ( open(TMP,&fix_path($f)) ) {
	    $contents = <TMP>;
	    close(TMP);
	    $n = 0;
	    @lines = split(/\n/,$contents);
	    grep( /tmake\s+ignore\s+Q_OBJECT/ && $n--, @lines );
	    $contents =~ s-//.*\n--g;		# strip C/C++ comments
	    $contents =~ s-/\*.*?\*/--gs;
	    @lines = split(/\n/,$contents);
	    grep( /(^|\W)(Q_OBJECT)|(Q_COMPONENT)(\W|$)/ && $n++, @lines );
	    if ( $n > 0 ) {
		$t = $f;
		$t =~ s-^(.*[/\\])?([^/\\]*?)\.(\w+)$-$1${pre}$2.${ext}-;
		if ( defined($project{"MOC_DIR"}) ) {
		    $t =~ s-^.*[\\/]--;
		    $t = $project{"MOC_DIR"} . $t;
		}
		$moc_output{$f} = $t;
		$moc_input{$t}	= $f;
		push(@m,$t);
	    }
	    $contents = "";
	}
    }
    $/ = "\n";
    return join(" ",@m);
}


#
# BuildObj(objects,sources)
#
# Builds the object files.
#

sub BuildObj {
    my($obj,$src) = @_;
    my(@objv,$srcv,$i,$s,$o,$d,$c,$comp,$cimp);
    @objv = split(/\s+/,$obj);
    @srcv = split(/\s+/,$src);
    for $i ( 0..$#objv ) {
	$s = $srcv[$i];
	$o = $objv[$i];
	next if $s eq "";
	$text .= $o . ": " . $s;
	if ( defined($moc_output{$s}) && ($moc_output{$s} ne "") ) {
	    $text .= " ${linebreak}\n\t\t" . $moc_output{$s};
	}
	if ( defined($uic_dependency{ $s } ) ) {
	    $d = $uic_dependency{ $s };
	} else {
	    $d = &make_depend($s);
	}
	$text .= " ${linebreak}\n\t\t" . $d if $d ne "";
	if ( ($s =~ /\.c$/) ) {
	    $comp = "TMAKE_RUN_CC";
	    $cimp = "TMAKE_RUN_CC_IMP";
	} else {
	    $comp = "TMAKE_RUN_CXX";
	    $cimp = "TMAKE_RUN_CXX_IMP";
	}
	if ( defined($project{"OBJECTS_DIR"}) ||
	     !defined($project{$cimp}) ) {
	    $c = $project{$comp};
	    $c =~ s/\$src/$s/;
	    $c =~ s/\$obj/$o/;
	    $text .= "\n\t$c";
	}
	$text .= "\n\n";
    }
    chomp $text;
}


#
# BuildMocObj(objects,sources)
#
# Builds the moc object files.
#

sub BuildMocObj {
    my($obj,$src) = @_;
    my(@objv,$srcv,$i,$s,$o,$hdr,$d);
    @objv = split(/\s+/,$obj);
    @srcv = split(/\s+/,$src);
    for $i ( 0..$#objv ) {
	$s = $srcv[$i];
	$o = $objv[$i];
	$hdr = $moc_input{$srcv[$i]};
	$text .= $o . ": " . $s . " ${linebreak}\n\t\t" . $hdr;
	$d = &make_depend($hdr);
	$text .= " ${linebreak}\n\t\t" . $d if $d ne "";
	if ( defined($project{"OBJECTS_DIR"}) || defined($project{"MOC_DIR"})||
	     !defined($project{"TMAKE_RUN_CXX_IMP"}) ) {
	    $c = $project{"TMAKE_RUN_CXX"};
	    $c =~ s/\$src/$s/;
	    $c =~ s/\$obj/$o/;
	    $text .= "\n\t$c";
	}
	$text .= "\n\n";
    }
    chop $text;
}


#
# BuildMocSrc(files)
#
# Builds the moc source files from headers and sources.
#

sub BuildMocSrc {
    my($f) = @_;
    my(@v,$m,$o);
    @v = split(/\s+/,$f);
    foreach $m ( @v ) {
	$o = $moc_output{$m};
	if ( defined($o) && ($o ne "") ) {
	    $text .= "$o: $m\n\t$moc_cmd $m -o $o\n\n";
	}
    }
    chop $text;
}

#
# BuildUicSrc(files)
#
# Builds the uic source files from interface definitions
#

sub BuildUicSrc {
    my($f) = @_;
    my(@v,$m,$o);
    @v = split(/\s+/,$f);
    foreach $m ( @v ) {
	$decl = $m;
	$decl =~ s/\.ui$/\.$uic_decl/;
	$impl = $m;
	$impl =~ s/\.ui$/\.$uic_impl/;
	$text .= "$decl: $m\n\t$uic_cmd $m -o $uic_decl_path/$decl\n\n";
	$fulldecl = $decl;
	$decl =~ s/.*\///; # No path - use -I... to find it.
	if ( ! ( $fulldecl eq $decl ) ) {
	  $text .= "$decl: $m\n\t$uic_cmd $m -o $decl\n\n";
	}
	$text .= "$impl: $m\n\t$uic_cmd $m -i $decl -o $impl\n\n";
    }
    chop $text;
}


#
# AddIncludePath(path)
#
# Adds path to the current include path, $project{"INCLUDEPATH"}.
#

sub AddIncludePath {
    my($path) = @_;
    my($p);
    if ( $project{"INCPATH"} &&
	 ($project{"INCPATH"} =~ /(?:^|\s)\Q$path\E(?:\s|$)/) ) {
	return;
    }
    $project{"INCLUDEPATH"} = "" if !defined($project{"INCLUDEPATH"});
    if ( !defined($project{"INCPATH_SEP"}) ) {
	if ( $project{"INCLUDEPATH"} =~ /;/ ) {
	    $project{"INCPATH_SEP"} = ";";
	} else {
	    $project{"INCPATH_SEP"} = " ";
	}
    }
    $p = $project{"INCLUDEPATH"};
    $p = ($p && $path) ? ($p . ";" . $path) : ($p . $path);
    $project{"INCLUDEPATH"} = $p;
    $p = join($project{"INCPATH_SEP"},&split_path($p));
    $p =~ s=[\\/]($project{"INCPATH_SEP"}|$)=$project{"INCPATH_SEP"}=g;
    $project{"INCPATH"} = $p;
}


#
# FindHighestLibVersion(dir,name)
#
# Returns the newest library version. Scans all the files in the specifies
# directory and returns the highest version number.
#
# Used on Windows only.
#
# Example:
#    FindHighestLibVersion("c:\qt\lib","qt") returns "200" if
#    the c:\qt\lib directory contains qt141.lib and qt200.lib.
#

sub FindHighestLibVersion {
    my($dir,$name) = @_;
    my(@files,$f,$v,$highest);
    $highest = "";
    @files = find_files($dir,"${name}.*\.lib");
    for $f ( @files ) {
	if ( $f =~ /(\d+)\.lib$/i ) {
	    $v = $1;
	    if ( $highest eq "" || $v > $highest ) {
		$highest = $v;
	    }
	} elsif ( $f =~ /(-mt(?:\d+)nc)\.lib$/i ) {
	    $v = $1;
	    if ( $highest eq "" || $v gt $highest ) {
		$highest = $v;
	    }
	}
    }
    return $highest;
}


#
# Finds files.
#
# Examples:
#   find_files("/usr","\.cpp$",1)   - finds .cpp files in /usr and below
#   find_files("/tmp","^#",0)	    - finds #* files in /tmp
#

sub find_files {
    my($dir,$match,$descend) = @_;
    my($file,$p,@files);
    local(*D);
    $dir =~ s=\\=/=g;
    ($dir eq "") && ($dir = ".");
    if ( opendir(D,&fix_path($dir)) ) {
	if ( $dir eq "." ) {
	    $dir = "";
	} else {
	    ($dir =~ /\/$/) || ($dir .= "/");
	}
	foreach $file ( readdir(D) ) {
	    next if ( $file  =~ /^\.\.?$/ );
	    $p = $dir . $file;
	    if ( $is_unix ) {
		($file =~ /$match/) && (push @files, $p);
	    } else {
		($file =~ /$match/i) && (push @files, $p);
	    }
	    if ( $descend && -d $p && ! -l $p ) {
		push @files, &find_files($p,$match,$descend);
	    }
	}
	closedir(D);
    }
    return @files;
}


#
# make_depend(file)
#
# Returns a list of included files.
# Uses the global $depend_path variable.
#

sub make_depend {
    my($file) = @_;
    my($i,$count);
    if ( $nodepend ) {
	return "";
    }
    if ( ! $depend_path_fixed ) {
	$depend_path_fixed = 1;
	if ( defined($project{"DEPENDPATH"}) ) {
	    $depend_path = $project{"DEPENDPATH"};
	} else {
	    $depend_path = "";
	}
	$count = 0;
	while ( $count < 100 ) {
	    if ( $depend_path =~ s/(\$[\{\(]?\w+[\}\)]?)/035/ ) {
		$_ = $1;
		s/[\$\{\}\(\)]//g;
		$depend_path =~ s/035/$ENV{$_}/g;
	    } else {
		$count = 100;
	    }
	}
	@dep_path = &split_path($depend_path);
    }
    @cur_dep_path = @dep_path;
    if ( $file =~ /(.*[\/\\])/ ) {
	$dep_curdir = $1;
	push @cur_dep_path, $dep_curdir;
    } else {
	$dep_curdir = "";
    }
    $dep_file = $file;
    &canonical_dep($file);
    %dep_dict = ();
    $i = &build_dep($file);
    chop $i;
    $i =~ s=/=$dir_sep=g unless $is_unix;
    $i =~ s=([a-zA-Z]):/=//$1/=g if (defined($gnuwin32) && $gnuwin32);
    return join(" ${linebreak}\n\t\t",split(/ /,$i) );
}

#
# build_dep() - Internal for make_depend()
#

sub build_dep {
    my($file) = @_;
    my(@i,$a,$n);
    $a = "";
    return $a if !(defined $depend_dict{$file});
    @i = split(/ /,$depend_dict{$file});
    for $n ( @i ) {
	if ( !defined($dep_dict{$n}) && ( defined($full_path{$n}) ) ) {
	    $dep_dict{$n} = 1;
	    $a .= $full_path{$n} . " " . &build_dep($n);
	}
    }
    return $a;
}

#
# canonical_dep(file) - Internal for make_depend()
#
# Reads the file and all included files recursively.
# %depend_dict associates a file name to a list of included files.
#

sub canonical_dep {
    my($file) = @_;
    my(@inc,$i);
    @inc = &scan_dep($file);
    if ( @inc ) {
	$depend_dict{$file} = join(" ",@inc);
	for $i ( @inc ) {
	    &canonical_dep($i) if !defined($depend_dict{$i});
	}
    }
}

#
# scan_dep(file) - Internal for make_depend()
#
# Returns an array of included files.
#

sub scan_dep {
    my($file) = @_;
    my($dir,$path,$found,@allincs,@includes,%incs);
    $path = $file;
    @includes = ();
    return @includes if $file =~ /\.$moc_ext$/; # avoid .moc files
    if ( ! (-f &fix_path($path)) ) {
	$found = 0;
	for $dir ( @cur_dep_path ) {
	    $path = $dir . $file;
	    last if ( $found = (-f &fix_path($path)) );
	}
	return @includes if ! $found;
    }
    undef $/;
    if ( open(TMP,&fix_path($path)) ) {
	$full_path{$file} = $path;
	$_ = <TMP>;
	s-//.*\n-\n-g;
	s-/\*.*?\*/--gs;			# strip C/C++ comments
	@allincs = split(/\n/,$_);
	@allincs = grep(/^\s*\#\s*include/,@allincs);
	foreach ( @allincs ) {			# all #include lines
	    next if !(/^\s*\#\s*include\s+[<\"]([^>\"]*)[>\"]/) || defined($incs{$1});
	    push(@includes,$1);
	    $incs{$1} = "1";
	    my $headerfile = $1;
	    my $hfile = $headerfile;
	    $hfile =~ s/\+/\\\+/g;
	    $full_path{$headerfile} ||= &fix_path( $headerfile )
	      if ( $project{"UICDECLS"} =~ /\b$hfile\b/ );
	}
	close(TMP);
    }
    $/ = "\n";
    return @includes;
}


#
# split_path(path)
#
# Splits a path containing : (Unix) or ; (MSDOS, NT etc.) separators.
# Returns an array.
#

sub split_path {
    my($p) = @_;
    my($s,@d);
    @d = ();
    return @d if !defined($p) || $p eq "";
    $p =~ s=:=;=g if $is_unix;
    $p =~ s=[/\\]+=/=g;
    if ( !($p =~ /;/) ) {
	$p =~ s/\s+/;/g;
    }
    $p =~ s/\s*;\s*/;/g;
    while( $p =~ /(?:(?:[^\"\;][^\;]*;*)|(?:\"[^\"]*\";*))/g ) {
	$s = $&;
	$s =~ s=\"==g;
	$s =~ s=[\s\;]+$==g;
	$s =~ s=([^/:])$=$1/=g;
	$s =~ s=/=$dir_sep=g unless $is_unix;
	push @d, $s;
    }
    return @d;
}


#
# fix_path(path)
#
# Converts all '\' to '/' if this really seems to be a Unix box.
# Also expands $(...) environment variables (god for $(QTDIR)).
#

sub fix_path {
    my($p) = @_;
    if ( $really_unix ) {
	$p =~ s-\\-/-g;
    } else {
	$p =~ s-/-\\-g;
    }
    $p =~ s/\$\(([^)]*)\)/$ENV{$1}/gs;
    return $p;
}


#
# mkdirp(filename,mode) - Internal for StdInit()
#
# Creates the directory specified by $filename, with permissions
# specified by mode (as modified by umask). Recursively calls
# mkdir, similar to 'mkdir -p'.
#

sub mkdirp {
    my($filename,$mode) = @_;
    if ( $filename =~ /\$\(\w+\)/ ) {  # ignore "$(something)"
	return 0;
    }
    $filename =~ s-[\\:/]+-/-g;
    if ( -d $filename ) {
	return 1;
    }
    $filename =~ m-^((.*)/)?(.*)-;
    if ( defined($2) && ! mkdirp($2,$mode) ) {
	return 0;
    }
    return mkdir($filename,$mode);

}