bdns_lookup.pl 16.5 KB
Newer Older
laux's avatar
laux committed
1
eval 'exec perl -S $0 ${1+"$@"}' # -*- Mode: perl -*-
2
if 0;
laux's avatar
laux committed
3

4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
# Copyright 2015 Helmholtz-Zentrum Berlin für Materialien und Energie GmbH
# <https://www.helmholtz-berlin.de>
#
# Authors:
#     Victoria Laux <victoria.laux@helmholtz-berlin.de>
#     Goetz Pfeiffer <Goetz.Pfeiffer@helmholtz-berlin.de>
#
# This program is free software: you can redistribute it and/or modify it under
# the terms of the GNU General Public License as published by the Free Software
# Foundation, either version 3 of the License, or (at your option) any later
# version.
# 
# This program is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
# FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
# details.
# 
# You should have received a copy of the GNU General Public License along with
# this program.  If not, see <http://www.gnu.org/licenses/>.
23
24


laux's avatar
laux committed
25
26
27
28
29
30
31
32
33
use strict;

# the above is a more portable way to find perl
# ! /usr/bin/perl

use strict;

use FindBin;

34
# enable this if you want to search modules like dbitable.pm
35
36
37
# relative to the location of THIS script:
# ------------------------------------------------------------
# use lib "$FindBin::RealBin/../lib/perl";
laux's avatar
laux committed
38
39
40

use DBI;
use Options;
41
use PgDB;
42
use Data::Dumper;
laux's avatar
laux committed
43
44

Options::register(
45
46
47
	['dbase',  				'd', 	'=s', "Database instance (e.g. devices)", "database", $ENV{'PGDATABASE'}],
	['dbport',  				'P', 	'=s', "Port of instance on server", "database", $ENV{'PGPORT'}],
	['dbhost',  				'H', 	'=s', "Hostname of database instance", "database", $ENV{'PGHOST'}],
laux's avatar
laux committed
48
	['user',   				'u', 	'=s', "User name",  'user',     "anonymous"],
laux's avatar
laux committed
49
	['passwd', 				'p', 	'=s', "Password",   "password", "", 1],
laux's avatar
laux committed
50
51
52
53
54
55
56
57
	['force', 				'f',   	'',   "use force query with the default database account"],
	['Verbose',  			'V',   '',    "print a lot more informations"],
	['output', 				'o', 	'=s', "output format as a selection of \n\tlist, \n\ttable, \n\thtmltable, \n\tcsvtable, \n\tset, \n\thtmlset, \n\txmlset or \n\tdump"],
	['outputbody',			'b', 	'',   "removing to output header"],
	['outputindex',			'i', 	'',   "insert indexcount to output"],
	['wwwform',				'w',	'',	  "returns the formular for webrequests" ],
	['extract', 			'x', 	'',   "concat the extracted name parts"],
	['description',			't', 	'',   "concat the textual descriptions"],
58
	['sort', 				's', 	'=s', "supported: key/revkey, \n\tnamerevname (default), \n\tfamily (only if -x option is set), \n\tdomain/revdomain (only if -x option is set)"],
laux's avatar
laux committed
59
60
61
	['revertsort', 			'S', 	'',   "revert/desc sort"],
	['facility', 			'F', 	'=s', "filter facility, like  bii, mls, fel"],
	['family', 				'T', 	'=s', "type of device, better the family"],
62
	['subdomain', 			'L', 	'=s', "location of the device or better the subdomain"],
laux's avatar
laux committed
63
64
);

65
my $usage = "parse bessy device name service for the given list of names or patterns (% as any and more, ? one unspecified character)
66
67
68
usage: bdns_lookup.pl [options] names...
% ... on ore more unspecified characters
_ ... one or no unspecified characters
laux's avatar
laux committed
69
70
71
options:
";

laux's avatar
laux committed
72
73
74
75
my $config = Options::parse($usage, 1);

$usage = $usage . $Options::help;

laux's avatar
laux committed
76
#warn Dumper($config);
laux's avatar
laux committed
77

