portbump 29 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052
  1. #!/usr/bin/perl
  2. # $OpenBSD: portbump,v 1.19 2016/11/06 21:37:55 zhuk Exp $
  3. #
  4. # Copyright (c) 2014-2016 Vadim Zhukov <zhuk@openbsd.org>
  5. #
  6. # Permission to use, copy, modify, and distribute this software for any
  7. # purpose with or without fee is hereby granted, provided that the above
  8. # copyright notice and this permission notice appear in all copies.
  9. #
  10. # THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
  11. # WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
  12. # MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
  13. # ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
  14. # WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
  15. # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
  16. # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  17. package Util;
  18. use strict;
  19. use warnings;
  20. sub plibs {
  21. my $prefix = shift;
  22. print STDERR "$prefix: ".join(", ", @_)."\n";
  23. }
  24. # prints hash in compact form, for debugging purposes
  25. sub phash {
  26. my $h = shift;
  27. "{ ".join (", ", map {
  28. $_."=>".(ref($h->{$_}) eq 'HASH' ? phash($h->{$_}) : $h->{$_})
  29. } (sort keys %{$h})) . " }";
  30. }
  31. sub spc_per_tab { 8 }
  32. sub expand_tabs {
  33. my $line = shift;
  34. while ($line =~ /\t/) {
  35. my $pos = $-[0] + spc_per_tab - 1;
  36. $pos -= $pos % spc_per_tab;
  37. $line = $` . (' ' x (($pos - $-[0]) || spc_per_tab)) . $';
  38. }
  39. return $line;
  40. }
  41. sub w_stem {
  42. my @v = @_;
  43. for (@v) {
  44. s,^.*/,,;
  45. s,^([^/<>=]+)(?:[<>=].*)$,$1,;
  46. }
  47. return wantarray ? @v : $v[0];
  48. }
  49. #################################################################
  50. package PortHandler;
  51. use strict;
  52. use warnings;
  53. # Here is a list of variables that REVISION's are usually placed
  54. # near to. Update if you see the "can't find a suitable place for
  55. # REVISION mark" message
  56. my @_REV_NEIGHBORS = qw(
  57. DISTNAME
  58. FULLPKGNAME
  59. GNOME_PROJECT
  60. PKGNAME
  61. REVISION
  62. V
  63. VERSION
  64. );
  65. my $_rev_neighbors_plain = join('|', @_REV_NEIGHBORS);
  66. sub new {
  67. my ($class, $dir, $tweak_wantlib, $lib_depends_tgt) = @_;
  68. die "lib depends target specified without WANTLIB tweaking"
  69. if !$tweak_wantlib and defined($lib_depends_tgt);
  70. my $self = {
  71. dir => $dir,
  72. modules => [],
  73. noarch => {},
  74. shlibs => {},
  75. tweak_wantlib => $tweak_wantlib,
  76. wantlib_mod => {},
  77. verbose => 0,
  78. };
  79. #
  80. # Get actual information about subpackages (including their
  81. # REVISIONs) and shared libraries.
  82. #
  83. open (my $dumpvars, '-|', "make", "SUBDIR=$dir", "dump-vars") or
  84. die "cannot run make dump-vars: $!";
  85. while (<$dumpvars>) {
  86. chomp;
  87. next unless /^[^,]*(?:,[^.-]*(-[^.]+)?)?\.([^=.]+)=(.*)$/;
  88. my ($subpkg, $var, $value) = ($1, $2, $3);
  89. $subpkg //= "";
  90. if ($var eq "MULTI_PACKAGES") {
  91. $self->{mpkgs} = { map { $_ => 1 } split(/\s+/, $value) };
  92. } elsif ($var eq "SHARED_LIBS") {
  93. # perhaps direct " = split (...)" would be enough?
  94. $self->{shlibs} = { %{$self->{shlibs}}, split(/\s+/, $value) };
  95. } elsif ($var eq "SUBPACKAGE") {
  96. $self->{defsubpkg} = $value;
  97. } elsif ($var eq "PKG_ARCH") {
  98. $self->{noarch}->{$subpkg} = 1 if $value eq "*";
  99. } elsif ($var eq "WANTLIB") {
  100. $self->{wantlib_resolved} //= {};
  101. $self->{wantlib_resolved}->{$subpkg} =
  102. { map { $_ => 1 } split(/\s+/, $value) };
  103. } elsif ($var eq "MODULES") {
  104. $self->{modules} = [ split(/\s+/, $value) ];
  105. }
  106. }
  107. close $dumpvars;
  108. if (scalar(keys %{$self->{mpkgs}}) == 1 and exists($self->{mpkgs}->{"-"})) {
  109. $self->{mpkgs} = { "" => 1 };
  110. }
  111. if ($tweak_wantlib and _is_mpkg_port($self)) {
  112. $self->{wantlib_resolved} //= {};
  113. #
  114. # Get actual value of WANTLIB (not the one of WANTLIB-foo or WANTLIB-),
  115. # to be used to avoid extra WANTLIB-* lines.
  116. #
  117. open ($dumpvars, '-|', "make", "SUBDIR=$dir", "show=WANTLIB") or
  118. die "cannot run make show=WANTLIB: $!";
  119. while (<$dumpvars>) {
  120. chomp;
  121. next if /^===>/;
  122. $_ =~ s/^\s*//;
  123. $self->{wantlib_resolved}->{""} =
  124. { map { $_ => 1 } split(/\s+/, $_) };
  125. }
  126. close $dumpvars;
  127. }
  128. if (defined $lib_depends_tgt) {
  129. my $dirref = ($dir eq ".") ? "" : " in $dir";
  130. # first, make sure we don't have to build/install anything
  131. if ($lib_depends_tgt eq 'lib-depends-check') {
  132. open ($dumpvars, '-|', qw(make show=PKGFILES)) or
  133. die "cannot run make show=PKGFILES: $!";
  134. my @missing;
  135. while (<$dumpvars>) {
  136. chomp;
  137. unless (-e $_) {
  138. $_ =~ s,.*/,,;
  139. push(@missing, $_);
  140. }
  141. }
  142. close $dumpvars;
  143. if (scalar(@missing)) {
  144. print STDERR "cannot tweak WANTLIB$dirref,"
  145. . "missing packages: "
  146. . join(", ", @missing) . "\n";
  147. return undef;
  148. }
  149. } else {
  150. open ($dumpvars, '-|', qw(make show=_FAKE_COOKIE)) or
  151. die "cannot run make show=_FAKE_COOKIE: $!";
  152. my $cookie = <$dumpvars>;
  153. close $dumpvars;
  154. chomp $cookie;
  155. unless (-e $cookie) {
  156. print STDERR "cannot tweak WANTLIB$dirref,"
  157. . " run 'make fake' first\n";
  158. return undef;
  159. }
  160. }
  161. $self->{wantlib_extra} = { "" => [] };
  162. $self->{wantlib_missing} = { "" => [] };
  163. open ($dumpvars, '-|', "make", "SUBDIR=$dir", $lib_depends_tgt) or
  164. die "cannot run make $lib_depends_tgt: $!";
  165. my $subpkg = "";
  166. my %not_reachable;
  167. while (<$dumpvars>) {
  168. chomp;
  169. if (/^[^\s\(]+\([^\)]+,(-[^\)]+)\):$/) {
  170. $subpkg = $1;
  171. $self->{wantlib_extra}->{$subpkg} = [];
  172. $self->{wantlib_missing}->{$subpkg} = [];
  173. } elsif (/^WANTLIB.* \+= (.+)/) {
  174. push(@{$self->{wantlib_missing}->{$subpkg}},
  175. split(/\s+/, $1));
  176. } elsif (/^Extra:\s*(\S+)/) {
  177. push(@{$self->{wantlib_extra}->{$subpkg}},
  178. map { s/\.[0-9]+$//; $_ } split(/\s+/, $1));
  179. } elsif (/^Bogus WANTLIB:\s*(\S+).*NOT REACHABLE/) {
  180. $not_reachable{$1} = 1;
  181. } elsif (/^Asking ports for dependency/) {
  182. print STDERR "$_\n";
  183. }
  184. }
  185. close $dumpvars;
  186. if (scalar(keys %not_reachable)) {
  187. print STDERR "cannot tweak WANTLIB$dirref,"
  188. . " not reachable missing libraries detected: "
  189. . join(", ", sort keys %not_reachable) . "\n";
  190. return undef;
  191. }
  192. }
  193. return bless($self, $class);
  194. }
  195. sub verbose {
  196. my $self = shift;
  197. my $rv = $self->{verbose};
  198. $self->{verbose} = $_[0] if defined $_[0];
  199. return $rv;
  200. }
  201. # Formats and returns string of "var = value" with whitespace adjustment
  202. # done like in the sample given line.
  203. sub _adj_whitespace {
  204. my ($self, $var, $value, $wssample) = @_;
  205. unless (defined($wssample) and
  206. $wssample =~ /^( *)([A-Za-z0-9_+-]+)(\s*)[\+\?\!]*=(\s*)/) {
  207. return "$var =\t$value";
  208. }
  209. my $start_ws = $1 // "";
  210. my $before_eq_ws = $3 // "";
  211. my $after_eq_ws = $4 // "";
  212. my $svalue_pos = $+[4];
  213. my $line = $start_ws.$var.$before_eq_ws."=";
  214. my $line_exp = Util::expand_tabs($line);
  215. my $wssample_exp = Util::expand_tabs($wssample);
  216. my $svalue_pos_exp = $svalue_pos +
  217. (length($wssample_exp) - length($wssample));
  218. my $elen = length($line_exp);
  219. if ($elen > $svalue_pos_exp) {
  220. # too long anyway, just add a tab and be done with it
  221. $line .= "\t";
  222. } elsif ($elen < $svalue_pos_exp) {
  223. if ($after_eq_ws =~ /^\t*$/) {
  224. # tab-based separation
  225. while ($elen < $svalue_pos_exp) {
  226. my $n_spc_to_add = ($svalue_pos_exp - $elen);
  227. $n_spc_to_add %= Util::spc_per_tab;
  228. $n_spc_to_add ||= Util::spc_per_tab;
  229. $elen += $n_spc_to_add;
  230. $line .= "\t";
  231. }
  232. } else {
  233. # space-based separation
  234. $line .= ' ' x ($svalue_pos_exp - length($line_exp));
  235. }
  236. }
  237. return $line.$value;
  238. }
  239. sub _is_mpkg_port {
  240. my $self = shift;
  241. for my $subpkg (keys %{$self->{mpkgs}}) {
  242. next if $subpkg eq "";
  243. next if $subpkg eq "-";
  244. return 1;
  245. }
  246. return 0;
  247. }
  248. sub _add_new_revs {
  249. my ($self, $out, $lineno, $bumppkgs) = (shift, shift, shift, shift);
  250. # Note: $lineno is the input file's line number, not output's one.
  251. if ($self->{maxrevsin}->{count} > 1) {
  252. return 0 unless $lineno == $self->{maxrevsin}->{blockend};
  253. }
  254. if ($self->{has_global_rev}) {
  255. return 0 unless $self->_is_mpkg_port;
  256. }
  257. my $nchanges = 0;
  258. for my $subpkg(sort keys %{$bumppkgs}) {
  259. # if no place found, error will be reported by update()
  260. if ($self->{maxrevsin}->{count} > 1 or
  261. (defined $self->{newrevplace}->{$subpkg}->{blockend} and
  262. $lineno == $self->{newrevplace}->{$subpkg}->{blockend})) {
  263. my $line = $self->_adj_whitespace(
  264. "REVISION" . $subpkg,
  265. "0",
  266. $self->{newrevplace}->{$subpkg}->{wssample});
  267. print $out $line, "\n";
  268. $nchanges++;
  269. }
  270. }
  271. return $nchanges;
  272. }
  273. # un-expand ${MOD*}
  274. sub _unexpand_mod_wantlib {
  275. my $self = shift;
  276. my @libs = @_;
  277. for my $m (keys %{$self->{wantlib_mod}}) {
  278. my $nlibs = keys %{$self->{wantlib_mod}->{$m}};
  279. if ($nlibs == 0) {
  280. print STDERR "warning: empty $m is used in ".
  281. $self->{dir}.", it may don't get somewhere\n"
  282. if $self->{verbose};
  283. next;
  284. }
  285. my @compacted = grep { !exists $self->{wantlib_mod}->{$m}->{Util::w_stem($_)} } @libs;
  286. if (scalar(@libs) - scalar(@compacted) == $nlibs) {
  287. @libs = ("\${$m}", @compacted);
  288. }
  289. }
  290. return @libs;
  291. }
  292. sub _put_wantlib_lines {
  293. my ($self, $out, $bumppkgs, $wl_add, $wl_del, $empty_line)
  294. = @_;
  295. my $wantlib_auto = exists $self->{wantlib_extra};
  296. my %wl_del_hash;
  297. if ($wantlib_auto) {
  298. # adjust wantlib_resolved according to wantlib_missing
  299. for my $subpkg (keys %{$self->{wantlib_missing}}) {
  300. $self->{wantlib_resolved}->{$subpkg} //= {};
  301. for my $w (@{$self->{wantlib_missing}->{$subpkg}}) {
  302. $self->{wantlib_resolved}->{$subpkg}->{$w} = 1;
  303. }
  304. }
  305. for my $subpkg (keys %{$self->{wantlib_extra}}) {
  306. next unless exists $self->{wantlib_resolved}->{$subpkg};
  307. for my $w (@{$self->{wantlib_extra}->{$subpkg}}) {
  308. for my $w2 (keys %{$self->{wantlib_resolved}->{$subpkg}}) {
  309. my $w_short = Util::w_stem($w2);
  310. delete $self->{wantlib_resolved}->{$subpkg}->{$w2}
  311. if $w_short eq $w;
  312. }
  313. }
  314. }
  315. } else {
  316. %wl_del_hash = map { Util::w_stem($_) => 1; }
  317. @$wl_add, @$wl_del;
  318. }
  319. # build list of WANTLIB items common to all subpackages;
  320. # also used to populate WANTLIB in case there is only
  321. # WANTLIB declaration used.
  322. my %wl_common = map { $_ => 1 } (@{$wl_add // []});
  323. for my $subpkg (keys %{$self->{wantlib_resolved}}) {
  324. next if exists $self->{noarch}->{$subpkg};
  325. %wl_common = (%wl_common, %{$self->{wantlib_resolved}->{$subpkg}});
  326. }
  327. for my $w (keys %wl_common) {
  328. WLC_REMOVAL: for my $subpkg (keys %{$self->{wantlib_resolved}}) {
  329. next if $subpkg eq "";
  330. next if exists $self->{noarch}->{$subpkg};
  331. next if exists $self->{wantlib_resolved}->{$subpkg}->{$w};
  332. if (exists $bumppkgs->{$subpkg} and defined $wl_add) {
  333. for my $w2 (@$wl_add) {
  334. next WLC_REMOVAL if $w2 eq $w;
  335. }
  336. }
  337. delete $wl_common{$w};
  338. last;
  339. }
  340. }
  341. $self->_init_wantlib("");
  342. # TODO
  343. #my $common_created = 0;
  344. #if (scalar @{$self->{wantlib}->{""}->{libs}} == 0) {
  345. # $common_created = 1;
  346. # $self->{wantlib}->{""}->{libs} = [ keys %wl_common ];
  347. #}
  348. my %all_subpkgs_hash = map { $_ => 1 }
  349. keys(%{$self->{wantlib}}), keys(%{$self->{noarch}});
  350. my @sorted_subpkgs = sort {
  351. return -1 if $a eq "";
  352. return 1 if $b eq "";
  353. return -1 if $a eq $self->{defsubpkg};
  354. return 1 if $b eq $self->{defsubpkg};
  355. $a cmp $b;
  356. } keys %all_subpkgs_hash;
  357. my $defpkgchanged = 0;
  358. my $nlines = 0;
  359. for my $subpkg (@sorted_subpkgs) {
  360. if (exists $self->{noarch}->{$subpkg}) {
  361. #
  362. # Catch both situations when WANTLIB is populated from
  363. # outside and when some ${MOD*} inside ${WANTLIB}
  364. # could be empty in default case.
  365. #
  366. if (keys(%{$self->{wantlib_resolved}->{""}}) > 0 or
  367. scalar(@{$self->{wantlib}->{""}->{libs}}) > 0) {
  368. print $out "\n" unless $empty_line;
  369. $empty_line = 0;
  370. print $out "WANTLIB${subpkg} = # no-arch package\n";
  371. $nlines++;
  372. }
  373. next;
  374. }
  375. $self->{wantlib}->{$subpkg}->{wssample} =~ /^ *WANTLIB(?:-[A-Za-z0-9_+]*)?(\s*)[\+\?\!]*=/;
  376. my $ws = $1;
  377. my @libs;
  378. if ($wantlib_auto) {
  379. $self->{wantlib}->{$subpkg}->{inherits_global} = 1
  380. if $self->_init_wantlib($subpkg);
  381. @libs = keys(%{$self->{wantlib_resolved}->{$subpkg}});
  382. if ($self->{wantlib}->{$subpkg}->{inherits_global}) {
  383. @libs = grep { !exists $wl_common{$_} } @libs;
  384. unshift(@libs, '${WANTLIB}');
  385. }
  386. } else {
  387. @libs = grep {
  388. !exists $wl_del_hash{Util::w_stem($_)}
  389. } @{$self->{wantlib}->{$subpkg}->{libs}};
  390. }
  391. # find the difference between resolved and found in Makefile
  392. # items; that should be inherited from ${MOD*} and thus
  393. # do not go into WANTLIB explicitly.
  394. @libs = $self->_unexpand_mod_wantlib(@libs);
  395. my %libs_inherited = map { $_ => 1 } @libs;
  396. for my $w ($self->_unexpand_mod_wantlib(@{$self->{wantlib}->{$subpkg}->{libs}})) {
  397. delete $libs_inherited{$w};
  398. }
  399. @libs = grep { !exists $libs_inherited{$_} } @libs;
  400. if ($wantlib_auto) {
  401. for my $w (@{$self->{wantlib_extra}->{$subpkg} // [] }) {
  402. @libs = grep { $_ !~ m,^(?:.*/)?\Q$w\E(?:[<>=].*)?$, } @libs;
  403. }
  404. push(@libs, @{$self->{wantlib_missing}->{$subpkg} // [] });
  405. }
  406. if ($subpkg eq "") {
  407. next if scalar(@libs) == 0;
  408. } else {
  409. next if $self->{wantlib}->{$subpkg}->{inherits_global}
  410. and scalar(@libs) == 1
  411. and $libs[0] eq '${WANTLIB}';
  412. }
  413. if ($subpkg eq "" or !$defpkgchanged or
  414. !$self->{wantlib}->{$subpkg}->{inherits_global}) {
  415. push(@libs, @$wl_add);
  416. }
  417. @libs = sort $self->_unexpand_mod_wantlib(@libs);
  418. print $out "\n" unless $empty_line;
  419. $empty_line = 0;
  420. $nlines++;
  421. my $line = "WANTLIB${subpkg}${ws}= ";
  422. my $expanded = 0;
  423. for my $w (@libs) {
  424. if ($w =~ /^\$/ and $w !~ /^\$[\{\(]WANTLIB/) {
  425. $expanded = 1;
  426. } else {
  427. if ($expanded) {
  428. print $out $line."\n";
  429. $nlines++;
  430. $line = "WANTLIB${subpkg}${ws}+=";
  431. }
  432. $expanded = 0;
  433. }
  434. if (length($line) + 1 + length($w) > 72) {
  435. print $out $line."\n";
  436. $nlines++;
  437. $line = "WANTLIB${subpkg}${ws}+=";
  438. }
  439. $line .= " ".$w;
  440. }
  441. print $out $line."\n";
  442. $nlines++;
  443. $defpkgchanged = 1 if $subpkg eq "";
  444. }
  445. return $nlines;
  446. }
  447. sub _init_wantlib {
  448. my ($self, $subpkg) = @_;
  449. my $rv = 0;
  450. if (!exists $self->{wantlib}->{$subpkg}) {
  451. $rv = 1;
  452. $self->{wantlib}->{$subpkg} = {
  453. libs => [],
  454. wssample => "WANTLIB += foo",
  455. permitline => -1,
  456. reqmanual => 0,
  457. wantlibline => 0,
  458. inherits_global => 0,
  459. }
  460. }
  461. return $rv;
  462. }
  463. #
  464. # Search for places where new REVISION and WANTLIB marks should be added,
  465. # in given makefile, and with what whitespace.
  466. #
  467. sub process_makefile {
  468. my ($self, $in) = (shift, shift);
  469. # subpkg => {
  470. # line => number of line where subpackage is mentioned
  471. # wssample => a line from block to look for whitespace sample in
  472. # blockend => block ending line number
  473. # }
  474. $self->{newrevplace} = {};
  475. $self->{maxrevsin} = { blockend => 0, count => 0 };
  476. my $revsincurblock = 0;
  477. my ($block1begin, $block1end) = (0, 0);
  478. # subpkg => {
  479. # libs => [ wantlib items ... ]
  480. # wssample => a line to look for whitespace sample in
  481. # permitline => number of last line where PERMIT_* variable was set + 1
  482. # reqmanual => 1 if WANTLIB-foo requires manual intervention
  483. # wantlibline => number of last line where WANTLIB$subpkg is mentioned
  484. # inherits_global => 1 if WANTLIB-foo inherits WANTLIB
  485. # }
  486. $self->{wantlib} = {};
  487. # indicator if we're in .if or .for block
  488. my $looplevel = 0;
  489. # list of PERMIT_* variables assigned inside .if/.for,
  490. # used to set permitline at the end of .if/.for block.
  491. my @permits_in_loop = ();
  492. # indicator if last non-empty line was a PERMIT_* one
  493. my $last_was_permit = 0;
  494. # indicator if we're continuing WANTLIB line
  495. my $wantlib_block = 0;
  496. # used for wantlib_blocks to track initial subpackage and whole
  497. # WANTLIB$w_subpkg value
  498. my ($w_subpkg, $w_value);
  499. # list of ${MOD*} variables mentioned in WANTLIBs
  500. my @mod_wantlib_seen;
  501. my @mentionedsubpkgs;
  502. $self->{has_global_rev} = 0;
  503. while (<$in>) {
  504. chomp;
  505. if (/^ *REVISION(\s*)[\+\?\!]*=/) {
  506. $self->{has_global_rev} = 1;
  507. }
  508. if (/^ *PERMIT_(?:PACKAGE_(?:CDROM|FTP)|DISTFILES_FTP)(-[A-Za-z0-9_+]*)?\b/) {
  509. $last_was_permit = 1;
  510. for my $subpkg(keys %{$self->{wantlib}}) {
  511. $self->{wantlib}->{$subpkg}->{permitline}++
  512. if $self->{wantlib}->{$subpkg}->{permitline}
  513. == $in->input_line_number();
  514. }
  515. } elsif (/^ *(?:#.*)?#/) {
  516. for my $subpkg(keys %{$self->{wantlib}}) {
  517. $self->{wantlib}->{$subpkg}->{permitline}++
  518. if $self->{wantlib}->{$subpkg}->{permitline}
  519. == $in->input_line_number();
  520. }
  521. } else {
  522. $last_was_permit = 0;
  523. }
  524. if (/^\. *(if|for)/) {
  525. $looplevel++;
  526. } elsif (/^\. *end(if|for)/) {
  527. $looplevel--;
  528. while (scalar @permits_in_loop) {
  529. my $subpkg = shift @permits_in_loop;
  530. $self->_init_wantlib($subpkg);
  531. $self->{wantlib}->{$subpkg}->{permitline} = $in->input_line_number();
  532. }
  533. } elsif (/^ *(${_rev_neighbors_plain})(-[A-Za-z0-9_+]*)?(\s*)[\+\?\!]*=(\s*)(.*)$/o) {
  534. my $var = $1;
  535. my $subpkg = $2 // "";
  536. $self->{newrevplace}->{$subpkg} //= {};
  537. $self->{newrevplace}->{$subpkg}->{line} = $in->input_line_number();
  538. $self->{newrevplace}->{$subpkg}->{wssample} = $_;
  539. delete $self->{newrevplace}->{$subpkg}->{blockend};
  540. push(@mentionedsubpkgs, $subpkg);
  541. if ($var eq "REVISION") {
  542. if (++$revsincurblock > $self->{maxrevsin}->{count}) {
  543. $self->{maxrevsin}->{blockend} = 0;
  544. $self->{maxrevsin}->{count} = $revsincurblock;
  545. }
  546. }
  547. $block1begin = $in->input_line_number() if !$block1begin;
  548. } elsif ($wantlib_block or /^ *WANTLIB(-[A-Za-z0-9_+]*)?\s*[\+\?\!]*=\s*(.*)$/) {
  549. if ($wantlib_block) {
  550. $_ =~ s/#.*$//;
  551. $w_value .= " ".$_;
  552. } else {
  553. $w_subpkg = $1 // "";
  554. $w_value = $2;
  555. $self->_init_wantlib($w_subpkg);
  556. $self->{wantlib}->{$w_subpkg}->{wssample} = $_;
  557. $self->{wantlib}->{$w_subpkg}->{reqmanual} = 1
  558. if !exists $self->{mpkgs}->{$w_subpkg};
  559. }
  560. $wantlib_block = $w_value =~ s/\s*\\$//;
  561. next if $wantlib_block;
  562. $w_value =~ s/\s*#.*$//;
  563. if ($looplevel) {
  564. $self->{wantlib}->{$w_subpkg}->{reqmanual} = 1;
  565. } else {
  566. $self->{wantlib}->{$w_subpkg}->{line} = $in->input_line_number();
  567. next if $self->{wantlib}->{$w_subpkg}->{reqmanual};
  568. while ($w_value =~ /(\S+)/g) {
  569. my $w = $1;
  570. if ($w !~ /^\$[\{\(].*[\}\)]$/) {
  571. # no problems
  572. } elsif ($w =~ /^\$[\{\(]WANTLIB[\}\)]$/) {
  573. $self->{wantlib}->{$w_subpkg}->{inherits_global} = 1;
  574. } elsif ($w =~ /^\$[\{\(](MOD.+)[\}\)]$/) {
  575. push(@mod_wantlib_seen, $1);
  576. } else {
  577. $self->{wantlib}->{$w_subpkg}->{reqmanual} = 1;
  578. }
  579. push @{$self->{wantlib}->{$w_subpkg}->{libs}}, $w;
  580. }
  581. delete $self->{wantlib}->{$w_subpkg}->{blockend};
  582. }
  583. } elsif (/^ *PERMIT_(?:PACKAGE_(?:CDROM|FTP)|DISTFILES_FTP)(-[A-Za-z0-9_+]*)?\b/) {
  584. my $subpkg = $1 // "";
  585. $self->_init_wantlib($subpkg);
  586. $self->{wantlib}->{$subpkg}->{permitline} = $in->input_line_number();
  587. push(@permits_in_loop, $subpkg) if $looplevel;
  588. } elsif (/^\s*$/) {
  589. for my $subpkg(@mentionedsubpkgs) {
  590. $self->{newrevplace}->{$subpkg}->{blockend} = $in->input_line_number();
  591. }
  592. $self->{maxrevsin}->{blockend} = $in->input_line_number()
  593. if $self->{maxrevsin}->{blockend} == 0;
  594. @mentionedsubpkgs = ();
  595. $revsincurblock = 0;
  596. $block1end = $in->input_line_number()
  597. if $block1begin && !$block1end;
  598. } elsif (!/^ *(\#|BROKEN|COMES_WITH|IGNORE|NOT_FOR_ARCHS|ONLY_FOR_ARCHS)/) {
  599. $block1begin = $in->input_line_number() if !$block1begin;
  600. }
  601. }
  602. for my $subpkg(@mentionedsubpkgs) {
  603. $self->{newrevplace}->{$subpkg}->{blockend} = $in->input_line_number();
  604. }
  605. if ($self->{maxrevsin}->{blockend} == 0) {
  606. $self->{maxrevsin}->{blockend} = $block1end ? $block1end :
  607. $in->input_line_number();
  608. }
  609. # make sure new REVISION-foo won't arise when bumping REVISION
  610. if ($self->{has_global_rev} and $self->{maxrevsin}->{blockend} <
  611. $self->{newrevplace}->{""}->{blockend}) {
  612. $self->{maxrevsin}->{blockend} = $self->{newrevplace}->{""}->{blockend};
  613. $self->{maxrevsin}->{count} = 2; # see _add_new_revs for >1 check
  614. }
  615. return unless $self->{tweak_wantlib};
  616. my $wstart = -1;
  617. # first, try to find a place for WANTLIB after PERMIT_* lines
  618. for my $subpkg(keys %{$self->{wantlib}}) {
  619. if ($self->{wantlib}->{$subpkg}->{permitline} > $wstart) {
  620. $wstart = $self->{wantlib}->{$subpkg}->{permitline};
  621. }
  622. }
  623. # next, find first WANTLIB line and use it
  624. if ($wstart == -1) {
  625. $wstart = $in->input_line_number();
  626. for my $subpkg(keys %{$self->{wantlib}}) {
  627. if ($self->{wantlib}->{$subpkg}->{line} < $wstart) {
  628. $wstart = $self->{wantlib}->{$subpkg}->{line};
  629. }
  630. }
  631. }
  632. # finally, try to anchor to @_REV_NEIGHBORS items
  633. if ($wstart == $in->input_line_number()) {
  634. $wstart = -1;
  635. for my $subpkg(keys %{$self->{newrevplace}}) {
  636. if ($self->{newrevplace}->{$subpkg}->{line} > $wstart) {
  637. $wstart = $self->{newrevplace}->{$subpkg}->{line};
  638. }
  639. }
  640. if ($wstart == -1) {
  641. $self->_init_wantlib("");
  642. $self->{wantlib}->{""}->{reqmanual} = 1;
  643. } else {
  644. $wstart++;
  645. }
  646. }
  647. $self->{wantlib_start} = $wstart;
  648. my $gcc4_seen = 0;
  649. push(@mod_wantlib_seen, map {
  650. $gcc4_seen = 1 if $_ eq "gcc4";
  651. my $v = uc($_);
  652. $v =~ s,.*/,,g;
  653. $v =~ s,^PYTHON$,PY,g;
  654. "MOD${v}_WANTLIB"
  655. } @{$self->{modules}});
  656. push(@mod_wantlib_seen, "MODGCC4_CPPWANTLIB", "MODGCC4_GCJWANTLIB")
  657. if $gcc4_seen;
  658. if (scalar(@mod_wantlib_seen)) {
  659. my $show = 'show='.join(' ', @mod_wantlib_seen);
  660. open (my $makeh, '-|', 'make', $show)
  661. or die "cannot run make $show: $!";
  662. while (<$makeh>) {
  663. chomp;
  664. my $m = shift @mod_wantlib_seen;
  665. $self->{wantlib_mod}->{$m} = { map {
  666. Util::w_stem($_) => $_
  667. } split(/\s+/, $_) };
  668. }
  669. close $makeh;
  670. }
  671. }
  672. { my %manual_noticed;
  673. sub _update_shlibs {
  674. my ($self, $shline) = @_;
  675. my @splitres = split(/\s+/, $shline);
  676. my $nchanges = 0;
  677. if (scalar(@splitres) % 2 != 0) {
  678. # avoid pointless error message from Perl
  679. if (!defined $manual_noticed{$self->{dir}}) {
  680. printf STDERR $self->{dir} .
  681. " may need manual intervention\n";
  682. $manual_noticed{$self->{dir}} = 1;
  683. }
  684. } else {
  685. my %lineshlibs = @splitres;
  686. for my $lib (keys %lineshlibs) {
  687. my $v = $self->{shlibs}->{$lib} // next;
  688. printf STDERR "%-30s: changing shared library ".
  689. "%s version to %s\n",
  690. $self->{dir}, $lib, $v
  691. if $self->{verbose};
  692. $nchanges++ if s/($lib\s+)[0-9]+\.[0-9]+/$1$v/g;
  693. }
  694. }
  695. return $nchanges;
  696. } }
  697. sub update {
  698. my ($self, $in, $out, $bumppkgs, $bumprevs, $removerevs, $bumpshlibs,
  699. $wl_add, $wl_del) = @_;
  700. if ($self->{tweak_wantlib}) {
  701. for my $subpkg (keys %$bumppkgs) {
  702. next unless exists $bumppkgs->{$subpkg};
  703. next unless exists $self->{wantlib}->{$subpkg};
  704. next unless $self->{wantlib}->{$subpkg}->{reqmanual};
  705. printf STDERR "%s requires manual WANTLIB handling\n",
  706. $self->{dir};
  707. return -1;
  708. }
  709. }
  710. my $defbumped = 0;
  711. my ($shlib_block, $wantlib_block) = (0, 0);
  712. my $nchanges = 0;
  713. my $wl_ws_removal;
  714. my ($empty_line, $prev_line_was_empty) = (1, 1);
  715. while (<$in>) {
  716. chomp;
  717. $prev_line_was_empty = $empty_line;
  718. $empty_line = 0;
  719. if ($shlib_block or /^ *SHARED_LIBS/) {
  720. $wl_ws_removal = undef;
  721. my $shline = $_;
  722. # N.B.: Some ports define SHARED_LIBS in subpackage-
  723. # dependant way, i.e., add them only if
  724. # the corresponding subpackage should be built,
  725. # or use subpackage-specific lists of shared libs
  726. # for additional tasks.
  727. $shlib_block or $shline =~ s/^ *SHARED_LIBS(?:\S+)?\s*\+?=\s*//;
  728. $shlib_block = $shline =~ s/\s*\\$//;
  729. if ($bumpshlibs) {
  730. # XXX will misbehave after "<...> # \"
  731. $shline =~ s/\\s*#.*//;
  732. $shline =~ s/^\s*//;
  733. $nchanges += $self->_update_shlibs($shline);
  734. }
  735. } elsif ($wantlib_block or /^ *WANTLIB(?:-[A-Za-z0-9_+]*)?\s*[\+\?\!]*=/) {
  736. my $line = $_;
  737. $wantlib_block = $line =~ s/\s*\\$//;
  738. if ($self->{tweak_wantlib}) {
  739. $_ = undef;
  740. $empty_line = $prev_line_was_empty;
  741. $wl_ws_removal = 0 unless defined $wl_ws_removal;
  742. }
  743. } elsif (/^ *REVISION(-[A-Za-z0-9_+]+)?.*=\s*([0-9]*)$/) {
  744. $wl_ws_removal = undef;
  745. my $subpkg = $1 // "";
  746. if ($removerevs) {
  747. $nchanges++;
  748. $_ = undef;
  749. $empty_line = $prev_line_was_empty;
  750. } elsif (!$bumprevs) {
  751. # do nothing
  752. } elsif (exists $bumppkgs->{$subpkg} or
  753. ($subpkg eq "" and scalar(keys %{$self->{mpkgs}}) ==
  754. scalar(keys %{$bumppkgs}))) {
  755. my $rev = $2 // -1;
  756. my $newrev = $rev + 1;
  757. printf STDERR "%-30s: changing %s to %d\n",
  758. $self->{dir}, $_, $newrev
  759. if $self->{verbose};
  760. $nchanges++ if s/[0-9]*$/$newrev/;
  761. delete $bumppkgs->{$subpkg};
  762. $defbumped = 1 if $subpkg eq "";
  763. }
  764. } elsif (/^\s*$/) {
  765. $empty_line = 1;
  766. if (defined $wl_ws_removal) {
  767. $_ = undef if $wl_ws_removal > 0;
  768. $wl_ws_removal++;
  769. }
  770. } elsif (defined($wl_ws_removal) and $wl_ws_removal != -1) {
  771. $wl_ws_removal = undef;
  772. }
  773. if (!$empty_line and defined($wl_ws_removal) and $wl_ws_removal == -1) {
  774. print $out "\n";
  775. $wl_ws_removal = undef;
  776. }
  777. if ($bumprevs and !$defbumped) {
  778. my $n = $self->_add_new_revs($out,
  779. $in->input_line_number(), $bumppkgs);
  780. $wl_ws_removal = undef if $n;
  781. $nchanges += $n;
  782. }
  783. if (defined $_) {
  784. print $out "$_\n";
  785. print STDERR "$_\n" if $self->{verbose};
  786. } elsif ($self->{verbose}) {
  787. print STDERR "<skipping line>\n";
  788. }
  789. if ($self->{tweak_wantlib} and
  790. $in->input_line_number() == $self->{wantlib_start}) {
  791. print STDERR "putting new WANTLIB lines at $self->{wantlib_start}\n" if $self->{verbose};
  792. $nchanges += $self->_put_wantlib_lines($out, $bumppkgs,
  793. $wl_add, $wl_del, $empty_line);
  794. $wl_ws_removal = 0;
  795. }
  796. }
  797. if ($bumprevs) {
  798. for my $subpkg(sort keys %{$bumppkgs}) {
  799. next if defined $self->{newrevplace}->{$subpkg}->{blockend};
  800. print STDERR "can't find a suitable place for ".
  801. "REVISION${subpkg} mark in ".$self->{dir}."\n";
  802. return -1;
  803. }
  804. }
  805. return $nchanges;
  806. }
  807. #################################################################
  808. package main;
  809. use strict;
  810. use warnings;
  811. use v5.14;
  812. use OpenBSD::Getopt;
  813. sub usage {
  814. print join("\n", @_) if scalar @_;
  815. print STDERR
  816. "usage: portbump [-dMmrnv] [-o outfile] [-W lib] [-w lib] [dir ...]\n";
  817. exit 1;
  818. }
  819. our ($opt_d, $opt_l, $opt_M, $opt_m, $opt_n, $opt_o, $opt_r, $opt_v) =
  820. (0, 0, 0, 0, 0, undef, undef, 0);
  821. my (@wl_add, @wl_del);
  822. eval { getopts('dlMmno:rW:w:v', {
  823. 'd' => sub { $opt_d++; },
  824. 'l' => sub { $opt_l++; },
  825. 'M' => sub { $opt_M++; },
  826. 'm' => sub { $opt_m++; },
  827. 'n' => sub { $opt_n++; },
  828. 'o' => sub { $opt_o = shift; },
  829. 'v' => sub { $opt_v++; },
  830. 'r' => sub { $opt_r++; },
  831. 'W' => sub { push(@wl_add, shift); },
  832. 'w' => sub { push(@wl_del, shift); },
  833. }) } // usage $@;
  834. $opt_d && $opt_r and usage "cannot mix -d and -r options";
  835. $opt_m && $opt_M and usage "cannot mix -M and -m options";
  836. scalar(@wl_add) || scalar(@wl_del) and $opt_l = 1;
  837. !defined($opt_r) && !$opt_M && !$opt_m && !$opt_d && !$opt_l
  838. and $opt_r = 1;
  839. my %allpkgs; # dir => { subpkg => 1, ... };
  840. my %newrevplace;
  841. scalar(@ARGV) or @ARGV = (".");
  842. for (@ARGV) {
  843. # zap any FLAVOR information to make it easier to feed from of sqlports
  844. s/,+[^,-]*/,/g;
  845. # Allow simple "-subpkg" instead of ugly ",-subpkg"
  846. s/^-/,-/;
  847. if (/^(.*),(-.+)$/) {
  848. my $subdir = $1 || ".";
  849. if (defined $allpkgs{$subdir}) {
  850. if (scalar($allpkgs{$subdir}) == 0) {
  851. die "mixed non-subpackaged and subpackaged for $subdir";
  852. } elsif (exists $allpkgs{$subdir}->{$2}) {
  853. # XXX maybe just ignore?
  854. $opt_v and print STDERR "double bump of \"$_\" requested, ignoring";
  855. }
  856. } else {
  857. $allpkgs{$subdir} = {};
  858. }
  859. $allpkgs{$subdir}->{$2} = 1;
  860. } else {
  861. if (defined $allpkgs{$_}) {
  862. die "mixed non-subpackaged and subpackaged for $_";
  863. }
  864. $allpkgs{$_} = {};
  865. }
  866. }
  867. if (defined($opt_o) and scalar(keys %allpkgs) > 1) {
  868. usage "cannot use -o if more than one port is being processed";
  869. }
  870. if ($opt_v) {
  871. print STDERR "port directories to visit:\n";
  872. for my $dir (keys %allpkgs) {
  873. print STDERR "\t$dir\n";
  874. }
  875. }
  876. my $exitstatus = 0;
  877. for my $dir (keys %allpkgs) {
  878. my $scan_lib_depends = $opt_l;
  879. $scan_lib_depends = 0 if scalar(@wl_add) || scalar(@wl_del);
  880. my $lib_depends_tgt;
  881. if ($scan_lib_depends) {
  882. $lib_depends_tgt = ($scan_lib_depends == 1) ?
  883. 'port-lib-depends-check' : 'lib-depends-check';
  884. }
  885. my $port = PortHandler->new($dir, $opt_l, $lib_depends_tgt);
  886. if (!defined $port) {
  887. $exitstatus = 1;
  888. next;
  889. }
  890. $port->verbose(1) if $opt_v;
  891. #
  892. # Bump library versions, if requested.
  893. #
  894. if ($opt_M or $opt_m) {
  895. for my $lib (keys %{$port->{shlibs}}) {
  896. my ($major, $minor) = split(/\./, $port->{shlibs}->{$lib});
  897. if ($opt_M) {
  898. $major++;
  899. $minor = 0;
  900. } else {
  901. $minor++;
  902. }
  903. $port->{shlibs}->{$lib} = "${major}.${minor}";
  904. }
  905. }
  906. #
  907. # Read port information, choose what subpackages to bump.
  908. #
  909. open (my $in, '<', "$dir/Makefile") or
  910. die "cannot open input file $dir/Makefile: $!";
  911. $port->process_makefile($in);
  912. my $bumppkgs;
  913. if (scalar(keys %{$allpkgs{$dir}}) != 0) {
  914. for my $subpkg (keys %{$allpkgs{$dir}}) {
  915. next if exists $port->{mpkgs}->{$subpkg};
  916. die "there is no $dir,$subpkg package";
  917. }
  918. $bumppkgs = $allpkgs{$dir};
  919. } else {
  920. $bumppkgs = $port->{mpkgs};
  921. }
  922. #
  923. # Actual update process.
  924. #
  925. my $outpath = $opt_o // "$dir/Makefile.bump";
  926. open (my $out, '>', $outpath) or
  927. die "cannot open output file $outpath: $!";
  928. seek($in, 0, 0);
  929. $in->input_line_number(0);
  930. my $nchanges = $port->update($in, $out, $bumppkgs, $opt_r, $opt_d,
  931. $opt_m|$opt_M, \@wl_add, \@wl_del);
  932. close($in);
  933. close($out);
  934. if ($nchanges == -1) {
  935. # warning message should be printed already
  936. unlink $outpath;
  937. $exitstatus = 1;
  938. } elsif (!defined $opt_o) {
  939. if (!$nchanges) {
  940. print STDERR "nothing to do in $dir\n" if $opt_v;
  941. unlink $outpath;
  942. } elsif (!$opt_n) {
  943. rename($outpath, "$dir/Makefile") or
  944. die "cannot move $outpath to $dir/Makefile: $!"
  945. }
  946. }
  947. }
  948. exit $exitstatus;