      SUBROUTINE PLW.BLD.FILE(FNAME,ID,R.ERR)
*PIC-LAN
*
*ALL
*PC
*N
*
*
*
*
      INCLUDE SYS.TYPE.INCLUDE
*
      INCLUDE PL.COMMON
      INCLUDE PL.COMMON.DEFS
      INCLUDE PL.DEFS
      INCLUDE PLIP.COMMON
      INCLUDE PLW.COMMON
*
      DIM SRC.ARRAY(1000)
      DIM CTRL.ARRAY(10)
      DIM DATA.ARRAY(10)
*
      IF DATA$TP = 'FILE' THEN
         LOCATE(FNAME,PL$FILE.LIST;N) ELSE
            R.ERR = '404 NOT FOUND [PLW.BLD.FILE:1];Directory not found.  [PLW.BLD.FILE:1:' : FNAME : ']'
            RETURN
         END
         READ SRC FROM F$ARRAY(N) , ID ELSE
            R.ERR = '404 NOT FOUND [PLW.BLD.FILE:2];File not found.  [PLW.BLD.FILE:2:' : FNAME : '!' : ID : ']'
            RETURN
         END
         PL_WRITEFIX SRC ON PL$PGCACHE.FD , PL$PGNAME
      END ELSE
         READ SRC FROM PL$STATE.FD , PL$V.PORT.NO : '*IMPORT' ELSE
            R.ERR = '404 NOT FOUND [PLW.BLD.FILE:3];File not found after import.  [PLW.BLD.FILE:3]'
            RETURN
         END
         DELETE PL$STATE.FD , PL$V.PORT.NO : '*IMPORT'
      END
      TM = PL_NOW() - PLIP$TZ
      TMS = PL_TODATE(TM)
*
      MAT CTRL$ARRAY = ''
      CTRL$TM = TM
      CTRL$TMS = TMS
*
      SRC0 = SRC
*
      FILE.TP = OCONV(FIELD(ID,'.',DCOUNT(ID,'.')),'MCU')
*
      READ F.TP FROM PL$CTRL.FD , 'MIME*' : FILE.TP ELSE
         READ F.TP FROM PL$CTRL.FD , 'MIME*' ELSE
            R.ERR = '501 NOT IMPLMENTED [PLW.BLD.FILE:4];Not Implemented, the file type is not supported.  [PLW.BLD.FILE:4]'
            RETURN
         END
      END
*
      BEGIN CASE
         CASE F.TP<2> = 'AM'
            IF SRC[LEN(SRC),1] <> AM THEN SRC = SRC : AM
            GOSUB 200
            T = INDEX(SRC,'</HEAD>',1)
            IF NOT(T) THEN T = INDEX(SRC,'</head>',1)
            IF T THEN
               SRC = SRC[1,T-1] : '<!-- Coyote Web Server - PicLan-IP SN ' : PLIP$PICLANIPSN : ' - ' : SYS.TYPE : ' -->' : CRLF : SRC[T,BIG.STR]
            END
            IF R.ERR <> '' THEN RETURN
            CTRL$MIME = F.TP<1>
            CTRL$HEXFLG = NO
         CASE F.TP<2> = 'HEX'
            CTRL$TP = 1
            CTRL$MIME = F.TP<1>
            CTRL$HEXFLG = YES
         CASE YES
            R.ERR = '500 INTERNAL ERROR [PLW.BLD.FILE:5];Invalid MIME type coding.  [PLW.BLD.FILE:5]'
            RETURN
      END CASE
*
      IF CTRL$TP = 1 THEN
         IF CTRL$HEXFLG THEN
            CALL PLW.BLD.HTTP.HDR(1,'200 OK',1,CTRL$MIME,CTRL$TMS,LEN(SRC)/2,LL,'')
            CTRL$HDR = LL
         END ELSE
            CALL PLW.BLD.HTTP.HDR(1,'200 OK',1,CTRL$MIME,CTRL$TMS,LEN(SRC),LL,'')
            CTRL$HDR = LL
         END
         CALL PLW.BLD.HTTP.HDR(1,'304 NOT MODIFIED',1,'','','',LL,'')
         IF CTRL$HEXFLG THEN
            CTRL$NMHDR = LL
         END ELSE
            CTRL$NMHDR = LL
         END
      END
      WRITE SRC ON PL$PGDATA.FD , PL$PGNAME
      CTRL$CACHETM = PR$NOW
      MATWRITE CTRL$ARRAY ON PL$PGCTRL.FD , PL$PGNAME
