1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
|
#! /bin/sh
#!perl -w # --*- Perl -*--
eval 'exec perl -x $0 ${1+"$@"}'
if 0;
#------------------------------------------------------------------------------
#$Author: antanas $
#$Date: 2017-05-24 20:10:55 +0300 (Tr, 24 geg. 2017) $
#$Revision: 5322 $
#$URL: svn://www.crystallography.net/cod-tools/tags/v2.3/scripts/fetch_cif_dict $
#$Id: fetch_cif_dict 5322 2017-05-24 17:10:55Z antanas $
#------------------------------------------------------------------------------
#*
#* Fetches cif_core.dic from the IUCr FTP site if non-expired local copy
#* does not exist.
#*
#* USAGE:
#* $0 --options
#**
use strict;
use warnings;
use Net::FTP;
use File::Compare qw( compare );
use File::Copy qw( move );
use COD::SOptions qw( getOptions );
use COD::SUsage qw( usage options );
use COD::UserMessage qw( note warning error sprint_message );
use COD::ToolsVersion;
my $version = '1.0';
my $cache_duration = 432000; # 60 * 60 * 24 * 5 = 432000 -> for 5 days
my $from_mail = undef; # e-mail of user using script
my $force_overwrite = 0; # force overwrite of local file or cache clearance
my $verbose = 0;
my $dict_file_uri = 'ftp://ftp.iucr.org/pub/cif_core.dic';
#* OPTIONS:
#* --cache-duration 432000
#* Time in seconds, for which the file will remain
#* untouched unless forced to do otherwise
#* (see --force-overwrite) (default 432000).
#* --mail-address fetcher@mail.com
#* The e-mail address that will be used passed to the FTP
#* server as an identifier of the client using the service.
#* It is not mandatory and there is no default, but we
#* insist you to declare it.
#* --force-overwrite
#* Disregard local file modification time and cache duration
#* values while fetching the requested file.
#* --no-force-overwrite
#* Respect local file modification time and cache duration
#* values while fetching the requested file (default).
#* --silent, --quiet
#* Suppress additional messages about the progress of the
#* script. Only fatal errors will be printed.
#* --verbose, --no-quiet
#* Print additional messages about the progress of the
#* script.
#* --help, --usage
#* Output a short usage message (this message) and exit.
#* --version
#* Output version information and exit.
#**
@ARGV = getOptions(
'--cache-duration' => \$cache_duration,
'--mail-address' => \$from_mail,
'--force-overwrite' => sub { $force_overwrite = 1 },
'--no-force-overwrite' => sub { $force_overwrite = 0 },
'--silent' => sub { $verbose = 0 },
'--quiet' => sub { $verbose = 0 },
'--verbose' => sub { $verbose = 1 },
'--no-quiet' => sub { $verbose = 1 },
'--options' => sub { options; exit },
'--help,--usage' => sub { usage; exit },
'--version' => sub { print 'cod-tools version ',
$COD::ToolsVersion::Version, "\n";
exit }
);
fetch_dictionary($dict_file_uri, $cache_duration, $from_mail, $force_overwrite);
# This subroutine is used before fetching new dictionary from FTP.
# It creates local directory and returns path to it.
# Parameters:
# NONE
# Example:
# prepare_local();
sub prepare_local
{
my $my_cod_dir = '';
if( defined $ENV{HOME} ) {
$my_cod_dir = $ENV{HOME} . '/';
}
$my_cod_dir .= '.cod/';
if( ! -d $my_cod_dir ) {
if( ! mkdir $my_cod_dir, 0775 ) {
error( $0, $my_cod_dir, undef, 'unable to create COD directory ',
lcfirst($!) );
return 0;
}
note( $0, $my_cod_dir, undef, 'created directory to store '
. 'Crystallography Open Database (COD) persistent files', undef );
}
return $my_cod_dir;
}
# Subroutine used to create a copy of local dictionary file appending
# date to file name.
# Parameters:
# 1) string -- path to local dictionary file
# Example:
# create_copy_of_local_file( '/home/user/.cod/cif_core.dic' );
sub create_copy_of_local_file
{
my ($local_dict_file) = @_;
my @local_time = localtime(time);
my $moved_dist_file = $local_dict_file . '_';
$moved_dist_file .= ($local_time[5]+1900) . '-';
$moved_dist_file .= ($local_time[4] < 10) ? '0' . $local_time[4] : $local_time[4];
$moved_dist_file .= '-' . $local_time[3];
if( -e $moved_dist_file ) {
warning( $0, undef, undef, 'back-up of your current dictionary file '
. "already exists as '$moved_dist_file'", 'operation stopped' );
return 0;
}
if( ! move $local_dict_file, $moved_dist_file ) {
error( $0, undef, undef, "unable to create copy '$moved_dist_file' "
. "of your dictionary file '$local_dict_file'", lcfirst($!) );
return 0;
}
note( $0, undef, undef, 'created a copy of your dictionary file '
. "'$local_dict_file' as '$moved_dist_file'", undef);
return 1;
}
# Subroutine to replace fetched dictionary file by new one.
# This subroutine uses 'File::Compare' to check, if files are equal.
# There is no need, to replace old file by new if they are equal.
# If files are not equal and old file exists - create_copy_of_local_file is
# called.
# Parameters:
# 1) string -- path to local dictionary file;
# 2) string -- path to temporary folder where downloaded file resides.
# Example:
# move_fetched_file_if_diff( '/home/user/.cod/cif_core.dic',
# '/tmp/fetch_cif_dict_17531_cif_core.dic' )
sub move_fetched_file_if_diff
{
my ($dict_file_path, $new_file_path) = @_;
if( -e $dict_file_path ) {
if( compare($dict_file_path, $new_file_path) == 0 ) {
note( $0, undef, undef, 'new file does not differ from its '
. 'previous version', 'only its mtime will be changed '
. 'for further processes' );
utime undef, undef, $dict_file_path;
unlink $new_file_path;
return 0;
}
return unless create_copy_of_local_file( $dict_file_path );
}
if( ! move $new_file_path, $dict_file_path ) {
error( $0, undef, undef, 'unable to create new dictionary file '
. "'$dict_file_path' moving '$new_file_path'", lcfirst($!) );
unlink $new_file_path;
return 0;
}
note( $0, $dict_file_path, undef, 'new dictionary file was successfuly ' .
'downloaded', undef );
return 1;
}
# Subroutine to fetch dictionary.
# Parameters:
# 1) string -- full FTP address of dictionary to be fecthed;
# 2) int -- time in seconds to cache file (will be checked against
# mtime of local file);
# 3) string -- e-mail of user using script (will be used to
# authenticate against FTP server);
# 4) int -- this flag forces download if set to higher than 0 (zero)
# value;
# Example:
# fetch_dictionary( 'ftp://ftp.iucr.org/pub/cif_core.dic', 432000,
# 'name@example.com', 0 );
sub fetch_dictionary
{
my ($dict_file_uri, $cache_duration, $user_mail, $force_download) = @_;
$dict_file_uri =~ m/^([a-z]+):\/\/([^\/]+)(\/.*\/)([^\/]+)$/s;
my %ftp = ( 'protocol' => $1,
'host' => $2,
'path' => $3,
'file' => $4
);
my $local_path = prepare_local();
my $local_dict_path = $local_path . $ftp{file};
return unless $local_path ;
my $temporary_store = '/tmp';
if( defined $ENV{TMP}
&& -d $ENV{TMP} ) {
$ENV{TMP} =~ m/^(.*)\/?$/;
$temporary_store = $1;
}
$0 =~ m/\/?([^\/]+)$/;
$temporary_store .= '/' . $1 . '_' . $$ . '_' . $ftp{file};
# if dictionary does not exist in local cache, or has expired
if( $force_download == 0
&& -e $local_dict_path
&& (stat($local_dict_path))[9] < (time() + $cache_duration) ) {
warning( $0, $ftp{file}, undef, 'dictionary file already exists in '
. "local folder as '$local_dict_path'", 'operation canceled' );
return 0;
}
# download file
my $ftp_agent = Net::FTP->new($ftp{host}, Debug => 0, Passive => 1) or die
sprint_message($0, undef, undef, 'ERROR', 'unable to connect'
. "to ftp '$ftp{host}'", lcfirst($@));
$ftp_agent->login('anonymous', $user_mail) or die
sprint_message($0, undef, undef, 'ERROR', 'unable to '
. 'authenticate', lcfirst($ftp_agent->message) );
$ftp_agent->cwd($ftp{path}) or die
sprint_message($0, undef, undef, 'ERROR', 'unable to '
. "change working directory to '$ftp{path}'",
lcfirst($ftp_agent->message) );
$ftp_agent->get($ftp{file}, $temporary_store) or die
sprint_message($0, undef, undef, 'ERROR', 'unable to fetch'
. "file '$ftp{file}'",
lcfirst($ftp_agent->message));
note( $0, $dict_file_uri, undef, 'succesfully downloaded the dictionary and '
. "stored it as '$temporary_store' for further processing", undef );
$ftp_agent->quit;
# attempt to replace file
return move_fetched_file_if_diff( $local_dict_path, $temporary_store );
}
|
