#!/devtool/local/bin/perl
#
#    archive_pcr.pl - archives the precompiler runtimes
#
#    @(#)archive_pcr.pl     2003-02-24
#
#    U. Jansen, SAP AG
#
#    *WARNING* *WARNING* *WARNING* *WARNING* *WARNING* *WARNING*
#
#    This script can only run, if a valid Makeprofiles.xml is
#    found under $OWN/sys/wrk/config !!!
#
#    *WARNING* *WARNING* *WARNING* *WARNING* *WARNING* *WARNING*
#
#    ========== licence begin LGPL
#    Copyright (C) 2002 SAP AG
#
#    This library is free software; you can redistribute it and/or
#    modify it under the terms of the GNU Lesser General Public
#    License as published by the Free Software Foundation; either
#    version 2.1 of the License, or (at your option) any later version.
#
#    This library is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
#    Lesser General Public License for more details.
#
#    You should have received a copy of the GNU Lesser General Public
#    License along with this library; if not, write to the Free Software
#    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#    ========== licence end
#

unshift @INC, "$ENV{TOOL}/bin";
unshift @INC, "$ENV{TOOL}/lib/Perl";

use XML::DOM;
require Net::FTP;
import  Net::FTP;

select (STDERR); $| = 1;
select (STDOUT); $| = 1;

################################################################################
# main() - The main entry point.
################################################################################

unless (defined $ENV{'MACHINE_CONFIG'})
{
    print STDERR "ERROR: Environment variable 'MACHINE_CONFIG' is not set!\nExiting...\n\n";
    exit(1);
}

unless (-e "$ENV{'OWN'}/sys/wrk/config/Nachtmake.xml")
{
    print STDERR "ERROR: Can't read configuration file '$ENV{'OWN'}/sys/wrk/config/Nachtmake.xml'!\nExiting...\n\n";
    exit(1);
}

my $Glob    = {};
my $RC      = 0;

$Glob->{'OWN'}              = $ENV{'OWN'};
$Glob->{'MACHINE_CONFIG'}   = $ENV{'MACHINE_CONFIG'};

FillPlatformHash("$ENV{'OWN'}/sys/wrk/config/Nachtmake.xml", "_default");
FillPlatformHash("$ENV{'OWN'}/sys/wrk/config/Nachtmake.xml", "$ENV{'MACHINE_CONFIG'}");

if ($Glob->{'ARCHPCR_COND'})
{
    print "Config used:\n\n";
    print "ARCHPCR_TYPE     = $Glob->{'ARCHPCR_TYPE'}\n";
    print "ARCHPCR_SRV      = $Glob->{'ARCHPCR_SRV'}\n";
    print "ARCHPCR_USR      = $Glob->{'ARCHPCR_USR'}\n" if ($Glob->{'ARCHPCR_TYPE'} eq "ftp");
    print "ARCHPCR_SROOT    = $Glob->{'ARCHPCR_SROOT'}\n";
    print "ARCHPCR_DROOT    = $Glob->{'ARCHPCR_DROOT'}\n";
    print "ARCHPCR_FLIST    = HASH:\n";
    foreach my $dest (keys %{$Glob->{'ARCHPCR_FLIST'}}) { print "                   $Glob->{'ARCHPCR_FLIST'}->{$dest} --> $dest\n"; }
    print "\n";

    if (!CopyPCR($Glob->{'ARCHPCR_TYPE'}))
    {
        print STDERR "Can't copy files to server!\n";
        $RC = 1;
    }
    else
    {
        print "File(s) copied.\n";
    }

}
else
{
    print "Nothing to do for this release...\n";
}

caller () ? return ( $RC ) : exit ( $RC );



################################################################################
# FillPlatformHash() - Reads platform settings from a XML-File
################################################################################

