tools/p4_description_change_controller.pl

   1 #! /usr/bin/perl
   2
   3 use warnings;
   4 use strict;
   5 use Socket;
   6
   7 # ======================================================================
   8 # Globals
   9 # ======================================================================
  10
  11 my $perforceBox         = "aus-perforce1.soe.sony.com";
  12 my $port                = "42845";
  13 my $tmpfile             = "tmpchangelist.txt";
  14
  15 my $name = $0;
  16 $name =~ s/^(.*)\\//;
  17
  18 my $user;
  19 my $changelist;
  20
  21 # ======================================================================
  22 # Subroutines
  23 # ======================================================================
  24
  25 sub usage
  26 {
  27         print STDERR "\nUsage:\n";
  28         print STDERR "\t$name <changelist>\n\n";
  29         die "\n";
  30 }
  31
  32 # ======================================================================
  33 # Main
  34 # ======================================================================
  35
  36 usage() if (@ARGV != 1);
  37
  38 $changelist = shift;
  39
  40 # verify perforce user (p4 user -o)
  41 # get user name
  42 # verify password is set
  43 my $passwd = 0;
  44
  45 open(P4, "p4 user -o |") || die "p4 user failed\n";
  46 while(<P4>)
  47 {
  48         $user = $1 if(/^User:\s+(\S+)/);
  49         $passwd = 1 if(/^Password:\s+\*+/);
  50 }
  51 close(P4);
  52
  53 die "Password is not set\n" if(!$passwd);
  54
  55 # get changelist
  56 # verify changelist's user was the same
  57 my @oldchange;
  58 open(CHANGE, ">$tmpfile");
  59 open(P4, "p4 change -o $changelist |") || die "error executing p4 change -o";
  60 while(<P4>)
  61 {
  62         push @oldchange, $_;
  63         print CHANGE $_;
  64
  65         if(/^User:\s+(\S+)/ && $user ne $1)
  66         {
  67                 close(P4);
  68                 close(CHANGE);
  69                 unlink($tmpfile);
  70                 die "Error: Cannot edit another user's changelist\n";
  71         }
  72 }
  73 close(P4);
  74 close(CHANGE);
  75
  76 # pop up editor and let user make changes to the text (P4EDITOR, EDITOR, VISUAL)
  77 my $editor = "emacs";
  78 $editor = "notepad.exe" if(exists $ENV{WINDIR});
  79 $editor = $ENV{VISUAL} if(exists $ENV{VISUAL});
  80 $editor = $ENV{EDITOR} if(exists $ENV{EDITOR});
  81 $editor = $ENV{P4EDITOR} if(exists $ENV{P4EDITOR});
  82
  83 system("$editor $tmpfile");
  84
  85 # verify only the description text has changed
  86 my $current = "";
  87 my $buffer = "";
  88 open(CHANGE, "<$tmpfile");
  89 while(<CHANGE>)
  90 {
  91         my $elem = shift @oldchange;
  92
  93         $current = $1 if(/^(\w+):/);
  94
  95         if(!defined $elem || $elem ne $_)
  96         {
  97                 close(CHANGE);
  98                 unlink($tmpfile);
  99                 die "Error: Can only change description of changelist\n";
 100         }
 101
 102         if($current eq "Description")
 103         {
 104                 $buffer = "Description:\n";
 105
 106                 while(<CHANGE>)
 107                 {
 108                         $buffer .= $_;
 109
 110                         if(/^(\w+):/)
 111                         {
 112                                 $current = $1;
 113                                 last;
 114                         }
 115                 }
 116                 while(@oldchange)
 117                 {
 118                         my $tmp = shift @oldchange;
 119                         if($tmp =~ /^(\w+):/)
 120                         {
 121                                 $current = $1;
 122                                 last;
 123                         }
 124                 }
 125         }
 126 }
 127 close(CHANGE);
 128 die "Error: Can only change description of changelist\n" if(@oldchange);
 129
 130 # send the data to the daemon
 131 socket(PERFORCE, PF_INET, SOCK_STREAM, getprotobyname('tcp')) || die "socket failed\n";
 132 {
 133         my $destination = inet_aton($perforceBox) || die "inet_aton failed\n";
 134         my $paddr = sockaddr_in($port, $destination);
 135         connect(PERFORCE, $paddr) || die "connect failed\n";
 136
 137         # unbuffer the socket
 138         my $oldSelect = select(PERFORCE);
 139         $| = 1;
 140         select($oldSelect);
 141
 142         # put the socket into binary mode
 143         binmode PERFORCE;
 144 }
 145
 146 print PERFORCE pack("N", length "$user $changelist");
 147 print PERFORCE "$user $changelist";
 148
 149 print PERFORCE pack("N", length $buffer);
 150 print PERFORCE $buffer;
 151
 152 die "Error getting response from Perforce server\n" if(read(PERFORCE, $buffer, 1) != 1);
 153
 154 if($buffer eq "P")
 155 {
 156         print "Successfully updated changelist\n";
 157 }
 158 else
 159 {
 160         print "Error updating changelist\n";
 161 }
 162
 163 close(PERFORCE);
 164 unlink($tmpfile);