Debbugs/Bug/Status.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::Status;
   8
   9 =head1 NAME
  10
  11 Debbugs::Bug::Status -- OO interface to status files
  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 use Mouse::Util::TypeConstraints qw(enum);
  29
  30 use DateTime;
  31 use List::AllUtils qw(max first min);
  32
  33 use Params::Validate qw(validate_with :types);
  34 use Debbugs::Common qw(make_list);
  35 use Debbugs::Config qw(:config);
  36 use Debbugs::Status qw(get_bug_status);
  37
  38 use Debbugs::OOTypes;
  39
  40 use Carp;
  41
  42 extends 'Debbugs::OOBase';
  43
  44 my $meta = __PACKAGE__->meta;
  45
  46 has bug => (is => 'ro', isa => 'Int',
  47            );
  48
  49 # status obtained from DB, filesystem, or hashref
  50 has status_source => (is => 'ro',
  51                       isa => enum([qw(db filesystem hashref)]),
  52                       default => 'filesystem',
  53                       writer => '_set_status_source',
  54                      );
  55
  56 has _status => (is => 'bare',
  57                 writer => '_set_status',
  58                 reader => '_status',
  59                 predicate => '_has__status',
  60                );
  61
  62 my %field_methods;
  63
  64 sub BUILD {
  65     my $self = shift;
  66     my $args = shift;
  67     if (not exists $args->{status} and exists $args->{bug}) {
  68         if ($self->has_schema) {
  69             ($args->{status}) =
  70                 $self->schema->resultset('BugStatus')->
  71                 search_rs({id => [make_list($args->{bug})]},
  72                          {result_class => 'DBIx::Class::ResultClass::HashRefInflator'})->
  73                              all();
  74             state $field_mapping =
  75                {originator => 'submitter',
  76                 blockedby => 'blocked_by',
  77                 found_versions => 'found',
  78                 fixed_versions => 'fixed',
  79                };
  80             for my $field (keys %{$field_mapping}) {
  81                 $args->{status}{$field_mapping->{$field}} =
  82                     $args->{status}{$field} if defined $args->{status}{$field};
  83                 delete $args->{status}{$field};
  84             }
  85             $self->_set_status_source('db');
  86         } else {
  87             $args->{status} = get_bug_status(bug=>$args->{bug});
  88             state $field_mapping =
  89                {originator => 'submitter',
  90                 keywords => 'tags',
  91                 msgid => 'message_id',
  92                 blockedby => 'blocked_by',
  93                 found_versions => 'found',
  94                 fixed_versions => 'fixed',
  95                };
  96             for my $field (keys %{$field_mapping}) {
  97                 $args->{status}{$field_mapping->{$field}} =
  98                     $args->{status}{$field};
  99             }
 100             $self->_set_status_source('filesystem');
 101         }
 102     } elsif (exists $args->{status}) {
 103         $self->_set_status_source('hashref');
 104     }
 105     if (exists $args->{status}) {
 106         if (ref($args->{status}) ne 'HASH') {
 107             croak "status must be a HASHREF (argument to __PACKAGE__)";
 108         }
 109         $self->_set_status($args->{status});
 110         # single value fields
 111         for my $field (qw(submitter date subject message_id done severity unarchived),
 112                        qw(owner summary outlook bug log_modified),
 113                        qw(last_modified archived forwarded)) {
 114             next unless defined $args->{status}{$field};
 115             # we're going to let status override passed values in args for now;
 116             # maybe this should change
 117             if (not exists $field_methods{'_set_'.$field}) {
 118                 $field_methods{'_set_'.$field} =
 119                     $meta->find_method_by_name('_set_'.$field);
 120                 if (not defined $field_methods{'_set_'.$field}) {
 121                     croak "Unable to find field method for _set_$field";
 122                 }
 123             }
 124             $field_methods{'_set_'.$field}->($self,$args->{status}{$field});
 125         }
 126         # multi value fields
 127         for my $field (qw(affects package tags blocks blocked_by mergedwith),
 128                        qw(found fixed)) {
 129             next unless defined $args->{status}{$field};
 130             my $field_method = $meta->find_method_by_name('_set_'.$field);
 131             if (not exists $field_methods{'_set_'.$field}) {
 132                 $field_methods{'_set_'.$field} =
 133                     $meta->find_method_by_name('_set_'.$field);
 134                 if (not defined $field_methods{'_set_'.$field}) {
 135                     croak "Unable to find field method for _set_$field";
 136                 }
 137             }
 138             my $split_field = $args->{status}{$field};
 139             if (!ref($split_field)) {
 140                 $split_field =
 141                     _build_split_field($args->{status}{$field},
 142                                        $field);
 143             }
 144             $field_methods{'_set_'.$field}->($self,
 145                                              $split_field);
 146         }
 147         delete $args->{status};
 148     }
 149 }
 150
 151 has saved => (is => 'ro', isa => 'Bool',
 152               default => 0,
 153               writer => '_set_set_saved',
 154              );
 155
 156 sub __field_or_def {
 157     my ($self,$field,$default) = @_;
 158     if ($self->_has__status) {
 159         my $s = $self->_status()->{$field};
 160         return $s if defined $s;
 161     }
 162     return $default;
 163 }
 164
 165 =head2 Status Fields
 166
 167 =cut
 168
 169 =head3 Single-value Fields
 170
 171 =over
 172
 173 =item submitter (single)
 174
 175 =cut
 176
 177 has submitter =>
 178     (is => 'ro',
 179      isa => 'Str',
 180      builder =>
 181      sub {
 182          my $self = shift;
 183          $self->__field_or_def('submitter',
 184                                $config{maintainer_email});
 185       },
 186      writer => '_set_submitter',
 187     );
 188
 189 =item date (single)
 190
 191 =cut
 192
 193 has date =>
 194     (is => 'ro',
 195      isa => 'Str',
 196      builder =>
 197      sub {
 198          my $self = shift;
 199          $self->__field_or_def('date',
 200                                time);
 201       },
 202      lazy => 1,
 203      writer => '_set_date',
 204     );
 205
 206 =item last_modified (single)
 207
 208 =cut
 209
 210 has last_modified =>
 211     (is => 'ro',
 212      isa => 'Str',
 213      builder =>
 214      sub {
 215          my $self = shift;
 216          $self->__field_or_def('last_modified',
 217                                time);
 218       },
 219      lazy => 1,
 220      writer => '_set_last_modified',
 221     );
 222
 223 =item log_modified (single)
 224
 225 =cut
 226
 227 has log_modified =>
 228     (is => 'ro',
 229      isa => 'Str',
 230      builder =>
 231      sub {
 232          my $self = shift;
 233          $self->__field_or_def('log_modified',
 234                                 time);
 235       },
 236      lazy => 1,
 237      writer => '_set_log_modified',
 238     );
 239
 240
 241 =item subject
 242
 243 =cut
 244
 245 has subject =>
 246     (is => 'ro',
 247      isa => 'Str',
 248      builder =>
 249      sub {
 250          my $self = shift;
 251          $self->__field_or_def('subject',
 252                                'No subject');
 253      },
 254      writer => '_set_subject',
 255     );
 256
 257 =item message_id
 258
 259 =cut
 260
 261 has message_id =>
 262     (is => 'ro',
 263      isa => 'Str',
 264      lazy => 1,
 265      builder =>
 266      sub {
 267          my $self = shift;
 268          $self->__field_or_def('message_id',
 269                                'nomessageid.'.$self->date.'_'.
 270                                md5_hex($self->subject.$self->submitter).
 271                                '@'.$config{email_domain},
 272                               );
 273      },
 274      writer => '_set_message_id',
 275     );
 276
 277
 278 =item done
 279
 280 =item severity
 281
 282 =cut
 283
 284 has severity =>
 285     (is => 'ro',
 286      isa => 'Str',
 287      builder =>
 288      sub {
 289          my $self = shift;
 290          $self->__field_or_def('severity',
 291                                $config{default_severity});
 292      },
 293      writer => '_set_severity',
 294     );
 295
 296 =item unarchived
 297
 298 Unix epoch the bug was last unarchived. Zero if the bug has never been
 299 unarchived.
 300
 301 =cut
 302
 303 has unarchived =>
 304     (is => 'ro',
 305      isa => 'Int',
 306      builder =>
 307      sub {
 308          my $self = shift;
 309          $self->__field_or_def('unarchived',
 310                                0);
 311      },
 312      writer => '_set_unarchived',
 313     );
 314
 315 =item archived
 316
 317 True if the bug is archived, false otherwise.
 318
 319 =cut
 320
 321 has archived =>
 322     (is => 'ro',
 323      isa => 'Int',
 324      builder =>
 325      sub {
 326          my $self = shift;
 327          $self->__field_or_def('archived',
 328                                0);
 329      },
 330      writer => '_set_archived',
 331     );
 332
 333 =item owner
 334
 335 =item summary
 336
 337 =item outlook
 338
 339 =item done
 340
 341 =item forwarded
 342
 343 =cut
 344
 345 for my $field (qw(owner unarchived summary outlook done forwarded)) {
 346     has $field =>
 347         (is => 'ro',
 348          isa => 'Str',
 349          builder =>
 350          sub {
 351              my $self = shift;
 352              $self->__field_or_def($field,
 353                                    '');
 354          },
 355          writer => '_set_'.$field,
 356         );
 357     my $field_method = $meta->find_method_by_name($field);
 358     die "No field method for $field" unless defined $field_method;
 359     $meta->add_method('has_'.$field =>
 360                       sub {my $self = shift;
 361                            return length($field_method->($self));
 362                        });
 363 }
 364
 365 =back
 366
 367 =head3 Multi-value Fields
 368
 369 =over
 370
 371 =item affects
 372
 373 =item package
 374
 375 =item tags
 376
 377 =cut
 378
 379 for my $field (qw(affects package tags)) {
 380     has '_'.$field =>
 381         (is => 'ro',
 382          traits => [qw(Array)],
 383          isa => 'ArrayRef[Str]',
 384          builder =>
 385          sub {
 386              my $self = shift;
 387              if ($self->_has__status) {
 388                  my $s = $self->_status()->{$field};
 389                  if (!ref($s)) {
 390                      $s = _build_split_field($s,
 391                                              $field);
 392                  }
 393                  return $s;
 394              }
 395              return [];
 396          },
 397          writer => '_set_'.$field,
 398          handles => {$field => 'elements',
 399                     },
 400          lazy => 1,
 401         );
 402     my $field_method = $meta->find_method_by_name($field);
 403     if (defined $field_method) {
 404         $meta->add_method($field.'_ref'=>
 405                           sub {my $self = shift;
 406                                return [$field_method->($self)]
 407                            });
 408     }
 409 }
 410
 411 =item found
 412
 413 =item fixed
 414
 415 =cut
 416
 417 sub __hashref_field {
 418     my ($self,$field) = @_;
 419
 420     if ($self->_has__status) {
 421         my $s = $self->_status()->{$field};
 422         if (!ref($s)) {
 423             $s = _build_split_field($s,
 424                                     $field);
 425         }
 426         return $s;
 427     }
 428     return [];
 429 }
 430
 431 for my $field (qw(found fixed)) {
 432     has '_'.$field =>
 433         (is => 'ro',
 434          traits => ['Hash'],
 435          isa => 'HashRef[Str]',
 436          builder =>
 437          sub {
 438              my $self = shift;
 439              if ($self->_has__status) {
 440                  my $s = $self->_status()->{$field};
 441                  if (!ref($s)) {
 442                      $s = _build_split_field($s,
 443                                              $field);
 444                  }
 445                  if (ref($s) ne 'HASH') {
 446                      $s = {map {$_,'1'} @{$s}};
 447                  }
 448                  return $s;
 449              }
 450              return {};
 451          },
 452          default => sub {return {}},
 453          writer => '_set_'.$field,
 454          handles => {$field => 'keys',
 455                     },
 456          lazy => 1,
 457         );
 458     my $field_method = $meta->find_method_by_name($field);
 459     if (defined $field_method) {
 460         $meta->add_method('_'.$field.'_ref'=>
 461                           sub {my $self = shift;
 462                                return [$field_method->($self)]
 463                            });
 464     }
 465 }
 466
 467
 468 for (qw(found fixed)) {
 469     around '_set_'.$_ => sub {
 470         my $orig = shift;
 471         my $self = shift;
 472         if (defined ref($_[0]) and
 473             ref($_[0]) eq 'ARRAY'
 474            ) {
 475             @_ = {map {$_,'1'} @{$_[0]}};
 476         } elsif (@_ > 1) {
 477             @_ = {map {$_,'1'} @_};
 478         }
 479         $self->$orig(@_);
 480     };
 481 }
 482
 483
 484
 485 =item mergedwith
 486
 487 =item blocks
 488
 489 =item blocked_by
 490
 491 =cut
 492
 493 for my $field (qw(blocks blocked_by mergedwith)) {
 494     has '_'.$field =>
 495         (is => 'ro',
 496          traits => ['Hash'],
 497          isa => 'HashRef[Int]',
 498          builder =>
 499          sub {
 500              my $self = shift;
 501              if ($self->_has__status) {
 502                  my $s = $self->_status()->{$field};
 503                  if (!ref($s)) {
 504                      $s = _build_split_field($s,
 505                                              $field);
 506                  }
 507                  if (ref($s) ne 'HASH') {
 508                      $s = {map {$_,'1'} @{$s}};
 509                  }
 510                  return $s;
 511              }
 512              return {};
 513          },
 514          writer => '_set_'.$field,
 515          lazy => 1,
 516         );
 517     my $internal_field_method = $meta->find_method_by_name('_'.$field);
 518     die "No field method for _$field" unless defined $internal_field_method;
 519     $meta->add_method($field =>
 520                       sub {my $self = shift;
 521                            return sort {$a <=> $b}
 522                                keys %{$internal_field_method->($self)};
 523                        });
 524     my $field_method = $meta->find_method_by_name($field);
 525     die "No field method for _$field" unless defined $field_method;
 526     $meta->add_method('_'.$field.'_ref'=>
 527                       sub {my $self = shift;
 528                            return [$field_method->($self)]
 529                        });
 530 }
 531
 532 for (qw(blocks blocked_by mergedwith)) {
 533     around '_set_'.$_ => sub {
 534         my $orig = shift;
 535         my $self = shift;
 536         if (defined ref($_[0]) and
 537             ref($_[0]) eq 'ARRAY'
 538            ) {
 539             $_[0] = {map {$_,'1'} @{$_[0]}};
 540         } elsif (@_ > 1) {
 541             @_ = {map {$_,'1'} @{$_[0]}};
 542         }
 543         $self->$orig(@_);
 544     };
 545 }
 546
 547 =back
 548
 549 =cut
 550
 551 sub _build_split_field {
 552     sub sort_and_unique {
 553         my @v;
 554         my %u;
 555         my $all_numeric = 1;
 556         for my $v (@_) {
 557             if ($all_numeric and $v =~ /\D/) {
 558                 $all_numeric = 0;
 559             }
 560             next if exists $u{$v};
 561             $u{$v} = 1;
 562             push @v, $v;
 563         }
 564         if ($all_numeric) {
 565             return sort {$a <=> $b} @v;
 566         } else {
 567             return sort @v;
 568         }
 569     }
 570     sub split_ditch_empty {
 571         return grep {length $_} map {split ' '} @_;
 572
 573     }
 574     my ($val,$field) = @_;
 575     $val //= '';
 576
 577     if ($field =~ /^(package|affects|source)$/) {
 578         return [grep {length $_} map lc, split /[\s,()?]+/, $val];
 579     } else {
 580         return [sort_and_unique(split_ditch_empty($val))];
 581     }
 582 }
 583
 584
 585 __PACKAGE__->meta->make_immutable;
 586
 587 no Mouse;
 588 no Mouse::Util::TypeConstraints;
 589 1;
 590
 591
 592 __END__
 593 # Local Variables:
 594 # indent-tabs-mode: nil
 595 # cperl-indent-level: 4
 596 # End: