1 # Copyright (c) 2003-2009 Nokia Corporation and/or its subsidiary(-ies).

     2 # All rights reserved.

     3 # This component and the accompanying materials are made available

     4 # under the terms of "Eclipse Public License v1.0"

     5 # which accompanies this distribution, and is available

     6 # at the URL "http://www.eclipse.org/legal/epl-v10.html".

     7 #

     8 # Initial Contributors:

     9 # Nokia Corporation - initial contribution.

    10 #

    11 # Contributors:

    12 #

    13 # Description:

    14 # Script that actually calls the send_xml_to_diamonds.pl for sending data to Diamonds server

    15 # It also maintains the Diamonds BuildID

    16 #

    17 package publishDiamonds;

    18 use strict;

    19 use FindBin;

    20 use lib "$FindBin::Bin";

    21 

    22 my $buildIdFile = "DiamondsBuildID";

    23 #~ my $server = 'diamonds.nmp.nokia.com:9003';

    24 #~ my $localServer = '2ind04992.noe.nokia.com:8888';

    25 sub publishToDiamonds

    26 {

    27   my $file = shift;

    28   my $server = shift;

    29   chomp ($file);

    30   

    31   ##--remove blank lines

    32   open (FILE,"<$file") or warn "$file::$!\n";

    33   open (OUT, ">tmpfile.$$") or warn "tmpfile.$$::$!\n";

    34   while(<FILE>)

    35   {

    36     next if /^\s*$/;

    37     print OUT $_;

    38   }

    39   close FILE; close OUT;

    40   unlink("$file") or warn "Error in deleting: $!\n";

    41   rename("tmpfile.$$", "$file") or warn "Error in rename: $!";

    42   

    43   my $command = "perl $FindBin::Bin\\send_xml_to_diamonds.pl -s $server -f $file";

    44   

    45   my $id = 0;

    46   eval

    47   {

    48     open(FH,"<DiamondsBuildID") or warn "DiamondsBuildID file not created: $!\n";

    49   };

    50   if (!$@)

    51   {

    52     $id = <FH>;

    53     close (FH);

    54   }

    55   if($id ne "" && $id > 1)

    56   {

    57     $command .= " -u /diamonds/builds/$id/";

    58     executeCommand($command);

    59   }

    60   else

    61   {

    62     $command .= " -u /diamonds/builds/";

    63     $id = executeCommand($command);

    64     open (FH,">DiamondsBuildID") or die "DiamondsBuildID file not created: $!\n";

    65     print FH $id;

    66   }

    67 close(FH);

    68 }

    69 

    70 

    71 sub executeCommand

    72 {

    73   my $command = shift;

    74   #~ print "$command\n";

    75   my @cmdOP = `$command`;

    76   my @serverResponse = grep {/^Server response:/i} @cmdOP;

    77   my @responseStatus = grep {/^Response status:/i} @cmdOP;

    78   my @responseReason = grep {/^Response reason:/i} @cmdOP;

    79   

    80   chomp(@serverResponse,@responseReason,@responseStatus);

    81   if ($responseStatus[0] !~ /:200/)

    82   {

    83     print "Error sending XML: $responseReason[0]\n";

    84   }

    85   elsif($serverResponse[0] !~ /:\/diamonds\/builds\/\d+\//)

    86   {

    87     print "Diamond Server Response: $serverResponse[0]\n";

    88   }

    89   else

    90   {

    91     $serverResponse[0] =~ /:\/diamonds\/builds\/(\d+)\//;

    92     my $id = $1;

    93     print "$id\n";

    94     return $id;

    95   }

    96 }

    97 

    98 1;