File Coverage

lib/Class/DBI/Lite/TableInfo.pm
Criterion Covered Total %
statement 22 22 100.0
branch n/a
condition n/a
subroutine 8 8 100.0
pod 5 5 100.0
total 35 35 100.0


line stmt bran cond sub pod time code
1              
2             package Class::DBI::Lite::TableInfo;
3              
4 16     16   94 use strict;
  16         29  
  16         446  
5 16     16   80 use warnings 'all';
  16         27  
  16         539  
6 16     16   4659 use Class::DBI::Lite::ColumnInfo;
  16         44  
  16         2863  
7              
8              
9             #==============================================================================
10             sub new
11             {
12 8     8 1 18 my ($class, $table) = @_;
13 8         34 return bless {
14             table => $table,
15             columns => [ ]
16             }, $class;
17             }# end new()
18              
19              
20             #==============================================================================
21             sub table
22             {
23 1     1 1 6 $_[0]->{table};
24             }# end table()
25              
26              
27             #==============================================================================
28             sub columns
29             {
30 1     1 1 2 @{ $_[0]->{columns} };
  1         6  
31             }# end columns()
32              
33              
34             #==============================================================================
35             sub column
36             {
37 5     5 1 16 my ($s, $name) = @_;
38            
39 5         9 my ($item) = grep { $_->{name} eq $name } @{$s->{columns}};
  15         40  
  5         12  
40 5         33 return $item;
41             }# end column()
42              
43              
44             #==============================================================================
45             sub add_column
46             {
47 24     24 1 97 my ($s, %column) = @_;
48            
49 24         32 push @{$s->{columns}}, Class::DBI::Lite::ColumnInfo->new( %column );
  24         97  
50             }# end add_column()
51              
52             1;# return true:
53              
54             =pod
55              
56             =head1 NAME
57              
58             Class::DBI::Lite::TableInfo - Utility class for database table meta-information.
59              
60             =head1 SYNOPSIS
61              
62             # Methods:
63             my $info = Class::DBI::Lite::TableInfo->new( 'users' );
64             $info->add_column(
65             name => 'user_id',
66             type => 'integer',
67             length => 10,
68             is_nullable => 0,
69             default_value => undef,
70             is_pk => 1,
71             key => 'primary_key',
72             );
73             my $col = $info->column( 'user_id' );
74            
75             # Properties:
76             my @cols = $info->columns();
77             print $info->table; # "users"
78              
79             =head1 DESCRIPTION
80              
81             C provides a consistent means to discover the meta-info about
82             tables and their fields in a database.
83              
84             =head1 PUBLIC PROPERTIES
85              
86             =head2 table
87              
88             Returns the name of the table.
89              
90             =head2 columns
91              
92             Returns a list of L objects that pertain to the current table.
93              
94             =head1 PUBLIC METHODS
95              
96             =head2 new( $table_name )
97              
98             Returns a new C object for the table named C<$table_name>.
99              
100             =head2 column( $name )
101              
102             Returns a L object that matches C<$name>.
103              
104             =head2 add_column( %args )
105              
106             Adds a new L object to the table's collection.
107              
108             C<%args> is passed to the L constructor and should contain its required parameters.
109              
110             =head1 AUTHOR
111              
112             John Drago
113              
114             L
115              
116             =head1 COPYRIGHT AND LICENSE
117              
118             Copyright 2008 John Drago , All Rights Reserved.
119              
120             This software is Free software and may be used and redistributed under the same
121             terms as perl itself.
122              
123             =cut
124