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   --debug, -d debugging level (Default 0)
  31   --help, -h display this help
  32   --man, -m display manual
  33
  34 =head1 OPTIONS
  35
  36 =over
  37
  38 =item B<--create,-c>
  39
  40 Create a database
  41
  42 =item B<--update,-u>
  43
  44 Update a database; replaces all keys with the values loaded from the
  45 file, but keeps existing keys which were not replaced
  46
  47 =item B<--dump,-D>
  48
  49 Dump database to stdout
  50
  51 =item B<--include-key,-k>
  52
  53 Output the key as well as the value. (Off by default)
  54
  55 =item B<--missing-newline,-n>
  56
  57 If a key doesn't exist in the database, output a newline. (Forced on
  58 when --include-key set)
  59
  60 =item B<--debug, -d>
  61
  62 Debug verbosity. (Default 0)
  63
  64 =item B<--help, -h>
  65
  66 Display brief usage information.
  67
  68 =item B<--man, -m>
  69
  70 Display this manual.
  71
  72 =back
  73
  74 =head1 EXAMPLES
  75
  76
  77 =cut
  78
  79 use Fcntl qw/O_RDWR O_RDONLY O_CREAT O_TRUNC/;
  80 use MLDBM qw(DB_File Storable);
  81
  82 use vars qw($DEBUG);
  83
  84 my %options = (debug           => 0,
  85                help            => 0,
  86                man             => 0,
  87                create          => 0,
  88                update          => 0,
  89                dump            => 0,
  90 #              include_key     => 0,
  91                missing_newline => 1,
  92                );
  93
  94 GetOptions(\%options,
  95            'create|c','update|u',
  96            'dump|D',
  97            'include_key|include-key|k!',
  98            'missing_newline|missing-newline|n!',
  99            'debug|d+','help|h|?','man|m');
 100
 101 pod2usage() if $options{help};
 102 pod2usage({verbose=>2}) if $options{man};
 103
 104 $DEBUG = $options{debug};
 105
 106 my @USAGE_ERRORS;
 107 # if (1) {
 108 #      push @USAGE_ERRORS,"You must pass something";
 109 # }
 110
 111 pod2usage(join("\n",@USAGE_ERRORS)) if @USAGE_ERRORS;
 112
 113
 114
 115 my ($db,@keys) = @ARGV;
 116
 117 my %t_db;
 118
 119 if (not ($options{create} or $options{update})) {
 120     tie %t_db, MLDBM => $db, O_RDONLY or
 121         die "Unable to open $db for reading: $!";
 122 }
 123 else {
 124     tie %t_db, MLDBM => $db, O_RDWR|O_CREAT|($options{update}?0:O_TRUNC), 0666 or
 125         die "Unable to open $db for writing: $!";
 126 }
 127
 128 if (not defined $options{include_key}) {
 129     $options{include_key} = $options{dump} ? 0 : 1;
 130 }
 131
 132
 133 if ($options{update}) {
 134     my %fast_db;
 135     while (<STDIN>) {
 136         chomp;
 137         my ($key,@val) = split /\t/;
 138         $fast_db{$key} = [make_list($fast_db{$key} // [],@val)];
 139     }
 140     for my $key (keys %fast_db) {
 141         $t_db{$key} = $fast_db{$key};
 142     }
 143 }
 144 elsif ($options{create}) {
 145     my %fast_db;
 146     while (<STDIN>) {
 147         chomp;
 148         my ($key,@val) = split /\t/;
 149         $fast_db{$key} = [make_list($fast_db{$key} // [],@val)];
 150     }
 151     for my $key (keys %fast_db) {
 152         $t_db{$key} = $fast_db{$key};
 153     }
 154 }
 155 elsif ($options{dump}) {
 156     for my $key (keys %t_db) {
 157         print "$key:".join("\t",make_list($t_db{$key}))."\n";
 158     }
 159 }
 160 else {
 161     if (!@keys) {
 162         output_keys(<STDIN>);
 163     }
 164     else {
 165         output_keys(@keys);
 166     }
 167 }
 168
 169 sub output_keys {
 170     my @temp = @_;
 171     for my $key (@temp) {
 172         if (not exists $t_db{$key}) {
 173             chomp $key;
 174         }
 175         if ($options{include_key}) {
 176             print $key."\t";
 177         }
 178         if (exists $t_db{$key}) {
 179             print join("\t",make_list($t_db{$key}));
 180             print "\n";
 181         }
 182         elsif ($options{missing_newline}) {
 183             print "\n";
 184         }
 185     }
 186 }
 187
 188 sub make_list {
 189      return map {(ref($_) eq 'ARRAY')?@{$_}:$_} @_;
 190 }
 191
 192
 193
 194
 195 __END__