WebSVN – gelsvn – Diff – /branches/vc2005beta-branch/MPC/modules/Parser.pm


package Parser;
 
# ************************************************************
# Description   : A basic parser that requires a parse_line override
# Author        : Chad Elliott
# Create Date   : 5/16/2002
# ************************************************************
 
# ************************************************************
# Pragmas
# ************************************************************
 
use strict;
use FileHandle;
 
use OutputMessage;
use StringProcessor;
use DirectoryManager;
 
use vars qw(@ISA);
@ISA = qw(OutputMessage StringProcessor DirectoryManager);
 
# ************************************************************
# Data Section
# ************************************************************
 
my(%filecache) = ();
my($silent)    = 'MPC_SILENT';
my($logging)   = 'MPC_LOGGING';
 
# ************************************************************
# Subroutine Section
# ************************************************************
 
sub new {
  my($class) = shift;
  my($inc)   = shift;
  my($log)   = $ENV{$logging};
 
  ## The order of these array variables must correspond to the
  ## order of the parameters to OutputMessage::new().
  my($params) = (defined $ENV{$silent} ||
                 defined $log ? [0, 0, 0, 0] : [0, 1, 1, 1]);
 
  if (defined $log) {
    if ($log =~ /info(rmation)?\s*=\s*(\d+)/i) {
      $$params[0] = $2;
    }
    if ($log =~ /warn(ing)?\s*=\s*(\d+)/i) {
      $$params[1] = $2;
    }
    if ($log =~ /diag(nostic)?\s*=\s*(\d+)/i) {
      $$params[2] = $2;
    }
    if ($log =~ /detail(s)?\s*=\s*(\d+)/i) {
      $$params[3] = $2;
    }
  }
 
  my($self) = $class->SUPER::new(@$params);
 
  $self->{'line_number'} = 0;
  $self->{'include'}     = $inc;
 
  return $self;
}
 
 
sub strip_line {
  my($self) = shift;
  my($line) = shift;
 
  ++$self->{'line_number'};
  $line =~ s/\/\/.*//;
  $line =~ s/^\s+//;
  $line =~ s/\s+$//;
 
  return $line;
}
 
 
sub preprocess_line {
  #my($self) = shift;
  #my($fh)   = shift;
  #my($line) = shift;
  return $_[0]->strip_line($_[2]);
}
 
 
sub read_file {
  my($self)        = shift;
  my($input)       = shift;
  my($cache)       = shift;
  my($ih)          = new FileHandle();
  my($status)      = 1;
  my($errorString) = undef;
 
  $self->{'line_number'} = 0;
  if (open($ih, $input)) {
    if ($cache) {
      ## If we don't have an array for this file, then start one
      if (!defined $filecache{$input}) {
        $filecache{$input} = [];
      }
 
      while(<$ih>) {
        my($line) = $self->preprocess_line($ih, $_);
 
        ## Push the line onto the array for this file
        push(@{$filecache{$input}}, $line);
 
        ($status, $errorString) = $self->parse_line($ih, $line);
 
        if (!$status) {
          last;
        }
      }
    }
    else {
      while(<$ih>) {
        ($status, $errorString) = $self->parse_line(
                                    $ih, $self->preprocess_line($ih, $_));
 
        if (!$status) {
          last;
        }
      }
    }
    close($ih);
  }
  else {
    $errorString = "Unable to open \"$input\" for reading";
    $status = 0;
  }
 
  return $status, $errorString;
}
 
 
sub cached_file_read {
  my($self)  = shift;
  my($input) = shift;
  my($lines) = $filecache{$input};
 
  if (defined $lines) {
    my($status) = 1;
    my($error)  = undef;
    $self->{'line_number'} = 0;
    foreach my $line (@$lines) {
      ++$self->{'line_number'};
      ($status, $error) = $self->parse_line(undef, $line);
 
      if (!$status) {
        last;
      }
    }
    return $status, $error;
  }
 
  return $self->read_file($input, 1);
}
 
 
sub get_line_number {
  my($self) = shift;
  return $self->{'line_number'};
}
 
 
sub set_line_number {
  my($self)   = shift;
  my($number) = shift;
  $self->{'line_number'} = $number;
}
 
 
sub slash_to_backslash {
  my($self) = shift;
  my($file) = shift;
  $file =~ s/\//\\/g;
  return $file;
}
 
 
sub get_include_path {
  my($self) = shift;
  return $self->{'include'};
}
 
 
sub search_include_path {
  my($self)  = shift;
  my($file)  = shift;
 
  foreach my $include ('.', @{$self->{'include'}}) {
    if (-r "$include/$file") {
      return "$include/$file";
    }
  }
 
  return undef;
}
 
 
sub escape_regex_special {
  my($self) = shift;
  my($name) = shift;
 
  $name =~ s/([\+\-\\\$\[\]\(\)\.])/\\$1/g;
  return $name;
}
 
 
# ************************************************************
# Virtual Methods To Be Overridden
# ************************************************************
 
