#ActivePerl v5.10.1, build 1007 for MSWin32-x86-multi-thread
#===== Copyright 2010, Webpraxis Consulting Ltd. - ALL RIGHTS RESERVED - Email: webpraxis@gmail.com ============================
# prep4PhotographicMosaic(threaded).pl: Threaded photographic mosaic tile generator.
#===============================================================================================================================
#           Usage : perl prep4PhotographicMosaic(threaded).pl XmlFile
#       Arguments : XmlFile = path of the XML file detailing the processing specifications.
#     Input Files : Designated image files, with extensions .bmp, .gif, .jpeg, .jpg, .png or .tif (case insensitive).
#    Output Files : Written to the designated tile subdirectory (it will be created if it does not exist), are
#                    - the GIF tile files, in the form "tile_k.gif" where "k" denotes a positive integer code.
#                    - "_tiles.dat", a TSV file for each tile's filename, associated image collection name and
#                      mean normalized RGB values.
#                    - "_tiles(m).dat", a tentative backup copy of a previous "_tiles.dat" where "m" is the smallest
#                      positive integer that ensured a non-conflicting filename. It will be retained only if it differs
#                      with "_tiles.dat".
#                    - "_scatterPlot.gif", an animated rotating 3D scatter plot of the mean normalized RGB tile values.
#                    - "_scatterPlot(n).gif", a tentative backup copy of a previous "_scatterPlot.gif" where "n" is the
#                      smallest positive integer that ensured a non-conflicting filename. It will be retained only if it
#                      differs with "_scatterPlot.gif".
# Temporary Files : "_scatterPlot.rot", a text file containing the required rotation commands for the gnuplot application.
#                   It will be created in one of the temporary directories reported in the environment. If none are available,
#                   then the current directory will be used. Moreover, the file will be deleted upon normal termination.
#         Remarks : See http://www.webpraxis.ab.ca/photo_mosaic_v2/prep4PhotographicMosaic(threaded).php for details.
#         History : v2.0.0: October 1, 2010 - Original release.
#===============================================================================================================================
# 0) INITIALIZE:
use strict;																					#pragma to restrict unsafe constructs
use warnings;																				#pragma for all optional warnings
use Time::HiRes qw(gettimeofday tv_interval);												#high resolution interval timer, v1.9721
use File::Basename;																			#core module to parse file specifications
use File::Compare;																			#core module to compare files
use File::Copy;																				#core module to copy files
use File::Find;																				#core module to traverse a directory tree
use File::Path qw(make_path);																#core module to create directory trees, v2.08
use Image::Magick;																			#PerlMagick from ImageMagick-6.6.3-4-Q16 Win package
use Term::ANSIScreen qw/:color :cursor :screen/;											#terminal control using ANSI escape sequences, v1.42
use Win32::Console::ANSI qw/ Cursor /;														#emulate ANSI console on Win32 system, v1.04
use Win32::File qw(:DEFAULT GetAttributes SetAttributes);									#read & set attributes of MS files, v0.06
use threads;																				#pragma for interpreter-based threads, v1.79
use threads::shared;																		#pragma for sharing data structures between threads, v1.33
use Thread::Queue;																			#core module for thread-safe queues, v2.11
use XML::Simple;																			#module to maintain XML files, v2.18
	$XML::Simple::PREFERRED_PARSER = 'XML::Parser';											#set module to parse XML documents, v2.36-r1
use constant FATAL => colored ['white on red'],"\n\n\aFATAL ERROR:",colored ['reset'], ' ';	#intro msg when reporting a fatal error

my $StartTime 		= [gettimeofday];														#record start of execution time

$| = 1; 																					#set STDOUT buffer to auto-flush
cls();																						#clear screen
print colored ['black on white'], "$0\n\n\n";												#display program name

( my $XmlFile		= shift ) =~ tr#\\#/#;													#get path of XML file (Unix style)
die FATAL, "Cannot locate the XML file '$XmlFile' -" unless -e $XmlFile;					#check its existence

