SVN: toys/rsget.pl/RSGet/FileList.pm

[sparky]

Author: sparky
Date: Thu Jul  8 02:35:13 2010
New Revision: 11637

Modified:
   toys/rsget.pl/RSGet/FileList.pm
Log:
- implement list file locking, may be buggy - please test;
  should solve RSGETPL-9


Modified: toys/rsget.pl/RSGet/FileList.pm
==============================================================================
--- toys/rsget.pl/RSGet/FileList.pm	(original)
+++ toys/rsget.pl/RSGet/FileList.pm	Thu Jul  8 02:35:13 2010
@@ -8,6 +8,7 @@
 use strict;
 use warnings;
 use URI::Escape;
+use Fcntl qw(:DEFAULT :flock SEEK_SET);
 use RSGet::Tools;
 set_rev qq$Id$;
 
@@ -29,6 +30,7 @@
 
 my $file;
 my $file_swp;
+my $list_fh;
 
 my $update = 1;
 # $uri => { cmd => "CMD", globals => {...}, options => {...} }
@@ -42,21 +44,40 @@
 our @actual;
 our @added;
 
+sub list_open
+{
+	my $file = shift;
+	sysopen my $fh, $file, O_RDWR | O_CREAT or die "Cannot open $file: $!\n";
+	flock $fh, LOCK_EX | LOCK_NB or die "Cannot lock $file: $!\n";
+	seek $fh, 0, SEEK_SET;
+	return $fh;
+}
+
+sub list_close
+{
+	my $fh = shift;
+	flock $fh, LOCK_UN;
+	return close $fh;
+}
+
+END {
+	list_close $list_fh if $list_fh;
+}
+
 sub set_file
 {
 	$file = setting( "list_file" );
 	unless ( defined $file ) {
 		$file = 'get.list';
-		if ( -r $file ) {
-			p "Using '$file' file list\n";
-		} else {
+		unless ( -r $file ) {
 			p "Creating empty file list '$file'";
-			open F_OUT, '>', $file;
-			print F_OUT "# empty list\n";
-			close F_OUT;
+			$list_fh = list_open $file;
+			print $list_fh "# empty list\n";
 		}
-	} else {
+	}
+	unless ( $list_fh ) {
 		p "Using '$file' file list\n";
+		$list_fh = list_open $file;
 	}
 	die "Can't read '$file'\n" unless -r $file;
 
@@ -187,11 +208,10 @@
 	return unless -r $file;
 	my $mtime = (stat _)[9];
 	return unless $update or $mtime != $listmtime;
-	#p "readlist()";
 
-	open my $list, '<', $file;
-	my @list = <$list>;
-	close $list;
+	list_close $list_fh;
+	$list_fh = list_open $file;
+	my @list = <$list_fh>;
 
 	push @list, @added;
 
@@ -371,11 +391,13 @@
 	unlink $file_swp if @added or $update == 2;
 
 	unless ( -e $file_swp ) {
-		open my $newlist, '>', $file . ".tmp";
-		print $newlist @new;
-		close $newlist || die "\nCannot update $file file: $!\n";
+		my $fh = list_open $file . ".tmp";
+		print $fh @new;
+		$fh->flush() or die "Cannot write data to file: $!\n";
+		list_close $list_fh;
 		unlink $file;
 		rename $file . ".tmp", $file;
+		$list_fh = $fh;
 		@added = ();
 		$process = undef;
 		foreach my $uri ( @used_save ) {