#!/usr/bin/perl # IBM_PROLOG_BEGIN_TAG # This is an automatically generated prolog. # # $Source: src/build/tools/hbRelease $ # # IBM CONFIDENTIAL # # COPYRIGHT International Business Machines Corp. 2012,2013 # # p1 # # Object Code Only (OCO) source materials # Licensed Internal Code Source Materials # IBM HostBoot Licensed Internal Code # # The source code for this program is not published or otherwise # divested of its trade secrets, irrespective of what has been # deposited with the U.S. Copyright Office. # # Origin: 30 # # IBM_PROLOG_END_TAG use strict; use Getopt::Long qw(:config pass_through); use POSIX; use Text::Wrap; use List::Util 'max'; my $debug = 0; my $help = 0; GetOptions("debug!" => \$debug, "help" => \$help); my %globals = (); my %commands = ( "define" => \&execute_define, "undef" => \&execute_undef, "list-levels" => \&config_print_levels, "query-gerrit" => \&execute_gerrit_query, "query-git" => \&execute_git_query, "query-level" => \&execute_level_query, "add-patch" => \&execute_add_patch, "add-forcedep" => \&execute_add_forcedep, "verify-patches" => \&execute_verify_patches, "release" => \&execute_release, "build-name" => \&execute_build_name, "help" => \&execute_help, ); if ($help) { execute_help(); } my $command = shift @ARGV; if ($commands{$command}) { &{$commands{$command}}(); } else { execute_help(); } foreach my $arg (@ARGV) { print "Unprocessed arg: $arg\n" if $debug; } ############################## Begin Actions ################################## sub execute_define { print "Defining new level...\n"; my %level = (); GetOptions("level:s" => \$level{name}, "name:s" => \$level{name}, "baseline:s" => \$level{base}, "released:s" => \$level{released}); die "Missing level name" if ($level{name} eq ""); die "Missing baseline name" if ($level{base} eq ""); die "Missing released level name" if ($level{released} eq ""); print "New level: ".$level{name}.":".$level{base}.":".$level{released}."\n" if $debug; $level{base} = git_resolve_ref($level{base}); $level{released} = git_resolve_ref($level{released}); config_add_level(\%level); } sub execute_undef { my $level = shift @ARGV; die "Level to undefine not given" if ($level eq ""); my $levels = config_list_levels(); die "Level $level does not exist" if (not defined $levels->{$level}); print "Undefining level $level...\n"; config_del_level($level); } sub execute_gerrit_query { my $project = ""; GetOptions("project:s" => \$project); if ("" eq $project) { $project = config_project(); } my $items = gerrit_query("status:open project:$project"); foreach my $item (@$items) { if (defined $item->{"project"}) { print wrap("","",$item->{"subject"}) . "\n"; print "\t" . $item->{"id"} . "\n"; print "\n"; } } } sub execute_git_query { my $level = ""; my $branch = "gerrit/master"; GetOptions("name:s" => \$level, "level:s" => \$level, "branch:s" => \$branch); die "Missing level name" if ($level eq ""); $branch = git_resolve_ref($branch); my $level = config_get_level($level); my $commits = git_commit_history($branch, $level->{base}); foreach my $commit (@{$commits}) { my $subject = git_get_subject($commit); print "$subject\n\t$commit\n\n"; } } sub execute_level_query { my $level = ""; GetOptions("name:s" => \$level, "level:s" => \$level); die "Missing level name" if ($level eq ""); my $level_info = config_get_level($level); print "Level $level\n"; print " Base: \n"; print " ".git_name_rev($level_info->{base})."\n"; print " Released:\n"; print " ".git_name_rev($level_info->{released})."\n"; print " Patches:\n"; foreach my $patch (sort @{$level_info->{patches}}) { print " $patch\n"; } print " Forced Deps:\n"; foreach my $dep (sort keys %{$level_info->{forceDeps}}) { my $deps = $level_info->{forceDeps}; print " $dep =>\n"; print " ".$deps->{$dep}."\n"; } } sub execute_add_patch { my $level = ""; my $patch = ""; GetOptions("name:s" => \$level, "level:s" => \$level, "patch:s" => \$patch); die "Missing level name" if ($level eq ""); die "Missing patch name" if ($patch eq ""); config_add_patch($level, $patch); } sub execute_add_forcedep { my $level = ""; my $from = ""; my $to = ""; GetOptions("name:s" => \$level, "level:s" => \$level, "from:s" => \$from, "to:s" => \$to); die "Missing level name" if ($level eq ""); die "Missing from depend" if ($from eq ""); die "Missing to depend" if ($to eq ""); config_add_dep($level, $from, $to); } sub execute_verify_patches { my $level = ""; GetOptions("name:s" => \$level, "level:s" => \$level); die "Missing level name" if ($level eq ""); my $level_info = config_get_level($level); my $patches = $level_info->{patches}; $patches = gerrit_resolve_patches($patches); foreach my $patch (@{$patches}) { print "Deps for $patch\n" if $debug; my $displayed_header = 0; my $deps = git_commit_deps($level_info->{base},$patch); foreach my $dep (@{$deps}) { unless (grep {$_ eq $dep} @{$patches}) { unless ($displayed_header) { print "-------------------------------------------------\n"; print "Potential missing dependency for:\n"; print wrap(" "," ",git_get_subject($patch)."\n"); print "\t$patch\n\n"; $displayed_header = 1; } print wrap(" ", " ", git_get_subject($dep)."\n"); print "\t$dep\n"; my $files = array_intersect(git_commit_files($patch), git_commit_files($dep)); foreach my $file (@{$files}) { print "\t$file\n"; } print "\n"; } } if ($displayed_header) { print "-------------------------------------------------\n"; } } } sub execute_release { my $level = ""; GetOptions("name:s" => \$level, "level:s" => \$level); die "Missing level name" if ($level eq ""); my $level_info = config_get_level($level); print "Creating release branch...\n"; git_create_branch($level, $level_info->{base}); my $patches = $level_info->{patches}; print "Resolving and ordering patches...\n"; $patches = gerrit_resolve_patches($level_info->{patches}); $patches = git_order_commits($patches, $level_info); if ($debug) { print "Determined patch order as:\n"; foreach my $patch (@{$patches}) { print "\t$patch\n"; } } print "Applying patches...\n"; foreach my $patch (@{$patches}) { print "Applying $patch.\n" if ($debug); unless (git_cherry_pick($patch)) { system("git reset HEAD --hard"); die "Cherry-pick of $patch failed"; } } print "Generating release notes...\n"; create_release_notes($level, $level_info); print "Creating tag...\n"; git_create_tag($level, $level_info); } sub execute_build_name { my $release = "810"; my $build_letter = "a"; GetOptions("release:s" => \$release, "letter:s" => \$build_letter); system ("date +hb%m%d".$build_letter."_%g%V.$release"); } sub execute_help { my $command = shift @ARGV; if ($command eq "") { print "hbRelease:\n"; print " Prepare the hostboot codebase for release.\n"; print "\n"; print " Syntax:\n"; print " hbRelease [options] \n"; print "\n"; print " Available subtools:\n"; foreach my $key (sort keys %commands) { print " $key\n"; } print "\n"; print " Global options:\n"; print " --debug Enable debug mode.\n"; print " --help Display help on a specific tool.\n"; print "\n"; print " Note: Generally a can be any git or gerrit\n"; print " reference. A git commit number, tag, branch, or\n"; print " a gerrit change-id are all valid.\n"; } elsif (not defined $commands{$command}) { die "Unknown subcommand: $command.\n"; } else { my %help = ( "define" => q( Define a new level for release. Options: --level= Name for the new level [required]. --base= Baseline commit [required]. --released= Commit of previous release [required]. ), "undef" => q( Delete a previously defined release level. Options: --level= Name for the level to delete [required]. ), "list-levels" => q( Displays a list of currently defined levels. ), "query-gerrit" => q( Displays a list of open change-sets from the Gerrit server. ), "query-git" => q( Displays a list of merged commits which are NOT currently destined for a release level. Options: --level= Name for the level to query [required]. --branch= Branch to query against [default=gerrit/master]. ), "query-level" => q( Displays information about a defined release level. Options: --level= Name for the level to query [required]. ), "add-patch" => q( Adds a commit to the patch-list for a release. Options: --level= Release to add patch to [required]. --patch= Commit to add to patch-list [required]. ), "add-forcedep" => q( Add a commit-pair as a forced dependency for a release. Options: --level= Release to add dependency to [required]. --from= Decendent commit in the dependency [required]. --to= Ancestor commit in the dependency [required]. ), "verify-patches" => q( Verify patch-list to ensure all dependencies are met. This tool will give a list of dependency candidates if an ancestor commit is found modifying the same files as a commit in the patch-list. Options: --level= The level to verify [required]. ), "release" => q( Create a branch / tag based on the definition of a release. Options: --level= The level to release [required]. ), "build-name" => q( Display a properly formatted build name based on the date. Ex: hb0402a_1412.810 Options: --release= Release name [default=810]. --letter=[a-z] Build letter [default=a]. ), ); print "hbRelease $command:"; print $help{$command}; } } ######################### Begin Utility Subroutines ########################### # sub create_release_notes # # Generates an HTML file (releaseNotes.html) with the release notes for a # release. # # @param [in] level - The level name to release. # @param [in] level_info - The level_info hash (see config_get_level). # sub create_release_notes { my $level = shift; my $level_info = shift; my $commits = git_commit_history("HEAD", $level_info->{released}); open RELNOTE, "> ".git_root()."/releaseNotes.html"; print RELNOTE "\n"; print RELNOTE " Release notes for $level\n"; print RELNOTE < table.release { border-width: 1px; border-spacing: 2px; border-style: outset; border-color: gray; border-collapse: separate; background-color: white; } table.release th { border-width: 1px; padding: 1px; border-style: inset; border-color: gray; background-color: white; } table.release td { border-width: 1px; padding: 1px; border-style: inset; border-color: gray; background-color: white; } STYLESHEET print RELNOTE " \n"; print RELNOTE "

