R LINEND X'30'
UTABLE LNTBL 300
* --------------------------------------------------------------- *
* Upload a file from the client machine to a Model 204 procedure. *
*                                                                 *
* Changes necessary to make this proc work at your site:          *
*                                                                 *
*  1. Uncomment the call to $Web_Proc_Recv.                       *
*  2. Substitute these two includes:                              *
*                                                                 *
*        In JANWEB Include WEB/TEMPLATE_TOP                       *
*        In JANWEB Include WEB/TEMPLATE_BOTTOM                    *
*                                                                 *
*     with calls to your own html page "start" and "end" procs.   *
*                                                                 *
* --------------------------------------------------------------- *

Begin

       %dt          is Float          Common
       %i           is Float
       %j           is Float
       %rc          is Float          Common

       %fBin        is String len   3 Common
       %fBinChecked is String len   7 Common
       %FGName      is String len  30 Common
       %Format      is String len  10 Common
       %Method      is String len  10 Common
       %Password    is String len   8 Common
       %Prefix      is String len 255 Common
       %Proc        is String len 255 Common
       %Source      is String len 255 Common
       %Suffix      is String len   6 Common
       %Type        is String len  30 Common

* Web session setup.

       %dt     = $Web_Date + (30 * 24 * 60 * 60)
       %rc     = $Web_On
       %rc     = $Web_Type('TEXT/HTML')
       %rc     = $Web_Sub('@@')
       %rc     = $Web_Expire(-1)
       %rc     = $Web_Response('PRAGMA', 'NO-CACHE')

* If form was "posted" capture the input and reset cookie.

       %Method = $UpCase($Web_Hdr_Parm('METHOD'))

       If %Method eq 'POST' Then
          %Type     = $UpCase($Web_Form_Parm('type'))
          %FGName   = $UpCase($Web_Form_Parm('fgname'))
          %Password = $UpCase($Web_Form_Parm('password'))
          %Prefix   = $UpCase($Web_Form_Parm('prefix'))
          %Source   = $UpCase($Web_Form_Parm('source'))
          %fBin     = $UpCase($Web_Form_Parm('fbin'))
          %rc       = $Web_Set_Cookie('TYPE',   %Type,   %dt )
          %rc       = $Web_Set_Cookie('FGName', %FGName, %dt )
          %rc       = $Web_Set_Cookie('PREFIX', %Prefix, %dt )
          %rc       = $Web_Set_Cookie('SOURCE', %Source, %dt )
          %rc       = $Web_Set_Cookie('FBIN',   %fBin,   %dt )

* Else (form method is "get") see if we can populate form from cookie.

       Else
          %Type     = $Web_Cookie_Parm('TYPE')
          %FGName   = $Web_Cookie_Parm('FGName')
          %Prefix   = $Web_Cookie_Parm('PREFIX')
          %Source   = $Web_Cookie_Parm('SOURCE')
          %fBin     = $Web_Cookie_Parm('FBIN')
       End If

