#!/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 # path - a depot path # rev - a Perforce revision specifier # # Returned data: Perforce tagged data formatted as XML, root tag named # # 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') ) { # verify we at least have a command if( !exists $vars{"cmd"} ) { print "Content-type: text/html\n\nGive me a command fool"; exit; } my $ results; switch( $vars{"cmd"} ) { case "changes" { $results = &fetchChanges } else { print "Content-type: text/html\n\nI can't handle dat yet. Yo."; exit; } } # das headers print "Content-type: text/xml\n\n" ; print ""; # the good stuff print "$results"; } sub fetchChanges { my( @changes, $cmdline, $output ); my $needEndTag = 0; # get the changes $cmdline .= $p4 . "changes "; if( exists $vars{"path"} ) { $cmdline .= $vars{"path"}; } if( exists $vars{"rev"} ) { $cmdline .= $vars{"rev"}; } @changes = `$cmdline`; # now parse 'em foreach( @changes ) { next if /^$/; next if !/^\.\.\./; if( /^\.\.\. change/ && $needEndTag ) { $output .= ''; } switch( $_ ) { case /^\.\.\. change/ { /^\.\.\. change ([0-9]*)/; $output .= ""; } else { /^\.\.\. (\w*) (.*)/; $output .= "<$1>" . $2 . ""; } } $needEndTag = 1; } $output .= ''; return $output; } sub getCgiVars( ) { my( $in, $key, $val ); # read entire string of CGI vars into $in 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 ; }