File Coverage

blib/lib/File/Operator.pm

Criterion	Covered	Total	%
statement	54	144	37.5
branch	9	40	22.5
condition			n/a
subroutine	8	14	57.1
pod	0	8	0.0
total	71	206	34.4

package File::Operator;

use strict;
use vars qw($VERSION);
use Fcntl qw(:flock);

$VERSION = '1.00';

sub new {
my $class=shift;
my %arg=@_;
# ÐÏ ÕÍÏÌÞÁÎÉÀ ÒÁÂÏÔÁÅÍ Ó ÔÅËÕÝÉÍ ËÁÔÁÌÏÇÏÍ ÓËÒÉÐÔÁ
$arg{'-path'}="." unless(exists($arg{'-path'}));
die "Incorrect file name" unless(defined($arg{'-file'}));
# ÅÓÌÉ ÆÁÊÌ ÎÅ ÓÕÝÅÓÔ×ÕÅÔ, ÔÏ ÓÏÚÄÁÅÍ ÎÏ×ÙÊ ÆÁÊÌ
unless(-e "$arg{'-path'}/$arg{'-file'}") {
	open(NEW,">","$arg{'-path'}/$arg{'-file'}") || die "Can't create file: $!";
	close(NEW);
	}
my $fh;
# ÂÌÏËÉÒÕÅÍ ÞÅÒÅÚ ÓÅÍÁÆÏÒ (ÛÁÒÏ×ÁÒÎÁÑ)
_block($arg{'-path'},LOCK_SH);
# ÏÖÉ×ÌÑÅÍ ÄÅÓËÒÉÐÔÏÒ $fh
open($fh,"<","$arg{'-path'}/$arg{'-file'}") || die "Can't open file: $!";
my $self={
          file  => $fh, # ÄÅÓËÒÉÐÔÏÒ ÆÁÊÌÁ
          fpath => $arg{'-path'}, # ÐÕÔØ Ë ÆÁÊÌÕ
          nfile => $arg{'-file'},# ÉÍÑ ÆÁÊÌÁ
          };
bless($self,$class);
return $self;
}

sub renew {# ÏÂÎÏ×ÌÅÎÉÅ ÄÅÓËÒÉÐÔÏÒÁ ÐÏÓÌÅ ÚÁËÒÙÔÉÑ
my $class=shift;
my $package=__PACKAGE__;
die "Bad file name" unless(-e "$class->{'fpath'}/$class->{'nfile'}");
my $fh;
# ÂÌÏËÉÒÕÅÍ ÞÅÒÅÚ ÓÅÍÁÆÏÒ
_block($class->{'fpath'},LOCK_SH);
# ÏÖÉ×ÌÑÅÍ ÄÅÓËÒÉÐÔÏÒ $fh
open($fh,"<","$class->{'fpath'}/$class->{'nfile'}") || die "Can't open file: $!";
my $self={
          file  => $fh, # ÄÅÓËÒÉÐÔÏÒ ÆÁÊÌÁ
          fpath => $class->{'fpath'}, # ÐÕÔØ Ë ÆÁÊÌÕ
          nfile => $class->{'nfile'},# ÉÍÑ ÆÁÊÌÁ
          };
bless($self,$package);
return $self;
}

sub FetchFileToHash {# ÂÅÚ ÁÒÇÕÍÅÎÔÏ×
my $obj=shift;
my $fh=$obj->{'file'};# ÓÏÈÒÁÎÑÅÍ ÄÅÓËÒÉÐÔÏÒ ÆÁÊÌÁ × ÐÅÒÅÍÅÎÎÏÊ
my %hash=();
# ÓÞÉÔÙ×ÁÅÍ ÆÁÊÌ
seek($fh,0,0);# ÐÅÒÅÍÅÝÁÅÍÓÑ Ë ÎÁÞÁÌÕ ÆÁÊÌÁ
while(defined(my $line=<$fh>)) {
        chomp($line);
	my($id,@REC)=split(/\|/,$line);
	$hash{$id}=\@REC;
}
return %hash;
}

sub FetchRecord {# ÁÒÇÕÍÅÎÔ -id
my $obj=shift;
my $fh=$obj->{'file'};# ÓÏÈÒÁÎÑÅÍ ÄÅÓËÒÉÐÔÏÒ ÆÁÊÌÁ × ÐÅÒÅÍÅÎÎÏÊ
my %param=@_;# ÐÒÉÎÉÍÁÅÍ ÁÒÇÕÍÅÎÔÙ × ÈÜÛ
# ÓÞÉÔÙ×ÁÅÍ ÆÁÊÌ × ÐÏÉÓËÁÈ ÎÕÖÎÏÇÏ id
seek($fh,0,0);
while(defined(my $line=<$fh>)) {
        chomp($line);
	my($id,@REC)=split(/\|/,$line);
	return \@REC if($id eq $param{'-id'});
}
my @ERR=();
push(@ERR,"record by id $param{'-id'} not found");
return \@ERR;
}

