[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 | |
---|