*
      IF CTRL$SUB <> '' THEN
         WRITEV PL$PGNAME ON PL$BASXREF.FD , CTRL$SUB , 1
      END
*
      R.ERR = ''
*
      RETURN
*
200   REM Scan for embedded BASIC code
*
      IF FILE.TP = 'HTM' OR FILE.TP = 'HTML' THEN
         IF NOT(INDEX(DATA$OPT,'X',1)) THEN
            CALL PLW.CRUNCH.HTML(SRC:'',SRC)
         END
      END
*
      IF INDEX(DATA$OPT,'B',1) THEN
         CTRL$TP = 1
         SRC = PL_AMTOCRLF(SRC)
         RETURN
      END
*
      MAT DATA.ARRAY = MAT DATA$ARRAY
      GOSUB 300
      MAT DATA$ARRAY = MAT DATA.ARRAY
      IF R.ERR <> '' THEN RETURN
*
      FLG = NO
      T = 1
      LOOP UNTIL FLG DO
         T1 = INDEX(SRC[T,BIG.STR],'PicLan-IP/BASIC',1)
         IF NOT(T1) THEN
            CTRL$TP = 1
            SRC = PL_AMTOCRLF(SRC)
            RETURN
         END
         T = T1 + T - 1
         IF SRC[T-1,1] <> '~' THEN
            L = (SRC[T,BIG.STR])<1>
            STR1 = FIELD(L,' ',2)
            STR2 = FIELD(L,' ',3)
            FLG = YES
         END ELSE
            SRC = SRC[1,T-2] : SRC[T,BIG.STR]
            T = T + 5
         END
      REPEAT
*
      B.SRC = SRC[T,BIG.STR]
      T2 = INDEX(B.SRC,'</PRE>',1)
      IF NOT(T2) THEN T2 = INDEX(B.SRC,'</pre>',1)
      IF NOT(T2) THEN
         R.ERR = '500 INTERNAL ERROR;Embedded BASIC code is not a part of a PREFORMATTED paragraph'
         RETURN
      END
      SRC = SRC[1,T-1] : B.SRC[T2,BIG.STR]
      B.SRC = B.SRC[1,T2-1]
      B.SRC = DELETE(B.SRC,1,0,0)
*
      AM.LST = '<BR>' : @VM : '<br>'
      FOR I = 1 TO DCOUNT(AM.LST,VM)
         LOOP
            T = INDEX(B.SRC,AM.LST<1,I>,1)
         WHILE T DO
            IF T = 1 THEN
               B.SRC = AM : B.SRC[LEN(AM.LST<1,I>)+1,BIG.STR]
            END ELSE
               B.SRC = B.SRC[1,T-1] : AM : B.SRC[T+LEN(AM.LST<1,I>),BIG.STR]
            END
         REPEAT
      NEXT I
*
      MAT SRC.ARRAY = ''
      SRC.CNT = 1
*
      V.LST = ''
*
      TP = 'SRC'
      LOOP
         IF TP = 'SRC' THEN
            T = INDEX(SRC,STR1,1)
         END ELSE
            T = INDEX(SRC,STR2,1)
         END
      WHILE T DO
         BEGIN CASE
            CASE TP = 'SRC'
               IF T > 1 THEN
                  SRC.ARRAY(SRC.CNT) = SRC.ARRAY(SRC.CNT) : SRC[1,T-1]
               END
               SRC = SRC[T+1,BIG.STR]
               IF SRC[1,1] = STR1 THEN
                  SRC.ARRAY(SRC.CNT) = SRC.ARRAY(SRC.CNT) : SRC[1,1]
                  SRC = SRC[2,BIG.STR]
               END ELSE
                  TP = 'VAR'
               END
            CASE TP = 'VAR'
               IF T > 1 THEN
                  S = PL_UNQUOTE(SRC[1,T-1])
                  IF OCONV(S[1,4],'MCU') = 'RAW(' AND S[LEN(S),1] = ')' THEN
                     V.LST<-1> = S[5,LEN(S)-5]
                  END ELSE
                     V.LST<-1> = 'PL_QUOTE(' : S : ')'
                  END
                  SRC.CNT = SRC.CNT + 1
               END
               SRC = SRC[T+1,BIG.STR]
               TP = 'SRC'
         END CASE
      REPEAT
      SRC.ARRAY(SRC.CNT) = SRC.ARRAY(SRC.CNT) : SRC
