gitorious.org Git - kakapo:kakapo.git/blob

1 #! /usr/bin/env parrot-nqp

3 # http://www.opensource.org/licenses/artistic-license-2.0.php for license.

4

5 # =head1 NAME

6 #

7 # setup.nqp - Configure and build the Kakapo library.

8 #

9 # =head1 USAGE

10 #

11 # $ parrot-nqp setup.nqp build

12 # $ parrot-nqp setup.nqp test

13 # $ sudo parrot-nqp setup.nqp install

14

15 INIT {

16 pir::load_language('parrot');

17 pir::load_bytecode('distutils.pbc');

18

19 pir::load_bytecode('dumper.pir');

20 }

21

22 MAIN(get_args());

23

24 sub new_hash(*%hash) {

25 %hash;

26 }

27

28 sub MAIN(@argv) {

29

30 my %kakapo := new_hash(

31 :name( 'Kakapo' ),

32 :abstract( 'Run-time library for NQP programs on the Parrot VM' ),

33 :authority( 'http://gitorious.org/austin' ),

34 :copyright_holder( 'Austin Hastings' ),

35 :doc_files( <README CREDITS> ),

36 :keywords( < library nqp parrot runtime stand alone xunit

37 unit testing matcher pmc methods >),

38 :license_type( 'Artistic License 2.0' ),

39 :license_uri( 'http://www.perlfoundation.org/artistic_license_2_0' ),

40 :checkout_uri( 'git://gitorious.org/kakapo/kakapo.git' ),

41 :browser_uri( 'http://code.google.com/p/kakapo-parrot/' ),

42 :project_uri( 'git://gitorious.org/kakapo/kakapo.git' ),

43

44 :harness_files( 't/bootstrap' ),

45

46 :release_id( 'release-3' ),

47 :release_dir_format( 'released/%s'),

48 :vdd_file( 'vdd.txt' ),

49 );

50

51 %kakapo<copy_templates><library/krt0.pir> := <src/Internals/krt0.pir_tmpl>;

52 %kakapo<copy_templates><src/Internals/kakapo_bottom.pir> := <src/Internals/kakapo_bottom.pir_tmpl>;

53 %kakapo<copy_templates><src/Internals/kakapo_top.pir> := <src/Internals/kakapo_top.pir_tmpl>;

54

55

56 %kakapo<pir_nqp-rx><src/Internals/Base.pir> := <src/Internals/Base.nqp>;

57 %kakapo<pir_nqp-rx><src/Internals/Full.pir> := <src/Internals/Full.nqp>;

58

59 my @base_pir_files := <

60 src/Global.pir

61

62 src/Parrot/Opcode.pir

63 src/Parrot/Parrot.pir

64 src/Parrot/Pir.pir

65

66 src/Pmc/Array.pir

67 src/Pmc/common_methods.pir

68 src/Pmc/Exception.pir

69 src/Exceptions.pir

70 src/Pmc/Hash.pir

71 src/Pmc/Namespace.pir

72 src/Pmc/String.pir

73 src/Pmc/Sub.pir

74 src/Pmc/Undef.pir

75 >;

76

77 for @base_pir_files {

78 %kakapo<pir_nqp-rx>{~ $_} := change_ext(~$_, :from('.pir'), :to('.nqp'));

79 }

80

81 %kakapo<build_libs><library/kakapo_base.pir> := <

82 src/Internals/kakapo_top.pir

83 src/Internals/Base.pir

84 >;

85 %kakapo<build_libs><library/kakapo_base.pir>.append( @base_pir_files );

86 %kakapo<build_libs><library/kakapo_base.pir>.push( <src/Internals/kakapo_bottom.pir>);

87

88 my @full_pir_files := <

89 src/Classes/P6object.pir

90 src/Classes/P6metaclass.pir

91 src/UnitTest/Listeners.pir

92 src/UnitTest/Loader.pir

93 src/UnitTest/Result.pir

94 src/UnitTest/Suite.pir

95 src/UnitTest/Testcase.pir

96 >;

97

98 for @full_pir_files {

99 %kakapo<pir_nqp-rx>{~ $_} := change_ext(~$_, :from('.pir'), :to('.nqp'));

100 }

101

102 %kakapo<build_libs><library/kakapo_full.pir> := <

103 src/Internals/kakapo_top.pir

104 src/Internals/Full.pir

105 >;

106 %kakapo<build_libs><library/kakapo_full.pir>.append( @base_pir_files );

107 %kakapo<build_libs><library/kakapo_full.pir>.append( @full_pir_files );

108 %kakapo<build_libs><library/kakapo_full.pir>.push( <src/Internals/kakapo_bottom.pir>);

109

110 %kakapo<strip_annotations> := %kakapo<build_libs>;

111

112 %kakapo<pbc_pir><library/kakapo_base.pbc> := <library/kakapo_base.pir>;

113 %kakapo<pbc_pir><library/kakapo_full.pbc> := <library/kakapo_full.pir>;

114

115 %kakapo<release_files><kakapo_base.pir> := <library/kakapo_base.pir>;

116 %kakapo<release_files><kakapo_base.pbc> := <library/kakapo_base.pbc>;

117 %kakapo<release_files><kakapo_full.pir> := <library/kakapo_full.pir>;

118 %kakapo<release_files><kakapo_full.pbc> := <library/kakapo_full.pbc>;

119 %kakapo<release_files><krt0.pir> := <library/krt0.pir>;

120

121 register_step_before('build', Setup::Step::copy_templates);

122 register_step_before('clean', Setup::Step::clean_templates);

123

124 #install_build_libs();

125 install_substep('build', Setup::Step::build_libs, :before('_build_pbc_pir'));

126 install_substep('build', Setup::Step::strip_annotations, :before('_build_pbc_pir'));

127 register_step_before('clean', Setup::Step::clean_libs);

128

129 register_step('release', Setup::Step::make_release);

130

131 pir::shift(@argv);

132 setup_(@argv, %kakapo);

133 }

