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 |