... | ... |
@@ -621,33 +621,33 @@ sub insert_at { |
621 | 621 |
sub insert_param_tag { |
622 | 622 |
my ($self, $param) = @_; |
623 | 623 |
|
624 |
- # Insert parameter tag |
|
625 |
- my @names; |
|
626 |
- my @placeholders; |
|
627 |
- |
|
624 |
+ # Create insert parameter tag |
|
628 | 625 |
my $safety = $self->safety_character; |
629 | 626 |
my $q = $self->reserved_word_quote; |
630 |
- |
|
627 |
+ my @columns; |
|
628 |
+ my @placeholders; |
|
631 | 629 |
foreach my $column (keys %$param) { |
632 | 630 |
croak qq{"$column" is not safety column name} |
633 | 631 |
unless $column =~ /^[$safety\.]+$/; |
634 |
- |
|
635 |
- my $c = "$q$column$q"; |
|
636 |
- $c =~ s/\./$q.$q/; |
|
637 |
- |
|
638 |
- push @names, $c; |
|
639 |
- push @placeholders, "{? $c}"; |
|
632 |
+ $column = "$q$column$q"; |
|
633 |
+ $column =~ s/\./$q.$q/; |
|
634 |
+ push @columns, $column; |
|
635 |
+ push @placeholders, "{? $column}"; |
|
640 | 636 |
} |
641 | 637 |
|
642 |
- return '(' . join(', ', @names) . ') ' . 'values' . |
|
643 |
- ' (' . join(', ', @placeholders) . ')'; |
|
638 |
+ return '(' . join(', ', @columns) . ') ' . 'values ' . |
|
639 |
+ '(' . join(', ', @placeholders) . ')' |
|
644 | 640 |
} |
645 | 641 |
|
646 | 642 |
sub include_model { |
647 | 643 |
my ($self, $name_space, $model_infos) = @_; |
648 | 644 |
|
645 |
+ # Name space |
|
649 | 646 |
$name_space ||= ''; |
647 |
+ |
|
648 |
+ # Get Model infomations |
|
650 | 649 |
unless ($model_infos) { |
650 |
+ |
|
651 | 651 |
# Load name space module |
652 | 652 |
croak qq{"$name_space" is invalid class name} |
653 | 653 |
if $name_space =~ /[^\w:]/; |
... | ... |
@@ -664,13 +664,13 @@ sub include_model { |
664 | 664 |
push @$model_infos, $module |
665 | 665 |
if $module =~ s/\.pm$//; |
666 | 666 |
} |
667 |
- |
|
668 | 667 |
close $dh; |
669 | 668 |
} |
670 | 669 |
|
670 |
+ # Include models |
|
671 | 671 |
foreach my $model_info (@$model_infos) { |
672 | 672 |
|
673 |
- # Model class, name, table |
|
673 |
+ # Load model |
|
674 | 674 |
my $model_class; |
675 | 675 |
my $model_name; |
676 | 676 |
my $model_table; |
... | ... |
@@ -684,8 +684,6 @@ sub include_model { |
684 | 684 |
} |
685 | 685 |
else { $model_class = $model_name = $model_table = $model_info } |
686 | 686 |
my $mclass = "${name_space}::$model_class"; |
687 |
- |
|
688 |
- # Load |
|
689 | 687 |
croak qq{"$mclass" is invalid class name} |
690 | 688 |
if $mclass =~ /[^\w:]/; |
691 | 689 |
unless ($mclass->can('isa')) { |
... | ... |
@@ -693,13 +691,11 @@ sub include_model { |
693 | 691 |
croak $@ if $@; |
694 | 692 |
} |
695 | 693 |
|
696 |
- # Instantiate |
|
694 |
+ # Create model |
|
697 | 695 |
my $args = {}; |
698 | 696 |
$args->{model_class} = $mclass if $mclass; |
699 | 697 |
$args->{name} = $model_name if $model_name; |
700 | 698 |
$args->{table} = $model_table if $model_table; |
701 |
- |
|
702 |
- # Create model |
|
703 | 699 |
$self->create_model($args); |
704 | 700 |
} |
705 | 701 |
|
... | ... |
@@ -709,8 +705,8 @@ sub include_model { |
709 | 705 |
sub merge_param { |
710 | 706 |
my ($self, @params) = @_; |
711 | 707 |
|
708 |
+ # Merge parameters |
|
712 | 709 |
my $param = {}; |
713 |
- |
|
714 | 710 |
foreach my $p (@params) { |
715 | 711 |
foreach my $column (keys %$p) { |
716 | 712 |
if (exists $param->{$column}) { |
... | ... |
@@ -730,7 +726,7 @@ sub merge_param { |
730 | 726 |
sub method { |
731 | 727 |
my $self = shift; |
732 | 728 |
|
733 |
- # Merge |
|
729 |
+ # Register method |
|
734 | 730 |
my $methods = ref $_[0] eq 'HASH' ? $_[0] : {@_}; |
735 | 731 |
$self->{_methods} = {%{$self->{_methods} || {}}, %$methods}; |
736 | 732 |
|
... | ... |
@@ -740,7 +736,7 @@ sub method { |
740 | 736 |
sub model { |
741 | 737 |
my ($self, $name, $model) = @_; |
742 | 738 |
|
743 |
- # Set |
|
739 |
+ # Set model |
|
744 | 740 |
if ($model) { |
745 | 741 |
$self->models->{$name} = $model; |
746 | 742 |
return $self; |
... | ... |
@@ -750,17 +746,17 @@ sub model { |
750 | 746 |
croak qq{Model "$name" is not included} |
751 | 747 |
unless $self->models->{$name}; |
752 | 748 |
|
753 |
- # Get |
|
749 |
+ # Get model |
|
754 | 750 |
return $self->models->{$name}; |
755 | 751 |
} |
756 | 752 |
|
757 | 753 |
sub mycolumn { |
758 | 754 |
my ($self, $table, $columns) = @_; |
759 | 755 |
|
756 |
+ # Create column clause |
|
757 |
+ my @column; |
|
760 | 758 |
my $q = $self->reserved_word_quote; |
761 |
- |
|
762 | 759 |
$columns ||= []; |
763 |
- my @column; |
|
764 | 760 |
push @column, "$q$table$q.$q$_$q as $q$_$q" for @$columns; |
765 | 761 |
|
766 | 762 |
return join (', ', @column); |
... | ... |
@@ -769,13 +765,14 @@ sub mycolumn { |
769 | 765 |
sub new { |
770 | 766 |
my $self = shift->SUPER::new(@_); |
771 | 767 |
|
772 |
- # Check attribute names |
|
768 |
+ # Check attributes |
|
773 | 769 |
my @attrs = keys %$self; |
774 | 770 |
foreach my $attr (@attrs) { |
775 |
- croak qq{"$attr" is invalid attribute name} |
|
771 |
+ croak qq{"$attr" is wrong name} |
|
776 | 772 |
unless $self->can($attr); |
777 | 773 |
} |
778 |
- |
|
774 |
+ |
|
775 |
+ # Register tag |
|
779 | 776 |
$self->register_tag( |
780 | 777 |
'?' => \&DBIx::Custom::Tag::placeholder, |
781 | 778 |
'=' => \&DBIx::Custom::Tag::equal, |
... | ... |
@@ -796,13 +793,13 @@ sub new { |
796 | 793 |
sub not_exists { bless {}, 'DBIx::Custom::NotExists' } |
797 | 794 |
|
798 | 795 |
sub register_filter { |
799 |
- my $invocant = shift; |
|
796 |
+ my $self = shift; |
|
800 | 797 |
|
801 | 798 |
# Register filter |
802 | 799 |
my $filters = ref $_[0] eq 'HASH' ? $_[0] : {@_}; |
803 |
- $invocant->filters({%{$invocant->filters}, %$filters}); |
|
800 |
+ $self->filters({%{$self->filters}, %$filters}); |
|
804 | 801 |
|
805 |
- return $invocant; |
|
802 |
+ return $self; |
|
806 | 803 |
} |
807 | 804 |
|
808 | 805 |
sub register_tag { shift->query_builder->register_tag(@_) } |
... | ... |
@@ -810,6 +807,7 @@ sub register_tag { shift->query_builder->register_tag(@_) } |
810 | 807 |
sub replace { |
811 | 808 |
my ($self, $join, $search, $replace) = @_; |
812 | 809 |
|
810 |
+ # Replace |
|
813 | 811 |
my @replace_join; |
814 | 812 |
my $is_replaced; |
815 | 813 |
foreach my $j (@$join) { |
... | ... |
@@ -832,15 +830,6 @@ our %SELECT_ARGS |
832 | 830 |
sub select { |
833 | 831 |
my ($self, %args) = @_; |
834 | 832 |
|
835 |
- # Reserved word quote |
|
836 |
- my $q = $self->reserved_word_quote; |
|
837 |
- |
|
838 |
- # Check argument names |
|
839 |
- foreach my $name (keys %args) { |
|
840 |
- croak qq{Argument "$name" is wrong name} |
|
841 |
- unless $SELECT_ARGS{$name}; |
|
842 |
- } |
|
843 |
- |
|
844 | 833 |
# Arguments |
845 | 834 |
my $table = delete $args{table}; |
846 | 835 |
my $tables = ref $table eq 'ARRAY' ? $table |
... | ... |
@@ -854,11 +843,18 @@ sub select { |
854 | 843 |
unless ref $join eq 'ARRAY'; |
855 | 844 |
my $relation = delete $args{relation}; |
856 | 845 |
my $param = delete $args{param} || {}; |
846 |
+ my $query_return = $args{query}; |
|
847 |
+ |
|
848 |
+ # Check arguments |
|
849 |
+ foreach my $name (keys %args) { |
|
850 |
+ croak qq{Argument "$name" is wrong name} |
|
851 |
+ unless $SELECT_ARGS{$name}; |
|
852 |
+ } |
|
857 | 853 |
|
858 | 854 |
# Add relation tables(DEPRECATED!); |
859 | 855 |
$self->_add_relation_table($tables, $relation); |
860 | 856 |
|
861 |
- # SQL stack |
|
857 |
+ # Select statement |
|
862 | 858 |
my @sql; |
863 | 859 |
push @sql, 'select'; |
864 | 860 |
|
... | ... |
@@ -866,17 +862,16 @@ sub select { |
866 | 862 |
if ($columns) { |
867 | 863 |
$columns = [$columns] if ! ref $columns; |
868 | 864 |
foreach my $column (@$columns) { |
869 |
- unshift @$tables, @{$self->_tables($column)}; |
|
865 |
+ unshift @$tables, @{$self->_search_tables($column)}; |
|
870 | 866 |
push @sql, ($column, ','); |
871 | 867 |
} |
872 | 868 |
pop @sql if $sql[-1] eq ','; |
873 | 869 |
} |
874 |
- |
|
875 |
- # "*" is default |
|
876 | 870 |
else { push @sql, '*' } |
877 | 871 |
|
878 | 872 |
# Table |
879 | 873 |
push @sql, 'from'; |
874 |
+ my $q = $self->reserved_word_quote; |
|
880 | 875 |
if ($relation) { |
881 | 876 |
my $found = {}; |
882 | 877 |
foreach my $table (@$tables) { |
... | ... |
@@ -889,34 +884,32 @@ sub select { |
889 | 884 |
push @sql, "$q$main_table$q"; |
890 | 885 |
} |
891 | 886 |
pop @sql if ($sql[-1] || '') eq ','; |
892 |
- |
|
893 |
- # Main table |
|
894 | 887 |
croak "Not found table name" unless $tables->[-1]; |
895 | 888 |
|
896 |
- # Add table names in param |
|
897 |
- unshift @$tables, @{$self->_tables(join(' ', keys %$param) || '')}; |
|
889 |
+ # Add tables in parameter |
|
890 |
+ unshift @$tables, @{$self->_search_tables(join(' ', keys %$param) || '')}; |
|
898 | 891 |
|
899 | 892 |
# Where |
900 |
- my $w = $self->_where_to_obj($where); |
|
901 |
- $param = keys %$param ? $self->merge_param($param, $w->param) |
|
902 |
- : $w->param; |
|
893 |
+ $where = $self->_where_to_obj($where); |
|
894 |
+ $param = keys %$param ? $self->merge_param($param, $where->param) |
|
895 |
+ : $where->param; |
|
903 | 896 |
|
904 | 897 |
# String where |
905 |
- my $swhere = "$w"; |
|
898 |
+ my $where_clause = $where->to_string; |
|
906 | 899 |
|
907 | 900 |
# Add table names in where clause |
908 |
- unshift @$tables, @{$self->_tables($swhere)}; |
|
901 |
+ unshift @$tables, @{$self->_search_tables($where_clause)}; |
|
909 | 902 |
|
910 | 903 |
# Push join |
911 | 904 |
$self->_push_join(\@sql, $join, $tables); |
912 | 905 |
|
913 | 906 |
# Add where clause |
914 |
- push @sql, $swhere; |
|
907 |
+ push @sql, $where_clause; |
|
915 | 908 |
|
916 | 909 |
# Relation(DEPRECATED!); |
917 |
- $self->_push_relation(\@sql, $tables, $relation, $swhere eq '' ? 1 : 0); |
|
910 |
+ $self->_push_relation(\@sql, $tables, $relation, $where_clause eq '' ? 1 : 0); |
|
918 | 911 |
|
919 |
- # Append statement |
|
912 |
+ # Append |
|
920 | 913 |
push @sql, $append if $append; |
921 | 914 |
|
922 | 915 |
# SQL |
... | ... |
@@ -924,12 +917,12 @@ sub select { |
924 | 917 |
|
925 | 918 |
# Create query |
926 | 919 |
my $query = $self->create_query($sql); |
927 |
- return $query if $args{query}; |
|
920 |
+ return $query if $query_return; |
|
928 | 921 |
|
929 | 922 |
# Execute query |
930 | 923 |
my $result = $self->execute( |
931 | 924 |
$query, |
932 |
- param => $param, |
|
925 |
+ param => $param, |
|
933 | 926 |
table => $tables, |
934 | 927 |
%args |
935 | 928 |
); |
... | ... |
@@ -941,44 +934,35 @@ our %SELECT_AT_ARGS = (%SELECT_ARGS, where => 1, primary_key => 1); |
941 | 934 |
|
942 | 935 |
sub select_at { |
943 | 936 |
my ($self, %args) = @_; |
937 |
+ |
|
938 |
+ # Arguments |
|
939 |
+ my $primary_keys = delete $args{primary_key}; |
|
940 |
+ $primary_keys = [$primary_keys] unless ref $primary_keys; |
|
941 |
+ my $where = delete $args{where}; |
|
942 |
+ my $param = delete $args{param}; |
|
944 | 943 |
|
945 |
- # Check argument names |
|
944 |
+ # Check arguments |
|
946 | 945 |
foreach my $name (keys %args) { |
947 | 946 |
croak qq{Argument "$name" is wrong name} |
948 | 947 |
unless $SELECT_AT_ARGS{$name}; |
949 | 948 |
} |
950 | 949 |
|
951 |
- # Primary key |
|
952 |
- my $primary_keys = delete $args{primary_key}; |
|
953 |
- $primary_keys = [$primary_keys] unless ref $primary_keys; |
|
954 |
- |
|
955 | 950 |
# Table |
956 | 951 |
croak qq{"table" option must be specified} unless $args{table}; |
957 | 952 |
my $table = ref $args{table} ? $args{table}->[-1] : $args{table}; |
958 | 953 |
|
959 |
- # Where clause |
|
960 |
- my $where = {}; |
|
961 |
- if (exists $args{where}) { |
|
962 |
- my $where_columns = delete $args{where}; |
|
963 |
- |
|
954 |
+ # Where |
|
955 |
+ my $where_param = {}; |
|
956 |
+ if ($where) { |
|
964 | 957 |
croak qq{"where" must be constant value or array reference} |
965 |
- unless !ref $where_columns || ref $where_columns eq 'ARRAY'; |
|
966 |
- |
|
967 |
- $where_columns = [$where_columns] unless ref $where_columns; |
|
968 |
- |
|
969 |
- for(my $i = 0; $i < @$primary_keys; $i ++) { |
|
970 |
- $where->{$table . '.' . $primary_keys->[$i]} = $where_columns->[$i]; |
|
971 |
- } |
|
972 |
- } |
|
973 |
- |
|
974 |
- if (exists $args{param}) { |
|
975 |
- my $param = delete $args{param}; |
|
958 |
+ unless !ref $where || ref $where eq 'ARRAY'; |
|
959 |
+ $where = [$where] unless ref $where; |
|
976 | 960 |
for(my $i = 0; $i < @$primary_keys; $i ++) { |
977 |
- delete $param->{$primary_keys->[$i]}; |
|
961 |
+ $where_param->{$table . '.' . $primary_keys->[$i]} = $where->[$i]; |
|
978 | 962 |
} |
979 | 963 |
} |
980 | 964 |
|
981 |
- return $self->select(where => $where, %args); |
|
965 |
+ return $self->select(where => $where_param, %args); |
|
982 | 966 |
} |
983 | 967 |
|
984 | 968 |
sub setup_model { |
... | ... |
@@ -1319,7 +1303,7 @@ sub _remove_duplicate_table { |
1319 | 1303 |
return [keys %tables, $main_table ? $main_table : ()]; |
1320 | 1304 |
} |
1321 | 1305 |
|
1322 |
-sub _tables { |
|
1306 |
+sub _search_tables { |
|
1323 | 1307 |
my ($self, $source) = @_; |
1324 | 1308 |
|
1325 | 1309 |
my $tables = []; |
... | ... |
@@ -85,4 +85,4 @@ is($dbi->filters->{b}->(), 2); |
85 | 85 |
|
86 | 86 |
test 'invalid attribute name'; |
87 | 87 |
eval {$dbi = DBIx::Custom->new(a => 1) }; |
88 |
-like ($@, qr/"a" is invalid attribute name/); |
|
88 |
+like ($@, qr/name/); |