Fix Bug 387 - full newline processing as per "perlport" guidance
Removed clone_BOM.pl as the functionality is now all in clone_all_packages.pl
Updated convert_to_eula.pl for revised license notice.
--- a/clone_BOM.pl Tue Sep 22 17:01:01 2009 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,182 +0,0 @@
-#!/usr/bin/perl -w
-# Copyright (c) 2009 Symbian Foundation Ltd
-# This component and the accompanying materials are made available
-# under the terms of the License "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:
-# Symbian Foundation Ltd - initial contribution.
-#
-# Contributors:
-#
-# Description:
-# Perl script to clone or update all Foundation repositories based on content of
-# BOM (bill of materials) file provided with a PDK release
-
-
-use strict;
-
-use XML::DOM ();
-use Getopt::Long;
-
-
-my ($help,$verbose,$build_info,$rincoming,$rstatus,$rclean);
-my $username="";
-my $password="";
-my $rclone=1;
-
-my $opts_err = GetOptions(
- "h|help" => \$help, # print Usage
- "b|build-info=s" => \$build_info, # build info xml file
- "u|user=s" => \$username, # user name when pushing to foundation
- "p|password=s" => \$password, # password when pushing to foundation
- "status!"=> \$rstatus, #flag to request hg status for each repo
- "incoming!"=>\$rincoming, #flag to request incoming for each repo from sf repositories
- "clean!"=>\$rclean, # flag to request clean the working source tree
- "clone!"=>\$rclone, # flag to request clone
- "verbose!" => \$verbose, #verbosity, currently only on or off (verbose or noverbose)
-) or die ("Error processing options\n\n" . Usage() );
-
-# check if there were any extra parameters ignored by GetOptions
-@ARGV and die ("Input not understood - unrecognised paramters : @ARGV \n\n" . Usage() );
-
-if ($help)
-{
- print Usage();
- exit;
-}
-if (! defined ($build_info))
-{
- die ("Need to specify the BOM file, e.g. -b build-info.xml\n\n".Usage());
-}
-if (!-f $build_info) {die " Can't find build info file $build_info\n"}
-
-
-if (defined($rincoming) || ($rclone))
-{
- ## if you are going to try any operations on foundation host need password
- if ($username eq "" || $password eq "")
- {
- print "Must supply your username and password to talk to Foundation host\n";
- exit 1;
- }
-}
-
-my ( $parser, $buildinfoxml );
-eval
-{
- $parser = XML::DOM::Parser->new();
- $buildinfoxml = $parser->parsefile($build_info);
-};
-if ( $@ )
-{
- print "Fatal XML error processing build info file: $@";
-}
-my @baseline_entries = $buildinfoxml->getElementsByTagName('baseline');
-
-foreach my $repository (@baseline_entries)
-{
-# print $repository->toString();
-
- my $baseline = $repository->getFirstChild->getNodeValue;
- # e.g. E:/hg_cache/mercurial_master_prod/sfl/MCL/sf/tools/swconfigtools/#2:fa09df6b7e6a
- $baseline =~ m/(.*?)#\d*:(.*)$/;
- my $repo_path = $1; # e.g. E:/hg_cache/mercurial_master_prod/sfl/MCL/sf/tools/swconfigtools/
- my $changeset = $2; # e.g fa09df6b7e6a
-
- $repo_path =~ m/.*?(oss|sfl).(MCL|FCL)(.*$)/;
- my $license = $1;
- my $codeline =$2;
- my $package =$3;
- my $sf_repo = "https://$username:$password\@developer.symbian.org/$1/$2$package";
- $sf_repo =~ s!\\!\/!g;
- my @dirs = split /\//, $package;
- my $destdir = pop @dirs; # ignore the package name, because Mercurial will create that
- # Ensure the directories already exist as far as the parent of the repository
- my $local_path = "";
- foreach my $dir (@dirs)
- {
- $local_path = ($local_path eq "") ? $dir : "$local_path/$dir";
- if (!-d $local_path)
- {
- mkdir $local_path;
- }
- }
- $local_path .= "/$destdir"; # this is where the repository will go
- $local_path =~ s!\\!\/!g;
-
- if($rclone)
- {
- if (-d "$local_path/.hg")
- {
- # The repository already exists, so just do an update
- print "Updating $local_path from $sf_repo at changeset $changeset\n";
- system("hg", "pull", "-R", $local_path, $sf_repo);
- system("hg","-R", $local_path,"update",$changeset);
- }
- else
- {
- # hg clone -U http://«user»:«password»@developer.symbian.org/sfl/MCL/adaptation/stubs/",
- print "Cloning $local_path from $sf_repo and update to changeset $changeset \n";
- # need to update the working directory otherwise the parent of the tag change create a new head
- system("hg", "clone", "--noupdate",$sf_repo, $local_path);
- system("hg","-R", $local_path,"update",$changeset);
- }
- }
-
- if (-d "$local_path/.hg")
- {
- if($rincoming)
- {
- system("hg","-R", $local_path,"incoming",$sf_repo);
- }
- if($rstatus)
- {
- print "Identify $local_path ";
- system("hg","-R", $local_path, "identify");
- system("hg","-R", $local_path, "status");
- }
- if($rclean)
- {
- print "Clean $local_path ";
- system("hg","-R", $local_path,"update","-C",$changeset);
- my @added =`hg -R $local_path status`;
- foreach my $addedfile (@added)
- {
- $addedfile =~ s/\?\s*/\.\/$local_path\//;
- $addedfile =~ s!\/!\\!g;
- print "del $addedfile\n";
- # system("del", $addedfile);
- #unlink($addedfile);
- }
- }
- }
- else
- {
- print "ERROR: No repository found at $local_path\n";
- }
-}
-
-sub Usage
-{
- return <<"EOF";
-Usage: clone_BOM.pl -b <build info file> [-status] [-incoming] [-u <user name> -p <password>] [-verbose]
-
-Description:
- Clones repositories listed in the build BOM
- Optionally can display status of local repositories
- and preview of incoming changes from Foundation repos
-
-Arguments:
- -h -> Output this usage message;
- -b -> file containing the build info (xml BOM format)
- -u -> User name (required if accessing the Foundation repositories)
- -p -> Password (required if accessing the Foundation repositories)
- -status -> Query hg identify and hg status for each local repo
- -incoming -> Query any incoming changes from the Foundation host
- -clean -> clean the local source tree (n.b. removes local files not committed to mercurial)
- -noclone -> skip the clone repositories step
- -verbose -> more debug statements (optional, default off)
-EOF
-}
\ No newline at end of file
--- a/clone_packages/clone_all_packages.pl Tue Sep 22 17:01:01 2009 +0100
+++ b/clone_packages/clone_all_packages.pl Wed Sep 23 17:01:55 2009 +0100
@@ -290,6 +290,7 @@
foreach my $line (<PKG_LIST>)
{
chomp($line);
+ $line =~ s/\015//g; # remove CR, in case we are processing Windows text files on Linux
my $revision; # set when processing build-info listings
--- a/williamr/convert_to_eula.pl Tue Sep 22 17:01:01 2009 +0100
+++ b/williamr/convert_to_eula.pl Wed Sep 23 17:01:55 2009 +0100
@@ -21,6 +21,17 @@
my $debug = 0;
+my @oldtext = (
+ 'terms of the License "Symbian Foundation License v1.0"',
+ 'the URL "http://www.symbianfoundation.org/legal/sfl-v10.html"'
+);
+my @newtext = (
+ 'terms of the License "Symbian Foundation License v1.0" to members and "Symbian Foundation End User License Agreement v1.0" to non-members',
+ 'the URL "http://www.symbianfoundation.org/legal/licencesv10.html"'
+);
+
+my @errorfiles = ();
+
sub map_eula($$$)
{
my ($file,$shadowdir,$name) = @_;
@@ -32,26 +43,34 @@
my $updated = 0;
my @newlines = ();
while (my $line = shift @lines)
- {
+ {
+ if (index($line,$newtext[0]) >= 0)
+ {
+ # file already converted - nothing to do
+ last;
+ }
# under the terms of the License "Symbian Foundation License v1.0"
# which accompanies this distribution, and is available
# at the URL "http://www.symbianfoundation.org/legal/sfl-v10.html".
- if ($line =~ /terms of the License "Symbian Foundation License v1.0"/)
+ my $pos1 = index $line, $oldtext[0];
+ if ($pos1 >= 0)
{
my $midline = shift @lines;
- my $nextline = shift @lines;
- if ($nextline =~ /the URL "http:\/\/www.symbianfoundation.org\/legal\/sfl-v10.html"/)
+ my $urlline = shift @lines;
+ my $pos2 = index $urlline, $oldtext[1];
+ if ($pos2 >= 0)
{
# Found it - assume that there's only one instance
- $line =~ s/Symbian Foundation License v1.0/Symbian End User License v1.0/;
- $nextline =~ s/legal\/sfl-v10.html/legal\/eula-v10.html/;
- push @newlines, $line, $midline, $nextline, @lines;
+ substr $line, $pos1, length($oldtext[0]), $newtext[0];
+ substr $urlline, $pos2, length($oldtext[1]), $newtext[1];
+ push @newlines, $line, $midline, $urlline;
$updated = 1;
last;
}
else
{
- print STDERR "Problem in $file: incorrectly formatted >\n$line$nextline\n";
+ print STDERR "Problem in $file: incorrectly formatted >\n$line$midline$urlline\n";
+ push @errorfiles, $file;
last;
}
}
@@ -63,7 +82,7 @@
mkpath($shadowdir, {verbose=>0});
move($file, "$shadowdir/$name") or die("Cannot move $file to $shadowdir/$name: $!\n");
open NEWFILE, ">$file" or die("Cannot overwrite $file: $!\n");
- print NEWFILE @newlines;
+ print NEWFILE @newlines, @lines;
close NEWFILE or die("Failed to update $file: $!\n");
print "* updated $file\n";
}
@@ -95,3 +114,7 @@
}
scan_directory("/epoc32", "/sfl_epoc32");
+
+printf "%d problem files\n", scalar @errorfiles;
+print "\t", join("\n\t", @errorfiles), "\n";
+