File Coverage

blib/lib/DBR/Config/Field/Anon.pm
Criterion Covered Total %
statement 25 32 78.1
branch 4 18 22.2
condition n/a
subroutine 5 6 83.3
pod 0 3 0.0
total 34 59 57.6


line stmt bran cond sub pod time code
1             # the contents of this file are Copyright (c) 2009 Daniel Norman
2             # This program is free software; you can redistribute it and/or
3             # modify it under the terms of the GNU General Public License as
4             # published by the Free Software Foundation.
5              
6             package DBR::Config::Field::Anon;
7              
8 18     18   106 use strict;
  18         38  
  18         887  
9 18     18   101 use base 'DBR::Config::Field::Common';
  18         35  
  18         10872  
10             use constant ({
11             # Object fields
12 18         13259 O_fieldname => 0,
13             O_session => 1,
14             O_index => 2,
15             O_table_alias => 3,
16             O_alias_flag => 4,
17 18     18   127 });
  18         43  
18             sub new{
19 5131     5131 0 10855 my( $package ) = shift;
20 5131         23579 my %params = @_;
21              
22 5131         6766 my $field;
23              
24 5131         19784 my $self = [undef,$params{session}];
25              
26 5131         32500 bless( $self, $package );
27              
28 5131         9637 my $table = $params{table};
29              
30 5131 50       21957 my $name = $params{name} or return $self->_error('name is required');
31              
32 5131         29358 my @parts = split(/\./,$name);
33 5131 50       15669 if(scalar(@parts) == 1){
    0          
34 5131         9585 ($field) = @parts;
35             }elsif(scalar(@parts) == 2){
36 0 0       0 return $self->_error("illegal use of table parameter with table.field notation") if length($table);
37 0         0 ($table,$field) = @parts;
38             }else{
39 0         0 return $self->_error('Invalid name');
40             }
41              
42 5131 50       22379 return $self->_error("invalid field name '$field'") unless $field =~ /^[A-Z][A-Z0-9_-]*$/i;
43              
44 5131 50       15447 if($table){
45 0 0       0 return $self->_error("invalid table name '$table'") unless $table =~ /^[A-Z][A-Z0-9_-]*$/i;
46             }
47              
48 5131         11485 $self->[O_table_alias] = $table;
49 5131         9648 $self->[O_fieldname] = $field;
50              
51 5131         45953 return $self;
52             }
53              
54             sub clone{
55 0     0 0 0 my $self = shift;
56 0         0 my %params = @_;
57              
58 0 0       0 return bless(
    0          
59             [
60             $self->[O_fieldname],
61             $self->[O_session],
62             $params{with_index} ? $self->[O_index] : undef, # index
63             $params{with_alias} ? $self->[O_table_alias] : undef, #alias
64             ],
65             ref($self),
66             );
67             }
68              
69 5131     5131 0 14858 sub name { $_[0]->[O_fieldname] }
70              
71             1;