78
die $usage if $#ARGV < 0 and not ($config->{"wwwform"}  or $config->{"help"});
79
PgDB::verbose() == 1 if $config->{'verbose'};
laux's avatar
laux committed
80

81
if (! defined $config->{'output'} or ! $config->{'output'} =~ /(table|csvtable|htmltable|list|set|htmlset|xmlset|dump)/) {
82
83
	$config->{'output'} = 'list';
}
84
$config->{"verbose"} = undef if ($config->{"wwwform"} or $config->{"output"} =~ /(htmltable|xmlset|htmlset)/);
85

86
my $dbschema = "inventory";
87

88
if ($config->{"force"} or $config->{"wwwform"}) {
89
	$config->{'dbase'} = "devices_2015";
90
91
	$config->{'user'} = "anonymous";
	$config->{'passwd'} = "bessyguest";
92
93
	$config->{'dbhost'} = "dbnode1.trs.bessy.de";
	$config->{'dbport'} = "5432";
94
95
96
97
}

my @names = @ARGV;

98
die $usage if $#names = 0 or undef ($config->{"wwwform"});
99
100
101

Options::ask_out();

102
# main object string, will be completed iprportionally of arguments
103
my $dbobject = '';
104
# array of the database columnnames
105
my @columns = ('vn.key AS "KEY"', 'vn.name AS "NAME"');
106
107
# array of the given names in the select statement
my @head = ('KEY', 'NAME');
108
# maybe the whereclause and teh sortorder
109
my $dbjoin = "vn.KEY > 0";
110
my %dborder = ();
111
my %dbtables = ();
112
113
114
115
116
if ($config->{'sort'}) {
	$config->{'sort'} = lc($config->{'sort'});
} else {
	$config->{'sort'} = "name";
}
117
118
119
my %dbselectionlists = ();
my %dboptionfield = ();

120
121
122
123
$dborder{"key"} = "vn.KEY";
$dborder{"name"} = "vn.NAME";
$dborder{"revkey"} = "vn.KEY DESC";
$dborder{"revname"} = "vn.NAME DESC";
124
125
126
127
128
129
130
131
$dbtables{'facilities'} = "location.v_facilities f";
$dbtables{'names'} = "inventory.v_names vn";
$dbtables{'subdomains'} = "inventory.v_named_subdomains vns";
$dbtables{'families'} = "inventory.v_device_families vdf";
$dbtables{'descriptions'} = "inventory.v_name_descriptionsi vnd";
$dbtables{'-'} = "";

$dbobject = $dbtables{'names'};
132

133
134
135
# columnwidth maximal
my $colmax = 12;

laux's avatar
laux committed
136
137
if ($config->{'extract'} == 1) {
	if ($config->{'wwwform'} == 1) {
138
139
140
141
142
143
144
145
		$dboptionfield{"Extraction"} = "extract";
	} else {
		push @columns, ('MEMBER','IND', 'SUBIND', 'FAMILY', 'COUNTER', 'SUBDOMAIN', 'DOMAIN', 'FACILITY');
		push @head, ('MEMBER','IND', 'SUBIND', 'FAMILY', 'COUNTER', 'SUBDOMAIN', 'DOMAIN', 'FACILITY');
		$dborder{"family"} = "FAMILY";
		$dborder{"domain"} = "FACILITY, DOMAIN, SUBSTR(SUBDOMAIN, 1, 1), TO_NUMBER(SUBSTR(SUBDOMAIN, 2))";
		$dborder{"revdomain"} = "FACILITY DESC, DOMAIN DESC, SUBSTR(SUBDOMAIN, 1, 1) DESC, TO_NUMBER(SUBSTR(SUBDOMAIN, 2)) DESC";
	}
146
}
laux's avatar
laux committed
147

