File Coverage

blib/lib/Cwd/Guard.pm
Criterion Covered Total %
statement 32 32 100.0
branch 3 4 75.0
condition n/a
subroutine 9 9 100.0
pod 1 2 50.0
total 45 47 95.7


line stmt bran cond sub pod time code
1             package Cwd::Guard;
2              
3 2     2   211709 use strict;
  2         5  
  2         149  
4 2     2   11 use warnings;
  2         3  
  2         138  
5 2     2   4197 use parent 'Exporter';
  2         2506  
  2         13  
6              
7             our @EXPORT_OK = qw/cwd_guard/;
8             our $Error;
9              
10             our $VERSION = '0.04';
11              
12 2     2   372 use constant USE_FCHDIR => eval { opendir my $dh, '.'; chdir $dh; 1 };
  2         3  
  2         4  
  2         97  
  2         73  
  2         240  
13 2     2   12297 use if !USE_FCHDIR, Cwd => qw/getcwd/;
  2         28  
  2         14  
14              
15             sub cwd_guard {
16 2     2 1 606 my $dir = shift;
17 2         18 __PACKAGE__->new($dir);
18             }
19              
20             sub new {
21 2     2 0 5 my $class = shift;
22 2         3 my $dir = shift;
23 2         4 my $cwd;
24 2         3 if (USE_FCHDIR) { opendir $cwd, '.' } else { $cwd = getcwd() }
  2         69  
25             my $callback = sub {
26 1     1   36 chdir $cwd;
27 2         12 };
28 2 50       34 my $result = defined $dir ? chdir($dir) : chdir();
29 2         15 $Error = $!;
30 2 100       23 return unless $result;
31 1         6 bless $callback, $class;
32             }
33              
34             sub DESTROY {
35 1     1   1740 $_[0]->();
36             }
37              
38              
39             1;
40             __END__
41              
42             =head1 NAME
43              
44             Cwd::Guard - Temporary changing working directory (chdir)
45              
46             =head1 SYNOPSIS
47              
48             use Cwd::Guard qw/cwd_guard/;
49             use Cwd;
50              
51             my $dir = getcwd;
52             MYBLOCK: {
53             my $guard = cwd_guard('/tmp/xxxxx') or die "failed chdir: $Cwd::Guard::Error";
54             # chdir to /tmp/xxxxx
55             }
56             # back to $dir
57              
58              
59             =head1 DESCRIPTION
60              
61             CORE::chdir Cwd:: Guard can change the current directory (chdir) using a limited scope.
62              
63             =head1 FUNCTIONS
64              
65             =over 4
66              
67             =item cwd_guard($dir);
68              
69             chdir to $dir and returns Cwd::Guard object. return to current working directory, if this object destroyed.
70             if failed to chdir, cwd_guard return undefined value. You can get error messages with $Gwd::Guard::Error.
71              
72             =back
73              
74             =head1 AUTHOR
75              
76             Masahiro Nagano E<lt>kazeburo {at} gmail.comE<gt>
77              
78             =head1 SEE ALSO
79              
80             L<File::chdir>, L<File::pushd>
81              
82             =head1 LICENSE
83              
84             Copyright (C) Masahiro Nagano
85              
86             This library is free software; you can redistribute it and/or modify
87             it under the same terms as Perl itself.
88              
89             =cut