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 $globalname$name.vql: $!" unless
118	    open(G,">$globalname$name.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 $globalname$name.vql > $globalname$name.vqh";
128	print ">>> $command\n";
129	die "Couldn't build latticebook.\n\tcommand:$command\n"
130	    if syst($command);
131
132	if(-e $datafile){
133
134	    if($interleave=~/non/){
135		$restune="res1tune";
136	    }else{
137		$restune="res0tune";
138	    }
139
140	    if($seqp=~/cull/){
141		my $command="$restune $globalname$name.vqh $datafile 1 > temp$$.vqh";
142		print ">>> $command\n";
143		die "Couldn't tune latticebook.\n\tcommand:$command\n"
144		    if syst($command);
145	    }else{
146		my $command="$restune $globalname$name.vqh $datafile > temp$$.vqh";
147		print ">>> $command\n";
148		die "Couldn't tune latticebook.\n\tcommand:$command\n"
149		    if syst($command);
150	    }
151
152	    my $command="mv temp$$.vqh $globalname$name.vqh";
153	    print ">>> $command\n";
154	    die "Couldn't rename latticebook.\n\tcommand:$command\n"
155		if syst($command);
156
157	}else{
158	    print "No matching training file; leaving this codebook untrained.\n";
159	}
160
161	my $command="rm $globalname$name.vql";
162	print ">>> $command\n";
163	die "Couldn't remove temp files.\n\tcommand:$command\n"
164	    if syst($command);
165
166	next;
167    }
168}
169
170$command="rm -f temp$$.vqd";
171print ">>> $command\n";
172die "Couldn't remove temp files.\n\tcommand:$command\n"
173    if syst($command);
174
175sub syst{
176    system(@_)/256;
177}
178