Mercurial > repos > jesse-erdmann > tapdance

comparison lib/list2tab.pl @ 0:1437a2df99c0

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Uploaded
author jesse-erdmann
date Fri, 09 Dec 2011 11:56:56 -0500
parents
children
comparison
equal deleted inserted replaced
-1:000000000000 0:1437a2df99c0
1 #!/usr/bin/perl
2 # The Missing Textutils, Ondrej Bojar, obo@cuni.cz
3 # http://www.cuni.cz/~obo/textutils
4 #
5 # 'list2tab' builds a 2D table out of key-key-value triples.
6 #
7 # $Id: list2tab,v 1.4 2006/07/07 15:01:53 bojar Exp $
8 #
9
10 $rows = shift;
11 $cols = shift;
12 $data = shift;
13 $blankvalue = shift;
14 @rows = split /,/, $rows;
15 @cols = split /,/, $cols;
16 @data = split /,/, $data;
17
18 $blankvalue = "-" if $blankvalue eq "";
19
20 if (!$rows || !$cols || !$data) {
21 my $help = <<EOH;
22 Sample usage:
23 ./list2tab.pl 1,2 5,6 3,4 [default_value] < datafile > tablefile
24 The output table will have lines labelled with values seen in columns 1 and 2,
25 columns labelled with values from columns 5,6 and the values in the interior of the table will come from columns 3,4.
26
27 Sample input:
28 GIN Praha 5
29 IOL Praha 20
30 GIN Brno 10
31 IOL Nova Paka 2
32
33 Output produced by: "list2tab 2 1 3 none"
34
35 GIN IOL
36 Brno 10 none
37 Nova Paka none 2
38 Praha 5 20
39 EOH
40 print STDERR $help;
41 exit $1;
42 }
43
44
45 while (<>) {
46 chomp;
47 @line = split /\t/;
48 $key = $val = $datum = "";
49 foreach $row (@rows) {
50 $key .= $line[$row-1]."\t";
51 }
52 chop $key;
53 foreach $col (@cols) {
54 $val .= $line[$col-1]."\t";
55 }
56 chop $val;
57 foreach $dat (@data) {
58 $datum .= $line[$dat-1]."\t";
59 }
60 chop $datum;
61 $datum =~ s/^ *//;
62 $datum =~ s/ *$//;
63
64 $table{"$key\t$val"} = $datum;
65 #print STDERR "Tabulka >>$key\t$val<<.....$datum\n";
66 $keys{$key} = 1;
67 push @svals, $val if (!$vals{$val});
68 $vals{$val} = 1;
69 }
70
71 @skeys = sort {uc($a) cmp uc($b)} keys %keys;
72 #@svals = sort {uc($a) cmp uc($b)} keys %vals;
73
74 #print STDERR "Klice: ".join(",",@skeys)."\n";
75 #print STDERR "Hodnoty: ".join(",",@svals)."\n";
76
77
78 print "\t" x $#rows;
79
80 foreach $col (@svals) {
81 print "\t$col";
82 }
83 print "\n";
84
85 foreach $row (@skeys) {
86 print "$row";
87 foreach $col (@svals) {
88 $pos = "$row\t$col";
89 print "\t$table{$pos}" if defined $table{$pos};
90 print "\t$blankvalue" if ! defined $table{$pos};
91 }
92 print "\n";
93 }