aboutsummaryrefslogtreecommitdiff
path: root/Scripting/Perl/ListOpenDatabases.pl
blob: dec547e78caacb5febd722020a6449792aa89d37 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
#!/usr/bin/perl -w
# Lists all databases open in the current thread, topmost first.  Obscure
# fields are open count (#) and the mode with which the db was opened (see
# &openflags below).
#
# 2001-10-25  John Marshall  <jmarshall@acm.org>

use strict;

use EmRPC;
use EmFunctions;

EmRPC::OpenConnection (@ARGV);

sub openflags {
  my ($f) = @_;
  local $_ = "";
  $_ .= "R" if $f & dmModeReadOnly;
  $_ .= "W" if $f & dmModeWrite;
  $_ .= "L" if $f & dmModeLeaveOpen;
  $_ .= "E" if $f & dmModeExclusive;
  $_ .= "S" if $f & dmModeShowSecret;
  return $_;
  }

print "DmOpenRef   card/LocalID  #  mode  r/type/crid  name\n";

my $db = 0;
while (($db = DmNextOpenDatabase ($db)) != 0) {
  printf "0x%08x  ", $db;

  my ($err, %r) = DmOpenDatabaseInfo ($db);

  if ($err == 0) {
    printf "%d 0x%08x%3d  %-5s %s ",
	   $r{cardNo}, $r{dbID}, $r{openCount}, openflags($r{mode}),
	   $r{resDB}? "R" : "D";

    my ($err, %r) = DmDatabaseInfo ($r{cardNo}, $r{dbID});

    if ($err == 0) {
      $_ = pack "NcN", $r{type}, ord " ", $r{creator};
      s/[[:^print:]]/./g;
      print "$_  $r{name}";
      }
    else { printf "[DmDatabaseInfo failed: 0x%x]", $err; }
    }
  else { printf "[DmOpenDatabaseInfo failed: 0x%x]", $err; }

  print "\n";
  }

EmRPC::CloseConnection ();