File Coverage

blib/lib/RDF/Trine/Store/DBI/SQLite.pm
Criterion Covered Total %
statement 48 70 68.5
branch 4 16 25.0
condition n/a
subroutine 11 13 84.6
pod 2 2 100.0
total 65 101 64.3


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             RDF::Trine::Store::DBI::SQLite - SQLite subclass of DBI store
4              
5             =head1 VERSION
6              
7             This document describes RDF::Trine::Store::DBI::SQLite version 1.018
8              
9             =head1 SYNOPSIS
10              
11             use RDF::Trine::Store::DBI::SQLite;
12             my $store = RDF::Trine::Store->new({
13             storetype => 'DBI',
14             name => 'test',
15             dsn => "dbi:SQLite:dbname=test.db",
16             username => '',
17             password => ''
18             });
19              
20              
21             =head1 CHANGES IN VERSION 1.014
22              
23             The schema used to encode RDF data in SQLite changed in RDF::Trine version
24             1.014 to fix a bug that was causing data loss. This change is not backwards
25             compatible, and is not compatible with the shared schema used by the other
26             database backends supported by RDF::Trine (PostgreSQL and MySQL).
27              
28             To exchange data between SQLite and other databases, the data will require
29             export to an RDF serialization and re-import to the new database.
30              
31             =cut
32              
33             package RDF::Trine::Store::DBI::SQLite;
34              
35 68     68   477 use strict;
  68         164  
  68         1713  
36 68     68   338 use warnings;
  68         156  
  68         1596  
37 68     68   337 no warnings 'redefine';
  68         151  
  68         1989  
38 68     68   417 use base qw(RDF::Trine::Store::DBI);
  68         292  
  68         4627  
39              
40              
41 68     68   417 use Scalar::Util qw(blessed reftype refaddr);
  68         160  
  68         3170  
42 68     68   400 use Encode;
  68         160  
  68         5073  
43 68     68   412 use Digest::MD5 ('md5');
  68         168  
  68         2431  
44 68     68   418 use Math::BigInt;
  68         156  
  68         440  
45              
46             our $VERSION;
47             BEGIN {
48 68     68   21388 $VERSION = "1.018";
49 68         161 my $class = __PACKAGE__;
50 68         28479 $RDF::Trine::Store::STORE_CLASSES{ $class } = $VERSION;
51             }
52              
53              
54             sub _config_meta {
55             return {
56 0     0   0 required_keys => [qw(dsn username password name)],
57             fields => {
58             name => { description => 'Model Name', type => 'string' },
59             dsn => { description => 'DSN', type => 'string', template => 'DBI:SQLite:dbname=[%filename%]' },
60             filename => { description => 'SQLite Database Filename', type => 'filename' },
61             username => { description => 'Username', type => 'string', value => '' },
62             password => { description => 'Password', type => 'password', value => '' },
63             driver => { description => 'Driver', type => 'string', value => 'SQLite' },
64             },
65             }
66             }
67              
68             =head1 METHODS
69              
70             Beyond the methods documented below, this class inherits methods from the
71             L<RDF::Trine::Store::DBI> class.
72              
73             =over 4
74              
75             =cut
76              
77             =item C<< new_with_config ( \%config ) >>
78              
79             Returns a new RDF::Trine::Store object based on the supplied configuration hashref.
80              
81             =cut
82              
83             sub new_with_config {
84 0     0 1 0 my $proto = shift;
85 0         0 my $config = shift;
86 0         0 $config->{storetype} = 'DBI::SQLite';
87 0         0 my $exists = (-r $config->{filename});
88 0         0 my $self = $proto->SUPER::new_with_config( $config );
89 0 0       0 unless ($exists) {
90 0         0 $self->init();
91             }
92 0         0 return $self;
93             }
94              
95             # SQLite only supports 64-bit SIGNED integers, so this hash function masks out
96             # the high-bit on hash values (unlike the superclass which produces full 64-bit
97             # integers)
98             sub _mysql_hash {
99 3539 100   3539   10865 if (ref($_[0])) {
100 3538         6413 my $self = shift;
101             }
102 3539 50       9078 Carp::confess unless scalar(@_);
103 3539         12685 my $data = encode('utf8', shift);
104 3539         143613 my @data = unpack('C*', md5( $data ));
105 3539         14512 my $sum = Math::BigInt->new('0');
106             # CHANGE: 7 -> 6, Smaller numbers for Sqlite which does not support real 64-bit :(
107 3539         345294 foreach my $count (0 .. 7) {
108 28312         1503468 my $data = Math::BigInt->new( $data[ $count ] ); #shift(@data);
109 28312         1075491 my $part = $data << (8 * $count);
110             # warn "+ $part\n";
111 28312         6632756 $sum += $part;
112             }
113             # warn "= $sum\n";
114 3539         221002 $sum = $sum->band(Math::BigInt->new('0x7fff_ffff_ffff_ffff'));
115 3539         2191385 $sum =~ s/\D//; # get rid of the extraneous '+' that pops up under perl 5.6
116 3539         129590 return $sum;
117             }
118              
119             =item C<< init >>
120              
121             Creates the necessary tables in the underlying database.
122              
123             =cut
124              
125             sub init {
126 17     17 1 49 my $self = shift;
127 17         90 my $dbh = $self->dbh;
128 17         63757 my $name = $self->model_name;
129 17         88 $self->SUPER::init();
130 17         21634 my $id = $self->_mysql_hash( $name );
131            
132 17         64 my $table = "Statements${id}";
133 17         572 local($dbh->{AutoCommit}) = 0;
134 17 50       260 unless ($self->_table_exists($table)) {
135 0 0         $dbh->do( "CREATE INDEX idx_${name}_spog ON Statements${id} (Subject,Predicate,Object,Context);" ) || do { $dbh->rollback; return };
  0            
  0            
136 0 0         $dbh->do( "CREATE INDEX idx_${name}_pogs ON Statements${id} (Predicate,Object,Context,Subject);" ) || do { $dbh->rollback; return };
  0            
  0            
137 0 0         $dbh->do( "CREATE INDEX idx_${name}_opcs ON Statements${id} (Object,Predicate,Context,Subject);" ) || do { $dbh->rollback; return };
  0            
  0            
138 0 0         $dbh->do( "CREATE INDEX idx_${name}_cpos ON Statements${id} (Context,Predicate,Object,Subject);" ) || do { $dbh->rollback; return };
  0            
  0            
139 0           $dbh->commit;
140             }
141             }
142              
143              
144             1; # Magic true value required at end of module
145             __END__
146              
147             =back
148              
149             =head1 BUGS
150              
151             Please report any bugs or feature requests to through the GitHub web interface
152             at L<https://github.com/kasei/perlrdf/issues>.
153              
154             =head1 AUTHOR
155              
156             Gregory Todd Williams C<< <gwilliams@cpan.org> >>
157              
158             =head1 COPYRIGHT
159              
160             Copyright (c) 2006-2012 Gregory Todd Williams. This
161             program is free software; you can redistribute it and/or modify it under
162             the same terms as Perl itself.
163              
164             =cut