| 14 |
|
|
| 15 |
|
=cut |
| 16 |
|
|
| 17 |
< |
package AddDir; |
| 17 |
> |
package Utilities::AddDir; |
| 18 |
|
require 5.001; |
| 19 |
|
require Exporter; |
| 20 |
|
use Cwd; |
| 21 |
|
@ISA = qw(Exporter); |
| 22 |
< |
@EXPORT = qw(adddir copydir copydirwithskip); |
| 22 |
> |
@EXPORT = qw(adddir copydir copydirwithskip copydirexp getfileslist fixpath); |
| 23 |
|
|
| 24 |
|
=item C<adddir($dir)> |
| 25 |
|
|
| 27 |
|
|
| 28 |
|
=cut |
| 29 |
|
|
| 30 |
+ |
|
| 31 |
+ |
sub fixpath { |
| 32 |
+ |
my $dir=shift; |
| 33 |
+ |
my @parts=(); |
| 34 |
+ |
my $p="/"; |
| 35 |
+ |
if($dir!~/^\//){$p="";} |
| 36 |
+ |
foreach my $part (split /\//, $dir) |
| 37 |
+ |
{ |
| 38 |
+ |
if($part eq ".."){pop @parts;} |
| 39 |
+ |
elsif(($part ne "") && ($part ne ".")){push @parts, $part;} |
| 40 |
+ |
} |
| 41 |
+ |
return "$p".join("/",@parts); |
| 42 |
+ |
} |
| 43 |
+ |
|
| 44 |
|
sub adddir { |
| 45 |
|
my $indir=shift; |
| 46 |
|
my $startdir=cwd; |
| 103 |
|
} |
| 104 |
|
else |
| 105 |
|
{ |
| 106 |
< |
die "Attempt to open a non-existent directory ($src). Exitting\n"; |
| 106 |
> |
die "Attempt to open a non-existent directory ($src). Exiting\n"; |
| 107 |
|
} |
| 108 |
|
} |
| 109 |
|
|
| 168 |
|
} |
| 169 |
|
else |
| 170 |
|
{ |
| 171 |
< |
die "Attempt to open a non-existent directory ($src). Exitting\n"; |
| 171 |
> |
die "Attempt to open a non-existent directory ($src). Exiting\n"; |
| 172 |
|
} |
| 173 |
|
} |
| 174 |
+ |
|
| 175 |
+ |
sub copydirexp |
| 176 |
+ |
{ |
| 177 |
+ |
my $src=shift; |
| 178 |
+ |
my $dest=shift; |
| 179 |
+ |
my $exp=shift || ".+"; |
| 180 |
+ |
my $op=shift || 0; |
| 181 |
+ |
|
| 182 |
+ |
if ($exp=~/^!(.+)/){$exp=$1; $op=1;} |
| 183 |
+ |
|
| 184 |
+ |
use DirHandle; |
| 185 |
+ |
use File::Copy; |
| 186 |
+ |
adddir($dest); |
| 187 |
+ |
my $dh=DirHandle->new($src); |
| 188 |
+ |
|
| 189 |
+ |
if (defined $dh) |
| 190 |
+ |
{ |
| 191 |
+ |
my @allfiles=$dh->read(); |
| 192 |
+ |
|
| 193 |
+ |
my $file; |
| 194 |
+ |
foreach $file ( @allfiles ) |
| 195 |
+ |
{ |
| 196 |
+ |
next if $file=~/^\.\.?/; |
| 197 |
+ |
if ( -d $src."/".$file ) |
| 198 |
+ |
{ |
| 199 |
+ |
copydirexp($src."/".$file,$dest."/".$file,$exp,$op); |
| 200 |
+ |
} |
| 201 |
+ |
else |
| 202 |
+ |
{ |
| 203 |
+ |
my $skip=1; |
| 204 |
+ |
if ($file=~/$exp/) |
| 205 |
+ |
{ |
| 206 |
+ |
if ($op == 0){$skip=0;} |
| 207 |
+ |
} |
| 208 |
+ |
elsif ($op == 1){$skip=0;} |
| 209 |
+ |
if (!$skip) |
| 210 |
+ |
{ |
| 211 |
+ |
copy($src."/".$file,$dest."/".$file); |
| 212 |
+ |
if ( -x $src."/".$file || -X $src."/".$file ) {chmod(0755,$dest."/".$file);} |
| 213 |
+ |
} |
| 214 |
+ |
} |
| 215 |
+ |
} |
| 216 |
+ |
undef $dh; |
| 217 |
+ |
} |
| 218 |
+ |
else |
| 219 |
+ |
{ |
| 220 |
+ |
die "Attempt to open a non-existent directory ($src). Exiting\n"; |
| 221 |
+ |
} |
| 222 |
+ |
} |
| 223 |
+ |
|
| 224 |
+ |
sub getfileslist () |
| 225 |
+ |
{ |
| 226 |
+ |
my $dir=shift; |
| 227 |
+ |
my $data=shift || []; |
| 228 |
+ |
my $base=shift || $dir; |
| 229 |
+ |
my $ref; |
| 230 |
+ |
opendir($ref,$dir) || die "ERROR: Can not open directory for reading: $dir"; |
| 231 |
+ |
foreach my $f (readdir($ref)) |
| 232 |
+ |
{ |
| 233 |
+ |
next if $f=~/^\.\.?/; |
| 234 |
+ |
$f = "${dir}/${f}"; |
| 235 |
+ |
if (-d $f){&getfileslist($f,$data,$base);} |
| 236 |
+ |
else |
| 237 |
+ |
{ |
| 238 |
+ |
$f=~s/^$base\///; |
| 239 |
+ |
push @$data,$f; |
| 240 |
+ |
} |
| 241 |
+ |
} |
| 242 |
+ |
closedir($ref); |
| 243 |
+ |
return $data; |
| 244 |
+ |
} |
| 245 |
+ |
|
| 246 |
+ |
1; |
| 247 |
+ |
|
| 248 |
+ |
__END__ |
| 249 |
|
|
| 250 |
|
=back |
| 251 |
|
|
