Fix Bug 387 - full newline processing as per "perlport" guidance
authorWilliam Roberts <williamr@symbian.org>
Wed, 23 Sep 2009 17:01:55 +0100
changeset 60 e86c659b78a0
parent 59 69e9b8ca3ae9
child 61 3efaaf387e1a
child 85 f1dc34daa946
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.
clone_BOM.pl
clone_packages/clone_all_packages.pl
williamr/convert_to_eula.pl
--- 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";
+