View of /trunk/pg/lib/Value/String.pm

    1 ###########################################################################
    2 
    3 package Value::String;
    4 my $pkg = 'Value::String';
    5 
    6 use strict;
    7 our @ISA = qw(Value);
    8 
    9 #
   10 #  Create a string object
   11 #
   12 sub new {
   13   my $self = shift; my $class = ref($self) || $self;
   14   my $context = (Value::isContext($_[0]) ? shift : $self->context);
   15   my $x = join('',@_);
   16   my $s = bless {data => [$x], context => $context}, $class;
   17   if ($Parser::installed && !($x eq '' && $self->getFlag('allowEmptyStrings'))) {
   18     my $strings = $context->{strings};
   19     if (!$strings->{$x}) {
   20       my $X = $strings->{uc($x)};
   21       Value::Error("String constant '%s' is not defined in this context",$x)
   22         unless $X && !$X->{caseSensitive};
   23       $x = uc($x); while ($strings->{$x}{alias}) {$x = $strings->{$x}{alias}}
   24     }
   25     $s->{caseSensitive} = 1 if $strings->{$x}{caseSensitive};
   26   }
   27   return $s;
   28 }
   29 
   30 #
   31 #  Return the appropriate data.
   32 #
   33 sub length {1}
   34 sub typeRef {$Value::Type{string}}
   35 sub value {shift->{data}[0]}
   36 
   37 sub isOne {0}
   38 sub isZero {0}
   39 
   40 ##################################################
   41 
   42 #
   43 #  Convert to a string object
   44 #
   45 sub promote {
   46   my $self = shift;
   47   my $x = (scalar(@_) ? shift : $self); $x = [$x,@_] if scalar(@_) > 0;
   48   $x = Value::makeValue($x,showError=>1,context=>$self->context);
   49   $x = join('',@{$x}) if ref($x) eq 'ARRAY';
   50   $x = $self->make($x) unless Value::isValue($x);
   51   return $x;
   52 }
   53 
   54 ############################################
   55 #
   56 #  Operations on strings
   57 #
   58 sub compare {
   59   my ($self,$l,$r,$flag) = Value::checkOpOrder(@_);
   60   return $l->value cmp $r->value if $l->{caseSensitive} || $r->{caseSensitive};
   61   return uc($l->value) cmp uc($r->value);
   62 }
   63 
   64 ############################################
   65 #
   66 #  Generate the various output formats
   67 #
   68 
   69 sub TeX {'{\rm '.shift->value.'}'}
   70 sub perl {"'".shift->value."'"}
   71 
   72 ###########################################################################
   73 
   74 1;