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 F$GetSyi("HW_MODEL").gt.1024
  41 $ Then
  42 $   arch = "AXP"
  43 $ Else
  44 $   arch = "VAX"
  45 $ EndIf
  46 $ If p2.eqs."#NOFILE#"
  47 $ Then
  48 $   Write Sys$Output "Perl version directory name is ""''perl_version'"""
  49 $   Exit
  50 $ EndIf
  51 $!
  52 $ token = """""""""/perl_root/lib/VMS_''arch'/''perl_version'"""""""""
  53 $ If sublevel.eqs."" Then token = token + "  "
  54 $ token = token + "  /**/"
  55 $ Call update_file "''p2'" "#define ARCHLIB_EXP" "''token'"
  56 $ teststs = $Status
  57 $ If .not.teststs Then Exit teststs
  58 $!
  59 $ If teststs.ne.1 ! current values in config.vms are appropriate
  60 $ Then
  61 $   token = """""""""VMS_''arch'  /**/"""""""""
  62 $   Call update_file "''p2'" "#define ARCHNAME" "''token'"
  63 $   teststs = $Status
  64 $   If .not.teststs Then Exit teststs
  65 $!
  66 $   token = """""""""/perl_root/lib/VMS_''arch'""""""""  /**/"
  67 $   Call update_file "''p2'" "#define OLDARCHLIB_EXP" "''token'"
  68 $   If .not.$Status Then Exit $Status
  69 $!
  70 $   token = """""""""/perl_root/lib/site_perl/VMS_''arch'""""""""  /**/"
  71 $   Call update_file "''p2'" "#define SITEARCH_EXP" "''token'"
  72 $   If .not.$Status Then Exit $Status
  73 $EndIf
  74 $!
  75 $ token = "''perl_version'"
  76 $ If sublevel.eqs."" Then token = token + "  "
  77 $ token = token + "#"
  78 $ Call update_file "''p3'" "PERL_VERSION =" "''token'"
  79 $ If .not.$Status Then Exit $Status
  80 $ If $Status.eq.3
  81 $ Then
  82 $   cmd = "MM[SK]"
  83 $   If F$Locate("MMS",p3).eqs."" Then cmd = "make"
  84 $   err "The PERL_VERSION macro was out of date in the file"
  85 $   err "    ''p3'"
  86 $   err "The file has been corrected, but you must restart the build process"
  87 $   err "by reinvoking ''cmd' to incorporate the new value."
  88 $   Exit 44  ! SS$_ABORT
  89 $ EndIf
  90 $!
  91 $ update_file: Subroutine
  92 $
  93 $ If F$Search(p1).nes.""
  94 $ Then
  95 $   Search/Exact/Output=_NLA0: 'p1' "''p2' ''p3'"
  96 $   If $Status.eq.%X08D78053  ! SEARCH$_NOMATCHES
  97 $   Then
  98 $     Open/Read/Write/Error=done  file &p1
  99 $
 100 $     nextline:
 101 $     Read/End_of_File=done file line
 102 $     If F$Locate(p2,line).ne.F$Length(line)
 103 $     Then
 104 $       Write/Update file "''p2' ''p3'"
 105 $       Goto done
 106 $     EndIf
 107 $     Goto nextline
 108 $
 109 $     done:
 110 $     Close file
 111 $     Exit 3  ! Unused success status
 112 $   EndIf
 113 $   Exit 1  ! SS$_NORMAL
 114 $ Else
 115 $   err "Can't find ''p1'"
 116 $   Exit 98962  ! RMS$_FNF
 117 $ EndIf
 118 $ EndSubroutine