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;