view release on metacpan or  search on metacpan

lib/App/PhotoDB/handlers.pm  view on Meta::CPAN

# Delete a scan from the database and optionally from the filesystem
sub scan_delete {
	my $href = shift;
	my $db = $href->{db};

	# Prompt user for filename of scan
	my $scan_id = $href->{scan_id} // &choosescan({db=>$db});

	# Work out file path
	my $basepath = &basepath;
	my $relativepath = &lookupval({db=>$db, col=>"concat(directory, '/', filename)", table=>'scans_negs', where=>{scan_id=>$scan_id}});
	my $fullpath = "$basepath/$relativepath";

	# Offer to delete the file
	if (&prompt({prompt=>"Delete the file $fullpath ?", type=>'boolean', default=>'no'})) {
		unlink $fullpath or print "Could not delete file $fullpath: $!\n";
	}

	# Remove record from SCAN
	return &deleterecord({db=>$db, table=>'SCAN', where=>{scan_id=>$scan_id}});
}

# Search the filesystem for scans which are not in the database
sub scan_search {
	my $href = shift;
	my $db = $href->{db};

	# Search filesystem basepath & DB to enumerate all *.jpg scans
	my @fsfiles = &fsfiles;
	my @dbfiles = &dbfiles({db=>$db});

	# Find the scans only on the filesystem
	my @fsonly = array_minus(@fsfiles, @dbfiles);
	my $numfsonly = scalar @fsonly;

	# Scans only on the fs
	if ($numfsonly>0 && &prompt({prompt=>"Audit $numfsonly scans that exist only on the filesystem and not in the database?", type=>'boolean', default=>'yes', required=>1})) {
		my $auto = &prompt({prompt=>'Auto-add scans to the database that can be auto-matched to a negative or print?', type=>'boolean', required=>1});
		my $x = 0;
		for my $fsonlyfile (@fsonly) {
			if ($auto || &prompt({prompt=>"Add $fsonlyfile to the database?", type=>'boolean', required=>1})) {
				my $filename = fileparse($fsonlyfile);

				# Test to see if this is from a negative, e.g. 123-12-image012.jpg
				if ($filename =~ m/^(\d+)-([0-9a-z]+)-.+\.jpg$/i) {
					my $film_id = $1;
					my $frame = $2;
					if ($auto || &prompt({prompt=>"This looks like a scan of negative $film_id/$frame. Add it?", type=>'boolean', default=>'yes', required=>1})) {
						my $neg_id = &lookupval({db=>$db, col=>"lookupneg($film_id, '$frame')", table=>'NEGATIVE'});
						my $subdir = &lookupval({db=>$db, col=>'directory', table=>'FILM', where=>{film_id=>$film_id}});

						# Test for non-null subdir
						if ($subdir =~ m/.+/) {
							my $basepath = &basepath;
							my $correctpath = "$basepath/$subdir/$filename";

							# Test to make sure it's in a valid directory
							if ($fsonlyfile ne $correctpath) {
								if (&prompt({prompt=>"Move scan $fsonlyfile to its correct path $correctpath?", type=>'boolean', default=>'yes'})) {
									# Rename it to the correct dir and continue using the new path
									rename(&untaint($fsonlyfile), &untaint($correctpath));
									$fsonlyfile = $correctpath;
								}
							}
						}

						if (!$neg_id || $neg_id !~ /\d+/) {
							print "Could not determine negative ID for negative $film_id/$frame, skipping\n";
							next;
						}
						&newrecord({db=>$db, data=>{negative_id=>$neg_id, filename=>$filename}, table=>'SCAN', silent=>$auto});
						print "Added $filename as scan of negative $film_id/$frame\n" if $auto;
						$x++;
					}
				# Test to see if this is from a print, e.g. P232-image012.jpg
				} elsif ($filename =~ m/^p(rint)?(\d+).*\.jpg$/i) {
					my $print_id = $2;
					if ($auto || &prompt({prompt=>"This looks like a scan of print #$print_id. Add it?", type=>'boolean', default=>'yes', required=>1})) {
						&newrecord({db=>$db, data=>{print_id=>$print_id, filename=>$filename}, table=>'SCAN', silent=>$auto});
						print "Added $filename as scan of print #$print_id\n" if $auto;
						$x++;
					}
				} else {
					next if $auto;
					if (&prompt({prompt=>"Can't automatically determine the source of this scan. Add it manually?", type=>'boolean', default=>'yes', required=>1})) {
						&scan_add({db=>$db, filename=>$filename});
					}
				}
			}
		}
		my $stillfsonly = $numfsonly - $x;
		print "Added $x scans to the database. There are $stillfsonly scans on the filesystem but not in the database.\n";
	} else {
		print "All scans on the filesystem are already in the database\n";
	}

	# Re-search filesystem basepath & DB in case it was updated above
	@fsfiles = &fsfiles;
	@dbfiles = &dbfiles({db=>$db});

	# Find scans only in the database
	my @dbonly = array_minus(@dbfiles, @fsfiles);
	my $numdbonly = scalar @dbonly;

	# Scans only in the db
	if ($numdbonly>0 && &prompt({prompt=>"Audit $numdbonly scans that exist only in the database and not on the filesystem?", type=>'boolean', default=>'no', required=>1})) {
		my $x = 0;
		for my $dbonlyfile (@dbonly) {
			if (&prompt({prompt=>"Delete $dbonlyfile from the database?", type=>'boolean', default=>'no', required=>1})) {
				my $filename = fileparse($dbonlyfile);
				&deleterecord({db=>$db, table=>'SCAN', where=>{filename=>$filename}, silent=>1});
				$x++;
			}
		}
		my $stilldbonly = $numdbonly - $x;
		print "Deleted $x scans from the database. There are $stilldbonly scans in the database but not on the filesystem.\n";
	} else {
		print "All scans in the database exist on the filesystem\n";
	}
	return;
}

