view release on metacpan or  search on metacpan

t/lib/MakeMaker/Test/Utils.pm  view on Meta::CPAN

            $have_compiler = $cb->have_compiler;
        };
    });

    return $have_compiler;
}

=item slurp

  $contents = slurp($filename);

Returns the $contents of $filename.

Will die if $filename cannot be opened.

=cut

sub slurp {
    my $filename = shift;

    local $/ = undef;
    open my $fh, $filename or die "Can't open $filename for reading: $!";
    my $text = <$fh>;
    close $fh;

    return $text;
}

=item write_file

  write_file('filename', @contents);

Writes the content to the given file. Will die if errors occur.

=cut

sub write_file {
  my ($file, @contents) = @_;
  my $utf8 = ("$]" < 5.008 or !$Config{useperlio}) ? "" : ":utf8";
  open my $fh, ">$utf8", $file or die "Can't create $file: $!";
  print $fh @contents or die "Can't write to $file: $!";
  close $fh or die "Can't close $file: $!";
}

=item hash2files

  hash2files('dirname', { 'filename' => 'some content' });

Goes through given hash-ref, treating each key as a /-separated filename
under the specified directory, and writing the value into it. Will create
any necessary directories.

Will die if errors occur.

=cut

sub hash2files {
    my ($prefix, $hashref) = @_;
    while(my ($file, $text) = each %$hashref) {
        # Convert to a relative, native file path.
        $file = File::Spec->catfile(File::Spec->curdir, $prefix, split m{\/}, $file);
        my $dir = dirname($file);
        mkpath $dir;
        write_file($file, $text);
        # ensure file at least 1 second old for makes that assume
        # files with the same time are out of date.
        my $time = calibrate_mtime();
        utime $time, $time - 1, $file;
    }
}

=item in_dir

  $retval = in_dir(\&coderef);
  $retval = in_dir(\&coderef, $specified_dir);
  $retval = in_dir { somecode(); };
  $retval = in_dir { somecode(); } $specified_dir;

Does a C<chdir> to either a directory. If none is specified, one is
created with L<File::Temp> and then automatically deleted after. It ends
by C<chdir>ing back to where it started.

If the given code throws an exception, it will be re-thrown after the
re-C<chdir>.

Returns the return value of the given code.

=cut

sub in_dir(&;$) {
    my $code = shift;
    require File::Temp;
    my $dir = shift || File::Temp::tempdir(TMPDIR => 1, CLEANUP => 1);
    # chdir to the new directory
    my $orig_dir = getcwd();
    chdir $dir or die "Can't chdir to $dir: $!";
    # Run the code, but trap the error so we can chdir back
    my $return;
    my $ok = eval { $return = $code->(); 1; };
    my $err = $@;
    # chdir back
    chdir $orig_dir or die "Can't chdir to $orig_dir: $!";
    # rethrow if necessary
    die $err unless $ok;
    return $return;
}

=back

=head1 AUTHOR

Michael G Schwern <schwern@pobox.com>

=cut

1;