1 # see first posting http://use.perl.org/~LaPerla/journal/35252
2 # (Top rt.cpan.org requestors) (up to ticket 32022)
4 # second: http://use.perl.org/~LaPerla/journal/38195 (Who wrote all
5 # the RT tickets?) (up to ticket 42061)
9 query-rt-group-by-requestor -
21 my $optpod = <<'=back';
25 No default. Try C<2009-01-01>
29 No default. Try <2010-01-01>
31 =item B<--chunksize=i>
33 Default 396. We stop bothering rt.cpan.org after that many requests.
45 defaults to 1, unreliable otherwise
65 Defaults to C<ANDK>. Needs to be set to empty string if only
66 statistics are wanted. This can be done with
68 --username "" # not --username="" !
70 =item B<--withlastyear!>
78 RT::Client::REST broke at some point in time and I posted a mostly
79 clueless patch that seemed to work. At least the progam did not die
80 immediately. The patch was integrated into 0.35 and soon after that
81 ticket 35146 was opened that reverted a part of my patch. (Sidenote:
82 The patch is posted reverse)
84 Now with that patch this program again died quickly with
86 HTTP::Message content must be bytes
88 So I decided to patch REST thusly:
90 --- /home/k/.cpan/build/RT-Client-REST-0.35-d_Mo_f/lib/RT/Client/REST.pm 2008-04-15 12:24:11.000000000 +0200
91 +++ /home/src/perl/repoperls/installed-perls/perl/pVNtS9N/perl-5.8.0@32642/lib/site_perl/5.10.0/RT/Client/REST.pm 2008-05-01 09:27:13.000000000 +0200
93 # not sufficiently portable and uncomplicated.)
96 - $res->decoded_content($text);
98 + $res->content(Encode::encode_utf8($text));
99 #$session->update($res) if ($res->is_success || $res->code != 401);
100 if ($res->header('set-cookie')) {
101 my $jar = HTTP::Cookies->new;
106 Of course this cannot be correct but for me it works right now quite
107 well but only because rt.cpan.org sends charset=utf-8 or so.
114 use RT
::Client
::REST
;
116 use List
::Util
qw(max);
117 use DateTime
::Format
::Strptime
;
118 use Pod
::Usage
qw(pod2usage);
121 warn "Working with version $RT::Client::REST::VERSION";
123 # XXX yes, it's a stupid setup that requires an argument to
124 # (logically) boolean options
126 fromdate
=> "", # "2009-01-01",
127 todate
=> "", # "2010-01-01",
130 inclself
=> 1, # setting to 0 not reliable
132 server
=> 'https://rt.cpan.org',
134 upto
=> 0, # allows recalc against a point in the past
136 withlastyear
=> 0, # well, hardcoded 2007; probably a crappy idea
139 my @opt = $optpod =~ /B<--(\S+)>/g;
140 GetOptions
(\
my %config, @opt) or pod2usage
(2);
144 while (my($k,$v) = each %config) {
148 my $yaml_db_file = "$ENV{HOME}/sources/CPAN/data/query-rt-group-by-requestor.yml";
150 if (-e
$yaml_db_file) {
151 warn "Loading yaml file '$yaml_db_file'";
152 $ALL = YAML
::Syck
::LoadFile
($yaml_db_file);
154 warn "WARNING: yaml file '$yaml_db_file' not found!!!";
158 my $curmax = max
keys %{$ALL->{tickets
} || {}};
160 print "highest registered ticket number ATM: $curmax\n";
162 FINDHOLES
: for (my $i = 1; $i <= $curmax; $i++) {
163 if (exists $ALL->{tickets
}{$i}) {
169 print "Max after findholes: $curmax\n";
170 TRIM
: for (my $i = $curmax;;$i--) {
171 my $ticket = $ALL->{tickets
}{$i};
176 delete $ALL->{tickets
}{$i};
179 print "Max after trim: $curmax\n";
181 my $nextmax = $curmax + $Config{chunksize
};
183 my $rt = RT
::Client
::REST
->new(
184 server
=> $Config{server
},
188 if ($Config{username
} && !$Config{password
}) {
191 print "Please enter the password of user '$Config{username}': ";
192 ReadMode
"noecho"; # Turn off controls keys
195 ReadMode
0; # Reset tty mode before exiting
196 $Config{password
} = $pw;
198 if ($Config{username
} && $Config{password
}) {
199 eval { $rt->login( username
=> $Config{username
}, password
=> $Config{password
} ); };
200 die "Alert: Problem logging in: '$@'" if $@
;
206 query
=> qq[(Id
>= $curmax and Id
<= $nextmax)],
209 die "search failed: $@" if $@
;
214 my $maxid = max
@ids;
215 print "filling $curmax..$maxid\n";
216 ID
: for my $id ($curmax..$maxid) {
218 if ($ALL->{tickets
}{$id}){
219 $feedback = "E"; # existed before
221 if (exists $ids{$id}) {
222 } elsif (keys %ids) {
224 print "\nStopping at $id.\n";
228 if (exists $ids{$id}) {
229 $ticket = eval { $rt->show(type
=> 'ticket', id
=> $id) };
230 if (!$ticket || $@
) {
231 warn "Emergency-saving YAML";
232 YAML
::Syck
::DumpFile
("$yaml_db_file.new", $ALL);
233 rename "$yaml_db_file.new", $yaml_db_file;
240 $feedback = "w"; # wrote something interesting
242 $feedback = "e"; # empty
244 $ALL->{tickets
}{$id} = $ticket;
250 YAML
::Syck
::DumpFile
("$yaml_db_file.new", $ALL);
251 rename "$yaml_db_file.new", $yaml_db_file;
255 YAML
::Syck
::DumpFile
("$yaml_db_file.new", $ALL);
256 rename "$yaml_db_file.new", $yaml_db_file;
262 my $who = $v->{Requestors
} || $v->{Creator
};
263 return "" unless $who;
264 if ($who =~ s/\@cpan\.org(,.*)?$//) {
267 my %alias = map { s/~A~/@/r } (
268 'ANDY~A~PETDANCE.COM, ESUMMERS' => 'PETDANCE',
269 'Marek.Rouchal~A~gmx.net' => 'MAREKR',
270 'marek.rouchal~A~infineon.com' => 'MAREKR',
271 'aaron~A~FreeBSD.org' => 'ACDALTON',
272 'acferen~A~yahoo.com' => 'Andrew Feren',
273 'agentzh~A~gmail.com' => 'AGENT',
274 'alexchorny~A~gmail.com' => 'CHORNY',
275 'andreas.koenig~A~anima.de' => 'ANDK',
276 'andrey~A~kostenko.name' => 'GUGU',
277 'andy~A~petdance.com' => 'PETDANCE',
278 'a.r.ferreira~A~gmail.com' => 'FERREIRA',
279 'ask~A~develooper.com' => 'ABH',
280 'at~A~altlinux.org' => 'ATOURBIN',
281 'at~A~altlinux.ru' => 'ATOURBIN',
282 'audreyt~A~audreyt.org' => 'AUDREYT',
283 'autrijus~A~autrijus.org' => 'AUDREYT',
284 'barbie~A~missbarbell.co.uk' => 'BARBIE',
285 'blair~A~orcaware.com' => 'BZAJAC',
286 'bobtfish~A~bobtfish.net' => 'BOBTFISH',
287 'chad.a.davis~A~gmail.com' => 'CADAVIS',
288 'chris~A~clotho.com' => 'CLOTHO',
289 'corion~A~corion.net' => 'CORION',
290 'cpan~A~ali.as' => 'ADAMK',
291 'cpan~A~audreyt.org' => 'AUDREYT',
292 'cpan~A~chrisdolan.net' => 'CDOLAN',
293 'cpan~A~clotho.com' => 'CLOTHO',
294 'cpan~A~pjedwards.co.uk' => 'STIGPJE',
295 'ddascalescu+perl~A~gmail.com' => 'DANDV',
296 'dan.horne~A~redbone.co.nz' => 'DHORNE',
297 'davem~A~iabyn.com' => 'DAVEM',
298 'david~A~davidfavor.com' => 'David Favor',
299 'david~A~landgren.net' => 'DLAND',
300 'david.tulloh~A~AirservicesAustralia.com' => 'LORDLOD',
301 'dha~A~panix.com' => 'DHA',
302 'dmacks~A~netspace.org' => 'DMACKS',
303 'florent.angly~A~gmail.com' => 'FANGLY',
304 'felix.ostmann~A~thewar.de' => 'SADRAK',
305 'frank.wiegand~A~gmail.com' => 'FWIE',
306 'gbarr~A~pobox.com' => 'GBARR',
307 'gregoa~A~debian.org' => 'GREGOA',
308 'he~A~NetBSD.org' => 'Havard Eidnes',
309 'imacat~A~mail.imacat.idv.tw' => 'IMACAT',
310 'ivorw-cpan~A~xemaps.com' => 'IVORW',
311 'jdhedden~A~1979.usna.com' => 'JDHEDDEN',
312 'jesse~A~bestpractical.com' => 'JESSE',
313 'jesse~A~fsck.com' => 'JESSE',
314 'jhi~A~iki.fi' => 'JHI',
315 'jozef~A~kutej.net' => 'JKUTEJ',
316 'julian~A~mehnle.net' => 'JMEHNLE',
317 'kmx~A~volny.cz' => 'KMX',
318 'leon~A~astray.com' => 'LBROCARD',
319 'leonerd-cpan~A~leonerd.org.uk' => 'LEONERD',
320 'livingcosmos~A~gmail.com' => 'TBONE', # http://www.livingcosmos.org/about/
321 'malmberg~A~Encompasserve.org' => 'John Malmberg',
322 'mark~A~summersault.com' => 'MARKSTOS',
323 'mark~A~twoshortplanks.com' => 'MARKF',
324 'matthew~A~mdarwin.ca' => 'MDARWIN',
325 'merlyn~A~stonehenge.com' => 'MERLYN',
326 'mnodine~A~alum.mit.edu' => 'NODINE',
327 'm.nooning~A~comcast.net' => 'MNOONING',
328 'mst~A~shadowcat.co.uk' => 'MSTROUT',
329 'mstevens~A~etla.org' => 'MSTEVENS',
330 'nadim~A~khemir.net' => 'NKH',
331 'nick~A~ccl4.org' => 'NWCLARK',
332 'nigel.metheringham~A~Dev.intechnology.co.uk' => 'NIGELM',
333 'njh~A~bandsman.co.uk' => 'NJH',
334 'njh~A~ecs.soton.ac.uk' => 'NJH',
335 'nospam-abuse~A~bloodgate.com' => 'TELS',
336 'ntyni~A~iki.fi' => 'Niko Tyni',
337 'nothingmuch~A~woobling.org' => 'NUFFIN',
338 'otto.hirr~A~olabinc.com' => 'OTTO',
339 'perl-rt~A~misterwhipple.com' => 'MRWHIPPLE',
340 'perl~A~evancarroll.com' => 'ECARROLL',
341 'pjacklam~A~online.no' => 'PJACKLAM',
342 'rafl~A~debian.org' => 'FLORA',
343 'rcaputo~A~pobox.com' => 'RCAPUTO',
344 'ron~A~savage.net.au' => 'RSAVAGE',
345 'rurban~A~x-ray.at' => 'RURBAN',
346 'salvatore.bonaccorso~A~gmail.com' => 'Salvatore Bonaccorso',
347 'sartak~A~gmail.com' => 'SARTAK',
348 'shlomif~A~iglu.org.il' => 'SHLOMIF',
349 'schmorp~A~schmorp.de' => 'MLEHMANN',
350 'schwern~A~pobox.com' => 'MSCHWERN',
351 'schwern~A~bestpractical.com' => 'MSCHWERN',
352 'slaven~A~rezic.de' => 'SREZIC',
353 'slaven~A~cpan' => 'SREZIC',
354 'slaven.rezic~A~berlin.de' => 'SREZIC',
355 'steve.hay~A~uk.radan.com' => 'SHAY',
356 'steve~A~fisharerojo.org' => 'SMPETERS',
357 'steven~A~knowmad.com' => 'WMCKEE',
358 'stro~A~railways.dp.ua' => 'STRO',
359 'taro.nishino~A~gmail.com' => 'TNISHINO',
360 'mail~A~tobyinkster.co.uk' => 'TOBYINK',
361 'todd.e.rinaldo~A~jpmorgan.com'=> 'TODDR',
362 'toddr~A~null.net' => 'TODDR',
363 'tokuhirom+cpan~A~gmail.com' => 'TOKUHIROM',
364 'tony~A~develop-help.com' => 'TONYC',
365 # JKEGL is it in https://rt.cpan.org/Ticket/Display.html?id=46925
366 'user42~A~zip.com.au', => 'JKEGL', # why did I believe 'KRYDE',?
367 'ville.skytta~A~iki.fi' => 'SCOP',
368 'wb8tyw~A~gmail.com' => 'John Malmberg',
369 'william~A~knowmad.com' => 'WMCKEE',
370 'xdaveg~A~gmail.com' => 'DAGOLDEN',
371 'xenoterracide~A~gmail.com' => 'XENO',
372 'zefram~A~fysh.org' => 'ZEFRAM',
373 'cpan~A~zoffix.com' => 'ZOFFIX',
375 $who = $alias{$who} || $who;
376 if ($Config{inclself
}) {
379 if ($who && $v->{Owner
} && $who eq $v->{Owner
}) {
382 if ($who eq "TONYC" and $v->{Queue
} eq "Imager") {
383 # too many tickets never get an owner, so inclself should stay
384 # default until we know how to reliably identify tickets to self
392 my $postedlist = <<'EOL';
442 50: dsteinbrunner@pobox.com 36
446 54: mcummings@gentoo.org 34
451 59: arnaud@underlands.org 33
460 68: perl@infotrope.net 29
462 70: dave@riverside-cms.co.uk 28
464 72: dhoworth@mrc-lmb.cam.ac.uk 27
469 77: tom@eborcom.com 25
470 78: cpan@fireartist.com 25
476 84: jpo@di.uminho.pt 24
478 86: cweyl@alumni.drew.edu 24
482 90: tony@develop-help.com 22
487 95: perl@crystalflame.net 21
489 97: m.romani@spinsoft.it 21
496 for my $line (split /\n/, $postedlist) {
497 my($pos,$name,$count) = $line =~ /(\d+):\s(\S.+\S)\s+(\d+)$/;
498 $p{$name} = { pos => $pos, count
=> $count };
503 keys %{$ALL->{tickets
}}; # reset iterator
505 TICKET
: while (my($k,$v) = each %{$ALL->{tickets
}}) {
506 if (my $upto = $Config{upto
}) {
507 next TICKET
if $k > $upto;
509 my $fromdate = $Config{fromdate
};
510 my $todate = $config{todate
};
511 if ($fromdate or $todate) {
512 my $date = $v->{Created
} or next TICKET
;
514 DATEFMT
: for my $pat (
515 "%a %b %d %T %Y", # Sun Sep 28 12:23:12 2008
516 "%a, %d %b %Y %T %z", # Sun, 28 Sep 2008 12:23:12 +0100
517 "%b %d, %Y %R", # July 10,...
518 "%b %d, %Y %R", # July 4,...
519 "%Y-%m-%d %H:%M:%S", # 2010-01-20 20:40:53 for ticket 53865
522 my $p = DateTime
::Format
::Strptime
->new
528 $p->parse_datetime($date)
533 die "Could not parse date[$date] for ticket $k";
535 if ($fromdate and $dt->datetime lt $fromdate
536 or $todate and $dt->datetime ge $todate) {
541 next TICKET
unless $who;
545 printf "%s\n", $Config{html
} ?
"<dl>" : "";
547 my $showtop = $Config{top
} || 40;
548 for my $k (sort {$S{$b} <=> $S{$a}} keys %S) {
549 $longestname = length $k if length $k > $longestname;
550 last if $top >= $showtop;
555 my $sprintf = "%s%2s: %-".$longestname."s %4d%s\n";
556 if ($Config{withlastyear
}) {
557 $sprintf = "%s%2s: %-".$longestname."s %4d (%2s) %3s%s\n";
561 for my $k (sort {$S{$b} <=> $S{$a}} keys %S) {
563 my $top_or_empty = $score == $last_score ?
"" : $top;
567 $Config{html
} ?
"<code>" : " ",
571 $p ?
( $p->{$k}{pos} || "-", $p->{$k}{pos} ?
$S{$k}-$p->{$k}{count
} : "-") : (),
572 $Config{html
} ?
"</code><br/>" : "",
574 $x =~ s/ / /g if $Config{html
};
576 last if $top >= $showtop;
578 $last_score = $score;
580 printf "%s\n", $Config{html
} ?
"</dl>" : "";
584 # cperl-indent-level: 2