#!/usr/bin/perl -w # -*- perl -*- use P4CGI ; use strict ; use CGI::Carp ; # ################################################################# # CONFIGURATION INFORMATION # All config info should be in P4CGI.pm # ################################################################# # # P4 file log viewer # ################################################################# ## Check if we have GD (required for branchGraph.cgi). my $GD_AVAILABLE=undef ; { my $tmpDie = $SIG{'__DIE__'} ; $SIG{'__DIE__'} = "" ; eval ' use GD ; ' ; if(length($@) == 0) { $GD_AVAILABLE= "Y" ; } $SIG{'__DIE__'} = $tmpDie ; } sub offsetOf($@ ) { my $v = shift @_ ; my $pos = 0 ; while(@_ > 0) { if($v eq (shift @_)) { return $pos ; } $pos++ ; } return -1 ; } my $err2null = &P4CGI::REDIRECT_ERROR_TO_NULL_DEVICE() ; my $err2stdout = &P4CGI::REDIRECT_ERROR_TO_STDOUT() ; # File argument my $file = P4CGI::cgi()->param("FSPC") ; &P4CGI::bail("No file spec") unless defined $file ; $file = &P4CGI::htmlEncode($file) ; my $showBranching = P4CGI::cgi()->param("SHOWBRANCH") ; # Get file data my @filelogdata ; my %relatedFiles ; local *F ; &P4CGI::p4call(*F,"filelog -l -t \"$file\"") ; my $curr ; while() { chomp ; next if /^\s*$/ ; /^\.\.\. \#(\d+) change (\d+) (\S+) on (\S+ \S+) by (\S+)\@(\S+) \((\S+)\)/ and do { my %data ; my $rev ; ($rev, $data{"change"}, $data{"action"}, $data{"date"}, $data{"user"}, $data{"client"}, $data{"type"}) =($1,$2,$3,$4,$5,$6,$7); $data{"date"} =~ s/ / / ; $data{"description"} = "" ; $data{"labels"} = [] ; $data{"open"} = [] ; $curr = \%data ; unshift @filelogdata,$curr ; next ; } ; /^\t(.+)/ and do { ${$curr}{"description"} .= $1 . "\n" ; next ; } ; /^\.\.\. \.\.\. (\S+) (\S+) (.+)$/ and do { my ($act,$dir,$filespec) = ($1,$2,$3) ; $filespec =~ /([^\#]+)(\#\d+.*)/ and do { my ($file,$r) = ($1,$2) ; $filespec = &P4CGI::ahref(-url=>"fileLogView.cgi", "FSPC=$file", "HELP=View file log", "$file$r") ; $relatedFiles{$file} = 1 ; } ; if(!exists ${$curr}{$dir}) { my @arr ; ${$curr}{$dir} = \@arr ; } push @{${$curr}{$dir}},"$act $filespec" ; } ; } close *F ; if (@filelogdata == 0) { my @legendList ; my $filename = $file ; $filename =~ s/^.*\/// ; my $searchPattern = "//.../$filename" ; push @legendList, &P4CGI::buttonCell("fileSearch.cgi", "Search depot for $filename", "FSPC=$searchPattern", "Search depot for file") ; print &P4CGI::start_page("No information available about $file",@legendList) , &P4CGI::end_page() ; exit 0 ; } ; my @opendata ; # Get info about opened status &P4CGI::p4call(\@opendata,"opened -a \"$file\" $err2null") ; my $openedText = "" ; while(@opendata) { $_ = shift @opendata ; $openedText = "Opened by" ; /^.*\#(\d+) - .* by (\S+)\@(\S+)/ or &P4CGI::bail("Can not read info from \"p4 opened\"") ; my ($rev,$user,$client) = ($1,$2,$3) ; $user = &P4CGI::ahref(-url => "userView.cgi", "USER=$user", "HELP=View user info", "$user") ; $client = &P4CGI::ahref(-url => "clientView.cgi", "CLIENT=$client", "HELP=View client info", "$client") ; push @{${$filelogdata[$rev-1]}{"open"}},"$user\@${client}" ; } ; ## ## Get Label cross reference ## my %fileToLabels ; # Hash containing labels by file name and version { my @labels ; # Labels containing file &P4CGI::p4call(\@labels,"labels $file") ; map { s/^Label (\S+) .*/$1/ ; } @labels ; if(@labels > 0) { my $filelabels = "" ; foreach (@labels) { $filelabels .= " \"$file\@$_\"" ; } my @filesInLabels ; &P4CGI::p4call(\@filesInLabels,"files $filelabels $err2null") ; foreach (@filesInLabels) { my $labt = shift @labels ; my $lab = &P4CGI::ahref(-url => "labelView.cgi", "LABEL=$labt", "HELP=View label", "$labt") ; /^.*\#(\d+)/ and do { my $v = $1 ; push @{${$filelogdata[$v-1]}{"labels"}},"$lab" ; } ; /^(\S+)/ ; if(defined $fileToLabels{$1}) { $fileToLabels{$1} .= "
$lab" ; } else { $fileToLabels{$1} = "$lab" ; } } } ; } ; ### ### Get jobs fixed by changes to file ### my %jobDataByChangeNo ; { my @fixes ; &P4CGI::p4call(\@fixes,"fixes -i \"$file\"") ; foreach (@fixes) { /^(.*) fixed by change (\d+)/ and do { my ($job,$change)=($1,$2) ; my %jobData ; &P4CGI::p4readform("job -o \"$job\"",\%jobData) ; $jobData{"Job"} = &P4CGI::ahref(-url=>"jobView.cgi", "JOB=$jobData{Job}", "HELP=View job", "$jobData{Job}") ; $jobData{"Description"} = &P4CGI::formatDescription($jobData{"Description"}) ; $jobDataByChangeNo{$change} = \%jobData ; } ; } ; } ; my @legendList ; push @legendList, &P4CGI::buttonCell("changeList.cgi", "List all changes for this file", "FSPC=$file", "Changes") ; my @parsListLab ; my $p ; foreach $p (&P4CGI::cgi()->param()) { push @parsListLab, "$p=" . &P4CGI::cgi()->param($p) unless $p eq "LISTLAB" ; } if(defined $showBranching) { &P4CGI::cgi()->delete("SHOWBRANCH") ; push @legendList, &P4CGI::buttonCell(&P4CGI::cgi()->url(-query=>1), "Hide all notes about branching in file log", "Hide branch info") ; } else { &P4CGI::cgi()->param("SHOWBRANCH","Y") ; push @legendList, &P4CGI::buttonCell(&P4CGI::cgi()->url(-query=>1), "Display notes about branching in file log", "Show branch info") ; } ; my %vars ; { my $par ; foreach $par (&P4CGI::cgi()->param()) { $vars{$par} = &P4CGI::cgi()->param($par); } ; } ; if($GD_AVAILABLE) { push @legendList, &P4CGI::buttonCell("branchGraph.cgi", "Show graph over branches and merges to/from this file", "FSPC=$file", "View Branch Graph") ; } # Get file directory part my $fileDir=$file ; $fileDir =~ s#/[^/]+$## ; push @legendList, "  " ; push @legendList, &P4CGI::buttonCell("depotTreeBrowser.cgi", "Browse depot tree at $fileDir", "FSPC=$fileDir", "Browse dir.") ; print &P4CGI::start_page("File log for $file",@legendList) ; my $labelHead =""; $labelHead="In label(s)" ; print &P4CGI::start_framedTable("Log") ; print &P4CGI::start_table("class=\"ListX\"") ; print &P4CGI::table_header("Rev", "Action", "Date and time", "User", "Change", "Type", $labelHead, $openedText) ; my @revs ; while(@filelogdata) { my $rev = scalar @filelogdata ; push @revs,$rev ; my $tmpr = pop @filelogdata ; my %data = %{$tmpr} ; my $revLink ; my $actionLink ; if(defined $showBranching and exists $data{"into"}) { foreach (@{$data{"into"}}) { /^(\w+) (.*)/ ; my ($act,$file) = ($1,$2) ; print &P4CGI::table_row(-valign => "top", # -class=>"Delimiter", "", undef, undef, undef, undef, undef, undef, undef, {-class=>"kalle", -text=>"$act into $file"}) ; } ; } ; if( $data{"action"} eq "delete") { $revLink = {-rowspan=>"2", -class=>"ListHeadColumn", -text=>"\#$rev"} ; $actionLink = {-class=>"ListC", -text=>$data{"action"}} ; } else { $revLink = {-rowspan=>"2", -class=>"ListHeadColumn", -text=> &P4CGI::ahref(-url=>"fileViewer.cgi", "FSPC=$file", "REV=$rev", "HELP=View file", "\#$rev")} ; $actionLink = {-class=>"ListC", -text=>&P4CGI::ahref(-url=>"fileDiffView.cgi", "FSPC=$file", "REV=$rev", "ACT=$data{action}", "HELP=View diff", $data{"action"})} ; } ; print &P4CGI::table_row(-valign => "top", -class => "\"Top\"", $revLink, $actionLink, {-class=>"List", -text =>$data{"date"}}, {-class=>"List", -text =>&P4CGI::ahref(-url=>"userView.cgi", "USER=$data{user}", "HELP=View user info", $data{"user"})}, {-class=>"List", -text =>&P4CGI::ahref(-url=>"changeView.cgi", "CH=$data{change}", "HELP=View change", $data{"change"})}, {-class=>"ListC", -text =>"$data{type}"}, {-class=>"List", -text =>join("
",@{$data{"labels"}})}, join("
",@{$data{"open"}})) ; my %desc = ( -text => &P4CGI::formatDescription($data{"description"}), -class=> "Description" ) ; print &P4CGI::table_row(-valign => "top", undef, undef, undef, undef, undef, undef, undef, \%desc) ; if(exists $data{"from"}) { foreach (@{$data{"from"}}) { /^(\w+) (.*)/ ; my ($act,$file) = ($1,$2) ; print &P4CGI::table_row(-valign => "top", # -class=>"Delimiter", "", undef, undef, undef, undef, undef, undef, undef, {-class=>"kalle", -text=>"$act from $file"}) ; } ; } ; if(exists $jobDataByChangeNo{$data{"change"}}) { my %jobData = %{$jobDataByChangeNo{$data{"change"}}} ; print &P4CGI::table_row(-valign => "top", "", "Fixes job:
$jobData{Job}", undef, undef, undef, undef, undef, undef, {-class=>"Description", -text =>$jobData{"Description"}}) ; } ; } ; print &P4CGI::end_table("") ; if(@revs > 2) { print "
", &P4CGI::cgi()->startform("-action","fileDiffView.cgi", "-method","GET"), &P4CGI::cgi()->hidden("-name","FSPC", "-value",&P4CGI::urlEncode("$file")), &P4CGI::cgi()->hidden("-name","DP", "-value",&P4CGI::CURR_DEPOT_NO()), &P4CGI::cgi()->hidden("-name","ACT", "-value","edit"), &P4CGI::start_framedTable("Show diff between revisions"), &P4CGI::cgi()->popup_menu(-name =>"REV", "-values" =>\@revs); shift @revs ; print " and ", &P4CGI::cgi()->popup_menu(-name =>"REV2", "-values" =>\@revs), " ", &P4CGI::cgi()->submit(-name =>"Go", -value =>"Go"), &P4CGI::end_framedTable(), &P4CGI::cgi()->endform() ; } ; sub getRelatedFiles($ ) { my $file = shift @_ ; my @data ; &P4CGI::p4call(\@data,"filelog \"$file\"") ; my %res ; map { if(/^\.\.\. \.\.\. \w+ \w+ (\S+?)\#/) { $res{$1} = 1 ; } ; } @data ; return ( sort keys %res ) ; } ; if((keys %relatedFiles) > 0) { my @rel = sort keys %relatedFiles ; my @fileLinks = map { &P4CGI::ahref("-url","fileLogView.cgi", "FSPC=$_", "HELP=View file log", "$_") ; } @rel ; my %indrel ; $relatedFiles{$file} = 1 ; while(@rel > 0) { my $r ; foreach $r (map { exists $relatedFiles{$_} ? () : $_ } getRelatedFiles(shift @rel)) { &P4CGI::ERRLOG("found: $r") ; $indrel{$r} = 1; push @rel, $r ; $relatedFiles{$r} = 1 ; } } my @indFileLinks = map { &P4CGI::ahref("-url","fileLogView.cgi", "FSPC=$_", "HELP=View file log", "$_") ; } sort keys %indrel ; print "
", &P4CGI::start_framedTable("Related files"), &P4CGI::start_table(""), &P4CGI::table_row({-class => "Prompt", -text => "Direct related:" }, { -text => join("
",@fileLinks) }) ; if(@indFileLinks > 0) { print "", &P4CGI::table_row({ -class => "Prompt", -text => "Indirect related:" }, { -text => join("
",@indFileLinks) }) ; } ; print &P4CGI::end_table(), &P4CGI::end_framedTable() ; } ; print &P4CGI::end_framedTable(), &P4CGI::end_page() ; # # That's all folks #