| 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 |
|---|
