Browse Source
git-svn-id: svn://127.0.0.1/Perl/Dir::Watch/trunk@118 0c1c3402-1be1-de11-8092-0022686faf23master
commit
73a897f60e
10 changed files with 375 additions and 0 deletions
@ -0,0 +1,10 @@
|
||||
blib* |
||||
Makefile |
||||
Makefile.old |
||||
Build |
||||
_build* |
||||
pm_to_blib* |
||||
*.tar.gz |
||||
.lwpcookies |
||||
Dir-Watch-* |
||||
cover_db |
@ -0,0 +1,5 @@
|
||||
Revision history for Dir-Watch |
||||
|
||||
0.01 Date/time |
||||
First version, released on an unsuspecting world. |
||||
|
@ -0,0 +1,8 @@
|
||||
Changes |
||||
MANIFEST |
||||
Makefile.PL |
||||
README |
||||
lib/Dir/Watch.pm |
||||
t/00-load.t |
||||
t/pod-coverage.t |
||||
t/pod.t |
@ -0,0 +1,20 @@
|
||||
use strict; |
||||
use warnings; |
||||
use ExtUtils::MakeMaker; |
||||
|
||||
WriteMakefile( |
||||
NAME => 'Dir::Watch',
|
||||
AUTHOR => 'Zane C. Bowers <vvelox@vvelox.net>',
|
||||
VERSION_FROM => 'lib/Dir/Watch.pm',
|
||||
ABSTRACT_FROM => 'lib/Dir/Watch.pm',
|
||||
($ExtUtils::MakeMaker::VERSION >= 6.3002
|
||||
? ('LICENSE'=> 'perl')
|
||||
: ()),
|
||||
PL_FILES => {},
|
||||
PREREQ_PM => {
|
||||
'Test::More'=>0,
|
||||
'Cwd'=>0,
|
||||
},
|
||||
dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
|
||||
clean => { FILES => 'Dir-Watch-*' },
|
||||
);
|
@ -0,0 +1,52 @@
|
||||
Dir-Watch |
||||
|
||||
The README is used to introduce the module and provide instructions on |
||||
how to install the module, any machine dependencies it may have (for |
||||
example C compilers and installed libraries) and any other information |
||||
that should be provided before the module is installed. |
||||
|
||||
A README file is required for CPAN modules since CPAN extracts the README |
||||
file from a module distribution so that people browsing the archive |
||||
can use it to get an idea of the module's uses. It is usually a good idea |
||||
to provide version information here so that people can decide whether |
||||
fixes for the module are worth downloading. |
||||
|
||||
|
||||
INSTALLATION |
||||
|
||||
To install this module, run the following commands: |
||||
|
||||
perl Makefile.PL |
||||
make |
||||
make test |
||||
make install |
||||
|
||||
SUPPORT AND DOCUMENTATION |
||||
|
||||
After installing, you can find documentation for this module with the |
||||
perldoc command. |
||||
|
||||
perldoc Dir::Watch |
||||
|
||||
You can also look for information at: |
||||
|
||||
RT, CPAN's request tracker |
||||
http://rt.cpan.org/NoAuth/Bugs.html?Dist=Dir-Watch |
||||
|
||||
AnnoCPAN, Annotated CPAN documentation |
||||
http://annocpan.org/dist/Dir-Watch |
||||
|
||||
CPAN Ratings |
||||
http://cpanratings.perl.org/d/Dir-Watch |
||||
|
||||
Search CPAN |
||||
http://search.cpan.org/dist/Dir-Watch/ |
||||
|
||||
|
||||
COPYRIGHT AND LICENCE |
||||
|
||||
Copyright (C) 2009 Zane C. Bowers |
||||
|
||||
This program is free software; you can redistribute it and/or modify it |
||||
under the same terms as Perl itself. |
||||
|
@ -0,0 +1,186 @@
|
||||
package Dir::Watch; |
||||
|
||||
use warnings; |
||||
use strict; |
||||
use Cwd; |
||||
|
||||
=head1 NAME |
||||
|
||||
Dir::Watch - Watches the current directory for file additions or removals. |
||||
|
||||
=head1 VERSION |
||||
|
||||
Version 0.0.0 |
||||
|
||||
=cut |
||||
|
||||
our $VERSION = '0.0.0'; |
||||
|
||||
|
||||
=head1 SYNOPSIS |
||||
|
||||
use Dir::Watch; |
||||
|
||||
$dirwatch=Dir::Watch->new; |
||||
|
||||
if($dirwatch->check){ |
||||
print "There are new items\n"; |
||||
} |
||||
|
||||
=head1 METHODS |
||||
|
||||
=head2 new |
||||
|
||||
This initiates the object. |
||||
|
||||
$dirwatch=Dir::Watch->new; |
||||
|
||||
=cut |
||||
|
||||
sub new{ |
||||
my %args; |
||||
# if (defined($_[1])) { |
||||
# %args=%{$_[1]}; |
||||
# } |
||||
|
||||
$args{dir}=cwd; |
||||
|
||||
my $self={ dir=>$args{dir} }; |
||||
bless $self; |
||||
|
||||
#get the stuff in the current directory |
||||
opendir(NEWREAD, $args{dir}); |
||||
my @direntries=readdir(NEWREAD); |
||||
closedir(NEWREAD); |
||||
|
||||
#builds the hash that will be used for checking |
||||
my %dirhash; |
||||
my $int=0; |
||||
while(defined($direntries[$int])){ |
||||
$dirhash{$direntries[$int]}=1; |
||||
|
||||
$int++; |
||||
} |
||||
$self->{dirhash}=\%dirhash; |
||||
|
||||
return $self; |
||||
} |
||||
|
||||
=head2 check |
||||
|
||||
This checks for a new directories or files. |
||||
|
||||
If any thing has been added or removed, true is returned. |
||||
|
||||
If nothing has been added or removed, false is returned. |
||||
|
||||
if(!$dirwatch->check){ |
||||
print "There have been either files/directories added or removed.\n"; |
||||
} |
||||
|
||||
=cut |
||||
|
||||
sub check{ |
||||
my $self=$_[0]; |
||||
|
||||
#get the stuff in the current directory |
||||
opendir(CHECKREAD, $self->{dir}); |
||||
my @direntries=readdir(CHECKREAD); |
||||
closedir(CHECKREAD); |
||||
|
||||
#builds the hash that will be used for checking |
||||
my %dirhash; |
||||
my $int=0; |
||||
while(defined($direntries[$int])){ |
||||
$dirhash{$direntries[$int]}=1; |
||||
|
||||
$int++; |
||||
} |
||||
|
||||
#check for anything new |
||||
$int=0; |
||||
while (defined($direntries[$int])) { |
||||
if (!defined( $self->{dirhash}{ $direntries[$int] } )) { |
||||
$self->{dirhash}=\%dirhash; |
||||
return 1; |
||||
} |
||||
|
||||
$int++; |
||||
} |
||||
|
||||
#check for any thing removed |
||||
$int=0; |
||||
my @keys=keys(%{ $self->{dirhash} }); |
||||
while (defined( $keys[$int] )) { |
||||
if (!defined( $dirhash{ $keys[$int] } )) { |
||||
$self->{dirhash}=\%dirhash; |
||||
return 1; |
||||
} |
||||
|
||||
$int++; |
||||
} |
||||
|
||||
#saves the dir hash for checking later |
||||
$self->{dirhash}=\%dirhash; |
||||
|
||||
#return false as if we got here nothing new was found or old was removed |
||||
return 0; |
||||
} |
||||
|
||||
=head1 AUTHOR |
||||
|
||||
Zane C. Bowers, C<< <vvelox at vvelox.net> >> |
||||
|
||||
=head1 BUGS |
||||
|
||||
Please report any bugs or feature requests to C<bug-dir-watch at rt.cpan.org>, or through |
||||
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Dir-Watch>. I will be notified, and then you'll |
||||
automatically be notified of progress on your bug as I make changes. |
||||
|
||||
|
||||
|
||||
|
||||
=head1 SUPPORT |
||||
|
||||
You can find documentation for this module with the perldoc command. |
||||
|
||||
perldoc Dir::Watch |
||||
|
||||
|
||||
You can also look for information at: |
||||
|
||||
=over 4 |
||||
|
||||
=item * RT: CPAN's request tracker |
||||
|
||||
L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Dir-Watch> |
||||
|
||||
=item * AnnoCPAN: Annotated CPAN documentation |
||||
|
||||
L<http://annocpan.org/dist/Dir-Watch> |
||||
|
||||
=item * CPAN Ratings |
||||
|
||||
L<http://cpanratings.perl.org/d/Dir-Watch> |
||||
|
||||
=item * Search CPAN |
||||
|
||||
L<http://search.cpan.org/dist/Dir-Watch/> |
||||
|
||||
=back |
||||
|
||||
|
||||
=head1 ACKNOWLEDGEMENTS |
||||
|
||||
|
||||
=head1 COPYRIGHT & LICENSE |
||||
|
||||
Copyright 2009 Zane C. Bowers, all rights reserved. |
||||
|
||||
This program is free software; you can redistribute it and/or modify it |
||||
under the same terms as Perl itself. |
||||
|
||||
|
||||
=cut |
||||
|
||||
1; # End of Dir::Watch |
@ -0,0 +1,9 @@
|
||||
#!perl -T |
||||
|
||||
use Test::More tests => 1; |
||||
|
||||
BEGIN { |
||||
use_ok( 'Dir::Watch' ); |
||||
} |
||||
|
||||
diag( "Testing Dir::Watch $Dir::Watch::VERSION, Perl $], $^X" ); |
@ -0,0 +1,55 @@
|
||||
#!perl -T |
||||
|
||||
use strict; |
||||
use warnings; |
||||
use Test::More tests => 3; |
||||
|
||||
sub not_in_file_ok { |
||||
my ($filename, %regex) = @_; |
||||
open( my $fh, '<', $filename ) |
||||
or die "couldn't open $filename for reading: $!"; |
||||
|
||||
my %violated; |
||||
|
||||
while (my $line = <$fh>) { |
||||
while (my ($desc, $regex) = each %regex) { |
||||
if ($line =~ $regex) { |
||||
push @{$violated{$desc}||=[]}, $.; |
||||
} |
||||
} |
||||
} |
||||
|
||||
if (%violated) { |
||||
fail("$filename contains boilerplate text"); |
||||
diag "$_ appears on lines @{$violated{$_}}" for keys %violated; |
||||
} else { |
||||
pass("$filename contains no boilerplate text"); |
||||
} |
||||
} |
||||
|
||||
sub module_boilerplate_ok { |
||||
my ($module) = @_; |
||||
not_in_file_ok($module => |
||||
'the great new $MODULENAME' => qr/ - The great new /, |
||||
'boilerplate description' => qr/Quick summary of what the module/, |
||||
'stub function definition' => qr/function[12]/, |
||||
); |
||||
} |
||||
|
||||
TODO: { |
||||
local $TODO = "Need to replace the boilerplate text"; |
||||
|
||||
not_in_file_ok(README => |
||||
"The README is used..." => qr/The README is used/, |
||||
"'version information here'" => qr/to provide version information/, |
||||
); |
||||
|
||||
not_in_file_ok(Changes => |
||||
"placeholder date/time" => qr(Date/time) |
||||
); |
||||
|
||||
module_boilerplate_ok('lib/Dir/Watch.pm'); |
||||
|
||||
|
||||
} |
||||
|
@ -0,0 +1,18 @@
|
||||
use strict; |
||||
use warnings; |
||||
use Test::More; |
||||
|
||||
# Ensure a recent version of Test::Pod::Coverage |
||||
my $min_tpc = 1.08; |
||||
eval "use Test::Pod::Coverage $min_tpc"; |
||||
plan skip_all => "Test::Pod::Coverage $min_tpc required for testing POD coverage" |
||||
if $@; |
||||
|
||||
# Test::Pod::Coverage doesn't require a minimum Pod::Coverage version, |
||||
# but older versions don't recognize some common documentation styles |
||||
my $min_pc = 0.18; |
||||
eval "use Pod::Coverage $min_pc"; |
||||
plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage" |
||||
if $@; |
||||
|
||||
all_pod_coverage_ok(); |
Loading…
Reference in new issue