xref: /trunk/main/solenv/bin/modules/par2script/work.pm (revision 86e1cf34) 
1#**************************************************************
2#
3#  Licensed to the Apache Software Foundation (ASF) under one
4#  or more contributor license agreements.  See the NOTICE file
5#  distributed with this work for additional information
6#  regarding copyright ownership.  The ASF licenses this file
7#  to you under the Apache License, Version 2.0 (the
8#  "License"); you may not use this file except in compliance
9#  with the License.  You may obtain a copy of the License at
10#
11#    http://www.apache.org/licenses/LICENSE-2.0
12#
13#  Unless required by applicable law or agreed to in writing,
14#  software distributed under the License is distributed on an
15#  "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
16#  KIND, either express or implied.  See the License for the
17#  specific language governing permissions and limitations
18#  under the License.
19#
20#**************************************************************
21
22
23
24
25package par2script::work;
26
27use par2script::existence;
28use par2script::globals;
29use par2script::remover;
30
31############################################
32# par2script working module
33############################################
34
35sub analyze_comma_separated_list
36{
37	my ($list, $listref) = @_;	# second parameter is optional
38
39	my @list = ();
40	my $locallistref;
41
42	if (!( $listref )) { $locallistref = \@list; }
43	else { $locallistref = $listref; }
44
45	par2script::remover::remove_leading_and_ending_comma(\$list);
46	par2script::remover::remove_leading_and_ending_whitespaces(\$list);
47
48	while ( $list =~ /^\s*(.*?)\s*\,\s*(.*)\s*$/ )
49	{
50		my $oneentry = $1;
51		$list = $2;
52		par2script::remover::remove_leading_and_ending_whitespaces(\$oneentry);
53		push(@{$locallistref}, $oneentry);
54	}
55
56	# the last entry
57
58	par2script::remover::remove_leading_and_ending_whitespaces(\$list);
59	push(@{$locallistref}, $list);
60
61	return $locallistref;
62}
63
64############################################
65# setting list of include paths
66############################################
67
68sub setincludes
69{
70	my ($list) = @_;
71
72	# input is the comma separated list of include paths
73
74	my $includes = analyze_comma_separated_list($list);
75
76	return $includes;
77}
78
79############################################
80# setting list of all par files
81############################################
82
83sub setparfiles
84{
85	my ($filename) = @_;
86
87	# input is the name of the list file
88	$filename =~ s/\@//;	# removing the leading \@
89
90	my $filecontent = par2script::files::read_file($filename);
91
92	my @parfiles = ();
93	my $parfilesref = \@parfiles;
94
95	foreach ( @{$filecontent} ) { $parfilesref = analyze_comma_separated_list($_, $parfilesref); }
96
97	return $parfilesref;
98}
99
100############################################
101# finding the correct include path
102# for the par files
103############################################
104
105sub make_complete_pathes_for_parfiles
106{
107	my ($parfiles, $includes) = @_;
108
109	my $oneparfile;
110
111	foreach $oneparfile ( @{$parfiles} )
112	{
113		my $foundparfile = 0;
114		my $includepath;
115
116		foreach $includepath ( @{$includes} )
117		{
118			my $parfile = "$includepath/$oneparfile";
119
120			if ( -f $parfile )
121			{
122				$foundparfile = 1;
123				$oneparfile = $parfile;
124				last;
125			}
126		}
127
128		if ( ! $foundparfile )
129		{
130			die "ERROR: Could not find parfile ${$parfiles}[$i] in includes paths: $par2script::globals::includepathlist !\n";
131		}
132	}
133}
134
135######################################################
136# collecting one special item in the par files and
137# including it into the "definitions" hash
138######################################################
139
140sub collect_definitions
141{
142	my ($parfilecontent) = @_;
143
144	my $multidefinitionerror = 0;
145	my @multidefinitiongids = ();
146
147
148	foreach $oneitem ( @par2script::globals::allitems )
149	{
150		my $docollect = 0;
151		my $gid = "";
152		my %allitemhash = ();
153
154		for ( my $i = 0; $i <= $#{$parfilecontent}; $i++ )
155		{
156			my $line = ${$parfilecontent}[$i];
157
158			if ( $line =~ /^\s*$oneitem\s+(\w+)\s*$/ )
159			{
160				$gid = $1;
161				$docollect = 1;
162			}
163			else
164			{
165				$docollect = 0;
166			}
167
168			if ( $docollect )
169			{
170				my $currentline = $i;
171				my %oneitemhash;
172
173				while (! ( ${$parfilecontent}[$currentline] =~ /^\s*End\s*$/i ) )
174				{
175					if ( ${$parfilecontent}[$currentline] =~ /^\s*(.+?)\s*\=\s*(.+?)\s*\;\s*$/ )	# only oneliner!
176					{
177						$itemkey = $1;
178						$itemvalue = $2;
179
180						if ( $oneitem eq "Directory" ) { if ( $itemkey =~ "DosName" ) { $itemkey =~ s/DosName/HostName/; } }
181						if (( $oneitem eq "Directory" ) || ( $oneitem eq "File" ) || ( $oneitem eq "Unixlink" )) { if ( $itemvalue eq "PD_PROGDIR" ) { $itemvalue = "PREDEFINED_PROGDIR"; }}
182						if (( $itemkey eq "Styles" ) && ( $itemvalue =~ /^\s*(\w+)(\s*\;\s*)$/ )) { $itemvalue = "($1)$2"; }
183
184						$oneitemhash{$itemkey} = $itemvalue;
185					}
186
187					$currentline++;
188				}
189
190				# no hyphen allowed in gids -> cannot happen here because (\w+) is required for gids
191				if ( $gid =~ /-/ ) { par2script::exiter::exit_program("ERROR: No hyphen allowed in global id: $gid", "test_of_hyphen"); }
192
193				# test of uniqueness
194				if ( exists($allitemhash{$gid}) )
195				{
196					$multidefinitionerror = 1;
197					push(@multidefinitiongids, $gid);
198				}
199
200				$allitemhash{$gid} = \%oneitemhash;
201			}
202		}
203
204		$par2script::globals::definitions{$oneitem} = \%allitemhash;
205	}
206
207	if ( $multidefinitionerror ) {	par2script::exiter::multidefinitionerror(\@multidefinitiongids); }
208
209	# foreach $key (keys %par2script::globals::definitions)
210	# {
211	#	print "Key: $key \n";
212	#
213	#	foreach $key (keys %{$par2script::globals::definitions{$key}})
214	#	{
215	#		print "\t$key \n";
216	#	}
217	# }
218}
219
220######################################################
221# Filling content into the script
222######################################################
223
224sub put_oneitem_into_script
225{
226	my ( $script, $item, $itemhash, $itemkey ) = @_;
227
228	push(@{$script}, "$item $itemkey\n" );
229	my $content = "";
230	foreach $content (sort keys %{$itemhash->{$itemkey}}) { push(@{$script}, "\t$content = $itemhash->{$itemkey}->{$content};\n" ); }
231	push(@{$script}, "End\n" );
232	push(@{$script}, "\n" );
233}
234
235######################################################
236# Creating the script
237######################################################
238
239sub create_script
240{
241	my @script = ();
242	my $oneitem;
243
244	foreach $oneitem ( @par2script::globals::allitems )
245	{
246		if ( exists($par2script::globals::definitions{$oneitem}) )
247		{
248			if ( $oneitem eq "Shortcut" ) { next; } # "Shortcuts" after "Files"
249
250			if (( $oneitem eq "Module" ) || ( $oneitem eq "Directory" )) { write_sorted_items(\@script, $oneitem); }
251			else { write_unsorted_items(\@script, $oneitem); }
252		}
253	}
254
255	return \@script;
256}
257
258######################################################
259# Adding script content for the unsorted items
260######################################################
261
262sub write_unsorted_items
263{
264	my ( $script, $oneitem ) = @_;
265
266	my $itemhash = $par2script::globals::definitions{$oneitem};
267
268	my $itemkey = "";
269	foreach $itemkey (sort keys %{$itemhash})
270	{
271		put_oneitem_into_script($script, $oneitem, $itemhash, $itemkey);
272
273		# special handling for Shortcuts after Files
274		if (( $oneitem eq "File" ) && ( exists($par2script::globals::definitions{"Shortcut"}) ))
275		{
276			my $shortcutkey;
277			foreach $shortcutkey ( keys %{$par2script::globals::definitions{"Shortcut"}} )
278			{
279				if ( $par2script::globals::definitions{"Shortcut"}->{$shortcutkey}->{'FileID'} eq $itemkey )
280				{
281					put_oneitem_into_script($script, "Shortcut", $par2script::globals::definitions{"Shortcut"}, $shortcutkey);
282
283					# and Shortcut to Shortcut also
284					my $internshortcutkey;
285					foreach $internshortcutkey ( keys %{$par2script::globals::definitions{"Shortcut"}} )
286					{
287						if ( $par2script::globals::definitions{"Shortcut"}->{$internshortcutkey}->{'ShortcutID'} eq $shortcutkey )
288						{
289							put_oneitem_into_script($script, "Shortcut", $par2script::globals::definitions{"Shortcut"}, $internshortcutkey);
290						}
291					}
292				}
293			}
294		}
295	}
296}
297
298######################################################
299# Collecting all children of a specified parent
300######################################################
301
302sub collect_children
303{
304	my ( $itemhash, $parent, $order ) = @_;
305
306	my $item;
307	foreach $item ( keys %{$itemhash} )
308	{
309		if ( $itemhash->{$item}->{'ParentID'} eq $parent )
310		{
311			push(@{$order}, $item);
312			my $newparent = $item;
313			collect_children($itemhash, $newparent, $order);
314		}
315	}
316}
317
318######################################################
319# Adding script content for the sorted items
320######################################################
321
322sub write_sorted_items
323{
324	my ( $script, $oneitem ) = @_;
325
326	my $itemhash = $par2script::globals::definitions{$oneitem};
327
328	my @itemorder = ();
329	my @startparents = ();
330
331	if ( $oneitem eq "Module" ) { push(@startparents, ""); }
332	elsif ( $oneitem eq "Directory" ) { push(@startparents, "PREDEFINED_PROGDIR"); }
333	else { die "ERROR: No root parent defined for item type $oneitem !\n"; }
334
335	# supporting more than one toplevel item
336	my $parent;
337	foreach $parent ( @startparents ) { collect_children($itemhash, $parent, \@itemorder); }
338
339	my $itemkey;
340	foreach $itemkey ( @itemorder ) { put_oneitem_into_script($script, $oneitem, $itemhash, $itemkey); }
341}
342
343#######################################################################
344# Collecting all assigned gids of the type "item" from the modules
345# in the par files. Using a hash!
346#######################################################################
347
348sub collect_assigned_gids
349{
350	my $allmodules = $par2script::globals::definitions{'Module'};
351
352	my $item;
353	foreach $item ( @par2script::globals::items_assigned_at_modules )
354	{
355		if ( ! exists($par2script::globals::searchkeys{$item}) ) { par2script::exiter::exit_program("ERROR: Unknown type \"$item\" at modules.", "collect_assigned_gids"); }
356
357		my $searchkey = $par2script::globals::searchkeys{$item};
358
359		my %assignitems = ();
360		my $modulegid = "";
361
362		foreach $modulegid (keys %{$allmodules} )
363		{
364			# print "Module $modulegid\n";
365			# my $content = "";
366			# foreach $content (sort keys %{$allmodules->{$modulegid}}) { print "\t$content = $allmodules->{$modulegid}->{$content};\n"; }
367			# print "End\n";
368			# print "\n";
369
370			if ( exists($allmodules->{$modulegid}->{$searchkey}) )
371			{
372				my $list = $allmodules->{$modulegid}->{$searchkey};
373				if ( $list =~ /^\s*\((.*?)\)\s*(.*?)\s*$/ ) { $list = $1; }
374				else { par2script::exiter::exit_program("ERROR: Invalid module list: $list", "collect_assigned_gids"); }
375				my $allassigneditems = par2script::converter::convert_stringlist_into_array_2($list, ",");
376
377				my $gid;
378				foreach $gid ( @{$allassigneditems} )
379				{
380					if ( exists($assignitems{$gid}) ) { $assignitems{$gid} = $assignitems{$gid} + 1; }
381					else { $assignitems{$gid} = 1; }
382				}
383			}
384		}
385
386		$par2script::globals::assignedgids{$item} = \%assignitems;
387	}
388}
389
390##################################################
391# Collecting the content of all par files.
392# Then the files do not need to be opened twice.
393##################################################
394
395sub read_all_parfiles
396{
397	my ($parfiles) = @_;
398
399	my @parfilecontent = ();
400	my $parfilename;
401
402	foreach $parfilename ( @{$parfiles} )
403	{
404		my $parfile = par2script::files::read_file($parfilename);
405		foreach ( @{$parfile} ) { push(@parfilecontent, $_); }
406		push(@parfilecontent, "\n");
407	}
408
409	return \@parfilecontent;
410}
411
4121;
413