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.017
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.017
22              
23             The schema used to encode RDF data in SQLite changed in RDF::Trine version
24             1.017 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   423 use strict;
  68         163  
  68         1785  
36 68     68   362 use warnings;
  68         155  
  68         1556  
37 68     68   331 no warnings 'redefine';
  68         155  
  68         1798  
38 68     68   363 use base qw(RDF::Trine::Store::DBI);
  68         260  
  68         4341  
39              
40              
41 68     68   408 use Scalar::Util qw(blessed reftype refaddr);
  68         161  
  68         3186  
42 68     68   426 use Encode;
  68         164  
  68         5462  
43 68     68   417 use Digest::MD5 ('md5');
  68         152  
  68         2396  
44 68     68   383 use Math::BigInt;
  68         148  
  68         446  
45              
46             our $VERSION;
47             BEGIN {
48 68     68   21292 $VERSION = "1.017";
49 68         181 my $class = __PACKAGE__;
50 68         27815 $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   10260 if (ref($_[0])) {
100 3538         6219 my $self = shift;
101             }
102 3539 50       9040 Carp::confess unless scalar(@_);
103 3539         11479 my $data = encode('utf8', shift);
104 3539         141089 my @data = unpack('C*', md5( $data ));
105 3539         14532 my $sum = Math::BigInt->new('0');
106             # CHANGE: 7 -> 6, Smaller numbers for Sqlite which does not support real 64-bit :(
107 3539         338394 foreach my $count (0 .. 7) {
108 28312         1483126 my $data = Math::BigInt->new( $data[ $count ] ); #shift(@data);
109 28312         1068834 my $part = $data << (8 * $count);
110             # warn "+ $part\n";
111 28312         6568436 $sum += $part;
112             }
113             # warn "= $sum\n";
114 3539         217384 $sum = $sum->band(Math::BigInt->new('0x7fff_ffff_ffff_ffff'));
115 3539         2155445 $sum =~ s/\D//; # get rid of the extraneous '+' that pops up under perl 5.6
116 3539         125046 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 53 my $self = shift;
127 17         85 my $dbh = $self->dbh;
128 17         62266 my $name = $self->model_name;
129 17         109 $self->SUPER::init();
130 17         20999 my $id = $self->_mysql_hash( $name );
131            
132 17         65 my $table = "Statements${id}";
133 17         606 local($dbh->{AutoCommit}) = 0;
134 17 50       346 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