0010 ! act_build_one.pvx
0020 ! (c) Copyright 2006-2008, Sage Software Canada Ltd. (Ontario, Canada)
0030 ! $Id: act_build_one.pvxsrc 321 2009-11-18 17:28:35Z fred.mcguirk $
0100 ! 
0110 enter (SOURCEFILE$),(DESTINATION$),(ALT_SRC$),(BuildLog),(use_RPC)
0130 if use_RPC then {
0140 enter *,*,*,*,*,(_pf_BUILD_CHKSTRUCTURE),(_pf_BUILD_DEBUG),(FLAGS$),(OWNER$),(PASSWORD$),WarnLog$,WarnCount,BooleanOptions$,err=*next
0150 SAVE_AS_TEXT$=mid(BooleanOptions$,1,1)
0160 FORMATTED_TEXT$=mid(BooleanOptions$,2,1)
0170 MC_PRM=num(mid(BooleanOptions$,3,1),err=*next)
0180  } else {
0190 enter *,*,*,*,*,_pvxConstants,_pvxState,_pf_BUILD_CHKSTRUCTURE,_pf_BUILD_DEBUG
0200  }
0220 if BuildLog=0 then {
0230 ! Build log is now managed using a class
0240 isMyBuildLog=1
0250 BuildLog=new("*obj/pvx_build_log",SOURCEFILE$,DESTINATION$)
0260  }
0280 BUILD_PGM_START:
0290 local RESUME_CMD$,wpop,X,X$,ZCTL,aEclipseData,_tmp$
0420 dim err_data$[256,31]
0470 error_handler read cErrorHandler$
0480 error_handler ""
0540 if _pvxConstants<>0 and _pvxState<>0 then {
0560 FORMATTED_TEXT$=_pvxState'getArgumentValue$(_pvxConstants'_bFormattedText$),PASSWORD_VALIDATE$=_pvxState'getArgumentValue$(_pvxConstants'_bPasswordValidate$),SAVE_AS_TEXT$=_pvxState'getArgumentValue$(_pvxConstants'_bSaveAsText$),FLAGS$=_pvxState'getArgumentValue$(_pvxConstants'FLAGS$),OWNER$=_pvxState'getArgumentValue$(_pvxConstants'OwnerCode$),PASSWORD$=_pvxState'getArgumentValue$(_pvxConstants'pkf_Password$)
0630 MC_PRM=_pvxState'getBooleanPreference(_pvxConstants'_iBuildMaintainCase$)
0640 PZ_PRM=1-_pvxState'getBooleanPreference(_pvxConstants'_iShowSizeWarning$)
0660 _pf_LineNumberInc=_pvxState'getBooleanPreference(_pvxConstants'_LineNumberInc$)
0670 if _pf_BUILD_CHKSTRUCTURE=0 then _pf_BUILD_CHKSTRUCTURE=_pvxState'getBooleanPreference(_pvxConstants'_iBuildCheckStructure$)
0690 if _pf_BUILD_DEBUG=0 then _pf_BUILD_DEBUG=_pvxState'getBooleanPreference(_pvxConstants'_iBuildDebug$)
0710  }
0730 ! Save system parameters that are changed by this program
0740 SAV_LC=prm('LC'),SAV_LE=prm('LE'),SAV_MC=prm('MC'),SAV_NN=prm('NN'),SAV_PZ=prm('PZ'),SAV_SS=prm('SS'),SAV_UL=prm('UL'),SAV_XT=prm('XT')
0950 set_param -'LC',-'LE','MC'=MC_PRM,-'NN','PZ'=PZ_PRM,-'SS',-'XT'
0960 if _pf_BUILD_CHKSTRUCTURE then set_param 'SS'
1050 if _pf_LineNumberInc then set_param -'UL'
1080 ! BUILD_OUT$ will capture output of the SAVE command
1090 BUILD_OUT$="",COMPILEOPTS=1
1120 ! Verify that the destination directory exists - abort if not found.
1130 if nul(DESTINATION$) then goto Build_Done else DEST_DIR$=mid(DESTINATION$,1,pos(dlm=DESTINATION$,-1)); if not(nul(DEST_DIR$)) then catchError=10; open (hfn,err=BUILD_ERROR)DEST_DIR$; close (lfo); catchError=0
1240 if not(nul(ALT_SRC$)) then open (hfn,err=*next)ALT_SRC$; close (lfo); SOURCEFILE$=ALT_SRC$
1290 catchError=12; open (hfn,err=BUILD_ERROR)SOURCEFILE$; close (lfo); catchError=0
1340 if not(nul(PASSWORD$)) then COMPILEOPTS+=2
1370 if not(nul(OWNER$)) then {
1380 COMPILEOPTS+=4
1390 _tmp$=OWNER$,OWNER$="",OWNER$=str(num(_tmp$,err=*next))
1430 open (hfn,err=*next)DESTINATION$; COMPILEOPTS+=32; close (lfo)
1460  } else {
1470 ! Do NOT erase destination if there is an OwnerCode
1480 erase DESTINATION$,err=*next
1490  }
1510 if not(nul(FLAGS$)) then COMPILEOPTS+=8
1540 if not(nul(SAVE_AS_TEXT$)) then COMPILEOPTS=16; if not(nul(FORMATTED_TEXT$)) then COMPILEOPTS=17 end_if ; if not(nul(PASSWORD_VALIDATE$)) then COMPILEOPTS=18 end_if 
1630 ! Build the command to be executed based on the options provided
1640 ! NOTE:
1650 ! Cannot use an =ERR on the LOAD/SAVE since this program will not be in
1660 ! memory when an error occurs.
1670 switch COMPILEOPTS
1680 case 1 ! Simple, no password, owner, or flags
1690 EXECCMD$=lst(pgm(tcb(4)+1)),EXECCMD$=mid(EXECCMD$,pos(" "=EXECCMD$)+1); break
1720 load SOURCEFILE$; wpop=1; print 'window'(-100,-100,80,30),'CS',; save DESTINATION$; input 'TR',BUILD_OUT$; print 'pop',; wpop=0; load THISPROGRAM$; goto Build_Done
1820 case 3 ! Add a password
1830 EXECCMD$=lst(pgm(tcb(4)+1)),EXECCMD$=mid(EXECCMD$,pos(" "=EXECCMD$)+1); break
1860 load SOURCEFILE$; password PASSWORD$; wpop=1; print 'window'(-100,-100,80,30),'CS',; save DESTINATION$; input 'TR',BUILD_OUT$; print 'pop',; wpop=0; load THISPROGRAM$; goto Build_Done
1970 case 5 ! Add an owner code
1980 EXECCMD$=lst(pgm(tcb(4)+1)),EXECCMD$=mid(EXECCMD$,pos(" "=EXECCMD$)+1); break
2010 load SOURCEFILE$; wpop=1; print 'window'(-100,-100,80,30),'CS',; save DESTINATION$,own=num(OWNER$); input 'TR',BUILD_OUT$; print 'pop',; wpop=0; load THISPROGRAM$; goto Build_Done
2110 case 7 ! Add an owner code and password
2120 EXECCMD$=lst(pgm(tcb(4)+1)),EXECCMD$=mid(EXECCMD$,pos(" "=EXECCMD$)+1); break
2150 load SOURCEFILE$; password PASSWORD$; wpop=1; print 'window'(-100,-100,80,30),'CS',; save DESTINATION$,own=num(OWNER$); input 'TR',BUILD_OUT$; print 'pop',; wpop=0; load THISPROGRAM$; goto Build_Done
2260 case 9 ! Add flags
2270 ! NOTE:  The flags are colon-separated numeric values, simply replace
2280 ! the variable 'PLACE_FLAGS_HERE' in the command line with the
2290 ! value in the FLAGS$ variable.
2300 EXECCMD$=lst(pgm(tcb(4)+1)),EXECCMD$=mid(EXECCMD$,pos(" "=EXECCMD$)+1),EXECCMD$=sub(EXECCMD$,"PLACE_FLAGS_HERE",FLAGS$); break
2340 load SOURCEFILE$; wpop=1; print 'window'(-100,-100,80,30),'CS',; save DESTINATION$,flg=PLACE_FLAGS_HERE; input 'TR',BUILD_OUT$; print 'pop',; wpop=0; load THISPROGRAM$; goto Build_Done
2440 case 11 ! Add password and flags
2450 EXECCMD$=lst(pgm(tcb(4)+1)),EXECCMD$=mid(EXECCMD$,pos(" "=EXECCMD$)+1),EXECCMD$=sub(EXECCMD$,"PLACE_FLAGS_HERE",FLAGS$); break
2490 load SOURCEFILE$; password PASSWORD$; wpop=1; print 'window'(-100,-100,80,30),'CS',; save DESTINATION$,flg=PLACE_FLAGS_HERE; input 'TR',BUILD_OUT$; print 'pop',; wpop=0; load THISPROGRAM$; goto Build_Done
2600 case 13 ! Add an owner code and flags
2610 EXECCMD$=lst(pgm(tcb(4)+1)),EXECCMD$=mid(EXECCMD$,pos(" "=EXECCMD$)+1),EXECCMD$=sub(EXECCMD$,"PLACE_FLAGS_HERE",FLAGS$); break
2650 load SOURCEFILE$; wpop=1; print 'window'(-100,-100,80,30),'CS',; save DESTINATION$,own=num(OWNER$),flg=PLACE_FLAGS_HERE; input 'TR',BUILD_OUT$; print 'pop',; wpop=0; load THISPROGRAM$; goto Build_Done
2750 case 15 ! Add a password, owner code and flags
2760 EXECCMD$=lst(pgm(tcb(4)+1)),EXECCMD$=mid(EXECCMD$,pos(" "=EXECCMD$)+1),EXECCMD$=sub(EXECCMD$,"PLACE_FLAGS_HERE",FLAGS$); break
2800 load SOURCEFILE$; password PASSWORD$; wpop=1; print 'window'(-100,-100,80,30),'CS',; save DESTINATION$,own=num(OWNER$),flg=PLACE_FLAGS_HERE; input 'TR',BUILD_OUT$; print 'pop',; wpop=0; load THISPROGRAM$; goto Build_Done
2910 case 16 ! Save as Text - Destination CANNOT exist
2920 EXECCMD$=lst(pgm(tcb(4)+1)),EXECCMD$=mid(EXECCMD$,pos(" "=EXECCMD$)+1); break
2950 load SOURCEFILE$; serial DESTINATION$; password PASSWORD$; password ""; save DESTINATION$; load THISPROGRAM$; goto Build_Done
3030 case 17 ! Save as Formatted Text - Destination CANNOT exist
3040 EXECCMD$=lst(pgm(tcb(4)+1)),EXECCMD$=mid(EXECCMD$,pos(" "=EXECCMD$)+1); break
3070 load SOURCEFILE$; serial DESTINATION$; password PASSWORD$; password ""; save edit DESTINATION$; load THISPROGRAM$; goto Build_Done
3150 case 18 ! Validate password
3160 EXECCMD$=lst(pgm(tcb(4)+1)),EXECCMD$=mid(EXECCMD$,pos(" "=EXECCMD$)+1); break
3190 load SOURCEFILE$; password PASSWORD$; load THISPROGRAM$; goto Build_Done
3240 case 37,39,45,47 ! Merge into pre-existing stub program
3250 EXECCMD$=lst(pgm(tcb(4)+1)),EXECCMD$=mid(EXECCMD$,pos(" "=EXECCMD$)+1); break
3280 load DESTINATION$; password PASSWORD$; delete 0001,64999; merge SOURCEFILE$; password PASSWORD$; wpop=1; print 'window'(-100,-100,80,30),'CS',; save DESTINATION$; input 'TR',BUILD_OUT$; print 'pop',; wpop=0; load THISPROGRAM$; goto BUILD_DONE
3420 end switch 
3440 setResume:
3490 RESUME_CMD$=lst(pgm(tcb(4)+1)),RESUME_CMD$=mid(RESUME_CMD$,pos(" "=RESUME_CMD$)+1),RESUME_CMD$=sub(RESUME_CMD$,"THISPROGRAM$",quo+pgn+quo); preinput next RESUME_CMD$; goto doExec
3550 catchError=err; run THISPROGRAM$+";BUILD_ERROR"
3580 doExec:
3590 ! Substitute actual program as a literal instead of THISPROGRAM$
3600 EXECCMD$=sub(EXECCMD$,"THISPROGRAM$",quo+pgn+quo)
3620 if _pvxConstants<>0 and _pvxState<>0 then if not(nul(EXECCMD$)) then aEclipseData=new("*obj/pvx_data",_pvxConstants'Build_Exec_CMD$,EXECCMD$); aEclipseData'setType(aEclipseData'STRING_TYPE); _pvxState'addArgument(aEclipseData)
3700 ! Restore LowerCase variables argument for program file.
3710 set_param 'LC'=SAV_LC,'MC'=SAV_MC
3730 if not(nul(EXECCMD$)) then execute EXECCMD$
3750 goto Build_Done
3760 ! 
3770 EXEC_ERROR:exit err
3800 Build_Done:
3830 obtain (0,err=*next,tim=0)garbage$
3850 ! Restore Errorhandler
3860 if not(nul(cErrorHandler$)) then error_handler cErrorHandler$
3890 err_num=0,err_sub=0,X$=cvs(BUILD_OUT$,3),BUILD_OUT$="",LOG_TEXT$=""
3940 if nul(X$) then goto Dump_Errors
3970 for X=1 to len(X$) step 80
3980 xln$=cvs(mid(X$,X,80),2)
3990 ! Check for specific warning messages that may be generated by SAVE
4000 if xln$=msg(2) then err_num=2,err_data$[err_num,0]="0",err_data$[err_num,1]="0"; continue ! Error - EOF
4020 if xln$=msg(10) then err_num=10,err_data$[err_num,0]="0",err_data$[err_num,1]="0"; continue ! Bad Pathname
4040 if xln$=msg(12) then err_num=12,err_data$[err_num,0]="0",err_data$[err_num,1]="0"; continue ! No such file
4060 if xln$=msg(13) then err_num=13,err_data$[err_num,0]="0",err_data$[err_num,1]="0"; continue ! File mode
4080 if xln$=msg(17) then err_num=17,err_data$[err_num,0]="0",err_data$[err_num,1]="0"; continue ! Data Format
4100 if xln$=msg(19) then err_num=19,err_data$[err_num,0]="0",err_data$[err_num,1]="0"; continue ! Too big
4120 if xln$=msg(52) then err_num=52,err_data$[err_num,0]="0",err_data$[err_num,1]="0"; continue ! Password required
4140 if xln$=msg(53) then err_num=53,err_data$[err_num,0]="1",err_data$[err_num,1]="0"; continue ! Bad password
4160 if xln$=msg(61) then err_num=61,err_data$[err_num,0]="1",err_data$[err_num,1]="0"; continue ! Authorization failure
4180 if xln$=msg(62) then err_num=62,err_data$[err_num,0]="",err_data$[err_num,1]=""; continue ! Not DevSystem (ignore!)
4200 if xln$=msg(63) then err_num=63,err_data$[err_num,0]="0",err_data$[err_num,1]="0"; continue ! Not activated
4220 if xln$=msg(66) then err_num=66,err_data$[err_num,0]="0",err_data$[err_num,1]="0"; continue ! 64K warning for Save size
4240 if xln$=msg(123) then err_num=123,err_data$[err_num,0]="0",err_data$[err_num,1]="0"; continue ! Missing labels
4260 if xln$=msg(124) then err_num=124,err_data$[err_num,0]="0",err_data$[err_num,1]="0"; continue ! Duplicate labels
4280 if xln$=msg(125) then err_num=125,err_data$[err_num,0]="0",err_data$[err_num,1]="0"; continue ! Improper Structure
4300 if num(err_data$[err_num,1])<30 then err_sub=num(err_data$[err_num,1])+1,err_data$[err_num,1]=str(err_sub),err_data$[err_num,err_sub+1]+=" "+cvs(xln$,1)
4350 next X
4370 Dump_Errors:
4380 for X=1 to 256
4390 ! Output the error number, error message text on separate lines
4400 if nul(err_data$[X,1]) then {
4410 continue
4420  }
4440 ! if there is data associated with the error,
4450 ! output each data value on a separate line
4460 err_sub=num(err_data$[X,1],err=*continue)
4470 theData$=""
4480 if err_sub>0 then {
4490 ! Each data value will be logged separately.
4500 for x2=2 to err_sub
4510 BuildLog'record_warning(X,msg(X),cvs(err_data$[X,x2],1))
4520 theData$+=tbl(nul(err_data$[X,x2]),cvs(err_data$[X,x2],1)+" ","")
4530 next x2
4540 LOG_TEXT$+=$0A$
4550  } else {
4560 if err_data$[X,0]="1" then {
4570 BuildLog'record_error(0,0,X,msg(X),"")
4580  } else {
4590 BuildLog'record_warning(X,msg(X))
4600  }
4610  }
4620 LOG_TEXT$+=msg(X)+$0A$+tbl(nul(theData$),theData$+$0A$,"")
4630 next X
4640 BuildLog'getWarningData(WarnLog$,WarnCount)
4660 Clean_Up:
4670 ! Retrieve BuildLog information from new structure to be returned to event manager.
4680 if isMyBuildLog then {
4690 drop object BuildLog
4700 BuildLog=0
4710  }
4730 if _pvxConstants<>0 and _pvxState<>0 then if not(nul(cvs(WarnLog$,16))) then aEclipseData=new("*obj/pvx_data",_pvxConstants'Build_Exec_Out$,WarnLog$); aEclipseData'setType(aEclipseData'STRING_TYPE); _pvxState'addArgument(aEclipseData) end_if ; if not(nul(cvs(LOG_TEXT$,16))) then aEclipseData=new("*obj/pvx_data",_pvxConstants'Build_Exec_Log$,LOG_TEXT$); aEclipseData'setType(aEclipseData'STRING_TYPE); _pvxState'addArgument(aEclipseData)
4870 ! Restore system parameters
4880 set_param 'LC'=SAV_LC,'LE'=SAV_LE,'MC'=SAV_MC,'NN'=SAV_NN,'PZ'=SAV_PZ,'SS'=SAV_SS,'UL'=SAV_UL,'XT'=SAV_XT
4910 exit 
4930 BUILD_ERROR:
4940 ! Restore Errorhandler
4950 if not(nul(cErrorHandler$)) then {
4960 error_handler cErrorHandler$
4970 cErrorHandler$=""
4980  }
5010 if wpop=1 then print 'pop', end_if 
5020 print 'CS',
5040 switch catchError
5050 case 0
5060 break
5070 default 
5080 err_data$[catchError,0]="1" ! flag as an ERROR
5090 err_data$[catchError,1]="0"
5100 break
5110 end switch 
5130 if SAVE_AS_TEXT$="1" and not(nul(DESTINATION$)) then erase DESTINATION$,err=*next
5160 goto Build_Done
5180 ! ========================================================================
5190 ! Functions that are local to this program
5200 ! 
5210 def fnTailofName$(local _filenm$, local _len)
5220 local _tailnm$
5240 tailnm$=tbl(len(_filenm$)>_len,_filenm$,"..."+mid(filenm$,pos(dlm=mid(filenm$,-_len))+len(filenm$)-_len))
5260 return tailnm$
5270 end def
5290 end 