134

135 sub change_ext($file, :$from!, :$to!) {

136 my $len := pir::length__IS($file) - pir::length__IS($from);

137

138 unless pir::substr__SSI($file, $len) eq $from {

139 pir::die("No matching extension '$from' on file: $file");

140 }

141

142 my $base := pir::substr__SSI($file, 0, $len);

143 $base ~ $to;

144 }

145

146 sub get_args() {

147 my $interp := pir::getinterp__P();

148 $interp[2];

149 }

150

151 sub install_substep($step, &func, :$before, :$after) {

152 my $target := $before // $after;

153 my @insert;

154 @insert.push(&func);

155

156 our %step;

157 my $index := ?$after;

158 for %step{$step} {

159 if ~ $_ eq $target {

160 pir::splice__vppii(%step{$step}, @insert, $index, 0);

161 return 0;

162 }

163

164 $index++;

165 }

166

167 pir::die("Unable to insert substep &func into $step - could not find $target");

168 }

169

170

171 # distutils functions are not in a namespace, so Step:: methods can't address them

172 # directly.

173

174 sub needs_update($src, $dst, :$verbose) {

175

176 ! file_exists($dst) ||newer(~$src, $dst, :verbose($verbose));

177 }

178

179 sub setup_(@steps, %config) {

180 Q:PIR {

181 $P0 = find_lex '@steps'

182 $P1 = find_lex '%config'

183 'setup'($P0 :flat, $P1 :flat :named)

184 };

185 }

186

187 module Setup::Step;

188

189 sub build_libs(*%config) {

190 my $output_file;

191 my @inputs;

192 my $needs_update;

193 my $command;

194

195 for %config<build_libs> {

196 $output_file := ~ $_;

197 @inputs := %config<build_libs>{$output_file};

198 $needs_update := 0;

199

200 unless newer(~$output_file, @inputs) {

201 $command := 'cat '

202 ~ pir::join(' ', @inputs)

203 ~ ' > '

204 ~ $output_file;

205 system($command, :verbose(1));

206 }

207 }

208 }

209

210 sub clean_libs(*%config) {

211 clean_key(%config<build_libs>);

212 }

213

214 sub clean_templates(*%config) {

215 clean_key(%config<copy_templates>);

216 }

217

218 sub copy_templates(*%config) {

219 my %cfg := %config<copy_templates>;

220 for %cfg {

221 my $src := %cfg{$_};

222 my $dst := ~ $_;

223

224 unless newer(~$dst, ~$src) {

225 cp($src, $dst, :verbose(1));

226 }

227 }

228 }

229

230 sub make_release(*%config) {

231 my $release_id := %config<release_id>;

232 unless $release_id {

233 pir::die("Cannot release: <release_id> config not set");

234 }

235

236 my @args;

237 @args.push( $release_id );

238

239 my $release_dir := pir::sprintf__SSP(%config<release_dir_format>, @args);

240

241 if file_exists($release_dir) {

242 pir::die("Cannot release: '$release_dir' already exists.");

243 }

244

245 my $vdd := %config<vdd_file>;

246

247 unless $vdd && file_exists($vdd) {

248 pir::die("Cannot release: no Version Description Document provided. Set <vdd_file> config.");

249 }

250

251 my $fh := pir::open__PSS($vdd, 'r');

252 my $leader := $fh.readline;

253 $fh.close;

254

255 if pir::index__ISS($leader, $release_id) < 0 {

256 pir::die("Cannot release: VDD file '$vdd' does not contain '$release_id' in line 1");

257 }

258

259 my %cfg := %config<release_files>;

260 my $installed_vdd := 0;

261

262 for %cfg {

263 install(%cfg{~$_}, $release_dir ~ '/' ~$_, :verbose(1));

264

265 if %cfg{~$_} eq $vdd {

266 $installed_vdd++;

267 }

268 }

269

270 unless $installed_vdd {

271 install($vdd, $release_dir ~ '/VERSION', :verbose(1));

272 }

273

274 unlink($vdd, :verbose(1));

275 }

276

277 sub strip_annotations(*%config) {

278 for %config<strip_annotations> {

279 if file_exists(~$_) {

280 my $fh := pir::open__PSS(~$_, 'r');

281 my $body := $fh.readall();

282 $fh.close;

283

284 if pir::index__ISS($body, "\n.annotate ") >= 0 {

285 say("Removing annotations from $_");

286 $body.replace("\n.annotate ", "\n# .annotate ");

287 $fh := pir::open__PSS(~$_, 'w');

288 $fh.puts($body);

289 $fh.close;

290 }

291 }

292 }

293 }