~beaky/wacs/trunk

#!/usr/bin/perl
#
# wacsupdinfo - Update info files
#    (formerly known as updateinfo)
#
#    (C) Copyright 2006,2007,2008,2009,2010,2011,2012,2013,2015,2017,2019,
#        2021 B King
#    This file is part of WACS.
#
#    WACS is free software; you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation; either version 3 of the License, or
#    (at your option) any later version.
#
#    WACS is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    You should have received a copy of the GNU General Public License
#    along with WACS.  If not, see <http://www.gnu.org/licenses/>.
#
use Wacs;
use Wacs::WacsId;
use Wacs::WacsDnl;
use Wacs::WacsStd;
use File::Basename;
use DBI;
use Data::Dumper;

# initialise Wacs
read_conf;
# no need to check_auth on a console application


#
# Global Variables
$treetop=conf_get_attr("fsloc","images");
$startpoint=$treetop;
$title="Unnamed";   # Title
$debug=conf_get_attr("debug","tool_wacsupdinfo");

$name="";
$hair="";
$modelno="";
$setno="";
$setname="";
$srank="";
$attire="";
$curinfo="";
$source="unknown";
$foundry="unknown";
$idlogo="";
$notes="";
$sauto="";
$imagesread=0;
$indexread=0;
$catinfo="";
$catflag="";
$location="";
$locdetail="";
$officon="";
$imagecount=0;
$indexcount=0;
$newone=0;
$sizerecalc=0;
$imgarea="";
$imgcategory="";
$imgdirectory="";
$namestem="";
$download="";
$reldate="";
$proddate="";
$branding="";
$today="";
$land_x=0;
$land_y=0;
$port_x=0;
$port_y=0;
$photog="";
$descfile="";
$updates=0;
$inserts=0;
$relocs=0;
$nodownload=0;
$forceupdate=0;
$updcmd='';
$updflag=0;
%unpackinfo=();
#
# MAIN
# ----
#
init_stuff( "wacsupdinfo" );
if( $ARGV[0] ne "" )
{
	if( $ARGV[0] eq "--force" )
	{
		if( $ARGV[1] eq "" )
		{
			print "Usage: wacsupdinfo [--force] wacs_sarea\n";
			exit -1;
		}
		$forceupdate=1;
		shift @ARGV;
	}
	$title = $ARGV[0];
	$startpoint = $treetop."/".$ARGV[0];
	if( $debug )
	{
		print "Starting wacsupdinfo from: $startpoint\n";
	}
}
doscandir( $startpoint );
print "COMPLETED: $inserts new records inserted, $updates updated.\n";
if( $relocs > 0 )
{
	print "        $relocs of the updates were relocations.\n";
}
if( $nodownload > 0 )
{
	print "        $nodownload of the updates had no download record.\n";
}
exit 0;

sub init_stuff( $ )
{
	my( $myname )=@_;

	# database initialisation
	$dbienv = conf_get_attr( "database","dbienvvar" );
	if( $dbienv ne "" )
	{
		$ENV{$dbienv}= conf_get_attr( "database","dbienvvalue" );
	}
	$dbhandle=DBI->connect( conf_get_attr("database","dbiconnect"),
			conf_get_attr("database","dbuser"),
			conf_get_attr("database","dbpass") ) ||
	die("Can't connect to database\nReason given was $DBI::errstr\n");
        # tune DBI parameters - insist on lower case fieldnames
	$dbhandle->{FetchHashKeyName} = "NAME_lc";

	$today = gettoday;
}

sub doscandir( $ )
{
	my( $currentdir )=@_;
	my( $dirh, $file, $retval, $dnldno );

	$curinfo="None";
	$imagecount=0;
	$sizerecalc=0;
	opendir( $dirh, $currentdir );
	while( $file = readdir( $dirh ))
	{
		if( $curinfo ne $currentdir )
		{
			# print "We enter $currentdir\n";
			$imagecount=0;
			$indexcount=0;
			$land_x = 0;
			$land_y = 0;
			$port_x = 0;
			$port_y = 0;
			$dnldno = 0;
			# FIXME: try reading the .info.xml file in the 
			#        directory above first.
			if( -f $currentdir."/.info" )
			{
				# print "Reading info file...\n";
				readinfo( $currentdir."/.info", $currentdir );
				$newone=0;
			}
			else
			{
				# print "New Details - setting defaults\n";
				$newone=1;
			}
			$curinfo=$currentdir;
		}
		$retval = processinfo( filename=>$file,
			     currentdir=>$currentdir,
			     newone=>$newone,
			     sizerecalc=>$sizerecalc );
		if( $retval eq "none" )
		{
			$dnldno = "none";
			if( $debug > 2 )
			{
				print "doscandir: no download but may be ".
					"info in .unpack.\n";
			}
		}
		elsif( $retval > 0 )
		{
			$dnldno = $retval;
			if( $debug > 2 )
			{
				print "doscandir: dnldno = ".$dnldno."\n";
			}
		}
	}
	closedir( $dirh );
	if( $imagecount > 0 && $title ne "")
	{
		# FIXME: Check for both types - need to see if .info.xml
		#        contains this set yet?
		if( ! -f "$currentdir/.info" )
		{
			if( $debug > 2 )
			{
				print "Images found but no info in $currentdir";
				print " - writing new .info\n";
			}
			adddetails_db( setno=>$setno,
                                       currentdir=>$currentdir,
				       downloadno=>$dnldno );
			adddetails_text( legacy=>$currentdir."/.info",
					 xml=>$currentdir."/../.info.xml" );
		}
		else
		{
			if( $debug > 2 )
			{
				print "Existing info file in $currentdir";
				print " - considering updates\n";
			}
			decode_directory( $currentdir );
			do_update( $setno, $currentdir, $forceupdate );
			if( $debug > 2 )
			{
				print "writing $currentdir/.info with catinfo";
				print " of $catinfo\n";
			}
			adddetails_text( legacy=>$currentdir."/.info",
					 xml=>$currentdir."/../.info.xml" );
		}
		
		# clear down now we've written it
		$title="";
		$imagecount=0;
		$indexcount=0;
		$foundry="unknown";
		$source="usenet";
		$location="";
		$attire="";
		$reldate="";
		$proddate="";
		$branding="";
		$photog="";
		$setno=0;
		$newone=0;
		$sizerecalc=0;
	}
}

sub readinfo( $$ )
{
	my( $infofile, $curname )=@_;
	my( $key, $value, $unused );

	# set defaults
	( $key, $value, $unused )= fileparse( $curname );
	$title = $curname;
	$title =~ s/_/ /g;
	$name="";
	$hair="";
	$modelno="";
	$setno="";
	$source = "usenet";
	$foundry = "unknown";
	$location = "";
	$attire = "";
	$notes = "";
	$reldate = "";
	$proddate = "";
	$branding = "";
	$photog = "";
	$idlogo = "no";
	$imagesread = 0;
	$indexread = 0;

	# get what is there
	open( info, "< $infofile" ) || die "No such file as $infofile\n";
	while( <info> )
	{
		chomp;
		( $key, $value ) = split( /=/, $_, 2 );
		if ( $key eq "title" )
		{
			$title = $value;
		}
		if( $key eq "name" )
		{
			$name = $value;
		}
		if( $key eq "hair" )
		{
			$hair = $value;
		}
		if( $key eq "setno" )
		{
			$setno = $value;
		}
		if( $key eq "modelno" )
		{
			$modelno = $value;
		}
		if( $key eq "source" )
		{
			$source = $value;
		}
		if( $key eq "foundry" )
		{
			$foundry = $value;
		}
		if( $key eq "notes" )
		{
			$notes = $value;
		}
		if( $key eq "indexes" )
		{
			$indexread = $value;
		}
		if( $key eq "images" )
		{
			$imagesread = $value;
		}
		if( $key eq "idlogo" )
		{
			$idlogo = $value;
		}
		if( $key eq "catinfo" )
		{
			$catinfo = $value;
		}
		if( $key eq "location" )
		{
			$location = $value;
		}
		if( $key eq "attire" )
		{
			$attire = $value;
		}
		if( $key eq "sreldate" )
		{
			$reldate = $value;
		}
		if( $key eq "sproddate" )
		{
			$proddate = $value;
		}
		if( $key eq "sbranding" )
		{
			$branding = $value;
		}
		if( $key eq "photog" )
		{
			$photog = $value;
		}
	}
	close( INFO );
}

