Usage: cleaning of old BLOB and associated records into a corporate 3D application databases; result of stuff ~700 the application users.
#!/usr/local/bin/perl # # $Id: mosaic-purge.pl,v 1.1 2017/06/26 12:45:18 root Exp $ # package MU; use utf8; use DBI; sub new { my ($class, $dsn, $username, $password) = @_; my $self = { dsn => $dsn, username => $username, password => $password }; bless $self, $class; return $self; } sub dsn { return shift->{dsn}; } sub username { return shift->{username}; } sub password { return shift->{password}; } sub unlinkProjectOIDs { my ($self, $column) = @_; my $db = DBI->connect($self->dsn, $self->username, $self->password); my $query = "select lo_unlink(p.$column) from projects5d p where p.date_change < (extract(epoch from now())-7776000) and exists (select 1 from pg_largeobject_metadata l where l.oid = p.$column);"; my $sth = $db->prepare($query); my $rows = $sth->execute; my @a; while (my $row = $sth->fetchrow_hashref) { push @a, $row; } $sth->finish; $db->disconnect; return undef if $rows*1;; return \@a; } sub unlinkImageOIDs { my ($self, $column) = @_; my $db = DBI->connect($self->dsn, $self->username, $self->password); my $query = "select lo_unlink(i.$column) from projects5d p, images5d i where p.date_change < (extract(epoch from now())-7776000) and p.project_guid = i.project_guid and exists (select 1 from pg_largeobject_metadata l where l.oid = i.$column);"; my $sth = $db->prepare($query); my $rows = $sth->execute; my @a; while (my $row = $sth->fetchrow_hashref) { push @a, $row; } $sth->finish; $db->disconnect; return undef if $rows*1; return \@a; } sub deleteImageRecords { my ($self, $column) = @_; my $db = DBI->connect($self->dsn, $self->username, $self->password); my $query = "delete from images5d i using projects5d p where p.date_change < (extract(epoch from now())-7776000) and p.project_guid = i.project_guid;"; $rows = $db->do($query); $db->disconnect; return undef if $rows*1; return 1; } sub deleteProjectRecords { my ($self, $column) = @_; my $db = DBI->connect($self->dsn, $self->username, $self->password); my $query = "delete from projects5d p where p.date_change < (extract(epoch from now())-7776000);"; $rows = $db->do($query); $db->disconnect; return undef if $rows*1; return 1; } sub vacuumFull { my ($self, $column) = @_; my $db = DBI->connect($self->dsn, $self->username, $self->password); my $query = "vacuum full"; $rows = $db->do($query); $db->disconnect; return undef if $rows*1; return 1; } 1; my $dbhost = "xxxxxxxxx"; my $username = "xxxxx"; my $password = "xxxxxx"; my @reg = ("kxx", "sxx", "exx", "rxx", "lxx", "mxx", "sxx", "oxx"); foreach my $reg (@reg) { my $dbname = "mxxxxxx_$reg"; my $mu = MU->new("dbi:Pg:dbname=$dbname;host=$dbhost","$username","$password"); $mu->unlinkProjectOIDs("file_project"); $mu->unlinkProjectOIDs("file_preview"); $mu->unlinkProjectOIDs("file_xml"); $mu->unlinkImageOIDs("image_oid"); $mu->deleteImageRecords; $mu->deleteProjectRecords; $mu->vacuumFull; } #EOF
select lo_unlink(p.file_project) from projects5d p where p.date_change < (extract(epoch from now())-7776000) and exists (select 1 from pg_largeobject_metadata l where l.oid = p.file_project); select lo_unlink(p.file_preview) from projects5d p where p.date_change < (extract(epoch from now())-7776000) and exists (select 1 from pg_largeobject_metadata l where l.oid = p.file_preview); select lo_unlink(p.file_xml) from projects5d p where p.date_change < (extract(epoch from now())-7776000) and exists (select 1 from pg_largeobject_metadata l where l.oid = p.file_xml); select lo_unlink(i.image_oid) from projects5d p, images5d i where p.date_change < (extract(epoch from now())-7776000) and p.project_guid = i.project_guid and exists (select 1 from pg_largeobject_metadata l where l.oid = i.image_oid); delete from images5d i using projects5d p where p.date_change < (extract(epoch from now())-7776000) and p.project_guid = i.project_guid; delete from projects5d p where p.date_change < (extract(epoch from now())-7776000); vacuum full;