my $Specs			= XMLin($XmlFile, forcearray => [qw(images)], SuppressEmpty => undef);	#read the XML data file for the specifications

my $N  				= $$Specs{noThreads} || $ENV{NUMBER_OF_PROCESSORS};						#parameterize number of tile-creator threads
die FATAL, 'Invalid number of tile-creator threads -' unless $N > 0;						#check that there's at least one thread

my @ImageSets;																				#parameterize the image sets
push @ImageSets, map{ \%$_ } @{ $$Specs{images} };											#deep copy the info
die FATAL, 'No image set(s) defined -' unless @ImageSets;									#check that there's at least one set

my $TileWidth		= $$Specs{tiles}{width};												#parameterize the tile width
my $TileHeight		= $$Specs{tiles}{height};												#parameterize the tile height
my $Geometry		= "${TileWidth}x${TileHeight}";											#geometry of a tile: width, height
die FATAL, 'Invalid tile width specified -' unless $TileWidth > 0;							#check for positive value
die FATAL, 'Invalid tile height specified -' unless $TileHeight > 0;						#check for positive value

( my $TmpDir		= $ENV{TMP} || $ENV{TEMP} || '.' )	=~ tr#\\#/#;						#define the temporary directory (Unix style)
( my $TileDir		= $$Specs{tiles}{dir} )				=~ tr#\\#/#;						#parameterize the tile directory (Unix style)
my $TileData		= "$TileDir/_tiles.dat";												#set the filepath for the tile data
die FATAL, "Cannot create tile directory '$TileDir': $! -"									#check existence of target tile directory:
 unless ( -d $TileDir ) or make_path( $TileDir, { verbose => 0, mode => 0600 } );			# or create it if need be

my $Gnuplot			= $$Specs{plot}{gnuplot} 		|| 'gnuplot.exe';						#parameterize path of gnuplot executable
my $PlotDelay		= $$Specs{plot}{delay}   		|| 100;									#parameterize the animation frame delay
my $PlotHeight		= $$Specs{plot}{height}			|| 500;									#parameterize the plot height
my $PlotWidth		= $$Specs{plot}{width}			|| 500;									#parameterize the plot width
my $PlotTwirl		= $$Specs{plot}{twirlIncrement}	|| 10;									#parameterize the plot rotation increment
my $PlotFile		= "$TileDir/_scatterPlot.gif";											#define the scatter plot file
my $PlotRotation	= "$TmpDir/_scatterPlot.rot";											#define the plot rotation command file
die FATAL, 'Invalid animation frame delay specified -' unless $PlotDelay >= 0;				#check for non-negative value
die FATAL, 'Invalid plot height specified -' unless $PlotHeight > 0;						#check for positive value
die FATAL, 'Invalid plot width specified -' unless $PlotWidth > 0;							#check for positive value
die FATAL, 'Invalid plot rotation increment specified -' unless $PlotTwirl > 0;				#check for positive value

my @Threads;																				#thread description:
push @Threads, "#0 = main";																	# main program
push @Threads, "#$_ = tile creator" for ( 1..$N );											# tile-creator threads
push @Threads, "#" . ( $N + 1 ) . " = tile-data updater";									# tile-data updater thread

