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