--- /dev/null
+package Perforce;
+
+use strict;
+use warnings;
+
+use Carp;
+use File::Basename;
+use File::Temp;
+
+use P4;
+use Authen::Simple::LDAP;
+
+use Display;
+use GetConfig;
+use Utils;
+
+our $VERSION = '$Revision: 2.23 $';
+ ($VERSION) = ($VERSION =~ /\$Revision: (.*) /);
+
+my $p4config = $ENV{P4_CONF} || dirname (__FILE__) . '/../etc/p4.conf';
+my $ldapconfig = $ENV{LDAP_CONF} || dirname (__FILE__) . '/../etc/LDAP.conf';
+
+my %P4OPTS = GetConfig $p4config if -r $p4config;
+my %LDAPOPTS = GetConfig $ldapconfig if -r $ldapconfig;
+
+my $serviceUser = 'shared';
+my ($domain, $password);
+my $defaultPort = 'perforce:1666';
+my $p4tickets = $^O =~ /win/i ? 'C:/Program Files/Devops/Perforce/p4tickets'
+ : '/opt/audience/perforce/p4tickets';
+
+my $keys;
+
+# If USERDOMAIN is set and equal to audience then set $domain to ''. This will
+# use the Audience domain settings in LDAP.conf.
+if ($ENV{USERDOMAIN}) {
+ if (lc $ENV{USERDOMAIN} eq 'audience') {
+ $domain = '';
+ } else {
+ $domain = $ENV{USERDOMAIN}
+ } # if
+} # if
+
+sub new (;%) {
+ my ($class, %parms) = @_;
+
+ my $self = bless {}, $class;
+
+ $self->{P4USER} = $parms{username} || $P4OPTS{P4USER} || $ENV{P4USER} || $serviceUser;
+ $self->{P4PASSWD} = $parms{password} || $P4OPTS{P4PASSWD} || $ENV{P4PASSWD} || undef;
+ $self->{P4CLIENT} = $parms{p4client} || $P4OPTS{P4CLIENT} || $ENV{P4CLIENT} || undef;
+ $self->{P4PORT} = $parms{p4port} || $ENV{P4PORT} || $defaultPort;
+
+ $self->{P4} = $self->connect (%parms);
+
+ return $self;
+} # new
+
+sub errors ($;$) {
+ my ($self, $cmd, $exit) = @_;
+
+ my $msg = "Unable to run \"p4 $cmd\"";
+ my $errors = $self->{P4}->ErrorCount;
+
+ error "$msg\n" . $self->{P4}->Errors, $exit if $errors;
+
+ return $errors;
+} # errors
+
+sub connect () {
+ my ($self) = @_;
+
+ $self->{P4} = P4->new;
+
+ $self->{P4}->SetUser ($self->{P4USER});
+ $self->{P4}->SetClient ($self->{P4CLIENT}) if $self->{P4CLIENT};
+ $self->{P4}->SetPort ($self->{P4PORT});
+ $self->{P4}->SetPassword ($self->{P4PASSWD}) unless $self->{P4USER} eq $serviceUser;
+
+ verbose_nolf "Connecting to Perforce server $self->{P4PORT}...";
+ $self->{P4}->Connect or croak "Unable to connect to Perforce Server\n";
+ verbose 'done';
+
+ verbose_nolf "Logging in as $self->{P4USER}\@$self->{P4PORT}...";
+
+ unless ($self->{P4USER} eq $serviceUser) {
+ $self->{P4}->RunLogin;
+
+ $self->errors ('login', $self->{P4}->ErrorCount);
+ } else {
+ $ENV{P4TICKETS} = $p4tickets if $self->{P4USER} eq $serviceUser;
+ } # unless
+
+ verbose 'done';
+
+ return $self->{P4};
+} # connect
+
+sub authenticateUser ($;$) {
+ my ($self, $username, $p4client) = @_;
+
+ # Connect to LDAP
+ my $ad = Authen::Simple::LDAP->new (
+ host => $LDAPOPTS{AD_HOST},
+ basedn => $LDAPOPTS{AD_BASEDN},
+ port => $LDAPOPTS{AD_PORT},
+ filter => $LDAPOPTS{AD_FILTER},
+ ) or croak $@;
+
+ # Read the password from <stdin> and truncate the newline - unless we already
+ # read in the password
+ unless ($password) {
+ if (-t STDIN) {
+ $password = GetPassword;
+ } else {
+ $password = <STDIN>;
+
+ chomp $password;
+ } # if
+ } # unless
+
+ # Special handling of "shared" user
+ if ($username eq 'shared') {
+ my $sharedAcl = "$FindBin::Bin/sharedAcl.txt";
+
+ croak "Unable to find file $sharedAcl" unless -f $sharedAcl;
+
+ open my $sharedAcls, '<', $sharedAcl
+ or croak "Unable to open $sharedAcl - $!";
+
+ chomp (my @acls = <$sharedAcls>);
+
+ close $sharedAcls;
+
+ for (@acls) {
+ if (/\*$/) {
+ chop;
+
+ exit if $p4client =~ /$_/;
+ } else {
+ exit if $_ eq $p4client;
+ } # if
+ } # for
+ } # if
+
+ # Connect to Perforce
+ $self->connect unless $self->{P4};
+
+ # Must be a valid Perforce user
+ return unless $self->getUser ($username);
+
+ # And supply a valid username/password
+ return $ad->authenticate ($username, $password);
+} # authenticateUser
+
+sub change ($) {
+ my ($self, $changelist) = @_;
+
+ my $change = $self->{P4}->Run ('change', '-o', $changelist);
+
+ return $change->[0];
+} # change
+
+sub changelist ($) {
+ my ($self, $changelist) = @_;
+
+ goto change;
+} # changelist
+
+sub changes (;$%) {
+ my ($self, $args, %opts) = @_;
+
+ my $cmd = 'changes';
+
+ for (keys %opts) {
+ if (/from/i and $opts{to}) {
+ $args .= " $opts{$_},$opts{to}";
+
+ delete $opts{to};
+ } else {
+ $args .= " $opts{$_}";
+ } # if
+ } # for
+
+ my $changes = $self->{P4}->Run ($cmd, $args);
+
+ return $self->errors ("$cmd $args") || $changes;
+} # changes
+
+sub job ($) {
+ my ($self, $job) = @_;
+
+ my $jobs = $self->{P4}->IterateJobs ("-e $job");
+
+ return $self->errors ("jobs -e $job") || $job;
+} # job
+
+sub comments ($) {
+ my ($self, $changelist) = @_;
+
+ my $change = $self->{P4}->FetchChange ($changelist);
+
+ return $self->errors ("change $changelist") || $change;
+} # comments
+
+sub files ($) {
+ my ($self, $changelist) = @_;
+
+ my $files = $self->{P4}->Run ('files', "\@=$changelist");
+
+ return $self->errors ("files \@=$changelist") || $files;
+} # files
+
+sub filelog ($;%) {
+ my ($self, $fileSpec, %opts) = @_;
+
+ return $self->{P4}->RunFilelog ($fileSpec, %opts);
+} # filelog
+
+sub getRevision ($;$) {
+ my ($self, $filename, $revision) = @_;
+
+ unless ($revision) {
+ if ($filename =~ /#/) {
+ ($filename, $revision) = split $filename, '#';
+ } else {
+ error "No revision specified in $filename";
+
+ return;
+ } # if
+ } # unlessf
+
+ my @contents = $self->{P4}->RunPrint ("$filename#$revision");
+
+ if ($self->{P4}->ErrorCount) {
+ $self->errors ("Print $filename#$revision");
+
+ return;
+ } else {
+ return @contents;
+ } # if
+} # getRevision
+
+sub getUser (;$) {
+ my ($self, $user) = @_;
+
+ $user //= $ENV{P4USER} || $ENV{USER};
+
+ my $cmd = 'user';
+ my @args = ('-o', $user);
+
+ my $userRecs = $self->{P4}->Run ($cmd, @args);
+
+ # Perforce returns an array of qualifying users. We only care about the first
+ # one. However if the username is invalid, Perforce still returns something
+ # that looks like a user. We look to see if there is a Type field here which
+ # indicates that it's a valid user
+ if ($userRecs->[0]{Type}) {
+ return %{$userRecs->[0]};
+ } else {
+ return;
+ } # if
+} # getUser
+
+sub renameSwarmUser ($$) {
+ my ($self, $oldusername, $newusername) = @_;
+
+ # We are turning this off because Perforce support says that just modifying
+ # the keys we do not update the indexing done in the Perforce Server/Database.
+ # So instead we have a PHP script (renameUser.php) which goes through the
+ # official, but still unsupported, "Swarm Record API" to change the usernames
+ # and call the object's method "save" which should perform the necessary
+ # reindexing... Stay tuned! :-)
+ #
+ # BTW One needs to run renameUser.php by hand as we do not do that here.
+ return;
+
+ $keys = $self->getKeys ('swarm-*') unless $keys;
+
+ for (@$keys) {
+ my %key = %$_;
+
+ if ($key{value} =~ /$oldusername/) {
+ $key{value} =~ s/\"$oldusername\"/\"$newusername\"/g;
+ $key{value} =~ s/\@$oldusername /\@$newusername /g;
+ $key{value} =~ s/\@$oldusername\./\@$newusername\./g;
+ $key{value} =~ s/\@$oldusername,/\@$newusername,/g;
+ $key{value} =~ s/ $oldusername / $newusername /g;
+ $key{value} =~ s/ $oldusername,/ $newusername,/g;
+ $key{value} =~ s/ $oldusername\./ $newusername\./g;
+ $key{value} =~ s/-$oldusername\"/-$newusername\"/g;
+
+ my $cmd = 'key';
+
+ display "Correcting key $key{key}";
+
+ my @result = $self->{P4}->Run ($cmd, $key{key}, $key{value});
+
+ $self->errors ($cmd, $result[0]->{key} || 1);
+ } # if
+ } # for
+
+ return;
+} # renameSwarmUser
+
+sub renameUser ($$) {
+ my ($self, $old, $new) = @_;
+
+ my $cmd = 'renameuser';
+ my @args = ("--from=$old", "--to=$new");
+
+ $self->{P4}->Run ($cmd, @args);
+
+ my $status = $self->errors (join ' ', $cmd, @args);
+
+ return $status if $status;
+
+# return $self->renameSwarmUser ($old, $new);
+} # renameUser
+
+sub updateUser (%) {
+ my ($self, %user) = @_;
+
+ # Trying to do this with P4Perl is difficult. First off the structure needs
+ # to be AOH and secondly you need to call SetUser to be the other user. That
+ # said you need to also specify -f to force the update (which means you must
+ # a admin (or superuser?) and I found no way to specify -f so I've reverted
+ # back to using p4 from the command line. I also don't like having to use
+ # a file here...
+ my $tmpfile = File::Temp->new;
+ my $tmpfilename = $tmpfile->filename;
+
+ print $tmpfile "User: $user{User}\n";
+ print $tmpfile "Email: $user{Email}\n";
+ print $tmpfile "Update: $user{Update}\n";
+ print $tmpfile "FullName: $user{FullName}\n";
+
+ close $tmpfile;
+
+ my @lines = `p4 -p $self->{P4PORT} user -f -i < $tmpfilename`;
+ my $status = $?;
+
+ return wantarray ? @lines : join '', @lines;
+} # updateUser
+
+sub getKeys (;$) {
+ my ($self, $filter) = @_;
+
+ my $cmd = 'keys';
+ my @args;
+
+ if ($filter) {
+ push @args, '-e';
+ push @args, $filter;
+ } # if
+
+ my $keys = $self->{P4}->Run ($cmd, @args);
+
+ $self->errors ($cmd . join (' ', @args), 1);
+
+ return $keys;
+} # getKeys
+
+sub key ($$) {
+ my ($self, $name, $value) = @_;
+
+ my $cmd = 'key';
+ my @args = ($name, $value);
+
+ $self->{P4}->Run ($cmd, @args);
+
+ return $self->errors (join ' ', $cmd, @args);
+} # key
+
+1;
projects / clearscm.git / commitdiff