#!/usr/local/bin/perl5
# -*-perl-*-
#################################################################
#
# "P4CGI" perl module
#
#################################################################
package P4CGI ;
use lib '/usr/local/lib/perl5/site_perl' ;
use CGI ;
use CGI::Carp ;
use strict ;
###
###
###
my $VERSION ;

###
### Module variables
###
my $P4 ;
my $CGI ;
local *P4 ;
my $currentChangeLevel ;
my $TMPDIR ;
my $pageEndPrinted ;
my $pageStartPrinted ;
my %administrators ;

# For cookies
my $cookie ;
my $cookie_p4port ;
my $extern_cookie ;

# Parameter for p4call() -p flag, page header, and USER_P4PORT()
my $userP4PORT ;

# Parameter for RESTRICTED() (see config file)
my @restricted ;

sub init ()
{
				## death handler
    $SIG{'__DIE__'} = sub {	# Thank You Ron Shalhoup for the idea
	my($error) = shift; 
	&P4CGI::bail("Signal caught: $error") ;	
	exit 0; 
    }; 

    # Set version
    $VERSION="0.99f" ;
    
    # Initiate CGI module (if we run as a cgi script!)
    $0 =~ /.cgi$/ and do { $CGI = new CGI ; } ;

    # Verify configuration file
    my $configFile="CONFIG" ;

    # Get any restricted files (see $configFile)
    open( CONFIG, $configFile ) ;
    while( <CONFIG> ) {
	chomp ;
	next unless /^#!\S+/ ;
	$_ =~ s/^#!// ;
	push ( @restricted, $_ ) ;
    }
    close CONFIG ;

    # Set the default environment
    eval `cat $configFile` ;

    # Bail on error
    if($@) {
	$@ =~ s/\n/\n<br>/g ;	
	&P4CGI::bail("Error reading configuration file: $configFile",
	    "<p><pre>$@</pre>") ;
    } ;

    ### Allow each user to point to a different repository
    #
    #   Store the information in a HTTP cookie, because eval'ing the
    #   config file everytime thru overwrites the environment's $P4PORT.
    #
    # Default P4 port and user's IP addr
    my $default_p4port = $ENV{P4PORT} ;
    my $ipaddr = $ENV{REMOTE_ADDR} ;

    # Associate a user's IP addr with a P4PORT, use the default unless
    # otherwise specified from top-level page (see index.cgi)
    my $addr_port ;
    my $newHost = P4CGI::cgi()->param("HOST") ;
    my $newPort = P4CGI::cgi()->param("PORT") ;
    if( defined $newHost ) {
	$addr_port = $newHost . ":" . $newPort ;
    }

    # Get IPaddr/host:port pairs from cookies
    my %p4ports ;
    my ($key,$val,$addr,$port) ;
    my @cookies = split( /; /, $ENV{HTTP_COOKIE} ) ;
    foreach( @cookies ) {
        ($key, $val) = split( /=/, $_ ) ;
        if( $key eq "USERS_P4PORT" ) {
            ($addr,$port) = split( /-/, $val ) ;
            $p4ports{$addr} = $port ;
        } 
    } ;
    # See if they have a cookie...
    if( defined $p4ports{$ipaddr} ) {
        # ...if they do, and it's stale, give them a new one...
        if( defined $newHost ) {
	    $cookie_p4port = $ipaddr . '-' . $addr_port ;
            # ...and set their P4PORT
	    $userP4PORT = $addr_port ;
        }
        # ...else let it ride, and set their P4PORT to it
        else {
	    $userP4PORT= $p4ports{$ipaddr} ;
        } ;
    }
    #...else, give them one and set their P4PORT
    else {
	$addr_port = $default_p4port ;
	$cookie_p4port = $ipaddr . '-' . $addr_port ;
	$userP4PORT = $addr_port ;
    } ;

    #
    ### End cookiestuff

    # Check that we have contact with p4 server & get the current chg no.
    $currentChangeLevel=4711 ;
    my $d ;
    p4call( \$d,"changes -m 1" ) ;
    $d =~ /Change (\d+)/ 
	or &P4CGI::bail("No contact with P4 server") ;
    $currentChangeLevel=$1 ;  
} ;