Level: $level

\n"; print RELNOTE "

Included commits:

\n"; print RELNOTE "\n"; print RELNOTE " \n"; print RELNOTE " \n"; print RELNOTE " \n"; print RELNOTE " \n"; print RELNOTE " \n"; foreach my $commit (@{$commits}) { my $subject = git_get_subject($commit); my $rtc = rtc_workitem_num($commit); my $rtc_hyper = ""; my $cq = cq_workitem_num($commit); my $cq_hyper = ""; if ($rtc ne "") { $rtc_hyper = rtc_hyperlink($rtc); $rtc_hyper = "$rtc"; } if ($cq ne "") { $cq_hyper = cq_hyperlink($cq); $cq_hyper = "$cq"; if ($rtc_hyper ne "") { $cq_hyper = "
$cq_hyper"; } } print RELNOTE " \n"; print RELNOTE " \n"; print RELNOTE " \n"; print RELNOTE " \n"; print RELNOTE " \n"; } print RELNOTE "
RTC/CQ Number(s)SubjectGit Commit
$rtc_hyper $cq_hyper$subject$commit
\n"; print RELNOTE " \n"; print RELNOTE "\n"; close RELNOTE; system "git add ".git_root()."/releaseNotes.html"; system "git commit -m \"Release notes for $level\""; } # sub git_resolve_ref # # Transforms a symbolic git reference into a commit number. # # @param [in] ref - The reference to resolve. # # @return string - Resolved git commit number. # sub git_resolve_ref { my $ref = shift; my $resolve = ""; if (gerrit_is_patch($ref)) { my $gerrit = gerrit_resolve_patches(\[$ref]); $resolve = @{$gerrit}[0]; } else { open COMMAND, "git log -n1 --pretty=\"%H\" $ref |"; $resolve = ; close COMMAND; chomp $resolve; } die "Unable to resolve ref $ref" if ($resolve eq ""); print "Resolved $ref as $resolve\n" if $debug; return $resolve; } # sub git_root # # Determines the path of the root of the git repository. # # @return string - Root of the git repository. sub git_root { return $globals{git_root} if (defined $globals{git_root}); open COMMAND, "git rev-parse --show-toplevel |"; my $root = ; close COMMAND; chomp $root; die "Unable to determine git_root" if ($root eq ""); print "Found git_root at $root\n" if $debug; $globals{git_root} = $root; return $root; } # sub git_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 git_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 = ) { chomp $line; push @commits, $line; } close COMMAND; return \@commits; } # sub git_name_rev # # Transforms a git commit number to a symbolic name for human readability. # # @param[in] rev - Git revision (commit number) to name. # @return string - The symbolic name git uses for that commit number. # sub git_name_rev { my $rev = shift; open COMMAND, "git name-rev $rev |"; my $line = ; chomp $line; close COMMAND; return $line; } # sub git_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 git_commit_deps { my $base = shift; my $commit = shift; 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 | ". "xargs git rev-list $commit~1 ^$base -- |"; while (my $line = ) { print "Found dep: $line" if $debug; chomp $line; push @deps, $line; } close COMMAND; return \@deps; } # sub git_commit_files # # Find the files touched by a commit. # # @param[in] commit - The commit to examine. # @return array - List of files touched by the commit. # sub git_commit_files { my $commit = shift; my @files = (); open COMMAND, "git diff-tree --name-only --no-commit-id -r $commit |"; while (my $line = ) { chomp $line; push @files, $line; } close COMMAND; return \@files; } # sub git_get_subject # # Get the subject of the commit message associated with a commit. # See git log --oneline. # # @param[in] commit - The commit to examine. # @return string - The subject of the commit. # sub git_get_subject { my $commit = shift; open COMMAND, "git log -n1 --pretty=\"%s\" $commit |"; my $subject = ; chomp($subject); close COMMAND; return $subject; } # sub git_commit_msg # # Get the entire commit message associated with a commit. # # @param[in] commit - The commit to examine. # @return string - The commit message. # sub git_commit_msg { my $commit = shift; open COMMAND, "git log -n1 --pretty=%B $commit |"; my $message = ""; while (my $line = ) { $message = $message.$line; } close COMMAND; return $message; } # sub git_create_branch # # Create a branch for a release-level. # # @param[in] level - The release-level to use as basis for the branch name. # @param[in] base - The commit to use as the base for the new branch. # sub git_create_branch { my $level = shift; my $base = shift; system("git checkout -b __hbRelease_$level $base"); die "Could not create branch for $level" if ($?); } # sub git_create_tag # # Create a tag for a release-level. # # @param[in] level - The release-level to create a tag for. # @param[in] level_info - The level-info associated with the level. # sub git_create_tag { my $level = shift; my $level_info = shift; # Create an annotated tag, taking annotation from stdin. open COMMAND, "| git tag -a $level -F -" || die; # Add information about the level to the tag. print COMMAND "Release: $level\n\n"; print COMMAND "Base: ".$level_info->{base}."\n"; print COMMAND "Previous-Release: ".$level_info->{released}."\n"; print COMMAND "\n"; foreach my $patch (@{$level_info->{patches}}) { print COMMAND "Patch: $patch\n"; } my $forceDeps = $level_info->{forceDeps}; foreach my $from (keys %{$forceDeps}) { print COMMAND "Forced-Dep: $from:".$forceDeps->{$from}."\n"; } # Commit annotated tag. close COMMAND; } # sub git_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 git_cherry_pick { my $commit = shift; system("git cherry-pick -x $commit"); return ($? == 0); } # sub git_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] patches - The list of commits to order. # @param[in] level_info - The level_info for the release-level being created. # # @return array - Re-ordered list of commits (from patches). # sub git_order_commits { my $patches = shift; my $level_info = shift; my $forceDeps = $level_info->{forceDeps}; # Create patch -> { distance -> 0, deps -> [] } hash. my %patch_hash = map { $_ => \{ distance => 0, deps => [] }} @{$patches}; # Determine dependencies and distance for each patch. foreach my $patch (@{$patches}) { # Add dependencies for each patch to the hash. my $deps = git_commit_deps($level_info->{base}, $patch); push @{${$patch_hash{$patch}}->{deps}}, @{$deps}; # Determine the distance from previous release for each patch. ${$patch_hash{$patch}}->{distance} = scalar @{git_commit_history($patch, $level_info->{released})}; } # Determine forced dependencies for each patch. foreach my $patch (keys %{$forceDeps}) { my $resolve_from = @{gerrit_resolve_patches([$patch])}[0]; my $resolve_to = @{gerrit_resolve_patches([$forceDeps->{$patch}])}[0]; print "Force dep: $resolve_from : $resolve_to\n" if ($debug); push @{${$patch_hash{$resolve_from}}->{deps}}, $resolve_to; } # Calculate Dijkstra's on the patches. my $changed = 1; while ($changed != 0) { $changed = 0; foreach my $patch (@{$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} } @{$patches}; return \@commit_order; } # sub config_filename # # @return The location of the hbRelease config file. # sub config_filename { return git_root()."/.git/hbRelease.config"; } # sub config_init # # Ensures the hbRelease tool is initialized properly. # sub config_init { return if (defined $globals{config_init}); unless (-e config_filename()) { open COMMAND, "git config --get remote.gerrit.url |"; my $url = ; close COMMAND; chomp $url; die "Undefined git-remote 'gerrit'" if ($url eq ""); die "Unexpected url found: $url" if (not ($url =~ m/ssh:\/\/.*\/.*/)); my $server = $url; my $project = $url; $server =~ s/ssh:\/\/(.*)\/.*/$1/; $project =~ s/.*\/(.*)/$1/; print "Gerrit Server: ".$server."\n" if $debug; print "Gerrit Project: ".$project."\n" if $debug; open(UNUSED, ">".config_filename()) || die; close UNUSED; system("git config --file ".config_filename(). " --add releaseLevels.server $server"); system("git config --file ".config_filename(). " --add releaseLevels.project $project"); } $globals{config_init} = 1; } # sub config_list_levels # # Determines the previously defined release-levels. # # @return hash - { level => 1 } for each defined level. # sub config_list_levels { return $globals{config_list_levels} if (defined $globals{config_list_levels}); config_init(); open COMMAND, "git config --file ".config_filename(). " --get-all releaseLevels.levelname |"; my $names = {}; while (my $line = ) { chomp $line; $names->{$line} = 1; } close COMMAND; $globals{config_list_levels} = $names; return $names; } # sub config_add_level # # Add a new level definition to the config file. # # @param level_def - A level info with the name/base/released for the new level. # sub config_add_level { config_init(); my $level_def = shift; my $levels = config_list_levels(); if (defined $levels->{$level_def->{name}}) { die "Level ".$level_def->{name}." is already defined"; } system("git config --file ".config_filename(). " --add releaseLevels.levelname ".$level_def->{name}); system("git config --file ".config_filename(). " --add level.".$level_def->{name}.".base ".$level_def->{base}); system("git config --file ".config_filename(). " --add level.".$level_def->{name}.".released ". $level_def->{released}); } # sub config_del_level # # Delete a level definition from the config file. # # @param level - The level name to delete. # sub config_del_level { config_init(); my $level = shift; system("git config --file ".config_filename(). " --unset releaseLevels.levelname ^".$level."\$"); system("git config --file ".config_filename(). " --remove-section level.".$level); } # sub config_add_patch # # Add a patch to a level definition. # # @param level - The level to add patch to. # @param patch - The patch to add. # sub config_add_patch { my $level = shift; my $patch = shift; config_get_level($level); unless (gerrit_is_patch($patch)) { $patch = git_resolve_ref($patch); } die "Unknown patch requested" if ($patch eq ""); system("git config --file ".config_filename(). " --add level.$level.patch $patch"); } # sub config_add_dep # # Add a forced dependency to a level definition. # # @param level - The level to add to. # @param from - The decendent patch. # @param to - THe ancestor patch. # sub config_add_dep { my $level = shift; my $from = shift; my $to = shift; config_get_level($level); unless (gerrit_is_patch($from)) { $from = git_resolve_ref($from); } die "Unknown patch requested for 'from' dep" if ($from eq ""); unless (gerrit_is_patch($to)) { $to = git_resolve_ref($to); } die "Unknown patch requested for 'to' dep" if ($to eq ""); system("git config --file ".config_filename(). " --add level.$level.forceDep $from:$to"); } # sub config_get_level # # Reads a level's information from the config file. # # @param level - The level to read. # # @return hash - { name => level, base => base release, # released => previous release, # patches => array of patches, # forceDep => hash of { from => to } pairs }. # sub config_get_level { config_init(); my $level = shift; my %level_data = (); open COMMAND, "git config --file ".config_filename(). " --get releaseLevels.levelname $level |"; my $found_level = ; chomp($found_level); close COMMAND; die "Level $level not defined" if ($found_level eq ""); $level_data{name} = $level; open COMMAND, "git config --file ".config_filename(). " --get level.$level.base |"; my $base = ; chomp($base); close COMMAND; $level_data{base} = $base; open COMMAND, "git config --file ".config_filename(). " --get level.$level.released |"; my $released = ; chomp($released); close COMMAND; $level_data{released} = $released; my @patches = (); open COMMAND, "git config --file ".config_filename(). " --get-all level.$level.patch |"; while (my $patch = ) { chomp($patch); push @patches, $patch; } close COMMAND; $level_data{patches} = \@patches; my %forceDeps = (); open COMMAND, "git config --file ".config_filename(). " --get-all level.$level.forceDep |"; while (my $forceDep = ) { $forceDep =~ m/(.*):(.*)/; $forceDeps{$1} = $2; } close COMMAND; $level_data{forceDeps} = \%forceDeps; return \%level_data; } # sub config_print_levels # # Displays the name of each defined level. # sub config_print_levels { my $levels = config_list_levels(); foreach my $level (sort keys %$levels) { print $level."\n"; } } # sub config_server # # Gets the Gerrit server name / address from the config file. # # @return string - The location of the Gerrit server. # sub config_server { return $globals{config_server} if (defined $globals{config_server}); config_init(); open COMMAND, "git config --file ".config_filename(). " --get releaseLevels.server |"; my $server = ; chomp($server); close COMMAND; die "Server config does not exist" if ($server eq ""); $globals{config_server} = $server; return $server; } # sub config_project # # Gets the Gerrit project managed by this repository from the config file. # # @return string - Project managed by this repository. # sub config_project { return $globals{config_project} if (defined $globals{config_project}); config_init(); open COMMAND, "git config --file ".config_filename(). " --get releaseLevels.project |"; my $project = ; chomp($project); close COMMAND; die "Project config does not exist" if ($project eq ""); $globals{config_project} = $project; return $project; } # sub gerrit_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 gerrit_ssh_command { return $globals{gerrit_ssh_command} if (defined $globals{gerrit_ssh_command}); my $server = config_server(); my $port = ""; if ($server =~ m/.*:.*/) { $port = $server; $server =~ s/(.*):.*/$1/; $port =~ s/.*:(.*)/$1/; $port = "-p $port"; } my $command = "ssh -qx $port $server gerrit"; print "SSH command: $command\n" if $debug; $globals{gerrit_ssh_command} = $command; return $command; } # sub gerrit_query # # Performs a gerrit query and parses the resulting JSON. # # @param[in] 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 gerrit_query { my $query = shift; my @items = (); open COMMAND, gerrit_ssh_command()." query $query --current-patch-set". " --format=JSON |"; while (my $line = ) { chomp $line; push @items, json_parse($line); } return \@items; } # sub gerrit_query_commit # # Performs a gerrit query on a specific commit. # # @param[in] commit - The commit to query. # # @return hash - The parsed JSON for the queried commit. # sub gerrit_query_commit { my $commit = shift; my $query_result = gerrit_query($commit); foreach my $result (@{$query_result}) { if ($result->{id} eq $commit) { return $result; } } die "Cannot find $commit in Gerrit"; } # sub gerrit_is_patch # # Determines if a patch identifier is a Gerrit patch or not. # # @param[in] 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 gerrit_is_patch { my $patch = shift; return 1 if ($patch =~ m/I[0-9a-f]+/); return 0; } # sub gerrit_resolve_patches # # 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] patches - An array of patches. # # @return array - An array of git commit numbers. # sub gerrit_resolve_patches { my $patches = shift; my @result = (); foreach my $patch (@{$patches}) { if (gerrit_is_patch($patch)) { my $patch_info = gerrit_query_commit($patch); gerrit_fetch($patch_info->{currentPatchSet}->{ref}); push @result, $patch_info->{currentPatchSet}->{revision}; } else { push @result, $patch; } } return \@result; } # sub gerrit_fetch # # Fetches the contents of a Gerrit revision (refs/changes/*) to the local # git repository. # # @param[in] ref - The revision to fetch from the Gerrit server. # sub gerrit_fetch { my $ref = shift; system("git fetch gerrit $ref -q"); } # sub rtc_workitem_num # # Determines the RTC WorkItem associated with a git commit. # # @param[in] commit - The git commit. # # @return string - RTC WorkItem number (or ""). # sub rtc_workitem_num { my $commit = shift; my $message = git_commit_msg($commit); if ($message =~ m/RTC:\s*([0-9]+)/) { return $1; } else { return ""; } } # sub cq_workitem_num # # Determine the CQ WorkItem associated with a git commit. # # @param[in] commit - The git commit. # # @return string - CQ WorkItem number (or ""). # sub cq_workitem_num { my $commit = shift; my $message = git_commit_msg($commit); if ($message =~ m/CQ:\s*([A-Z][A-Z][0-9]+)/) { return $1; } else { return ""; } } # sub rtc_hyperlink # # Turn an RTC WorkItem number into the https:// address to the RTC server. # # @param[in] workitem - RTC workitem number. # # @return string - The https:// address of the RTC item on the server. # sub rtc_hyperlink { my $workitem = shift; return "https://jazz07.rchland.ibm.com:13443/jazz/oslc/workitems/". "$workitem.hover.html"; } # sub cq_hyperlink # # Turn a CQ WorkItem number into the http:// address to the BQ server. # # @param[in] workitem - CQ workitem number. # # @return string - The http:// address of the CQ item on the server. # sub cq_hyperlink { my $workitem = shift; return "http://w3.rchland.ibm.com/projects/bestquest/?defect=$workitem"; } # 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 { print "Parse JSON object ... \n" if $debug; 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; } print "Adding $key => $value\n" if $debug; $object{$key} = $value; } print "Done parsing JSON object.\n" if $debug; 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; } print "Adding $value\n" if $debug; 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); } # sub array_intersect # # Perform set intersection on two arrays. # # @param[in] one - The first array. # @param[in] two - The second array. # # @return array - The set intersection. # sub array_intersect { my $one = shift; my $two = shift; my %set = {}; map { $set{$_}++ } (@{$one}, @{$two}); my @result = map { ($set{$_} > 1) ? $_ : () } (keys %set); return \@result; }