annotate GEMBASSY-1.0.3/doc/text/copydesc.pl @ 1:84a17b3fad1f draft

Uploaded
author ktnyt
date Fri, 26 Jun 2015 05:20:29 -0400
parents 8300eb051bea
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
0
8300eb051bea Initial upload
ktnyt
parents:
diff changeset
1 use strict;
8300eb051bea Initial upload
ktnyt
parents:
diff changeset
2 use warnings;
8300eb051bea Initial upload
ktnyt
parents:
diff changeset
3
8300eb051bea Initial upload
ktnyt
parents:
diff changeset
4 my @progs = split "\n", `wossname -showembassy GEMBASSY -auto | cut -d ' ' -f 1| grep ^g | sort`;
8300eb051bea Initial upload
ktnyt
parents:
diff changeset
5
8300eb051bea Initial upload
ktnyt
parents:
diff changeset
6 copy($_) foreach @progs;
8300eb051bea Initial upload
ktnyt
parents:
diff changeset
7
8300eb051bea Initial upload
ktnyt
parents:
diff changeset
8 sub copy {
8300eb051bea Initial upload
ktnyt
parents:
diff changeset
9 my $prog = shift;
8300eb051bea Initial upload
ktnyt
parents:
diff changeset
10
8300eb051bea Initial upload
ktnyt
parents:
diff changeset
11 print STDERR "\r\e[K$prog";
8300eb051bea Initial upload
ktnyt
parents:
diff changeset
12
8300eb051bea Initial upload
ktnyt
parents:
diff changeset
13 open my $rdr, "<", "old/$prog.txt";
8300eb051bea Initial upload
ktnyt
parents:
diff changeset
14 open my $wtr, ">", "final/$prog.txt";
8300eb051bea Initial upload
ktnyt
parents:
diff changeset
15 open my $tmp, "<", "new/$prog.txt";
8300eb051bea Initial upload
ktnyt
parents:
diff changeset
16
8300eb051bea Initial upload
ktnyt
parents:
diff changeset
17 my $out = join "", <$tmp>;
8300eb051bea Initial upload
ktnyt
parents:
diff changeset
18
8300eb051bea Initial upload
ktnyt
parents:
diff changeset
19 my $progdesc;
8300eb051bea Initial upload
ktnyt
parents:
diff changeset
20
8300eb051bea Initial upload
ktnyt
parents:
diff changeset
21 while(my $line = readline $rdr) {
8300eb051bea Initial upload
ktnyt
parents:
diff changeset
22 if($line =~ /^Description/) {
8300eb051bea Initial upload
ktnyt
parents:
diff changeset
23 readline $rdr;
8300eb051bea Initial upload
ktnyt
parents:
diff changeset
24 while($line !~ /SOAP/) {
8300eb051bea Initial upload
ktnyt
parents:
diff changeset
25 $line = readline $rdr;
8300eb051bea Initial upload
ktnyt
parents:
diff changeset
26 last if $line =~ /SOAP/;
8300eb051bea Initial upload
ktnyt
parents:
diff changeset
27 $progdesc .= $line;
8300eb051bea Initial upload
ktnyt
parents:
diff changeset
28 }
8300eb051bea Initial upload
ktnyt
parents:
diff changeset
29 $progdesc =~ s/\n+$//smg;
8300eb051bea Initial upload
ktnyt
parents:
diff changeset
30 }
8300eb051bea Initial upload
ktnyt
parents:
diff changeset
31 }
8300eb051bea Initial upload
ktnyt
parents:
diff changeset
32
8300eb051bea Initial upload
ktnyt
parents:
diff changeset
33 $out =~ s/\[ProgDef\]\n/$progdesc/smg;
8300eb051bea Initial upload
ktnyt
parents:
diff changeset
34
8300eb051bea Initial upload
ktnyt
parents:
diff changeset
35 print $wtr $out;
8300eb051bea Initial upload
ktnyt
parents:
diff changeset
36 }