laux's avatar
laux committed
148
149
if ($config->{'description'} == 1) {
	if ($config->{"wwwform"} == 1) {
150
151
		$dboptionfield{"Description"} = "description";
	} else {
152
		$dbobject .= ', '.$dbtables{'descriptions'};
153
154
155
156
		push @columns, ('DESCRIPTION');
		push @head, ('DESCRIPTION');
		$dbjoin .= " AND vn.key = vnd.key(+)";
	}
157
158
}

laux's avatar
laux committed
159
160
if ($config->{'family'} == 1) {
	if ($config->{"wwwform"} == 1) {
161
		$dbselectionlists{"Families"} = [$dbtables{'families'}, "KEY, NAME||' ('||DESCRIPTION||')' VALUE", "NAME IS NOT NULL"];
162
	} else {
163
		$dbjoin .= " AND vn.family_key IN (SELECT family_key FROM ".$dbtables{'families'}." WHERE name='".$config->{'family'}."')";
164
	}
165
166
}

laux's avatar
laux committed
167
168
if ($config->{'subdomain'} == 1) {
	if ($config->{"wwwform"} == 1) {
169
		$dbselectionlists{"Subdomains"} = [$dbtables{'subdomains'}, "KEY, NAME||' ('||DESCRIPTION||')' VALUE", "NAME IS NOT NULL"];
170
	} else {
171
		$dbjoin .= " AND vn.name_subdomain_key IN (SELECT name_subdomain_key FROM ".$dbtables{'subdomains'}." WHERE name = '".$config->{'subdomain'}."'";
172
	}
173
174
}

laux's avatar
laux committed
175
176
if ($config->{'facility'} == 1) {
	if ($config->{"wwwform"} == 1) {
177
		$dbselectionlists{"Facilities"} = [$dbtables{'facilities'}, "KEY, NAME||' ('||PART_FACILITY||')' VALUE", "NAME IS NOT NULL"];
178
	} else {
179
		if (uc($config->{'facility'}) eq "MLS") {
laux's avatar
laux committed
180
			if ($config->{"extract"} == 1) {
181
182
183
184
				$dbjoin .= " AND vn.facility = 'P'";
			} else {
				$dbjoin .= " AND vn.name LIKE '%P'";
			}
185
		} elsif (uc($config->{'facility'}) eq "Future") {
laux's avatar
laux committed
186
			if ($config->{"extract"} == 1) {
187
188
189
190
				$dbjoin .= " AND vn.facility = 'F'";
			} else {
				$dbjoin .= " AND vn.name LIKE '%F'";
			}
191
		} else {
laux's avatar
laux committed
192
			if ($config->{"extract"} == 1) {
193
194
195
196
				$dbjoin .= " AND vn.facility = ' '";
			} else {
				$dbjoin .= " AND (vn.name NOT LIKE '%F' OR vn.name NOT LIKE '%F')";
			}
197
198
199
200
		}
	}
}

201
202
203
if (! $dborder{$config->{'sort'}}) {
	$config->{'sort'} = "name";
}
laux's avatar
laux committed
204
205
print "Sourcing from '$dbobject'\n" if ($config->{"Verbose"});
print "Selecting with '".join(",", @columns)."'\n" if ($config->{"Verbose"});
laux's avatar
laux committed
206
207
208
print "Filtering with '$dbjoin'\n" if ($config->{"Verbose"});

print "Output formatted as ".$config->{'output'}." and sorted by ".$config->{"sort"}."\n" if ($config->{"verbose"});
209

210
my $handle = PgDB::login($config);
211
delete ($config->{'passwd'});
212

