--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/toolsandutils/productionbldtools/ZipLog2Pkg.pm Tue Feb 02 01:39:43 2010 +0200
@@ -0,0 +1,870 @@
+#!perl
+
+# ziplog2pkg.pm
+
+# Copyright (c) 1997-2009 Nokia Corporation and/or its subsidiary(-ies).
+# All rights reserved.
+# This component and the accompanying materials are made available
+# under the terms of "Eclipse Public License v1.0"
+# which accompanies this distribution, and is available
+# at the URL "http://www.eclipse.org/legal/epl-v10.html".
+#
+# Initial Contributors:
+# Nokia Corporation - initial contribution.
+#
+# Contributors:
+#
+# Description:
+#
+
+use strict;
+
+
+package ZipLog2Pkg;
+
+use File::Path;
+use CProgressLog;
+use KitStandardLocations;
+
+my $log;
+my %stdVars = ();
+
+
+# --------------------------------- Start of ZipLog2Pkg() ----------------------------
+sub ZipLog2Pkg($$)
+{
+ my $cmdfile = shift;
+
+ my $parameters = shift;
+ my @options = grep(/^-/,$parameters);
+
+ my $verbose = 1;
+ foreach my $option (@options)
+ {
+ if ($option eq "-v")
+ {
+ $verbose = 2;
+ }
+ elsif (($option eq "-batch") || ($option eq "-b"))
+ {
+ $verbose = 0;
+ }
+ else
+ {
+ print "WARNING: Option '$option' not understood; ignoring\n";
+ }
+ }
+
+ # set up hash containing variables defined in KitStandardLocations.pm
+ foreach my $var (@KitStandardLocations::EXPORT)
+ {
+ $var =~ s/\$//;
+ eval{
+ no strict 'refs';
+ $stdVars{"%".$var."%"} = "$$var";
+ };
+ }
+
+ my $PlatformProductToolsDir = $FindBin::Bin;
+ $PlatformProductToolsDir =~ s/common/$KitStandardLocations::Platform/i; # change "common" to platform name in path to tools directory
+ $stdVars{"%baseline%"} = "$PlatformProductToolsDir\\baseline";
+
+ $log = New CProgressLog($verbose);
+ open (CMDFILE, "<$cmdfile") or print "Unable to open $cmdfile - $!\n" ;
+
+ my $packages = {};
+ my @files;
+ my @usedFiles;
+ my $version;
+ my @global_map;
+
+ $global_map[0] = ""; # global map from
+ $global_map[1] = "[emul]\\"; # global map to
+
+
+ foreach my $line (<CMDFILE>)
+ {
+ chomp($line);
+
+ if ($line =~ /^#/)
+ {
+ print "\n$line\n" # Printable comment
+ }
+ elsif (($line =~ /^\/\//) || ($line =~ /^\s*$/))
+ {
+ # Nonprintable comment or blank line
+ }
+ else
+ {
+ # replace standard variables in @params
+ if ($line =~ /%/)
+ {
+ $line = replaceStdVars ($line)
+ }
+
+ my @parms = split(" ", $line);
+ # Recombine quoted entries
+ for (my $index=0; $index < scalar(@parms); $index++)
+ {
+ if ($parms[$index] =~ /^\"/)
+ {
+ # If double quoted
+ my $entry = $parms[$index];
+
+ while ( ($entry !~ /\"$/) && ( ($index+1) < scalar(@parms) ) )
+ {
+ # If end quote not found, merge following entry
+ $entry = $entry." ".$parms[$index+1];
+
+ splice @parms, $index+1, 1;
+ }
+
+ if ($entry !~ /\"$/)
+ {
+ if ($entry =~ /^\"[^\"]*$/)
+ {
+ die "'$line' invalid: Opening quote must have corresponding close quote\n";
+ }
+ else
+ {
+ die "'$line' invalid: Close quote must come at end of parameter\n";
+ }
+ }
+
+ # Store combined quoted entries
+ $entry =~ s/^\"//;
+ $entry =~ s/\"$//;
+ splice @parms, $index, 1, $entry;
+ }
+ elsif ($parms[$index] =~ /^'/)
+ {
+ # If single quoted
+ my $entry = $parms[$index];
+
+ while ( ($entry !~ /'$/) && ( ($index+1) < scalar(@parms) ) )
+ {
+ # If end quote not found, merge following entry
+ $entry = $entry." ".$parms[$index+1];
+
+ splice @parms, $index+1, 1;
+ }
+
+ if ($entry !~ /'$/)
+ {
+ if ($entry =~ /^'[^']*$/)
+ {
+ die "'$line' invalid: Opening quote must have corresponding close quote\n";
+ }
+ else
+ {
+ die "'$line' invalid: Close quote must come at end of parameter\n";
+ }
+ }
+
+ # Store combined quoted entries
+ $entry =~ s/^'//;
+ $entry =~ s/'$//;
+ splice @parms, $index, 1, $entry;
+ }
+ }
+
+
+ my $command = shift @parms;
+ $command = lc($command);
+
+ if (($command eq "load") or ($command eq "add"))
+ {
+ if ($command eq "load")
+ {
+ # Don't append this; clear first
+ if (scalar(@files)>0)
+ {
+ $log->Warn("WARNING: ".scalar(@files)." files discarded.");
+ }
+ @files = ();
+ }
+
+ if (scalar(@parms) != 1)
+ {
+ die "'$line' invalid:\nExpected only one parameter (ziplog filename)\n";
+ }
+
+ my @new;
+
+ if ($parms[0] =~ /^#/)
+ {
+ my $file = $parms[0];
+ $file =~ s/^#//;
+ @new = @{readFileList($file)};
+ }
+ else
+ {
+ @new = @{readZiplog($parms[0])};
+ }
+
+ $log->Progress("");
+
+ my $orig = scalar(@files);
+ @files = (@files, @new);
+
+ # Clear any additional duplicated items
+ @files = @{removeDuplicates(\@files, 1)};
+
+ # Don't load in any lines that were previously loaded
+ # (add in @usedFiles twice, remove all duplicates)
+ @files = (@usedFiles, @usedFiles, @files);
+ @files = @{removeDuplicates(\@files, 0)}; # Removes all
+ # of the @used files added, plus any of those which
+ # matched the original @files too
+
+ $log->Progress("Loaded $parms[0]. ".scalar(@new)." files (".(scalar(@new)+$orig-scalar(@files))." duplicates)");
+ }
+ elsif ($command eq "patch")
+ {
+ if (scalar(@parms) != 1)
+ {
+ die "'$line' invalid:\nExpected only one parameter (file list filename)\n";
+ }
+
+ my $file = $parms[0];
+ if ($file =~ /^#/)
+ {
+ $file=~s/^#//;
+ }
+ else
+ {
+ $log->Error("ERROR: Patch file should be prefixed with a '#' to specify filelist.\nAttempting default of filelist.");
+ }
+
+ # Read file list in
+ my @filelist = @{readFileList($file)};
+
+ # Add them back in to files to match
+ my $orig = scalar(@files);
+ @files = (@files, @filelist);
+ @files = @{removeDuplicates(\@files, 1)};
+
+ # Take them out of files already matched
+ # (so a load containing one of them won't eliminate it)
+ @usedFiles = (@usedFiles, @filelist, @filelist);
+ @usedFiles = @{removeDuplicates(\@usedFiles, 0)};
+
+ $log->Progress("Loaded $parms[0]. ".scalar(@filelist)." files (".(scalar(@filelist)+$orig-scalar(@files))." duplicates)");
+ }
+ elsif ($command eq "create")
+ {
+ # Create package list
+ if (scalar(@parms) < 2)
+ {
+ die "'$line' invalid:\nExpected at least 2 parameters (package name, device name, [dependencies ...])\n";
+ }
+
+ # Parms: packagePath, device, dependencies...
+ my $packagePath = shift @parms;
+ my $device = shift @parms;
+
+ my $packageName = $packagePath;
+ $packageName =~ s/^.*[\/\\]//;
+ $packagePath =~ s/[\/\\][^\/\\]+$/\\/ or $packagePath = "";
+
+ if ($packageName eq "null")
+ {
+ die "'$line' invalid:\nCannot create package named 'null'. This name is reserved for files not to be written\n";
+ }
+
+ $packages->{$packageName} = [$packagePath, $device, [], \@parms, [], [], \@global_map, "", "", "", []];
+ }
+ elsif ($command eq "path")
+ {
+ # Parms: packageName, path to add
+ if (scalar(@parms) != 2)
+ {
+ die "'$line' invalid:\nExpected 2 parameters (package name, path to add)\n";
+ }
+ my $packageName = shift @parms;
+ my $path = shift @parms;
+
+ my ($packagePath, $device, $files, $dependencies, $paths, $menu, $map, $category, $description, $licence, $tags) = @{$packages->{$packageName}};
+ push @$paths, $path;
+
+ $packages->{$packageName} = [$packagePath, $device, $files, $dependencies, $paths, $menu, $map, $category, $description, $licence, $tags];
+ }
+ elsif ($command eq "menu")
+ {
+ # Parms: package name, menu entry, description, working path, file path [arguments, icon path]
+ if (scalar(@parms) < 5)
+ {
+ die "'$line' invalid:\nExpected at least 5 parameters (package name, menu entry, description, working path, file path, arguments, icon path)\n";
+ }
+ my ($packageName,$entry,$desc,$path,$file,$args,$icon) = @parms;
+
+ my ($packagePath, $device, $files, $dependencies, $paths, $menu, $map, $category, $description, $licence, $tags) = @{$packages->{$packageName}};
+ push @$menu, [$entry, $desc, $path, $file, $args, $icon];
+
+ $packages->{$packageName} = [$packagePath, $device, $files, $dependencies, $paths, $menu, $map, $category, $description, $licence, $tags];
+ }
+ elsif ($command eq "map_global")
+ {
+ # Parms: global map from, global map to
+ if (scalar(@parms) != 2)
+ {
+ die "'$line' invalid:\nExpected 2 parameters (global map from, global map to)\n";
+ }
+ @global_map = @parms;
+ }
+ elsif ($command eq "map")
+ {
+ # Parms: packageName, map from, map to
+ if (scalar(@parms) != 3)
+ {
+ die "'$line' invalid:\nExpected 3 parameters (package name, map from, map to)\n";
+ }
+ my ($packageName, $from, $to) = @parms;
+
+ my ($packagePath, $device, $files, $dependencies, $paths, $menu, $map, $category, $description, $licence, $tags) = @{$packages->{$packageName}};
+ $packages->{$packageName} = [$packagePath, $device, $files, $dependencies, $paths, $menu, [$from, $to], $category, $description, $licence, $tags];
+ }
+ elsif ($command eq "category")
+ {
+ # Parms: packageName, category
+ if (scalar(@parms) < 2)
+ {
+ die "'$line' invalid:\nExpected 2 parameters (package name, category)\n";
+ }
+ my $packageName = shift @parms;
+ my ($packagePath, $device, $files, $dependencies, $paths, $menu, $map, $category, $description, $licence, $tags) = @{$packages->{$packageName}};
+ my $category = shift @parms;
+ $packages->{$packageName} = [$packagePath, $device, $files, $dependencies, $paths, $menu, $map, $category, $description, $licence, $tags];
+ }
+ elsif ($command eq "description")
+ {
+ # Parms: packageName, description
+ if (scalar(@parms) < 2)
+ {
+ die "'$line' invalid:\nExpected 2 parameters (package name, description)\n";
+ }
+ my $packageName = shift @parms;
+ my ($packagePath, $device, $files, $dependencies, $paths, $menu, $map, $category, $description, $licence, $tags) = @{$packages->{$packageName}};
+ my $description = shift @parms;
+ $packages->{$packageName} = [$packagePath, $device, $files, $dependencies, $paths, $menu, $map, $category, $description, $licence, $tags];
+ }
+ elsif ($command eq "licence")
+ {
+ # Parms: packageName, licence file
+ if (scalar(@parms) != 2)
+ {
+ die "'$line' invalid:\nExpected 2 parameters (package name, licence file)\n";
+ }
+ my $packageName = shift @parms;
+ my ($packagePath, $device, $files, $dependencies, $paths, $menu, $map, $category, $description, $licence, $tags) = @{$packages->{$packageName}};
+ my $licence = shift @parms;
+ $packages->{$packageName} = [$packagePath, $device, $files, $dependencies, $paths, $menu, $map, $category, $description, $licence, $tags];
+ }
+ elsif ($command eq "tag")
+ {
+ # Parms: packageName, tag name, tag value
+ if (scalar(@parms) != 3)
+ {
+ die "'$line' invalid:\nExpected 3 parameters (package name, tag name, tag value)\n";
+ }
+ my ($packageName, $tagName, $tagValue) = @parms;
+
+ my ($packagePath, $device, $files, $dependencies, $paths, $menu, $map, $category, $description, $licence, $tags) = @{$packages->{$packageName}};
+ $packages->{$packageName} = [$packagePath, $device, $files, $dependencies, $paths, $menu, $map, $category, $description, $licence, [$tagName, $tagValue]];
+ }
+ elsif ($command eq "test")
+ {
+ # Warn if any files match
+ if (scalar(@parms) < 1)
+ {
+ die "'$line' invalid:\nExpected >1 parameter (expressions to match)\n";
+ }
+
+ my @files = @{ match(\@files, \@parms, [0], $cmdfile) };
+
+ foreach my $file (@files)
+ {
+ $log->Warn("WARNING: '$file' matched tests '".join(", ",@parms)."'");
+ }
+ }
+ elsif ($command eq "write")
+ {
+ # Write out to a package list
+ my @options = grep(/^-/,@parms);
+ my @parms = grep(!/^-/,@parms);
+
+ if (scalar(@parms) < 2)
+ {
+ die "'$line' invalid:\nExpected >2 parameters (expressions..., package name)\n";
+ }
+
+ my $warn = 1;
+ foreach my $option (@options)
+ {
+ if ($option eq "-nowarn")
+ {
+ $warn = 0;
+ }
+ else
+ {
+ die "'$line' invalid:\nOption $option not understood\n";
+ }
+ }
+
+ my $packageName = pop @parms;
+
+ # Perform the matching
+ my @package = @{ match(\@files,\@parms, [$warn], $cmdfile) };
+
+ # Get list of the files that are still to be matched
+ @files = (@files, @package, @package);
+ @files = @{removeDuplicates(\@files,0)};
+
+ # Record the matched files as used
+ @usedFiles = (@usedFiles, @package);
+
+ $log->Progress("Matched ".scalar(@package)." files for $packageName");
+
+ if (defined($packages->{$packageName}))
+ {
+ my ($packagePath, $device, $merge, $dependencies, $paths, $menu, $map, $category, $description, $licence, $tags) = @{$packages->{$packageName}};
+
+ $merge = [@package, @$merge];
+ $packages->{$packageName} = [$packagePath, $device, $merge, $dependencies, $paths, $menu, $map, $category, $description, $licence, $tags];
+ }
+ else
+ {
+ if ($packageName ne "null")
+ {
+ die "\nIn line '$line':\nAttempt to add to non-existent package '$packageName'.\nUse 'create $packageName [device name]' to create the package definition first\n";
+ }
+ }
+ }
+ elsif ($command eq "version")
+ {
+ if (defined($version))
+ {
+ die "\nIn line '$line':\nVersion has already been defined. One script can only have one version\n";
+ }
+ else
+ {
+ if (scalar(@parms) > 1)
+ {
+ die "\nIn line '$line':\nExpected only one parameter (spaces must be quoted)\n";
+ }
+ else
+ {
+ $version = shift @parms;
+ }
+ }
+ }
+ else
+ {
+ $log->Error("ERROR: Command not understood; ignoring: $line");
+ }
+ }
+ }
+ close(CMDFILE);
+
+ # Write out $packages
+ my $device;
+ my $files;
+ my $dependencies;
+ my $paths;
+ my $menu;
+ my $map;
+ my $category;
+ my $description;
+ my $licence;
+ my $tags;
+ my $packagePath;
+ foreach my $pkgName (keys(%$packages))
+ {
+ ($packagePath, $device, $files, $dependencies, $paths, $menu, $map, $category, $description, $licence, $tags) = @{$packages->{$pkgName}};
+ writePkg($packagePath, $pkgName, $files, $device, $dependencies, $paths, $menu, $map, $version, $category, $description, $licence, $tags);
+ }
+}
+
+sub readZiplog($)
+ {
+ my ($zipLog)=@_;
+ my @package;
+
+ # read in file
+ open (FILE, "<$zipLog") or die "Couldn't open file $zipLog";
+
+ # parse for elements we want
+ foreach my $line (<FILE>)
+ {
+ $line =~ s/^\s+// ;
+
+ if ($line =~ m/^adding: (.*)$/ )
+ {
+ # found line with file on - need to parse
+ my $fileline = $1;
+
+ # remove (deflated... or (stored... or ( anything bit at end
+
+ $fileline=~s/ \(.*\)$//;
+
+ $fileline =~ s/\s+$// ;
+
+ # ignore lines ending in slash - probably a directory
+
+ if ($fileline =~ /\/$/ )
+ {
+ print "Directory?? - $fileline\n" ;
+ }
+ else
+ {
+ $fileline =~ s,/,\\,g;
+ $fileline =~ s/^[\/\\]//;
+ push (@package, $fileline);
+ }
+ }
+ }
+
+ close(FILE);
+
+ return \@package;
+ }
+
+sub readFileList($)
+ {
+ my ($file) = @_;
+
+ my @filelist;
+
+ # Read file list in
+ open (FILELIST, $file) or die "File '$file' not found\n";
+ while (my $filename=<FILELIST>)
+ {
+ chomp($filename);
+ $filename =~ s,/,\\,g ;
+ $filename =~ s/^[\/\\]//; # remove initial slash
+ push @filelist, $filename;
+ }
+
+ close(FILELIST);
+
+ return \@filelist;
+ }
+
+sub writePkg($$$$$$$$$$$$)
+ {
+ my ($pkgPath, $pkgName, $fileList, $device, $dependencies, $paths, $menu, $map, $version, $category, $description, $licence, $tags) = @_;
+ my $from;
+ my $to;
+
+ if ($map != 0)
+ {
+ ($from, $to) = @$map;
+ }
+ if ($pkgPath ne "")
+ {
+ mkpath($pkgPath);
+
+ if (-e $pkgPath)
+ {
+ if (!(-d $pkgPath))
+ {
+ die "Couldn't open output dir $pkgPath (file of the same name already exists)\n";
+ }
+ }
+ else
+ {
+ die "Couldn't open output dir $pkgPath\n";
+ }
+ }
+
+ open (FILE, ">$pkgPath$pkgName.pkgdef") or die "Couldn't open output file $pkgPath$pkgName.pkgdef";
+ print (FILE "<?xml version=\"1.0\" encoding=\"ISO8859-1\"?>\n");
+ print (FILE "\n");
+
+ print (FILE "<packagedef version=\"1.0\">\n");
+ print (FILE " <package name=\"$pkgName\" major-version=\"0\" minor-version=\"0\">\n");
+ print (FILE " <supplier>Symbian Ltd</supplier>\n");
+ print (FILE " <sdk-version>$version</sdk-version>\n");
+ print (FILE " <category>$category</category>\n") if ($category ne "");
+ print (FILE " <description>$description</description>\n\n") if ($description ne "");
+
+ print (FILE " <licensing-agreement xml:lang=\"en_US\" document-root=\"".$licence."\" mime-type=\"text\/plain\"/>\n") if ($licence ne "");
+ print (FILE " <attributes>\n <device name=\"".$device."\"/>\n </attributes>\n") if ($device ne "device");
+
+ if (scalar(@$tags) > 0)
+ {
+ print (FILE " <install-path-tags>\n");
+ (my $tagName, my $tagValue) = @$tags;
+ print (FILE " <tag tag=\"$tagName\">$tagValue</tag>\n");
+ print (FILE " </install-path-tags>\n");
+ }
+ if (scalar(@$dependencies) > 0)
+ {
+ print (FILE " <dependencies>\n");
+ foreach my $dependency (@$dependencies)
+ {
+ print (FILE " <dependency name=\"$dependency\" major-version=\"0\" minor-version=\"0\" build-number=\"0\"/>\n");
+ }
+ print (FILE " </dependencies>\n");
+ }
+ if (scalar(@$paths) > 0)
+ {
+ print (FILE " <environment-changes>\n");
+ foreach my $path (@$paths)
+ {
+ print (FILE " <add-to-variable name=\"Path\" value=\"$path\" how=\"append\" separator=\";\"/>\n");
+ }
+ print (FILE " </environment-changes>\n");
+ }
+ if (scalar(@$menu) > 0)
+ {
+ print (FILE " <shortcuts>\n");
+ foreach my $entry (@$menu)
+ {
+ my ($name, $description, $workingDirectory, $filePath, $arguments, $iconPath) = @$entry;
+
+ print (FILE " <shortcut shortcut-path=\"Symbian\" file-path=\"".$filePath."\"");
+ print (FILE " description=\"".$description."\"") unless ($description eq "");
+ print (FILE " arguments=\'".$arguments."\'") unless ($arguments eq "");
+ print (FILE " working-directory=\"".$workingDirectory."\"") unless ($workingDirectory eq "");
+ print (FILE ">\n");
+ print (FILE " <shortcut-name xml:lang=\"en-US\" name=\"".$name."\"/>\n");
+ print (FILE " <shortcut-icon path=\"".$iconPath."\"/>\n") unless ($iconPath eq "");
+ print (FILE " </shortcut>\n");
+ }
+ print (FILE " </shortcuts>\n");
+ }
+ print (FILE " </package>\n");
+ print (FILE "\n");
+ print (FILE " <manifest>\n");
+
+ $fileList=[sort(@$fileList)];
+ $fileList=removeDuplicates($fileList,1); # Remove additional duplicates (may happen with 'patch'ed files)
+
+ foreach my $line (@$fileList)
+ {
+ print FILE " <item src=\"\\$line\"";
+ $line =~ s/^$from(.*)$/$1/i;
+ print FILE " dest=\"$to$line\"/>\n";
+ }
+ print FILE " <\/manifest>\n</packagedef>\n";
+ close(FILE);
+ }
+
+sub removeDuplicates($$)
+ {
+ # NB: Case insensitive matching
+ my ($aListRef, $aLeave) = @_;
+ my @list = @$aListRef;
+
+ if ($aLeave>1)
+ {
+ die "removeDuplicates(\$\$): Cannot leave more than 1 duplicate\n";
+ }
+
+ my $prevEntry = undef;
+ my $entry;
+
+ my $index=0;
+
+ @list=sort(@list);
+
+ while ($index < scalar(@list))
+ {
+ $entry = lc($list[$index]);
+
+ if ($entry eq $prevEntry)
+ {
+ if ($aLeave == 0)
+ {
+ # Get rid of the prevEntry as well if we need
+ splice(@list, $index-1, 1);
+ $index--;
+ }
+
+ while ($entry eq $prevEntry)
+ {
+ # If there's a duplicate, remove the duplicate
+ splice(@list, $index, 1);
+ # then get the next entry to check
+ $entry = lc($list[$index]);
+ }
+ }
+
+ $prevEntry = $entry;
+
+ $index++;
+ }
+
+ return \@list;
+ }
+
+# Keep only duplicated entries - and then only keep one of them
+sub keepDuplicates($)
+ {
+ my ($listRef) = @_;
+
+ my @list = sort(@$listRef);
+
+ my $index=0;
+
+ while ($index < scalar(@list))
+ {
+ if (($index<(scalar(@list)-1)) && (lc($list[$index]) eq lc($list[$index+1])))
+ {
+ # Remove all other duplicates except the last one
+ while ((lc($list[$index]) eq lc($list[$index+1])) && $index < (scalar(@list)-1))
+ {
+ splice(@list, $index, 1);
+ }
+ $index++;
+ }
+ else
+ {
+ # Not a duplicate; remove it
+ splice(@list, $index, 1);
+ }
+ }
+
+ return \@list;
+ }
+
+sub match($$$$)
+ {
+ my @package = @{(shift)}; # Files available for matching
+ my @patterns = @{(shift)}; # List of patterns to match
+ my @options = @{(shift)}; # Options ($warn)
+ my $filename = shift; # This is only used for error messages
+
+ my ($warn) = @options;
+
+ my @regexp = grep(/^\/.*\/$/, @patterns);
+ my @leftpatterns = grep(!/^\/.*\/$/, @patterns);
+ my @filelist = grep(/^#/, @leftpatterns);
+ @leftpatterns = grep(!/^#/, @leftpatterns);
+
+ if (scalar(@leftpatterns) > 0)
+ {
+ foreach my $expression (@leftpatterns)
+ {
+ $log->Error("ERROR: Expression '$expression' not understood (must be /regexp/ or #filename)");
+ }
+ exit($log->getErrorCode());
+ }
+
+ if (scalar(@filelist)>0)
+ {
+ # Prepare list of files to match
+ my $file = shift @filelist;
+ $file =~ s/^#//;
+ my @tomatch = @{readFileList($file) };
+
+ @tomatch = @{removeDuplicates(\@tomatch, 1)}; # Remove extra duplicates
+
+ foreach my $file (@filelist)
+ {
+ $file =~ s/^#//;
+ my @list = @{readFileList($file)};
+
+ @list = @{removeDuplicates(\@list, 1)}; # Remove extra duplicates
+
+ @tomatch = @tomatch, @list;
+ @tomatch = @{keepDuplicates(\@tomatch)}; # Keep only matching files
+ }
+
+ foreach my $regexp (@regexp)
+ {
+ $regexp =~ s/^\/(.*)\/$/\1/;
+ @tomatch = grep(/$regexp/i, @tomatch); # Filter list of files to match
+ }
+
+ # Match files
+ my @match = ();
+ my @nomatch = ();
+ my $lcentry;
+
+ foreach my $entry (@tomatch)
+ {
+ $lcentry = lc($entry);
+ my @matches = grep((lc($_) eq $lcentry), @package);
+
+ if (scalar(@matches) == 0)
+ {
+ push @nomatch, $entry;
+ }
+ elsif (scalar(@matches) == 1)
+ {
+ push @match, $matches[0];
+ }
+ else
+ {
+ die "Fatal error: Failure to clear duplicates\n";
+ }
+ }
+ @package = @match;
+
+ if ($warn)
+ {
+ if (scalar(@nomatch)>0)
+ {
+ my $object;
+
+ if (scalar(@patterns) == 1)
+ {
+ $object="file";
+ }
+ else
+ {
+ $object="rule";
+ }
+
+ $log->Warn("WARNING: ".scalar(@nomatch)." files not matched from $object '".join(" ",@patterns)."'.");
+
+ $log->ListMissing(@nomatch);
+ }
+ }
+
+ if ((scalar(@package) == 0) && (scalar(@tomatch) > 0))
+ {
+ if ($warn)
+ {
+ $log->Warn("WARNING: 0 files matched against rule '".join(" ",@patterns)."' [$filename:$.]");
+ }
+ }
+ }
+ else
+ {
+ # Regexps only
+ foreach my $regexp (@regexp)
+ {
+ $regexp =~ s/^\/(.*)\/$/\1/;
+ @package = grep(/$regexp/i, @package );
+
+ if (scalar(@package) == 0)
+ {
+ last;
+ }
+ }
+ if (scalar(@package) == 0)
+ {
+ if ($warn)
+ {
+ $log->Warn("WARNING: 0 files matched against rule '".join(" ",@patterns)."' [$filename:$.]");
+ }
+ }
+ }
+
+ return \@package;
+ }
+
+
+sub replaceStdVars($)
+ {
+ my $line = $_[0];
+ $line =~ s/(%[^%]*?%)/$stdVars{$1}/gi;
+ return $line;
+ }
+
+
+
+1;