sub processinfo( % )
{
	my( %params )=@_;
	my( $pifile, $picurrentdir, $pinewone, $pisizerecalc );
	my( $pidnldno );

	$pifile = $params{'filename'};
	$picurrentdir = $params{'currentdir'};
	$pinewone = $params{'newone'};
	$pisizerecalc = $params{'sizerecalc'};
	
	if( $debug > 4 )
	{
		print STDERR "processinfo: called with ".$pifile.
			" and ".$picurrentdir."\n";
	}

	# check for being an excluded file
	if( ! checkexclude( $pifile ) )
	{
		# is it a directory?
		if( -d $picurrentdir."/".$pifile )
		{
			# if it's not spares, recursively call doscandir
			if( $file ne "spares" && $file ne ".index" )
			{
				doscandir( "$picurrentdir/$pifile" );
			}
		}
		else
		{
			# it's (most likely) a regular file
			$_ = $pifile;
			# sanity checks first
			$imagecount++;

			# check the sizes for each file, not just the first.
			if( $pisizerecalc == 1 )
			{
				getsizes( $picurrentdir, $pifile );
			}

			# is this a new record?
			if( $pinewone == 1 )
			{
				print "New One: Generating defaults.\n";
				guessinfo( $picurrentdir );
				getsizes( $picurrentdir, $pifile );
				$namestem = find_namestem($picurrentdir);
				if( -f $picurrentdir."/.unpack" )
				{
					print "Reading .unpack file".
						" in ".$picurrentdir."\n";
					# read_unpack calls dnld_img
					$pidnldno = read_unpack(
						$picurrentdir."/.unpack",
							$namestem );
				}
				else
				{
					$pidnldno = dnld_img(
						'dfname'=>$namestem,
						'dbhandle'=>$dbhandle );
				}
				guesscatflag( $pidnldno, $catinfo,
						$picurrentdir);
				if( $photog eq "" )
				{
					# try namestem method if not known
					# from the download record
					$photog = extractphotog( $namestem,
					 conf_get_attr("tables","photographer"),
							$dbhandle );
				}

				# updating globals
				$sizerecalc = 1;
				$newone = 0;
				if( $pidnldno == 0 )
				{
					$nodownload++;
				}
			}
		}
	}
	return( $pidnldno );
}

sub adddetails_text( % )
{
	my( %adtparams )=@_;
	my( $adtoutfile, $adtxmlout, $adtsethash ); 
	my( $adgroup, $adnewone );
	$adtoutfile = $adtparams{'legacy'};
	$adtxmlout = $adtparams{'xml'};

	$adnewone = 0;
	$adtsethash = {};
	# FIXME: needs to look for setno object in XML file
	if( ! -f $adtoutfile )
	{
		$adnewone++;
	}

	# write to the file
	open( OUTFILE, "> $adtoutfile" ) || die "Can't open $adtoutfile\n";
	print OUTFILE "title=$title\n";
	print OUTFILE "name=$name\n";
	print OUTFILE "hair=$hair\n";
	print OUTFILE "setno=$setno\n";
	print OUTFILE "modelno=$modelno\n";
	print OUTFILE "source=$source\n";
	print OUTFILE "foundry=$foundry\n";
	print OUTFILE "location=$location\n";
	print OUTFILE "attire=$attire\n";
	print OUTFILE "notes=$notes\n";
	print OUTFILE "indexes=$indexcount\n";
	print OUTFILE "images=$imagecount\n";
	print OUTFILE "idlogo=$idlogo\n";
	print OUTFILE "catinfo=$catinfo\n";
	print OUTFILE "sreldate=$reldate\n";
	print OUTFILE "sproddate=$proddate\n";
	print OUTFILE "sbranding=$branding\n";
	print OUTFILE "photog=$photog\n";
	close( OUTFILE );

	# start working on new XML version of this file
	# FIXME: should check for existing entry for this set number
	$adtsethash->{name} = "set".$setno;
	$adtsethash->{stitle} = $title;
	$adtsethash->{mname} = $name;
	$adtsethash->{mhair} = $hair;
	$adtsethash->{asetno} = $setno;
	$adtsethash->{amodelno} = $modelno;
	$adtsethash->{ssource} = $source;
	$adtsethash->{sfoundry} = $foundry;
	$adtsethash->{slocation} = $location;
	$adtsethash->{sattire} = $attire;
	$adtsethash->{snotes} = $notes;
	$adtsethash->{sindexes} = $indexcount;
	$adtsethash->{simages} = $imagecount;
	$adtsethash->{sidlogo} = $idlogo;
	$adtsethash->{scatinfo} = $catinfo;
	$adtsethash->{sreldate} = $reldate;
	$adtsethash->{sproddate} = $proddate;
	$adtsethash->{sbranding} = $branding;
	$adtsethash->{photog} = $photog;
	info_addupdate( filename=> $adtxmlout,
		        setno=>$setno,
			setinfo=>$adtsethash );

	# set it's permissions correctly so it isn't inaccessible to the
	# web user (or vice versa) but ONLY IF WE'RE CREATING THIS FILE
	if( $adnewone == 1 )
	{
		$adgroup = conf_get_attr("security","admingroup");
		if( $adgroup ne "" )
		{
			print "adddetails_text: chgrp ".$adgroup." ".
					$adtoutfile."\n";
			# old individual file
			system( "chgrp ".$adgroup." ".$adtoutfile ) ||
			    print STDERR "adddetails_text: chgrp ".$adgroup.
				" failed on ".$adtoutfile."\n";
			system( "chmod ug+rwX ".$adtoutfile );
			# new shared XML file
			system( "chgrp ".$adgroup." ".$adtxmlout ) ||
			    print STDERR "adddetails_text: chgrp ".$adgroup.
				" failed on ".$adtxmlout."\n";
			system( "chmod ug+rwX ".$adtxmlout );
		}
	}
}

