~vcs-imports/wacs/trunk

#!/usr/bin/perl
#
# WacsExport
#
#    (C) Copyright 2006,2007,2008,2011 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 DBI;
use XML::Simple;
use Data::Dumper;
use MIME::Base64;

# initialise Wacs
read_conf;
# check_auth not needed for console apps

# global variables
$modelno=0;
$confidential=1;
$expimages=1;
$maximg=1049600;	# maximum image size (1024*1025 = 1MB)
$actsize=0;
$debug=conf_get_attr("debug","app_wacsexport");
#
# MAIN
#
setup( "wacsexport" );
if( $ARGV[0] ne "" )
{
	if( $ARGV[0] eq "--noimages" )
	{
		$expimages=0;
		shift @ARGV;
	}
	$modelno = $ARGV[0];
}
else
{
	print STDERR "usage: wacsexport [--noimages] <modelno>\n";
	exit( -1 );
}
exportmodel( $modelno );
exit( 0 );

#
# SUB-ROUTINES
#
sub setup ( $ ) 
{
	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";
}

sub exportmodel( $ ) 
{
	my( $expmodel )=@_;
	my( $expsql, $expcsr, $exphash, $idsql, $idcsr, $idhash );
	my( $dlsql, $dlcsr, $dlhash );
	my( $modfile, $wacsxml, $wacsdata, $imghash, $bimghash );
	my( @idmaps, @dnlrecs );

	# initialise wacsdata
	$wacsdata= {};

	# prepare and execute for models table
	$expsql = "select * from ".conf_get_attr("tables","models")." ";
	$expsql.= "where modelno = ? ";
	$expcsr = $dbhandle->prepare( $expsql );
	$expcsr->execute( $expmodel );

	if( $DBI::errstr ne "" )
	{
		print STDERR "SQL Croaked\n";
		print STDERR "Error was: $DBI::errstr\n";
		print STDERR "Query was: $expsql\n";
		exit( -1 );
	}

	# prepare and execute for idmap table
	$idsql = "select * from ".conf_get_attr("tables","idmap")." ";
	$idsql.= "where imodelno = ? ";
	$idcsr = $dbhandle->prepare( $idsql );
	$idcsr->execute( $expmodel );

	if( $DBI::errstr ne "" )
	{
		print STDERR "SQL Croaked\n";
		print STDERR "Error was: $DBI::errstr\n";
		print STDERR "Query was: $idsql\n";
		exit( -1 );
	}

	# prepare and execute for download table
	$dlsql = "select * from ".conf_get_attr("tables","download")." ";
	$dlsql.= "where dmodelno = ? ";
	$dlcsr = $dbhandle->prepare( $dlsql );
	$dlcsr->execute( $expmodel );

	if( $DBI::errstr ne "" )
	{
		print STDERR "SQL Croaked\n";
		print STDERR "Error was: $DBI::errstr\n";
		print STDERR "Query was: $dlsql\n";
		exit( -1 );
	}

	# fetch the model record
	$exphash = $expcsr->fetchrow_hashref;
	if( $exphash eq undef )
	{
		# nothing found - abort
		print STDERR "Failed to find record for model $expmodel\n";
		exit( -1 );
	}
	# remove any contact information before exporting
	if( $confidential == 1 )
	{
		$exphash->{mcontact} = undef;
	}
	# reformat the dates into Oracle style if coming from MySQL or 
	# other databases
	if( conf_get_attr("database","dateformat") ne "DD-MON-YYYY" )
	{
		# we need to convert dates
		$exphash->{madded} = convertdate( $exphash->{madded} );
		$exphash->{mamended} = convertdate( $exphash->{mamended} );
	}
	# prepare the model data for XML output
	if( $debug > 3 )
	{
		print STDERR "Result: ".Dumper( $exphash )."\n";
	}
	$wacsdata->{model} = $exphash;

	# export the JPEGs (unless we've been asked not to)
	if( $expimages )
	{
		# first normal size - 120 x 156
		$actsize=0;  # global - updated by getimage
		$imghash->{filename} = $exphash->{mimage};
		$imghash->{encoding} = "jpeg";
		$imghash->{type} = "standard";
		$imghash->{data} = getimage( "standard", $exphash->{mimage} );
		$imghash->{bytes} = $actsize;   # size of the image
		if( $debug > 1 )
		{
			print STDERR "Image (in base64): ".Dumper($imghash).
					"\n";
		}
		$wacsdata->{image} = $imghash;

		# now, if it exists, the big icon
		$actsize=0;  # global - updated by getimage
		if( $exphash->{mbigimage} ne "" &&
		    $exphash->{mbigimage} ne undef )
		{
			$bimghash->{filename} = $exphash->{mbigimage};
			$bimghash->{encoding} = "jpeg";
			$bimghash->{type} = "big";
			$bimghash->{data} = getimage( "big",
						$exphash->{mbigimage} );
			$bimghash->{bytes} = $actsize;   # size of the image
			if( $debug > 3 )
			{
				print STDERR "Image (in base64): ".
						Dumper($bimghash)."\n";
			}
			$wacsdata->{bigimage} = $bimghash;
		}
	}

	# export the idmaps
	@idmaps = ();
	while( $idhash = $idcsr->fetchrow_hashref )
	{
		# reformat the dates into Oracle style if coming from MySQL or 
		# other databases
		if( conf_get_attr("database","dateformat") ne "DD-MON-YYYY" )
		{
			# we need to convert dates
			$idhash->{ichecked} = convertdate($idhash->{ichecked});
			$idhash->{ichanged} = convertdate($idhash->{ichanged});
			$idhash->{iadded} = convertdate($idhash->{iadded});
			$idhash->{iamended} = convertdate($idhash->{iamended});
		}
		if( $debug > 2 )
		{
			print STDERR "IdMap: ".Dumper( $idhash )."\n";
		}
		push( @idmaps, $idhash );
	}
	$wacsdata->{idmap} = [ @idmaps ];

	# export the download records
	@dnlrecs = ();
	while( $dlhash = $dlcsr->fetchrow_hashref )
	{
		# reformat the dates into Oracle style if coming from MySQL or 
		# other databases
		if( conf_get_attr("database","dateformat") ne "DD-MON-YYYY" )
		{
			# we need to convert dates
			$dlhash->{dpulled} = convertdate($dlhash->{dpulled});
			$dlhash->{dadded} = convertdate($dlhash->{dadded});
			$dlhash->{damended} = convertdate($dlhash->{damended});
		}
		if( $debug > 3 )
		{
			print STDERR "Download: ".Dumper( $dlhash )."\n";
		}
		push( @dnlrecs, $dlhash );
	}
	$wacsdata->{download} = [ @dnlrecs ];

	# add a few tags
	$wacsdata->{version} = "WACS_EXPORT_VERSION_2"; # indicates 0.9 schema
	$wacsdata->{coreschema} = "models";
	$wacsdata->{exportdate} = gettoday( 'format'=>"DD-MON-YYYY" );
	$wacsdata->{exportspec} = $expmodel.": ".$exphash->{mname};

	# give the file a .xml extension to help those people with
	# windows somewhere in the chain...
	$modfile = $exphash->{mname}."-".$expmodel.".xml";
	$modfile =~ s/\s//g;
	$wacsxml = XMLout( $wacsdata, XMLDecl => 1, SuppressEmpty=> 1,
			  NoAttr=> 1, RootName=>'WACS_model_data' );

	# open the output file
	open( XMODEL, "> $modfile ") ||
		die( "Can't write model XML file: $modfile\n");
	# send it all out
	print XMODEL $wacsxml;
	# all done - close output file
	close XMODEL;
	# informational report
	if( $debug > 0 )
	{
		print STDERR "Wrote ".$modfile." at ".$wacsdata->{exportdate}.
				"\n";
	}
}

