#!/usr/local/bin/perl # # p4xml.pl - a CGI script for serving up Perforce related data as # XML to web applications # # Accepted parameters: # command=<perforce command> - Perforce command (required) # path - a depot path # rev=<rev specifier> - a Perforce revision specifier # user=<user> - a Perforce user # client=<client> - a Perforce client # max=<num> - max number of elements # followIntegs=<anything> - shockingly enough, follow integs a.k.a. '-i' # long=<anything> - fetch long descriptions # # Returned data: Perforce tagged data formatted as XML, root tag named <perforce> # # Sample query: http://public.perforce.com/cgi-bin/p4xml.pl?command=changes;path=//guest/matt_attaway/p4xml/... # use strict; use Switch; my $user = "matt_attaway"; my $passwd = "foobar"; my $port = "public.perforce.com:1666"; my $p4exec = "p4.exe"; my $p4 = "$p4exec -ztag -p $port -u $user -P $passwd "; # let's get this party started my %vars = &getCgiVars; if( ($ENV{'REQUEST_METHOD'} eq 'GET') ) { # das headers print "Content-type: text/xml\n\n" ; print "<?xml version='1.0' encoding='ISO-8859-1'?>"; # verify we at least have a command if( !exists $vars{"cmd"} ) { print "<perforce><error>Give me a command fool</error></perforce>"; exit; } my $ results; switch( $vars{"cmd"} ) { case "changes" { $results = &fetchChanges } else { print "<perforce><error>Give me a command fool</error></perforce>"; exit; } } # the good stuff print "<perforce>$results</perforce>"; } sub fetchChanges { my( @changes, $cmdline, $output ); my $needEndTag = 0; # get the changes $cmdline .= $p4 . "changes "; if( exists $vars{"user"} ) { $cmdline .= "-u " . $vars{"user"} . " "; } if( exists $vars{"client"} ) { $cmdline .= "-c " . $vars{"client"} . " "; } if( exists $vars{"max"} ) { $cmdline .= "-m " . $vars{"max"} . " "; } if( exists $vars{"followIntegs"} ) { $cmdline .= "-i "; } if( exists $vars{"long"} ) { $cmdline .= "-l "; } if( exists $vars{"path"} ) { $cmdline .= $vars{"path"}; } if( exists $vars{"rev"} ) { $cmdline .= $vars{"rev"}; } @changes = `$cmdline`; # now parse 'em my $desc; my $parsingDesc = 0; while( scalar(@changes) ) { $_ = shift @changes; # handle multiline descriptions if( $parsingDesc ) { if( /^\.\.\. .*/ ) { unshift @changes, $_; $output .= "$desc</desc>"; $desc = ""; $parsingDesc = 0; } else { $desc .= $_; } next; } # toss away blank lines between sets of changes next if /^$/; # throw on the end tag if we need it if( /^\.\.\. change/ && $needEndTag ) { $output .= '</change>'; } # handle actual output switch( $_ ) { case /^\.\.\. change/ { /^\.\.\. change ([0-9]*)/; $output .= "<change id=\"$1\">"; } case /^\.\.\. desc/ { /^\.\.\. desc (.*)/; $desc .= "<desc>$1"; $parsingDesc = 1; } else { /^\.\.\. (\w*) (.*)/; $output .= "<$1>" . $2 . "</$1>"; } } $needEndTag = 1; } $output .= '</change>'; return $output; } sub getCgiVars( ) { my( $in, $key, $val ); # read entire string of CGI vars if( ($ENV{'REQUEST_METHOD'} eq 'GET') || ($ENV{'REQUEST_METHOD'} eq 'HEAD') ) { $in = $ENV{'QUERY_STRING'}; } elsif ($ENV{'REQUEST_METHOD'} eq 'POST') { read(STDIN, $in, $ENV{'CONTENT_LENGTH'}) ; } else { exit; } # resolve name/value pairs into %in foreach( split( /[&;]/, $in ) ) { s/\+/ /g ; my ($key, $val) = split /=/; $key =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/ge ; $val =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/ge ; $vars{$key}.= $val ; } return %vars ; }
# | Change | User | Description | Committed | |
---|---|---|---|---|---|
#10 | 7151 | Matt Attaway | Fix platform issue | ||
#9 | 6234 | Matt Attaway |
Add more input validation. I wouldn't run this on an external network, but it seems safe enough for intranet usage. |
||
#8 | 6232 | Matt Attaway | Start adding in more variable verification. | ||
#7 | 6230 | Matt Attaway |
Add support for 'p4 monitor' and expand the tagged output parser to take a paramter for the main tag name. |
||
#6 | 6181 | Matt Attaway |
Add support for all specs except groups. Groups has odd output, it's going to need a custom parser. |
||
#5 | 6180 | Matt Attaway | Yank out the extra newlines Perforce loves to put between list elements. | ||
#4 | 6179 | Matt Attaway |
Generalize spec list parser code The tagged output for the spec list commands is all pretty much the same, so there was a lot of redundant code. |
||
#3 | 6178 | Matt Attaway |
Add jobs support. The next step is to generalize the spec data parsing function. |
||
#2 | 6174 | Matt Attaway | Add support for long descriptions and the -i flag | ||
#1 | 6173 | Matt Attaway |
First cut at a Perforce XML server. At this point the CGI script will return XML describing a list of changes. |