#!/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 # # 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 = "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 . 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 = "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+)|$1|'; 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; $| = 1; # autoflush stdout 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 'changediff') { &p4_changediff(); } elsif (param('command') eq 'changes') { &p4_changes(); } elsif (param('command') eq 'client') { &p4_client(); } elsif (param('command') eq 'clientdiff') { &p4_clientdiff(); } 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 () { 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 400 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)'), " (advanced 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)'), " (advanced 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)'), " (advanced 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 " . "here"); } elsif ($LISTFILE) { print em("To change the above depot listboxes back to the standard " . "list of depots, click here"); } print end_html; } exit(0); # # This subroutine returns a list of all depot directories up to the ones # that contain files. # sub make_depotlist { my (@dirs, $dir, @stack); push @stack, "/"; while (scalar(@stack) > 0) { $dir = pop @stack; #print "Calling p4 files '" . $dir . "/*'\n"; &p4open(\*P5, "p4 files '" . $dir . "/*'"); if (!) { #print "Calling p4 dirs '" . $dir . "/*'\n"; &p4open(\*P4, "p4 dirs '" . $dir . "/*'"); while () { chop; #print "adding to stack: $_\n"; push @stack, $_; } close P4; } else { push @dirs, $dir; #print $dir . "\n"; } close P5; } @dirs = sort @dirs; # foreach $dir (@dirs) { # print $dir . "\n"; # } # exit(0); 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 here"); } elsif ($LISTFILE) { print em("To change the above depot listboxes back to the standard " . "list of depots, click " . "here"); } # Normal querying link print br, start_em, "Go back to the main page.", 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 here"); } elsif ($LISTFILE) { print em("To change the above depot listboxes back to the standard " . "list of depots, click " . "here"); } # Normal querying link print br, start_em, "Go back to the main page.", 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 here"); } elsif ($LISTFILE) { print em("To change the above depot listboxes back to the standard " . "list of depots, click " . "here"); } # Normal querying link print br, start_em, "Go back to the main page.", end_em(); print end_html; } # # p4 change # sub p4_change { my @cmds; my $cmd = 'p4 describe -s ' . param('change'); push @cmds, $cmd; &p4open(\*P4, $cmd); $_ = ; my($user, $client, $date, $time, $pending); if (!(($user, $client, $date, $time, $pending) = /^Change \d+ by (\S*)@(\S*) on (\S*) (\S*)\s*(\S*)/)) { &start_with('Change ' . param('change')); print "Sorry, there is no such change recorded\n"; &print_cmds($cmd); print end_html; close P4; return; } &start_with(($pending ? 'Pending change ' : 'Change ') . param('change')); my($description); while ( ) { last if /^Jobs fixed/; last if /^Affected files/; $description .= &protect_html($_) . "
\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 ( ) { last if /^Affected files/; if (my($jname, $jdate, $juser, $jstate) = /(\S+) on (\S+) by (\S+) (\S+)/) { ; # skip blank line my $jdesc; while ( ) { last if (/^\s*$/); $jdesc .= &protect_html($_) . "
\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'); print start_em . " ("; if ($ENSCRIPT ne '') { print "print code review, "; } print "show diff of all files"; print ")" . end_em; print ":\n"; print start_table({-cellpadding=>1, -cellspacing=>1}); print Tr({-align=>'left'}, th(['File', 'Rev', 'Action'])), "\n"; while ( ) { if (my($filename, $revision, $action) = /^... ([^\#]+)\#(\d+) (\S+)/) { print start_Tr(); if (!$pending) { 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); } } else { print td([&filelog_url($filename)]), td({-align=>'right'}, [&print_pending_url($client, $filename, $action, $revision)]); if (($action eq 'edit') || ($action eq 'integrate')) { print td(&diff_url($client, $filename, $action)); } else { print td($action); } } print end_Tr(), "\n"; } } close P4; print end_table; &print_cmds(@cmds); print end_html; } sub p4_changediff { my $context = 10; if (param('context')) { $context = param('context'); } param('context', ''); &start_with('Change ' . param('change')); my @cmds = ('p4 describe -s ' . param('change')); &p4open(\*P5, $cmds[0]); while () { if (my($filename, $revision, $action) = /^... ([^\#]+)\#(\d+) (\S+)/) { print "\n"; print start_table({-border=>1, -cellpadding=>4, -cellspacing=>5, -bgcolor=>"#0000FF", -width=>"100%"}), start_Tr(), start_td(); print start_center(); print font({-color=>"white"}, b("$action: $filename#$revision")); print end_center(); print end_td(), end_Tr(), end_table(); print "\n"; if ($action eq 'edit') { my ($r1, $r2) = ($revision - 1, $revision); my $cmd = "p4 diff2 -du$context $filename#$r1 $filename#$r2"; push @cmds, $cmd; &p4_diff_common($cmd); } elsif ($action eq 'add') { push @cmds, &p4_print_common($filename, $revision, $action); } else { print br(); } } } close P5; &print_cmds(@cmds); print end_html; } # # p4 changes # sub p4_changes { my $max = " -m 400"; 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 " . "files and " . "pending changes."), 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 () { 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/

\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. ; } 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/

\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 ( ) { 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:/) { $_ = ; ($description) = /^\s+(.+)$/; } if (/^View:/) { while ( ) { if (/^\s+(\S+)\s+(\S+)$/) { push(@view1, $1); push(@view2, $2); } } } } print start_table({-cellpadding=>1, -cellspacing=>1}), "\n"; print Tr([ td(['Owner:', &email_url($owner)]), td(['Host:', $host]), td(['Last Update:', $update]), td(['Last Access:', $access]), td(['Root:', &root_url($root)])]), "\n"; print start_Tr(); print td({-valign=>"top"}, ['View:']); print start_td(), "\n"; print start_table({-cellpadding=>0, -cellspacing=>0}); while (@view1) { my $view1 = pop(@view1); my $view2 = pop(@view2); print Tr([td([&opened_url($view1), "  ", $view2])]), "\n"; } print end_table(), "\n"; 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 here 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 = ) { $_ = $gotpend; if ( ($p_filename, $p_revision, $p_action) = /([^\#]+)\#(\d+) - (\S+) / ) { last; } } while () { 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 = ) { $_ = $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 all files"; if ($ENSCRIPT ne '') { print ", print code review"; } print ", show diff of all opened files"; print ")" . end_em; print br, br; print start_table({-cellpadding=>1, -cellspacing=>1}); if ($host eq "") { print Tr({-align=>'left'}, th(['File', 'Rev', 'Action', 'Change'])), "\n"; } while () { if (my($filename, $revision, $action, $change) = /([^\#]+)\#(\d+) - (\S+) \S+ (\S+)/) { print start_Tr(); print td([&filelog_url($filename)]), td({-align=>'right'}, [&print_pending_url(param('client'), $filename, $action, $revision)]); if (($action eq 'edit') || ($action eq 'integrate')) { print td({-align=>"right"}, &diff_url(param('client'), $filename, $action)); } else { print td({-align=>"right"}, $action); } if ($change ne "change") { print td({-align=>"right"}, &change_url($change)); } else { print td({-align=>"right"}, "default"); } 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'); &p4open(\*P4, $cmds[0]); my ($line); my ($matching_client); my ($num_matches)= 0; while () { my($userid); if (my($client, $date, $root, $description) = /^Client (\S+) (\S+) root (\S+) \'(.*)\'/) { if ($client eq $client_regexp) { # exact match $num_matches = 1; $matching_client = $client; last; } if ($client =~ /$client_regexp/) { if ($num_matches == 1) { &start_with('Clients matching "' . $client_regexp . '"'); 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 () { 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) { &start_with('Clients matching "' . $client_regexp . '"'); print 'Sorry, there are no clients matching "' . $client_regexp . '"'; } elsif ($num_matches == 1) { print header, "\n"; return; } else { print end_table; close P4; &print_cmds(@cmds); } print end_html; } sub p4_clientdiff { my $context = 10; if (param('context')) { $context = param('context'); } param('context', ''); my $changenum; if (param('change')) { $changenum = param('change'); } $ENV{P4CLIENT} = param('client'); if ($changenum) { &start_with("Pending change $changenum in " . param('client')); } else { &start_with('Pending changes in ' . param('client')); } my @cmds = ('p4 opened'); &p4open(\*P5, $cmds[0]); while () { if (my($filename, $revision, $action, $change) = /([^\#]+)\#(\d+) - (\S+)\s*\w*\s*(\d*)/) { if ($changenum && ($changenum ne $change)) { next; } print "\n"; print start_table({-border=>1, -cellpadding=>4, -cellspacing=>5, -bgcolor=>"#0000FF", -width=>"100%"}), start_Tr(), start_td(); print start_center(); print font({-color=>"white"}, b("$action: $filename")); print end_center(); print end_td(), end_Tr(), end_table(); print "\n"; if (($action eq 'edit') || ($action eq 'integrate')) { my $cmd = 'p4 diff -du' . $context . ' ' . $filename; push @cmds, $cmd; &p4_diff_common($cmd); } elsif ($action eq 'add') { push @cmds, &p4_print_common($filename, $revision, $action); } else { print br(); } } } close P5; &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 here for whole file diff", end_em()); } print end_table(); &p4_diff_common($cmd); print hr(), start_center(), b("And so it ends..."), end_center(); &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 here for whole file diff", end_em()); } print end_table(); &p4_diff_common($cmd); print hr(), start_center(), b("And so it ends..."), end_center(); &print_cmds($cmd); print end_html; } sub p4_diff_common { my ($cmd) = @_; &p4open(\*P4, $cmd); # Skip first line $_ = ; my($file1, $rev, $file2) = /^==== ([^\#]+)\#(\d+) - (\S+) ====/; my ($newline) = 1; my ($curline, $size); my ($premode) = 0; while () { if (/\@\@ \-(\d+),(\d+)\s+\+(\d+),(\d+)\s+\@\@/) { if ($premode == 1) { print end_pre(); } print hr(); my $end = $3 + $4 - 1; print start_center(), b("Line numbers $3 - $end"), end_center(); print hr(), "\n", start_pre(); $premode = 1; $curline = $3; $size = 0; while ($end > 0) { $end = int($end / 10); $size++; } $newline = 0; next; } my $mode = substr($_, 0, 1); # Replace all tabs with the correct number of spaces my $line = expand(substr($_, 1)); $line = &protect_html($line); if ($newline == 1) { print "\n"; } else { $newline = 1; } chop($line); if ($mode eq '-') { print &del(sprintf("%${size}s: %s", '', $line)); } elsif ($mode eq '+') { print &add(sprintf("%${size}d: %s", $curline, $line)); $curline++; } elsif ($mode eq '(') { print hr(), start_center(), b("Binary files differ"), end_center(), hr(); $curline++; } else { print sprintf("%${size}d: %s", $curline, $line); $curline++; } } print end_pre(); close P4; } # # 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 () { 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 () { if (my($nrev, $nchange, $naction, $ndate, $nuser, $nclient) = /^\.\.\. \#(\d+) change (\d+) (\S+) on (\S+) by ([^@]+)@(\S+) /) { if ($nrev > $max_rev) { $max_rev = $nrev } if ($print) { $desc = &protect_html($desc); $desc =~ s/\n\s*\n/

\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 'integrate')) { 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. ; } elsif (/^\.\.\. \.\.\./) { # Skip these lines. These indicate branches and copies. } else { $desc .= $_; } } if ($print) { $desc = &protect_html($desc); $desc =~ s/\n\s*\n/

\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 'integrate')) { 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 here to view this depot's " . "non-deleted files."), br; } else { print em("Click here to view deleted " . "files from this depot."), br; } print em("You may also view this depot's " . "recent changes and " . "pending changes."), 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 ( ) { 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 " . "files and " . "recent changes."), br, br; my $cmd = "p4 opened -a $depot"; # Get client list my(%clients); &p4open(\*P4, $cmd); while () { 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 (sort 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 () { 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 $title; if (param('client')) { $title = 'Client ' . param('client') . ', '; } $title .= 'File ' . param('file'); if (param('revision') != 0) { $title .= ', revision ' . param('revision'); } if (!param('image')) { &start_with($title); } my $revision = param('revision'); my @cmds = &p4_print_common(param('file'), $revision, param('action')); if (param('image')) { return; } &print_cmds(@cmds); print end_html; } sub p4_print_common { my ($filename, $revision, $action) = @_; my $use_code2html = (($CODE2HTML ne "") && (-e $CODE2HTML)); my $filespec = $filename; if ($revision != 0) { $filespec .= '#' . $revision; } my $img = 0; my $language = 'c++'; if ($filename =~ /\.c$/) { $language = 'c'; } elsif ($filename =~ /\.awk$/) { $language = 'awk'; } elsif ($filename =~ /\.groff$/) { $language = 'groff'; } elsif ($filename =~ /\.html?$/) { $language = 'html'; } elsif ($filename =~ /\.java$/) { $language = 'java'; } elsif ($filename =~ /\.js$/) { $language = 'js'; } elsif ($filename =~ /\.m4$/) { $language = 'm4'; } elsif ($filename =~ /[Mm]akefile.*/) { $language = 'make'; } elsif ($filename =~ /\.p([lm5]|od)$/) { $language = 'perl'; } elsif ($filename =~ /Cons(cript|truct).*/) { $language = 'perl'; } elsif ($filename =~ /\.(c(c|pp|xx|\+\+)|h|hh|[iCH])$/) { $language = 'c++'; } elsif ($filename =~ /\.png$/) { $img = 1; $language = 'png'; } elsif ($filename =~ /\.gif$/) { $img = 1; $language = 'gif'; } elsif ($filename =~ /\.jpe?g$/) { $img = 1; $language = 'jpg'; } elsif ($filename =~ /\.xpm$/) { $img = 1; $language = 'xpm'; } elsif ($filename =~ /\.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 ($action eq 'edit') { $cmds[0] = 'p4 diff -du999999 ' . $filespec; } elsif ($action eq 'delete') { # no change } else { $cmds[0] = 'cat ' . &get_local_filename($filename); } } # Just send images by themselves. if (param('image')) { print header(-type=>'image/' . $language); &p4open(\*P4, $cmds[0]); while () { print $_; } return; } if ($img == 1) { print ''; &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') && ($action eq 'edit')) { $diff = 1; $_ = ; # 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 (!) { close P4; &p4open(\*P4, "p4 print -q $filespec"); $diff = 0; } } while () { my $line = $_; if ($diff && ($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(); print "\n
\n";
    while (<$rfh>) {
	print $_;
    }
    print "
\n"; $rfh->close(); return @cmds; } # # 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); $_ = ; 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 () { ($root) = /^Root:\s*(\S*)/; if (/^View:/) { $_ = ; ($depot) = /^\s*(\S*)\.\.\. /; } } close P4; my($numlines) = 1; # Go through all opened files &p4open(\*P4, 'p4 describe -s ' . $change_num); while () { 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 () { 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 () { 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'); } my $changenum; if (param('change')) { $changenum = param('change'); } $ENV{P4CLIENT} = param('client'); my $rfh = new FileHandle; my $wfh = new FileHandle; my $pid = open2($rfh, $wfh, $ENSCRIPT . $ENSCRIPT_OPTS . ' -t ' . ($changenum ? "\"Pending change $changenum in $ENV{P4CLIENT}\"" : "\"Pending changes in $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 () { ($root) = /^Root:\s*(\S*)/; if (/^View:/) { $_ = ; ($depot) = /^\s*(\S*)\.\.\. /; } } close P4; my($numlines) = 1; # For a specific pending change, include the change's description if ($changenum) { &p4open(\*P4, "p4 describe -s $changenum"); while () { if (/^Change/) { print $wfh "Pending change $changenum description:\n"; ++$numlines; } elsif (/^Jobs/) { last; } else { print $wfh $_; ++$numlines; } } close P4; } # Go through all opened files &p4open(\*P4, 'p4 opened'); while () { my($full_filename, $action, $change) = /(\S*)\#\d+ \- (\S*)\s*\w*\s*(\d*)/; if ($changenum && ($changenum ne $change)) { next; } my($file) = $full_filename; if ($file =~ /^$depot/) { $file = substr($file, length($depot)); } if ($action eq 'delete') { print $wfh "==== Deleted file $file\n\n"; $numlines += 2; } elsif ($action eq 'add') { print $wfh "==== Added file $file\n"; ++$numlines; if (open(FILE, &get_local_filename($full_filename))) { while () { printf $wfh "%04d ", $numlines; print $wfh expand($_); ++$numlines; } close FILE; } else { print $wfh "**** (Cannot view contents)\n"; ++$numlines; } print $wfh "\n"; ++$numlines; } elsif ($action eq 'branch') { print $wfh "==== Branched file $file\n\n"; $numlines += 2; } elsif ($action eq 'edit') { &p4open(\*P5, 'p4 diff -du' . $context . " " . $full_filename); while () { 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", "\n", "\n", "\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() . $line . qq(); } sub del { my($line) = @_; return qq() . $line . qq(); } 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 . ":
\n"); foreach my $cmd (@cmds) { print em($cmd) . "
\n"; } } sub get_local_filename { my ($file) = @_; &p4open(\*P4FN, 'p4 client -o ' . param('client')); my ($filename, $client, $rootdir, @depots, @dirs); while () { if (/^Client:\s+(\S+)/) { $client = $1; } elsif (/^Root:\s+(\S+)/) { $rootdir = $1; } elsif (/^View:/) { while () { 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 "" . $change . ""; } sub changes_url { my ( $depot ) = @_; return "" . $depot . ""; } sub client_url { my ( $client ) = @_; return "" . $client . ""; } sub client_url_wbr { my ( $client ) = @_; my ( $client_text ) = $client; $client_text =~ s/([-_|]+)/$1/g; return "" . $client_text . ""; } sub diff_url { my ( $client, $file, $action ) = @_; return "" . $action . ""; } sub diff2_url { my ( $file, $revision, $action ) = @_; return "$action"; } sub email_url { my ( $user ) = @_; &p4open(\*TEMP, 'p4 user -o ' . $user); my $email; while ( ) { if (/^Email:\s+(\S+)/) { $email = $1; # Don't trust anything after the @ if ((length($DOMAIN) > 0) && (index($email, "\@") != -1)) { $email = substr($email, 0, index($email, "\@")) . "\@" . $DOMAIN; } last; } } close TEMP; return a({-href=>'mailto:' . $email}, $user); } sub filelog_url { my ( $file ) = @_; return "" . $file . ""; } sub files_url { my ( $depot ) = @_; return "" . $depot . ""; } sub opened_url { my ( $depot ) = @_; return "" . $depot . ""; } sub print_pending_url { my ( $client, $file, $action, $revision ) = @_; return "p" . $revision . ""; } sub print_url { my ( $file, $revision, $action ) = @_; my ( $newrev ) = ($action eq "delete") ? ($revision - 1) : $revision; my ( $link ) = "" . $revision . ""; } else { $link .= "\">" . $file . ""; } return $link; } sub root_url { my ( $root ) = @_; return "" . $root . ""; }