view release on metacpan or  search on metacpan

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

package App::PhotoDB::funcs;

=head1 Functions

This package provides reusable functions to be consumed by the rest of the PhotoDB application.

Note that some of these functions take traditional argument lists which must
be in order, while the more complex functions take a hashref of arguments
which can be passed in any order. Examples of each function are given.

=cut

use strict;
use warnings;
use experimental 'smartmatch';

use DBI;
use DBD::mysql;
use SQL::Abstract;
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') {
		return friendlybool($rv);
	} else {
		return $rv;
	}
}

=head2 term

Set up a terminal object for use by PhotoDB

=head4 Usage

    my $term = &term;

=head4 Arguments

None

=head4 Returns

Terminal object

=cut

sub term {
	my $term = Term::ReadLine->new('PhotoDB');
	$term->ornaments(0);
	$term->MinLine(7);
	return $term;
}


=head2 validate

Validate that a value is a certain data type

=head4 Usage

    my $result = &validate({val => 'hello', type => 'text'});

=head4 Arguments

=item * C<$val> The value to be validated

=item * C<$type> Data type to validate as, out of C<text>, C<integer>, C<boolean>, C<date>, C<decimal>, C<time>. Defaults to C<text>.

=head4 Returns

Returns C<1> if the value passes validation as the requested type, and C<0> if it doesn't.

=cut

sub validate {
	# Pass in a hashref of arguments
	my $href = shift;
	# Unpack the hashref and set default values
	my $val = $href->{val};			# The value to be validated
	my $type = $href->{type} || 'text';	# Data type to validate as, out of text, integer, boolean, date, decimal, time

	die "Must provide value for \$val\n" if !defined($val);

	# Empty string always passes validation
	if ($val eq '') {
		return 1;
	}
	elsif ($type eq 'boolean') {
		if ($val =~ m/^(y(es)?|no?|false|true|1|0)$/i) {
			return 1;
		} else {
			return 0;
		}
	} elsif ($type eq 'integer') {
		if ($val =~ m/^-?\d+$/) {
			return 1;
		} else {
			return 0;
		}
	} elsif ($type eq 'text') {
		if ($val =~ m/^.+$/) {
			return 1;
		} else {
			return 0;
		}
	} elsif ($type eq 'date') {
		if ($val =~ m/^\d{4}-\d{2}-\d{2}$/) {
			return 1;
		} else {
			return 0;
		}
	} elsif ($type eq 'decimal') {
		if ($val =~ m/^\d+(\.\d+)?$/) {
			return 1;
		} else {
			return 0;
		}
	} elsif ($type eq 'time') {
		if ($val =~ m/^\d\d?:\d\d?:\d\d?$/) {
			return 1;
		} else {
			return 0;
		}
	} else {
		die "$type is not a valid data type\n";
	}
}

=head2 ini

Find PhotoDB config ini file

=head4 Usage

    my $ini = &ini;

=head4 Arguments

None