Perlbug::File - Module for generic file access functions Perlbug.

	my $o_file = Perlbug::File->new('/tmp/abc.xyz', '+>>', '0755');

	$o_file->append("data");

	my $a_data = $o_file->read();

	print $a_data; # 'other data\nOK\n'

# Perlbug Fileging and file accessor
# (C) 1999 Richard Foley RFI perlbug@rfi.net
# $Id: File.pm,v 1.10 2002/01/11 13:51:05 richardf Exp $
# 

package Perlbug::File;
use strict;
use vars qw($VERSION);
$VERSION = do { my @r = (q$Revision: 1.10 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; 
$| = 1;

use Carp;
use Data::Dumper;
use FileHandle;
use Shell qw(chmod);

sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto; 
    my $file  = shift || 'undefined_File_name'; 
	my $perm  = shift || '+>>';
	my $num   = shift || '0755';

	my $sep   = quotemeta('/');
	my $self = bless({
		'_handle' => undef,							# GLOB(...)
		'_name'   => '',							# /tmp/here/there.etc
		'_regex'  => '^(.+)('.$sep.')([\w\.])+', 	# ext
		'_status' => '',							# open/locked/closed/...
	}, $class);

	my $rex = $self->{'_regex'};
	if ($file !~ /$rex$/) { 
		$self->error("File($file) doesn't match($rex)");
	} else {
		my ($dir, $tgt) = ($1, $3);
		if (!($dir =~ /\w+/o && -d $dir && -r _)) {
			$self->error("file can't attach to dir($dir) file($tgt): $!");
		} else {
			$self->{'_name'} = $file;
			$self = $self->open($file, $perm, $num); # create or append
		}
	}	

	return $self;
}

sub error {
	return Perlbug::Config->error(@_);
}

sub open {
    my $self = shift;
	my $file = shift;
	my $perm = shift;
	my $num  = shift;

	my $fh = $self->handle($self->fh($file, $perm, $num));
	if (!$fh) {
		$self->error("no handle returned!");
	} else {
		$self->status('open');
	}

	return $self;
}

sub handle {
	my $self   = shift;
	my $handle = shift || $self->{'_handle'};

	$self->error("no handle($handle) found") unless $handle;

	$self->{'_handle'} = $handle;

	return $self->{'_handle'};
}

sub status {
	my $self = shift;
	my $status = shift || $self->{'_status'};

	$self->{'_status'} = $status;

	return $self->{'_status'};
}

sub close {
    my $self = shift;
	my $fh = $self->handle;

	if ($fh) {
		$fh->flush;
		flock($fh, 8) or $self->error("Can't unlock fh($fh): $!"); # unlock it
		$self->status('unlocked');
		$fh->close() if ref($fh);
		$self->status('closed');
	}

	undef $self->{'_handle'};

	return $self;
}

sub x_DESTROY {
    my $self = shift;
	$self->close() if defined($self) && $self->can('close');
}

sub fh { 
    my $self = shift;
    my $file = shift;
    my $ctl  = shift || '+>>' || '<'; 
	my $num  = shift || '';

	my $fh   = undef;

    if ($file !~ /\w+/) {   
		$self->error("inappropriate file($file) given");
    } else {
		$fh = new FileHandle($file, $ctl, $num);
		if (!(defined $fh)) {      # OK
			$self->error("can't define filehandle($fh) for file($file) with ctl($ctl): $!");
        } else {
			# $fh->autoflush(1);  # 
		}
   	} 

    return $fh;
}

sub append { 
    my $self = shift;
    my $data = shift;

	my $fh = $self->handle;
	my $pos  = '';

	if (!defined($fh)) {
		$self->error("can't append to fh($fh)");
	} else {
		flock($fh, 2) or $self->error("Can't lock fh($fh): $!"); # lock it
		$self->status('locked'); 
		$fh->seek(0, 2);
		print $fh $data;
		flock($fh, 8) or $self->error("Can't unlock fh($fh): $!"); # lock it
		$self->status('unlocked'); 
		$pos = $fh->tell;
    }

    return $self;
}

sub read {
    my $self = shift;
	my $fh = $self->handle;
	my @data = ();

	if (!defined($fh)) {
		$self->error("can't read from fh($fh)");
	} else {
		$fh->flush;
		$fh->seek(0, 0);
		@data = $fh->getlines; 
    }
	return @data;
}

sub print {
    my $self = shift;

	print $self->read();

	return $self;
}

sub truncate {
    my $self = shift;
	my $fh = $self->handle;

	if (!defined($fh)) {
		$self->error("can't truncate fh($fh)");
	} else {
		$fh->seek(0, 2);
		$fh->seek(0, 0);
		$fh->truncate(0);
		$fh->seek(0, 8);
    }
	return $self;
}

sub copy {
    my $self = shift;
    my $orig = shift;
    my $targ = shift;
	my $perm = shift || '0766';
    my @data = ();
    
    # FILEHANDLES
    # my $oldfh = new FileHandle($orig, '<');
	# my $newfh = new FileHandle($targ, '+>', $perm);
    my $oldfh = $self->fh($orig, '<');
	my $newfh = $self->fh($targ, '+<', $perm);

	if (!(defined($oldfh)) || (!defined($newfh))) {
	    $self->error("Filehandle failures for copy: orig($orig -> '$oldfh'), targ($targ -> '$newfh')");
    } else {
		flock($oldfh, 2);
		flock($newfh, 2);
		LINE:
        while (<$oldfh>) {
            # s/\b(p)earl\b/${1}erl/i;
            if (print $newfh $_) {
                push(@data, $_); # see what was copied
            } else {
                $self->error("can't write to target($targ) fh($newfh): $!");
                last LINE;
            }
        }
		flock($oldfh, 8);
		flock($newfh, 8);
    }
    
    # CLEAN UP
    CORE::close($oldfh) if defined $oldfh;
    CORE::close($newfh) if defined $newfh;

    return @data;
}

sub xcreate {
    my $self = shift;
    my $file = shift;
    my $data = shift;
	my $perm = shift || '0766';
	my $o_file = '';
    
    # ARGS
    if (!(($file =~ /\w+/o) && ($data =~ /\w+/o))) {
        $self->errors("Duff args given to create($file, $data, $perm)");
    } else {
    	$o_file = Perlbug::File($file, '>', $perm);
        if (ref($o_file)) {
			$o_file->append($data);
        } else {
            $self->error("failed to create file($file) -> o_file($o_file)");
        }
    }
    
    return $o_file;
}

sub link {
    my $self = shift;
    my $orig = shift;
    my $targ = shift;
	my $mod  = shift || ''; # -f?
	my $res  = 0;
    
	if (! -e $orig) {
		$self->error("orig($orig) doesn't exist to link to targ($targ) from: $!");
	} else {
		my $cmd = "ln $mod -s $orig $targ";
		$res = system($cmd); 	# doit
		if ($res == 1 || ! -l $targ) {
			$self->error("link($cmd) failed($res): $!");
		} 
	}
    
    return !$res;
}

sub _syntax_check {
    my $self = shift;
    my $file = shift;
    my $ok = 0;
    
    # ARGS
    if ($file =~ /\w+/o) {
        $self->error("requires a file($file) to syntax check");
	} else {
        if (-f $file) {
			$ok = 1;
		} else {	
            $self->error("File ($file) doesn't exist for syntax check");
        }
    }
    
    if ($ok == 1) {
        eval { 
            require "$file";
        };
        if ($@) {
			$ok = 0;
            $self->error("Syntax problem with '$file': $@");
        }
    }
    
    return $ok;
}

1;