1 package Wx::build::Utils;
6 use File::Spec::Functions qw(curdir catdir catfile updir);
7 use File::Find qw(find);
8 use File::Path qw(mkpath);
9 use File::Basename qw(dirname);
12 use vars qw(@EXPORT @EXPORT_OK);
13 @EXPORT_OK = qw(obj_from_src xs_dependencies write_string
14 lib_file arch_file arch_auto_file
15 path_search files_with_overload files_with_constants
16 pipe_stderr read_file write_file);
20 Wx::build::Utils - utility routines
24 =head2 xs_dependencies
26 my %dependencies = xs_dependencies( $mm_object, [ 'dir1', 'dir2' ] );
32 $x{$_} = 1 foreach @_;
37 my( $this, $dirs, $top_dir ) = @_;
40 my( $c, $o, $cinclude, $xsinclude );
42 foreach ( keys %{ $this->{XS} } ) {
43 ( $cinclude, $xsinclude ) = scan_xs( $_, $dirs, $top_dir );
46 $o = obj_from_src( $c );
48 $depend{$c} = $_ . ' ' . join( ' ', _uniq( @$xsinclude ) );
49 $depend{$o} = $c . ' ' . join( ' ', _uniq( @$cinclude ) );
57 my @obj_files = obj_from_src( 'Foo.xs', 'bar.c', 'cpp/bar.cpp' );
59 Calculates the object file name from the source file name.
60 In scalar context returns the first file.
66 my $obj_ext = $Config{obj_ext} || $Config{_o};
68 foreach ( @xs ) { s[\.(?:xs|c|cc|cpp)$][$obj_ext] }
70 return wantarray ? @xs : $xs[0];
78 return $d if -f catfile( $d, $file );
79 $d = catdir( updir, $d );
82 confess "Unable to find top level directory ($file)";
86 # quick and dirty method for creating dependencies:
87 # considers files included via #include "..." or INCLUDE: ...
88 # (not #include <...>) and does not take into account preprocessor directives
93 my( $xs, $incpath, $top_dir ) = @_;
96 my( @cinclude, @xsinclude );
103 while( defined( $_ = <IN> ) ) {
106 m/^\#\s*include\s+"([^"]*)"\s*$/ and $file = $1 and $arr = \@cinclude;
107 m/^\s*INCLUDE:\s+(.*)$/ and $file = $1 and $arr = \@xsinclude;
108 m/^\s*INCLUDE:\s+.*\s(\S+\.xsp?)\s*\|/ and $file = $1 and
111 if( defined $file ) {
112 $file = catfile( split '/', $file );
114 foreach my $dir ( @$incpath ) {
115 my $f = $dir eq curdir() ? $file : catfile( $dir, $file );
118 my( $cinclude, $xsinclude ) = scan_xs( $f, $incpath, $top_dir );
119 push @cinclude, @$cinclude;
120 push @xsinclude, @$xsinclude;
122 } elsif( $file =~ m/ovl_const\.(?:cpp|h)/i
123 || $file =~ m/v_cback_def\.h/i
124 || $file =~ m/ItemContainer(?:Immutable)?\.xs/i
125 || $file =~ m/Var[VH]{0,2}ScrollHelper(?:Base)?\.xs/i ) {
126 push @$arr, ( ( $top_dir eq curdir() ) ?
128 catfile( $top_dir, $file ) );
136 ( \@cinclude, \@xsinclude );
139 =head2 write_string, write_file
141 write_string( 'file', $scalar );
142 write_file( 'file', $scalar );
148 my $string = read_file( 'file' );
152 *write_string = \&write_file;
155 my( $file, $string ) = @_;
157 mkpath( dirname( $file ) ) if dirname( $file );
158 open my $fh, ">", $file or die "open '$file': $!";
160 print $fh $string or die "print '$file': $!";
161 close $fh or die "close '$file': $!";
167 local $/ = wantarray ? $/ : undef;;
168 open my $fh, "<", $file or die "open '$file': $!";
174 =head2 lib_file, arch_file, arch_auto_file
176 my $file = lib_file( 'Foo.pm' ); # blib/lib/Foo.pm on *nix
177 my $file = lib_file( 'Foo/Bar.pm' ); # blib\lib\Foo\Bar.pm on Win32
178 my $file = arch_auto_file( 'My\My.dll' ); # blib\arch\auto\My\My.dll
180 All input paths must be relative, output paths may be absolute.
185 require File::Spec::Unix;
188 my( $volume, $dir, $file ) = File::Spec::Unix->splitpath( $path );
189 my @dirs = File::Spec::Unix->splitdir( $dir );
191 return ( @dirs, $file );
195 my @split = _split( shift );
197 return File::Spec->catfile( 'blib', 'lib', @split );
201 my @split = _split( shift );
203 return File::Spec->catfile( 'blib', 'arch', @split );
207 my @split = _split( shift );
209 return File::Spec->catfile( 'blib', 'arch', 'auto', @split );
214 my $file = path_search( 'foo.exe' );
216 Searches PATH for the given executable.
223 foreach my $d ( File::Spec->path ) {
224 my $full = File::Spec->catfile( $d, $file );
225 return $full if -f $full;
231 =head2 files_with_constants
233 my @files = files_with_constants;
235 Finds files containing constants
239 sub files_with_constants {
243 my $name = $File::Find::name;
245 m/\.(?:pm|xsp?|cpp|h)$/i && do {
249 open IN, "< $_" || warn "unable to open '$_'";
250 while( defined( $line = <IN> ) ) {
251 $line =~ m/^\W+\!\w+:/ && do {
259 find( $wanted, curdir );
264 =head2 files_with_overload
266 my @files = files_with_overload;
268 Finds files containing overloaded XS/Perl subroutines
272 sub files_with_overload {
276 my $name = $File::Find::name;
282 open IN, "< $_" || warn "unable to open '$_'";
283 while( defined( $line = <IN> ) ) {
284 $line =~ m/Wx::_match/ && do {
295 open IN, "< $_" || warn "unable to open '$_'";
296 while( defined( $line = <IN> ) ) {
297 $line =~ m/wxPli_match_arguments|BEGIN_OVERLOAD\(\)/ && do {
305 find( $wanted, curdir );
312 my $pipe = File::Spec->catfile( 'script', 'pipe.pl' );
315 return qx{$^X $pipe $cmd};
317 # fix quoting later if necessary
318 return qx[$^X -e "open STDERR, q{>&STDOUT}; exec q{$cmd}"];