# -*-c-*-
#
# $Id: 35MQPUT1-v5,v 9.8 1999/10/26 14:25:29 wpm Exp $
#
# (c) 1999 Morgan Stanley Dean Witter and Co.
# See ..../src/LICENSE for terms of distribution.
#

void
MQPUT1(Hconn,ObjDesc,MsgDesc,PutMsgOpts,Msg,CompCode,Reason)
	MQHCONN	Hconn
	MQOD	ObjDesc
	MQMD	MsgDesc
	MQPMO	PutMsgOpts
	SV *	Msg
	MQLONG	CompCode
	MQLONG	Reason

	PPCODE:
	{

	SV	**svp;
	AV	*ObjectRecs, *ObjectRecsArrayEntry;
	AV	*PutMsgRecs, *ValidPutMsgRecFieldsArray;
	AV	*ResponseRecArray;
	HV	*ObjectRecsHashEntry, *ResponseRecHash;
	HV	*PutMsgRecFields, *PutMsgRecHash;
	HV	*ValidPutMsgRecFieldsHash, *ValidPutMsgRecFields;
	HV	*ValidPutMsgRecFieldsSubHash;
	HE	*PutMsgRecsIter;
	PMQRR	pResponseRecPtr;
	PMQOR	pObjectRecPtr;

	char	*Key, *pPutMsgRecPtr, *String;
	STRLEN	KeyLength, StringLength;
	int	index, subindex, FieldSize;
	int	PutMsgRecSize = 0;
	PMQCHAR Buffer;

	CompCode = MQCC_FAILED;
	Reason = MQRC_UNEXPECTED_ERROR;
	sv_setiv(ST(5),(IV)CompCode);
	sv_setiv(ST(6),(IV)Reason);

	/*
	  If there is a list of ObjectRecs, then we are dealing with a
	  distribution list.
	 */

	if ( hv_exists((HV*)SvRV(ST(1)),"ObjectRecs",10) ) {

	  svp = hv_fetch((HV*)SvRV(ST(1)),"ObjectRecs",10,FALSE);
	  if ( svp == NULL ) {
	    warn("Unable to fetch value for key ObjectRecs\n");
	    XSRETURN_EMPTY;
	  }

	  if ( 
	      !SvROK(*svp) ||
	      ( SvROK(*svp) && SvTYPE(SvRV(*svp)) != SVt_PVAV )
	      ) {
	    warn("Invalid data for 'ObjectRecs', not an ARRAY reference\n");
	    XSRETURN_EMPTY;
	  }

	  ObjectRecs = (AV*)SvRV(*svp);

	  /* Override this, even if it was provided by the user */
	  ObjDesc.RecsPresent = av_len(ObjectRecs) + 1;

	  /* If this is NOT set, then MQOPEN() will puke.  One more
	     thing the user doesn't have to care about... */
	  ObjDesc.Version = MQOD_VERSION_2;

	  if ( (pResponseRecPtr = (PMQRR)malloc( ObjDesc.RecsPresent * sizeof(MQRR) ) ) == NULL ) {
	    perror("Unable to allocate memory");
	    XSRETURN_EMPTY;
	  }
	
	  memset(pResponseRecPtr,'\0',ObjDesc.RecsPresent * sizeof(MQRR));

	  if ( (pObjectRecPtr = (PMQOR)malloc( ObjDesc.RecsPresent * sizeof(MQOR) ) ) == NULL ) {
	    perror("Unable to allocate memory");
	    XSRETURN_EMPTY;
	  }

	  memset(pObjectRecPtr,'\0',ObjDesc.RecsPresent * sizeof(MQOR));

	  ObjDesc.ResponseRecPtr = pResponseRecPtr;
	  ObjDesc.ObjectRecPtr = pObjectRecPtr;

	  /*
	    Now we have to go through the list, and extract the
	    QName/QMgrName pairs.  We'll allow this to be one of three
	    formats.

	    ObjectRecs => [qw( FOO BAR BAZ )],

	    ObjectRecs => [ 
	    [qw( FOO QM1 )],
	    [qw( BAR QM2 )],
	    [qw( BAZ QM3 )], 
	    ],

	    ObjectRecs => [
	    {
	    ObjectName	=> 'FOO',
	    ObjectQMgrName	=> 'QM1',
	    },
	    {
	    ObjectName	=> 'BAR',
	    ObjectQMgrName	=> 'QM2',
	    },
	    {
	    ObjectName	=> 'BAZ',
	    ObjectQMgrName	=> 'QM3',
	    },
	    ],
	
	    That is, you can either provide a simple array of queue
	    names, or an array of arrays, where the qname and
	    qmgrname are provided seperately, or an array of hashes,
	    where the qname and qmgrname are given as key/vaue
	    pairs.
	  */	    	    

	  for ( index = 0 ; index < ObjDesc.RecsPresent ; index++ ) {

	    svp = av_fetch(ObjectRecs,index,FALSE);
	    if ( svp == NULL ) {
	      warn("Unable to retreive array element from ObjectRecs!!\n");
	      XSRETURN_EMPTY;
	    }

	    /* It had better be a string, array or hash reference */

	    if ( !SvPOK(*svp) &&
		 !(SvROK(*svp) && SvTYPE(SvRV(*svp)) == SVt_PVAV) && 
		 !(SvROK(*svp) && SvTYPE(SvRV(*svp)) == SVt_PVHV) ) {
	      warn("Invalid data in ObjectRecs->[%d], not a string or ARRAY/HASH reference\n",index);
	      XSRETURN_EMPTY;
	    }

	    if ( SvPOK(*svp) ) {
	      String = SvPV(*svp,StringLength);
	      strncpy(pObjectRecPtr->ObjectName,
		      String,
		      (StringLength > (size_t)MQ_Q_NAME_LENGTH ? 
		       (size_t)MQ_Q_NAME_LENGTH : 
		       StringLength));
	      pObjectRecPtr++;
	      continue;
	    }

	    if ( SvROK(*svp) && SvTYPE(SvRV(*svp)) == SVt_PVAV ) {

	      ObjectRecsArrayEntry = (AV*)SvRV(*svp);

	      /* The first entry (the QName) must be there */
	      svp = av_fetch(ObjectRecsArrayEntry,0,FALSE);
	      if ( svp == NULL ) {
		warn("Unable to retreive array element ObjectRecs->[%d]->[0]!!\n",index);
		XSRETURN_EMPTY;
	      }

	      if ( !SvPOK(*svp) ) {
		warn("Invalid data in ObjectRecs->[%d]->[0], not a string\n",index);
		XSRETURN_EMPTY;
	      }
	
	      String = SvPV(*svp,StringLength);
	      strncpy(pObjectRecPtr->ObjectName,
		      String,
		      (StringLength > (size_t)MQ_Q_NAME_LENGTH ? 
		       (size_t)MQ_Q_NAME_LENGTH : 
		       StringLength));

	      /* The second entry (the QMgrName) is optional */
	      svp = av_fetch(ObjectRecsArrayEntry,1,FALSE);
	      if ( svp != NULL ) {
		/* But if it is there, it had better be a string...*/
		if ( !SvPOK(*svp) ) {
		  warn("Invalid data in ObjectRecs->[%d]->[1], not a string\n",index);
		  XSRETURN_EMPTY;
		}
		String = SvPV(*svp,StringLength);
		strncpy(pObjectRecPtr->ObjectQMgrName,
		      String,
		      (StringLength > (size_t)MQ_Q_NAME_LENGTH ? 
		       (size_t)MQ_Q_NAME_LENGTH : 
		       StringLength));
	      }

	      pObjectRecPtr++;
	      continue;
	    }

	    if ( SvROK(*svp) && SvTYPE(SvRV(*svp)) == SVt_PVHV ) {

	      ObjectRecsHashEntry = (HV*)SvRV(*svp);

	      if ( !hv_exists(ObjectRecsHashEntry,"ObjectName",10) ) {
		warn("Missing required key 'ObjectName' from ObjectRecs->[%d]",index);
		XSRETURN_EMPTY;
	      }

	      svp = hv_fetch(ObjectRecsHashEntry,"ObjectName",10,FALSE);
	      if ( svp == NULL ) {
		warn("Unable to fetch value of key 'ObjectName' from ObjectRecs->[%d]",index);
		XSRETURN_EMPTY;
	      }

	      if ( !SvPOK(*svp) ) {
		warn("Invalid data in ObjectRecs->[%d]->{ObjectName}, not a string\n",index);
		XSRETURN_EMPTY;
	      }

	      String = SvPV(*svp,StringLength);
	      strncpy(pObjectRecPtr->ObjectName,
		      String,
		      (StringLength > (size_t)MQ_Q_NAME_LENGTH ? 
		       (size_t)MQ_Q_NAME_LENGTH : 
		       StringLength));

	      if ( hv_exists(ObjectRecsHashEntry,"ObjectQMgrName",14) ) {
		
		svp = hv_fetch(ObjectRecsHashEntry,"ObjectQMgrName",14,FALSE);
		if ( svp == NULL ) {
		  warn("Unable to fetch value of key 'ObjectQMgrName' from ObjectRecs->[%d]",index);
		  XSRETURN_EMPTY;
		}

		if ( !SvPOK(*svp) ) {
		  warn("Invalid data in ObjectRecs->[%d]->{ObjectQMgrName}, not a string\n",index);
		  XSRETURN_EMPTY;
		}

		String = SvPV(*svp,StringLength);
		strncpy(pObjectRecPtr->ObjectQMgrName,
		      String,
		      (StringLength > (size_t)MQ_Q_NAME_LENGTH ? 
		       (size_t)MQ_Q_NAME_LENGTH : 
		       StringLength));

	      }

	      pObjectRecPtr++;
	      continue;

	    }

	  }

	}

	if ( hv_exists((HV*)SvRV(ST(3)),"PutMsgRecs",10) ) {
	
	  /*
	    We will need this configuration hash, but only
	    when handling dist lists.
	  */
	  if ( (ValidPutMsgRecFieldsHash = 
		perl_get_hv("MQSeries::Constants::ValidPutMsgRecFields",FALSE)) == NULL ) {
	    warn("Unable to see %%MQSeries::Constants::ValidPutMsgRecFields\n");
	    XSRETURN_EMPTY;
	  }

	  if ( (ValidPutMsgRecFieldsArray = 
		perl_get_av("MQSeries::Constants::ValidPutMsgRecFields",FALSE)) == NULL ) {
	    warn("Unable to see @MQSeries::Constants::ValidPutMsgRecFields\n");
	    XSRETURN_EMPTY;
	  }

	  svp = hv_fetch((HV*)SvRV(ST(3)),"PutMsgRecs",10,FALSE);
	  if ( svp == NULL ) {
	    warn("Unable to fetch value for key PutMsgRecs\n");
	    XSRETURN_EMPTY;
	  }

	  if ( !SvROK(*svp) || ( SvROK(*svp) && SvTYPE(SvRV(*svp)) != SVt_PVAV ) ) {
	    warn("Invalid data for 'PutMsgRecs', not an ARRAY reference\n");
	    XSRETURN_EMPTY;
	  }

	  PutMsgRecs = (AV*)SvRV(*svp);

	  PutMsgOpts.RecsPresent = av_len(PutMsgRecs) + 1;

	  /*
	    OK, here we go...
		
	    First, look at the *first* PutMsgRecs hash, and from
	    that set the PutMsgOpts.PutMsgRecFields value, and
	    malloc() the necessary memory for the MQMPR and MQRR
	    structures.

	    NOTE: When we scan the entire list of PutMsgRecs hashes,
	    they will be required to have the *same* keys as the
	    first one.  
	  */

	  for ( index = -1 ; index < PutMsgOpts.RecsPresent ; index++ ) {
		
	    svp = av_fetch(PutMsgRecs,(index == -1 ? 0 : index),FALSE);
	    if ( svp == NULL ) {
	      warn("Unable to retreive array element from PutMsgRecs!!\n");
	      XSRETURN_EMPTY;
	    }

	    if ( !SvROK(*svp) || ( SvROK(*svp) && SvTYPE(SvRV(*svp)) != SVt_PVHV ) ) {
	      warn("Invalid data for PutMsgRecs->[%d], not a HASH reference\n",
		   (index == -1 ? 0 : index));
	      XSRETURN_EMPTY;
	    }

	    PutMsgRecHash = (HV*)SvRV(*svp);

	    if ( index == -1 ) {
	      PutMsgRecFields = (HV*)SvRV(*svp);
	    }

	    for ( subindex = 0 ; subindex < av_len(ValidPutMsgRecFieldsArray) + 1 ; subindex++ ) {

	      svp = av_fetch(ValidPutMsgRecFieldsArray,subindex,FALSE);
	      if ( svp == NULL ) {
		warn("Unable to retreive array element from ValidPutMsgRecFieldsArray!!\n");
		XSRETURN_EMPTY;
	      }
	      Key = SvPV(*svp,KeyLength);

	      if ( !hv_exists(PutMsgRecFields,Key,KeyLength) ) {
		continue;
	      }

	      svp = hv_fetch(ValidPutMsgRecFieldsHash,Key,KeyLength,FALSE);
	      if ( svp == NULL ) {
		warn("Unable to retreive hash value from ValidPutMsgRecFieldsHash!!\n");
		XSRETURN_EMPTY;
	      }
	      if ( !SvROK(*svp) || ( SvROK(*svp) && SvTYPE(SvRV(*svp)) != SVt_PVHV ) ) {
		warn("Invalid data for ValidPutMsgRecFields->{%s}, not a HASH reference\n",Key);
		XSRETURN_EMPTY;
	      }
	      ValidPutMsgRecFieldsSubHash = (HV*)SvRV(*svp);

	      if ( index == -1 ) {

		svp = hv_fetch(ValidPutMsgRecFieldsSubHash,"Flag",4,FALSE);
		if ( svp == NULL ) {
		  warn("Invalid data for ValidPutMsgRecFields->{%s} HASH, no 'Flag' key\n",Key);
		  XSRETURN_EMPTY;
		}

		PutMsgOpts.PutMsgRecFields |= SvIV(*svp);

	      }

	      svp = hv_fetch(ValidPutMsgRecFieldsSubHash,"Size",4,FALSE);
	      if ( svp == NULL ) {
		warn("Invalid data for ValidPutMsgRecFields->{%s} HASH, no 'Size' key\n",Key);
		XSRETURN_EMPTY;
	      }

	      FieldSize = SvIV(*svp);
	
	      if ( index == -1 ) {
		PutMsgRecSize += FieldSize ? FieldSize : sizeof(MQLONG);
	      }
	      else {

		svp = hv_fetch(PutMsgRecHash,Key,KeyLength,FALSE);
		if ( svp == NULL ) {
		  warn("Unable to retrieve hash value from PutMsgRecs->[%d]\n",index);
		  XSRETURN_EMPTY;
		}

		if ( FieldSize ) {
		  String = SvPV(*svp,StringLength);
		  strncpy(pPutMsgRecPtr,
			  String,
			  StringLength > FieldSize ? FieldSize : StringLength);
		  pPutMsgRecPtr += FieldSize;
		}
		else {
		  *(PMQLONG)pPutMsgRecPtr = SvIV(*svp);
		  pPutMsgRecPtr += sizeof(MQLONG);
		}

	      }
		    		    

	    }

	    if ( index == -1 ) {

	      if ( (pPutMsgRecPtr = malloc(PutMsgOpts.RecsPresent * PutMsgRecSize)) == NULL ) {
		perror("Unable to allocate memory");
		XSRETURN_EMPTY;
	      }

	      memset(pPutMsgRecPtr,'\0',PutMsgOpts.RecsPresent * PutMsgRecSize);

	      if ( (pResponseRecPtr = malloc(PutMsgOpts.RecsPresent * sizeof(MQRR))) == NULL ) {
		perror("Unable to allocate memory");
		XSRETURN_EMPTY;
	      }

	      memset(pResponseRecPtr,'\0',PutMsgOpts.RecsPresent * sizeof(MQRR));

	      PutMsgOpts.PutMsgRecPtr = pPutMsgRecPtr;
	      PutMsgOpts.ResponseRecPtr = pResponseRecPtr;

	    }

	  }

	}

	Buffer = SvPV(Msg,PL_na);
	MQPUT1(Hconn,&ObjDesc,&MsgDesc,&PutMsgOpts,SvCUR(Msg),Buffer,&CompCode,&Reason);

	/*
	  If there were multiple reason codes imbedded in the
	  "Response Records", then we have to decode these.
	 */
	if ( Reason == MQRC_MULTIPLE_REASONS ) {

	  ResponseRecArray = newAV();

	  for ( index = 0 ; index < ObjDesc.RecsPresent ; index++ ) {
	    ResponseRecHash = newHV();
	    hv_store(ResponseRecHash,"CompCode",8,newSViv(pResponseRecPtr->CompCode),FALSE);
	    hv_store(ResponseRecHash,"Reason",6,newSViv(pResponseRecPtr->Reason),FALSE);
	    av_push(ResponseRecArray,newRV_noinc((SV*)ResponseRecHash));
	    pResponseRecPtr++;
	  }

	  hv_store((HV*)SvRV(ST(1)),"ResponseRecs",12,newRV_noinc((SV*)ResponseRecArray),FALSE);

	}

	/*
	  This adds all the usual fields to the ObjDesc hash
	 */
        hv_store((HV*)SvRV(ST(1)),"Version",7,
		 (newSViv(ObjDesc.Version)),0);
        hv_store((HV*)SvRV(ST(1)),"ObjectType",10,
		 (newSViv(ObjDesc.ObjectType)),0);
	hv_store((HV*)SvRV(ST(1)),"ObjectName",10,
		 (newSVpv(ObjDesc.ObjectName, 48)),0);
	hv_store((HV*)SvRV(ST(1)),"ObjectQMgrName",14,
		 (newSVpv(ObjDesc.ObjectQMgrName, 48)),0);
	hv_store((HV*)SvRV(ST(1)),"DynamicQName",12,
		 (newSVpv(ObjDesc.DynamicQName, 48)),0);
	hv_store((HV*)SvRV(ST(1)),"AlternateUserId",15,
		 (newSVpv(ObjDesc.AlternateUserId, 12)),0);
        hv_store((HV*)SvRV(ST(1)),"RecsPresent",11,
		 (newSViv(ObjDesc.RecsPresent)),0);
        hv_store((HV*)SvRV(ST(1)),"KnownDestCount",14,
		 (newSViv(ObjDesc.KnownDestCount)),0);
        hv_store((HV*)SvRV(ST(1)),"UnknownDestCount",16,
		 (newSViv(ObjDesc.UnknownDestCount)),0);
        hv_store((HV*)SvRV(ST(1)),"InvalidDestCount",16,
		 (newSViv(ObjDesc.InvalidDestCount)),0);
	SvSETMAGIC(ST(1));

        hv_store((HV*)SvRV(ST(2)),"Version",7,
		 (newSViv(MsgDesc.Version)),0);
        hv_store((HV*)SvRV(ST(2)),"Report",6,
		 (newSViv(MsgDesc.Report)),0);
        hv_store((HV*)SvRV(ST(2)),"MsgType",7,
		 (newSViv(MsgDesc.MsgType)),0);
        hv_store((HV*)SvRV(ST(2)),"Expiry",6,
		 (newSViv(MsgDesc.Expiry)),0);
        hv_store((HV*)SvRV(ST(2)),"Feedback",8,
		 (newSViv(MsgDesc.Feedback)),0);
        hv_store((HV*)SvRV(ST(2)),"Encoding",8,
		 (newSViv(MsgDesc.Encoding)),0);
        hv_store((HV*)SvRV(ST(2)),"CodedCharSetId",14,
		 (newSViv(MsgDesc.CodedCharSetId)),0);
	hv_store((HV*)SvRV(ST(2)),"Format",6,
		 (newSVpv(MsgDesc.Format, 8)),0);
        hv_store((HV*)SvRV(ST(2)),"Priority",8,
		 (newSViv(MsgDesc.Priority)),0);
        hv_store((HV*)SvRV(ST(2)),"Persistence",11,
		 (newSViv(MsgDesc.Persistence)),0);
        hv_store((HV*)SvRV(ST(2)),"MsgId",5,
		 (newSVpv((char *)MsgDesc.MsgId,24)),0);
        hv_store((HV*)SvRV(ST(2)),"CorrelId",8,
		 (newSVpv((char *)MsgDesc.CorrelId,24)),0);
        hv_store((HV*)SvRV(ST(2)),"BackoutCount",12,
		 (newSViv(MsgDesc.BackoutCount)),0);
	hv_store((HV*)SvRV(ST(2)),"ReplyToQ",8,
		 (newSVpv(MsgDesc.ReplyToQ, 48)),0);
	hv_store((HV*)SvRV(ST(2)),"ReplyToQMgr",11,
		 (newSVpv(MsgDesc.ReplyToQMgr, 48)),0);
	hv_store((HV*)SvRV(ST(2)),"UserIdentifier",14,
		 (newSVpv(MsgDesc.UserIdentifier, 12)),0);
        hv_store((HV*)SvRV(ST(2)),"AccountingToken",15,
		 (newSVpv((char *)MsgDesc.AccountingToken,32)),0);
	hv_store((HV*)SvRV(ST(2)),"ApplIdentityData",16,
		 (newSVpv(MsgDesc.ApplIdentityData, 32)),0);
        hv_store((HV*)SvRV(ST(2)),"PutApplType",11,
		 (newSViv(MsgDesc.PutApplType)),0);
	hv_store((HV*)SvRV(ST(2)),"PutApplName",11,
		 (newSVpv(MsgDesc.PutApplName, 28)),0);
	hv_store((HV*)SvRV(ST(2)),"PutDate",7,
		 (newSVpv(MsgDesc.PutDate, 8)),0);
	hv_store((HV*)SvRV(ST(2)),"PutTime",7,
		 (newSVpv(MsgDesc.PutTime, 8)),0);
	hv_store((HV*)SvRV(ST(2)),"ApplOriginData",14,
		 (newSVpv(MsgDesc.ApplOriginData, 4)),0);
        hv_store((HV*)SvRV(ST(2)),"GroupId",7,
		 (newSVpv((char *)MsgDesc.GroupId,24)),0);
        hv_store((HV*)SvRV(ST(2)),"MsgSeqNumber",12,
		 (newSViv(MsgDesc.MsgSeqNumber)),0);
        hv_store((HV*)SvRV(ST(2)),"Offset",6,
		 (newSViv(MsgDesc.Offset)),0);
        hv_store((HV*)SvRV(ST(2)),"MsgFlags",8,
		 (newSViv(MsgDesc.MsgFlags)),0);
        hv_store((HV*)SvRV(ST(2)),"OriginalLength",14,
		 (newSViv(MsgDesc.OriginalLength)),0);
	SvSETMAGIC(ST(2));

        hv_store((HV*)SvRV(ST(3)),"Version",7,
		 (newSViv(PutMsgOpts.Version)),0);
        hv_store((HV*)SvRV(ST(3)),"Options",7,
		 (newSViv(PutMsgOpts.Options)),0);
        hv_store((HV*)SvRV(ST(3)),"Timeout",7,
		 (newSViv(PutMsgOpts.Timeout)),0);
        hv_store((HV*)SvRV(ST(3)),"Context",7,
		 (newSViv(PutMsgOpts.Context)),0);
        hv_store((HV*)SvRV(ST(3)),"KnownDestCount",14,
		 (newSViv(PutMsgOpts.KnownDestCount)),0);
        hv_store((HV*)SvRV(ST(3)),"UnknownDestCount",16,
		 (newSViv(PutMsgOpts.UnknownDestCount)),0);
        hv_store((HV*)SvRV(ST(3)),"InvalidDestCount",16,
		 (newSViv(PutMsgOpts.InvalidDestCount)),0);
	hv_store((HV*)SvRV(ST(3)),"ResolvedQName",13,
		 (newSVpv(PutMsgOpts.ResolvedQName, 48)),0);
	hv_store((HV*)SvRV(ST(3)),"ResolvedQMgrName",16,
		 (newSVpv(PutMsgOpts.ResolvedQMgrName, 48)),0);
        hv_store((HV*)SvRV(ST(3)),"RecsPresent",11,
		 (newSViv(PutMsgOpts.RecsPresent)),0);
        hv_store((HV*)SvRV(ST(3)),"PutMsgRecFields",15,
		 (newSViv(PutMsgOpts.PutMsgRecFields)),0);
        hv_store((HV*)SvRV(ST(3)),"PutMsgRecOffset",15,
		 (newSViv(PutMsgOpts.PutMsgRecOffset)),0);
        hv_store((HV*)SvRV(ST(3)),"ResponseRecOffset",17,
		 (newSViv(PutMsgOpts.ResponseRecOffset)),0);
	SvSETMAGIC(ST(3));

	sv_setiv(ST(5), (IV)CompCode);
	SvSETMAGIC(ST(5));

	sv_setiv(ST(6), (IV)Reason);
	SvSETMAGIC(ST(6));

	}