print																						#echo initialization results
		colored ['reset'], 'XML input file   : ', colored ['bold white'], $XmlFile, "\n\n",
		colored ['reset'], 'No of Image Sets : ', colored ['bold white'], scalar @ImageSets, "\n\n",
		colored ['reset'], 'Tile Width       : ', colored ['bold white'], $TileWidth, " px\n",
		colored ['reset'], 'Tile Height      : ', colored ['bold white'], $TileHeight, " px\n",
		colored ['reset'], 'Tile Directory   : ', colored ['bold white'], $TileDir, "\n",
		colored ['reset'], 'Tile Data        : ', colored ['bold white'], $TileData, "\n\n",
		colored ['reset'], 'Scatter Plot     : ', colored ['bold white'], $PlotFile, "\n",
		colored ['reset'], ' - Width         : ', colored ['bold white'], $PlotWidth, " px\n",
		colored ['reset'], ' - Height        : ', colored ['bold white'], $PlotHeight, " px\n",
		colored ['reset'], ' - Frame Delay   : ', colored ['bold white'], $PlotDelay, " hundreds of a second\n",
		colored ['reset'], ' - Rotation Inc. : ', colored ['bold white'], $PlotTwirl, " degree(s)\n\n",
		colored ['reset'], 'Threads          : ', colored ['bold white'], join( ",\n" . ' ' x 19, @Threads ), "\n\n",
		colored ['reset'], '-' x 80, "\n\n";

my $CursorY			= ( Cursor() )[1];  													#record cursor row position
#-------------------------------------------------------------------------------------------------------------------------------
# 1) CREATE THE TILES FOR EACH SPECIFIED IMAGE SET:
my $Collection;																				#image collection name
my $NoImages				= 0;															#number of images processed
my $NoBytes					= 0;															#number of bytes processed
my $NoThreadsDone:shared	= 0;															#number of tile-creator threads that have ended
my $TileCode:shared			= &initTileCode();												#init tile code value
my $ImageQueue				= Thread::Queue->new();											#queue for the image data
my $TileQueue				= Thread::Queue->new();											#queue for the tile data
my %FindOptions				= ( wanted		=> \&enqueueImage,								#reference to callback function for enqueueing image data
								no_chdir	=> 1											#suppress directory changes on recurse
							  );

threads->create( \&makeTiles )->detach() for ( 1..$N );										#launch thread(s) for creating tiles
threads->create( \&updateTileData );														#launch thread for updating the tile data

&report( 0, 'bold green', 'Populating image queue...' );									#report processing step
for( @ImageSets ) {																			#repeat for each image set
	$Collection = $$_{collection};															# parameterize the image collection name
	die FATAL, "Invalid collection name '$Collection': $! -" unless $Collection;			# check existence of collection name
	die FATAL, "No such directory '$$_{topDir}': $! -" unless -d $$_{topDir};				# check existence of source image directory
	find( \%FindOptions, $$_{topDir} );														# populate image queue
}																							#until all image sets processed
$ImageQueue->enqueue( map{ undef } 1..3*$N );												#signal creator threads that no more images forthcoming
&report( 0, 'bold yellow', 'Waiting...' );													#report wait state
$_->join() for threads->list(threads::running);												#wait for data-updater thread to end
my $Elapsed = tv_interval( $StartTime );													#determine total elapsed time for tile creation
#-------------------------------------------------------------------------------------------------------------------------------
# 2) CREATE ANIMATED 3D SCATTER PLOT OF TILE RGB VALUES:
&report( 0, 'bold green', 'Creating 3D scatter-plot animation...' );
&animScatterPlot();
&report( 0, 'bold red', 'Done' );															#report termination
#-------------------------------------------------------------------------------------------------------------------------------
# 3) REPORT PROCESSING STATISTICS:
print locate( $CursorY + $N + 3, 1 ),
	  colored ['bold white'], "\a", $NoImages,
	  colored ['reset'], ' images / ',
	  colored ['bold white'], &niceSize( $NoBytes, 2 ),
	  colored ['reset'], ' processed in ',
	  colored ['bold white'], $Elapsed,
	  colored ['reset'], " secs\nThroughput: ",
	  colored ['bold white'], &niceSize( $NoBytes/$Elapsed, 2 ), "/sec\n";
