File Coverage

blib/lib/DBIx/SystemCatalog.pm

Criterion	Covered	Total	%
statement	12	75	16.0
branch	0	22	0.0
condition	0	3	0.0
subroutine	4	21	19.0
pod	17	17	100.0
total	33	138	23.9

line

stmt

bran

cond

sub

pod

time

code

1

package DBIx::SystemCatalog;

2

3

1

742

use strict;

1

1

1

37

4

1

2480

use DBI;

1

19049

1

96

5

1

14

use Exporter;

1

7

1

44

6

1

5

use vars qw/$VERSION @ISA @EXPORT/;

1

1

1

1093

7

8

$VERSION = '0.06';

9

@ISA = qw/Exporter/;

10

@EXPORT = qw/SC_TYPE_TABLE SC_TYPE_VIEW SC_TYPE_UNKNOWN/;

11

12

=head1 NAME

13

14

DBIx::SystemCatalog - Perl module for accessing system catalog in common databases (access through DBI(3))

15

16

=head1 SYNOPSIS

17

18

use DBI;

19

use DBIx::SystemCatalog;

20

21

# create DBIx::SystemCatalog object and bind DBI

22

my $dbh = DBI->connect('dbi:Oracle:','login','password');

23

my $catalog = new DBIx::SystemCatalog $dbh;

24

25

# fetch all database schemas

26

my @schemas = $catalog->schemas;

27

28

# select one schema (e.g. first schema)

29

$catalog->schema($schemas[0]);

30

31

# fetch all tables and views with types of objects

32

my @tables = $catalog->tables_with_types;

33

34

# fetch columns of first fetched table

35

my @columns = $catalog->table_columns($tables[0]->{name});

36

37

# fetch all relationships between tables and views

38

my @relationships = $catalog->relationships;

39

40

# fetch all primary keys for table

41

my @primary_keys = $catalog->primary_keys($tables[0]->{name});

42

43

# fetch all unique indexes for table

44

my @unique_indexes = $catalog->unique_indexes($tables[0]->{name});

45

46

# fetch all indexes for table

47

my @indexes = $catalog->indexes($table[0]->{name});

48

49

# disconnect database

50

$dbh->disconnect;

51

52

=head1 DESCRIPTION

53

54

This module can access to system catalog of database through DBI(3) interface.

55

Basic methods access to objects through standard DBI(3) interface

56

(call C for list of objects and C with basic

57

SQL to get structure of objects).

58

59

Constructor looks for specific module implemented database interface for

60

used DBD driver (obtained from DBI(3)). These module can add faster and better

61

functions such as relationships or types of objects.

62

63

=head1 CONSTANTS

64

65

=head2 Type of object

66

67

=over 4

68

69

=item SC_TYPE_UNKNOWN

70

71

=cut

72

73

0

sub SC_TYPE_UNKNOWN () { return 0; }

74

75

=item SC_TYPE_TABLE

76

77

=cut

78

79

0

sub SC_TYPE_TABLE () { return 1; }

80

81

=item SC_TYPE_VIEW

82

83

=back

84

85

=cut

86

87

0

sub SC_TYPE_VIEW () { return 2; }

88

89

=head1 THE DBIx::SystemCatalog CLASS

90

91

=head2 new (DBI)

92

93

Constructor create instance of this class and bind DBI(3) connection.

94

Then obtain used driver name from DBI(3) class and look for descendant

95

of this class for this driver (e.g. C module

96

for C driver). If success, return instance of this more specific class,

97

otherwise return itself.

98

99

You must passed connected DBI(3) instance as first argument to constructor

and you can't disconnect that instance while you use this instance of

DBIx::SystemCatalog.

$catalog = new DBIx::SystemCatalog $dbh

=cut

sub new {

0

my $class = shift;

0

my $dbi = shift;

0

my $obj = bless { dbi => $dbi, class => $class, schema => '' },$class;

0

$obj->{Driver} = $obj->{dbi}->{Driver}->{Name};

# Only base class can dispatch to more specific class

0

if ($class eq 'DBIx::SystemCatalog') {

0

my $driver_name = 'DBIx::SystemCatalog::'.$obj->{Driver};

0

eval "package DBIx::SystemCatalog::_safe; require $driver_name";

0

unless ($@) { # found specific driver

0

$driver_name->import();

0

return $driver_name->new($dbi,@_);

}

}

# Hmm, we are specific class or specific class not found

0

return undef unless $obj->init(@_);

0

return $obj;

}

=head2 init

Because C is quite complicated, descendant inherits this C

constructor and redefine C constructor which is called from C.

C gets all arguments from C with one exception - instead of

name of class this constructor get instance of object.

Constructor must return true value to make successful of creating instance

of object. In this base class is C abstract, always true.

This method isn't called directly from user.

=cut

0

sub init { 1; }

=head2 schemas

Method must return list of schemas from database. In this base class method

always return empty list, because standard DBI(3) method can't get list of

schemas.

my @schemas = $catalog->schemas()

=cut

sub schemas {

0

return ();

}

=head2 schema (NAME)

Method set current schema name. Other methods work only with this schema.

Because working with one schema is typical work, all methods in specific

class need this schema name. Method can set schema (descendant need not

redefine it).

$catalog->schema('IS')

=cut

sub schema {

0

my $obj = shift;

0

$obj->{schema} = shift;

}

=head2 tables

Method must return list of storage objects from database (mean tables and

views). In this base class method use DBI(3) function C for

fetching this list. Specific class ussually redefine method for faster

access and return all objects (list of views is in DBI(3) functions

uncertain).

