File::Butler - Handy collection of file-related tools.
Index
Code Index:
NAME
File::Butler - Handy collection of file-related tools.
VERSION
SYNOPSIS
A collection of basic file manipulation tools.
As of version 4.0.0, File::Butler is built around Moose.
use File::Butler;
my $fb = File::Butler->new( 'filename' => 'myfile.txt' );
my $contents = $fb->read();
my $retval = $fb->append( "Text to be appended." );
my $retval = $fb->prepend( "Text to be prepended to the beginning of the file." );
Please note that "filename" is a required element during invocation. In
cases where file contents are to be returned, contents are returned
either as an array or an array reference, depending upon how the method is called.
SUBROUTINES/METHODS
dir
read
write
append
prepend
srm
wc
AUTHOR
Kurt Kincaid, <kurt.kincaid at gmail.com>
BUGS
Please report any bugs or feature requests to bug-file-butler at rt.cpan.org, or through
the web interface at http://rt.cpan.org/NoAuth/ReportBug.html?Queue=File-Butler. I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.
SUPPORT
You can find documentation for this module with the perldoc command.
perldoc File::Butler
You can also look for information at:
- * RT: CPAN's request tracker
-
http://rt.cpan.org/NoAuth/Bugs.html?Dist=File-Butler
- * AnnoCPAN: Annotated CPAN documentation
-
http://annocpan.org/dist/File-Butler
- * CPAN Ratings
-
http://cpanratings.perl.org/d/File-Butler
- * Search CPAN
-
http://search.cpan.org/dist/File-Butler/
LICENSE AND COPYRIGHT
Copyright 2010 Kurt Kincaid.
This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.
See http://dev.perl.org/licenses/ for more information.
#!/usr/bin/perl
################################################################################
# $Id: Butler.pm 2 2010-07-21 21:56:38Z v89326 $
# $URL: file:///S:/svn/File-Butler/trunk/lib/File/Butler.pm $
################################################################################
#
# Title: File::Butler
# Author: Kurt Kincaid
# VERSION: 4.0.0
#
################################################################################
package File::Butler;
use warnings;
use strict;
use Moose;
use feature "switch";
our $VERSION = '4.0.0';
has 'filename' => (
'is' => 'rw',
'isa' => 'Str',
'required' => 1
);
sub dir {
my $self = shift;
my $name = $self->{ 'filename' };
unless ( -d $name ) {
die "Directory $name does not exist";
}
my @files;
opendir( my $dh, $name ) || die "Can't opendir $name: $!";
@files = sort { lc( $a ) cmp lc( $b ) } readdir( $dh );
closedir $dh;
chomp @files;
my @FILES;
foreach my $file ( @files ) {
push( @FILES, $file ) unless $file eq "." or $file eq "..";
}
if ( wantarray() ) {
return @FILES;
}
else {
return \@FILES;
}
}
sub read {
my $self = shift;
my @array;
open my $FILE, "<", $self->{ 'filename' }
or die "File $self->{ 'filename' } does not exist";
while ( <$FILE> ) {
chomp;
push( @array, $_ );
}
close $FILE;
if ( wantarray() ) {
return @array;
}
elsif ( defined wantarray() ) {
my $content = join "\n", @array;
return $content;
}
}
sub write {
my ( $self, $content ) = @_;
open my $OUT, ">", $self->{ 'filename' }
or die "Unable to open $self->{ 'filename' } for writing";
print $OUT $content;
close $OUT;
return 1;
}
sub append {
my ( $self, $content ) = @_;
open my $OUT, ">>", $self->{ 'filename' }
or die "Unable to open $self->{ 'filename' } for writing";
print $OUT $content;
close $OUT;
return 1;
}
sub prepend {
my ( $self, $content ) = @_;
local $/ = undef;
open my $IN, "<", $self->{ 'filename' }
or die "Unable to open $self->{ 'filename' } for reading";
my $old = <$IN>;
close $IN;
open my $OUT, ">", $self->{ 'filename' }
or die "Unable to open $self->{ 'filename' } for writing";
print $OUT $content;
print $OUT $old;
close $OUT;
return 1;
}
sub srm {
my ( $self, $passes ) = @_;
local $/ = undef;
open my $IN, "<", $self->{ 'filename' }
or die "Unable to open $self->{ 'filename' } for reading";
my $old = <$IN>;
close $IN;
my $length = length $old;
for ( 1 .. $passes ) {
my $text = "";
my $method = $_ % 10;
my $pattern;
given ( $method ) {
when ( [ 1, 2, 3 ] ) {
while ( length $text < $length ) {
$text .= sprintf( "%.0f", rand() );
}
}
when ( 4 ) {
$pattern = "010101";
}
when ( 5 ) {
$pattern = "101010";
}
when ( 6 ) {
$pattern = "100100";
}
when ( 7 ) {
$pattern = "010010";
}
when ( 8 ) {
$pattern = "001001";
}
when ( 9 ) {
$pattern = "000000";
}
default {
$pattern = "111111";
}
}
while ( length $text < $length ) {
$text .= $pattern;
}
open my $OUT, ">", $self->{ "filename" }
or die "Unable to open $self->{ 'filename' } for writing";
print $OUT $text;
close $OUT;
}
}
sub wc {
my $self = shift;
my ( $lines, $words, $chars, $text );
local $/ = undef;
open my $IN, "<", $self->{ 'filename' }
or die "Unable to open $self->{ 'filename' } for reading";
$text = <$IN>;
close $IN;
$words = $text =~ s/((^|\s)\S)/$1/g;
while ( $text =~ /\n/g ) {
$lines++;
}
$chars = length $text;
return $lines, $words, $chars;
}
1;
################################################################################
# EOF