sub FillPlatformHash
{
    my $XMLFile  = shift;
    my $platform = shift;
    my $node;
    my $parser   = new XML::DOM::Parser or return;
    my $doc      = $parser->parsefile($XMLFile) or return;

    foreach my $elem ($doc->getElementsByTagName("platform"))
    {
        if ($elem->getAttribute("id") eq $platform) { $node = $elem; last; }
    }

    return unless ($node);

    foreach my $elem ($node->getChildNodes())
    {
        if (($elem->getNodeType() == 1) and ($elem->getNodeName() eq "option"))
        {
            my $name = $elem->getAttribute("name");
            my $type = $elem->getAttribute("type");
            my $val  = $elem->getFirstChild()->getData();

            if      ($type eq "scalar") { $$Glob{$name} = $elem->getFirstChild()->getData() }
            elsif   ($type eq "array")
            {
                my @tmparr = split(/,/, $elem->getFirstChild()->getData());
                $Glob->{$name} = \@tmparr;
            }
            elsif   ($type eq "hash")
            {
                my %tmphash     = split(/,/, $elem->getFirstChild()->getData());
                $Glob->{$name}  = \%tmphash;
            }
            elsif ($type eq "strevl")
            {
                eval '$Glob->{$name} = "' . $elem->getFirstChild()->getData() . '";';
                if ($@) { print STDERR "XMLparse eval error: $@\n" }
            }
            elsif ($type eq "cmdevl")
            {
                eval '$Glob->{$name} = ' . $elem->getFirstChild()->getData() . ';';
                if ($@) { print STDERR "XMLparse eval error: $@\n" }
            }
            else { print STDERR "XMLparse type error: Unknown option format found ($name, $type, $val)\n" }
        }
    }
}


################################################################################
# FillPlatformHash() - Reads platform settings from a XML-File
################################################################################

sub CopyPCR
{
    my $type = shift;
    if ($type eq "ftp")
    {
        return(_CopyFTP());
    }
    else
    {
        print STDERR "ERROR: Unknown copy method '$type'!\n";
    }

    return(0);
}

##############################################################################
# _CopyFTP() - Copies a file list to a ftp server
##############################################################################

sub _CopyFTP
{
    chdir($Glob->{'ARCHPCR_SROOT'});

    print "Connecting to '$Glob->{'ARCHPCR_SRV'}'..";
    my $ftp = Net::FTP->new($Glob->{'ARCHPCR_SRV'}, Debug =>0);

    if (!$ftp)
    {
        print "..FAILED!\n";
        print STDERR "ERROR: Connection to '$Glob->{'ARCHPCR_SRV'}' failed!\n";
        return (0);
    }
    else
    {
        print "..OK\n";
    }

    print "Logging in..";

    if (!$ftp->login($Glob->{'ARCHPCR_USR'}, $Glob->{'ARCHPCR_PW'}))
    {
        print "..FAILED!\n";
        print STDERR "ERROR: Login with user '$Glob->{'ARCHPCR_USR'}' failed!\n";
        $ftp->quit();
        return (0);
    }
    else
    {
        print "..OK\n";
    }

    if (!$ftp->cwd($Glob->{'ARCHPCR_DROOT'}))
    {
        print "Creating directory '$Glob->{'ARCHPCR_DROOT'}'..";

        if (!$ftp->mkdir($Glob->{'ARCHPCR_DROOT'}, 1))
        {
            print "..FAILED!\n";
            print STDERR "ERROR: Can't create dir '$Glob->{'ARCHPCR_DROOT'}'!\n";
            $ftp->quit();
            return (0);
        }
        else
        {
            print "..OK\n";
        }

        if (!$ftp->cwd($Glob->{'ARCHPCR_DROOT'}))
        {
            print STDERR "ERROR: Can't change to dir '$Glob->{'ARCHPCR_DROOT'}'!\n";
            $ftp->quit();
            return (0);
        }
    }

    $ftp->binary();

    foreach my $destfile (keys %{$Glob->{'ARCHPCR_FLIST'}})
    {
        print "Copying file '$destfile'..";
        if ($destfile =~ /^(.*)[\/\\](([^\/\\])+)/)
        {
            if (!$ftp->mkdir($1, 1))
            {
                print STDERR "ERROR: Can't create dir '$1'!\n";
                next;
            }
        }

        if ($ftp->put($Glob->{'ARCHPCR_FLIST'}->{$destfile},$destfile))
        {
            print "..OK\n";
        }
        else
        {
            print "..FAILED!\n";
        }
    }

    $ftp->quit();

    return (1);
}

################################################################################
# ReadFileLines() - Reads [n] lines from a file
################################################################################

sub ReadFileLines
{
    my $file    = shift;
    my $lines   = shift;
    my $line    = 1;
    my $tmpvar;

    unless (open (IN_FILE, "<$file"))
    {
        print STDERR "ERROR: Can't open file '$file'!\n" ;
        return 0;
    }

    while (<IN_FILE>)
    {
        chomp $_;
        $tmpvar .= ($tmpvar eq "" ? "$_" : "\n$_");
        last if ($line == $lines);
        $line ++;
    }

    close (IN_FILE) or print STDERR "ERROR: Can't close file '$file'!\n$!\n";

    return $tmpvar;
}

