# HG changeset patch
# User William Roberts <williamr@symbian.org>
# Date 1245767516 -3600
# Node ID 319764718a57780c2c3ef9527c7d19e89ba1f548
# Parent  ccca325104053c595e6e8ff677681ff0468d548d
Add proper usage and more options (Bug 80). Add prototype screen-scraping to read repository list.

diff -r ccca32510405 -r 319764718a57 clone_all_packages.pl
--- a/clone_all_packages.pl	Tue Jun 23 12:00:58 2009 +0100
+++ b/clone_all_packages.pl	Tue Jun 23 15:31:56 2009 +0100
@@ -15,27 +15,86 @@
 # Perl script to clone or update all of the Foundation MCL repositories
 
 use strict;
+use Getopt::Long;
+
+sub Usage($)
+  {
+  my ($msg) = @_;
+  
+  print "$msg\n\n" if ($msg ne "");
+  
+	print <<'EOF';
+clone_all_repositories - simple script for cloning Symbian repository tree
+	
+This script will clone repositories, or pull changes into a previously
+cloned repository. The script will prompt for your username and
+password, which will be needed to access the SFL repositories, or you can
+supply them with command line arguments.
+
+Important: 
+  This script uses https access to the repositories, so the username and
+  password will be stored as cleartext in the .hg/hgrc file for each repository.
+
+Used with the "-mirror" option, the script will copy both MCL and FCL
+repositories into the same directory layout as the Symbian website, and will
+use the Mercurial "--noupdate" option when cloning.
+
+Options:
+
+-username      username at the Symbian website
+-password      password to go with username
+-mirror        create a "mirror" of the Symbian repository tree
+-retries       number of times to retry a failed operation (default 1)
+-verbose       print the underlying "hg" commands before executing them
+-n             do nothing - don't actually execute the hg commands
+-help          print this help information
+
+EOF
+  exit (1);  
+  }
 
 my @clone_options = (); # use ("--noupdate") to clone without extracting the source
 my @pull_options  = (); # use ("--rebase") to rebase your changes when pulling
 my $hostname = "developer.symbian.org";
+
+my $username = "";
+my $password = "";
 my $mirror = 0; # set to 1 if you want to mirror the repository structure
 my $retries = 1;  # number of times to retry problem repos
+my $verbose = 0;  # turn on more tracing
+my $do_nothing = 0; # print the hg commands, don't actually do them
+my $help = 0;
+
+if (!GetOptions(
+    "u|username" => \$username,
+    "p|password" => \$password,
+    "m|mirror" => \$mirror, 
+    "r|retries=i" => \$retries,
+    "v|verbose" => \$verbose,
+    "n" => \$do_nothing,
+    "h|help" => \$help,
+    ))
+  {
+  Usage("Invalid argument");
+  }
+  
+Usage("Too many arguments") if ($ARGV);
+Usage("") if ($help);
 
 # Important: This script uses http access to the repositories, so
 # the username and password will be stored as cleartext in the
 # .hg/hgrc file in each repository.
 
-my $username = "";
-my $password = "";
-
-if ($username eq "" || $password eq "")
+if ($username eq "" )
   {
   print "Username: ";
   $username = <STDIN>;
+  chomp $username;
+  }
+if ($password eq "" )
+  {
   print "Password: ";
   $password = <STDIN>;
-  chomp $username;
   chomp $password;
   }
 
@@ -212,6 +271,19 @@
 "oss/MCL/utilities",
 );
 
+sub do_system(@)
+  {
+  my (@cmd) = @_;
+  
+  if ($verbose)
+    {
+    print "* ", join(" ", @cmd), "\n";
+    }
+  return 0 if ($do_nothing);
+  
+  return system(@cmd);
+  }
+
 sub get_repo($)
   {
   my ($package) = @_;
@@ -252,14 +324,14 @@
     # The repository already exists, so just do an update
     
     print "Updating $destdir from $package...\n";
-    return system("hg", "pull", @pull_options, "-R", $path, $repo_url);
+    return do_system("hg", "pull", @pull_options, "-R", $path, $repo_url);
     }
   else
     {
     # Clone the repository
     
     print "Cloning $destdir from $package...\n";
-    return system("hg", "clone", @clone_options, $repo_url, $path);
+    return do_system("hg", "clone", @clone_options, $repo_url, $path);
     }
   
   }
@@ -271,6 +343,61 @@
 if ($mirror)
   {
   push @clone_options, "--noupdate";
+  
+  if (0)
+    {
+    # Prototype code to scrape the repository list from the website
+    # Needs to have extra modules and executables installed to support https
+    # so this would only work for the oss packages at present...
+    
+    # Create a user agent object
+    use LWP::UserAgent;
+    use HTTP::Request::Common;
+    my $ua = LWP::UserAgent->new;
+    $ua->agent("clone_all_packages.pl ");
+  
+    # Request the oss package list
+    my $res = $ua->request(GET "http://$hostname/oss");
+  
+    # Check the outcome of the response
+    if (! $res->is_success) 
+      {
+      print "Failed to read oss package list:\n\t", $res->status_line, "\n";
+      }
+    
+    my @oss_packages = ($res->content =~ m/<td><a href="\/(oss\/[^"]+)\/?">/g);  # umatched "
+    print join ("\n\t",@oss_packages), "\n";
+
+    # Request the oss package list
+    $res = $ua->request(GET "https://$username:$password\@$hostname/sfl");
+  
+    # Check the outcome of the response
+    if (! $res->is_success) 
+      {
+      print "Failed to read sfl package list:\n\t", $res->status_line, "\n";
+      }
+    
+    my @sfl_packages = ($res->content =~ m/<td><a href="\/(sfl\/[^"]+)\/?">/g);  # umatched "
+    
+    @all_packages = (@sfl_packages, @oss_packages);
+    }
+  else
+    {
+    # Assume that every MCL has a matching FCL
+    my @list_with_fcls = ();
+    foreach my $package (@all_packages)
+      {
+      push @list_with_fcls, $package;
+      if ($package =~ /MCL/)
+        {
+        # If mirroring, get the matching FCLs as well as MCLs
+        $package =~ s/MCL/FCL/;
+        push @list_with_fcls, $package;
+        }
+      }
+    @all_packages = @list_with_fcls;
+    }
+
   }
 
 my @problem_packages = ();
@@ -281,22 +408,18 @@
   my $err = get_repo($package);
   $total_packages++;
   push @problem_packages, $package if ($err); 
-  
-  if ($mirror && $package =~ /MCL/)
-    {
-    # If mirroring, get the matching FCLs as well as MCLs
-    $package =~ s/MCL/FCL/;
-    $err = get_repo($package);
-    $total_packages++;
-    push @problem_packages, $package if ($err); 
-    }
   }
   
 # retry problem packages
 
-while ($retries > 0 && scalar @problem_packages) 
+my $attempt = 0;
+while ($attempt < $retries && scalar @problem_packages) 
   {
-  $retries --;
+  $attempt++;
+  printf "\n\n------------\nRetry attempt %d on %d packages\n",
+    $attempt, scalar @problem_packages;
+  print join("\n", @problem_packages, ""), "\n";
+    
   my @list = @problem_packages;
   @problem_packages = ();
   foreach my $package (@list)