#!/usr/bin/perl -w
# Backups Blow by Brandon Low 
#
# Copyright 2007 Brandon Low 
# Released under the terms of the GPL v2
#
# http://lostlogicx.com/backupsblow/

package BackupsBlow::Transport::Ftp;

use strict;
use Exporter;
our (@EXPORT_OK, %EXPORT_TAGS, @ISA);
@ISA = qw(Exporter);
@EXPORT_OK = qw(&performBackup &removeBackups &listBackups &fixBackupPath);
%EXPORT_TAGS = ("all" => [@EXPORT_OK]);

use BackupsBlow::Config qw(:read);
use BackupsBlow::Programs qw(:all);
use BackupsBlow::Util qw(:transport);

use Log::Log4perl;
my $logger=Log::Log4perl->get_logger();

sub fixBackupPath ($) {
    my ($backupPath)=@_;
    $backupPath=~s/\/*$/\//;
    return $backupPath;
}

sub buildFtpCommand () {
    # Create a general ftp command
    my @ftpCommand;
    push @ftpCommand,needProgram("ncftp");
    push @ftpCommand,buildFtpBase();
    return join(" ",@ftpCommand);
}

# Package up an echo command to echo pre and post lines
# surrounding the output of a given ftp command
sub buildEchoCommand ($$$) {
    my @startCommand;
    push @startCommand,"echo";
    push @startCommand,$_[1];
    my @endCommand;
    push @endCommand,"echo";
    push @endCommand,$_[2];
    my @commands;
    push @commands,join(" ",@startCommand);
    push @commands,$_[0];
    push @commands,join(" ",@endCommand);
    my @echoCommand;
    push @echoCommand,"echo";
    push @echoCommand,"\"" . join(";", @commands) . "\"";
    return join(" ", @echoCommand);
}

# Build a base for the FTP commands
sub buildFtpBase () {
    my @ftpBase;

    push @ftpBase, "-u ".needConfig("USERNAME");
    push @ftpBase, "-p ".needConfig("PASSWORD");
    push @ftpBase, needConfig("HOSTNAME");

    return @ftpBase
}

sub performBackup ($$$$) {
    my ($backupDir,$backupFile,$incFile,$errFile)=@_;

    my @command;
    push @command,buildTarCommand($incFile, $errFile);

    # Build a ftp put commandline
    my @ftpCommand;
    push @ftpCommand,needProgram("ncftpput"); # Pipeable ftp command
    push @ftpCommand,"-c";                    # Read from stdin
    push @ftpCommand,buildFtpBase();          # The basic username/site/pwd
    push @ftpCommand,"$backupDir$backupFile"; # Destination file
    # Build a command to delay ftp start until there is data to transfer
    my @delayCommand;
    push @delayCommand,"while [ ! -s $errFile ]";
    push @delayCommand,"do sleep 1";
    push @delayCommand,"done";
    push @delayCommand,join(" ",@ftpCommand);
    push @command,"(" . join(";",@delayCommand) . ")";
    my $command=join("|",@command);
    system($command);
    unless ($? == 0) {
        die("Failed to perform backup: $command: $?");
        capture("rm $backupDir$backupFile");
    }
}

sub removeBackups ($$) {
    my ($backupDir,$fileNames)=@_;
    unshift @$fileNames,"rm";
    my $rmCommand=join(" $backupDir",@$fileNames);
    my @rm=capture($rmCommand);
    my $errStr;
    foreach my $line(@rm) {
        $errStr.="$line " if ($line =~ m/failed/i);
    }
    die("Failed to remove old backups: $rmCommand: $errStr") if ($errStr);
}

# Takes an ftp command to read the FTP server and a command to run there
# returns an array of the lines resulting from the command
sub capture ($) {
    my @commands;
    push @commands,buildEchoCommand($_[0],"B#B#S","B#B#E");
    push @commands,buildFtpCommand();
    my $command=join("|",@commands);
    # Capture the output from the ls comand
    my @lsOutput=`$command`;

    #TODO: This should report the error to the caller, not die itself
    die("Unable to capture $_[0]") unless ($? == 0);
    my @retVal;
    # Search the listing for the actual output of our command
    my $active=0;
    foreach my $line(@lsOutput) {
        chomp($line);
        unless ($active) {
            $active=1 if ($line =~ m/^B#B#S$/);
            next;
        }
        last if ($active == 1 && $line =~ m/^B#B#E$/);
        $line=~s/^[[:space:]]*(.*)[[:space:]]*$/$1/;
        push @retVal,$line unless ($line =~ m/^$/);
    }
    return @retVal;
}

# Takes a directory to list
# returns an array of files in that directory
sub listBackups ($) {
    # Create a command to list the backups already on the server
    my @lsCommand;
    push @lsCommand,"ls";
    push @lsCommand,"-1";
    push @lsCommand,$_[0];
    return capture(join(" ",@lsCommand));
}

1;