view release on metacpan or  search on metacpan

lib/Bio/ConnectDots/scripts/update_connectorsets.pl  view on Meta::CPAN

					my $localdir = "/tmp";
					print "# Downloading file: $file\n";
					$ftp->get(RemoteDir=>$dir, RemoteFile=>$file, LocalDir=>$localdir);
					
					# unzip if needed
					if($file =~ /\.gz$/) {
						system "gunzip $localdir/$file";
						$file =~ s/\.gz$//i;	
					} elsif ($file =~ /\.z$/i || $file =~ /\.zip$/i) {
						system "unzip $localdir/$file";	
						$file =~ s/\.z(.{2})*$//i;	
					}
					push @cat_files, "$localdir/$file";
				}
			}
			
			# concatenate multiple downloaded files into db file if needed
			if(@cat_files > 1) {
				my $catcmd = "cat ". join(' ', @cat_files) ." > $localfile";
				my $rmcmd = "rm ". join(' ', @cat_files);
				system "$catcmd";
				system "$rmcmd";
			} elsif(@cat_files == 1) {
				system "mv ". $cat_files[0] ." $localfile";
			} else {
				print "### ERROR ($cs_name): Problem with downloaded files\n";
			}			
			
			# reload the connectorset into connect the dots database
			system "perl unload.pl --connectorset $cs_name" if $REMOVEOLD;
			modify_cnf_version($cs_name,$newversion);
			my $loadcmd = "perl load.pl --database $DATABASE --user $USER ";
			$loadcmd .= " --password ". $PASSWORD if $PASSWORD;
			$loadcmd .= " ../ConnectorSet/$cs_name.cnf $localfile";
			system "$loadcmd";
			
		} # end exist new		
	} # end if ftp attributes exist
} # end fetchrow loop 



# recieves a comma seperated list of files with their direct paths
# returns a hashref keyed on directory, value is filename
sub parse_files {
	my ($ftp_files) = @_;
	my %files;
	my @entries = split(/,/, $ftp_files);
	foreach (@entries) {
		my ($dir,$file) = /(.*\/)(.+)$/;
		push @{$files{$dir}}, $file;
	}	
	return \%files;
}

# recieves a file and returns hashref of day,month,year it was last modified in the local file system
sub get_file_date {
	my ($filename) = @_;
	my %out;
	open(FILE,$filename) or die "Can not open $filename\n";
	my $stat = stat($filename);
	my $lastmodified = $stat->mtime;
	my @times = localtime($lastmodified);
	$out{day} = $times[3];
	$out{month} = $times[4];
	$out{year} = $times[5]+1900;
	return \%out;
}

# returns true when remote(year,month,day) is newer than local
sub is_new {
	my ($local, $remote) = @_;
	return 0 unless $local && $remote;
	my $ldate = cat_date($local);
	my $rdate = cat_date($remote);
	return 1 if $rdate > $ldate;
	return 0;
}

# returns concatentated data
sub cat_date {
	my $remote = shift;
	my $return = $remote->{year};
	if($remote->{month} < 10) {
		$return .= 	'0'. $remote->{month};
	} else {
		$return .= 	$remote->{month};
	}
	if($remote->{day} < 10) {
		$return .= 	'0'. $remote->{day};
	} else {
		$return .= 	$remote->{day};
	}
	return $return;	
}

sub modify_cnf_version {
	my ($cs_name, $newversion) = @_;
	my $filename = "../ConnectorSet/$cs_name.cnf";
	my @lines;
	open(IN, "$filename")  or die "Can not open $filename\n";
	while(<IN>) {
		if(/^version/) {
			push @lines, "version=$newversion\n";
		} else {
			push @lines, $_;	
		}
	}
	close(IN);
	open(OUT, ">$filename") or die "Can not open $filename for writing\n";
	foreach (@lines) {
		print OUT $_;	
	}
	close(OUT);
}