package MinP4; #------------------------------------------------------------------------------ # Copyright (c) Perforce Software, Inc., 2007-2014. All rights reserved # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions are met: # # 1 Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS # "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT # LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS # FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL PERFORCE # SOFTWARE, INC. BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, # SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT # LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, # DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON # ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR # TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF # THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH # DAMAGE. #------------------------------------------------------------------------------ =head1 NAME MinP4.pm - Minimal Perforce interface. =head1 VERSION 1.3.0 =head1 DESCRIPTION Minimal Perforce interface, not to be confused with the more comprehensive P4Perl API (the P4.pm module). =head1 PUBLIC DATA None. =head1 PUBLIC FUNCTIONS =cut require Exporter; use strict; use File::Temp; use POSIX qw(uname); use Misc; use Msg; use Cmd; # The next line avoids problems with 'use strict'. use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); # Initialization processing occurs in the BEGIN block. BEGIN { # Keep $VERSION value the same as at the top of this file. $VERSION = "1.3.0"; } # Package interface standards. By default, any export can be blocked. @ISA = qw(Exporter); @EXPORT_OK = qw( FindJIRAIssues GenChangelist GenGlobalWorkspace GenStreamWorkspace GenWorkspace GetBranchPaths GetChangelistFiles ); # Prototypes for public functions. sub FindJIRAIssues ($$;); sub GenChangelist($$$$;); sub GenGlobalWorkspace($$$;); sub GenStreamWorkspace($$$$;); sub GenWorkspace($$$$;); sub GetBranchPaths($$$;$); sub GetChangelistFiles($$;); #============================================================================== # Internal Functions #============================================================================== #============================================================================== # Public Functions #============================================================================== #------------------------------------------------------------------------------ # Find JIRA issues in the changelist description. =head2 FindJIRAIssues() FindJIRAIssues($I, $I) =head3 Description-FindJIRAIssues Find JIRA issue keys in a Perforce changelist description. =head3 Parameters-FindJIRAIssues =over 4 =item * $I =item * $I A reference to an array containing a list of issues. =back =head3 Output-FindJIRAIssues None. =head3 Returns-FindJIRAIssues None. =head3 Examples-FindJIRAIssues Sample call: C =cut #------------------------------------------------------------------------------ sub FindJIRAIssues ($$;) { $Msg->trace ("CALL MinP4::FindJIRAIssues(@_)"); my ($changeDesc, $issueArrayRef) = @_; my $issue; my $issueCount = 0; foreach (split '\n', $changeDesc) { foreach (split ' ', $_) { next if (/\[\s*review/i); next if (/\#review/i); if (/[A-Z]{1}([A-Z]|[0-9])+\-\d+/i) { # We found a JIRA issue. Clean up the text, removing # whitespace and text following the numnbers. s/\s//g; s/(\.|\;|\:).*$//g; # Normalize the JIRA issue to uppercase, # then capture it. $_ = uc($_); # Normalize to uppercase. @$issueArrayRef[$issueCount++]=$_; } } } } #------------------------------------------------------------------------------ =head2 GenChangelist() GenChangelist($I, $I, $I, $I;) =head3 Description-GenChangelist Generate a Perforce changelist. =head3 Parameters-GenChangelist =over 4 =item * $I =item * $I =item * $I =item * $I - Description for the generated Perforce changelist, quoted. =back =head3 Output-GenChangelist None except for errors. =head3 Returns-GenChangelist This returns the generated changelist number. In NoOp mode, '999999' is returned. In event of error, a 0 is returned. =head3 Examples-GenChangelist Sample call: C C =cut #------------------------------------------------------------------------------ sub GenChangelist($$$$;) { $Msg->trace ("CALL MinP4::GenChangelist(@_)\n"); my ($P4PORT, $P4USER, $P4CLIENT, $desc) = @_; my $tmpFile; my $changelist = 0; my $changeSpec; if ($NoOp) { $changelist = "999999"; return $changelist; } $tmpFile = Misc::GenTempFilename(); $changeSpec = "Change: new\n\nClient: $P4CLIENT\n\nUser: $P4USER\n\nStatus: new\n\nDescription:\n\t$desc\n\n"; open (TMP, ">$tmpFile") or $Msg->logdie ("Error: Failed to create temp file [$tmpFile]: $!\n"); print TMP $changeSpec; close (TMP); Cmd::Run ("/p4/common/bin/p4 -p $P4PORT -u $P4USER -c $P4CLIENT -s change -i < $tmpFile", "Generating pending changelist.", 0, $INFO); if ($Cmd::Output =~ /info: Change \d+/) { $changelist = $Cmd::Output; $changelist =~ s/^.*info: Change //; $changelist =~ s/ .*$//s; } else { $Msg->error ("Error generating changelist. Spec:\n$changeSpec\n\nOutput:\n$Cmd::Output\n"); return 0; } return $changelist; } #------------------------------------------------------------------------------ =head2 GenWorkspace() GenWorkspace($I, $I, $I, $I;) =head3 Description-GenWorkspace Generate a Perforce workspace. Honors $NoOp and $Verbosity. In $NoOp mode, the workspace spec is shown, but the workspace is not created on the Perforce server. =head3 Parameters-GenWorkspace =over 4 =item * $I =item * $I =item * $I =item * $I - A View path in Perforce depot syntax. It should start with "//some_depot", and may contain more folders. A "/..." will be appended to the value specified. =back =head3 Output-GenWorkspace Displays a message indicating workspace creation, or an error message. Honors $Verbosity setting. =head3 Returns-GenWorkspace None. =head3 Examples-GenWorkspace Sample call: Clogdie ("Failed to create workspace.");> =cut #------------------------------------------------------------------------------ sub GenWorkspace($$$$;) { $Msg->trace ("CALL MinP4::GenWorkspace(@_)\n"); my ($P4PORT, $P4USER, $P4CLIENT, $path) = @_; my $tmpFile; my $clientSpec; my $hostname = `hostname`; chomp $hostname; $clientSpec = "Client: $P4CLIENT\n\nOwner: $P4USER\n\nHost: $hostname\n\nDescription:\n\tGenerated workspace.\n\nRoot: /p4/1/tmp/ws/$P4CLIENT\n\nOptions: noallwrite noclobber nocompress unlocked modtime rmdir\n\nSubmitOptions: revertunchanged\n\nLineEnd: local\n\nView:\n\t$path/... //$P4CLIENT/...\n\n"; if ($NoOp) { $Msg->debug ("No-Op: Would have generated workspace with this spec:\n$clientSpec\n"); return 1; } $tmpFile = Misc::GenTempFilename(); open (TMP, ">$tmpFile") or $Msg->logdie ("Error: Failed to create temp file [$tmpFile]: $!\n"); print TMP $clientSpec; close (TMP); Cmd::Run ("/p4/common/bin/p4 -p $P4PORT -u $P4USER -c $P4CLIENT -s client -i < $tmpFile", "Generating workspace $P4CLIENT.", 0, $INFO); if ($Cmd::Output =~ /exit: 0/) { $Msg->info ("Generated workspace [$P4CLIENT]."); return 1; } else { $Msg->error ("Failed to generate workspace [$P4CLIENT].\n\nSpec:\n$clientSpec\n\nOutput:\n$Cmd::Output\n\n"); return 0; } } #------------------------------------------------------------------------------ =head2 GenGlobalWorkspace() GenGlobalWorkspace($I, $I, $I;) =head3 Description-GenGlobalWorkspace Generate a Perforce workspace with a wide view, seeing all depots of type 'local' the user has access to. Honors $NoOp and $Verbosity. In $NoOp mode, the workspace spec is shown, but the workspace is not created on the Perforce server. =head3 Parameters-GenGlobalWorkspace =over 4 =item * $I =item * $I =item * $I =back =head3 Output-GenGlobalWorkspace Displays a message indicating workspace creation, or an error message. Honors $Verbosity setting. =head3 Returns-GenGlobalWorkspace None. =head3 Examples-GenGlobalWorkspace Sample call: Clogdie ("Failed to create global workspace.");> =cut sub GenGlobalWorkspace($$$;) { $Msg->trace ("CALL MinP4::GenGlobalWorkspace(@_)\n"); my ($P4PORT, $P4USER, $P4CLIENT) = @_; my $tmpFile; my $clientSpec; my $depot; my $hostname = `hostname`; chomp $hostname; $clientSpec = "Client: $P4CLIENT\n\nOwner: $P4USER\n\nHost: $hostname\n\nDescription:\n\tGenerated workspace.\n\nRoot: /p4/1/tmp/ws/$P4CLIENT\n\nOptions: noallwrite noclobber nocompress unlocked modtime rmdir\n\nSubmitOptions: revertunchanged\n\nLineEnd: local\n\nView:\n"; # Get the list of all local depots, but don't display it even in high verbosity mode. Cmd::Run ("/p4/common/bin/p4 -p $P4PORT -u $P4USER -c none -s depots", "Getting list of local depots visible to user $P4USER.", 1, $TRACE); foreach (split '\n', $Cmd::Output) { next unless /^info: Depot .* \d{4}\/\d{2}\/\d{2} local /; s/^info: Depot //; s/ .*$//; chomp; $depot = $_; $clientSpec = "$clientSpec\t//$depot/... //$P4CLIENT/$depot/...\n"; } $clientSpec = "$clientSpec\n"; if ($NoOp) { $Msg->debug ("No-Op: Would have generated workspace with this spec:\n$clientSpec\n"); return 1; } $tmpFile = Misc::GenTempFilename(); open (TMP, ">$tmpFile") or $Msg->logdie ("Error: Failed to create temp file [$tmpFile]: $!\n"); print TMP $clientSpec; close (TMP); Cmd::Run ("/p4/common/bin/p4 -p $P4PORT -u $P4USER -c $P4CLIENT -s client -i < $tmpFile", "Generating workspace [$P4CLIENT].", 0, $INFO); if ($Cmd::Output =~ /exit: 0/) { $Msg->info ("Generated workspace [$P4CLIENT]."); return 1; } else { $Msg->error ("Failed to generate workspace [$P4CLIENT].\n\nSpec:\n$clientSpec\n\nOutput:\n$Cmd::Output\n\n"); return 0; } } #------------------------------------------------------------------------------ =head2 GenStreamWorkspace() GenStreamWorkspace($I, $I, $I, $I;) =head3 Description-GenStreamWorkspace Generate a Perforce workspace with a wide view, seeing all depots of type 'local' the user has access to. Honors $NoOp and $Verbosity. In $NoOp mode, the workspace spec is shown, but the workspace is not created on the Perforce server. =head3 Parameters-GenStreamWorkspace =over 4 =item * $I =item * $I =item * $I =item * $I =back =head3 Output-GenStreamWorkspace Displays a message indicating workspace creation, or an error message. Honors $Verbosity setting. =head3 Returns-GenStreamWorkspace None. =head3 Examples-GenStreamWorkspace Sample call: Clogdie ("Failed to create global workspace.");> =cut sub GenStreamWorkspace($$$$;) { $Msg->trace ("CALL MinP4::GenStreamWorkspace(@_)\n"); my ($P4PORT, $P4USER, $P4CLIENT, $stream) = @_; my $tmpFile; my $clientSpec; my $hostname = `hostname`; chomp $hostname; $clientSpec = "Client: $P4CLIENT\n\nOwner: $P4USER\n\nHost: $hostname\n\nDescription:\n\tGenerated workspace.\n\nRoot: /p4/1/tmp/ws/$P4CLIENT\n\nOptions: noallwrite noclobber nocompress unlocked modtime rmdir\n\nSubmitOptions: revertunchanged\n\nLineEnd: local\n\nStream: $stream\n\n"; if ($NoOp) { $Msg->debug ("No-Op: Would have generated workspace with this spec:\n$clientSpec\n"); return 1; } $tmpFile = Misc::GenTempFilename(); open (TMP, ">$tmpFile") or $Msg->logdie ("Error: Failed to create temp file [$tmpFile]: $!\n"); print TMP $clientSpec; close (TMP); Cmd::Run ("/p4/common/bin/p4 -p $P4PORT -u $P4USER -c $P4CLIENT -s client -i < $tmpFile", "Generating workspace [$P4CLIENT] for stream [$stream].", 0, $INFO); if ($Cmd::Output =~ /exit: 0/) { $Msg->info ("Generated stream workspace [$P4CLIENT]."); return 1; } else { $Msg->error ("Failed to generate workspace [$P4CLIENT].\n\nSpec:\n$clientSpec\n\nOutput:\n$Cmd::Output\n\n"); return 0; } } #------------------------------------------------------------------------------ =head2 GetBranchPaths() GetBranchPaths ($I, $I, \@I, $I) =head3 Description-GetBranchPaths Populate an array with source or target paths of a branch spec. This routine properly handles paths with spaces in the name. =head3 Parameters-GetBranchPaths =over 4 =item * $I The name of the branch spec. =item * $I Pass 1 for paths on the left side of the branch spec, or 2 for paths on the right. =item * \@I Pass in a reference to the array of paths to populate. =item * $I Set to 1 to keep Exclusionary mappings in the reivew returned. By default, they are excluded. =back =head3 Returns-GetBranchPaths Returns 1 on and populates the paths array, or 0 on error. =head3 Examples-GetBranchPaths =head4 Get Source Branch Paths: C C Clogdie ("Couldn't get branch paths.");> =head4 Get Target Branch Paths: C C C =cut #------------------------------------------------------------------------------ sub GetBranchPaths ($$$;$) { $Msg->trace("CALL MinP4::GetBranchPaths (@_)"); my ($branchSpecName, $sourceOrTarget, $pathsArrayRef, $keepExclusions) = @_; my $path; my $i = 0; Cmd::Run ("p4 -ztag branch -o $branchSpecName", "Getting details for branch spec [$branchSpecName]", 1, $DEBUG); if ($Cmd::Output =~ /\.\.\. Access /) { if ($sourceOrTarget == 1) { foreach (split ('\n', $Cmd::Output)) { next unless (/^\.\.\. View\d+ /); s/^\.\.\. View\d+ //; if (/^\-/ or /^\"\-/) { next unless ($keepExclusions); } # Consider entries with and without spaces needing double # quotes, and with and without exclusionary mappings. if (/\"\-\/\//) { s/^.*\"\/\//\"\-\/\//; } elsif (/\-\/\//) { s/^.*\-\/\//\-\/\//; } elsif (/\"\/\//) { s/^.*\"\-\/\//\"\-\/\//; } else { s/^.*\/\//\/\//; } #if (/\"/) { $_ = "\"$_"; } $Msg->trace ("Adding source path [$_].\n"); @$pathsArrayRef[$i++] = $_; } } else { foreach (split ('\n', $Cmd::Output)) { next unless (/^\.\.\. View\d+ /); s/^\.\.\. View\d+ //; s/ \"*\/\/.*$//s; if (/^\-/ or /^\"\-/) { next unless ($keepExclusions); } $Msg->trace ("Adding target path [$_].\n"); @$pathsArrayRef[$i++] = $_; } } } elsif ($Cmd::Output =~ /\.\.\. Branch /) { $Msg->error ("Branch [$branchSpecName] does not exist."); return 0; } else { $Msg->error ("Failed to process branch spec [$branchSpecName]:\n$Cmd::Output\n"); return 0; } return 1; } #------------------------------------------------------------------------------ =head2 GetChangelistFiles() GetChangelistFiles ($I, \@I; $I) =head3 Description-GetChangelistFiles Populate an array with file paths from a changelist. This routine properly handles paths with spaces in the name. =head3 Parameters-GetChangelistFiles =over 4 =item * $I Provide 'p4 describe' output changelist info obtained by a command like the this sample: C =item * =item * \@I Pass in a reference to the array of paths to populate. =item * $I Set to 1 to keep Exclusionary mappings in the returned. By default, they are excluded. =back =head3 Returns-GetChangelistFiles Returns 1 on and populates the paths array, or 0 on error. =head3 Examples-GetChangelistFiles =head4 Get changes from change 31110 C C C Clogdie ("Couldn't get files paths.");> =cut #------------------------------------------------------------------------------ sub GetChangelistFiles ($$;) { $Msg->trace("CALL MinP4::GetChangelistFiles (@_)"); my ($changelist, $filesArrayRef) = @_; my $file; my $i = 0; Cmd::Run ("p4 -ztag describe -s $changelist", "Getting changelist data.", 1, $DEBUG); if ($Cmd::Output =~ /\.\.\. change /) { foreach (split ('\n', $Cmd::Output)) { next unless /^\.\.\. depotFile\d+ /; $file = $_; $file =~ s/^\.\.\. depotFile\d+ //; chomp $file; @$filesArrayRef[$i++] = $file; } } else { $Msg->logdie ("Could not get details for change %changelist:\n$Cmd::Output\nAborting\n"); } if ($Cmd::Verbosity >= $DEBUG) { $Msg->debug("Changelist files:"); foreach (@$filesArrayRef) { print "$_\n"; } } } # Return package load success. 1;