exit;																						#end processing
#===== SUBROUTINES =============================================================================================================
#            Usage : &enqueueImage()
#          Purpose : Processes the result of File::Find. For each file recognized as an image type and not set as "read-only",
#                    it enqueues the corresponding path, attributes and image collection name for the tile-creator thread(s)
#                    to process.
#        Arguments : $_ = file path
#          Returns : None.
#  Externals -  In : $Collection, $NoBytes, $NoImages
#  Externals - Out : $NoBytes, $NoImages
#     Shared -  In : None.
#     Shared - Out : None.
#           Queues : $ImageQueue
#             Subs : None.
#          Remarks : None.
#          History : v2.0.0 - October 1, 2010 - Original release.

sub enqueueImage {																			#begin sub
	my $attrbs;																				# file attributes

	return unless /\.(bmp|gif|jpeg|jpg|png|tif)$/i;											# return unless dealing with a recognized image file
	GetAttributes( $_, $attrbs );															# get the file attributes
	return if $attrbs & READONLY;															# return if "read-only" attribute set
	++$NoImages;																			# increment image counter
	$NoBytes += -s $_;																		# increment byte count
	$ImageQueue->enqueue( $_, $attrbs, $Collection );										# enqueue file path, attributes & collection name
}																							#end sub enqueueImage
#-------------------------------------------------------------------------------------------------------------------------------
#            Usage : &fileBackup( Source )
#          Purpose : Copies the designated source file to a target file with a similar file specification. The target's basename
#                    will differ by having a positive integer, enclosed in parentheses, appended. The chosen integer will be the
#                    smallest possible value that ensures a non-conflicting filename.
#        Arguments : Source = Source file specification.
#          Returns : String containing the target file specification or the undefined value.
#  Externals -  In : FATAL.
#  Externals - Out : None.
#     Shared -  In : None.
#     Shared - Out : None.
#           Queues : None.
#             Subs : None.
#          Remarks : The undefined value is returned if the source file does not exist.
#          History : v1.0.0 - October 1, 2010 - Original release.

sub fileBackup {																			#begin sub
	my $source		= shift;																# parameterize the source file specification
	my $target		= $source;																# init backup file specification
	my $modifier	= 0;																	# init basename modifier

	return undef unless -e $source;															# return undefined value if source does not exist

	fileparse_set_fstype('');																# force Unix-style interpretation
	my ( $basename, $path, $suffix ) = fileparse( $source, '\..*' );						# split the source file spec into components
	$target = "$path${basename}(" . ++$modifier . ')' . $suffix while -e $target;			# compose unique filename

	copy( $source, $target )																# copy source file to target
	 or die FATAL, "Cannot backup the file '$source' to '$target': $! -";
	return $target;																			# return the target file specification
}																							#end sub fileBackup
#-------------------------------------------------------------------------------------------------------------------------------
#            Usage : &initTileCode()
#          Purpose : Returns a starting value for the tile code.
#        Arguments : None.
#          Returns : Integer scalar.
#  Externals -  In : FATAL, $TileDir
#  Externals - Out : None.
#     Shared -  In : None.
#     Shared - Out : None.
#           Queues : None.
#             Subs : None.
#          Remarks : Scans the tile directory to find the greatest of the code values used in the tile basenames.
#          History : v1.0.0 - October 1, 2010 - Original release.

sub initTileCode {																			#begin sub
	my $code = 0;																			# greatest code value

	local *TILES;																			# handle for the tile directory

	opendir( TILES, $TileDir )																# open the tile directory for read
	 or die FATAL, "Cannot open the tile directory '$TileDir' for read: $! -";
	while( $_ = readdir( TILES ) ) {														# repeat for every entry
		next unless /^tile_(.+)\.gif$/;														#  skip entry if not a tile
		$code = $1 if $1 > $code;															#  update greatest code value
	}																						# until all directory entries processed
	closedir( TILES );																		# close the tile directory
	return ++$code;																			# return starting value
}																							#end sub initTileCode
#-------------------------------------------------------------------------------------------------------------------------------
#            Usage : &niceSize( ByteCount {,Precision} )
#          Purpose : Formats a byte count as a "human-readable" string.
#        Arguments : ByteCount = number of bytes
#                    Precision = optional number of decimal places
#          Returns : "Human-readable" bytecount string.
#  Externals -  In : None.
#  Externals - Out : None.
#     Shared -  In : None.
#     Shared - Out : None.
#           Queues : None.
#             Subs : None.
#          Remarks : Original code sourced from http://www.jb.man.ac.uk/~slowe/perl/filesize.html.
#                    Corrected and modified for IEC binary prefixes.
#          History : v1.0.0 - October 1, 2010 - Original release.

