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
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
|
package StringProcessor;
# ************************************************************
# Description : Perform various algorithms on strings
# Author : Chad Elliott
# Create Date : 3/07/2003
# $Id: StringProcessor.pm 2035 2011-10-06 15:05:21Z johnnyw $
# ************************************************************
# ************************************************************
# 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.
## Line may have embedded new lines, so using 's' modifier.
if ($line =~ /^((\w+[-\s\w]+\w::)*\w+)\s*([\-+]?=)\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. We need to distinguish between doubly escaped quotes
## (<%equote%>) and escaped quotes (\"). We also need to retain the
## escaped escape characters.
my $escaped = ($line =~ s/\\\\\"/\01/g);
$escaped |= ($line =~ s/\\\'/\02/g);
$escaped |= ($line =~ s/\\ /\03/g);
$escaped |= ($line =~ s/\\\t/\04/g);
$escaped |= ($line =~ s/\\\"/\05/g);
$escaped |= ($line =~ s/\\\\/\06/g);
foreach my $part (grep(!/^\s*$/,
split(/(\"[^\"]+\"|\'[^\']+\'|\s+)/, $line))) {
## Remove enclosing double and single quotes
$part =~ s/^"(.*)"$/$1/;
$part =~ s/^'(.*)'$/$1/;
## Put any escaped escaped characters back into the string, but
## processed to take out one of the escape sequences.
if ($escaped) {
$part =~ s/\01/\\"/g;
$part =~ s/\02/\'/g;
$part =~ s/\03/ /g;
$part =~ s/\04/\t/g;
$part =~ s/\05/\"/g;
$part =~ s/\06/\\/g;
}
## Push it onto the array
push(@array, $part);
}
return \@array;
}
sub crlf {
#my $self = shift;
return "\n";
}
sub windows_crlf {
## Windows 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 '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;
}
sub merge {
# Push each element of @$list on to @$into, unless it's already in @$into.
my($into, $list) = @_;
foreach my $in (@$list) {
push(@$into, $in) if (!fgrep($in, $into));
}
}
1;
|
