1 |
=head1 NAME
|
2 |
|
3 |
Utilities::AddDir - Utility functions for creating or copying directories.
|
4 |
|
5 |
=head1 SYNOPSIS
|
6 |
|
7 |
&Utilities::AddDir::adddir($dir);
|
8 |
&Utilities::AddDir::copydir($src,$dest);
|
9 |
&Utilities::AddDir::copydirwithskip($src,$dest,@files_to_skip);
|
10 |
|
11 |
=head1 METHODS
|
12 |
|
13 |
=over
|
14 |
|
15 |
=cut
|
16 |
|
17 |
package AddDir;
|
18 |
require 5.001;
|
19 |
require Exporter;
|
20 |
use Cwd;
|
21 |
@ISA = qw(Exporter);
|
22 |
@EXPORT = qw(adddir copydir copydirwithskip);
|
23 |
|
24 |
=item C<adddir($dir)>
|
25 |
|
26 |
Create a new directory.
|
27 |
|
28 |
=cut
|
29 |
|
30 |
sub adddir {
|
31 |
my $indir=shift;
|
32 |
my $startdir=cwd;
|
33 |
my @dir=split /\//, $indir;
|
34 |
|
35 |
if ( $indir=~/^\// ) {
|
36 |
chdir "/";
|
37 |
shift @dir;
|
38 |
}
|
39 |
umask 02;
|
40 |
foreach $dirname ( @dir ) {
|
41 |
next if ( $dirname eq "" );
|
42 |
if ( ! -e $dirname ) {
|
43 |
mkdir ( $dirname , 0755) ||
|
44 |
die "cannot make directory ".$dirname." $!\n";
|
45 |
print $i." ".$dirname."\n" if $debug;
|
46 |
}
|
47 |
chdir $dirname;
|
48 |
}
|
49 |
chdir $startdir;
|
50 |
}
|
51 |
|
52 |
|
53 |
=item C<copydir($src, $dest)>
|
54 |
|
55 |
Copy a directory $src and contents to $dest.
|
56 |
|
57 |
=cut
|
58 |
|
59 |
sub copydir
|
60 |
{
|
61 |
my $src=shift;
|
62 |
my $dest=shift;
|
63 |
|
64 |
use DirHandle;
|
65 |
use File::Copy;
|
66 |
|
67 |
adddir($dest);
|
68 |
my $dh=DirHandle->new($src);
|
69 |
|
70 |
if (defined $dh)
|
71 |
{
|
72 |
my @allfiles=$dh->read();
|
73 |
|
74 |
my $file;
|
75 |
foreach $file ( @allfiles )
|
76 |
{
|
77 |
next if $file=~/^\.\.?/;
|
78 |
if ( -d $src."/".$file )
|
79 |
{
|
80 |
copydir($src."/".$file,$dest."/".$file);
|
81 |
}
|
82 |
else
|
83 |
{
|
84 |
copy($src."/".$file,$dest."/".$file);
|
85 |
if ( -x $src."/".$file || -X $src."/".$file ) {chmod(0755,$dest."/".$file);}
|
86 |
}
|
87 |
}
|
88 |
undef $dh;
|
89 |
}
|
90 |
else
|
91 |
{
|
92 |
die "Attempt to open a non-existent directory ($src). Exitting\n";
|
93 |
}
|
94 |
}
|
95 |
|
96 |
=item C<copydirwithskip($src, $dest, @files_to_skip)>
|
97 |
|
98 |
Recursively copy a directory $src to $dest. All files
|
99 |
in @files_to_skip will be skipped.
|
100 |
|
101 |
=cut
|
102 |
|
103 |
sub copydirwithskip
|
104 |
{
|
105 |
my $src=shift;
|
106 |
my $dest=shift;
|
107 |
my ($filetoskip)=@_;
|
108 |
|
109 |
use DirHandle;
|
110 |
use File::Copy;
|
111 |
|
112 |
adddir($dest);
|
113 |
|
114 |
my $dh=DirHandle->new($src);
|
115 |
|
116 |
if (defined $dh)
|
117 |
{
|
118 |
my @allfiles=$dh->read();
|
119 |
|
120 |
my $file;
|
121 |
foreach $file ( @allfiles )
|
122 |
{
|
123 |
next if $file=~/^\.\.?/;
|
124 |
# Skip backup files and x~ files:
|
125 |
next if $file =~ /.*bak$/;
|
126 |
next if $file =~ /.*~$/;
|
127 |
|
128 |
if ($file eq $filetoskip)
|
129 |
{
|
130 |
next;
|
131 |
}
|
132 |
|
133 |
if ( -d $src."/".$file )
|
134 |
{
|
135 |
copydir($src."/".$file,$dest."/".$file);
|
136 |
}
|
137 |
else
|
138 |
{
|
139 |
copy($src."/".$file,$dest."/".$file);
|
140 |
if ( -x $src."/".$file || -X $src."/".$file ) {chmod(0755,$dest."/".$file);}
|
141 |
}
|
142 |
}
|
143 |
undef $dh;
|
144 |
}
|
145 |
else
|
146 |
{
|
147 |
die "Attempt to open a non-existent directory ($src). Exitting\n";
|
148 |
}
|
149 |
}
|
150 |
|
151 |
=back
|
152 |
|
153 |
=head1 AUTHOR
|
154 |
|
155 |
Originally written by Christopher Williams.
|
156 |
|
157 |
=head1 MAINTAINER
|
158 |
|
159 |
Shaun ASHBY
|
160 |
|
161 |
=cut
|
162 |
|