Line 1... |
Line 1... |
#!/usr/bin/perl -w
|
#!/usr/bin/perl -w
|
# $Id: tbw 314 2010-07-09 17:38:41Z mueller $
|
# $Id: tbw 420 2011-11-06 21:25:54Z mueller $
|
#
|
#
|
# Copyright 2007-2010 by Walter F.J. Mueller
|
# Copyright 2007-2011 by Walter F.J. Mueller
|
#
|
#
|
# This program is free software; you may redistribute and/or modify it under
|
# This program is free software; you may redistribute and/or modify it under
|
# the terms of the GNU General Public License as published by the Free
|
# the terms of the GNU General Public License as published by the Free
|
# Software Foundation, either version 2, or at your option any later version.
|
# Software Foundation, either version 2, or at your option any later version.
|
#
|
#
|
Line 12... |
Line 12... |
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
|
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
|
# for complete details.
|
# for complete details.
|
#
|
#
|
# Revision History:
|
# Revision History:
|
# Date Rev Version Comment
|
# Date Rev Version Comment
|
|
# 2011-11-06 420 1.2.3 fix tbw.dat parsing (allow / in file names)
|
# 2010-05-23 294 1.2.2 handle tb_code's in non-local directories
|
# 2010-05-23 294 1.2.2 handle tb_code's in non-local directories
|
# 2010-04-18 279 1.2.1 add -help and more text to print_usage()
|
# 2010-04-18 279 1.2.1 add -help and more text to print_usage()
|
# 2009-11-22 252 1.2 add ISim support
|
# 2009-11-22 252 1.2 add ISim support
|
# 2007-09-15 82 1.1.1 test for ambigous matches of name arguments; for
|
# 2007-09-15 82 1.1.1 test for ambigous matches of name arguments; for
|
# "suff=[l1;l2;..]" style inlines use linkname_tmp.tmp
|
# "suff=[l1;l2;..]" style inlines use linkname_tmp.tmp
|
Line 101... |
Line 102... |
|
|
open (TBW, $tbwdat_file) or die "failed to open $tbwdat_file: $!";
|
open (TBW, $tbwdat_file) or die "failed to open $tbwdat_file: $!";
|
while () {
|
while () {
|
chomp;
|
chomp;
|
next if /^#/;
|
next if /^#/;
|
if (/^\s*\[([\.\/a-zA-Z0-9_]*)\]\s*$/) {
|
if ( m{^\s*\[([\.\/a-zA-Z0-9_]*)\]\s*$} ) {
|
last if $done;
|
last if $done;
|
$ok = 0;
|
$ok = 0;
|
$ok = 1 if ($1 eq $tb_code || $1 eq $tb_code_stem);
|
$ok = 1 if ($1 eq $tb_code || $1 eq $tb_code_stem);
|
} elsif (/^\s*([a-zA-Z0-9_]*)\s*=\s*([a-zA-Z0-9_.<>]*)\s*$/) {
|
} elsif ( m{^\s*([a-zA-Z0-9_]*)\s*=\s*([a-zA-Z0-9_./<>]*)\s*$} ) {
|
if ($ok) {
|
if ($ok) {
|
push @file_dsc, {tag=>$1, val=>$2};
|
push @file_dsc, {tag=>$1, val=>$2};
|
$done = 1;
|
$done = 1;
|
}
|
}
|
|
} else {
|
|
print "tbw-E: bad line in tbw.dat:\n $_\n";
|
}
|
}
|
}
|
}
|
}
|
}
|
|
|
#
|
#
|
Line 123... |
Line 126... |
unless (scalar (@file_dsc)) {
|
unless (scalar (@file_dsc)) {
|
push @file_dsc, {tag=>$tb_code_stem . "_stim",
|
push @file_dsc, {tag=>$tb_code_stem . "_stim",
|
val=>$tb_code_stem . "_stim.dat"};
|
val=>$tb_code_stem . "_stim.dat"};
|
}
|
}
|
|
|
|
if (0) {
|
|
foreach my $dsc (@file_dsc) {
|
|
my $tag = $dsc->{tag};
|
|
my $val = $dsc->{val};
|
|
printf " %s = %s\n", $tag, $val;
|
|
}
|
|
}
|
|
|
#
|
#
|
# now process argument list
|
# now process argument list
|
#
|
#
|
|
|
{
|
{
|