Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 319 lines (252 sloc) 7.667 kB
5550c3a @perusionmike Initial import of changed Challenger with UI instead of Minimate.
perusionmike authored
1 #!/usr/bin/perl
2 ##!~_~perlpath~_~
3 #
2a14b06 testing
Eric Zarko authored
4 # Interchange database updater
5550c3a @perusionmike Initial import of changed Challenger with UI instead of Minimate.
perusionmike authored
5 #
43d511c @pajamian * Updated copyright headers to 2007 (closes bug #102)
pajamian authored
6 # Copyright (C) 2002-2007 Interchange Development Group
3397adc @jonjensen The great copyright, email address, URL, and version update.
jonjensen authored
7 # Copyright (C) 1996-2002 Red Hat, Inc.
2a14b06 testing
Eric Zarko authored
8 #
5550c3a @perusionmike Initial import of changed Challenger with UI instead of Minimate.
perusionmike authored
9 # This program is free software; you can redistribute it and/or modify
10 # it under the terms of the GNU General Public License as published by
11 # the Free Software Foundation; either version 2 of the License, or
12 # (at your option) any later version.
13 #
14 # This program is distributed in the hope that it will be useful,
15 # but WITHOUT ANY WARRANTY; without even the implied warranty of
16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 # GNU General Public License for more details.
18 #
19 # You should have received a copy of the GNU General Public
20 # License along with this program; if not, write to the Free
07f71a7 @pajamian New Free Software Foundation Address in headers of various files
pajamian authored
21 # Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
22 # MA 02110-1301 USA.
5550c3a @perusionmike Initial import of changed Challenger with UI instead of Minimate.
perusionmike authored
23
a30978f s:/usr/local/minivend:/usr/local/interchange:g;
Eric Zarko authored
24 use lib '/usr/local/interchange/lib';
5550c3a @perusionmike Initial import of changed Challenger with UI instead of Minimate.
perusionmike authored
25 #use lib '~_~INSTALLPRIVLIB~_~';
a30978f s:/usr/local/minivend:/usr/local/interchange:g;
Eric Zarko authored
26 use lib '/usr/local/interchange';
5550c3a @perusionmike Initial import of changed Challenger with UI instead of Minimate.
perusionmike authored
27 #use lib '~_~INSTALLARCHLIB~_~';
28
2a14b06 testing
Eric Zarko authored
29 use strict;
30 use Fcntl;
31 use Vend::Config;
32 use Vend::Data;
33 use Vend::Util;
5550c3a @perusionmike Initial import of changed Challenger with UI instead of Minimate.
perusionmike authored
34
2a14b06 testing
Eric Zarko authored
35 BEGIN {
36 eval {
37 require 5.004;
38 require FindBin;
39 1 and $Global::VendRoot = "$FindBin::RealBin";
40 1 and $Global::VendRoot =~ s/.bin$//;
41 };
5550c3a @perusionmike Initial import of changed Challenger with UI instead of Minimate.
perusionmike authored
42 ($Global::VendRoot = $ENV{MINIVEND_ROOT})
43 if defined $ENV{MINIVEND_ROOT};
a30978f s:/usr/local/minivend:/usr/local/interchange:g;
Eric Zarko authored
44 $Global::VendRoot = $Global::VendRoot || '/usr/local/interchange';
5550c3a @perusionmike Initial import of changed Challenger with UI instead of Minimate.
perusionmike authored
45 # $Global::VendRoot = $Global::VendRoot || '~_~INSTALLARCHLIB~_~';
a71f111 @perusionmike Updated to find either interchange.cfg or minivend.cfg
perusionmike authored
46
47 if(-f "$Global::VendRoot/interchange.cfg") {
48 $Global::ExeName = 'interchange';
49 $Global::ConfigFile = 'interchange.cfg';
50 }
51 elsif(-f "$Global::VendRoot/minivend.cfg") {
52 $Global::ExeName = 'minivend';
53 $Global::ConfigFile = 'minivend.cfg';
54 }
55 elsif(-f "$Global::VendRoot/interchange.cfg.dist") {
56 $Global::ExeName = 'interchange';
57 $Global::ConfigFile = 'interchange.cfg';
58 }
5550c3a @perusionmike Initial import of changed Challenger with UI instead of Minimate.
perusionmike authored
59 }
2a14b06 testing
Eric Zarko authored
60
61 ### END CONFIGURATION VARIABLES
5550c3a @perusionmike Initial import of changed Challenger with UI instead of Minimate.
perusionmike authored
62
63 sub dontwarn { $FindBin::RealBin; }
64
65 $Global::ErrorFile = "$Global::VendRoot/error.log";
66 $Vend::ExternalProgram = 1;
67
68 my $DEBUG = 0;
69
70 #select a DBM
71
72 BEGIN {
73 $Global::GDBM = $Global::DB_File = 0;
74 AUTO: {
75 last AUTO if
76 (defined $ENV{MINIVEND_DBFILE} and $Global::DB_File = 1);
77 last AUTO if
78 (defined $ENV{MINIVEND_NODBM});
79 eval {require GDBM_File and $Global::GDBM = 1};
80 eval {require DB_File and $Global::DB_File = 1};
81 }
82 if($Global::GDBM) {
83 require Vend::Table::GDBM;
84 import GDBM_File;
85 $Global::GDBM = 1;
86 $Global::Default_database = 'GDBM';
87 }
88 if($Global::DB_File) {
89 require Vend::Table::DB_File;
90 import DB_File;
91 $Global::DB_File = 1;
92 $Global::Default_database = 'DB_FILE'
93 unless defined $Global::Default_database;
94 }
95 if(! $Global::GDBM and ! $Global::DB_File) {
96 die "No DBM defined! Update not designed to work with DBI or memory databases.\n";
97 }
98 }
99
100 $Vend::Cfg = {};
101
102 my $Name = 'products';
103 my $Directory;
104
105 my $USAGE = <<EOF;
106 usage: update -c catalog [-n name] \\
107 -f field [-f field1 -f field2 ...] -k key value [value1 value2 ...]
108 or
109
110 usage: update -c catalog -i inputfile [-n name]
111
112 Options:
113
a71f111 @perusionmike Updated to find either interchange.cfg or minivend.cfg
perusionmike authored
114 -c catalog Catalog name as defined in interchange.cfg.
5550c3a @perusionmike Initial import of changed Challenger with UI instead of Minimate.
perusionmike authored
115 -f field Field name(s) in database. If multiple fields are specified,
116 multiple corresponding values must be supplied. Use '' to
117 set to the empty string.
118 -i file Input file to add entries to an existing database. (Must
119 be in same format/order as existing database.)
120 -k key Key (item code) to be updated.
121 -n name Database name as defined in catalog.cfg (default products).
122
123 If specifying a subcatalog database, make sure it is defined in the
124 subcatalog definition. If it is in the base catalog, use that catalog
125 as the parameter for the -c directive.
126 EOF
127
128 my ($Inputfile, $Key, @Fields, @Values);
129 my ($Catalog,$delimiter,$db);
130
131 GETOPT: {
132
133 if($ARGV[0] eq '-c') {
134 shift(@ARGV);
135 $Catalog = shift(@ARGV);
136 redo GETOPT;
137 }
138 elsif($ARGV[0] eq '-d') {
139 shift(@ARGV);
140 $Directory = shift(@ARGV);
141 redo GETOPT;
142 }
143 elsif($ARGV[0] eq '-n') {
144 shift(@ARGV);
145 $Name = shift(@ARGV);
146 redo GETOPT;
147 }
148 elsif($ARGV[0] eq '-k') {
149 shift(@ARGV);
150 $Key = shift(@ARGV);
151 redo GETOPT;
152 }
153 elsif($ARGV[0] eq '-i') {
154 shift(@ARGV);
155 $Inputfile = shift(@ARGV);
156 redo GETOPT;
157 }
158 elsif($ARGV[0] eq '-f') {
159 shift(@ARGV);
160 push(@Fields, shift @ARGV);
161 redo GETOPT;
162 }
163
164 } # END GETOPT
165
166 die $USAGE unless defined $Catalog;
167
168 push @Values, @ARGV;
169
170 if(@Fields and ! @Values) {
171 die $USAGE . "\n";
172 }
173 elsif (scalar(@Fields) != scalar(@Values) ) {
174 die "Number of fields and number of values don't match.\n" . $USAGE . "\n";
175 }
176 elsif ((@Fields or @Values) and defined $Inputfile) {
177 die "No field or value arguments accepted when inputting from a file.\n" .
178 $USAGE . "\n";
179 }
180 elsif (@Fields and ! $Key) {
181 die $USAGE . "\n";
182 }
183 elsif (!defined $Inputfile and ! @Fields and !@Values) {
184 die $USAGE . "\n";
185 }
186
187 my($name,$dir,$param,$subcat,$subconfig);
188 chdir $Global::VendRoot;
56f620a @perusionmike Multiple security fixes, tightening up opens with explicit "< $filena…
perusionmike authored
189 open(GLOBAL, "< $Global::ConfigFile") or
5550c3a @perusionmike Initial import of changed Challenger with UI instead of Minimate.
perusionmike authored
190 die "No global configuration file? Aborting.\n";
191 while(<GLOBAL>) {
192 next unless /^\s*(sub)?catalog\s+$Catalog\s+/i;
193 $subcat = $1 || '';
194 chomp;
195 s/^\s+//;
196 unless($subcat) {
197 (undef,$name,$dir,$param) = split /\s+/, $_, 4;
198 }
199 else {
200 (undef,$name,$subconfig,$dir,$param) = split /\s+/, $_, 5;
201 }
202 last;
203
204 }
205 close GLOBAL;
206
207 global_config();
208
209 chdir $dir or die "Couldn't change directory to $dir: $!\n";
210
a36ac8f @perusionmike * Add general purpose survey and mailed-form creator for the UI.
perusionmike authored
211 $Vend::ExternalProgram = $Vend::Quiet = 1;
212
5550c3a @perusionmike Initial import of changed Challenger with UI instead of Minimate.
perusionmike authored
213 $Vend::Cfg = config($name, $dir, "$dir/etc", ($subconfig || undef));
214 $::Variable = $Vend::Cfg->{Variable};
215
216 die "Problems with config.\n" unless defined $Vend::Cfg;
217
218 $Vend::Cfg->{ProductDir} = $Directory
219 if defined $Directory;
220
221 die "Bad data directory $Vend::Cfg->{ProductDir} -- doesn't exist.\n$USAGE\n"
222 unless -d $Vend::Cfg->{ProductDir};
223
224 open_database(1);
225
226 $Vend::WriteDatabase{$Name} = 1;
227
228 die "Bad database $Name -- doesn't exist.\n\n$USAGE\n"
229 unless $db = database_exists_ref($Name);
230
231 my $ref;
232 eval {
233 $ref = $db->ref();
234 };
235
236 die "Bad open of database $Name from catalog $Catalog ($!): $@\n"
237 unless $ref and ! $@;
238
239 unless($ref->record_exists($Key)) {
240 die "Key $Key not found in database $Name.\n";
241 }
242
243 my ($key,$field,@fields);
244
245 my $key_col = $Vend::Table::Common::KEY_IDX;
246
247 if (! defined $Inputfile ) {
248 foreach $field (@Fields) {
249 unless ( defined $ref->test_column($field) ) {
250 die "$field is not a column in the database.\n";
251 }
252 my $val = shift @Values;
253 print "setting ${Name}::${field}::$Key=$val\n";
254 $ref->set_field($Key, $field, $val);
255 }
256 }
257 else {
56f620a @perusionmike Multiple security fixes, tightening up opens with explicit "< $filena…
perusionmike authored
258 open (INPUT, "< $Inputfile") or die "Couldn't open input file $Inputfile: $!\n";
5550c3a @perusionmike Initial import of changed Challenger with UI instead of Minimate.
perusionmike authored
259 while(<INPUT>) {
260 chomp;
261 s/[\r\cZ]+//;
262 (@fields) = split /\t/, $_;
263 $key = $fields[$key_col];
264 $ref->set_row($key, @fields);
265 }
266 close INPUT;
267 }
268
269 close_database();
270
271 =head1 NAME
272
d6dc450 @perusionmike Changed Interchange name all over, minor exceptions being mvfaq.pod and
perusionmike authored
273 update -- command line setting of Interchange databases
5550c3a @perusionmike Initial import of changed Challenger with UI instead of Minimate.
perusionmike authored
274
275 =head1 VERSION
276
277 1.0
278
279 =head1 SYNOPSIS
280
281 update -c catalog [-f field -k key [-t table] value]
282
283 =head1 DESCRIPTION
284
d6dc450 @perusionmike Changed Interchange name all over, minor exceptions being mvfaq.pod and
perusionmike authored
285 Interchange's C<update> is a rudimentary method of directly setting the
286 DBM files (not the ASCII files) of a Interchange DBM database.
5550c3a @perusionmike Initial import of changed Challenger with UI instead of Minimate.
perusionmike authored
287
288 NOTE: This command DOES NOT APPLY TO SQL databases. They have their own
289 command line monitors that are more flexible.
290
291 =head1 OPTIONS
292
293 =over 4
294
295 =item -c name
296
297 Sets the catalog for which C<update> operates. It reads the
298 catalog.cfg file to retrieve database settings.
299
300 =item -f field
301
302 The name of the field to set.
303
304 =item -n name
305
306 The name of the table to set. If the table is not a DBM database the
307 C<update> program will terminate with an error.
308
309 =back
310
311 =head1 SEE ALSO
312
3397adc @jonjensen The great copyright, email address, URL, and version update.
jonjensen authored
313 http://www.icdevgroup.org/
5550c3a @perusionmike Initial import of changed Challenger with UI instead of Minimate.
perusionmike authored
314
315 =head1 AUTHOR
316
3397adc @jonjensen The great copyright, email address, URL, and version update.
jonjensen authored
317 Mike Heins
5550c3a @perusionmike Initial import of changed Challenger with UI instead of Minimate.
perusionmike authored
318
Something went wrong with that request. Please try again.