sub adddetails_db( % )
{
	my( %params )=@_;
	my( $adrefno, $addirectory, $adisdnl, $adoffdir, $adoffarchive );
	my( $adsrank, $adsprev, $adsduplicates, $adsaltmedia, $adsdownload );
	my( $adsproddate, $adsreldate, $adsbranding, $adphotog, $adsdesc );
	my( $nextsql, $nextcsr, @nextrec );
	my( $vendsql, $vendcsr, @vendrec );
	my( $modsql, $modcsr, @modrec, $modattr, $setinfo, $inssql );
	my( $nextref, $shortid, $addnldno, $setpos, $desctext );
	my( %adnew, $adinssql, $adkey );

	$adrefno = $params{'setno'};
	$addirectory = $params{'currentdir'};
	$adisdnl = $params{'downloadno'};

	decode_directory( $addirectory );
	if( $adrefno > 0 )
	{
		if( $debug > 1 )
		{
			print "WARNING: reached do_update() from adddetails\n";
		}
		# maybe do an update here
		do_update( $adrefno, $addirectory );
		# write back any changes to the .info file
		adddetails_text( legacy=>$addirectory."/.info",
				 xml=>$addirectory."../.info.xml" );
		return;
	}
	
	# sort out the id and set name
	$shortid = "";
	if( lc($idlogo) eq "yes" )
	{
		$shortid="Y";
	}
	if( lc($idlogo) eq "no" )
	{
		$shortid="N";
	}
	if( lc($idlogo) eq "unknown" )
	{
		$shortid="U";
	}
	$setname = id_get_setname;
	$modelno = id_get_modelno;

	# see if we have a set description file 

	# fetch the model attributes
	$modattr = '';
	if( int( $modelno ) > 0 )
	{
		$modsql = "select mattributes from ".
			  conf_get_attr("tables","models")." where ".
			  "modelno = '".int( $modelno )."' ";
		$modcsr = $dbhandle->prepare( $modsql );
		$modcsr->execute;
		if( @modrec = $modcsr->fetchrow_array )
		{
			$modattr = $modrec[0];
		}
	}
	if( $debug > 1 )
	{
		print "retrieved model no in adddetails_db is: ".$modelno.
			" and downloadno=".$adisdnl."\n";
		if( $modattr ne "" )
		{
			print "model attributes for ".$modelno." are: ".
				$modattr."\n";
		}
	}
	$foundry = id_get_vendor;
	$catflag = id_get_flag;
	$setinfo = $catinfo;  # catinfo should be a global var with stuff in it
	if( $modattr ne "" )
	{
		$setinfo = removeconflicts( model=>$modattr,
					    existing=>$catinfo );
		$setinfo .= " ".$modattr." ".$catinfo; # FixMe:  May replace
						       # clashing attribs
		$setinfo = removedups( $setinfo );
	}

	# new additions for Wacs 0.9.x
	$adsrank = id_get_srank;
	$adsprev = id_get_sprev;
	$sduplicates = id_get_sduplicates;
	$adsaltmedia = id_get_saltmedia;
	$adsdownload = id_get_sdownload;

	# new additions for Wacs 1.0.x 
	$adsproddate = id_get_sproddate;
	$adsreldate = id_get_sreldate;
	print "id_get_sreldate = ".$adsreldate."\n";
	$adsbranding = id_get_sbranding;
	$adphotog = id_get_attr('download','photog');

	# get the vendor shortname from the database
	$vendsql = "select vshortname from ".conf_get_attr("tables","vendor");
	$vendsql .= " where vsite = ? ";
	$vendcsr = $dbhandle->prepare( $vendsql );
	$vendcsr->execute( id_get_vendor );
	if( @vendrec = $vendcsr->fetchrow_array )
	{
		if( $vendrec[0] ne "" )
		{
			$foundry = $vendrec[0];
			if( $adisdnl > 0 ) 
			{
				$source = "subscription";
			}
		}
	}

	# catch-all for non-existant download record
	if( $debug > 2 )
	{
		print "adddetails_db: setname is ".$setname.".\n";
		print "adddetails_db: modelno is ".$modelno.".\n";
		print "adddetails_db: setinfo is ".$setinfo.".\n";
		print "adddetails_db: catinfo is ".$catinfo.".\n";
		print "adddetails_db: catflag is ".$catflag.".\n";
		print "adddetails_db: foundry is ".$foundry.".\n";
		print "adddetails_db: reldate is ".$adsreldate.".\n";
		print "adddetails_db: proddate is ".$adsproddate.".\n";
		print "adddetails_db: branding is ".$adsbranding.".\n";
	}

	# check for a pre-existing official icon and work out what
	# it would be called - this now includes converting the
	# possible archive names in to .jpg extensions.
	$adoffdir='';
	$adoffarchive=$adsdownload;
	$adoffarchive=~ s/\.zip$//;
	$adoffarchive=~ s/\.tar$//;
	$adoffarchive=~ s/\.tgz$//;
	$adoffarchive=~ s/\.rar$//;
	if( $imgarea ne "" )
	{
		$adoffdir = $imgarea."/";
	}
	if( $imgcategory ne "" )
	{
		$adoffdir.= $imgcategory."/";
	}
	if( $imgdirectory ne "" )
	{
		# is there an icon file called the name of the directory?
		if( -f conf_get_attr("fsloc","officons")."/".$adoffdir.
			$imgdirectory.".jpg" )
		{
			$officon = $adoffdir.$imgdirectory.".jpg";
		}
		elsif( -f conf_get_attr("fsloc","officons")."/".$adoffdir.
			$imgdirectory.".png" )
		{
			$officon = $adoffdir.$imgdirectory.".png";
		}
		# is there an icon file called the name of the archive but
		# with a image extension instead of the archive extension?
		elsif( -f conf_get_attr("fsloc","officons")."/".$adoffdir.
			$adoffarchive.".jpg" )
		{
			$officon = $adoffdir.$adoffarchive.".jpg";
		}
		elsif( -f conf_get_attr("fsloc","officons")."/".$adoffdir.
			$adoffarchive.".png" )
		{
			$officon = $adoffdir.$adoddarchive.".png";
		}
		# is there an icon file called the modelkey_setkey?
		elsif( -f conf_get_attr("fsloc","officons")."/".$adoffdir.
			id_get_key."_".id_get_setkey.".jpg" )
		{
			$officon = $adoffdir."/".id_get_key."_".
				id_get_setkey.".jpg";
		}
		elsif( -f conf_get_attr("fsloc","officons")."/".$adoffdir.
                        id_get_key."_".id_get_setkey.".png" )
		{
			$officon = $adoffdir."/".id_get_key."_".
				id_get_setkey.".png";
		}
		# is there an icon file called the modelkey-setkey?
		elsif( -f conf_get_attr("fsloc","officons")."/".$adoffdir.
			id_get_key."-".id_get_setkey.".jpg" )
		{
			$officon = $adoffdir."/".id_get_key."-".
				id_get_setkey.".jpg";
		}
		elsif( -f conf_get_attr("fsloc","officons")."/".$adoffdir.
                        id_get_key."-".id_get_setkey.".png" )
		{
			$officon = $adoffdir."/".id_get_key."-".
				id_get_setkey.".png";
		}
		# hopefully it was one of those options....
		if( $debug )
		{
			if( $officon ne "" )
			{
				print "Found official icon at ".$officon."\n";
			}
		}
	}

	# see if we have a text description file passed from .unpack
	$desctext='';
	if( $debug > 1 )
	{
		print STDERR "adddetails_db: descfile: ".$descfile."\n";
	}
	if( -f $descfile )
	{
		# confirm
		#if( debug > 2 )
		#{
			print STDERR "adddetails_db: .unpack specified a file ".
				"containing the set description. (".
				$descfile.")\n";
		#}
		# it exists
		open( DESCFILE, "< ".$descfile ) ||
			print STDERR "Could not open specified description ".
				$descfile."\n";
		while( $descline = <DESCFILE> )
		{
			chomp( $descline );
			$desctext .= $descline." ";
		}
		close( DESCFILE );

		# remove last space, then check is it too long for the field?
		chop( $desctext );
		if( length($desctext) < 2048 )
		{
			$adsdesc = makedbsafe( string=>$desctext );
		}
		else
		{
			print STDERR "adddetails_db: description text ".
				"excluded because ".length($desctext).
				" is too big.\n";
		}
	}

	# calculate next number
	$nextsql = "select max(setno) from ".conf_get_attr("tables","sets");
	$nextcsr = $dbhandle->prepare( $nextsql );
	$nextcsr->execute;
	@nextrec = $nextcsr->fetchrow_array;
	$nextref = ( $nextrec[0] +1 );
	print "Adding to database - next no is $nextref (".$adsrank.")\n";
	if( $nextref < 1 )
	{
		die "Can't get next number\n";
	}

	# OK, got the number, lets insert
	# OLD METHOD FIRST THEN NEW
	$setno = $nextref;
	$inssql = "insert into ".conf_get_attr("tables","sets");
	#               0      1      2        3
	$inssql .= " ( setno, stype, sstatus, sformat, ";
	#            4       5      6      7         8        9
	$inssql .= "stitle, sname, shair, smodelno, ssource, sfoundry, ";
	#            10      11        12       13       14
	$inssql .= "snotes, sindexes, simages, sidlogo, scatinfo, ";
	#            15       16         17        18      19      20
	$inssql .= "sarea, scategory, sdirectory, slandx, slandy, sportx, ";
	#            21      22         23	 24     25        26
	$inssql .= "sporty, snamestem, sphotog, sauto, sofftitle, slocation, ";
	#            27        28       29          30        31     32
	$inssql .= "scatflag, sattire, slocdetail, sofficon, srank, sprev, ";
	#            33           34         35         36         37
	$inssql .= "sduplicates, saltmedia, sdownload, sproddate, sreldate, ";
	#            38         39     40
	$inssql .= "sbranding, sdesc, sadded ) ";
	$inssql .= "values (";
	# and now the contents
	# NEW METHOD FOLLOWS OLD
	# 0 - 3 - what
	$inssql .= "'".$setno."','I','A','JPEG','";
	$adnew{setno} = $setno;
	$adnew{stype} = 'I';
	$adnew{sstatus} = 'A';
	$adnew{sformat} = 'JPEG';
	# 4 - 7 - who
	$inssql .= $title."','".$name."','".$hair."','".$modelno."','";
	$adnew{stitle} = $title;
	$adnew{sname} = $name;
	$adnew{shair} = $hair;
	$adnew{smodelno} = $modelno;
	# 8 - 10 - where
	$inssql .= $source."','".$foundry."','".$notes."','";
	$adnew{ssource} = $source;
	$adnew{sfoundry} = $foundry;
	$adnew{snotes} = $notes;
	# 11 - 12 - stats
	$inssql .= $indexcount."','".$imagecount."','";
	$adnew{sindexes} = $indexcount;
	$adnew{simages} = $imagecount;
	# 13 - 15 - misc, type and path component
	$inssql .= $shortid."','".$setinfo."','".$imgarea."','";
	$adnew{sidlogo} = $shortid;
	$adnew{scatinfo} = $setinfo;
	$adnew{sarea} = $imgarea;
	# 16 - 17 - more path components
	$inssql .= $imgcategory."','".$imgdirectory."','";
	$adnew{scategory} = $imgcategory;
	$adnew{sdirectory} = $imgdirectory;
	# 18-21 - image size 
	$inssql .= $land_x."','". $land_y."','". $port_x."','". $port_y ."','";
	$adnew{slandx} = $land_x;
	$adnew{slandy} = $land_y;
	$adnew{sportx} = $port_x;
	$adnew{sporty} = $port_y;
	# 22-25 - namestem, photographer, sauto and setname (official title)
	$inssql .= $namestem."','".$photog."','F','".$setname."','";
	$adnew{snamestem} = $namestem;
	$adnew{sphotog} = $photog;
	$adnew{sauto} = 'F';
	$adnew{sofftitle} = $setname;
	# 26-29 - location, catflag, and attire
	$inssql .= $location."','".$catflag."','".$attire."','";
	$adnew{slocation} = $location;
	$adnew{scatflag} = $catflag;
	$adnew{sattire} = $attire;
	# 29-32  - location detail, official icon, rank, previous
	$inssql .= $locdetail."','".$officon."','".$adsrank."','".
			$adsprev."','";
	$adnew{slocdetail} = $locdetail;
	$adnew{sofficon} = $officon;
	$adnew{srank} = $adsrank;
	$adnew{sprev} = $adsprev;
	# 33-35  - duplicates, alternative media and download filename
	$inssql .= $adsduplicates."','".$adsaltmedia."','".$adsdownload."','";
	$adnew{sduplicates} = $adsduplicates;
	$adnew{saltmedia} = $adsaltmedia;
	$adnew{sdownload} = $adsdownload;
	# 36-38     - dates and branding 
	$inssql .= $adsproddate."','".$adsreldate."','".$adsbranding."','";
	$adnew{sproddate} = $adsproddate;
	$adnew{sreldate} = $adsreldate;
	$adnew{sbranding} = $adsbranding;
	# 39-40 - desc and date stamp
	$inssql .= $adsdesc."','".$today."') ";
	$adnew{sdesc} = $adsdesc;
	$adnew{sadded} = $today;

	# create new method insert statement
	$adinssql = "insert into ".conf_get_attr("tables","sets")."(";
	foreach $adkey ( keys %adnew )
	{
		$adinssql .= $adkey.",";
	}
	chop( $adinssql );  # remove stray comma
	$adinssql .= ") values (";
	foreach $adkey( keys %adnew )
	{
		if( $adnew{$adkey} eq "" )
		{
			$adinssql .= "null,";
		}
		else
		{
			$adinssql .= "'".$adnew{$adkey}."',";
		}
	}
	chop( $adinssql );   # remove stray comma
	$adinssql .= ") ";

	if( $debug > 1 )
	{
		print "adddetails_db: old SQL is: ".$inssql."\n";
		print "adddetails_db: New version SQL is: ".$adinssql."\n";
	}
	$dbhandle->do( $adinssql ) ||
		die( "Can't insert record into database\n".
			"Command: $inssql\nReason given was $DBI::errstr\n");
	$inserts++;

	# if we have no download record, push our set number back into the
	# unpack file
	if( $adisdnl eq "none" )
	{
		# add the set number to the .unpack file
		if( -f $addirectory."/.unpack" )
		{
			open( UNPACK,">> ".$addirectory."/.unpack");
			print UNPACK "setno=".$setno."\n";
			close UNPACK;
		}
		else
		{
			if( $debug > 2 )
			{
				print "adddetails_db: couldn't find .unpack".
					" file in ".$addirectory."/.unpack\n"
			}
		}
	}
	# associate the model with this set
	if( $modelno > 0 )
	{
		addassoc( 'setno'=>$setno,
			  'modelno'=>$modelno,
			  'asstype'=>'G',
			  'dbhandle'=>$dbhandle );
	}
	else
	{
		# if we're even slightly checking, grumble
		if( $debug > 0 )
		{
			print STDERR "adddetails_db: can't associate model ".
				$modelno." with set ".$setno."\n";
		}
	}

	# get the download information stored earlier
	$addnldno = id_get_dnldno;
	if( $addnldno > 0 )
	{
		dnld_markdone( 'setno'=>$setno,
			       'downloadno'=>$addnldno,
			       'dbhandle'=>$dbhandle );
	}
	if( $addnldno ne $adisdnl )
	{
		print "adddetails_db: download details mismatch: ".
			"id_get_dnldno=".$addnldno." param=".
			$adisdnl."\n";
	}

	# check for any related record connections we need to add
	# this code matches code from genvideo
	if( $adsrank eq "C" )
	{
		# FIXME: TOTALLY WRONG but will work right for 90%+ sets!
		$setpos = 2;
		# all of these parameters are from OUR viewpoint not
		# that of the set to be updated
		linkfromprevious( setno=>$setno,
				  previous=>$adsprev,
				  setpos=>$setpos,
				  dbhandle=>$dbhandle );
	}
	elsif( $adsrank eq "S" )
	{
		# all of these parameteres are from OUR viewpoint not
		# that of the set to be updated
		linkrelated( setno=>$setno,
			     relatedno=>$adsduplicates,
			     relationtype=>"duplicate",
			     dbhandle=>$dbhandle );
	}
	# and finally do we have an altmedia?
	if( int( $adsaltmedia ) > 0 )
	{
		# once again specified from the viewpoint of the current set
		linkrelated( setno=>$setno,
			     relatedno=>$adsaltmedia,
			     relationtype=>"altmedia",
			     dbhandle=>$dbhandle );
	}

	# now nobble the values so there's none hanging around
	reset_attr( 'images');
}

