lib/SQL/Translator/Generator/Role/Quote.pm

   1 package SQL::Translator::Generator::Role::Quote;
   2
   3 use Moo::Role;
   4
   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
  16 requires qw(quote_chars name_sep);
  17
  18 has escape_char => (
  19   is => 'ro',
  20   lazy => 1,
  21   clearer => 1,
  22   default => sub { $_[0]->quote_chars->[-1] },
  23 );
  24
  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 || '';
  44   my $esc = $self->escape_char;
  45
  46   # parts containing * are naturally unquoted
  47   join $sep, map { (my $n = $_) =~ s/\Q$r/$esc$r/g; "$l$n$r" } ( $sep ? split (/\Q$sep\E/, $label ) : $label )
  48 }
  49
  50 1;
  51
  52 =head1 AUTHORS
  53
  54 See the included AUTHORS file:
  55 L<http://search.cpan.org/dist/SQL-Translator/AUTHORS>
  56
  57 =head1 COPYRIGHT
  58
  59 Copyright (c) 2012 the SQL::Translator L</AUTHORS> as listed above.
  60
  61 =head1 LICENSE
  62
  63 This code is free software and may be distributed under the same terms as Perl
  64 itself.
  65
  66 =cut