File Coverage

blib/lib/Brackup/Target/Gmail.pm

Criterion	Covered	Total	%
statement	12	49	24.4
branch	0	14	0.0
condition	0	6	0.0
subroutine	4	9	44.4
pod	0	4	0.0
total	16	82	19.5

package Brackup::Target::Gmail;

use strict;
use Net::FS::Gmail;
use File::Temp qw/tempfile/;
use base 'Brackup::Target';

our $VERSION = "0.1";
our $CACHE_TABLE = "gmail_key_exists";

=head1 NAME

Brackup::Target::Gmail - a GMail target to Brackup

=head1 SYNOPSIS

See Brackup for a details

=head1 EXTREMELY SERIOUS WARNING AND GENERAL ASS COVERING

This is completely alpha software. It hasn't even been tested properly.

It will almost certainly destroy all your data then come round your house,
empty any the bags of flour all over the kitchen, kick in your TV,
scratch the screen of your iPod Nano, get jam fingerprints on your favourite
limited edition "Me First and the Gimmie Gimmies" CDs and then urinate in
your laundry basket.

In fact, to paraphrase Neal Stephenson: Unless you are as smart as Johann Karl
Friedrich Gauss, savvy as a half-blind Calcutta bootblack, tough as General
William Tecumseh Sherman, rich as the Queen of England, emotionally resilient as
a Red Sox fan, and as generally able to take care of yourself as the average
nuclear submarine commander, you should never have been allowed near this module.
Please dispose of it as you would any piece of high-level radioactive waste and
then arrange with a qualified surgeon to amputate your arms at the elbows and gouge
your eyes from their sockets.

If you ignore this warning, read on at your peril -- you are dead certain to lose
everything you've got and live out your final decades beating back waves of termites
in a Mississippi Delta leper colony.

=head1 AUTHOR

Simon Wistow

=head1 COPYRIGHT

Copyright 2006, Simon Wistow

Distributed under the same terms as Perl itself.

=cut

# NOTE
# the cache stuff is ripped off Brackup::Target::Amazon
# and could probably be merged to give a generic hash implementation


sub new {
    my ($class, $confsec) = @_;
    my $self = bless {}, $class;
    my $user  = $confsec->value("gmail_username");
    my $pass  = $confsec->value("gmail_password");
    $self->{_gmail} = Net::FS::Gmail->new( username => "$user", password => "$pass" );

    if (my $cache_file = $confsec->value("exist_cache")) {
        $self->{dbh} = DBI->connect("dbi:SQLite:dbname=$cache_file","","", { RaiseError => 1, PrintError => 0 }) or
            die "Failed to connect to SQLite filesystem digest cache database at $cache_file: " . DBI->errstr;

        eval {
            $self->{dbh}->do("CREATE TABLE ${CACHE_TABLE} (key TEXT PRIMARY KEY, value TEXT)");
        };
        die "Error: $@" if $@ && $@ !~ /table ${CACHE_TABLE} already exists/;
    }



    return $self;
}


# returns bool
sub has_chunk {
    my ($self, $chunk) = @_;
    my $dig = $chunk->backup_digest;   # "sha1:sdfsdf" format scalar

    if (my $dbh = $self->{dbh}) {
        my $ans = $dbh->selectrow_array("SELECT COUNT(*) FROM ${CACHE_TABLE} WHERE key=?", undef, $dig);
        warn "gmail database for $dig is = $ans\n";
        return 1 if $ans;
    }

    my %files = eval { map { $_ => 1 } $self->{_gmail}->files() };
    my $ret = !$@ && exists $files{$dig};
    $self->_cache_existence_of($dig) if ($ret);
    return $ret;

}


sub _cache_existence_of {
    my ($self, $dig) = @_;
    if (my $dbh = $self->{dbh}) {
        $dbh->do("INSERT INTO ${CACHE_TABLE} VALUES (?,1)", undef, $dig);
    }
}

# returns true on success, or returns false or dies otherwise.
sub store_chunk {
    my ($self, $chunk) = @_;
    my ($fh, $filename) = tempfile( UNLINK => 1 );
    print $fh ${ $chunk->chunkref };
    close($fh);
    $self->{_gmail}->store($filename, $chunk->backup_digest);
}

sub store_backup_meta {
    my ($self, $name, $file) = @_;
    my ($fh, $filename) = tempfile( UNLINK => 1 );
    print $fh $file;
    close($fh);
    $self->{_gmail}->store($filename, $name);

}

1;