From: Don Armstrong Date: Mon, 24 May 2010 23:26:32 +0000 (+0000) Subject: add db-hash funciton X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;ds=sidebyside;h=2c65a131396bb59dda5b907109d0a52f33d85529;p=bin.git add db-hash funciton --- diff --git a/db-hash b/db-hash new file mode 100755 index 0000000..28f8209 --- /dev/null +++ b/db-hash @@ -0,0 +1,127 @@ +#! /usr/bin/perl +# , and is released +# under the terms of the GPL version 2, or any later version, at your +# option. See the file README and COPYING for more information. +# Copyright 2009 by Don Armstrong . +# $Id: perl_script 1432 2009-04-21 02:42:41Z don $ + + +use warnings; +use strict; + +use Getopt::Long; +use Pod::Usage; + +=head1 NAME + +db-hash - create a database and query using it + +=head1 SYNOPSIS + + db-hash [options] dbname key + db-hash --create [options] dbname < key_value.txt + + Options: + --create, -c create dbname + --update, -u update dbname, create if it doesn't exist + --debug, -d debugging level (Default 0) + --help, -h display this help + --man, -m display manual + +=head1 OPTIONS + +=over + +=item B<--debug, -d> + +Debug verbosity. (Default 0) + +=item B<--help, -h> + +Display brief usage information. + +=item B<--man, -m> + +Display this manual. + +=back + +=head1 EXAMPLES + + +=cut + +use Fcntl qw/O_RDWR O_RDONLY O_CREAT O_TRUNC/; +use MLDBM qw(DB_File Storable); + +use vars qw($DEBUG); + +my %options = (debug => 0, + help => 0, + man => 0, + create => 0, + update => 0, + ); + +GetOptions(\%options, + 'create|c','update|u', + 'debug|d+','help|h|?','man|m'); + +pod2usage() if $options{help}; +pod2usage({verbose=>2}) if $options{man}; + +$DEBUG = $options{debug}; + +my @USAGE_ERRORS; +# if (1) { +# push @USAGE_ERRORS,"You must pass something"; +# } + +pod2usage(join("\n",@USAGE_ERRORS)) if @USAGE_ERRORS; + + + +my ($db,@keys) = @ARGV; + +my %t_db; + +if (not ($options{create} or $options{update})) { + tie %t_db, MLDBM => $db, O_RDONLY or + die "Unable to open $db for reading: $!"; +} +else { + tie %t_db, MLDBM => $db, O_RDWR|O_CREAT|($options{update}?0:O_TRUNC), 0666 or + die "Unable to open $db for writing: $!"; +} + +if ($options{update}) { + die "update currently not supported" +} +elsif ($options{create}) { + my %fast_db; + while () { + chomp; + my ($key,@val) = split /\t/; + $fast_db{$key} = [make_list($fast_db{$key} // [],@val)]; + } + for my $key (keys %fast_db) { + $t_db{$key} = $fast_db{$key}; + } +} +else { + if (@keys) { + print map {"$_\n"} map {make_list($t_db{$_} // [])} @keys; + } + else { + print map {"$_\n"} map {make_list($t_db{$_} // [])} ; + } +} + +sub make_list { + return map {(ref($_) eq 'ARRAY')?@{$_}:$_} @_; +} + + + + +__END__ diff --git a/mlmdb_munge b/mlmdb_munge deleted file mode 100755 index 005e3ba..0000000 --- a/mlmdb_munge +++ /dev/null @@ -1,127 +0,0 @@ -#! /usr/bin/perl -# , and is released -# under the terms of the GPL version 2, or any later version, at your -# option. See the file README and COPYING for more information. -# Copyright 2009 by Don Armstrong . -# $Id: perl_script 1432 2009-04-21 02:42:41Z don $ - - -use warnings; -use strict; - -use Getopt::Long; -use Pod::Usage; - -=head1 NAME - -mldbm_munge - create a database and query using it - -=head1 SYNOPSIS - - mldbm_munge [options] dbname key - mldbm_munge --create [options] dbname < key_value.txt - - Options: - --create, -c create dbname - --update, -u update dbname, create if it doesn't exist - --debug, -d debugging level (Default 0) - --help, -h display this help - --man, -m display manual - -=head1 OPTIONS - -=over - -=item B<--debug, -d> - -Debug verbosity. (Default 0) - -=item B<--help, -h> - -Display brief usage information. - -=item B<--man, -m> - -Display this manual. - -=back - -=head1 EXAMPLES - - -=cut - -use Fcntl qw/O_RDWR O_RDONLY O_CREAT O_TRUNC/; -use MLDBM qw(DB_File Storable); - -use vars qw($DEBUG); - -my %options = (debug => 0, - help => 0, - man => 0, - create => 0, - update => 0, - ); - -GetOptions(\%options, - 'create|c','update|u', - 'debug|d+','help|h|?','man|m'); - -pod2usage() if $options{help}; -pod2usage({verbose=>2}) if $options{man}; - -$DEBUG = $options{debug}; - -my @USAGE_ERRORS; -# if (1) { -# push @USAGE_ERRORS,"You must pass something"; -# } - -pod2usage(join("\n",@USAGE_ERRORS)) if @USAGE_ERRORS; - - - -my ($db,@keys) = @ARGV; - -my %t_db; - -if (not ($options{create} or $options{update})) { - tie %t_db, MLDBM => $db, O_RDONLY or - die "Unable to open $db for reading: $!"; -} -else { - tie %t_db, MLDBM => $db, O_RDWR|O_CREAT|($options{update}?0:O_TRUNC), 0666 or - die "Unable to open $db for writing: $!"; -} - -if ($options{update}) { - die "update currently not supported" -} -elsif ($options{create}) { - my %fast_db; - while () { - chomp; - my ($key,@val) = split /\t/; - $fast_db{$key} = [make_list($fast_db{$key} // [],@val)]; - } - for my $key (keys %fast_db) { - $t_db{$key} = $fast_db{$key}; - } -} -else { - if (@keys) { - print map {"$_\n"} map {make_list($t_db{$_} // [])} @keys; - } - else { - print map {"$_\n"} map {make_list($t_db{$_} // [])} ; - } -} - -sub make_list { - return map {(ref($_) eq 'ARRAY')?@{$_}:$_} @_; -} - - - - -__END__