1#!/usr/bin/perl
2
3# quick, very dirty little script so that we can put all the
4# information for building a residue book set (except the original
5# partitioning) in one spec file.
6
7#eg:
8
9# >res0_128_128 interleaved
10# haux 44c0_s/resaux_0.vqd res0_96_128aux 0,4,2 9
11# :1 res0_128_128_1.vqd, 4, nonseq cull, 0 +- 1
12# :2 res0_128_128_2.vqd, 4, nonseq, 0 +- 1(.7) 2
13# :3 res0_128_128_3.vqd, 4, nonseq, 0 +- 1(.7) 3 5
14# :4 res0_128_128_4.vqd, 2, nonseq, 0 +- 1(.7) 3 5 8 11
15# :5 res0_128_128_5.vqd, 1, nonseq, 0 +- 1 3 5 8 11 14 17 20 24 28 31 35 39
16
17
18die "Could not open $ARGV[0]: $!" unless open (F,$ARGV[0]);
19
20$goflag=0;
21while($line=<F>){
22
23    print "#### $line";
24    if($line=~m/^GO/){
25	$goflag=1;
26	next;
27    }
28
29    if($goflag==0){
30	if($line=~m/\S+/ && !($line=~m/^\#/) ){
31	    my $command=$line;
32	    print ">>> $command";
33	    die "Couldn't shell command.\n\tcommand:$command\n"
34		if syst($command);
35	}
36	next;
37    }
38
39    # >res0_128_128
40    if($line=~m/^>(\S+)\s+(\S*)/){
41	# set the output name
42	$globalname=$1;
43	$interleave=$2;
44	next;
45    }
46
47    # haux 44c0_s/resaux_0.vqd res0_96_128aux 0,4,2 9
48    if($line=~m/^h(.*)/){
49	# build a huffman book (no mapping)
50	my($name,$datafile,$bookname,$interval,$range)=split(' ',$1);
51
52	# check the desired subdir to see if the data file exists
53	if(-e $datafile){
54	    my $command="cp $datafile $bookname.tmp";
55	    print ">>> $command\n";
56	    die "Couldn't access partition data file.\n\tcommand:$command\n"
57		if syst($command);
58
59	    my $command="huffbuild $bookname.tmp $interval";
60	    print ">>> $command\n";
61	    die "Couldn't build huffbook.\n\tcommand:$command\n"
62		if syst($command);
63
64	    my $command="rm $bookname.tmp";
65	    print ">>> $command\n";
66	    die "Couldn't remove temporary file.\n\tcommand:$command\n"
67		if syst($command);
68	}else{
69	    my $command="huffbuild $bookname.tmp 0-$range";
70	    print ">>> $command\n";
71	    die "Couldn't build huffbook.\n\tcommand:$command\n"
72		if syst($command);
73
74	}
75	next;
76    }
77
78    # :1 res0_128_128_1.vqd, 4, nonseq, 0 +- 1
79    if($line=~m/^:(.*)/){
80	my($namedata,$dim,$seqp,$vals)=split(',',$1);
81	my($name,$datafile)=split(' ',$namedata);
82	# build value list
83	my$plusminus="+";
84	my$list;
85	my$thlist;
86	my$count=0;
87	foreach my$val (split(' ',$vals)){
88	    if($val=~/\-?\+?\d+/){
89		my$th;
90
91		# got an explicit threshhint?
92		if($val=~/([0-9\.]+)\(([^\)]+)/){
93		    $val=$1;
94		    $th=$2;
95		}
96
97		if($plusminus=~/-/){
98		    $list.="-$val ";
99		    if(defined($th)){
100			$thlist.="," if(defined($thlist));
101			$thlist.="-$th";
102		    }
103		    $count++;
104		}
105		if($plusminus=~/\+/){
106		    $list.="$val ";
107		    if(defined($th)){
108			$thlist.="," if(defined($thlist));
109			$thlist.="$th";
110		    }
111		    $count++;
112		}
113	    }else{
114		$plusminus=$val;
115	    }
116	}
117	die "Couldn't open temp file temp$$.vql: $!" unless
118	    open(G,">temp$$.vql");
119	print G "$count $dim 0 ";
120	if($seqp=~/non/){
121	    print G "0\n$list\n";
122	}else{
123	    print G "1\n$list\n";
124	}
125	close(G);
126
127	my $command="latticebuild temp$$.vql > $globalname$name.vqh";
128	print ">>> $command\n";
129	die "Couldn't build latticebook.\n\tcommand:$command\n"
130	    if syst($command);
131
132	my $command="latticehint $globalname$name.vqh $thlist > temp$$.vqh";
133	print ">>> $command\n";
134	die "Couldn't pre-hint latticebook.\n\tcommand:$command\n"
135	    if syst($command);
136
137	if(-e $datafile){
138
139	    if($interleave=~/non/){
140		$restune="res1tune";
141	    }else{
142		$restune="res0tune";
143	    }
144
145	    if($seqp=~/cull/){
146		my $command="$restune temp$$.vqh $datafile 1 > $globalname$name.vqh";
147		print ">>> $command\n";
148		die "Couldn't tune latticebook.\n\tcommand:$command\n"
149		    if syst($command);
150	    }else{
151		my $command="$restune temp$$.vqh $datafile > $globalname$name.vqh";
152		print ">>> $command\n";
153		die "Couldn't tune latticebook.\n\tcommand:$command\n"
154		    if syst($command);
155	    }
156
157	    my $command="latticehint $globalname$name.vqh $thlist > temp$$.vqh";
158	    print ">>> $command\n";
159	    die "Couldn't post-hint latticebook.\n\tcommand:$command\n"
160		if syst($command);
161
162	}else{
163	    print "No matching training file; leaving this codebook untrained.\n";
164	}
165
166	my $command="mv temp$$.vqh $globalname$name.vqh";
167	print ">>> $command\n";
168	die "Couldn't rename latticebook.\n\tcommand:$command\n"
169	    if syst($command);
170
171	my $command="rm temp$$.vql";
172	print ">>> $command\n";
173	die "Couldn't remove temp files.\n\tcommand:$command\n"
174	    if syst($command);
175
176	next;
177    }
178}
179
180$command="rm -f temp$$.vqd";
181print ">>> $command\n";
182die "Couldn't remove temp files.\n\tcommand:$command\n"
183    if syst($command);
184
185sub syst{
186    system(@_)/256;
187}
188