package t::lib::Boot;

use strict;
use Carp;
use vars qw(@ISA $VERSION);

$VERSION = 0.11;

# revised 2015-03-21
#
# Copyright © 2004-2020 by William B. Birkett
#
# reads an ICC profile's profile header and tag table

# create bootstrap profile object
# parameters: (path_to_profile)
# returns: (ref_to_profile_object)
sub new {

	# get object class
	my $class = shift();

	# create empty profile object
	my $self = [
		{},  # object header
		[],  # profile header
		[]   # tag table
	];

	# if one parameter, a file path
	if (@_ == 1 && ! ref($_[0]) && -f $_[0]) {
		
		# read data from ICC profile
		_readICCprofile($self, @_) || croak("couldn't read profile: $_[0]\n");
		
	}

	# bless object
	bless($self, $class);

	# return object reference
	return($self);

}

# get reference to profile header
# returns: (ref_to_profile_header_array)
sub profile_header {

	# get tag reference
	my $self = shift();

	# return reference to header
	return($self->[1]);

}

# get reference to profile tag table
# returns: (ref_to_profile_tag_table_array)
sub tag_table {

	# get tag reference
	my $self = shift();

	# return reference to header
	return($self->[2]);

}

# get file handle
# returns: (file_handle)
sub fh {

	# get tag reference
	my $self = shift();

	# return file handle
	return($self->[3]);

}

# read data from ICC profile
# parameters: (ref_to_object, path_to_profile)
# returns: (success_flag)
sub _readICCprofile {

	# get parameters
	my ($self, $path) = @_;

	# local variables
	my ($fh, $buf);

	# open the profile file
	open($fh, $path) || return(0);

	# set binary mode
	binmode($fh);

	# save file handle
	$self->[3] = $fh;

	# seek to profile file signature
	seek($fh, 36, 0);

	# read profile file signature
	read($fh, $buf, 4);

	# return if not an ICC profile
	($buf eq 'acsp') || return(0);

	# read the header
	_readICCheader($fh, $self->[1]) || return(0);

	# read the tag table
	_readICCtagtable($fh, $self->[2]) || return(0);

	# return
	return(1);

}

# read ICC header
# parameters: (file_handle, ref_to_header_array)
# returns: (success_flag)
sub _readICCheader {

	# get parameters
	my ($fh, $header) = @_;

	# local variables
	my ($buf, $check);

	# seek to start of header
	seek($fh, 0, 0);

	# read the header (128 bytes)
	(read($fh, $buf, 128) == 128) || return(0);

	# unpack the header
	@{$header} = unpack('N a4 H8 a4 a4 a4 n6 a4 a4 N a4 a4 N2 N N3 a4 H32 x28', $buf);

	# return success if profile file signature verified
	return($header->[12] eq 'acsp' ? 1 : 0);

}

# read ICC tag table
# parameters: (file_handle, ref_to_tag_table_array)
# returns: (success_flag)
sub _readICCtagtable {

	# get parameters
	my ($fh, $tagtab) = @_;

	# local variables
	my ($buf, $i, $n);

	# seek to start of tag table
	seek($fh, 128, 0);

	# read tag count (4 bytes)
	(read($fh, $buf, 4) == 4) || return(0);

	# unpack tag count
	$n = unpack('N', $buf);

	# read tag entries
	for $i (0 .. $n - 1) {
		
		# read tag entry (12 bytes)
		(read($fh, $buf, 12) == 12) || return(0) ;
		
		# unpack tag entry
		@{$tagtab->[$i]} = unpack('a4 N N', $buf);
		
	}

	# return
	return(1);

}

1;