sub niceSize {																				#begin sub
	my $size	= shift;																	# parameterize the byte count
	my $ndp		= shift() || 0;																# parameterize the number of decimal places
	my @units	= ( 'bytes', 'KiB', 'MiB', 'GiB', 'TiB', 'PiB', 'EiB', 'ZiB', 'YiB' );		# define the binary units
	my $unitIdx	= 0;																		# init the units array index
	my $dp		= 10**$ndp;																	# init the precision factor

	while( $size > 1024 ) {																	# repeat while byte count exceeds 2**10
		$size /= 1024;																		#  divide byte count by 2**10 to get next unit
		$unitIdx++;																			#  set corresponding unit term
	}																						# until byte count appropriately factored
	return ( $units[$unitIdx] ) ? ( int( $size*$dp ) / $dp )  . " " . $units[$unitIdx]		# return human-readable string
								: $_[0];													# or original byte count if it exceeds 1024 YiB!
}																							#end sub niceSize
#-------------------------------------------------------------------------------------------------------------------------------
#            Usage : &report( ThreadId, Colors, Msg );
#          Purpose : Reports a thread's processing status.
#        Arguments : ThreadId = thread integer id
#                    Colors   = color attribute of message
#                    Msg      = message to be displayed
#          Returns : None.
#  Externals -  In : $CursorY
#  Externals - Out : None.
#     Shared -  In : None.
#     Shared - Out : None.
#           Queues : None.
#             Subs : None.
#          Remarks : None.
#          History : v2.0.0 - October 1, 2010 - Original release.

sub report {																				#begin sub
	my( $threadId, $colors, $msg ) = @_;													# parameterize the arguments

	print locate( $CursorY + $threadId, 1 ), clline,										# clear line coresponding to thread
		  colored [ 'reset' ], "Thread #$threadId: ",										# display heading
		  colored [ $colors ], $msg;														# display message
}																							#end sub report
#-------------------------------------------------------------------------------------------------------------------------------
#            Usage : &animScatterPlot();
#          Purpose : Creates an animated GIF of a rotating 3D scatter plot of the mean normalized RGB tile values.
#        Arguments : None.
#          Returns : None.
#  Externals -  In : FATAL, $Gnuplot, $PlotDelay, $PlotFile, $PlotHeight, $PlotRotation, $PlotTwirl, $PlotWidth, $TileData
#  Externals - Out : None.
#     Shared -  In : None.
#     Shared - Out : None.
#           Queues : None.
#             Subs : fileBackup
#          Remarks : Based on the Gnuplot demonstration code "animate.dem" and "gnuplot.rot".
#          History : v1.0.0 - October 1, 2010 - Original release.