laux's avatar
laux committed
213
if (defined $config->{'wwwform'}) {
214
215
216
217
218
219
220
	my $retform = "\n<!-- formbegin from bdns_param -->";
	$retform .= "\n<table class=\"bdns\" id=\"bdns_lookup_form\">";
	$retform .= "\n\t<input type=\"hidden\" name=\"table\" value=\"bdns_lookup\" />";
	$retform .= "\n\t<tr>\n\t\t<th class=\"bdns\" id=\"bdns_lookup_form.Name\">Name</th>\n\t\t<td class=\"bdns\" id=\"bdns_lookup_value.Name\"><input type=\"text\" id=\"bdns_lookup_value.name\" name=\"name\"></td>\n\t</th>";
	$retform .= "\n\t<tr>\n\t\t<th class=\"bdns\" id=\"bdns_lookup_form.Key\">Key</th>\n\t\t<td class=\"bdns\" id=\"bdns_lookup_value.Key\"><input type=\"text\" id=\"bdns_lookup_value.name_key\" name=\"name_key\"></td>\n\t</th>";
	foreach my $selopt (keys %dbselectionlists) {
		$retform .= "\n\t<tr>\n\t\t<th class=\"bdns\" id=\"bdns_lookup_form.".lc($selopt)."\">$selopt</th>\n\t\t<td class=\"bdns\" id=\"bdns_lookup_form.".lc($selopt)."\">\n\t\t\t<select name=\"".$selopt."\" id=\"bdns_lookup_form.".$selopt."\">";
221
		my $selresult = PgDB::sel($dbselectionlists{$selopt}[0], $dbselectionlists{$selopt}[1], $dbselectionlists{$selopt}[2]);
222
223
		if (defined $selresult) {
			#print Dumper($selresult);
224
			my $selidx = 0;
225
226
227
228
229
230
231
			foreach my $selrow (@$selresult) {
				$retform .= "\n\t\t\t\t<option value=\"".$selrow->{'KEY'}."\" id=\"bdns_lookup_form.".$selopt.".$selidx\">".$selrow->{'VALUE'}."</option>";
				$selidx++;
			}
		}
		$retform .= "\n\t\t\t</select>\n\t\t</td>\n\t</tr>";
	}
232
	# routine for facility, family
233
234
235
236
237
238
	$retform .= "\n</table>";
	$retform .= "\n<!-- formend from bdns_lookup -->\n";
	print $retform;
	exit 0;
}

laux's avatar
laux committed
239
Options::print_out("Connected as ".$config->{'user'}."@".$config->{'dbase'}."\n") if $config->{"Verbose"};
laux's avatar
laux committed
240

241
242
243
# counter for rows
my $indexed = 0;
# getting the aliased colstring for select
244
my $colstr = PgDB::col_aliases(\@columns, \@head);
245
246
247
# calculation linelength
my $linelength = 80;

laux's avatar
laux committed
248
249
print &getHeader();

