lib/SQL/Abstract/Converter.pm

   1 package SQL::Abstract::Converter;
   2
   3 use Carp ();
   4 use List::Util ();
   5 use Scalar::Util ();
   6 use Data::Query::ExprHelpers;
   7 use Moo;
   8 use namespace::clean;
   9
  10 has renderer_will_quote => (
  11   is => 'ro'
  12 );
  13
  14 has lower_case => (
  15   is => 'ro'
  16 );
  17
  18 has default_logic => (
  19   is => 'ro', coerce => sub { uc($_[0]) }, default => sub { 'OR' }
  20 );
  21
  22 has bind_meta => (
  23   is => 'ro', default => sub { 1 }
  24 );
  25
  26 has cmp => (is => 'ro', default => sub { '=' });
  27
  28 has sqltrue => (is => 'ro', default => sub { '1=1' });
  29 has sqlfalse => (is => 'ro', default => sub { '0=1' });
  30
  31 has special_ops => (is => 'ro', default => sub { [] });
  32
  33 # XXX documented but I don't current fail any tests not using it
  34 has unary_ops => (is => 'ro', default => sub { [] });
  35
  36 has injection_guard => (
  37   is => 'ro',
  38   default => sub {
  39     qr/
  40       \;
  41         |
  42       ^ \s* go \s
  43     /xmi;
  44   }
  45 );
  46
  47 has identifier_sep => (
  48   is => 'ro', default => sub { '.' },
  49 );
  50
  51 has always_quote => (is => 'ro', default => sub { 1 });
  52
  53 has convert => (is => 'ro');
  54
  55 has array_datatypes => (is => 'ro');
  56
  57 sub _literal_to_dq {
  58   my ($self, $literal) = @_;
  59   my @bind;
  60   ($literal, @bind) = @$literal if ref($literal) eq 'ARRAY';
  61   Literal('SQL', $literal, [ $self->_bind_to_dq(@bind) ]);
  62 }
  63
  64 sub _bind_to_dq {
  65   my ($self, @bind) = @_;
  66   return unless @bind;
  67   $self->bind_meta
  68     ? do {
  69         $self->_assert_bindval_matches_bindtype(@bind);
  70         map perl_scalar_value(reverse @$_), @bind
  71       }
  72     : map perl_scalar_value($_), @bind
  73 }
  74
  75 sub _value_to_dq {
  76   my ($self, $value) = @_;
  77   $self->_maybe_convert_dq(perl_scalar_value($value, our $Cur_Col_Meta));
  78 }
  79
  80 sub _ident_to_dq {
  81   my ($self, $ident) = @_;
  82   $self->_assert_pass_injection_guard($ident)
  83     unless $self->renderer_will_quote;
  84   $self->_maybe_convert_dq(Identifier(split /\Q${\$self->identifier_sep}/, $ident));
  85 }
  86
  87 sub _maybe_convert_dq {
  88   my ($self, $dq) = @_;
  89   if (my $c = $self->{where_convert}) {
  90     Operator({ 'SQL.Naive' => 'apply' }, [
  91         Identifier($self->_sqlcase($c)),
  92         $dq
  93       ]
  94     );
  95   } else {
  96     $dq;
  97   }
  98 }
  99
 100 sub _op_to_dq {
 101   my ($self, $op, @args) = @_;
 102   $self->_assert_pass_injection_guard($op);
 103   Operator({ 'SQL.Naive' => $op }, \@args);
 104 }
 105
 106 sub _assert_pass_injection_guard {
 107   if ($_[1] =~ $_[0]->{injection_guard}) {
 108     my $class = ref $_[0];
 109     die "Possible SQL injection attempt '$_[1]'. If this is indeed a part of the "
 110      . "desired SQL use literal SQL ( \'...' or \[ '...' ] ) or supply your own "
 111      . "{injection_guard} attribute to ${class}->new()"
 112   }
 113 }
 114
 115 sub _insert_to_dq {
 116   my ($self, $table, $data, $options) = @_;
 117   my (@names, @values);
 118   if (ref($data) eq 'HASH') {
 119     @names = sort keys %$data;
 120     foreach my $k (@names) {
 121       local our $Cur_Col_Meta = $k;
 122       push @values, $self->_mutation_rhs_to_dq($data->{$k});
 123     }
 124   } elsif (ref($data) eq 'ARRAY') {
 125     local our $Cur_Col_Meta;
 126     @values = map $self->_mutation_rhs_to_dq($_), @$data;
 127   } else {
 128     die "Not handled yet";
 129   }
 130   my $returning;
 131   if (my $r_source = $options->{returning}) {
 132     $returning = [
 133       map +(ref($_) ? $self->_expr_to_dq($_) : $self->_ident_to_dq($_)),
 134         (ref($r_source) eq 'ARRAY' ? @$r_source : $r_source),
 135     ];
 136   }
 137   Insert(
 138     (@names ? ([ map $self->_ident_to_dq($_), @names ]) : undef),
 139     [ \@values ],
 140     $self->_table_to_dq($table),
 141     ($returning ? ($returning) : undef),
 142   );
 143 }
 144
 145 sub _mutation_rhs_to_dq {
 146   my ($self, $v) = @_;
 147   if (ref($v) eq 'ARRAY') {
 148     if ($self->{array_datatypes}) {
 149       return $self->_value_to_dq($v);
 150     }
 151     $v = \do { my $x = $v };
 152   }
 153   if (ref($v) eq 'HASH') {
 154     my ($op, $arg, @rest) = %$v;
 155
 156     die 'Operator calls in update/insert must be in the form { -op => $arg }'
 157       if (@rest or not $op =~ /^\-(.+)/);
 158   }
 159   return $self->_expr_to_dq($v);
 160 }
 161
 162 sub _update_to_dq {
 163   my ($self, $table, $data, $where) = @_;
 164
 165   die "Unsupported data type specified to \$sql->update"
 166     unless ref $data eq 'HASH';
 167
 168   my @set;
 169
 170   foreach my $k (sort keys %$data) {
 171     my $v = $data->{$k};
 172     local our $Cur_Col_Meta = $k;
 173     push @set, [ $self->_ident_to_dq($k), $self->_mutation_rhs_to_dq($v) ];
 174   }
 175
 176   Update(
 177     \@set,
 178     $self->_where_to_dq($where),
 179     $self->_table_to_dq($table),
 180   );
 181 }
 182
 183 sub _source_to_dq {
 184   my ($self, $table, undef, $where) = @_;
 185
 186   my $source_dq = $self->_table_to_dq($table);
 187
 188   if (my $where_dq = $self->_where_to_dq($where)) {
 189     $source_dq = Where($where_dq, $source_dq);
 190   }
 191
 192   $source_dq;
 193 }
 194
 195 sub _select_to_dq {
 196   my $self = shift;
 197   my ($table, $fields, $where, $order) = @_;
 198
 199   my $source_dq = $self->_source_to_dq(@_);
 200
 201   my $ordered_dq = do {
 202     if ($order) {
 203       $self->_order_by_to_dq($order, undef, undef, $source_dq);
 204     } else {
 205       $source_dq
 206     }
 207   };
 208
 209   return $self->_select_select_to_dq($fields, $ordered_dq);
 210 }
 211
 212 sub _select_select_to_dq {
 213   my ($self, $fields, $from_dq) = @_;
 214
 215   $fields ||= '*';
 216
 217   Select(
 218     $self->_select_field_list_to_dq($fields),
 219     $from_dq,
 220   );
 221 }
 222
 223 sub _select_field_list_to_dq {
 224   my ($self, $fields) = @_;
 225   [ map $self->_select_field_to_dq($_),
 226       ref($fields) eq 'ARRAY' ? @$fields : $fields ];
 227 }
 228
 229 sub _select_field_to_dq {
 230   my ($self, $field) = @_;
 231   if (my $ref = ref($field)) {
 232     if ($ref eq 'REF' and ref($$field) eq 'HASH') {
 233       return $$field;
 234     } else {
 235       return $self->_literal_to_dq($$field);
 236     }
 237   }
 238   return $self->_ident_to_dq($field)
 239 }
 240
 241 sub _delete_to_dq {
 242   my ($self, $table, $where) = @_;
 243   Delete(
 244     $self->_where_to_dq($where),
 245     $self->_table_to_dq($table),
 246   );
 247 }
 248
 249 sub _where_to_dq {
 250   my ($self, $where, $logic) = @_;
 251
 252   return undef unless defined($where);
 253
 254   # if we're given a simple string assume it's a literal
 255   return $self->_literal_to_dq($where) if !ref($where);
 256
 257   # turn the convert misfeature on - only used in WHERE clauses
 258   local $self->{where_convert} = $self->convert;
 259
 260   return $self->_expr_to_dq($where, $logic);
 261 }
 262
 263 sub _expr_to_dq {
 264   my ($self, $where, $logic) = @_;
 265
 266   if (ref($where) eq 'ARRAY') {
 267     return $self->_expr_to_dq_ARRAYREF($where, $logic);
 268   } elsif (ref($where) eq 'HASH') {
 269     return $self->_expr_to_dq_HASHREF($where, $logic);
 270   } elsif (
 271     ref($where) eq 'SCALAR'
 272     or (ref($where) eq 'REF' and ref($$where) eq 'ARRAY')
 273   ) {
 274     return $self->_literal_to_dq($$where);
 275   } elsif (ref($where) eq 'REF' and ref($$where) eq 'HASH') {
 276     return $$where;
 277   } elsif (!ref($where) or Scalar::Util::blessed($where)) {
 278     return $self->_value_to_dq($where);
 279   }
 280   die "Can't handle $where";
 281 }
 282
 283 sub _expr_to_dq_ARRAYREF {
 284   my ($self, $where, $logic) = @_;
 285
 286   $logic = uc($logic || $self->default_logic || 'OR');
 287   $logic eq 'AND' or $logic eq 'OR' or die "unknown logic: $logic";
 288
 289   return unless @$where;
 290
 291   my ($first, @rest) = @$where;
 292
 293   return $self->_expr_to_dq($first) unless @rest;
 294
 295   my $first_dq = do {
 296     if (!ref($first)) {
 297       $self->_where_hashpair_to_dq($first => shift(@rest));
 298     } else {
 299       $self->_expr_to_dq($first);
 300     }
 301   };
 302
 303   return $self->_expr_to_dq_ARRAYREF(\@rest, $logic) unless $first_dq;
 304
 305   $self->_op_to_dq(
 306     $logic, $first_dq, $self->_expr_to_dq_ARRAYREF(\@rest, $logic)
 307   );
 308 }
 309
 310 sub _expr_to_dq_HASHREF {
 311   my ($self, $where, $logic) = @_;
 312
 313   $logic = uc($logic) if $logic;
 314
 315   my @dq = map {
 316     $self->_where_hashpair_to_dq($_ => $where->{$_}, $logic)
 317   } sort keys %$where;
 318
 319   return $dq[0] unless @dq > 1;
 320
 321   my $final = pop(@dq);
 322
 323   foreach my $dq (reverse @dq) {
 324     $final = $self->_op_to_dq($logic||'AND', $dq, $final);
 325   }
 326
 327   return $final;
 328 }
 329
 330 sub _where_to_dq_SCALAR {
 331   shift->_value_to_dq(@_);
 332 }
 333
 334 sub _apply_to_dq {
 335   my ($self, $op, $v) = @_;
 336   my @args = map $self->_expr_to_dq($_), (ref($v) eq 'ARRAY' ? @$v : $v);
 337
 338   # Ok. Welcome to stupid compat code land. An SQLA expr that would in the
 339   # absence of this piece of crazy render to:
 340   #
 341   #   A( B( C( x ) ) )
 342   #
 343   # such as
 344   #
 345   #   { -a => { -b => { -c => $x } } }
 346   #
 347   # actually needs to render to:
 348   #
 349   #   A( B( C x ) )
 350   #
 351   # because SQL sucks, and databases are hateful, and SQLA is Just That DWIM.
 352   #
 353   # However, we don't want to catch 'A(x)' and turn it into 'A x'
 354   #
 355   # So the way we deal with this is to go through all our arguments, and
 356   # then if the argument is -also- an apply, i.e. at least 'B', we check
 357   # its arguments - and if there's only one of them, and that isn't an apply,
 358   # then we convert to the bareword form. The end result should be:
 359   #
 360   # A( x )                   -> A( x )
 361   # A( B( x ) )              -> A( B x )
 362   # A( B( C( x ) ) )         -> A( B( C x ) )
 363   # A( B( x + y ) )          -> A( B( x + y ) )
 364   # A( B( x, y ) )           -> A( B( x, y ) )
 365   #
 366   # If this turns out not to be quite right, please add additional tests
 367   # to either 01generate.t or 02where.t *and* update this comment.
 368
 369   foreach my $arg (@args) {
 370     if (
 371       is_Operator($arg) and $arg->{operator}{'SQL.Naive'} eq 'apply'
 372       and @{$arg->{args}} == 2 and !is_Operator($arg->{args}[1])
 373
 374     ) {
 375       $arg->{operator}{'SQL.Naive'} = (shift @{$arg->{args}})->{elements}->[0];
 376     }
 377   }
 378   $self->_assert_pass_injection_guard($op);
 379   return $self->_op_to_dq(
 380     apply => $self->_ident_to_dq($op), @args
 381   );
 382 }
 383
 384 sub _where_hashpair_to_dq {
 385   my ($self, $k, $v, $logic) = @_;
 386
 387   if ($k =~ /^-(.*)/s) {
 388     my $op = uc($1);
 389     if ($op eq 'AND' or $op eq 'OR') {
 390       return $self->_expr_to_dq($v, $op);
 391     } elsif ($op eq 'NEST') {
 392       return $self->_expr_to_dq($v);
 393     } elsif ($op eq 'NOT') {
 394       return $self->_op_to_dq(NOT => $self->_expr_to_dq($v));
 395     } elsif ($op eq 'BOOL') {
 396       return ref($v) ? $self->_expr_to_dq($v) : $self->_ident_to_dq($v);
 397     } elsif ($op eq 'NOT_BOOL') {
 398       return $self->_op_to_dq(
 399         NOT => ref($v) ? $self->_expr_to_dq($v) : $self->_ident_to_dq($v)
 400       );
 401     } elsif ($op eq 'IDENT') {
 402       return $self->_ident_to_dq($v);
 403     } elsif ($op eq 'VALUE') {
 404       return $self->_value_to_dq($v);
 405     } elsif ($op =~ /^(?:AND|OR|NEST)_?\d+/) {
 406       die "Use of [and|or|nest]_N modifiers is no longer supported";
 407     } else {
 408       return $self->_apply_to_dq($op, $v);
 409     }
 410   } else {
 411     local our $Cur_Col_Meta = $k;
 412     if (ref($v) eq 'ARRAY') {
 413       if (!@$v) {
 414         return $self->_literal_to_dq($self->{sqlfalse});
 415       } elsif (defined($v->[0]) && $v->[0] =~ /-(and|or)/i) {
 416         return $self->_expr_to_dq_ARRAYREF([
 417           map +{ $k => $_ }, @{$v}[1..$#$v]
 418         ], uc($1));
 419       }
 420       return $self->_expr_to_dq_ARRAYREF([
 421         map +{ $k => $_ }, @$v
 422       ], $logic);
 423     } elsif (ref($v) eq 'SCALAR' or (ref($v) eq 'REF' and ref($$v) eq 'ARRAY')) {
 424       return Literal('SQL', [ $self->_ident_to_dq($k), $self->_literal_to_dq($$v) ]);
 425     }
 426     my ($op, $rhs) = do {
 427       if (ref($v) eq 'HASH') {
 428         if (keys %$v > 1) {
 429           return $self->_expr_to_dq_ARRAYREF([
 430             map +{ $k => { $_ => $v->{$_} } }, sort keys %$v
 431           ], $logic||'AND');
 432         }
 433         my ($op, $value) = %$v;
 434         s/^-//, s/_/ /g for $op;
 435         if ($op =~ /^(and|or)$/i) {
 436           return $self->_expr_to_dq({ $k => $value }, $op);
 437         } elsif (
 438           my $special_op = List::Util::first {$op =~ $_->{regex}}
 439                              @{$self->{special_ops}}
 440         ) {
 441           return $self->_literal_to_dq(
 442             [ $special_op->{handler}->($k, $op, $value) ]
 443           );;
 444         } elsif ($op =~ /^(?:AND|OR|NEST)_?\d+$/i) {
 445           die "Use of [and|or|nest]_N modifiers is no longer supported";
 446         }
 447         (uc($op), $value);
 448       } else {
 449         ($self->{cmp}, $v);
 450       }
 451     };
 452     if ($op eq 'BETWEEN' or $op eq 'IN' or $op eq 'NOT IN' or $op eq 'NOT BETWEEN') {
 453       if (ref($rhs) ne 'ARRAY') {
 454         if ($op =~ /IN$/) {
 455           # have to add parens if none present because -in => \"SELECT ..."
 456           # got documented. mst hates everything.
 457           if (ref($rhs) eq 'SCALAR') {
 458             my $x = $$rhs;
 459             1 while ($x =~ s/\A\s*\((.*)\)\s*\Z/$1/s);
 460             $rhs = \$x;
 461           } else {
 462             my ($x, @rest) = @{$$rhs};
 463             1 while ($x =~ s/\A\s*\((.*)\)\s*\Z/$1/s);
 464             $rhs = \[ $x, @rest ];
 465           }
 466         }
 467         return $self->_op_to_dq(
 468           $op, $self->_ident_to_dq($k), $self->_literal_to_dq($$rhs)
 469         );
 470       }
 471       return $self->_literal_to_dq($self->{sqlfalse}) unless @$rhs;
 472       return $self->_op_to_dq(
 473         $op, $self->_ident_to_dq($k), map $self->_expr_to_dq($_), @$rhs
 474       )
 475     } elsif ($op =~ s/^NOT (?!LIKE)//) {
 476       return $self->_where_hashpair_to_dq(-not => { $k => { $op => $rhs } });
 477     } elsif ($op eq 'IDENT') {
 478       return $self->_op_to_dq(
 479         $self->{cmp}, $self->_ident_to_dq($k), $self->_ident_to_dq($rhs)
 480       );
 481     } elsif ($op eq 'VALUE') {
 482       return $self->_op_to_dq(
 483         $self->{cmp}, $self->_ident_to_dq($k), $self->_value_to_dq($rhs)
 484       );
 485     } elsif (!defined($rhs)) {
 486       my $null_op = do {
 487         if ($op eq '=' or $op eq 'LIKE') {
 488           'IS NULL'
 489         } elsif ($op eq '!=') {
 490           'IS NOT NULL'
 491         } else {
 492           die "Can't do undef -> NULL transform for operator ${op}";
 493         }
 494       };
 495       return $self->_op_to_dq($null_op, $self->_ident_to_dq($k));
 496     }
 497     if (ref($rhs) eq 'ARRAY') {
 498       if (!@$rhs) {
 499         return $self->_literal_to_dq(
 500           $op eq '!=' ? $self->{sqltrue} : $self->{sqlfalse}
 501         );
 502       } elsif (defined($rhs->[0]) and $rhs->[0] =~ /^-(and|or)$/i) {
 503         return $self->_expr_to_dq_ARRAYREF([
 504           map +{ $k => { $op => $_ } }, @{$rhs}[1..$#$rhs]
 505         ], uc($1));
 506       } elsif ($op =~ /^-(?:AND|OR|NEST)_?\d+/) {
 507         die "Use of [and|or|nest]_N modifiers is no longer supported";
 508       }
 509       return $self->_expr_to_dq_ARRAYREF([
 510         map +{ $k => { $op => $_ } }, @$rhs
 511       ]);
 512     }
 513     return $self->_op_to_dq(
 514       $op, $self->_ident_to_dq($k), $self->_expr_to_dq($rhs)
 515     );
 516   }
 517 }
 518
 519 sub _order_by_to_dq {
 520   my ($self, $arg, $dir, $nulls, $from) = @_;
 521
 522   return unless $arg;
 523
 524   my $dq = Order(
 525     undef,
 526     (defined($dir) ? (!!($dir =~ /desc/i)) : undef),
 527     (defined($nulls) ? ($nulls =~ /first/i ? 1 : -1) : undef),
 528     ($from ? ($from) : undef),
 529   );
 530
 531   if (!ref($arg)) {
 532     $dq->{by} = $self->_ident_to_dq($arg);
 533   } elsif (ref($arg) eq 'ARRAY') {
 534     return unless @$arg;
 535     local our $Order_Inner unless our $Order_Recursing;
 536     local $Order_Recursing = 1;
 537     my ($outer, $inner);
 538     foreach my $member (@$arg) {
 539       local $Order_Inner;
 540       my $next = $self->_order_by_to_dq($member, $dir, $nulls, $from);
 541       $outer ||= $next;
 542       $inner->{from} = $next if $inner;
 543       $inner = $Order_Inner || $next;
 544     }
 545     $Order_Inner = $inner;
 546     return $outer;
 547   } elsif (ref($arg) eq 'REF' and ref($$arg) eq 'ARRAY') {
 548     $dq->{by} = $self->_literal_to_dq($$arg);
 549   } elsif (ref($arg) eq 'SCALAR') {
 550
 551     # < mst> right, but if it doesn't match that, it goes "ok, right, not sure,
 552     #        totally leaving this untouched as a literal"
 553     # < mst> so I -think- it's relatively robust
 554     # < ribasushi> right, it's relatively safe then
 555     # < ribasushi> is this regex centralized?
 556     # < mst> it only exists in _order_by_to_dq in SQL::Abstract::Converter
 557     # < mst> it only exists because you were kind enough to support new
 558     #        dbihacks crack combined with old literal order_by crack
 559     # < ribasushi> heh :)
 560
 561     if (my ($ident, $dir) = $$arg =~ /^(\w+)(?:\s+(desc|asc))?$/i) {
 562       $dq->{by} = $self->_ident_to_dq($ident);
 563       $dq->{reverse} = 1 if $dir and lc($dir) eq 'desc';
 564     } else {
 565       $dq->{by} = $self->_literal_to_dq($$arg);
 566     }
 567   } elsif (ref($arg) eq 'HASH') {
 568     return () unless %$arg;
 569
 570     my ($direction, $val);
 571     foreach my $key (keys %$arg) {
 572       if ( $key =~ /^-(desc|asc)/i ) {
 573         die "hash passed to _order_by_to_dq must have exactly one of -desc or -asc"
 574             if defined $direction;
 575         $direction = $1;
 576         $val = $arg->{$key};
 577       } elsif ($key =~ /^-nulls$/i)  {
 578         $nulls = $arg->{$key};
 579         die "invalid value for -nulls" unless $nulls =~ /^(?:first|last)$/;
 580       } else {
 581         die "invalid key in hash passed to _order_by_to_dq";
 582       }
 583     }
 584
 585     die "hash passed to _order_by_to_dq must have exactly one of -desc or -asc"
 586         unless defined $direction;
 587
 588     return $self->_order_by_to_dq($val, $direction, $nulls, $from);
 589   } else {
 590     die "Can't handle $arg in _order_by_to_dq";
 591   }
 592   return $dq;
 593 }
 594
 595 sub _table_to_dq {
 596   my ($self, $from) = @_;
 597   if (ref($from) eq 'ARRAY') {
 598     die "Empty FROM list" unless my @f = @$from;
 599     my $dq = $self->_table_to_dq(shift @f);
 600     while (my $x = shift @f) {
 601       $dq = Join(
 602         $dq,
 603         $self->_table_to_dq($x),
 604       );
 605     }
 606     $dq;
 607   } elsif (ref($from) eq 'SCALAR' or (ref($from) eq 'REF')) {
 608     $self->_literal_to_dq($$from);
 609   } else {
 610     $self->_ident_to_dq($from);
 611   }
 612 }
 613
 614 # And bindtype
 615 sub _bindtype (@) {
 616   #my ($self, $col, @vals) = @_;
 617
 618   #LDNOTE : changed original implementation below because it did not make
 619   # sense when bindtype eq 'columns' and @vals > 1.
 620 #  return $self->{bindtype} eq 'columns' ? [ $col, @vals ] : @vals;
 621
 622   # called often - tighten code
 623   return $_[0]->bind_meta
 624     ? map {[$_[1], $_]} @_[2 .. $#_]
 625     : @_[2 .. $#_]
 626   ;
 627 }
 628
 629 # Dies if any element of @bind is not in [colname => value] format
 630 # if bindtype is 'columns'.
 631 sub _assert_bindval_matches_bindtype {
 632 #  my ($self, @bind) = @_;
 633   my $self = shift;
 634   if ($self->bind_meta) {
 635     for (@_) {
 636       if (!defined $_ || ref($_) ne 'ARRAY' || @$_ != 2) {
 637         die "bindtype 'columns' selected, you need to pass: [column_name => bind_value]"
 638       }
 639     }
 640   }
 641 }
 642
 643 # Fix SQL case, if so requested
 644 sub _sqlcase {
 645   return $_[0]->lower_case ? $_[1] : uc($_[1]);
 646 }
 647
 648 1;