sub animScatterPlot {																		#begin sub
	my $backup		= &fileBackup( $PlotFile );												# tentatively backup any previous scatter plot
	my $noFrames	= int( 360 / $PlotTwirl );												# number of animation frames to generate

	local *GNUPLOT;																			# output filehandle

	open( GNUPLOT, ">$PlotRotation" )														# open the gnuplot rotation command file for write
	 or die FATAL, "Cannot create the command rotation file '$PlotRotation': $! -";
	print GNUPLOT <<ROTATION;																# write rotation commands:
frame_count	= frame_count + 1
frame_title = sprintf( "Scatter Plot of Mean Normalized RGB Tile Values\\n( Rotation Angle = %i%c )", zview( zrot ), 176 )
set title frame_title offset 0,2,0 font "Arial,14"
set view xrot,zview( zrot )
replot
zrot = ( zrot + $PlotTwirl ) % 360
if( frame_count < $noFrames ) reread
ROTATION

	open( GNUPLOT, "|$Gnuplot" )															# open pipe to the gnuplot executable
	 or die FATAL, "Cannot open the gnuplot program '$Gnuplot': $! -";
	print GNUPLOT <<COMMANDS;																# send plotting commands:
unset key
set hidden3d
set origin 0,-0.05
set border 4095 back lt 0 lc rgb "gray40"
set grid x y z back
set xyplane at 0
set xrange [0:1] noreverse nowriteback
set yrange [0:1] noreverse nowriteback
set zrange [0:1] noreverse nowriteback
set lmargin 8
set xlabel "Red" font "Arial,14" tc rgb "red"
set ylabel "Green" font "Arial,14" tc rgb "green"
set zlabel "Blue" offset -3,0,0 font "Arial,14" tc rgb "blue"

xrot = 60
zrot = 50
zview( zrot ) = ( zrot%90 > 0 ) ? zrot : zrot + 2

set terminal unknown
set datafile separator "\t"
set arrow from 0,0,0 to 1,1,1 nohead lt -1 lw 2 lc rgb "dark-gray"
splot "$TileData" using 3:4:5 with points lc rgb "steelblue"

set terminal gif font "Arial" 8 size $PlotWidth,$PlotHeight animate delay $PlotDelay loop 0 nooptimize
set output "$PlotFile"
frame_count = 0
load "$PlotRotation"
unset output
reset
COMMANDS
	close( GNUPLOT );																		# end command stream
	unlink $PlotRotation;																	# delete the temporary file
	if( defined( $backup ) ) {																# delete backup if no change
		unlink $backup unless compare( $PlotFile, $backup );
	}
}																							#end sub animScatterPlot
#===== THREADED SUBROUTINES ====================================================================================================
#            Usage : &makeTiles()
#          Purpose : Retrieves file data from the image queue, creates the corresponding tile, computes its mean RGB values
#                    and adds the tile data to the tile queue. Also sets the "read-only" attribute of the image file to
#                    mark it as having been processed.
#        Arguments : None.
#          Returns : None.
#  Externals -  In : FATAL, $Geometry, $N, $TileDir
#  Externals - Out : None.
#     Shared -  In : $NoThreadsDone, $TileCode
#     Shared - Out : $NoThreadsDone, $TileCode
#           Queues : $ImageQueue, $TileQueue
#             Subs : report
#          Remarks : Dequeues $ImageQueue for the image filepath, attributes & corresponding image collection name.
#                    Enqueues $TileQueue with the tile's particulars as a TSV string.
#          History : v2.0.0 - October 1, 2010 - Original release.

