view release on metacpan or  search on metacpan

lib/DBstorage/RDB.pm  view on Meta::CPAN

	$delete_all || last loop;
    }
    while(<INPUT_TABLE>) {
	print OUTPUT_TABLE;
    }
    close(OUTPUT_TABLE);

    $self->close();
    $self->commit($filename, "/tmp/delete1.$$");
    $lock->release();

}


sub append {
    my $self = shift;
    my $table = shift;
    my $hashref = shift;

    my %inarray = %{$hashref};

    my (%type, @fields, $output);

    foreach (keys %inarray) {
#	remove forward and trailing space
	$inarray{$_} =~ s/^\s+(.*)/$1/g;
	$inarray{$_} =~ s/(.*)\s+$/$1/g;
	$inarray{$_} =~ s/\s+/ /g;
    }

    my $lock = DBfilelock->new("${table}.lck");

    if (!-e $table || -z $table) {
	open("FILE", ">$table") || croak "Cannot open";
	$_ = join("\t", grep(!/^RDB/, sort (keys %inarray)));
	print FILE  "$_\n";
	s/[^\t]/\-/g;
	print FILE  "$_\n";
	close FILE;
    } 

    %type = $self->attrib($table);
    @fields = @{$type{"fields"}};
    if ($type{"type"} eq "list") {
	open (FILE, ">/tmp/file.$$");
	open (INPUT_FILE, $table);
	while (<INPUT_FILE>) {
	    print FILE $_;
	    $output = $_;
	}
	close(INPUT_FILE);
	if ($output !~ /^\s*$/) {	
	    print FILE "\n";
	}
	foreach (@fields) {
	    print FILE "$_\t$inarray{$_}\n";
	}
	close (FILE);
    } elsif($type{"type"} eq "table") {
	`cp $table /tmp/file.$$`;
	chmod 0664, "/tmp/file.$$";
	open (FILE ,">>/tmp/file.$$");
	print FILE join("\t", @inarray{@fields}) . "\n";
	close (FILE);
    } else {
	$lock->release();
	croak;
    }
    $self->commit($table, "/tmp/file.$$");	
    $lock->release();
    %{$hashref} = %inarray;
}

sub replace {
    my $self = shift;
    my $filename = shift;
    my $keyref = shift;
    my $replace_ref = shift;
    my $replace_all = shift;

    my %keys = %{$keyref};
    my %replace_values = %{$replace_ref};


    my (@keys) = keys %keys;
    my (@replace_keys) = keys %replace_values;
    my (%type, @fields, %f, $invalue, $input_line, %cookie);
    local ($_);
    my ($nrecords);

    my ($lock) = DBfilelock->new("$filename.lck");

    $self->open($filename, "INPUT_TABLE");
    if ($self->type() eq "table") {
	open (OUTPUT_TABLE, ">/tmp/replace1.$$");
    } elsif ($self->type() eq "list") {
	open (OUTPUT_TABLE, "| $self->{'tabletolist'} > /tmp/replace1.$$");
    } else {
	print "Unknown table type $type{'type'}!!!!";
	exit;
    }
    print OUTPUT_TABLE $self->table_header($self->{'FIELDS'});
    @fields = @{$self->{'FIELDS'}};
  loop:

# Break an abstraction barrier for speed
    while ($input_line = <INPUT_TABLE>) {
	chop $input_line;
	if ($input_line ne "") {
	    @f{@fields} = split("\t", $input_line);
	    $nrecords++;
	} else {
	    next loop;
	}

	foreach (@keys) {
	    if ($keys{$_} ne $f{$_}) {
		print OUTPUT_TABLE $input_line, "\n";
		next loop;
	    }
	}

lib/DBstorage/RDB.pm  view on Meta::CPAN

	print OUTPUT_TABLE join("\t", @f{@fields}), "\n";
	$replace_all || last loop;
    }
    while(<INPUT_TABLE>) {
	if ($_ ne "\n") {
	    print OUTPUT_TABLE;
	    $nrecords++;
	}
    }
    $cookie{'nrecords'} = $nrecords;

    close(OUTPUT_TABLE);
    $self->close();
    $self->commit($filename, "/tmp/replace1.$$");
    $lock->release();
}

sub commit {
    my $self = shift;
    my $filename = shift;
    my $newfilename = shift;
    my($has_rcs, $checkin, $checkout);
    my(@list) = split(/\//, $filename);
    my($file) = pop @list;
    my($dir) = join("/", @list);
    my($rcsfile) = "$dir/RCS/$file,v";

    if (-z $newfilename) {
	print "$newfilename is a zero length file.  Aborting....";
	croak;
    }

    $has_rcs = ((-e "$filename,v") || (-e $rcsfile));

    if (!-e $filename) {
	`mv $newfilename $filename`;
    }

    if (!-w $filename && $has_rcs) {
	$checkout = $self->checkout($filename, "-l");
	$checkin =  $self->checkin($filename, 
			 "-u", "Checked in by $ENV{'REMOTE_USER'}");
	`$checkout
cp $filename $filename.bak
mv $newfilename $filename
$checkin &`;
    }  elsif (-w $filename && $has_rcs) {
	$checkin = $self->checkin($filename, 
			 "-l", "Checked in by $ENV{'REMOTE_USER'}");
	`cp $filename $filename.bak
mv $newfilename $filename
$checkin &`;
    } elsif (-w $filename && !$has_rcs) {
	`cp $filename $filename.bak
mv $newfilename $filename`;
    } else {
	print "Error cannot write to file $filename";
	croak;
    }
    if (-e "${filename}.bak") {
	chmod 0666, "${filename}.bak";
    }
}

sub checkout {
    my ($self, $filename, $options) = @_;
    return "$self->{'CO'} $options $filename 2> /dev/null";
}

sub checkin {
    my ($self, $filename, $options, $message) = @_;
    return "echo '$message' | $self->{'CI'} $options $filename 2> /dev/null";
}

sub create {
    my ($self, $filename, $fieldref) = @_;
    local (*FILE);
    if (!-e $filename) {
	open(FILE, ">$filename");
	print FILE $self->table_header($fieldref);
	close(FILE);
    }
}

sub table_header {
    my($self, $fieldref) = @_;
    if (!defined($fieldref)) {
       $fieldref = $self->{'FIELDS'};
    }
    my($header) = join("\t", @{$fieldref});
    my($return_value) = $header;
    $return_value .= "\n";
    $header =~ s/\S/\-/g;
    $return_value .= $header;
    $return_value .= "\n";
    return $return_value;
}


sub open {
    my $self = shift;
    my $filename = shift;
    my $filehandle = shift;
    my $line;

    if (!defined($filehandle)) {
	$filehandle = gensym;
    }

    ($filehandle ne "STDIN") &&
	(open($filehandle, $filename) || return 0);
    $line = readline(*$filehandle);
    if ($line =~ /^\s*$/) {
	close($filehandle);
	($filehandle ne "STDIN") &&
	    (open($filehandle, "$self->{'listtotable'} < $filename |") ||
	     return 0);
	$line = <$filehandle>;
	chop;
	$self->{'TYPE'}->{"type"} = "list";
    } else {