From 01d6abb88ebeb8a357f1982242e0a94b29efb067 Mon Sep 17 00:00:00 2001 From: Brian Moses Hall Date: Mon, 3 Nov 2025 21:54:43 -0500 Subject: [PATCH 1/7] ETT-61 Exclude */man items from newyear.pl - Add `NewYear` module with tests for `are_rights_in_scope` extracted and expanded from what is in bin/newyear.pl - TODO: check the items listed in the tests, which are comprehensive, with KH to get confirmation this is the correct list --- bin/newyear.pl | 9 +++-- lib/CRMS/NewYear.pm | 43 ++++++++++++++++++++ t/lib/CRMS/NewYear.t | 96 ++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 145 insertions(+), 3 deletions(-) create mode 100644 lib/CRMS/NewYear.pm create mode 100644 t/lib/CRMS/NewYear.t diff --git a/bin/newyear.pl b/bin/newyear.pl index eeda7331..9ca7b1f1 100755 --- a/bin/newyear.pl +++ b/bin/newyear.pl @@ -18,6 +18,7 @@ BEGIN use Data::Dumper; use CRMS; +use CRMS::NewYear; use CRMS::RightsPredictor; binmode(STDOUT, ':encoding(UTF-8)'); @@ -83,6 +84,7 @@ END verbose => $verbose, instance => $instance ); +my $new_year = CRMS::NewYear->new; $verbose = 0 unless defined $verbose; print "Verbosity $verbose\n" if $verbose; @@ -153,7 +155,7 @@ sub ProcessCommonwealthProject { next; } my ($acurr, $rcurr, $src, $usr, $timecurr, $note) = @{$rq->[0]}; - next if $acurr eq 'pd' or $acurr =~ m/^cc/; + next if !$new_year->are_rights_in_scope($acurr, $rcurr); my $record = $crms->GetMetadata($id); next unless defined $record; my $rp = CRMS::RightsPredictor->new(record => $record); @@ -259,6 +261,7 @@ sub ProcessPubDateProject $date =~ s/^\s+|\s+$//g; $dates{$date} = $date if defined $date; } + # FIXME: $date_str is unused my $date_str = join ', ', keys %dates; if (scalar keys %dates == 1) { my $rq = $crms->RightsQuery($id, 1); @@ -267,7 +270,7 @@ sub ProcessPubDateProject next; } my ($acurr, $rcurr, $src, $usr, $timecurr, $note) = @{$rq->[0]}; - next if $acurr eq 'pd' or $acurr =~ m/^cc/; + next if !$new_year->are_rights_in_scope($acurr, $rcurr); my $record = $crms->GetMetadata($id); if (!defined $record) { #print RED "Unable to get metadata for $id\n"; @@ -318,7 +321,7 @@ sub ProcessCrownCopyrightProject { next; } my ($acurr, $rcurr, $src, $usr, $timecurr, $note) = @{$rq->[0]}; - next if $acurr eq 'pd' or $acurr =~ m/^cc/; + next if !$new_year->are_rights_in_scope($acurr, $rcurr); my $record = $crms->GetMetadata($id); next unless defined $record; my $gid = $row->[1]; diff --git a/lib/CRMS/NewYear.pm b/lib/CRMS/NewYear.pm new file mode 100644 index 00000000..2eb892c5 --- /dev/null +++ b/lib/CRMS/NewYear.pm @@ -0,0 +1,43 @@ +package CRMS::NewYear; + +# A utility package containing logic that relates to the new year Public Domain Day +# rollover of rights. + +use strict; +use warnings; +use utf8; + +use Data::Dumper; + +sub new { + my $class = shift; + + my $self = { @_ }; + bless($self, $class); + return $self; +} + +# Are the passed-in current rights "attribute" and "reason" names in scope for +# PDD rollover? This excludes pd and CC items, because there's nothing more to be done. +# It also excludes */{con, del, man, pvt, supp} items, because CRMS can't override them +# and there is no point in reporting them. +sub are_rights_in_scope { + my $self = shift; + my $attribute = shift; + my $reason = shift; + + if ( + $attribute eq 'pd' || + $attribute =~ m/^cc/ || + $reason eq 'con' || + $reason eq 'del' || + $reason eq 'man' || + $reason eq 'pvt' || + $reason eq 'supp' + ) { + return; + } + return 1; +} + +1; diff --git a/t/lib/CRMS/NewYear.t b/t/lib/CRMS/NewYear.t new file mode 100644 index 00000000..07b793fd --- /dev/null +++ b/t/lib/CRMS/NewYear.t @@ -0,0 +1,96 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; + +use lib $ENV{'SDRROOT'} . '/crms/lib'; +use CRMS::NewYear; + +my $new_year = CRMS::NewYear->new; + +subtest 'new' => sub { + isa_ok($new_year, 'CRMS::NewYear'); +}; + +# Note: here we are testing all 59 attested attr/reason combinations attested in rights_current +# at time of writing. Some of these are a little head scratchy. +subtest 'are_rights_in_scope' => sub { + subtest 'with in-scope rights combinations' => sub { + my $in_scope = [ + 'ic/add', + 'ic/bib', + 'ic/cdpp', + 'ic/crms', + 'ic/ipma', + 'icus/gatt', + 'icus/ren', + 'op/ipma', + 'pdus/add', + 'pdus/bib', + 'pdus/cdpp', + 'pdus/crms', + 'pdus/gfv', + 'pdus/ncn', + 'pdus/ren', + 'pdus/ncn', + 'und/bib', + 'und/crms', + 'und/ipma', + 'und/nfi', + 'und/ren', + ]; + foreach my $rights (@$in_scope) { + my ($attribute, $reason) = split('/', $rights); + ok($new_year->are_rights_in_scope($attribute, $reason), "$rights is in scope"); + } + }; + + subtest 'with out-of-scope rights combinations' => sub { + my $out_of_scope = [ + 'cc-by-3.0/con', + 'cc-by-3.0/man', + 'cc-by-4.0/con', + 'cc-by-4.0/man', + 'cc-by-nc-3.0/con', + 'cc-by-nc-3.0/man', + 'cc-by-nc-4.0/con', + 'cc-by-nc-4.0/man', + 'cc-by-nc-nd-3.0/con', + 'cc-by-nc-nd-4.0/con', + 'cc-by-nc-nd-4.0/man', + 'cc-by-nc-sa-3.0/con', + 'cc-by-nc-sa-4.0/con', + 'cc-by-nd-3.0/con', + 'cc-by-nd-4.0/con', + 'cc-by-sa-3.0/con', + 'cc-by-sa-4.0/con', + 'cc-zero/con', + 'ic-world/con', + 'ic-world/man', + 'nobody/del', + 'nobody/man', + 'nobody/pvt', + 'pd/add', + 'pd/bib', + 'pd/cdpp', + 'pd/con', + 'pd/crms', + 'pd/exp', + 'pd/man', + 'pd/ncn', + 'pd/ren', + 'pdus/man', + 'pd-pvt/pvt', + 'supp/supp', + 'und-world/con', + ]; + foreach my $rights (@$out_of_scope) { + my ($attribute, $reason) = split('/', $rights); + ok(!$new_year->are_rights_in_scope($attribute, $reason), "$rights is out of scope"); + } + }; +}; + +done_testing(); From a97b06fb3254f6d2ec95fa5e1529dfd1452e9894 Mon Sep 17 00:00:00 2001 From: Brian Moses Hall Date: Wed, 5 Nov 2025 11:31:01 -0500 Subject: [PATCH 2/7] Add `CRMS::NewYear` method `choose_rights_prediction` This is intended to replace one of the nastiest blocks of code encountered in `bin/newyear.pl` around lines 198-215 and duplicated at 359-376. Much depends on this being comprehensible and working as intended, so this is an attempt to get a better handle on it. Currently this new method is not swapped in. I would like to do an A/B comparison between the two methods of comparing PDD rights predictions. --- lib/CRMS/NewYear.pm | 73 ++++++++++++++++++++++++++++++++++++++++++++ t/lib/CRMS/NewYear.t | 45 +++++++++++++++++++++++++++ 2 files changed, 118 insertions(+) diff --git a/lib/CRMS/NewYear.pm b/lib/CRMS/NewYear.pm index 2eb892c5..7b4257bb 100644 --- a/lib/CRMS/NewYear.pm +++ b/lib/CRMS/NewYear.pm @@ -8,6 +8,7 @@ use warnings; use utf8; use Data::Dumper; +use List::Util qw(); sub new { my $class = shift; @@ -40,4 +41,76 @@ sub are_rights_in_scope { return 1; } +# Given a set of rights predictions that might reasonably be made based on reviewer data, +# in the form of a hashref of { "pd/add" => 1, "ic/add" => 1, ... } and the current attribute +# name, calculate the most restrictive attribute among the predictions, provided that attribute +# would be a "step up" from the current one (in terms of permissiveness). +# For example, if there is a "pdus" and an "icus" prediction, only consider "icus". +# And then only return it as the new rights if it would make the current rights less restrictive. +# +# Scenario where no prediction is allowed: +# |-----------| +# | 3 pd | <----- PREDICTION (cannot use, it is not the most restrictive) +# |-----------| +# | 2 pdus | <----- CURRENT RIGHTS +# |-----------| +# | 1 icus | <----- PREDICTION (cannot use, would be a downgrade) +# |-----------| +# | 0 ic | +# |-----------| +# +# Scenario where we do want a new prediction: +# |-----------| +# | 3 pd | <----- PREDICTION (cannot use, it is not the most restrictive) +# |-----------| +# | 2 pdus | <----- PREDICTION (USE THIS -- it is the most restrictive prediction, and better than icus) +# |-----------| +# | 1 icus | <----- CURRENT RIGHTS +# |-----------| +# | 0 ic | +# |-----------| +# +# In a nutshell: choose minimum prediction and return it if it is greater than current rights +sub choose_rights_prediction { + my $self = shift; + my $attribute = shift; # current rights attr string + my $predictions = shift; + + # This map allows us to grade the current rights and the predictions into 0-3 as above. + my $attr_values = {'pd' => 3, 'pdus' => 2, 'icus' => 1, 'ic' => 0}; + + # Get the value for current rights. + # It should not be terribly unusual to find current rights outside the pd/pdus/icus/ic contionuum + # although we will filter many of these out with `are_rights_in_scope` above. + # However, that does allow through rights like und/nfi (at least historically, we no longer export + # these to the rights DB by default). + # We can bail out if we get something outside the expected main four attributes. + my $current_value = $attr_values->{$attribute}; + return unless defined $current_value; + + # Expand predictions into array of { prediction => "attr/reason", value => value } + my @values = map { + my ($a, $r) = split('/', $_); + { prediction => $_, value => $attr_values->{$a} }; + } keys %$predictions; + + # Extract out the "minimum" prediction, conflating undefs (unknown prediction) with ic, + # neither of which we can return as a viable choice. + my $min = List::Util::reduce { + ($a->{value} || 0) < ($b->{value} || 0) ? $a : $b; + } @values; + + # Bail out if there were no predictions, or if the best we can do is undef/ic + if (!$min || !$min->{value}) { + return; + } + + # Compare the values. If the predicted is greater than current, return that. + # This will be the benefit of the new year rollover in terms of less restrictive rights. + if ($min->{value} > $current_value) { + return $min->{prediction}; + } + return; +} + 1; diff --git a/t/lib/CRMS/NewYear.t b/t/lib/CRMS/NewYear.t index 07b793fd..2877cdee 100644 --- a/t/lib/CRMS/NewYear.t +++ b/t/lib/CRMS/NewYear.t @@ -93,4 +93,49 @@ subtest 'are_rights_in_scope' => sub { }; }; +subtest 'choose_rights_prediction' => sub { + subtest 'with no predictions' => sub { + my $predictions = {}; + my $res = $new_year->choose_rights_prediction('ic', $predictions); + ok(!defined $res, 'no prediction'); + }; + + subtest 'with minimum prediction greater than current rights' => sub { + my $predictions = {'pd/add' => 1, 'pdus/exp' => 1, 'icus/gatt' => 1}; + my $res = $new_year->choose_rights_prediction('ic', $predictions); + is($res, 'icus/gatt', 'ic moves up to icus/gatt'); + }; + + subtest 'with minimum prediction same as current rights' => sub { + my $predictions = {'pd/add' => 1}; + my $res = $new_year->choose_rights_prediction('pd', $predictions); + ok(!defined $res, 'no prediction'); + }; + + subtest 'with minimum prediction less than current rights' => sub { + my $predictions = {'pdus/add' => 1, 'icus/gatt' => 1}; + my $res = $new_year->choose_rights_prediction('pd', $predictions); + ok(!defined $res, 'no prediction'); + }; + subtest 'edge cases' => sub { + subtest 'nonsense prediction' => sub { + my $predictions = {'xxx/yyy' => 1, 'ic/ren' => 1}; + my $res = $new_year->choose_rights_prediction('pdus', $predictions); + ok(!defined $res, 'no prediction'); + }; + + subtest 'nonsense prediction part deux' => sub { + my $predictions = {'xxx/yyy' => 1, 'ic/ren' => 1, 'pdus/ren' => 1}; + my $res = $new_year->choose_rights_prediction('pd', $predictions); + ok(!defined $res, 'no prediction'); + }; + + subtest 'out of scope current rights' => sub { + my $predictions = {'pdus/add' => 1}; + my $res = $new_year->choose_rights_prediction('und', $predictions); + ok(!defined $res, 'no prediction'); + }; + }; +}; + done_testing(); From aba30cfcddb3c27f4525d19687ffca1c3c98e376 Mon Sep 17 00:00:00 2001 From: Brian Moses Hall Date: Wed, 5 Nov 2025 11:46:34 -0500 Subject: [PATCH 3/7] Flag two unused variables --- bin/newyear.pl | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/bin/newyear.pl b/bin/newyear.pl index 9ca7b1f1..37ce974f 100755 --- a/bin/newyear.pl +++ b/bin/newyear.pl @@ -171,7 +171,7 @@ sub ProcessCommonwealthProject { my %predictions; foreach my $row2 (@{$ref2}) { my $note = $row2->[0] || ''; - my $user = $row2->[1]; + my $user = $row2->[1]; # FIXME: not used my $data = $row2->[2]; $data = $jsonxs->decode($data); my $date = $data->{'date'}; @@ -337,7 +337,7 @@ sub ProcessCrownCopyrightProject { my %dates = (); foreach my $row2 (@{$ref2}) { my $note = $row2->[0] || ''; - my $user = $row2->[1]; + my $user = $row2->[1]; # FIXME: not used my $data = $row2->[2]; $data = $jsonxs->decode($data); my $date = $data->{'date'}; From 07d09afd4293d44fcb1e07dfc286abd105973206 Mon Sep 17 00:00:00 2001 From: Brian Moses Hall Date: Wed, 5 Nov 2025 11:49:44 -0500 Subject: [PATCH 4/7] Clarify comment --- lib/CRMS/NewYear.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/CRMS/NewYear.pm b/lib/CRMS/NewYear.pm index 7b4257bb..fc810edc 100644 --- a/lib/CRMS/NewYear.pm +++ b/lib/CRMS/NewYear.pm @@ -100,7 +100,7 @@ sub choose_rights_prediction { ($a->{value} || 0) < ($b->{value} || 0) ? $a : $b; } @values; - # Bail out if there were no predictions, or if the best we can do is undef/ic + # Bail out if there were no predictions, or if the best we can do is ic or "anything else" if (!$min || !$min->{value}) { return; } From eb42f69b3028e89fae99891fcb53b6f81a2cd9cd Mon Sep 17 00:00:00 2001 From: Brian Moses Hall Date: Thu, 6 Nov 2025 10:19:28 -0500 Subject: [PATCH 5/7] Use standard GetMetadata block for all projects - Make sure to call ClearErrors on the CRMS object, otherwise a catalog error can become sticky and pollute the output - Only log metadata failure if verbose --- bin/newyear.pl | 22 +++++++++++++++++----- 1 file changed, 17 insertions(+), 5 deletions(-) diff --git a/bin/newyear.pl b/bin/newyear.pl index 37ce974f..c7fde763 100755 --- a/bin/newyear.pl +++ b/bin/newyear.pl @@ -157,7 +157,11 @@ sub ProcessCommonwealthProject { my ($acurr, $rcurr, $src, $usr, $timecurr, $note) = @{$rq->[0]}; next if !$new_year->are_rights_in_scope($acurr, $rcurr); my $record = $crms->GetMetadata($id); - next unless defined $record; + if (!defined $record) { + $crms->ClearErrors; + print RED "Unable to get metadata for $id\n" if $verbose; + next; + } my $rp = CRMS::RightsPredictor->new(record => $record); my $gid = $row->[1]; my $time = $row->[2]; @@ -273,7 +277,8 @@ sub ProcessPubDateProject next if !$new_year->are_rights_in_scope($acurr, $rcurr); my $record = $crms->GetMetadata($id); if (!defined $record) { - #print RED "Unable to get metadata for $id\n"; + $crms->ClearErrors; + print RED "Unable to get metadata for $id\n" if $verbose; next; } my $date = (keys %dates)[0]; @@ -323,7 +328,11 @@ sub ProcessCrownCopyrightProject { my ($acurr, $rcurr, $src, $usr, $timecurr, $note) = @{$rq->[0]}; next if !$new_year->are_rights_in_scope($acurr, $rcurr); my $record = $crms->GetMetadata($id); - next unless defined $record; + if (!defined $record) { + $crms->ClearErrors; + print RED "Unable to get metadata for $id\n" if $verbose; + next; + } my $gid = $row->[1]; my $time = $row->[2]; $seen{$id} = 1; @@ -394,8 +403,11 @@ sub ProcessKeioICUS { my $current_rights = $crms->GetCurrentRights($id); next if $current_rights !~ m/^icus/; my $record = $crms->GetMetadata($id); - print BOLD RED "Can't get metadata for $id\n" unless defined $record; - next unless defined $record; + if (!defined $record) { + $crms->ClearErrors; + print RED "Unable to get metadata for $id\n" if $verbose; + next; + } SubmitNewYearReview($id, 'pd', 'add', 'Keio', $record, '', ''); } } From 9ebe441ecd11dc985461c312578d480bffb8edbd Mon Sep 17 00:00:00 2001 From: Moses Hall Date: Fri, 7 Nov 2025 10:20:27 -0500 Subject: [PATCH 6/7] - Swap in CRMS::NewYear::choose_rights_prediction for existing code after successful A/B test. - Pass current rights to `SubmitNewYearReview` to eliminate a redundant Rights DB hit. - Short circuit no-op attempt to add to queue when generating TSV report and remove "message" field from the TSV. --- bin/newyear.pl | 96 ++++++++++++++++---------------------------------- 1 file changed, 31 insertions(+), 65 deletions(-) diff --git a/bin/newyear.pl b/bin/newyear.pl index c7fde763..86712bc1 100755 --- a/bin/newyear.pl +++ b/bin/newyear.pl @@ -106,7 +106,7 @@ END if ($tsv) { open $tsv_fh, '>:encoding(UTF-8)', $tsv or die "failed to open TSV file $tsv: $!"; my @cols = ('ID', 'Project', 'Author', 'Title', 'Pub Date', 'Country', 'Current Rights', - 'Extracted Data', 'Predictions', 'New Rights', 'Message'); + 'Extracted Data', 'Predictions', 'New Rights'); printf $tsv_fh "%s\n", join("\t", @cols); } @@ -172,7 +172,7 @@ sub ProcessCommonwealthProject { my $ref2 = $crms->SelectAll($sql, $gid); next if scalar @$ref2 == 0; my %alldates; - my %predictions; + my $predictions = {}; foreach my $row2 (@{$ref2}) { my $note = $row2->[0] || ''; my $user = $row2->[1]; # FIXME: not used @@ -194,35 +194,18 @@ sub ProcessCommonwealthProject { reference_year => $year); my $prediction = $rp->rights; if (defined $prediction) { - $predictions{$prediction} = 1; + $predictions->{$prediction} = 1; } } $alldates{$_->[0]} = 1 for @$dates; } - my ($ic, $icus, $pd, $pdus); - foreach my $pred (keys %predictions) { - $ic = $pred if $pred =~ m/^ic\//; - $icus = $pred if $pred =~ m/^icus/; - $pd = $pred if $pred =~ m/^pd\//; - $pdus = $pred if $pred =~ m/^pdus/; - } - if (scalar keys %predictions && !defined $ic && ($icus || $pd || $pdus)) { - my $new_rights; - if (defined $pd) { - $new_rights = ($acurr eq 'pd')? undef:$pd; - } - if (defined $pdus) { - $new_rights = ($acurr =~ m/^pd/)? undef:$pdus; - } - if (defined $icus) { - $new_rights = ($acurr =~ m/^pd/ || $acurr =~ m/^icus/)? undef:$icus; - } - if (defined $new_rights) { - my ($a, $r) = split m/\//, $new_rights; - SubmitNewYearReview($id, $a, $r, 'Commonwealth', $record, - join(';', sort keys %alldates), - join(';', sort keys %predictions)); - } + my $new_rights = $new_year->choose_rights_prediction($acurr, $predictions); + if ($new_rights) { + my ($a, $r) = split m/\//, $new_rights; + SubmitNewYearReview($id, $a, $r, 'Commonwealth', $record, + join(';', sort keys %alldates), + join(';', sort keys %$predictions), + "$acurr/$rcurr"); } } } @@ -294,7 +277,7 @@ sub ProcessPubDateProject } if (defined $attr && $attr ne $acurr) { SubmitNewYearReview($id, $attr, 'cdpp', 'Publication Date', $record, - join(';', sort keys %extracted_data), ''); + join(';', sort keys %extracted_data), '', "$acurr/$rcurr"); } } } @@ -342,7 +325,7 @@ sub ProcessCrownCopyrightProject { my $ref2 = $crms->SelectAll($sql, $gid); next unless scalar @$ref2 > 0; my %alldates; - my %predictions = (); + my $predictions = {}; my %dates = (); foreach my $row2 (@{$ref2}) { my $note = $row2->[0] || ''; @@ -360,35 +343,18 @@ sub ProcessCrownCopyrightProject { is_corporate => 1, is_crown => 1, reference_year => $year); my $prediction = $rp->rights; if (defined $prediction) { - $predictions{$prediction} = 1; + $predictions->{$prediction} = 1; } } $alldates{$_} = 1 for keys %dates; } - my ($ic, $icus, $pd, $pdus); - foreach my $pred (keys %predictions) { - $ic = $pred if $pred =~ m/^ic\//; - $icus = $pred if $pred =~ m/^icus/; - $pd = $pred if $pred =~ m/^pd\//; - $pdus = $pred if $pred =~ m/^pdus/; - } - if (scalar keys %predictions && !defined $ic && ($icus || $pd || $pdus)) { - my $new_rights; - if (defined $pd) { - $new_rights = ($acurr eq 'pd')? undef:$pd; - } - if (defined $pdus) { - $new_rights = ($acurr =~ m/^pd/)? undef:$pdus; - } - if (defined $icus) { - $new_rights = ($acurr =~ m/^pd/ || $acurr =~ m/^icus/)? undef:$icus; - } - if (defined $new_rights) { - my ($a, $r) = split m/\//, $new_rights; - SubmitNewYearReview($id, $a, $r, 'Crown Copyright', $record, - join(';', sort keys %alldates), - join(';', sort keys %predictions)); - } + my $new_rights = $new_year->choose_rights_prediction($acurr, $predictions); + if ($new_rights) { + my ($a, $r) = split m/\//, $new_rights; + SubmitNewYearReview($id, $a, $r, 'Crown Copyright', $record, + join(';', sort keys %alldates), + join(';', sort keys %$predictions), + "$acurr/$rcurr"); } } } @@ -408,7 +374,7 @@ sub ProcessKeioICUS { print RED "Unable to get metadata for $id\n" if $verbose; next; } - SubmitNewYearReview($id, 'pd', 'add', 'Keio', $record, '', ''); + SubmitNewYearReview($id, 'pd', 'add', 'Keio', $record, '', '', $current_rights); } } @@ -421,7 +387,17 @@ sub SubmitNewYearReview my $record = shift; my $extracted_data = shift; my $predictions = shift; + my $current_rights = shift; + if ($tsv) { + my @values = ($id, $project_name, $record->author || '', + $record->title || '', $record->publication_date->text || '', + $record->country || '', $current_rights, $extracted_data, + $predictions, "$new_attr/$new_reason"); + @values = map { local $_ = $_; $_ =~ s/\s+/ /g; $_; } @values; + printf $tsv_fh "%s\n", join("\t", @values); + } + return if $noop; $crms->UpdateMetadata($id, 1, $record); my $res = $crms->AddItemToQueueOrSetItemActive($id, 0, 1, 'newyear', undef, $record, $nyp); my $code = $res->{'status'}; @@ -446,16 +422,6 @@ sub SubmitNewYearReview if ($result) { print RED "SubmitReview() for $id: $result\n"; } - if ($tsv) { - my $rq = $crms->RightsQuery($id, 1); - my ($acurr, $rcurr, $src, $usr, $timecurr, $note) = @{$rq->[0]}; - my @values = ($id, $project_name, $record->author || '', - $record->title || '', $record->publication_date->text || '', - $record->country || '', "$acurr/$rcurr", $extracted_data, - $predictions, "$new_attr/$new_reason", $msg); - @values = map { local $_ = $_; $_ =~ s/\s+/ /g; $_; } @values; - printf $tsv_fh "%s\n", join("\t", @values); - } } close($tsv_fh) if $tsv; From e613e1c8d61da05310918f7a719a05638e6a9f99 Mon Sep 17 00:00:00 2001 From: Brian Moses Hall Date: Fri, 7 Nov 2025 10:30:04 -0500 Subject: [PATCH 7/7] Add note about random choice between competing pd/add and pd/exp predictions --- lib/CRMS/NewYear.pm | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/lib/CRMS/NewYear.pm b/lib/CRMS/NewYear.pm index fc810edc..411f2edd 100644 --- a/lib/CRMS/NewYear.pm +++ b/lib/CRMS/NewYear.pm @@ -71,6 +71,10 @@ sub are_rights_in_scope { # |-----------| # # In a nutshell: choose minimum prediction and return it if it is greater than current rights +# +# Note: there are rare but attested cases where we have legit pd/add and pd/exp predictions +# and the unordered hash implementation will, if pd is chosen, choose one at random. +# The old implementation did the same thing. KH has signed off on this as "don't care." sub choose_rights_prediction { my $self = shift; my $attribute = shift; # current rights attr string