#################################################################
### Documentation start
=head1 NAME

P4CGI - Support for CGI's that interface p4. Written specifically for P4DB

=cut ;

sub DEFAULT_TABLE_ATTRIBUTES() { "" ; } ;
sub CURRENT_CHANGE_LEVEL() { $currentChangeLevel ; } ;
sub RESTRICTED() { @restricted ; } ;
sub USER_P4PORT() { "$userP4PORT" ; } ;

###################################################################
### Constants for depot browser
###

=head1 CONSTANTS

The constants are defined as perl subroutines.

=head2 Url's

=over 4

=item P4CGI::MAIN_URL()

Main entry point.

=item P4CGI::CBB_URL()

URL to Changes by Branch.

=item P4CGI::CBU_URL()

URL to Changes by User.

=item P4CGI::CHB_URL()

URL to Change browser. 

=item P4CGI::CHV_URL()

URL to change viewer. 

=item P4CGI::CLV_URL()

URL to client viewer. 

=item P4CGI::DTB_URL()

URL to depot tree browser. 

=item P4CGI::FV_URL()

URL to file viewer. 

=item P4CGI::SFV_URL()

URL to special file viewer.

=item P4CGI::SFV_HTML_URL()

URL to special file viewer for HTML

=item P4CGI::FLV_URL()

URL to file log viewer.

=item P4CGI::FDV_URL()

URL to file diff viewer.

=item P4CGI::LDV_URL()

URL to label diff viewer.

=item P4CGI::SFF_URL()

URL to search for file.

=item P4CGI::LAB_URL()

URL to list all branches.

=item P4CGI::LAL_URL()

URL to list all labels.

=item P4CGI::LAU_URL()

URL to list all users.

=item P4CGI::LOF_URL()

URL to list all opened files.

=item P4CGI::LU_URL()

URL to view a user.

=item P4CGI::LV_URL()

URL to view a labels.

=back

=cut ;

sub MAIN_URL()      { "index.cgi"    ; } ;
sub CBB_URL()       { "cbb.cgi"      ; } ;
sub CBU_URL()       { "cbu.cgi"      ; } ;
sub CHB_URL()       { "chb.cgi"      ; } ;
sub CHV_URL()       { "chv.cgi"      ; } ;
sub CLV_URL()       { "clv.cgi"      ; } ;
sub DNLD_URL()      { "dnld.cgi"     ; } ;
sub DTB_URL()       { "dtb.cgi"      ; } ;
sub FDV_URL()       { "fdv.cgi"      ; } ; 
sub FLV_URL()       { "flv.cgi"      ; } ; 
sub FV_URL()        { "fv.cgi"       ; } ; 
sub LAB_URL()       { "lab.cgi"      ; } ;
sub LAL_URL()       { "lal.cgi"      ; } ;
sub LAU_URL()       { "lau.cgi"      ; } ;
sub LDV_URL()       { "ldv.cgi"      ; } ; 
sub LOF_URL()       { "lof.cgi"      ; } ;
sub LU_URL()        { "lu.cgi"       ; } ;
sub LV_URL()        { "lv.cgi"       ; } ;
sub SFF_URL()       { "sff.cgi"      ; } ; 
sub SFV_URL()       { "sfv.cgi"      ; } ; 
sub SFV_HTML_URL()  { "sfv_html.cgi" ; } ; 

=head1 SUBROUTINES

=cut ;

###################################################################
###  cgi
###

=head2 P4CGI::cgi()

Return CGI reference 

Example:

    my $file = P4CGI::cgi()->param("file") ;
    print "File parameter value: $file\n" ;

=cut
    ;
sub cgi() {
    confess "CGI not initialized" unless defined $CGI ;
    return $CGI ;
}

###################################################################
###  p4call
###

=head2 P4CGI::p4call(I<result>,I<command>)

