File Coverage

blib/lib/Class/PObject/Test/Types.pm

Criterion	Covered	Total	%
statement	99	99	100.0
branch			n/a
condition			n/a
subroutine	11	11	100.0
pod	0	1	0.0
total	110	111	99.1

package Class::PObject::Test::Types;

# Types.pm,v 1.7 2005/01/26 19:21:58 sherzodr Exp

use strict;
#use diagnostics;
use Test::More;
use vars ('$VERSION', '@ISA');

BEGIN {
    plan(tests => 46);
    use_ok("Class::PObject");
    use_ok("Class::PObject::Test");
    use_ok("Class::PObject::Type");
}

@ISA = ('Class::PObject::Test');
$VERSION = '1.03';


sub run {
    my $self = shift;

    pobject User => {
        columns     => ['id', 'name', 'login', 'psswd', 'activation_key'],
        driver      => $self->{driver},
#        datasource  => $self->{datasource},
        serializer  => 'storable',
        tmap        => {
            login       => 'CHAR(18)',
            psswd       => 'ENCRYPT',
            name        => 'VARCHAR(40)',
            id          => 'INTEGER',
            activation_key => 'MD5'
        }
    };
    ok(1);


	{
		package User;
		*pobject_init = sub {
			$_[0]->set_datasource( $self->{datasource} );
		}
	}


    ################
    #
    # Creating a new user
    #
    my $u = new User();
    ok(ref $u);
    $u->name("Sherzod Ruzmetov");
    $u->login("sherzodr");
    $u->psswd("marley01");
    $u->activation_key("geek");

    #print $u->dump;
    #exit(0);

    ################
    #
    # checking integrity of data before saving to disk
    #
    ok($u->name             eq "Sherzod Ruzmetov");
    ok($u->login            eq "sherzodr");
    ok($u->psswd            eq "marley01", ''.$u->psswd);
    ok($u->activation_key   eq "geek", ''.$u->activation_key);

    ok(ref($u->name)        eq 'VARCHAR');
    ok(ref($u->login)       eq 'CHAR');
    TODO: {
        # If a  value of a column is undef, even ref() doesn't work.
        # Should it?
        local $TODO = "Not sure if it is a bug or a feature";
        ok(ref($u->id)          eq 'INTEGER');
    }

    ok(ref($u->psswd)       eq 'ENCRYPT');
    ok(ref($u->activation_key) eq 'MD5');

    #print $u->dump;

    # let's check if we can assign objects directly
    my $name = VARCHAR->new(id=>"Sherzod Ruzmetov (e)", args=>40);
    ok($name, $name);
    $u->name( $name );
    ok($u->name            eq "Sherzod Ruzmetov (e)");
    ok(ref($u->name)    eq "VARCHAR", ref($u->name));

    #print $u->dump;

    $u->name( "Sherzod Ruzmetov" );
    ok($u->name            eq "Sherzod Ruzmetov", ''.$u->name);
    ok(ref($u->name)    eq "VARCHAR", ref($u->name));

    #print $u->dump;

    ok(my $id = $u->save, $u->errstr);

    $u =  undef;

    $u = User->load($id);
    ok($u);

    #print $u->dump;

    ################
    #
    # checking integrity of data after loaded from disk
    #
    ok($u->name            eq "Sherzod Ruzmetov");
    ok($u->login        eq "sherzodr");
    ok($u->psswd        eq "marley01", ''.$u->psswd);

    ok(ref($u->name)    eq 'VARCHAR');
    ok(ref($u->login)    eq 'CHAR');
    ok(ref($u->id)        eq 'INTEGER');
    ok(ref($u->psswd)    eq 'ENCRYPT');

    ################
    #
    # Updating the values again
    #
    $u->name("Sherzod Ruzmetov (e)");
    $u->psswd("marley02)");

    ok($u->psswd        eq "marley02", ''.$u->psswd);
    ok($u->name            eq "Sherzod Ruzmetov (e)");
    ok($u->activation_key eq "geek");
    ok(ref($u->psswd)    eq 'ENCRYPT');
    ok(ref($u->activation_key), 'MD5');
    ok($u->save == $id, $u->errstr);


	################
	#
	# Checking col. member functions (inside Type.pm)
	#
	my $substr = $u->name()->substr(0, 6);
	ok($substr eq "Sherzo", $substr);

    my $lcfirst = $u->name()->lcfirst();
    ok($lcfirst eq 'sherzod Ruzmetov (e)');

    my $ucfirst = $u->name()->ucfirst();
    ok($ucfirst eq 'Sherzod Ruzmetov (e)');

    my $lc = $u->name()->lc();
    ok($lc eq 'sherzod ruzmetov (e)');

    my $uc = $u->name()->uc();
    ok($uc eq 'SHERZOD RUZMETOV (E)');


    ################
    #
    # Checking load(\%terms, undef) syntax
    #

    $u = User->load({login=>'sherzodr'});
    ok($u);
    ok($u->psswd        eq "marley02");
    ok($u->activation_key eq "geek");

    ok(User->count == 1);
    ok(User->remove_all());
    ok(User->count == 0);

    ok(User->drop_datasource);
}






package VARCHAR;
use vars ('@ISA');
use Class::PObject::Type::VARCHAR;
@ISA = ("Class::PObject::Type::VARCHAR");


1;
__END__