version 1.3, 2005/05/26 14:31:28
|
version 1.9, 2007/03/21 14:22:27
|
Line 12 use vars qw(@ISA @EXPORT $VERSION
|
Line 12 use vars qw(@ISA @EXPORT $VERSION
|
$file_perm); |
$file_perm); |
use Exporter; |
use Exporter; |
|
|
$VERSION = 0.6; # ROC 26.5.2005 |
$VERSION = 0.6.3; # ROC 6.3.2007 |
|
|
@ISA = qw(Exporter); |
@ISA = qw(Exporter); |
|
|
Line 27 $debug = 0;
|
Line 27 $debug = 0;
|
|
|
# junk files |
# junk files |
%junk_files = ( |
%junk_files = ( |
'.HSResource' => '.HSResource', |
# netatalk stuff |
'.HSancillary' => '.HSancillary', |
'.AppleDB' => '.AppleDB', |
'.HSicon' => '.HSicon', |
'.AppleDesktop' => '.AppleDesktop', |
|
'.AppleDouble' => '.AppleDouble', |
|
'.FBCIndex' => '.FBCIndex', |
|
'.FBCLockFolder' => '.FBCLockFolder', |
|
':2eTemporaryItems' => ':2eTemporaryItems', |
|
':2eDS_Store' => ':2eDS_Store', |
|
':2eBridgeSort' => ':2eBridgeSort', |
|
# standard appleshare stuff |
|
'.DS_Store' => '.DS_Store', |
|
'.TemporaryItems' => '.TemporaryItems', |
'Network Trash Folder' => 'Network Trash Folder', |
'Network Trash Folder' => 'Network Trash Folder', |
'TheVolumeSettingsFolder' => 'TheVolumeSettingsFolder', |
'TheVolumeSettingsFolder' => 'TheVolumeSettingsFolder', |
'.DS_Store' => '.DS_Store' |
# old appleshare software turds |
|
'.HSResource' => '.HSResource', |
|
'.HSancillary' => '.HSancillary', |
|
'.HSicon' => '.HSicon' |
); |
); |
|
|
# filenames to not delete (but archive) |
# filenames to not delete (but archive) |
Line 140 sub ymd_date {
|
Line 152 sub ymd_date {
|
# file name (the last path element) and path |
# file name (the last path element) and path |
# |
# |
sub split_file_path { |
sub split_file_path { |
my ($fn) = @_; |
my ($fn, $nodot) = @_; |
|
|
if ($fn =~ /^(.*)\/([^\/]+)$/) { |
if ($fn =~ /^(.*)\/([^\/]+)$/) { |
return ($2, $1); |
return ($2, $1); |
} |
} |
return $fn; |
# only file name |
|
if ($nodot) { |
|
return ($fn, ''); |
|
} else { |
|
return ($fn, '.'); |
|
} |
} |
} |
|
|
|
|
# |
# |
# $name = sstrip($name) |
# $name = sstrip($name, $slash) |
# |
# |
# strips leading and trailing whitespace from $name |
# strips leading and trailing whitespace from $name |
|
# replaces double slashes with single ones with $slash. |
# |
# |
sub sstrip { |
sub sstrip { |
my ($name) = @_; |
my ($name, $slash) = @_; |
|
|
if ($name =~ /\s*(.*)\s*/) { |
if ($name =~ /^\s*(.*?)\s*$/) { |
return $1; |
$name = $1; |
|
} |
|
if ($slash) { |
|
# trim multiple slashes |
|
$name =~ s/\/+/\//g; |
} |
} |
return $name; |
return $name; |
} |
} |