home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / perl-5.003-src.tgz / tar.out / fsf / perl / vms / fndvers.com < prev    next >
Text File  |  1996-09-28  |  3KB  |  114 lines
  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 = """""""""/perl_root/lib/VMS_''arch'""""""""  /**/"
  62. $   Call update_file "''p2'" "#define OLDARCHLIB_EXP" "''token'"
  63. $   If .not.$Status Then Exit $Status
  64. $!
  65. $   token = """""""""/perl_root/lib/site_perl/VMS_''arch'""""""""  /**/"
  66. $   Call update_file "''p2'" "#define SITEARCH_EXP" "''token'"
  67. $   If .not.$Status Then Exit $Status
  68. $EndIf
  69. $!
  70. $ token = "''perl_version'"
  71. $ If sublevel.eqs."" Then token = token + "  "
  72. $ token = token + "#"
  73. $ Call update_file "''p3'" "PERL_VERSION =" "''token'"
  74. $ If .not.$Status Then Exit $Status
  75. $ If $Status.eq.3
  76. $ Then
  77. $   cmd = "MM[SK]"
  78. $   If F$Locate("MMS",p3).eqs."" Then cmd = "make"
  79. $   err "The PERL_VERSION macro was out of date in the file"
  80. $   err "    ''p3'"
  81. $   err "The file has been corrected, but you must restart the build process"
  82. $   err "by reinvoking ''cmd' to incorporate the new value."
  83. $   Exit 44  ! SS$_ABORT
  84. $ EndIf
  85. $!
  86. $ update_file: Subroutine
  87. $
  88. $ If F$Search(p1).nes.""
  89. $ Then
  90. $   Search/Exact/Output=_NLA0: 'p1' "''p2' ''p3'"
  91. $   If $Status.eq.%X08D78053  ! SEARCH$_NOMATCHES
  92. $   Then
  93. $     Open/Read/Write/Error=done  file &p1
  94. $
  95. $     nextline:
  96. $     Read/End_of_File=done file line
  97. $     If F$Locate(p2,line).ne.F$Length(line)
  98. $     Then
  99. $       Write/Update file "''p2' ''p3'"
  100. $       Goto done
  101. $     EndIf
  102. $     Goto nextline
  103. $
  104. $     done:
  105. $     Close file
  106. $     Exit 3  ! Unused success status
  107. $   EndIf
  108. $   Exit 1  ! SS$_NORMAL
  109. $ Else
  110. $   err "Can't find ''p1'"
  111. $   Exit 98962  ! RMS$_FNF
  112. $ EndIf
  113. $ EndSubroutine
  114.