view release on metacpan or  search on metacpan

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

sub mount_adapt {
	my $href = shift;
	my $db = $href->{db};
	my %data;
	$data{lens_mount} = $href->{lens_mount} // &listchoices({db=>$db, keyword=>'lens-facing mount', cols=>['mount_id as id', 'mount as opt'], table=>'choose_mount', where=>{'purpose'=>'Camera'}, inserthandler=>\&mount_add});
	$data{camera_mount} = $href->{camera_mount} // &listchoices({db=>$db, keyword=>'camera-facing mount', cols=>['mount_id as id', 'mount as opt'], table=>'choose_mount', where=>{'purpose'=>'Camera'}, inserthandler=>\&mount_add});
	$data{has_optics} = $href->{has_optics} // &prompt({prompt=>'Does this mount adapter have corrective optics?', type=>'boolean'});
	$data{infinity_focus} = $href->{infinity_focus} // &prompt({prompt=>'Does this mount adapter have infinity focus?', type=>'boolean'});
	$data{notes} = $href->{notes} // &prompt({prompt=>'Notes'});
	return &newrecord({db=>$db, data=>\%data, table=>'MOUNT_ADAPTER'});
}

# Add a new light meter to the database
sub lightmeter_add {
	my $href = shift;
	my $db = $href->{db};
	my %data;
	$data{manufacturer_id} = $href->{manufacturer_id} // &choose_manufacturer({db=>$db});
	$data{model} = $href->{model} // &prompt({prompt=>'What is the model of this light meter?'});
	$data{metering_type} = $href->{metering_type} // &listchoices({db=>$db, cols=>['metering_type_id as id', 'metering as opt'], table=>'METERING_TYPE', inserthandler=>\&meteringtype_add});
	$data{reflected} = $href->{reflected} // &prompt({prompt=>'Can this meter take reflected light readings?', type=>'boolean'});
	$data{incident} = $href->{incident} // &prompt({prompt=>'Can this meter take incident light readings?', type=>'boolean'});
	$data{spot} = $href->{spot} // &prompt({prompt=>'Can this meter take spot readings?', type=>'boolean'});
	$data{flash} = $href->{flash} // &prompt({prompt=>'Can this meter take flash readings?', type=>'boolean'});
	$data{min_asa} = $href->{min_asa} // &prompt({prompt=>'What\'s the lowest ISO/ASA setting this meter supports?', type=>'integer'});
	$data{max_asa} = $href->{max_asa} // &prompt({prompt=>'What\'s the highest ISO/ASA setting this meter supports?', type=>'integer'});
	$data{min_lv} = $href->{min_lv} // &prompt({prompt=>'What\'s the lowest light value (LV) reading this meter can give?', type=>'integer'});
	$data{max_lv} = $href->{max_lv} // &prompt({prompt=>'What\'s the highest light value (LV) reading this meter can give?', type=>'integer'});
	return &newrecord({db=>$db, data=>\%data, table=>'LIGHT_METER'});
}

# Add a new camera body type
sub camera_addbodytype {
	my $href = shift;
	my $db = $href->{db};
	my %data;
	$data{body_type} = $href->{body_type} // &prompt({prompt=>'Enter new camera body type'});
	return &newrecord({db=>$db, data=>\%data, table=>'BODY_TYPE'});
}

# Add a new series of camera/lens models
sub series_add {
	my $href = shift;
	my $db = $href->{db};
	my %data;
	$data{name} = $href->{name} // &prompt({prompt=>'What is the name of this series?'});
	return &newrecord({db=>$db, data=>\%data, table=>'SERIES'});
}

# Print info about a series
sub series_info {
	my $href = shift;
	my $db = $href->{db};
	my $series_id = $href->{series_id} // &listchoices({db=>$db, cols=>['series_id as id', 'name as opt'], table=>'SERIES', required=>1});
	my $seriesname = &lookupval({db=>$db, col=>'name', table=>'SERIES', where=>{series_id=>$series_id}});
	my $total = &printlist({db=>$db, msg=>"camera and lens models in series '$seriesname'", table=>'info_series', cols=>["Got as id", 'Model as opt'], where=>{'`Series ID`'=>$series_id}});
	my $got = &lookupval({db=>$db, col=>'count(*)', table=>'info_series', where=>{'`Series ID`'=>$series_id, Got=>'✓'}});

	if ($total > 0) {
		my $need = $total - $got;
		my $percentcomplete = round(100 * $got/$total);
		print "Series '$seriesname' is $percentcomplete% complete (got $got, need $need)\n";
	}
	return;
}

# Summarise all series
sub series_list {
	my $href = shift;
	my $db = $href->{db};
	my $rows = &tabulate({db=>$db, view=>'summary_series'});
	return $rows;
}

# List all models we need
sub series_need {
	my $href = shift;
	my $db = $href->{db};
	my $rows = &printlist({db=>$db, msg=>'models needed to complete series', cols=>["'' as id", 'Model as opt'], table=>'info_series', where=>{'Got'=>'✗'}});
	return $rows;
}

# Add a new physical archive for prints or films
sub archive_add {
	my $href = shift;
	my $db = $href->{db};
	my %data;
	$data{archive_type_id} = $href->{archive_type_id} // &listchoices({db=>$db, cols=>['archive_type_id as id', 'archive_type as opt'], table=>'ARCHIVE_TYPE'});
	$data{name} = $href->{name} // &prompt({prompt=>'What is the name of this archive?'});
	$data{max_width} = $href->{max_width} // &prompt({prompt=>'What is the maximum width of media that this archive can accept (if applicable)?'});
	$data{max_height} = $href->{max_height} // &prompt({prompt=>'What is the maximum height of media that this archive can accept (if applicable)?'});
	$data{location} = $href->{location} // &prompt({prompt=>'What is the location of this archive?'});
	$data{storage} = $href->{storage} // &prompt({prompt=>'What is the storage type of this archive? (e.g. box, folder, ringbinder, etc)'});
	$data{sealed} = $href->{sealed} // &prompt({default=>'no', prompt=>'Is this archive sealed (closed to new additions)?', type=>'boolean'});
	return &newrecord({db=>$db, data=>\%data, table=>'ARCHIVE'});
}

# Bulk-add multiple films to an archive
sub archive_films {
	my $href = shift;
	my $db = $href->{db};
	my %data;
	my $minfilm = $href->{minfilm} // &prompt({prompt=>'What is the lowest film ID in the range?', type=>'integer'});
	my $maxfilm = $href->{maxfilm} // &prompt({prompt=>'What is the highest film ID in the range?', type=>'integer'});
	if (($minfilm =~ m/^\d+$/) && ($maxfilm =~ m/^\d+$/)) {
		if ($maxfilm le $minfilm) {
			print "Highest film ID must be higher than lowest film ID\n";
			return;
		}
	} else {
		print "Must provide highest and lowest film IDs\n";
		return;
	}
	$data{archive_id} = $href->{archive_id} // &listchoices({db=>$db, cols=>['archive_id as id', 'name as opt'], table=>'ARCHIVE', where=>'archive_type_id in (1,2) and sealed = 0', inserthandler=>\&archive_add});
	return &updaterecord({db=>$db, data=>\%data, table=>'FILM', where=>"film_id >= $minfilm and film_id <= $maxfilm and archive_id is null"});
}

# Display info about an archive
sub archive_info {
	my $href = shift;
	my $db = $href->{db};
	my $archive_id = $href->{archive_id} // &listchoices({db=>$db, cols=>['archive_id as id', 'name as opt'], table=>'ARCHIVE', required=>1});