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");
}
print
"
Error: $message
" ;
if(defined $text) { print "$text\n" ; } ;
print
"Script parameters:
",
$CGI->dump() ;
print "",end_page() ;
exit 1 ;
}
###################################################################
### start_table
###
=head2 P4CGI::start_table(I)
Start a table with optional table attributes
=over 4
=item I
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 = "\n";
}
###################################################################
### end_table
###
=head2 P4CGI::end_table()
Return end of table string. (trivial function included mostly for symmetry)
=cut ;
sub end_table()
{
return "
\n" ;
}
###################################################################
### tableRow
###
=head2 P4CGI::table_row(I,I)
Insert a row in table.
=over 4
=item I
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 -tag.
The following keys are recognized as special:
=over 4
=item C<-type>
Type of cells. Default is -type.
=item C<->I
I 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
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 has contains two keys: "-text" for cell text and "-type" for cell type.
All other key/value pairs are treated as attributes to the or | 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
{
my @ret ;
my $n = 0 ;
my $option = shift @_ or croak ("Parameters required!") ;
my %options ;
while(defined $option and ($option =~ s/^-//)) {
$options{lc($option)} = shift @_ or croak ("Parameters required!") ;
$option = shift @_ or croak ("Parameters required!") ;
}
unshift @_,$option ;
my $type = "td" ;
$type = $options{"type"} if defined $options{"type"} ;
delete $options{"type"} ;
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"} or
carp "Missing text argument" ;
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," \n" ;
return join("",@ret) ;
}
###################################################################
### Make a list
###
=head2 P4CGI::ul_list(I)
Return a bulleted list.
=over 4
=item I
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,"\n" ;
my $a ;
foreach $a (@_) {
push @ret,"- $a\n" ;
}
push @ret,"
\n" ;
return join("",@ret) ;
}
###################################################################
### Make an dl list
###
=head2 P4CGI::dl_list(I)
Returns a definition list.
=over 4
=item I
List of data pairs to print as a definition list.
A hash will do just fine, only that You have no control of 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,"\n" ;
shift @_ ;
}
else {
push @ret,"\n" ;
}
while(@_ > 1) {
push @ret,"- ",shift @_,"
- ",shift @_,"\n" ;
}
push @ret,"
\n" ;
return join("",@ret) ;
}
###################################################################
### valid_lockfile
###
=head2 P4CGI::valid_lockfile(I)
Check if I is a valid lock file. Return true if I is a valid lock file.
=over 4
=item I
Name of lock file
=back
Example:
if(P4CGI::valid_lockfile("/tmp/lockfile")) {
print "Locked\n" ;
}
=cut ;
sub valid_lockfile($ ) {
return (-r $_[0]) && kill(0,`cat $_[0]`) ;
} ;
###################################################################
### create_lockfile
###
=head2 P4CGI::create_lockfile(I)
Create a valid lock file for this process. Returns true if success.
=over 4
=item I
Name of lock file
=back
Example:
P4CGI::create_lockfile("/tmp/lockfile") or die "can't create lockfile!" ;
=cut ;
sub create_lockfile($ ) {
if(valid_lockfile($_[0])) {
return 0 ;
}
system("echo $$ >$_[0]") ;
return valid_lockfile($_[0]) ;
} ;
###################################################################
### Fix some special characters
###
=head2 P4CGI::fixSpecChar(I)
Convert all '>' to "Cgt;>", '<' to "Clt;>" and '&' to "Camp;>".
=over 4
=item I
String to convert
=back
Example:
my $cvstr = &P4CGI::fixSpecChar("String containing <,> and &") ;
=cut ;
sub fixSpecChar($ )
{
my $d = shift @_ ;
$d =~ s/&/&/g ; # & -> &
$d =~ s/\"/"/g;# " -> "
$d =~ s/</g ; # < -> <
$d =~ s/>/>/g ; # > -> >
return $d ;
}
###################################################################
### Create a href tag
###
=head2 P4CGI::ahref(I,I,I)
Create a ... tag pair.
=over 4
=item I
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
Optional list of parameters for link.
=item I
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=//depot/.../doc/...",
"Changes for all documentation") ; # url with parameter
=cut ;
sub ahref
{
my $url = $ENV{SCRIPT_NAME} ;
my $anchor = "" ;
my $pars = "" ;
while($_[0] =~ /^-/) {
$_[0] =~ /^-url$/i and do {
shift @_ ;
$url = shift @_ ;
next ;
} ;
$_[0] =~ /^-anchor$/i and do {
shift @_ ;
$anchor = "#" . shift @_ ;
next ;
} ;
last ;
}
while(@_ > 1) {
if(length($pars) > 0) {
$pars .= "&" ;
}
else {
$pars = "?" ;
} ;
$pars .= shift @_ ;
}
return "$_[0]" ;
}
###################################################################
### Set magic buttons
###
=head2 P4CGI::magic(I)
Substitutes magic phrases in I with links.
Currently the pattern "change I" 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+)/$1$2<\/A>/ig ; #"
$t =~ s/(change no\.*[\s\n]+\#*)(\d+)/$1$2<\/A>/ig ; #"
return $t ;
}
###################################################################
### Make a directory
###
sub makedir($ ) {
my $dir= shift @_ or confess("missing parameter") ;
my $parentDir;
($parentDir="/$dir") =~ s/\/[^\/]+$//;
if ($parentDir ne "") {
$parentDir =~ s/^\///;
-d $parentDir || do { makedir($parentDir) };
}
mkdir $dir,0777 || die "Can not mkdir $dir\n";
chmod 0777,$dir ;
}
###################################################################
### BEGIN
###
sub BEGIN ()
{
init() ;
} ;
1;
|