sub parse_line {
  #my($self) = shift;
  #my($ih)   = shift;
  #my($line) = shift;
}
 
 
1;
 

Rev 107	Rev 119
1	`package Parser;`	1	`package Parser;`
2		2
3	`# ************************************************************`	3	`# ************************************************************`
4	`# Description : A basic parser that requires a parse_line override`	4	`# Description : A basic parser that requires a parse_line override`
5	`# Author : Chad Elliott`	5	`# Author : Chad Elliott`
6	`# Create Date : 5/16/2002`	6	`# Create Date : 5/16/2002`
7	`# ************************************************************`	7	`# ************************************************************`
8		8
9	`# ************************************************************`	9	`# ************************************************************`
10	`# Pragmas`	10	`# Pragmas`
11	`# ************************************************************`	11	`# ************************************************************`
12		12
13	`use strict;`	13	`use strict;`
14	`use FileHandle;`	14	`use FileHandle;`
15		15
16	`use OutputMessage;`	16	`use OutputMessage;`
17	`use StringProcessor;`	17	`use StringProcessor;`
18	`use DirectoryManager;`	18	`use DirectoryManager;`
19		19
20	`use vars qw(@ISA);`	20	`use vars qw(@ISA);`
21	`@ISA = qw(OutputMessage StringProcessor DirectoryManager);`	21	`@ISA = qw(OutputMessage StringProcessor DirectoryManager);`
22		22
23	`# ************************************************************`	23	`# ************************************************************`
24	`# Data Section`	24	`# Data Section`
25	`# ************************************************************`	25	`# ************************************************************`
26		26
27	`my(%filecache) = ();`	27	`my(%filecache) = ();`
28	`my($silent) = 'MPC_SILENT';`	28	`my($silent) = 'MPC_SILENT';`
29	`my($logging) = 'MPC_LOGGING';`	29	`my($logging) = 'MPC_LOGGING';`
30		30
31	`# ************************************************************`	31	`# ************************************************************`
32	`# Subroutine Section`	32	`# Subroutine Section`
33	`# ************************************************************`	33	`# ************************************************************`
34		34
35	`sub new {`	35	`sub new {`
36	`my($class) = shift;`	36	`my($class) = shift;`
37	`my($inc) = shift;`	37	`my($inc) = shift;`
38	`my($log) = $ENV{$logging};`	38	`my($log) = $ENV{$logging};`
39		39
40	`## The order of these array variables must correspond to the`	40	`## The order of these array variables must correspond to the`
41	`## order of the parameters to OutputMessage::new().`	41	`## order of the parameters to OutputMessage::new().`
42	`my($params) = (defined $ENV{$silent} \|\|`	42	`my($params) = (defined $ENV{$silent} \|\|`
43	`defined $log ? [0, 0, 0, 0] : [0, 1, 1, 1]);`	43	`defined $log ? [0, 0, 0, 0] : [0, 1, 1, 1]);`
44		44
45	`if (defined $log) {`	45	`if (defined $log) {`
46	`if ($log =~ /info(rmation)?\s=\s(\d+)/i) {`	46	`if ($log =~ /info(rmation)?\s=\s(\d+)/i) {`
47	`$$params[0] = $2;`	47	`$$params[0] = $2;`
48	`}`	48	`}`
49	`if ($log =~ /warn(ing)?\s=\s(\d+)/i) {`	49	`if ($log =~ /warn(ing)?\s=\s(\d+)/i) {`
50	`$$params[1] = $2;`	50	`$$params[1] = $2;`
51	`}`	51	`}`
52	`if ($log =~ /diag(nostic)?\s=\s(\d+)/i) {`	52	`if ($log =~ /diag(nostic)?\s=\s(\d+)/i) {`
53	`$$params[2] = $2;`	53	`$$params[2] = $2;`
54	`}`	54	`}`
55	`if ($log =~ /detail(s)?\s=\s(\d+)/i) {`	55	`if ($log =~ /detail(s)?\s=\s(\d+)/i) {`
56	`$$params[3] = $2;`	56	`$$params[3] = $2;`
57	`}`	57	`}`
58	`}`	58	`}`
59		59
60	`my($self) = $class->SUPER::new(@$params);`	60	`my($self) = $class->SUPER::new(@$params);`
61		61
62	`$self->{'line_number'} = 0;`	62	`$self->{'line_number'} = 0;`
63	`$self->{'include'} = $inc;`	63	`$self->{'include'} = $inc;`
64		64
65	`return $self;`	65	`return $self;`
66	`}`	66	`}`
67		67
68		68
69	`sub strip_line {`	69	`sub strip_line {`
70	`my($self) = shift;`	70	`my($self) = shift;`
71	`my($line) = shift;`	71	`my($line) = shift;`
72		72
73	`++$self->{'line_number'};`	73	`++$self->{'line_number'};`
74	`$line =~ s/\/\/.*//;`	74	`$line =~ s/\/\/.*//;`
75	`$line =~ s/^\s+//;`	75	`$line =~ s/^\s+//;`
76	`$line =~ s/\s+$//;`	76	`$line =~ s/\s+$//;`
77		77
78	`return $line;`	78	`return $line;`
79	`}`	79	`}`
80		80
81		81
82	`sub preprocess_line {`	82	`sub preprocess_line {`
83	`#my($self) = shift;`	83	`#my($self) = shift;`
84	`#my($fh) = shift;`	84	`#my($fh) = shift;`
85	`#my($line) = shift;`	85	`#my($line) = shift;`
86	`return $_[0]->strip_line($_[2]);`	86	`return $_[0]->strip_line($_[2]);`
87	`}`	87	`}`
88		88
89		89
90	`sub read_file {`	90	`sub read_file {`
91	`my($self) = shift;`	91	`my($self) = shift;`
92	`my($input) = shift;`	92	`my($input) = shift;`
93	`my($cache) = shift;`	93	`my($cache) = shift;`
94	`my($ih) = new FileHandle();`	94	`my($ih) = new FileHandle();`
95	`my($status) = 1;`	95	`my($status) = 1;`
96	`my($errorString) = undef;`	96	`my($errorString) = undef;`
97		97
98	`$self->{'line_number'} = 0;`	98	`$self->{'line_number'} = 0;`
99	`if (open($ih, $input)) {`	99	`if (open($ih, $input)) {`
100	`if ($cache) {`	100	`if ($cache) {`
101	`## If we don't have an array for this file, then start one`	101	`## If we don't have an array for this file, then start one`
102	`if (!defined $filecache{$input}) {`	102	`if (!defined $filecache{$input}) {`
103	`$filecache{$input} = [];`	103	`$filecache{$input} = [];`
104	`}`	104	`}`
105		105
106	`while(<$ih>) {`	106	`while(<$ih>) {`
107	`my($line) = $self->preprocess_line($ih, $_);`	107	`my($line) = $self->preprocess_line($ih, $_);`
108		108
109	`## Push the line onto the array for this file`	109	`## Push the line onto the array for this file`
110	`push(@{$filecache{$input}}, $line);`	110	`push(@{$filecache{$input}}, $line);`
111		111
112	`($status, $errorString) = $self->parse_line($ih, $line);`	112	`($status, $errorString) = $self->parse_line($ih, $line);`
113		113
114	`if (!$status) {`	114	`if (!$status) {`
115	`last;`	115	`last;`
116	`}`	116	`}`
117	`}`	117	`}`
118	`}`	118	`}`
119	`else {`	119	`else {`
120	`while(<$ih>) {`	120	`while(<$ih>) {`
121	`($status, $errorString) = $self->parse_line(`	121	`($status, $errorString) = $self->parse_line(`
122	`$ih, $self->preprocess_line($ih, $_));`	122	`$ih, $self->preprocess_line($ih, $_));`
123		123
124	`if (!$status) {`	124	`if (!$status) {`
125	`last;`	125	`last;`
126	`}`	126	`}`
127	`}`	127	`}`
128	`}`	128	`}`
129	`close($ih);`	129	`close($ih);`
130	`}`	130	`}`
131	`else {`	131	`else {`
132	`$errorString = "Unable to open \"$input\" for reading";`	132	`$errorString = "Unable to open \"$input\" for reading";`
133	`$status = 0;`	133	`$status = 0;`
134	`}`	134	`}`
135		135
136	`return $status, $errorString;`	136	`return $status, $errorString;`
137	`}`	137	`}`
138		138
139		139
140	`sub cached_file_read {`	140	`sub cached_file_read {`
141	`my($self) = shift;`	141	`my($self) = shift;`
142	`my($input) = shift;`	142	`my($input) = shift;`
143	`my($lines) = $filecache{$input};`	143	`my($lines) = $filecache{$input};`
144		144
145	`if (defined $lines) {`	145	`if (defined $lines) {`
146	`my($status) = 1;`	146	`my($status) = 1;`
147	`my($error) = undef;`	147	`my($error) = undef;`
148	`$self->{'line_number'} = 0;`	148	`$self->{'line_number'} = 0;`
149	`foreach my $line (@$lines) {`	149	`foreach my $line (@$lines) {`
150	`++$self->{'line_number'};`	150	`++$self->{'line_number'};`
151	`($status, $error) = $self->parse_line(undef, $line);`	151	`($status, $error) = $self->parse_line(undef, $line);`
152		152
153	`if (!$status) {`	153	`if (!$status) {`
154	`last;`	154	`last;`
155	`}`	155	`}`
156	`}`	156	`}`
157	`return $status, $error;`	157	`return $status, $error;`
158	`}`	158	`}`
159		159
160	`return $self->read_file($input, 1);`	160	`return $self->read_file($input, 1);`
161	`}`	161	`}`
162		162
163		163
164	`sub get_line_number {`	164	`sub get_line_number {`
165	`my($self) = shift;`	165	`my($self) = shift;`
166	`return $self->{'line_number'};`	166	`return $self->{'line_number'};`
167	`}`	167	`}`
168		168
169		169
170	`sub set_line_number {`	170	`sub set_line_number {`
171	`my($self) = shift;`	171	`my($self) = shift;`
172	`my($number) = shift;`	172	`my($number) = shift;`
173	`$self->{'line_number'} = $number;`	173	`$self->{'line_number'} = $number;`
174	`}`	174	`}`
175		175
176		176
177	`sub slash_to_backslash {`	177	`sub slash_to_backslash {`
178	`my($self) = shift;`	178	`my($self) = shift;`
179	`my($file) = shift;`	179	`my($file) = shift;`
180	`$file =~ s/\//\\/g;`	180	`$file =~ s/\//\\/g;`
181	`return $file;`	181	`return $file;`
182	`}`	182	`}`
183		183
184		184
185	`sub get_include_path {`	185	`sub get_include_path {`
186	`my($self) = shift;`	186	`my($self) = shift;`
187	`return $self->{'include'};`	187	`return $self->{'include'};`
188	`}`	188	`}`
189		189
190		190
191	`sub search_include_path {`	191	`sub search_include_path {`
192	`my($self) = shift;`	192	`my($self) = shift;`
193	`my($file) = shift;`	193	`my($file) = shift;`
194		194
195	`foreach my $include ('.', @{$self->{'include'}}) {`	195	`foreach my $include ('.', @{$self->{'include'}}) {`
196	`if (-r "$include/$file") {`	196	`if (-r "$include/$file") {`
197	`return "$include/$file";`	197	`return "$include/$file";`
198	`}`	198	`}`
199	`}`	199	`}`
200		200
201	`return undef;`	201	`return undef;`
202	`}`	202	`}`
203		203
204		204
205	`sub escape_regex_special {`	205	`sub escape_regex_special {`
206	`my($self) = shift;`	206	`my($self) = shift;`
207	`my($name) = shift;`	207	`my($name) = shift;`
208		208
209	`$name =~ s/([\+\-\\\$\[\]\(\)\.])/\\$1/g;`	209	`$name =~ s/([\+\-\\\$\[\]\(\)\.])/\\$1/g;`
210	`return $name;`	210	`return $name;`
211	`}`	211	`}`
212		212
213		213
214	`# ************************************************************`	214	`# ************************************************************`
215	`# Virtual Methods To Be Overridden`	215	`# Virtual Methods To Be Overridden`
216	`# ************************************************************`	216	`# ************************************************************`
217		217
218	`sub parse_line {`	218	`sub parse_line {`
219	`#my($self) = shift;`	219	`#my($self) = shift;`
220	`#my($ih) = shift;`	220	`#my($ih) = shift;`
221	`#my($line) = shift;`	221	`#my($line) = shift;`
222	`}`	222	`}`
223		223
224		224
225	`1;`	225	`1;`
226		226

Subversion Repositories gelsvn

(root)/branches/vc2005beta-branch/MPC/modules/Parser.pm – Rev 107 → 119