summaryrefslogtreecommitdiff
path: root/ACE/MPC/modules/StringProcessor.pm
blob: fc08e97fd2bdd45fc9a3c91cd76ffd605f461b29 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
package StringProcessor;

# ************************************************************
# Description   : Perform various algorithms on strings
# Author        : Chad Elliott
# Create Date   : 3/07/2003
# ************************************************************

# ************************************************************
# Pragmas
# ************************************************************

use strict;

# ************************************************************
# Subroutine Section
# ************************************************************

sub parse_assignment {
  my($self, $line, $values) = @_;

  ## In MPC, a scope can have spaces in it.  However, it can not end
  ## in a space.
  if ($line =~ /^((\w+[\s\w]+\w::)*\w+)\s*([\-+]?=)\s*(.*)?/) {
    my $op = ($3 eq '+=' ? 1 : $3 eq '-=' ? -1 : 0);
    push(@$values, $op, $self->resolve_alias(lc($1)), $4);
    return 1;
  }

  return 0;
}


sub extractType {
  my($self, $name) = @_;
  my $type = $name;

  if ($name =~ /(.*)(Project|Workspace)Creator/) {
    $type = $1;
  }

  return lc($type);
}


sub process_special {
  my($self, $line) = @_;

  ## Replace all escaped double quotes and escaped backslashes
  ## with special characters
  my $escaped = ($line =~ s/\\\\/\01/g);
  $escaped |= ($line =~ s/\\"/\02/g);

  ## Un-escape all other characters
  $line =~ s/\\(.)/$1/g;

  ## Remove any non-escaped double quotes
  $line =~ s/"//g;

  ## Put the escaped double quotes and backslashes back in
  if ($escaped) {
    $line =~ s/\02/"/g;
    $line =~ s/\01/\\/g;
  }

  return $line;
}


sub create_array {
  my($self, $line) = @_;
  my @array;

  ## Replace all escaped double and single quotes with special characters
  my $escaped = ($line =~ s/\\\"/\01/g);
  $escaped |= ($line =~ s/\\\'/\02/g);
  $escaped |= ($line =~ s/\\ /\03/g);
  $escaped |= ($line =~ s/\\\t/\04/g);

  foreach my $part (grep(!/^\s*$/,
                         split(/(\"[^\"]+\"|\'[^\']+\'|\s+)/, $line))) {
    ## Remove enclosing double and single quotes
    $part =~ s/^"(.*)"$/$1/;
    $part =~ s/^'(.*)'$/$1/;

    ## Put any escaped double or single quotes back into the string.
    if ($escaped) {
      $part =~ s/\01/\"/g;
      $part =~ s/\02/\'/g;
      $part =~ s/\03/ /g;
      $part =~ s/\04/\t/g;
    }

    ## Push it onto the array
    push(@array, $part);
  }

  return \@array;
}


sub crlf {
  #my $self = shift;
  return "\n";
}


sub windows_crlf {
  ## Windows, OS/2 and cygwin require a carriage return and line feed.
  ## However, at some point cygwin changed the way it does output and can
  ## be controled through an environment variable.
  return ($^O eq 'MSWin32' || $^O eq 'os2' ||
          ($^O eq 'cygwin' &&
           ($] < 5.008 || (defined $ENV{PERLIO} && $ENV{PERLIO} eq 'crlf'))) ?
           "\n" : "\r\n");
}


sub resolve_alias {
  #my $self = shift;
  #my $name = shift;
  return $_[1];
}

sub fgrep {
  my($str, $array) = @_;
  foreach my $target (@$array) {
    return 1 if ($str eq $target);
  }
  return undef;
}

1;