perl 5.002_01: vms/fndvers.com

Read Perl version for ARCHLIB from patchlevel.h, and
update config.vms and descrip.mms if necessary

1 files changed, 95 insertions, 0 deletions

diff --git a/vms/fndvers.com b/vms/fndvers.com
new file mode 100644
index 0000000000..04a9d9991c
--- /dev/null
+++ b/vms/fndvers.com
@@ -0,0 +1,95 @@
+$! Brief DCL procedure to parse current Perl version out of
+$! patchlevel.h, and update the version token for ARCHLIB
+$! config.vms and descrip.mms if necessary.
+$ err = "Write Sys$Error"
+$
+$ If p1.eqs."" Then p1 = "patchlevel.h"
+$ If p2.eqs."" Then p2 = F$Parse("config.vms",p1,"[.vms]")
+$ If p3.eqs."" Then p3 = F$Parse("descrip.mms",p1,"[.vms]")
+$
+$ If F$Search(p1).eqs.""
+$ Then
+$   err "Can't find ''p1' - exiting"
+$   Exit 98962  ! RMS$_FNF
+$ EndIf
+$ plevel = ""
+$ sublevel = ""
+$ Open/Read patchlevel_h &p1
+$
+$ pread:
+$ Read/End_Of_File=pdone patchlevel_h line
+$ If F$Locate("#define PATCHLEVEL",line).ne.F$Length(line)
+$ Then
+$    plevel = F$Element(2," ",line)
+$    If F$Length(plevel).lt.3 Then -
+       plevel = F$Extract(0,3 - F$Length(plevel),"000") + plevel
+$ EndIf
+$ If F$Locate("#define SUBVERSION",line).ne.F$Length(line)
+$ Then
+$    sublevel = F$Element(2," ",line)
+$    If F$Length(sublevel).lt.2 Then -
+       sublevel = F$Extract(0,2 - F$Length(sublevel),"00") + sublevel
+$ EndIf
+$ If .not.(plevel.nes."" .and. sublevel.nes."") Then Goto pread
+$
+$ pdone:
+$ Close patchlevel_h
+$!
+$ If sublevel.eq.0 Then sublevel = ""
+$ perl_version = "5_" + plevel + sublevel
+$ If p2.eqs."#NOFILE#"
+$ Then
+$   Write Sys$Output "Perl version directory name is ""''perl_version'"""
+$   Exit
+$ EndIf
+$!
+$ token = """""""""''perl_version'"""""""""
+$ If sublevel.eqs."" Then token = token + "  "
+$ token = token + "  /**/"
+$ Call update_file "''p2'" "#  define _PVERS" "''token'"
+$ If .not.$Status Then Exit $Status
+$!
+$ token = "''perl_version'"
+$ If sublevel.eqs."" Then token = token + "  "
+$ token = token + "#"
+$ Call update_file "''p3'" "PERL_VERSION =" "''token'"
+$ If .not.$Status Then Exit $Status
+$ If $Status.eq.3
+$ Then
+$   cmd = "MM[SK]"
+$   If F$Locate("MMS",p3).eqs."" Then cmd = "make"
+$   err "The PERL_VERSION macro was out of date in the file"
+$   err "    ''p3'"
+$   err "The file has been corrected, but you must restart the build process"
+$   err "by reinvoking ''cmd' to incorporate the new value."
+$   Exit 44  ! SS$_ABORT
+$ EndIf
+$!
+$ update_file: Subroutine
+$
+$ If F$Search(p1).nes.""
+$ Then
+$   Search/Exact/Output=_NLA0: 'p1' "''p2' ''p3'"
+$   If $Status.eq.%X08D78053  ! SEARCH$_NOMATCHES
+$   Then
+$     Open/Read/Write/Error=done  file &p1
+$
+$     nextline:
+$     Read/End_of_File=done file line
+$     If F$Locate(p2,line).ne.F$Length(line)
+$     Then
+$       Write/Update file "''p2' ''p3'"
+$       Goto done
+$     EndIf
+$     Goto nextline
+$
+$     done:
+$     Close file
+$     Exit 3  ! Unused success status
+$   EndIf
+$   Exit 1  ! SS$_NORMAL
+$ Else
+$   err "Can't find ''p1'"
+$   Exit 98962  ! RMS$_FNF
+$ EndIf
+$ EndSubroutine