sub getimage( $$ )
{
	my( $isize, $ifname )=@_;
	my( $fpath, $result );

	# which icon and sanity checks
	if( $isize eq "standard" )
	{
		$fpath = conf_get_attr("fsloc","modicons")."/".$ifname ;
	}
	elsif( $isize eq "big" )
	{
		$fpath = conf_get_attr("fsloc","modbigicons")."/".$ifname ;
	}
	else
	{
		print STDERR "unrecognised size request: $isize\n";
		return( undef );
	}

	# is the icon file there?
	if( ! -f $fpath )
	{
		print STDERR "can't find image file at $fpath.\n";
		return( undef );
	}

	open( IMAGE, "< ".$fpath ) ||
		die( "Can't open icon: ".$fpath."\n" );
	$actsize = read( IMAGE, $result, $maximg );
	close( IMAGE );

	return( encode_base64( $result ));
}

sub convertdate( $ )
{
	my( $indate )=@_;
	my( $day, $month, $year, $outdate );
	my( @monnames )=('Err','Jan','Feb','Mar','Apr','May','Jun','Jul',
		'Aug','Sep','Oct','Nov','Dec' );

	if( $indate eq "" )
	{
		return undef;
	}
	( $day, $month, $year ) = timecomps( $indate );
	if( $year < 100 )
	{
		$year += 2000;
	}
	$outdate = sprintf( "%-2.2d-%-3.3s-%-4.4d", $day, uc($monnames[$month]),
				$year );
	if( $debug > 0 )
	{
		print STDERR "convertdate: ".$indate." became ".$outdate."\n";
	}
	return( $outdate );
}