view release on metacpan or  search on metacpan

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

				# Print remaining key-value pairs for the negative
				foreach (sort keys %$ref) {
					push(@output, "\t$_: $ref->{$_}\n");
				}
			}
			# Write the compiled array out to a file
			open my $fh, '>', $filename or die "Cannot open $filename: $!";
			foreach (@output) {
				print $fh $_;
			}
			close $fh;
		} else {
			print "Film directory $path/$filmdir not found\n";
			return;
		}
	} else {
		print "Path $path not found\n";
		return;
	}
	return;
}

=head2 keyword

Figure out the human-readable keyword of an SQL statement, e.g. statements that select from
C<CAMERA> or C<choose_camera> would return C<camera>. Selecting from C<CAMERA_MOUNT> or
C<choose_camera_mount> would return C<camera mount>. This can be helpful when automating
user messages.

=head4 Usage

    my $keyword = &keyword($query);

=head4 Arguments

=item * C<$query> an SQL statement, e.g. C<SELECT * FROM CAMERA;>

=head4 Returns

A human-readable keyword representing the "subject" of the SQL query

=cut

sub keyword {
	my $query = shift;
	# This matches either a full SQL query, or just the table name
	if ($query =~ m/^.+ from (\w+).*$/i || $query =~ m/^(\w+)$/i) {
		my $text = $1;
		$text = lc($text);
		$text =~ s/^choose_//;
		$text =~ s/_/ /g;
		return $text;
	} else {
		print "Could not deduce valid keyword from SQL\n";
		return;
	}
}

=head2 parselensmodel

Parse lens model name to guess some data about the lens. Either specify which parameter you want
to be returned as a string, or expect a hashref of all params to be returned. Currently supports guessing
C<minfocal> (minimum focal length), C<maxfocal> (maximum focal length), C<zoom> (whether this is a zoom lens)
and C<aperture> (maximum aperture of lens).

=head4 Usage

    my $aperture = &parselensmodel($model, 'aperture');
    my $lensparams = &parselensmodel($model);

=head4 Arguments

=item * C<$model> Model name of the lens

=item * C<$param> The name of the desired parameter. Optional, choose from C<minfocal>, C<maxfocal>, C<zoom> or C<aperture>.

=head4 Returns

=item * If C<$param> is specified, returns the value of this parameter as a string

=item * If C<$param> is undefined, returns a hashref of all parameters

=cut

sub parselensmodel {
	my $model = shift;
	my $param = shift;

	# Define hash to hold results
	my %results;

	if ($model =~ m/(\d+)-?(\d+)?mm/) {
		$results{minfocal} = $1;
		$results{maxfocal} = $2;
	}
	if ($results{minfocal} && $results{maxfocal}) {
		$results{zoom} = 'yes';
	} else {
		$results{zoom} = 'no';
	}
	if ($model =~ m/(f\/|1:)([\d\.]+)/) {
		$results{aperture} = $2;
	}

	if ($param) {
		# If a specific param was requested, return it
		return $results{$param};
	} else {
		# Else return a hashref of all params
		return \%results;
	}
}

=head2 unsetdisplaylens

Unassociate a display lens from a camera by passing in either the camera ID or
the lens ID. It is not harmful to pass in both, but it is pointless.

=head4 Usage

    &unsetdisplaylens({db=>$db, camera_id=>$camera_id});
    &unsetdisplaylens({db=>$db, lens_id=>$lens_id});

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

	my $cols = $href->{cols} // '*';
	my $where = $href->{where} // {};

	# Use SQL::Abstract
	my $sql = SQL::Abstract->new;
	my($stmt, @bind) = $sql->select($view, $cols, $where);

	my $sth = $db->prepare($stmt);
	my $rows = $sth->execute(@bind);
	my $returnedcols = $sth->{'NAME'};
	my @array;
	my $table = Text::TabularDisplay->new(@$returnedcols);
	while (my @row = $sth->fetchrow) {
		$table->add(@row);
	}

	#	print "$choices[$action]{'desc'}\n";
	print $table->render;
	print "\n";
	return $rows;
}


=head2 canondatecode

Decode Canon datecodes to discover the year of manufacture. Datecodes are sometimes ambiguous so by passing in the dates that the model was
introduced and discontinued, the year of manufacture can be pinned down.

=head4 Usage

    my $manufactured = &canondatecode({datecode=>$datecode, introduced=>$introduced, discontinued=>$discontinued});

=head4 Arguments

=item * C<$datecode> the datecode to decode

=item * C<$introduced> year that the model was introduced. Assumes 1800 if not defined.

=item * C<$discontinued> year that the model was discontinued. Assumes 2100 if not defined.

=head4 Returns

Year of manufacture if the decoding was successful, otherwise undef

=cut

sub canondatecode {
	my $href = shift;
	my $datecode = $href->{datecode};
	my $introduced = $href->{introduced} // 1800;
	my $discontinued = $href->{discontinued} // 2100;

	# Reformat datecode for reliable matching
	$datecode = uc($datecode);
	$datecode =~ s/[^A-Z0-9]//g;

	# Map alphabet to numbers
	my %h;
	@h{'A' .. 'Z'} = (0 .. 25);

	my @guesses;

	# AB1234, B1234A, B123A
	# From 1960-2012, the date code is in the form of "AB1234". "A" indicates the factory. Prior to 1986, "A" is moved to the end.
	# "B" is a year code that indicates the year of manufacture. Canon increments this letter each year starting with A in 1960
	# Of the 4 digits, the first two are the month of manufacture. Sometimes the leading 0 is omitted.
	if ($datecode =~ /^[A-Z]?([A-Z])[0-9]{3,4}[A-Z]?$/ ) {
		my $dateletter = $1;
		my $epochstart = 1960;
		my $epochend = 2012;
		my $datenumber = $h{$dateletter};

		for (my $i=0; ; $i++) {
			my $guess = $epochstart + $datenumber + $i*26;

			# Stop if we go above the end date of the datecode epoch
			last if ($guess > $epochend);

			push(@guesses, $guess);
		}

	# From 2008, the date code is 10 digits. The first two correspond to the year & month of manufacture.
	# From 2008-2012 the month code runs from 38-97. In 2013, it is reset to 01. These are treated as different epochs.
	} elsif ($datecode =~ /^(\d{2})\d{8}$/ ) {
		my $datenumber = $1;

		# First epoch
		if ($datenumber >= 38 and $datenumber <= 97) {
			my $epochstart = 2008;
			my $epochend = 2012;
			my $start = 38;

			my $guess = $epochstart + int(($datenumber - $start) / 12);
			push(@guesses, $guess);
		}

		# Second epoch
		{
			my $epochstart = 2013;
			my $epochend = 2100;
			my $start = 1;

			for (my $i=0; ; $i++) {
				my $guess = $epochstart + int((($datenumber + $i*100) - $start) / 12);
				last if ($guess > $epochend);
				push(@guesses, $guess);
			}
		}
	}

	# Now examine our guesses for plausibility based on when the lens was released & discontinued
	my @plausible;
	foreach my $guess (@guesses) {
		# Skip if our guess is before the lens was introduced
		next if ($guess < $introduced);

		# Stop if our guess is after the lens was discontinued
		next if ($guess > $discontinued);

		push(@plausible, $guess);
	}

	# 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

=item * C<$film_id> Film ID that we are inserting into, so the camera can be found

=head4 Returns

String representation of a shutter speed, which is both a valid EXIF representation, and also a valid data object.

=cut

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});
		}
	}
	return $shutter_speed;
}

# This ensures the lib loads smoothly
1;