vms/fndvers.com

   1 $! Brief DCL procedure to parse current Perl version out of
   2 $! patchlevel.h, and update the version token for ARCHLIB
   3 $! config.vms and descrip.mms if necessary.
   4 $ err = "Write Sys$Error"
   5 $
   6 $ If p1.eqs."" Then p1 = "patchlevel.h"
   7 $ If p2.eqs."" Then p2 = F$Parse("config.vms",p1,"[.vms]")
   8 $ If p3.eqs."" Then p3 = F$Parse("descrip.mms",p1,"[.vms]")
   9 $
  10 $ If F$Search(p1).eqs.""
  11 $ Then
  12 $   err "Can't find ''p1' - exiting"
  13 $   Exit 98962  ! RMS$_FNF
  14 $ EndIf
  15 $ plevel = ""
  16 $ sublevel = ""
  17 $ Open/Read patchlevel_h &p1
  18 $
  19 $ pread:
  20 $ Read/End_Of_File=pdone patchlevel_h line
  21 $ If F$Locate("#define PATCHLEVEL",line).ne.F$Length(line)
  22 $ Then
  23 $    plevel = F$Element(2," ",line)
  24 $    If F$Length(plevel).lt.3 Then -
  25        plevel = F$Extract(0,3 - F$Length(plevel),"000") + plevel
  26 $ EndIf
  27 $ If F$Locate("#define SUBVERSION",line).ne.F$Length(line)
  28 $ Then
  29 $    sublevel = F$Element(2," ",line)
  30 $    If F$Length(sublevel).lt.2 Then -
  31        sublevel = F$Extract(0,2 - F$Length(sublevel),"00") + sublevel
  32 $ EndIf
  33 $ If .not.(plevel.nes."" .and. sublevel.nes."") Then Goto pread
  34 $
  35 $ pdone:
  36 $ Close patchlevel_h
  37 $!
  38 $ If sublevel.eq.0 Then sublevel = ""
  39 $ perl_version = "5_" + plevel + sublevel
  40 $ If p2.eqs."#NOFILE#"
  41 $ Then
  42 $   Write Sys$Output "Perl version directory name is ""''perl_version'"""
  43 $   Exit
  44 $ EndIf
  45 $!
  46 $ token = """""""""''perl_version'"""""""""
  47 $ If sublevel.eqs."" Then token = token + "  "
  48 $ token = token + "  /**/"
  49 $ Call update_file "''p2'" "#  define _PVERS" "''token'"
  50 $ If .not.$Status Then Exit $Status
  51 $!
  52 $ token = "''perl_version'"
  53 $ If sublevel.eqs."" Then token = token + "  "
  54 $ token = token + "#"
  55 $ Call update_file "''p3'" "PERL_VERSION =" "''token'"
  56 $ If .not.$Status Then Exit $Status
  57 $ If $Status.eq.3
  58 $ Then
  59 $   cmd = "MM[SK]"
  60 $   If F$Locate("MMS",p3).eqs."" Then cmd = "make"
  61 $   err "The PERL_VERSION macro was out of date in the file"
  62 $   err "    ''p3'"
  63 $   err "The file has been corrected, but you must restart the build process"
  64 $   err "by reinvoking ''cmd' to incorporate the new value."
  65 $   Exit 44  ! SS$_ABORT
  66 $ EndIf
  67 $!
  68 $ update_file: Subroutine
  69 $
  70 $ If F$Search(p1).nes.""
  71 $ Then
  72 $   Search/Exact/Output=_NLA0: 'p1' "''p2' ''p3'"
  73 $   If $Status.eq.%X08D78053  ! SEARCH$_NOMATCHES
  74 $   Then
  75 $     Open/Read/Write/Error=done  file &p1
  76 $
  77 $     nextline:
  78 $     Read/End_of_File=done file line
  79 $     If F$Locate(p2,line).ne.F$Length(line)
  80 $     Then
  81 $       Write/Update file "''p2' ''p3'"
  82 $       Goto done
  83 $     EndIf
  84 $     Goto nextline
  85 $
  86 $     done:
  87 $     Close file
  88 $     Exit 3  ! Unused success status
  89 $   EndIf
  90 $   Exit 1  ! SS$_NORMAL
  91 $ Else
  92 $   err "Can't find ''p1'"
  93 $   Exit 98962  ! RMS$_FNF
  94 $ EndIf
  95 $ EndSubroutine