# Rename scans to include their caption in the filename
sub scan_rename {
	# Read in cmdline args
	my $href = shift;
	my $db = $href->{db};
	my $film_id = $href->{film_id} // &film_choose({db=>$db});

	# Make sure basepath is valid
	my $basepath = &basepath;

	# Find matching scans
	my $sql = SQL::Abstract->new;
	my($stmt, @bind) = $sql->select('scans_negs', '*', {film_id=>$film_id});
	my $sth = $db->prepare($stmt) or die "Couldn't prepare statement: " . $db->errstr;
	my $rows = $sth->execute(@bind);
	$rows = &unsci($rows);
	return if ($rows == 0);

	# Loop through our result set
	while (my $ref = $sth->fetchrow_hashref()) {
		# First check the path is defined in MySQL
		if (defined($ref->{'filename'})) {
			# Now make sure the path actually exists on the system
			if (-e "$basepath/$ref->{'directory'}/$ref->{'filename'}") {

				# Sanitise description with fs-safe chars
				my $safedesc = $ref->{'description'};
				$safedesc =~ s/[^a-zA-Z0-9-_ ]//g;

				# Generate theoretical new filename
				my $newname;
				if ($ref->{'print_id'}) {
					# For prints
					$newname = "P$ref->{print_id}-$safedesc.jpg";
				} else {
					# For negatives
					$newname = "$ref->{film_id}-$ref->{frame}-$safedesc.jpg";
				}

				# Check if a change is needed
				if ($ref->{'filename'} ne $newname) {
					print "\t$ref->{'filename'} => $newname\n";

					# Move file on fs
					rename(&untaint("$basepath/$ref->{'directory'}/$ref->{'filename'}"), &untaint("$basepath/$ref->{'directory'}/$newname"));

					# Update scan in db
					&updaterecord({db=>$db, data=>{filename=>$newname}, table=>'SCAN', where=>{scan_id=>$ref->{scan_id}}, silent=>1});
				}
			}
		}
	}
	return $rows;
}

# This ensures the lib loads smoothly
1;