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