*
      IF TP <> 'SRC' THEN
         R.ERR = '500 INTERNAL ERROR [PLW.BLD.FILE:6];Internal Error, HTML In-Line BASIC error.  [PLW.BLD.FILE:6]'
         RETURN
      END
*
      FOR I = DCOUNT(B.SRC,AM) TO 1 STEP -1
         IF TRIM(B.SRC<I>) = '' THEN
            B.SRC = DELETE(B.SRC,I,0,0)
         END
      NEXT I
*
      B.SRC = PL_UNQUOTE(B.SRC)
*
      B.SRC<-1> = '*'
*
      FOR I = 1 TO SRC.CNT - 1
         B.SRC<-1> = 'SD$(' : I : ') = ' : V.LST<I>
      NEXT I
*
      B.SRC<-1> = 'RESX = '
      FOR I = 1 TO SRC.CNT - 1
         B.SRC = B.SRC : 'SA$(' : I : '):SD$(' : I : ')'
         IF MOD(I,25) THEN
            B.SRC = B.SRC : ':'
         END ELSE
            B.SRC<-1> = 'RESX = RESX : '
         END
      NEXT I
      B.SRC = B.SRC : 'SA$(' : SRC.CNT : ')'
*
      READ B FROM PL$CTRL.FD , 'GEN.SUB' ELSE CALL PLXX.STOP(202,'GEN.SUB')
*
      B = PL_REPL(B,'###SRC.CNT###',SRC.CNT)
      B = PL_REPL(B,'###CODE###',B.SRC)
*
      PL_READVU SUB.NUMBER FROM PL$CTRL.FD , 'WEB.SUB.ID' , 1 ELSE SUB.NUMBER = 0
      WRITEV SUB.NUMBER + 1 ON PL$CTRL.FD , 'WEB.SUB.ID' , 1
*
      CTRL$SUB = 'WEB$' : SUB.NUMBER 'R%8'
*
      B = PL_REPL(B,'###SUB.NAME###',CTRL$SUB)
*
      WRITE B ON PL$PGBASIC.FD , CTRL$SUB
*$*   PL_PRINT ''
*$*   PL_PRSTATE 'Compiling user subroutine ' : CTRL$SUB
      PL_PR ' Comp->' : CTRL$SUB : ' '
*$*   PL_PR 'Compiling ' : CTRL$SUB : ' '
*
      OPEN 'DICT WWW.CTRL' TO TEMP.FD THEN
         DELETE TEMP.FD , CTRL$SUB
      END
*
      OPEN 'VOC' TO TEMP.FD THEN
         DELETE TEMP.FD , CTRL$SUB
      END
*
      S = 'PC WWW.CTRL,PGBASIC ' : CTRL$SUB
      OPTS = ''
      IF INDEX(DATA$OPT,'V',1) THEN OPTS = OPTS : 'V'
      IF INDEX(DATA$OPT,'R',1) THEN OPTS = OPTS : 'R'
      IF OPTS <> '' THEN
         S = S : ' =' : OPTS
      END
      EXECUTE S CAPTURING SSTR
*
      IF INDEX(SSTR,'no errors',1) THEN
         FOR I = 1 TO DCOUNT(SSTR,AM)
            IF INDEX(SSTR<I>,'0 error',1) THEN
*$*            PL_PRINT SSTR<I>
            END
         NEXT I
      END ELSE
         PL_PRINT ''
         PL_PRINT SSTR
         R.ERR = '500 INTERNAL ERROR;Error compiling embedded BASIC.'
         R.ERR = R.ERR : CRLF
         READ X FROM PL$WORK.FD , 'PC*' : PORT.NO THEN
            SSTR = X
            DELETE PL$WORK.FD , 'PC*' : PORT.NO
         END
         I1 = DCOUNT(SSTR,AM)
         FOR I = 1 TO I1
            R.ERR = R.ERR : CRLF : SSTR<I>
         NEXT I
      END
      PL_EXECUTE 'CATALOG WWW.CTRL,PGBASIC ' : CTRL$SUB CAPTURING DUMMY
