# # This extraction code was taken from the libwww modules. # use Config; my $filename = $0; $filename =~ s/\.PL$//; open OUT,">$filename" or die "Can't create $filename: $!"; chmod(0755, $filename); print "Extracting $filename (with #! substitution)\n"; print OUT <<"EOHEADER"; $Config{'startperl'} -w eval 'exec perl -S \$0 "\$@"' if 0; EOHEADER print OUT <<'EOBODY'; use vars qw( $running_under_some_shell ); =head1 NAME dbfcstocs -- charset conversion of dbf files =head1 FORMAT dbfcstocs [options] src_encoding dst_encoding [file.dbf outfile.dbf...] =head1 SYNOPSIS dbfcstocs il2 1250 table.dbf table1.dbf Please see the dbfcstocs --help for short usage info. =head1 DESCRIPTION This script is a wrapper aound the cstocs utility, please see its man page first. This program converts charsets in dbf database files. You can also use the --field-names-charset option which will specify to which charset to convert the field names. So you can convert file in Windows-1250 to IOS-8859-2, but have its field names converted to US-ASCII: dbfcstocs --field-names-charset-ascii 1250 il2 table.dbf table1.dbf After the encoding specifications, pass couples of input dbf file, output destination file names. =head1 SEE ALSO cstocs(1). =head1 AUTHOR Jan Pazdziora, adelton@fi.muni.cz. =cut use strict; use Cz::Cstocs; use Cz::Cstocs::Getopt; use XBase; my ($convert, $options) = Cz::Cstocs::Getopt::process_argv( { 'field-names-charset=s' => 'field-names-charset', 'memofile=s' => 'memofile', 'memosep=s' => 'memosep', 'nomemo' => 'ignorememo', 'help' => sub { print "This is dbfcstocs version $Cz::Cstocs::VERSION.\n"; print STDERR <{'field-names-charset'}) { $names_convert = new Cz::Cstocs $options->{'inputenc'}, $options->{'field-names-charset'}, 'one-by-one' => 1 or die "Error initializing field names conversion: $Cz::Cstocs::errstr.\n"; } ### use Data::Dumper; print "Options: ", Dumper $options; if (not defined $convert) { print STDERR $@; exit(1); } my $length_of_argv = @ARGV; if ($length_of_argv == 0) { die "Need file names to convert.\n"; } elsif ($length_of_argv > 2 and (($length_of_argv % 2) == 1)) { die "Need output file name for the last dbf.\n"; } while (@ARGV) { my $filename = shift @ARGV; my $outfilename = shift @ARGV; $outfilename = 'out_' . $filename unless defined $outfilename; my %other_options = (); for (qw!memofile memosep ignorememo!) { $other_options{$_} = $options->{$_} if defined $options->{$_}; } my $table = new XBase $filename, %other_options; unless (defined $table) { print "Error reading $filename: $XBase::errstr"; next; } %other_options = (); if (defined $names_convert) { $other_options{'field_names'} = [ map { &$names_convert($_) } $table->field_names ]; } my $out = $table->create("name" => $outfilename, %other_options) or die "Error creating output file: $outfilename: $XBase::errstr"; my @types = $table->field_types; my @convert_fields = (); for (my $i = 0; $i < @types; $i++) { push @convert_fields, $i if $types[$i] eq 'C' or $types[$i] eq 'M'; } for my $i (0 .. $table->last_record) { my @data = $table->get_record($i); my $deleted = shift @data; for (@data[@convert_fields]) { ### print STDERR "Converting $_ "; $_ = &$convert($_); ### print STDERR "to $_\n"; } $out->set_record($i, @data); $out->delete_record($i) if $deleted; } $out->close; $table->close; } EOBODY