modules/StringProcessor.pm

   1 package StringProcessor;
   2
   3 # ************************************************************
   4 # Description   : Perform various algorithms on strings
   5 # Author        : Chad Elliott
   6 # Create Date   : 3/07/2003
   7 # ************************************************************
   8
   9 # ************************************************************
  10 # Pragmas
  11 # ************************************************************
  12
  13 use strict;
  14
  15 # ************************************************************
  16 # Subroutine Section
  17 # ************************************************************
  18
  19 sub parse_assignment {
  20   my($self, $line, $values) = @_;
  21
  22   ## In MPC, a scope can have spaces in it.  However, it can not end
  23   ## in a space.
  24   if ($line =~ /^((\w+[\s\w]+\w::)*\w+)\s*([\-+]?=)\s*(.*)?/) {
  25     my $op = ($3 eq '+=' ? 1 : $3 eq '-=' ? -1 : 0);
  26     push(@$values, $op, $self->resolve_alias(lc($1)), $4);
  27     return 1;
  28   }
  29
  30   return 0;
  31 }
  32
  33
  34 sub extractType {
  35   my($self, $name) = @_;
  36   my $type = $name;
  37
  38   if ($name =~ /(.*)(Project|Workspace)Creator/) {
  39     $type = $1;
  40   }
  41
  42   return lc($type);
  43 }
  44
  45
  46 sub process_special {
  47   my($self, $line) = @_;
  48
  49   ## Replace all escaped double quotes and escaped backslashes
  50   ## with special characters
  51   my $escaped = ($line =~ s/\\\\/\01/g);
  52   $escaped |= ($line =~ s/\\"/\02/g);
  53
  54   ## Un-escape all other characters
  55   $line =~ s/\\(.)/$1/g;
  56
  57   ## Remove any non-escaped double quotes
  58   $line =~ s/"//g;
  59
  60   ## Put the escaped double quotes and backslashes back in
  61   if ($escaped) {
  62     $line =~ s/\02/"/g;
  63     $line =~ s/\01/\\/g;
  64   }
  65
  66   return $line;
  67 }
  68
  69
  70 sub create_array {
  71   my($self, $line) = @_;
  72   my @array;
  73
  74   ## Replace all escaped double and single quotes with special characters
  75   my $escaped = ($line =~ s/\\\"/\01/g);
  76   $escaped |= ($line =~ s/\\\'/\02/g);
  77   $escaped |= ($line =~ s/\\ /\03/g);
  78   $escaped |= ($line =~ s/\\\t/\04/g);
  79
  80   foreach my $part (grep(!/^\s*$/,
  81                          split(/(\"[^\"]+\"|\'[^\']+\'|\s+)/, $line))) {
  82     ## Remove enclosing double and single quotes
  83     $part =~ s/^"(.*)"$/$1/;
  84     $part =~ s/^'(.*)'$/$1/;
  85
  86     ## Put any escaped double or single quotes back into the string.
  87     if ($escaped) {
  88       $part =~ s/\01/\"/g;
  89       $part =~ s/\02/\'/g;
  90       $part =~ s/\03/ /g;
  91       $part =~ s/\04/\t/g;
  92     }
  93
  94     ## Push it onto the array
  95     push(@array, $part);
  96   }
  97
  98   return \@array;
  99 }
 100
 101
 102 sub crlf {
 103   #my $self = shift;
 104   return "\n";
 105 }
 106
 107
 108 sub windows_crlf {
 109   ## Windows, OS/2 and cygwin require a carriage return and line feed.
 110   ## However, at some point cygwin changed the way it does output and can
 111   ## be controled through an environment variable.
 112   return ($^O eq 'MSWin32' || $^O eq 'os2' ||
 113           ($^O eq 'cygwin' &&
 114            ($] < 5.008 || (defined $ENV{PERLIO} && $ENV{PERLIO} eq 'crlf'))) ?
 115            "\n" : "\r\n");
 116 }
 117
 118
 119 sub resolve_alias {
 120   #my $self = shift;
 121   #my $name = shift;
 122   return $_[1];
 123 }
 124
 125 sub fgrep {
 126   my($str, $array) = @_;
 127   foreach my $target (@$array) {
 128     return 1 if ($str eq $target);
 129   }
 130   return undef;
 131 }
 132
 133 1;