diff --git a/Dockerfile b/Dockerfile index 180ada9..f19feba 100644 --- a/Dockerfile +++ b/Dockerfile @@ -20,7 +20,9 @@ RUN apt-get update && apt-get install -y \ libmarc-xml-perl \ libmariadb-dev \ libnet-ssleay-perl \ + libtest-exception-perl \ libtest-output-perl \ + libtest-simple-perl \ libwww-perl \ libxml-libxml-perl \ libyaml-libyaml-perl \ diff --git a/bin/populate_rights_data.pl b/bin/populate_rights_data.pl index edf8076..5eaae0a 100755 --- a/bin/populate_rights_data.pl +++ b/bin/populate_rights_data.pl @@ -21,39 +21,109 @@ my $PRIORITY_COPYRIGHT = 3; my $PRIORITY_ACCESS = 4; my $PRIORITY_MAN = 5; + +use constant { + HARVARD_CUTOFF_DATE => '2025-03-24' +}; + my $exit = 0; -my $priorities = { - $PRIORITY_BIB => [qw(ic/bib und/bib pd/bib pdus/bib)], - $PRIORITY_GFV => [qw(pdus/gfv)], - $PRIORITY_COPYRIGHT => [qw(ic/unp pd/ncn pdus/ncn pdus/crms pd/ren pdus/ren - ic/ren und/nfi pd/cdpp ic/cdpp pdus/cdpp ic/add pdus/add pd/add pd/exp - icus/gatt icus/ren op/ipma ic/ipma und/ipma und/ren ic/crms pd/crms - und/crms)], - $PRIORITY_ACCESS => [qw(ic-world/con und-world/con nobody/pvt cc-by-3.0/con - cc-by-4.0/con cc-by-nd-3.0/con cc-by-nd-4.0/con orph/ddd orphcand/ddd - cc-by-nc-3.0/con cc-by-nc-4.0/con cc-by-sa-3.0/con cc-by-sa-4.0/con - cc-by-nc-nd-3.0/con cc-by-nc-nd-4.0/con cc-by-nc-sa-3.0/con - cc-by-nc-sa-4.0/con cc-zero/con pd/con)], - $PRIORITY_MAN => [qw(pd/man pdus/man ic-world/man und-world/man ic/man - nobody/man nobody/del pd-pvt/pvt supp/supp cc-by-3.0/man cc-by-4.0/man - cc-by-nd-3.0/man cc-by-nd-4.0/man cc-by-nc-3.0/man cc-by-nc-4.0/man - cc-by-sa-3.0/man cc-by-sa-4.0/man cc-by-nc-nd-3.0/man cc-by-nc-nd-4.0/man - cc-by-nc-sa-3.0/man cc-by-nc-sa-4.0/man cc-zero/man)], +my $attr_reason_priorities = { + 'ic/bib' => $PRIORITY_BIB, + 'pd/bib' => $PRIORITY_BIB, + 'pdus/bib' => $PRIORITY_BIB, + 'und/bib' => $PRIORITY_BIB, + + 'pdus/gfv' => $PRIORITY_GFV, + + 'ic/add' => $PRIORITY_COPYRIGHT, + 'ic/cdpp' => $PRIORITY_COPYRIGHT, + 'ic/crms' => $PRIORITY_COPYRIGHT, + 'ic/ipma' => $PRIORITY_COPYRIGHT, + 'ic/ren' => $PRIORITY_COPYRIGHT, + 'ic/unp' => $PRIORITY_COPYRIGHT, + 'icus/gatt' => $PRIORITY_COPYRIGHT, + 'icus/ren' => $PRIORITY_COPYRIGHT, + 'op/ipma' => $PRIORITY_COPYRIGHT, + 'pd/add' => $PRIORITY_COPYRIGHT, + 'pd/cdpp' => $PRIORITY_COPYRIGHT, + 'pd/crms' => $PRIORITY_COPYRIGHT, + 'pd/exp' => $PRIORITY_COPYRIGHT, + 'pd/ncn' => $PRIORITY_COPYRIGHT, + 'pd/ren' => $PRIORITY_COPYRIGHT, + 'pdus/add' => $PRIORITY_COPYRIGHT, + 'pdus/cdpp' => $PRIORITY_COPYRIGHT, + 'pdus/crms' => $PRIORITY_COPYRIGHT, + 'pdus/ncn' => $PRIORITY_COPYRIGHT, + 'pdus/ren' => $PRIORITY_COPYRIGHT, + 'und/crms' => $PRIORITY_COPYRIGHT, + 'und/ipma' => $PRIORITY_COPYRIGHT, + 'und/nfi' => $PRIORITY_COPYRIGHT, + 'und/ren' => $PRIORITY_COPYRIGHT, + + 'cc-by-3.0/con' => $PRIORITY_ACCESS, + 'cc-by-nd-3.0/con' => $PRIORITY_ACCESS, + 'cc-by-sa-3.0/con' => $PRIORITY_ACCESS, + 'cc-by-nc-3.0/con' => $PRIORITY_ACCESS, + 'cc-by-nc-nd-3.0/con' => $PRIORITY_ACCESS, + 'cc-by-nc-sa-3.0/con' => $PRIORITY_ACCESS, + 'cc-by-4.0/con' => $PRIORITY_ACCESS, + 'cc-by-nd-4.0/con' => $PRIORITY_ACCESS, + 'cc-by-sa-4.0/con' => $PRIORITY_ACCESS, + 'cc-by-nc-4.0/con' => $PRIORITY_ACCESS, + 'cc-by-nc-nd-4.0/con' => $PRIORITY_ACCESS, + 'cc-by-nc-sa-4.0/con' => $PRIORITY_ACCESS, + 'cc-zero/con' => $PRIORITY_ACCESS, + 'ic-world/con' => $PRIORITY_ACCESS, + 'nobody/pvt' => $PRIORITY_ACCESS, + 'pd/con' => $PRIORITY_ACCESS, + 'und-world/con' => $PRIORITY_ACCESS, + + 'cc-by-3.0/man' => $PRIORITY_MAN, + 'cc-by-4.0/man' => $PRIORITY_MAN, + 'cc-by-nc-3.0/man' => $PRIORITY_MAN, + 'cc-by-nc-4.0/man' => $PRIORITY_MAN, + 'cc-by-nc-nd-3.0/man' => $PRIORITY_MAN, + 'cc-by-nc-nd-4.0/man' => $PRIORITY_MAN, + 'cc-by-nc-sa-3.0/man' => $PRIORITY_MAN, + 'cc-by-nc-sa-4.0/man' => $PRIORITY_MAN, + 'cc-by-nd-3.0/man' => $PRIORITY_MAN, + 'cc-by-nd-4.0/man' => $PRIORITY_MAN, + 'cc-by-sa-3.0/man' => $PRIORITY_MAN, + 'cc-by-sa-4.0/man' => $PRIORITY_MAN, + 'cc-zero/man' => $PRIORITY_MAN, + 'ic-world/man' => $PRIORITY_MAN, + 'ic/man' => $PRIORITY_MAN, + 'nobody/del' => $PRIORITY_MAN, + 'nobody/man' => $PRIORITY_MAN, + 'pd-pvt/pvt' => $PRIORITY_MAN, + 'pd/man' => $PRIORITY_MAN, + 'pdus/man' => $PRIORITY_MAN, + 'supp/supp' => $PRIORITY_MAN, + 'und-world/man' => $PRIORITY_MAN, }; # prepared statements my $dbh = undef; +my $rights_current_sth = undef; my $insert_sth = undef; -my $attr_sth = undef; -my $reason_sth = undef; -my $source_sth = undef; +my $access_profile_for_source_sth = undef; my $queue_update_sth = undef; +my $scan_date_sth = undef; + +my $attribute_names = {}; +my $reason_names = {}; +my $source_names = {}; +my $access_profile_names = {}; + +my $attribute_ids = {}; +my $reason_ids = {}; +my $source_ids = {}; +my $access_profile_ids = {}; # Command line args my $data = 0; my $note = undef; -my $new_source_cmdline = 'null'; my $force_override = 0; my $mock_tracker = 0; @@ -64,450 +134,450 @@ my $archive = $config->{rights}->{archive}; my $rights_dir = $config->{rights}->{rights_dir}; -# allow overriding some of the vars set by yaml config -# with commandline options. -GetOptions( +my $thisprog = 'populate_rights_data'; + +# global state +my $tracker = undef; + +my $user = `whoami`; +chomp($user); + +# Structure to keep track of results - which records were created. +my %results; + +### TODO +# * clean up the nested conditionals +# * object-orientify -- rights file, rights line + +sub main { + + # allow overriding some of the vars set by yaml config + # with commandline options. + GetOptions( 'data=s' => \$data, 'archive=s' => \$archive, 'rights_dir=s' => \$rights_dir, 'note=s' => \$note, - 'source=s' => \$new_source_cmdline, 'force-override!' => \$force_override, 'mock-tracker!' => \$mock_tracker, -) or pod2usage(); + ) or pod2usage(); -# pass in --mock-tracker to disable ProgressTracker (for dev/test purposes). -my $tracker = $mock_tracker ? MockTracker->new() : ProgressTracker->new(report_interval => '10000'); + # pass in --mock-tracker to disable ProgressTracker (for dev/test purposes). + $tracker = $mock_tracker ? MockTracker->new() : ProgressTracker->new(report_interval => '10000'); -my $thisprog = 'populate_rights_data'; -print "$thisprog -INFO- START: " . CORE::localtime() . "\n"; + print "$thisprog -INFO- START: " . CORE::localtime() . "\n"; -if ($force_override and not defined $note) { + if ($force_override and not defined $note) { print "You must provide a note (with --note) with the --force-override option.\n"; exit 1; -} - -if ($force_override) { - print <finish(); $dbh->disconnect(); # Print results print "Results:\n"; # TODO: Export these result metrics -- right now we only export a metric for lines processed if(defined $results{'inserted'}) { - print " Rows inserted: " . @{$results{'inserted'}} . "\n"; + print " Rows inserted: " . @{$results{'inserted'}} . "\n"; } if ($force_override) { - export_barcodes($results{'inserted'}) + export_barcodes($results{'inserted'}) } if (defined $results{'skipped'}) { - print " Items skipped (manually set): " . @{$results{'skipped'}} . "\n"; - foreach (@{$results{'skipped'}}) { - print "\t$_\n"; - } + print " Items skipped (manually set): " . @{$results{'skipped'}} . "\n"; + foreach (@{$results{'skipped'}}) { + print "\t$_\n"; + } } if (defined $results{'already_in_db'}) { - print " Items skipped (already in database with same attribute and reason): " . @{$results{'already_in_db'}} . "\n"; - foreach (@{$results{'already_in_db'}}) { - print "\t$_\n"; - } + print " Items skipped (already in database with same attribute and reason): " . @{$results{'already_in_db'}} . "\n"; + foreach (@{$results{'already_in_db'}}) { + print "\t$_\n"; + } } print "$thisprog -INFO- Done\n"; -} else { + } else { print "$thisprog -INFO- No rights files to process.\n"; + } + $tracker->finalize; +} + +sub load_table { + $dbh ||= Database::get_rights_rw_dbh(); + + my ($table, $names, $ids) = @_; + + foreach my $row ( @{ $dbh->selectall_arrayref("select id, name from $table") } ) { + my ($id, $name) = @$row; + $names->{$id} = $name; + $ids->{$name} = $id; + } } -$tracker->finalize; + +sub load_tables { + $dbh ||= Database::get_rights_rw_dbh(); + + load_table('attributes',$attribute_names,$attribute_ids); + load_table('reasons',$reason_names,$reason_ids); + load_table('sources',$source_names,$source_ids); + load_table('access_profiles',$access_profile_names,$access_profile_ids); +}; sub prepare_statements { - # Prepare SQL statements - my $replace_sql = "REPLACE INTO rights_current (namespace, id, attr, reason, source, access_profile, user, note) VALUES (?, ?, ?, ?, ?, ?, ?, ?)"; - $insert_sth = $dbh->prepare($replace_sql) || die("$thisprog -ERR- Database error: " . $dbh->errstr()); + $dbh ||= Database::get_rights_rw_dbh(); + # Prepare SQL statements + my $replace_sql = "REPLACE INTO rights_current (namespace, id, attr, reason, source, access_profile, user, note) VALUES (?, ?, ?, ?, ?, ?, ?, ?)"; + $insert_sth = $dbh->prepare($replace_sql); - my $reason_sql = "SELECT name FROM reasons WHERE id = (SELECT reason FROM rights_current WHERE namespace = ? AND id = ?)"; - $reason_sth = $dbh->prepare($reason_sql) || die ("$thisprog -ERR- Database error: " . $dbh->errstr()); + $rights_current_sth = $dbh->prepare("SELECT * FROM rights_current WHERE namespace = ? AND id = ?"); - my $attr_sql = "SELECT name FROM attributes WHERE id = (SELECT attr FROM rights_current WHERE namespace = ? AND id = ?)"; - $attr_sth = $dbh->prepare($attr_sql) || die("$thisprog -ERR- Database error: " . $dbh->errstr()); + $access_profile_for_source_sth = $dbh->prepare("SELECT ap.name FROM sources s, access_profiles ap WHERE s.access_profile = ap.id AND s.name = ?"); - my $source_sql = "SELECT name FROM sources WHERE id = (SELECT source FROM rights_current WHERE namespace = ? AND id = ?)"; - $source_sth = $dbh->prepare($source_sql) || die("$thisprog -ERR- Database error: " . $dbh->errstr()); + # To consider moving this to an event-based thing at some point, but for + # now we reach our tendrils into somebody else's database table... + my $queue_update_sql = "UPDATE ht.feed_queue SET status = 'done' WHERE + namespace = ? and id = ? AND status = 'rights'"; + $queue_update_sth = $dbh->prepare($queue_update_sql); + + $scan_date_sth = $dbh->prepare("SELECT DATE(scan_date) FROM feed_grin WHERE namespace = ? and id = ?"); - # To consider moving this to an event-based thing at some point, but for - # now we reach our tendrils into somebody else's database table... - my $queue_update_sql = "UPDATE ht.feed_queue SET status = 'done' WHERE - namespace = ? and id = ? AND status = 'rights'"; - $queue_update_sth = $dbh->prepare($queue_update_sql) || die("$thisprog -ERR- Database error: " . $dbh->errstr()); } sub process_file { - my $file = shift; - - # Open input file, Loop through lines of input file - open(IN, '<:encoding(UTF-8)', $file) or die("$thisprog -ERR- Could not open $file for reading: $!"); - while (my $line = ) { - process_rights_line($line); - $tracker->inc(); + my $file = shift; + + # Open input file, Loop through lines of input file + open(IN, '<:encoding(UTF-8)', $file) or die("$thisprog -ERR- Could not open $file for reading: $!"); + while (my $line = ) { + process_rights_line($line); + $tracker->inc(); + } + close(IN); + + if ($archive) { + # After populating rights database from *.rights file(s), + # move file(s) to archive directory. + + my $cmd = "cp $file $archive"; + if (!$data) { + $cmd = "mv $file $archive"; } - close(IN); - - if ($archive) { - # After populating rights database from *.rights file(s), - # move file(s) to archive directory. - my $cmd = "cp $file $archive"; - if (!$data) { - $cmd = "mv $file $archive"; - } - - if (my $res = `$cmd`) { - die("Error moving/copying rights file to archive: $res"); - } + if (my $res = `$cmd`) { + die("Error moving/copying rights file to archive: $res"); } + } } sub process_rights_line { - my $line = shift; - - chomp($line); - - # get rid of trailing tab - $line =~ s/\t$//; + my $line = shift; + + chomp($line); + + # get rid of trailing tab + $line =~ s/\t$//; + + # Format of line had better be: + # + # namespace.barcode attribute reason username source note + # + # ... where any of those fields can contain the string + # /null/i to default to default values. + # Also, the line could contain less than those fields, + # like just 'barcode attribute reason username', + # in which case 'source' will be the default value. + + my ($namespace_and_barcode, $new_attr, $new_reason, $uniqname, $new_source, $new_note) = split("\t", $line); + + if (defined $namespace_and_barcode && $namespace_and_barcode !~ /\bnull\b/i) { + $namespace_and_barcode =~ s/\"//g; + } else { + die("namespace and barcode missing from input: $namespace_and_barcode"); + } + + # The ? is needed right where it is in the regex below + # (greedy matching - so the namespace will be everything up to the first period). + $namespace_and_barcode =~ /(.+?)\.(.+)/ || die("Invalid namespace/barcode: $namespace_and_barcode"); + my $namespace = $1; + my $barcode = $2; + + # attribute is required + die("attribute missing from input") unless defined $new_attr && $new_attr !~ /\bnull\b/i; + $new_attr =~ s/\"//g; + my $attribute = $attribute_ids->{$new_attr}; + die("Invalid attribute: $new_attr ($barcode)") unless defined $attribute; + + # reason has a default + $new_reason = 'bib' unless defined $new_reason && $new_reason !~ /\bnull\b/i; + $new_reason =~ s/\"//g; + my $reason = $reason_ids->{$new_reason}; + die("Invalid reason: $new_reason ($barcode)") unless defined $reason; + + if (defined $uniqname && $uniqname !~ /\bnull\b/i) { + $uniqname =~ s/\"//g; + + if ($uniqname =~ /\W/) { + die("Invalid user: $uniqname for $namespace.$barcode"); + } - # Format of line had better be: - # - # namespace.barcode attribute reason username source note - # - # ... where any of those fields can contain the string - # /null/i to default to default values. - # Also, the line could contain less than those fields, - # like just 'barcode attribute reason username', - # in which case 'source' will be the default value. + $user = $uniqname; + } else { + # the default was set above + } - my ($namespace_and_barcode, $new_attr, $new_reason, $uniqname, $new_source, $new_note) = split("\t", $line); - if (defined $namespace_and_barcode && $namespace_and_barcode !~ /\bnull\b/i) { - $namespace_and_barcode =~ s/\"//g; - } else { - die("namespace and barcode missing from input: $namespace_and_barcode"); + if (defined $new_note && $new_note !~ /\bnull\b/i) { + if (defined $note && $note && $note ne $new_note) { + die("Command-line note conflicts with .rights note ($barcode)"); } - - # The ? is needed right where it is in the regex below - # (greedy matching - so the namespace will be everything up to the first period). - $namespace_and_barcode =~ /(.+?)\.(.+)/ || die("Invalid namespace/barcode: $namespace_and_barcode"); - my $namespace = $1; - my $barcode = $2; - - my $attribute; - if (defined $new_attr && $new_attr !~ /\bnull\b/i) { - $new_attr =~ s/\"//g; - - # Make sure attribute is a valid attribute in the db - my $hr = $dbh->selectcol_arrayref("SELECT id FROM attributes WHERE name = '$new_attr'"); - if (! defined $$hr[0]) { - die("Invalid attribute: $attribute ($barcode)"); - } else { - $attribute = $$hr[0]; - } + } else { + $new_note = $note; + } + + my ($old_attr, $old_reason, $old_source, $old_access_profile) = get_old_rights($namespace, $barcode); + + my $final_new_source = final_new_source($namespace, $barcode, $old_source, $new_source); + my $new_access_profile = get_access_profile($namespace, $barcode, $final_new_source, $new_attr); + + my $source = $source_ids->{$final_new_source}; + die("Invalid source: $final_new_source ($namespace.$barcode)") if not defined $source; + + my $access_profile = $access_profile_ids->{$new_access_profile}; + die("Invalid access profile: $new_access_profile ($namespace.$barcode)") if not defined $access_profile; + + my $do_insert = 0; + + if (defined $old_reason && defined $old_attr) { + # If the new reason, attribute and source are the same as the most + # recent ones, ignore at this point. + if ( ($new_reason eq $old_reason) && ($new_attr eq $old_attr) ) { + # Update if the source is different, but the attribute and reason are the same + # if a note was provided, or if the rights came from CRMS + if ( + (defined $new_source and $new_source ne 'null' and $new_source ne $old_source) + or ($new_access_profile ne $old_access_profile) + or (defined $new_note and $new_note) + or ($uniqname eq 'crms') + ) { + $do_insert = 1; + } else { + set_queue_done($namespace, $barcode); + push @{$results{'already_in_db'}}, "$namespace.$barcode"; + return; + } } else { - die("attribute missing from input"); + $do_insert = should_update_rights( + $namespace, + $barcode, + $old_attr, + $old_reason, + $old_source, + $new_attr, + $new_reason, + $new_source, + $new_note + ); } - - my $reason; - if (defined $new_reason && $new_reason !~ /\bnull\b/i) { - $new_reason =~ s/\"//g; - - # Make sure reason is a valid reason in the db - my $hr = $dbh->selectcol_arrayref("SELECT id FROM reasons WHERE name = '$new_reason'"); - if (! defined $$hr[0]) { - die("Invalid reason: $new_reason ($barcode)"); - } else { - $reason = $$hr[0]; - } + } else { + # No rights in the db yet for this barcode so just insert whatever we have here + $do_insert = 1; + } + + # Insert new row with most recent rights data + if ($do_insert) { + eval { + $insert_sth->execute( + $namespace, + $barcode, + $attribute, + $reason, + $source, + $access_profile, + $user, + $new_note + ) + }; + if ($@) { + warn($@); } else { - # default: - $new_reason = 'bib'; - my $hr = $dbh->selectcol_arrayref("SELECT id FROM reasons WHERE name = '$new_reason'"); - $reason = $$hr[0]; + push @{$results{'inserted'}}, "$namespace.$barcode"; + set_queue_done($namespace, $barcode); } + } else { + push @{$results{'skipped'}}, "$namespace.$barcode"; + set_queue_done($namespace, $barcode); + next; + } +} - if (defined $uniqname && $uniqname !~ /\bnull\b/i) { - $uniqname =~ s/\"//g; +# Use the new source if given; otherwise the old source +sub final_new_source { + my ($namespace, $barcode, $old_source, $new_source) = @_; - if ($uniqname =~ /\W/) { - die("Invalid user: $uniqname for $namespace.$barcode"); - } + if (defined $new_source && $new_source !~ /\bnull\b/i) { + $new_source =~ s/\"//g; - $user = $uniqname; + return $new_source; + } else { + if (! defined $old_source) { + die("Missing source (not already in rights) ($namespace.$barcode)"); } else { - # the default was set above + return $old_source; } + } +} - my $source; - my $access_profile; - if (defined $new_source_cmdline && $new_source_cmdline !~ /\bnull\b/i) { - # source on command line trumps source in input file - $new_source = $new_source_cmdline; - } +# Use access profile 'open' for pd and pdus Harvard material scanned by Google +# on or before 2025-03-24; access profile 'google' otherwise. - if (defined $new_source && $new_source !~ /\bnull\b/i) { - $new_source =~ s/\"//g; - - # Make sure source is a valid value in the db - my $hr = $dbh->selectrow_arrayref("SELECT id, access_profile FROM sources WHERE name = '$new_source'"); - if (! defined $$hr[0]) { - die("Invalid source: $new_source ($barcode)"); - } else { - $source = $$hr[0]; - $access_profile = $$hr[1]; - } - } else { - # Default source should be whatever the source value was - # in any previous rights db rows for this ID, or 'google' - my $hr = $dbh->selectrow_arrayref( - "SELECT source, access_profile FROM rights_current WHERE namespace = '$namespace' AND id = '$barcode'" - ); - - if (! defined $$hr[0]) { - $source = 1; # 'google' - $access_profile = 2; - } else { - $source = $$hr[0]; - $access_profile = $$hr[1]; - } - } +sub harvard_access_profile { + my ($namespace, $barcode, $new_attr) = @_; - if (defined $new_note && $new_note !~ /\bnull\b/i) { - if (defined $note && $note && $note ne $new_note) { - die("Command-line note conflicts with .rights note ($barcode)"); - } - } else { - $new_note = $note; - } + return 'google' unless ($new_attr eq 'pd' || $new_attr eq 'pdus'); - my ($old_attr, $old_reason, $old_source) = get_old_rights($namespace, $barcode); - my $do_insert = 0; - - if (defined $old_reason && defined $old_attr) { - # If the new reason, attribute and source are the same as the most - # recent ones, ignore at this point. - if ( ($new_reason eq $old_reason) && ($new_attr eq $old_attr) ) { - # Update if the source is different, but the attribute and reason are the same - # or if a note was provided - if ( - (defined $new_source and $new_source ne 'null' and $new_source ne $old_source) - or (defined $new_note and $new_note) - or ($uniqname eq 'crms' or $uniqname eq 'crmsworld') - ) { - $do_insert = 1; - } else { - set_queue_done($namespace, $barcode); - push @{$results{'already_in_db'}}, "$namespace.$barcode"; - next; - } - } else { - $do_insert = should_update_rights( - $namespace, - $barcode, - $old_attr, - $old_reason, - $old_source, - $new_attr, - $new_reason, - $new_source, - $new_note - ); - } - } else { - # No rights in the db yet for this barcode so just insert whatever we have here - $do_insert = 1; - } + $scan_date_sth->execute($namespace, $barcode); + my ($scan_date) = $scan_date_sth->fetchrow_array; + + # Date_Cmp works like the <=> operator; we want to ensure $scan_date is less + # than or equal to the cutoff date. + if (Date_Cmp($scan_date,HARVARD_CUTOFF_DATE) < 1) { + return 'open'; + } else { + return 'google'; + } +} + +sub get_access_profile { + my ($namespace, $barcode, $source, $new_attr) = @_; + + return harvard_access_profile($namespace, $barcode, $new_attr) if $namespace eq 'hvd' and $source eq 'google'; + + $access_profile_for_source_sth->execute($source); + my $hr = $access_profile_for_source_sth->fetchrow_arrayref(); + + return $$hr[0]; - # Insert new row with most recent rights data - if ($do_insert) { - eval { - $insert_sth->execute( - $namespace, - $barcode, - $attribute, - $reason, - $source, - $access_profile, - $user, - $new_note - ) or die("$thisprog -ERR- Database error: " . $dbh->errstr()); - }; - if ($@) { - warn($@); - } else { - push @{$results{'inserted'}}, "$namespace.$barcode"; - set_queue_done($namespace, $barcode); - } - } else { - push @{$results{'skipped'}}, "$namespace.$barcode"; - set_queue_done($namespace, $barcode); - next; - } } sub get_old_rights { - my ($namespace, $barcode) = @_; - - # Determine if a row already exists for this barcode. - # Get reason from most recent rights data: - $reason_sth->execute($namespace, $barcode) || die("$thisprog -ERR- Database error: " . $dbh->errstr()); - my $hr = $reason_sth->fetchrow_hashref(); - my $old_reason = $$hr{'name'} || undef; - $reason_sth->finish(); - - # Get attribute from most recent rights data: - $attr_sth->execute($namespace, $barcode) || die("$thisprog -ERR- Database error: " . $dbh->errstr()); - $hr = $attr_sth->fetchrow_hashref(); - my $old_attr = $$hr{'name'} || undef; - $attr_sth->finish(); - - # Get source from most recent rights data: - $source_sth->execute($namespace, $barcode) || die("$thisprog -ERR- Database error: " . $dbh->errstr()); - $hr = $source_sth->fetchrow_hashref(); - my $old_source = $$hr{'name'} || undef; - $source_sth->finish(); - - return ($old_attr, $old_reason, $old_source); + my ($namespace, $barcode) = @_; + + $rights_current_sth->execute($namespace, $barcode); + my $rights = $rights_current_sth->fetchrow_hashref; + + return undef unless $rights; + + my $old_reason = $reason_names->{$rights->{reason}}; + my $old_attr = $attribute_names->{$rights->{attr}}; + my $old_source = $source_names->{$rights->{source}}; + my $old_access_profile = $access_profile_names->{$rights->{access_profile}}; + + return ($old_attr, $old_reason, $old_source, $old_access_profile); } sub should_update_rights { - my ( + my ( + $namespace, + $barcode, + $old_attr, + $old_reason, + $old_source, + $new_attr, + $new_reason, + $new_source, + $new_note + ) = @_; + + my $do_insert = 0; + + # $old_reason -> Most recent reason + # $new_reason -> New reason + + # Does the old one or the new one win? + my $old_priority = get_priority($old_attr, $old_reason); + my $new_priority = get_priority($new_attr, $new_reason); + + # Make sure we were able to determine the priority + if (not defined $old_priority) { + warn("Unknown old rights $old_attr/$old_reason for $namespace.$barcode"); + $exit = 1; + $do_insert = 0; + } + if (not defined $new_priority) { + warn("Unknown new rights $new_attr/$new_reason for $namespace.$barcode"); + $exit = 1; + $do_insert = 0; + } + if (defined $old_priority and defined $new_priority) { + if ($force_override) { + $do_insert = 1; + } elsif ( + ($old_reason eq 'gfv' or $new_reason eq 'gfv') and + ($old_reason eq 'bib' or $new_reason eq 'bib') + ) { + # handle pdus/gfv precedence + ($exit, $do_insert) = gfv_overrides( $namespace, $barcode, $old_attr, $old_reason, - $old_source, $new_attr, - $new_reason, - $new_source, - $new_note - ) = @_; - - my $do_insert = 0; - - # $old_reason -> Most recent reason - # $new_reason -> New reason - - # Does the old one or the new one win? - my $old_priority = get_priority($old_attr, $old_reason); - my $new_priority = get_priority($new_attr, $new_reason); - - # Make sure we were able to determine the priority - if (not defined $old_priority) { - warn("Unknown old rights $old_attr/$old_reason for $namespace.$barcode"); - $exit = 1; - $do_insert = 0; - } - if (not defined $new_priority) { - warn("Unknown new rights $new_attr/$new_reason for $namespace.$barcode"); - $exit = 1; - $do_insert = 0; + $new_reason + ); + } elsif ($new_priority >= $old_priority) { + $do_insert = 1; + } else { + # new priority is too low; ignore + $do_insert = 0; } - if (defined $old_priority and defined $new_priority) { - if ($force_override) { - $do_insert = 1; - } elsif ( - ($old_reason eq 'gfv' or $new_reason eq 'gfv') and - ($old_reason eq 'bib' or $new_reason eq 'bib') - ) { - # handle pdus/gfv precedence - ($exit, $do_insert) = gfv_overrides( - $namespace, - $barcode, - $old_attr, - $old_reason, - $new_attr, - $new_reason - ); - } elsif ($new_priority >= $old_priority) { - $do_insert = 1; - } else { - # new priority is too low; ignore - $do_insert = 0; - } - - if ($new_priority == $PRIORITY_MAN && not defined $new_note) { - warn("$new_attr/$new_reason requested for $namespace.$barcode but note not provided"); - $exit = 1; - $do_insert = 0; - } + + if ($new_priority == $PRIORITY_MAN && not defined $new_note) { + warn("$new_attr/$new_reason requested for $namespace.$barcode but note not provided"); + $exit = 1; + $do_insert = 0; } + } - return $do_insert; + return $do_insert; } sub get_priority { - my ($attr, $reason) = @_; - - my $code = "$attr/$reason"; - my $toreturn = undef; + my ($attr, $reason) = @_; - while (my ($priority, $codes) = each %$priorities) { - if (grep {$_ eq $code} @$codes) { - warn("$attr/$reason has two priorities ($priority and $toreturn)??") if defined $toreturn; - $exit = 1; - $toreturn = $priority - } - } + my $code = "$attr/$reason"; + my $toreturn = $attr_reason_priorities->{$code}; - if (not defined $toreturn) { - warn("Unknown code $attr/$reason"); - $exit = 1; - } + if (not defined $toreturn) { + die("Unknown code $attr/$reason"); + $exit = 1; + } - return $toreturn; + return $toreturn; } # returns $exit, $do_insert @@ -516,64 +586,65 @@ sub get_priority { # pd/bib and pdus/bib should override pdus/gfv # all bibs should override each other sub gfv_overrides { - my ( - $namespace, - $barcode, - $old_attr, - $old_reason, - $new_attr, - $new_reason - ) = @_; - - # pd/bib and pdus/bib override pdus/gfv - if ($old_attr eq 'pdus' and $old_reason eq 'gfv') { - if ($new_reason eq 'bib' and ($new_attr eq 'pd' or $new_attr eq 'pdus')) { - return (0, 1); # use new rights - pd/bib, pdus/bib overrides pdus/gfv - } elsif ($new_reason eq 'bib' and ($new_attr eq 'ic' or $new_attr eq 'und')) { - return (0, 0); # ignore new rights - } else { - warn("unknown new attr/reason: $old_attr/$old_reason, new: $new_attr/$new_reason for $namespace.$barcode"); - return (1, 0); - } - - } elsif ($new_attr eq 'pdus' and $new_reason = 'gfv') { - if ($old_reason eq 'bib' and ($old_attr eq 'ic' or $old_attr eq 'und')) { - return (0, 1); # use new rights - pdus/gfv overrides ic/bib and und/bib - } elsif ($old_reason eq 'bib' and ($old_attr eq 'pd' or $old_attr eq 'pdus')) { - return (0, 0); # ignore new rights - } else { - warn("unknown old attr/reason: $old_attr/$old_reason, new: $new_attr/$new_reason for $namespace.$barcode"); - return (1, 0); - } + my ( + $namespace, + $barcode, + $old_attr, + $old_reason, + $new_attr, + $new_reason + ) = @_; + + # pd/bib and pdus/bib override pdus/gfv + if ($old_attr eq 'pdus' and $old_reason eq 'gfv') { + if ($new_reason eq 'bib' and ($new_attr eq 'pd' or $new_attr eq 'pdus')) { + return (0, 1); # use new rights - pd/bib, pdus/bib overrides pdus/gfv + } elsif ($new_reason eq 'bib' and ($new_attr eq 'ic' or $new_attr eq 'und')) { + return (0, 0); # ignore new rights + } else { + warn("unknown new attr/reason: $old_attr/$old_reason, new: $new_attr/$new_reason for $namespace.$barcode"); + return (1, 0); + } + } elsif ($new_attr eq 'pdus' and $new_reason = 'gfv') { + if ($old_reason eq 'bib' and ($old_attr eq 'ic' or $old_attr eq 'und')) { + return (0, 1); # use new rights - pdus/gfv overrides ic/bib and und/bib + } elsif ($old_reason eq 'bib' and ($old_attr eq 'pd' or $old_attr eq 'pdus')) { + return (0, 0); # ignore new rights } else { - warn("gfv but not pdus?? old: $old_attr/$old_reason, new: $new_attr/$new_reason for $namespace.$barcode"); - return (1, 0); + warn("unknown old attr/reason: $old_attr/$old_reason, new: $new_attr/$new_reason for $namespace.$barcode"); + return (1, 0); } + + } else { + warn("gfv but not pdus?? old: $old_attr/$old_reason, new: $new_attr/$new_reason for $namespace.$barcode"); + return (1, 0); + } } sub set_queue_done { - my $namespace = shift; - my $barcode = shift; + my $namespace = shift; + my $barcode = shift; - $queue_update_sth->execute($namespace, $barcode); + $queue_update_sth->execute($namespace, $barcode); } sub export_barcodes { - my $htids = shift; - - my $barcode_log = sprintf( - '%s/barcodes_%s_override_feed', - $rights_dir, - UnixDate(ParseDate("now"), '%Y-%m-%d_%H-%M-%S') - ); - open(my $fh, ">>", $barcode_log) or die("can't open $barcode_log: $!"); - - foreach my $htid (@$htids) { - print $fh $htid, "\n"; - } + my $htids = shift; + + my $barcode_log = sprintf( + '%s/barcodes_%s_override_feed', + $rights_dir, + UnixDate(ParseDate("now"), '%Y-%m-%d_%H-%M-%S') + ); + open(my $fh, ">>", $barcode_log) or die("can't open $barcode_log: $!"); + + foreach my $htid (@$htids) { + print $fh $htid, "\n"; + } } +main unless caller; =head1 NAME @@ -643,16 +714,16 @@ package MockTracker; sub new { - my $class = shift; - my $self = {}; - print "MockTracker->new\n"; - bless($self, $class); + my $class = shift; + my $self = {}; + print "MockTracker->new\n"; + bless($self, $class); } sub finalize { - print "MockTracker->finalize\n"; + print "MockTracker->finalize\n"; } sub inc { - print "MockTracker->inc\n"; + print "MockTracker->inc\n"; } diff --git a/t/populate_rights_test.t b/t/populate_rights_test.t new file mode 100644 index 0000000..03d1a37 --- /dev/null +++ b/t/populate_rights_test.t @@ -0,0 +1,378 @@ +#!/usr/bin/perl + +use strict; +use warnings; +use utf8; + +use Data::Dumper; +use File::Temp qw(tempdir); +use POSIX qw(strftime); +use Test2::Bundle::Extended; +use Test2::Tools::Spec; +use Test2::Tools::Compare; +use Test::Exception; +# use Test::More; + +use lib "$ENV{ROOTDIR}/perl_lib"; +use lib "$ENV{ROOTDIR}/bin"; +use Database; +use grin_gfv; + +require "populate_rights_data.pl"; + +# numerical constants corresponding to various rights values +use constant { + ATTR_PD => 1, + ATTR_IC => 2, + ATTR_PDUS => 9, + ATTR_NOBODY => 8, + + REASON_BIB => 1, + REASON_MAN => 5, + + SOURCE_GOOGLE => 1, + SOURCE_IA => 4, + + ACCESS_PROFILE_OPEN => 1, + ACCESS_PROFILE_GOOGLE => 2 + +}; + +my $dbh = Database::get_rights_rw_dbh; + +# These are used by `write_reversion_from_gfv` and `write_reversion_from_gfv` describe, as well as `load_test_fixtures` +my $rights_current_sql = "INSERT INTO rights_current (namespace, id, attr, reason, source, access_profile, user) VALUES (?, ?, ?, ?, ?, ?, 'defaultuser')"; +my $rights_current_sth = $dbh->prepare($rights_current_sql); + +my $feed_grin_sth = $dbh->prepare("INSERT INTO feed_grin (namespace, id, scan_date) VALUES (?,?,?)"); + +sub joinline { + return join("\t", @_) . "\n"; +} + +sub test_process_rights_line { + process_rights_line(joinline(@_)); +} + +# Clean up any previously failed describe + +describe "populate_rights_data.pl" => sub { + + before_all "prepare statement" => sub { + prepare_statements(); + load_tables(); + }; + + before_each "clean up database" => sub { + $dbh->do("DELETE FROM rights_current"); + $dbh->do("DELETE FROM feed_grin"); + }; + + describe "should_update_rights" => sub { + + sub should_update { + + my ($old_attr, $old_reason, $new_attr, $new_reason, $note) = @_; + + should_update_rights( + "prtest","testitem", + $old_attr,$old_reason,"open", + $new_attr,$new_reason,"open", + $note); + } + + sub expect_update { + ok(should_update(@_)); + } + + sub expect_no_update { + ok(!should_update(@_)); + } + + it "bib overrides bib" => sub { expect_update('pd','bib','ic','bib'); }; + it "copyright overrides bib" => sub { expect_update('ic','bib','pd','ren'); }; + it "bib doesn't override copyright" => sub { expect_no_update('pd','ren','ic','bib') }; + it "access overrides copyright" => sub { expect_update('ic','ren','cc-by-4.0','con') }; + it "copyright doesn't override access" => sub { expect_no_update('cc-by-4.0','con','ic','ren') }; + it "man with note overrides man" => sub { expect_update('nobody','man','pd','man','test note') }; + it "man without note doesn't override bib" => sub { expect_no_update('nobody','man','pd','bib') }; + it "access doesn't override man" => sub { expect_no_update('nobody','man','cc-by-4.0','con') }; + + describe "gfv overrides" => sub { + it "pdus/gfv overrides ic/bib" => sub { expect_update('ic','bib','pdus','gfv') }; + it "pdus/gfv overrides und/bib" => sub { expect_update('und','bib','pdus','gfv') }; + it "pdus/gfv does not override pd/bib" => sub { expect_no_update('pd','bib','pdus','gfv') }; + it "ic/bib does not override pdus/gfv" => sub { expect_no_update('pdus','gfv','ic','bib') }; + it "und/bib does not override pdus/gfv" => sub { expect_no_update('pdus','gfv','und','bib') }; + it "pd/bib overrides pdus/gfv" => sub { expect_update('pdus','gfv','pd','bib') }; + it "pdus/bib overrides pdus/gfv" => sub { expect_update('pdus','gfv','pdus','bib') }; + }; + + }; + + describe "process_rights_line" => sub { + + it "requires attr" => sub { + dies_ok { process_rights_line("prtest.123456") }; + like $@, qr(attribute missing); + }; + + it "requires valid id" => sub { + dies_ok { test_process_rights_line("not_an_id","pd","bib","testuser","google") }; + like $@, qr(Invalid namespace/barcode); + }; + + it "requires valid attr" => sub { + dies_ok { test_process_rights_line("prtest.123456","not_attr","bib","testuser","google") }; + like $@, qr(Invalid attribute); + }; + + it "requires valid reason" => sub { + dies_ok { test_process_rights_line("prtest.123456","pd","not_reason","testuser","google") }; + like $@, qr(Invalid reason); + }; + + it "requires valid source" => sub { + dies_ok { test_process_rights_line("prtest.123456","pd","bib","testuser","not_source") }; + like $@, qr(Invalid source); + }; + + it "requires source if not previously loaded" => sub { + dies_ok { test_process_rights_line("prtest.123456","pd","bib") }; + like $@, qr(Missing source); + }; + + it "loads bib rights for something not there" => sub { + test_process_rights_line("prtest.newitem","pd","bib","testuser","google"); + + my $rights = $dbh->selectrow_arrayref("SELECT attr, reason FROM rights_current WHERE namespace = 'prtest' and id = 'newitem'"); + + is([ATTR_PD, REASON_BIB],$rights); + }; + + it "doesn't update rights with same attr/reason/source" => sub { + $rights_current_sth->execute("prtest","samevals",ATTR_PD, REASON_BIB, SOURCE_GOOGLE, ACCESS_PROFILE_GOOGLE); + + # add it with a different user, shouldn't reload + test_process_rights_line("prtest.samevals","pd","bib","newuser","google"); + + my ($user) = $dbh->selectrow_array("SELECT user FROM rights_current WHERE namespace = 'prtest' and id = 'samevals'"); + is("defaultuser", $user); + }; + + it "retains source if not given & rights previously loaded" => sub { + $rights_current_sth->execute("prtest","keepsource",ATTR_PD, REASON_BIB, SOURCE_IA, ACCESS_PROFILE_OPEN); + + test_process_rights_line("prtest.keepsource","ic","bib"); + my $rights = $dbh->selectrow_arrayref("SELECT attr, reason, source FROM rights_current WHERE namespace = 'prtest' and id = 'keepsource'"); + + is([ATTR_IC, REASON_BIB, SOURCE_IA], $rights); + }; + + it "new source updates access profile (as specified in sources)" => sub { + # pd/bib/google/google + $rights_current_sth->execute("prtest","newsource",ATTR_PD, REASON_BIB, SOURCE_GOOGLE, ACCESS_PROFILE_GOOGLE); + + test_process_rights_line("prtest.newsource","pd","bib","testuser","ia"); + my ($access_profile) = $dbh->selectrow_array("SELECT access_profile FROM rights_current WHERE namespace = 'prtest' and id = 'newsource'"); + + is(ACCESS_PROFILE_OPEN, $access_profile); + }; + + }; + + describe "get_old_rights" => sub { + + it "gets old attribute, reason, source" => sub { + # pd/bib/google/google + $rights_current_sth->execute("prtest","oldrights",ATTR_PD, REASON_BIB, SOURCE_GOOGLE, ACCESS_PROFILE_GOOGLE); + + my ($old_attr, $old_reason, $old_source) = get_old_rights("prtest", "oldrights"); + is("pd",$old_attr); + is("bib",$old_reason); + is("google",$old_source); + }; + + it "returns undef if there are no rights" => sub { + my ($old_attr, $old_reason, $old_source) = get_old_rights("prtest", "nonexistent"); + + is(undef,$old_attr); + is(undef,$old_reason); + is(undef,$old_source); + } + }; + + describe "data loading/integration" => sub { + my $tempdir; + + before_all "set up temp dir" => sub { + $tempdir = tempdir( "/tmp/populate-rights-test-XXXXXX", CLEANUP => 1 ); + mkdir("$tempdir/rights"); + mkdir("$tempdir/archive"); + }; + + it "loads files in rights_dir" => sub { + open(my $rights, ">", "$tempdir/rights/testfile1.rights"); + print $rights joinline("prtest.loadfile","pd","bib","testuser","google"); + close($rights); + + my $res = qx(perl -w bin/populate_rights_data.pl --rights_dir=$tempdir/rights --archive=$tempdir/archive 2>&1); + # 0 (ok) exit code + ok(!$?); + ok($res =~ /Rows inserted: 1/m); + + my ($count) = $dbh->selectrow_array("SELECT count(*) FROM rights_current WHERE namespace = 'prtest' and id = 'loadfile'"); + + is(1,$count); + ok(!-e "$tempdir/rights/testfile1.rights"); + ok(-e "$tempdir/archive/testfile1.rights"); + }; + + it "accepts --data for individual file; processes all lines" => sub { + open(my $rights, ">", "$tempdir/testfile2.rights"); + print $rights joinline("prtest.procfile1","ic","bib","testuser","ia"); + print $rights joinline("prtest.procfile2","pd","bib","testuser","google"); + close($rights); + + my $res = qx(perl -w bin/populate_rights_data.pl --data=$tempdir/testfile2.rights --archive=$tempdir/archive 2>&1); + # 0 (ok) exit code + ok(!$?); + ok($res =~ /Rows inserted: 2/m); + + my ($count) = $dbh->selectrow_array("SELECT count(*) FROM rights_current WHERE namespace = 'prtest' and id in ('procfile1','procfile2')"); + + is(2,$count); + }; + + it "bails out when encountering invalid data" => sub { + open(my $rights, ">", "$tempdir/testfile3.rights"); + print $rights joinline("prtest.goodline1","ic","bib","testuser","ia"); + print $rights "badline\n"; + print $rights joinline("prtest.goodline2","pd","bib","testuser","google"); + close($rights); + + my $res = qx(perl -w bin/populate_rights_data.pl --data=$tempdir/testfile3.rights --archive=$tempdir/archive 2>&1); + # nonzero exit code (error) + ok($?); + ok($res =~ /Invalid namespace\/barcode/); + + # Should have loaded goodline1, but not goodline2 (since it bailed out after badline) + my ($count) = $dbh->selectrow_array("SELECT count(*) FROM rights_current WHERE namespace = 'prtest' and id = 'goodline1'"); + is(1,$count); + + ($count) = $dbh->selectrow_array("SELECT count(*) FROM rights_current WHERE namespace = 'prtest' and id = 'goodline2'"); + is(0,$count); + }; + + it "force-override requires note" => sub { + open(my $rights, ">", "$tempdir/testfile4.rights"); + print $rights joinline("prtest.override1","pd","bib","testuser","ia"); + close($rights); + + my $res = qx(perl -w bin/populate_rights_data.pl --force-override --data=$tempdir/testfile4.rights --archive=$tempdir/archive 2>&1); + # nonzero exit code (error) + ok($?); + ok($res =~ /must provide a note/m); + + # Should not have loaded anything + my ($count) = $dbh->selectrow_array("SELECT count(*) FROM rights_current WHERE namespace = 'prtest' and id = 'override1'"); + is(0,$count); + }; + + + it "force-override allows bib to override man & exports barcodes" => sub { + # preload 'man' rights + # nobody/man/google/google + $rights_current_sth->execute("prtest","override2",ATTR_NOBODY, REASON_MAN, SOURCE_GOOGLE, ACCESS_PROFILE_GOOGLE); + + open(my $rights, ">", "$tempdir/testfile5.rights"); + print $rights joinline("prtest.override2","pd","bib","testuser","ia"); + close($rights); + + my $res = qx(perl -w bin/populate_rights_data.pl --force-override --note="override note" --data=$tempdir/testfile5.rights --archive=$tempdir/archive --rights_dir=$tempdir/rights 2>&1); + + # zero exit code (success) + ok(!$?) or print STDERR $res; + ok($res =~ /Rows inserted: 1/m); + + # Should have loaded + my ($count) = $dbh->selectrow_array("SELECT count(*) FROM rights_current WHERE namespace = 'prtest' and id = 'override2'"); + is(1,$count); + + my @override_feed_barcodes = glob("$tempdir/rights/barcodes_*_override_feed"); + + is(1,scalar @override_feed_barcodes); + + open(my $fh, "<", $override_feed_barcodes[0]); + my $line = <$fh>; + is($line,"prtest.override2\n"); + }; + }; + + describe "access profile for Google-scanned harvard material" => sub { + + sub expect_access_profile { + my $id = shift; + my $expected_access_profile = shift; + + my ($actual_access_profile) = $dbh->selectrow_array("SELECT access_profile FROM rights_current WHERE namespace = 'hvd' and id = ?",{},$id); + + is($expected_access_profile,$actual_access_profile); + } + + describe "scan_date before 2025-03-24" => sub { + it "sets profile to open for pd" => sub { + $feed_grin_sth->execute("hvd","testitem1","2010-01-01 00:00:00"); + + test_process_rights_line("hvd.testitem1","pd","bib","testuser","google"); + + expect_access_profile("testitem1",ACCESS_PROFILE_OPEN); + }; + + it "updates profile for item that was ic and is now pd" => sub { + $feed_grin_sth->execute("hvd","testitem2","2010-01-01 00:00:00"); + $rights_current_sth->execute("hvd","testitem2",ATTR_IC, REASON_BIB, SOURCE_GOOGLE, ACCESS_PROFILE_GOOGLE); + test_process_rights_line("hvd.testitem2","pd","bib","testuser","google"); + + expect_access_profile("testitem2", ACCESS_PROFILE_OPEN); + }; + + it "updates profile for pd item" => sub { + # load data: pd/bib/google/google + $feed_grin_sth->execute("hvd","testitem3","2010-01-01 00:00:00"); + $rights_current_sth->execute("hvd","testitem3",ATTR_PD, REASON_BIB, SOURCE_GOOGLE, ACCESS_PROFILE_GOOGLE); + test_process_rights_line("hvd.testitem3","pd","bib","testuser","google"); + + expect_access_profile("testitem3", ACCESS_PROFILE_OPEN); + }; + + it "sets profile to open for pdus" => sub { + $feed_grin_sth->execute("hvd","testitem4","2010-01-01 00:00:00"); + test_process_rights_line("hvd.testitem4","pdus","bib","testuser","google"); + + expect_access_profile("testitem4", ACCESS_PROFILE_OPEN); + }; + + # load data: pd/bib/google/open + it "sets profile to google for ic" => sub { + test_process_rights_line("hvd.testitem5","ic","bib","testuser","google"); + + $feed_grin_sth->execute("hvd","testitem5","2010-01-01 00:00:00"); + expect_access_profile("testitem5", ACCESS_PROFILE_GOOGLE); + }; + }; + + # describe "scan_date after 2025-03-24" => sub { + # # load data: pd/bib/google/open + # it "sets profile to google for pd"; + # it "sets profile to google for pdus"; + # it "sets profile to google for ic"; + # }; + + # it "sets profile to google if item is not in feed_grin"; + + }; + +}; + +done_testing();