Request data from p4. Calls p4 with command I<command> and returns data in I<result>.

This function is really three different functions depeding in the type of the
I<result> parameter.

=over 4

=item I<result>

This parameter can be of three different types:

=over 4

=item Filehandle (typeglob)

Data from command can be read from filehandle. NOTE! File must be closed by
caller.

=item Reference to array

Returns result from command into array (newlines stripped)

=item Reference to scalar

Returns result from command into scalar. (lines separated by newline)

=back

Any other type of parameter will abort operation

=item I<command>

Command to send to p4 command line client.

=back

Example:

    my $d ;
    &P4CGI::p4call(\$d,"changes -m 1") ;
    $d =~ /Change (\d+)/ or &bail("No contact with P4 server") ;
    $currentChangeLevel=$1 ;    

=cut
    ;

sub p4call {
    my ( $par, @command ) = @_;
    my $partype = ref $par ;
    if(!$partype) {
	open( $par, "$P4 -p $userP4PORT @command |" ) ||
	    &bail( "p4 @command failed" );
	return ;
    }  ;
    "ARRAY" eq $partype and do {
	@$par = () ;
	open( P4, "$P4 -p $userP4PORT @command |" ) ||
	    &bail( "p4 @command failed" );
	while(<P4>) {
	    chomp ;
	    push @$par,$_ ;
	} ;
	close P4 ;
	return ;
    } ;
    "SCALAR" eq $partype and do {
	$$par = "" ;
	open( P4, "$P4 -p $userP4PORT @command |" ) ||
	    &bail( "p4 @command failed" );
	while(<P4>) {
	    $$par .= $_ ;
	} ;
	close P4 ;
	return ;
    } ;
    die("Called with illegal parameter ref: $partype") ;
} ;


###################################################################
###  set_cookie
###

sub set_cookie()
{
    $extern_cookie = shift @_ ;
}

###################################################################
###  start_page
###

=head2 P4CGI::start_page(I<title>[,I<legend>])

Start a page. Print http header and first part of HTML.

=over 4

=item I<title>

Title of page

=item I<legend> (Optional)

Short help text to be displayed at top of page

=back

Example:

 my $start = P4CGI::start_page("Title of page",
			       &P4CGI::dl_list("This","Goto this",
                                               "That","Goto that")) ;
 print $start ;

