Commit | Line | Data |
22c0c10f |
1 | package SQL::Translator::Generator::Role::Quote; |
d22073f1 |
2 | |
598a2461 |
3 | use Moo::Role; |
4 | |
22c0c10f |
5 | =head1 NAME |
6 | |
7 | SQL::Translator::Generator::Role::Quote - Role for dealing with identifier |
8 | quoting. |
9 | |
10 | =head1 DESCRIPTION |
11 | |
12 | I<documentation volunteers needed> |
13 | |
14 | =cut |
15 | |
598a2461 |
16 | requires qw(quote_chars name_sep); |
17 | |
0c425150 |
18 | has escape_char => ( |
19 | is => 'ro', |
20 | lazy => 1, |
21 | clearer => 1, |
22 | default => sub { $_[0]->quote_chars->[-1] }, |
23 | ); |
24 | |
598a2461 |
25 | sub quote { |
26 | my ($self, $label) = @_; |
27 | |
28 | return '' unless defined $label; |
29 | return $$label if ref($label) eq 'SCALAR'; |
30 | |
31 | my @quote_chars = @{$self->quote_chars}; |
32 | return $label unless scalar @quote_chars; |
33 | |
34 | my ($l, $r); |
35 | if (@quote_chars == 1) { |
36 | ($l, $r) = (@quote_chars) x 2; |
37 | } elsif (@quote_chars == 2) { |
38 | ($l, $r) = @quote_chars; |
39 | } else { |
40 | die 'too many quote chars!'; |
41 | } |
42 | |
43 | my $sep = $self->name_sep || ''; |
0c425150 |
44 | my $esc = $self->escape_char; |
45 | |
598a2461 |
46 | # parts containing * are naturally unquoted |
0c425150 |
47 | join $sep, map { (my $n = $_) =~ s/\Q$r/$esc$r/g; "$l$n$r" } ( $sep ? split (/\Q$sep\E/, $label ) : $label ) |
598a2461 |
48 | } |
49 | |
1868ddbe |
50 | sub quote_string { |
51 | my ($self, $string) = @_; |
52 | |
53 | return $string unless defined $string; |
54 | $string =~ s/'/''/g; |
55 | return qq{'$string'}; |
56 | } |
57 | |
598a2461 |
58 | 1; |
22c0c10f |
59 | |
60 | =head1 AUTHORS |
61 | |
62 | See the included AUTHORS file: |
63 | L<http://search.cpan.org/dist/SQL-Translator/AUTHORS> |
64 | |
65 | =head1 COPYRIGHT |
66 | |
67 | Copyright (c) 2012 the SQL::Translator L</AUTHORS> as listed above. |
68 | |
69 | =head1 LICENSE |
70 | |
71 | This code is free software and may be distributed under the same terms as Perl |
72 | itself. |
73 | |
74 | =cut |