* Create a procedure name.

       %Proc   = $Reverse($Parse($Reverse(%Source),'/\'))
       %Proc   = %Prefix with %Proc

* Store the procedure in BASE64 format unless it's text, html or java.

       %Suffix = $ParseX(%Proc,'.')
       %Format = 'BASE64'
       If %fBin eq 'ON' Then
          %fBinChecked = 'checked'
       Else
          %fBinChecked = ''
          If $OneOf(%Suffix, -
'TXT/HTML/HTM/JAVA/JAV/RTF/CSV/DIF/EPS/INC/PL/DB/CGI/CSS/XML/DTD/UL/XSL','/') Then
             %Format = 'TEXT'
          End If
       End If

* Start the page.

       %rc = $SetG('TITLE','Upload a Procedure to Model 204')
       %rc = $SetG('SUBHEAD','<i><h3>Upload Procedure to ' with -
             $View('JOBNM') with '</h2></i>')

       In JANWEB Include WEB/TEMPLATE_TOP

       Html
          <form name="upload"
              method="post"
             enctype="multipart/form-data"
              action="{$Web_HDR_PARM('URL')}">
            <center>
            <table>
              <tr><td colspan=2>
                Upload a file from your local machine to a procedure in Model 204.
                <hr>
             </td></tr>
             <tr><td>Source file:</td>
             <td><input type="file" name="source" value="{%Source}"></td></tr>
             <tr><td>Load to:</td>
             <td><select name="type">
       End Html

       If %Type eq 'GROUP' Then
          PRINT '              <option>File</option>'
          PRINT '              <option selected>Group</option>'
       Else
          PRINT '              <option>File</option>'
          PRINT '              <option>Group</option>'
       End If

       Html
            </select>
            <input type="text" name="fgname" value="{%FGName}"></td></tr>
          <tr><td></td></tr>
          <tr><td>Password:</td><td>
            <input type="password" name="password" value="{%Password}"></td</tr>
          </tr><tr><td>
            Destination procedure prefix:</td><td>
            <input type="text" name="prefix" value="{%Prefix}"></td></tr>
          </tr><tr><td>
            Force binary upload:</td><td>
            <input type="checkbox" name="fbin" value="on" {%fBinChecked}></td></tr>
          <tr><td></td><td>
            <input type="submit" value="Upload" width=30>
          </td></tr>
       </table>
       </center>
       </form>
       <br><hr>

       <p><a href="/plaintext/demo_form_upload">See the code</a> for this demo.</p>

       End Html

       If $Web_Hdr_Parm('METHOD') eq 'POST' Then
          Call OpenFile(%rc, %Type, %FGName, 0210)
          %FGName = %Type with ' ' with %FGName
*         %rc     = $Web_Proc_Recv(%FGName, %Proc, 'source',, %Format)

          If %rc Then
             Print 'SUCCESS!  The procedure ' with %Proc with -
                   ' was saved in ' with %FGName
          Else
             Print 'No go.  The procedure ' with %Proc with -
                   ' was not saved in ' with %FGName with '. That''s because we intentionallly' with -
                   ' disabled the $Web_Proc_Recv function in the demo.  You can make it work' with -
                   ' at your own site by un-commenting this function call.'
          End If
       End If

       Html
       <table cellpadding="0" cellspacing="0" border="0" width="200" height="300">
         <tr><td>&nbsp;</td></tr>
       </table>
       End Html

* Close out the page with the standard footer.

FormDone:
       In JANWEB Include WEB/TEMPLATE_BOTTOM

* End of mainline routine.

Subroutine OpenFile( %Status is Float Output,                  -
                     %iType  is String len 5,                  -
                     %iName  is String len 8,                  -
                     %Priv   is Fixed)

       %Context       is String len  20
       %CurPriv       is Fixed
       %dt            is Float          Common
       %FGName        is String len  30 Common
       %Format        is String len  10 Common
       %ItsOpen       is Fixed
       %Msg           is String len 255
       %Name          is String len   8
       %Password      is String len   8 Common
       %Prefix        is String len 255 Common
       %Proc          is String len 255 Common
       %Source        is String len 255 Common
       %Suffix        is String len   6 Common
       %Type          is String len  30 Common
       %rc            is Float

       %Type           = %iType
       %Name           = %iName
       If %Type eq '' Then
          %Type = 'FILE'
       End If

CHK:   If %Type eq 'GROUP' Then
          %Context = 'PERM GROUP ' with %Name
       Else
          %Context = 'FILE ' with %Name
       End If

       %rc = $Web_Off

       %ItsOpen = $Context(%Context)

       If %Password eq '' Then
          If Not %ItsOpen Then
             If %Type eq 'GROUP' Then
                OPENC PERM GROUP %Name
             Else
                OPENC FILE %Name
             End If
          End If
       Else
          If %Type eq 'GROUP' Then
             OPENC PERM GROUP %Name PASSWORD %Password
          Else
             OPENC FILE %Name PASSWORD %Password
          End If
       End If

       %rc = $Web_On

* See if user was given the requested access to the file/group

       %CurPriv          = $View('CURPRIV', %Context)
       %rc               = $ErrSet('')
       %rc               = $SetG('ERROR','')
       If $Status and Not %CurPriv Then
          %Msg = 'Couldn''t open the requested file.'
          Jump to ErrX
       End If

       If %Priv NE $BitAnd(%Priv, %CurPriv) Then
          %Msg = 'Insufficient file privileges to load procedure.  Required privileges: ' -
                 with %Priv with '. Current privileges: ' with %CurPriv
          Jump to ErrX
       End If

       %Status = 0
       Return

ErrX:  %rc = $Web_Flush
       %rc = $Web_Type('text/html')
       %rc = $Web_Set_Cookie('TYPE',   %Type,   ,, %dt )
       %rc = $Web_Set_Cookie('FGName', %FGName, ,, %dt )
       %rc = $Web_Set_Cookie('PREFIX', %Prefix, ,, %dt )
       %rc = $Web_Set_Cookie('SOURCE', %Source, ,, %dt )
       Html
       <html><head><title>System error</title></head>
       <body><h2>System error</h2>
       System terminated due to error.<br>
       Procedure causing error: SIRIUS/PROCLOAD
       Error message:<br>
       <xmp>
       {%Msg}
       </xmp>
       <p>Use your browser's "back" button to return to the form and try again.</p>
       </body></html>
       End Html
       %rc = $Web_Done
       Stop

End Subroutine OpenFile

END