From 658afd468836601f695a615a8a6d5a7a69e23d44 Mon Sep 17 00:00:00 2001 From: Brian Moses Hall Date: Fri, 24 Oct 2025 13:07:01 -0400 Subject: [PATCH 01/25] ETT-752 CRMS project interface - subject based copyright review (SBCR) - Add `Project` subclass and views for UI testing on dev-2 - Still TODO: - Unit tests - Input validation --- cgi/Project/SBCR.pm | 44 ++++ cgi/partial/bibdata_sbcr.tt | 21 ++ cgi/partial/sbcr_form.tt | 392 ++++++++++++++++++++++++++++++++++++ 3 files changed, 457 insertions(+) create mode 100644 cgi/Project/SBCR.pm create mode 100644 cgi/partial/bibdata_sbcr.tt create mode 100644 cgi/partial/sbcr_form.tt diff --git a/cgi/Project/SBCR.pm b/cgi/Project/SBCR.pm new file mode 100644 index 00000000..354f64bb --- /dev/null +++ b/cgi/Project/SBCR.pm @@ -0,0 +1,44 @@ +package SBCR; +use parent 'Project'; + +use strict; +use warnings; + +sub new { + my $class = shift; + return $class->SUPER::new(@_); +} + +# ========== REVIEW ========== # +# TODO +sub ValidateSubmission { + my $self = shift; + my $cgi = shift; + + my $rights = $cgi->param('rights'); + return if $rights; + return 'You must select a rights/reason combination'; +} + +# Extract Project-specific data from the CGI into a struct +# that will be encoded as JSON string in the reviewdata table. +sub ExtractReviewData { + my $self = shift; + my $cgi = shift; + + my $renNum = $cgi->param('renNum') || ''; + my $renDate = $cgi->param('renDate') || ''; + my $actualPubDate = $cgi->param('actualPubDate') || ''; + my $data = {}; + $data->{'renNum'} = $renNum if $renNum; + $data->{'renDate'} = $renDate if $renDate; + $data->{'actualPubDate'} = $actualPubDate if $actualPubDate; + return $data; +} + +sub ReviewPartials { + return ['top', 'bibdata_sbcr', 'authorities', + 'sbcr_form', 'expertDetails']; +} + +1; diff --git a/cgi/partial/bibdata_sbcr.tt b/cgi/partial/bibdata_sbcr.tt new file mode 100644 index 00000000..78f643d9 --- /dev/null +++ b/cgi/partial/bibdata_sbcr.tt @@ -0,0 +1,21 @@ +
+ + + + + + + + [% projs = crms.GetUserProjects() %] + [% IF projs.size > 1 %] + + [% END %] +
ID: [% htid %]
Pub Date: + + [% data.bibdata.display_date || '(unknown)' %] + +
Country: [% data.bibdata.country %]
Current Rights: [% crms.CurrentRightsString(htid) || 'unknown' %]
+ Project: [% data.project.name %] +
+
diff --git a/cgi/partial/sbcr_form.tt b/cgi/partial/sbcr_form.tt new file mode 100644 index 00000000..ce944aa1 --- /dev/null +++ b/cgi/partial/sbcr_form.tt @@ -0,0 +1,392 @@ +[% cgi = crms.get('cgi') %] +[% importUser = cgi.param('importUser') %] + +[% # Set up values from CGI (in case of error) or existing review (editing). %] +[% u_renNum = (error)? cgi.param('renNum') : data.reviews.$user.data.renNum %] +[% u_renDate = (error)? cgi.param('renDate') : data.reviews.$user.data.renDate %] +[% u_date = (error)? cgi.param('date') : data.reviews.$user.data.date %] +[% u_pub = (error)? cgi.param('pub') : data.reviews.$user.data.pub %] +[% u_crown = (error)? cgi.param('crown') : data.reviews.$user.data.crown %] +[% u_actual = (error)? cgi.param('actual') : data.reviews.$user.data.actual %] +[% u_rights = (error)? cgi.param('rights') : data.reviews.$user.rights %] +[% u_category = (error)? cgi.param('category') : data.reviews.$user.category %] +[% u_note = (error)? cgi.param('note') : data.reviews.$user.note %] +[% u_swiss = (error)? cgi.param('swiss') : data.reviews.$user.swiss %] +[% u_hold = (error)? cgi.param('hold') : data.reviews.$user.hold %] + +[% writing_hand_tag = "writing hand" %] +[% author_death_date_text = "Author Death Date: " _ writing_hand_tag %] +[% publication_date_text = "Publication Date:" %] + +
+
+ + + + + + + [% viafwarn = crms.VIAFWarning(htid, data.record) %] + [% IF viafwarn %] + [% viafwarn = "Warning: possible foreign author: " _ viafwarn %] + + [% END %] + + + + + + + + + + + + + + + + [% label = (u_pub)? publication_date_text : author_death_date_text %] + + + + + + [% display = "table-row" %] + [% IF u_pub %] + [% display = "none" %] + [% END %] + + + + + + + + + + + + + + + + +
$viafwarn
+ + + +
+ + + +
+ + + + + +
+ + + + + +
+ + + +
+ + +
+ +
+[% rights = crms.Rights(htid, 1) %] +
+
+ + [% rights = crms.Rights(htid) %] + [% of = rights.size() %] + [% n = 0 %] + + [% WHILE n < of %] + + [% right = rights.$n %] + + [% n = n + 1 %] + + + [% n = n + 1 %] + [% END %] +
+ + + + [% IF n < of %] + [% right = rights.$n %] + + + [% END %] +
+
+
+ + + + . +
+
+ + + + + +
+
+ + [% IF expert %] + + [% checked = (u_swiss || ((status == 2 || status == 3) && data.project.SwissByDefault())) %] + + + + [% END %] + [% holds = crms.CountHolds() %] + [% IF !hold %] + [% hold = crms.HoldForItem(htid, user) %] + [% END %] + + + + + + + +
+ +
+ =5 && !hold)? 'disabled="disabled"':'' %] + [% (hold)? 'checked="checked"':'' %] + onclick="toggleVisibility('expiry');"/> +
+ =5)? 'style="color:red;"':'' %]> + + You currently have [% holds %] out of the maximum 5 volumes on hold. + + +
+ [% IF expert && importUser %] + [% reviews = data.reviews %] + [% IF reviews.keys.size %] + + + + + [% FOREACH user IN reviews.keys.sort %] + + + + + [% END %] +
+
+ Import user review: +
+ 		+ +
+
+ [% END %] + [% END %] +
+
+ + + +
From e79ed8acac4ffe1e553f731ece346f812eaee0d7 Mon Sep 17 00:00:00 2001 From: Brian Moses Hall Date: Fri, 24 Oct 2025 13:09:48 -0400 Subject: [PATCH 02/25] prediction loader (busy animation) should be inline-block and not just block when displayed --- web/js/review.js | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/web/js/review.js b/web/js/review.js index 8bf76cd6..6d9c286b 100644 --- a/web/js/review.js +++ b/web/js/review.js @@ -135,7 +135,7 @@ function ajaxURL(target) { function togglePredictionLoader(display) { var img = document.getElementById("predictionLoader"); if (img) { - img.style.display = display ? "block" : "none"; + img.style.display = display ? "inline-block" : "none"; } } From 7ac6c2ac5b3c7746b64f449de8a5206ceb3eab09 Mon Sep 17 00:00:00 2001 From: Moses Hall Date: Fri, 24 Oct 2025 16:56:32 -0400 Subject: [PATCH 03/25] - Add a number of data validations to SBCR project - Add parameter extraction of all fields in SBCR UI - Review data format - Extract out `partial/rights.tt` which should be reusable across all projects --- cgi/Project/SBCR.pm | 141 +++++++++++++++++++++++++++++++++++++-- cgi/partial/rights.tt | 51 ++++++++++++++ cgi/partial/sbcr_form.tt | 74 +++++++------------- 3 files changed, 208 insertions(+), 58 deletions(-) create mode 100644 cgi/partial/rights.tt diff --git a/cgi/Project/SBCR.pm b/cgi/Project/SBCR.pm index 354f64bb..1a2b5cda 100644 --- a/cgi/Project/SBCR.pm +++ b/cgi/Project/SBCR.pm @@ -10,16 +10,97 @@ sub new { } # ========== REVIEW ========== # -# TODO +# There must be a rights selection +# sub ValidateSubmission { my $self = shift; my $cgi = shift; + my @errs; my $rights = $cgi->param('rights'); - return if $rights; - return 'You must select a rights/reason combination'; + return 'You must select a rights/reason combination' unless $rights; + my ($attr, $reason) = $self->{'crms'}->TranslateAttrReasonFromCode($rights); + # Renewal information + my $renNum = $cgi->param('renNum'); + my $renDate = $cgi->param('renDate'); + # ADD and pub date + my $date = $cgi->param('date'); + my $pub = $cgi->param('pub'); + my $crown = $cgi->param('crown'); + my $actual = $cgi->param('actual'); + #my $approximate = $cgi->param('approximate'); + my $note = $cgi->param('note'); + my $category = $cgi->param('category'); + $date =~ s/\s+//g if $date; + $actual =~ s/\s+//g if $actual; + if ($date && $date !~ m/^-?\d{1,4}$/) { + push @errs, 'year must be only decimal digits'; + } + elsif (($reason eq 'add' || $reason eq 'exp') && !$date) { + push @errs, "*/$reason must include a numeric year"; + } + ## ic/ren requires a nonexpired renewal if 1963 or earlier + if ($attr eq 'ic' && $reason eq 'ren') { + if ($renNum && $renDate) { + # Blow away everything but the trailing 2 year digits. + $renDate =~ s,.*[A-Za-z](.*),$1,; + $renDate = '19'. $renDate; + if ($renDate < 1950 && $renDate != 19) { + push @errs, "renewal ($renDate) has expired: volume is pd"; + } + } + else { + push @errs, 'ic/ren must include renewal id and renewal date'; + } + } + ## pd/ren should not have a ren number or date, and is not allowed for post-1963 works. + if ($attr eq 'pd' && $reason eq 'ren') { + if ($renNum && $renDate) { + push @errs, 'pd/ren should not include renewal info'; + } + } + ## pd*/cdpp must not have a ren number + if (($attr eq 'pd' || $attr eq 'pdus') && $reason eq 'cdpp' && ($renNum || $renDate)) { + push @errs, "$attr/$reason must not include renewal info"; + } + if ($attr eq 'pd' && $reason eq 'cdpp' && (!$note || !$category)) { + push @errs, 'pd/cdpp must include note category and note text'; + } + ## ic/cdpp requires a ren number + if ($attr eq 'ic' && $reason eq 'cdpp' && ($renNum || $renDate)) { + push @errs, 'ic/cdpp should not include renewal info'; + } + if ($attr eq 'ic' && $reason eq 'cdpp' && (!$note || !$category)) { + push @errs, 'ic/cdpp must include note category and note text'; + } + if ($attr eq 'und' && $reason eq 'nfi' && !$category) { + push @errs, 'und/nfi must include note category'; + } + ## und/ren must have Note Category Inserts/No Renewal + if ($attr eq 'und' && $reason eq 'ren') { + if ($category ne 'Inserts/No Renewal') { + push @errs, 'und/ren must have note category Inserts/No Renewal'; + } + } + ## and vice versa + if ($category eq 'Inserts/No Renewal') { + if ($attr ne 'und' || $reason ne 'ren') { + push @errs, 'Inserts/No Renewal must have rights code und/ren. '; + } + } + # Category/Note + if ($category && !$note) { + if ($self->{'crms'}->SimpleSqlGet('SELECT need_note FROM categories WHERE name=?', $category)) { + push @errs, qq{category "$category" requires a note}; + } + } + elsif ($note && !$category) { + push @errs, 'must include a category if there is a note'; + } + return join ', ', @errs; } + # Extract Project-specific data from the CGI into a struct # that will be encoded as JSON string in the reviewdata table. sub ExtractReviewData { @@ -28,17 +109,63 @@ sub ExtractReviewData { my $renNum = $cgi->param('renNum') || ''; my $renDate = $cgi->param('renDate') || ''; - my $actualPubDate = $cgi->param('actualPubDate') || ''; + my $date = $cgi->param('date') || ''; + my $pub = $cgi->param('pub') || ''; + my $crown = $cgi->param('crown') || ''; + my $actual = $cgi->param('actual') || ''; + my $approximate = $cgi->param('approximate') || ''; my $data = {}; $data->{'renNum'} = $renNum if $renNum; $data->{'renDate'} = $renDate if $renDate; - $data->{'actualPubDate'} = $actualPubDate if $actualPubDate; + $data->{'date'} = $date if $cgi->param('date'); + $data->{'pub'} = 1 if $cgi->param('pub'); + $data->{'crown'} = 1 if $cgi->param('crown'); + $data->{'actual'} = $actual if $actual; + $data->{'approximate'} = 1 if $approximate; return $data; } +sub FormatReviewData { + my $self = shift; + my $id = shift; + my $json = shift; + + my $jsonxs = JSON::XS->new->utf8->canonical(1)->pretty(0); + my $data = $jsonxs->decode($json); + my @lines; + if (scalar keys %$data) { + if ($data->{renNum} || $data->{renDate}) { + push @lines, sprintf 'Renewal %s / %s', $data->{'renNum'}, $data->{'renDate'}; + } + if ($data->{date}) { + my $date_type = ($data->{pub})? 'Pub' : 'ADD'; + push @lines, "$date_type $data->{date}"; + } + if ($data->{crown}) { + push @lines, "Crown \x{1F451}"; + } + if ($data->{actual}) { + push @lines, "Actual Pub Date $data->{actual}"; + } + if ($data->{approximate}) { + push @lines, "Approximate Pub Date"; + } + } + return { + 'id' => $id, + 'format' => join('
', @lines), + 'format_long' => '' + }; +} + sub ReviewPartials { - return ['top', 'bibdata_sbcr', 'authorities', - 'sbcr_form', 'expertDetails']; + return [ + 'top', + 'bibdata_sbcr', + 'expertDetails', + 'authorities', + 'sbcr_form' + ]; } 1; diff --git a/cgi/partial/rights.tt b/cgi/partial/rights.tt new file mode 100644 index 00000000..69bf4865 --- /dev/null +++ b/cgi/partial/rights.tt @@ -0,0 +1,51 @@ + +[% rights = crms.Rights(htid, 1) %] +
+ + [% rights = crms.Rights(htid) %] + [% of = rights.size() %] + [% n = 0 %] + + + + + + [% WHILE n < of %] + + [% right = rights.$n %] + + [% n = n + 1 %] + + + [% n = n + 1 %] + [% END %] +
Rights/Reason:
+ + + + [% IF n < of %] + [% right = rights.$n %] + + + [% END %] +
+
+ diff --git a/cgi/partial/sbcr_form.tt b/cgi/partial/sbcr_form.tt index ce944aa1..e9c84c7b 100644 --- a/cgi/partial/sbcr_form.tt +++ b/cgi/partial/sbcr_form.tt @@ -8,6 +8,7 @@ [% u_pub = (error)? cgi.param('pub') : data.reviews.$user.data.pub %] [% u_crown = (error)? cgi.param('crown') : data.reviews.$user.data.crown %] [% u_actual = (error)? cgi.param('actual') : data.reviews.$user.data.actual %] +[% u_approximate = (error)? cgi.param('approximate') : data.reviews.$user.data.approximate %] [% u_rights = (error)? cgi.param('rights') : data.reviews.$user.rights %] [% u_category = (error)? cgi.param('category') : data.reviews.$user.category %] [% u_note = (error)? cgi.param('note') : data.reviews.$user.note %] @@ -112,57 +113,18 @@ - + + + [% rights = crms.Rights(htid, 1) %]
-
- - [% rights = crms.Rights(htid) %] - [% of = rights.size() %] - [% n = 0 %] - - [% WHILE n < of %] - - [% right = rights.$n %] - - [% n = n + 1 %] - - - [% n = n + 1 %] - [% END %] -
- - - - [% IF n < of %] - [% right = rights.$n %] - - - [% END %] -
-
+ [% INCLUDE partial/rights.tt %] +
@@ -113,8 +113,7 @@ - + @@ -198,7 +197,7 @@ + onclick="insertUserReviewData('[% user %]');"/> [% END %] @@ -212,28 +211,6 @@ var gReviewData = [% data.json %]; addEvent(window, 'load', partial_sbcr_form_mainWindowLoad); -function popReviewInfo(user) -{ - var review = gReviewData.reviews[user]; - var button = document.getElementById("r" + review.rights); - if (button) { button.checked = "checked"; } - var renNum = null; - var renDate = null; - if (review.data) - { - renNum = review.data.renNum; - renDate = review.data.renDate; - } - var field = document.getElementById("renewalField"); - if (field) { field.value = renNum; } - // FIXME: renewalFieldCheckbox should only appear in the Commonwealth UI, not here. - button = document.getElementById("renewalFieldCheckbox"); - if (button) { button.checked = (renNum != null); } - document.submitReview.renDate.value = renDate; - document.submitReview.note.value = review.note; - selMenuItem('catMenu', (review.category)? review.category:''); -} - function partial_sbcr_form_mainWindowLoad(e) { [% IF importUser %] insertUserReviewData('[% importUser %]'); @@ -254,14 +231,14 @@ function partial_sbcr_form_mainWindowLoad(e) { function insertUserReviewData(user) { var review = gReviewData.reviews[user]; // Renewal - var field = document.getElementById("renNum"); + var field = document.getElementById("renewal-number-field"); if (field) { field.value = review.data?.renNum || ''; } - field = document.getElementById("renDate"); + field = document.getElementById("renewal-date-field"); if (field) { field.value = review.data?.renDate || ''; } // ADD/Pub field = document.getElementById("add-field"); if (field) { field.value = review.data?.date || ''; } - var field = document.getElementById("actual-pub-date-field"); + field = document.getElementById("actual-pub-date-field"); if (field) { field.value = review.data?.actual || ""; } button = document.getElementById("pub-checkbox"); if (button) { button.checked = Boolean(review.data?.pub); } @@ -331,7 +308,7 @@ function syncCheckboxes(checked, fromId, toId) { // but when tabbing out of the field force=0 so we don't clobber user-entered // values. async function getRenewalDate(force) { - var renNum = document.getElementById('renewalField'); + var renNum = document.getElementById('renewal-number-field'); var renDate = document.getElementById('renewal-date-field'); if (renDate.value.length > 0 && !force) { return; From 02b3d51830a729e37ff63ccdc8c265a15525d926 Mon Sep 17 00:00:00 2001 From: Brian Moses Hall Date: Tue, 28 Oct 2025 12:52:03 -0400 Subject: [PATCH 06/25] Add `CRMS::Entitlements` intended to eventually replace the attributes/reasons/rights routines in CRMS.pm with a more structured class that is not just a wrapper around SQL queries: - `TranslateAttr` - `TranslateReason` - `TranslateRights` - `AllCRMSRights` - `Rights` - `AllAssignableRights` - `GetAttrReasonFromCode` - `TranslateAttrReasonFromCode` - `GetCodeFromAttrReason` - `GetAttrReasonCode` This class is fully tested. For now it will only be used in the SBCR module and its tests. --- lib/CRMS/Entitlements.pm | 126 ++++++++++++++++++++++++++++++++++++++ t/lib/CRMS/Entitlements.t | 66 ++++++++++++++++++++ 2 files changed, 192 insertions(+) create mode 100644 lib/CRMS/Entitlements.pm create mode 100644 t/lib/CRMS/Entitlements.t diff --git a/lib/CRMS/Entitlements.pm b/lib/CRMS/Entitlements.pm new file mode 100644 index 00000000..2caccf30 --- /dev/null +++ b/lib/CRMS/Entitlements.pm @@ -0,0 +1,126 @@ +package CRMS::Entitlements; + +# NOTE THIS IS A TEMPORARY NAME +# CRMS::Rights conflicts with a method defined in the CRMS module +# Once this module is proven, it can replace some/all of the rights/attributes/reasons +# methods in CRMS.pm + +# Manages an in-memory copy of the crms.rights table +# and through it the attributes and reasons it ties together. + +use strict; +use warnings; + +use Data::Dumper; + +# This is a singleton. Rights, attributes, and reasons are static and can be cached. +# Derivatives based on project_rights, if any, should not be cached because they can change. +my $ONE_TRUE_ENTITLEMENTS; + +sub new { + my ($class, %args) = @_; + my $self = bless {}, $class; + # TODO: once we have a standalone DB module this can go away. + my $crms = $args{crms}; + die "CRMS::Entitlements module needs CRMS instance." unless defined $crms; + $self->{crms} = $crms; + # Eager load lookup tables + $self->_load_tables; + if (!defined $ONE_TRUE_ENTITLEMENTS) { + $ONE_TRUE_ENTITLEMENTS = $self; + } + return $ONE_TRUE_ENTITLEMENTS; +} + +sub rights_by_id { + my $self = shift; + my $id = shift; + + return $self->{rights}->{$id}; +} + +sub rights_by_attribute_reason { + my $self = shift; + my $attribute = shift; + my $reason = shift; + + # Translate attribute and reason into ids if not numeric + if ($attribute !~ m/^\d+$/) { + $attribute = $self->attribute_by_name($attribute)->{id}; + } + if ($reason !~ m/^\d+$/) { + $reason = $self->reason_by_name($reason)->{id}; + } + foreach my $id (keys %{$self->{rights}}) { + my $rights = $self->{rights}->{$id}; + if ($rights->{attr} == $attribute && $rights->{reason} == $reason) { + return $rights; + } + } +} + +# Returns a hashref with the fields id, type, dscr, name just as they appear in the +# `attributes` table +sub attribute_by_id { + my $self = shift; + my $id = shift; + + return $self->{attributes_by_id}->{$id}; +} + +# Returns a hashref with the fields id, type, dscr, name just as they appear in the +# `attributes` table +sub attribute_by_name { + my $self = shift; + my $name = shift; + + return $self->{attributes_by_name}->{$name}; +} + +# Returns a hashref with the fields id, dscr, name just as they appear in the +# `reasons` table +sub reason_by_id { + my $self = shift; + my $id = shift; + + return $self->{reasons_by_id}->{$id}; +} + +# Returns a hashref with the fields id, dscr, name just as they appear in the +# `reasons` table +sub reason_by_name { + my $self = shift; + my $name = shift; + + return $self->{reasons_by_name}->{$name}; +} + +# Set up slightly duplicative lookup tables for fast attribute/reason access by id or by name. +# Also set up rights lookup by id. +sub _load_tables { + my $self = shift; + + # crms.attributes + my $sql = 'SELECT * FROM attributes ORDER BY id'; + $self->{attributes_by_id} = $self->{crms}->GetDb->selectall_hashref($sql, 'id'); + $self->{attributes_by_name} = $self->{crms}->GetDb->selectall_hashref($sql, 'name'); + # crms.reasons + $sql = 'SELECT * FROM reasons ORDER BY id'; + $self->{reasons_by_id} = $self->{crms}->GetDb->selectall_hashref($sql, 'id'); + $self->{reasons_by_name} = $self->{crms}->GetDb->selectall_hashref($sql, 'name'); + # crms.rights + $self->{rights} = {}; + $sql = 'SELECT * FROM rights ORDER BY id'; + $self->{rights} = $self->{crms}->GetDb->selectall_hashref($sql, 'id'); + # Decorare each entry with attribute and reason names + foreach my $id (keys %{$self->{rights}}) { + my $rights = $self->{rights}->{$id}; + my $attr_name = $self->attribute_by_id($rights->{attr})->{name}; + my $reason_name = $self->reason_by_id($rights->{reason})->{name}; + $rights->{attribute_name} = $attr_name; + $rights->{reason_name} = $reason_name; + $rights->{name} = "$attr_name/$reason_name"; + } +} + +1; diff --git a/t/lib/CRMS/Entitlements.t b/t/lib/CRMS/Entitlements.t new file mode 100644 index 00000000..fad55cad --- /dev/null +++ b/t/lib/CRMS/Entitlements.t @@ -0,0 +1,66 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::Exception; +use Test::More; + +use lib $ENV{'SDRROOT'} . '/crms/cgi'; +use lib $ENV{'SDRROOT'} . '/crms/lib'; +use CRMS; +use CRMS::Entitlements; + +my $crms = CRMS->new; + +subtest '::new' => sub { + my $rights = CRMS::Entitlements->new(crms => $crms); + isa_ok($rights, 'CRMS::Entitlements'); + + subtest 'Missing CRMS' => sub { + dies_ok { CRMS::Entitlements->new; }; + }; +}; + +subtest 'rights_by_id' => sub { + my $rights = CRMS::Entitlements->new(crms => $crms)->rights_by_id(5); + is($rights->{id}, 5); +}; + +subtest 'rights_by_attribute_reason' => sub { + subtest 'with ids' => sub { + my $rights = CRMS::Entitlements->new(crms => $crms)->rights_by_attribute_reason(2, 7); + is($rights->{attribute_name}, 'ic'); + is($rights->{reason_name}, 'ren'); + is($rights->{name}, 'ic/ren'); + }; + + subtest 'with names' => sub { + my $rights = CRMS::Entitlements->new(crms => $crms)->rights_by_attribute_reason('ic', 'ren'); + is($rights->{attribute_name}, 'ic'); + is($rights->{reason_name}, 'ren'); + is($rights->{name}, 'ic/ren'); + }; +}; + +subtest 'attribute_by_id' => sub { + my $attr = CRMS::Entitlements->new(crms => $crms)->attribute_by_id(1); + is($attr->{name}, 'pd', 'attribute 1 is named "pd"'); +}; + +subtest 'attribute_by_name' => sub { + my $attr = CRMS::Entitlements->new(crms => $crms)->attribute_by_name('pd'); + is($attr->{id}, 1, 'attribute "pd" is id=1'); +}; + +subtest 'reason_by_id' => sub { + my $reason = CRMS::Entitlements->new(crms => $crms)->reason_by_id(1); + is($reason->{name}, 'bib', 'reason 1 is named "bib"'); +}; + +subtest 'reason_by_name' => sub { + my $reason = CRMS::Entitlements->new(crms => $crms)->reason_by_name('bib'); + is($reason->{id}, 1, 'reason "bib" is id=1'); +}; + +done_testing(); From 5cdbbf445902b92a588505eccdc70c4875f53083 Mon Sep 17 00:00:00 2001 From: Brian Moses Hall Date: Tue, 28 Oct 2025 13:00:44 -0400 Subject: [PATCH 07/25] - SBCR module uses `CRMS::Entitlements` - SBCR module tests, first pass --- cgi/Project/SBCR.pm | 80 ++++++++---- t/Project/SBCR.t | 291 ++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 344 insertions(+), 27 deletions(-) create mode 100644 t/Project/SBCR.t diff --git a/cgi/Project/SBCR.pm b/cgi/Project/SBCR.pm index 4a9e0602..801df0fa 100644 --- a/cgi/Project/SBCR.pm +++ b/cgi/Project/SBCR.pm @@ -10,29 +10,25 @@ sub new { } # ========== REVIEW ========== # -# There must be a rights selection -# sub ValidateSubmission { my $self = shift; my $cgi = shift; my @errs; - my $rights = $cgi->param('rights'); - return 'You must select a rights/reason combination' unless $rights; - my ($attr, $reason) = $self->{'crms'}->TranslateAttrReasonFromCode($rights); + my $params = $self->extract_parameters($cgi); + return 'You must select a rights/reason combination' unless $params->{rights}; + my $rights_data = CRMS::Entitlements->new(crms => $self->{crms})->rights_by_id($params->{rights}); + my $attr = $rights_data->{attribute_name}; + my $reason = $rights_data->{reason_name}; # Renewal information - my $renNum = $cgi->param('renNum'); - my $renDate = $cgi->param('renDate'); + my $renNum = $params->{renNum}; + my $renDate = $params->{renDate}; # ADD and pub date - my $date = $cgi->param('date'); - my $pub = $cgi->param('pub'); - my $crown = $cgi->param('crown'); - my $actual = $cgi->param('actual'); - #my $approximate = $cgi->param('approximate'); - my $note = $cgi->param('note'); - my $category = $cgi->param('category'); - $date =~ s/\s+//g if $date; - $actual =~ s/\s+//g if $actual; + my $date = $params->{date}; + my $actual = $params->{actual}; + # Note and note category + my $note = $params->{note}; + my $category = $params->{category}; if ($date && $date !~ m/^-?\d{1,4}$/) { push @errs, 'year must be only decimal digits'; } @@ -42,10 +38,8 @@ sub ValidateSubmission { ## ic/ren requires a nonexpired renewal if 1963 or earlier if ($attr eq 'ic' && $reason eq 'ren') { if ($renNum && $renDate) { - # Blow away everything but the trailing 2 year digits. - $renDate =~ s,.*[A-Za-z](.*),$1,; - $renDate = '19'. $renDate; - if ($renDate < 1950 && $renDate != 19) { + my $year = $self->renewal_date_to_year($renDate); + if ($year && $year < 1950) { push @errs, "renewal ($renDate) has expired: volume is pd"; } } @@ -60,33 +54,38 @@ sub ValidateSubmission { } } if ($actual && $actual !~ m/^\d{4}(-\d{4})?$/) { - push @errs, 'Actual Publication Date must be a date or a date range (DDDD or DDDD-DDDD)'; + push @errs, 'Actual Publication Date must be a date or a date range (YYYY or YYYY-YYYY)'; } - ## pd*/cdpp must not have a ren number + ## pd*/cdpp must not have renewal data if (($attr eq 'pd' || $attr eq 'pdus') && $reason eq 'cdpp' && ($renNum || $renDate)) { push @errs, "$attr/$reason must not include renewal info"; } if ($attr eq 'pd' && $reason eq 'cdpp' && (!$note || !$category)) { push @errs, 'pd/cdpp must include note category and note text'; } - ## ic/cdpp requires a ren number + ## ic/cdpp must not have renewal data + # NOTE: this could be merged with the pd/cdpp and pdus/cdpp logic above if ($attr eq 'ic' && $reason eq 'cdpp' && ($renNum || $renDate)) { - push @errs, 'ic/cdpp should not include renewal info'; + push @errs, 'ic/cdpp must not include renewal info'; } + # NOTE: this could be merged with the pd/cdpp and pdus/cdpp logic above if ($attr eq 'ic' && $reason eq 'cdpp' && (!$note || !$category)) { push @errs, 'ic/cdpp must include note category and note text'; } if ($attr eq 'und' && $reason eq 'nfi' && !$category) { push @errs, 'und/nfi must include note category'; } + + ### FIXME: STILL NEED TESTS FOR MOST OF THESE + ## und/ren must have Note Category Inserts/No Renewal if ($attr eq 'und' && $reason eq 'ren') { - if ($category ne 'Inserts/No Renewal') { + if (!defined $category || $category ne 'Inserts/No Renewal') { push @errs, 'und/ren must have note category Inserts/No Renewal'; } } ## and vice versa - if ($category eq 'Inserts/No Renewal') { + if ($category && $category eq 'Inserts/No Renewal') { if ($attr ne 'und' || $reason ne 'ren') { push @errs, 'Inserts/No Renewal must have rights code und/ren. '; } @@ -106,7 +105,6 @@ sub ValidateSubmission { return join ', ', @errs; } - # Extract Project-specific data from the CGI into a struct # that will be encoded as JSON string in the reviewdata table. sub ExtractReviewData { @@ -136,6 +134,7 @@ sub FormatReviewData { my $id = shift; my $json = shift; + # FIXME pretty() isn't needed here? my $jsonxs = JSON::XS->new->utf8->canonical(1)->pretty(0); my $data = $jsonxs->decode($json); my @lines; @@ -174,4 +173,31 @@ sub ReviewPartials { ]; } +# extract CGI parameters into a hashref +# values are stripped +# Note: this might be useful to apply much earlier in the call chain, would +# decouple project modules from CGI +sub extract_parameters { + my $self = shift; + my $cgi = shift; + + my $params = {}; + foreach my $name ($cgi->param) { + my $value = $cgi->param($name); + $value =~ s/\A\s+|\s+\z//ug; + $params->{$name} = $value; + } + return $params; +} + +# Turn a Stanford renewal date, e.g., 21Oct52, into a year, e.g., 1952 +sub renewal_date_to_year { + my $self = shift; + my $renDate = shift; + + # If the last two digits are not numeric for some reason then there is no reasonable answer. + return '' unless $renDate =~ m/\d\d$/; + return '19' . substr($renDate, -2, 2); +} + 1; diff --git a/t/Project/SBCR.t b/t/Project/SBCR.t new file mode 100644 index 00000000..fa589503 --- /dev/null +++ b/t/Project/SBCR.t @@ -0,0 +1,291 @@ +#!/usr/bin/perl + +use strict; +use warnings; +use utf8; + +use CGI; +use Data::Dumper; +use Test::More; + +use lib $ENV{'SDRROOT'} . '/crms/cgi'; +use lib $ENV{'SDRROOT'} . '/crms/lib'; +use CRMS; +use CRMS::Entitlements; + + +require_ok($ENV{'SDRROOT'}. '/crms/cgi/Project/SBCR.pm'); + +my $crms = CRMS->new(); +# TODO: Project::for_name would be a much nicer way to do this. +my $sql = 'SELECT id FROM projects WHERE name="SBCR"'; +my $project_id = $crms->SimpleSqlGet($sql); +my $proj = SBCR->new(crms => $crms, id => $project_id); +ok(defined $proj); + +subtest 'SBCR::PresentationOrder' => sub { + my $order = $proj->PresentationOrder; + ok(!defined $order, 'does not define a presentation order'); +}; + +subtest 'SBCR::ReviewPartials' => sub { + ok(defined $proj->ReviewPartials, 'defines a UI ordering'); +}; + +subtest 'SBCR::ValidateSubmission' => sub { + subtest 'no rights selected' => sub { + my $cgi = CGI->new; + my $err = $proj->ValidateSubmission($cgi); + ok($err =~ m/rights\/reason combination/); + }; + + subtest 'ADD/pub date with too many digits' => sub { + my $cgi = CGI->new; + $cgi->param('rights', 1); + $cgi->param('date', '12345'); + my $err = $proj->ValidateSubmission($cgi); + ok($err =~ m/decimal digits/); + }; + + subtest 'pd/add with no date' => sub { + my $cgi = CGI->new; + my $rights = CRMS::Entitlements->new(crms => $crms)->rights_by_attribute_reason('pd', 'add')->{id}; + $cgi->param('rights', $rights); + my $err = $proj->ValidateSubmission($cgi); + ok($err =~ m/numeric year/); + }; + + subtest 'pd/exp with no date' => sub { + my $cgi = CGI->new; + my $rights = CRMS::Entitlements->new(crms => $crms)->rights_by_attribute_reason('pd', 'exp')->{id}; + $cgi->param('rights', $rights); + my $err = $proj->ValidateSubmission($cgi); + ok($err =~ m/numeric year/); + }; + + subtest 'ic/ren with expired renewal' => sub { + my $cgi = CGI->new; + my $rights = CRMS::Entitlements->new(crms => $crms)->rights_by_attribute_reason('ic', 'ren')->{id}; + $cgi->param('rights', $rights); + $cgi->param('renNum', 'R123'); + $cgi->param('renDate', '4Jun23'); + my $err = $proj->ValidateSubmission($cgi); + ok($err =~ m/expired/); + }; + + subtest 'ic/ren with no renewal data' => sub { + my $cgi = CGI->new; + my $rights = CRMS::Entitlements->new(crms => $crms)->rights_by_attribute_reason('ic', 'ren')->{id}; + $cgi->param('rights', $rights); + my $err = $proj->ValidateSubmission($cgi); + ok($err =~ m/renewal id/); + }; + + subtest 'pd/ren with renewal data' => sub { + my $cgi = CGI->new; + my $rights = CRMS::Entitlements->new(crms => $crms)->rights_by_attribute_reason('pd', 'ren')->{id}; + $cgi->param('rights', $rights); + $cgi->param('renNum', 'R123'); + $cgi->param('renDate', '4Jun23'); + my $err = $proj->ValidateSubmission($cgi); + ok($err =~ m/should not include renewal info/); + }; + + subtest 'actual publication date' => sub { + subtest 'single date' => sub { + my $cgi = CGI->new; + $cgi->param('rights', 1); + $cgi->param('actual', '9999'); + my $err = $proj->ValidateSubmission($cgi); + ok($err !~ m/YYYY or YYYY-YYYY/); + }; + + subtest 'date range' => sub { + my $cgi = CGI->new; + $cgi->param('rights', 1); + $cgi->param('actual', '9990-9999'); + my $err = $proj->ValidateSubmission($cgi); + ok($err !~ m/YYYY or YYYY-YYYY/); + }; + + subtest 'nonsense' => sub { + my $cgi = CGI->new; + $cgi->param('rights', 1); + $cgi->param('actual', 'abcde'); + my $err = $proj->ValidateSubmission($cgi); + ok($err =~ m/YYYY or YYYY-YYYY/); + }; + }; + + subtest 'pd*/cdpp must not include renewal data' => sub { + foreach my $attr ('pd', 'pdus') { + subtest $attr => sub { + my $cgi = CGI->new; + my $rights = CRMS::Entitlements->new(crms => $crms)->rights_by_attribute_reason($attr, 'cdpp')->{id}; + $cgi->param('rights', $rights); + $cgi->param('renNum', 'R123'); + $cgi->param('renDate', '4Jun23'); + my $err = $proj->ValidateSubmission($cgi); + ok($err =~ m/must not include renewal info/); + }; + } + }; + + subtest 'pd/cdpp must include note category and note text' => sub { + my $rights = CRMS::Entitlements->new(crms => $crms)->rights_by_attribute_reason('pd', 'cdpp')->{id}; + subtest 'with both' => sub { + my $cgi = CGI->new; + $cgi->param('rights', $rights); + $cgi->param('category', 'Edition'); + $cgi->param('note', 'This is a note'); + my $err = $proj->ValidateSubmission($cgi); + ok($err !~ m/must include note category and note text/); + }; + + subtest 'with neither' => sub { + my $cgi = CGI->new; + $cgi->param('rights', $rights); + my $err = $proj->ValidateSubmission($cgi); + ok($err =~ m/must include note category and note text/); + }; + }; + + # NOTE: this could be merged with the pd/cdpp and pdus/cdpp logic above + subtest 'ic/cdpp must not include renewal data' => sub { + my $cgi = CGI->new; + my $rights = CRMS::Entitlements->new(crms => $crms)->rights_by_attribute_reason('ic', 'cdpp')->{id}; + $cgi->param('rights', $rights); + $cgi->param('renNum', 'R123'); + $cgi->param('renDate', '4Jun23'); + my $err = $proj->ValidateSubmission($cgi); + ok($err =~ m/must not include renewal info/); + }; + + # NOTE: this could be merged with the pd/cdpp and pdus/cdpp logic above + subtest 'ic/cdpp must include note category and note text' => sub { + my $rights = CRMS::Entitlements->new(crms => $crms)->rights_by_attribute_reason('ic', 'cdpp')->{id}; + subtest 'with both' => sub { + my $cgi = CGI->new; + $cgi->param('rights', $rights); + $cgi->param('category', 'Edition'); + $cgi->param('note', 'This is a note'); + my $err = $proj->ValidateSubmission($cgi); + ok($err !~ m/must include note category and note text/); + }; + + subtest 'with neither' => sub { + my $cgi = CGI->new; + $cgi->param('rights', $rights); + my $err = $proj->ValidateSubmission($cgi); + ok($err =~ m/must include note category and note text/); + }; + }; + + subtest 'und/nfi must include note category' => sub { + my $rights = CRMS::Entitlements->new(crms => $crms)->rights_by_attribute_reason('und', 'nfi')->{id}; + subtest 'with category' => sub { + my $cgi = CGI->new; + $cgi->param('rights', $rights); + $cgi->param('category', 'Edition'); + my $err = $proj->ValidateSubmission($cgi); + ok($err !~ m/must include note category/); + }; + + subtest 'without category' => sub { + my $cgi = CGI->new; + $cgi->param('rights', $rights); + my $err = $proj->ValidateSubmission($cgi); + ok($err =~ m/must include note category/); + }; + }; + + subtest 'und/ren must have note category Inserts/No Renewal' => sub { + my $rights = CRMS::Entitlements->new(crms => $crms)->rights_by_attribute_reason('und', 'ren')->{id}; + subtest 'with expected category' => sub { + my $cgi = CGI->new; + $cgi->param('rights', $rights); + $cgi->param('category', 'Inserts/No Renewal'); + my $err = $proj->ValidateSubmission($cgi); + ok($err !~ m/must have note category/); + }; + + subtest 'without expected category' => sub { + my $cgi = CGI->new; + $cgi->param('rights', $rights); + $cgi->param('category', 'Edition'); + my $err = $proj->ValidateSubmission($cgi); + ok($err =~ m/must have note category /); + }; + + subtest 'with no category' => sub { + my $cgi = CGI->new; + $cgi->param('rights', $rights); + my $err = $proj->ValidateSubmission($cgi); + ok($err =~ m/must have note category /); + }; + }; + + # FIXME: MORE TESTS NEEDED HERE + + + + subtest 'category without required note' => sub { + my $cgi = CGI->new; + $cgi->param('rights', 1); + $cgi->param('category', 'Misc'); + my $err = $proj->ValidateSubmission($cgi); + ok($err =~ m/requires a note/); + }; +}; + +subtest 'ExtractReviewData' => sub { + subtest 'with lots of data' => sub { + my $cgi = CGI->new; + $cgi->param('renNum', 'R123'); + $cgi->param('renDate', '26Sep39'); + $cgi->param('date', '1950'); + $cgi->param('pub', 'on'); + $cgi->param('crown', 'on'); + $cgi->param('actual', '1960'); + $cgi->param('approximate', 'on'); + my $extracted = $proj->ExtractReviewData($cgi); + is($extracted->{renNum}, 'R123'); + is($extracted->{renDate}, '26Sep39'); + is($extracted->{date}, '1950'); + is($extracted->{pub}, 1); + is($extracted->{crown}, 1); + is($extracted->{actual}, '1960'); + is($extracted->{approximate}, 1); + }; + + subtest 'with very little data' => sub { + my $cgi = CGI->new; + my $extracted = $proj->ExtractReviewData($cgi); + is_deeply($extracted, {}); + }; +}; + +subtest 'extract_parameters' => sub { + my $cgi = CGI->new; + $cgi->param('rights', 1); + $cgi->param('renNum', " R12345\n"); + my $params = $proj->extract_parameters($cgi); + is($params->{rights}, 1, 'leaves rights unchanged'); + is($params->{renNum}, 'R12345', 'strips whitespace'); +}; + +subtest 'renewal_date_to_year' => sub { + subtest 'with a well-formed renewal date' => sub { + my $year = $proj->renewal_date_to_year('21Sep51'); + is($year, '1951', 'extracts year'); + }; + + subtest 'with a nonsense renewal date' => sub { + my $year = $proj->renewal_date_to_year('abcde'); + is($year, '', 'returns empty string'); + }; +}; + +done_testing(); + + From afaf07a4c638f5d1e9739566c2358b38e69b4909 Mon Sep 17 00:00:00 2001 From: Brian Moses Hall Date: Tue, 28 Oct 2025 13:57:29 -0400 Subject: [PATCH 08/25] - Add `UNIQUE` index to rights table and note about it in `Entitlements.pm` - Eager load only when populating the singleton --- docker/db/sql/001_crms_schema.sql | 3 ++- lib/CRMS/Entitlements.pm | 8 ++++++-- 2 files changed, 8 insertions(+), 3 deletions(-) diff --git a/docker/db/sql/001_crms_schema.sql b/docker/db/sql/001_crms_schema.sql index 7c6decad..5a4fdb9a 100644 --- a/docker/db/sql/001_crms_schema.sql +++ b/docker/db/sql/001_crms_schema.sql @@ -1037,7 +1037,8 @@ CREATE TABLE `rights` ( `attr` tinyint(4) NOT NULL, `reason` tinyint(4) NOT NULL, `description` text, - PRIMARY KEY (`id`) + PRIMARY KEY (`id`), + UNIQUE KEY `unique_attr_reason` (`attr`,`reason`) ) ENGINE=InnoDB AUTO_INCREMENT=26 DEFAULT CHARSET=utf8; /*!40101 SET character_set_client = @saved_cs_client */; diff --git a/lib/CRMS/Entitlements.pm b/lib/CRMS/Entitlements.pm index 2caccf30..5348e6c4 100644 --- a/lib/CRMS/Entitlements.pm +++ b/lib/CRMS/Entitlements.pm @@ -8,6 +8,10 @@ package CRMS::Entitlements; # Manages an in-memory copy of the crms.rights table # and through it the attributes and reasons it ties together. +# As of CRMS version 8.7.1 the crms.rights table has a UNIQUE constraint on the attr,reason +# combination. As a result, a method like `rights_by_attribute_reason` need never worry +# about handling more than one result. + use strict; use warnings; @@ -24,9 +28,9 @@ sub new { my $crms = $args{crms}; die "CRMS::Entitlements module needs CRMS instance." unless defined $crms; $self->{crms} = $crms; - # Eager load lookup tables - $self->_load_tables; if (!defined $ONE_TRUE_ENTITLEMENTS) { + # Eager load lookup tables + $self->_load_tables; $ONE_TRUE_ENTITLEMENTS = $self; } return $ONE_TRUE_ENTITLEMENTS; From 7c497d7761e761762a4aec832acab628a83e711f Mon Sep 17 00:00:00 2001 From: Brian Moses Hall Date: Tue, 28 Oct 2025 14:07:08 -0400 Subject: [PATCH 09/25] ExtractReviewData uses extract_parameters to take advantage of whitespace trimming --- cgi/Project/SBCR.pm | 22 ++++++++-------------- t/Project/SBCR.t | 6 +++--- 2 files changed, 11 insertions(+), 17 deletions(-) diff --git a/cgi/Project/SBCR.pm b/cgi/Project/SBCR.pm index 801df0fa..e19224dc 100644 --- a/cgi/Project/SBCR.pm +++ b/cgi/Project/SBCR.pm @@ -111,21 +111,15 @@ sub ExtractReviewData { my $self = shift; my $cgi = shift; - my $renNum = $cgi->param('renNum') || ''; - my $renDate = $cgi->param('renDate') || ''; - my $date = $cgi->param('date') || ''; - my $pub = $cgi->param('pub') || ''; - my $crown = $cgi->param('crown') || ''; - my $actual = $cgi->param('actual') || ''; - my $approximate = $cgi->param('approximate') || ''; + my $params = $self->extract_parameters($cgi); my $data = {}; - $data->{'renNum'} = $renNum if $renNum; - $data->{'renDate'} = $renDate if $renDate; - $data->{'date'} = $date if $cgi->param('date'); - $data->{'pub'} = 1 if $cgi->param('pub'); - $data->{'crown'} = 1 if $cgi->param('crown'); - $data->{'actual'} = $actual if $actual; - $data->{'approximate'} = 1 if $approximate; + $data->{'renNum'} = $params->{renNum} if $params->{renNum}; + $data->{'renDate'} = $params->{renDate} if $params->{renDate}; + $data->{'date'} = $params->{date} if $params->{date}; + $data->{'pub'} = 1 if $params->{pub}; + $data->{'crown'} = 1 if $params->{crown}; + $data->{'actual'} = $params->{actual} if $params->{actual}; + $data->{'approximate'} = 1 if $params->{approximate}; return $data; } diff --git a/t/Project/SBCR.t b/t/Project/SBCR.t index fa589503..956712c8 100644 --- a/t/Project/SBCR.t +++ b/t/Project/SBCR.t @@ -239,10 +239,10 @@ subtest 'SBCR::ValidateSubmission' => sub { }; subtest 'ExtractReviewData' => sub { - subtest 'with lots of data' => sub { + subtest 'with lots of data, some of it messy' => sub { my $cgi = CGI->new; - $cgi->param('renNum', 'R123'); - $cgi->param('renDate', '26Sep39'); + $cgi->param('renNum', ' R123'); + $cgi->param('renDate', ' 26Sep39'); $cgi->param('date', '1950'); $cgi->param('pub', 'on'); $cgi->param('crown', 'on'); From 889ae1a5792f76b3503ee0cbb26ebbee6f022b0f Mon Sep 17 00:00:00 2001 From: Brian Moses Hall Date: Tue, 28 Oct 2025 14:16:42 -0400 Subject: [PATCH 10/25] FormatReviewData test --- t/Project/SBCR.t | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) diff --git a/t/Project/SBCR.t b/t/Project/SBCR.t index 956712c8..3978c3f7 100644 --- a/t/Project/SBCR.t +++ b/t/Project/SBCR.t @@ -6,6 +6,7 @@ use utf8; use CGI; use Data::Dumper; +use JSON::XS; use Test::More; use lib $ENV{'SDRROOT'} . '/crms/cgi'; @@ -13,6 +14,7 @@ use lib $ENV{'SDRROOT'} . '/crms/lib'; use CRMS; use CRMS::Entitlements; +my $jsonxs = JSON::XS->new->utf8->canonical(1)->pretty(0); require_ok($ENV{'SDRROOT'}. '/crms/cgi/Project/SBCR.pm'); @@ -265,6 +267,25 @@ subtest 'ExtractReviewData' => sub { }; }; +subtest 'FormatReviewData' => sub { + my $data = { + renNum => 'R123', + renDate => '26Sep39', + date => '1950', + pub => 1, + crown => 1, + actual => '1960', + approximate => 1 + }; + my $json = $jsonxs->encode($data); + my $format = $proj->FormatReviewData(1, $json); + ok($format->{format} =~ /renewal/i); + ok($format->{format} =~ /pub/i); + ok($format->{format} =~ /crown/i); + ok($format->{format} =~ /actual/i); + is($format->{id}, 1); +}; + subtest 'extract_parameters' => sub { my $cgi = CGI->new; $cgi->param('rights', 1); From 62ea8ce1f50c485b88befb900c8bdbf7cafc437f Mon Sep 17 00:00:00 2001 From: Brian Moses Hall Date: Wed, 29 Oct 2025 10:42:13 -0400 Subject: [PATCH 11/25] 100% coverage on SBCR.pm and Entitlements.pm modules --- cgi/Project/SBCR.pm | 78 ++++--- lib/CRMS/Entitlements.pm | 33 ++- t/Project/SBCR.t | 434 ++++++++++++++++++++++++++++++-------- t/lib/CRMS/Entitlements.t | 13 +- 4 files changed, 415 insertions(+), 143 deletions(-) diff --git a/cgi/Project/SBCR.pm b/cgi/Project/SBCR.pm index e19224dc..b99aeb5c 100644 --- a/cgi/Project/SBCR.pm +++ b/cgi/Project/SBCR.pm @@ -20,6 +20,7 @@ sub ValidateSubmission { my $rights_data = CRMS::Entitlements->new(crms => $self->{crms})->rights_by_id($params->{rights}); my $attr = $rights_data->{attribute_name}; my $reason = $rights_data->{reason_name}; + my $rights = $rights_data->{name}; # Renewal information my $renNum = $params->{renNum}; my $renDate = $params->{renDate}; @@ -30,13 +31,13 @@ sub ValidateSubmission { my $note = $params->{note}; my $category = $params->{category}; if ($date && $date !~ m/^-?\d{1,4}$/) { - push @errs, 'year must be only decimal digits'; + push @errs, 'date must be only decimal digits'; } - elsif (($reason eq 'add' || $reason eq 'exp') && !$date) { + if (($reason eq 'add' || $reason eq 'exp') && !$date) { push @errs, "*/$reason must include a numeric year"; } ## ic/ren requires a nonexpired renewal if 1963 or earlier - if ($attr eq 'ic' && $reason eq 'ren') { + if ($rights eq 'ic/ren') { if ($renNum && $renDate) { my $year = $self->renewal_date_to_year($renDate); if ($year && $year < 1950) { @@ -48,8 +49,8 @@ sub ValidateSubmission { } } ## pd/ren should not have a ren number or date, and is not allowed for post-1963 works. - if ($attr eq 'pd' && $reason eq 'ren') { - if ($renNum && $renDate) { + if ($rights eq 'pd/ren') { + if ($renNum || $renDate) { push @errs, 'pd/ren should not include renewal info'; } } @@ -57,36 +58,33 @@ sub ValidateSubmission { push @errs, 'Actual Publication Date must be a date or a date range (YYYY or YYYY-YYYY)'; } ## pd*/cdpp must not have renewal data - if (($attr eq 'pd' || $attr eq 'pdus') && $reason eq 'cdpp' && ($renNum || $renDate)) { - push @errs, "$attr/$reason must not include renewal info"; + if (($rights eq 'pd/cdpp' || $rights eq 'pdus/cdpp') && ($renNum || $renDate)) { + push @errs, "$attr/cdpp must not include renewal info"; } - if ($attr eq 'pd' && $reason eq 'cdpp' && (!$note || !$category)) { + if ($rights eq 'pd/cdpp' && (!$note || !$category)) { push @errs, 'pd/cdpp must include note category and note text'; } ## ic/cdpp must not have renewal data # NOTE: this could be merged with the pd/cdpp and pdus/cdpp logic above - if ($attr eq 'ic' && $reason eq 'cdpp' && ($renNum || $renDate)) { + if ($rights eq 'ic/cdpp' && ($renNum || $renDate)) { push @errs, 'ic/cdpp must not include renewal info'; } # NOTE: this could be merged with the pd/cdpp and pdus/cdpp logic above - if ($attr eq 'ic' && $reason eq 'cdpp' && (!$note || !$category)) { + if ($rights eq 'ic/cdpp' && (!$note || !$category)) { push @errs, 'ic/cdpp must include note category and note text'; } - if ($attr eq 'und' && $reason eq 'nfi' && !$category) { + if ($rights eq 'und/nfi' && !$category) { push @errs, 'und/nfi must include note category'; } - - ### FIXME: STILL NEED TESTS FOR MOST OF THESE - ## und/ren must have Note Category Inserts/No Renewal - if ($attr eq 'und' && $reason eq 'ren') { - if (!defined $category || $category ne 'Inserts/No Renewal') { + if ($rights eq 'und/ren') { + if (!$category || $category ne 'Inserts/No Renewal') { push @errs, 'und/ren must have note category Inserts/No Renewal'; } } ## and vice versa if ($category && $category eq 'Inserts/No Renewal') { - if ($attr ne 'und' || $reason ne 'ren') { + if ($rights ne 'und/ren') { push @errs, 'Inserts/No Renewal must have rights code und/ren. '; } } @@ -132,23 +130,22 @@ sub FormatReviewData { my $jsonxs = JSON::XS->new->utf8->canonical(1)->pretty(0); my $data = $jsonxs->decode($json); my @lines; - if (scalar keys %$data) { - if ($data->{renNum} || $data->{renDate}) { - push @lines, sprintf 'Renewal %s / %s', $data->{'renNum'}, $data->{'renDate'}; - } - if ($data->{date}) { - my $date_type = ($data->{pub})? 'Pub' : 'ADD'; - push @lines, "$date_type $data->{date}"; - } - if ($data->{crown}) { - push @lines, "Crown \x{1F451}"; - } - if ($data->{actual}) { - push @lines, "Actual Pub Date $data->{actual}"; - } - if ($data->{approximate}) { - push @lines, "Approximate Pub Date"; - } + my $renewal_fmt = $self->format_renewal_data($data->{renNum}, $data->{renDate}); + if ($renewal_fmt) { + push @lines, $renewal_fmt; + } + if ($data->{date}) { + my $date_type = ($data->{pub})? 'Pub' : 'ADD'; + push @lines, "$date_type $data->{date}"; + } + if ($data->{crown}) { + push @lines, "Crown \x{1F451}"; + } + if ($data->{actual}) { + push @lines, "Actual Pub Date $data->{actual}"; + } + if ($data->{approximate}) { + push @lines, "Approximate Pub Date"; } return { 'id' => $id, @@ -171,6 +168,9 @@ sub ReviewPartials { # values are stripped # Note: this might be useful to apply much earlier in the call chain, would # decouple project modules from CGI +# Would have to think carefully about other possible side effect data transformations, +# don't know if it's appropriate to delve into the semantics of the review +# parameters too deeply. sub extract_parameters { my $self = shift; my $cgi = shift; @@ -185,6 +185,7 @@ sub extract_parameters { } # Turn a Stanford renewal date, e.g., 21Oct52, into a year, e.g., 1952 +# Note: this can also be used by the Core project logic in Project.pm sub renewal_date_to_year { my $self = shift; my $renDate = shift; @@ -194,4 +195,13 @@ sub renewal_date_to_year { return '19' . substr($renDate, -2, 2); } +sub format_renewal_data { + my $self = shift; + my $renNum = shift || ''; + my $renDate = shift || ''; + + return '' unless $renNum || $renDate; + return "Renewal $renNum / $renDate"; +} + 1; diff --git a/lib/CRMS/Entitlements.pm b/lib/CRMS/Entitlements.pm index 5348e6c4..b308b69a 100644 --- a/lib/CRMS/Entitlements.pm +++ b/lib/CRMS/Entitlements.pm @@ -23,12 +23,14 @@ my $ONE_TRUE_ENTITLEMENTS; sub new { my ($class, %args) = @_; - my $self = bless {}, $class; - # TODO: once we have a standalone DB module this can go away. - my $crms = $args{crms}; - die "CRMS::Entitlements module needs CRMS instance." unless defined $crms; - $self->{crms} = $crms; - if (!defined $ONE_TRUE_ENTITLEMENTS) { + if (!$ONE_TRUE_ENTITLEMENTS) { + my $self = bless {}, $class; + # TODO: once we have a standalone DB module this can go away. + my $crms = $args{crms}; + if (!defined $crms) { + die "CRMS::Entitlements module needs CRMS instance."; + } + $self->{crms} = $crms; # Eager load lookup tables $self->_load_tables; $ONE_TRUE_ENTITLEMENTS = $self; @@ -48,19 +50,14 @@ sub rights_by_attribute_reason { my $attribute = shift; my $reason = shift; - # Translate attribute and reason into ids if not numeric - if ($attribute !~ m/^\d+$/) { - $attribute = $self->attribute_by_name($attribute)->{id}; - } - if ($reason !~ m/^\d+$/) { - $reason = $self->reason_by_name($reason)->{id}; + # Translate attribute and reason into names if numeric + if ($attribute =~ m/^\d+$/) { + $attribute = $self->attribute_by_id($attribute)->{name}; } - foreach my $id (keys %{$self->{rights}}) { - my $rights = $self->{rights}->{$id}; - if ($rights->{attr} == $attribute && $rights->{reason} == $reason) { - return $rights; - } + if ($reason =~ m/^\d+$/) { + $reason = $self->reason_by_id($reason)->{name}; } + return $self->{rights_by_name}->{"$attribute/$reason"}; } # Returns a hashref with the fields id, type, dscr, name just as they appear in the @@ -114,6 +111,7 @@ sub _load_tables { $self->{reasons_by_name} = $self->{crms}->GetDb->selectall_hashref($sql, 'name'); # crms.rights $self->{rights} = {}; + $self->{rights_by_name} = {}; $sql = 'SELECT * FROM rights ORDER BY id'; $self->{rights} = $self->{crms}->GetDb->selectall_hashref($sql, 'id'); # Decorare each entry with attribute and reason names @@ -124,6 +122,7 @@ sub _load_tables { $rights->{attribute_name} = $attr_name; $rights->{reason_name} = $reason_name; $rights->{name} = "$attr_name/$reason_name"; + $self->{rights_by_name}->{$rights->{name}} = $rights; } } diff --git a/t/Project/SBCR.t b/t/Project/SBCR.t index 3978c3f7..e8df2c06 100644 --- a/t/Project/SBCR.t +++ b/t/Project/SBCR.t @@ -15,11 +15,18 @@ use CRMS; use CRMS::Entitlements; my $jsonxs = JSON::XS->new->utf8->canonical(1)->pretty(0); +# Will be used multiple times in this test suite. +my $crms = CRMS->new(); +my $entitlements = CRMS::Entitlements->new(crms => $crms); +# Grab the most frequently used rights ids +my $ic_ren_rights_id = $entitlements->rights_by_attribute_reason('ic', 'ren')->{id}; +my $pd_ren_rights_id = $entitlements->rights_by_attribute_reason('pd', 'ren')->{id}; +my $ic_cdpp_rights_id = $entitlements->rights_by_attribute_reason('ic', 'cdpp')->{id}; +my $und_nfi_rights_id = $entitlements->rights_by_attribute_reason('und', 'nfi')->{id}; +my $und_ren_rights_id = $entitlements->rights_by_attribute_reason('und', 'ren')->{id}; require_ok($ENV{'SDRROOT'}. '/crms/cgi/Project/SBCR.pm'); -my $crms = CRMS->new(); -# TODO: Project::for_name would be a much nicer way to do this. my $sql = 'SELECT id FROM projects WHERE name="SBCR"'; my $project_id = $crms->SimpleSqlGet($sql); my $proj = SBCR->new(crms => $crms, id => $project_id); @@ -41,56 +48,142 @@ subtest 'SBCR::ValidateSubmission' => sub { ok($err =~ m/rights\/reason combination/); }; - subtest 'ADD/pub date with too many digits' => sub { - my $cgi = CGI->new; - $cgi->param('rights', 1); - $cgi->param('date', '12345'); - my $err = $proj->ValidateSubmission($cgi); - ok($err =~ m/decimal digits/); - }; + subtest 'date must be only decimal digits' => sub { + subtest 'acceptable inputs' => sub { + foreach my $date ('1234', '-1234') { + my $cgi = CGI->new; + $cgi->param('rights', 1); + $cgi->param('date', $date); + my $err = $proj->ValidateSubmission($cgi); + ok($err !~ m/date must be only decimal digits/); + } + }; - subtest 'pd/add with no date' => sub { - my $cgi = CGI->new; - my $rights = CRMS::Entitlements->new(crms => $crms)->rights_by_attribute_reason('pd', 'add')->{id}; - $cgi->param('rights', $rights); - my $err = $proj->ValidateSubmission($cgi); - ok($err =~ m/numeric year/); + subtest 'unacceptable inputs' => sub { + foreach my $date ('12345', '-12345', 'c.1950') { + my $cgi = CGI->new; + $cgi->param('rights', 1); + $cgi->param('date', $date); + my $err = $proj->ValidateSubmission($cgi); + ok($err =~ m/date must be only decimal digits/); + } + }; + + subtest 'no date submitted' => sub { + my $cgi = CGI->new; + $cgi->param('rights', 1); + my $err = $proj->ValidateSubmission($cgi); + ok($err !~ m/date must be only decimal digits/); + }; }; - subtest 'pd/exp with no date' => sub { - my $cgi = CGI->new; - my $rights = CRMS::Entitlements->new(crms => $crms)->rights_by_attribute_reason('pd', 'exp')->{id}; - $cgi->param('rights', $rights); - my $err = $proj->ValidateSubmission($cgi); - ok($err =~ m/numeric year/); + subtest '*/add and */exp must include a numeric year' => sub { + foreach my $id (keys %{$entitlements->{rights}}) { + my $rights = $entitlements->{rights}->{$id}; + if ($rights->{reason_name} eq 'add' || $rights->{reason_name} eq 'exp') { + subtest "$rights->{name} with date" => sub { + my $cgi = CGI->new; + $cgi->param('rights', $rights->{id}); + $cgi->param('date', 1957); + my $err = $proj->ValidateSubmission($cgi); + ok($err !~ m/must include a numeric year/); + }; + + subtest "$rights->{name} without date" => sub { + my $cgi = CGI->new; + $cgi->param('rights', $rights->{id}); + #$cgi->param('date', 1957); + my $err = $proj->ValidateSubmission($cgi); + ok($err =~ m/must include a numeric year/); + }; + } else { + subtest "$rights->{name} with date" => sub { + my $cgi = CGI->new; + $cgi->param('rights', $rights->{id}); + $cgi->param('date', 1957); + my $err = $proj->ValidateSubmission($cgi); + ok($err !~ m/must include a numeric year/); + }; + } + } }; - subtest 'ic/ren with expired renewal' => sub { - my $cgi = CGI->new; - my $rights = CRMS::Entitlements->new(crms => $crms)->rights_by_attribute_reason('ic', 'ren')->{id}; - $cgi->param('rights', $rights); - $cgi->param('renNum', 'R123'); - $cgi->param('renDate', '4Jun23'); - my $err = $proj->ValidateSubmission($cgi); - ok($err =~ m/expired/); + subtest 'renewal ... has expired: volume is pd' => sub { + subtest 'ic/ren with nonexpired renewal' => sub { + my $cgi = CGI->new; + $cgi->param('rights', $ic_ren_rights_id); + $cgi->param('renNum', 'R123'); + $cgi->param('renDate', '4Jun63'); + my $err = $proj->ValidateSubmission($cgi); + ok($err !~ m/renewal .*? has expired: volume is pd/); + }; + + subtest 'ic/ren with expired renewal date' => sub { + my $cgi = CGI->new; + $cgi->param('rights', $ic_ren_rights_id); + $cgi->param('renNum', 'R123'); + $cgi->param('renDate', '4Jun23'); + my $err = $proj->ValidateSubmission($cgi); + ok($err =~ m/renewal .*? has expired: volume is pd/); + }; + + subtest 'ic/ren with unparseable renewal date' => sub { + my $cgi = CGI->new; + $cgi->param('rights', $ic_ren_rights_id); + $cgi->param('renNum', 'R123'); + $cgi->param('renDate', 'unparseable'); + my $err = $proj->ValidateSubmission($cgi); + ok($err !~ m/renewal .*? has expired: volume is pd/); + }; + + subtest 'ic/ren with no renewal date' => sub { + my $cgi = CGI->new; + $cgi->param('rights', $ic_ren_rights_id); + $cgi->param('renNum', 'R123'); + my $err = $proj->ValidateSubmission($cgi); + ok($err !~ m/renewal .*? has expired: volume is pd/); + }; + + subtest 'not ic/ren' => sub { + my $cgi = CGI->new; + $cgi->param('rights', $pd_ren_rights_id); + $cgi->param('renNum', 'R123'); + $cgi->param('renDate', '4Jun23'); + my $err = $proj->ValidateSubmission($cgi); + ok($err !~ m/renewal .*? has expired: volume is pd/); + }; }; - subtest 'ic/ren with no renewal data' => sub { + subtest 'ic/ren must include renewal id and renewal date' => sub { my $cgi = CGI->new; - my $rights = CRMS::Entitlements->new(crms => $crms)->rights_by_attribute_reason('ic', 'ren')->{id}; - $cgi->param('rights', $rights); + $cgi->param('rights', $ic_ren_rights_id); my $err = $proj->ValidateSubmission($cgi); - ok($err =~ m/renewal id/); + ok($err =~ m/must include renewal id and renewal date/); }; - subtest 'pd/ren with renewal data' => sub { - my $cgi = CGI->new; - my $rights = CRMS::Entitlements->new(crms => $crms)->rights_by_attribute_reason('pd', 'ren')->{id}; - $cgi->param('rights', $rights); - $cgi->param('renNum', 'R123'); - $cgi->param('renDate', '4Jun23'); - my $err = $proj->ValidateSubmission($cgi); - ok($err =~ m/should not include renewal info/); + subtest 'pd/ren should not include renewal info' => sub { + subtest 'without renewal info' => sub { + my $cgi = CGI->new; + $cgi->param('rights', $pd_ren_rights_id); + my $err = $proj->ValidateSubmission($cgi); + ok($err !~ m/should not include renewal info/); + }; + + subtest 'with renNum' => sub { + my $cgi = CGI->new; + $cgi->param('rights', $pd_ren_rights_id); + $cgi->param('renNum', 'R123'); + my $err = $proj->ValidateSubmission($cgi); + ok($err =~ m/should not include renewal info/); + }; + + subtest 'with renDate' => sub { + my $cgi = CGI->new; + $cgi->param('rights', $pd_ren_rights_id); + $cgi->param('renDate', '4Jun23'); + my $err = $proj->ValidateSubmission($cgi); + ok($err =~ m/should not include renewal info/); + }; }; subtest 'actual publication date' => sub { @@ -118,23 +211,37 @@ subtest 'SBCR::ValidateSubmission' => sub { ok($err =~ m/YYYY or YYYY-YYYY/); }; }; - + subtest 'pd*/cdpp must not include renewal data' => sub { foreach my $attr ('pd', 'pdus') { - subtest $attr => sub { + my $rights = $entitlements->rights_by_attribute_reason($attr, 'cdpp')->{id}; + subtest "$attr with renewal number" => sub { my $cgi = CGI->new; - my $rights = CRMS::Entitlements->new(crms => $crms)->rights_by_attribute_reason($attr, 'cdpp')->{id}; $cgi->param('rights', $rights); $cgi->param('renNum', 'R123'); + my $err = $proj->ValidateSubmission($cgi); + ok($err =~ m/must not include renewal info/); + }; + + subtest "$attr with renewal date" => sub { + my $cgi = CGI->new; + $cgi->param('rights', $rights); $cgi->param('renDate', '4Jun23'); my $err = $proj->ValidateSubmission($cgi); ok($err =~ m/must not include renewal info/); }; + + subtest "$attr without renewal data" => sub { + my $cgi = CGI->new; + $cgi->param('rights', $rights); + my $err = $proj->ValidateSubmission($cgi); + ok($err !~ m/must not include renewal info/); + }; } }; subtest 'pd/cdpp must include note category and note text' => sub { - my $rights = CRMS::Entitlements->new(crms => $crms)->rights_by_attribute_reason('pd', 'cdpp')->{id}; + my $rights = $entitlements->rights_by_attribute_reason('pd', 'cdpp')->{id}; subtest 'with both' => sub { my $cgi = CGI->new; $cgi->param('rights', $rights); @@ -144,6 +251,14 @@ subtest 'SBCR::ValidateSubmission' => sub { ok($err !~ m/must include note category and note text/); }; + subtest 'with note only' => sub { + my $cgi = CGI->new; + $cgi->param('rights', $rights); + $cgi->param('note', 'This is a note'); + my $err = $proj->ValidateSubmission($cgi); + ok($err =~ m/must include note category and note text/); + }; + subtest 'with neither' => sub { my $cgi = CGI->new; $cgi->param('rights', $rights); @@ -154,40 +269,54 @@ subtest 'SBCR::ValidateSubmission' => sub { # NOTE: this could be merged with the pd/cdpp and pdus/cdpp logic above subtest 'ic/cdpp must not include renewal data' => sub { - my $cgi = CGI->new; - my $rights = CRMS::Entitlements->new(crms => $crms)->rights_by_attribute_reason('ic', 'cdpp')->{id}; - $cgi->param('rights', $rights); - $cgi->param('renNum', 'R123'); - $cgi->param('renDate', '4Jun23'); - my $err = $proj->ValidateSubmission($cgi); - ok($err =~ m/must not include renewal info/); + subtest 'with renewal number' => sub { + my $cgi = CGI->new; + $cgi->param('rights', $ic_cdpp_rights_id); + $cgi->param('renNum', 'R123'); + my $err = $proj->ValidateSubmission($cgi); + ok($err =~ m/must not include renewal info/); + }; + + subtest 'with renewal date' => sub { + my $cgi = CGI->new; + $cgi->param('rights', $ic_cdpp_rights_id); + $cgi->param('renDate', '4Jun23'); + my $err = $proj->ValidateSubmission($cgi); + ok($err =~ m/must not include renewal info/); + }; }; # NOTE: this could be merged with the pd/cdpp and pdus/cdpp logic above subtest 'ic/cdpp must include note category and note text' => sub { - my $rights = CRMS::Entitlements->new(crms => $crms)->rights_by_attribute_reason('ic', 'cdpp')->{id}; subtest 'with both' => sub { my $cgi = CGI->new; - $cgi->param('rights', $rights); + $cgi->param('rights', $ic_cdpp_rights_id); $cgi->param('category', 'Edition'); $cgi->param('note', 'This is a note'); my $err = $proj->ValidateSubmission($cgi); ok($err !~ m/must include note category and note text/); }; + subtest 'with note only' => sub { + my $cgi = CGI->new; + $cgi->param('rights', $ic_cdpp_rights_id); + $cgi->param('note', 'This is a note'); + my $err = $proj->ValidateSubmission($cgi); + ok($err =~ m/must include note category and note text/); + }; + subtest 'with neither' => sub { my $cgi = CGI->new; - $cgi->param('rights', $rights); + $cgi->param('rights', $ic_cdpp_rights_id); my $err = $proj->ValidateSubmission($cgi); ok($err =~ m/must include note category and note text/); }; }; subtest 'und/nfi must include note category' => sub { - my $rights = CRMS::Entitlements->new(crms => $crms)->rights_by_attribute_reason('und', 'nfi')->{id}; subtest 'with category' => sub { my $cgi = CGI->new; - $cgi->param('rights', $rights); + $cgi->param('rights', $und_nfi_rights_id); $cgi->param('category', 'Edition'); my $err = $proj->ValidateSubmission($cgi); ok($err !~ m/must include note category/); @@ -195,49 +324,131 @@ subtest 'SBCR::ValidateSubmission' => sub { subtest 'without category' => sub { my $cgi = CGI->new; - $cgi->param('rights', $rights); + $cgi->param('rights', $und_nfi_rights_id); my $err = $proj->ValidateSubmission($cgi); ok($err =~ m/must include note category/); }; }; subtest 'und/ren must have note category Inserts/No Renewal' => sub { - my $rights = CRMS::Entitlements->new(crms => $crms)->rights_by_attribute_reason('und', 'ren')->{id}; subtest 'with expected category' => sub { my $cgi = CGI->new; - $cgi->param('rights', $rights); + $cgi->param('rights', $und_ren_rights_id); $cgi->param('category', 'Inserts/No Renewal'); my $err = $proj->ValidateSubmission($cgi); - ok($err !~ m/must have note category/); + ok($err !~ m/mmust have note category Inserts\/No Renewal/); }; subtest 'without expected category' => sub { my $cgi = CGI->new; - $cgi->param('rights', $rights); + $cgi->param('rights', $und_ren_rights_id); $cgi->param('category', 'Edition'); my $err = $proj->ValidateSubmission($cgi); - ok($err =~ m/must have note category /); + ok($err =~ m/must have note category Inserts\/No Renewal/); }; subtest 'with no category' => sub { my $cgi = CGI->new; - $cgi->param('rights', $rights); + $cgi->param('rights', $und_ren_rights_id); my $err = $proj->ValidateSubmission($cgi); ok($err =~ m/must have note category /); }; }; - - # FIXME: MORE TESTS NEEDED HERE + subtest 'Inserts/No Renewal category is only used with und/ren' => sub { + subtest 'with expected rights' => sub { + my $cgi = CGI->new; + $cgi->param('rights', $und_ren_rights_id); + $cgi->param('category', 'Inserts/No Renewal'); + my $err = $proj->ValidateSubmission($cgi); + ok($err !~ m/must have rights code/); + }; + subtest 'without expected rights' => sub { + my $cgi = CGI->new; + $cgi->param('rights', $und_nfi_rights_id); + $cgi->param('category', 'Inserts/No Renewal'); + my $err = $proj->ValidateSubmission($cgi); + ok($err =~ m/must have rights code/); + }; + }; - subtest 'category without required note' => sub { - my $cgi = CGI->new; - $cgi->param('rights', 1); - $cgi->param('category', 'Misc'); - my $err = $proj->ValidateSubmission($cgi); - ok($err =~ m/requires a note/); + subtest "note optionality" => sub { + my $note_required = $crms->SimpleSqlGet('SELECT name FROM categories WHERE need_note=1 AND interface=1 AND restricted IS NULL'); + my $note_optional = $crms->SimpleSqlGet('SELECT name FROM categories WHERE need_note=0 AND interface=1 AND restricted IS NULL'); + subtest 'category without required note' => sub { + my $cgi = CGI->new; + $cgi->param('rights', 1); + $cgi->param('category', $note_required); + my $err = $proj->ValidateSubmission($cgi); + ok($err =~ m/requires a note/); + }; + + subtest 'category with required note' => sub { + my $cgi = CGI->new; + $cgi->param('rights', 1); + $cgi->param('category', $note_required); + $cgi->param('note', 'This is a required note'); + my $err = $proj->ValidateSubmission($cgi); + ok($err !~ m/requires a note/); + }; + + subtest 'category without optional note' => sub { + my $cgi = CGI->new; + $cgi->param('rights', 1); + $cgi->param('category', $note_optional); + my $err = $proj->ValidateSubmission($cgi); + ok($err !~ m/requires a note/); + }; + + subtest 'category with required note' => sub { + my $cgi = CGI->new; + $cgi->param('rights', 1); + $cgi->param('category', $note_optional); + $cgi->param('note', 'This is an optional note'); + my $err = $proj->ValidateSubmission($cgi); + ok($err !~ m/requires a note/); + }; }; + + subtest 'must include a category if there is a note' => sub { + subtest 'note with category' => sub { + my $cgi = CGI->new; + $cgi->param('rights', 1); + $cgi->param('note', 'This is a note'); + $cgi->param('category', 'Misc'); + my $err = $proj->ValidateSubmission($cgi); + ok($err !~ m/must include a category/); + }; + + subtest 'note without category' => sub { + my $cgi = CGI->new; + $cgi->param('rights', 1); + $cgi->param('note', 'This is a note'); + my $err = $proj->ValidateSubmission($cgi); + ok($err =~ m/must include a category/); + }; + }; + + subtest 'Not Government category requires und/NFI' => sub { + subtest 'Not Government category with und/nfi' => sub { + my $rights = $entitlements->rights_by_attribute_reason('und', 'nfi')->{id}; + my $cgi = CGI->new; + $cgi->param('rights', $rights); + $cgi->param('category', 'Not Government'); + my $err = $proj->ValidateSubmission($cgi); + ok($err !~ m/Not Government category requires/); + }; + + subtest 'Not Government category without und/nfi' => sub { + my $cgi = CGI->new; + $cgi->param('rights', $ic_ren_rights_id); + $cgi->param('category', 'Not Government'); + my $err = $proj->ValidateSubmission($cgi); + ok($err =~ m/Not Government category requires/); + }; + }; + # End of ValidateSubmission subtest }; subtest 'ExtractReviewData' => sub { @@ -268,22 +479,52 @@ subtest 'ExtractReviewData' => sub { }; subtest 'FormatReviewData' => sub { - my $data = { - renNum => 'R123', - renDate => '26Sep39', - date => '1950', - pub => 1, - crown => 1, - actual => '1960', - approximate => 1 + subtest 'with lots of data' => sub { + my $data = { + renNum => 'R123', + renDate => '26Sep39', + date => '1950', + pub => 0, + crown => 1, + actual => '1960', + approximate => 1 + }; + my $json = $jsonxs->encode($data); + my $format = $proj->FormatReviewData(1, $json); + ok($format->{format} =~ /Renewal/); + ok($format->{format} =~ /ADD/); + ok($format->{format} !~ /Pub/); + ok($format->{format} =~ /Crown/); + ok($format->{format} =~ /Actual/); + is($format->{id}, 1); + }; + + subtest 'with a little data' => sub { + my $data = { + date => '1960', + pub => 1 + }; + my $json = $jsonxs->encode($data); + my $format = $proj->FormatReviewData(1, $json); + ok($format->{format} !~ /Renewal/); + ok($format->{format} !~ /ADD/); + ok($format->{format} =~ /Pub/); + ok($format->{format} !~ /Crown/); + ok($format->{format} !~ /Actual/); + is($format->{id}, 1); + }; + + subtest 'with no data' => sub { + my $data = {}; + my $json = $jsonxs->encode($data); + my $format = $proj->FormatReviewData(1, $json); + ok($format->{format} !~ /Renewal/); + ok($format->{format} !~ /ADD/); + ok($format->{format} !~ /Pub/); + ok($format->{format} !~ /Crown/); + ok($format->{format} !~ /Actual/); + is($format->{id}, 1); }; - my $json = $jsonxs->encode($data); - my $format = $proj->FormatReviewData(1, $json); - ok($format->{format} =~ /renewal/i); - ok($format->{format} =~ /pub/i); - ok($format->{format} =~ /crown/i); - ok($format->{format} =~ /actual/i); - is($format->{id}, 1); }; subtest 'extract_parameters' => sub { @@ -295,6 +536,25 @@ subtest 'extract_parameters' => sub { is($params->{renNum}, 'R12345', 'strips whitespace'); }; +subtest 'format_renewal_data' => sub { + subtest 'with no data' => sub { + ok(length $proj->format_renewal_data(undef, undef) == 0); + }; + + subtest 'with only renNum' => sub { + ok($proj->format_renewal_data('R123', undef) =~ m/R123/); + }; + + subtest 'with only renDate' => sub { + ok($proj->format_renewal_data(undef, '1Oct51') =~ m/1Oct51/); + }; + + subtest 'with both renNum and renDate' => sub { + ok($proj->format_renewal_data('R123', '1Oct51') =~ m/R123/); + ok($proj->format_renewal_data('R123', '1Oct51') =~ m/1Oct51/); + }; +}; + subtest 'renewal_date_to_year' => sub { subtest 'with a well-formed renewal date' => sub { my $year = $proj->renewal_date_to_year('21Sep51'); diff --git a/t/lib/CRMS/Entitlements.t b/t/lib/CRMS/Entitlements.t index fad55cad..4c3d0009 100644 --- a/t/lib/CRMS/Entitlements.t +++ b/t/lib/CRMS/Entitlements.t @@ -13,13 +13,16 @@ use CRMS::Entitlements; my $crms = CRMS->new; -subtest '::new' => sub { - my $rights = CRMS::Entitlements->new(crms => $crms); - isa_ok($rights, 'CRMS::Entitlements'); - +#$CRMS::Entitlements::ONE_TRUE_ENTITLEMENTS = undef; +subtest 'new' => sub { subtest 'Missing CRMS' => sub { dies_ok { CRMS::Entitlements->new; }; }; + + subtest 'CRMS supplied' => sub { + my $rights = CRMS::Entitlements->new(crms => $crms, reinit => 1); + isa_ok($rights, 'CRMS::Entitlements'); + }; }; subtest 'rights_by_id' => sub { @@ -34,7 +37,7 @@ subtest 'rights_by_attribute_reason' => sub { is($rights->{reason_name}, 'ren'); is($rights->{name}, 'ic/ren'); }; - + subtest 'with names' => sub { my $rights = CRMS::Entitlements->new(crms => $crms)->rights_by_attribute_reason('ic', 'ren'); is($rights->{attribute_name}, 'ic'); From 2dccddf8813dd6520dad840d78070c72f850a8b0 Mon Sep 17 00:00:00 2001 From: Brian Moses Hall Date: Wed, 29 Oct 2025 13:47:51 -0400 Subject: [PATCH 12/25] Move unused review data validations from SBCR to projects that use them --- cgi/Project/SBCR.pm | 70 +------ t/Project.t | 333 ++++++++++++++++++++++++++++++- t/Project/CrownCopyright.t | 58 ++++++ t/Project/SBCR.t | 387 ++++--------------------------------- 4 files changed, 432 insertions(+), 416 deletions(-) create mode 100644 t/Project/CrownCopyright.t diff --git a/cgi/Project/SBCR.pm b/cgi/Project/SBCR.pm index b99aeb5c..60e14732 100644 --- a/cgi/Project/SBCR.pm +++ b/cgi/Project/SBCR.pm @@ -36,70 +36,15 @@ sub ValidateSubmission { if (($reason eq 'add' || $reason eq 'exp') && !$date) { push @errs, "*/$reason must include a numeric year"; } - ## ic/ren requires a nonexpired renewal if 1963 or earlier + ## ic/ren requires a renewal number and date if ($rights eq 'ic/ren') { - if ($renNum && $renDate) { - my $year = $self->renewal_date_to_year($renDate); - if ($year && $year < 1950) { - push @errs, "renewal ($renDate) has expired: volume is pd"; - } - } - else { + if (!$renNum || !$renDate) { push @errs, 'ic/ren must include renewal id and renewal date'; } } - ## pd/ren should not have a ren number or date, and is not allowed for post-1963 works. - if ($rights eq 'pd/ren') { - if ($renNum || $renDate) { - push @errs, 'pd/ren should not include renewal info'; - } - } if ($actual && $actual !~ m/^\d{4}(-\d{4})?$/) { push @errs, 'Actual Publication Date must be a date or a date range (YYYY or YYYY-YYYY)'; } - ## pd*/cdpp must not have renewal data - if (($rights eq 'pd/cdpp' || $rights eq 'pdus/cdpp') && ($renNum || $renDate)) { - push @errs, "$attr/cdpp must not include renewal info"; - } - if ($rights eq 'pd/cdpp' && (!$note || !$category)) { - push @errs, 'pd/cdpp must include note category and note text'; - } - ## ic/cdpp must not have renewal data - # NOTE: this could be merged with the pd/cdpp and pdus/cdpp logic above - if ($rights eq 'ic/cdpp' && ($renNum || $renDate)) { - push @errs, 'ic/cdpp must not include renewal info'; - } - # NOTE: this could be merged with the pd/cdpp and pdus/cdpp logic above - if ($rights eq 'ic/cdpp' && (!$note || !$category)) { - push @errs, 'ic/cdpp must include note category and note text'; - } - if ($rights eq 'und/nfi' && !$category) { - push @errs, 'und/nfi must include note category'; - } - ## und/ren must have Note Category Inserts/No Renewal - if ($rights eq 'und/ren') { - if (!$category || $category ne 'Inserts/No Renewal') { - push @errs, 'und/ren must have note category Inserts/No Renewal'; - } - } - ## and vice versa - if ($category && $category eq 'Inserts/No Renewal') { - if ($rights ne 'und/ren') { - push @errs, 'Inserts/No Renewal must have rights code und/ren. '; - } - } - # Category/Note - if ($category && !$note) { - if ($self->{'crms'}->SimpleSqlGet('SELECT need_note FROM categories WHERE name=?', $category)) { - push @errs, qq{category "$category" requires a note}; - } - } - elsif ($note && !$category) { - push @errs, 'must include a category if there is a note'; - } - if ($category && $category eq 'Not Government' && $attr ne 'und') { - push @errs, 'Not Government category requires und/NFI'; - } return join ', ', @errs; } @@ -184,17 +129,6 @@ sub extract_parameters { return $params; } -# Turn a Stanford renewal date, e.g., 21Oct52, into a year, e.g., 1952 -# Note: this can also be used by the Core project logic in Project.pm -sub renewal_date_to_year { - my $self = shift; - my $renDate = shift; - - # If the last two digits are not numeric for some reason then there is no reasonable answer. - return '' unless $renDate =~ m/\d\d$/; - return '19' . substr($renDate, -2, 2); -} - sub format_renewal_data { my $self = shift; my $renNum = shift || ''; diff --git a/t/Project.t b/t/Project.t index 595102a6..5d0c42a6 100755 --- a/t/Project.t +++ b/t/Project.t @@ -2,11 +2,14 @@ use strict; use warnings; -BEGIN { unshift(@INC, $ENV{'SDRROOT'}. '/crms/cgi'); } use Test::More; +use lib $ENV{'SDRROOT'} . '/crms/cgi'; +use lib $ENV{'SDRROOT'} . '/crms/lib'; + use CRMS; +use CRMS::Entitlements; my $dir = $ENV{'SDRROOT'}. '/crms/cgi/Project'; opendir(DIR, $dir) or die "Can't open $dir\n"; @@ -20,6 +23,12 @@ foreach my $file (sort @files) } my $crms = CRMS->new; +my $entitlements = CRMS::Entitlements->new(crms => $crms); +# Rights ids used across subtests + +my $ic_cdpp_rights_id = $entitlements->rights_by_attribute_reason('ic', 'cdpp')->{id}; +my $und_nfi_rights_id = $entitlements->rights_by_attribute_reason('und', 'nfi')->{id}; +my $und_ren_rights_id = $entitlements->rights_by_attribute_reason('und', 'ren')->{id}; my $project = Project->new(crms => $crms); subtest '#queue_order' => sub { @@ -30,5 +39,327 @@ subtest '#PresentationOrder' => sub { is($project->PresentationOrder, undef, 'default project has no PresentationOrder'); }; +subtest 'ValidateSubmission' => sub { + subtest 'no rights selected' => sub { + my $cgi = CGI->new; + my $err = $project->ValidateSubmission($cgi); + ok($err =~ m/rights\/reason combination/, 'error displayed'); + }; + + subtest 'und/nfi must include note category and note text' => sub { + subtest 'with category and note' => sub { + my $cgi = CGI->new; + $cgi->param('rights', $und_nfi_rights_id); + $cgi->param('category', 'Edition'); + $cgi->param('note', 'This is a note'); + my $err = $project->ValidateSubmission($cgi); + ok($err !~ m/must include note category and note text/, 'no error'); + }; + + subtest 'without category' => sub { + my $cgi = CGI->new; + $cgi->param('rights', $und_nfi_rights_id); + # Setting the category explicitly to empty string is needed to avoid + # "uninitialized value $category" warnings in Project.pm. + # These can be all removed when that is fixed with a default empty string value. + $cgi->param('category', ''); + $cgi->param('note', 'This is a note'); + my $err = $project->ValidateSubmission($cgi); + ok($err =~ m/must include note category and note text/, 'error displayed'); + }; + + subtest 'with neither' => sub { + my $cgi = CGI->new; + $cgi->param('rights', $und_nfi_rights_id); + $cgi->param('category', ''); + my $err = $project->ValidateSubmission($cgi); + ok($err =~ m/must include note category and note text/, 'error displayed'); + }; + }; + + subtest 'ic/ren must include renewal id and renewal date' => sub { + my $ic_ren_rights_id = $entitlements->rights_by_attribute_reason('ic', 'ren')->{id}; + subtest 'with renewal data' => sub { + my $cgi = CGI->new; + $cgi->param('rights', $ic_ren_rights_id); + $cgi->param('renNum', 'R123'); + $cgi->param('renDate', '4Jun23'); + $cgi->param('category', ''); + my $err = $project->ValidateSubmission($cgi); + ok($err !~ m/must include renewal id and renewal date/, 'no error'); + }; + + subtest 'with just renewal id' => sub { + my $cgi = CGI->new; + $cgi->param('rights', $ic_ren_rights_id); + $cgi->param('renNum', 'R123'); + $cgi->param('category', ''); + my $err = $project->ValidateSubmission($cgi); + ok($err =~ m/must include renewal id and renewal date/, 'error displayed'); + }; + + subtest 'without renewal data' => sub { + my $cgi = CGI->new; + $cgi->param('rights', $ic_ren_rights_id); + $cgi->param('category', ''); + my $err = $project->ValidateSubmission($cgi); + ok($err =~ m/must include renewal id and renewal date/, 'error displayed'); + }; + }; + + subtest 'pd/ren should not include renewal info' => sub { + my $pd_ren_rights_id = $entitlements->rights_by_attribute_reason('pd', 'ren')->{id}; + subtest 'without renewal info' => sub { + my $cgi = CGI->new; + $cgi->param('rights', $pd_ren_rights_id); + $cgi->param('category', ''); + my $err = $project->ValidateSubmission($cgi); + ok($err !~ m/should not include renewal info/, 'no error'); + }; + + # FIXME: next two tests show arguably incorrect behavior, the error should be triggered if either + # renNum or renDate is present. The assumption has been that renDate will always be present + # if renNum is, and that's maybe not quite true. + subtest 'with renNum' => sub { + my $cgi = CGI->new; + $cgi->param('rights', $pd_ren_rights_id); + $cgi->param('renNum', 'R123'); + $cgi->param('category', ''); + my $err = $project->ValidateSubmission($cgi); + ok($err !~ m/should not include renewal info/, 'no error'); + }; + + subtest 'with renDate' => sub { + my $cgi = CGI->new; + $cgi->param('rights', $pd_ren_rights_id); + $cgi->param('renDate', '4Jun23'); + $cgi->param('category', ''); + my $err = $project->ValidateSubmission($cgi); + ok($err !~ m/should not include renewal info/, 'no error'); + }; + + subtest 'with both' => sub { + my $cgi = CGI->new; + $cgi->param('rights', $pd_ren_rights_id); + $cgi->param('renDate', '4Jun23'); + $cgi->param('category', ''); + my $err = $project->ValidateSubmission($cgi); + ok($err !~ m/should not include renewal info/, 'error displayed'); + }; + }; + + subtest 'pd*/cdpp must not include renewal data' => sub { + foreach my $attr ('pd', 'pdus') { + my $rights = $entitlements->rights_by_attribute_reason($attr, 'cdpp')->{id}; + subtest "$attr with renewal number" => sub { + my $cgi = CGI->new; + $cgi->param('rights', $rights); + $cgi->param('renNum', 'R123'); + $cgi->param('category', ''); + my $err = $project->ValidateSubmission($cgi); + ok($err =~ m/must not include renewal info/, 'error displayed'); + }; + + subtest "$attr with renewal date" => sub { + my $cgi = CGI->new; + $cgi->param('rights', $rights); + $cgi->param('renDate', '4Jun23'); + $cgi->param('category', ''); + my $err = $project->ValidateSubmission($cgi); + ok($err =~ m/must not include renewal info/, 'error displayed'); + }; + + subtest "$attr without renewal data" => sub { + my $cgi = CGI->new; + $cgi->param('rights', $rights); + $cgi->param('category', ''); + my $err = $project->ValidateSubmission($cgi); + ok($err !~ m/must not include renewal info/, 'no error'); + }; + } + }; + + subtest 'pd/cdpp must include note category and note text' => sub { + my $rights = $entitlements->rights_by_attribute_reason('pd', 'cdpp')->{id}; + subtest 'with both' => sub { + my $cgi = CGI->new; + $cgi->param('rights', $rights); + $cgi->param('category', 'Edition'); + $cgi->param('note', 'This is a note'); + my $err = $project->ValidateSubmission($cgi); + ok($err !~ m/must include note category and note text/, 'no error'); + }; + + subtest 'with note only' => sub { + my $cgi = CGI->new; + $cgi->param('rights', $rights); + $cgi->param('category', ''); + $cgi->param('note', 'This is a note'); + my $err = $project->ValidateSubmission($cgi); + ok($err =~ m/must include note category and note text/, 'error displayed'); + }; + + subtest 'with neither' => sub { + my $cgi = CGI->new; + $cgi->param('rights', $rights); + $cgi->param('category', ''); + my $err = $project->ValidateSubmission($cgi); + ok($err =~ m/must include note category and note text/, 'error displayed'); + }; + }; + + # NOTE: this could be merged with the pd/cdpp and pdus/cdpp logic above + subtest 'ic/cdpp must not include renewal data' => sub { + subtest 'with renewal number' => sub { + my $cgi = CGI->new; + $cgi->param('rights', $ic_cdpp_rights_id); + $cgi->param('renNum', 'R123'); + $cgi->param('category', ''); + my $err = $project->ValidateSubmission($cgi); + ok($err =~ m/should not include renewal info/, 'error displayed'); + }; + + subtest 'with renewal date' => sub { + my $cgi = CGI->new; + $cgi->param('rights', $ic_cdpp_rights_id); + $cgi->param('renDate', '4Jun23'); + $cgi->param('category', ''); + my $err = $project->ValidateSubmission($cgi); + ok($err =~ m/should not include renewal info/, 'error displayed'); + }; + }; + + # NOTE: this could be merged with the pd/cdpp and pdus/cdpp logic above + subtest 'ic/cdpp must include note category and note text' => sub { + subtest 'with both' => sub { + my $cgi = CGI->new; + $cgi->param('rights', $ic_cdpp_rights_id); + $cgi->param('category', 'Edition'); + $cgi->param('note', 'This is a note'); + my $err = $project->ValidateSubmission($cgi); + ok($err !~ m/must include note category and note text/, 'no error'); + }; + + subtest 'with note only' => sub { + my $cgi = CGI->new; + $cgi->param('rights', $ic_cdpp_rights_id); + $cgi->param('category', ''); + $cgi->param('note', 'This is a note'); + my $err = $project->ValidateSubmission($cgi); + ok($err =~ m/must include note category and note text/, 'error displayed'); + }; + + subtest 'with neither' => sub { + my $cgi = CGI->new; + $cgi->param('rights', $ic_cdpp_rights_id); + $cgi->param('category', ''); + my $err = $project->ValidateSubmission($cgi); + ok($err =~ m/must include note category and note text/, 'error displayed'); + }; + }; + + subtest 'und/ren must have note category Inserts/No Renewal' => sub { + subtest 'with expected category' => sub { + my $cgi = CGI->new; + $cgi->param('rights', $und_ren_rights_id); + $cgi->param('category', 'Inserts/No Renewal'); + my $err = $project->ValidateSubmission($cgi); + ok($err !~ m/mmust have note category Inserts\/No Renewal/, 'no error'); + }; + + subtest 'without expected category' => sub { + my $cgi = CGI->new; + $cgi->param('rights', $und_ren_rights_id); + $cgi->param('category', 'Edition'); + my $err = $project->ValidateSubmission($cgi); + ok($err =~ m/must have note category Inserts\/No Renewal/, 'no error'); + }; + + subtest 'with no category' => sub { + my $cgi = CGI->new; + $cgi->param('rights', $und_ren_rights_id); + $cgi->param('category', ''); + my $err = $project->ValidateSubmission($cgi); + ok($err =~ m/must have note category/, 'error displayed'); + }; + }; + + subtest 'Inserts/No Renewal category is only used with und/ren' => sub { + subtest 'with expected rights' => sub { + my $cgi = CGI->new; + $cgi->param('rights', $und_ren_rights_id); + $cgi->param('category', 'Inserts/No Renewal'); + my $err = $project->ValidateSubmission($cgi); + ok($err !~ m/must have rights code/, 'no error'); + }; + + subtest 'without expected rights' => sub { + my $cgi = CGI->new; + $cgi->param('rights', $und_nfi_rights_id); + $cgi->param('category', 'Inserts/No Renewal'); + my $err = $project->ValidateSubmission($cgi); + ok($err =~ m/must have rights code/, 'error displayed'); + }; + }; + + subtest "note optionality" => sub { + my $note_required = $crms->SimpleSqlGet('SELECT name FROM categories WHERE need_note=1 AND interface=1 AND restricted IS NULL'); + my $note_optional = $crms->SimpleSqlGet('SELECT name FROM categories WHERE need_note=0 AND interface=1 AND restricted IS NULL'); + subtest 'category without required note' => sub { + my $cgi = CGI->new; + $cgi->param('rights', 1); + $cgi->param('category', $note_required); + my $err = $project->ValidateSubmission($cgi); + ok($err =~ m/must include a note/, 'error displayed'); + }; + + subtest 'category with required note' => sub { + my $cgi = CGI->new; + $cgi->param('rights', 1); + $cgi->param('category', $note_required); + $cgi->param('note', 'This is a required note'); + my $err = $project->ValidateSubmission($cgi); + ok($err !~ m/must include a note/, 'no error'); + }; + + subtest 'category without optional note' => sub { + my $cgi = CGI->new; + $cgi->param('rights', 1); + $cgi->param('category', $note_optional); + my $err = $project->ValidateSubmission($cgi); + ok($err !~ m/must include a note/, 'no error'); + }; + + subtest 'category with required note' => sub { + my $cgi = CGI->new; + $cgi->param('rights', 1); + $cgi->param('category', $note_optional); + $cgi->param('note', 'This is an optional note'); + my $err = $project->ValidateSubmission($cgi); + ok($err !~ m/must include a note/, 'no error'); + }; + }; + + subtest 'must include a category if there is a note' => sub { + subtest 'note with category' => sub { + my $cgi = CGI->new; + $cgi->param('rights', 1); + $cgi->param('note', 'This is a note'); + $cgi->param('category', 'Misc'); + my $err = $project->ValidateSubmission($cgi); + ok($err !~ m/must include a category/, 'no error'); + }; + + subtest 'note without category' => sub { + my $cgi = CGI->new; + $cgi->param('rights', 1); + $cgi->param('category', ''); + $cgi->param('note', 'This is a note'); + my $err = $project->ValidateSubmission($cgi); + ok($err =~ m/must include a category/, 'error displayed'); + }; + }; +}; + done_testing(); diff --git a/t/Project/CrownCopyright.t b/t/Project/CrownCopyright.t new file mode 100644 index 00000000..3e6c231b --- /dev/null +++ b/t/Project/CrownCopyright.t @@ -0,0 +1,58 @@ +#!/usr/bin/perl + +use strict; +use warnings; +use utf8; + +use CGI; +use Test::More; + +use lib $ENV{'SDRROOT'} . '/crms/cgi'; +use lib $ENV{'SDRROOT'} . '/crms/lib'; +use CRMS; +use CRMS::Entitlements; + +my $crms = CRMS->new(); +my $entitlements = CRMS::Entitlements->new(crms => $crms); + +require_ok($ENV{'SDRROOT'}. '/crms/cgi/Project/CrownCopyright.pm'); + +my $sql = 'SELECT id FROM projects WHERE name="Crown Copyright"'; +my $project_id = $crms->SimpleSqlGet($sql); +my $project = CrownCopyright->new(crms => $crms, id => $project_id); +ok(defined $project); + +subtest 'ValidateSubmission' => sub { + subtest 'no rights selected' => sub { + my $cgi = CGI->new; + my $err = $project->ValidateSubmission($cgi); + ok($err =~ m/rights\/reason combination/); + }; + + subtest 'Not Government category requires und/NFI' => sub { + subtest 'Not Government category with und/nfi' => sub { + my $rights = $entitlements->rights_by_attribute_reason('und', 'nfi')->{id}; + my $cgi = CGI->new; + $cgi->param('rights', $rights); + # Setting the date explicitly to empty string is needed to avoid + # "uninitialized value $date" warnings in CrownCopyright.pm. + # These can be all removed when that is fixed with a default empty string value. + $cgi->param('date', ''); + $cgi->param('category', 'Not Government'); + my $err = $project->ValidateSubmission($cgi); + ok($err !~ m/Not Government category requires/); + }; + + subtest 'Not Government category without und/nfi' => sub { + my $rights = $entitlements->rights_by_attribute_reason('ic', 'ren')->{id}; + my $cgi = CGI->new; + $cgi->param('rights', $rights); + $cgi->param('date', ''); + $cgi->param('category', 'Not Government'); + my $err = $project->ValidateSubmission($cgi); + ok($err =~ m/Not Government category requires/); + }; + }; +}; + +done_testing(); diff --git a/t/Project/SBCR.t b/t/Project/SBCR.t index e8df2c06..8134af6c 100644 --- a/t/Project/SBCR.t +++ b/t/Project/SBCR.t @@ -18,33 +18,27 @@ my $jsonxs = JSON::XS->new->utf8->canonical(1)->pretty(0); # Will be used multiple times in this test suite. my $crms = CRMS->new(); my $entitlements = CRMS::Entitlements->new(crms => $crms); -# Grab the most frequently used rights ids -my $ic_ren_rights_id = $entitlements->rights_by_attribute_reason('ic', 'ren')->{id}; -my $pd_ren_rights_id = $entitlements->rights_by_attribute_reason('pd', 'ren')->{id}; -my $ic_cdpp_rights_id = $entitlements->rights_by_attribute_reason('ic', 'cdpp')->{id}; -my $und_nfi_rights_id = $entitlements->rights_by_attribute_reason('und', 'nfi')->{id}; -my $und_ren_rights_id = $entitlements->rights_by_attribute_reason('und', 'ren')->{id}; require_ok($ENV{'SDRROOT'}. '/crms/cgi/Project/SBCR.pm'); my $sql = 'SELECT id FROM projects WHERE name="SBCR"'; my $project_id = $crms->SimpleSqlGet($sql); -my $proj = SBCR->new(crms => $crms, id => $project_id); -ok(defined $proj); +my $project = SBCR->new(crms => $crms, id => $project_id); +ok(defined $project); -subtest 'SBCR::PresentationOrder' => sub { - my $order = $proj->PresentationOrder; +subtest 'PresentationOrder' => sub { + my $order = $project->PresentationOrder; ok(!defined $order, 'does not define a presentation order'); }; -subtest 'SBCR::ReviewPartials' => sub { - ok(defined $proj->ReviewPartials, 'defines a UI ordering'); +subtest 'ReviewPartials' => sub { + ok(defined $project->ReviewPartials, 'defines a UI ordering'); }; -subtest 'SBCR::ValidateSubmission' => sub { +subtest 'ValidateSubmission' => sub { subtest 'no rights selected' => sub { my $cgi = CGI->new; - my $err = $proj->ValidateSubmission($cgi); + my $err = $project->ValidateSubmission($cgi); ok($err =~ m/rights\/reason combination/); }; @@ -54,7 +48,7 @@ subtest 'SBCR::ValidateSubmission' => sub { my $cgi = CGI->new; $cgi->param('rights', 1); $cgi->param('date', $date); - my $err = $proj->ValidateSubmission($cgi); + my $err = $project->ValidateSubmission($cgi); ok($err !~ m/date must be only decimal digits/); } }; @@ -64,7 +58,7 @@ subtest 'SBCR::ValidateSubmission' => sub { my $cgi = CGI->new; $cgi->param('rights', 1); $cgi->param('date', $date); - my $err = $proj->ValidateSubmission($cgi); + my $err = $project->ValidateSubmission($cgi); ok($err =~ m/date must be only decimal digits/); } }; @@ -72,7 +66,7 @@ subtest 'SBCR::ValidateSubmission' => sub { subtest 'no date submitted' => sub { my $cgi = CGI->new; $cgi->param('rights', 1); - my $err = $proj->ValidateSubmission($cgi); + my $err = $project->ValidateSubmission($cgi); ok($err !~ m/date must be only decimal digits/); }; }; @@ -85,15 +79,14 @@ subtest 'SBCR::ValidateSubmission' => sub { my $cgi = CGI->new; $cgi->param('rights', $rights->{id}); $cgi->param('date', 1957); - my $err = $proj->ValidateSubmission($cgi); + my $err = $project->ValidateSubmission($cgi); ok($err !~ m/must include a numeric year/); }; subtest "$rights->{name} without date" => sub { my $cgi = CGI->new; $cgi->param('rights', $rights->{id}); - #$cgi->param('date', 1957); - my $err = $proj->ValidateSubmission($cgi); + my $err = $project->ValidateSubmission($cgi); ok($err =~ m/must include a numeric year/); }; } else { @@ -101,88 +94,37 @@ subtest 'SBCR::ValidateSubmission' => sub { my $cgi = CGI->new; $cgi->param('rights', $rights->{id}); $cgi->param('date', 1957); - my $err = $proj->ValidateSubmission($cgi); + my $err = $project->ValidateSubmission($cgi); ok($err !~ m/must include a numeric year/); }; } } }; - subtest 'renewal ... has expired: volume is pd' => sub { - subtest 'ic/ren with nonexpired renewal' => sub { - my $cgi = CGI->new; - $cgi->param('rights', $ic_ren_rights_id); - $cgi->param('renNum', 'R123'); - $cgi->param('renDate', '4Jun63'); - my $err = $proj->ValidateSubmission($cgi); - ok($err !~ m/renewal .*? has expired: volume is pd/); - }; - - subtest 'ic/ren with expired renewal date' => sub { + subtest 'ic/ren must include renewal id and renewal date' => sub { + my $ic_ren_rights_id = $entitlements->rights_by_attribute_reason('ic', 'ren')->{id}; + subtest 'with renewal data' => sub { my $cgi = CGI->new; $cgi->param('rights', $ic_ren_rights_id); $cgi->param('renNum', 'R123'); $cgi->param('renDate', '4Jun23'); - my $err = $proj->ValidateSubmission($cgi); - ok($err =~ m/renewal .*? has expired: volume is pd/); - }; - - subtest 'ic/ren with unparseable renewal date' => sub { - my $cgi = CGI->new; - $cgi->param('rights', $ic_ren_rights_id); - $cgi->param('renNum', 'R123'); - $cgi->param('renDate', 'unparseable'); - my $err = $proj->ValidateSubmission($cgi); - ok($err !~ m/renewal .*? has expired: volume is pd/); + my $err = $project->ValidateSubmission($cgi); + ok($err !~ m/must include renewal id and renewal date/); }; - subtest 'ic/ren with no renewal date' => sub { + subtest 'with just renewal id' => sub { my $cgi = CGI->new; $cgi->param('rights', $ic_ren_rights_id); $cgi->param('renNum', 'R123'); - my $err = $proj->ValidateSubmission($cgi); - ok($err !~ m/renewal .*? has expired: volume is pd/); - }; - - subtest 'not ic/ren' => sub { - my $cgi = CGI->new; - $cgi->param('rights', $pd_ren_rights_id); - $cgi->param('renNum', 'R123'); - $cgi->param('renDate', '4Jun23'); - my $err = $proj->ValidateSubmission($cgi); - ok($err !~ m/renewal .*? has expired: volume is pd/); - }; - }; - - subtest 'ic/ren must include renewal id and renewal date' => sub { - my $cgi = CGI->new; - $cgi->param('rights', $ic_ren_rights_id); - my $err = $proj->ValidateSubmission($cgi); - ok($err =~ m/must include renewal id and renewal date/); - }; - - subtest 'pd/ren should not include renewal info' => sub { - subtest 'without renewal info' => sub { - my $cgi = CGI->new; - $cgi->param('rights', $pd_ren_rights_id); - my $err = $proj->ValidateSubmission($cgi); - ok($err !~ m/should not include renewal info/); - }; - - subtest 'with renNum' => sub { - my $cgi = CGI->new; - $cgi->param('rights', $pd_ren_rights_id); - $cgi->param('renNum', 'R123'); - my $err = $proj->ValidateSubmission($cgi); - ok($err =~ m/should not include renewal info/); + my $err = $project->ValidateSubmission($cgi); + ok($err =~ m/must include renewal id and renewal date/); }; - subtest 'with renDate' => sub { + subtest 'without renewal data' => sub { my $cgi = CGI->new; - $cgi->param('rights', $pd_ren_rights_id); - $cgi->param('renDate', '4Jun23'); - my $err = $proj->ValidateSubmission($cgi); - ok($err =~ m/should not include renewal info/); + $cgi->param('rights', $ic_ren_rights_id); + my $err = $project->ValidateSubmission($cgi); + ok($err =~ m/must include renewal id and renewal date/); }; }; @@ -191,7 +133,7 @@ subtest 'SBCR::ValidateSubmission' => sub { my $cgi = CGI->new; $cgi->param('rights', 1); $cgi->param('actual', '9999'); - my $err = $proj->ValidateSubmission($cgi); + my $err = $project->ValidateSubmission($cgi); ok($err !~ m/YYYY or YYYY-YYYY/); }; @@ -199,7 +141,7 @@ subtest 'SBCR::ValidateSubmission' => sub { my $cgi = CGI->new; $cgi->param('rights', 1); $cgi->param('actual', '9990-9999'); - my $err = $proj->ValidateSubmission($cgi); + my $err = $project->ValidateSubmission($cgi); ok($err !~ m/YYYY or YYYY-YYYY/); }; @@ -207,247 +149,10 @@ subtest 'SBCR::ValidateSubmission' => sub { my $cgi = CGI->new; $cgi->param('rights', 1); $cgi->param('actual', 'abcde'); - my $err = $proj->ValidateSubmission($cgi); + my $err = $project->ValidateSubmission($cgi); ok($err =~ m/YYYY or YYYY-YYYY/); }; }; - - subtest 'pd*/cdpp must not include renewal data' => sub { - foreach my $attr ('pd', 'pdus') { - my $rights = $entitlements->rights_by_attribute_reason($attr, 'cdpp')->{id}; - subtest "$attr with renewal number" => sub { - my $cgi = CGI->new; - $cgi->param('rights', $rights); - $cgi->param('renNum', 'R123'); - my $err = $proj->ValidateSubmission($cgi); - ok($err =~ m/must not include renewal info/); - }; - - subtest "$attr with renewal date" => sub { - my $cgi = CGI->new; - $cgi->param('rights', $rights); - $cgi->param('renDate', '4Jun23'); - my $err = $proj->ValidateSubmission($cgi); - ok($err =~ m/must not include renewal info/); - }; - - subtest "$attr without renewal data" => sub { - my $cgi = CGI->new; - $cgi->param('rights', $rights); - my $err = $proj->ValidateSubmission($cgi); - ok($err !~ m/must not include renewal info/); - }; - } - }; - - subtest 'pd/cdpp must include note category and note text' => sub { - my $rights = $entitlements->rights_by_attribute_reason('pd', 'cdpp')->{id}; - subtest 'with both' => sub { - my $cgi = CGI->new; - $cgi->param('rights', $rights); - $cgi->param('category', 'Edition'); - $cgi->param('note', 'This is a note'); - my $err = $proj->ValidateSubmission($cgi); - ok($err !~ m/must include note category and note text/); - }; - - subtest 'with note only' => sub { - my $cgi = CGI->new; - $cgi->param('rights', $rights); - $cgi->param('note', 'This is a note'); - my $err = $proj->ValidateSubmission($cgi); - ok($err =~ m/must include note category and note text/); - }; - - subtest 'with neither' => sub { - my $cgi = CGI->new; - $cgi->param('rights', $rights); - my $err = $proj->ValidateSubmission($cgi); - ok($err =~ m/must include note category and note text/); - }; - }; - - # NOTE: this could be merged with the pd/cdpp and pdus/cdpp logic above - subtest 'ic/cdpp must not include renewal data' => sub { - subtest 'with renewal number' => sub { - my $cgi = CGI->new; - $cgi->param('rights', $ic_cdpp_rights_id); - $cgi->param('renNum', 'R123'); - my $err = $proj->ValidateSubmission($cgi); - ok($err =~ m/must not include renewal info/); - }; - - subtest 'with renewal date' => sub { - my $cgi = CGI->new; - $cgi->param('rights', $ic_cdpp_rights_id); - $cgi->param('renDate', '4Jun23'); - my $err = $proj->ValidateSubmission($cgi); - ok($err =~ m/must not include renewal info/); - }; - }; - - # NOTE: this could be merged with the pd/cdpp and pdus/cdpp logic above - subtest 'ic/cdpp must include note category and note text' => sub { - subtest 'with both' => sub { - my $cgi = CGI->new; - $cgi->param('rights', $ic_cdpp_rights_id); - $cgi->param('category', 'Edition'); - $cgi->param('note', 'This is a note'); - my $err = $proj->ValidateSubmission($cgi); - ok($err !~ m/must include note category and note text/); - }; - - subtest 'with note only' => sub { - my $cgi = CGI->new; - $cgi->param('rights', $ic_cdpp_rights_id); - $cgi->param('note', 'This is a note'); - my $err = $proj->ValidateSubmission($cgi); - ok($err =~ m/must include note category and note text/); - }; - - subtest 'with neither' => sub { - my $cgi = CGI->new; - $cgi->param('rights', $ic_cdpp_rights_id); - my $err = $proj->ValidateSubmission($cgi); - ok($err =~ m/must include note category and note text/); - }; - }; - - subtest 'und/nfi must include note category' => sub { - subtest 'with category' => sub { - my $cgi = CGI->new; - $cgi->param('rights', $und_nfi_rights_id); - $cgi->param('category', 'Edition'); - my $err = $proj->ValidateSubmission($cgi); - ok($err !~ m/must include note category/); - }; - - subtest 'without category' => sub { - my $cgi = CGI->new; - $cgi->param('rights', $und_nfi_rights_id); - my $err = $proj->ValidateSubmission($cgi); - ok($err =~ m/must include note category/); - }; - }; - - subtest 'und/ren must have note category Inserts/No Renewal' => sub { - subtest 'with expected category' => sub { - my $cgi = CGI->new; - $cgi->param('rights', $und_ren_rights_id); - $cgi->param('category', 'Inserts/No Renewal'); - my $err = $proj->ValidateSubmission($cgi); - ok($err !~ m/mmust have note category Inserts\/No Renewal/); - }; - - subtest 'without expected category' => sub { - my $cgi = CGI->new; - $cgi->param('rights', $und_ren_rights_id); - $cgi->param('category', 'Edition'); - my $err = $proj->ValidateSubmission($cgi); - ok($err =~ m/must have note category Inserts\/No Renewal/); - }; - - subtest 'with no category' => sub { - my $cgi = CGI->new; - $cgi->param('rights', $und_ren_rights_id); - my $err = $proj->ValidateSubmission($cgi); - ok($err =~ m/must have note category /); - }; - }; - - subtest 'Inserts/No Renewal category is only used with und/ren' => sub { - subtest 'with expected rights' => sub { - my $cgi = CGI->new; - $cgi->param('rights', $und_ren_rights_id); - $cgi->param('category', 'Inserts/No Renewal'); - my $err = $proj->ValidateSubmission($cgi); - ok($err !~ m/must have rights code/); - }; - - subtest 'without expected rights' => sub { - my $cgi = CGI->new; - $cgi->param('rights', $und_nfi_rights_id); - $cgi->param('category', 'Inserts/No Renewal'); - my $err = $proj->ValidateSubmission($cgi); - ok($err =~ m/must have rights code/); - }; - }; - - subtest "note optionality" => sub { - my $note_required = $crms->SimpleSqlGet('SELECT name FROM categories WHERE need_note=1 AND interface=1 AND restricted IS NULL'); - my $note_optional = $crms->SimpleSqlGet('SELECT name FROM categories WHERE need_note=0 AND interface=1 AND restricted IS NULL'); - subtest 'category without required note' => sub { - my $cgi = CGI->new; - $cgi->param('rights', 1); - $cgi->param('category', $note_required); - my $err = $proj->ValidateSubmission($cgi); - ok($err =~ m/requires a note/); - }; - - subtest 'category with required note' => sub { - my $cgi = CGI->new; - $cgi->param('rights', 1); - $cgi->param('category', $note_required); - $cgi->param('note', 'This is a required note'); - my $err = $proj->ValidateSubmission($cgi); - ok($err !~ m/requires a note/); - }; - - subtest 'category without optional note' => sub { - my $cgi = CGI->new; - $cgi->param('rights', 1); - $cgi->param('category', $note_optional); - my $err = $proj->ValidateSubmission($cgi); - ok($err !~ m/requires a note/); - }; - - subtest 'category with required note' => sub { - my $cgi = CGI->new; - $cgi->param('rights', 1); - $cgi->param('category', $note_optional); - $cgi->param('note', 'This is an optional note'); - my $err = $proj->ValidateSubmission($cgi); - ok($err !~ m/requires a note/); - }; - }; - - subtest 'must include a category if there is a note' => sub { - subtest 'note with category' => sub { - my $cgi = CGI->new; - $cgi->param('rights', 1); - $cgi->param('note', 'This is a note'); - $cgi->param('category', 'Misc'); - my $err = $proj->ValidateSubmission($cgi); - ok($err !~ m/must include a category/); - }; - - subtest 'note without category' => sub { - my $cgi = CGI->new; - $cgi->param('rights', 1); - $cgi->param('note', 'This is a note'); - my $err = $proj->ValidateSubmission($cgi); - ok($err =~ m/must include a category/); - }; - }; - - subtest 'Not Government category requires und/NFI' => sub { - subtest 'Not Government category with und/nfi' => sub { - my $rights = $entitlements->rights_by_attribute_reason('und', 'nfi')->{id}; - my $cgi = CGI->new; - $cgi->param('rights', $rights); - $cgi->param('category', 'Not Government'); - my $err = $proj->ValidateSubmission($cgi); - ok($err !~ m/Not Government category requires/); - }; - - subtest 'Not Government category without und/nfi' => sub { - my $cgi = CGI->new; - $cgi->param('rights', $ic_ren_rights_id); - $cgi->param('category', 'Not Government'); - my $err = $proj->ValidateSubmission($cgi); - ok($err =~ m/Not Government category requires/); - }; - }; # End of ValidateSubmission subtest }; @@ -461,7 +166,7 @@ subtest 'ExtractReviewData' => sub { $cgi->param('crown', 'on'); $cgi->param('actual', '1960'); $cgi->param('approximate', 'on'); - my $extracted = $proj->ExtractReviewData($cgi); + my $extracted = $project->ExtractReviewData($cgi); is($extracted->{renNum}, 'R123'); is($extracted->{renDate}, '26Sep39'); is($extracted->{date}, '1950'); @@ -473,7 +178,7 @@ subtest 'ExtractReviewData' => sub { subtest 'with very little data' => sub { my $cgi = CGI->new; - my $extracted = $proj->ExtractReviewData($cgi); + my $extracted = $project->ExtractReviewData($cgi); is_deeply($extracted, {}); }; }; @@ -490,7 +195,7 @@ subtest 'FormatReviewData' => sub { approximate => 1 }; my $json = $jsonxs->encode($data); - my $format = $proj->FormatReviewData(1, $json); + my $format = $project->FormatReviewData(1, $json); ok($format->{format} =~ /Renewal/); ok($format->{format} =~ /ADD/); ok($format->{format} !~ /Pub/); @@ -505,7 +210,7 @@ subtest 'FormatReviewData' => sub { pub => 1 }; my $json = $jsonxs->encode($data); - my $format = $proj->FormatReviewData(1, $json); + my $format = $project->FormatReviewData(1, $json); ok($format->{format} !~ /Renewal/); ok($format->{format} !~ /ADD/); ok($format->{format} =~ /Pub/); @@ -517,7 +222,7 @@ subtest 'FormatReviewData' => sub { subtest 'with no data' => sub { my $data = {}; my $json = $jsonxs->encode($data); - my $format = $proj->FormatReviewData(1, $json); + my $format = $project->FormatReviewData(1, $json); ok($format->{format} !~ /Renewal/); ok($format->{format} !~ /ADD/); ok($format->{format} !~ /Pub/); @@ -531,39 +236,27 @@ subtest 'extract_parameters' => sub { my $cgi = CGI->new; $cgi->param('rights', 1); $cgi->param('renNum', " R12345\n"); - my $params = $proj->extract_parameters($cgi); + my $params = $project->extract_parameters($cgi); is($params->{rights}, 1, 'leaves rights unchanged'); is($params->{renNum}, 'R12345', 'strips whitespace'); }; subtest 'format_renewal_data' => sub { subtest 'with no data' => sub { - ok(length $proj->format_renewal_data(undef, undef) == 0); + ok(length $project->format_renewal_data(undef, undef) == 0); }; subtest 'with only renNum' => sub { - ok($proj->format_renewal_data('R123', undef) =~ m/R123/); + ok($project->format_renewal_data('R123', undef) =~ m/R123/); }; subtest 'with only renDate' => sub { - ok($proj->format_renewal_data(undef, '1Oct51') =~ m/1Oct51/); + ok($project->format_renewal_data(undef, '1Oct51') =~ m/1Oct51/); }; subtest 'with both renNum and renDate' => sub { - ok($proj->format_renewal_data('R123', '1Oct51') =~ m/R123/); - ok($proj->format_renewal_data('R123', '1Oct51') =~ m/1Oct51/); - }; -}; - -subtest 'renewal_date_to_year' => sub { - subtest 'with a well-formed renewal date' => sub { - my $year = $proj->renewal_date_to_year('21Sep51'); - is($year, '1951', 'extracts year'); - }; - - subtest 'with a nonsense renewal date' => sub { - my $year = $proj->renewal_date_to_year('abcde'); - is($year, '', 'returns empty string'); + ok($project->format_renewal_data('R123', '1Oct51') =~ m/R123/); + ok($project->format_renewal_data('R123', '1Oct51') =~ m/1Oct51/); }; }; From b90cbb0f7a1ece21ce4b206a22e0ea3dfd0bfeca Mon Sep 17 00:00:00 2001 From: Moses Hall Date: Fri, 31 Oct 2025 15:35:38 -0400 Subject: [PATCH 13/25] Remove redundant call to crms.Rights --- cgi/partial/sbcr_form.tt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cgi/partial/sbcr_form.tt b/cgi/partial/sbcr_form.tt index 5e902e65..3af3881a 100644 --- a/cgi/partial/sbcr_form.tt +++ b/cgi/partial/sbcr_form.tt @@ -120,7 +120,7 @@ -[% rights = crms.Rights(htid, 1) %] +
[% INCLUDE partial/rights.tt %] From d50ce627bd28a94a267438f39ec3c5ab902ac35f Mon Sep 17 00:00:00 2001 From: Moses Hall Date: Fri, 31 Oct 2025 15:36:32 -0400 Subject: [PATCH 14/25] Add `use CRMS::Entitlements` to SBCR.pm --- cgi/Project/SBCR.pm | 3 +++ 1 file changed, 3 insertions(+) diff --git a/cgi/Project/SBCR.pm b/cgi/Project/SBCR.pm index 60e14732..291d2cd1 100644 --- a/cgi/Project/SBCR.pm +++ b/cgi/Project/SBCR.pm @@ -4,6 +4,9 @@ use parent 'Project'; use strict; use warnings; +use lib $ENV{'SDRROOT'} . '/crms/lib'; +use CRMS::Entitlements; + sub new { my $class = shift; return $class->SUPER::new(@_); From 7c5f9418f12328bc17b2df1d28f4def404c11a38 Mon Sep 17 00:00:00 2001 From: Moses Hall Date: Fri, 31 Oct 2025 16:17:40 -0400 Subject: [PATCH 15/25] - Fix copypasta in JS popRenewalDate function that fortunately should not have led to aberrant behavior - Add comment about the rights way to do the rights <-> id mapping in JS code --- web/js/review.js | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/web/js/review.js b/web/js/review.js index 6d9c286b..92f89e4d 100644 --- a/web/js/review.js +++ b/web/js/review.js @@ -51,12 +51,16 @@ function popRenewalDate() { var icren = document.getElementById('ICREN'); var pdusren = document.getElementById('PDUSREN'); + // TODO: this is a really clunky way of making the mapping from rights name -> + // rights id (and ultimately the radio button with that id value) available to JavaScript. + // Ideally, review.tt should query Entitlements.pm and construct JSON with name -> id map + // as a global variable. var icrenButton, pdusrenButton; if (icren) { icrenButton = document.getElementById("r" + icren.title); } - if (icren) + if (pdusren) { pdusrenButton = document.getElementById("r" + pdusren.title); } From 5858598876bc69e4a44a81a762b7a97f16af6475 Mon Sep 17 00:00:00 2001 From: Moses Hall Date: Fri, 31 Oct 2025 16:46:03 -0400 Subject: [PATCH 16/25] Add notes on how to reuse rights.tt --- cgi/partial/rights.tt | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/cgi/partial/rights.tt b/cgi/partial/rights.tt index 69bf4865..53209647 100644 --- a/cgi/partial/rights.tt +++ b/cgi/partial/rights.tt @@ -1,4 +1,8 @@ +[% # Note: before trying to use this with projects other than SBCR, need to add a prediction loader in the after Rights/Reason %] +[% # and modify the JS togglePredictionLoader() routine to take an id parameter. %] +[% # SBCR has a prediction loader for the renDate so we need to trigger a loader by id instead of %] +[% # assuming there will only be one loader per operational pane, and its id will be "predictionLoader" %] [% rights = crms.Rights(htid, 1) %]
From 08e5eb234ba7bcdb076e22623df0a1d7683388a3 Mon Sep 17 00:00:00 2001 From: Moses Hall Date: Fri, 31 Oct 2025 16:46:40 -0400 Subject: [PATCH 17/25] Remove prediction loader img left over from Commonwealth UI and effectively commented out --- cgi/partial/copyrightForm.tt | 8 +------- 1 file changed, 1 insertion(+), 7 deletions(-) diff --git a/cgi/partial/copyrightForm.tt b/cgi/partial/copyrightForm.tt index 4eddcdf7..86193534 100644 --- a/cgi/partial/copyrightForm.tt +++ b/cgi/partial/copyrightForm.tt @@ -74,13 +74,7 @@ - + [% WHILE n < of %] From 2ac6638a7bcceae96bd3b5325b3b2bfe0e318838 Mon Sep 17 00:00:00 2001 From: Moses Hall Date: Fri, 31 Oct 2025 17:13:50 -0400 Subject: [PATCH 18/25] - Extract out the notes category menu and textarea into its own
partial used by SBCR - Should be usable by other projects by swapping in an `INCLUDE` in each project's main form --- cgi/partial/notes.tt | 12 ++++++++++++ cgi/partial/sbcr_form.tt | 13 +------------ web/css/review.css | 11 +++++++++++ 3 files changed, 24 insertions(+), 12 deletions(-) create mode 100644 cgi/partial/notes.tt diff --git a/cgi/partial/notes.tt b/cgi/partial/notes.tt new file mode 100644 index 00000000..b1e4805a --- /dev/null +++ b/cgi/partial/notes.tt @@ -0,0 +1,12 @@ +
+ + + + . +
diff --git a/cgi/partial/sbcr_form.tt b/cgi/partial/sbcr_form.tt index 3af3881a..de9f8017 100644 --- a/cgi/partial/sbcr_form.tt +++ b/cgi/partial/sbcr_form.tt @@ -123,19 +123,8 @@
[% INCLUDE partial/rights.tt %] + [% INCLUDE partial/notes.tt %] -
- - - - . -
Rights/Reason: - [% IF !ren %] - - [% END %] -
diff --git a/web/css/review.css b/web/css/review.css index a19e5809..257410fc 100644 --- a/web/css/review.css +++ b/web/css/review.css @@ -207,6 +207,9 @@ table.ReviewError { font-size:12px; } +/* + FIXME: remove the #Notes styles when all review interfaces are using .note-container class +*/ #Notes { margin-left:10px; } @@ -215,6 +218,14 @@ table.ReviewError { margin-block-start: 5px; } +.note-container { + margin-left:10px; +} + +.note-container textarea { + margin-block-start: 5px; +} + #SubmitForm { margin-block-start: 8px; } From 60d351c0668d1b815f6ff172ca6f345cf0629073 Mon Sep 17 00:00:00 2001 From: Moses Hall Date: Mon, 3 Nov 2025 12:45:38 -0500 Subject: [PATCH 19/25] Split user review data import logic off into import_user.tt partial --- cgi/partial/import_user.tt | 32 ++++++++++++++++++++++++++++++++ cgi/partial/sbcr_form.tt | 27 +-------------------------- 2 files changed, 33 insertions(+), 26 deletions(-) create mode 100644 cgi/partial/import_user.tt diff --git a/cgi/partial/import_user.tt b/cgi/partial/import_user.tt new file mode 100644 index 00000000..319bbcc9 --- /dev/null +++ b/cgi/partial/import_user.tt @@ -0,0 +1,32 @@ +[% # When an expert is adjudicating a conflict, make it possible to import user-entered data %] +[% # rather than manually entering it (though there is that option if expert needs to add or modify %] + +[% IF expert && importUser %] + [% reviews = data.reviews %] + [% IF reviews.keys.size %] +
+ + + + [% FOREACH user IN reviews.keys.sort %] + + + + + [% END %] +
+
+ Import user review: +
+ 		+ [% # Note there is no JS that actually causes this image to be displayed %] + [% # Since importing user review data is just a matter of swapping in local JSON data %] + [% # It would probably be safe to remove this %] + +
+
+ [% END %] +[% END %] \ No newline at end of file diff --git a/cgi/partial/sbcr_form.tt b/cgi/partial/sbcr_form.tt index de9f8017..b5eda3d6 100644 --- a/cgi/partial/sbcr_form.tt +++ b/cgi/partial/sbcr_form.tt @@ -167,32 +167,7 @@ - [% IF expert && importUser %] - [% reviews = data.reviews %] - [% IF reviews.keys.size %] - - - - - [% FOREACH user IN reviews.keys.sort %] - - - - - [% END %] -
-
- Import user review: -
- 		- -
-
- [% END %] - [% END %] + [% INCLUDE partial/import_user.tt %]
From 19067cbb9218711407418708ea1be35ceb674b35 Mon Sep 17 00:00:00 2001 From: Moses Hall Date: Mon, 3 Nov 2025 13:24:32 -0500 Subject: [PATCH 20/25] Experiment: use attr/reason descriptions from ht_rights rather than our own poorly maintained version --- cgi/CRMS.pm | 6 ++++-- cgi/partial/rights.tt | 10 ++++------ 2 files changed, 8 insertions(+), 8 deletions(-) diff --git a/cgi/CRMS.pm b/cgi/CRMS.pm index ee15408a..3927b308 100755 --- a/cgi/CRMS.pm +++ b/cgi/CRMS.pm @@ -7279,7 +7279,8 @@ sub Rights my $proj = $self->SimpleSqlGet('SELECT project FROM queue WHERE id=?', $id); $proj = 1 unless defined $proj; my @all = (); - my $sql = 'SELECT r.id,CONCAT(a.name,"/",rs.name),r.description,a.name,rs.name FROM rights r'. + my $sql = 'SELECT r.id,CONCAT(a.name,"/",rs.name),r.description,a.name,rs.name,a.dscr,rs.dscr'. + ' FROM rights r'. ' INNER JOIN attributes a ON r.attr=a.id'. ' INNER JOIN reasons rs ON r.reason=rs.id'. ' INNER JOIN projectrights pr ON r.id=pr.rights'. @@ -7293,7 +7294,8 @@ sub Rights { push @all, {'id' => $row->[0], 'rights' => $row->[1], 'description' => $row->[2], 'n' => $n, - 'attr' => $row->[3], 'reason' => $row->[4]}; + 'attr' => $row->[3], 'reason' => $row->[4], + 'attr_dscr' => $row->[5], 'reason_dscr' => $row->[6]}; $n++; } return \@all if $order; diff --git a/cgi/partial/rights.tt b/cgi/partial/rights.tt index 53209647..269b165d 100644 --- a/cgi/partial/rights.tt +++ b/cgi/partial/rights.tt @@ -9,13 +9,11 @@ Rights/Reason Help - [% asterisk = 0 %] + [% # This is an experimental version of the "rights reference" tooltip which uses %] + [% # attr/reason descriptions from ht_rights rather than our own, which are not well %] + [% # maintained and contain many blanks. Do we need specialized CRMS rights descriptions? %] [% FOR right IN rights %] - [% right.rights %] - [% right.description %]
- [% IF right.description.search('\*') %][% asterisk = 1 %][% END %] - [% END %] - [% IF asterisk %] -
* if no publication date listed on piece, use copyright date + [% right.rights %] - [% right.attr_dscr %] / [% right.reason_dscr %]
[% END %] From 75f0cec1f7aa643441bd5630915e67c010326a6d Mon Sep 17 00:00:00 2001 From: Moses Hall Date: Mon, 3 Nov 2025 14:29:45 -0500 Subject: [PATCH 21/25] - Add CRMS.pm `array_to_pairs` utility to simplify logic in rights.tt partial --- cgi/CRMS.pm | 26 ++++++++++++++++++++++ cgi/partial/rights.tt | 51 +++++++++++++++++++++++-------------------- t/CRMS.t | 12 ++++++++++ 3 files changed, 65 insertions(+), 24 deletions(-) diff --git a/cgi/CRMS.pm b/cgi/CRMS.pm index 3927b308..02fe287b 100755 --- a/cgi/CRMS.pm +++ b/cgi/CRMS.pm @@ -8021,4 +8021,30 @@ sub Field008Formatter { CRMS::Field008Formatter->new; } +# TODO: move to a Utilities class or module. +# This is only used with output of CRMS::Rights for the rights.tt partial. +sub array_to_pairs { + my $self = shift; + my $array = shift; + + my $pairs = []; + if (!scalar @$array) { + return $pairs; + } + foreach my $element (@$array) { + # If there is nothing in the pairs list, or if the last entry contains two elements, add a new one-item pair + # Otherwise add second pair to last element + if (scalar @$pairs == 0 || scalar @{$pairs->[-1]} == 2) { + push @$pairs, [$element]; + } else { + push @{$pairs->[-1]}, $element; + } + } + # Final non-pair in case of odd array, [x] -> [x, undef] + if (scalar @{$pairs->[-1]} == 1) { + push @{$pairs->[-1]}, undef; + } + return $pairs; +} + 1; diff --git a/cgi/partial/rights.tt b/cgi/partial/rights.tt index 269b165d..1fa48a9b 100644 --- a/cgi/partial/rights.tt +++ b/cgi/partial/rights.tt @@ -11,42 +11,45 @@ [% # This is an experimental version of the "rights reference" tooltip which uses %] [% # attr/reason descriptions from ht_rights rather than our own, which are not well %] - [% # maintained and contain many blanks. Do we need specialized CRMS rights descriptions? %] + [% # maintained and contain many blanks. %] + [% # KH says: we do not need specialized CRMS rights descriptions. %] + [% # When projects other than SBCR begin to use this, the `description` column from %] + [% # the `crms.rights` table can be removed %] [% FOR right IN rights %] [% right.rights %] - [% right.attr_dscr %] / [% right.reason_dscr %]
[% END %]
- [% rights = crms.Rights(htid) %] - [% of = rights.size() %] - [% n = 0 %] - + [% # TODO: the rights structure is needed by every project. %] + [% # We should provide it to the templates and let them derive layouts as needed %] + [% # e.g., convert to two columns, convert to pairs, via utility routines %] + [% rights = crms.array_to_pairs(crms.Rights(htid)) %] +
- [% WHILE n < of %] + [% FOREACH rights_pair IN rights %] - [% right = rights.$n %] - - [% n = n + 1 %] - + [% right = rights_pair.0 %] + + + - [% n = n + 1 %] [% END %]
Rights/Reason:
- - - - [% IF n < of %] - [% right = rights.$n %] - - - [% END %] - + + + + [% right = rights_pair.1 %] + [% IF right %] + + + [% END %] +
diff --git a/t/CRMS.t b/t/CRMS.t index ec53d81e..cb85b147 100755 --- a/t/CRMS.t +++ b/t/CRMS.t @@ -173,4 +173,16 @@ subtest '#Field008Formatter' => sub { isa_ok $crms->Field008Formatter, "CRMS::Field008Formatter"; }; +subtest '#Field008Formatter' => sub { + isa_ok $crms->Field008Formatter, "CRMS::Field008Formatter"; +}; + +subtest 'array_to_pairs' => sub { + is_deeply($crms->array_to_pairs([]), [], 'no elements'); + is_deeply($crms->array_to_pairs([1]), [[1, undef]], 'one element'); + is_deeply($crms->array_to_pairs([1, 2]), [[1, 2]], 'two elements'); + is_deeply($crms->array_to_pairs([1, 2, 3]), [[1, 2], [3, undef]], 'three elements'); + is_deeply($crms->array_to_pairs([1, 2, 3, 4]), [[1, 2], [3, 4]], 'four elements'); +}; + done_testing(); From ebced9ee222b3e022f1d8431d6b4481fa352dc08 Mon Sep 17 00:00:00 2001 From: Moses Hall Date: Mon, 3 Nov 2025 14:42:43 -0500 Subject: [PATCH 22/25] Make CRMS::array_to_pairs comments clearer --- cgi/CRMS.pm | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/cgi/CRMS.pm b/cgi/CRMS.pm index 02fe287b..13529100 100755 --- a/cgi/CRMS.pm +++ b/cgi/CRMS.pm @@ -8022,6 +8022,8 @@ sub Field008Formatter { } # TODO: move to a Utilities class or module. +# Right now the partials do not have access to the Utilities module directly +# so until that gets refactored keep this here so it can be used in a template. # This is only used with output of CRMS::Rights for the rights.tt partial. sub array_to_pairs { my $self = shift; @@ -8032,8 +8034,8 @@ sub array_to_pairs { return $pairs; } foreach my $element (@$array) { - # If there is nothing in the pairs list, or if the last entry contains two elements, add a new one-item pair - # Otherwise add second pair to last element + # If there is nothing in the pairs list, or if the last entry contains two elements, add a new one-item arrayref. + # Otherwise add as the second half of the pair under construction. if (scalar @$pairs == 0 || scalar @{$pairs->[-1]} == 2) { push @$pairs, [$element]; } else { From 9f4bd850b4a3ed86770c5f61461156adc12e1019 Mon Sep 17 00:00:00 2001 From: Moses Hall Date: Tue, 11 Nov 2025 12:37:48 -0500 Subject: [PATCH 23/25] Save and restore SBCR project ADD value when pub date checkbox is toggled so user-entered data is not lost. --- cgi/partial/sbcr_form.tt | 30 +++++++++++++++++++++++++++--- 1 file changed, 27 insertions(+), 3 deletions(-) diff --git a/cgi/partial/sbcr_form.tt b/cgi/partial/sbcr_form.tt index b5eda3d6..d773a36b 100644 --- a/cgi/partial/sbcr_form.tt +++ b/cgi/partial/sbcr_form.tt @@ -173,6 +173,9 @@