sub makeTiles {																				#begin sub
	my $threadId	= threads->tid();														# get thread id
	my $tile		= Image::Magick->new( magick => 'GIF' );								# instantiate an image object for a tile
	my $errorMsg;																			# error message returned by PerlMagick
	my $tileFile;																			# tile filename
	#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
	sub meanColor {																			# begin sub to compute a mean normalized channel color
		my @colors = $tile->GetPixels														#  get channel intensities of all pixels:
								(	map			=> shift,									#   get color channel designation,
									geometry	=> $Geometry,								#   specify tile geometry,
									normalize	=> 'true'									#   request normalized values
								);
		my $mean;																			#  average value
		$mean += $_ for @colors;															#  sum all intensities
		$mean /= scalar @colors;															#  return the average value
	}																						# end sub meanColor
	#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
	while( my ( $imageFile, $attribs, $collection ) = $ImageQueue->dequeue( 3 ) ) {			# repeat; get image file path, attributes & collection name
		last unless defined $imageFile;														#  end repeat if end of queue encountered
		{	lock $TileCode;																	#  get lock on tile code
			$tileFile = 'tile_' . $TileCode++ . '.gif';										#  compose tile filename & increment tile code
		}																					#  release lock on tile code
		&report( $threadId, 'bold green', "Processing $imageFile -> $tileFile" );			#  report processing status

		@$tile = ();																		#  clear tile object
		$tile->Read( $imageFile );															#  init tile with source image file
		$tile->Quantize( colorspace => 'RGB' );												#  insure RGB colorspace
		$tile->Scale( geometry => "$Geometry!" );											#  scale tile image
		die FATAL, "Cannot create tile for '$imageFile': $errorMsg\n -"						#  abort if unable to save the tile to disk
		 if $errorMsg = $tile->Write( filename => "$TileDir/$tileFile" );
		SetAttributes( $imageFile, $attribs | READONLY );									#  mark image as processed

		$TileQueue->enqueue( join "\t", 													#  enqueue tile data as a TSV string:
								$tileFile,													#   tile filename
								$collection,												#   image collection name,
								&meanColor( 'r' ),											#   mean normalized red color,
								&meanColor( 'g' ),											#   mean normalized green color
								&meanColor( 'b' )											#   mean normalized blue color
						  );
		&report( $threadId, 'bold yellow', 'Waiting...' );									#  report  waiting status
	}																						# until all image data dequeued
	{	lock $NoThreadsDone;																# get lock on threads-done counter
		$TileQueue->enqueue( undef )														# signal updater thread that no more data forthcoming
		 if ++$NoThreadsDone == $N;															#  if this is the last tile-creator thread to end
	}																						# release lock on counter
	&report( $threadId, 'bold red', 'Done' );												# report end of processing
}																							#end sub makeTiles
#-------------------------------------------------------------------------------------------------------------------------------
#            Usage : &updateTileData()
#          Purpose : Retrieves a new tile's data from the tile queue and writes it to the TSV data file.
#        Arguments : None.
#          Returns : None.
#  Externals -  In : FATAL, $TileData
#  Externals - Out : None.
#     Shared -  In : None.
#     Shared - Out : None.
#           Queues : $TileQueue
#             Subs : fileBackup, report
#          Remarks : Each tile record is a TSV string structured as follows:
#                    column 1: tile filename,
#                    column 2: image collection name,
#                    column 3: mean normalized red color,
#                    column 4: mean normalized green color and
#                    column 5: mean normalized blue color.
#          History : v2.0.0 - October 1, 2010 - Original release.

sub updateTileData {																		#begin sub
	my $threadId	= threads->tid();														# get thread id
	my $backup		= &fileBackup( $TileData );												# tentatively backup any previous tile data

	local *DATA;																			# output filehandle

	open( DATA, ">>$TileData" )																# open the tile data file for append
	 or die FATAL, "Cannot open the tile data file '$TileData' for append: $! -";
	while( my $data = $TileQueue->dequeue() ) {												# repeat: get tile data from queue
		my $file = (split /\t/, $data, 2)[0];												#  extract tile filename
		&report( $threadId, 'bold green', "Processing $file" );								#  report processing status
		print DATA $data, "\n";																#  output TSV record
		&report( $threadId, 'bold yellow', "$file created. Waiting..." );					#  report waiting status
	}																						# until end of queue encountered
	close( DATA );																			# close the tile data file

	if( defined( $backup ) ) {																# delete backup if no change
		unlink $backup unless compare( $TileData, $backup );
	}
	&report( $threadId, 'bold red', 'Done' );												# report end of processing
}																							#end sub updateTileData
#===== Copyright 2010, Webpraxis Consulting Ltd. - ALL RIGHTS RESERVED - Email: webpraxis@gmail.com ============================
# end of prep4PhotographicMosaic(threaded).pl