sub decode_directory( $ )
{
	my( $wherearewe )=@_;
	my( $rest, $junk );

	# reset the variables
	$imgarea = "";
	$imgcategory = "";
	$imgdirectory = "";
	# remove the top of the tree and then clean the ends
	$wherearewe =~ s/$treetop//g;
	$wherearewe =~ s/^\///g;
	$wherearewe =~ s/\/$//g;
	( $imgarea, $rest ) = split( /\//, $wherearewe, 2 );
	if( $rest ne "" )
	{
		( $imgdirectory, $imgcategory, $junk ) = fileparse( $rest );
	}
	# imgcategory can be left with a trailing slash here, so clean it
	# of (or at least try to)
	$imgcategory =~ s/\/$//;
}

sub guessinfo( $ )
{
	my( $directory )=@_;
	my( $fname, $path, $suffix, $kwscat, $kwsloc, $kwsattrib, $kwsattire );
	my( $kwslocdet );
	my( $vcsql, $vccsr, @vcrec );

	# set defaults
	( $fname, $path, $suffix ) = fileparse( $directory );
	$title = $fname;
	$title =~ s/_/ /g;
	$fname="";
	$hair="";
	$modelno="";
	$modelattr="";
	$source = "usenet";
	$foundry = "unknown";
	$notes = "";   # changed - sauto now controls this (or should)
	$sauto = "F";
	$idlogo = "unknown";
	$indexread = 0;
	$imagesread = 0;
	$catinfo = "";
	$location = "";
	$locdetail = "";
	$reldate = "";
	$proddate = "";
	$branding = "";

	# check for toplevel (sarea) directory being a vendor name
	$vcsql = "select vsite, vshortname from ";
	$vcsql.= conf_get_attr("tables","vendor")." ";
	$vcsql.= "where vshortname = ? ";
	$vccsr = $dbhandle->prepare( $vcsql );
	if( $debug > 3 )
	{
		print STDERR "directory is: ".$directory."\n";
	}
	$vccsr->execute( $directory );
	if( @vcrec = $vccsr->fetchrow_array )
	{
		# found a vendor record
		$source = "subscription";
		$foundry = $vcrec[1];
	}
	else
	{
		if( $debug > 2 )
		{
			print STDERR "Directory: ".$directory.
				" not a vendor name\n";
		}
	}

	# do the processing
	$_ = $title;
	$_ =~ y/A-Z/a-z/;
	# new (keyword db based) version
	kwscore_reset( 'all' );
	kwscore_process( 'string'=>$title,
			 'dbhandle'=>$dbhandle );
	$kwscat=kwscore_get( 'what'=>'cat', 'default'=>'S' );
	$kwsloc=kwscore_get( 'what'=>'loc' );
	$kwslocdet=kwscore_get( 'what'=>'det' );
	$kwsattrib=kwscore_get( 'what'=>'attr' );
	$kwsattire=kwscore_get( 'what'=>'other' );

	# remove duplicates
	$location=$kwsloc;
	$locdetail=$kwslocdet;
	$attire= removedups( $kwsattire );
	$catinfo= removedups( $kwsattrib );
	print "Done.\n";
}

sub do_update( $$$ )
{
	my( $setno, $curdir, $force )=@_;
	my( $chksql, $chkcsr, @chkrec );
	my( $modsql, $modcsr, @modrec );
	my( $vcsql, $vccsr, @vcrec );
	my( $dcsql, $dccsr, @dcrec );
	my( $chkattr, $chkcatinfo, $chkphotog, $kwscat, $kwsloc, $kwsattrib );
	my( $kwsattire, $kwslocdet, $chkimgcount );
	my( $lesbo, $changes, $imgdirh, $imgfile, $chkcatflag, $vendch );
	
	
	if( $debug > 5 )
	{
		print "Entering Update routines for $setno ($curdir)\n";
	}
	$updcmd = "update ".conf_get_attr("tables","sets")." set ";
	$updflag=0;
	$lesbo=0;
	$vendch=0;
	$changes='';
	$chkimgcount=0;

	#                   0      1      2          3
        $chksql = "select stitle, sarea, scategory, sdirectory, ";
        #            4      5      6        7         8       9
        $chksql .= "sname, shair, ssource, sfoundry, snotes, scatinfo, ";
        #            10          11        12        13     14
        $chksql .= "snamestem, sdownload, smodelno, sauto, slandx, ";
	#            15      16      17      18       19        20
	$chksql .= "slandy, sportx, sporty, sphotog, scatflag, slocation, ";
	#            21       22         23     24          25
	$chksql .= "sattire, sofftitle, sdesc, slocdetail, simages ";
	$chksql .= "from ".conf_get_attr("tables","sets");
	$chksql .= " where setno = '".$setno."' ";
	$chkcsr = $dbhandle->prepare( $chksql );
	$chkcsr->execute;
	
	@chkrec = $chkcsr->fetchrow_array;
	if( $chkrec[0] eq "" )
	{
		print "ERROR: Lack of sensible result for set no $setno\n";
		print "Directory was $curdir.\n";
		exit -1;
	}

	# these location checks aren't really conditional
	doareacheck( $chkrec[1], $imgarea, $imgdirectory );
	docategorycheck( $chkrec[2], $imgcategory, $imgdirectory );
	dodircheck( $chkrec[3], $imgdirectory, $chkrec[0] );

	# other checks - chkrec8 is notes, chkrec9 is catinfo
	if( $chkrec[13] eq "" )
	{
		# start getting values into the sauto field
		# and zero off the old notes field
		if( $chkrec[8] eq "auto" )
		{
			$updcmd .= "sauto = 'F', snotes = '', ";
			$updflag++;
		}
	}
	# this routine should trigger ever more rarely as we manage
	# to populate the sauto field - it is depricated
	if( $chkrec[13] eq "" && $chkrec[8] eq "auto" && $notes ne "auto" )
        {
                # the text file has been updated and the database
                # has not
                print "WARNING: found text file newer than DB";
                print " - updating $setno\n";
                $updcmd .= "snotes = '', ";
                $updcmd .= "sname = '".$name."', ";
                $updcmd .= "shair = '".$hair."', ";
                $updcmd .= "ssource = '".$source."', ";
                $updcmd .= "sfoundry = '".$foundry."', ";
                $updcmd .= "scatinfo = '".$catinfo."', ";
                $updflag++;
        }

	# Attempt to run the keyword scoring process only once using all
	# of the possible fields for processing
	kwscore_reset( 'all' );
	# process all possible fields: stitle, sofftitle and sdesc
	kwscore_process( 'string'=>$chkrec[0],
			 'dbhandle'=>$dbhandle );
	# check if sofftitle or sdesc contain anything before checking
	if( $chkrec[22] ne "" )
	{
		kwscore_process( 'string'=>$chkrec[22],
				 'dbhandle'=>$dbhandle );
	}
	if( $chkrec[23] ne "" )
	{
		kwscore_process( 'string'=>$chkrec[23],
				 'dbhandle'=>$dbhandle );
	}

	# rebuild the catinfo for this set if it's either append or
	# fully auto
	if( $chkrec[13] eq "F" || $chkrec[13] eq "A" )
	{
		# redo the catinfo guesses
		$catinfo = "";
		if( $chkrec[13] eq "A" )
		{
			# for F (Full Auto) we start from scratch
			# for A (Append) we only append so we preset
			#        catinfo to what's in the database
			$catinfo = $chkrec[9];
			# if we're type A (Append) bring across any
			# different value from the catflag field
			if( $chkrec[19] eq "F" )
			{
				$catinfo .= " fuck ";
			}
			if( $chkrec[19] eq "L" )
			{
				$catinfo .= " lesbian ";
			}
			if( $chkrec[19] eq "A" )
			{
				# All girl is lesbian and (at least) fff
				$catinfo .= " lesbian fff ";
			}
			if( $chkrec[19] eq "T" )
			{
				$catinfo .= " dildo ";
			}
		}
		$chkattr = impinfofrommodel( $setno );
		$kwsattrib=kwscore_get( 'what'=>'attr', 'default'=>$chkrec[9] );
		if( $chkattr ne "" )
		{
			# add model sourced info to that collected by 
                        # guesscatinfo (and placed into catinfo).
                        $kwsattrib .= " ".removeconflicts( model=>$chkattr,
					             existing=>$kwsattrib );
                }
		$kwsattrib= removedups( $kwsattrib );
		if( $debug > 2 )
		{
			print "Catinfo guessed to be: $kwsattrib\n";
		}
		if( $kwsattrib ne $chkrec[9] )
		{
			$catinfo = $kwsattrib;
			if( $debug )
			{
				print "Catinfo changed to: [".$kwsattrib.
					"] - was [".$chkrec[9]."]\n";
			}
			$updcmd .= "scatinfo = '".$kwsattrib."', ";
			$changes = $changes . " catinfo";
			$updflag++;
		}
	}

	# rebuild the location info as well but only if not set in A
	if( $chkrec[13] eq "F" )
	{
		$kwsloc=kwscore_get( 'what'=>'loc' );
		$kwslocdet=kwscore_get( 'what'=>'det' );
		if( $kwsloc ne $chkrec[20] && $kwsloc ne "" )
		{
			print "Location changed to: ".$kwsloc." was ".
				$chkrec[20]."\n";
			$updcmd .= "slocation = '".$kwsloc."', ";
			$changes = $changes . " location";
			$updflag++;
		}
		if( $kwslocdet ne $chkrec[24] && $kwslocdet ne "" )
		{
			print "Location detail changed to: ".$kwslocdet.
				" was ".$chkrec[24]."\n";
			$updcmd .= "slocdetail = '".$kwslocdet."', ";
			$changes = $changes . " locdetail";
			$updflag++;
		}
	}
	# and now the attire field if fully automatic
	if( $chkrec[13] eq "F" )
	{
		$kwsattire=kwscore_get( 'what'=>'other' );
		if( $kwsattire ne $chkrec[21] && $kwsattire ne "" )
		{
			if( $debug > 1 )
			{
				print "Attire changed to: ".$kwsattire." was ".
					$chkrec[21]."\n";
			}
			$updcmd .= "sattire = '".$kwsattire."', ";
			$changes = $changes . " attire";
			$updflag++;
		}
	}
	# back to the location field, now for append only
	if( $chkrec[13] eq "A" && $chkrec[20] eq "" )
	{
		$kwsloc=kwscore_get( 'what'=>'loc' );
		if( $kwsloc ne $chkrec[20] && $kwsloc ne "" )
		{
			print "Location set to: ".$kwsloc."\n";
			$updcmd .= "slocation = '".$kwsloc."', ";
			$changes = $changes . " location";
			$updflag++;
		}
	}
	# and location detail too
	if( $chkrec[13] eq "A" && $chkrec[24] eq "" )
	{
		$kwslocdet=kwscore_get( 'what'=>'det' );
		if( $kwslocdet ne $chkrec[24] && $kwslocdet ne "" )
		{
			print "Detailed Location set to: ".$kwslocdet."\n";
			$updcmd .= "slocdetail = '".$kwsloc."', ";
			$changes = $changes . " locdetail";
			$updflag++;
		}
	}
	# and again for the attire field for append only
	if( $chkrec[13] eq "A" && $chkrec[21] eq "" )
	{
		$kwsattire=kwscore_get( 'what'=>'other' );
		if( $kwsattire ne $chkrec[21] && $kwsattire ne "" )
		{
			if( $debug > 1 ) 
			{
				print "Attire set to: ".$kwsattire."\n";
			}
			$updcmd .= "sattire = '".$kwsattire."', ";
			$changes = $changes . " attire";
			$updflag++;
		}
	}
	# recheck the catflag as well
	if( $chkrec[19] eq "" || $chkrec[19] eq "N" || $force == 1)
	{
		# keyword version
		$kwscat=kwscore_get( 'what'=>'cat', 'default'=>'S' );
		$updcmd .= "scatflag = '".$kwscat."', ";
		$changes = $changes . " attributes";
		$updflag++;
	}
	# since solo is the default, and toys is a subset of solo
	# we just do a quick recheck that a toys keyword has not
	# been added
	# FIXME: Do this better now we have several toy keywords
	if( $chkrec[19] eq "S" && $catinfo =~ /dildo/ )
	{
		# WARNING: this will cause a keyword reset
		$chkcatflag = guessflag( $catinfo, $chkrec[0] );
                $updcmd .= "scatflag = '".$chkcatflag."', ";
                $changes = $changes . " attributes";
                $updflag++;
	}
	if( $chkrec[19] eq "S" && $catinfo =~ /vibrator/ )
	{
		# WARNING: this will cause a keyword reset
		$chkcatflag = guessflag( $catinfo, $chkrec[0] );
		$updcmd .= "scatflag = '".$chkcatflag."', ";
		$changes = $changes . " attributes";
		$updflag++;
	}
	if( $chkrec[19] eq "S" && $catinfo =~ /massager/ )
	{
		# WARNING: this will cause a keyword reset
		$chkcatflag = guessflag( $catinfo, $chkrec[0] );
		$updcmd .= "scatflag = '".$chkcatflag."', ";
		$changes = $changes . " attributes";
		$updflag++;
	}
        if( $chkrec[10] eq "" || $force == 1 )
        {
                $namestem = find_namestem( $curdir );
		if( $namestem ne "" )
		{
			$updcmd .= "snamestem = '".$namestem."', ";
			$changes = $changes . " namestem";
			$updflag++;
			if( $chkrec[11] eq "" &&
				$chkrec[1] eq "sapphicerotica" )
			{
				$download = $namestem .".zip";
				$updcmd .= "sdownload = '".$download."', ";
				$updflag++;
			}
		}
        }
	if( $chkrec[14] == 0 && $chkrec[16] == 0 || $force == 1 )
	{
		# update image sizes
		print "Calculating image size information\n";
		$changes = $changes . " imgsize";
		opendir( $imgdirh, $curdir );
		while( $imgfile = readdir( $imgdirh ))
		{
			if( ! checkexclude( $imgfile) )
			{
				getsizes( $curdir, $imgfile );
			}
		}
		closedir( $imgdirh );
		print "image sizes are: landscape ";
		print "$land_x by $land_y\n";
		print "               : portrait  ";
		print "$port_x by $port_y\n";
		if( $land_x > 0 )
		{
			if( $land_y > 0 )
			{
				$updcmd .= "slandx = '$land_x', ";
				$updcmd .= "slandy = '$land_y', ";
			}
			$updflag++;
		}
		if( $port_x > 0 )
		{
			if( $port_y > 0 )
			{
				$updcmd .= "sportx = '$port_x', ";
				$updcmd .= "sporty = '$port_y', ";
			}
			$updflag++;
		}
	}
	# check image counts
	if( $chkrec[25] == 0 || $force == 1 )
	{
		# update image count
		print "Calculating image count information\n";
		$changes = $changes . " imgcount";
		opendir( $imgdirh, $curdir );
		while( $imgfile = readdir( $imgdirh ))
		{
			if( ! checkexclude( $imgfile) )
			{
				$chkimgcount++;
			}
		}
		closedir( $imgdirh );
		$updcmd .= "simages = '".$chkimgcount."', ";
		$updflag++;
	}
	# recheck the photographer info
	if( $chkrec[18] eq "" || $force == 1 )
	{
		# no photographer set
		$chkphotog = extractphotog( $chkrec[10], 
			conf_get_attr("tables","photographer"), $dbhandle );
		if( $chkphotog ne "" )
		{
			$updcmd .= "sphotog = '".$chkphotog."', ";
                        $changes = $changes . " photographer";
                        $updflag++;
		}
	}
	# recheck for vendor site name from path
	if( $chkrec[13] eq "F" || $chkrec[13] eq "A" )
	{
		# check for toplevel (sarea) directory being a vendor name
		$vcsql = "select vsite, vshortname from ";
		$vcsql.= conf_get_attr("tables","vendor")." ";
		$vcsql.= "where vshortname = ? ";
		$vccsr = $dbhandle->prepare( $vcsql );
		if( $debug > 3 )
		{
			print STDERR "directory is: ".$chkrec[1]."\n";
		}
		$vccsr->execute( $chkrec[1] );
		if( @vcrec = $vccsr->fetchrow_array )
		{
			# if the foundry isn't specified and the sarea
			# is a vendor name, set the foundry to the vendor
			# NB: This is a fix from an overzealous previous
			#     version which didn't work for third-party
			#     licensed content (ie baremaidens sets on
			#     adulttime).
			if( $chkrec[7] eq "" && $chkrec[1] eq $vcrec[1])
			{
				# found a vendor record
				$updcmd .= "sfoundry = '".$vcrec[1]."', ";
				$changes = $changes . " foundry";
				$updflag++;
				$vendch++;
			}
		}
	}
	# check for download record if default values
	if( $chkrec[7] eq "unknown" && $vendch == 0 && 
		( $chkrec[13] eq "F" || $chkrec[13] eq "A" ))
	{
		#                 0           1      2        3      4
		$dcsql = "select downloadno, dsite, dstatus, dtype, dmodelno ";
		$dcsql.= "from ".conf_get_attr("tables","download")." ";
		$dcsql.= "where dsetno = ? ";
		$dccsr = $dbhandle->prepare( $dcsql );
		$dccsr->execute( $setno );
		if( @dcrec = $dccsr->fetchrow_array )
		{
			if( $debug > 1 )
			{
				print STDERR "Found vendor ".$dcrec[1].
					" via download for ".$setno."\n";;
			}
			$vcsql = "select vsite, vshortname from ";
			$vcsql.= conf_get_attr("tables","vendor")." ";
			$vcsql.= "where vsite = ? ";
			$vccsr = $dbhandle->prepare( $vcsql );
			$vccsr->execute( $dcrec[1] );
			if( @vcrec = $vccsr->fetchrow_array )
			{
				# found a vendor record
				$updcmd .= "ssource = 'subscription', ";
				$updcmd .= "sfoundry = '".$vcrec[1]."', ";
				$changes = $changes . " source foundry";
				$updflag++;
			}
		}
	}

	if( $updflag == 0 )
	{
		# nothing to do
		return;
	}
	# do the update
	$updcmd .= "samended = '".$today."' where setno = '".$setno."' ";
	print "Updating set no $setno with changed";
	print "$changes in database\n";
	if( $debug > 2 )
	{
		print "SQL is: $updcmd\n";
	}
	$dbhandle->do( $updcmd );
	if( $DBI::errstr ne "" )
	{
		print "ERROR: Database routines report $DBI::errstr\n";
		print "SQL Query was: $updcmd\n";
		exit -1;
	}

	# keep stats 
	$updates++;
}

sub doareacheck( $$$ )
{
	my( $curarea, $newarea, $newdir )=@_;

	# image area check
	if( $curarea eq "" && $newarea ne "" )
	{
		$updcmd .= "sarea = '".$newarea."', ";
		$updflag++;
	}
	if( $curarea ne "" && $curarea ne $newarea )
	{
		# check for relocation
		if( $debug )
		{
			print "$newdir appears to have moved ";
			print "from $curarea to $newarea\n";
		}
		$updcmd .= "sarea = '".$newarea."', ";
		$changes = $changes . " fsloc";
                $updflag++;
		$relocs++;
	}
}

sub docategorycheck( $$$ )
{
	my( $curcateg, $newcateg, $newdir )=@_;

	# image category check
	if( $curcateg eq "" && $newcateg ne "" )
	{
		$updcmd .= "scategory = '".$newcateg."', ";
		$updflag++;
	}
	if( $curcateg ne "" && $curcateg ne $newcateg )
	{
		# relocation check
		if( $debug )
		{
			print "$newdir appears to have moved ";
			print "from $curcateg to $newcateg\n";
		}
		$updcmd .= "scategory = '".$newcateg."', ";
                $updflag++;
		$relocs++;
	}
}

sub dodircheck( $$$ )
{
	my( $curdir, $newdir, $prevtitle )=@_;
	my( $chktitle );

	# image directory check
	if( $curdir eq "" && $newdir ne "" )
	{
		$updcmd .= "sdirectory = '".$newdir."', ";
		$updflag++;
	}
	if( $curdir ne "" && $curdir ne $newdir )
	{
		# the directory name appears to have changed
		print "$newdir appears to have been ";
		print "renamed from $curdir\n";
		# change stitle and imgdirectory
		$chktitle = $curdir;
		$chktitle =~ s/_/ /g;
		if( $chktitle eq $prevtitle )
		{
			# the old title was the directory name with spaces
			print "The old title was the directory ";
			print "name ($prevtitle).\n";
			$chktitle = $newdir;
			$chktitle =~ s/_/ /g;
			if( $chktitle ne "" )
			{
				$updcmd .= "stitle = '".$chktitle."', ";
				$updflag++;
				print "Title changed from $prevtitle ";
				print "to $chktitle\n";
				$title = $chktitle;
			}
		}
		# change the directory entry anyway
		$updcmd .= "sdirectory = '".$newdir."', ";
		$changes = $changes . " title";
		$updflag++;
		$relocs++;
	}
}

sub impinfofrommodel( $ )
{
	my( $targetset )=@_;
	my( $chkhair, $chkname, $retattr, $islesbo );

	$islesbo = 0;
	# Auto or no modelno set
	if( $targetset ne "" )
	{
		$modelno="";
		$chkhair="";
		$chkname="";
		$retattr="";
		$modsql = "select modelno, mname, mhair, mattributes ";
		$modsql .= "from ".conf_get_attr("tables","models");
		$modsql .= ", ".conf_get_attr("tables","assoc");
		$modsql .= " where amodelno = modelno and ";
		$modsql .= "asetno = '".$targetset."' ";
		$modcsr = $dbhandle->prepare( $modsql );
		$modcsr->execute;
		while( @modrec = $modcsr->fetchrow_array )
		{
			if( $modrec[0] ne "" )
			{
				if( $modelno eq "" )
				{
					# first model
					$modelno = $modrec[0];
					$chkname = $modrec[1];
					$chkhair = $modrec[2];
					$retattr = $modrec[3];
				}
				else
				{
					# looking lesbo
					$modelno .= ",".$modrec[0];
					$chkname .= ",".$modrec[1];
					$chkhair .= ",".$modrec[2];
					$retattr .= " ".$modrec[3];
					$islesbo++;
				}
			}
		}
		if( $modelno ne "" )
		{
			# this seems to always happen which it
			# probably shouldn't
			$updcmd .= "smodelno = '".$modelno."', ";
			# lets say this isn't an update unless
			# something else changes
			#$updflag++;
		}
		if( $name ne $chkname )
		{
			$name = $chkname;
			$updcmd .= "sname = '".$name."', ";
			$changes = $changes . " names";
			$updflag++;
		}
		if( $hair ne $chkhair )
		{
			$hair = $chkhair;
			$updcmd .= "shair = '".$hair."', ";
			$updflag++;
		}
		if( $islesbo > 0 )
		{
			$retattr .= " lesbian";
		}
		return( $retattr );
	}
	return( undef );
}

sub getsizes( $$ )
{
	my( $sizedir, $sizefile )=@_;
	my( $gsmediaobj );
	my( $valuex, $valuey, $result );

	if( $sizefile eq ".info" )
	{
		return;
	}

	# updated to use media_scan (ExifTool)
	$gsmediaobj = media_scan( $sizedir."/".$sizefile );
	$valuex = media_get_attr( $gsmediaobj, "width" );
	$valuey = media_get_attr( $gsmediaobj, "height" );

 	if( $valuex == 0 && $valuey == 0 )
	{
		print "NULL return for $sizefile in $sizedir\n";
		return;
	}
	# print "$sizefile: [$valuex][$valuey]\n";
	if( $valuex > 0 && $valuex > $valuey )
	{
		# should be landscape - width(x) is bigger than height(y)
		if( $land_x > 0 )
		{
			# existing value for landscape
			if( $land_x < $valuex )
			{
				print "new image $sizefile is bigger than ";
				print "previous landscape image.\n";
				$land_x = $valuex;
				$land_y = $valuey;
			}
			elsif( $land_x > $valuex )
			{
				print "new image $sizefile is smaller than ";
				print "previous landscape image.\n";
			}
		}
		else
		{
			if( $valuex > 0 && $valuey > 0 )
			{
				$land_x = $valuex;
				$land_y = $valuey;
			}
		}
	}

	if( $valuex > 0 && $valuey > $valuex )
	{
		# should be portrait - height(y) is bigger than width(x)
		if( $port_x > 0 )
		{
			# existing value for portrait
			if( $port_x < $valuex )
			{
				print "new image $sizefile is bigger than ";
				print "previous portrait image.\n";
				$port_x = $valuex;
				$port_y = $valuey;
			}
			elsif( $port_x > $valuex )
			{
				print "new image $sizefile is smaller than ";
				print "previous portrait image.\n";
			}
		}
		else
		{
			if( $valuex > 0 && $valuey > 0 )
			{
				$port_x = $valuex;
				$port_y = $valuey;
			}
		}
	}
}

sub guessflag( $$ )
{
	my( $curcatinfo, $curtitle )=@_;
	my( $flagout );

	# check for backstage case
	if( lc( $curtitle ) =~ /backstage/ ||
		lc( $curtitle ) =~ /behindthescenes/ )
	{
		# this overrides all other settings
		$flagout = "B";
		return( $flagout );
	}
	# normal set
	if( $curcatinfo =~ /fuck/ && $curcatinfo =~ /lesbian/  )
	{
		# lesbian and fuck means orgy
		$flagout = "G";
	}
	else
	{
		if( $curcatinfo =~ /lesbian/ )
		{
			# two girls in clothes not lesbian
			if( $curcatinfo =~ /clothed/ )
			{
				$flagout = "C";
			}
			else
			{
				if( $curcatinfo =~ /fff/ )
				{
					# three or more girls
					$flagout = "A";
				}
				else
				{
					# two girls - lesbian
					$flagout = "L";
				}
			}
		}
		elsif( $curcatinfo =~ /fuck/ )
		{
			# fuck only there if it is
			$flagout = "F";
		}
		elsif( $curcatinfo =~ /blowjob/ )
		{
			# blowjob is classed as fuck (aka Straight)
			$flagout = "F";
		}
		elsif( $curcatinfo =~ /clothed/ )
		{
			# flag clothed sets as such
			$flagout = "C";
		}
		elsif( $curcatinfo =~ /dildo/ )
		{
			# if nothing else but includes toys, toy set
			$flagout = "T";
		}
		elsif( $curcatinfo =~ /vibrator/ )
		{
			# if nothing else but includes toys, toy set (2)
			$flagout = "T";
		}
		elsif( $curcatinfo =~ /massager/ )
		{
			# if nothing else but includes toys, toy set (3)
			$flagout = "T";
		}
		else
		{
			# everything else solo
			$flagout = "S";
		}
	}
	return( $flagout );
}

sub read_unpack( $$ )
{
	my( $rupath, $runamestem )=@_;
	my( $rukeyword, $ruvalue, $ruretval );
	my( $rudownloadno, $ruvendor, $rumodelno, $rusetname, $rusetno );
	my( $rusreldate, $rusproddate, $rusbranding, $ruphotog, $rudescfile );

	unless( open( UNPACK, "< ".$rupath ) )
	{
		print STDERR "read_unpack: failed to open ".$rupath."\n";
		return 0;
	}
	while( <UNPACK> )
	{
		chomp;
		if( /=/ )
		{
			($rukeyword, $ruvalue) = split( /=/, $_, 2 );
			$unpackinfo{$rukeyword}=$ruvalue;
			if( $rukeyword eq "downloadno" )
			{
				if( $ruvalue eq "none" )
				{
					$rudownloadno = "none";
				}
				elsif( $ruvalue > 0 )
				{
					$rudownloadno = $ruvalue;
					id_set_attr("dnldno",$ruvalue);
				}
			}
			if( $rukeyword eq "vendor" )
			{
				if( $ruvalue ne "" )
				{
					$ruvendor = $ruvalue;
					id_set_attr("vendor",$ruvalue);
				}
			}
			if( $rukeyword eq "modelno" )
			{
				if( $ruvalue ne "" )
				{
					$rumodelno = $ruvalue;
					id_set_attr("modelno",$ruvalue);
				}
			}
			if( $rukeyword eq "setname" )
			{
				if( $ruvalue ne "" )
				{
					$rusetname = $ruvalue;
					id_set_attr("setname",$ruvalue);
				}
			}
			if( $rukeyword eq "setno" )
			{
				if( $ruvalue ne "" )
				{
					$rusetno = $ruvalue;
					id_set_attr("setno",$ruvalue);
				}
			}
			if( $rukeyword eq "sreldate" )
			{
				if( $ruvalue ne "" )
				{
					$rusreldate = $ruvalue;
					id_set_attr("sreldate",$ruvalue);
				}
			}
			if( $rukeyword eq "sproddate" )
			{
				if( $ruvalue ne "" )
				{
					$rusproddate = $ruvalue;
					id_set_attr("sproddate",$ruvalue);
				}
			}
			if( $rukeyword eq "sbranding" )
			{
				if( $ruvalue ne "" )
				{
					$rusbranding = $ruvalue;
					id_set_attr("sbranding",$ruvalue);
				}
			}
			if( $rukeyword eq "photog" )
			{
				if( $ruvalue ne "" )
				{
					$ruphotog = $ruvalue;
					id_set_attr("photog",$ruvalue);
				}
			}
			if( $rukeyword eq "descfile" )
			{
				if( $ruvalue ne "" )
				{
					$rudescfile = $ruvalue;
					# set the global one as well
					$descfile = $ruvalue;
					id_set_attr("descfile",$ruvalue);
				}
			}
		}
	}
	close UNPACK;
	if( $debug > 1 )
	{
		print STDERR "read_unpack: downloadno is ".$rudownloadno."\n";
		print STDERR "read_unpack: setname ".$rusetname.
				" featuring modelno ".$rumodelno."\n";
	}	
	if( $rudownloadno eq "none" )
	{
		# this is the new case of a web-based install of an
		# unknown set.  We need to make a fake download entry
		# for other parts to use.
		reset_attr('images');
		id_set_attr( "dnldno","none");
		if( exists $unpackinfo{'vendor'} )
		{
			id_set_attr("vendor",$unpackinfo{'vendor'});
		}
		if( exists $unpackinfo{'setname'} )
		{
			id_set_attr("setname",$unpackinfo{'setname'});
		}
		if( exists $unpackinfo{'setflag'} )
		{
			id_set_attr("setflag",$unpackinfo{'setflag'});
		}
		if( exists $updateinfo{'unpackinfo'} )
		{
			id_set_attr("archive",$unpackinfo{'archive'});
		}
		if( exists $unpackinfo{'modelno'} )
		{
			id_set_attr("modelno",$unpackinfo{'modelno'});
		}
		if( exists $unpackinfo{'setno'} )
		{
			id_set_attr("setno",$unpackinfo{'setno'});
		}
		if( exists $unpackinfo{'srank'} )
		{
			id_set_attr("srank",$unpackinfo{'srank'});
		}
		if( exists $unpackinfo{'sprev'} )
		{
			id_set_attr("sprev",$unpackinfo{'sprev'});
		}
		if( exists $unpackinfo{'sduplicates'} )
		{
			id_set_attr("sduplicates",$unpackinfo{'sduplicates'});
		}
		if( exists $unpackinfo{'saltmedia'} )
		{
			id_set_attr("saltmedia",$unpackinfo{'saltmedia'});
		}
		if( exists $unpackinfo{'sdownload'} )
		{
			id_set_attr("sdownload",$unpackinfo{'sdownload'});
		}
		if( exists $unpackinfo{'sproddate'} )
		{
			id_set_attr("sproddate",$unpackinfo{'sproddate'});
		}
		if( exists $unpackinfo{'sreldate'} )
		{
			id_set_attr("sreldate",$unpackinfo{'sreldate'});
		}
		if( exists $unpackinfo{'sbranding'} )
		{
			id_set_attr("sbranding",$unpackinfo{'sbranding'});
		}
		if( exists $unpackinfo{'photog'} )
		{
			id_set_attr("photog",$unpackinfo{'photog'});
		}
		if( exists $unpackinfo{'descfile'} )
		{
			id_set_attr("descfile",$unpackinfo{'descfile'});
		}

		# we got the proper clue that we should fake it up...
		print "Stored model no ".id_get_modelno."\n";
		return( "none" );
	}
	if( $rudownloadno > 0 )
	{
		# return what dnld_img returns because if we were given
		# a duff downloadno by the .unpack file, this would come
		# back as zero/null and the next actions would not proceed
		$ruretval = dnld_img( 'downloadno' => $rudownloadno,
			  'vendor' => $ruvendor,
			  'dfname' => $runamestem,
			  'srank' => $unpackinfo{'srank'},
			  'sprev' => $unpackinfo{'sprev'},
			  'sduplicates' => $unpackinfo{'sduplicates'},
			  'saltmedia' => $unpackinfo{'saltmedia'},
			  'sdownload' => $unpackinfo{'sdownload'},
			  'sproddate' => $unpackinfo{'sproddate'},
			  'sreldate' => $unpackinfo{'sreldate'},
			  'sbranding' => $unpackinfo{'sbranding'},
			  'photog' => $unpackinfo{'photog'},
			  'descfile' => $unpackinfo{'descfile'},
			  'dbhandle' => $dbhandle );
		return( $ruretval );
	}
	# not found
	print STDERR "read_unpack: found unpack file but no downloadno\n";
	return 0;
}

sub guesscatflag( $$$ )
{
	my( $gcfdownloadno, $gcfcatinfo, $gcftitle )=@_;
	my( $gcfsql, $gcfcsr, @gcfrec, $gcfold );

	if( $gcfdownloadno eq "none" )
	{
		# use the values from the unpack file
		if( exists $unpackinfo{'setflag'} )
		{
			# S is the default so don't return that
			if( $unpackinfo{'setflag'} ne "" &&
			    $unpackinfo{'setflag'} ne "S" )
			{
				return( $unpackinfo{'setflag'} );
			}
		}
	}
	elsif( $gcfdownloadno > 0 )
	{
		#                         0         1         2         3
		$gcfsql = "select downloadno, dsetname, dmodelno, dsetflag, ";
		#           4    
		$gcfsql.= "dnotes ";
		$gcfsql.= "from ".conf_get_attr("tables","download")." ";
		$gcfsql.= "where downloadno = ? ";

		$gcfcsr= $dbhandle->prepare( $gcfsql );
		$gcfcsr->execute( $gcfdownloadno );
		if( $DBI::errstr ne "" )
		{
			print STDERR "guesscatflag: ".
				"fetch of download record failed.\n";
			print STDERR "guesscatflag: error was ".
				$DBI::errstr."\n";
			print STDERR "guesscatflag: query was ".$gcfsql."\n";
			return null;
		}
		if( @gcfrec = $gcfcsr->fetchrow_array )
		{
			# dsetflag field first:
			# since Solo is the default we ignore a specification
			# of that
			if( $gcfrec[3] ne "" && $gcfrec[3] ne "S" )
			{
				$catflag = $gcfrec[3];
				return( $gcfrec[3] );
			}
			# second dnotes:
			# now check dnotes for anything useful
			if( $gcfrec[4] =~ /^Catflag: / )
			{
				$catflag = $gcfrec[4];
				$catflag =~ s/^Catflag: //g;
				return( $catflag );
			}
		}
	}
	# if we've still not found anything, try the derived catinfo
	# keyword Technique
	kwscore_reset( 'all' );
	kwscore_process( 'string'=>$gcftitle,
			 'dbhandle'=>$dbhandle );
	$catflag=kwscore_get( 'what'=>'cat', 'default'=>'S' );
	return( $catflag );
}