Skip to content

HTTPS clone URL

Subversion checkout URL

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