Debbugs/Bug.pm

   1 # This module is part of debbugs, and
   2 # is released under the terms of the GPL version 2, or any later
   3 # version (at your option). See the file README and COPYING for more
   4 # information.
   5 # Copyright 2018 by Don Armstrong <don@donarmstrong.com>.
   6
   7 package Debbugs::Bug;
   8
   9 =head1 NAME
  10
  11 Debbugs::Bug -- OO interface to bugs
  12
  13 =head1 SYNOPSIS
  14
  15    use Debbugs::Bug;
  16    Debbugs::Bug->new(schema => $s,binaries => [qw(foo)],sources => [qw(bar)]);
  17
  18 =head1 DESCRIPTION
  19
  20
  21
  22 =cut
  23
  24 use Mouse;
  25 use strictures 2;
  26 use namespace::clean;
  27 use v5.10; # for state
  28
  29 use DateTime;
  30 use List::AllUtils qw(max);
  31
  32 use Debbugs::Config qw(:config);
  33 use Debbugs::Status qw(read_bug);
  34 use Debbugs::Bug::Tag;
  35 use Debbugs::Collection::Package;
  36 use Debbugs::Collection::Bug;
  37
  38 use Debbugs::OOTypes;
  39
  40 extends 'Debbugs::OOBase';
  41
  42 state $strong_severities =
  43    {map {($_,1)} @{$config{strong_severities}}};
  44
  45 has bug => (is => 'ro', isa => 'Int',
  46             required => 1,
  47            );
  48
  49 has saved => (is => 'ro', isa => 'Bool',
  50               default => 0,
  51               writer => '_set_saved',
  52              );
  53
  54 has status => (is => 'ro', isa => 'HashRef',
  55                lazy => 1,
  56                builder => '_build_status',
  57               );
  58
  59 sub _build_status {
  60     my $self = shift;
  61     $self->reset;
  62     my $status = read_bug(bug=>$self->bug) or
  63         confess("Unable to read bug ".$self->bug);
  64     return $status;
  65 }
  66
  67 has 'package_collection' => (is => 'ro',
  68                              isa => 'Debbugs::Collection::Package',
  69                              builder => '_build_package_collection',
  70                              lazy => 1,
  71                             );
  72
  73 sub _build_package_collection {
  74     return Debbugs::Collection::Package->new();
  75 }
  76 has bug_collection => (is => 'ro',
  77                        isa => 'Debbugs::Collection::Bug',
  78                        builder => '_build_bug_collection',
  79                       );
  80 sub _build_bug_collection {
  81     return Debbugs::Collection::Bug->new();
  82 }
  83
  84
  85 sub reset {
  86     my $self = shift;
  87     $self->_clear_done();
  88     $self->_clear_severity();
  89     $self->_clear_packages();
  90     $self->_clear_sources();
  91     $self->_clear_affects();
  92     $self->_clear_blocks();
  93     $self->_clear_blockedby();
  94     $self->_clear_found();
  95     $self->_clear_fixed();
  96     $self->_clear_mergedwith();
  97     $self->_clear_pending();
  98     $self->_clear_location();
  99     $self->_clear_archived();
 100     $self->_clear_archiveable();
 101     $self->_clear_when_archiveable();
 102     $self->_clear_submitter();
 103     $self->_clear_created();
 104     $self->_clear_modified();
 105     $self->_set_saved(1);
 106 }
 107
 108 sub _clear_saved_if_changed {
 109     my ($self,$new,$old) = @_;
 110     if (@_ > 2) {
 111         if ($new ne $old) {
 112             $self->_set_saved(0);
 113         }
 114     }
 115 }
 116
 117 # package attributes
 118 for my $attr (qw(packages affects sources)) {
 119     has $attr =>
 120         (is => 'rw',
 121          isa => 'Debbugs::Collection::Package',
 122          clearer => '_clear_'.$attr,
 123          builder => '_build_'.$attr,
 124          trigger => \&_clear_saved_if_changed,
 125          lazy => 1,
 126         );
 127 }
 128
 129 # bugs
 130 for my $attr (qw(blocks blockedby mergedwith)) {
 131     has $attr =>
 132         (is => 'bare',
 133          isa => 'Debbugs::Collection::Bug',
 134          clearer => '_clear_'.$attr,
 135          builder => '_build_'.$attr,
 136          handles => {},
 137          lazy => 1,
 138         );
 139 }
 140
 141
 142
 143 for my $attr (qw(done severity),
 144               qw(found fixed),
 145               qw(pending location submitter),
 146              ) {
 147     has $attr =>
 148         (is => 'rw',
 149          isa => 'Str',
 150          clearer => '_clear_'.$attr,
 151          builder => '_build_'.$attr,
 152          trigger => \&_clear_saved_if_changed,
 153          lazy => 1,
 154         );
 155 }
 156
 157 sub is_done {
 158     return length $_[0]->done?1:0;
 159 }
 160 sub _build_done {
 161     return $_[0]->status->{done} // '';
 162 }
 163
 164 sub _build_severity {
 165     return $_[0]->status->{severity} // $config{default_severity};
 166 }
 167
 168 sub strong_severity {
 169     my $self = shift;
 170     return exists $strong_severities->{$self->severity};
 171 }
 172
 173 sub package {
 174     local $_;
 175     return join(', ',map {$_->name} $_[0]->packages);
 176 }
 177
 178 sub _build_packages {
 179     return [$_[0]->package_collection->
 180             get_package($_[0]->status->{package} //
 181                         '')
 182            ];
 183 }
 184
 185 sub affect {
 186     local $_;
 187     return join(', ',map {$_->name} $_[0]->affects->members);
 188 }
 189
 190 sub _build_affects {
 191     return [$_[0]->package_collection->
 192             get_package($_[0]->status->{affects} //
 193                         '')
 194            ];
 195 }
 196 sub source {
 197     local $_;
 198     return join(', ',map {$_->name} $_[0]->sources->members);
 199 }
 200 sub _build_sources {
 201     local $_;
 202     my @sources = map {$_->sources} $_[0]->packages;
 203 }
 204
 205
 206 sub _split_if_defined {
 207     my ($self,$field,$split) = @_;
 208     $split //= ' ';
 209     my $e = $self->status->{$field};
 210     my @f;
 211     if (defined $e and
 212         length $e) {
 213         return split /$split/,$e;
 214     }
 215     return ();
 216 }
 217
 218 sub _build_blocks {
 219     my $self = shift;
 220     return $self->bug_collection->
 221         limit_or_create(sort {$a <=> $b}
 222                         $self->_split_if_defined('blocks'));
 223 }
 224
 225 sub _build_blockedby {
 226     my $self = shift;
 227     return $self->bug_collection->
 228         limit_or_create(sort {$a <=> $b}
 229                         $self->_split_if_defined('blockedby'));
 230 }
 231
 232 sub _build_found {
 233     my $self = shift;
 234     return $self->sources->
 235         versions($self->_split_if_defined('found',',\s*'));
 236 }
 237
 238
 239 sub _build_fixed {
 240     my $self;
 241     return $self->sources->
 242         versions($self->_split_if_defined('fixed',',\s*'));
 243 }
 244 sub _build_mergedwith {
 245     my $self = shift;
 246     return $self->bug_collection->
 247         limit_or_create(sort {$a <=> $b}
 248                         $self->_split_if_defined('mergedwith'));
 249 }
 250 sub _build_pending {
 251     return $_[0]->status->{pending} // '';
 252 }
 253 sub _build_submitter {
 254     return $_[0]->status->{originator} // '';
 255 }
 256
 257 for my $attr (qw(created modified)) {
 258     has $attr => (is => 'rw', isa => 'Object',
 259                 clearer => '_clear_'.$attr,
 260                 builder => '_build_'.$attr,
 261                 lazy => 1);
 262 }
 263 sub _build_created {
 264     return DateTime->
 265         from_epoch(epoch => $_[0]->status->{date} // time);
 266 }
 267 sub _build_modified {
 268     return DateTime->
 269         from_epoch(epoch => max($_[0]->status->{log_modified},
 270                                 $_[0]->status->{last_modified}
 271                                ));
 272 }
 273 sub _build_location {
 274     return $_[0]->status->{location};
 275 }
 276 has archived => (is => 'ro', isa => 'Bool',
 277                  clearer => '_clear_archived',
 278                  builder => '_build_archived',
 279                  lazy => 1);
 280 sub _build_archived {
 281     return $_[0]->location eq 'archived'?1:0;
 282 }
 283
 284 has tags => (is => 'ro', isa => 'Object',
 285              clearer => '_clear_tags',
 286              builder => '_build_tags',
 287              lazy => 1,
 288             );
 289 sub _build_tags {
 290     return Debbugs::Bug::Tag->new($_[0]->status->{keywords});
 291 }
 292
 293 =item buggy
 294
 295      $bug->buggy('debbugs/2.6.0-1','debbugs/2.6.0-2');
 296      $bug->buggy(Debbugs::Version->new('debbugs/2.6.0-1'),
 297                  Debbugs::Version->new('debbugs/2.6.0-2'),
 298                 );
 299
 300 Returns the output of Debbugs::Versions::buggy for a particular
 301 package, version and found/fixed set. Automatically turns found, fixed
 302 and version into source/version strings.
 303
 304 =cut
 305
 306 sub buggy {
 307     my $self = shift;
 308     my $vertree =
 309         $self->package_collection->
 310         versions;
 311     my $max_buggy = 'absent';
 312     for my $ver (@_) {
 313         if (not ref($ver)) {
 314             $ver = Debbugs::Version->
 315                 new(string => $ver,
 316                     package_collection => $self->package_collection,
 317                    );
 318         }
 319         $vertree->load($ver->source);
 320         my $buggy =
 321             $vertree->tree->
 322             buggy($ver->srcver,
 323                   [map {$_->srcver} $self->found],
 324                   [map {$_->srcver} $self->fixed]);
 325         if ($buggy eq 'found') {
 326             return 'found'
 327         }
 328         if ($buggy eq 'fixed') {
 329             $max_buggy = 'fixed';
 330         }
 331     }
 332     return $max_buggy;
 333 }
 334
 335 has archiveable =>
 336     (is => 'ro', isa => 'Bool',
 337      writer => '_set_archiveable',
 338      builder => '_build_archiveable',
 339      clearer => '_clear_archiveable',
 340      lazy => 1,
 341     );
 342 has when_archiveable =>
 343     (is => 'ro', isa => 'Num',
 344      writer => '_set_when_archiveable',
 345      builder => '_build_when_archiveable',
 346      clearer => '_clear_when_archiveable',
 347      lazy => 1,
 348     );
 349
 350 sub _build_archiveable {
 351     my $self = shift;
 352     $self->_populate_archiveable(0);
 353     return $self->archiveable;
 354 }
 355 sub _build_when_archiveable {
 356     my $self = shift;
 357     $self->_populate_archiveable(1);
 358     return $self->when_archiveable;
 359 }
 360
 361 sub _populate_archiveable {
 362     my $self = shift;
 363     my ($need_time) = @_;
 364     $need_time //= 0;
 365     # Bugs can be archived if they are
 366     # 1. Closed
 367     if (not $self->done) {
 368         $self->_set_archiveable(0);
 369         $self->_set_when_archiveable(-1);
 370         return;
 371     }
 372     # 2. Have no unremovable tags set
 373     if (@{$config{removal_unremovable_tags}}) {
 374         state $unrem_tags =
 375            {map {($_=>1)} @{$config{removal_unremovable_tags}}};
 376         for my $tag ($self->tags) {
 377             if ($unrem_tags->{$tag}) {
 378                 $self->_set_archiveable(0);
 379                 $self->_set_when_archiveable(-1);
 380                 return;
 381             }
 382         }
 383     }
 384     my $time = time;
 385     state $remove_time = 24 * 60 * 60 * $config{removal_age};
 386     # 4. Have been modified more than removal_age ago
 387     my $moded_ago =
 388         $time - $self->last_modified;
 389     # if we don't need to know when we can archive, we can stop here if it's
 390     # been modified too recently
 391     if ($moded_ago < $remove_time) {
 392         $self->_set_archiveable(0);
 393         return unless $need_time;
 394     }
 395     my @distributions =
 396         @{$config{removal_default_distribution_tags}};
 397     if ($self->strong_severity) {
 398         @distributions =
 399             @{$config{removal_strong_severity_default_distribution_tags}};
 400     }
 401     # 3. Have a maximum buggy of fixed
 402     my $buggy = $self->buggy($self->package->
 403                              dist_source_versions(@distributions));
 404     if ('found' eq $buggy) {
 405         $self->_set_archiveable(0);
 406         $self->_set_when_archiveable(-1);
 407         return;
 408     }
 409     my $fixed_ago = $time - $self->when_fixed(@distributions);
 410     if ($fixed_ago < $remove_time) {
 411         $self->_set_archiveable(0);
 412     }
 413     $self->_set_when_archiveable(($remove_time - min($fixed_ago,$moded_ago)) / (24 * 60 * 60));
 414     if ($fixed_ago > $remove_time and
 415         $moded_ago > $remove_time) {
 416         $self->_set_archiveable(1);
 417         $self->_set_when_archiveable(0);
 418     }
 419     return;
 420 }
 421
 422
 423 no Mouse;
 424 1;
 425
 426
 427 __END__
 428 # Local Variables:
 429 # indent-tabs-mode: nil
 430 # cperl-indent-level: 4
 431 # End: