Subversion Repositories DevTools

#!/usr/bin/perl
#
#   This simple CGI script is deployed to the package server within the
#   http subsystem ( lighttpd or apache )
#   
#   The function is used by Release Manager to locate build logs for a specific build
#   
#   This script must work within both lighttpd and apache. Issues: 
#       * lighttpd cannot return error codes
#   
use CGI qw(:standard);
use JSON;
my $cgi = CGI->new();
print header('application/json');
my $json->{result} = 1;

my $rootDir='/export/devl/abtlog';
my $rootDirLen = 1+length($rootDir);

if (! -d $rootDir) {
    $json->{result} = -1;
    $json->{error} = "ABT Root directory does not exist"

} elsif ( ! defined $cgi->param("rtagId") ) {
    $json->{result} = -1;
    $json->{error} = "Parameter not present: rtagId"

} elsif ( ! defined $cgi->param("buildRef") ) {
    $json->{result} = -1;
    $json->{error} = "Parameter not present: buildRef"

} else  {

    # Expect files in the path
    #   /export/devl/abtlog/<BuildMachine>/<rtgId>/<BuildRef>/<PackageVersion>.log

    my $globStr = $rootDir . '/*/'. scalar $cgi->param("rtagId") .'/' .  scalar $cgi->param("buildRef") . '/*.log';
    push @data, glob($globStr);
    my @clean =  map {substr($_,$rootDirLen)} @data;

    $json->{data} = \@clean;

    #$json->{ref} =  scalar $cgi->param("buildRef");
    #$json->{glob} =  $globStr;
    #$json->{dataRaw} = \@data;
}

my $json_text = to_json($json);
print $json_text;