🚀 go-pugleaf

Submitted-by: munroe@dmc.com (Dick Munroe)
Posting-number: Volume 3, Issue 121
Archive-name: organize_ftpmail/patch2_01
Patch-to: organize_ftpmail: Volume 3, Issue 101,106

This is a patch to ORGANIZE-FTPMAIL V1.0 to add functionality for
organizing information retrieved from MAILSERV@ualr.edu (where I 
managed to find a public domain BBS for VMS).
-- 
Dick Munroe				Internet: munroe@dmc.com
Doyle Munroe Consultants, Inc.		UUCP: ...uunet!thehulk!munroe
267 Cox St.				Office: (508) 568-1618
Hudson, Ma.				FAX: (508) 562-1133

GET CONNECTED!!! Send mail to info@dmc.com to find out about DMConnection.

$! ------------------ CUT HERE -----------------------
$ v='f$verify(f$trnlnm("SHARE_VERIFY"))'
$!
$! This archive created by VMS_SHARE Version 7.2-010  25-Jun-1992
$!   On  8-AUG-1992 20:47:06.71   By user MUNROE 
$!
$! This VMS_SHARE Written by:
$!    Andy Harper, Kings College London UK
$!
$! Acknowledgements to:
$!    James Gray       - Original VMS_SHARE
$!    Michael Bednarek - Original Concept and implementation
$!
$! TO UNPACK THIS SHARE FILE, CONCATENATE ALL PARTS IN ORDER
$! AND EXECUTE AS A COMMAND PROCEDURE  (  @name  )
$!
$! THE FOLLOWING FILE(S) WILL BE CREATED AFTER UNPACKING:
$!       1. AAAREADME-V1-2.1ST;2
$!       2. UTL-ORGANIZEFTPMAIL.PATCH02;1
$!
$set="set"
$set symbol/scope=(nolocal,noglobal)
$f=f$parse("SHARE_TEMP","SYS$SCRATCH:.TMP_"+f$getjpi("","PID"))
$e="write sys$error  ""%UNPACK"", "
$w="write sys$output ""%UNPACK"", "
$ if f$trnlnm("SHARE_LOG") then $ w = "!"
$ ve=f$getsyi("version")
$ if ve-f$extract(0,1,ve) .ges. "4.4" then $ goto START
$ e "-E-OLDVER, Must run at least VMS 4.4"
$ v=f$verify(v)
$ exit 44
$UNPACK: SUBROUTINE ! P1=filename, P2=checksum
$ x = P1 - f$parse(P1,,,"version")
$ y = f$search(x)
$ if y .eqs. "" then $ goto file_absent
$ x = f$integer(f$parse(P1,,,"version")-";")
$ y = f$integer(f$parse(y,,,"version")-";")
$ if x .gt. y then $ goto file_absent
$ if f$mode() .eqs. "INTERACTIVE" then $ goto file_interactive
$ if x .eq. y then e "-W-EXISTS, File ''P1' exists. Skipped."
$ if x .ne. y then e "-W-NEWERVERSION, of File ''P1' exists. Skipped."
$file_delete:
$ delete 'f'*
$ exit
$file_interactive:
$ if x .eq. y then e "-W-EXISTS, File ''P1' exists."
$ if x .ne. y then e "-W-NEWERVERSION, of File ''P1' exists."
$ read/error=file_delete/end=file_delete-
  /prompt="Create new version [y/n]: " -
  sys$command x
