File Coverage

blib/lib/WWW/ConfixxBackup/Confixx.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

package WWW::ConfixxBackup::Confixx;

use strict;
use warnings;
use WWW::Mechanize;
use HTTP::Cookies;
use HTTP::Request;

our $VERSION = '0.05';

my %map = (
    'confixx2.0' =>
      {
        backup_id    => '',
        backup_html  => '',
        backup_files => '',
        backup_mysql => '',
        html         =>  1,
        files        =>  1,
        mysql        =>  1,
      },
    'confixx3.0' =>
      {
        'selectAll' => 1,
        'backup[]'  => ['html','files','mysql'],
        action      => 'backup',
        destination => '/backup',
      }
);

my $default_version = 'confixx3.0';

sub new{
    my ($class,%args) = @_;
    my $self = bless {},$class;

    $self->debug( sub{ print join "\n", @_ } );
    $self->DEBUG(0);

    $self->password($args{password});
    $self->user($args{user});
    $self->server($args{server});
    $self->proxy( $args{proxy} );
    $self->confixx_version( defined $args{confixx_version} ?
                                    $args{confixx_version} :
                                    $default_version );

    return $self;
}# new

sub login{
    my ($self) = @_;

    if(ref($self->mech) eq 'WWW::Mechanize'){
        $self->mech->post(
             $self->server . '/login.php',
             {
                 username => $self->user,
                 password => $self->password,

             }
        );

        if( $self->DEBUG ){
            $self->debug->( 'POST: ' . $self->server . '/login.php' );
            my $msg = $self->mech->success ? 'Got login page' :
                             'Error: cannot get login page : ' . $self->mech->response->status_line;
        }

        $self->mech->get( $self->server . '/user/' . $self->user . '/' );

        if( $self->DEBUG ){
            $self->debug->( 'GET: ' . $self->server . '/user/' . $self->user . '/' );
            my $msg = $self->mech->success ? $self->server . ': logged in' :
                                             'Error: ' . $self->server . ': cannot login .. ' . $self->mech->response->status_line;
            $self->debug->( $msg );
        }

        return unless($self->mech->success);
    }
    return 1;
}# login

sub proxy{
    my ($self,$proxy) = @_;

    $self->{_proxy} = $proxy if @_ == 2;
    return $self->{_proxy};
}

sub _detect_version{
    my ($self,$content) = @_;

    my %versions = (
        'confixx2.0' => [
              '',
              '',
              '',
              '',
              '',
              '',
              ''
            ],
        'confixx3.0' => [
              '',
              '',
              '',
              '',
              '',
              ''
            ],
    );

    unless( $content ){
        $self->mech->get( $self->server . '/user/' . $self->user . '/tools_backup.php' );
        $content = $self->mech->content;
        #warn $content;
    }

    my @inputs  = $content =~ m!(]+>)!ig;
       @inputs  = grep{ !/type=.?image/ }@inputs;

    my $version = "";
    for my $key ( keys %versions ){
        if( join( "", @inputs ) eq join( "", @{$versions{$key}} ) ){
            $version = $key;
            last;
        }
    }

    if( $version ){
        $self->confixx_version( $version );
    }

    if( $self->DEBUG ){
        my $msg = $version ? 'Detected version: ' . $version :
                             'Error: cannot detect version. Maybe a new Confixx Version.';
        $self->debug->( $msg );
    }
}

sub backup{
    my ($self) = @_;

    $self->_detect_version unless $self->confixx_version;

    $self->mech->post(
        $self->server . '/user/' . $self->user . '/tools_backup2.php',
        $map{$self->confixx_version},
    );

    if( $self->DEBUG ){
        my %fields = %{ $map{$self->confixx_version} };
        $self->debug->( 'POST: ' . $self->server . '/user/' . $self->user . '/tools_backup2.php' );
        $self->debug->( 'Parameters: ' . join( " , ", map{ $_ . " -> " . $fields{$_} }keys %fields ) );
        $self->debug->( 'Confixx Version: ' . $self->confixx_version );
        my $msg = $self->mech->success ? 'Called backup tool' :
                                         'Error: cannot call backup tool : ' . $self->mech->response->status_line;
    }

    return unless($self->mech->success);
    return 1;
}# create_backup

sub confixx_version{
    my ($self,$version) = @_;

    $self->{__version} = $version if defined $version;
    return $self->{__version};
}

sub available_confixx_versions{
    return sort keys %map;
}

sub password{
    my ($self,$pwd) = @_;
    $self->{password} = $pwd if(defined $pwd);
    return $self->{password};
}# password

sub user{
    my ($self,$user) = @_;
    $self->{user} = $user if(defined $user);
    return $self->{user};
}# user

sub server{
    my ($self,$server) = @_;
    $self->{server} = $server if(defined $server);
    return $self->{server};
}# server

sub mech{
    my ($self) = @_;
    my $subref = ( $self->DEBUG ) ? $self->debug : \&mech_warnings;
    unless(ref($self->{mechanizer}) eq 'WWW::Mechanize'){
        $self->{cookie_jar} = HTTP::Cookies->new();
        $self->{mechanizer} = WWW::Mechanize->new(
            quiet       => 1,
            onwarn      => $subref,
            ondie       => $subref,
            stack_depth => 1,
            cookie_jar  => $self->{cookie_jar},
        );
        $self->{mechanizer}->proxy( [qw/http https/], $self->proxy ) if $self->proxy;
        $self->{mechanizer}->get($self->server);


        if( $self->DEBUG ){
            $self->debug->( 'GET: ' . $self->server );
            my $msg = $self->{mechanizer}->success ? 'Got start page' :
                             'Error: cannot get start page : ' . $self->{mechanizer}->response->status_line;
            $self->debug->( $msg );
        }

        return [] unless($self->{mechanizer}->success);
    }
    return $self->{mechanizer};
}# mech

sub default_version{
    return $default_version;
}

sub mech_warnings{
  #print STDERR "HALLO";
}# mech_warnings

sub debug{
    my ($self,$coderef) = @_;

    if( @_ == 2 ){
        $self->DEBUG(1);
        $self->{__debug} = $coderef;
    }

    return $self->{__debug};
}

sub DEBUG{
    my ($self,$bool) = @_;

    if( @_ == 2 ){
        $self->{__DEBUG} = $bool;
    }

    return $self->{__DEBUG};
}

1;

__END__