my @tables = $catalog->tables()

=cut

sub tables {

0

my $obj = shift;

0

return $obj->{dbi}->tables;

}

=head2 sc_types

Method return list of names of constants C.

my @types = $catalog->sc_types()

=cut

sub sc_types {

0

my $obj = shift;

0

my @types = ();

0

for (keys %{DBIx::SystemCatalog::}) {

0

push @types,$_ if /^SC_TYPE_/;

}

0

return @types;

}

=head2 table_columns (OBJECT)

Method must return list of columns for object in argument (table or view).

In this base class method use SQL query

SELECT * FROM object WHERE 0 = 1

and fetch names of returned columns. Specific class can redefine method

for faster access.

In future this method (or similar extended method) return

more details about columns. This feature must add specific class. API for

returned values are not still specified.

my @columns = $catalog->table_column('USERS')

=cut

sub table_columns {

0

my $obj = shift;

0

my $table = shift;

0

my $sth = $obj->{dbi}->prepare("SELECT * FROM $table WHERE 0 = 1");

0

return () unless defined $sth;

0

$sth->execute;

0

my @columns = @{$sth->{NAME}};

0

0

$sth->finish;

0

return @columns;

}

=head2 table_type (OBJECT)

Method return constant C according to type of object passed

as argument (table or view). In this base class method return

C. Specific class ussually redefine method for correct

result.

my $type = $catalog->table_type('USERS')

=cut

sub table_type {

0

return SC_TYPE_UNKNOWN;

}

=head2 tables_with_types

Method combine C and C and return list of hashes

with keys C (table name) and C (same meaning as returned value

from C). Base class implement this method as C and

for each table call C. Specific class ussually redefine it for

faster access.

for my $object ($catalog->tables_with_types()) {

my $name = $object->{name};

my $type = $object->{type};

}

=cut

sub tables_with_types {

0

my $obj = shift;

0

return map { { name => $_, type => $obj->table_type($_) }; }

0

$obj->{dbi}->tables;

}

=head2 relationships

Method return list of all relationships in schema. Each item in list is

hash with keys:

=over 4

=item name

Name of relationship

=item from_table

Name of source table with foreign key

=item to_table

Name of destination table with reference for foreign key

=item from_columns

List of source columns, each item is hash with key C (table name) and

C (column name). I think all C will be same as C key

298							in returning hash, but only God know true.
299
300							=item to_columns
301
302							List of destination columns, each item has same structure as items in
303							C item of returning hash.
304
305							=back
306
307							Base class don't implement this method (return empty list), but specific
308							class can redefine it (for database which support foreign keys or another
309							form of relationships).
310
311							for my $relationship ($catalog->relationships()) {
312							for (%$relationship) {
313							print "$_: ";
314							if (ref $relationship{$_}) {
315							print join ',',@{$relationship{$_}};
316							} else {
317							print $relationship{$_};
318							}
319							print "\n";
320							}
321							}
322
323							=cut
324
325							sub relationships {
326	0			0	1		return ();
327							}
328
329							=head2 primary_keys
330
331							Method return list of all columns which are primary keys of specified
332							table.
333
334							my @primary_keys = $catalog->primary_keys($tablename);
335
336							=cut
337
338							sub primary_keys {
339	0			0	1		return ();
340							}
341
342							=head2 unique_indexes
343
344							Method return list of all columns which contain unique indexes of specified
345							table. Returns list of lists.
346
347							my @unique_indexes = $catalog->unique_indexes($tablename);
348
349							=cut
350
351							sub unique_indexes {
352	0			0	1		return ();
353							}
354
355							=head2 indexes
356
357							Method return list of all columns which contain indexes of specified table.
358							Returns list of lists.
359
360							my @indexes = $catalog->indexes($tablename);
361
362							=cut
363
364							sub indexes {
365	0			0	1		return ();
366							}
367
368							=head2 fs_ls CWD
369
370							Emulating filesystem for dbsh - method must return list of names according to
371							CWD. All items ended by / are directories. We must return ../ in subdirectories.
372
373							Standard module produce next structure:
374
375							/Schema
376							/Schema/Tables
377							/Schema/Views
378
379							and generate tables and views (or unknown table objects) into this structure.
380
381							my @files = $catalog->fs_ls('/');
382
383							=cut
384
385							sub fs_ls {
386	0			0	1		my $obj = shift;
387	0						my $cwd = shift;
388
389	0	0					if ($cwd eq '/') { # schema
		0
		0
390	0						my @root = map { '/'.$_."/"; } sort $obj->schemas;
	0
391	0	0					return @root if @root;
392	0						return ('/Schema/');
393							} elsif ($cwd =~ /^\/[^\/]+\/$/) { # type of objects
394	0						return map { $cwd.$_.'/'; } qw/.. Tables Views/;
	0
395							} elsif ($cwd =~ /^\/([^\/]+)\/([^\/]+)\/$/) { # objects
396	0						$obj->schema($1);
397	0						my $type = SC_TYPE_VIEW;
398	0	0					if ($2 eq 'Tables') { $type = SC_TYPE_TABLE; }
	0
399	0						my @res = ('../');
400	0						for my $object ($obj->tables_with_types()) {
401	0	0	0				if ($object->{type} == $type
402							\|\| $object->{type} == SC_TYPE_UNKNOWN) {
403	0						push @res,$object->{name};
404							}
405							}
406	0						return map { $cwd.$_; } sort @res;
	0
407							} else { # unknown
408	0						return ();
409							}
410							}
411
412							1;
413
414							__END__