bin/query-rt-group-by-requestor.pl

   1 # see first posting http://use.perl.org/~LaPerla/journal/35252
   2 # (Top rt.cpan.org requestors) (up to ticket 32022)
   3
   4 # second: http://use.perl.org/~LaPerla/journal/38195 (Who wrote all
   5 # the RT tickets?) (up to ticket 42061)
   6
   7 =head1 NAME
   8
   9 query-rt-group-by-requestor -
  10
  11 =head1 SYNOPSIS
  12
  13
  14
  15 =head1 OPTIONS
  16
  17 =over 2
  18
  19 =cut
  20
  21 my $optpod = <<'=back';
  22
  23 =item B<--fromdate=s>
  24
  25 No default. Try C<2009-01-01>
  26
  27 =item B<--todate=s>
  28
  29 No default. Try <2010-01-01>
  30
  31 =item B<--chunksize=i>
  32
  33 Default 396. We stop bothering rt.cpan.org after that many requests.
  34
  35 =item B<--help|h!>
  36
  37 TBD
  38
  39 =item B<--html!>
  40
  41 TBD
  42
  43 =item B<--inclself!>
  44
  45 defaults to 1, unreliable otherwise
  46
  47 =item B<--password=s>
  48
  49 TBD
  50
  51 =item B<--server=s>
  52
  53 TBD
  54
  55 =item B<--top=i>
  56
  57 TBD
  58
  59 =item B<--upto=i>
  60
  61 TBD
  62
  63 =item B<--username=s>
  64
  65 Defaults to C<ANDK>. Needs to be set to empty string if only
  66 statistics are wanted. This can be done with
  67
  68   --username ""        # not --username="" !
  69
  70 =item B<--withlastyear!>
  71
  72 TBD
  73
  74 =back
  75
  76 =head1 DESCRIPTION
  77
  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)
  83
  84 Now with that patch this program again died quickly with
  85
  86     HTTP::Message content must be bytes
  87
  88 So I decided to patch REST thusly:
  89
  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
  92 @@ -496,7 +496,8 @@
  93          # not sufficiently portable and uncomplicated.)
  94          $res->code($1);
  95          $res->message($2);
  96 -        $res->decoded_content($text);
  97 +        use Encode;
  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;
 102
 103
 104
 105
 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.
 108
 109 =cut
 110
 111 use strict;
 112 use warnings;
 113
 114 use RT::Client::REST;
 115 use Getopt::Long;
 116 use List::Util qw(max);
 117 use DateTime::Format::Strptime;
 118 use Pod::Usage qw(pod2usage);
 119 use YAML::Syck;
 120
 121 warn "Working with version $RT::Client::REST::VERSION";
 122
 123 # XXX yes, it's a stupid setup that requires an argument to
 124 # (logically) boolean options
 125 my %Config = (
 126               fromdate    => "", # "2009-01-01",
 127               todate      => "", # "2010-01-01",
 128               chunksize   => 396,
 129               html        => 0,
 130               inclself    => 1, # setting to 0 not reliable
 131               password    => '',
 132               server      => 'https://rt.cpan.org',
 133               top         => 70,
 134               upto        => 0,  # allows recalc against a point in the past
 135               username    => 'ANDK',
 136               withlastyear => 0, # well, hardcoded 2007; probably a crappy idea
 137              );
 138
 139 my @opt = $optpod =~ /B<--(\S+)>/g;
 140 GetOptions(\my %config, @opt) or pod2usage(2);
 141 if ($config{help}) {
 142   pod2usage(0);
 143 }
 144 while (my($k,$v) = each %config) {
 145   $Config{$k} = $v;
 146 }
 147
 148 my $yaml_db_file = "$ENV{HOME}/sources/CPAN/data/query-rt-group-by-requestor.yml";
 149 my $ALL;
 150 if (-e $yaml_db_file) {
 151   warn "Loading yaml file '$yaml_db_file'";
 152   $ALL = YAML::Syck::LoadFile($yaml_db_file);
 153 } else {
 154   warn "WARNING: yaml file '$yaml_db_file' not found!!!";
 155   sleep 3;
 156   $ALL = {};
 157 }
 158 my $curmax = max keys %{$ALL->{tickets} || {}};
 159 $curmax ||= 0;
 160 print "highest registered ticket number ATM: $curmax\n";
 161 $curmax ||= 1;
 162 FINDHOLES: for (my $i = 1; $i <= $curmax; $i++) {
 163   if (exists $ALL->{tickets}{$i}) {
 164   } else {
 165     $curmax = $i;
 166     last FINDHOLES;
 167   }
 168 }
 169 print "Max after findholes: $curmax\n";
 170 TRIM: for (my $i = $curmax;;$i--) {
 171     my $ticket = $ALL->{tickets}{$i};
 172     $curmax = $i;
 173     if (keys %$ticket) {
 174         last;
 175     } else {
 176         delete $ALL->{tickets}{$i};
 177     }
 178 }
 179 print "Max after trim: $curmax\n";
 180
 181 my $nextmax = $curmax + $Config{chunksize};
 182
 183 my $rt = RT::Client::REST->new(
 184                                server  => $Config{server},
 185                                timeout => 300
 186                               );
 187
 188 if ($Config{username} && !$Config{password}) {
 189   use Term::ReadKey;
 190   local $|=1;
 191   print "Please enter the password of user '$Config{username}': ";
 192   ReadMode "noecho"; # Turn off controls keys
 193   my $pw = ReadLine;
 194   print "\n";
 195   ReadMode 0; # Reset tty mode before exiting
 196   $Config{password} = $pw;
 197 }
 198 if ($Config{username} && $Config{password}) {
 199   eval { $rt->login( username => $Config{username}, password => $Config{password} ); };
 200   die "Alert: Problem logging in: '$@'" if $@;
 201
 202   my @ids;
 203   eval {
 204     @ids = $rt->search(
 205                        type    => 'ticket',
 206                        query   => qq[(Id >= $curmax and Id <= $nextmax)],
 207                       );
 208   };
 209   die "search failed: $@" if $@;
 210
 211   my %ids;
 212   @ids{@ids} = ();
 213   $|=1;
 214   my $maxid = max @ids;
 215   print "filling $curmax..$maxid\n";
 216  ID: for my $id ($curmax..$maxid) {
 217     my $feedback;
 218     if ($ALL->{tickets}{$id}){
 219       $feedback = "E"; # existed before
 220     } else {
 221       if (exists $ids{$id}) {
 222       } elsif (keys %ids) {
 223       } else {
 224         print "\nStopping at $id.\n";
 225         last ID;
 226       }
 227       my $ticket;
 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;
 234           die $@;
 235         }
 236       } else {
 237         $ticket = {};
 238       }
 239       if (keys %$ticket) {
 240         $feedback = "w"; # wrote something interesting
 241       } else {
 242         $feedback = "e"; # empty
 243       }
 244       $ALL->{tickets}{$id} = $ticket;
 245     }
 246     print $feedback;
 247     delete $ids{$id};
 248     unless ($id % 37){
 249       print "z";
 250       YAML::Syck::DumpFile("$yaml_db_file.new", $ALL);
 251       rename "$yaml_db_file.new", $yaml_db_file;
 252       sleep 3;
 253     }
 254   }
 255   YAML::Syck::DumpFile("$yaml_db_file.new", $ALL);
 256   rename "$yaml_db_file.new", $yaml_db_file;
 257   print "filled\n";
 258 }
 259
 260 sub who {
 261   my($v) = @_;
 262   my $who = $v->{Requestors} || $v->{Creator};
 263   return "" unless $who;
 264   if ($who =~ s/\@cpan\.org(,.*)?$//) {
 265     $who = uc $who;
 266   }
 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',
 374               );
 375   $who = $alias{$who} || $who;
 376   if ($Config{inclself}) {
 377     # fall through
 378   } else {
 379     if ($who && $v->{Owner} && $who eq $v->{Owner}) {
 380       return;
 381     }
 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
 385       return;
 386     }
 387   }
 388   return $who;
 389 }
 390
 391 sub users_2007 {
 392   my $postedlist = <<'EOL';
 393      1: guest      486
 394      2: SREZIC     393
 395      3: MSCHWERN   385
 396      4: ANDK       347
 397      5: ADAMK      317
 398      6: MARKSTOS   304
 399      7: CHORNY     248
 400      8: RRWO       205
 401      9: WMCKEE     161
 402     10: SMPETERS   136
 403     11: TONYC      132
 404     12: LGODDARD   129
 405     13: CDOLAN     117
 406     14: JDHEDDEN   114
 407     15: RCAPUTO    110
 408     16: RJBS       101
 409     17: MAREKR     101
 410     18: MTHURN      98
 411     19: ATOURBIN    85
 412     20: PETDANCE    84
 413     21: SAPER       79
 414     22: BARBIE      72
 415     23: JESSE       71
 416     24: NKH         62
 417     25: IMACAT      60
 418     26: CORION      60
 419     27: ACDALTON    59
 420     28: DAGOLDEN    58
 421     29: CLOTHO      57
 422     30: RSAVAGE     57
 423     31: MERLYN      52
 424     32: HANENKAMP   51
 425     33: Niko Tyni   51
 426     34: TELS        49
 427     35: LTHEGLER    47
 428     36: MARKF       47
 429     37: PODMASTER   47
 430     38: JPIERCE     47
 431     39: GROUSSE     46
 432     40: BZAJAC      46
 433     41: KANE        44
 434     42: JONASBN     44
 435     43: STENNIE     43
 436     44: SPOON       43
 437     45: MUENALAN    41
 438     46: JJORE       41
 439     47: RURBAN      40
 440     48: SHLOMIF     37
 441     49: JOHANL      36
 442     50: dsteinbrunner@pobox.com   36
 443     51: SHAY        36
 444     52: DLAND       36
 445     53: IVORW       35
 446     54: mcummings@gentoo.org   34
 447     55: FERREIRA    34
 448     56: NUFFIN      34
 449     57: NIKC        33
 450     58: STIGPJE     33
 451     59: arnaud@underlands.org   33
 452     60: MSTEVENS    32
 453     61: DHA         31
 454     62: ABH         31
 455     63: NJH         31
 456     64: SCOP        30
 457     65: KWILLIAMS   30
 458     66: STRO        30
 459     67: SMYLERS     30
 460     68: perl@infotrope.net   29
 461     69: DHORNE      29
 462     70: dave@riverside-cms.co.uk   28
 463     71: SMUELLER    28
 464     72: dhoworth@mrc-lmb.cam.ac.uk   27
 465     73: ISHIGAKI    27
 466     74: JKEENAN     26
 467     75: JMEHNLE     26
 468     76: DMUEY       26
 469     77: tom@eborcom.com   25
 470     78: cpan@fireartist.com   25
 471     79: JROCKWAY    25
 472     80: NODINE      25
 473     81: DMITRI      24
 474     82: JHI         24
 475     83: RENEEB      24
 476     84: jpo@di.uminho.pt   24
 477     85: DOM         24
 478     86: cweyl@alumni.drew.edu   24
 479     87: BOOK        23
 480     88: OVID        23
 481     89: DAXIM       22
 482     90: tony@develop-help.com   22
 483     91: THALJEF     22
 484     92: CNANDOR     21
 485     93: GHENRY      21
 486     94: CLACO       21
 487     95: perl@crystalflame.net   21
 488     96: YANICK      21
 489     97: m.romani@spinsoft.it   21
 490     98: MARKOV      20
 491     99: DJERIUS     20
 492     100: LEIRA       20
 493 EOL
 494
 495   my %p;
 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 };
 499   }
 500   return \%p;
 501 }
 502
 503 keys %{$ALL->{tickets}}; # reset iterator
 504 my %S;
 505 TICKET: while (my($k,$v) = each %{$ALL->{tickets}}) {
 506   if (my $upto = $Config{upto}) {
 507     next TICKET if $k > $upto;
 508   }
 509   my $fromdate = $Config{fromdate};
 510   my $todate = $config{todate};
 511   if ($fromdate or $todate) {
 512     my $date = $v->{Created} or next TICKET;
 513     my $dt;
 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
 520                       ) {
 521       $dt = eval {
 522         my $p = DateTime::Format::Strptime->new
 523             (
 524              locale => "en",
 525              time_zone => "UTC",
 526              pattern => $pat,
 527             );
 528         $p->parse_datetime($date)
 529       };
 530       last DATEFMT if $dt;
 531     }
 532     unless ($dt) {
 533       die "Could not parse date[$date] for ticket $k";
 534     }
 535     if ($fromdate and $dt->datetime lt $fromdate
 536         or $todate and $dt->datetime ge $todate) {
 537       next TICKET;
 538     }
 539   }
 540   my $who = who($v);
 541   next TICKET unless $who;
 542   $S{$who}++;
 543 }
 544 my $top = 1;
 545 printf "%s\n", $Config{html} ? "<dl>" : "";
 546 my $longestname = 0;
 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;
 551   $top++;
 552 }
 553 $top = 1;
 554 my $p;
 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";
 558   $p = users_2007();
 559 }
 560 my $last_score = 0;
 561 for my $k (sort {$S{$b} <=> $S{$a}} keys %S) {
 562   my $score = $S{$k};
 563   my $top_or_empty = $score == $last_score ? "" : $top;
 564   my $x = sprintf
 565       (
 566        $sprintf,
 567        $Config{html} ? "<code>" : " ",
 568        $top_or_empty,
 569        $k,
 570        $score,
 571        $p ? ( $p->{$k}{pos} || "-", $p->{$k}{pos} ? $S{$k}-$p->{$k}{count} : "-") : (),
 572        $Config{html} ? "</code><br/>" : "",
 573       );
 574   $x =~ s/ /&nbsp;/g if $Config{html};
 575   print $x;
 576   last if $top >= $showtop;
 577   $top++;
 578   $last_score = $score;
 579 }
 580 printf "%s\n", $Config{html} ? "</dl>" : "";
 581
 582 # Local Variables:
 583 # mode: cperl
 584 # cperl-indent-level: 2
 585 # End: