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