sub FetchLastRecords {# ÁÒÇÕÍÅÎÔÙ -num  (ÎÅÏÂÑÚÁÔÅÌØÎÙÊ -raw)
my $obj=shift;
my $fh=$obj->{'file'};# ÓÏÈÒÁÎÑÅÍ ÄÅÓËÒÉÐÔÏÒ ÆÁÊÌÁ × ÐÅÒÅÍÅÎÎÏÊ
my %param=@_;# ÐÒÉÎÉÍÁÅÍ ÁÒÇÕÍÅÎÔÙ × ÈÜÛ
$param{'-num'}=1 unless(exists($param{'-num'}));# ÐÏ ÕÍÏÌÞÁÎÉÀ 1 ÚÁÐÉÓØ
seek($fh,0,0);
# ÓÞÉÔÙ×ÁÅÍ ÆÁÊÌ × ÐÏÉÓËÁÈ ÎÕÖÎÏÇÏ id
my @LIST=<$fh>;# ÓÞÉÔÙ×ÁÅÍ ÆÁÊÌ × ÍÁÓÓÉ×
# ÐÒÏ×ÅÒÑÅÍ ÎÅ ÐÒÅ×ÙÛÁÅÔ ÌÉ ÚÁÐÒÏÓ ËÏÌ-×Ï ÜÌÅÍÅÎÔÏ× × ÍÁÓÓÉ×Å
$param{'-num'}=$param{'-num'}>@LIST ? @LIST : $param{'-num'};
@LIST=splice(@LIST,-$param{'-num'});# ÕÄÁÌÑÅÍ N ÐÏÓÌÅÄÎÉÈ ÜÌÅÍÅÎÔÏ× É ÐÒÉÓ×ÁÉ×ÁÅÍ ÉÈ ÍÁÓÓÉ×Õ @LIST
return \@LIST if exists($param{'-raw'});# ×ÙÈÏÄÉÍ ÚÄÅÓØ - ÅÓÌÉ ÎÕÖÅÎ ÎÅ ÆÏÒÍÁÔÉÒÏ×ÁÎÎÙÊ ×Ù×ÏÄ
# ÏÔÓÅËÁÅÍ ÐÅÒÅ×ÏÄ ÓÔÒÏË É ÒÁÚÄÅÌÉÔÅÌØ |
my @LIST_CUT=();
foreach (@LIST) {
	chomp;# ÕÄÁÌÑÅÍ ÐÅÒÅ×ÏÄ ÓÔÒÏËÉ
	s/\|/ /g;# ÚÁÍÅÎÑÅÍ ÒÁÚÄÅÌÉÔÅÌØ | ÎÁ ÐÒÏÂÅÌ
	push(@LIST_CUT,$_);
	}
return \@LIST_CUT;
}

sub WriteRecord { # ÁÒÇÕÍÅÎÔÙ -id =>(ÎÅÏÂÑÚÁÔÅÌØÎÙÊ) -record =>ÓÙÓÌËÁ ÎÁ ÍÁÓÓÉ×
my $obj=shift;
my $fh=$obj->{'file'};# ÓÏÈÒÁÎÑÅÍ ÄÅÓËÒÉÐÔÏÒ ÆÁÊÌÁ × ÐÅÒÅÍÅÎÎÏÊ
#$obj->{'fpath'};# ÐÕÔØ ÄÏ ÆÁÊÌÁ
#$obj->{'nfile'}; # ÉÍÑ ÆÁÊÌÁ
my $File="$obj->{'fpath'}/$obj->{'nfile'}";# ÄÌÑ ÕÄÏÂÓÔ×Á ÓÏÈÒÁÎÑÅÍ ÄÁÎÎÙÅ × ÐÅÒÅÍÅÎÎÏÊ
my %param=@_;# ÐÒÉÎÉÍÁÅÍ ÁÒÇÕÍÅÎÔÙ × ÈÜÛ
$param{'-id'}=time() unless(exists($param{'-id'}));# ÅÓÌÉ -id ÎÅ ÐÅÒÅÄÁÎ, ÓÁÍÉ ÇÅÎÅÒÉÍ ÅÇÏ
my %hash=();
my $random=time();
my $name=int(rand($random));
$name=$random . $name .".tmp";
# ÏÔËÒÙ×ÁÅÍ ×ÒÅÍÅÎÎÙÊ ÆÁÊÌ
open(TMP,">","$obj->{'fpath'}/$name") || die "can't create temp file: $!";
# ÚÁÐÉÓÙ×ÁÅÍ ×ÅÓØ ÆÁÊÌ $fh ×Ï ×ÒÅÍÅÎÎÙÊ
seek($fh,0,0);
while(defined(my $line=<$fh>)) {
        print TMP $line;
}
# ÄÏÐÉÓÙ×ÁÅÍ × ËÏÎÅà ÎÏ×ÕÀ ÚÁÐÉÓØ
$param{'-id'}=~s/\|//g;# ÕÄÑÌÑÅÍ ÓÉÍ×ÏÌÙ |
print TMP "$param{'-id'}|";
foreach (@{$param{'-record'}}) {
                s/\|/ /g;# ÚÁÍÅÎÑÅÍ ×ÓÅ ÓÉÍ×ÏÌÙ | ÎÁ ÐÒÏÂÅÌÙ
		print TMP "$_|";
		}
	print TMP "\n";
close(TMP);
close($fh);
my $test=rename($File,"$File.orig");
$test=rename("$obj->{'fpath'}/$name",$File);
return $param{'-id'} if $test==1;
return 0;
}

