1 | package g2futil;
|
---|
2 |
|
---|
3 |
|
---|
4 | BEGIN
|
---|
5 | {
|
---|
6 | if (!defined $ENV{'FEDORA_HOME'}) {
|
---|
7 | print STDERR "Environment variable FEDORA_HOME not set.\n";
|
---|
8 | exit 1;
|
---|
9 | }
|
---|
10 |
|
---|
11 | my $fedora_home = $ENV{'FEDORA_HOME'};
|
---|
12 | my $fedora_client_bin = &util::filename_cat($fedora_home,"client","bin");
|
---|
13 | $ENV{'PATH'} .= ":$fedora_client_bin";
|
---|
14 | }
|
---|
15 |
|
---|
16 | use util;
|
---|
17 |
|
---|
18 | sub run_cmd_old
|
---|
19 | {
|
---|
20 | my ($cmd,$verbosity,$tolerate_error) = @_;
|
---|
21 |
|
---|
22 | if (($verbosity == 0)
|
---|
23 | || (defined $tolerate_error && ($tolerate_error eq "tolerate_error"))) {
|
---|
24 | $cmd .= " > /dev/null"; # Too Unix specific?
|
---|
25 | }
|
---|
26 |
|
---|
27 | if ($verbosity >= 2) {
|
---|
28 | print "Runing command:\n";
|
---|
29 | print "$cmd\n";
|
---|
30 | }
|
---|
31 |
|
---|
32 | my $status = system($cmd);
|
---|
33 |
|
---|
34 | if ($verbosity >= 2) {
|
---|
35 | print "Exit status = ", $status/256, "\n";
|
---|
36 | }
|
---|
37 |
|
---|
38 | if ((!defined $tolerate_error) || ($tolerate_error ne "tolerate_error")) {
|
---|
39 | if ($status>0) {
|
---|
40 | print STDERR "Error executing:\n$cmd\n";
|
---|
41 | print STDERR "$!\n";
|
---|
42 | }
|
---|
43 | }
|
---|
44 |
|
---|
45 | return $status;
|
---|
46 | }
|
---|
47 |
|
---|
48 |
|
---|
49 | sub run_cmd
|
---|
50 | {
|
---|
51 | my ($prog,$arguments,$verbosity,$tolerate_error) = @_;
|
---|
52 |
|
---|
53 | my $script_ext = ($ENV{'GSDLOS'} =~ m/^windows/) ? ".bat" : ".sh";
|
---|
54 |
|
---|
55 | if ($prog =~ m/^fedora-/) {
|
---|
56 | $prog .= $script_ext;
|
---|
57 | }
|
---|
58 |
|
---|
59 | my $cmd = "$prog $arguments";
|
---|
60 |
|
---|
61 | ### print "*** cmd = $cmd\n";
|
---|
62 |
|
---|
63 | if (open(CMD,"$cmd 2>&1 |"))
|
---|
64 | {
|
---|
65 | my $result = "";
|
---|
66 | my $line;
|
---|
67 | while (defined ($line = <CMD>))
|
---|
68 | {
|
---|
69 | $result .= $line;
|
---|
70 |
|
---|
71 | if ((!defined $tolerate_error) || ($tolerate_error ne "tolerate_error"))
|
---|
72 | {
|
---|
73 | print $line;
|
---|
74 | }
|
---|
75 |
|
---|
76 |
|
---|
77 | }
|
---|
78 |
|
---|
79 | close(CMD);
|
---|
80 |
|
---|
81 | $cmd_status = $?;
|
---|
82 |
|
---|
83 | if ($cmd_status == 0) {
|
---|
84 | # Check for any lines in result begining 'Error:'
|
---|
85 |
|
---|
86 | if ($result =~ m/^Error\s*:/m) {
|
---|
87 | # Fedora script generated an error, but did not exit
|
---|
88 | # with an error status => artificially raise one
|
---|
89 |
|
---|
90 | $cmd_status = -1;
|
---|
91 | }
|
---|
92 | }
|
---|
93 |
|
---|
94 | if ($cmd_status != 0) {
|
---|
95 |
|
---|
96 | if ((!defined $tolerate_error) || ($tolerate_error ne "tolerate_error"))
|
---|
97 | {
|
---|
98 | print STDERR "Error: processing command failed. Exit status $cmd_status\n";
|
---|
99 |
|
---|
100 | if ($verbosity >= 2) {
|
---|
101 | print STDERR " Command was: $cmd\n";
|
---|
102 | }
|
---|
103 | if ($verbosity >= 3) {
|
---|
104 | print STDERR "result: $result\n";
|
---|
105 | }
|
---|
106 |
|
---|
107 | }
|
---|
108 | }
|
---|
109 | }
|
---|
110 | else
|
---|
111 | {
|
---|
112 | print STDERR "Error: failed to execute $cmd\n";
|
---|
113 | }
|
---|
114 |
|
---|
115 |
|
---|
116 | return $cmd_status;
|
---|
117 | }
|
---|
118 |
|
---|
119 |
|
---|
120 | sub run_datastore_info
|
---|
121 | {
|
---|
122 | my ($pid,$options) = @_;
|
---|
123 |
|
---|
124 | my $verbosity = $options->{'verbosity'};
|
---|
125 |
|
---|
126 | my $hostname = $options->{'hostname'};
|
---|
127 | my $port = $options->{'port'};
|
---|
128 | my $username = $options->{'username'};
|
---|
129 | my $password = $options->{'password'};
|
---|
130 | my $protocol = $options->{'protocol'};
|
---|
131 |
|
---|
132 | my $prog = "fedora-dsinfo";
|
---|
133 | my $arguments = "$hostname $port $username $password $pid $protocol";
|
---|
134 | my $status = run_cmd($prog,$arguments,$verbosity,"tolerate_error");
|
---|
135 |
|
---|
136 | return $status;
|
---|
137 | }
|
---|
138 |
|
---|
139 | sub run_purge
|
---|
140 | {
|
---|
141 | my ($pid,$options) = @_;
|
---|
142 |
|
---|
143 | my $verbosity = $options->{'verbosity'};
|
---|
144 |
|
---|
145 | my $hostname = $options->{'hostname'};
|
---|
146 | my $port = $options->{'port'};
|
---|
147 | my $username = $options->{'username'};
|
---|
148 | my $password = $options->{'password'};
|
---|
149 | my $protocol = $options->{'protocol'};
|
---|
150 |
|
---|
151 | my $server = "$hostname:$port";
|
---|
152 |
|
---|
153 | my $prog = "fedora-purge";
|
---|
154 | my $arguments = "$server $username $password $pid $protocol";
|
---|
155 | $arguments .= " \\\n \"Automated_purge_by_g2f_script\"";
|
---|
156 |
|
---|
157 | my $status = run_cmd($prog,$arguments,$verbosity);
|
---|
158 |
|
---|
159 | return $status;
|
---|
160 | }
|
---|
161 |
|
---|
162 | sub run_ingest
|
---|
163 | {
|
---|
164 | my ($docmets_filename,$options) = @_;
|
---|
165 |
|
---|
166 | my $verbosity = $options->{'verbosity'};
|
---|
167 |
|
---|
168 | my $hostname = $options->{'hostname'};
|
---|
169 | my $port = $options->{'port'};
|
---|
170 | my $username = $options->{'username'};
|
---|
171 | my $password = $options->{'password'};
|
---|
172 | my $protocol = $options->{'protocol'};
|
---|
173 |
|
---|
174 | my $server = "$hostname:$port";
|
---|
175 |
|
---|
176 | my $prog = "fedora-ingest";
|
---|
177 |
|
---|
178 | my $type = undef;
|
---|
179 |
|
---|
180 | if ($ENV{'FEDORA2_HOME'}) {
|
---|
181 | $type = "metslikefedora1";
|
---|
182 | }
|
---|
183 | else {
|
---|
184 | $type = "info:fedora/fedora-system:METSFedoraExt-1.1";
|
---|
185 | }
|
---|
186 |
|
---|
187 | my $arguments = "file \"$docmets_filename\" $type $server $username $password $protocol";
|
---|
188 | $arguments .= " \\\n \"Automated_purge_by_g2f_script\"";
|
---|
189 |
|
---|
190 | my $status = run_cmd($prog,$arguments,$verbosity);
|
---|
191 |
|
---|
192 | return $status;
|
---|
193 | }
|
---|
194 |
|
---|
195 |
|
---|
196 |
|
---|
197 | sub get_hash_id
|
---|
198 | {
|
---|
199 | my ($hash_dir) = @_;
|
---|
200 |
|
---|
201 | my $hash_id = undef;
|
---|
202 |
|
---|
203 | my $docmets_filename = &util::filename_cat($hash_dir,"docmets.xml");
|
---|
204 |
|
---|
205 | if (open(DIN,"<$docmets_filename"))
|
---|
206 | {
|
---|
207 | while (defined (my $line = <DIN>))
|
---|
208 | {
|
---|
209 | if ($line =~ m/<dc:identifier>(.*?)<\/dc:identifier>/)
|
---|
210 | {
|
---|
211 | $hash_id = $1;
|
---|
212 | last;
|
---|
213 | }
|
---|
214 | }
|
---|
215 |
|
---|
216 | close(DIN);
|
---|
217 | }
|
---|
218 | else
|
---|
219 | {
|
---|
220 | print STDERR "Warning: Unable to open \"$docmets_filename\"\n";
|
---|
221 | }
|
---|
222 |
|
---|
223 | return $hash_id;
|
---|
224 |
|
---|
225 | }
|
---|
226 |
|
---|
227 |
|
---|
228 |
|
---|
229 |
|
---|
230 | 1;
|
---|