BEGIN
{
require
5.6.0;
our
(
$VERSION
,
$VERBOSE
,
$DEBUG
);
$VERSION
=
'0.3'
;
$VERBOSE
= 0;
$DEBUG
= 0;
};
sub
init
{
return
(
shift
->DB::Object::Tables::init(
@_
) );
}
sub
create
{
my
$self
=
shift
(
@_
);
my
$data
=
shift
(
@_
) || [];
my
$opt
=
shift
(
@_
) || {};
my
$sth
=
shift
(
@_
);
my
$table
=
$self
->{
'table'
};
my
$temp
=
$self
->{
'temporary'
} =
delete
(
$opt
->{
'temporary'
} );
my
$allowed
=
{
'type'
=>
qr/^(ISAM|MYISAM|HEAP)$/
i,
'auto_increment'
=>
qr/^(1|0)$/
,
'avg_row_length'
=>
qr/^\d+$/
,
'checksum'
=>
qr/^(1|0)$/
,
'comment'
=>
qr//
,
'max_rows'
=>
qr/^\d+$/
,
'min_rows'
=>
qr/^\d+$/
,
'pack_keys'
=>
qr/^(1|0)$/
,
'password'
=>
qr//
,
'delay_key_write'
=>
qr/^\d+$/
,
'row_format'
=>
qr/^(default|dynamic|static|compressed)$/
i,
'raid_type'
=>
qr/^(?:1|STRIPED|RAID0|RAID_CHUNKS\s*=\s*\d+|RAID_CHUNKSIZE\s*=\s*\d+)$/
,
};
my
@options
= ();
my
@errors
= ();
if
(
%$opt
)
{
my
%lc_opt
=
map
{
lc
(
$_
) =>
$opt
->{
$_
} }
keys
(
%$opt
);
$opt
= \
%lc_opt
;
foreach
my
$key
(
keys
(
%$opt
) )
{
next
if
(
$opt
->{
$key
} =~ /^\s*$/ || !
exists
(
$allowed
->{
$key
} ) );
if
(
$opt
->{
$key
} !~ /
$allowed
->{
$key
}/ )
{
push
(
@errors
,
$key
);
}
else
{
push
(
@options
,
$key
);
}
}
$opt
->{comment} =
"'"
.
quotemeta
(
$opt
->{comment} ) .
"'"
if
(
exists
(
$opt
->{comment} ) );
$opt
->{password} =
"'"
.
$opt
->{password} .
"'"
if
(
exists
(
$opt
->{password} ) );
}
if
(
@errors
)
{
warn
(
"The options '"
,
join
( ',
', @errors ), "'
were either not recognized or malformed and thus were ignored.\n" );
}
my
$select
=
''
;
if
(
$sth
&&
ref
(
$sth
) && (
$sth
->isa(
"DB::Object::Statement"
) ||
$sth
->can(
'as_string'
) ) )
{
$select
=
$sth
->as_string();
if
(
$select
!~ /^\s*(?:IGNORE|REPLACE)*\s*\bSELECT\s+/ )
{
return
(
$self
->error(
"SELECT statement to use to create table is invalid:\n$select"
) );
}
}
if
(
$self
->
exists
() == 0 )
{
my
$query
=
'CREATE '
. (
$temp
?
'TEMPORARY '
:
''
) .
"TABLE $table "
;
my
$def
=
"(\n"
. CORE::
join
(
",\n"
,
@$data
) .
"\n)"
if
(
$data
&&
ref
(
$data
) &&
@$data
);
my
$tdef
= CORE::
join
(
' '
,
map
{
"\U$_\E = $opt->{ $_ }"
}
@options
);
if
( !
$def
&& !
$select
)
{
return
(
$self
->error(
"Lacking table '$table' structure information to create it."
) );
}
$query
.=
join
(
' '
,
$def
,
$tdef
,
$select
);
my
$new
=
$self
->prepare(
$query
) ||
return
(
$self
->error(
"Error while preparing query to create table '$table':\n$query"
,
$self
->errstr() ) );
if
( !
defined
(
wantarray
() ) )
{
$self
->message(
"wantarray in void context"
);
$new
->execute() ||
return
(
$self
->error(
"Error while executing query to create table '$table':\n$query"
,
$new
->errstr() ) );
}
return
(
$new
);
}
else
{
return
(
$self
->error(
"Table '$table' already exists."
) );
}
}
sub
create_info
{
my
$self
=
shift
(
@_
);
my
$table
=
$self
->{table};
$self
->structure();
my
$struct
=
$self
->{structure};
my
$fields
=
$self
->{fields};
my
$default
=
$self
->{
default
};
my
$primary
=
$self
->{primary};
my
@output
= ();
foreach
my
$field
(
sort
{
$fields
->{
$a
} <=>
$fields
->{
$b
} }
keys
(
%$fields
) )
{
push
(
@output
,
"$field $struct->{ $field }"
);
}
push
(
@output
,
"PRIMARY KEY("
. CORE::
join
(
','
,
@$primary
) .
")"
)
if
(
$primary
&&
@$primary
);
my
$info
=
$self
->
stat
(
$table
);
my
@opt
= ();
push
(
@opt
,
"TYPE = $info->{type}"
)
if
(
$info
->{type} );
my
$addons
=
$info
->{
'create_options'
};
if
(
$addons
)
{
$addons
=~ s/(\A|\s+)([\w\_]+)\s*=\s*/$1\U$2\E=/g;
push
(
@opt
,
$addons
);
}
push
(
@opt
,
"COMMENT='"
.
quotemeta
(
$info
->{comment} ) .
"'"
)
if
(
$info
->{comment} );
my
$str
=
"CREATE TABLE $table (\n\t"
. CORE::
join
(
",\n\t"
,
@output
) .
"\n)"
;
$str
.=
' '
. CORE::
join
(
' '
,
@opt
)
if
(
@opt
);
$str
.=
';'
;
return
(
@output
?
$str
:
undef
() );
}
sub
exists
{
return
(
shift
->table_exists(
shift
(
@_
) ) );
}
sub
lock
{
return
(
shift
->error(
"There is no table locking in SQLite."
) ); }
sub
rename
{
my
$self
=
shift
(
@_
);
my
$table
=
$self
->{table} ||
return
(
$self
->error(
'No table was provided to rename'
) );
my
$new
=
shift
(
@_
) ||
return
(
$self
->error(
"No new table name was provided to rename table '$table'."
) );
if
(
$new
!~ /^[\w\_]+$/ )
{
return
(
$self
->error(
"Bad new table name '$new'."
) );
}
my
$query
=
"ALTER TABLE $table RENAME TO $new"
;
my
$sth
=
$self
->prepare(
$query
) ||
return
(
$self
->error(
"Error while preparing query to rename table '$table' into '$new':\n$query"
,
$self
->errstr() ) );
if
( !
defined
(
wantarray
() ) )
{
$sth
->execute() ||
return
(
$self
->error(
"Error while executing query to rename table '$table' into '$new':\n$query"
,
$sth
->errstr() ) );
}
return
(
$sth
);
}
sub
structure
{
my
$self
=
shift
(
@_
);
my
$table
=
shift
(
@_
) ||
$self
->{table} ||
do
{
$self
->error(
"No table provided to get its structure."
);
return
(
wantarray
() ? () :
undef
() );
};
my
$sth1
=
$self
->prepare_cached(
"SELECT * FROM sqlite_master WHERE name = ?"
) ||
return
(
$self
->error(
"An error occured while preparing the sql query to get the details of table \"$table\": "
,
$self
->errstr() ) );
$sth1
->execute(
$table
) ||
return
(
$self
->error(
"An erro occured while executing the sql query to get the details of table \"$table\": "
,
$sth1
->errstr() ) );
my
$def
=
$sth1
->fetchrow_hashref;
$sth1
->finish;
$self
->{type} =
$def
->{type};
my
$struct
=
$self
->{structure};
my
$fields
=
$self
->{fields};
my
$default
=
$self
->{
default
};
my
$null
=
$self
->{null};
my
$types
=
$self
->{types};
if
( !
%$fields
|| !
%$struct
|| !
%$default
)
{
$self
->message( 3,
"No structure, field, default values, null or types set yet for this table '$table' object. Populating."
);
my
$query
=
<<EOT;
PRAGMA table_info(${table})
EOT
my
$sth
=
$self
->prepare_cached(
$query
) ||
return
(
$self
->error(
"Error while preparing query to get table '$table' columns specification: "
,
$self
->errstr() ) );
$sth
->execute ||
return
(
$self
->error(
"Error while executing query to get table '$table' columns specification: "
,
$sth
->errstr() ) );
my
@primary
= ();
my
$ref
=
''
;
my
$c
= 0;
my
$type_convert
=
{
'int'
=>
'integer'
,
};
while
(
$ref
=
$sth
->fetchrow_hashref() )
{
my
%data
=
map
{
lc
(
$_
) =>
$ref
->{
$_
} }
keys
(
%$ref
);
$data
{
default
} = CORE::
delete
(
$data
{dflt_value} );
$data
{field} = CORE::
delete
(
$data
{name} );
$data
{key} = CORE::
delete
(
$data
{pk} );
if
(
exists
(
$type_convert
->{
$data
{type} } ) )
{
$data
{type} =
$type_convert
->{
$data
{type} };
}
$data
{
default
} =
''
if
( !
defined
(
$data
{
default
} ) );
$fields
->{
$data
{field} } = ++
$c
;
$types
->{
$data
{field} } =
$data
{
'type'
};
$default
->{
$data
{field} } =
''
;
$default
->{
$data
{field} } =
$data
{
'default'
}
if
(
$data
{
default
} ne
''
&&
$data
{notnull} );
$null
->{
$data
{field} } =
$data
{
'notnull'
} ? 0 : 1;
my
@define
= (
$data
{type} );
push
(
@define
,
"DEFAULT '$data{default}'"
)
if
(
$data
{
default
} ne
''
||
$data
{notnull} );
push
(
@define
,
"NOT NULL"
)
if
(
$data
{notnull} );
push
(
@primary
,
$data
{field} )
if
(
$data
{key} );
$struct
->{
$data
{field} } = CORE::
join
(
' '
,
@define
);
}
$sth
->finish();
if
(
@primary
)
{
$self
->{primary} = \
@primary
;
}
$self
->{
default
} =
$default
;
$self
->{fields} =
$fields
;
$self
->{structure} =
$struct
;
$self
->{types} =
$types
;
$self
->message( 3,
"Fields found: "
,
sub
{
$self
->dumper(
$fields
) } );
}
return
(
wantarray
() ? () :
undef
() )
if
( !
scalar
(
keys
(
%$struct
) ) );
return
(
wantarray
() ?
%$struct
: \
%$struct
);
}
sub
unlock {
return
(
shift
->error(
"Locking and unlocking of tables is unsupportde in SQLite."
) ); }
DESTROY
{
};
1;