#!/usr/bin/perl # # pb - Perforce Browser # # Copyright (c) 2000, 2001, Laurel Networks Inc. All rights reserved. # # Permission to use, copy, modify and distribute this software and # its documentation for any purpose and without fee is hereby granted, # provided that the above copyright notice appear in all copies and # that both that copyright notice and this permission notice appear # in supporting documentation, and that the name of Laurel Networks, Inc. # ("Laurel Networks") not be used in advertising or publicity pertaining to # distribution of the software without specific, written prior permission. # # LAUREL NETWORKS DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, # INCLUDING ANY WARRANTIES REGARDING INTELLECTUAL PROPERTY RIGHTS AND # ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR # PURPOSE. IN NO EVENT SHALL LAUREL NETWORKS BE LIABLE FOR ANY SPECIAL, # INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING # FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, # NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION # WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. # # Author: Brad Garcia <bgarcia@laurelnetworks.com> # # This Perforce Browser takes advantage of the perl CGI module, # as well as Javascript and the code2html perl script to make # browsing easier for the user. # use strict; ############################################################################## # # Global setup. You will most likely need to change the following values # in order for this script to function correctly. # A path on which we can find the following utilities: # p4, cat $ENV{PATH} = "/bin:/usr/bin:/usr/local/bin"; # The name of the user that this script will act as. $ENV{P4USER} = "browser"; # If you have the code2html script, then set this variable to the pathname # for the executable. If you don't have the script, set this to a null string. my $CODE2HTML = "code2html"; # If you have enscript available, place the entire pathname here. Otherwise, # set $ENSCRIPT to a null string. # If $ENSCRIPT is defined, then there will be a link available on pages that # show submitted and pending changes that allow you to print out the entire # change in a form suitable for code reviews. The second variable is a list # of arguments that need to be passed to enscript so that output is sent to # stdout (and to format the input nicely). my $ENSCRIPT = "/usr/bin/enscript"; my $ENSCRIPT_OPTS = ' -2rG -o -'; # If you have ghostscript available, place the entire pathname here. # Otherwise, set $GS to a null string. # This will make the code-review link output pdf instead of postscript. # This is needed to make the Windows users happy, since they # have apparently never heard of postscript <duck>. The second variable # is a list of arguments that need to be passed to ghostscript so that it # will read a postscript file on stdin, and write a pdf file on stdout. my $GS = "/usr/bin/gs"; my $GS_OPTS = " -q -dNOPAUSE -dBATCH -sDEVICE=pdfwrite -sOutputFile=- " . "-c save pop -f -"; # It seems that most users don't setup the email field in their user # definitions correctly. Sometimes it will have a host name but no domain, # or maybe nothing but the user name. # # If this field is set to some domain name, then we will replace everything # after the '@' with this domain name. my $DOMAIN = ""; # If you have a lot of files in your depot, The front page may take too long # to come up. For sites like these, you need to define a listfile for the # browser to read in. This is a list of all possible top-level depots. # # You can create one from your current depot by running "pb.pl createlist=1". # Just save standard output to a file and give the name of the file in the # following variable. # # Otherwise, just leave this variable blank. my $LISTFILE = ""; # If you define a listfile, it can be one of two styles - SIMPLE or DEFAULT. # If you want your listboxes to have the default behavior where common # directories must be selected before subdirectories appear, then set this # to DEFAULT. If you simply want every entry in the LISTFILE to appear as # a separate entry at the top level, set this to SIMPLE. my $LISTFILE_STYLE = "SIMPLE"; # If this variable is not null, then job names will simply be printed out. # Otherwise, this is a string that will be eval'ed, with the job name being # given in $_. It is expected that this little script will update $_ with # something different to print, like a hyperlink to a gnatsweb server that # would show the PR report. # # Example (for integrating with a gnats server at http://gnats): # my $JOB_LINK = 's|GNATS0*(\d+)|<a href="http://gnats?cmd=view' . # '&database=default&pr=$1">$1</a>|'; my $JOB_LINK = ''; # # End of Global setup. Nothing below this point needs to be changed. # ############################################################################## use CGI qw(:standard *blockquote *center *pre *table *td *Tr *em); use FileHandle; use IPC::Open2; use Text::Tabs; my $myname = $ENV{SCRIPT_NAME}; if (param('listfile')) { $LISTFILE = param('listfile'); } if (param('createlist')) { my @lookup = &make_depotlist(); for my $i ( 0 .. $#lookup ) { print "$lookup[$i]\n"; } exit 0; } my @lookup; if (param('command') eq 'change') { &p4_change(); } elsif (param('command') eq 'changes') { &p4_changes(); } elsif (param('command') eq 'client') { &p4_client(); } elsif (param('command') eq 'clients') { &p4_clients(); } elsif (param('command') eq 'diff') { &p4_diff(); } elsif (param('command') eq 'diff2') { &p4_diff2(); } elsif (param('command') eq 'filelog') { &p4_filelog(); } elsif (param('command') eq 'files') { &p4_files(); } elsif (param('command') eq 'print') { &p4_print(); } elsif (param('command') eq 'opened') { &p4_opened(); } elsif (param('command') eq 'print_diff_client') { &print_diff_client(); } elsif (param('command') eq 'print_diff_change') { &print_diff_change(); } else { my @dirs; if ($LISTFILE && (param('depotlist') ne 'default')) { if (!open P4, "$LISTFILE") { &start_with("Misconfiguration"); &bail("$myname: Couldn't open $LISTFILE\n"); } while (<P4>) { if (substr($_, length($_) - 1, 1) eq "\n") { chop $_; } push(@dirs, $_); } close P4; if ($LISTFILE_STYLE eq "SIMPLE") { @lookup = ( ["Choose one:", @dirs] ); } else { @lookup = &make_array(@dirs); } } else { @lookup = &make_depotlist(); @lookup = &make_array(@lookup); } my($depot_script) = "\n//Define the depot array\n"; $depot_script .= "a = new Array(" . ($#lookup + 1) . ")\n"; for my $i ( 0 .. $#lookup ) { $depot_script .= "a[$i] = new Array(" . ($#{$lookup[$i]} + 1) . ")\n"; for my $j ( 0 .. $#{$lookup[$i]} ) { $depot_script .= "a[$i][$j] = \"$lookup[$i][$j]\"\n"; } } $depot_script .= ("\n" . "function update_depot(form) {\n" . " if (!(form.depot.selectedIndex > 0)) {\n" . " form.depot.selectedIndex = 0\n" . " }\n" . " var val = form.depot.options[form.depot.selectedIndex].value\n" . " for (var i = 0; i <= " . $#lookup . "; i++) {\n" . " if (a[i][0] === val) {\n" . " var oldlength = form.depot.length\n" . " // Remove the old elements from options\n" . " for (var j = 0; j < oldlength; j++) {\n" . " form.depot.options[0] = null\n" . " }\n" . " // Insert the new elements into options\n" . " for (var j = 0; j < i; j++) {\n" . " for (var k = 1; k < a[j].length; k++) {\n" . " if (a[j][k] === a[i][0]) {\n" . " form.depot.options" . "[form.depot.options.length] = new Option(a[j][0], a[j][0])\n" . " }\n" . " }\n" . " }\n" . " for (var j = 0; j < a[i].length; j++) {\n" . " form.depot.options[form.depot.options.length] " . "= new Option(a[i][j], a[i][j])\n" . " }\n" . " form.depot.selectedIndex = (i == 0) ? 0 : 1\n" . " return true\n" . " }\n" . " }\n"); if (substr(param('command'), 0, 8) eq 'advanced') { $depot_script .= (" return true\n" . "}\n\n"); } else { $depot_script .= (" form.submit();\n" . " form.depot.selectedIndex = 0\n" . "}\n\n"); } print header, start_html(-bgcolor=>'white', -title=>'Perforce Browser', -script=>$depot_script), start_center, h1('Perforce Browser'), end_center; if (0) { # Print out the two-dimensional array print start_pre(); for my $i ( 0 .. $#lookup ) { print "$lookup[$i][0]: "; for my $j ( 1 .. $#{$lookup[$i]} ) { print "$lookup[$i][$j], "; } if ($#{$lookup[$i]} < 2) { print "(collapsable)"; } print "\n"; } print "\n"; print end_pre(); } if (substr(param('command'), 0, 8) eq 'advanced') { eval "&p4_" . param('command') . "()" || &p4_advanced_changes(); exit(0); } print start_table({-cellpadding=>0, -cellspacing=>3}), "\n\n"; # This is a little hack to get the input lines indented. print Tr(td(em("Enter a")), td({-colspan=>10}, em("change number here to view information about " . "a particular change:"))); print start_Tr(), start_form({-name=>'change', -method=>'GET'}), hidden('command', 'change'), "\n", td([' ', 'Change number:', textfield(-name=>'change', -onChange=>"document.change.submit();")]), "\n", end_form, end_Tr(), "\n\n"; print Tr(td({-colspan=>10}, em("View all clients matching a regular expression:"))); print start_Tr(), start_form({-name=>'clients', -method=>'GET'}), hidden('command', 'clients'), "\n", td([' ', 'Client name:', textfield(-name=>'client', -onChange=>"document.clients.submit();"), em('(A regular expression)')]), "\n", end_form, end_Tr(), "\n\n"; print Tr(td({-colspan=>10}, em("View the last 50 changes to a depot:"))); print start_Tr(), start_form({-name=>'changes', -method=>'GET'}), hidden('command', 'changes'), "\n", td([' ', 'Recent changes:', popup_menu(-name=>'depot', -values=>$lookup[0], -onChange=>'update_depot(document.changes)'), " (<a href=\"" . url() . "?command=advanced_changes" . (($LISTFILE && (param('depotlist') eq 'default')) ? "&depotlist=default" : "") . (param('listfile') ? ("&listfile=" . param('listfile')) : "") . "\">advanced</a> querying)" ]), "\n", end_form, end_Tr(), "\n\n"; print Tr(td({-colspan=>10}, em("View any pending changes to a depot here:"))); print start_Tr(), start_form({-name=>'opened', -method=>'GET'}), hidden('command', 'opened'), "\n", td([' ', 'Pending changes:', popup_menu(-name=>'depot', -values=>$lookup[0], -onChange=>'update_depot(document.opened)'), " (<a href=\"" . url() . "?command=advanced_opened" . (($LISTFILE && (param('depotlist') eq 'default')) ? "&depotlist=default" : "") . (param('listfile') ? ("&listfile=" . param('listfile')) : "") . "\">advanced</a> querying)" ]), "\n", end_form, end_Tr(), "\n\n"; print Tr(td({-colspan=>10}, em("Choose a depot to view all files within that depot:"))); print start_Tr(), start_form({-name=>'files', -method=>'GET'}), hidden('command', 'files'), "\n", td([' ', 'Files:', popup_menu(-name=>'depot', -values=>$lookup[0], -onChange=>'update_depot(document.files)'), " (<a href=\"" . url() . "?command=advanced_files" . (($LISTFILE && (param('depotlist') eq 'default')) ? "&depotlist=default" : "") . (param('listfile') ? ("&listfile=" . param('listfile')) : "") . "\">advanced</a> querying)" ]), "\n", end_form, end_Tr(), "\n\n"; print end_table(), "\n", hr; # Link to change listbox choices if ($LISTFILE && (param('depotlist') ne 'default')) { print em("To change the above depot listboxes to include all " . "possible depots, click " . "<a href=\"" . url() . "?depotlist=default\">here</a>"); } elsif ($LISTFILE) { print em("To change the above depot listboxes back to the standard " . "list of depots, click <a href=\"" . url() . "\">here</a>"); } print end_html; } exit(0); sub make_depotlist { # First, get a list of all files. # Change this into a list of all directories my (@dirs, $dir); &p4open(\*P4, 'p4 files //...'); while (<P4>) { /(\S+)\/[^\#]+\#/; if (((substr($1, 0, length($dir) + 1) ne $dir . '/') && ($1 ne $dir)) || (length($dir) == 0)) { #if ($1 ne $dir) { $dir = $1; push @dirs, $dir; # print $dir . "\n"; } } # print "\n"; close P4; return @dirs; } sub make_array { my (@dirs) = @_; # Next, change this into a two-dimensional array my (@lookup); foreach my $dir (@dirs) { my (@dirs2) = split(/\//, , $dir); for (my $i = 3; $i < scalar(@dirs2); $i++) { my(@tdirs2) = @dirs2; splice(@tdirs2, $i); my $tdir = join('/', @tdirs2); # print $tdir . " : " . $dirs2[$i] . "\n"; # Now, see if there is an entry for $tdir in @lookup my $gotkey = 0; foreach my $j (@lookup) { if ($j->[0] eq $tdir) { $gotkey = 1; my $gotit = 0; for my $k ( 1 .. $#{$j} ) { if ($j->[$k] eq $tdir . '/' . $dirs2[$i]) { $gotit = 1; last; } } if ($gotit == 0) { push @$j, $tdir . '/' . $dirs2[$i]; } } } if ($gotkey == 0) { push @lookup, [ $tdir, $tdir . '/' . $dirs2[$i] ]; } } } # Collapse the rows with only a single child. for (my $i = 0; $i <= $#lookup; ) { if ($#{$lookup[$i]} < 2) { my ($gotit) = 0; for my $j ( 0 .. $i ) { for my $k ( 1 .. $#{$lookup[$j]} ) { if ($lookup[$j][$k] eq $lookup[$i][0]) { $lookup[$j][$k] = $lookup[$i][1]; splice @lookup, $i, 1; $gotit = 1; last; } } if ($gotit) { last; } } } else { $i++; } } return @lookup; } # # advanced files querying # sub p4_advanced_files { print start_form({-name=>'files', -method=>'GET'}); print start_table({-cellpadding=>0, -cellspacing=>3}), "\n\n"; # This is a little hack to get the input lines indented. print Tr(td(em("Show a")), td({-colspan=>10}, em("subset of files in the depot:"))); print Tr([ td([' ', 'Depot:', popup_menu(-name=>'depot', -values=>$lookup[0], -onChange=>'update_depot(document.changes)') ]), td([' ', 'File name:', textfield(-name=>'file'), em('(A p4 file specification)') ]), td([' ', ' ', submit('command', 'files')]), ]), "\n\n"; print end_table(), end_form(), "\n", hr; # Link to change listbox choices if ($LISTFILE && (param('depotlist') ne 'default')) { print em("To change the above depot listboxes to include all " . "possible depots, click <a href=\"" . url() . "?command=advanced_files&depotlist=default\">here</a>"); } elsif ($LISTFILE) { print em("To change the above depot listboxes back to the standard " . "list of depots, click " . "<a href=\"" . url() . "?command=advanced_files\">here</a>"); } # Normal querying link print br, start_em, "Go back to the <a href=\"" . url(); if ($LISTFILE && (param('depotlist') eq 'default')) { print "?depotlist=default"; if (param('listfile')) { print "&listfile=", param('listfile'); } } elsif (param('listfile')) { print "?listfile=", param('listfile'); } print "\">main page</a>.", end_em(); print end_html; } # # advanced changes querying # sub p4_advanced_changes { print start_form({-name=>'changes', -method=>'GET'}); print start_table({-cellpadding=>0, -cellspacing=>3}), "\n\n"; # This is a little hack to get the input lines indented. print Tr(td(em("Query on")), td({-colspan=>10}, em("changes to the depot:"))); print Tr([ td([' ', 'Depot:', popup_menu(-name=>'depot', -values=>$lookup[0], -onChange=>'update_depot(document.changes)') ]), td([' ', 'File name:', textfield(-name=>'file'), em('(A p4 file specification)') ]), td([' ', 'User name:', textfield(-name=>'user'), em('(A regular expression)') ]), td([' ', 'Client name:', textfield(-name=>'client'), em('(A regular expression)') ]), td([' ', 'Max Changes:', textfield(-name=>'maximum'), em('(A number)') ]), td([' ', ' ', submit('command', 'changes')]), ]), "\n\n"; print end_table(), end_form(), "\n", hr; # Link to change listbox choices if ($LISTFILE && (param('depotlist') ne 'default')) { print em("To change the above depot listboxes to include all " . "possible depots, click <a href=\"" . url() . "?command=advanced_changes&depotlist=default\">here</a>"); } elsif ($LISTFILE) { print em("To change the above depot listboxes back to the standard " . "list of depots, click " . "<a href=\"" . url() . "?command=advanced_changes\">here</a>"); } # Normal querying link print br, start_em, "Go back to the <a href=\"" . url(); if ($LISTFILE && (param('depotlist') eq 'default')) { print "?depotlist=default"; if (param('listfile')) { print "&listfile=", param('listfile'); } } elsif (param('listfile')) { print "?listfile=", param('listfile'); } print "\">main page</a>.", end_em(); print end_html; } # # advanced opened querying # sub p4_advanced_opened { print start_form({-name=>'opened', -method=>'GET'}); print start_table({-cellpadding=>0, -cellspacing=>3}), "\n\n"; # This is a little hack to get the input lines indented. print Tr(td(em("Query on")), td({-colspan=>10}, em("pending changes to the depot:"))); print Tr([ td([' ', 'Depot:', popup_menu(-name=>'depot', -values=>$lookup[0], -onChange=>'update_depot(document.opened)') ]), td([' ', 'File name:', textfield(-name=>'file'), em('(A p4 file specification)') ]), td([' ', 'User name:', textfield(-name=>'user'), em('(A regular expression)') ]), td([' ', 'Client name:', textfield(-name=>'client'), em('(A regular expression)') ]), td([' ', ' ', submit('command', 'opened')]), ]), "\n\n"; print end_table(), end_form(), "\n", hr; # Link to change listbox choices if ($LISTFILE && (param('depotlist') ne 'default')) { print em("To change the above depot listboxes to include all " . "possible depots, click <a href=\"" . url() . "?command=advanced_opened&depotlist=default\">here</a>"); } elsif ($LISTFILE) { print em("To change the above depot listboxes back to the standard " . "list of depots, click " . "<a href=\"" . url() . "?command=advanced_opened\">here</a>"); } # Normal querying link print br, start_em, "Go back to the <a href=\"" . url(); if ($LISTFILE && (param('depotlist') eq 'default')) { print "?depotlist=default"; if (param('listfile')) { print "&listfile=", param('listfile'); } } elsif (param('listfile')) { print "?listfile=", param('listfile'); } print "\">main page</a>.", end_em(); print end_html; } # # p4 change # sub p4_change { &start_with('Change ' . param('change')); my $cmd = 'p4 describe -s ' . param('change'); &p4open(\*P4, $cmd); $_ = <P4>; my($user, $client, $date, $time); if (!(($user, $client, $date, $time) = /^Change \d+ by (\S*)@(\S*) on (\S*) (\S*)$/)) { print "Sorry, there is no such change recorded\n"; &print_cmds($cmd); print end_html; close P4; return; } my($description); while ( <P4> ) { last if /^Jobs fixed/; last if /^Affected files/; $description .= &protect_html($_) . "<br>\n"; } my $last_line = $_; print table({-cellpadding=>1, -cellspacing=>1}, Tr([ td(['User:', &email_url($user)]), td(['Client:', &client_url($client)]), td(['Date:', $date]), td(['Time:', $time]), td({-valign=>"top"}, ['Description:', $description]), ])), "\n"; if ($last_line =~ /^Jobs fixed/) { print br, b('Jobs fixed'); print start_table({-cellpadding=>2, -cellspacing=>1}), Tr(th(['Name', 'Date', 'User', 'State', 'Description'])), "\n"; while ( <P4> ) { last if /^Affected files/; if (my($jname, $jdate, $juser, $jstate) = /(\S+) on (\S+) by (\S+) (\S+)/) { <P4>; # skip blank line my $jdesc; while ( <P4> ) { last if (/^\s*$/); $jdesc .= &protect_html($_) . "<br>\n"; } if ($JOB_LINK ne '') { $_ = $jname; eval $JOB_LINK; $jname = $_; } print Tr({-valign=>"top"}, [td([$jname, $jdate, &email_url($juser), $jstate, $jdesc])]), "\n"; } } print end_table(), "\n"; } print br, b('Files affected'); if ($ENSCRIPT ne '') { print start_em . " (print <a href=\"" . url() . "?command=print_diff_change&change=" . param('change') . "\">code review</a>)" . end_em; } print ":\n"; print start_table({-cellpadding=>1, -cellspacing=>1}); print Tr({-align=>'left'}, th(['File', 'Rev', 'Action'])), "\n"; while ( <P4> ) { if (my($filename, $revision, $action) = /^... ([^\#]+)\#(\d+) (\S+)/) { print start_Tr(); print td([&filelog_url($filename)]), td({-align=>'right'}, [&print_url($filename, $revision, $action)]); if (($action eq 'edit') || ($action eq 'integrate')) { print td(&diff2_url($filename, $revision, $action)); } else { print td($action); } print end_Tr(), "\n"; } } print end_table; &print_cmds($cmd); print end_html; close P4; } # # p4 changes # sub p4_changes { my $max = " -m 50"; if (param('maximum') && (param('maximum') ne '')) { if (param('maximum') == 0) { $max = ''; } else { $max = " -m " . param('maximum'); } } my $depot = param('depot'); if (param('file') && (param('file') ne '')) { if (substr(param('file'), 0, 1) ne '/') { $depot .= '/'; } $depot .= param('file'); } elsif (substr($depot, -4, 4) ne '/...') { $depot .= '/...'; } &start_with('Changes to ' . $depot); print em("You may also view this depot's " . "<a href=\"" . url() . "?command=files&depot=" . $depot . "\">files</a> and " . "<a href=\"" . url() . "?command=opened&depot=" . $depot . "\">pending changes</a>."), br, br; my $cmd = "p4 changes -l$max " . $depot; # Get change information &p4open(\*P4, $cmd); print start_table({-cellpadding=>1, -cellspacing=>1}); print Tr({-align=>'left'}, th(['Change', 'Date', 'User', 'Client', 'Description'])), "\n"; my($change, $date, $user, $client, $description); my($print) = 0; while (<P4>) { if (my($nchange, $ndate, $nuser, $nclient) = /^Change (\S+) on (\S+) by ([^@]+)@(\S+)/) { $print = 1; if (param('user') && (param('user') ne '')) { my $regexp = param('user'); if (!($user =~ /$regexp/)) { $print = 0; } } if (param('client') && (param('client') ne '')) { my $regexp = param('client'); if (!($client =~ /$regexp/)) { $print = 0; } } if ($print) { $description = &protect_html($description); $description =~ s/\n\s*\n/<br><br>\n/g; print start_Tr({-valign=>"top"}); print td({-align=>"right"},[&change_url($change)]); print td([$date]); print td([&email_url($user)]); print td([&client_url_wbr($client)]); print td([$description]); print end_Tr(); } $change = $nchange; $date = $ndate; $user = $nuser; $client = $nclient; $description = ''; # Skip the blank line following this. <P4>; } else { $description .= $_; } } if (param('user') && (param('user') ne '')) { my $regexp = param('user'); if (!($user =~ /$regexp/)) { $print = 0; } } if (param('client') && (param('client') ne '')) { my $regexp = param('client'); if (!($client =~ /$regexp/)) { $print = 0; } } if ($print) { $description = &protect_html($description); $description =~ s/\n\s*\n/<br><br>\n/g; print start_Tr({-valign=>"top"}); print td({-align=>"right"},[&change_url($change)]); print td([$date]); print td([&email_url($user)]); print td([&client_url_wbr($client)]); print td([$description]); print end_Tr(); } print end_table; close P4; &print_cmds($cmd); print end_html; } # # p4 client # sub p4_client { &start_with('Client ' . param('client')); $ENV{P4CLIENT} = param('client'); my @cmds = ('p4 client -o ' . param('client'), 'p4 opened'); &p4open(\*P4, $cmds[0]); my($update, $access, $owner, $host, $description, $root, $options); my(@view1, @view2); while ( <P4> ) { if (/^Update:\s+(.+)$/) { $update = $1; } if (/^Access:\s+(.+)$/) { $access = $1; } if (/^Owner:\s+(\S+)/) { $owner = $1; } if (/^Host:\s+(\S+)/) { $host = $1; } if (/^Root:\s+(\S+)/) { $root = $1; } if (/^Options:\s+(.+)$/) { $options = $1; } if (/^Description:/) { $_ = <P4>; ($description) = /^\s+(.+)$/; } if (/^View:/) { while ( <P4> ) { if (/^\s+(\S+)\s+(\S+)$/) { push(@view1, $1); push(@view2, $2); } } } } print start_table({-cellpadding=>1, -cellspacing=>1}); print Tr([ td(['Owner:', &email_url($owner)]), td(['Host:', $host]), td(['Last Update:', $update]), td(['Last Access:', $access]), td(['Root:', &root_url($root)])]); print start_Tr(); print td({-valign=>"top"}, ['View:']); print start_td(); print start_table({-cellpadding=>1, -cellspacing=>1}); while (@view1) { my $view1 = pop(@view1); my $view2 = pop(@view2); print td([&opened_url($view1), $view2]); } print end_table(); print end_td(); print end_Tr(); print "\n"; print end_table(); close P4; &p4open(\*P4, $cmds[1]); if (param('show')) { print br, b("All files"); print em(" (Click <a href = \"" . url() . "?command=client&client=" . param('client') . "\">here</a> to view only opened files)"); print br, br; push (@cmds, 'p4 files @' . param('client')); &p4open(\*P5, $cmds[2]); print start_table({-cellpadding=>1, -cellspacing=>1}); if ($host eq "") { print Tr({-align=>'left'}, th(['File', 'Rev', 'Action'])), "\n"; } my($p_filename, $p_revision, $p_action, $gotpend); while ($gotpend = <P4>) { $_ = $gotpend; if ( ($p_filename, $p_revision, $p_action) = /([^\#]+)\#(\d+) - (\S+) / ) { last; } } while (<P5>) { if (my($filename, $revision, $action) = /([^\#]+)\#(\d+) - (\S+) /) { if (!$gotpend || ($p_filename gt $filename)) { print start_Tr(); print td([&filelog_url($filename)]), td({-align=>'right'}, [&print_url($filename, $revision, $action)]); print end_Tr(), "\n"; } if ($gotpend && ($p_filename le $filename)) { while ($p_filename le $filename) { print start_Tr(); print td([&filelog_url($p_filename)]), td({-align=>'right'}, [&print_pending_url(param('client'), $p_filename, $p_action, $p_revision)]); if ($p_action eq 'edit') { print td(&diff_url(param('client'), $p_filename, $p_action)); } else { print td($p_action); } print end_Tr(), "\n"; while ($gotpend = <P4>) { $_ = $gotpend; if (($p_filename, $p_revision, $p_action) = /([^\#]+)\#(\d+) - (\S+) /) { last; } } if (!$gotpend) { last; } } } } } close P5; } else { print br, b("Opened files"); print start_em . " (View <a href = \"" . url() . "?command=client&client=" . param('client') . "&show=all\">all files</a>"; if ($ENSCRIPT ne '') { print ", print <a href=\"" . url() . "?command=print_diff_client&client=" . param('client') . "\">code review</a>"; } print ")" . end_em; print br, br; print start_table({-cellpadding=>1, -cellspacing=>1}); if ($host eq "") { print Tr({-align=>'left'}, th(['File', 'Rev', 'Action'])), "\n"; } while (<P4>) { if (my($filename, $revision, $action) = /([^\#]+)\#(\d+) - (\S+) /) { print start_Tr(); print td([&filelog_url($filename)]), td({-align=>'right'}, [&print_pending_url(param('client'), $filename, $action, $revision)]); if ($action eq 'edit') { print td(&diff_url(param('client'), $filename, $action)); } else { print td($action); } print end_Tr(), "\n"; } } } if ($host ne "") { print Tr(td({-colspan=>10}, "Sorry, opened files on this client can " . "only be viewed from host \"$host\"")), "\n"; } print end_table(); &print_cmds(@cmds); print end_html; close P4; } # # p4 clients # sub p4_clients { my $client_regexp = param('client'); my @cmds = ('p4 clients'); &start_with('Clients matching "' . $client_regexp . '"'); &p4open(\*P4, $cmds[0]); my ($line); my ($matching_client); my ($num_matches)= 0; while (<P4>) { my($userid); if (my($client, $date, $root, $description) = /^Client (\S+) (\S+) root (\S+) \'(.*)\'/) { if ($client =~ /$client_regexp/) { if ($num_matches == 1) { print start_table({-cellpadding=>1, -cellspacing=>1}); print Tr(th({-align=>"left"}, ['Client', 'Owner', 'Last Update', 'Root', 'Description'])); print $line; } if ($description =~ /^Created by (\S+)\.\s*$/) { $userid = $1; } else { my $cmd = 'p4 client -o ' . $client; push(@cmds, $cmd); &p4open(\*P5, $cmd); $userid = 'unknown'; while (<P5>) { if (/^Owner:\s+(\S+)/) { $userid = $1; last; } } close P5; } $matching_client = $client; $line = start_Tr(); $line .= td([&client_url($client), &email_url($userid), $date, &root_url($root), $description]); $line .= end_Tr() . "\n"; if ($num_matches > 0) { print $line; } $num_matches++; } } } if ($num_matches == 0) { print 'Sorry, there are no clients matching "' . $client_regexp . '"'; } elsif ($num_matches == 1) { print "<meta http-equiv=\"Refresh\" content=\"0; URL=", url(), "?command=client&client=", $matching_client, "\">\n"; } else { print end_table; close P4; &print_cmds(@cmds); } print end_html; } # # p4 diff # sub p4_diff { my $context = 10; if (param('context')) { $context = param('context'); } param('context', ''); $ENV{P4CLIENT} = param('client'); my $cmd = 'p4 diff -du' . $context . ' ' . param('file'); &start_with('Pending change to ' . param('file') . ', Client ' . param('client')); print start_table(), Tr(); print td(em("Enter a new context size:")), "\n", td(start_form({-name=>'diffform', -method=>'GET'}), hidden(-name=>'client', -value=>param('client')), "\n", hidden(-name=>'command', -value=>'diff'), "\n", hidden(-name=>'file', -value=>param('file')), "\n", textfield(-name=>'context', -size=>5, -value=>$context, -onChange=>"document.diffform.submit();"), end_form), "\n"; if ($context != 99999) { param('context', '99999'); print td(start_em, ", or click <a href=\"" . self_url() . "\">here</a> for whole file diff", end_em()); } print end_table(); &p4open(\*P4, $cmd); # Skip first line $_ = <P4>; my($file1, $rev, $file2) = /^==== ([^\#]+)\#(\d+) - (\S+) ====/; my ($newline) = 1; my ($curline, $size); while (<P4>) { if (/\@\@ \-(\d+),(\d+)\s+\+(\d+),(\d+)\s+\@\@/) { print end_pre(), hr(); my $end = $3 + $4 - 1; print start_center(), b("Line numbers $3 - $end"), end_center(); print hr(), start_pre(); $curline = $3; $size = 0; while ($end > 0) { $end = int($end / 10); $size++; } $newline = 0; next; } my $mode = substr($_, 0, 1); my $line = &protect_html(substr($_, 1)); if ($newline == 1) { print "\n"; } else { $newline = 1; } chop($line); my $whitespace = " "; # Replace all tabs with the correct number of spaces $line = expand($line); if ($mode eq '-') { print &del(sprintf("%${size}s: %s", '', $line)); } elsif ($mode eq '+') { print &add(sprintf("%${size}d: %s", $curline, $line)); $curline++; } else { print sprintf("%${size}d: %s", $curline, $line); $curline++; } } print end_pre(), hr(), start_center(), b("And so it ends..."), end_center(); close P4; &print_cmds($cmd); print end_html; } # # p4 diff2 # sub p4_diff2 { my $context = 10; if (param('context')) { $context = param('context'); } param('context', ''); my $f1 = param('file1'); my $f2 = (param('file2') ? param('file2') : param('file1')); my $r1 = (param('rev2') ? param('rev1') : (param('rev1') - 1)); my $r2 = (param('rev2') ? param('rev2') : param('rev1')); my $cmd = "p4 diff2 -du$context $f1#$r1 $f2#$r2"; my($title); if (param('file2')) { $title = "Diff of $f1 rev $r1 & $f2 rev $r2"; } elsif (param('rev2')) { $title = "Diff of $f1, revisions $r1 & $r2"; } else { $title = "Diff of $f1, revisions $r1 & $r2"; } &start_with($title); print start_table(), Tr(); print td(em("Enter a new context size:")), "\n", start_td(), start_form({-name=>'diffform', -method=>'GET'}), hidden(-name=>'command', -value=>'diff2'), "\n", hidden(-name=>'file1', -value=>$f1), "\n"; if (param('file2')) { print hidden(-name=>'file2', -value=>$f2), "\n"; } print hidden(-name=>'rev1', -value=>$r1), "\n"; if (param('rev2')) { print hidden(-name=>'rev2', -value=>$r2), "\n"; } print textfield(-name=>'context', -size=>5, -value=>$context, -onChange=>"document.diffform.submit();"), end_td(), end_form, "\n"; if ($context != 99999) { param('context', '99999'); print td(start_em, ", or click <a href=\"" . self_url() . "\">here</a> for whole file diff", end_em()); } print end_table(); &p4open(\*P4, $cmd); # Skip first line $_ = <P4>; my($file1, $rev, $file2) = /^==== ([^\#]+)\#(\d+) - (\S+) ====/; my ($newline) = 1; my ($curline, $size); print start_pre(); while (<P4>) { if (/\@\@ \-(\d+),(\d+)\s+\+(\d+),(\d+)\s+\@\@/) { print hr(); my $end = $3 + $4 - 1; print start_center(), h4("Line numbers $3 - $end"), end_center(); print hr(); $curline = $3; $size = 0; while ($end > 0) { $end = int($end / 10); $size++; } $newline = 0; next; } my $mode = substr($_, 0, 1); my $line = &protect_html(substr($_, 1)); if ($newline == 1) { print "\n"; } else { $newline = 1; } chop($line); # Replace all tabs with the correct number of spaces $line = expand($line); if ($mode eq '-') { print &del(sprintf("%${size}s: %s", '', $line)); } elsif ($mode eq '+') { print &add(sprintf("%${size}d: %s", $curline, $line)); $curline++; } else { print sprintf("%${size}d: %s", $curline, $line); $curline++; } } print hr(), start_center(), h4("And so it ends..."), end_center(); print end_pre(); close P4; &print_cmds($cmd); print end_html; } # # p4 filelog # sub p4_filelog { my $diff_script = ("\n" . "function diff2_script(rev, max_rev) {\n" . " var elem = document.diff2.elements\n\n" . " if (!elem[max_rev - rev].checked) {\n" . " return false;\n" . " }\n\n" . " var rev2 = 0;\n" . " for (var i = 1; i <= max_rev; ++i) {\n" . " if (elem[max_rev - i].checked && (i != rev)) {\n" . " if (rev2 != 0) {\n" . " return false;\n" . " }\n" . " rev2 = i;\n" . " }\n" . " }\n\n" . " if (rev2 == 0) {\n" . " return false;\n" . " }\n\n" . " if (rev2 < rev) {\n" . " var tmp = rev;\n" . " rev = rev2;\n" . " rev2 = tmp;\n" . " }\n\n" . " var newlocation;\n" . " var end = (window.location.href).indexOf(\"\?\")\n" . " if (end >= 0) {\n" . " newlocation = window.location.href.substr(0, end);\n". " } else {\n" . " newlocation = window.location.href;\n" . " }\n" . " newlocation += \"?command=diff2&file1=" . &protect_url(param('file')) . "&rev1=\" + rev + \"&rev2=\" + rev2;\n" . " window.location.href = newlocation;\n" . " return true;\n" . "}\n\n"); my $name = 'File ' . param('file'); print header, start_html(-bgcolor=>'white', -title=>$name, -script=>$diff_script), start_center, h1($name), end_center; my @cmds = ('p4 opened -a ' . param('file'), 'p4 filelog -l ' . param('file')); print start_form({-name=>'diff2', -method=>'GET'}); print start_table({-cellpadding=>1, -cellspacing=>1}); print Tr(th(['Diff', 'Rev', 'Action', 'Date', 'User', 'Client', 'Change', 'Description'])); &p4open(\*P4, $cmds[0]); while (<P4>) { if (my($rev, $action, $user, $client) = /^.+\#(\d+) - (\S+) .* by ([^@]+)@(\S+)/) { print start_Tr(); print td(''); print td({-align=>"right"}, [&print_pending_url($client, param('file'), $action, $rev)]); if (($action eq 'edit') || ($action eq 'integrate')) { print td({-align=>"right"}, &diff_url($client, param('file'), $action)); } else { print td({-align=>"right"}, $action); } print td(['pending', &email_url($user), &client_url_wbr($client), ' ', ' ']); print end_Tr(), "\n"; } } close P4; my $max_rev = 0; &p4open(\*P4, $cmds[1]); my($rev, $change, $action, $date, $user, $client, $desc); my($print) = 0; while (<P4>) { if (my($nrev, $nchange, $naction, $ndate, $nuser, $nclient) = /^\.\.\. \#(\d+) change (\d+) (\S+) on (\S+) by ([^@]+)@(\S+) /) { if ($nrev > $max_rev) { $max_rev = $nrev } if ($naction eq 'integrate') { $naction = 'integ'; } if ($print) { $desc = &protect_html($desc); $desc =~ s/\n\s*\n/<br><br>\n/g; print start_Tr({-valign=>"top"}); print td(checkbox(-name=>$rev, -label=>'', -value=>$rev, -onClick=>"diff2_script($rev, $max_rev)")); print td({-align=>"right"}, [&print_url(param('file'), $rev, $action)]); if (($action eq 'edit') || ($action eq 'integ')) { print td({-align=>"right"}, [ &diff2_url(param('file'), $rev, $action)]); } else { print td({-align=>"right"}, [$action]); } print td([$date, &email_url($user), &client_url_wbr($client)]); print td({-align=>"right"}, &change_url($change)); print td([$desc]); print end_Tr(), "\n"; } $print = 1; $rev = $nrev; $change = $nchange; $action = $naction; $date = $ndate; $user = $nuser; $client = $nclient; $desc = ''; # Skip the blank line following this. <P4>; } elsif (/^\.\.\. \.\.\./) { # Skip these lines. These indicate branches and copies. } else { $desc .= $_; } } if ($print) { $desc = &protect_html($desc); $desc =~ s/\n\s*\n/<br><br>\n/g; print start_Tr({-valign=>"top"}); print td(checkbox(-name=>$rev, -label=>'', -value=>$rev, -onClick=>"diff2_script($rev, $max_rev)")); print td({-align=>"right"}, [&print_url(param('file'), $rev, $action)]); if (($action eq 'edit') || ($action eq 'integ')) { print td({-align=>"right"}, [ &diff2_url(param('file'), $rev, $action)]); } else { print td({-align=>"right"}, [$action]); } print td([$date, &email_url($user), &client_url_wbr($client)]); print td({-align=>"right"}, &change_url($change)); print td([$desc]); print end_Tr(), "\n"; } close P4; print end_table(); print end_form(); &print_cmds(@cmds); print end_html; } # # p4 files # sub p4_files { my($title); my $depot = param('depot'); if (param('file') && (param('file') ne '')) { if (substr(param('file'), 0, 1) ne '/') { $depot .= '/'; } $depot .= param('file'); } elsif (substr($depot, -4, 4) ne '/...') { $depot .= '/...'; } if (param('deleted') eq "true") { $title = 'Deleted files in ' . $depot; } else { $title = 'Files in ' . $depot; } &start_with($title); if (param('deleted') eq "true") { print em("Click <a href=\"" . url() . "?command=files&depot=" . $depot . "\">here</a> to view this depot's " . "non-deleted files."), br; } else { print em("Click <a href=\"" . url() . "?command=files&depot=" . $depot . "&deleted=true\">here</a> to view deleted " . "files from this depot."), br; } print em("You may also view this depot's " . "<a href=\"" . url() . "?command=changes&depot=" . $depot . "\">recent changes</a> and " . "<a href=\"" . url() . "?command=opened&depot=" . $depot . "\">pending changes</a>."), br, br; my $cmd = 'p4 files ' . $depot; &p4open(\*P4, $cmd); print start_table({-cellpadding=>1, -cellspacing=>1}); print Tr({-align=>'left'}, th(['File', 'Cur Rev'])), "\n"; while ( <P4> ) { if (my($filename, $revision, $action) = /^([^\#]+)\#(\d+) - (\S+)/) { if (((param('deleted') eq "true") && ($action eq 'delete')) || ((param('deleted') ne "true") && ($action ne 'delete'))) { print start_Tr(); print td([&filelog_url($filename)]), td({-align=>'right'}, [&print_url($filename, $revision, $action)]); print end_Tr(), "\n"; } } } print end_table; &print_cmds($cmd); print end_html; close P4; } # # p4 opened # sub p4_opened { my $depot = param('depot'); if (param('file') && (param('file') ne '')) { if (substr(param('file'), 0, 1) ne '/') { $depot .= '/'; } $depot .= param('file'); } elsif (substr($depot, -4, 4) ne '/...') { $depot .= '/...'; } &start_with('Pending changes to ' . $depot); print em("You may also view this depot's " . "<a href=\"" . url() . "?command=files&depot=" . $depot . "\">files</a> and " . "<a href=\"" . url() . "?command=changes&depot=" . $depot . "\">recent changes</a>."), br, br; my $cmd = "p4 opened -a $depot"; # Get client list my(%clients); &p4open(\*P4, $cmd); while (<P4>) { if (my($file, $revision, $action, $user, $client) = /^([^\#]+)\#(\S+) - (\S+) .* by ([^@]+)@(\S+)/) { if (param('user') && (param('user') ne '')) { my $regexp = param('user'); if (!($user =~ /$regexp/)) { next; } } if (param('client') && (param('client') ne '')) { my $regexp = param('client'); if (!($client =~ /$regexp/)) { next; } } $clients{$client} = 1; } } close P4; print "Clients with files opened against this depot:\n"; if (keys(%clients) == 0) { print b("None"); &print_cmds($cmd); print end_html; return; } print start_blockquote(); print start_table({-cellpadding=>0, -cellspacing=>0}); foreach my $key (keys %clients) { print start_Tr(); print td(&client_url($key)); print end_Tr(), "\n"; } print end_table; print end_blockquote(); # Get pending changelist &p4open(\*P4, $cmd); print start_table({-cellpadding=>1, -cellspacing=>1}); print Tr({-align=>'left'}, th(['File', 'Revision', 'Action', 'User', 'Client'])), "\n"; while (<P4>) { if (my($file, $revision, $action, $user, $client) = /^([^\#]+)\#(\S+) - (\S+) .* by ([^@]+)@(\S+)/) { if (param('user') && (param('user') ne '')) { my $regexp = param('user'); if (!($user =~ /$regexp/)) { next; } } if (param('client') && (param('client') ne '')) { my $regexp = param('client'); if (!($client =~ /$regexp/)) { next; } } print start_Tr(); print td([&filelog_url($file)]); print td({-align=>"right"}, [&print_pending_url($client, $file, $action, $revision)]); print td([&diff_url($client, $file, $action)]); print td([&email_url($user)]); print td([&client_url($client)]); print end_Tr(), "\n"; } } print end_table, "\n"; close P4; &print_cmds($cmd); print end_html; } # # p4 print # sub p4_print { my $use_code2html = (($CODE2HTML ne "") && (-e $CODE2HTML)); my $title; if (param('client')) { $title = 'Client ' . param('client') . ', '; } $title .= 'File ' . param('file'); my $filespec = param('file'); if (param('revision') != 0) { $title .= ', revision ' . param('revision'); $filespec .= '#' . param('revision'); } my $img = 0; my $language = 'c++'; if (param('file') =~ /\.c$/) { $language = 'c'; } elsif (param('file') =~ /\.awk$/) { $language = 'awk'; } elsif (param('file') =~ /\.groff$/) { $language = 'groff'; } elsif (param('file') =~ /\.html?$/) { $language = 'html'; } elsif (param('file') =~ /\.java$/) { $language = 'java'; } elsif (param('file') =~ /\.js$/) { $language = 'js'; } elsif (param('file') =~ /\.m4$/) { $language = 'm4'; } elsif (param('file') =~ /[Mm]akefile.*/) { $language = 'make'; } elsif (param('file') =~ /\.p([lm5]|od)$/) { $language = 'perl'; } elsif (param('file') =~ /Cons(cript|truct).*/) { $language = 'perl'; } elsif (param('file') =~ /\.(c(c|pp|xx|\+\+)|h|hh|[iCH])$/) { $language = 'c++'; } elsif (param('file') =~ /\.png$/) { $img = 1; $language = 'png'; } elsif (param('file') =~ /\.gif$/) { $img = 1; $language = 'gif'; } elsif (param('file') =~ /\.jpe?g$/) { $img = 1; $language = 'jpg'; } elsif (param('file') =~ /\.xpm$/) { $img = 1; $language = 'xpm'; } elsif (param('file') =~ /\.xbm$/) { $img = 1; $language = 'xbm'; } else { $language = 'plain'; } my @cmds = ('p4 print -q ' . $filespec, $CODE2HTML . ' -n -H -l ' . $language); $cmds[1] = 'cat' unless $use_code2html; if (param('client')) { $ENV{P4CLIENT} = param('client'); if (param('action') eq 'edit') { $cmds[0] = 'p4 diff -du999999 ' . $filespec; } elsif (param('action') eq 'delete') { # no change } else { $cmds[0] = 'cat ' . &get_local_filename(param('file')); } } # Just send images by themselves. if (param('image')) { print header(-type=>'image/' . $language); &p4open(\*P4, $cmds[0]); while (<P4>) { print $_; } return; } if ($img == 1) { &start_with($title); print '<img src="' . url(-query=>1) . '&image=1">'; &print_cmds($cmds[0]); print end_html; return; } my $rfh = new FileHandle; my $wfh = new FileHandle; my $pid = open2($rfh, $wfh, $cmds[1]); $pid = fork; if (!defined $pid) { &bail($myname . ": got a fork error"); } # Child process if ($pid == 0) { $rfh->close(); my($diff) = 0; &p4open(\*P4, $cmds[0]); if (param('client') && (param('action') eq 'edit')) { $diff = 1; $_ = <P4>; # Skip the first two lines. # If there is no output, then this is an opened file that currently # has no changes. Print out the head-of-line file. # XXX - should actually get the revision that's in the client. if (!<P4>) { close P4; &p4open(\*P4, "p4 print -q $filespec"); $diff = 0; } } while (<P4>) { my $line = $_; if ($diff && (param('action') eq 'edit')) { if (substr($line, 0, 1) eq '-') { next; } $line = substr($line, 1); } if ($use_code2html) { print $wfh expand($line); } else { print $wfh &protect_html(expand($line)); } } close P4; $wfh->close(); exit; } $wfh->close(); &start_with($title); print "\n<pre>\n"; while (<$rfh>) { print $_; } print "</pre>\n"; $rfh->close(); &print_cmds(@cmds); print end_html; } # # Utility routines # sub print_diff_change { my $context = 10; if (param('context')) { $context = param('context'); } my $change_num = param('change'); # Get client &p4open(\*P4, 'p4 describe -s ' . $change_num); $_ = <P4>; my ($user, $client, $date, $time); if (!(($user, $client, $date, $time) = /^Change \d+ by (\S*)@(\S*) on (\S*) (\S*)$/)) { &start_with('Diff of change ' . $change_num); print "Sorry, there is no such change recorded\n"; print end_html; close P4; return; } close P4; $ENV{P4CLIENT} = $client; my $rfh = new FileHandle; my $wfh = new FileHandle; my $pid = open2($rfh, $wfh, $ENSCRIPT . $ENSCRIPT_OPTS . ' -t ' . "\"Change $change_num\""); $pid = fork; if (!defined $pid) { &bail($myname . ": got a fork error"); } # Child process if ($pid == 0) { $rfh->close(); # Get client root & depot. &p4open(\*P4, 'p4 client -o'); my ($root, $depot); while (<P4>) { ($root) = /^Root:\s*(\S*)/; if (/^View:/) { $_ = <P4>; ($depot) = /^\s*(\S*)\.\.\. /; } } close P4; my($numlines) = 1; # Go through all opened files &p4open(\*P4, 'p4 describe -s ' . $change_num); while (<P4>) { my($full_filename, $rev, $change); if (!(($full_filename, $rev, $change) = /... (\S*)\#(\d+) (\S*)/)) { next; } my($file) = $full_filename; if ($file =~ /^$depot/) { $file = substr($file, length($depot)); } if ($change eq 'delete') { print $wfh "==== Deleted file $file\n\n"; $numlines += 2; } elsif ($change eq 'add') { print $wfh "==== Added file $file\n"; ++$numlines; &p4open(\*P5, 'p4 print ' . $full_filename . "#" . $rev); while (<P5>) { printf $wfh "%04d ", $numlines; print $wfh expand($_); ++$numlines; } close P5; print $wfh "\n"; ++$numlines; } elsif ($change eq 'branch') { print $wfh "==== Branched file $file\n\n"; $numlines += 2; } elsif ($change eq 'edit') { &p4open(\*P5, 'p4 diff2 -du' . $context . " " . $full_filename . "#" . ($rev - 1) . " " . $full_filename . "#" . $rev); while (<P5>) { my $line = $_; if (/==== /) { $line = "==== Changes made to $file:\n"; } elsif (my($ob, $ol, $nb, $nl) = /^\@\@ \-(\d+),(\d+) \+(\d+),(\d+) \@\@/) { my $ne = $nb + $nl - 1; $line = "**** Lines $nb to $ne\n"; } else { $line = substr($line, 0, 1) . expand(substr($line, 1)); $line = sprintf "%04d %s", $numlines, $line; } print $wfh $line; ++$numlines; } close P5; print $wfh "\n"; ++$numlines; } else { print $wfh "ERROR: $_\n"; $numlines += 2; } } close P4; $wfh->close(); exit; } # Parent process $wfh->close(); if (($GS ne '') && (user_agent() =~ /[Ww]in/)) { my $rfh2 = new FileHandle; my $wfh2 = new FileHandle; my $pid = open2($rfh2, $wfh2, $GS . $GS_OPTS); $pid = fork; if (!defined $pid) { &bail($myname . ": got a fork error"); } # Child process if ($pid == 0) { $rfh2->close(); while (<$rfh>) { print $wfh2 $_; } $wfh2->close(); $rfh->close(); exit; } # Parent process $wfh2->close(); print "Content-type: application/pdf\n\n"; while (<$rfh2>) { print $_; } $rfh2->close(); } else { print "Content-type: application/postscript\n\n"; while (<$rfh>) { print $_; } } $rfh->close(); } sub print_diff_client { my $context = 10; if (param('context')) { $context = param('context'); } $ENV{P4CLIENT} = param('client'); my $rfh = new FileHandle; my $wfh = new FileHandle; my $pid = open2($rfh, $wfh, $ENSCRIPT . $ENSCRIPT_OPTS . ' -t ' . "\"Pending change to $ENV{P4CLIENT}\""); $pid = fork; if (!defined $pid) { &bail($myname . ": got a fork error"); } # Child process if ($pid == 0) { $rfh->close(); # Get client root & depot. &p4open(\*P4, 'p4 client -o'); my ($root, $depot); while (<P4>) { ($root) = /^Root:\s*(\S*)/; if (/^View:/) { $_ = <P4>; ($depot) = /^\s*(\S*)\.\.\. /; } } close P4; my($numlines) = 1; # Go through all opened files &p4open(\*P4, 'p4 opened'); while (<P4>) { my($full_filename, $change) = /(\S*)\#\d+ \- (\S*)/; my($file) = $full_filename; if ($file =~ /^$depot/) { $file = substr($file, length($depot)); } if ($change eq 'delete') { print $wfh "==== Deleted file $file\n\n"; $numlines += 2; } elsif ($change eq 'add') { print $wfh "==== Added file $file\n"; ++$numlines; if (open(FILE, &get_local_filename($full_filename))) { while (<FILE>) { printf $wfh "%04d ", $numlines; print $wfh expand($_); ++$numlines; } close FILE; } else { print $wfh "**** (Cannot view contents)\n"; ++$numlines; } print $wfh "\n"; ++$numlines; } elsif ($change eq 'branch') { print $wfh "==== Branched file $file\n\n"; $numlines += 2; } elsif ($change eq 'edit') { &p4open(\*P5, 'p4 diff -du' . $context . " " . $depot . $file); while (<P5>) { my $line = $_; if (/==== \S* - $root\/(\S*) ====/) { $line = "==== Changes made to $file:\n"; } elsif (my($ob, $ol, $nb, $nl) = /^\@\@ \-(\d+),(\d+) \+(\d+),(\d+) \@\@/) { my $ne = $nb + $nl - 1; $line = "**** Lines $nb to $ne\n"; } else { $line = substr($line, 0, 1) . expand(substr($line, 1)); $line = sprintf "%04d %s", $numlines, $line; } print $wfh $line; ++$numlines; } close P5; print $wfh "\n"; ++$numlines; } else { print $wfh "ERROR: $_\n"; $numlines += 2; } } close P4; $wfh->close(); exit; } # Parent process $wfh->close(); if (($GS ne '') && (user_agent() =~ /[Ww]in/)) { my $rfh2 = new FileHandle; my $wfh2 = new FileHandle; my $pid = open2($rfh2, $wfh2, $GS . $GS_OPTS); $pid = fork; if (!defined $pid) { &bail($myname . ": got a fork error"); } # Child process if ($pid == 0) { $rfh2->close(); while (<$rfh>) { print $wfh2 $_; } $wfh2->close(); $rfh->close(); exit; } # Parent process $wfh2->close(); print "Content-type: application/pdf\n\n"; while (<$rfh2>) { print $_; } $rfh2->close(); } else { print "Content-type: application/postscript\n\n"; while (<$rfh>) { print $_; } } $rfh->close(); } my @HTMLERROR = ( "Content-type: text/html\n", "\n", "<html>\n", "<head>\n", "<body bgcolor=\"#ffffff\">\n" ); sub start_with { my( $name ) = @_; print header, start_html(-bgcolor=>'white', -title=>$name), start_center, h1($name), end_center; } sub add { my($line) = @_; return qq(<font color="#0000FF">) . $line . qq(</font>); } sub del { my($line) = @_; return qq(<strike><font color="#B00000">) . $line . qq(</font></strike>); } sub bail { print @HTMLERROR, @_, "\n"; die @_; } sub p4open { my( $handle, @command ) = @_; open( $handle, "@command |" ) || &bail( "@command failed" ); } sub protect_html { my ($line) = @_; $line =~ s/</</g ; $line =~ s/>/>/g ; return $line; } sub protect_url { my ($line) = @_; $line =~ s/ /%20/g ; $line =~ s/\+/%2b/g ; $line =~ s/-/%2d/g ; $line =~ s/_/%5f/g ; $line =~ s/~/%7e/g ; $line =~ s/:/%3A/g ; return $line; } sub print_cmds { my ( @cmds ) = @_; my $s = ''; if (scalar(@cmds) > 1) { $s .= 's'; } print br(), hr(), em("This page was generated using the command" . $s . ":<br>\n"); foreach my $cmd (@cmds) { print em($cmd) . "<br>\n"; } } sub get_local_filename { my ($file) = @_; &p4open(\*P4FN, 'p4 client -o ' . param('client')); my ($filename, $client, $rootdir, @depots, @dirs); while (<P4FN>) { if (/^Client:\s+(\S+)/) { $client = $1; } elsif (/^Root:\s+(\S+)/) { $rootdir = $1; } elsif (/^View:/) { while (<P4FN>) { my $regexp = "\\s*(\\S+)\\/\\.\\.\\.\\s+//" . $client . "(\\S*)\\/\\.\\.\\."; if (/$regexp/) { push(@depots, $1); push(@dirs, $2); } } } } close P4FN; while (scalar(@depots)) { my ($depot) = pop(@depots); my ($dir) = pop(@dirs); if (substr($file, 0, length($depot)) eq $depot) { $filename = $rootdir . $dir . substr($file, length($depot)); } } return $filename; } sub change_url { my ( $change ) = @_; return "<a href=\"" . url() . "?command=change&change=" . $change . "\">" . $change . "</a>"; } sub changes_url { my ( $depot ) = @_; return "<a href=\"" . url() . "?command=changes&depot=" . &protect_url($depot) . "\">" . $depot . "</a>"; } sub client_url { my ( $client ) = @_; return "<a href=\"" . url() . "?command=client&client=" . $client . "\">" . $client . "</a>"; } sub client_url_wbr { my ( $client ) = @_; my ( $client_text ) = $client; $client_text =~ s/([-_|]+)/$1<wbr>/g; return "<a href=\"" . url() . "?command=client&client=" . $client . "\">" . $client_text . "</a>"; } sub diff_url { my ( $client, $file, $action ) = @_; return "<a href=\"" . url() . "?command=diff&client=" . $client . "&file=" . &protect_url($file) . "\">" . $action . "</a>"; } sub diff2_url { my ( $file, $revision, $action ) = @_; return "<a href=\"" . url() . "?command=diff2&file1=" . &protect_url($file) . "&rev1=$revision\">$action</a>"; } sub email_url { my ( $user ) = @_; &p4open(\*TEMP, 'p4 user -o ' . $user); my $email; while ( <TEMP> ) { if (/^Email:\s+(\S+)/) { $email = $1; # Don't trust anything after the @ if (length($DOMAIN) > 0) { $email = substr($email, 0, index($email, "\@")) . "\@" . $DOMAIN; } last; } } close TEMP; return a({-href=>'mailto:' . $email}, $user); } sub filelog_url { my ( $file ) = @_; return "<a href=\"" . url() . "?command=filelog&file=" . &protect_url($file) . "\">" . $file . "</a>"; } sub files_url { my ( $depot ) = @_; return "<a href=\"" . url() . "?command=files&depot=" . &protect_url($depot) . "\">" . $depot . "</a>"; } sub opened_url { my ( $depot ) = @_; return "<a href=\"" . url() . "?command=opened&depot=" . &protect_url($depot) . "\">" . $depot . "</a>"; } sub print_pending_url { my ( $client, $file, $action, $revision ) = @_; return "<a href=\"" . url() . "?command=print&client=" . $client . "&file=" . &protect_url($file) . "&action=" . $action . "\">p" . $revision . "</a>"; } sub print_url { my ( $file, $revision, $action ) = @_; my ( $newrev ) = ($action eq "delete") ? ($revision - 1) : $revision; my ( $link ) = "<a href=\"" . url() . "?command=print&file=" . &protect_url($file); if ($revision != 0) { $link .= "&revision=" . $newrev . "\">" . $revision . "</a>"; } else { $link .= "\">" . $file . "</a>"; } return $link; } sub root_url { my ( $root ) = @_; return "<a href=\"file:" . $root . "\">" . $root . "</a>"; }
# | Change | User | Description | Committed | |
---|---|---|---|---|---|
#4 | 4257 | brad_garcia |
Wow, it's been a LONG time since the last public code drop. Changes include: When there is only one matching client, do a redirect to take you to the client page, instead of having the clients page display a single client directly. When generating the list of depots, use a new algorithm that doesn't result in such a huge load for the p4 server. This new algorithm takes a little longer for small depots, but takes much less time for large depots. Factor out some common code from p4_diff and p4_diff2. Fixed output of p4_diff2 in the process. Add a link to show all changes in a client at once. autoflush STDOUT so that we don't get double-output due to forked processes getting copies of the buffer. Problem seen on Solaris machine w. perl 5.00503. Linux w perl 5.6.0 seems to automatically flush before a fork. If an exact match is given for a client name, then display that particular client, even if it is a subset of other client's names. Add a link to show all file diffs for a single change at once. Fix some regexps to be a little more picky. Fix problem with spacing in file diffs. Need to expand tabs before protecting characters from html. Fix display of binary file diffs. Fix code-review generation on clients with multiple views. Show each file's pending change number in client view. Handle pending changes correctly. When printing the code review for a pending change, include the change's description at the beginning. Fix some links to display file diffs as the result of an integration. Fix "diff of all opened files" option to show integrated changes correctly. Fix email address munging. When viewing opened files, sort the list of clients with opened files alphabetically. Fix "p4 change" display for pending changes (remove double file listings). Escape ampersands before outputting text. |
||
#3 | 680 | brad_garcia |
Another public code drop. Changes include: Allow per-user depot listfile by appending "listfile=<filename>' to the URL. File must be accessible from server. Code is now 'use strict' compliant, and runs w. 'perl -w'. Fixed some javascript problems, including one that caused problems with IE. Also, prefer submitting forms rather than reloading windows. The latter seems flakey Protected more output from containing html meta-characters. Filelog checkbox selection speedups. Added support for displaying jobs fixed in change output. Not sure if this is generic enough for all purposes, so let me know if you have a problem with this feature. Work around in file diff formatting for brokeness in Opera browser. Added advanced querying capabilities for viewing pending changes. Add a form to select the context size when viewing file diffs. |
||
#2 | 516 | brad_garcia |
Lots of changes since the original submission: Added full descriptions to Recent Changes output. We now replace tabs with spaces in file & diff output. Add a "code review" link to the client & submitted changes pages. This prints out a nicely formatted document, including line number, showing the entire pending change. The output is provided as pdf to windows machines and postscript to all other clients. When viewing filelog, added checkboxes that allow viewing a diff between any two revisions of a file. And of course, it includes a few bugfixes. |
||
#1 | 317 | brad_garcia | First public release of pb (Perforce Browser). |