File Coverage

blib/lib/File/Scan.pm

Criterion	Covered	Total	%
statement	12	75	16.0
branch	0	44	0.0
condition	0	34	0.0
subroutine	4	15	26.6
pod	7	8	87.5
total	23	176	13.0

#
# Scan.pm
# Last Modification: Wed May  4 16:31:36 WEST 2005
#
# Copyright (c) 2005 Henrique Dias . All rights reserved.
# This module is free software; you can redistribute it and/or modify
# it under the same terms as Perl itself.
#
#
package File::Scan;

require 5;
use strict;

require Exporter;
use File::Copy;
use SelfLoader;

use vars qw($VERSION @ISA @EXPORT $ERROR $SKIPPED $SUSPICIOUS $CALLBACK);

@ISA = qw(Exporter);
$VERSION = '1.43';

($ERROR, $SKIPPED, $SUSPICIOUS, $CALLBACK) = ("", 0, 0, "");

SelfLoader->load_stubs();

sub new {
	my $proto = shift;
	my $class = ref($proto) || $proto;
	my $self  = {
		extension    => "",
		delete       => 0,
		move         => "",
		copy         => "",
		mkdir        => 0,
		max_txt_size => 5120,
		max_bin_size => 10240,
		@_,
	};
	bless ($self, $class);
	return($self);
}

sub scan {
	my $self = shift;
	my $file = shift;

	&_set_error();
	&_set_skip();
	&_set_suspicious();
	&ret_callback();

	(-e $file) or return(&_set_error("No such file or directory: $file"));
	my $fsize = -s $file;
	$fsize or return(&_set_skip(2));
	my $res = "";
	if(-f $file && -T $file) {
		return(&_set_skip(3)) if($fsize < 23);
		return(&_set_skip(4))
			if($self->{'max_txt_size'} && ($fsize > $self->{'max_txt_size'} * 1024));
		$res = &scan_text($self, $file);
	} else {
		return(&_set_skip(5))
			if($self->{'max_bin_size'} && ($fsize > $self->{'max_bin_size'} * 1024));
		$res = &scan_binary($self, $file);
	}
	if($res) {
		if($self->{'extension'} && $file !~ /\.$self->{'extension'}$/o) {
			my $newname = join("\.", $file, $self->{'extension'});
			if(move($file, $newname)) { $file = $newname; }
			else { &_set_error("Failed to move '$file' to '$newname'"); }
		}
		if($self->{'copy'}) {
			if(!(-d $self->{'copy'}) && $self->{'mkdir'}) {
				mkdir($self->{'copy'}, $self->{'mkdir'}) or &_set_error(join("", "Failed to create directory '", $self->{'copy'}, "' $!"));
			}
			my ($f) = ($file =~ /([^\/]+)$/o);
			my $cpdir = join("/", $self->{'copy'}, $f);
			copy($file, $cpdir) or &_set_error("Failed to copy '$file' to $cpdir");
		}
		if($self->{'move'}) {
			if(!(-d $self->{'move'}) && $self->{'mkdir'}) {
				mkdir($self->{'move'}, $self->{'mkdir'}) or &_set_error(join("", "Failed to create directory '", $self->{'move'}, "' $!"));
			}
			my ($f) = ($file =~ /([^\/]+)$/o);
			my $mvfile = join("/", $self->{'move'}, $f);
			if(move($file, $mvfile)) { $file = $mvfile; }
			else { &_set_error("Failed to move '$file' to '$mvfile'"); }
		}
		if($self->{'delete'}) {
			if($file =~ /^(.+)$/s) {
				unlink($1) or &_set_error("Could not delete $1: $!");
			}
		}
	}
	return($res);
}

sub set_callback {
	my $self = shift;
	my $subref = shift || undef;

	if(defined($subref) && ref($subref) eq "CODE") {
		$self->{'callback'} = $subref;
	} elsif(exists($self->{'callback'})) {
		delete($self->{'callback'});
	}
	return();
}

sub _set_error {
	$ERROR = shift || "";
	return();
}

sub _set_skip {
	$SKIPPED = shift || 0;
	return();
}

sub _set_suspicious {
	$SUSPICIOUS = shift || 0;
	return();
}

sub ret_callback {
	$CALLBACK = shift || "";
	return();
}

sub error { $ERROR; }
sub skipped { $SKIPPED; }
sub suspicious { $SUSPICIOUS; }
sub callback { $CALLBACK; }

1;

__DATA__