1package Mport::Utils;
2#
3# $MidnightBSD: mports/Tools/lib/Mport/Utils.pm,v 1.5 2007/11/05 16:52:38 ctriv Exp $
4#
5use strict;
6use warnings;
7use Exporter ();
8use Cwd ();
9use Text::ParseWords qw(shellwords);
10
11use Mport::Globals qw($MAKE $ROOT);
12
13*import = \&Exporter::import;
14
15our @EXPORT_OK = qw(make_var recurse_ports);
16
17sub make_var {
18  my $vars  = join(' ', map { "-V $_" } @_);
19  my $ret   = `$MAKE $vars`;
20
21  if (wantarray) {
22    return shellwords($ret);
23  } else {
24    chomp($ret);
25    return $ret;
26  }
27}
28
29sub recurse_ports (&;@) {
30  my ($code, %args) = @_;
31  my $orig = Cwd::getcwd();
32
33  my $root    = $args{root} || $ROOT;
34  my $nochdir = $args{nochdir} || sub { die "Couldn't chdir to @_: $!" };
35
36  _do_recurse($code, $root, $nochdir);
37
38  chdir($orig);
39}
40
41sub _do_recurse {
42  my ($code, $cwd, $nochdir) = @_;
43
44  chdir($cwd) || do { $nochdir->($cwd); return };
45
46  # Calling make is expensive.  Only do so if we need to.
47  if (-e 'pkg-descr' || -e 'pkg-plist') {
48    return $code->($cwd);
49  }
50
51  # it is actually much faster to check if it is a dir makefile than to call
52  # make and ask.
53  open(my $make, '<', "Makefile") || die "Couldn't open $cwd/Makefile: $!\n";
54  while (<$make>) {
55    if (m/bsd.port.subdir.mk/) {
56      my @dirs = make_var('SUBDIR');
57      # close the filehandle before we recurse.
58      close($make);
59      if (@dirs) {
60        foreach my $dir (@dirs) {
61          _do_recurse($code, "$cwd/$dir", $nochdir);
62        }
63      }
64
65      # we're done with this makefile.
66      return;
67    }
68  }
69
70  # must be a real port!
71  close($make);
72  $code->($cwd);
73}
74
751;
76__END__
77