$ if .not. x then $ e "-W-SKIPPED, File ''P1' skipped."
$ if .not. x then $ goto file_delete
$ P1 = P1 - f$parse(P1,,,"version")
$file_absent:
$ if f$parse(P1) .nes. "" then $ goto dirok
$ dn=f$parse(P1,,,"DIRECTORY")
$ w "-I-CREDIR, Creating directory ''dn'."
$ create/dir 'dn'
$ if $status then $ goto dirok
$ e "-E-CREDIRFAIL, Unable to create ''dn'. File skipped."
$ delete 'f'*
$ exit
$dirok:
$ w "-I-PROCESS, Processing file ''P1'."
$ if .not. f$verify() then $ define/user sys$output nl:
$ EDIT/TPU/NOSEC/NODIS/COM=SYS$INPUT 'f'/OUT='P1'
PROCEDURE Unpacker ON_ERROR ENDON_ERROR;SET(FACILITY_NAME,"UNPACK");SET(
SUCCESS,OFF);SET(INFORMATIONAL,OFF);f:=GET_INFO(COMMAND_LINE,"file_name");b:=
CREATE_BUFFER(f,f);p:=SPAN(" ")@r&LINE_END;POSITION(BEGINNING_OF(b));
LOOP EXITIF SEARCH(p,FORWARD)=0;POSITION(r);ERASE(r);ENDLOOP;POSITION(
BEGINNING_OF(b));g:=0;LOOP EXITIF MARK(NONE)=END_OF(b);x:=ERASE_CHARACTER(1);
IF g=0 THEN IF x="X" THEN MOVE_VERTICAL(1);ENDIF;IF x="V" THEN APPEND_LINE;
MOVE_HORIZONTAL(-CURRENT_OFFSET);MOVE_VERTICAL(1);ENDIF;IF x="+" THEN g:=1;
ERASE_LINE;ENDIF;ELSE IF x="-" THEN IF INDEX(CURRENT_LINE,"+-+-+-+-+-+-+-+")=
1 THEN g:=0;ENDIF;ENDIF;ERASE_LINE;ENDIF;ENDLOOP;t:="0123456789ABCDEF";
POSITION(BEGINNING_OF(b));LOOP r:=SEARCH("`",FORWARD);EXITIF r=0;POSITION(r);
ERASE(r);x1:=INDEX(t,ERASE_CHARACTER(1))-1;x2:=INDEX(t,ERASE_CHARACTER(1))-1;
COPY_TEXT(ASCII(16*x1+x2));ENDLOOP;WRITE_FILE(b,GET_INFO(COMMAND_LINE,
"output_file"));ENDPROCEDURE;Unpacker;QUIT;
$ delete/nolog 'f'*
$ CHECKSUM 'P1'
$ IF CHECKSUM$CHECKSUM .eqs. P2 THEN $ EXIT
$ e "-E-CHKSMFAIL, Checksum of ''P1' failed."
$ ENDSUBROUTINE
$START:
$ create 'f'
XThis is a patch to ORGANIZE-FTPMAIL V1.0 to add functionality for
Xorganizing information retrieved from MAILSERV@ualr.edu (where I managed
Xto find a public domain BBS for VMS).
X
XThis assumes that you have applied all prior patches.
X
XApply it using PATCH (NOT the VMS PATCH utility, but the one that
Xcomes with DECUS UUCP.  I believe it's available from CERRITOS or
XWKUVX1.BITNET) as follows:
X
X1. Move to the directory containtaining ORGANIZE-FTPMAIL V1.1
X2. Rename the original source for ORGANIZE-FTPMAIL to be
XUTL-ORGANIZEFTPMAIL.TPU
X3. Apply the patch:
X
X        PATCH <UTL-ORGANIZEFTPMAIL.DIFF
X
X4. You should have V1.2 of ORGANIZE-FTPMAIL.
X5. Install the new version as per the original instructions.
X
XIf you have any problems, please let me know.
X
XDick Munroe
XDoyle, Munroe Consultants, Inc.
X267 Cox St.
XHudson, Ma. 01749
X(508) 568-1618
X(FAX) (508) 562-1133
Xmunroe@dmc.com
$ CALL UNPACK AAAREADME-V1-2.1ST;2 1936937327
$ create 'f'
X*** `5B-.ref-lib`5Dutl-organizeftpmail.tpu
X--- utl-organizeftpmail.tpu
X**************
X*** 12,18
X  ! information is retained.  Use of this code for profit is forbidden witho
Vut the
X  ! express permission of the author.
X  !
X! ! OrganizeFTPMAIL V1.1
X  !
X  ! Not being blessed with a direct internet connection, I get all of my lar
Vge
X  ! file transactions through direct interactions with mail servers or indir
Vect
X--- 12,18 -----
X  ! information is retained.  Use of this code for profit is forbidden witho
Vut the
X  ! express permission of the author.
X  !
X! ! OrganizeFTPMAIL V1.2
X  !
X  ! Not being blessed with a direct internet connection, I get all of my lar
Vge
X  ! file transactions through direct interactions with mail servers or indir
Vect
X**************
X*** 67,72
X  !       property of PDMF mail servers.  For now I'll assume its a property
X  !       only of MRCSERV and generalize it later.
X  !
X  !--
X `20
X  procedure rchm_organizeFTPMAIL
X--- 67,80 -----
X  !       property of PDMF mail servers.  For now I'll assume its a property
X  !       only of MRCSERV and generalize it later.
X  !
X+ !   0.002 Dick Munroe 08-Aug-92
X+ !       And another one's been added, mailserv-reply@ualr.edu.  This one`2
V0
X+ !       puts out subject lines of the form:
X+ !
X+ !           Re: SEND `5Bdirectory`5Dname.ext
X+ !
X+ !       Where ext is SHARE_n and n varies from 1..n.  Make n 3 digits in
X+ !       length before performing the subject extraction and sorting.
X  !--
X `20
X  procedure rchm_organizeFTPMAIL
X**************
X*** 90,96
X          xxxM,                                           ! Contains miscell
Vaneous mark variables.
X          xxxR,                                           ! Contains miscell
Vaneous range variables.
X          xxxS,
X!         yyyI
X          ;
X `20
X      subjectArrayS := create_array(100,0) ;              ! All arrays start
V with 100 elements and are indexed with 0.
X--- 98,105 -----
X          xxxM,                                           ! Contains miscell
Vaneous mark variables.
X          xxxR,                                           ! Contains miscell
Vaneous range variables.
X          xxxS,
X!         yyyI,
X!         yyyR
X          ;
X `20
X      subjectArrayS := create_array(100,0) ;              ! All arrays start
V with 100 elements and are indexed with 0.
X**************
X*** 105,111
X      ! Set the server type.
X      !--
X `20
X!     xxxR := search_quietly(line_begin + "Return-Path:" + span(" `09") + "<
VMRCSERV@mtroyal.ab.ca>", forward, no_exact) ;
X      if xxxR <> 0
X      then
X          serverTypeI := 1 ;                              ! This collection
V of messages came from Mt Royal College.
X--- 114,122 -----
X      ! Set the server type.
X      !--
X `20
X!     xxxR := search_quietly(line_begin + "Subject:", forward, no_exact) ;
X!     position(beginning_of(xxxR)) ;
X!     xxxR := search_quietly(line_begin + "Return-Path:" + span(" `09") + "<
VMRCSERV@mtroyal.ab.ca>", reverse, no_exact) ;
X      if xxxR <> 0
X      then
X          serverTypeI := 1 ;                              ! This collection
V of messages came from Mt Royal College.
X**************
X*** 110,115
X      then
X          serverTypeI := 1 ;                              ! This collection
V of messages came from Mt Royal College.
X      endif ;
X `20
X      !++
X      ! Check to see if this message came from MRCSERV@mtroyal.ab.ca and if
V it
X--- 121,132 -----
X      then
X          serverTypeI := 1 ;                              ! This collection
V of messages came from Mt Royal College.
X      endif ;
X+     xxxR := search_quietly(line_begin + "Return-Path:" + span(" `09") + "<
Vmailserv-reply@ualr.edu>", reverse, no_exact) ;
X+     if xxxR <> 0
X+     then
X+         serverTypeI := 2 ;                              ! This collection
V of messages came from University of Arkansas at Little
X+                                                         ! Rock.
X+     endif ;
X `20
X      !++
X      ! Check to see if this message came from MRCSERV@mtroyal.ab.ca and if
V it
X**************
X*** 142,147
X                  position(beginning_of(partNR)) ;
X                  loop
X                      exitif xxxI = xxx1I ;
X                      copy_text("0") ;
X                      xxxi := xxxi + 1 ;
X                  endloop ;
X--- 159,202 -----
X                  position(beginning_of(partNR)) ;
X                  loop
X                      exitif xxxI = xxx1I ;
X+                     copy_text("0") ;
X+                     xxxi := xxxi + 1 ;
X+                 endloop ;
X+             endif ;
X+             position(end_of(xxxR)) ;
X+             move_horizontal(1) ;
X+         endloop ;
X+         set(modified,current_buffer,off) ;
X+     endif ;   `20
X+`20
X+     if serverTypeI = 2
X+     then
X+         message("Fixing mailserv-reply@ualr.edu message headers") ;
X+         loop
X+             xxxR :=
X+                 search_quietly (
X+                     line_begin +`20
X+                     "Subject:" +`20
X+                     span(" `09") +`20
X+                     "Re: " +
X+                     remain,
X+                     forward,`20
X+                     no_exact) ;
X+             exitif xxxR = 0 ;
X+`20
X+             partNR := 0 ;
X+             search_quietly (
X+                 ".share_" +
X+                 (span("0123456789") @ partNR),
X+                 forward,
X+                 no_exact,
X+                 xxxR) ;
X+             xxxI := length(str(partNR)) ;
X+             if xxxI < 3
X+             then
X+                 position(beginning_of(partNR)) ;
X+                 loop
X+                     exitif xxxI = 3 ;
X                      copy_text("0") ;
X                      xxxi := xxxi + 1 ;
X                  endloop ;
$ CALL UNPACK UTL-ORGANIZEFTPMAIL.PATCH02;1 1867933198
$ v=f$verify(v)
$ EXIT