Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
95 changes: 11 additions & 84 deletions bin/grin_gfv.pl
Original file line number Diff line number Diff line change
Expand Up @@ -28,24 +28,16 @@
use YAML::XS;

use Database;
use grin_gfv;

my $noop = undef; # set with --noop
my $mailer = undef;
my $email_body = ""; # holds the current email body
my $volcount = 0;

# static values for queries
my $force_attr = "9"; # pdus
my $force_reason = "12"; # gfv
my $r_note = 'Revert to previous attr/reason; no longer VIEW_FULL';
my $user = 'libadm';

# config
my $config_dir = $ENV{CONFIG_DIR} || '/usr/src/app/config';
my $config_yaml = "$config_dir/rights.yml";
my $config = YAML::XS::LoadFile($config_yaml);
my $rights_dir = $config->{rights}->{rights_dir};
my $dbh = Database::get_rights_rw_dbh();

GetOptions(
# skip update queries, emails, log file & tracker
Expand All @@ -56,81 +48,27 @@
my $tracker = ProgressTracker->new();
$tracker->start_stage("set_pdus_gfv") unless $noop;

# This gets us the items to update in update_gfv.
my $select_gfv_sql = join(
' ',
"SELECT r.namespace, r.id, a.name",
"FROM rights_current r",
"INNER JOIN attributes a ON r.attr = a.id",
"INNER JOIN reasons e ON r.reason = e.id",
"INNER JOIN ht.feed_grin g ON r.id = g.id AND r.namespace = g.namespace",
"WHERE g.viewability = 'VIEW_FULL' AND a.name IN ('ic', 'und') AND e.name = 'bib' AND g.claimed != 'true' AND r.namespace != 'keio'"
);

# Takes values for 2 bind-params, in the order: namespace, id.
# user, attr & reason are static, so no bind-params for those.
my $update_gfv_sql = join(
' ',
"UPDATE rights_current",
"SET attr = '$force_attr', reason = '$force_reason', time = CURRENT_TIMESTAMP, user = '$user'",
"WHERE namespace = ? AND id = ?"
);
my $update_gfv_sth = $dbh->prepare($update_gfv_sql) || die "could not prepare query: $update_gfv_sql";
my $grin_gfv = grin_gfv->new;
my $updates = $grin_gfv->updates_to_gfv;

# Loop over the relevant items and update their attr/reason
foreach my $row (@{$dbh->selectall_arrayref($select_gfv_sql)}) {
my ($namespace, $id, $attrname) = @$row;
$email_body .= "$namespace.$id\t$attrname\n";
$volcount++;
foreach my $update (@$updates) {
unless ($noop) {
$update_gfv_sth->execute($namespace, $id);
$grin_gfv->write_update_to_gfv($update);
$tracker->inc();
}
}

# Send first email
unless ($noop) {
$mailer = new_mailer("New ic/und but VIEW_FULL volumes");
print $mailer "$volcount volumes set to pdus/gfv at " . CORE::localtime() . "\n";
print $mailer "$email_body";
print $mailer $grin_gfv->updates_to_gfv_report($updates);
$mailer->close() or warn("Couldn't send message: $!");
}

#### Step 2: REVERT FORMERLY VIEW_FULL ITEMS ####
$tracker->start_stage("revert_pdus_gfv") unless $noop;

my $select_revert_sql = join(
' ',
"SELECT r.namespace, r.id",
"FROM rights_current r",
"INNER JOIN ht.feed_grin g ON r.id = g.id AND r.namespace = g.namespace",
"WHERE r.reason='12' AND (g.viewability != 'VIEW_FULL' OR g.claimed = 'true' OR r.namespace = 'keio')"
);

# Takes values for 2 bind-params, in the order: id, namespace.
my $select_old_sql = join(
' ',
"SELECT attr, reason, source",
"FROM rights_log",
"WHERE id = ? AND namespace = ? AND reason != '12'",
"ORDER BY time DESC",
"LIMIT 1"
);
my $select_old_sth = $dbh->prepare($select_old_sql) || die "could not prepare query: $select_old_sql";

# Takes values for 4 bind-params in the order: oldattr, oldreason, namespace, id.
# user, note & time are static so not a bind-params for them.
my $update_revert_sql = join(
' ',
"UPDATE rights_current",
"SET attr = ?, reason = ?, user = '$user', time = CURRENT_TIMESTAMP, note = '$r_note'",
"WHERE namespace = ? AND id = ?"
);
my $update_revert_sth = $dbh->prepare($update_revert_sql) || die "could not prepare query: $update_revert_sql";

# Start second email
$email_body = "Reverting pdus/gfv volumes that are no longer VIEW_FULL\n";

# Open file for which to record reverted barcodes
my $barcode_log = sprintf(
'%s/barcodes_%s_revert_gfv_feed',
Expand All @@ -139,22 +77,12 @@
);
open(my $fh, ">>", $barcode_log) or die("can't open $barcode_log: $!");

# This loop does a couple of things...
foreach my $row (@{$dbh->selectall_arrayref($select_revert_sql)}) {
# get the namespace and id for the item to update
my ($namespace, $id) = @$row;

# get the item's most recent non-gfv attr/reason
$select_old_sth->execute($id, $namespace);
my ($oldattr, $oldreason) = $select_old_sth->fetchrow_array();

my $reversions = $grin_gfv->reversions_from_gfv;
foreach my $reversion (@$reversions) {
unless ($noop) {
# append item to email body and print barcode to log file
$email_body .= "\t$namespace.$id\n";
print $fh "$namespace.$id\n";

print $fh "$reversion->{namespace}.$reversion->{id}\n";
# update item in rights_current with the old attr/reason
$update_revert_sth->execute($oldattr, $oldreason, $namespace, $id);
$grin_gfv->write_reversion_from_gfv($reversion);
$tracker->inc();
}
}
Expand All @@ -163,12 +91,11 @@
unless ($noop) {
# Send the second email and we're done
$mailer = new_mailer("Old pdus/gfv volumes no longer VIEW_FULL");
print $mailer "$email_body";
print $mailer $grin_gfv->reversions_from_gfv_report($reversions);
$mailer->close() or warn("Couldn't send message: $!");
}

$tracker->finalize() unless $noop;
$dbh->disconnect;

# The 2 emails sent only differ in subject and body,
# so we can do everything else using the same template.
Expand Down
4 changes: 4 additions & 0 deletions perl_lib/Database.pm
Original file line number Diff line number Diff line change
@@ -1,5 +1,9 @@
package Database;

use strict;
use warnings;
use utf8;

# Shared utility for read-only connection to Rights DB (via views in ht database)
# or, for populate_rights_data.pl, read-write access to the Rights DB directly.

Expand Down
222 changes: 222 additions & 0 deletions perl_lib/grin_gfv.pm
Original file line number Diff line number Diff line change
@@ -0,0 +1,222 @@
package grin_gfv;

use strict;
use warnings;
use utf8;

use POSIX qw(strftime);

# Day Mo NN XX:YY:ZZ Year
our $REPORT_TIME_FORMAT = "%a %b %e %T %Y";

my $UPDATE_USER = 'libadm';
# For rights_current update ($write_update_to_gfv_sql)
our $GFV_ATTR_ID = 9; # pdus
our $GFV_REASON_ID = 12; # gfv
# For rights_current reversion update
my $REVERSION_NOTE = 'Revert to previous attr/reason; no longer VIEW_FULL';


# This gets us the items to update in update_gfv.
my $select_updates_to_gfv_sql = <<~'SQL';
SELECT r.namespace, r.id, a.name
FROM rights_current r
INNER JOIN attributes a ON r.attr = a.id
INNER JOIN reasons e ON r.reason = e.id
INNER JOIN ht.feed_grin g ON r.id = g.id AND r.namespace = g.namespace
WHERE g.viewability = 'VIEW_FULL' AND a.name IN ('ic', 'und') AND e.name = 'bib' AND g.claimed != 'true' AND r.namespace != 'keio'
ORDER BY r.namespace, r.id
SQL

my $select_reversions_from_gfv_sql = <<~'SQL';
SELECT r.namespace, r.id
FROM rights_current r
INNER JOIN ht.feed_grin g ON r.id = g.id AND r.namespace = g.namespace
WHERE r.reason='12' AND (g.viewability != 'VIEW_FULL' OR g.claimed = 'true' OR r.namespace = 'keio')
ORDER BY r.namespace, r.id
SQL

my $select_rights_log_sql = <<~'SQL';
SELECT attr, reason, source
FROM rights_log
WHERE namespace = ? AND id = ?
ORDER BY time DESC
SQL

my $write_update_to_gfv_sql = <<~SQL;
UPDATE rights_current
SET
attr = $GFV_ATTR_ID,
reason = $GFV_REASON_ID,
time = CURRENT_TIMESTAMP,
user = '$UPDATE_USER'
WHERE namespace = ? AND id = ?
SQL

my $write_reversion_from_gfv_sql = <<~SQL;
UPDATE rights_current
SET
attr = ?,
reason = ?,
time = CURRENT_TIMESTAMP,
user = '$UPDATE_USER',
note = '$REVERSION_NOTE'
WHERE namespace = ? AND id = ?
SQL

sub new {
my ($class, %args) = @_;
my $self = bless {}, $class;
my $dbh = Database::get_rights_rw_dbh;
$self->{dbh} = $dbh;
$self->{select_updates_to_gfv_sth} = $dbh->prepare($select_updates_to_gfv_sql) || die "could not prepare query: $select_updates_to_gfv_sql";;
$self->{select_reversions_from_gfv_sth} = $dbh->prepare($select_reversions_from_gfv_sql) || die "could not prepare query: $select_reversions_from_gfv_sql";
$self->{select_rights_log_sth} = $dbh->prepare($select_rights_log_sql) || die "could not prepare query: $select_rights_log_sql";
$self->{write_update_to_gfv_sth} = $dbh->prepare($write_update_to_gfv_sql) || die "could not prepare query: $write_update_to_gfv_sql";
$self->{write_reversion_from_gfv_sth} = $dbh->prepare($write_reversion_from_gfv_sql) || die "could not prepare query: $write_reversion_from_gfv_sql";
return $self;
}

# ic/und items that should nonetheless be pdus/gfv according to GRIN
# Returns an arrayref of hashref, sorted by namespace and id
# Each hashref contains the fields {namespace, id, attr}
# e.g. { namespace => 'mdp', id => '001', attr => 'ic' }
sub updates_to_gfv {
my $self = shift;

my $updates = [];
my $sth = $self->{select_updates_to_gfv_sth};
$sth->execute or die $sth->errstr;
while (my $row = $sth->fetch) {
my ($namespace, $id, $attr) = @$row;
push @$updates, {namespace => $namespace, id => $id, attr => $attr};
}
$sth->finish;
return $updates;
}

# Extract updates_to_gfv data into e-mail report
# Optional date_string keyword arg is for testing
sub updates_to_gfv_report {
my $self = shift;
my $updates = shift;
my %args = @_;

my $date_string = $args{date_string} || strftime($REPORT_TIME_FORMAT, localtime);
my $report = sprintf "%d volumes set to pdus/gfv at $date_string\n\n", scalar @$updates;
my $ic_section = "IC\n\n";
my $und_section = "UND\n\n";
foreach my $update (@$updates) {
if ($update->{attr} eq 'ic') {
$ic_section .= "$update->{namespace}.$update->{id}\n";
} elsif ($update->{attr} eq 'und') {
$und_section .= "$update->{namespace}.$update->{id}\n";
} else {
printf STDERR "ERROR: unknown attribute in %s\n", Dumper($update);
}
}
$report .= $ic_section . "\n";
$report .= $und_section;
return $report;
}

# Write a pdus/gfv update (one of the hashrefs from updates_to_gfv) to the Rights DB
sub write_update_to_gfv {
my $self = shift;
my $update = shift;

$self->{write_update_to_gfv_sth}->execute(
$update->{namespace},
$update->{id}
);
}

# pdus_gfv items that should be reverted to bib rights
# Returns an arrayref of hashref, sorted by namespace, id
# Each hashref contains the fields {namespace, id, attr, reason, source, gfv_count}
# e.g. { namespace => 'mdp', id => '001', attr => 5, reason => 8, source => 1, gfv_count => 0 }
# NOTE, the attr/reason/src are NUMERIC this time
sub reversions_from_gfv {
my $self = shift;

my $updates = [];
my $sth = $self->{select_reversions_from_gfv_sth};
$sth->execute or die $sth->errstr;
while (my $row = $sth->fetch) {
my ($namespace, $id) = @$row;
my $rights_log_data = $self->_rights_log_data($namespace, $id);
push @$updates, {
namespace => $namespace,
id => $id,
attr => $rights_log_data->{attr},
reason => $rights_log_data->{reason},
source => $rights_log_data->{source},
gfv_count => $rights_log_data->{gfv_count}
};
}
$sth->finish;
return $updates;
}

# Extract reversions_from_gfv data into e-mail report
# Optional date_string keyword arg is for testing
sub reversions_from_gfv_report {
my $self = shift;
my $reversions = shift;
my %args = @_;

my $date_string = $args{date_string} || strftime($REPORT_TIME_FORMAT, localtime);
my $report = sprintf "%d volumes reverted from pdus/gfv at $date_string\n\n", scalar @$reversions;
my $prior_section = "Has prior GFV status\n\n";
my $no_prior_section = "No prior GFV status\n\n";
foreach my $reversion (@$reversions) {
# There should be at least one GFV (the one we are reverting from).
# Anything more than that counts as prior GFV status.
if ($reversion->{gfv_count} > 1) {
$prior_section .= "$reversion->{namespace}.$reversion->{id}\n";
} else {
$no_prior_section .= "$reversion->{namespace}.$reversion->{id}\n";
}
}
$report .= $prior_section . "\n";
$report .= $no_prior_section;
return $report;
}

sub write_reversion_from_gfv {
my $self = shift;
my $reversion = shift;

$self->{write_reversion_from_gfv_sth}->execute(
$reversion->{attr},
$reversion->{reason},
$reversion->{namespace},
$reversion->{id}
);
}

# Returns data from the most recent non-gfv entry in rights_log,
# plus a count of */gfv entries (including the one we are reverting from)
# e.g., { attr => 5, reason => 8, source => 1, gfv_count => 1 }
sub _rights_log_data {
my $self = shift;
my $namespace = shift;
my $id = shift;

my $rights_log_data = { gfv_count => 0 };
my $sth = $self->{select_rights_log_sth};
$sth->execute($namespace, $id) or die $sth->errstr;
while (my $row = $sth->fetch) {
my ($attr, $reason, $source) = @$row;
if ($reason == $GFV_REASON_ID) {
$rights_log_data->{gfv_count}++;
} elsif (!defined $rights_log_data->{attr}) {
$rights_log_data->{attr} = $attr;
$rights_log_data->{reason} = $reason;
$rights_log_data->{source} = $source;
}
}
return $rights_log_data;
}

1;
Loading