File: del_from_prfl.pl

package info (click to toggle)
augustus 3.5.0%2Bdfsg-2
  • links: PTS, VCS
  • area: main
  • in suites: bookworm
  • size: 777,036 kB
  • sloc: cpp: 80,063; perl: 21,491; python: 4,368; ansic: 1,244; makefile: 1,126; sh: 171; javascript: 32
file content (120 lines) | stat: -rwxr-xr-x 3,244 bytes parent folder | download | duplicates (3)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
#!/usr/bin/perl
use strict;
use warnings;

die "Need two arguments" unless @ARGV >= 2;

my %todel;
foreach (split(",", $ARGV[1])) {
    $todel{$_}=1;
}
splice (@ARGV, 1);

my  @input;
while (<>) {
    if (/^\[/ || @input == 0) {
	push @input, $_;
    } else {
	$input[-1].=$_;
    }
}

my $index = 0;
my $blockno = 0;
my @output = ();
my $deleted_lines = 0;
my $ADDMODE = 1;


sub infsum {
    my $result = 0;
    foreach (@_) {
	return "*" if /^\*$/;
	print STDERR "Unexpected value: '$_'\n" unless /^\d+$/;
	$result += $_ if /^\d+$/;
    }
    return $result;
}
 
foreach (@input) {
    if (/^\[block\]/m) {
	my $name;
	$name=$1 if (/^name=(.*?)$/m);
	if ($ADDMODE && $deleted_lines > 0) {
	    # if deleted_lines > 0 => block was deleted but no [dist] followed
	    # if there is [dist] in output: add deleted_lines to <min> and set <max> to inf
	    # else push new output deleted_lines <max>

	    if (@output && $output[-1] =~ /^\[dist\]/m) {
		$output[-1] =~ s/^(\d+)(\s+)(\d+|\*)/($1 + $deleted_lines)."$2*"/me;
	    } else {
		push @output, "[dist]\n# distance to previous block\n# <min> <max>\n$deleted_lines\t*\n\n";
	    }
	}
	if ((defined $name && exists $todel{$name}) || exists $todel{$blockno}) {
	    my $blsize = 0;
	    while (/^(\d+)\s/mg && $blsize == $1) {
		$blsize++;
	    }
	    ### DEBUG part
	    if ($blsize == 0) {
		die "This file is corrupted (trying to delete empty block). Gave up";
	    }
	    $deleted_lines = $blsize;
	    ### end of DEBUG part
	    unless ($ADDMODE) {
		# ADDMODE == false
		while (@output && $output[-1] =~ /^\[dist\]/m) {
		    pop @output;
		}
	    }
	} else {
	    push @output, $_;
	    $deleted_lines = 0;
	}
	$blockno++;
    } elsif (/^\[dist\]/)  {
	if ($deleted_lines>0)  {
	    if ($ADDMODE) {
		# if deleted_lines > 0 && there is [dist] in output (must be
		# from before deleted block): add output and deleted_lines to input, replace output by input
		# if deleted_lines > 0 && no [dist] in output:
		# push current on output add deleted_lines to min and set max to inf
		my ($outmin, $outmax) = 
		    (@output && $output[-1] =~ /^\[dist\]/m) ?
		    ((pop @output) =~ /^(\d+)\s+(\d+|\*)/m) : (0, "*");
		### DEBUG part
		die "Undefined" unless defined $_;
		die "Bad syntax: $_" unless defined $outmax;
		s/^(.*\n)(\d+)(\s+)(\d+|\*)//s;
		my ($prefix, $inmin, $tab, $inmax) = ($1, $2, $3, $4);
		### DEBUG part
		die "Bad syntax: $_" unless (defined $inmax);
		push @output, $prefix.($outmin + $deleted_lines + $inmin).$tab.&infsum($outmax, $inmax, $deleted_lines).$_;
		$deleted_lines = 0;
	    }
	    # if ADDMODE==false: skip [dist] in output
	} else {
	    push @output, $_;
	}
    } else {
	push @output, $_;
    }
}

# this is needed if last block was deleted
if ($ADDMODE && $deleted_lines > 0) {
    # if deleted_lines > 0 => block was deleted but no [dist] followed
    # if there is [dist] in output: add deleted_lines to <min> and set <max> to inf
    # else push new output deleted_lines <max>
    
    if (@output && $output[-1] =~ /^\[dist\]/m) {
	$output[-1] =~ s/^(\d+)(\s+)(\d+|\*)/($1 + $deleted_lines)."$2*"/me;
    } else {
	push @output, "[dist]\n# distance to previous block\n# <min> <max>\n$deleted_lines\t*\n\n";
    }
}

print foreach @output;