chiark / gitweb /
Move old update algorith, which is very wrong according to new THEORY, into its own...
[topbloke.git] / tb-list.pl
1 #!/usr/bin/perl
2 # usage: tb-list [<patch-spec>]
3 #  lists all patches matching <patch-spec> and other criteria
4
5 use warnings;
6 use strict;
7
8 use Getopt::Long;
9 use Topbloke;
10
11 #----- option parsing -----
12
13 Getopt::Long::Configure(qw(bundling));
14
15 our $deleted=0;
16 our $deleted_only=0;
17 our $current=0;
18 our $relatedto;
19 our $leaves=0;
20 our $sort='';
21
22 GetOptions("d|deleted!" => \$deleted,         # including deleted patches
23            "deleted-only!" => \$deleted_only, # only deleted patches
24            "r|related=s" => sub {             # only patches related to that
25                $relatedto = parse_patch_spec($_[1]);
26            },
27            "c|related-current" => sub {      # only patches related to current
28                my $current_branch = current_branch();
29                die "-c only permitted when on a topbloke branch\n"
30                    unless $current_branch->{Kind} =~ m/^(?:tip|base)$/;
31                $relatedto = $current_branch;
32            },
33            "l|last|leaf|leaves" => \$leaves, # only leaf patches
34            "sort=s" => \$sort,
35     ) or die "bad options\n";
36
37 our $spec;
38
39 if (@ARGV==1) {
40     $spec = parse_patch_spec($ARGV[0]);
41 } elsif (!@ARGV) {
42 } else {
43     die "too many arguments\n";
44 }
45
46 our @sort = grep { /./ } split m/,/, $sort;
47 push @sort, 'topo' if !$spec;
48 push @sort, 'created';
49 my $toposort = 0;
50 foreach $sort (@sort) {
51     die "bad sort $sort\n" unless grep { $_ eq $sort } 
52         qw(fullname created nick topo);
53     $toposort=1 if $sort eq $toposort;
54 }
55
56 #----- list patches -----
57
58 our %patches;
59
60 foreach_patch($relatedto || $leaves || !$spec ? { } : $spec, 
61               $deleted || $deleted_only, 
62               [0, !!$leaves, 0, $toposort || !!$relatedto],
63               sub { 
64                   my ($patch,$parsedname,@info) = @_;
65                   $patches{$patch}{Info} = \@info;
66                   $patches{$patch}{ParsedName} = $parsedname;
67               });
68
69 #----- selection -----
70
71 if ($leaves) {
72     debug("leaves");
73     foreach my $p (keys %patches) {
74         debug("leaves $p");
75         my $v = $patches{$p};
76         next if $v->{Info}[0]{Deleted};
77         foreach my $dep (keys %{ $v->{Info}[1] }) {
78             debug("leaves $p $dep");
79             next unless exists $patches{$dep};
80             $patches{$dep}{NotLeaf} = 1;
81         }
82     }
83 }
84
85 if ($relatedto) {
86     foreach my $p (keys %patches) {
87         my $v = $patches{$p};
88         # mark Related=1 if any patch matching $relatedto includes us
89         foreach my $dep (keys %{ $v->{Info}[3] }) {
90             next unless exists $patches{$dep};
91             my $depv = $patches{$dep};
92             next unless patch_matches_spec($depv->{ParsedName}, $relatedto);
93             $v->{Related} = 1;
94             last;
95         }
96         if (patch_matches_spec($v->{ParsedName}, $relatedto)) {
97             # if we match $relatedto, mark all our inclusions as Related=1
98             foreach my $dep (keys %{ $v->{Info}[3] }) {
99                 next unless exists $patches{$dep};
100                 $patches{$dep}{Related} = 1;
101             }
102             # oh, and mark ourselves as Related=1 too!
103             $v->{Related} = 1;
104         }
105     }
106 }
107
108 our @output;
109
110 foreach my $p (keys %patches) {
111     my $v = $patches{$p};
112     next if !$deleted && $v->{Info}[0]{Deleted};
113     next if $deleted_only && !$v->{Info}[0]{Deleted};
114     next if $leaves && $v->{NotLeaf};
115     next if $relatedto && !$v->{Related};
116     next if $spec && !patch_matches_spec($v->{ParsedName}, $spec);
117     push @output, $p;
118 }
119
120 #----- sorting -----
121
122 sub sortsub () {
123     my $txt = "sub sort_cmp {\n    my \$r;\n";
124     debug("@sort");
125     my $def_vab;
126     $def_vab = sub {
127         foreach my $ab (qw(a b)) {
128             $txt .= "    my \$v$ab = \$patches{\$$ab};\n";
129         }
130         $def_vab = sub { };
131     };
132     my $by_r = sub {
133         $txt .= "    \$r = $_[0];\n    return \$r if \$r;\n";
134     };
135     my $by_parsed = sub {
136         $def_vab->();
137         $by_r->("\$va->{ParsedName}{$_[0]} cmp \$vb->{ParsedName}{$_[0]}");
138     };
139     my %done;
140     foreach my $sort (@sort) {
141         next if $done{$sort}++;
142         if ($sort eq 'fullname') {
143             $by_r->('$a cmp $b');
144         } elsif ($sort eq 'created') {
145             $by_parsed->('Date');
146         } elsif ($sort eq 'nick') {
147             $by_parsed->('Nick');
148         } elsif ($sort eq 'topo') {
149             $def_vab->();
150             foreach my $ix (qw(0 1)) {
151                 my $ab = (qw(a b))[$ix];
152                 my $ba = (qw(b a))[$ix];
153                 my $r = (qw(1 -1))[$ix];
154                 $txt .= "    return $r if \$v${ab}->{Info}[3]{\$$ba};\n";
155             }
156         } else {
157             die $sort;
158         }
159     }
160     $txt .= "    return 0;\n}\n";
161     debug("sortsub | $_") foreach split /\n/, $txt;
162     return $txt;
163 }
164 eval sortsub()." 1;" or die "$@ ?";
165
166 @output = sort sort_cmp @output;
167
168 #----- printing -----
169
170 my $current_branch = current_branch();
171 my $current_patch = '';
172 my $ifcurrent;
173 if ($current_branch->{Kind} eq 'tip') {
174     $current_patch = $current_branch->{Fullname};
175     $ifcurrent = '>';
176 } elsif ($current_branch->{Kind} eq 'base') {
177     $current_patch = $current_branch->{Fullname};
178     $ifcurrent = '#';
179 }
180
181 foreach my $p (@output) {
182     my $v = $patches{$p};
183     my $pa = $v->{ParsedName};
184     my ($msgkind, $msg) = git_get_object("$pa->{Ref}:.topbloke/msg");
185     die "$p $msgkind ?" unless $msgkind eq 'blob';
186     my $subject =
187         $msg =~ m/^Subject:\s*(?:\[[^][]*\]\s*)?(.*\S)\s*$/mi
188         ? $1 : "[no subject]";  
189     printf("%1s%1s %s\@%s/%s/%-20s %s\n",
190            $p eq $current_patch ? $ifcurrent : '',
191            $v->{Info}[0]{Deleted} ? 'D' : '',
192            $pa->{Email}, $pa->{Domain}, $pa->{Date}, $pa->{Nick},
193            $subject)
194         or die $!;
195 }
196
197 closeout();