db-hash

   1 #! /usr/bin/perl
   2 # , and is released
   3 # under the terms of the GPL version 2, or any later version, at your
   4 # option. See the file README and COPYING for more information.
   5 # Copyright 2009 by Don Armstrong <don@donarmstrong.com>.
   6 # $Id: perl_script 1432 2009-04-21 02:42:41Z don $
   7
   8
   9 use warnings;
  10 use strict;
  11
  12 use Getopt::Long;
  13 use Pod::Usage;
  14
  15 =head1 NAME
  16
  17 db-hash - create a database and query using it
  18
  19 =head1 SYNOPSIS
  20
  21  db-hash [options] dbname key
  22  db-hash --create [options] dbname < key_value.txt
  23
  24  Options:
  25   --create, -c create dbname
  26   --update, -u update dbname, create if it doesn't exist
  27   --dump, -D dump dbname
  28   --missing-newline, -n output a newline for unhashed keys
  29   --include-key, -k output the key as well as the value
  30   --reverse, -r reverse (values to key)
  31   --key-to-itself map key to itself
  32   --debug, -d debugging level (Default 0)
  33   --help, -h display this help
  34   --man, -m display manual
  35
  36 =head1 OPTIONS
  37
  38 =over
  39
  40 =item B<--create,-c>
  41
  42 Create a database
  43
  44 =item B<--update,-u>
  45
  46 Update a database; replaces all keys with the values loaded from the
  47 file, but keeps existing keys which were not replaced
  48
  49 =item B<--dump,-D>
  50
  51 Dump database to stdout
  52
  53 =item B<--include-key,-k>
  54
  55 Output the key as well as the value. (Off by default)
  56
  57 =item B<--reverse>
  58
  59 Map values to a key
  60
  61 =item B<--key-to-itself>
  62
  63 Map the key to itself (On by default in reverse hashes)
  64
  65 =item B<--missing-newline,-n>
  66
  67 If a key doesn't exist in the database, output a newline. (Forced on
  68 when --include-key set)
  69
  70 =item B<--reverse,-r>
  71
  72 Reverse the database (value looks up keys instead); only useful during
  73 creation/update
  74
  75 =item B<--debug, -d>
  76
  77 Debug verbosity. (Default 0)
  78
  79 =item B<--help, -h>
  80
  81 Display brief usage information.
  82
  83 =item B<--man, -m>
  84
  85 Display this manual.
  86
  87 =back
  88
  89 =head1 EXAMPLES
  90
  91
  92 =cut
  93
  94 use Fcntl qw/O_RDWR O_RDONLY O_CREAT O_TRUNC/;
  95 use MLDBM qw(DB_File Storable);
  96
  97 use vars qw($DEBUG);
  98
  99 my %options = (debug           => 0,
 100                help            => 0,
 101                man             => 0,
 102                create          => 0,
 103                update          => 0,
 104                dump            => 0,
 105 #              include_key     => 0,
 106                missing_newline => 1,
 107                reverse         => 0,
 108                );
 109
 110 GetOptions(\%options,
 111            'create|c','update|u',
 112            'dump|D',
 113            'include_key|include-key|k!',
 114            'reverse|r!',
 115            'key_to_itself|key-to-itself|K',
 116            'missing_newline|missing-newline|n!',
 117            'debug|d+','help|h|?','man|m');
 118
 119 pod2usage() if $options{help};
 120 pod2usage({verbose=>2}) if $options{man};
 121
 122 $DEBUG = $options{debug};
 123
 124 my @USAGE_ERRORS;
 125 # if (1) {
 126 #      push @USAGE_ERRORS,"You must pass something";
 127 # }
 128
 129 pod2usage(join("\n",@USAGE_ERRORS)) if @USAGE_ERRORS;
 130
 131
 132
 133 my ($db,@keys) = @ARGV;
 134
 135 my %t_db;
 136
 137 if (not ($options{create} or $options{update})) {
 138     tie %t_db, MLDBM => $db, O_RDONLY or
 139         die "Unable to open $db for reading: $!";
 140 }
 141 else {
 142     tie %t_db, MLDBM => $db, O_RDWR|O_CREAT|($options{update}?0:O_TRUNC), 0666 or
 143         die "Unable to open $db for writing: $!";
 144 }
 145
 146 if ($options{reverse}) {
 147     if (not exists $options{key_to_itself}) {
 148         $options{key_to_itself} = 1;
 149     }
 150 }
 151
 152 if (not defined $options{include_key}) {
 153     $options{include_key} = $options{dump} ? 0 : 1;
 154 }
 155
 156
 157 if ($options{update} or $options{create}) {
 158     my %fast_db;
 159     while (<STDIN>) {
 160         chomp;
 161         my ($key,@val) = split /\t/;
 162         if ($options{reverse}) {
 163             for my $val_key (@val,$options{key_to_itself}?$key:()) {
 164                 $fast_db{$val_key} = [make_list($fast_db{$val_key} // []),$key];
 165             }
 166         }
 167         else {
 168             $fast_db{$key} = [make_list($fast_db{$key} // [],@val)];
 169         }
 170     }
 171     for my $key (keys %fast_db) {
 172         $t_db{$key} = $fast_db{$key};
 173     }
 174 }
 175 elsif ($options{dump}) {
 176     for my $key (keys %t_db) {
 177         print "$key\t".join("\t",make_list($t_db{$key}))."\n";
 178     }
 179 }
 180 else {
 181     if (!@keys) {
 182         output_keys(<STDIN>);
 183     }
 184     else {
 185         output_keys(@keys);
 186     }
 187 }
 188
 189 sub output_keys {
 190     my @temp = @_;
 191     for my $key (@temp) {
 192         if (not exists $t_db{$key}) {
 193             chomp $key;
 194         }
 195         if ($options{include_key}) {
 196             print $key."\t";
 197         }
 198         if (exists $t_db{$key}) {
 199             print join("\t",make_list($t_db{$key}));
 200             print "\n";
 201         }
 202         elsif ($options{missing_newline}) {
 203             print "\n";
 204         }
 205     }
 206 }
 207
 208 sub make_list {
 209      return map {(ref($_) eq 'ARRAY')?@{$_}:$_} @_;
 210 }
 211
 212
 213
 214
 215 __END__