*
      SRC.ARRAY(SRC.CNT) = SRC.ARRAY(SRC.CNT) : AM
      SRC = ''
      FOR I = 1 TO SRC.CNT
         SRC<I> = PL_AMTOCRLF(SRC.ARRAY(I))
      NEXT I
*
      CTRL$TP = 2
*
      RETURN
*
300   REM Process server-side includes
*
      T = INDEX(ID,'/',COUNT(ID,'/'))
      IF T THEN
         FROOT = ID[1,T]
      END ELSE
         FROOT = ''
      END
*
      SRC1 = ''
      LOOP
         GOSUB 310
      WHILE T DO REPEAT
*
      SRC = SRC1
      SRC1 = ''
*
      RESX = ''
*
      RETURN
*
310   REM 
*
      T = INDEX(SRC,'{INCLUDE',1)
*
      IF NOT(T) THEN
         SRC1 = SRC1 : SRC
         SRC = ''
         RETURN
      END
*
      IF T > 1 THEN
         IF SRC[T-1,1] = '{' THEN
            SRC1 = SRC1 : SRC[1,T-1] : SRC[T+1,7]
            SRC = SRC[T+8,BIG.STR]
            RETURN
         END
         SRC1 = SRC1 : SRC[1,T-1]
      END
*
      SRC = SRC[T+8,BIG.STR]
      INAME = FIELD(SRC,'}',1)
      INAME = TRIM(PL_REPL(INAME,AM,' '))
      IF INAME[1,1] <> '/' THEN
         INAME = FROOT : INAME
      END
      T = INDEX(SRC,'}',1)
      SRC = SRC[T+1,BIG.STR]
*
      PL_GETVAR X FROM 'SRC' ELSE X = ''
      IF X <> '' THEN
         X = ID : AM : X
      END ELSE
         X = ID
      END
      PL_PUTVAR X IN 'SRC' ELSE NULL
*
      PGNAME = PL$PGNAME
      MAT CTRL.ARRAY = MAT CTRL$ARRAY
*
      IF INAME[1,1] <> '/' THEN
         T = COUNT(PL$PGNAME,'/')
         IF T > 1 THEN
            INAME = '/' : OCONV(PL$PGNAME,'G1/':(T-1)) : '/' : INAME
         END ELSE
            INAME = '/' : INAME
         END
      END
      IF INAME[LEN(INAME),1] = '/' THEN INAME = INAME : 'INDEX.HTM'
      DELETE PL$PGCACHE.FD , ST$IP : INAME
*
      CALL PLW.PAGE(INAME,'',R.ERR)
      PL$PBHDR = ''
      SRC2 = RESX
*
      MAT CTRL$ARRAY = MAT CTRL.ARRAY
      PL$PGNAME = PGNAME
*
      PL_GETVAR X FROM 'SRC' ELSE X = ''
      PL_PUTVAR DELETE(X,1,0,0) IN 'SRC' ELSE NULL
*
      IF R.ERR <> '' THEN RETURN
      IF SRC2 <> '' THEN
         TT = INDEX(SRC2,'<BODY',1)
         IF NOT(TT) THEN TT = INDEX(SRC2,'<body',1)
         IF NOT(TT) THEN RETURN
         SRC2 = SRC2[TT,BIG.STR]
         TT = INDEX(SRC2,'>',1)
         IF NOT(TT) THEN RETURN
         SRC2 = SRC2[TT+1,BIG.STR]
         IF SRC2[1,1] = AM THEN SRC2 = SRC2[2,BIG.STR]
         TT = INDEX(SRC2,'</BODY',1)
         IF NOT(TT) THEN TT = INDEX(SRC2,'</body',1)
         IF NOT(TT) THEN RETURN
         SRC2 = SRC2[1,TT-1]
         SRC = SRC2 : SRC
      END
*
      RETURN
   END