250
#main part
laux's avatar
laux committed
251
foreach my $devname (@names) {
252
	$indexed ++;
253
254
        Options::print_out("\n>bdns_lookup Routine for ".$devname."\n") if not $config->{'silent'};
	my $where = "vn.NAME LIKE '$devname'";
255
256
257
	if (length($dbjoin) > 0) {
		$where .= " AND ".$dbjoin;
	}
258
	$where .= " ORDER BY ".$dborder{$config->{"sort"}};
259
260
261
262
263
264
265

        Options::print_out("\n>bdns_lookup Call PgDB::sel('".$dbobject."', '".$colstr."', '".$where."')") if $config->{"Verbose"};

	my $result = PgDB::sel($dbobject, $colstr, $where);

	Options::print_out("\n>bdns_lookup Result of statement has ".$#$result." entries.") if ($config->{'verbose'});

266
267
268
	my $out;
	foreach my $row (@$result) {
		$indexed++;
269
                Options::print_out("\n>bdns_lookup Row ".$indexed.": (".$row.")") if ($config->{'verbose'});
270
271
272
273
274
		if ($config->{"index"}) {
			printf ("%u", $indexed);
		}
		if ($config->{'output'} eq 'table') {
# table
275
276
			print "|".join(" |", map(sprintf("%".$colmax."s",$row->{$_}), @head))." |";
			print "\n";
277
278
279
# htmltable
		} elsif ($config->{'output'} eq 'htmltable') {
			print "\n\t".sprintf("<tr id=\"%u\">", $indexed);
280
			print "\n\t\t".join("\n\t\t", map(sprintf("<td class=\"bdns\" id=\"bdns_lookup_result.$_$indexed\">%s</td>", $row->{$_}), @head));
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
			print "\n\t".sprintf("</tr>");
# csvtable
		} elsif ($config->{'output'} eq 'csvtable') {
			print "\n".join(",",map(sprintf("\"%s\"",$row->{$_}), @head)).",";
# set
		} elsif ($config->{'output'} eq 'set') {
			print &printLine("=")."\n";
			if ($config->{'index'}) {
				print &printLine();
				print sprintf(" %12s: %s", "#", $indexed);
			}
			print join("\n",map(sprintf("%".$colmax."s: \"%s\"",$_,$row->{$_}), @head));
			print "\n";
# xmlset
		} elsif ($config->{'output'} eq 'htmlset') {
laux's avatar
laux committed
296
			print join("", map(sprintf("\n\t<tr class=\"bdns\" id=\"bdns_lookup_result.$_$indexed\"><th class=\"bdns\" align=\"right\" id=\"bdns_lookup_result.$_$indexed\">%s</th><td class=\"bdns\" id=\"bdns_lookup_result.$_$indexed\">%s</td></tr>", $_, $row->{$_}), @head));
laux's avatar
laux committed
297
			print "\n\t<tr class=\"bdns\" colspan=\"2\" id=\"bdns_lookup_result.separator\"><td class=\"bdns\" id=\"bdns_lookup_result.separator$indexed\"><hr /></td></tr>\n";
298
299
300
301
302
303
		} elsif ($config->{'output'} eq 'xmlset') {
			print "\n\t".sprintf("<entry index=\"%u\">", $indexed);
			print "\n\t\t".join("\n\t\t", map(sprintf("<%s>%s</%s>", lc($_), $row->{$_}, lc($_)), @head));
			print "\n\t".sprintf("</entry>");
# list
		} elsif ($config->{'output'} eq 'dump') {
laux's avatar
laux committed
304
			print "\n\t{".join(", ", map(sprintf("\'%s\'=>\'%s\'",$_, $row->{$_}), @head))."},";
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
# dump
		} else {
# list oputput or unknown
			print "\n".join("\t", map(sprintf("%s", $row->{$_}), @head));
		}
	}
}

print &getFooter($indexed);

# build header if not forbidden
sub getHeader {
	my $ret = "";
	if (! $config->{"outputbody"}) {
		if ($config->{'output'} eq 'table') {
320
321
			$linelength = ($colmax+2)*@columns+1;
			$ret .=  &printLine();
322
323
324
325
			if ($config->{'index'}) {
				$ret .=  sprintf(" %12s ", "#");
				$linelength += 12;
			}
326
327
			$ret .=  "\n|".join("|",map(sprintf("%".$colmax."s ",$_), @head))."|";
			$ret .=  "\n".&printLine()."\n";
328
329
330
		} elsif ($config->{'output'} eq 'htmltable') {
			print "\n<table class=\"bdns\">\n\t<tr>";
			if ($config->{'index'}) {
331
				print "\n\t<th>#</th>";
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
			}
			$ret .=   "\n\t".join("\n\t",map(sprintf("<th class=\"bdns\">%".$colmax."s</th>",$_), @head));
			print "\n\t</tr>";
		} elsif ($config->{'output'} eq 'csvtable') {
			if ($config->{'index'}) {
				$ret .=  sprintf( "#");
			}
			$ret .=  join(",",map(sprintf("\"%s\"",$_),@head)).",";
		}  elsif ($config->{'output'} eq 'set') {
			print &printLine()."\n";
		} elsif ($config->{'output'} eq 'htmlset') {
			print "\n<table class=\"bdns\">";
		} elsif ($config->{'output'} eq 'xmlset') {
			$ret .=  "<?xml version=\"1.0\"?>\n<bdns>";
		} elsif ($config->{'output'} eq 'dump') {
laux's avatar
laux committed
347
			$ret = "\@BDNS = ("
348
349
350
351
352
353
354
355
356
357
358
359
		} else {
			print join("\t", map(sprintf("%s", $_), @head));
		}
	};
	return $ret;
}

sub getFooter {
	my $rowindex = shift;
	my $ret = "";
	if (! $config->{'outputbody'}) {
		if ($config->{'output'} eq "table") {
360
			$linelength = ($colmax+2)*@columns+1;
361
362
363
			print &printLine();
			$ret .= "\n $rowindex Entries found";
		} elsif ($config->{'output'} eq "htmltable") {
laux's avatar
laux committed
364
			$ret .= "</table>";
365
366
367
368
369
		} elsif ($config->{'output'} eq "set") {
			$ret .= "\n";
			print &printLine();
			$ret .= "\n $rowindex Entries found";
		} elsif ($config->{'output'} eq "htmlset") {
laux's avatar
laux committed
370
			$ret .= "</table>";
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
		}
	}
	if ($config->{'output'} eq "xmlset") {
		$ret .= "\n</bdns>";
	} elsif ($config->{'output'} eq "dump") {
		$ret .= "\n);"
	}
	$ret .= "\n";
}

sub printLine {
	my $printchar = shift;
	my $ret = "";
	if (length($printchar) != 1) {
		$printchar = "-";
	}
	for (my $index = 0; $index < $linelength; $index++) {
		$ret .= "-";
	}
	return $ret;
391
}
laux's avatar
laux committed
392

393
exit;
laux's avatar
laux committed
394

laux's avatar
laux committed
395
396
397
398
399
400
401
402
403
404
405
406
407
__END__

=head1 NAME

bdns_lookup.pl - a Perl programm for querying the database for device names

=head2 INTRODUCTION

This program uses DBI for accessing the database. The Modules u needed to install:

 * FindBin
 * DBI
 * Options
408
 * PgDB
laux's avatar
laux committed
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
 * Data::Dumper;

The results can be presented different as formats and content.
In the following overview the most options are described.

=head2 SYNTAX

To call thte syntax the following short syntax is preferred:

	usage: bdns_lookup.pl [bdfFghilLnuopsStTvwx] names

Please suggest to configure the packages and have may be a look to your
PERL5LIB environment variable, that there is the path to the packages
is correctly set.

=head2 ACCESS

	-h, --help		display this help

	-v, --verbose		print verbose messages

	-V, --Verbose		print a lot more informations

	-l, --log[=STRING]	print messages to file instead of stdout

	-n, --not		do not perform any actual work

	-d, --dbase=STRING	Database instance (e.g. devices)

	-u, --user=STRING	User name for database access

	-p, --passwd=STRING	Password, not shown in TTY

	-f, --force		use force query with the default database account,

				ignoring user and password options

=head2 OUTPUT/FORMAT

	-o, --output=STRING		output format as a selection of
	
		* list - textual list of names,
		* table - ascii table,
		* set - ascii sets,
		* csvtable - csvtable,
		* htmltable - htmlbased table,
		* htmlset - separated html listentries,
		* xmlset - simpleformatted xml text
		* dump - perl dump

	-b, --outputbody		removing to output header

	-i, --outputindex		insert indexcount to output, formerly known as number of line

	-w, --wwwform			returns the formular for webrequests

	-x, --extract			concat the extracted name parts in to different columns,

								shows the complete partitioning splitted in the parsed parts

	-t, --description		concat the textual descriptions are given to all name parts

=head2 ORDERING AND SORTING

	-s, --sort=STRING			sort options supported:
		* namerevname (default),
		* key/revkey,
		* family (only if -x option is set),
		* domain/revdomain (only if -x option is set),

	-S, --revertsort			revert/desc sort of given sort order

	-F, --facility=STRING		filter facility, like  bii, mls, fel

	-T, --family=STRING			type of device, better the family

	-L, --subdomain=STRING		location of the device or better the subdomain

=head1 AUTHOR

489
Victoria Laux,  victoria.laux@helmholtz-berlin.de
laux's avatar
laux committed
490
491

=cut