################################################################################
# #
# ############################################################################ #
# # Title : Deans::Functions # #
# # Description : I finally decided to organize some of my "regular" stuff. # #
# # Coded by : Justin Lee # #
# # Version : 0.1.0-RC1 # #
# # Date : Wednesday, March 12, 2008 # #
# # License : GNU General Public License v.2 # #
# # Copyright (C) 2008 Justin Lee <kool.name at gmail.com> # #
# ############################################################################ #
# #
# ############################################################################ #
# # This program is free software; you can redistribute it and/or # #
# # modify it under the terms of the GNU General Public License version 2 # #
# # as published by the Free Software Foundation. # #
# # # #
# # This program is distributed in the hope that it will be useful, # #
# # but WITHOUT ANY WARRANTY; without even the implied warranty of # #
# # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # #
# # GNU General Public License for more details. # #
# # # #
# # You should have received a copy of the GNU General Public License # #
# # along with this program; if not, write to the Free Software # #
# # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA # #
# # 02110-1301, USA. Or, see: <http://www.gnu.org/licenses/> # #
# ############################################################################ #
# #
################################################################################
############
# PREAMBLE #
############
package Deans::Functions;
use strict;
use warnings;
use subs qw( _main_parse );
our(@ISA,@EXPORT_OK);
BEGIN {
require Exporter;
@ISA = qw(Exporter);
@EXPORT_OK = qw( skew housekeep );
}
my @order = qw(
directory
path
regex
keep
strict
);
########
# SKEW #
########
###################################
# mostly used for windows systems #
# will take a messy path that has #
# is a gross amalgamation of unix #
# and win32 paths and change them #
# to pure unix-style #
###################################
sub skew { #
my $p = join( #
'/', #
_main_parse @_ #
); #
$p =~ s/(?:\\|\/)+/\//go; #
return $p; #
} #
#############################
#############
# HOUSEKEEP #
#############
########################################
# will unlink all files matching $r in #
# $d untill only $k are left or all if #
# $k is undef, not an int, or zero #
# if it fails to unlink a file, and $s #
# is true, then it will return nothing #
# otherwise it just continues #
#########################################
use File::Find; #
sub housekeep { #
my ($d,$r,$k,$s) = _main_parse @_; #
my @fs; #
$k = _hk_int_prc($k,$s) or return; #
$r = _hk_gex_prc($r,$s) or return; #
return 1 if $k < 0; #
#
find( #
{ #
no_chdir => 1, #
wanted => sub { #
return if -d $_; #
push(@fs,$_) if $k =~ /$r/oi; #
}, #
}, #
$d #
); #
#
foreach my $fp (splice(@fs,0,0-$k)) { #
unless (unlink($fp)) { #
return if $s; #
} #
} #
#
return 1; #
} #
#########################################
#############
# INTERNALS #
#############
####################################
# stuff used by the main functions #
# caution: may cause cramping upon #
# ingestion #
####################################
sub _main_parse { #this function makes me proud
return @_ unless (ref $_[0] eq 'HASH');
return map { $_[0]->{$_} if exists $_[0]->{$_} } @order;
}
sub _hk_int_prc {
my ($k,$s) = @_;
map { return $_->[0] if $k =~ /$_->[1]/i; } (
[$k,'^\\d+$'],
[ 3,'three.*some|few'],
[13,'b.*dozen'],
[12,'dozen'],
[ 2,'couple'],
[ 5,'some'],
[-1,'all']
);
return if $s;
return 0;
}
sub hk_gex_prc {
my ($r,$s) = @_;
unless (defined $r) {
return if $s;
return '.*';
}
return $r;
}