lib/perl/Blerg-Database/lib/Blerg/Database.pm

   1 package Blerg::Database;
   2
   3 use 5.008000;
   4 use strict;
   5 use warnings;
   6 use Carp;
   7
   8 require Exporter;
   9 use AutoLoader;
  10
  11 our @ISA = qw(Exporter);
  12
  13 # Items to export into callers namespace by default. Note: do not export
  14 # names by default without a very good reason. Use EXPORT_OK instead.
  15 # Do not simply export all your public functions/methods/constants.
  16
  17 # This allows declaration       use Blerg::Database ':all';
  18 # If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
  19 # will save memory.
  20 our %EXPORT_TAGS = ( 'all' => [ qw(
  21
  22 ) ] );
  23
  24 our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
  25
  26 our @EXPORT = qw(
  27
  28 );
  29
  30 our $VERSION = '1.7';
  31
  32 sub AUTOLOAD {
  33     # This AUTOLOAD is used to 'autoload' constants from the constant()
  34     # XS function.
  35
  36     my $constname;
  37     our $AUTOLOAD;
  38     ($constname = $AUTOLOAD) =~ s/.*:://;
  39     croak "&Blerg::Database::constant not defined" if $constname eq 'constant';
  40     my ($error, $val) = constant($constname);
  41     if ($error) { croak $error; }
  42     {
  43         no strict 'refs';
  44         # Fixed between 5.005_53 and 5.005_61
  45 #XXX    if ($] >= 5.00561) {
  46 #XXX        *$AUTOLOAD = sub () { $val };
  47 #XXX    }
  48 #XXX    else {
  49             *$AUTOLOAD = sub { $val };
  50 #XXX    }
  51     }
  52     goto &$AUTOLOAD;
  53 }
  54
  55 require XSLoader;
  56 XSLoader::load('Blerg::Database', $VERSION);
  57
  58 # Preloaded methods go here.
  59
  60 sub open {
  61     my ($class, $name) = @_;
  62     my $ptr = Blerg::Database::_open($name);
  63     my $obj = {
  64         ptr => $ptr,
  65         name => $name,
  66     };
  67     return bless $obj, $class;
  68 }
  69
  70 sub open_existing {
  71     my ($class, $name) = @_;
  72
  73     if (Blerg::Database::exists($name)) {
  74         return Blerg::Database->open($name);
  75     }
  76     return undef;
  77 }
  78
  79 sub _ensure_pointer {
  80     my ($obj) = @_;
  81     if (!defined $obj->{ptr}) {
  82         croak "Attempted to use closed Blerg::Database";
  83     }
  84 }
  85
  86 sub close {
  87     my ($obj) = @_;
  88     $obj->_ensure_pointer;
  89     Blerg::Database::_close($obj->{ptr});
  90     delete $obj->{ptr};
  91 }
  92
  93 DESTROY {
  94     my ($obj) = @_;
  95     $obj->close;
  96 }
  97
  98 sub record_count {
  99     my ($obj) = @_;
 100     $obj->_ensure_pointer;
 101     return Blerg::Database::_get_record_count($obj->{ptr});
 102 }
 103
 104 sub set_subscription_mark {
 105     my ($obj) = @_;
 106     $obj->_ensure_pointer;
 107     return Blerg::Database::_set_subscription_mark($obj->{ptr});
 108 }
 109
 110 sub get_subscription_mark {
 111     my ($obj) = @_;
 112     $obj->_ensure_pointer;
 113     return Blerg::Database::_get_subscription_mark($obj->{ptr});
 114 }
 115
 116 sub subscription_list {
 117     my ($obj) = @_;
 118     return Blerg::Database::subscription_list($obj->{name});
 119 }
 120
 121 sub mute {
 122     my ($obj, $v) = @_;
 123     $obj->_ensure_pointer;
 124     if (defined $v) {
 125         return Blerg::Database::_set_mute($obj->{ptr}, $v);
 126     } else {
 127         return Blerg::Database::_get_mute($obj->{ptr});
 128     }
 129 }
 130
 131 sub refs {
 132     my ($obj) = @_;
 133     return Blerg::Database::tag_list('@' . $obj->{name}, 50, -1);
 134 }
 135
 136 sub store {
 137     my ($obj, $data) = @_;
 138     $obj->_ensure_pointer;
 139     return Blerg::Database::_store($obj->{ptr}, $data);
 140 }
 141
 142 sub fetch {
 143     my ($obj, $record) = @_;
 144     $obj->_ensure_pointer;
 145     return Blerg::Database::_fetch($obj->{ptr}, $record);
 146 }
 147
 148 sub timestamp {
 149     my ($obj, $record) = @_;
 150     $obj->_ensure_pointer;
 151     return Blerg::Database::_get_timestamp($obj->{ptr}, $record);
 152 }
 153
 154 # Convenience shortcuts
 155 sub hash_tag_list {
 156     my ($name, $str_offset, $direction) = @_;
 157     return Blerg::Database::tag_list("#$name", $str_offset, $direction);
 158 }
 159
 160 sub ref_tag_list {
 161     my ($name, $str_offset, $direction) = @_;
 162     return Blerg::Database::tag_list("@$name", $str_offset, $direction);
 163 }
 164
 165 # Autoload methods go after =cut, and are processed by the autosplit program.
 166
 167 1;
 168 __END__
 169 # Below is stub documentation for your module. You'd better edit it!
 170
 171 =head1 NAME
 172
 173 Blerg::Database - Perl extension for blah blah blah
 174
 175 =head1 SYNOPSIS
 176
 177   use Blerg::Database;
 178   blah blah blah
 179
 180 =head1 DESCRIPTION
 181
 182 Stub documentation for Blerg::Database, created by h2xs. It looks like the
 183 author of the extension was negligent enough to leave the stub
 184 unedited.
 185
 186 Blah blah blah.
 187
 188 =head2 EXPORT
 189
 190 None by default.
 191
 192
 193 =head1 HISTORY
 194
 195 =over 8
 196
 197 =item 1.7
 198
 199 Original version; created by h2xs 1.23 with options
 200
 201   -C
 202         -b
 203         5.8.0
 204         -n
 205         Blerg::Database
 206         -v
 207         1.7
 208
 209 =back
 210
 211
 212
 213 =head1 SEE ALSO
 214
 215 Mention other useful documentation such as the documentation of
 216 related modules or operating system documentation (such as man pages
 217 in UNIX), or any relevant external documentation such as RFCs or
 218 standards.
 219
 220 If you have a mailing list set up for your module, mention it here.
 221
 222 If you have a web site set up for your module, mention it here.
 223
 224 =head1 AUTHOR
 225
 226 Chip Black, E<lt>bytex64@bytex64.netE<gt>
 227
 228 =head1 COPYRIGHT AND LICENSE
 229
 230 Copyright (C) 2013 by Chip Black
 231
 232 This library is free software; you can redistribute it and/or modify
 233 it under the same terms as Perl itself, either Perl version 5.16.1 or,
 234 at your option, any later version of Perl 5 you may have available.
 235
 236
 237 =cut