App-PhotoDB
view release on metacpan or search on metacpan
lib/App/PhotoDB/handlers.pm view on Meta::CPAN
package App::PhotoDB::handlers;
# This package provides reusable handlers to be interact with the user
use strict;
use warnings;
use Exporter qw(import);
use Config::IniHash;
use YAML;
use Array::Utils qw(:all);
use Path::Iterator::Rule;
use File::Basename;
use App::PhotoDB::funcs qw(/./);
our @EXPORT_OK = qw(
film_add film_load film_archive film_develop film_tag film_locate film_bulk film_annotate film_stocks film_current film_choose film_info film_search
cameramodel_add cameramodel_shutterspeeds cameramodel_exposureprogram cameramodel_meteringmode cameramodel_accessory cameramodel_series cameramodel_info
camera_add camera_displaylens camera_sell camera_repair camera_addbodytype camera_info camera_choose camera_edit camera_search
mount_add mount_info mount_adapt
negative_add negative_bulkadd negative_prints negative_info negative_tag negative_search
lens_add lens_sell lens_repair lens_info lens_edit lens_search
lensmodel_add lensmodel_accessory lensmodel_series lensmodel_info
print_add print_tone print_sell print_order print_fulfil print_archive print_unarchive print_locate print_info print_exhibit print_label print_worklist print_tag
paperstock_add
developer_add
toner_add
run_task run_report run_migrations
filmstock_add
teleconverter_add
filter_add filter_adapt
manufacturer_add
accessory_add accessory_category accessory_info accessory_search
enlarger_add enlarger_info enlarger_sell
flash_add
battery_add
format_add format_compat
negativesize_add negative_size_compat
lightmeter_add
process_add
person_add
projector_add
movie_add movie_info
series_add series_info series_list series_need
archive_add archive_films archive_info archive_list archive_seal archive_unseal archive_move
shuttertype_add focustype_add flashprotocol_add meteringtype_add shutterspeed_add
audit_shutterspeeds audit_exposureprograms audit_meteringmodes audit_displaylenses
exhibition_add exhibition_info
choose_manufacturer
db_stats db_logs db_test
scan_add scan_edit scan_delete scan_search scan_rename
);
# Add a new film to the database
sub film_add {
my $href = shift;
my $db = $href->{db};
my %data;
if ($href->{bulk_loaded} // &prompt({default=>'no', prompt=>'Is this film bulk-loaded?', type=>'boolean'}) == 1) {
# These are filled in only for bulk-loaded films
$data{film_bulk_id} = $href->{film_bulk_id} // &listchoices({db=>$db, table=>'choose_bulk_film', required=>1});
$data{film_bulk_loaded} = $href->{film_bulk_loaded} // &prompt({default=>&today, prompt=>'When was the film bulk-loaded?'});
# These are deduced automagically for bulk-loaded films
$data{film_batch} = $href->{film_batch} // &lookupval({db=>$db, col=>'batch', table=>'FILM_BULK', where=>{film_bulk_id=>$data{'film_bulk_id'}}});
$data{film_expiry} = $href->{film_expiry} // &lookupval({db=>$db, col=>'expiry', table=>'FILM_BULK', where=>{film_bulk_id=>$data{'film_bulk_id'}}});
$data{purchase_date} = $href->{purchase_date} // &lookupval({db=>$db, col=>'purchase_date', table=>'FILM_BULK', where=>{film_bulk_id=>$data{'film_bulk_id'}}});
$data{filmstock_id} = $href->{filmstock_id} // &lookupval({db=>$db, col=>'filmstock_id', table=>'FILM_BULK', where=>{film_bulk_id=>$data{'film_bulk_id'}}});
$data{format_id} = $href->{format_id} // &lookupval({db=>$db, col=>'format_id', table=>'FILM_BULK', where=>{film_bulk_id=>$data{'film_bulk_id'}}});
} else {
# These are filled in only for standalone films
$data{film_batch} = $href->{film_batch} // &prompt({prompt=>'Film batch number'});
$data{film_expiry} = $href->{film_expiry} // &prompt({prompt=>'Film expiry date', type=>'date'});
$data{purchase_date} = $href->{purchase_date} // &prompt({default=>&today, prompt=>'Purchase date', type=>'date'});
$data{filmstock_id} = $href->{filmstock_id} // &listchoices({db=>$db, table=>'choose_filmstock', inserthandler=>\&filmstock_add, required=>1});
$data{format_id} = $href->{format_id} // &listchoices({db=>$db, cols=>['format_id as id', 'format as opt'], table=>'FORMAT', inserthandler=>\&format_add}, required=>1);
}
$data{frames} = $href->{frames} // &prompt({prompt=>'How many frames?', type=>'integer'});
$data{price} = $href->{price} // &prompt({prompt=>'Purchase price', type=>'decimal'});
my $film_id = &newrecord({db=>$db, data=>\%data, table=>'FILM'});
if (&prompt({default=>'no', prompt=>'Load this film into a camera now?', type=>'boolean'})) {
&film_load({db=>$db, film_id=>$film_id});
}
return $film_id;
}
# Load a film into a camera
sub film_load {
my $href = shift;
my $db = $href->{db};
my $film_id = $href->{film_id} // &listchoices({db=>$db, table=>'choose_film_to_load', required=>1});
my %data;
$data{camera_id} = $href->{camera_id} // &listchoices({db=>$db, table=>'choose_camera_by_film', where=>{film_id=>$film_id}, required=>1});
$data{exposed_at} = $href->{exposed_at} // &prompt({default=>&lookupval({db=>$db, col=>"iso", table=>'FILM join FILMSTOCK on FILM.filmstock_id=FILMSTOCK.filmstock_id', where=>{film_id=>$film_id}}), prompt=>'What ISO?', type=>'integer'});
$data{date_loaded} = $href->{date_loaded} // &prompt({default=>&today, prompt=>'What date was this film loaded?', type=>'date'});
$data{notes} = $href->{notes} // &prompt({prompt=>'Notes'});
return &updaterecord({db=>$db, data=>\%data, table=>'FILM', where=>{film_id=>$film_id}});
}
# Put a film in a physical archive
sub film_archive {
my $href = shift;
my $db = $href->{db};
my $film_id = $href->{film_id} // &film_choose({db=>$db});
my %data;
$data{archive_id} = $href->{archive_id} // &listchoices({db=>$db, table=>'ARCHIVE', cols=>['archive_id as id', 'name as opt'], where=>['archive_type_id in (1,2)', 'sealed = 0'], inserthandler=>\&archive_add, required=>1});
return &updaterecord({db=>$db, data=>\%data, table=>'FILM', where=>{film_id=>$film_id}});
}
# Develop a film
sub film_develop {
my $href = shift;
my $db = $href->{db};
my $film_id = $href->{film_id} // &listchoices({db=>$db, table=>'choose_film_to_develop', required=>1});
my %data;
$data{date} = $href->{date} // &prompt({default=>&today, prompt=>'What date was this film processed?', type=>'date'});
$data{developer_id} = $href->{developer_id} // &listchoices({db=>$db, table=>'DEVELOPER', cols=>['developer_id as id', 'name as opt'], where=>{'for_film'=>1}, inserthandler=>\&developer_add});
$data{directory} = $href->{directory} // &prompt({prompt=>'What directory are these scans in?'});
$data{dev_uses} = $href->{dev_uses} // &prompt({prompt=>'How many previous uses has the developer had?', type=>'integer'});
$data{dev_time} = $href->{dev_time} // &prompt({prompt=>'How long was the film developed for?', type=>'time'});
$data{dev_temp} = $href->{dev_temp} // &prompt({prompt=>'What temperature was the developer?', type=>'decimal'});
$data{dev_n} = $href->{dev_n} // &prompt({default=>0, prompt=>'What push/pull was used?', type=>'integer'});
$data{development_notes} = $href->{development_notes} // &prompt({prompt=>'Any other development notes'});
$data{processed_by} = $href->{processed_by} // &prompt({prompt=>'Who developed the film?'});
&updaterecord({db=>$db, data=>\%data, table=>'FILM', where=>{film_id=>$film_id}});
if (&prompt({default=>'no', prompt=>'Archive this film now?', type=>'boolean'})) {
&film_archive({db=>$db, film_id=>$film_id});
}
return;
}
# Show information about a negative
sub film_info {
my $href = shift;
my $db = $href->{db};
my $film_id = $href->{film_id} // &film_choose({db=>$db});
print Dump(&lookupcol({db=>$db, table=>'info_film', where=>{'`Film ID`'=>$film_id}}));
return;
}
# Write EXIF tags to scans from a film
sub film_tag {
my $href = shift;
my $db = $href->{db};
my $film_id = $href->{film_id} // &film_choose({db=>$db});
&tag({db=>$db, where=>{film_id=>$film_id}});
return;
}
# Locate where this film is
sub film_locate {
my $href = shift;
my $db = $href->{db};
my $film_id = $href->{film_id} // &film_choose({db=>$db});
if (my $archiveid = &lookupval({db=>$db, col=>'archive_id', table=>'FILM', where=>{film_id=>$film_id}})) {
my $archive = &lookupval({db=>$db, col=>"concat(name, ' (', location, ')') as archive", table=>'ARCHIVE', where=>{archive_id=> $archiveid}});
print "Film #${film_id} is in $archive\n";
} else {
print "The location of film #${film_id} is unknown\n";
}
return;
}
# Add a new bulk film to the database
sub film_bulk {
my $href = shift;
my $db = $href->{db};
my %data;
$data{filmstock_id} = &listchoices({db=>$db, table=>'choose_filmstock', inserthandler=>\&filmstock_add, required=>1});
$data{format_id} = &listchoices({db=>$db, cols=>['format_id as id', 'format as opt'], table=>'FORMAT', inserthandler=>\&format_add, required=>1});
$data{batch} = &prompt({prompt=>'Film batch number'});
$data{expiry} = &prompt({prompt=>'Film expiry date', type=>'date'});
$data{purchase_date} = &prompt({default=>&today, prompt=>'Purchase date', type=>'date'});
$data{cost} = &prompt({prompt=>'Purchase price', type=>'decimal'});
$data{source} = &prompt({prompt=>'Where was this bulk film purchased from?'});
return &newrecord({db=>$db, data=>\%data, table=>'FILM_BULK'});
}
# Write out a text file with the scans from the film
sub film_annotate {
my $href = shift;
my $db = $href->{db};
my $film_id = $href->{film_id} // &film_choose({db=>$db});
&annotatefilm({db=>$db, film_id=>$film_id});
return;
}
# List the films that are currently in stock
sub film_stocks {
my $href = shift;
my $db = $href->{db};
print "Films currently in stock:\n";
my $rows = &tabulate({db=>$db, view=>'view_film_stocks'});
if ($rows > 0) {
if (&prompt({default=>'yes', prompt=>'Load a film into a camera now?', type=>'boolean'})) {
&film_load({db=>$db});
}
} else {
print "No films currently in stock\n";
}
return;
}
# List films that are currently loaded into cameras
sub film_current {
my $href = shift;
my $db = $href->{db};
&printlist({db=>$db, msg=>"current films", table=>'current_films'});
return;
}
sub film_choose {
my $href = shift;
my $db = $href->{db};
while (1) {
my $film_id = &prompt({prompt=>'Enter film ID if you know it, or leave blank to choose', type=>'integer'});
if ($film_id ne '') {
my $info = &lookupval({db=>$db, col=>'notes', table=>'FILM', where=>{film_id=>$film_id}});
return $film_id if &prompt({default=>'yes', prompt=>"This film is entitled $info. Is this the right film?", type=>'boolean'})
} else {
my %where;
#narrow by format
if (&prompt({default=>'no', prompt=>'Narrow search by film format?', type=>'boolean'})) {
$where{format_id} = &listchoices({db=>$db, cols=>['format_id as id', 'format as opt'], table=>'FORMAT'});
}
if (&prompt({default=>'no', prompt=>'Narrow search by filmstock?', type=>'boolean'})) {
$where{filmstock_id} = &listchoices({db=>$db, table=>'choose_filmstock'});
}
if (&prompt({default=>'no', prompt=>'Narrow search by the camera the film was loaded into?', type=>'boolean'})) {
$where{camera_id} = &listchoices({db=>$db, table=>'choose_camera'});
}
#listchoices
$where{notes} = {'!=',undef};
my $thinwhere = &thin(\%where);
return &listchoices({db=>$db, cols=>['film_id as id', 'notes as opt'], table=>'FILM', where=>$thinwhere, required=>1});
}
}
return;
}
# Search for a film
sub film_search {
my $href = shift;
my $db = $href->{db};
my $searchterm = $href->{searchterm} // &prompt({prompt=>'Enter search term'});
# Perform search
my $id = &search({
db => $db,
cols => ['film_id as id', 'notes as opt'],
table => 'FILM',
where => "notes like '%$searchterm%' collate utf8mb4_general_ci",
searchterm => $searchterm,
choices => [
{ desc => 'Do nothing' },
{ handler => \&film_annotate, desc => 'Write out a text file with the scans from the film', id=>'film_id' },
{ handler => \&film_archive, desc => 'Put this film in a physical archive', id=>'film_id' },
{ handler => \&film_develop, desc => 'Develop this film', id=>'film_id' },
{ handler => \&film_info, desc => 'Show information about this film', id=>'film_id' },
{ handler => \&film_locate, desc => 'Locate where this film is', id=>'film_id' },
{ handler => \&film_tag, desc => 'Write EXIF tags to scans from this film', id=>'film_id' },
],
});
return $id;
}
# Add a new camera model to the database
sub cameramodel_add {
my $href = shift;
my $db = $href->{db};
# Gather data from user
my $datahr = &camera_prompt({db=>$db});
my %data = %$datahr;
# Insert new record into DB
my $cameramodel_id = &newrecord({db=>$db, data=>\%data, table=>'CAMERAMODEL'});
# Now we have a camera model ID, we can insert rows in auxiliary tables
if (&prompt({default=>'yes', prompt=>'Add exposure programs for this camera model?', type=>'boolean'})) {
&cameramodel_exposureprogram({db=>$db, cameramodel_id=>$cameramodel_id});
}
if (&prompt({default=>'yes', prompt=>'Add metering modes for this camera model?', type=>'boolean'})) {
if ($data{metering}) {
&cameramodel_meteringmode({db=>$db, cameramodel_id=>$cameramodel_id});
} else {
my %mmdata = ('cameramodel_id' => $cameramodel_id, 'metering_mode_id' => 0);
&newrecord({db=>$db, data=>\%mmdata, table=>'METERING_MODE_AVAILABLE'});
}
}
if (&prompt({default=>'yes', prompt=>'Add shutter speeds for this camera model?', type=>'boolean'})) {
&cameramodel_shutterspeeds({db=>$db, cameramodel_id=>$cameramodel_id});
}
if (&prompt({default=>'yes', prompt=>'Add accessory compatibility for this camera model?', type=>'boolean'})) {
&cameramodel_accessory({db=>$db, cameramodel_id=>$cameramodel_id});
}
if (&prompt({default=>'no', prompt=>'Add this camera model to a series?', type=>'boolean'})) {
&cameramodel_series({db=>$db, cameramodel_id=>$cameramodel_id});
}
return $cameramodel_id;
}
# Show information about a cameramodel
sub cameramodel_info {
my $href = shift;
my $db = $href->{db};
# Choose camera
my $cameramodel_id = $href->{cameramodel_id} // &listchoices({db=>$db, table=>'choose_cameramodel', required=>1});
# Get camera data
my $cameradata = &lookupcol({db=>$db, table=>'info_cameramodel', where=>{'`Camera Model ID`'=>$cameramodel_id}});
# Show compatible accessories
my $accessories = &lookuplist({db=>$db, col=>'opt', table=>'choose_accessory_compat', where=>{cameramodel_id=>$cameramodel_id}});
${@$cameradata[0]}{'Accessories'} = $accessories;
print Dump($cameradata);
return;
}
# Add a new camera to the database
sub camera_add {
my $href = shift;
my $db = $href->{db};
# Gather data from user
my %data;
my $manufacturer_id = &choose_manufacturer({db=>$db});
$data{cameramodel_id} = &listchoices({db=>$db, table=>'choose_cameramodel', where=>{'manufacturer_id'=>$manufacturer_id}, required=>1, inserthandler=>\&cameramodel_add});
$data{acquired} = &prompt({default=>&today, prompt=>'When was it acquired?', type=>'date'});
$data{cost} = &prompt({prompt=>'What did the camera cost?', type=>'decimal'});
$data{serial} = &prompt({prompt=>'What is the camera\'s serial number?'});
$data{datecode} = &prompt({prompt=>'What is the camera\'s datecode?'});
# Attempt to decode datecode for Canon cameras
my $manufactured;
if ($manufacturer_id == 3 && $data{datecode}) {
my $introduced = &lookupval({db=>$db, col=>'introduced', table=>'CAMERAMODEL', where=>{cameramodel_id=>$data{cameramodel_id}}});
my $discontinued = &lookupval({db=>$db, col=>'discontinued', table=>'CAMERAMODEL', where=>{cameramodel_id=>$data{cameramodel_id}}});
$manufactured = &canondatecode({datecode=>$data{datecode}, introduced=>$introduced, discontinued=>$discontinued});
}
$data{manufactured} = &prompt({prompt=>'When was the camera manufactured?', type=>'integer', default=>$manufactured});
$data{own} = &prompt({default=>'yes', prompt=>'Do you own this camera?', type=>'boolean'});
$data{notes} = &prompt({prompt=>'Additional notes'});
$data{source} = &prompt({prompt=>'Where was the camera acquired from?'});
$data{condition_id} = &listchoices({db=>$db, keyword=>'condition', cols=>['condition_id as id', 'name as opt'], table=>'`CONDITION`'});
if (&lookupval({db=>$db, col=>'fixed_mount', table=>'CAMERAMODEL', where=>{cameramodel_id=>$data{cameramodel_id}}})) {
# Attempt to figure out the lensmodel that comes with this cameramodel
my $lensmodel_id = &lookupval({db=>$db, col=>'lensmodel_id', table=>'CAMERAMODEL', where=>{cameramodel_id=>$data{cameramodel_id}}});
# Get info about lens
print "Please enter some information about the lens\n";
$data{lens_id} = &lens_add({db=>$db, cost=>0, own=>$data{own}, lensmodel_id=>$lensmodel_id, acquired=>$data{acquired}, source=>$data{source}});
}
if (defined($data{mount_id})) {
$data{display_lens} = &listchoices({db=>$db, table=>'choose_display_lens', where=>{mount_id=>$data{mount_id}}, skipok=>1});
}
# Insert new record into DB
my $camera_id = &newrecord({db=>$db, data=>\%data, table=>'CAMERA'});
return $camera_id;
}
# Edit an existing camera
sub camera_edit {
my $href = shift;
my $db = $href->{db};
my $camera_id = $href->{camera_id} // &listchoices({db=>$db, table=>'choose_camera', required=>1});
my $existing = &lookupcol({db=>$db, table=>'CAMERA', where=>{camera_id=>$camera_id}});
$existing = @$existing[0];
# Gather data from user
my %data;
$data{acquired} = &prompt({default=>$$existing{acquired}//&today, prompt=>'When was it acquired?', type=>'date'});
$data{cost} = &prompt({prompt=>'What did the camera cost?', type=>'decimal', default=>$$existing{cost}});
$data{serial} = &prompt({prompt=>'What is the camera\'s serial number?', default=>$$existing{serial}});
$data{datecode} = &prompt({prompt=>'What is the camera\'s datecode?', default=>$$existing{datecode}});
$data{manufactured} = &prompt({prompt=>'When was the camera manufactured?', type=>'integer', default=>$$existing{manufactured}});
$data{own} = &prompt({default=>$$existing{own}//'yes', prompt=>'Do you own this camera?', type=>'boolean'});
$data{notes} = &prompt({prompt=>'Additional notes', default=>$$existing{notes}});
$data{source} = &prompt({prompt=>'Where was the camera acquired from?', default=>$$existing{source}});
$data{condition_id} = &listchoices({db=>$db, keyword=>'condition', cols=>['condition_id as id', 'name as opt'], table=>'`CONDITION`', default=>$$existing{condition_id}});
# Compare new and old data to find changed fields
my $changes = &hashdiff($existing, \%data);
# Update the DB
return &updaterecord({db=>$db, data=>$changes, table=>'CAMERA', where=>{camera_id=>$camera_id}});
}
sub camera_prompt {
my $href = shift;
my $db = $href->{db};
my $defaults = $href->{defaults};
my %data;
$data{manufacturer_id} = &choose_manufacturer({db=>$db, default=>$$defaults{manufacturer_id}});
$data{model} = &prompt({prompt=>'What model is the camera?', required=>1, default=>$$defaults{model}});
$data{fixed_mount} = &prompt({prompt=>'Does this camera have a fixed lens?', type=>'boolean', required=>1, default=>$$defaults{fixed_mount}});
if (defined($data{fixed_mount}) && $data{fixed_mount} == 1 && !defined($$defaults{lens_id})) {
# Get info about lens
print "Please select the lens model that this camera has\n";
$data{lensmodel_id} = &listchoices({db=>$db, table=>'choose_lensmodel', required=>1, inserthandler=>\&lensmodel_add});
} else {
$data{mount_id} = &listchoices({db=>$db, cols=>['mount_id as id', 'mount as opt'], table=>'choose_mount', where=>{purpose=>'Camera'}, inserthandler=>\&mount_add, default=>$$defaults{mount_id}});
}
$data{format_id} = &listchoices({db=>$db, cols=>['format_id as id', 'format as opt'], table=>'FORMAT', inserthandler=>\&format_add, required=>1, default=>$$defaults{format_id}});
$data{negative_size_id} = &listchoices({db=>$db, cols=>['negative_size_id as id', 'negative_size as opt'], table=>'choose_negativeformat', where=>{format_id=>$data{format_id}}, inserthandler=>\&negative_size_compat, default=>$$defaults{negative_size...
$data{focus_type_id} = &listchoices({db=>$db, cols=>['focus_type_id as id', 'focus_type as opt'], table=>'FOCUS_TYPE', inserthandler=>\&focustype_add, default=>$$defaults{focus_type_id}});
$data{metering} = &prompt({prompt=>'Does this camera have metering?', type=>'boolean', default=>$$defaults{metering}});
if (defined($data{metering}) && $data{metering} == 1) {
$data{coupled_metering} = &prompt({prompt=>'Is the metering coupled?', type=>'boolean', default=>$$defaults{coupled_metering}});
$data{metering_type_id} = &listchoices({db=>$db, cols=>['metering_type_id as id', 'metering as opt'], table=>'METERING_TYPE', inserthandler=>\&meteringtype_add, default=>$$defaults{metering_type_id}});
$data{meter_min_ev} = &prompt({prompt=>'What\'s the lowest EV the meter can handle?', type=>'integer', default=>$$defaults{meter_min_ev}});
$data{meter_max_ev} = &prompt({prompt=>'What\'s the highest EV the meter can handle?', type=>'integer', default=>$$defaults{meter_max_ev}});
}
$data{body_type_id} = &listchoices({db=>$db, cols=>['body_type_id as id', 'body_type as opt'], table=>'BODY_TYPE', inserthandler=>\&camera_addbodytype, default=>$$defaults{body_type_id}});
$data{weight} = &prompt({prompt=>'What does it weigh? (g)', type=>'integer', default=>$$defaults{weight}});
$data{introduced} = &prompt({prompt=>'What year was the camera introduced?', type=>'integer', default=>$$defaults{introduced}});
$data{discontinued} = &prompt({prompt=>'What year was the camera discontinued?', type=>'integer', default=>$$defaults{discontinued}});
$data{shutter_type_id} = &listchoices({db=>$db, cols=>['shutter_type_id as id', 'shutter_type as opt'], table=>'SHUTTER_TYPE', inserthandler=>\&shuttertype_add, default=>$$defaults{shutter_type_id}});
$data{shutter_model} = &prompt({prompt=>'What is the shutter model?', default=>$$defaults{shutter_model}});
$data{cable_release} = &prompt({prompt=>'Does this camera have a cable release?', type=>'boolean', default=>$$defaults{cable_release}});
$data{viewfinder_coverage} = &prompt({prompt=>'What is the viewfinder coverage?', type=>'integer', default=>$$defaults{viewfinder_coverage}});
$data{power_drive} = &prompt({prompt=>'Does this camera have power drive?', type=>'boolean', default=>$$defaults{power_drive}});
if (defined($data{power_drive}) && $data{power_drive} == 1) {
$data{continuous_fps} = &prompt({prompt=>'How many frames per second can this camera manage?', type=>'decimal', default=>$$defaults{continuous_fps}});
}
$data{video} = &prompt({default=>$$defaults{video}//'no', prompt=>'Does this camera have a video/movie function?', type=>'boolean'});
$data{digital} = &prompt({default=>$$defaults{digital}//'no', prompt=>'Is this a digital camera?', type=>'boolean'});
$data{battery_qty} = &prompt({prompt=>'How many batteries does this camera take?', type=>'integer', default=>$$defaults{battery_qty}});
if (defined($data{battery_qty}) && $data{battery_qty} > 0) {
$data{battery_type} = &listchoices({db=>$db, keyword=>'battery type', table=>'choose_battery', inserthandler=>\&battery_add, default=>$$defaults{battery_type}});
}
$data{notes} = &prompt({prompt=>'Additional notes', default=>$$defaults{notes}});
$data{bulb} = &prompt({prompt=>'Does the camera have bulb exposure mode?', type=>'boolean', default=>$$defaults{bulb}});
$data{time} = &prompt({prompt=>'Does the camera have time exposure mode?', type=>'boolean', default=>$$defaults{time}});
$data{min_iso} = &prompt({prompt=>'What\'s the lowest ISO the camera can do?', type=>'integer', default=>$$defaults{min_iso}});
$data{max_iso} = &prompt({prompt=>'What\'s the highest ISO the camera can do?', type=>'integer', default=>$$defaults{max_iso}});
$data{af_points} = &prompt({prompt=>'How many autofocus points does the camera have?', type=>'integer', default=>$$defaults{af_points}});
$data{int_flash} = &prompt({prompt=>'Does the camera have an internal flash?', type=>'boolean', default=>$$defaults{int_flash}});
if (defined($data{int_flash}) && $data{int_flash} == 1) {
$data{int_flash_gn} = &prompt({prompt=>'What\'s the guide number of the internal flash?', type=>'integer', default=>$$defaults{int_flash_gn}});
}
$data{ext_flash} = &prompt({prompt=>'Does the camera support an external flash?', type=>'boolean', default=>$$defaults{ext_flash}});
if ($data{ext_flash} == 1) {
$data{pc_sync} = &prompt({prompt=>'Does the camera have a PC sync socket?', type=>'boolean', default=>$$defaults{pc_sync}});
$data{hotshoe} = &prompt({prompt=>'Does the camera have a hot shoe?', type=>'boolean', default=>$$defaults{hotshoe}});
}
if ($data{int_flash} == 1 || $data{ext_flash} == 1) {
$data{coldshoe} = &prompt({prompt=>'Does the camera have a cold/accessory shoe?', type=>'boolean', default=>$$defaults{coldshoe}});
$data{x_sync} = &prompt({prompt=>'What\'s the X-sync speed?', type=>'text', default=>$$defaults{x_sync}});
$data{flash_metering} = &listchoices({db=>$db, table=>'choose_flash_protocol', inserthandler=>\&flashprotocol_add, default=>$$defaults{flash_metering}});
}
$data{dof_preview} = &prompt({prompt=>'Does this camera have a depth-of-field preview feature?', type=>'boolean', default=>$$defaults{dof_preview}});
$data{tripod} = &prompt({prompt=>'Does this camera have a tripod bush?', type=>'boolean', default=>$$defaults{tripod}});
return \%data;
}
# Add accessory compatibility info to a camera
sub cameramodel_accessory {
my $href = shift;
my $db = $href->{db};
my $cameramodel_id = $href->{cameramodel_id} // &listchoices({db=>$db, table=>'choose_cameramodel', required=>1});
while (1) {
my %compatdata;
$compatdata{accessory_id} = &listchoices({db=>$db, table=>'choose_accessory'});
$compatdata{cameramodel_id} = $cameramodel_id;
&newrecord({db=>$db, data=>\%compatdata, table=>'ACCESSORY_COMPAT', silent=>1});
last if (!&prompt({default=>'yes', prompt=>'Add more accessory compatibility info?', type=>'boolean'}));
}
return;
}
# Add a compatible negative size to a known film format
sub negative_size_compat {
my $href = shift;
my $db = $href->{db};
my %compatdata;
$compatdata{format_id} = $href->{format_id} // &listchoices({db=>$db, cols=>['format_id as id', 'format as opt'], table=>'FORMAT'});
$compatdata{negative_size_id} = &listchoices({db=>$db, cols=>['negative_size_id as id', 'negative_size as opt'], table=>'NEGATIVE_SIZE', inserthandler=>\&negativesize_add});
&newrecord({db=>$db, data=>\%compatdata, table=>'NEGATIVEFORMAT_COMPAT', silent=>1});
return $compatdata{negative_size_id};
}
# Add a compatible film format to a known negative size
sub format_compat {
my $href = shift;
my $db = $href->{db};
my %compatdata;
$compatdata{negative_size_id} = $href->{negative_size_id} // &listchoices({db=>$db, cols=>['negative_size_id as id', 'negative_size as opt'], table=>'NEGATIVE_SIZE'});
$compatdata{format_id} = &listchoices({db=>$db, cols=>['format_id as id', 'format as opt'], table=>'FORMAT', inserthandler=>\&format_add});
&newrecord({db=>$db, data=>\%compatdata, table=>'NEGATIVEFORMAT_COMPAT', silent=>1});
return $compatdata{format_id};
}
# Add available shutter speed info to a camera model
sub cameramodel_shutterspeeds {
my $href = shift;
my $db = $href->{db};
my $cameramodel_id = $href->{cameramodel_id} // &listchoices({db=>$db, table=>'choose_cameramodel', required=>1});
my $min_shutter_speed = &listchoices({db=>$db, keyword=>'min (fastest) shutter speed', query=>"SELECT shutter_speed as id, '' as opt FROM SHUTTER_SPEED where shutter_speed not in ('B', 'T') and shutter_speed not in (select shutter_speed from SHUTTER...
&newrecord({db=>$db, data=>{cameramodel_id=>$cameramodel_id, shutter_speed=>$min_shutter_speed}, table=>'SHUTTER_SPEED_AVAILABLE', silent=>1});
my $min_shutter_speed_duration = &duration($min_shutter_speed);
my $max_shutter_speed = &listchoices({db=>$db, keyword=>'max (slowest) shutter speed', query=>"SELECT shutter_speed as id, '' as opt FROM SHUTTER_SPEED where shutter_speed not in ('B', 'T') and duration > $min_shutter_speed_duration and shutter_spee...
my $max_shutter_speed_duration = &duration($max_shutter_speed);
&newrecord({db=>$db, data=>{cameramodel_id=>$cameramodel_id, shutter_speed=>$max_shutter_speed}, table=>'SHUTTER_SPEED_AVAILABLE', silent=>1});
while (1) {
my %shutterdata;
$shutterdata{shutter_speed} = &listchoices({db=>$db, keyword=>'shutter speed', query=>"SELECT shutter_speed as id, '' as opt FROM SHUTTER_SPEED where duration > $min_shutter_speed_duration and duration < $max_shutter_speed_duration and shutter_spee...
last if (!$shutterdata{shutter_speed});
$shutterdata{cameramodel_id} = $cameramodel_id;
&newrecord({db=>$db, data=>\%shutterdata, table=>'SHUTTER_SPEED_AVAILABLE', silent=>1});
}
return;
}
# Add available exposure program info to a camera
sub cameramodel_exposureprogram {
my $href = shift;
my $db = $href->{db};
my $cameramodel_id = $href->{cameramodel_id} // &listchoices({db=>$db, table=>'choose_cameramodel', required=>1});
my $exposureprograms = &lookupcol({db=>$db, table=>'EXPOSURE_PROGRAM'});
foreach my $exposureprogram (@$exposureprograms) {
# Skip 'creative' AE modes
next if $exposureprogram->{exposure_program_id} == 5;
next if $exposureprogram->{exposure_program_id} == 6;
next if $exposureprogram->{exposure_program_id} == 7;
next if $exposureprogram->{exposure_program_id} == 8;
if (&prompt({default=>'no', prompt=>"Does this camera have $exposureprogram->{exposure_program} exposure program?", type=>'boolean'})) {
my %epdata = ('cameramodel_id' => $cameramodel_id, 'exposure_program_id' => $exposureprogram->{exposure_program_id});
&newrecord({db=>$db, data=>\%epdata, table=>'EXPOSURE_PROGRAM_AVAILABLE', silent=>1});
last if $exposureprogram->{exposure_program_id} == 0;
}
}
return;
}
# Add available metering mode info to a camera
sub cameramodel_meteringmode {
my $href = shift;
my $db = $href->{db};
my $cameramodel_id = $href->{cameramodel_id} // &listchoices({db=>$db, table=>'choose_cameramodel', required=>1});
my $meteringmodes = &lookupcol({db=>$db, table=>'METERING_MODE'});
foreach my $meteringmode (@$meteringmodes) {
if (&prompt({default=>'no', prompt=>"Does this camera have $meteringmode->{metering_mode} metering?", type=>'boolean'})) {
my %mmdata = ('cameramodel_id' => $cameramodel_id, 'metering_mode_id' => $meteringmode->{metering_mode_id});
&newrecord({db=>$db, data=>\%mmdata, table=>'METERING_MODE_AVAILABLE', silent=>1});
last if $meteringmode->{metering_mode_id} == 0;
}
}
return;
}
# Add a cameramodel to a series
sub cameramodel_series {
my $href = shift;
my $db = $href->{db};
my %data;
$data{cameramodel_id} = $href->{cameramodel_id} // &listchoices({db=>$db, table=>'choose_cameramodel', required=>1});
$data{series_id} = $href->{series_id} // &listchoices({db=>$db, cols=>['series_id as id', 'name as opt'], table=>'SERIES', required=>1, inserthandler=>\&series_add});
return &newrecord({db=>$db, data=>\%data, table=>'SERIES_MEMBER'});
}
# Associate a camera with a lens for display purposes
sub camera_displaylens {
my $href = shift;
my $db = $href->{db};
my %data;
my $camera_id = $href->{camera_id} // &listchoices({db=>$db, keyword=>'camera', table=>'choose_camera', where=>{mount_id=>{'!=', undef}}, required=>1 });
my $mount = &lookupval({db=>$db, col=>'mount_id', table=>'choose_camera', where=>{id=>$camera_id}});
$data{display_lens} = &listchoices({db=>$db, table=>'choose_display_lens', where=>{camera_id=>[$camera_id, undef], mount_id=>$mount}, default=>&lookupval({db=>$db, col=>'display_lens', table=>'CAMERA', where=>{camera_id=>$camera_id}})});
return &updaterecord({db=>$db, data=>\%data, table=>'CAMERA', where=>{camera_id=>$camera_id}});
}
# Search for a camera
sub camera_search {
my $href = shift;
my $db = $href->{db};
my $searchterm = $href->{searchterm} // &prompt({prompt=>'Enter camera search term'});
# Perform search
my $id = &search({
db => $db,
table => 'choose_camera',
searchterm => $searchterm,
choices => [
{ desc => 'Do nothing' },
{ handler => \&camera_info, desc => 'Get camera info', id=>'camera_id' },
{ handler => \&cameramodel_accessory, desc => 'Add accessory compatibility info', id=>'camera_id' },
{ handler => \&camera_displaylens, desc => 'Associate with a lens for display', id=>'camera_id' },
{ handler => \&camera_edit, desc => 'Edit this camera', id=>'camera_id' },
{ handler => \&cameramodel_exposureprogram, desc => 'Add available exposure program info', id=>'camera_id' },
{ handler => \&cameramodel_meteringmode, desc => 'Add available metering mode info', id=>'camera_id' },
{ handler => \&camera_repair, desc => 'Repair this camera', id=>'camera_id' },
{ handler => \&cameramodel_shutterspeeds, desc => 'Add available shutter speed info', id=>'camera_id' },
{ handler => \&camera_sell, desc => 'Sell this camera', id=>'camera_id' },
{ handler => \&film_load, desc => 'Load a film', id=>'camera_id' },
],
});
return $id;
}
# Sell a camera
sub camera_sell {
my $href = shift;
my $db = $href->{db};
my $camera_id = $href->{camera_id} // &listchoices({db=>$db, table=>'choose_camera'});
my %data;
$data{own} = 0;
$data{lost} = $href->{lost} // &prompt({default=>&today, prompt=>'What date was this camera sold?', type=>'date'});
$data{lost_price} = $href->{lost_price} // &prompt({prompt=>'How much did this camera sell for?', type=>'decimal'});
&updaterecord({db=>$db, data=>\%data, table=>'CAMERA', where=>{camera_id=>$camera_id}});
&unsetdisplaylens({db=>$db, camera_id=>$camera_id});
if (my $lens_id = &lookupval({db=>$db, col=>'lens_id', table=>'CAMERA', where=>{camera_id=>$camera_id}})) {
my %lensdata;
$lensdata{own} = 0;
$lensdata{lost} = $data{lost};
$lensdata{lost_price} = 0;
&updaterecord({db=>$db, data=>\%lensdata, table=>'LENS', where=>{lens_id=>$lens_id}});
}
return;
}
# Repair a camera
sub camera_repair {
my $href = shift;
my $db = $href->{db};
my %data;
$data{camera_id} = $href->{camera_id} // &listchoices({db=>$db, table=>'choose_camera'});
$data{date} = $href->{date} // &prompt({default=>&today, prompt=>'What date was this camera repaired?', type=>'date'});
$data{summary} = $href->{summary} // &prompt({prompt=>'Short summary of repair'});
$data{description} = $href->{description} // &prompt({prompt=>'Longer description of repair'});
return &newrecord({db=>$db, data=>\%data, table=>'REPAIR'});
}
# Show information about a camera
sub camera_info {
my $href = shift;
my $db = $href->{db};
# Choose camera
my $camera_id = $href->{camera_id} // &listchoices({db=>$db, table=>'choose_camera', required=>1});
# Get camera data
my $cameradata = &lookupcol({db=>$db, table=>'info_camera', where=>{'`Camera ID`'=>$camera_id}});
# Get camera model
my $cameramodel_id = ${@$cameradata[0]}{'Camera Model ID'};
# Show compatible accessories
my $accessories = &lookuplist({db=>$db, col=>'opt', table=>'choose_accessory_compat', where=>{cameramodel_id=>$cameramodel_id}});
${@$cameradata[0]}{'Accessories'} = $accessories;
# Show compatible lenses
my $lenses = &lookuplist({db=>$db, col=>'lens', table=>'cameralens_compat', where=>{camera_id=>$camera_id}});
${@$cameradata[0]}{'Lenses'} = $lenses;
print Dump($cameradata);
return;
}
# Choose a camera based on several criteria
sub camera_choose {
my $href = shift;
my $db = $href->{db};
my %where;
$where{manufacturer_id} = $href->{manufacturer_id} // &choose_manufacturer({db=>$db});
$where{format_id} = $href->{format_id} // &listchoices({db=>$db, cols=>['format_id as id', 'format as opt'], table=>'FORMAT'});
$where{bulb} = $href->{bulb} // &prompt({prompt=>'Do you need Bulb (B) shutter speed?', type=>'boolean'});
$where{time} = $href->{time} // &prompt({prompt=>'Do you need Time (T) shutter speed?', type=>'boolean'});
$where{fixed_mount} = $href->{fixed_mount} // &prompt({prompt=>'Do you need a camera with an interchangeable lens?', type=>'boolean'});
if ($where{fixed_mount} && $where{fixed_mount} != 1) {
$where{mount_id} = $href->{mount_id} // &listchoices({db=>$db, cols=>['mount_id as id', 'mount as opt'], table=>'choose_mount', where=>{'purpose'=>'Camera'}});
}
$where{focus_type_id} = $href->{focus_type_id} // &listchoices({db=>$db, cols=>['focus_type_id as id', 'focus_type as opt'], table=>'FOCUS_TYPE', 'integer'});
$where{metering} = $href->{metering} // &prompt({prompt=>'Do you need a camera with metering?', type=>'boolean'});
if ($where{metering} && $where{metering} == 1) {
$where{coupled_metering} = $href->{coupled_metering} // &prompt({prompt=>'Do you need coupled metering?', type=>'boolean'});
$where{metering_type_id} = $href->{metering_type_id} // &listchoices({db=>$db, cols=>['metering_type_id as id', 'metering as opt'], table=>'METERING_TYPE'});
}
$where{body_type_id} = $href->{body_type_id} // &listchoices({db=>$db, cols=>['body_type_id as id', 'body_type as opt'], table=>'BODY_TYPE'});
$where{negative_size_id} = $href->{negative_size_id} // &listchoices({db=>$db, cols=>['negative_size_id as id', 'negative_size as opt'], table=>'NEGATIVE_SIZE'});
$where{cable_release} = $href->{cable_release} // &prompt({prompt=>'Do you need a camera with cable release?', type=>'boolean'});
$where{power_drive} = $href->{power_drive} // &prompt({prompt=>'Do you need a camera with power drive?', type=>'boolean'});
$where{int_flash} = $href->{int_flash} // &prompt({prompt=>'Do you need a camera with internal flash?', type=>'boolean'});
$where{ext_flash} = $href->{ext_flash} // &prompt({prompt=>'Do you need a camera that supports an external flash?', type=>'boolean'});
if ($where{ext_flash} && $where{ext_flash} == 1) {
$where{pc_sync} = $href->{pc_sync} // &prompt({prompt=>'Do you need a PC sync socket?', type=>'boolean'});
$where{hotshoe} = $href->{hotshoe} // &prompt({prompt=>'Do you need a hot shoe?', type=>'boolean'});
}
if (($where{int_flash} && $where{int_flash} == 1) || ($where{ext_flash} && $where{ext_flash} == 1)) {
$where{coldshoe} = $href->{coldshoe} // &prompt({prompt=>'Do you need a cold/accessory shoe?', type=>'boolean'});
$where{flash_metering} = $href->{flash_metering} // &listchoices({db=>$db, table=>'choose_flash_protocol'});
}
$where{dof_preview} = $href->{dof_preview} // &prompt({prompt=>'Do you need a depth-of-field preview feature?', type=>'boolean'});
$where{tripod} = $href->{tripod} // &prompt({prompt=>'Do you need a tripod bush?', type=>'boolean'});
my $thinwhere = &thin(\%where);
&printlist({db=>$db, msg=>"cameras that match your criteria", table=>'camera_chooser', where=>$thinwhere});
return;
}
# Add a new negative to the database as part of a film
sub negative_add {
my $href = shift;
my $db = $href->{db};
my %data;
$data{film_id} = $href->{film_id} // &film_choose({db=>$db});
if (!&lookupval({db=>$db, col=>'camera_id', table=>'FILM', where=>{film_id=>$data{film_id}}})) {
print 'Film must be loaded into a camera before you can add negatives\n';
if (&prompt({default=>'yes', prompt=>'Load film into a camera now?', type=>'boolean'})) {
&film_load({db=>$db, film_id=>$data{film_id}});
} else {
return;
}
}
$data{frame} = $href->{frame} // &prompt({prompt=>'Frame number'});
$data{description} = $href->{description} // &prompt({prompt=>'Caption'});
$data{date} = $href->{date} // &prompt({default=>&today, prompt=>'What date was this negative taken?', type=>'date'});
$data{lens_id} = $href->{lens_id} // &listchoices({db=>$db, keyword=>'lens', table=>'choose_lens_by_film', where=>{film_id=>$data{film_id}}});
$data{shutter_speed} = $href->{shutter_speed} // &choose_shutterspeed({db=>$db, film_id=>$data{film_id}});
$data{aperture} = $href->{aperture} // &prompt({prompt=>'Aperture', type=>'decimal'});
my $filter_dia = 0;
if ($data{lens_id}) {
$filter_dia = &lookupval({db=>$db, col=>'if(filter_thread, filter_thread, 0)', table=>'LENS join LENSMODEL on LENS.lensmodel_id=LENSMODEL.lensmodel_id', where=>{lens_id=>$data{lens_id}}});
}
$data{filter_id} = $href->{filter_id} // &listchoices({db=>$db, table=>'choose_filter', where=>{'thread'=>{'>=', $filter_dia}}, inserthandler=>\&filter_add, skipok=>1, autodefault=>0});
$data{teleconverter_id} = $href->{teleconverter_id} // &listchoices({db=>$db, keyword=>'teleconverter', table=>'choose_teleconverter_by_film', where=>{film_id=>$data{film_id}}, inserthandler=>\&teleconverter_add, skipok=>1, autodefault=>0});
$data{notes} = $href->{notes} // &prompt({prompt=>'Extra notes'});
$data{mount_adapter_id} = $href->{mount_adapter_id} // &listchoices({db=>$db, table=>'choose_mount_adapter_by_film', where=>{film_id=>$data{film_id}}, skipok=>1});
$data{focal_length} = $href->{focal_length} // &prompt({default=>&lookupval({db=>$db, col=>'min_focal_length', table=>'LENS', where=>{lens_id=>$data{'lens_id'}}}), prompt=>'Focal length', type=>'integer'});
$data{latitude} = $href->{latitude} // &prompt({prompt=>'Latitude', type=>'decimal'});
$data{longitude} = $href->{longitude} // &prompt({prompt=>'Longitude', type=>'decimal'});
$data{flash} = $href->{flash} // &prompt({default=>'no', prompt=>'Was flash used?', type=>'boolean'});
$data{metering_mode} = $href->{metering_mode} // &listchoices({db=>$db, cols=>['metering_mode_id as id', 'metering_mode as opt'], table=>'METERING_MODE'});
$data{exposure_program} = $href->{exposure_program} // &listchoices({db=>$db, cols=>['exposure_program_id as id', 'exposure_program as opt'], table=>'EXPOSURE_PROGRAM'});
$data{photographer_id} = $href->{photographer_id} // &listchoices({db=>$db, keyword=>'photographer', cols=>['person_id as id', 'name as opt'], table=>'PERSON', inserthandler=>\&person_add});
if (&prompt({prompt=>'Is this negative duplicated from another?', type=>'boolean', default=>'no'})) {
$data{copy_of} = $href->{copy_of} // &chooseneg({db=>$db, oktoreturnundef=>1});
}
return &newrecord({db=>$db, data=>\%data, table=>'NEGATIVE'});
}
# Bulk add multiple negatives to the database as part of a film
sub negative_bulkadd {
my $href = shift;
my $db = $href->{db};
my %data;
$data{film_id} = $href->{film_id} // &film_choose({db=>$db});
my $num = &prompt({prompt=>'How many frames to add?', type=>'integer'});
if (&prompt({default=>'no', prompt=>"Add any other attributes to all $num negatives?", type=>'boolean'})) {
$data{description} = $href->{description} // &prompt({prompt=>'Caption'});
$data{date} = $href->{date} // &prompt({default=>&today, prompt=>'What date was this negative taken?', type=>'date'});
$data{lens_id} = $href->{lens_id} // &listchoices({db=>$db, keyword=>'lens', table=>'choose_lens_by_film', where=>{film_id=>$data{film_id}}, skipok=>1});
$data{shutter_speed} = $href->{shutter_speed} // &choose_shutterspeed({db=>$db, film_id=>$data{film_id}});
$data{aperture} = $href->{aperture} // &prompt({prompt=>'Aperture', type=>'decimal'});
$data{filter_id} = $href->{filter_id} // &listchoices({db=>$db, table=>'choose_filter', inserthandler=>\&filter_add, skipok=>1, autodefault=>0});
$data{teleconverter_id} = $href->{teleconverter_id} // &listchoices({db=>$db, keyword=>'teleconverter', table=>'choose_teleconverter_by_film', where=>{film_id=>$data{film_id}}, inserthandler=>\&teleconverter_add, skipok=>1, autodefault=>0});
$data{notes} = $href->{notes} // &prompt({prompt=>'Extra notes'});
$data{mount_adapter_id} = $href->{mount_adapter_id} // &listchoices({db=>$db, table=>'choose_mount_adapter_by_film', where=>{film_id=>$data{film_id}}, skipok=>1});
$data{focal_length} = $href->{focal_length} // &prompt({default=>&lookupval({db=>$db, col=>'min_focal_length', table=>'LENS', where=>{lens_id=>$data{lens_id}}}), prompt=>'Focal length', type=>'integer'});
$data{latitude} = $href->{latitude} // &prompt({prompt=>'Latitude', type=>'decimal'});
$data{longitude} = $href->{longitude} // &prompt({prompt=>'Longitude', type=>'decimal'});
$data{flash} = $href->{flash} // &prompt({default=>'no', prompt=>'Was flash used?', type=>'boolean'});
$data{metering_mode} = $href->{metering_mode} // &listchoices({db=>$db, cols=>['metering_mode_id as id', 'metering_mode as opt'], table=>'METERING_MODE'});
$data{exposure_program} = $href->{exposure_program} // &listchoices({db=>$db, cols=>['exposure_program_id as id', 'exposure_program as opt'], table=>'EXPOSURE_PROGRAM'});
$data{photographer_id} = $href->{photographer_id} // &listchoices({db=>$db, keyword=>'photographer', cols=>['person_id as id', 'name as opt'], table=>'PERSON', inserthandler=>\&person_add});
}
# Delete empty strings from data hash
my $thindata = &thin(\%data);
# Build query
my $sql = SQL::Abstract->new;
# Final confirmation
if (!&prompt({default=>'yes', prompt=>'Proceed?', type=>'boolean'})) {
print "Aborted!\n";
return;
}
# Execute query
for my $i (1..$num) {
# Now inside the loop, add an incremented frame number for each neg
$$thindata{frame} = $i;
# Create a new row
&newrecord({db=>$db, data=>\%$thindata, table=>'NEGATIVE', silent=>1});
}
print "Inserted $num negatives into film #$$thindata{film_id}\n";
return;
}
# Show information about a negative
sub negative_info {
my $href = shift;
my $db = $href->{db};
my $negative_id = $href->{negative_id} // &chooseneg({db=>$db});
print Dump(&lookupcol({db=>$db, table=>'info_negative', where=>{'`Negative ID`'=>$negative_id}}));
return;
}
# Find all prints made from a negative
sub negative_prints {
my $href = shift;
my $db = $href->{db};
my $neg_id = &chooseneg({db=>$db});
&printlist({db=>$db, msg=>"prints from negative $neg_id", cols=>'Print as id, concat(Size, \' - \', Location) as opt', table=>'info_print', where=>{'`Negative ID`'=>$neg_id}});
return;
}
# Write EXIF tags to scans from a negative
sub negative_tag {
my $href = shift;
my $db = $href->{db};
my $neg_id = $href->{negative_id} // &chooseneg({db=>$db});
&tag({db=>$db, where=>{negative_id=>$neg_id}});
return;
}
# Search for a negative
sub negative_search {
my $href = shift;
my $db = $href->{db};
my $searchterm = $href->{searchterm} // &prompt({prompt=>'Enter search term'});
# Perform search
my $id = &search({
db => $db,
cols => ["concat(film_id, '/', frame) as id", 'description as opt'],
table => 'NEGATIVE',
where => "description like '%$searchterm%' collate utf8mb4_general_ci",
searchterm => $searchterm,
choices => [
{ desc => 'Do nothing' },
{ handler => \&negative_info, desc => 'Show information about this negative', id=>'negative_id' },
{ handler => \&negative_prints, desc => 'Find all prints made from this negative', id=>'negative_id' },
{ handler => \&negative_tag, desc => 'Write EXIF tags to scans from this negative', id=>'negative_id' },
],
});
return $id;
}
# Add a new lens to the database
sub lens_add {
my $href = shift;
my $db = $href->{db};
my %data;
my $manufacturer_id = $href->{manufacturer_id} // &choose_manufacturer({db=>$db});
$data{lensmodel_id} = $href->{lensmodel_id} // &listchoices({db=>$db, table=>'choose_lensmodel', where=>{'manufacturer_id'=>$manufacturer_id}, required=>1, inserthandler=>\&lensmodel_add});
$data{cost} = $href->{cost} // &prompt({prompt=>'How much did this lens cost?', type=>'decimal'});
$data{serial} = $href->{serial} // &prompt({prompt=>'What is the serial number of the lens?'});
$data{date_code} = $href->{date_code} // &prompt({prompt=>'What is the date code of the lens?'});
# Attempt to decode datecode for Canon lenses
my $manufactured;
if ($manufacturer_id == 3 && $data{date_code}) {
my $introduced = &lookupval({db=>$db, col=>'introduced', table=>'LENSMODEL', where=>{lensmodel_id=>$data{lensmodel_id}}});
my $discontinued = &lookupval({db=>$db, col=>'discontinued', table=>'LENSMODEL', where=>{lensmodel_id=>$data{lensmodel_id}}});
$manufactured = &canondatecode({datecode=>$data{date_code}, introduced=>$introduced, discontinued=>$discontinued});
}
$data{manufactured} = $href->{manufactured} // &prompt({prompt=>'When was this lens manufactured?', type=>'integer', default=>$manufactured});
$data{acquired} = $href->{acquired} // &prompt({prompt=>'When was this lens acquired?', type=>'date', default=>&today});
$data{own} = $href->{own} // &prompt({prompt=>'Do you own this lens?', type=>'boolean', default=>'yes'});
$data{source} = $href->{source} // &prompt({prompt=>'Where was this lens sourced from?'});
$data{condition_id} = $href->{condition_id} // &listchoices({db=>$db, keyword=>'condition', cols=>['condition_id as id', 'name as opt'], table=>'`CONDITION`'});
my $lens_id = &newrecord({db=>$db, data=>\%data, table=>'LENS'});
return $lens_id;
}
# Add a new lens model to the database
sub lensmodel_add {
my $href = shift;
my $db = $href->{db};
# Gather data from user
my $datahr = &lensmodel_prompt({db=>$db});
my %data = %$datahr;
my $lensmodel_id = &newrecord({db=>$db, data=>\%data, table=>'LENSMODEL'});
if (&prompt({default=>'yes', prompt=>'Add accessory compatibility for this lens model?', type=>'boolean'})) {
&lensmodel_accessory({db=>$db, lensmodel_id=>$lensmodel_id});
}
if (&prompt({default=>'no', prompt=>'Add this lens model to a series?', type=>'boolean'})) {
&lensmodel_series({db=>$db, lensmodel_id=>$lensmodel_id});
}
return $lensmodel_id;
}
# Edit an existing lens model
sub lensmodel_edit {
my $href = shift;
my $db = $href->{db};
my $lens_id = $href->{lens_id} // &listchoices({db=>$db, table=>'choose_lens', required=>1});
my $existing = &lookupcol({db=>$db, table=>'LENS', where=>{lens_id=>$lens_id}});
$existing = @$existing[0];
# Gather data from user
my $data = &lens_prompt({db=>$db, defaults=>$existing});
# Compare new and old data to find changed fields
my $changes = &hashdiff($existing, $data);
# Update the DB
return &updaterecord({db=>$db, data=>$changes, table=>'LENS', where=>{lens_id=>$lens_id}});
}
sub lensmodel_prompt {
my $href = shift;
my $db = $href->{db};
my $defaults = $href->{defaults};
my %data;
$data{manufacturer_id} = &choose_manufacturer({db=>$db, default=>$$defaults{manufacturer_id}});
$data{model} = &prompt({prompt=>'What is the lens model?', default=>$$defaults{model}});
$data{zoom} = &prompt({prompt=>'Is this a zoom lens?', type=>'boolean', default=>$$defaults{zoom}//&parselensmodel($data{model}, 'zoom')});
if ($data{zoom} == 0) {
$data{min_focal_length} = &prompt({prompt=>'What is the focal length?', type=>'integer', default=>$$defaults{min_focal_length}//&parselensmodel($data{model}, 'minfocal')});
$data{max_focal_length} = $data{min_focal_length};
$data{nominal_min_angle_diag} = &prompt({prompt=>'What is the diagonal angle of view?', type=>'integer', default=>$$defaults{nominal_min_angle_diag}});
$data{nominal_max_angle_diag} = $data{nominal_min_angle_diag};
} else {
$data{min_focal_length} = &prompt({prompt=>'What is the minimum focal length?', type=>'integer', default=>$$defaults{min_focal_length}//&parselensmodel($data{model}, 'minfocal')});
$data{max_focal_length} = &prompt({prompt=>'What is the maximum focal length?', type=>'integer', default=>$$defaults{max_focal_length}//&parselensmodel($data{model}, 'maxfocal')});
$data{nominal_min_angle_diag} = &prompt({prompt=>'What is the minimum diagonal angle of view?', type=>'integer', default=>$$defaults{nominal_min_angle_diag}});
$data{nominal_max_angle_diag} = &prompt({prompt=>'What is the maximum diagonal angle of view?', type=>'integer', default=>$$defaults{nominal_max_angle_diag}});
}
$data{fixed_mount} = &prompt({prompt=>'Does this lens have a fixed mount?', type=>'boolean', default=>$$defaults{fixed_mount}//'no'});
if ($data{fixed_mount} == 0) {
$data{mount_id} = &listchoices({db=>$db, cols=>['mount_id as id', 'mount as opt'], table=>'choose_mount', inserthandler=>\&mount_add, default=>$$defaults{mount_id}});
$data{weight} = &prompt({prompt=>'What is the weight of the lens? (g)', type=>'integer', default=>$$defaults{weight}});
$data{length} = &prompt({prompt=>'How long is this lens? (mm)', type=>'integer', default=>$$defaults{length}});
$data{diameter} = &prompt({prompt=>'How wide is this lens? (mm)', type=>'integer', default=>$$defaults{diameter}});
}
$data{max_aperture} = &prompt({prompt=>'What is the largest lens aperture?', type=>'decimal', default=>$$defaults{max_aperture}//&parselensmodel($data{model}, 'aperture')});
$data{min_aperture} = &prompt({prompt=>'What is the smallest lens aperture?', type=>'decimal', default=>$$defaults{min_aperture}});
$data{closest_focus} = &prompt({prompt=>'How close can the lens focus? (cm)', type=>'integer', default=>$$defaults{closest_focus}});
$data{elements} = &prompt({prompt=>'How many elements does the lens have?', type=>'integer', default=>$$defaults{elements}});
$data{groups} = &prompt({prompt=>'How many groups are these elements in?', type=>'integer', default=>$$defaults{groups}});
$data{aperture_blades} = &prompt({prompt=>'How many aperture blades does the lens have?', type=>'integer', default=>$$defaults{aperture_blades}});
$data{autofocus} = &prompt({prompt=>'Does this lens have autofocus?', type=>'boolean', default=>$$defaults{autofocus}});
$data{filter_thread} = &prompt({prompt=>'What is the diameter of the filter thread? (mm)', type=>'decimal', default=>$$defaults{filter_thread}});
$data{magnification} = &prompt({prompt=>'What is the maximum magnification possible with this lens?', type=>'decimal', default=>$$defaults{magnification}});
$data{url} = &prompt({prompt=>'Informational URL for this lens', default=>$$defaults{url}});
$data{introduced} = &prompt({prompt=>'When was this lens introduced?', type=>'integer', default=>$$defaults{introduced}});
$data{discontinued} = &prompt({prompt=>'When was this lens discontinued?', type=>'integer', default=>$$defaults{discontinued}});
$data{negative_size_id} = &listchoices({db=>$db, cols=>['negative_size_id as id', 'negative_size as opt'], table=>'NEGATIVE_SIZE', inserthandler=>\&negativesize_add, default=>$$defaults{negative_size_id}});
$data{notes} = &prompt({prompt=>'Notes', default=>$$defaults{notes}});
$data{coating} = &prompt({prompt=>'What coating does this lens have?', default=>$$defaults{coating}});
$data{hood} = &prompt({prompt=>'What is the model number of the suitable hood for this lens?', default=>$$defaults{hood}});
$data{exif_lenstype} = &prompt({prompt=>'EXIF lens type code', default=>$$defaults{exif_lenstype}});
$data{rectilinear} = &prompt({prompt=>'Is this a rectilinear lens?', type=>'boolean', default=>$$defaults{rectilinear}//'yes'});
$data{image_circle} = &prompt({prompt=>'What is the diameter of the image circle?', type=>'integer', default=>$$defaults{image_circle}});
$data{formula} = &prompt({prompt=>'Does this lens have a named optical formula?', default=>$$defaults{formula}});
$data{shutter_model} = &prompt({prompt=>'What shutter does this lens incorporate?', default=>$$defaults{shutter_model}});
return \%data;
}
# Add accessory compatibility info to a lens
sub lensmodel_accessory {
my $href = shift;
my $db = $href->{db};
my $lensmodel_id = $href->{lensmodel_id} // &listchoices({db=>$db, table=>'choose_lensmodel', required=>1});
while (1) {
my %compatdata;
$compatdata{accessory_id} = $href->{accessory_id} // &listchoices({db=>$db, table=>'choose_accessory'});
$compatdata{lensmodel_id} = $lensmodel_id;
&newrecord({db=>$db, data=>\%compatdata, table=>'ACCESSORY_COMPAT'});
last if (!&prompt({default=>'yes', prompt=>'Add more accessory compatibility info?', type=>'boolean'}));
}
return;
}
# Add a lensmodel to a series
sub lensmodel_series {
my $href = shift;
my $db = $href->{db};
my %data;
$data{lensmodel_id} = $href->{lensmodel_id} // &listchoices({db=>$db, table=>'choose_lensmodel', required=>1});
$data{series_id} = $href->{series_id} // &listchoices({db=>$db, cols=>['series_id as id', 'name as opt'], table=>'SERIES', required=>1, inserthandler=>\&series_add});
return &newrecord({db=>$db, data=>\%data, table=>'SERIES_MEMBER'});
}
# Show information about a lensmodel
sub lensmodel_info {
my $href = shift;
my $db = $href->{db};
# Choose lens
my $lensmodel_id = $href->{lens_id} // &listchoices({db=>$db, table=>'choose_lensmodel', required=>1});
# Get lens data
my $lensdata = &lookupcol({db=>$db, table=>'info_lensmodel', where=>{'`Lens Model ID`'=>$lensmodel_id}});
# Show compatible accessories
my $accessories = &lookuplist({db=>$db, col=>'opt', table=>'choose_accessory_compat', where=>{lensmodel_id=>$lensmodel_id}});
${@$lensdata[0]}{'Accessories'} = $accessories;
# Show compatible cameras
my $cameras = &lookuplist({db=>$db, col=>'camera', table=>'cameralens_compat', where=>{lensmodel_id=>$lensmodel_id}});
${@$lensdata[0]}{'Cameras'} = $cameras;
print Dump($lensdata);
return;
}
# Search for a lens
sub lens_search {
my $href = shift;
my $db = $href->{db};
my $searchterm = $href->{searchterm} // &prompt({prompt=>'Enter search term'});
# Perform search
my $id = &search({
db => $db,
cols => ['id', 'opt'],
table => 'choose_lens',
where => "opt like '%$searchterm%' collate utf8mb4_general_ci",
searchterm => $searchterm,
choices => [
{ desc => 'Do nothing' },
{ handler => \&lens_accessory, desc => 'Add accessory compatibility info to this lens', id=>'lens_id' },
{ handler => \&lens_edit, desc => 'Edit this lens', id=>'lens_id' },
{ handler => \&lens_info, desc => 'Show information about this lens', id=>'lens_id' },
{ handler => \&lens_repair, desc => 'Repair this lens', id=>'lens_id' },
{ handler => \&lens_sell, desc => 'Sell this lens', id=>'lens_id' },
],
});
return $id;
}
# Sell a lens
sub lens_sell {
my $href = shift;
my $db = $href->{db};
my %data;
my $lens_id = $href->{lens_id} // &listchoices({db=>$db, table=>'choose_lens', required=>1});
$data{own} = 0;
$data{lost} = $href->{lost} // &prompt({default=>&today, prompt=>'What date was this lens sold?', type=>'date'});
$data{lost_price} = $href->{lost_price} // &prompt({prompt=>'How much did this lens sell for?', type=>'decimal'});
&unsetdisplaylens({db=>$db, lens_id=>$lens_id});
return &updaterecord({db=>$db, data=>\%data, table=>'LENS', where=>{lens_id=>$lens_id}});
}
# Repair a lens
sub lens_repair {
my $href = shift;
my $db = $href->{db};
my %data;
$data{lens_id} = $href->{lens_id} // &listchoices({db=>$db, table=>'choose_lens', required=>1});
$data{date} = $href->{date} // &prompt({default=>&today, prompt=>'What date was this lens repaired?', type=>'date'});
$data{summary} = $href->{summary} // &prompt({prompt=>'Short summary of repair'});
$data{description} = $href->{description} // &prompt({prompt=>'Longer description of repair'});
return &newrecord({db=>$db, data=>\%data, table=>'REPAIR'});
}
# Show information about a lens
sub lens_info {
my $href = shift;
my $db = $href->{db};
# Choose lens
my $lens_id = $href->{lens_id} // &listchoices({db=>$db, table=>'choose_lens', required=>1});
# Get lens data
my $lensdata = &lookupcol({db=>$db, table=>'info_lens', where=>{'`Lens ID`'=>$lens_id}});
# Get lens model
my $lensmodel_id = ${@$lensdata[0]}{'Lens Model ID'};
# Show compatible accessories
my $accessories = &lookuplist({db=>$db, col=>'opt', table=>'choose_accessory_compat', where=>{lensmodel_id=>$lensmodel_id}});
${@$lensdata[0]}{'Accessories'} = $accessories;
# Show compatible cameras
my $cameras = &lookuplist({db=>$db, col=>'camera', table=>'cameralens_compat', where=>{lens_id=>$lens_id}});
${@$lensdata[0]}{'Cameras'} = $cameras;
print Dump($lensdata);
# Generate and print lens statistics
my $lens = ${@$lensdata[0]}{'Lens'};
print "\tShowing statistics for $lens\n";
my $maxaperture = &lookupval({db=>$db, col=>'max_aperture', table=>'LENSMODEL', where=>{lensmodel_id=>$lensmodel_id}});
my $modeaperture = &lookupval({db=>$db, query=>"select aperture from NEGATIVE where aperture is not null and lens_id=$lens_id group by aperture order by count(aperture) desc limit 1"});
print "\tThis lens has a maximum aperture of f/$maxaperture but you most commonly use it at f/$modeaperture\n";
if (&lookupval({db=>$db, col=>'zoom', table=>'LENSMODEL', where=>{lensmodel_id=>$lensmodel_id}})) {
my $minf = &lookupval({db=>$db, col=>'min_focal_length', table=>'LENSMODEL', where=>{lensmodel_id=>$lensmodel_id}});
my $maxf = &lookupval({db=>$db, col=>'max_focal_length', table=>'LENSMODEL', where=>{lensmodel_id=>$lensmodel_id}});
my $meanf = &lookupval({db=>$db, col=>'avg(focal_length)', table=>'NEGATIVE', where=>{lens_id=>$lens_id}});
print "\tThis is a zoom lens with a range of ${minf}-${maxf}mm, but the average focal length you used is ${meanf}mm\n";
}
return;
}
# Add a new print that has been made from a negative
sub print_add {
my $href = shift;
my $db = $href->{db};
my %data;
my $todo_id = $href->{todo_id} // &listchoices({db=>$db, keyword=>'print from the order queue', table=>'choose_todo'});
if ($todo_id) {
$data{negative_id} = $href->{negative_id} // &lookupval({db=>$db, col=>'negative_id', table=>'TO_PRINT', where=>{id=>$todo_id}});
} else {
$data{negative_id} = $href->{negative_id} // &chooseneg({db=>$db});
}
my $qty = $href->{qty} // &prompt({default=>1, prompt=>'How many similar prints did you make from this negative?', type=>'integer'});
print "Enter some data about all the prints in the run:\n" if ($qty > 1);
$data{date} = $href->{date} // &prompt({default=>&today, prompt=>'Date that the print was made', type=>'date'});
$data{paper_stock_id} = $href->{paper_stock_id} // &listchoices({db=>$db, keyword=>'paper stock', table=>'choose_paper', inserthandler=>\&paperstock_add});
$data{height} = $href->{height} // &prompt({prompt=>'Height of the print (inches)', type=>'integer'});
$data{width} = $href->{width} // &prompt({prompt=>'Width of the print (inches)', type=>'integer'});
$data{enlarger_id} = $href->{enlarger_id} // &listchoices({db=>$db, table=>'choose_enlarger', inserthandler=>\&enlarger_add});
$data{lens_id} = $href->{lens_id} // &listchoices({db=>$db, table=>'choose_enlarger_lens'});
$data{developer_id} = $href->{developer_id} // &listchoices({db=>$db, cols=>['developer_id as id', 'name as opt'], table=>'DEVELOPER', where=>{'for_paper'=>1}, inserthandler=>\&developer_add});
$data{printer_id} = $href->{printer_id} // &listchoices({db=>$db, keyword=>'printer', cols=>['person_id as id', 'name as opt'], table=>'PERSON', inserthandler=>\&person_add});
my @prints;
for my $n (1..$qty) {
print "\nEnter some data about print $n of $qty in this run:\n" if ($qty > 1);
$data{aperture} = $href->{aperture} // &prompt({prompt=>'Aperture used on enlarging lens', type=>'decimal'});
$data{exposure_time} = $href->{exposure_time} // &prompt({prompt=>'Exposure time (s)', type=>'integer'});
$data{filtration_grade} = $href->{filtration_grade} // &prompt({prompt=>'Filtration grade', type=>'decimal'});
$data{development_time} = $href->{development_time} // &prompt({default=>'60', prompt=>'Development time (s)', type=>'integer'});
$data{fine} = $href->{fine} // &prompt({prompt=>'Is this a fine print?', type=>'boolean'});
$data{notes} = $href->{notes} // &prompt({prompt=>'Notes'});
my $print_id = &newrecord({db=>$db, data=>\%data, table=>'PRINT'});
push @prints, $print_id;
&print_tone({db=>$db, print_id=>$print_id}) if (&prompt({default=>'no', prompt=>'Did you tone this print?', type=>'boolean'}));
&print_archive({db=>$db, print_id=>$print_id}) if (&prompt({default=>'no', prompt=>'Archive this print?', type=>'boolean'}));
}
print "\nAdded $qty prints in this run, numbered #$prints[0]-$prints[-1]\n" if ($qty > 1);
# Mark is as complete in the todo list
&updaterecord({db=>$db, data=>{printed=>1, print_id=>$prints[-1]}, table=>'TO_PRINT', where=>{id=>$todo_id}}) if ($todo_id);
# Return ID of the last print in the run
return $prints[-1];
}
# Fulfil an order for a print
sub print_fulfil {
my $href = shift;
my $db = $href->{db};
my %data;
my $todo_id = $href->{todo_id} // &listchoices({db=>$db, keyword=>'print from the queue', table=>'choose_todo', required=>1});
$data{printed} = $href->{printed} // &prompt({default=>'yes', prompt=>'Is this print order now fulfilled?', type=>'boolean'});
$data{print_id} = $href->{print_id} // &prompt({prompt=>'Which print fulfilled this order?', type=>'integer'});
return &updaterecord({db=>$db, data=>\%data, table=>'TO_PRINT', where=>{id=>$todo_id}});
}
# Add toning to a print
sub print_tone {
my $href = shift;
my $db = $href->{db};
my %data;
my $print_id = $href->{print_id} // &prompt({prompt=>'Which print did you tone?', type=>'integer', required=>1});
$data{bleach_time} = $href->{bleach_time} // &prompt({default=>'00:00:00', prompt=>'How long did you bleach for? (HH:MM:SS)', type=>'time'});
$data{toner_id} = $href->{toner_id} // &listchoices({db=>$db, cols=>['toner_id as id', 'toner as opt'], table=>'TONER', inserthandler=>\&toner_add});
my $dilution1 = &lookupval({db=>$db, col=>'stock_dilution', table=>'TONER', where=>{toner_id=>$data{toner_id}}});
$data{toner_dilution} = $href->{toner_dilution} // &prompt({default=>$dilution1, prompt=>'What was the dilution of the first toner?'});
$data{toner_time} = $href->{toner_time} // &prompt({prompt=>'How long did you tone for? (HH:MM:SS)', type=>'time'});
if (&prompt({default=>'no', prompt=>'Did you use a second toner?', type=>'boolean'}) == 1) {
$data{'2nd_toner_id'} = $href->{'2nd_toner_id'} // &listchoices({db=>$db, cols=>['toner_id as id', 'toner as opt'], table=>'TONER', inserthandler=>\&toner_add});
my $dilution2 = &lookupval({db=>$db, col=>'stock_dilution', table=>'TONER', where=>{toner_id=>$data{'2nd_toner_id'}}});
$data{'2nd_toner_dilution'} = $href->{'2nd_toner_dilution'} // &prompt({default=>$dilution2, prompt=>'What was the dilution of the second toner?'});
$data{'2nd_toner_time'} = $href->{'2nd_toner_time'} // &prompt({prompt=>'How long did you tone for? (HH:MM:SS)', type=>'time'});
}
return &updaterecord({db=>$db, data=>\%data, table=>'PRINT', where=>{print_id=>$print_id}});
}
# Sell a print
sub print_sell {
my $href = shift;
my $db = $href->{db};
my %data;
my $print_id = $href->{print_id} // &prompt({prompt=>'Which print did you sell?', type=>'integer', required=>1});
$data{own} = 0;
$data{location} = $href->{location} // &prompt({prompt=>'What happened to the print?'});
$data{sold_price} = $href->{sold_price} // &prompt({prompt=>'What price was the print sold for?', type=>'decimal'});
&print_unarchive({db=>$db, print_id=>$print_id});
return &updaterecord({db=>$db, data=>\%data, table=>'PRINT', where=>{print_id=>$print_id}});
}
# Register an order for a print
sub print_order {
my $href = shift;
my $db = $href->{db};
my %data;
$data{negative_id} = $href->{negative_id} // &chooseneg({db=>$db});
$data{height} = $href->{height} // &prompt({prompt=>'Height of the print (inches)', type=>'integer'});
$data{width} = $href->{width} // &prompt({prompt=>'Width of the print (inches)', type=>'integer'});
$data{recipient} = $href->{recipient} // &prompt({prompt=>'Who is the print for?'});
$data{added} = $href->{added} // &prompt({default=>&today, prompt=>'Date that this order was placed', type=>'date'});
return &newrecord({db=>$db, data=>\%data, table=>'TO_PRINT'});
}
# Add a print to a physical archive
sub print_archive {
# Archive a print for storage
my $href = shift;
my $db = $href->{db};
my %data;
my $print_id = $href->{print_id} // &prompt({prompt=>'Which print did you archive?', type=>'integer', required=>1});
$data{archive_id} = $href->{archive_id} // &listchoices({db=>$db, cols=>['archive_id as id', 'name as opt'], table=>'ARCHIVE', where=>{'archive_type_id'=>3, 'sealed'=>0}, inserthandler=>\&archive_add, required=>1});
$data{own} = 1;
$data{location} = 'Archive';
return &updaterecord({db=>$db, data=>\%data, table=>'PRINT', where=>{print_id=>$print_id}});
}
# Remove a print from a physical archive
sub print_unarchive {
# Remove a print from an archive
my $href = shift;
my $db = $href->{db};
my $print_id = $href->{print_id} // &prompt({prompt=>'Which print did you remove from its archive?', type=>'integer', required=>1});
return &call({db=>$db, procedure=>'print_unarchive', args=>[$print_id]});
}
# Locate a print in an archive
sub print_locate {
my $href = shift;
my $db = $href->{db};
my $print_id = $href->{print_id} // &prompt({prompt=>'Which print do you want to locate?', type=>'integer', required=>1});
if (my $archiveid = &lookupval({db=>$db, col=>'archive_id', table=>'PRINT', where=>{print_id=>$print_id}})) {
my $archive = &lookupval({db=>$db, col=>"concat(name, ' (', location, ')') as archive", table=>'ARCHIVE', where=>{archive_id=>$archiveid}});
print "Print #${print_id} is in $archive\n";
} elsif (my $location = &lookupval({db=>$db, col=>'location', table=>'PRINT', where=>{print_id=>$print_id}})) {
if (my $own = &lookupval({db=>$db, col=>'own', table=>'PRINT', where=>{print_id=>$print_id}})) {
print "Print #${print_id} is in the collection. Location: $location\n";
} else {
print "Print #${print_id} is not in the collection. Location: $location\n";
}
} else {
print "The location of print #${print_id} is unknown\n";
}
return;
}
# Show details about a print
sub print_info {
my $href = shift;
my $db = $href->{db};
my $print_id = $href->{print_id} // &prompt({prompt=>'Which print do you want info on?', type=>'integer', required=>1});
print Dump(&lookupcol({db=>$db, table=>'info_print', where=>{Print=>$print_id}}));
return;
}
# Exhibit a print in an exhibition
sub print_exhibit {
my $href = shift;
my $db = $href->{db};
my %data;
$data{print_id} = &prompt({prompt=>'Which print do you want to exhibit?', type=>'integer', required=>1});
$data{exhibition_id} = &listchoices({db=>$db, cols=>['exhibition_id as id', 'title as opt'], table=>'EXHIBITION', inserthandler=>\&exhibition_add, required=>1});
return &newrecord({db=>$db, data=>\%data, table=>'EXHIBIT'});
}
# Generate text to label a print
sub print_label {
my $href = shift;
my $db = $href->{db};
my $print_id = $href->{print_id} // &prompt({prompt=>'Which print do you want to label?', type=>'integer', required=>1});
my $data = &lookupcol({db=>$db, table=>'info_print', where=>{Print=>$print_id}});
my $row = @$data[0];
print "\t#$row->{'Print'} $row->{'Description'}\n" if ($row->{'Print'} && $row->{Description});
print "\tPhotographed $row->{'Photo date'}\n" if ($row->{'Photo date'});
print "\tPrinted $row->{'Print date'}\n" if ($row->{'Print date'});
print "\tby $row->{Photographer}\n" if ($row->{Photographer});
return;
}
# Display print todo list
sub print_worklist {
my $href = shift;
my $db = $href->{db};
my $data = &lookupcol({db=>$db, table=>'choose_todo'});
foreach my $row (@$data) {
print "\t$row->{opt}\n";
}
return;
}
# Write EXIF tags to scans from a print
sub print_tag {
my $href = shift;
my $db = $href->{db};
my $print_id = $href->{print_id} // &prompt({prompt=>'Which print do you want to tag?', type=>'integer', required=>1});
&tag({db=>$db, where=>{print_id=>$print_id}});
return;
}
# Add a new type of photo paper to the database
sub paperstock_add {
my $href = shift;
my $db = $href->{db};
my %data;
$data{manufacturer_id} = $href->{manufacturer_id} // &choose_manufacturer({db=>$db});
$data{name} = $href->{name} // &prompt({prompt=>'What model is the paper?'});
$data{resin_coated} = $href->{resin_coated} // &prompt({prompt=>'Is this paper resin-coated?', type=>'boolean'});
$data{tonable} = $href->{tonable} // &prompt({prompt=>'Is this paper tonable?', type=>'boolean'});
$data{colour} = $href->{colour} // &prompt({prompt=>'Is this a colour paper?', type=>'boolean'});
$data{finish} = $href->{finish} // &prompt({prompt=>'What surface finish does this paper have?'});
return &newrecord({db=>$db, data=>\%data, table=>'PAPER_STOCK'});
}
# Add a new developer to the database
sub developer_add {
my $href = shift;
my $db = $href->{db};
my %data;
$data{manufacturer_id} = $href->{manufacturer_id} // &choose_manufacturer({db=>$db});
$data{name} = $href->{name} // &prompt({prompt=>'What model is the developer?'});
$data{for_paper} = $href->{for_paper} // &prompt({prompt=>'Is this developer suitable for paper?', type=>'boolean'});
$data{for_film} = $href->{for_film} // &prompt({prompt=>'Is this developer suitable for film?', type=>'boolean'});
$data{chemistry} = $href->{chemistry} // &prompt({prompt=>'What type of chemistry is this developer based on?'});
return &newrecord({db=>$db, data=>\%data, table=>'DEVELOPER'});
}
# Add a new lens mount to the database
sub mount_add {
my $href = shift;
my $db = $href->{db};
my %data;
$data{mount} = $href->{mount} // &prompt({prompt=>'What is the name of this lens mount?'});
$data{manufacturer_id} = $href->{manufacturer_id} // &choose_manufacturer({db=>$db});
$data{fixed} = $href->{fixed} // &prompt({default=>'no', prompt=>'Is this a fixed mount?', type=>'boolean'});
$data{shutter_in_lens} = $href->{shutter_in_lens} // &prompt({default=>'no', prompt=>'Does this mount contain the shutter in the lens?', type=>'boolean'});
$data{type} = $href->{type} // &prompt({prompt=>'What type of mounting does this mount use? (e.g. bayonet, screw, etc)'});
$data{purpose} = $href->{purpose} // &prompt({default=>'camera', prompt=>'What is the intended purpose of this mount? (e.g. camera, enlarger, projector, etc)'});
$data{digital_only} = $href->{digital_only} // &prompt({default=>'no', prompt=>'Is this a digital-only mount?', type=>'boolean'});
$data{notes} = $href->{notes} // &prompt({prompt=>'Notes about this mount'});
return &newrecord({db=>$db, data=>\%data, table=>'MOUNT'});
}
# View compatible cameras and lenses for a mount
sub mount_info {
my $href = shift;
my $db = $href->{db};
my $mountid = $href->{mount_id} // &listchoices({db=>$db, cols=>['mount_id as id', 'mount as opt'], table=>'choose_mount', required=>1});
my $mount = &lookupval({db=>$db, col=>'mount', table=>'choose_mount', where=>{mount_id=>${mountid}}});
print "Showing data for $mount mount\n";
&printlist({db=>$db, msg=>"cameras with $mount mount", cols=>"distinct camera_id as id, camera as opt", table=>'cameralens_compat', where=>{mount_id=>$mountid}, order=>'opt'});
&printlist({db=>$db, msg=>"lenses with $mount mount", cols=>"distinct lens_id as id, lens as opt", table=>'cameralens_compat', where=>{mount_id=>$mountid}, order=>'opt'});
return;
}
# Add a new chemical toner to the database
sub toner_add {
my $href = shift;
my $db = $href->{db};
my %data;
$data{manufacturer_id} = $href->{manufacturer_id} // &choose_manufacturer({db=>$db});
$data{toner} = $href->{toner} // &prompt({prompt=>'What is the name of this toner?'});
$data{formulation} = $href->{formulation} // &prompt({prompt=>'What is the chemical formulation of this toner?'});
$data{stock_dilution} = $href->{stock_dilution} // &prompt({prompt=>'What is the stock dilution of this toner?'});
return &newrecord({db=>$db, data=>\%data, table=>'TONER'});
}
# Add a new type of filmstock to the database
sub filmstock_add {
my $href = shift;
my $db = $href->{db};
my %data;
$data{manufacturer_id} = $href->{manufacturer_id} // &choose_manufacturer({db=>$db});
$data{name} = $href->{name} // &prompt({prompt=>'What is the name of this filmstock?'});
$data{iso} = $href->{iso} // &prompt({prompt=>'What is the box ISO/ASA speed of this filmstock?', type=>'integer'});
$data{colour} = $href->{colour} // &prompt({prompt=>'Is this a colour film?', type=>'boolean'});
if ($data{colour} == 1) {
$data{panchromatic} = 1;
} else {
$data{panchromatic} = $href->{panchromatic} // &prompt({default=>'yes', prompt=>'Is this a panchromatic film?', type=>'boolean'});
}
$data{process_id} = $href->{process_id} // &listchoices({db=>$db, cols=>['process_id as id', 'name as opt'], table=>'PROCESS', inserthandler=>\&process_add});
return &newrecord({db=>$db, data=>\%data, table=>'FILMSTOCK'});
}
# Add a new teleconverter to the database
sub teleconverter_add {
my $href = shift;
my $db = $href->{db};
my %data;
$data{manufacturer_id} = $href->{manufacturer_id} // &choose_manufacturer({db=>$db});
$data{model} = $href->{model} // &prompt({prompt=>'What is the model of this teleconverter?'});
$data{factor} = $href->{factor} // &prompt('', 'What is the magnification factor of this teleconverter?', 'decimal');
$data{mount_id} = $href->{mount_id} // &listchoices({db=>$db, cols=>['mount_id as id', 'mount as opt'], table=>'choose_mount', where=>{'purpose'=>'Camera'}, inserthandler=>\&mount_add});
$data{elements} = $href->{elements} // &prompt({prompt=>'How many elements does this teleconverter have?', type=>'integer'});
$data{groups} = $href->{groups} // &prompt({prompt=>'How many groups are the elements arranged in?', type=>'integer'});
$data{multicoated} = $href->{multicoated} // &prompt({prompt=>'Is this teleconverter multicoated?', type=>'boolean'});
return &newrecord({db=>$db, data=>\%data, table=>'TELECONVERTER'});
}
# Add a new (optical) filter to the database
sub filter_add {
my $href = shift;
my $db = $href->{db};
my %data;
$data{type} = $href->{type} // &prompt({prompt=>'What type of filter is this?'});
$data{manufacturer_id} = $href->{manufacturer_id} // &choose_manufacturer({db=>$db});
$data{attenuation} = $href->{attenuation} // &prompt({prompt=>'What attenutation (in stops) does this filter have?', type=>'decimal'});
$data{thread} = $href->{thread} // &prompt({prompt=>'What diameter mounting thread does this filter have?', type=>'decimal'});
$data{qty} = $href->{qty} // &prompt({default=>1, prompt=>'How many of these filters do you have?', type=>'integer'});
return &newrecord({db=>$db, data=>\%data, table=>'FILTER'});
}
# Add a new development process to the database
sub process_add {
my $href = shift;
my $db = $href->{db};
my %data;
$data{name} = $href->{name} // &prompt({prompt=>'What is the name of this film process?'});
$data{colour} = $href->{colour} // &prompt({prompt=>'Is this a colour process?', type=>'boolean'});
$data{positive} = $href->{positive} // &prompt({prompt=>'Is this a reversal process?', type=>'boolean'});
return &newrecord({db=>$db, data=>\%data, table=>'PROCESS'});
}
# Add a filter adapter to the database
sub filter_adapt {
my $href = shift;
my $db = $href->{db};
my %data;
$data{camera_thread} = $href->{camera_thread} // &prompt({prompt=>'What diameter thread faces the camera on this filter adapter?', type=>'decimal'});
$data{filter_thread} = $href->{filter_thread} // &prompt({prompt=>'What diameter thread faces the filter on this filter adapter?', type=>'decimal'});
return &newrecord({db=>$db, data=>\%data, table=>'FILTER_ADAPTER'});
}
# Add a new manufacturer to the database
sub manufacturer_add {
my $href = shift;
my $db = $href->{db};
my %data;
$data{manufacturer} = $href->{manufacturer} // &prompt({prompt=>'What is the name of the manufacturer?', required=>1});
$data{country} = $href->{country} // &prompt({prompt=>'What country is the manufacturer based in?'});
$data{city} = $href->{city} // &prompt({prompt=>'What city is the manufacturer based in?'});
$data{url} = $href->{url} // &prompt({prompt=>'What is the main website of the manufacturer?'});
$data{founded} = $href->{founded} // &prompt({prompt=>'When was the manufacturer founded?', type=>'integer'});
$data{dissolved} = $href->{dissolved} // &prompt({prompt=>'When was the manufacturer dissolved?', type=>'integer'});
return &newrecord({db=>$db, data=>\%data, table=>'MANUFACTURER'});
}
# Add a new "other" accessory to the database
sub accessory_add {
my $href = shift;
my $db = $href->{db};
my %data;
$data{accessory_type_id} = $href->{accessory_type_id} // &listchoices({db=>$db, cols=>['accessory_type_id as id', 'accessory_type as opt'], table=>'ACCESSORY_TYPE', inserthandler=>\&accessory_type});
$data{manufacturer_id} = $href->{manufacturer_id} // &choose_manufacturer({db=>$db});
$data{model} = $href->{model} // &prompt({prompt=>'What is the model of this accessory?'});
$data{acquired} = $href->{acquired} // &prompt({default=>&today, prompt=>'When was this accessory acquired?', type=>'date'});
$data{cost} = $href->{cost} // &prompt({prompt=>'What did this accessory cost?', type=>'decimal'});
my $accessoryid = &newrecord({db=>$db, data=>\%data, table=>'ACCESSORY'});
if (&prompt({default=>'yes', prompt=>'Add camera compatibility info for this accessory?', type=>'boolean'})) {
while (1) {
my %compatdata;
$compatdata{accessory_id} = $accessoryid;
$compatdata{camera_id} = &listchoices({db=>$db, table=>'choose_camera', required=>1});
&newrecord({db=>$db, data=>\%compatdata, table=>'ACCESSORY_COMPAT', silent=>1});
last if (!&prompt({default=>'yes', prompt=>'Add another compatible camera?', type=>'boolean'}));
}
}
if (&prompt({default=>'yes', prompt=>'Add lens compatibility info for this accessory?', type=>'boolean'})) {
while (1) {
my %compatdata;
$compatdata{accessory_id} = $accessoryid;
$compatdata{lens_id} = &listchoices({db=>$db, table=>'choose_lens', required=>1});
&newrecord({db=>$db, data=>\%compatdata, table=>'ACCESSORY_COMPAT', silent=>1});
last if (!&prompt({default=>'yes', prompt=>'Add another compatible lens?', type=>'boolean'}));
}
}
return $accessoryid;
}
# Add a new type of "other" accessory to the database
sub accessory_category {
my $href = shift;
my $db = $href->{db};
my %data;
$data{accessory_type} = $href->{accessory_type} // &prompt({prompt=>'What category of accessory do you want to add?'});
return &newrecord({db=>$db, data=>\%data, table=>'ACCESSORY_TYPE'});
}
# Display info about an accessory
sub accessory_info {
my $href = shift;
my $db = $href->{db};
my $accessory_id = $href->{accessory_id} // &listchoices({db=>$db, table=>'choose_accessory'});
print Dump(&lookupcol({db=>$db, table=>'info_accessory', where=>{'`Accessory ID`'=>$accessory_id}}));
return;
}
# Search for an accessory
sub accessory_search {
my $href = shift;
my $db = $href->{db};
my $searchterm = $href->{searchterm} // &prompt({prompt=>'Enter search term'});
# Perform search
my $id = &search({
db => $db,
cols => ['id', 'opt'],
table => 'choose_accessory',
where => "opt like '%$searchterm%' collate utf8mb4_general_ci",
searchterm => $searchterm,
choices => [
{ desc => 'Do nothing' },
{ handler => \&accessory_info, desc => 'Display info about an accessory', id=>'accessory_id' },
],
});
return $id;
}
# Add a new enlarger to the database
sub enlarger_add {
my $href = shift;
my $db = $href->{db};
my %data;
$data{manufacturer_id} = $href->{manufacturer_id} // &choose_manufacturer({db=>$db});
$data{enlarger} = $href->{enlarger} // &prompt({prompt=>'What is the model of this enlarger?'});
$data{negative_size_id} = $href->{negative_size_id} // &listchoices({db=>$db, cols=>['negative_size_id as id', 'negative_size as opt'], table=>'NEGATIVE_SIZE', inserthandler=>\&negativesize_add});
$data{introduced} = $href->{introduced} // &prompt({prompt=>'What year was this enlarger introduced?', type=>'integer'});
$data{discontinued} = $href->{discontinued} // &prompt({prompt=>'What year was this enlarger discontinued?', type=>'integer'});
$data{acquired} = $href->{acquired} // &prompt({default=>&today, prompt=>'Purchase date', type=>'date'});
$data{cost} = $href->{cost} // &prompt({prompt=>'Purchase price', type=>'decimal'});
return &newrecord({db=>$db, data=>\%data, table=>'ENLARGER'});
}
# Display info about an enlarger
sub enlarger_info {
my $href = shift;
my $db = $href->{db};
my $enlarger_id = $href->{enlarger_id} // &listchoices({db=>$db, table=>'choose_enlarger', required=>1});
print Dump(&lookupcol({db=>$db, table=>'info_enlarger', where=>{'`Enlarger ID`'=>$enlarger_id}}));
return;
}
# Sell an enlarger
sub enlarger_sell {
my $href = shift;
my $db = $href->{db};
my %data;
my $enlarger_id = $href->{enlarger_id} // &listchoices({db=>$db, table=>'choose_enlarger', required=>1});
$data{lost} = $href->{lost} // &prompt({default=>&today, prompt=>'What date was this enlarger sold?', type=>'date'});
$data{lost_price} = $href->{lost_price} // &prompt({prompt=>'How much did this enlarger sell for?', type=>'decimal'});
return &updaterecord({db=>$db, data=>\%data, table=>'ENLARGER', where=>{enlarger_id=>$enlarger_id}});
}
# Add a new flash to the database
sub flash_add {
my $href = shift;
my $db = $href->{db};
my %data;
$data{manufacturer_id} = $href->{manufacturer_id} // &choose_manufacturer({db=>$db});
$data{model} = $href->{model} // &prompt({prompt=>'What is the model of this flash?'});
$data{guide_number} = $href->{guide_number} // &prompt({prompt=>'What is the guide number of this flash?', type=>'integer'});
$data{gn_info} = $href->{gn_info} // &prompt({default=>'ISO 100', prompt=>'What are the conditions of the guide number?'});
$data{battery_powered} = $href->{battery_powered} // &prompt({default=>'yes', prompt=>'Is this flash battery-powered?', type=>'boolean'});
if ($data{battery_powered} == 1) {
$data{battery_type_id} = $href->{battery_type_id} // &listchoices({db=>$db, keyword=>'battery type', table=>'choose_battery', inserthandler=>\&battery_add});
$data{battery_qty} = $href->{battery_qty} // &prompt({prompt=>'How many batteries does this flash need?', type=>'integer'});
}
$data{pc_sync} = $href->{pc_sync} // &prompt({default=>'yes', prompt=>'Does this flash have a PC sync socket?', type=>'boolean'});
$data{hot_shoe} = $href->{hot_shoe} // &prompt({default=>'yes', prompt=>'Does this flash have a hot shoe connector?', type=>'boolean'});
$data{light_stand} = $href->{light_stand} // &prompt({default=>'yes', prompt=>'Can this flash be fitted onto a light stand?', type=>'boolean'});
$data{manual_control} = $href->{manual_control} // &prompt({default=>'yes', prompt=>'Does this flash have manual power control?', type=>'boolean'});
$data{swivel_head} = $href->{swivel_head} // &prompt({default=>'yes', prompt=>'Does this flash have a left/right swivel head?', type=>'boolean'});
$data{tilt_head} = $href->{tilt_head} // &prompt({default=>'yes', prompt=>'Does this flash have an up/down tilt head?', type=>'boolean'});
$data{zoom} = $href->{zoom} // &prompt({default=>'yes', prompt=>'Does this flash have a zoom head?', type=>'boolean'});
$data{dslr_safe} = $href->{dslr_safe} // &prompt({default=>'yes', prompt=>'Is this flash safe to use on a DSLR?', type=>'boolean'});
$data{ttl} = $href->{ttl} // &prompt({default=>'yes', prompt=>'Does this flash support TTL metering?', type=>'boolean'});
if ($data{ttl} == 1) {
$data{flash_protocol_id} = $href->{flash_protocol_id} // &listchoices({db=>$db, table=>'choose_flash_protocol'});
}
$data{trigger_voltage} = $href->{trigger_voltage} // &prompt({prompt=>'What is the measured trigger voltage?', type=>'decimal'});
$data{own} = 1;
$data{acquired} = $href->{acquired} // &prompt({default=>&today, prompt=>'When was it acquired?', type=>'date'});
$data{cost} = $href->{cost} // &prompt({prompt=>'What did this flash cost?', type=>'decimal'});
return &newrecord({db=>$db, data=>\%data, table=>'FLASH'});
}
# Add a new type of battery to the database
sub battery_add {
my $href = shift;
my $db = $href->{db};
my %data;
$data{battery_name} = $href->{battery_name} // &prompt({prompt=>'What is the name of this battery?'});
$data{voltage} = $href->{voltage} // &prompt({prompt=>'What is the nominal voltage of this battery?', type=>'decimal'});
$data{chemistry} = $href->{chemistry} // &prompt({prompt=>'What type of chemistry is this battery based on?'});
$data{other_names} = $href->{other_names} // &prompt({prompt=>'Does this type of battery go by any other names?'});
return &newrecord({db=>$db, data=>\%data, table=>'BATTERY'});
}
# Add a new film format to the database
sub format_add {
my $href = shift;
my $db = $href->{db};
my %data;
$data{format} = $href->{format} // &prompt({prompt=>'What is the name of this film format?'});
$data{digital} = $href->{digital} // &prompt({default=>'no', prompt=>'Is this a digital format?', type=>'boolean'});
return &newrecord({db=>$db, data=>\%data, table=>'FORMAT'});
}
# Add a size of negative to the database
sub negativesize_add {
my $href = shift;
my $db = $href->{db};
my %data;
$data{negative_size} = $href->{negative_size} // &prompt({prompt=>'What is the name of this negative size?'});
$data{width} = $href->{width} // &prompt({prompt=>'What is the width of this negative size in mm?', type=>'decimal'});
$data{height} = $href->{height} // &prompt({prompt=>'What is the height of this negative size in mm?', type=>'decimal'});
if ($data{width} > 0 && $data{height} > 0) {
$data{crop_factor} = round(sqrt($data{width}*$data{width} + $data{height}*$data{height}) / sqrt(36*36 + 24*24), 2);
$data{area} = $data{width} * $data{height};
$data{aspect_ratio} = round($data{width} / $data{height}, 2);
}
return &newrecord({db=>$db, data=>\%data, table=>'NEGATIVE_SIZE'});
}
# Add a new mount adapter to the database
sub mount_adapt {
my $href = shift;
my $db = $href->{db};
my %data;
$data{lens_mount} = $href->{lens_mount} // &listchoices({db=>$db, keyword=>'lens-facing mount', cols=>['mount_id as id', 'mount as opt'], table=>'choose_mount', where=>{'purpose'=>'Camera'}, inserthandler=>\&mount_add});
$data{camera_mount} = $href->{camera_mount} // &listchoices({db=>$db, keyword=>'camera-facing mount', cols=>['mount_id as id', 'mount as opt'], table=>'choose_mount', where=>{'purpose'=>'Camera'}, inserthandler=>\&mount_add});
$data{has_optics} = $href->{has_optics} // &prompt({prompt=>'Does this mount adapter have corrective optics?', type=>'boolean'});
$data{infinity_focus} = $href->{infinity_focus} // &prompt({prompt=>'Does this mount adapter have infinity focus?', type=>'boolean'});
$data{notes} = $href->{notes} // &prompt({prompt=>'Notes'});
return &newrecord({db=>$db, data=>\%data, table=>'MOUNT_ADAPTER'});
}
# Add a new light meter to the database
sub lightmeter_add {
my $href = shift;
my $db = $href->{db};
my %data;
$data{manufacturer_id} = $href->{manufacturer_id} // &choose_manufacturer({db=>$db});
$data{model} = $href->{model} // &prompt({prompt=>'What is the model of this light meter?'});
$data{metering_type} = $href->{metering_type} // &listchoices({db=>$db, cols=>['metering_type_id as id', 'metering as opt'], table=>'METERING_TYPE', inserthandler=>\&meteringtype_add});
$data{reflected} = $href->{reflected} // &prompt({prompt=>'Can this meter take reflected light readings?', type=>'boolean'});
$data{incident} = $href->{incident} // &prompt({prompt=>'Can this meter take incident light readings?', type=>'boolean'});
$data{spot} = $href->{spot} // &prompt({prompt=>'Can this meter take spot readings?', type=>'boolean'});
$data{flash} = $href->{flash} // &prompt({prompt=>'Can this meter take flash readings?', type=>'boolean'});
$data{min_asa} = $href->{min_asa} // &prompt({prompt=>'What\'s the lowest ISO/ASA setting this meter supports?', type=>'integer'});
$data{max_asa} = $href->{max_asa} // &prompt({prompt=>'What\'s the highest ISO/ASA setting this meter supports?', type=>'integer'});
$data{min_lv} = $href->{min_lv} // &prompt({prompt=>'What\'s the lowest light value (LV) reading this meter can give?', type=>'integer'});
$data{max_lv} = $href->{max_lv} // &prompt({prompt=>'What\'s the highest light value (LV) reading this meter can give?', type=>'integer'});
return &newrecord({db=>$db, data=>\%data, table=>'LIGHT_METER'});
}
# Add a new camera body type
sub camera_addbodytype {
my $href = shift;
my $db = $href->{db};
my %data;
$data{body_type} = $href->{body_type} // &prompt({prompt=>'Enter new camera body type'});
return &newrecord({db=>$db, data=>\%data, table=>'BODY_TYPE'});
}
# Add a new series of camera/lens models
sub series_add {
my $href = shift;
my $db = $href->{db};
my %data;
$data{name} = $href->{name} // &prompt({prompt=>'What is the name of this series?'});
return &newrecord({db=>$db, data=>\%data, table=>'SERIES'});
}
# Print info about a series
sub series_info {
my $href = shift;
my $db = $href->{db};
my $series_id = $href->{series_id} // &listchoices({db=>$db, cols=>['series_id as id', 'name as opt'], table=>'SERIES', required=>1});
my $seriesname = &lookupval({db=>$db, col=>'name', table=>'SERIES', where=>{series_id=>$series_id}});
my $total = &printlist({db=>$db, msg=>"camera and lens models in series '$seriesname'", table=>'info_series', cols=>["Got as id", 'Model as opt'], where=>{'`Series ID`'=>$series_id}});
my $got = &lookupval({db=>$db, col=>'count(*)', table=>'info_series', where=>{'`Series ID`'=>$series_id, Got=>'â'}});
if ($total > 0) {
my $need = $total - $got;
my $percentcomplete = round(100 * $got/$total);
print "Series '$seriesname' is $percentcomplete% complete (got $got, need $need)\n";
}
return;
}
# Summarise all series
sub series_list {
my $href = shift;
my $db = $href->{db};
my $rows = &tabulate({db=>$db, view=>'summary_series'});
return $rows;
}
# List all models we need
sub series_need {
my $href = shift;
my $db = $href->{db};
my $rows = &printlist({db=>$db, msg=>'models needed to complete series', cols=>["'' as id", 'Model as opt'], table=>'info_series', where=>{'Got'=>'â'}});
return $rows;
}
# Add a new physical archive for prints or films
sub archive_add {
my $href = shift;
my $db = $href->{db};
my %data;
$data{archive_type_id} = $href->{archive_type_id} // &listchoices({db=>$db, cols=>['archive_type_id as id', 'archive_type as opt'], table=>'ARCHIVE_TYPE'});
$data{name} = $href->{name} // &prompt({prompt=>'What is the name of this archive?'});
$data{max_width} = $href->{max_width} // &prompt({prompt=>'What is the maximum width of media that this archive can accept (if applicable)?'});
$data{max_height} = $href->{max_height} // &prompt({prompt=>'What is the maximum height of media that this archive can accept (if applicable)?'});
$data{location} = $href->{location} // &prompt({prompt=>'What is the location of this archive?'});
$data{storage} = $href->{storage} // &prompt({prompt=>'What is the storage type of this archive? (e.g. box, folder, ringbinder, etc)'});
$data{sealed} = $href->{sealed} // &prompt({default=>'no', prompt=>'Is this archive sealed (closed to new additions)?', type=>'boolean'});
return &newrecord({db=>$db, data=>\%data, table=>'ARCHIVE'});
}
# Bulk-add multiple films to an archive
sub archive_films {
my $href = shift;
my $db = $href->{db};
my %data;
my $minfilm = $href->{minfilm} // &prompt({prompt=>'What is the lowest film ID in the range?', type=>'integer'});
my $maxfilm = $href->{maxfilm} // &prompt({prompt=>'What is the highest film ID in the range?', type=>'integer'});
if (($minfilm =~ m/^\d+$/) && ($maxfilm =~ m/^\d+$/)) {
if ($maxfilm le $minfilm) {
print "Highest film ID must be higher than lowest film ID\n";
return;
}
} else {
print "Must provide highest and lowest film IDs\n";
return;
}
$data{archive_id} = $href->{archive_id} // &listchoices({db=>$db, cols=>['archive_id as id', 'name as opt'], table=>'ARCHIVE', where=>'archive_type_id in (1,2) and sealed = 0', inserthandler=>\&archive_add});
return &updaterecord({db=>$db, data=>\%data, table=>'FILM', where=>"film_id >= $minfilm and film_id <= $maxfilm and archive_id is null"});
}
# Display info about an archive
sub archive_info {
my $href = shift;
my $db = $href->{db};
my $archive_id = $href->{archive_id} // &listchoices({db=>$db, cols=>['archive_id as id', 'name as opt'], table=>'ARCHIVE', required=>1});
print Dump(&lookupcol({db=>$db, table=>'info_archive', where=>{'`Archive ID`'=>$archive_id}}));
return;
}
# List the contents of an archive
sub archive_list {
my $href = shift;
my $db = $href->{db};
my $archive_id = $href->{archive_id} // &listchoices({db=>$db, cols=>['archive_id as id', 'name as opt'], table=>'ARCHIVE', required=>1});
my $archive_name = &lookupval({db=>$db, col=>'name', table=>'ARCHIVE', where=>{archive_id=>$archive_id}});
&printlist({db=>$db, msg=>"items in archive $archive_name", table=>'archive_contents', where=>{archive_id=>$archive_id}});
return;
}
# Seal an archive and prevent new items from being added to it
sub archive_seal {
my $href = shift;
my $db = $href->{db};
my %data;
my $archive_id = $href->{archive_id} // &listchoices({db=>$db, cols=>['archive_id as id', 'name as opt'], table=>'ARCHIVE', where=>{sealed=>0}, required=>1});
$data{sealed} = 1;
return &updaterecord({db=>$db, data=>\%data, table=>'ARCHIVE', where=>{archive_id=>$archive_id}});
}
# Unseal an archive and allow new items to be added to it
sub archive_unseal {
my $href = shift;
my $db = $href->{db};
my %data;
my $archive_id = $href->{archive_id} // &listchoices({db=>$db, cols=>['archive_id as id', 'name as opt'], table=>'ARCHIVE', where=>{sealed=>1}, required=>1});
$data{sealed} = 0;
return &updaterecord({db=>$db, data=>\%data, table=>'ARCHIVE', where=>{archive_id=>$archive_id}});
}
# Move an archive to a new location
sub archive_move {
my $href = shift;
my $db = $href->{db};
my %data;
my $archive_id = $href->{archive_id} // &listchoices({db=>$db, cols=>['archive_id as id', 'name as opt'], table=>'ARCHIVE', required=>1});
my $oldlocation = &lookupval({db=>$db, col=>'location', table=>'ARCHIVE', where=>{archive_id=>$archive_id}});
$data{location} = $href->{location} // &prompt({default=>$oldlocation, prompt=>'What is the new location of this archive?'});
return &updaterecord({db=>$db, data=>\%data, table=>'ARCHIVE', where=>{archive_id=>$archive_id}});
}
# Add a new type of shutter to the database
sub shuttertype_add {
my $href = shift;
my $db = $href->{db};
my %data;
$data{shutter_type} = $href->{shutter_type} // &prompt({prompt=>'What type of shutter do you want to add?', required=>1});
return &newrecord({db=>$db, data=>\%data, table=>'SHUTTER_TYPE'});
}
# Add a new type of focus system to the database
sub focustype_add {
my $href = shift;
my $db = $href->{db};
my %data;
$data{focus_type} = $href->{focus_type} // &prompt({prompt=>'What type of focus system do you want to add?', required=>1});
return &newrecord({db=>$db, data=>\%data, table=>'FOCUS_TYPE'});
}
# Add a new flash protocol to the database
sub flashprotocol_add {
my $href = shift;
my $db = $href->{db};
my %data;
$data{manufacturer_id} = $href->{manufacturer_id} // &choose_manufacturer({db=>$db});
$data{name} = $href->{name} // &prompt({prompt=>'What flash protocol do you want to add?', required=>1});
return &newrecord({db=>$db, data=>\%data, table=>'FLASH_PROTOCOL'});
}
# Add a new type of metering system to the database
sub meteringtype_add {
my $href = shift;
my $db = $href->{db};
my %data;
$data{metering} = $href->{metering} // &prompt({prompt=>'What type of metering system do you want to add?', required=>1});
return &newrecord({db=>$db, data=>\%data, table=>'METERING_TYPE'});
}
# Add a new shutter speed to the database
sub shutterspeed_add {
my $href = shift;
my $db = $href->{db};
my %data;
$data{shutter_speed} = $href->{shutter_speed} // &prompt({prompt=>'What shutter speed do you want to add?', required=>1});
$data{duration} = &duration($data{shutter_speed});
return &newrecord({db=>$db, data=>\%data, table=>'SHUTTER_SPEED'});
}
# Add a new person to the database
sub person_add {
my $href = shift;
my $db = $href->{db};
my %data;
$data{name} = $href->{name} // &prompt({prompt=>'What is this person\'s name?', required=>1});
return &newrecord({db=>$db, data=>\%data, table=>'PERSON'});
}
# Add a new projector to the database
sub projector_add {
my $href = shift;
my $db = $href->{db};
my %data;
$data{manufacturer_id} = $href->{manufacturer_id} // &choose_manufacturer({db=>$db});
$data{model} = $href->{model} // &prompt({prompt=>'What is the model of this projector?'});
$data{mount_id} = $href->{mount_id} // &listchoices({db=>$db, cols=>['mount_id as id', 'mount as opt'], table=>'choose_mount', where=>{'purpose'=>'Projector'}, inserthandler=>\&mount_add});
$data{negative_size_id} = $href->{negative_size_id} // &listchoices({db=>$db, cols=>['negative_size_id as id', 'negative_size as opt'], table=>'NEGATIVE_SIZE', inserthandler=>\&negativesize_add});
$data{own} = 1;
$data{cine} = $href->{cine} // &prompt({prompt=>'Is this a cine/movie projector?', type=>'boolean'});
return &newrecord({db=>$db, data=>\%data, table=>'PROJECTOR'});
}
# Add a new movie to the database
sub movie_add {
my $href = shift;
my $db = $href->{db};
my %data;
$data{title} = $href->{title} // &prompt({prompt=>'What is the title of this movie?'});
$data{camera_id} = $href->{camera_id} // &listchoices({db=>$db, table=>'choose_movie_camera'});
if (&lookupval({db=>$db, col=>'fixed_mount', table=>'CAMERA', where=>{camera_id=>$data{camera_id}}})) {
$data{lens_id} = &lookupval({db=>$db, col=>'lens_id', table=>'CAMERA', where=>{camera_id=>$data{camera_id}}});
} else {
$data{lens_id} = $href->{lens_id} // &listchoices({db=>$db, table=>'choose_lens'});
}
$data{format_id} = $href->{format_id} // &listchoices({db=>$db, cols=>['format_id as id', 'format as opt'], table=>'FORMAT', inserthandler=>\&format_add});
$data{sound} = $href->{sound} // &prompt({prompt=>'Does this movie have sound?', type=>'boolean'});
$data{fps} = $href->{fps} // &prompt({prompt=>'What is the framerate of this movie in fps?', type=>'integer'});
$data{filmstock_id} = $href->{filmstock_id} // &listchoices({db=>$db, table=>'choose_filmstock', inserthandler=>\&filmstock_add});
$data{feet} = $href->{feet} // &prompt({prompt=>'What is the length of this movie in feet?', type=>'integer'});
$data{date_loaded} = $href->{date_loaded} // &prompt({default=>&today, prompt=>'What date was the film loaded?', type=>'date'});
$data{date_shot} = $href->{date_shot} // &prompt({default=>&today, prompt=>'What date was the movie shot?', type=>'date'});
$data{date_processed} = $href->{date_processed} // &prompt({default=>&today, prompt=>'What date was the movie processed?', type=>'date'});
$data{process_id} = $href->{process_id} // &listchoices({db=>$db, keyword=>'process', cols=>['process_id as id', 'name as opt'], table=>'PROCESS', inserthandler=>\&process_add});
$data{description} = $href->{description} // &prompt({prompt=>'Please enter a description of the movie'});
return &newrecord({db=>$db, data=>\%data, table=>'MOVIE'});
}
# Show info about a movie
sub movie_info {
my $href = shift;
my $db = $href->{db};
my $movie_id = $href->{movie_id} // &listchoices({db=>$db, cols=>['movie_id as id', 'title as opt'], table=>'MOVIE', required=>1});
print Dump(&lookupcol({db=>$db, table=>'info_movie', where=>{'`Movie ID`'=>$movie_id}}));
return;
}
# Audit cameras without shutter speed data
sub audit_shutterspeeds {
my $href = shift;
my $db = $href->{db};
my $cameramodel_id = $href->{cameramodel_id} // &listchoices({db=>$db, keyword=>'camera model without shutter speed data', table=>'choose_cameramodel_without_shutter_data', required=>1});
&cameramodel_shutterspeeds({db=>$db, cameramodel_id=>$cameramodel_id});
return;
}
# Audit cameras without exposure program data
sub audit_exposureprograms {
my $href = shift;
my $db = $href->{db};
my $cameramodel_id = $href->{cameramodel_id} // &listchoices({db=>$db, keyword=>'camera model without exposure program data', table=>'choose_cameramodel_without_exposure_programs', required=>1});
&cameramodel_exposureprogram({db=>$db, cameramodel_id=>$cameramodel_id});
return;
}
# Audit cameras without metering mode data
sub audit_meteringmodes {
my $href = shift;
my $db = $href->{db};
my $cameramodel_id = $href->{cameramodel_id} // &listchoices({db=>$db, keyword=>'camera without metering mode data', table=>'choose_cameramodel_without_metering_data', required=>1});
&cameramodel_meteringmode({db=>$db, cameramodel_id=>$cameramodel_id});
return;
}
# Add a new exhibition to the database
sub exhibition_add {
my $href = shift;
my $db = $href->{db};
my %data;
$data{title} = $href->{title} // &prompt({prompt=>'What is the title of this exhibition?', required=>1});
$data{location} = $href->{location} // &prompt({prompt=>'Where is this exhibition?'});
$data{start_date} = $href->{start_date} // &prompt({prompt=>'What date does the exhibition start?', type=>'date'});
$data{end_date} = $href->{end_date} // &prompt({prompt=>'What date does the exhibition end?', type=>'date'});
return &newrecord({db=>$db, data=>\%data, table=>'EXHIBITION'});
}
# Review which prints were exhibited at an exhibition
sub exhibition_info {
my $href = shift;
my $db = $href->{db};
my $exhibition_id = &listchoices({db=>$db, cols=>['exhibition_id as id', 'title as opt'], table=>'EXHIBITION', required=>1});
my $title = &lookupval({db=>$db, col=>'title', table=>'EXHIBITION', where=>{exhibition_id=>$exhibition_id}});
&printlist({db=>$db, msg=>"prints exhibited at $title", table=>'exhibits', where=>{exhibition_id=>$exhibition_id}});
return;
}
# Run a selection of maintenance tasks on the database
sub run_task {
my $href = shift;
my $db = $href->{db};
my @choices = (
{ desc => 'Set right lens_id for all negatives taken with fixed-lens cameras', proc => 'update_lens_id_fixed_camera' },
{ desc => 'Update lens focal length per negative', proc => 'update_focal_length' },
{ desc => 'Update dates of fixed lenses', proc => 'update_dates_of_fixed_lenses' },
{ desc => 'Set metering mode for negatives taken with cameras with only one metering mode', proc => 'update_metering_modes' },
{ desc => 'Set exposure program for negatives taken with cameras with only one exposure program', proc => 'update_exposure_programs' },
{ desc => 'Set fixed lenses as lost when their camera is lost', proc => 'set_fixed_lenses' },
{ desc => 'Set crop factor, area, and aspect ratio for negative sizes that lack it', proc => 'update_negative_sizes' },
{ desc => 'Set no flash for negatives taken with cameras that don\'t support flash', proc => 'update_negative_flash' },
{ desc => 'Delete log entries older than 90 days', proc => 'delete_logs' },
{ desc => 'Update copied negatives with inherited data', proc => 'update_copied_negs'},
);
my $action = &multiplechoice({choices => \@choices});
if (defined($action) && $choices[$action]->{proc}) {
my $rows = &call({db=>$db, procedure=>$choices[$action]->{proc}});
$rows = &unsci($rows);
print "Updated $rows rows\n";
return $rows;
}
return;
}
# Run a selection of reports on the database
sub run_report {
my $href = shift;
my $db = $href->{db};
my @choices = (
{ desc => 'How many cameras in the collection are from each decade', view => 'report_cameras_by_decade', },
{ desc => 'Lenses have been used to take most frames', view => 'report_most_popular_lenses_relative', },
{ desc => 'Cameras that have never been to used to take a frame', view => 'report_never_used_cameras', },
{ desc => 'Lenses that have never been used to take a frame', view => 'report_never_used_lenses', },
{ desc => 'Cameras that have taken most frames', view => 'report_total_negatives_per_camera', },
{ desc => 'Lenses that have taken most frames', view => 'report_total_negatives_per_lens', },
{ desc => 'Negatives that have not been scanned', view => 'report_unscanned_negs', },
{ desc => 'Potential duplicate camera models', view => 'report_duplicate_cameramodels', },
{ desc => 'Potential duplicate lens models', view => 'report_duplicate_lensmodels', },
{ desc => 'Duplicate cameras', view => 'report_duplicate_cameras', },
{ desc => 'Duplicate lenses', view => 'report_duplicate_lenses', },
);
my $action = &multiplechoice({choices => \@choices});
if (defined($action) && $choices[$action]->{view}) {
&tabulate({db=>$db, view=>$choices[$action]->{view}});
}
return;
}
# Run database migrations to upgrade the schema
sub run_migrations {
my $href = shift;
my $db = $href->{db};
&runmigrations($db);
return;
}
# Select a manufacturer using the first initial
sub choose_manufacturer {
my $href = shift;
my $db = $href->{db};
my $default = $href->{default};
if ($default) {
my $manufacturer = &lookupval({db=>$db, col=>'manufacturer', table=>'MANUFACTURER', where=>{manufacturer_id=>$default}});
return $default if (!&prompt({prompt=>"Current manufacturer is $manufacturer. Change this?", type=>'boolean', default=>'no'}));
}
# Loop until we get valid input
my $initial;
do {
$initial = &prompt({prompt=>'Enter the first initial of the manufacturer', type=>'text'});
} while (!($initial =~ m/^[a-z]$/i || $initial eq ''));
$initial = lc($initial);
return &listchoices({db=>$db, cols=>['manufacturer_id as id', 'manufacturer as opt'], table=>'MANUFACTURER', where=>{'lower(left(manufacturer, 1))'=>$initial}, inserthandler=>\&handlers::manufacturer_add, required=>1});
}
# Audit cameras without display lenses set
sub audit_displaylenses {
my $href = shift;
my $db = $href->{db};
my $camera_id = $href->{camera_id} // &listchoices({db=>$db, keyword=>'camera', table=>'camera_chooser', where=>{mount_id=>{'!=', undef}, display_lens=>{'=', undef}}, required=>1 });
&camera_displaylens({db=>$db, camera_id=>$camera_id});
return;
}
# Show statistics about the database
sub db_stats {
my $href = shift;
my $db = $href->{db};
my %data;
$data{'Total cameras'} = &lookupval({db=>$db, col=>'count(camera_id)', table=>'CAMERA'});
$data{'Total lenses'} = &lookupval({db=>$db, col=>'count(lens_id)', table=>'LENS'});
$data{'Total negatives'} = &lookupval({db=>$db, col=>'count(negative_id)', table=>'NEGATIVE'});
$data{'Total prints'} = &lookupval({db=>$db, col=>'count(print_id)', table=>'PRINT'});
print Dump(\%data);
return;
}
# Show database logs
sub db_logs {
my $href = shift;
my $db = $href->{db};
print Dump(&lookuplist({db=>$db, col=>"concat(datetime, ' ', type, ' ', message) as log", table=>'LOG'}));
return;
}
# Print basic database info
sub db_test {
my $href = shift;
my $db = $href->{db};
my $hostname = $db->{'mysql_hostinfo'};
my $version = $db->{'mysql_serverinfo'};
my $stats = $db->{'mysql_stat'};
$stats =~ s/ /\n\t/g;
print "\tConnected to $hostname\n\tRunning version $version\n\t$stats\n";
return;
}
# Add a new scan of a negative or print
sub scan_add {
my $href = shift;
my $db = $href->{db};
my %data;
$data{negative_id} = $href->{negative_id};
$data{print_id} = $href->{print_id};
if (!defined($href->{negative_id}) && !defined($href->{print_id})) {
if (&prompt({prompt=>'Is this a scan of a negative?', type=>'boolean'})) {
# choose negative
$data{negative_id} = &chooseneg({db=>$db});
} else {
# choose print
$data{print_id} = &prompt({prompt=>'Which print did you scan?', type=>'integer'});
}
}
$data{filename} = $href->{filename} // &prompt({prompt=>'Enter the filename of this scan', type=>'text'});
return &newrecord({db=>$db, data=>\%data, table=>'SCAN'});
}
# Add a new scan which is a derivative of an existing one
sub scan_edit {
my $href = shift;
my $db = $href->{db};
# Prompt user for filename of scan
my $scan_id = $href->{scan_id} // &choosescan({db=>$db});
# Work out negative_id or print_id
my $scan_data = &lookupcol({db=>$db, cols=>['negative_id', 'print_id'], table=>'SCAN', where=>{scan_id=>$scan_id}});
$scan_data = &thin($$scan_data[0]);
# Insert new scan from same source
return &scan_add({db=>$db, scan_data=>$scan_data});
}
# 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
( run in 0.573 second using v1.01-cache-2.11-cpan-6aa56a78535 )