summaryrefslogtreecommitdiffstats
path: root/src/build/tools/perl.modules
diff options
context:
space:
mode:
authorStephen Cprek <smcprek@us.ibm.com>2015-12-18 14:40:51 -0600
committerStephen Cprek <smcprek@us.ibm.com>2016-02-19 17:06:05 -0600
commit875b7b11041874bd1f4ca2ecf595f14652cbdac8 (patch)
tree1d2de55ed2df6a7a8de8f606d1ce96faef012638 /src/build/tools/perl.modules
parent3fd70a51b397987f839af987287f5afbb2fc087f (diff)
downloadtalos-hostboot-875b7b11041874bd1f4ca2ecf595f14652cbdac8.tar.gz
talos-hostboot-875b7b11041874bd1f4ca2ecf595f14652cbdac8.zip
Copy ekb tools and modules into hostboot
Change-Id: I4bb4fbd339e373fa15e2de15810f18421a9006f3 Reviewed-on: http://gfw160.aus.stglabs.ibm.com:8080/gerrit/22911 Tested-by: Jenkins Server Reviewed-by: Daniel M. Crowell <dcrowell@us.ibm.com>
Diffstat (limited to 'src/build/tools/perl.modules')
-rwxr-xr-xsrc/build/tools/perl.modules/GerritUtil.pm517
-rwxr-xr-xsrc/build/tools/perl.modules/GitUtil.pm836
-rw-r--r--src/build/tools/perl.modules/ToolInit.pm96
3 files changed, 1449 insertions, 0 deletions
diff --git a/src/build/tools/perl.modules/GerritUtil.pm b/src/build/tools/perl.modules/GerritUtil.pm
new file mode 100755
index 000000000..5dcd936bc
--- /dev/null
+++ b/src/build/tools/perl.modules/GerritUtil.pm
@@ -0,0 +1,517 @@
+# IBM_PROLOG_BEGIN_TAG
+# This is an automatically generated prolog.
+#
+# $Source: src/build/tools/perl.modules/GerritUtil.pm $
+#
+# OpenPOWER HostBoot Project
+#
+# Contributors Listed Below - COPYRIGHT 2015
+# [+] International Business Machines Corp.
+#
+#
+# Licensed under the Apache License, Version 2.0 (the "License");
+# you may not use this file except in compliance with the License.
+# You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing, software
+# distributed under the License is distributed on an "AS IS" BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or
+# implied. See the License for the specific language governing
+# permissions and limitations under the License.
+#
+# IBM_PROLOG_END_TAG
+package GerritUtil;
+
+use strict;
+use Data::Dumper;
+# Include custom modules
+use lib "$ENV{'PERLMODULES'}";
+use ToolInit;
+use GitUtil;
+
+# Grab initial globals from ToolInit module
+my %globals = init_globals();
+
+######################## Begin Gerrit Utility Subroutines ######################
+
+# sub push
+#
+# Push commits in local git repository to gerrit server
+#
+# @param[in] i_git_root - The root of the local git repository.
+# @param[in] i_remote - Remote to push to.
+#
+sub push
+{
+ my ($i_git_root, $i_remote) = @_;
+ chdir($i_git_root);
+
+ system("git push $i_remote HEAD:refs/for/master");
+ die ("$?") if ($?);
+}
+
+# sub is_patch
+#
+# Determines if a patch identifier is a Gerrit patch or not.
+#
+# @param[in] i_patch - The patch to make determination about.
+#
+# @retval true - Patch is a Gerrit patch ID.
+# @retval false - Patch does not appear to be a Gerrit patch ID.
+sub is_patch
+{
+ my $i_patch = shift;
+ chomp($i_patch);
+ return 1 if ($i_patch =~ m/I[0-9a-f]+/);
+ return 0;
+}
+
+# sub resolve_patch
+#
+# Resolves gerrit patch IDs to git commit numbers and ensures the git
+# commits are fetched from the gerrit server.
+#
+# Any git commit number is left unchanged.
+#
+# @param[in] i_git_root - The root of the local git repository.
+# @param[in] i_remote - Remote to fetch from.
+# @param[in] i_patch - Patche to fetch.
+# @param[in] i_patchset - Patchset to fetch. [0 or blank to get currentPatchSet]
+#
+# @return string - git commit number.
+#
+sub resolve_patch
+{
+ my ($i_git_root, $i_remote, $i_patch, $i_patchset) = @_;
+ my $result = "";
+
+ if (is_patch($i_patch))
+ {
+ # If latest wanted patchset <=0 or no patchset specified
+ if($i_patchset <= 0 || $i_patchset eq "")
+ {
+ my $patch_info = query_current_patchset($i_patch);
+ GitUtil::fetch($i_git_root, $i_remote,
+ $patch_info->{currentPatchSet}->{ref});
+ $result = $patch_info->{currentPatchSet}->{revision};
+ }
+ # Patchset specified
+ else
+ {
+ my $patch_info = query_patchsets($i_patch);
+ # Fail if patchset DNE
+ if ($i_patchset > $patch_info->{currentPatchSet}->{number})
+ {
+ die "$i_patch does not have patch number $i_patchset";
+ }
+ # JSON creates array of patchSets in number order
+ my $index = $i_patchset - 1;
+ GitUtil::fetch($i_git_root, $i_remote,
+ $patch_info->{patchSets}[$index]->{ref});
+ $result = $patch_info->{patchSets}[$index]->{revision};
+ }
+ }
+ else
+ {
+ $result = $i_patch;
+ }
+
+ return $result;
+}
+
+# sub query
+#
+# Performs a gerrit query and parses the resulting JSON.
+#
+# @param[in] i_query - The query to perform.
+#
+# @return array - A list of items from the JSON query. Each item is a
+# hash (key-value pair) for the item attributes.
+#
+sub query
+{
+ my $i_query = shift;
+
+ my @items = ();
+
+ open COMMAND, ssh_command()." query $i_query --current-patch-set".
+ " --format=JSON |";
+ while (my $line = <COMMAND>)
+ {
+ chomp $line;
+ push @items, json_parse($line);
+ }
+
+ return \@items;
+}
+
+# sub query_commit
+#
+# Performs a gerrit query on a specific change-id or commit, can retrieve all
+# or only current patchset via $patch_sets parameter.
+#
+# @param[in] commit - The commit to query.
+# @param[in] project - The project to query [optional]
+# @param[in] branch - The branch in the project to query [optional]
+# @param[in] patch_set - Indicate patchset is not the currentPatchSet [optional]
+#
+# @return hash - The parsed JSON for the queried commit.
+#
+sub query_commit
+{
+ my ($commit, $project, $branch, $patch_set) = @_;
+
+ $project = $globals{gerrit_project} if ($project eq "");
+ $branch = $globals{branch} if ($branch eq "");
+
+ # Get all patchsets, default no. This is important for performance.
+ my $patch_sets = "";
+ $patch_sets = "--patch-sets" if($patch_set == 1);
+
+ # If --patch-sets and --current-patch-set flags are combined then the
+ # current patch set information will be output twice, once in each field.
+ my $query_result = query("$commit project:$project branch:$branch $patch_sets");
+ foreach my $result (@{$query_result})
+ {
+ if ($result->{id} eq $commit ||
+ $result->{currentPatchSet}->{revision} =~ m/$commit/)
+ {
+ return $result;
+ }
+ }
+
+ die "Cannot find $commit in $project:$branch";
+}
+
+# sub ssh_command
+#
+# Creates a properly formed ssh command based on the server address.
+#
+# @return string - The basic ssh command to connect to the server.
+#
+sub ssh_command
+{
+ my $server = $globals{remote_server};
+ my $port = "";
+
+ if ($server =~ m/.*:.*/)
+ {
+ $port = $server;
+ $server =~ s/(.*):.*/$1/;
+ $port =~ s/.*:(.*)/$1/;
+
+ $port = "-p $port";
+ }
+
+ return "ssh -qx $port $server gerrit";
+}
+
+# sub current_patchset
+#
+# Get current patchset number of changd-id
+#
+# @param[in] i_patch - Change-id to get current patchset of.
+#
+# @return string - Number of currentPatchset
+#
+sub current_patchset
+{
+ my $i_patch = shift;
+
+ die "Patch is not of type changd-id" if (!is_patch($i_patch));
+ my $patch_info = query_current_patchset($i_patch);
+
+ return $patch_info->{currentPatchSet}->{number};
+}
+
+# sub query_current_patchset
+#
+# Get current patchset info of a commit or change-id
+#
+# @param[in] i_commit - Change-id to get current patchset of.
+#
+# @return hash - The parsed JSON for the commit, only current patchset.
+#
+sub query_current_patchset
+{
+ my ($commit, $project, $branch) = @_;
+
+ # Pass in 0 as last parameter to query only current patchset
+ return query_commit($commit,$project,$branch,0);
+}
+
+# sub query_patchsets
+#
+# Get every patch set's info of a commit or change-id
+#
+# @param[in] i_commit - Change-id to get current patchset of.
+#
+# @return hash - The parsed JSON for the commit, containing all patchsets
+#
+sub query_patchsets
+{
+ my ($commit, $project, $branch) = @_;
+
+ # Pass in 1 as last parameter to query all patchsets
+ return query_commit($commit,$project,$branch,1);
+}
+# sub retrieve_change_ids
+#
+# Get the change Id associated with the commit
+#
+# @param[in] i_commit - The commit to examine.
+#
+# @return @Ids - The array of change Ids
+#
+sub retrieve_change_ids
+{
+ my $i_commit = shift;
+ my @Ids;
+ my $message = GitUtil::commit_msg($i_commit);
+ if ($message =~ m/Change-Id:\s*(I[0-9a-z]+)/)
+ {
+ push @Ids, $1;
+ }
+ if ($message =~ m/Original-Change-Id:\s*(I[0-9a-z]+)/)
+ {
+ push @Ids, $1;
+ }
+ if($#Ids < 0)
+ {
+ die "\nERROR: Invalid Commit, cannot get the Change ID\n";
+ }
+ return @Ids;
+}
+
+#################### Begin Gerrit JSON Utility Subroutines #####################
+
+# sub json_parse
+#
+# Parse a line of JSON into an hash-object.
+#
+# @param[in] line - The JSON content.
+#
+# @return hash - The parsed object.
+#
+# @note There are perl modules for doing this but they are not installed on
+# the pool machines. The parsing for JSON (at least the content from
+# the Gerrit server) isn't so bad...
+#
+sub json_parse
+{
+ my $line = shift;
+
+ die "Invalid JSON format: $line" unless ($line =~ m/^\{.*\}$/);
+ $line =~ s/^\{(.*)}$/$1/;
+
+ my %object = ();
+
+ while($line ne "")
+ {
+ my $key;
+ my $value;
+
+ ($key, $line) = json_get_string($line);
+ $key =~ s/^"(.*)"$/$1/;
+
+ $line =~ s/^://;
+ if ($line =~ m/^"/)
+ {
+ ($value, $line) = json_get_string($line);
+ $value =~ s/^"(.*)"$/$1/;
+ }
+ elsif ($line =~ m/^{/)
+ {
+ ($value, $line) = json_get_object($line);
+ $value = json_parse($value);
+ }
+ elsif ($line =~ m/^\[/)
+ {
+ ($value, $line) = json_get_array($line);
+ $value = json_parse_array($value);
+ }
+ else
+ {
+ $line =~ s/([^,]*)//;
+ $value = $1;
+ }
+
+ $object{$key} = $value;
+ }
+
+ return \%object;
+}
+
+# sub json_parse_array
+#
+# Utility function for json_parse.
+#
+sub json_parse_array
+{
+ my $line = shift;
+
+ $line =~ s/^\[(.*)\]$/$1/;
+
+ my @array = ();
+
+ while ($line ne "")
+ {
+ my $value;
+
+ if ($line =~ m/^"/)
+ {
+ ($value, $line) = json_get_string($line);
+ $value =~ s/^"(.*)"$/$1/;
+ }
+ elsif ($line =~ m/^\{/)
+ {
+ ($value, $line) = json_get_object($line);
+ $value = json_parse($value);
+ }
+ elsif ($line =~ m/^\[/)
+ {
+ ($value, $line) = json_get_array($line);
+ $value = json_parse_array($value);
+ }
+ else
+ {
+ $line =~ s/([^,]*)//;
+ $value = $1;
+ }
+
+ push @array, $value;
+ $line =~ s/^,//;
+ }
+
+ return \@array;
+}
+
+# sub json_get_string
+#
+# Utility function for json_parse.
+#
+sub json_get_string
+{
+ my $line = shift;
+
+ $line =~ /("[^"]*")(.*)/;
+ my $first = $1;
+ my $second = $2;
+
+ if ($first =~ m/\\"$/)
+ {
+ my ($more, $rest) = json_get_string($second);
+ return ($first.$more , $rest);
+ }
+ else
+ {
+ return ($first, $second);
+ }
+}
+
+# sub json_get_object
+#
+# Utility function for json_parse.
+#
+sub json_get_object
+{
+ my $line = shift;
+
+ $line =~ s/^{//;
+ my $object = "{";
+ my $frag = "";
+
+ my $found_object = 0;
+
+ until ((not $found_object) && ($object =~ m/}$/))
+ {
+ $found_object = 0;
+
+ if ($line =~ m/^\{/)
+ {
+ ($frag, $line) = json_get_object($line);
+ $object = $object.$frag;
+ $found_object = 1;
+ }
+ elsif ($line =~ m/^"/)
+ {
+ ($frag, $line) = json_get_string($line);
+ $object = $object.$frag;
+ }
+ elsif ($line =~ m/^\[/)
+ {
+ ($frag, $line) = json_get_array($line);
+ $object = $object.$frag;
+ }
+ elsif ($line =~ m/^[:,}]/)
+ {
+ $line =~ s/^([:,}])//;
+ $frag = $1;
+ $object = $object.$frag;
+ }
+ else
+ {
+ $line =~ s/([^,}]*)//;
+ $frag = $1;
+ $object = $object.$frag;
+ }
+ }
+
+ return ($object, $line);
+}
+
+# sub json_get_array
+#
+# Utility function for json_parse.
+#
+sub json_get_array
+{
+ my $line = shift;
+
+ $line =~ s/^\[//;
+ my $array = "[";
+ my $frag = "";
+
+ my $found_array = 0;
+
+ until ((not $found_array) && ($array =~ m/]$/))
+ {
+ $found_array = 0;
+
+ if ($line =~ m/^\[/)
+ {
+ ($frag, $line) = json_get_array($line);
+ $array = $array.$frag;
+ $found_array;
+ }
+ elsif ($line =~ m/^\{/)
+ {
+ ($frag, $line) = json_get_object($line);
+ $array = $array.$frag;
+ }
+ elsif ($line =~ m/^"/)
+ {
+ ($frag, $line) = json_get_string($line);
+ $array = $array.$frag;
+ }
+ elsif ($line =~ m/^[:,\]]/)
+ {
+ $line =~ s/^([:,\]])//;
+ $frag = $1;
+ $array = $array.$frag;
+ }
+ else
+ {
+ $line =~ s/([^,]*)//;
+ $frag = $1;
+ $array = $array.$frag;
+ }
+ }
+
+ return ($array, $line);
+}
+
+# Perl module must return true value
+1;
diff --git a/src/build/tools/perl.modules/GitUtil.pm b/src/build/tools/perl.modules/GitUtil.pm
new file mode 100755
index 000000000..7c7dc8005
--- /dev/null
+++ b/src/build/tools/perl.modules/GitUtil.pm
@@ -0,0 +1,836 @@
+# IBM_PROLOG_BEGIN_TAG
+# This is an automatically generated prolog.
+#
+# $Source: src/build/tools/perl.modules/GitUtil.pm $
+#
+# OpenPOWER HostBoot Project
+#
+# Contributors Listed Below - COPYRIGHT 2015
+# [+] International Business Machines Corp.
+#
+#
+# Licensed under the Apache License, Version 2.0 (the "License");
+# you may not use this file except in compliance with the License.
+# You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing, software
+# distributed under the License is distributed on an "AS IS" BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or
+# implied. See the License for the specific language governing
+# permissions and limitations under the License.
+#
+# IBM_PROLOG_END_TAG
+package GitUtil;
+
+use strict;
+use Data::Dumper;
+use Switch;
+use Cwd;
+use List::Util 'max';
+# Include custom modules
+use lib "$ENV{'PERLMODULES'}";
+use ToolInit;
+use GerritUtil;
+
+# Grab initial globals from ToolInit module
+my %globals = init_globals;
+
+######################## Begin Git Utility Subroutines #########################
+
+# sub remote
+#
+# Gets the remote name of the specified project in a local git repostiory
+#
+# @param[in] git_root - The root of the local git repository.
+# @param[in] project - The project desired relative to the remote base.
+#
+# @return string - Remote name that matches project for local repository.
+#
+sub remote
+{
+ my ($i_git_root, $i_project) = @_;
+ chdir($i_git_root);
+ my $o_remote = "";
+
+ # Get all remotes in local repo
+ my @remotes = split('\n', `git remote`);
+
+ die ("Git remotes not found in $i_git_root") if (!@remotes);
+
+ # Search local remotes for correct project
+ foreach my $remote (@remotes)
+ {
+ my $url = `git config --get remote.$remote.url`;
+ chomp $url;
+
+ die "Undefined git-remote '$remote'" if ($url eq "");
+ die "Unexpected url found: $url" if (not ($url =~ m/ssh:\/\/.*\/.*/));
+
+ # Only care about urls that match the specified remote server
+ die "remote server not defined" if (!defined $globals{remote_server});
+ next if ($url !~ m/$globals{remote_server}/);
+
+ my $project = $url;
+ $project =~ s/ssh:\/\/$globals{remote_server}\///;
+
+ if ($i_project eq $project)
+ {
+ $o_remote = $remote;
+ }
+ }
+
+ die ("$i_project not found in remotes in $i_git_root") if ($o_remote eq "");
+ return $o_remote;
+}
+
+# sub root
+#
+# Determines the path of the root of the git repository.
+#
+# @return string - Root of the git repository.
+#
+sub root
+{
+ open COMMAND, "git rev-parse --show-toplevel |";
+ my $root = <COMMAND>;
+ close COMMAND;
+ chomp $root;
+
+ die "Unable to determine git_root" if ($root eq "");
+ print "Found git_root at $root\n" if $debug;
+
+ return $root;
+}
+
+# sub clone
+#
+# Clones git repository specified into git directory
+#
+# @param[in] i_location - Location to clone into
+# @param[in] i_project - Project to clone, relative to gerrit server
+# @param[in] i_dir - Directory to clone to, overriding default name
+#
+sub clone
+{
+ my ($i_location, $i_project, $i_dir) = @_;
+ chdir($i_location);
+
+ # Check if caller provides full url for i_project
+ if ($i_project =~ m/ssh:\/\//)
+ {
+ system("git clone $i_project $i_dir -q");
+ die ("$?") if ($?);
+ }
+ else
+ {
+ die "remote server not defined" if (!defined $globals{remote_server});
+ system("git clone ssh://$globals{remote_server}/$i_project $i_dir -q");
+ die ("$?") if ($?);
+ }
+}
+
+use constant
+{
+ STAGED => 1,
+ NOT_STAGED => 2,
+ TRACKED => 3,
+ UNTRACKED => 4,
+};
+
+# sub status
+#
+# Run git status command to check state of git repoistory passed in
+#
+# See git status --help for info on porcelain format
+#
+# @param[in] i_git_root - The root of the git repository to check.
+# @param[in] i_status - Type of status to check for
+#
+sub status
+{
+ my ($i_git_root, $i_status) = @_;
+ chdir($i_git_root);
+ my $num = 0;
+
+ # Shorten lines below
+ my $git_cmd = "git status --porcelain 2>/dev/null|";
+ switch ($i_status)
+ {
+ case (STAGED)
+ {
+ # Get number of file changes staged for commit
+ $num = `$git_cmd egrep "^(M|A|D|R|C)" | wc -l`;
+ }
+ case (NOT_STAGED)
+ {
+ # Get number of file changes not staged for commit
+ $num = `$git_cmd egrep "^(\\\?\\\?| M| D)" | wc -l`;
+ }
+ case (TRACKED)
+ {
+ # Get number of tracked changes, staged and not staged
+ $num = `$git_cmd egrep "^(M| M|D| D|R)" | wc -l`;
+ }
+ case (UNTRACKED)
+ {
+ # Get number of untracked files, staged and not staged
+ $num = `$git_cmd egrep "^(\\\?\\\?|A)" | wc -l`;
+ }
+ else
+ {
+ die "Git status $i_status not supported";
+ }
+ }
+
+ die ("$?") if ($?);
+ return $num;
+}
+
+# sub dirty
+#
+# Determines if git repository is Dirty.
+# Dirty - any staged or not staged changes
+#
+# @param[in] i_git_root - The root of the git repository to check.
+#
+# @return bool - 1 if dirty.
+#
+sub dirty
+{
+ my $i_git_root = shift;
+ if ( (status($i_git_root,STAGED) +
+ status($i_git_root,NOT_STAGED)) > 0 )
+ {
+ return 1;
+ }
+ return 0;
+}
+
+# sub staged
+#
+# Determines if git repository has only staged changes.
+#
+# @param[in] i_git_root - The root of the git repository to check.
+#
+# @return bool - 1 if staged only.
+#
+sub staged
+{
+ my $i_git_root = shift;
+ if ( (status($i_git_root,NOT_STAGED) <= 0) &&
+ (status($i_git_root,STAGED) > 0) )
+ {
+ return 1;
+ }
+ return 0;
+}
+
+# sub clean
+#
+# Determines if git repository has nothing staged and only untracked changes
+#
+# @param[in] i_git_root - The root of the git repository to check.
+#
+# @return bool - 1 if untracked only.
+#
+sub clean
+{
+ my $i_git_root = shift;
+ if ( (status($i_git_root,TRACKED) +
+ status($i_git_root,STAGED)) > 0 )
+ {
+ return 0;
+ }
+ return 1;
+}
+
+# sub fetch
+#
+# Fetches the contents of a remote revision (refs/changes/*) to the local
+# git repository.
+#
+# @param[in] i_git_root - The root of the local git repository.
+# @param[in] i_remote - Remote to fetch from.
+# @param[in] i_ref - The revision to fetch from the Gerrit server [optional].
+# @param[in] i_project - The project to query [optional]
+# @param[in] i_branch - The branch in the project to query [optional]
+# @param[in] i_verbose - Display output of fetch for user to use [optional]
+#
+sub fetch
+{
+ my ($i_git_root, $i_remote, $i_ref, $i_project, $i_branch, $i_verbose) = @_;
+ chdir($i_git_root);
+
+ # Check if ref is a change-id or commit and fetch from gerrit server
+ if (GerritUtil::is_patch($i_ref) || is_commit($i_ref))
+ {
+ my $patch = GerritUtil::query_current_patchset($i_ref, $i_project,
+ $i_branch);
+ $i_ref = $patch->{currentPatchSet}->{ref};
+ }
+
+ ($i_verbose) ? my $quiet = "" : my $quiet = "-q";
+
+ system("git fetch $i_remote $i_ref $quiet");
+ die ("Could not find ref = $i_ref in remote = $i_remote") if ($?);
+}
+
+# sub reset
+#
+# Reset --hard current HEAD of git repository to the specified reference
+#
+# @param[in] i_git_root - The root of the local git repository.
+# @param[in] i_remote - Remote to fetch from.
+# @param[in] i_ref - The reference to fetch from the remote server.
+#
+sub reset
+{
+ my ($i_git_root, $i_remote, $i_ref) = @_;
+ chdir($i_git_root);
+
+ # Check if commit is referenced locallay
+ unless (GerritUtil::is_patch($i_ref))
+ {
+ system("git reset --hard $i_ref");
+ die ("Could not resolve commit, may need rebase") if ($?);
+ }
+ # Try fetching change-id from remote
+ else
+ {
+ fetch(cwd(),$i_remote,$i_ref);
+ system("git reset --hard FETCH_HEAD");
+ die ("$?") if ($?);
+ }
+
+}
+
+# sub hooks
+#
+# Copies git hooks from remote server into local git repository
+#
+# @param[in] i_git_root - The root of the local git repository.
+#
+sub hooks
+{
+ my ($i_git_root) = @_;
+ chdir($i_git_root);
+
+ die "remote server not defined" if (!defined $globals{remote_server});
+ system("scp -p -q $globals{remote_server}:hooks/commit-msg $i_git_root/.git/hooks");
+ die ("$?") if ($?);
+}
+
+# sub add
+#
+# Stage all changes in a git repository for commit
+#
+# @param[in] i_git_root - The root of the local git repository.
+#
+sub add
+{
+ my ($i_git_root) = @_;
+ chdir($i_git_root);
+
+ system("git add -A .");
+ die ("$?") if ($?);
+}
+
+# sub commit
+#
+# Commit all changes staged for commit in a git repository
+#
+# @param[in] i_git_root - The root of the local git repository.
+# @param[in] i_amend - Amend commit in $GIT_ROOT [default 0].
+#
+sub commit
+{
+ my ($i_git_root, $i_amend) = @_;
+ chdir($i_git_root);
+
+ if ($i_amend)
+ {
+ system("git commit --amend");
+ }
+ else
+ {
+ system("git commit");
+ }
+ die ("$?") if ($?);
+}
+
+# sub resolve_ref
+#
+# Transforms a symbolic git reference into a commit number.
+#
+# @param[in] i_git_root - The root of the local git repository.
+# @param[in] i_remote - Remote to fetch from.
+# @param[in] i_ref - The reference to resolve.
+#
+# @return string - Resolved git commit number.
+#
+sub resolve_ref
+{
+ my ($i_git_root, $i_remote, $i_ref) = @_;
+ chdir($i_git_root);
+
+ my $resolve = "";
+
+ if (GerritUtil::is_patch($i_ref))
+ {
+ my $gerrit = GerritUtil::resolve_patch($i_git_root,
+ $i_remote,[$i_ref]);
+ $resolve = $gerrit;
+ }
+ else
+ {
+ $resolve = `git log -n1 --pretty=\"%H\" $i_ref`;
+ die ("Could not resolve commit, may need rebase") if ($?);
+ chomp $resolve;
+
+ }
+
+ die "Unable to resolve ref $i_ref" if ($resolve eq "");
+ print "Resolved $i_ref as $resolve\n" if $debug;
+
+ return $resolve;
+}
+
+# sub order_commits
+#
+# Order a list of commits so that they are in a good order with regard to
+# dependencies. The order returned should be the most likely to not fail
+# a cherry-pick sequence.
+#
+# @param[in] i_base - The base to apply patches to.
+# @param[in] i_patches - The list of commits to order.
+#
+# @return array - Re-ordered list of commits (from patches).
+#
+sub order_commits
+{
+ my ($i_base, $i_patches) = @_;
+ my @result = ();
+
+ # Create patch -> { distance -> 0, deps -> [] } hash.
+ my %patch_hash =
+ map { $_ => \{ distance => 0, deps => [] }} @{$i_patches};
+
+ # Determine dependencies and distance for each patch.
+ foreach my $patch (@{$i_patches})
+ {
+ # Add dependencies for each patch to the hash.
+ my $deps = commit_deps($i_base, $patch);
+ push @{${$patch_hash{$patch}}->{deps}}, @{$deps};
+
+ # Determine the distance from previous release for each patch.
+ ${$patch_hash{$patch}}->{distance} =
+ scalar @{commit_history($patch, $i_base)};
+ }
+
+ # Calculate Dijkstra's on the patches.
+ my $changed = 1;
+ while ($changed != 0)
+ {
+ $changed = 0;
+ foreach my $patch (@{$i_patches})
+ {
+ my $distance = 1 + max( map
+ { ${$patch_hash{$_}}->{distance}}
+ @{${$patch_hash{$patch}}->{deps}});
+
+ if ($distance > ${$patch_hash{$patch}}->{distance})
+ {
+ $changed = 1;
+ ${$patch_hash{$patch}}->{distance} = $distance;
+ }
+ }
+ }
+
+ # Sort the patches based on shortest distance from previous release
+ # (after Dijkstra).
+ my @commit_order =
+ sort { ${$patch_hash{$a}}->{distance} <=>
+ ${$patch_hash{$b}}->{distance} }
+ @{$i_patches};
+ return \@commit_order;
+}
+
+# sub commit_deps
+#
+# Determines a list of dependent commits based on common files touched.
+#
+# @param[in] base - The end point, in git history, of commits to compare.
+# @param[in] commit - The commit to find dependents of.
+#
+# @return array - List of dependent commits.
+#
+sub commit_deps
+{
+ my $base = shift;
+ my $commit = shift;
+ chomp($base);
+ chomp($commit);
+
+ my @deps = ();
+
+ print "Searching for deps for $commit against $base\n" if $debug;
+
+ open COMMAND, "git diff-tree --name-only --no-commit-id -r $commit --diff-filter CMRT| ".
+ "xargs git rev-list $commit~1 ^$base -- |";
+ while (my $line = <COMMAND>)
+ {
+ print "Found dep: $line" if $debug;
+
+ chomp $line;
+ push @deps, $line;
+ }
+ close COMMAND;
+
+ return \@deps;
+}
+
+# sub commit_history
+#
+# Determines all the commits between two points in git history.
+#
+# @param[in] start - Beginning commit.
+# @param[in, optional] not_including - Starting point to exclude.
+#
+# @return array - Commit history.
+#
+sub commit_history
+{
+ my $start = shift;
+ my $not_including = shift;
+
+ my @commits = ();
+
+ unless ($not_including eq "") { $not_including = "^".$not_including; }
+
+ open COMMAND, "git rev-list --cherry-pick $start $not_including |";
+ while (my $line = <COMMAND>)
+ {
+ chomp $line;
+ push @commits, $line;
+ }
+ close COMMAND;
+
+ return \@commits;
+}
+
+# sub checkout
+#
+# Checkout specified reference in git repository
+#
+# @param[in] i_git_root - The root of the local git repository.
+# @param[in] i_remote - Remote to fetch from.
+# @param[in] i_ref - The reference to fetch from the remote server.
+#
+sub checkout
+{
+ my ($i_git_root, $i_remote, $i_ref) = @_;
+ chdir($i_git_root);
+
+ my $base = top_commit($i_git_root);
+
+ # Check if commit is referenced locally or is a non-commit reference
+ # (e.g. FETCH_HEAD, master, remote tag)
+ if ($i_remote eq "" || !is_commit($i_ref) || commit_local($base,
+ $i_ref))
+ {
+ system("git checkout $i_ref -q");
+ die ("Could not resolve commit, may need rebase") if ($?);
+ }
+ else
+ {
+ fetch(cwd(),$i_remote,$i_ref);
+ system("git checkout FETCH_HEAD -q");
+ die ("$?") if ($?);
+ }
+}
+
+# sub checkout_branch
+#
+# Create/Checkout branch in git repository
+#
+# @param[in] i_git_root - The root of the local git repository.
+# @param[in] i_branch - The refer.
+# @param[in] i_base - The reference to base the branch on.[optional]
+#
+sub checkout_branch
+{
+ my ($i_git_root, $i_remote, $i_branch, $i_base) = @_;
+ chdir($i_git_root);
+
+ my $base = top_commit($i_git_root);
+
+ # Check if commit is referenced locally or is a non-commit reference
+ # (e.g. FETCH_HEAD, master, remote tag)
+ if ($i_remote eq "" || !is_commit($i_base) || commit_local($base,
+ $i_base))
+ {
+ system("git checkout -b $i_branch $i_base -q");
+ die ("Could not resolve branch base = $i_base") if ($?);
+ }
+ # Try fetching change-id/commit from remote
+ else
+ {
+ fetch(cwd(),$i_remote,$i_base);
+ system("git checkout -b $i_branch FETCH_HEAD -q");
+ die ("$?") if ($?);
+ }
+}
+
+# sub cherry_pick
+#
+# Cherry-pick a commit onto the current branch.
+#
+# @param[in] commit - The commit to cherry-pick.
+#
+# @retval false - Error occurred during cherry-pick.
+sub cherry_pick
+{
+ my $commit = shift;
+
+ system("git cherry-pick -x $commit");
+ return ($? == 0);
+}
+
+# sub top_commit
+#
+# Get top commit on current branch
+#
+# @param[in] i_git_root - The root of the local git repository.
+#
+# @retval commit - Top commit on current branch.
+sub top_commit
+{
+ my ($i_git_root) = @_;
+
+ chdir($i_git_root);
+ return `git rev-parse HEAD`;
+}
+
+sub init
+{
+ system("git init -q");
+ die $? if ($?);
+}
+
+# sub delete_branch
+#
+# Delete a git branch
+#
+# @param[in] i_git_root - The root of the local git repository.
+# @param[in] i_branch - Branch to delete.
+#
+sub delete_branch
+{
+ my ($i_git_root, $i_branch) = @_;
+ chdir($i_git_root);
+
+ system("git branch -D $i_branch -q");
+ die "Failed to delete branch $i_branch" if ($?);
+}
+
+# sub commit_msg
+#
+# Get the entire commit message associated with a commit.
+#
+# @param[in] i_commit - The commit to examine.
+#
+# @return string - The commit message.
+#
+sub commit_msg
+{
+ my $i_commit = shift;
+
+ open COMMAND, "git log -n1 --pretty=%B $i_commit |";
+ my $message = "";
+ while (my $line = <COMMAND>)
+ {
+ $message = $message.$line;
+ }
+ close COMMAND;
+
+ return $message;
+}
+
+# sub retrieveChangeIds
+#
+# Get the change Id associated with the commit
+#
+# @param[in] i_commit - The commit to examine.
+#
+# @return @Ids - The array of change Ids
+#
+sub retrieveChangeIds
+{
+ my $i_commit = shift;
+ my @Ids;
+ my $message = commit_msg($i_commit);
+ if ($message =~ m/Change-Id:\s*(I[0-9a-z]+)/)
+ {
+ push @Ids, $1;
+ }
+ if ($message =~ m/Original-Change-Id:\s*(I[0-9a-z]+)/)
+ {
+ push @Ids, $1;
+ }
+ if($#Ids < 0)
+ {
+ die "\nERROR: Invalid Commit, cannot get the Change ID\n";
+ }
+ return @Ids;
+}
+
+# sub commit_local
+#
+# Checks if commit is in local tree
+#
+# @param[in] i_commit - The commit to examine.
+#
+# @return bool - true if in local tree
+#
+sub commit_local
+{
+ my ($i_base, $i_commit) = @_;
+ chomp($i_base);
+ chomp($i_commit);
+
+ die "Based is not of type commit (SHA hash)" if (!is_commit($i_base));
+
+ # Git log will fail if not valid change-id or commit. Note order is check
+ # for change-id first as it will also match the regex for is_commit
+ if (GerritUtil::is_patch($i_commit))
+ {
+ `git log $i_base | grep "Change-Id: $i_commit"`;
+ ($?) ? return 0 : return 1;
+ }
+ elsif(is_commit($i_commit))
+ {
+ # Note '^commit' used to avoid finding the commit in the commit message
+ # somewhere
+ `git log $i_base | grep "^commit $i_commit"`;
+ ($?) ? return 0 : return 1;
+ }
+ else
+ {
+ die "Commit is not of type commit or change-id";
+ }
+}
+
+# sub is_commit
+#
+# Determines if a patch identifier is a git commit id or not.
+#
+# @param[in] i_ref - The reference to make determination about.
+#
+# @return bool - Ref is in the style of a git commit
+sub is_commit
+{
+ my $i_ref = shift;
+ chomp($i_ref);
+
+ ($i_ref =~ m/[0-9a-f]{7,40}/) ? return 1 : return 0;
+}
+
+sub cherry_pick_commits
+{
+ my ($i_git_root, $i_base, $i_commits, $i_verbose) = @_;
+
+ chdir($i_git_root);
+ die $? if ($?);
+
+ # Order commits
+ my $commit_ref = order_commits($i_base,$i_commits);
+ if ($debug)
+ {
+ print "Determined commit order as:\n";
+ foreach my $commit (@{$commit_ref})
+ {
+ print "\t$commit\n";
+ }
+ }
+
+ print "\nApplying commits...\n";
+ my @cp_failures = ();
+ foreach my $commit (@{$commit_ref})
+ {
+ # Skip over commits that are already in the base. Some tooling has
+ # old information, for a reason, but does not need to be applied as the
+ # base is updated
+ next if(commit_local($i_base, $commit));
+
+ print "\nApplying $commit:\n";
+ # If cherry-pick fails, continue on and store failed commit
+ if(!cherry_pick($commit))
+ {
+ # Clear out failed cherry-pick
+ print "Reverting $commit as cherry-pick failed.\n";
+ system("git reset HEAD --hard");
+ push @cp_failures, $commit;
+ }
+ }
+ if (@cp_failures)
+ {
+ print "\n**Following Cherry-picks failed:\n";
+ foreach my $commit (@cp_failures)
+ {
+ print_commit($commit,$i_verbose);
+ }
+ }
+ else
+ {
+ print "\nAll Cherry-picks applied cleanly\n";
+ }
+}
+
+####################### Begin Print Utility Subroutines ########################
+
+# sub print_diff_help
+#
+# Print a reference for what different file change marks mean.
+#
+sub print_diff_help
+{
+ print
+ q(
+Diff-filter Guide:
+ A - Added
+ C - Copied
+ D - Deleted
+ M - Modified
+ R - Renamed
+ T - Have their type (mode) changed
+ );
+}
+
+# sub print_commit
+#
+# Print info about commit
+#
+# @param[in] i_commit - Commit number.
+# @param[in] i_verbose - Verbose display
+#
+sub print_commit
+{
+ my ($i_commit, $i_verbose) = @_;
+
+ my $pretty_format = " --pretty=format:'%Cred%h%Creset - %s %Cgreen(%ci) ";
+ $pretty_format.="%C(bold blue)<%ae>%Creset'";
+
+ if ($i_verbose)
+ {
+ print `git show --name-status $pretty_format $i_commit --diff-filter ACDMRT`."\n";
+ }
+ else
+ {
+ print $i_commit."\n";
+ }
+}
+
+# Perl module must return true value
+1;
diff --git a/src/build/tools/perl.modules/ToolInit.pm b/src/build/tools/perl.modules/ToolInit.pm
new file mode 100644
index 000000000..381acaabb
--- /dev/null
+++ b/src/build/tools/perl.modules/ToolInit.pm
@@ -0,0 +1,96 @@
+# IBM_PROLOG_BEGIN_TAG
+# This is an automatically generated prolog.
+#
+# $Source: src/build/tools/perl.modules/ToolInit.pm $
+#
+# OpenPOWER HostBoot Project
+#
+# Contributors Listed Below - COPYRIGHT 2015
+# [+] International Business Machines Corp.
+#
+#
+# Licensed under the Apache License, Version 2.0 (the "License");
+# you may not use this file except in compliance with the License.
+# You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing, software
+# distributed under the License is distributed on an "AS IS" BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or
+# implied. See the License for the specific language governing
+# permissions and limitations under the License.
+#
+# IBM_PROLOG_END_TAG
+
+package ToolInit;
+
+use strict;
+use Getopt::Long qw(:config pass_through);
+use Switch;
+# Allow platform scripts to use init_globals
+use Exporter 'import';
+our @EXPORT = qw(init_globals $debug $help $module_script MASTER FETCH_HEAD);
+
+# Globals
+our $debug = 0;
+our $help = 0;
+our $module_script = "";
+my %globals = ( branch => "master");
+
+# Projects that use ToolInit
+use constant {
+ MASTER => "master",
+ FETCH_HEAD => "FETCH_HEAD",
+ EKB => "EKB",
+};
+
+# Global options for all infrastructure scripts/modules
+GetOptions("debug!" => \$debug,
+ "help" => \$help,
+ "module-script:s" => \$module_script,
+ "branch:s" => \$globals{branch});
+
+# sub init_globals
+#
+# Export global variables to all scripts/modules that need them
+#
+# @return hash - variables needed for infrastructure scripts
+#
+sub init_globals
+{
+ $globals{project_name} = $ENV{'PROJECT_NAME'};
+ $globals{remote_server} = $ENV{'GERRIT_SRV'};
+
+ if ($globals{project_name} eq "")
+ {
+ print "Environment not setup properly...\n\tRun 'source env.bash' or ";
+ print "'./$module_script workon' based on your current environment\n";
+ print "\tFor more info run './$module_script --help'\n";
+ die ();
+ }
+ project_settings();
+
+ return %globals;
+}
+
+# sub project_settings
+#
+# Set project specific settings for tools on any platform.
+# Project names are found via env variable set (e.g.in env.bash)
+# If project is not supported this fails, as supported must be added.
+#
+sub project_settings
+{
+ switch ($globals{project_name})
+ {
+ case (EKB)
+ {
+ $globals{gerrit_project} = "hw/ekb";
+ }
+ else
+ {
+ die "Project => $module_script not supported";
+ }
+ }
+} \ No newline at end of file
OpenPOWER on IntegriCloud