[differences between cumulative patch application and perl5.004_01]
[p5sagit/p5-mst-13.2.git] / vms / fndvers.com
CommitLineData
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
774d564b 61$ token = """""""""VMS_''arch' /**/"""""""""
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/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
2ab89e18 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