App-PhotoDB
view release on metacpan or search on metacpan
App::PhotoDB - App to manage a collection of film cameras & lenses
=head1 SYNOPSIS
All usage of PhotoDB is via the interactive command line, which is launched by running
photodb [OPTIONS]
=head1 OPTIONS
PhotoDB uses a config file to store database connection info. You will be prompted to create this file on first run. However, you can override this by
specifying database connection info as command line options. It is only recommended to do this for local testing. If you specify these database connection
options, you must specify either ALL of them or NONE of them.
=over
=item -h --host
Hostname or IP address of MySQL database server
=item -s --schema
This guide tries to explain the key concepts behind PhotoDB. It is not an exhaustive guide to every command available. To list all commands, run C<help>. To
list all subcommands available under a command, run (for example) C<camera>. Each subcommand has a brief explanation with it.
=head2 User data
Out of the box, PhotoDB is mostly empty, ready for you to enter your own data. However if you install PhotoDB in the recommended way, it comes with some pre-
filled data e.g. about manufacturers, film emulsions, film sizes, metering modes, etc, to get you up and running faster. In many cases you'll want to add to
this data to suit your own needs but you shouldn't need to edit anything that already exists.
The command C<data> has subcommands for adding various pieces of data. Normally, you shouldn't need to go out of your way to add this type of data, as PhotoDB
will prompt you if you need to add any while adding cameras, lenses, films, etc.
=head3 Unique identifiers
Every object registered in PhotoDB (e.g. camera, lenses, films, negatives, etc) is allocated a unique ID number, starting at 1 and counting up. This number is
used to reference other objects. This number is often prefixed with a C<#> for readability, e.g. _Film #99_.
One exception where alternative naming is also used is for negatives. A negative might have an ID of #100 but it may also be referred to in the format 18/6,
where 18 is the ID number of the film it belongs to, and 6 is the number of the frame, separated by a forward slash. This alternative system makes it easier
to handle negatives in the darkroom. It is accepted in most places in PhotoDB where a negative ID is needed.
docker run -it --rm -v ~/.photodb:/root/.photodb --name photodb photodb
=head2 Configure database connection
There are three methods for connecting to the database:
1. Database and application on same computer
2. Database and application on different computers, connect via native MySQL
3. Database and application on different computers, connect via SSH tunnel
The app and accessory scripts need to know how to connect to the database. The first time you run PhotoDB, you will be prompted to enter connection details for
the database backend. If you need to edit the config in future, the config file is created at C</etc/photodb.ini>.
=head3 Tunnelling
If the database is on a remote server and does not have the MySQL port (3306) open to receive connections, you will need to set up a tunnel. Run the command
below, substituting in the correct hostname and username for the database server.
ssh -L 3306:localhost:3306 -N <username>@<database.example.com>
Once the tunnel is established, you should be able to connect to the database on C<127.0.0.1:3306> and your connection will be tunnelled. Configure PhotoDB in
docs/CONTRIBUTING.pod view on Meta::CPAN
After running the script, check which files have been added, removed or changed, and then commit
the diffs with a meaningful commit message.
=head2 Application conventions
The application frontend, C<photodb>, is the smallest possible script to determine which command
the user wants to run, map the command to a handler using C<commands.pm> and then execute the
handler from C<handlers.pm> to complete the user interaction.
Handlers are pieces of code which carry out user interaction, and encode logic about what information
to collect. They tend to be simple but extensive. Most handlers simply run through a list of prompts to
build a hash of data, which is then inserted/updated/etc into the database backend. Some handlers
contain simple logic to make decisions or loops to simplify bulk operations.
Handlers rely on functions in C<funcs.pm> which are reusable pieces of code which do not interact
with the user, but perform common operations like selecting from a database, validating user input,
etc.
=head2 Contributing your work
Pull requests are welcome.
lib/App/PhotoDB.pm view on Meta::CPAN
App::PhotoDB - App to manage a collection of film cameras & lenses
=head1 SYNOPSIS
All usage of PhotoDB is via the interactive command line, which is launched by running
photodb [OPTIONS]
=head1 OPTIONS
PhotoDB uses a config file to store database connection info. You will be prompted to create this file on first run. However, you can override this by
specifying database connection info as command line options. It is only recommended to do this for local testing. If you specify these database connection
options, you must specify either ALL of them or NONE of them.
=over
=item -h --host
Hostname or IP address of MySQL database server
=item -s --schema
lib/App/PhotoDB.pm view on Meta::CPAN
This guide tries to explain the key concepts behind PhotoDB. It is not an exhaustive guide to every command available. To list all commands, run C<help>. To
list all subcommands available under a command, run (for example) C<camera>. Each subcommand has a brief explanation with it.
=head2 User data
Out of the box, PhotoDB is mostly empty, ready for you to enter your own data. However if you install PhotoDB in the recommended way, it comes with some pre-
filled data e.g. about manufacturers, film emulsions, film sizes, metering modes, etc, to get you up and running faster. In many cases you'll want to add to
this data to suit your own needs but you shouldn't need to edit anything that already exists.
The command C<data> has subcommands for adding various pieces of data. Normally, you shouldn't need to go out of your way to add this type of data, as PhotoDB
will prompt you if you need to add any while adding cameras, lenses, films, etc.
=head3 Unique identifiers
Every object registered in PhotoDB (e.g. camera, lenses, films, negatives, etc) is allocated a unique ID number, starting at 1 and counting up. This number is
used to reference other objects. This number is often prefixed with a C<#> for readability, e.g. _Film #99_.
One exception where alternative naming is also used is for negatives. A negative might have an ID of #100 but it may also be referred to in the format 18/6,
where 18 is the ID number of the film it belongs to, and 6 is the number of the frame, separated by a forward slash. This alternative system makes it easier
to handle negatives in the darkroom. It is accepted in most places in PhotoDB where a negative ID is needed.
lib/App/PhotoDB.pm view on Meta::CPAN
docker run -it --rm -v ~/.photodb:/root/.photodb --name photodb photodb
=head2 Configure database connection
There are three methods for connecting to the database:
1. Database and application on same computer
2. Database and application on different computers, connect via native MySQL
3. Database and application on different computers, connect via SSH tunnel
The app and accessory scripts need to know how to connect to the database. The first time you run PhotoDB, you will be prompted to enter connection details for
the database backend. If you need to edit the config in future, the config file is created at C</etc/photodb.ini>.
=head3 Tunnelling
If the database is on a remote server and does not have the MySQL port (3306) open to receive connections, you will need to set up a tunnel. Run the command
below, substituting in the correct hostname and username for the database server.
ssh -L 3306:localhost:3306 -N <username>@<database.example.com>
Once the tunnel is established, you should be able to connect to the database on C<127.0.0.1:3306> and your connection will be tunnelled. Configure PhotoDB in
lib/App/PhotoDB.pm view on Meta::CPAN
my %handlers = %App::PhotoDB::commands::handlers;
&welcome;
# Connect to the database
my $db = &db({args=>$args});
# Set up terminal
our $term = &term;
# Enter interactive prompt and loop until exited by user
while (1) {
my $rv = &prompt({prompt=>'photodb', type=>'text', showtype=>0, showdefault=>0, char=>'>'});
# Trap important keywords first
if ($rv eq 'exit' || $rv eq 'quit') {
last;
} elsif ($rv =~ /^(\w+) ?([\w-]+)?$/) {
# Match a command and an optional subcommand
# Check if the command is defined in the handlers
my $command = $1;
if (!exists $handlers{$command}) {
&nocommand(\%handlers);
next;
lib/App/PhotoDB/funcs.pm view on Meta::CPAN
use Exporter qw(import);
use Config::IniHash;
use YAML;
use Image::ExifTool;
use Term::ReadLine;
use Term::ReadLine::Perl;
use File::Basename;
use Time::Piece;
use Text::TabularDisplay;
our @EXPORT_OK = qw(prompt db updaterecord deleterecord newrecord notimplemented nocommand nosubcommand listchoices lookupval lookuplist today validate ini printlist round pad lookupcol thin resolvenegid chooseneg annotatefilm keyword parselensmodel ...
=head2 prompt
Prompt the user for an arbitrary value. Has various options for data validation and customisation of the prompt.
If the provided input fails validation, or if a blank string is given when required=1 then the prompt is repeated.
=head4 Usage
my $camera = &prompt({prompt=>'What model is the camera?', required=>1, default=>$$defaults{model}, type=>'text'});
would give a prompt like
What model is the camera? (text) []:
=head4 Arguments
=item * C<$default> Default value that will be used if no input from user. Default empty string.
=item * C<$prompt> Prompt message for the user
=item * C<$type> Data type that this input expects, out of C<text>, C<integer>, C<boolean>, C<date>, C<decimal>, C<time>
=item * C<$required> Whether this input is required, or whether it can return an empty value. Default C<0>
=item * C<$showtype> Whether to show the user what data type is expected, in parentheses. Default C<1>
=item * C<$showdefault> Whether to show the user what the default value is set to, in square brackets. Default C<1>
=item * C<$char> Character to print at the end of the prompt. Defaults to C<:>
=head4 Returns
The value the user provided
=cut
sub prompt {
# Pass in a hashref of arguments
my $href = shift;
# Unpack the hashref and set default values
my $default = $href->{default} // ''; # Default value that will be used if no input from user
my $prompt = $href->{prompt}; # Prompt message for the user
my $type = $href->{type} || 'text'; # Data type that this input expects, out of text, integer, boolean, date, decimal, time
my $required = $href->{required} // 0; # Whether this input is required, or whether it can return an empty value
my $showtype = $href->{showtype} // 1; # Whether to show the user what data type is expected
my $showdefault = $href->{showdefault} // 1; # Whether to show the user what the default value is
my $char = $href->{char} // ':'; # Character to print at the end of the prompt
die "Must provide value for \$prompt\n" if !($prompt);
# Rewrite binary bools as strings
if ($type eq 'boolean' && $default ne '') {
$default = &printbool($default);
}
# Assemble prompt text
my $msg = $prompt;
$msg .= " ($type)" if $showtype;
$msg .= " [$default]" if $showdefault;
$msg .= "$char ";
# Create terminal handler
my $term = $App::PhotoDB::term;
my $rv;
# Repeatedly prompt user until we get a response of the correct type
do {
my $input = $term->readline($msg);
# Use default value if user gave blank input
$rv = ($input eq "") ? $default:$input;
# Prompt again if the input doesn't pass validation, or if it's a required field that was blank
} while (!&validate({val => $rv, type => $type}) || ($rv eq '' && $required == 1));
# Rewrite friendly bools and then return the value
if ($type eq 'boolean') {
lib/App/PhotoDB/funcs.pm view on Meta::CPAN
"/etc/photodb.ini",
"/photodb/photodb.ini",
);
# Loop through paths and checkt they're readable
for my $path (@paths) {
return $path if (-r $path);
}
# If no file was found, write one out in the preferred location
if (&prompt({default=>'yes', prompt=>'Could not find config file. Generate one now?', type=>'boolean'})) {
my $path = $paths[0];
&writeconfig($path);
return $path;
} else {
exit;
}
}
=head2 db
lib/App/PhotoDB/funcs.pm view on Meta::CPAN
print Dump($data) unless $silent;
print "\n$rowcount records will be updated\n" unless $silent;
print "\n" unless $silent;
# Build query
my $sql = SQL::Abstract->new;
my($stmt, @bind) = $sql->update($table, $data, $where);
# Final confirmation
unless ($silent) {
if (!&prompt({default=>'yes', prompt=>'Proceed?', type=>'boolean'})) {
print "Aborted!\n";
return;
}
}
# Execute query
my $sth = $db->prepare($stmt);
my $rows = $sth->execute(@bind);
$rows = &unsci($rows);
print "Updated $rows rows\n" unless $silent;
lib/App/PhotoDB/funcs.pm view on Meta::CPAN
print "\n\nI will delete from $table where:\n" unless $silent;
print Dump($where) unless $silent;
print "$rowcount records will be deleted\n" unless $silent;
# Build query
my $sql = SQL::Abstract->new;
my($stmt, @bind) = $sql->delete($table, $where);
# Final confirmation
unless ($silent) {
if (!&prompt({default=>'yes', prompt=>'Proceed?', type=>'boolean'})) {
print "Aborted!\n";
return;
}
}
# Execute query
my $sth = $db->prepare($stmt);
my $rows = $sth->execute(@bind);
$rows = &unsci($rows);
print "Deleted $rows rows\n" unless $silent;
lib/App/PhotoDB/funcs.pm view on Meta::CPAN
print "\n\nThis is what I will insert into $table:\n" unless $silent;
print Dump($data) unless $silent;
print "\n" unless $silent;
# Build query
my $sql = SQL::Abstract->new;
my($stmt, @bind) = $sql->insert($table, $data);
# Final confirmation
unless ($silent) {
if (!&prompt({default=>'yes', prompt=>'Proceed?', type=>'boolean'})) {
print "Aborted!\n";
return;
}
}
# Execute query
my $sth = $db->prepare($stmt);
$sth->execute(@bind);
# Display inserted row
lib/App/PhotoDB/funcs.pm view on Meta::CPAN
my($stmt, @bind) = $sql->select($table, $cols, $where);
$sth = $db->prepare($stmt);
$rows = $sth->execute(@bind);
} else {
die "Must pass in either query OR table, cols, where\n";
}
# No point in proceeding if there are no valid options to choose from
if ($rows == 0) {
print "No valid $keyword options to choose from\n";
if ($inserthandler && &prompt({prompt=>"Add a new $keyword?", type=>'boolean', default=>'no'})) {
# add a new entry
my $id = $inserthandler->({db=>$db});
return $id;
} elsif ($skipok) {
return;
} else {
die;
}
}
lib/App/PhotoDB/funcs.pm view on Meta::CPAN
$default = '';
}
}
# Loop until we get valid input
my $input;
my $msg = "Please select a $keyword from the list";
$msg .= ', or leave blank to skip' if ($required == 0);
do {
$input = &prompt({default=>$default, prompt=>$msg, type=>$type, required=>$required});
} while ($input && !($input ~~ [ map {"$_"} @allowedvals ] || $input eq ''));
# Spawn a new handler if that's what the user chose
# Otherwise return what we got
if ($input eq $char && $inserthandler) {
my $id = $inserthandler->({db=>$db});
return $id;
} else {
# Return input
return $input;
lib/App/PhotoDB/funcs.pm view on Meta::CPAN
while (my ($index, $choice) = each @{$choices}) {
print "\t$index\t$$choice{desc}\n";
push(@allowedvals, $index);
}
# Loop until we get valid input
my $input;
my $msg = "Please select an action from the list";
do {
$input = &prompt({prompt=>$msg, type=>'integer'});
} while ($input && !($input ~~ [ map {"$_"} @allowedvals ] || $input eq ''));
return $input;
}
=head2 printlist
Print arbitrary rows from the database as an easy way of displaying data
=head4 Usage
lib/App/PhotoDB/funcs.pm view on Meta::CPAN
return 'yes';
} elsif ($val =~ m/^n(o)?$/i || $val =~ m/^false$/i || $val eq 0) {
return 'no';
} else {
return '';
}
}
=head2 writeconfig
Write out an initial config file by prompting the user interactively.
=head4 Usage
&writeconfig($path);
=head4 Arguments
=item * C<$path> path to the config file that should be written
=head4 Returns
lib/App/PhotoDB/funcs.pm view on Meta::CPAN
$inifile = $1;
# Check for existence of config dir
my $dir = dirname($inifile);
if (!-d $dir) {
# Create it if necessary
mkdir $dir or die "Can't create config directory $dir";
}
my %inidata;
$inidata{'database'}{'host'} = &prompt({default=>'localhost', prompt=>'Database hostname or IP address', type=>'text'});
$inidata{'database'}{'schema'} = &prompt({default=>'photodb', prompt=>'Schema name of photography database', type=>'text'});
$inidata{'database'}{'user'} = &prompt({default=>'photodb', prompt=>'Username with access to the schema', type=>'text'});
$inidata{'database'}{'pass'} = &prompt({default=>'', prompt=>'Password for this user', type=>'text'});
$inidata{'filesystem'}{'basepath'} = &prompt({default=>'', prompt=>'Path to your scanned images', type=>'text'});
WriteINI($inifile, \%inidata)
or die "Could not write to ini file at $inifile\n";
return;
}
=head2 round
Round a number to any precision
=head4 Usage
lib/App/PhotoDB/funcs.pm view on Meta::CPAN
Integer representing the negative ID
=cut
sub chooseneg {
my $href = shift;
my $db = $href->{db};
my $oktoreturnundef = $href->{oktoreturnundef} || 0;
# Choose a film
my $film_id = &prompt({default=>'', prompt=>'Enter Film ID', type=>'integer'});
# Choose a negative from this film
my $frame = &listchoices({db=>$db, table=>'NEGATIVE', cols=>'frame as id, description as opt', where=>{film_id=>$film_id}, type=>'text'});
my $neg_id = &lookupval({db=>$db, col=>"lookupneg($film_id, $frame)", table=>'NEGATIVE'});
if (defined($neg_id) && $neg_id =~ m/^\d+$/) {
return $neg_id;
} elsif ($oktoreturnundef == 1) {
return;
} else {
die "Could not find a negative ID for film $film_id and frame $frame\n";
lib/App/PhotoDB/funcs.pm view on Meta::CPAN
# Prepare and execute the SQL
my $sth = $db->prepare($stmt) or die "Couldn't prepare statement: " . $db->errstr;
my $rows = $sth->execute(@bind);
$rows = &unsci($rows);
# Get confirmation
if ($rows == 0) {
print "No scans be will tagged\n";
return;
}
return unless &prompt({prompt=>"This will review and potentially update the tags of $rows scans. Proceed?", type=>'boolean'});
# Set some globals
my $foundcount=0;
my $changedcount=0;
my @missingfiles;
# Loop through our result set
while (my $ref = $sth->fetchrow_hashref()) {
# First check the path is defined in MySQL
if (defined($ref->{'path'})) {
lib/App/PhotoDB/funcs.pm view on Meta::CPAN
=head4 Returns
Integer representing the scan ID
=cut
sub choosescan {
my $href = shift;
my $db = $href->{db};
# prompt user for filename of scan
my $filename = &prompt({prompt=>'Please enter the filename of the scan', type=>'text'});
# should be unique if filename is X-Y-img1234.jpg, otherwise they can choose
return &listchoices({db=>$db, table=>'choose_scan', where=>{'filename'=>$filename}, type=>'text'});
}
=head2 basepath
Returns filesystem basepath which contains scans
lib/App/PhotoDB/funcs.pm view on Meta::CPAN
ID of located object
=cut
# Search for objects in the database
sub search {
my $href = shift;
my $db = $href->{db};
my $table = $href->{table};
my $keyword = $href->{keyword} // &keyword($table);
my $searchterm = $href->{searchterm} // &prompt({prompt=>"Enter $keyword search term"});
my $cols = $href->{cols} // ['id', 'opt'];
my $where = $href->{where} // "opt like '%$searchterm%' collate utf8mb4_general_ci";
my $choices = $href->{choices};
print "Searching for $keyword objects that match '$searchterm'\n";
# Perform search
my $id = &listchoices({
db => $db,
cols => $cols,
lib/App/PhotoDB/funcs.pm view on Meta::CPAN
# If we narrowed it down to one year, return that. Otherwise, return nothing.
if (scalar(@plausible) == 1) {
return $plausible[0];
}
return;
}
=head2 choose_shutterspeed
While entering a negative into a film, prompt the user to select an available shutter speed for the camera in use. If they choose C<B> or C<T>, prompt them for
the duration in seconds, and return that instead. Also add it to the C<SHUTTER_SPEED_AVAILABLE> table, marked as a "bulb" speed if necessary.
=head4 Usage
my $shutter_speed = &choose_shutterspeed({db=>$db, film_id=>$film_id});
=head4 Arguments
=item * C<$db> DB handle
lib/App/PhotoDB/funcs.pm view on Meta::CPAN
sub choose_shutterspeed {
my $href = shift;
my $db = $href->{db};
my $film_id = $href->{film_id};
# Prompt user to choose available shutter speed for their camera
my $shutter_speed = &listchoices({db=>$db, keyword=>'shutter speed', table=>'choose_shutter_speed_by_film', where=>{film_id=>$film_id}, type=>'text', required=>1});
# If they chose B or T
if ($shutter_speed eq 'B' or $shutter_speed eq 'T') {
my $shutter_speed = &prompt({prompt=>'What duration was the exposure? (s)', type=>'integer', required=>1});
# If this is not already a valid shutter speed, insert it as a bulb-only speed
my $cameramodel_id = &lookupval({db=>$db, col=>'cameramodel_id', table=>'FILM join CAMERA on FILM.camera_id=CAMERA.camera_id', where=>{film_id=>$film_id}});
if (!&lookupval({db=>$db, col=>'count(*)', table=>'SHUTTER_SPEED_AVAILABLE', where=>{cameramodel_id=>$cameramodel_id, shutter_speed=>$shutter_speed}})) {
# insert new bulb shutter speed
my %data;
$data{cameramodel_id} = $cameramodel_id;
$data{shutter_speed} = $shutter_speed;
$data{bulb} = 1;
&newrecord({db=>$db, data=>\%data, table=>'SHUTTER_SPEED_AVAILABLE', silent=>1});
lib/App/PhotoDB/handlers.pm view on Meta::CPAN
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});
lib/App/PhotoDB/handlers.pm view on Meta::CPAN
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' },
lib/App/PhotoDB/handlers.pm view on Meta::CPAN
});
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};
lib/App/PhotoDB/handlers.pm view on Meta::CPAN
# 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}});
}
lib/App/PhotoDB/handlers.pm view on Meta::CPAN
# 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'});
lib/App/PhotoDB/handlers.pm view on Meta::CPAN
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 {
lib/App/PhotoDB/handlers.pm view on Meta::CPAN
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' },
lib/App/PhotoDB/handlers.pm view on Meta::CPAN
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});
lib/App/PhotoDB/handlers.pm view on Meta::CPAN
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
lib/App/PhotoDB/handlers.pm view on Meta::CPAN
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' },
lib/App/PhotoDB/handlers.pm view on Meta::CPAN
}
# 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});
lib/App/PhotoDB/handlers.pm view on Meta::CPAN
${@$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' },
lib/App/PhotoDB/handlers.pm view on Meta::CPAN
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});
lib/App/PhotoDB/handlers.pm view on Meta::CPAN
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
lib/App/PhotoDB/handlers.pm view on Meta::CPAN
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";
lib/App/PhotoDB/handlers.pm view on Meta::CPAN
&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' },
lib/App/PhotoDB/handlers.pm view on Meta::CPAN
});
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}});
lib/App/PhotoDB/handlers.pm view on Meta::CPAN
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});
lib/App/PhotoDB/handlers.pm view on Meta::CPAN
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;
lib/App/PhotoDB/handlers.pm view on Meta::CPAN
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}});
lib/App/PhotoDB/handlers.pm view on Meta::CPAN
}
# 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 });
lib/App/PhotoDB/handlers.pm view on Meta::CPAN
# 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});
lib/App/PhotoDB/handlers.pm view on Meta::CPAN
# 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;
lib/App/PhotoDB/handlers.pm view on Meta::CPAN
# 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";
}
t/04-functional.t view on Meta::CPAN
# Local test database credentials
my $host = 'localhost';
my $schema = 'photodb';
my $user = 'photodb';
my $pass = 'photodb';
# Start up PhotoDB, connected to local db
expect_run(
command => ["bin/photodb -h $host -s $schema -u $user -p $pass --skipmigrations"],
prompt => ['photodb> ', -re => '^.+: '],
quit => 'exit',
);
# run migrations - run migrations to configure schema
expect_send("run migrations", 'run migrations');
expect_like(qr/Applied migration|Up to date/, 'migrations complete');
# db test - test db connectivity
expect_send("db test", 'db test');
expect_like(qr/Connected to /, 'connected');
( run in 0.994 second using v1.01-cache-2.11-cpan-6aa56a78535 )