=cut ;
sub start_page($$)
{
   
    my $title = shift @_ ;
    my $legend = shift @_ ;
    my $backtourl = shift @_ ;
    my $backtoname = shift @_ ;
    my $prevchg = shift @_ ;
    my $nextchg = shift @_ ;
    my $n = 0 ;
    
    my $backtoimg = "../icons/back.gif" ;
    my $p4port = "" ;
    if(defined $userP4PORT) {
	my ($host,$port) = split /:/,$userP4PORT ;
	$p4port = 
	    "<small><table>\n<tr><th align=right>Host:<br>Port:"
		."</th><td>$host<br>$port</td></tr></table></small>\n" ;

    }

    # Set up HTML file header
    my $ret ;
    if( defined $cookie_p4port ) {
	$cookie="USERS_P4PORT=$cookie_p4port" ;
	$ret = $CGI->header('-Set-cookie'=>"$cookie") . "\n" ;
    }
    elsif( defined $extern_cookie ) {
	$ret = $CGI->header('-Set-cookie'=>"$extern_cookie") . "\n" ;
    }
    else {
	$ret = $CGI->header() . "\n" ;
    }
    my $t = "$title" ;
    $t =~ s/<br>/ /ig ;
    $t =~ s/<[^>]*>//g ;
    $ret .=  $CGI->start_html(

    #####
    # Take this out, if you like having your links underscored.
    # (I find they get in the way, especially with links that
    # already have underscores as part of their text.)
			      -style=>'A:active,A:hover
				{color:"#0088ff"; text-decoration:none;}
				A:visited
				{color:"#000099"; text-decoration:none;}',
    # End style
    #####
			      -title   => "P4DB: $t",
			      -author  => "holtdl\@yahoo.com",
			      -bgcolor => "#e0f0f0",
			      -text    => "#000000",) . "\n" ;

    $ret .= start_table("width=100% bgcolor=\"#FFFF99\" border=0 cellspacing=8") ;
    $ret .= table_row(-valign  => "top",
		      {-align  => "center",
		       -valign => "center",
		       -width  => "20%",
		       -text   => "<a name=pagetop></a>",
		       -text   => "<br><small><b>Current change number:</b></small>
			    $currentChangeLevel"},
		      {-align  => "center",
		       -valign => "center",
		       -width  => "60%",
		       -bgcolor=> "#ccffff",
		       -text   => "<font size=+1 color=red><b>$title</b></font>\n"},
		      {-align  => "center",
		       -valign => "center",
		       -width  => "20%",
		       -text   => $p4port}) ;
    $ret .= table_row(-bgcolor => "#cccccc",
		      undef,
		      {-align   => "left",
		       -text    => $legend ? "$legend":""},
		      {-align   => "center",
		       -valign  => "middle",
		       -bgcolor => "aqua",
		       -text    => ahref(-url=>"$backtourl","$backtoname")}) ;
    $ret .= table_row({-align  => "left",
		       -width  => "20%",
		       -text   => $prevchg ? "$prevchg":""},
		      {-align  => "center",
		       -width  => "60%",
		       -text   => ""},
		      {-align  => "right",
		       -width  => "20%",
		       -text   => $nextchg ? "$nextchg":""}) ;
			
    $ret .= end_table() ;
    $pageStartPrinted = 1 ;
    return $ret . "<hr>\n" ;    
} ;

###################################################################
###  end_page
###

=head2 P4CGI::end_page()

End a page. Print HTML trailer.

Example:

 print P4CGI::end_page() ;

=cut ;
sub end_page()
{
    # Check to see if we're being called from index.cgi
    my $indexcheck = shift @_ ;
    $pageEndPrinted = 1 ;
    my $adms ;
    my $adm ;
    foreach $adm (sort keys %administrators) {
	if(defined $adms) {
	    $adms .= "  ||  " ;
	}
	else {
	    $adms = "<font color=red>Mail:</font> " ;
	} ;
	$adms .= "<a href=mailto:$administrators{$adm}>$adm</a>" ;
    } ;
    # Don't print "Page Top" return link for top-level page - it should
    # never be long enuf to need it.
    if ( $indexcheck ) {
	return join("",
		    ("<hr><small><i>\n",
		     $adms,
		     "</small>",
		     $CGI->end_html())) ;
    }
    else {
	return join("",
	    ("<hr><table align=right valign=center><td>
	      <img height=15 width=15 border=0 src=../icons/uarrw.gif>&nbsp;
	      <a href=#pagetop>Page Top</a></td></table>",
	     "<small><i>\n", $adms, "</small>",
	     $CGI->end_html())) ;
    }
}

###################################################################
### bail
###

=head2 P4CGI::bail(I<message>)

Report an error. This routine will emit HTML code for an error message and exit. 

=over 4

=item I<message>
Message that will be displayed to user

=back

Example:

 unless(defined $must_be_defined) { 
     &P4CGI::bail("was not defined") ; 
 } ;

=cut ;

sub bail {
    my $message = shift @_ ;
    my $text = shift @_ ;    
    unless(defined $pageStartPrinted) {
	print 
	    "",
	    $CGI->header(),
	    $CGI->start_html(-title   => "Error in script",
			     -bgcolor => "white");
    } ;    
    $message = &fixSpecChar($message) ;
    print 
	"<br><hr color=red><p align=center><font color=red size=+2>An error has occurred<br>Sorry!</font><p><font color=red>Message:<br><pre>$message</pre><br>" ;
    if(defined $text) { 
	$text = &fixSpecChar($text) ;
	print "<pre>$text</pre><br>\n" ; 
    } ;
    print
	"<p>Parameters to script:<br>",
	$CGI->dump() ;
    print "</font>",end_page() ;
    exit 1 ;
}

###################################################################
### start_table
###  

=head2 P4CGI::start_table(I<table_attribute_text>)

Start a table with optional table attributes

=over 4

=item I<table_attribute_text>

This text will be inserted as attributes to table tag

=back

Example:

    print P4CGI::start_table("align=center border") ;

=cut ;
sub start_table($) 
{
    my $attribs = shift @_ ;
    my $ret = "<table " . DEFAULT_TABLE_ATTRIBUTES() ;  
    if($attribs) {
	$ret .=  " $attribs" ;
    }
    return $ret . ">\n";
}

###################################################################
### end_table
###  

=head2 P4CGI::end_table()

Return end of table string. (trivial function included mostly for symmetry)

=cut ;
sub end_table() 
{
    return "</table>\n" ;
}

###################################################################
### tableRow
###

=head2 P4CGI::table_row(I<options>,I<listOfValues>)

Insert a row in table.

=over 4

=item I<options>

A list of key/value pairs (a hash will do just fine) containing options for 
the row. 

The key must start with a "-".

Most key/value pairs are treated as attributes to the <TR>-tag.
The following keys are recognized as special:

=over 4

=item C<-type>

Type of cells. Default is <TD>-type. 

=item C<->I<anykey>

I<anykey> will be assumed to be a row option and will be inserted in the TR-tag. 
The value for the option is the key value, unless value is empty or undefined, in which
case the option anykey is assumed to have no value.

=back

=item C<listOfValues>

Row data. Remaining values are assumed to be data for each cell. 
The data is typically the text in the cell but can also be:

=over 4

=item undef

An undefined value indicates that the next cell spans more than one column. 

=item Reference to a hash

The hash contains two keys: "-text" for cell text and "-type" for cell type.
All other key/value pairs are treated as attributes to the <TD> or <TH> tag.

=back

=back

Example:

 print P4CGI::start_table("align=center") ;
                                   ### print header row
 print P4CGI::table_row(-type   => "th",
			-valign => "top",
			-align  => "left",
                        "Heading 1","Heading 2",undef,"Heading 3") ;
                                   ### print data
 my %h = (-text    => "text in hash", 
	  -bgcolor => "blue") ;
 print P4CGI::table_row(-valign  => "top",
			-bgcolor => "white",
                        "Cell 1",
			{-text    => "Cell 2",
			 -bgcolor => "red"},
			\%h,
			"Cell 3-2") ;
 print P4CGI::end_table() ;

=cut ;
sub table_row 
{   
    confess ("P4CGI::table_row() Parameters required!") if @_ == 0 ;
    my @ret ;
    my $n = 0 ;
    my $ec = 0 ;
    my $option = shift @_ ;
    my %options ;
    while(defined $option and ($option =~ s/^-//)) {	
	confess ("P4CGI::table_row() Option value required!") if @_ == 0 ;
	$options{lc($option)} = shift @_ ;
	$option = shift @_ ;
    }
    unshift @_,$option ;
    
    my $type      = "td" ;
    $type = $options{"type"} if defined $options{"type"} ;
    delete $options{"type"} ;

    push @ret,"<tr" ;
    my $attr ;
    foreach $attr (keys %options) {
	push @ret," $attr" ;
	if($options{$attr}) {
	    push @ret,"=$options{$attr}" ;
	}
    }
    push @ret,">\n" ;

    my $colspan = 0 ;
    my $cell ;
    foreach $cell (@_) {
	$colspan++ ;
	if(defined $cell) {
	    my $COLSPAN="colspan=$colspan" ;
	    $colspan=0 ;
	    if(ref $cell) {
		my $reftyp = ref $cell ;
		"HASH" eq $reftyp and do { my $txt = $$cell{"-text"} ;
			confess "P4CGI::table_row() Missing text argument" 
			unless defined $txt ;
			delete $$cell{"-text"} ;
			my $tp = $type ;
			$tp = $$cell{"-type"} if defined 
			$$cell{"-type"} ;
			delete $$cell{"-type"} ;
			push @ret,"<$tp $COLSPAN" ;
			my $attr ;
			foreach $attr (keys %$cell) {
			    ($a = $attr) =~ s/^-// ;
			    push @ret," $a=$$cell{$attr}" ;
			}
			push @ret,">$txt</$tp>\n" ;
			next ; } ;
		confess "Illegal cell data type: $reftyp" ;
	    } 
	    else {
		push @ret,"<$type $COLSPAN>$cell</$type>\n" ;
	    }
	}
    }
    push @ret,"</tr>\n" ;
    return join("",@ret) ;
}

###################################################################
### Make a list
###

=head2 P4CGI::ul_list(I<list>)

Return a bulleted list.

=over 4

=item I<list>

Lits of data to print as bulleted list

=back

Example:

 print P4CGI::ul_list("This","is","a","bulleted","list") ;

=cut ;
sub ul_list(@) 
{
    my @ret ;
    if($_[0] eq "-title") {
	shift @_ ;
	push @ret, shift @_ ;
    }
    push @ret,"<ul>\n" ;
    my $a ;
    foreach $a (@_) {
	push @ret,"<li>$a\n" ;
    }
    push @ret,"</ul>\n" ;
    return join("",@ret) ;
}

###################################################################
### Make a dl list
###

=head2 P4CGI::dl_list(I<list_of_pairs>)

Returns a definition list.

=over 4

=item I<list_of_pairs>

List of data pairs to print as a definition list. 
A hash will do just fine, only you have no control over the order in the list. 

=back

Example:

 print P4CGI::dl_list("This","Description of this",
                      "That","Description of that") ;

=cut ;
sub dl_list
{
    my @ret ;
    if($_[0] eq "-title") {
	shift @_ ;
	push @ret,shift @_ ;  
    }
    if($_[0] eq "-compact") {
	push @ret,"<dl compact>\n" ;
	shift @_ ;
    } 
    else {
	push @ret,"<dl>\n" ;
    }
    while(@_ > 1) {
	push @ret,"<dt>",shift @_,"<dd>",shift @_,"\n" ;
    }
    push @ret,"</dl>\n" ;
    return join("",@ret) ;
}

###################################################################
### Fix some special characters
###

=head2 P4CGI::fixSpecChar(I<str>)

Convert all '>' to "C<E<amp>gt;>", '<' to "C<E<amp>lt;>" and '&' to "C<E<amp>amp;>".

=over 4

=item I<str>

String to convert

=back

Example:

    my $cvstr = &P4CGI::fixSpecChar("String containing <,> and &") ;

=cut ;
sub fixSpecChar($)
{    
    my $d = shift @_ ;
    $d =~ s/&/&amp;/g ; # & -> &amp;
    $d =~ s/\"/&quot;/g;# " -> &quot;
    $d =~ s/</&lt;/g  ; # < -> &lt;
    $d =~ s/>/&gt;/g  ; # > -> &gt;
    return $d ;
}

###################################################################
### Replace tabs with spaces
###

=head2 P4CGI::rmTabs(I<str>)

Convert tabs to spaces

=over 4

=item I<str>

String to convert

=back

=cut ;
sub rmTabs($)
{    
    # This algorithm is kind of, well, the first thing I came up
    # with. Should be replaced with a smarter (== more efficient)
    # eventually.......
    my $l = shift @_ ;    
    if($l =~ /\t/) {
	my $pos = -1 ;
	$l = join('',map
		  { 
		      $pos++ ;
		      if($_ ne "\t") {
			  $_  ;
		      } else
		      {
			  my $p = $pos % 8 ;
			  $pos += 7-$p ;
			  substr("        ",$p) ;
		      } ;
		  } split('',$l)) ;
	# For those that wonder what is going on:
	# 1.  Split string to an array (of characters)
	# 2.  For each entry of array, map a function that returns value
	#     for entry or, if value is <TAB>, returns a number of spaces
	#     depending on position in string
	# 3.  Make string (scalar) of array returned from map using join().
    }
    return $l ;
}

###################################################################
### Create a href tag
###

=head2 P4CGI::ahref(I<options>,I<parameters>,I<text>)

Create a <A HREF...>...</A> tag pair.

=over 4

=item I<options>

Optional list of option-value pairs. Valid options are:

=over 4

=item C<-url>

Url for link. Default is current.

=item C<-anchor>

Anchor in url. Default is none.

=back

Any non-valid option marks the end of the options

=item I<parameters>

Optional list of parameters for link.

=item I<text>

The last parameter is used as text for link. 

=back

Example:

    print &P4CGI::ahref("Back to myself") ; # link to this. No parameters.

    print &P4CGI::ahref("-url","www.perforce.com",
			"To perforce") ; # link to perforce

    print &P4CGI::ahref("-anchor","THERE",
			"Go there") ; # link to anchor THERE

    print &P4CGI::ahref("-url","chb.cgi",
			"FSPC=//.../doc/...",
			"Changes for all documentation") ; # url with parameter

=cut ;
sub ahref
{    
    my $url = $ENV{SCRIPT_NAME} ;
    my $anchor = "" ;
    my $pars   = "" ;
    my $params = "" ;
    while($_[0] =~ /^-/) {
	$_[0] =~ /^-url$/i and do {
	    shift @_ ;
	    $url = shift @_ ;
	    next ;
	} ;
	$_[0] =~ /^-anchor$/i and do {
	    shift @_ ;
	    $anchor = "#" . shift @_ ;
	    next ;
	} ;
	$_[0] =~ /^-(.*)/ and do {
	    my $p = $1 ;
	    shift @_ ;
	    my $v = shift @_ ;
	    $params .= " $p=$v" ;
	    next ;
	} ;
	last ;
    }
    while(@_ > 1) {
	if(length($pars) > 0) {
	    $pars .= "&" ;
	}
	else {
	    $pars = "?" ;
	} ;
	$pars .= shift @_ ;
    } ;
    my $txt = shift @_ ;
    $pars =~ s/ /\+/g ;
    return "<a href=\"${url}${anchor}${pars}\"$params>$txt</a>" ;
}

###################################################################
### Set magic buttons
###

=head2 P4CGI::magic(I<text>)

Substitutes magic phrases in I<text> with links.

Currently the pattern "change I<number>" is replaced with a link to the
change browser.

=back

Example:

    my $t = "This change is the same as change 4711, but with a twist" ;

    print &P4CGI::magic($t) ; # inserts a link to change 4711

=cut ;
sub magic($)
{    
    my $t = shift @_ ;
    my $url = &CHV_URL() ;
    $t =~ s/(change[\s\n]+\#*)(\d+)/<a href=\"$url?CH=$2\">$1$2<\/A>/ig ; #"    
    $t =~ s/(change no\.*[\s\n]+\#*)(\d+)/<a href=\"$url?CH=$2\">$1$2<\/A>/ig ; #"    
    return $t ;
}

###################################################################
### Fixspaces
###

=head2 P4CGI::fixspaces(I<text>)

Return parameter with spaces substituted with %20

=back

Example:

    my $t = "/File with spaces" ;

    print &P4CGI::fixspaces($t) ; # prints: /File%20with%20spaces

=cut ;
sub fixspaces($)
{    
    my $t = shift @_ ;
    $t =~ s/ /%20/g ;
    $t =~ s/\+/%2b/g ;
    $t =~ s/-/%2d/g ;
    $t =~ s/_/%5f/g ;
    $t =~ s/~/%7e/g ;
    return $t ;
}

# Execute a command, keeping the output of the command in an array.
# Returns the array, unless an error occured, in which case an
# exception is thrown (via die) with an appropriate message.
sub command {
    my($command) = @_;
    my(@results) = `$command`;
    if ($?) {
	my($err) = ($? >> 8);
	print STDERR @results;
	die qq($0: "$command" exited with status $err.\n);
    }
    @results
}


###################################################################
###
### BEGIN
###
sub BEGIN ()
{
    init() ;
} ;

1;