1 #!/usr/bin/perl -w

     2 # Copyright (c) 2009 Symbian Foundation Ltd

     3 # This component and the accompanying materials are made available

     4 # under the terms of the License "Eclipse Public License v1.0"

     5 # which accompanies this distribution, and is available

     6 # at the URL "http://www.eclipse.org/legal/epl-v10.html".

     7 #

     8 # Initial Contributors:

     9 # Symbian Foundation Ltd - initial contribution.

    10 # 

    11 # Contributors:

    12 #

    13 # Description:

    14 # Perl script to clone or update all Foundation repositories based on content of 

    15 # BOM (bill of materials) file provided with a PDK release

    16 

    17 

    18 use strict;

    19 

    20 use XML::DOM ();

    21 use Getopt::Long;

    22 

    23 

    24 my ($help,$verbose,$build_info,$rincoming,$rstatus,$rclean);

    25 my $username="";

    26 my $password="";

    27 my $rclone=1;

    28 

    29 my $opts_err = GetOptions(

    30   "h|help" => \$help,			# print Usage

    31   "b|build-info=s" => \$build_info,		    # build info xml file

    32   "u|user=s" => \$username, # user name when pushing to foundation

    33   "p|password=s" => \$password, # password when pushing to foundation

    34   "status!"=> \$rstatus,     #flag to request hg status for each repo

    35   "incoming!"=>\$rincoming,   #flag to request incoming for each repo from sf repositories

    36   "clean!"=>\$rclean, # flag to request clean the working source tree

    37   "clone!"=>\$rclone, # flag to request clone   

    38   "verbose!" => \$verbose,		#verbosity, currently only on or off (verbose or noverbose)

    39 ) or die ("Error processing options\n\n" . Usage() );

    40 

    41 # check if there were any extra parameters ignored by GetOptions

    42 @ARGV and die ("Input not understood - unrecognised paramters : @ARGV \n\n" . Usage() );

    43 

    44 if ($help)

    45 {

    46     print Usage();

    47     exit;

    48 }

    49 if (! defined ($build_info))

    50 {

    51     die ("Need to specify the BOM file, e.g. -b build-info.xml\n\n".Usage());

    52 }

    53 if (!-f $build_info) {die " Can't find build info file $build_info\n"}

    54 

    55 

    56 if (defined($rincoming) || ($rclone))

    57 {

    58   ## if you are going to try any operations on foundation host need password 

    59   if ($username eq "" || $password eq "")

    60   {

    61     print "Must supply your username and password to talk to Foundation host\n";

    62     exit 1;

    63   }

    64 }

    65 

    66 my ( $parser, $buildinfoxml );

    67 eval

    68 {

    69     $parser = XML::DOM::Parser->new();

    70     $buildinfoxml    = $parser->parsefile($build_info);

    71 };

    72 if ( $@ )

    73 {

    74     print "Fatal XML error processing build info file: $@";

    75 }

    76 my @baseline_entries = $buildinfoxml->getElementsByTagName('baseline');

    77 

    78 foreach my $repository (@baseline_entries)

    79 {

    80 #    print $repository->toString();

    81 

    82     my $baseline = $repository->getFirstChild->getNodeValue;

    83     # e.g. E:/hg_cache/mercurial_master_prod/sfl/MCL/sf/tools/swconfigtools/#2:fa09df6b7e6a

    84     $baseline =~ m/(.*?)#\d*:(.*)$/; 

    85     my $repo_path = $1;      # e.g. E:/hg_cache/mercurial_master_prod/sfl/MCL/sf/tools/swconfigtools/

    86     my $changeset = $2; # e.g fa09df6b7e6a

    87 

    88     $repo_path =~ m/.*?(oss|sfl).(MCL|FCL)(.*$)/;

    89     my $license = $1;

    90     my $codeline =$2;

    91     my $package =$3;

    92     my $sf_repo = "https://$username:$password\@developer.symbian.org/$1/$2$package";

    93     $sf_repo =~ s!\\!\/!g;

    94     my @dirs = split /\//, $package;

    95     my $destdir = pop @dirs;  # ignore the package name, because Mercurial will create that

    96     # Ensure the directories already exist as far as the parent of the repository

    97     my $local_path = "";

    98     foreach my $dir (@dirs)

    99     {

   100       $local_path = ($local_path eq "") ? $dir : "$local_path/$dir";

   101       if (!-d $local_path)

   102       {

   103         mkdir $local_path;

   104       }

   105     }

   106     $local_path .= "/$destdir";   # this is where the repository will go

   107     $local_path =~ s!\\!\/!g;

   108 

   109     if($rclone)

   110     {

   111        if (-d "$local_path/.hg")

   112        {

   113           # The repository already exists, so just do an update

   114           print "Updating $local_path from $sf_repo at changeset $changeset\n";

   115           system("hg", "pull", "-R", $local_path, $sf_repo);

   116           system("hg","-R", $local_path,"update",$changeset);

   117       }

   118       else

   119       {

   120           # hg clone -U    http://«user»:«password»@developer.symbian.org/sfl/MCL/adaptation/stubs/",

   121           print "Cloning $local_path from $sf_repo and update to changeset $changeset \n";

   122           # need to update the working directory otherwise the parent of the tag change create a new head

   123           system("hg", "clone", "--noupdate",$sf_repo, $local_path);

   124           system("hg","-R", $local_path,"update",$changeset);

   125       }

   126     }

   127 

   128     if (-d "$local_path/.hg")

   129     {

   130       if($rincoming)

   131       {

   132           system("hg","-R", $local_path,"incoming",$sf_repo);

   133       }

   134       if($rstatus)

   135       {

   136           print "Identify $local_path ";

   137           system("hg","-R", $local_path, "identify");

   138           system("hg","-R", $local_path, "status");

   139       }

   140       if($rclean)

   141       {

   142         print "Clean $local_path ";

   143         system("hg","-R", $local_path,"update","-C",$changeset);

   144         my @added =`hg -R $local_path status`;

   145         foreach my $addedfile (@added)

   146         {

   147           $addedfile =~ s/\?\s*/\.\/$local_path\//;

   148           $addedfile =~ s!\/!\\!g;

   149           print "del $addedfile\n";

   150        #   system("del", $addedfile);

   151           #unlink($addedfile);       

   152         }

   153       }

   154     }

   155     else

   156     {

   157         print "ERROR: No repository found at $local_path\n";

   158     }

   159 }

   160 

   161 sub Usage

   162 {

   163   return <<"EOF";

   164 Usage: clone_BOM.pl -b <build info file> [-status] [-incoming] [-u <user name> -p <password>] [-verbose]

   165 

   166 Description:

   167 	Clones repositories listed in the build BOM 

   168 	Optionally can display status of local repositories

   169 	and preview of incoming changes from Foundation repos

   170 

   171 Arguments:

   172     -h -> Output this usage message;

   173     -b -> file containing the build info (xml BOM format)

   174     -u -> User name (required if accessing the Foundation repositories)

   175     -p -> Password (required if accessing the Foundation repositories)

   176     -status -> Query hg identify and hg status for each local repo

   177     -incoming -> Query any incoming changes from the Foundation host

   178     -clean -> clean the local source tree (n.b. removes local files not committed to mercurial)

   179     -noclone -> skip the clone repositories step

   180     -verbose -> more debug statements (optional, default off)

   181 EOF

   182 }