| [25ae32e] | 1 | #!/usr/bin/perl |
|---|
| 2 | |
|---|
| [20b4e44] | 3 | #package: UAM Text Tools |
|---|
| 4 | #component: gph |
|---|
| 5 | #version: 1.0 |
|---|
| 6 | #author: Tomasz Obrebski |
|---|
| 7 | |
|---|
| 8 | use strict; |
|---|
| [25ae32e] | 9 | use Getopt::Long; |
|---|
| [19dfa5c] | 10 | use File::HomeDir; |
|---|
| 11 | |
|---|
| 12 | |
|---|
| 13 | |
|---|
| 14 | |
|---|
| 15 | |
|---|
| 16 | my $systemconfigfile='/usr/local/etc/utt/gph.conf'; |
|---|
| 17 | my $userconfigfile=home()."/.utt/gph.conf"; |
|---|
| 18 | |
|---|
| 19 | Getopt::Long::Configure('no_ignore_case_always'); |
|---|
| [25ae32e] | 20 | |
|---|
| 21 | my $help=0; |
|---|
| [19dfa5c] | 22 | my $inputfile=0; |
|---|
| 23 | my $outputfile=0; |
|---|
| 24 | my @process=(); |
|---|
| [25ae32e] | 25 | my $reset; |
|---|
| [19dfa5c] | 26 | my $interactive=0; |
|---|
| 27 | |
|---|
| 28 | #read configuration files########################### |
|---|
| 29 | my $file; |
|---|
| 30 | my @process_conf=(); |
|---|
| 31 | foreach $file ($systemconfigfile, $userconfigfile){ |
|---|
| 32 | if(open(CONFIG, $file)){ |
|---|
| 33 | while (<CONFIG>) { |
|---|
| 34 | chomp; |
|---|
| 35 | s/#.*//; |
|---|
| 36 | s/^\s+//; |
|---|
| 37 | s/\s+$//; |
|---|
| 38 | next unless length; |
|---|
| 39 | my ($name, $value) = split(/\s*=\s*/, $_, 2); |
|---|
| 40 | if(($name eq "inputfile")or($name eq "f")){ |
|---|
| 41 | $inputfile=$value; |
|---|
| 42 | } |
|---|
| 43 | elsif(($name eq "outputfile")or($name eq "o")){ |
|---|
| 44 | $outputfile=$value; |
|---|
| 45 | } |
|---|
| 46 | elsif(($name eq "process")or($name eq "p")){ |
|---|
| 47 | push @process_conf, $value; |
|---|
| 48 | } |
|---|
| 49 | elsif(($name eq "reset")or($name eq "r")){ |
|---|
| 50 | $reset=$value; |
|---|
| 51 | } |
|---|
| 52 | elsif(($name eq "interactive")or($name eq "i")){ |
|---|
| 53 | $interactive=1; |
|---|
| 54 | } |
|---|
| 55 | elsif(($name eq "help")or($name eq "h")){ |
|---|
| 56 | $help=1; |
|---|
| 57 | } |
|---|
| 58 | |
|---|
| 59 | } |
|---|
| 60 | close CONFIG; |
|---|
| 61 | } |
|---|
| 62 | } |
|---|
| 63 | ######################################################### |
|---|
| 64 | |
|---|
| 65 | |
|---|
| [25ae32e] | 66 | |
|---|
| 67 | GetOptions("process|p=s" => \@process, |
|---|
| [19dfa5c] | 68 | "inputfile|f=s" => \$inputfile, |
|---|
| 69 | "outputfile|o=s" => \$outputfile, |
|---|
| [25ae32e] | 70 | "help|h" => \$help, |
|---|
| 71 | "reset|r=s" => \$reset, |
|---|
| 72 | "interactive|i" => \$interactive); |
|---|
| 73 | |
|---|
| [19dfa5c] | 74 | @process = @process_conf if @process<1; |
|---|
| 75 | |
|---|
| [25ae32e] | 76 | if($help) |
|---|
| 77 | { |
|---|
| 78 | print <<'END' |
|---|
| 79 | Usage: gph [OPTIONS] |
|---|
| 80 | |
|---|
| 81 | Options: |
|---|
| [3748bd1] | 82 | --process=TYPE -p TYPE Process segments of type TYPE. |
|---|
| 83 | --reset=TYPE -r TYPE Start new graph at tags of type TYPE. |
|---|
| 84 | --inputfile=FILE -f FILE Input file. |
|---|
| 85 | --outputfile=FILE -o FILE Output file. |
|---|
| 86 | --interactive -i Toggle interactive mode (default=off). |
|---|
| [25ae32e] | 87 | END |
|---|
| 88 | ; |
|---|
| 89 | exit 0; |
|---|
| 90 | } |
|---|
| 91 | |
|---|
| 92 | |
|---|
| 93 | $|=1 if $interactive; |
|---|
| 94 | |
|---|
| 95 | |
|---|
| [19dfa5c] | 96 | if(!$inputfile or $inputfile eq "-") { |
|---|
| 97 | *INPUT = *STDIN; |
|---|
| 98 | } |
|---|
| 99 | else { |
|---|
| 100 | open(INPUT, "$inputfile") or die("Can't open input file: $inputfile!"); |
|---|
| 101 | } |
|---|
| 102 | |
|---|
| 103 | if(!$outputfile or $outputfile eq "-") { |
|---|
| 104 | *OUTPUT = *STDOUT; |
|---|
| 105 | } |
|---|
| 106 | else { |
|---|
| 107 | open(OUTPUT, "$outputfile") or die("Can't open output file: $outputfile!"); |
|---|
| 108 | } |
|---|
| 109 | |
|---|
| 110 | my @prev; |
|---|
| [25ae32e] | 111 | my $n=0; |
|---|
| 112 | |
|---|
| [19dfa5c] | 113 | while(<INPUT>) |
|---|
| [25ae32e] | 114 | { |
|---|
| 115 | chomp; |
|---|
| 116 | my $do=0; |
|---|
| 117 | |
|---|
| 118 | my @line = split /\s+/; |
|---|
| 119 | |
|---|
| 120 | if($line[2] eq $reset) |
|---|
| 121 | { |
|---|
| 122 | $n=0; |
|---|
| 123 | @prev = (); |
|---|
| 124 | } |
|---|
| 125 | |
|---|
| 126 | for my $p (@process) |
|---|
| 127 | { |
|---|
| 128 | $do=1 if $line[2] eq $p; |
|---|
| 129 | } |
|---|
| 130 | |
|---|
| [cfed5c1] | 131 | my $gph = ''; |
|---|
| [25ae32e] | 132 | if($do) |
|---|
| 133 | { |
|---|
| [cfed5c1] | 134 | my @preds = (); |
|---|
| [25ae32e] | 135 | shift @prev while @prev+0 && $prev[0]->[1] + $prev[0]->[2] < $line[0]; |
|---|
| 136 | for my $p (@prev) |
|---|
| 137 | { |
|---|
| 138 | push(@preds, $p->[0]) if $p->[1] + $p->[2] == $line[0]; |
|---|
| 139 | } |
|---|
| 140 | push @prev, [$n, $line[0], $line[1]]; |
|---|
| 141 | |
|---|
| 142 | $gph=' gph:'.$n.':'.join(',',@preds); |
|---|
| 143 | |
|---|
| 144 | $n++; |
|---|
| 145 | } |
|---|
| 146 | else |
|---|
| 147 | { |
|---|
| 148 | for my $p (@prev) |
|---|
| 149 | { |
|---|
| 150 | if($p->[1]+$p->[2] == $line[0]) |
|---|
| 151 | { |
|---|
| 152 | $p->[2] += $line[1]; |
|---|
| 153 | } |
|---|
| 154 | } |
|---|
| 155 | |
|---|
| 156 | $gph=''; |
|---|
| 157 | |
|---|
| 158 | } |
|---|
| 159 | |
|---|
| [19dfa5c] | 160 | print OUTPUT $_.$gph."\n"; |
|---|
| [25ae32e] | 161 | } |
|---|
| [cfed5c1] | 162 | |
|---|