view release on metacpan or  search on metacpan

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

	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 {