- #!/usr/local/bin/perl5
- # -*- perl -*-
- use P4CGI ;
- use strict ;
- #
- #####################################################################
- ##
- ## CONFIGURATION INFORMATION
- ## All config info should be in $configFile (see init() in P4CGI.pm)
- ##
- #####################################################################
- ##
- ## List User
- ##
- #####################################################################
- # Set back references
- my $homepage="index.cgi";
- my $backtohome="Back to Home" ;
- # Get user name
- my $user = P4CGI::cgi()->param("USER") ;
- unless(defined $user) {
- &P4CGI::bail("No user specified.") ;
- }
- # See if they want to see their clients
- my $showclients = P4CGI::cgi()->param("CLIENTS") ;
- # Get user info
- local *P4 ;
- &P4CGI::p4call(*P4, "user -o $user" );
- my $email ;
- my $update ;
- my $access ;
- my $fullname ;
- my $jobview ;
- my $reviews ;
- while(<P4>) {
- chomp ;
- next if /^#/ ;
- next if /^\s*$/ ;
- /^Email:\s(\S+)/ and do { $email=&P4CGI::ahref(-url => "mailto:$1",$1) ; } ;
- /^Update:\s(.*)$/ and do { $update=$1 ; } ;
- /^Access:\s(.*)$/ and do { $access=$1 ; } ;
- /^FullName:\s(.*)$/ and do { $fullname=$1 ; } ;
- /^JobView:\s(.*)$/ and do { $jobview=$1 ; } ;
- last if /^Reviews:/ ;
- }
- while(<P4>) {
- chomp ;
- s/^\t// ;
- if( defined $reviews ) { $reviews .= "\n$_" ; }
- else { $reviews = "$_" ; }
- }
- close P4 ;
- $reviews = "" unless defined $reviews ;
- # Print title and legend
- if( defined $showclients ) {
- "",
- &P4CGI::start_page("P4 User Information",
- &P4CGI::ul_list("<b>Email:</b> to send mail to user",
- "<b>Client:</b> to see P4 client info",
- "<b>Filename:</b> to see complete file history"),
- $homepage,$backtohome) ;
- }
- else {
- "",
- &P4CGI::start_page("P4 User Information",
- &P4CGI::ul_list("<b>Email:</b> to send mail to user",
- "<b>Filename:</b> to see complete file history",
- "<hr>",
- &P4CGI::ahref(-url => "lu.cgi",
- "USER=$user",
- "CLIENTS=yes",
- "<b>Display user's clients</b>")),
- $homepage,$backtohome) ;
- }
- # Print user
- "",
- "<b>User:</b><font color=green> $user ($fullname)</font>" ;
- # Print user info
- &P4CGI::start_table(""),
- &P4CGI::table_row({-align => "right",
- -type => "th",
- -text => "Email:"},
- $email),
- &P4CGI::table_row({-align => "right",
- -type => "th",
- -text => "Update:"},
- $update),
- &P4CGI::table_row({-align => "right",
- -type => "th",
- -text => "Access:"},
- $access),
- &P4CGI::table_row({-align => "right",
- -type => "th",
- -text => "FullName:"},
- $fullname),
- &P4CGI::table_row({-align => "right",
- -type => "th",
- -text => "JobView:"},
- $jobview) ;
- if(defined $reviews) {
- print &P4CGI::table_row({-align => "right",
- -valign => "top",
- -type => "th",
- -text => "Reviews:"},
- "<pre>$reviews</pre>") ;
- }
- # Get user's clients
- my @clients ;
- my $listclient ;
- my $listclients ;
- if( defined $showclients ) {
- &P4CGI::p4call(*P4, "clients" );
- while( <P4> ) {
- my $client ;
- chomp ;
- /^Client (\S+) / and do {
- my $client = $1 ;
- push( @clients, $client ) ; } ;
- }
- foreach $listclient (@clients) {
- my ( $owner, $lclient ) ;
- local *P4 ;
- &P4CGI::p4call(*P4, "client -o $listclient" );
- while(<P4>) {
- chomp ;
- next unless /^Owner:/ ;
- /^Owner:\s+(\S+)/ ;
- $owner = $1 ;
- if( $owner eq $user ) {
- $lclient = &P4CGI::ahref( -url => &P4CGI::CLV_URL(),
- "CLIENT=$listclient",
- $listclient ) ;
- if(defined $listclients) {
- $listclients .= "\n$lclient" ;
- }
- else {
- $listclients = "$lclient" ;
- }
- }
- }
- }
- if( defined $listclients ) {
- print &P4CGI::table_row({-align => "right",
- -type => "th",
- -valign => "top",
- -text => "Clients:"},
- "<pre>$listclients</pre>") ;
- }
- }
- # Get opened files for user
- my $openfiles ;
- &P4CGI::p4call(*P4, "opened -a" ) ;
- while(<P4>) {
- chomp ;
- / by $user\@/ and do {
- /^(.*) -.* by \w+\@(\S+)/ ;
- my $file = $1 ;
- my $client = &P4CGI::ahref(-url=>&P4CGI::CLV_URL(),"CLIENT=$2",$2);
- $file =~ /(.*)\#(\d+)/ ;
- my $file = &P4CGI::ahref(-url => &P4CGI::FLV_URL(),
- &P4CGI::fixspaces("FSPC=$1"),
- $file) ;
- if(defined $openfiles) {
- $openfiles .= "\n$file (On client: $client)" ;
- } else {
- $openfiles = "$file (On client: $client)" ;
- }
- }
- }
- if(defined $openfiles) {
- print &P4CGI::table_row({-align => "right",
- -type => "th",
- -valign => "top",
- -text => "Open files:"},
- "<pre>$openfiles</pre>") ;
- }
- # End the table, end the page
- &P4CGI::end_table(),
- &P4CGI::end_page() ;
# | Change | User | Description | Committed | |
---|---|---|---|---|---|
#1 | 271 | Diane Holt | The Perl files for P4DB. These (almost) match the files in rev 1 of the p4db.tar file --... a few files have some minor cosmetic changes in the code, and chv.cgi has a Legend item added that was missing in the one in the tar-file. These files, at rev 1 (and the files in p4db.tar at rev 1), are suitable for for running the app with release 98.2 of P4. « |
25 years ago |