added common test executing ...
|
1 |
package DBIx::Custom::Order; |
2 |
use Object::Simple -base; |
|
3 |
use overload |
|
4 |
'bool' => sub {1}, |
|
5 |
'""' => sub { shift->to_string }, |
|
6 |
fallback => 1; |
|
7 | ||
8 |
has 'dbi', |
|
9 |
orders => sub { [] }; |
|
10 | ||
11 |
sub prepend { |
|
12 |
my $self = shift; |
|
13 |
|
|
14 |
foreach my $order (reverse @_) { |
|
15 |
if (ref $order eq 'ARRAY') { |
|
16 |
my $column = shift @$order; |
|
17 |
$column = $self->dbi->_q($column) if defined $column; |
|
18 |
my $derection = shift @$order; |
|
19 |
$order = $column; |
|
20 |
$order .= " $derection" if $derection; |
|
21 |
} |
|
22 |
unshift @{$self->orders}, $order; |
|
23 |
} |
|
24 |
|
|
25 |
return $self; |
|
26 |
} |
|
27 | ||
28 |
sub to_string { |
|
29 |
my $self = shift; |
|
30 |
|
|
31 |
my $exists = {}; |
|
32 |
my @orders; |
|
33 |
foreach my $order (@{$self->orders}) { |
|
34 |
next unless defined $order; |
|
35 |
$order =~ s/^\s+//; |
|
36 |
$order =~ s/\s+$//; |
|
37 |
my ($column, $direction) = split /\s+/, $order; |
|
38 |
push @orders, $order unless $exists->{$column}; |
|
39 |
$exists->{$column} = 1; |
|
40 |
} |
|
41 |
|
|
42 |
return '' unless @orders; |
|
43 |
return 'order by ' . join(', ', @orders); |
|
44 |
} |
|
45 | ||
46 |
1; |
|
47 | ||
48 |
=head1 NAME |
|
49 | ||
50 |
DBIx::Custom::Order - Order by EXPERIMENTAL |
|
51 | ||
52 |
=head1 SYNOPSIS |
|
53 | ||
54 |
# Result |
|
55 |
my $order = DBIx::Custom::Order->new; |
|
56 |
$order->prepend('title', 'author desc'); |
|
57 |
my $order_by = "$order"; |
|
58 |
|
|
59 |
=head1 ATTRIBUTES |
|
60 | ||
61 |
=head2 C<dbi> |
|
62 | ||
63 |
my $dbi = $order->dbi; |
|
64 |
$order = $order->dbi($dbi); |
|
65 | ||
66 |
L<DBIx::Custom> object. |
|
67 | ||
68 |
=head2 C<orders> |
|
69 | ||
70 |
my $orders = $result->orders; |
|
71 |
$result = $result->orders(\%orders); |
|
72 | ||
73 |
Parts of order by clause |
|
74 | ||
75 |
=head1 METHODS |
|
76 | ||
77 |
L<DBIx::Custom::Result> inherits all methods from L<Object::Simple> |
|
78 |
and implements the following new ones. |
|
79 | ||
80 |
=head2 C<prepend> |
|
81 | ||
82 |
$order->prepend('title', 'author desc'); |
|
83 | ||
84 |
Prepend order parts to C<orders>. |
|
85 | ||
86 |
You can pass array reference, which contain column name and direction. |
|
87 |
Column name is quoted properly |
|
88 |
|
|
89 |
# Column name and direction |
|
90 |
$order->prepend(['book-title']); |
|
91 |
$order->prepend([qw/book-title desc/]); |
|
92 | ||
93 |
This is expanded to the following way. |
|
94 | ||
95 |
"book-title" |
|
96 |
"book-title" desc |
|
97 | ||
98 |
=head2 C<to_string> |
|
99 | ||
100 |
my $order_by = $order->to_string; |
|
101 | ||
102 |
Create order by clause. If column name is duplicated, First one is used. |
|
103 |
C<to_string> override stringification. so you can write the follwoing way. |
|
104 | ||
105 |
my $order_by = "$order"; |
|
106 | ||
107 |
=cut |
|
108 |