This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
30243d82e5a7251d68cdd545e37d25e6a9e6dff0
[perl5.git] / vms / fndvers.com
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/site_perl/VMS_''arch'""""""""  /**/"
67 $   Call update_file "''p2'" "#define SITEARCH_EXP" "''token'"
68 $   If .not.$Status Then Exit $Status
69 $EndIf
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