sub EditRecord { # ÁÒÇÕÍÅÎÔÙ -id -record =>ÓÙÓÌËÁ ÎÁ ÍÁÓÓÉ×
my $obj=shift;
my $fh=$obj->{'file'};# ÓÏÈÒÁÎÑÅÍ ÄÅÓËÒÉÐÔÏÒ ÆÁÊÌÁ × ÐÅÒÅÍÅÎÎÏÊ
my $File="$obj->{'fpath'}/$obj->{'nfile'}";# ÄÌÑ ÕÄÏÂÓÔ×Á ÓÏÈÒÁÎÑÅÍ ÄÁÎÎÙÅ × ÐÅÒÅÍÅÎÎÏÊ
my %param=@_;# ÐÒÉÎÉÍÁÅÍ ÁÒÇÕÍÅÎÔÙ × ÈÜÛ
my %hash=();
my $random=time();
my $name=int(rand($random));
$name=$random . $name .".tmp";
# ÏÔËÒÙ×ÁÅÍ ×ÒÅÍÅÎÎÙÊ ÆÁÊÌ
open(TMP,">","$obj->{'fpath'}/$name") || die "can't create temp file: $!";
# ÓÞÉÔÙ×ÁÅÍ ÆÁÊÌ
seek($fh,0,0);
while(defined(my $line=<$fh>)) {
	my($id,@REC)=split(/\|/,$line);
        print TMP $line  if($id ne $param{'-id'});
        if($id eq $param{'-id'}) {
        print TMP "$param{'-id'}|";
        	foreach (@{$param{'-record'}}) {
        	s/\|/ /g;# ÚÁÍÅÎÑÅÍ ×ÓÅ ÓÉÍ×ÏÌÙ | ÎÁ ÐÒÏÂÅÌÙ
		print TMP "$_|";
		}
	print TMP "\n";
        }
}
close(TMP);
close($fh);
my $test=rename($File,"$File.orig");
$test=rename("$obj->{'fpath'}/$name",$File);
return $test;
}

sub DeleteRecord { # ÁÒÇÕÍÅÎÔÙ -id
my $obj=shift;
my $fh=$obj->{'file'};# ÓÏÈÒÁÎÑÅÍ ÄÅÓËÒÉÐÔÏÒ ÆÁÊÌÁ × ÐÅÒÅÍÅÎÎÏÊ
my $File="$obj->{'fpath'}/$obj->{'nfile'}";# ÄÌÑ ÕÄÏÂÓÔ×Á ÓÏÈÒÁÎÑÅÍ ÄÁÎÎÙÅ × ÐÅÒÅÍÅÎÎÏÊ
my %param=@_;# ÐÒÉÎÉÍÁÅÍ ÁÒÇÕÍÅÎÔÙ × ÈÜÛ
my %hash=();
my $random=time();
my $name=int(rand($random));
$name=$random . $name .".tmp";
# ÏÔËÒÙ×ÁÅÍ ×ÒÅÍÅÎÎÙÊ ÆÁÊÌ
open(TMP,">","$obj->{'fpath'}/$name") || die "can't create temp file: $!";
# ÓÞÉÔÙ×ÁÅÍ ÆÁÊÌ
seek($fh,0,0);
while(defined(my $line=<$fh>)) {
	my($id,@REC)=split(/\|/,$line);
	next if($id eq $param{'-id'});# ÐÒÏÐÕÓËÁÅÍ ÐÒÉ ËÏÐÉÒÏ×ÁÎÉÉ ÚÁÐÉÓØ Ë ÕÄÁÌÅÎÉÀ
        print TMP $line;
}
close(TMP);
close($fh);
my $test=rename($File,"$File.orig");
$test=rename("$obj->{'fpath'}/$name",$File);
return $test;
}

sub DESTROY {
my $self=shift;
close($self->{'file'});
_unblock();
}

## private methods ########
sub _block {
my($path,$type)=@_;
open(SEM,">","$path/.keep_me") || die "Can't create lock file";
my $lock=flock(SEM,$type);
return $lock;
}

sub _unblock {
close(SEM)
}

1;

__END__