X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=Debbugs%2FDB%2FLoad.pm;h=03ab770636eb8ec3a1d554ad78815f1f17794d8f;hb=466f7faff129a5699c7674f59900a92aa256175d;hp=3ff6470586f26b15075e413c1db49177d08591e3;hpb=54fc7e0edd7b95eda0e49f7d8c6a0d9c6a47baef;p=debbugs.git diff --git a/Debbugs/DB/Load.pm b/Debbugs/DB/Load.pm index 3ff6470..03ab770 100644 --- a/Debbugs/DB/Load.pm +++ b/Debbugs/DB/Load.pm @@ -23,6 +23,7 @@ None known. use warnings; use strict; +use v5.10; use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT); use base qw(Exporter); @@ -31,7 +32,10 @@ BEGIN{ $DEBUG = 0 unless defined $DEBUG; @EXPORT = (); - %EXPORT_TAGS = (load_bug => [qw(load_bug handle_load_bug_queue)], + %EXPORT_TAGS = (load_bug => [qw(load_bug handle_load_bug_queue load_bug_log)], + load_debinfo => [qw(load_debinfo)], + load_package => [qw(load_packages)], + load_suite => [qw(load_suite)], ); @EXPORT_OK = (); Exporter::export_ok_tags(keys %EXPORT_TAGS); @@ -39,12 +43,16 @@ BEGIN{ } use Params::Validate qw(validate_with :types); +use List::AllUtils qw(natatime); use Debbugs::Status qw(read_bug split_status_fields); use Debbugs::DB; use DateTime; -use Debbugs::Common qw(make_list); +use Debbugs::Common qw(make_list getparsedaddrs); use Debbugs::Config qw(:config); +use Debbugs::MIME qw(parse_to_mime_entity decode_rfc1522); +use DateTime::Format::Mail; +use Carp; =head2 Bug loading @@ -76,72 +84,161 @@ Loads a bug's metadata into the database. (Does not load any messages) =cut sub load_bug { - my %param = validate_with(params => \@_, + my %param = validate_with(params => \@_, spec => {db => {type => OBJECT, }, - data => {type => HASHREF}, + data => {type => HASHREF, + optional => 1, + }, + bug => {type => SCALAR, + optional => 1, + }, tags => {type => HASHREF, default => sub {return {}}, optional => 1}, + severities => {type => HASHREF, + default => sub {return {}}, + optional => 1, + }, queue => {type => HASHREF, optional => 1}, + packages => {type => HASHREF, + default => sub {return {}}, + optional => 1, + }, }); my $s = $param{db}; + if (not exists $param{data} and not exists $param{bug}) { + croak "One of data or bug must be provided to load_bug"; + } + if (not exists $param{data}) { + $param{data} = read_bug(bug => $param{bug}); + } my $data = $param{data}; my $tags = $param{tags}; my $queue = $param{queue}; + my $severities = $param{severities}; my $can_queue = 1; if (not defined $queue) { $can_queue = 0; $queue = {}; } - my $s_data = split_status_fields($data); - my @tags; - for my $tag (make_list($s_data->{keywords})) { + my %tags; + $data = split_status_fields($data); + for my $tag (make_list($data->{keywords})) { next unless defined $tag and length $tag; # this allows for invalid tags. But we'll use this to try to # find those bugs and clean them up if (not exists $tags->{$tag}) { - $tags->{$tag} = $s->resultset('Tag')->find_or_create({tag => $tag}); + $tags->{$tag} = $s->resultset('Tag')-> + find_or_create({tag => $tag}); } - push @tags, $tags->{$tag}; - } - my $bug = {id => $data->{bug_num}, - creation => DateTime->from_epoch(epoch => $data->{date}), - log_modified => DateTime->from_epoch(epoch => $data->{log_modified}), - last_modified => DateTime->from_epoch(epoch => $data->{last_modified}), - archived => $data->{archived}, - (defined $data->{unarchived} and length($data->{unarchived}))?(unarchived => DateTime->from_epoch(epoch => $data->{unarchived})):(), - forwarded => $data->{forwarded} // '', - summary => $data->{summary} // '', - outlook => $data->{outlook} // '', - subject => $data->{subject} // '', - done => $data->{done} // '', - owner => $data->{owner} // '', - submitter => $data->{submitter} // '', - severity => length($data->{severity}) ? $data->{severity} : $config{default_severity}, - }; - $s->resultset('Bug')->update_or_create($bug); + $tags{$tag} = $tags->{$tag}; + } + my $severity = length($data->{severity}) ? $data->{severity} : + $config{default_severity}; + if (not exists $severities->{$severity}) { + $severities->{$severity} = + $s->resultset('Severity')-> + find_or_create({severity => $severity}, + ); + } + $severity = $severities->{$severity}; + my $bug = + {id => $data->{bug_num}, + creation => DateTime->from_epoch(epoch => $data->{date}), + log_modified => DateTime->from_epoch(epoch => $data->{log_modified}), + last_modified => DateTime->from_epoch(epoch => $data->{last_modified}), + archived => $data->{archived}, + (defined $data->{unarchived} and length($data->{unarchived}))? + (unarchived => DateTime->from_epoch(epoch => $data->{unarchived})):(), + forwarded => $data->{forwarded} // '', + summary => $data->{summary} // '', + outlook => $data->{outlook} // '', + subject => $data->{subject} // '', + done_full => $data->{done} // '', + severity => $severity, + owner_full => $data->{owner} // '', + submitter_full => $data->{originator} // '', + }; + my %addr_map = + (done => 'done', + owner => 'owner', + submitter => 'originator', + ); + for my $addr_type (keys %addr_map) { + $bug->{$addr_type} = undef; + next unless defined $data->{$addr_map{$addr_type}} and + length($data->{$addr_map{$addr_type}}); + $bug->{$addr_type} = + $s->resultset('Correspondent')-> + get_correspondent_id($data->{$addr_map{$addr_type}}) + } + my $b = $s->resultset('Bug')->update_or_create($bug) or + die "Unable to update or create bug $bug->{id}"; $s->txn_do(sub { - for my $ff (qw(found fixed)) { - my @elements = $s->resultset('BugVer')->search({bug_id => $data->{bug_num}, + my @unknown_packages; + my @unknown_affects_packages; + push @unknown_packages, + $b->set_related_packages('binpackages', + [grep {defined $_ and + length $_ and $_ !~ /^src:/} + make_list($data->{package})], + $param{packages}, + ); + push @unknown_packages, + $b->set_related_packages('srcpackages', + [map {s/src://; + $_} + grep {defined $_ and + $_ =~ /^src:/} + make_list($data->{package})], + $param{packages}, + ); + push @unknown_affects_packages, + $b->set_related_packages('affects_binpackages', + [grep {defined $_ and + length $_ and $_ !~ /^src:/} + make_list($data->{affects}) + ], + $param{packages}, + ); + push @unknown_affects_packages, + $b->set_related_packages('affects_srcpackages', + [map {s/src://; + $_} + grep {defined $_ and + $_ =~ /^src:/} + make_list($data->{affects})], + $param{packages}, + ); + $b->unknown_packages(join(', ',@unknown_packages)); + $b->unknown_affects(join(', ',@unknown_affects_packages)); + $b->update(); + for my $ff (qw(found fixed)) { + my @elements = $s->resultset('BugVer')->search({bug => $data->{bug_num}, found => $ff eq 'found'?1:0, }); - my %elements_to_delete = map {($elements[$_]->ver_string(),$_)} 0..$#elements; - my @elements_to_add; + my %elements_to_delete = map {($elements[$_]->ver_string(), + $elements[$_])} 0..$#elements; + my %elements_to_add; + my @elements_to_keep; for my $version (@{$data->{"${ff}_versions"}}) { if (exists $elements_to_delete{$version}) { - delete $elements_to_delete{$version}; + push @elements_to_keep,$version; } else { - push @elements_to_add,$version; + $elements_to_add{$version} = 1; } } + for my $version (@elements_to_keep) { + delete $elements_to_delete{$version}; + } for my $element (keys %elements_to_delete) { - $elements_to_delete{$element}->delete(); + $elements_to_delete{$element}->delete(); } - for my $element (@elements_to_add) { + for my $element (keys %elements_to_add) { # find source package and source version id - my $ne = $s->resultset('BugVer')->new_result({bug_id => $data->{bug_num}, + my $ne = $s->resultset('BugVer')->new_result({bug => $data->{bug_num}, ver_string => $element, found => $ff eq 'found'?1:0, } @@ -149,32 +246,45 @@ sub load_bug { if (my ($src_pkg,$src_ver) = $element =~ m{^([^\/]+)/(.+)$}) { my $src_pkg_e = $s->resultset('SrcPkg')->single({pkg => $src_pkg}); if (defined $src_pkg_e) { - $ne->src_pkg_id($src_pkg_e->id()); - my $src_ver_e = $s->resultset('SrcVer')->single({src_pkg_id => $src_pkg_e->id(), + $ne->src_pkg($src_pkg_e->id()); + my $src_ver_e = $s->resultset('SrcVer')->single({src_pkg => $src_pkg_e->id(), ver => $src_ver }); - $ne->src_ver_id($src_ver_e->id()) if defined $src_ver_e; + $ne->src_ver($src_ver_e->id()) if defined $src_ver_e; } } $ne->insert(); } } }); - $s->txn_do(sub { - $s->resultset('BugTag')->search({bug_id => $data->{bug_num}})->delete(); - $s->populate(BugTag => [[qw(bug_id tag_id)], map {[$data->{bug_num}, $_->id()]} @tags]); - }); + ### set bug tags + $s->txn_do(sub {$b->set_tags([values %tags ] )}); # because these bugs reference other bugs which might not exist # yet, we can't handle them until we've loaded all bugs. queue # them up. - $queue->{merged}{$data->{bug_num}} = [@{$data->{mergedwith}}]; - $queue->{blocks}{$data->{bug_num}} = [@{$data->{blocks}}]; + for my $merge_block (qw(mergedwith blocks)) { + my $count = 0; + if (@{$data->{$merge_block}}) { + $count = + $s->resultset('Bug')-> + search({id => [@{$data->{$merge_block}}]})-> + count(); + } + # if all of the bugs exist, immediately fix the merge/blocks + if ($count == @{$data->{$merge_block}}) { + handle_load_bug_queue(db=>$s, + queue => {$merge_block, + {$data->{bug_num},[@{$data->{$merge_block}}]} + }); + } else { + $queue->{$merge_block}{$data->{bug_num}} = [@{$data->{$merge_block}}]; + } + } - if (not $can_queue) { + if (not $can_queue and keys %{$queue}) { handle_load_bug_queue(db => $s,queue => $queue); } - print STDERR "Handled $data->{bug_num}\n"; # still need to handle merges, versions, etc. } @@ -199,26 +309,152 @@ sub handle_load_bug_queue{ my $s = $param{db}; my $queue = $param{queue}; my %queue_types = - (merged => {set => 'BugMerged', - columns => [qw(bug_id merged)], - bug_id => 'bug_id', - }, + (mergedwith => {set => 'BugMerged', + columns => [qw(bug merged)], + bug => 'bug', + }, blocks => {set => 'BugBlock', - columns => [qw(bug_id blocks)], - bug_id => 'bug_id', - }, + columns => [qw(bug blocks)], + bug => 'bug', + }, ); for my $queue_type (keys %queue_types) { - for my $bug (%{$queue->{$queue_type}}) { - my $qt = $queue_types{$queue_type}; + my $qt = $queue_types{$queue_type}; + my @bugs = keys %{$queue->{$queue_type}}; + next unless @bugs; + my @entries; + for my $bug (@bugs) { + push @entries, + map {[$bug,$_]} + @{$queue->{$queue_type}{$bug}}; + } + $s->txn_do(sub { + $s->resultset($qt->{set})-> + search({$qt->{bug}=>\@bugs})->delete(); + $s->resultset($qt->{set})-> + populate([[@{$qt->{columns}}], + @entries]) if @entries; + } + ); + } +} + +=item load_bug_log -- load bug logs + + load_bug_log(db => $s, + bug => $bug); + + +=over + +=item db -- database + +=item bug -- bug whose log should be loaded + +=back + +=cut + +sub load_bug_log { + my %param = validate_with(params => \@_, + spec => {db => {type => OBJECT, + }, + bug => {type => SCALAR, + }, + queue => {type => HASHREF, + optional => 1}, + }); + my $s = $param{db}; + my $msg_num=0; + my %seen_msg_ids; + my $log = Debbugs::Log->new(bug_num => $param{bug}) or + die "Unable to open log for $param{bug} for reading: $!"; + while (my $record = $log->read_record()) { + next unless $record->{type} eq 'incoming-recv'; + my ($msg_id) = $record->{text} =~ /^Message-Id:\s+<(.+)>/im; + next if defined $msg_id and exists $seen_msg_ids{$msg_id}; + $seen_msg_ids{$msg_id} = 1 if defined $msg_id; + next if defined $msg_id and $msg_id =~ /handler\..+\.ack(?:info)?\@/; + my $entity = parse_to_mime_entity($record); + # search for a message with this message id in the database + $msg_id = $entity->head->get('Message-Id') // + $entity->head->get('Resent-Message-ID') // + ''; + $msg_id =~ s/^\s*\\s*$//; + # check to see if the subject, to, and from match. if so, it's + # probably the same message. + my $subject = decode_rfc1522($entity->head->get('Subject')//''); + $subject =~ s/\n(?:(\s)\s*|\s*$)//g; + my $to = decode_rfc1522($entity->head->get('To')//''); + $to =~ s/\n(?:(\s)\s*|\s*$)//g; + my $from = decode_rfc1522($entity->head->get('From')//''); + $from =~ s/\n(?:(\s)\s*|\s*$)//g; + my $m = $s->resultset('Message')-> + find({msgid => $msg_id, + from_complete => $from, + to_complete => $to, + subject => $subject + }); + if (not defined $m) { + # if not, create a new message + $m = $s->resultset('Message')-> + find_or_create({msgid => $msg_id, + from_complete => $from, + to_complete => $to, + subject => $subject + }); + eval { + my $date = DateTime::Format::Mail-> + parse_datetime($entity->head->get('Date',0)); + if (abs($date->offset) >= 60 * 60 * 12) { + $date = $date->set_time_zone('UTC'); + } + $m->sent_date($date); + }; + my $spam = $entity->head->get('X-Spam-Status',0)//''; + if ($spam=~ /score=([\d\.]+)/) { + $m->spam_score($1); + } + my %corr; + @{$corr{from}} = getparsedaddrs($from); + @{$corr{to}} = getparsedaddrs($to); + @{$corr{cc}} = getparsedaddrs($entity->head->get('Cc')); + # add correspondents if necessary + my @cors; + for my $type (keys %corr) { + for my $addr (@{$corr{$type}}) { + my $cor = $s->resultset('Correspondent')-> + get_correspondent_id($addr); + next unless defined $cor; + push @cors, + {correspondent => $cor, + correspondent_type => $type, + }; + } + } + $m->update(); $s->txn_do(sub { - $s->resultset($qt->{set})->search({$qt->{bug_id},$bug})->delete(); - $s->populate($qt->{set},[[@{$qt->{columns}}],map {[$bug,$_]} @{$queue->{$queue_type}{$bug}}]) if - @{$queue->{$queue_type}{$bug}}; + $m->message_correspondents()->delete(); + $m->add_to_message_correspondents(@cors) if + @cors; } ); } + my $recv; + if ($entity->head->get('Received',0) + =~ /via spool by (\S+)/) { + $recv = $s->resultset('Correspondent')-> + get_correspondent_id($1); + $m->add_to_message_correspondents({correspondent=>$recv, + correspondent_type => 'recv'}); + } + # link message to bugs if necessary + $m->find_or_create_related('bug_messages', + {bug=>$param{bug}, + message_number => $msg_num}); } + } =back @@ -227,6 +463,8 @@ sub handle_load_bug_queue{ Commands to handle src and package version loading from debinfo files +=over + =item load_debinfo load_debinfo($schema,$binname, $binver, $binarch, $srcname, $srcver); @@ -236,20 +474,298 @@ Commands to handle src and package version loading from debinfo files =cut sub load_debinfo { - my ($schema,$binname, $binver, $binarch, $srcname, $srcver) = @_; - my $sp = $schema->resultset('SrcPkg')->find_or_create({pkg => $srcname}); - my $sv = $schema->resultset('SrcVer')->find_or_create({src_pkg_id=>$sp->id(), - ver => $srcver}); - my $arch = $schema->resultset('Arch')->find_or_create({arch => $binarch}); - my $bp = $schema->resultset('BinPkg')->find_or_create({pkg => $binname}); - $schema->resultset('BinVer')->find_or_create({bin_pkg_id => $bp->id(), - src_ver_id => $sv->id(), - arch_id => $arch->id(), - ver => $binver, - }); + my ($s,$binname, $binver, $binarch, $srcname, $srcver,$ct_date,$cache) = @_; + $cache //= {}; + my $sp; + if (not defined $cache->{sp}{$srcname}) { + $cache->{sp}{$srcname} = + $s->resultset('SrcPkg')->find_or_create({pkg => $srcname}); + } + $sp = $cache->{sp}{$srcname}; + # update the creation date if the data we have is earlier + if (defined $ct_date and + (not defined $sp->creation or + $ct_date < $sp->creation)) { + $sp->creation($ct_date); + $sp->last_modified(DateTime->now); + $sp->update; + } + my $sv; + if (not defined $cache->{sv}{$srcname}{$srcver}) { + $cache->{sv}{$srcname}{$srcver} = + $s->resultset('SrcVer')-> + find_or_create({src_pkg =>$sp->id(), + ver => $srcver}); + } + $sv = $cache->{sv}{$srcname}{$srcver}; + if (defined $ct_date and + (not defined $sv->upload_date() or $ct_date < $sv->upload_date())) { + $sv->upload_date($ct_date); + $sv->update; + } + my $arch; + if (not defined $cache->{arch}{$binarch}) { + $cache->{arch}{$binarch} = + $s->resultset('Arch')-> + find_or_create({arch => $binarch}, + )->id(); + } + $arch = $cache->{arch}{$binarch}; + my $bp; + if (not defined $cache->{bp}{$binname}) { + $cache->{bp}{$binname} = + $s->resultset('BinPkg')-> + get_or_create_bin_pkg_id($binname); + } + $bp = $cache->{bp}{$binname}; + $s->resultset('BinVer')-> + get_bin_ver_id($bp,$binver,$arch,$sv->id()); +} + + +=back + +=head2 Packages + +=over + +=item load_package + + load_package($schema,$suite,$component,$arch,$pkg) + +=cut + +sub load_packages { + my ($schema,$suite,$pkgs,$p) = @_; + my $suite_id = $schema->resultset('Suite')-> + find_or_create({codename => $suite})->id; + my %maint_cache; + my %arch_cache; + my %source_cache; + my $src_max_last_modified = $schema->resultset('SrcAssociation')-> + search_rs({suite => $suite_id}, + {order_by => {-desc => ['me.modified']}, + rows => 1, + page => 1 + } + )->single(); + my $bin_max_last_modified = $schema->resultset('BinAssociation')-> + search_rs({suite => $suite_id}, + {order_by => {-desc => ['me.modified']}, + rows => 1, + page => 1 + } + )->single(); + my %maints; + my %sources; + my %bins; + for my $pkg_tuple (@{$pkgs}) { + my ($arch,$component,$pkg) = @{$pkg_tuple}; + $maints{$pkg->{Maintainer}} = $pkg->{Maintainer}; + if ($arch eq 'source') { + my $source = $pkg->{Package}; + my $source_ver = $pkg->{Version}; + $sources{$source}{$source_ver} = $pkg->{Maintainer}; + } else { + my $source = $pkg->{Source} // $pkg->{Package}; + my $source_ver = $pkg->{Version}; + if ($source =~ /^\s*(\S+) \(([^\)]+)\)\s*$/) { + ($source,$source_ver) = ($1,$2); + } + $sources{$source}{$source_ver} = $pkg->{Maintainer}; + $bins{$arch}{$pkg->{Package}} = + {arch => $arch, + bin => $pkg->{Package}, + bin_ver => $pkg->{Version}, + src_ver => $source_ver, + source => $source, + maint => $pkg->{Maintainer}, + }; + } + } + # Retrieve and Insert new maintainers + my $maints = + $schema->resultset('Maintainer')-> + get_maintainers(keys %maints); + my $archs = + $schema->resultset('Arch')-> + get_archs(keys %bins); + # We want all of the source package/versions which are in this suite to + # start with + my @sa_to_add; + my @sa_to_del; + my %included_sa; + # Calculate which source packages are no longer in this suite + for my $s ($schema->resultset('SrcPkg')-> + src_pkg_and_ver_in_suite($suite)) { + if (not exists $sources{$s->{pkg}} or + not exists $sources{$s->{pkg}}{$s->{src_vers}{ver}} + ) { + push @sa_to_del, + $s->{src_associations}{id}; + } + $included_sa{$s->{pkg}}{$s->{src_vers}} = 1; + } + # Calculate which source packages are newly in this suite + for my $s (keys %sources) { + for my $v (keys %{$sources{$s}}) { + if (not exists $included_sa{$s} and + not $included_sa{$s}{$v}) { + push @sa_to_add, + [$s,$v,$sources{$s}{$v}]; + } else { + $p->update() if defined $p; + } + } + } + # add new source packages + my $it = natatime 100, @sa_to_add; + while (my @v = $it->()) { + $schema->txn_do( + sub { + for my $svm (@_) { + my $s_id = $schema->resultset('SrcPkg')-> + get_or_create_src_pkg_id($svm->[0]); + my $sv_id = $schema->resultset('SrcVer')-> + get_src_ver_id($s_id,$svm->[1],$maints->{$svm->[2]}); + $schema->resultset('SrcAssociation')-> + insert_suite_src_ver_association($suite_id,$sv_id); + } + }, + @v + ); + $p->update($p->last_update()+ + scalar @v) if defined $p; + } + # remove associations for packages not in this suite + if (@sa_to_del) { + $it = natatime 1000, @sa_to_del; + while (my @v = $it->()) { + $schema-> + txn_do(sub { + $schema->resultset('SrcAssociation')-> + search_rs({id => \@v})-> + delete(); + }); + } + } + # update packages in this suite to have a modification time of now + $schema->resultset('SrcAssociation')-> + search_rs({suite => $suite_id})-> + update({modified => 'NOW()'}); + ## Handle binary packages + my @bin_to_del; + my @bin_to_add; + my %included_bin; + # calculate which binary packages are no longer in this suite + for my $b ($schema->resultset('BinPkg')-> + bin_pkg_and_ver_in_suite($suite)) { + if (not exists $bins{$b->{arch}{arch}} or + not exists $bins{$b->{arch}{arch}}{$b->{pkg}} or + ($bins{$b->{arch}{arch}}{$b->{pkg}}{bin_ver} ne + $b->{bin_vers}{ver} + ) + ) { + push @bin_to_del, + $b->{bin_associations}{id}; + } + $included_bin{$b->{arch}{arch}}{$b->{pkg}} = + $b->{bin_vers}{ver}; + } + # calculate which binary packages are newly in this suite + for my $a (keys %bins) { + for my $pkg (keys %{$bins{$a}}) { + if (not exists $included_bin{$a} or + not exists $included_bin{$a}{$pkg} or + $bins{$a}{$pkg}{bin_ver} ne + $included_bin{$a}{$pkg}) { + push @bin_to_add, + $bins{$a}{$pkg}; + } else { + $p->update() if defined $p; + } + } + } + $it = natatime 100, @bin_to_add; + while (my @v = $it->()) { + $schema->txn_do( + sub { + for my $bvm (@_) { + my $s_id = $schema->resultset('SrcPkg')-> + get_or_create_src_pkg_id($bvm->{source}); + my $sv_id = $schema->resultset('SrcVer')-> + get_src_ver_id($s_id,$bvm->{src_ver},$maints->{$bvm->{maint}}); + my $b_id = $schema->resultset('BinPkg')-> + get_or_create_bin_pkg_id($bvm->{bin}); + my $bv_id = $schema->resultset('BinVer')-> + get_bin_ver_id($b_id,$bvm->{bin_ver}, + $archs->{$bvm->{arch}},$sv_id); + $schema->resultset('BinAssociation')-> + insert_suite_bin_ver_association($suite_id,$bv_id); + } + }, + @v + ); + $p->update($p->last_update()+ + scalar @v) if defined $p; + } + if (@bin_to_del) { + $it = natatime 1000, @bin_to_del; + while (my @v = $it->()) { + $schema-> + txn_do(sub { + $schema->resultset('BinAssociation')-> + search_rs({id => \@v})-> + delete(); + }); + } + } + $schema->resultset('BinAssociation')-> + search_rs({suite => $suite_id})-> + update({modified => 'NOW()'}); + +} + + +=back + +=cut + +=head2 Suites + +=over + +=item load_suite + + load_suite($schema,$codename,$suite,$version,$active); + +=cut + +sub load_suite { + my ($schema,$codename,$suite,$version,$active) = @_; + if (ref($codename)) { + ($codename,$suite,$version) = + @{$codename}{qw(Codename Suite Version)}; + $active = 1; + } + my $s = $schema->resultset('Suite')->find_or_create({codename => $codename}); + $s->suite_name($suite); + $s->version($version); + $s->active($active); + $s->update(); + return $s; + } +=back + +=cut + 1; __END__ +# Local Variables: +# indent-tabs-mode: nil +# cperl-indent-level: 4 +# End: