Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/src/system/smlnj/internal/versiontool.sml
ViewVC logotype

Annotation of /sml/trunk/src/system/smlnj/internal/versiontool.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1639 - (view) (download)

1 : mblume 1639 (* versiontool.sml
2 :     *
3 :     * A CM tool for automatically generating file version.sml
4 :     * from a template, incorporating current version, release,
5 :     * and date/time.
6 :     *
7 :     * Copyright (c) 2004 by The Fellowship of SML/NJ
8 :     *
9 :     * Author: Matthias Blume (blume@tti-c.org)
10 :     *)
11 :     structure VersionTool = struct
12 :    
13 :     local
14 :    
15 :     val bump_release =
16 :     ref (Option.isSome (OS.Process.getEnv "VERSIONTOOL_BUMP_RELEASE"))
17 :    
18 :     fun getVersion file =
19 :     let val s = TextIO.openIn file
20 :     in
21 :     case TextIO.inputLine s of
22 :     SOME l =>
23 :     let val _ = TextIO.closeIn s
24 :     val fl = String.tokens
25 :     (fn c => Char.isSpace c orelse c = #".") l
26 :     in
27 :     map (fn f => getOpt (Int.fromString f, 0)) fl
28 :     end
29 :     | NONE => [0, 0]
30 :     end handle _ => [0, 0]
31 :    
32 :     fun getRelease file =
33 :     let val s = TextIO.openIn file
34 :     in
35 :     case TextIO.inputLine s of
36 :     SOME l => (TextIO.closeIn s; Int.fromString l)
37 :     | NONE => (TextIO.closeIn s; NONE)
38 :     end handle _ => NONE
39 :    
40 :     fun putRelease (file, r) =
41 :     let val s = TextIO.openOut file
42 :     in
43 :     TextIO.output (s, Int.toString r ^ "\n");
44 :     TextIO.closeOut s
45 :     end
46 :    
47 :     fun bumpRelease (file, r) =
48 :     if !bump_release then putRelease (file, r + 1) else ()
49 :    
50 :     fun mkDate () =
51 :     let val d = Date.fromTimeLocal (Time.now ())
52 :     fun month Date.Jan = "January"
53 :     | month Date.Feb = "February"
54 :     | month Date.Mar = "March"
55 :     | month Date.Apr = "April"
56 :     | month Date.May = "May"
57 :     | month Date.Jun = "June"
58 :     | month Date.Jul = "July"
59 :     | month Date.Aug = "August"
60 :     | month Date.Sep = "September"
61 :     | month Date.Oct = "October"
62 :     | month Date.Nov = "November"
63 :     | month Date.Dec = "December"
64 :     val i = Int.toString
65 :     fun si x = if x >= 0 then "+" ^ i x else "-" ^ i (~x)
66 :     fun dd x =
67 :     if x < 10 then "0" ^ i x else i x
68 :     in
69 :     concat [month (Date.month d), " ",
70 :     i (Date.day d), ", ",
71 :     i (Date.year d), " ",
72 :     dd (Date.hour d), ":",
73 :     dd (Date.minute d), ":",
74 :     dd (Date.second d), " (",
75 :     si (LargeInt.toInt (Time.toSeconds (Date.localOffset ()))
76 :     div 3600), ")"]
77 :     end
78 :    
79 :     fun gen { template, target, vfile, rfile } =
80 :     let val version = getVersion vfile
81 :     val release = getRelease rfile
82 :     val version' =
83 :     case release of
84 :     NONE => version
85 :     | SOME r => version @ [r]
86 :     val vstring = String.concatWith ", " (map Int.toString version')
87 :     val date = mkDate ()
88 :     val ss = TextIO.openIn template
89 :     val ts = TextIO.openOut target
90 :     fun loop () =
91 :     case TextIO.input1 ss of
92 :     NONE => ()
93 :     | SOME #"%" =>
94 :     (case TextIO.input1 ss of
95 :     SOME #"V" => (TextIO.output (ts, vstring); loop ())
96 :     | SOME #"D" => (TextIO.output (ts, date); loop ())
97 :     | SOME #"F" => (TextIO.output (ts, OS.Path.file target);
98 :     TextIO.output (ts, " generated from");
99 :     loop ())
100 :     | SOME c => (TextIO.output1 (ts, c); loop ())
101 :     | NONE => TextIO.output1 (ts, #"%"))
102 :     | SOME c => (TextIO.output1 (ts, c); loop ())
103 :     in
104 :     bumpRelease (rfile, getOpt (release, ~1));
105 :     loop ();
106 :     TextIO.closeIn ss;
107 :     TextIO.closeOut ts
108 :     end
109 :    
110 :     val tool = "versiontool"
111 :     val class = "version"
112 :    
113 :     val kw_target = "target"
114 :     val kw_versionfile = "versionfile"
115 :     val kw_releasefile = "releasefile"
116 :     val keywords = [kw_target, kw_versionfile, kw_releasefile]
117 :    
118 :     fun versiontoolrule { spec: Tools.spec,
119 :     native2pathmaker,
120 :     context: Tools.rulecontext,
121 :     defaultClassOf,
122 :     sysinfo } : Tools.partial_expansion =
123 :     let fun dogen (targetpp, versionfilepp, releasefilepp) () =
124 :     let val templatep = Tools.srcpath (#mkpath spec ())
125 :     val targetp = Tools.srcpath targetpp
126 :     in
127 :     gen { template = Tools.nativeSpec templatep,
128 :     target = Tools.nativeSpec targetp,
129 :     vfile = Tools.nativePreSpec versionfilepp,
130 :     rfile = Tools.nativePreSpec releasefilepp };
131 :     ({ smlfiles = [(targetp, { share = Sharing.DONTCARE,
132 :     setup = (NONE, NONE),
133 :     split = NONE,
134 :     noguid = false,
135 :     locl = false,
136 :     controllers = [] })],
137 :     cmfiles = [],
138 :     sources = [(templatep, { class = class,
139 :     derived = #derived spec })] },
140 :     [])
141 :     end
142 :     fun complain l =
143 :     raise Tools.ToolError { tool = tool, msg = concat l }
144 :     in
145 :     case #opts spec of
146 :     NONE => complain ["missing parameters"]
147 :     | SOME to =>
148 :     let val { matches, restoptions } =
149 :     Tools.parseOptions { tool = tool,
150 :     keywords = keywords,
151 :     options = to }
152 :     fun match kw =
153 :     case matches kw of
154 :     NONE => complain ["missing parameter \"",
155 :     kw, "\""]
156 :     | SOME [Tools.STRING { mkpath, ... }] =>
157 :     mkpath ()
158 :     | _ => complain ["invalid parameter \"",
159 :     kw, "\""]
160 :     in
161 :     context (dogen (match kw_target,
162 :     match kw_versionfile,
163 :     match kw_releasefile))
164 :     end
165 :     end
166 :    
167 :     in
168 :    
169 :     val bump_release = bump_release
170 :     val _ = Tools.registerClass (class, versiontoolrule)
171 :    
172 :     end
173 :     end

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0