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.9.0';
  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 if (!Blerg::Database::init()) {
  61     die "Could not initialize C library";
  62 }
  63
  64 sub open {
  65     my ($class, $name) = @_;
  66     my $ptr = Blerg::Database::_open($name);
  67     my $obj = {
  68         ptr => $ptr,
  69         name => $name,
  70     };
  71     return bless $obj, $class;
  72 }
  73
  74 sub open_existing {
  75     my ($class, $name) = @_;
  76
  77     if (Blerg::Database::exists($name)) {
  78         return Blerg::Database->open($name);
  79     }
  80     return undef;
  81 }
  82
  83 sub _ensure_pointer {
  84     my ($obj) = @_;
  85     if (!defined $obj->{ptr}) {
  86         croak "Attempted to use closed Blerg::Database";
  87     }
  88 }
  89
  90 sub close {
  91     my ($obj) = @_;
  92     if (!(defined $obj && defined $obj->{ptr})) {
  93         # Welp, nothing to do here!
  94         return;
  95     }
  96     Blerg::Database::_close($obj->{ptr});
  97     delete $obj->{ptr};
  98 }
  99
 100 DESTROY {
 101     my ($obj) = @_;
 102     $obj->close;
 103 }
 104
 105 sub record_count {
 106     my ($obj) = @_;
 107     $obj->_ensure_pointer;
 108     return Blerg::Database::_get_record_count($obj->{ptr});
 109 }
 110
 111 sub set_subscription_mark {
 112     my ($obj) = @_;
 113     $obj->_ensure_pointer;
 114     return Blerg::Database::_set_subscription_mark($obj->{ptr});
 115 }
 116
 117 sub get_subscription_mark {
 118     my ($obj) = @_;
 119     $obj->_ensure_pointer;
 120     return Blerg::Database::_get_subscription_mark($obj->{ptr});
 121 }
 122
 123 sub subscription_list {
 124     my ($obj) = @_;
 125     $obj->_ensure_pointer;
 126     return Blerg::Database::_subscription_list($obj->{name}, 0, 1);
 127 }
 128
 129 sub mute {
 130     my ($obj, $v) = @_;
 131     $obj->_ensure_pointer;
 132     if (defined $v) {
 133         return Blerg::Database::_set_mute($obj->{ptr}, $v);
 134     } else {
 135         return Blerg::Database::_get_mute($obj->{ptr});
 136     }
 137 }
 138
 139 sub refs {
 140     my ($obj) = @_;
 141     return Blerg::Database::tag_list('@' . $obj->{name}, 50, -1);
 142 }
 143
 144 sub store {
 145     my ($obj, $data) = @_;
 146     $obj->_ensure_pointer;
 147     return Blerg::Database::_store($obj->{ptr}, $data);
 148 }
 149
 150 sub fetch {
 151     my ($obj, $record) = @_;
 152     $obj->_ensure_pointer;
 153     return Blerg::Database::_fetch($obj->{ptr}, $record);
 154 }
 155
 156 sub timestamp {
 157     my ($obj, $record) = @_;
 158     $obj->_ensure_pointer;
 159     return Blerg::Database::_get_timestamp($obj->{ptr}, $record);
 160 }
 161
 162 # Convenience shortcuts
 163 sub hash_tag_list {
 164     my ($name, $str_offset, $direction) = @_;
 165     return Blerg::Database::tag_list("#$name", $str_offset, $direction);
 166 }
 167
 168 sub ref_tag_list {
 169     my ($name, $str_offset, $direction) = @_;
 170     return Blerg::Database::tag_list("@$name", $str_offset, $direction);
 171 }
 172
 173 # Autoload methods go after =cut, and are processed by the autosplit program.
 174
 175 1;
 176 __END__
 177
 178 =head1 NAME
 179
 180 =encoding utf8
 181
 182 Blerg::Database - Perl extension for reading Blërg! databases
 183
 184 =head1 SYNOPSIS
 185
 186   use Blerg::Database;
 187
 188   my $blerg = Blerg::Database->open_existing('foo');
 189   my $record = $blerg->post('This is some data!');
 190   $blerg->fetch($record);
 191
 192 =head1 DESCRIPTION
 193
 194 Blerg::Database is a utility library wrapping the core Blërg! database.  It
 195 provides nicer OO wrappers around the core C library that powers Blërg!.
 196
 197 =head1 MODULE FUNCTIONS
 198
 199 =over
 200
 201 =item exists(name)
 202
 203 Returns 1 if the named database exists, or C<undef> if it doesn't.
 204
 205 =item tag_list(tag, offset, direction)
 206
 207 Returns a list of hashrefs describing blerg posts related to the given tag.
 208 C<tag> includes the leading '@' or '#'.  Each item has two keys, C<author> and
 209 C<record>.
 210
 211 =item hash_tag_list(name, offset, direction)
 212
 213 Convenience for C<tag_list> so that you don't have to prepend '#' to the name.
 214
 215 =item ref_tag_list(name, offset, direction)
 216
 217 Convenience for C<tag_list> so that you don't have to prepend '@' to the name.
 218
 219 =item subscription_add(from, to)
 220
 221 Adds a subscription from C<from> to C<to>.
 222
 223 =item subscription_remove(from, to)
 224
 225 The opposite of subscription_add.
 226
 227 =item valid_tag_name(name)
 228
 229 Validates that C<name> is a valid tag name.
 230
 231 =item valid_name(name)
 232
 233 Validates that C<name> is a valid username.
 234
 235 =back
 236
 237 =head1 CONSTRUCTOR
 238
 239 =over
 240
 241 =item open(name)
 242
 243 Opens the named database, creating it if it doesn't exist.
 244
 245 =item open_existing(name)
 246
 247 Opens the named database.  If it doesn't exist, returns C<undef>.
 248
 249 =back
 250
 251 =head1 CLASS METHODS
 252
 253 =head2 RECORDS
 254
 255 =over
 256
 257 =item record_count()
 258
 259 Returns the number of records in the database.
 260
 261 =item store(data)
 262
 263 Stores a new record containing C<data>.  Returns the record number of the new
 264 record.
 265
 266 =item fetch(record)
 267
 268 Fetches a record from the database.
 269
 270 =item timestamp(record)
 271
 272 Returns a unix epoch timestamp for when the record was created.
 273
 274 =back
 275
 276 =head2 SUBSCRIPTIONS
 277
 278 =over
 279
 280 =item set_subscription_mark()
 281
 282 Mark all items on the subscription list as read.
 283
 284 =item get_subscription_mark()
 285
 286 Return the subscription list mark.
 287
 288 =item subscription_list()
 289
 290 Return a list of hashrefs describing posts in your subscription feed.  Each
 291 hashref has a C<author> and C<record> key.
 292
 293 =back
 294
 295 =head2 REFS, MUTE, CLEANUP
 296
 297 =over
 298
 299 =item refs()
 300
 301 Convenience for listing references to the database.  Equivalent to
 302 C<tag_list('@' . $obj-E<gt>{name})>.
 303
 304 =item mute(v)
 305
 306 When v = 1, mute the user, otherwise, unmute.
 307
 308 =item close()
 309
 310 Closes the database.
 311
 312 =back
 313
 314 =head1 SEE ALSO
 315
 316 See the Blërg! website at http://blerg.cc.  More detailed docs about the
 317 database internals are available in the source repo under www/doc, or at
 318 http://blerg.cc/doc/
 319
 320 =head1 AUTHOR
 321
 322 Chip Black, E<lt>bytex64@bytex64.netE<gt>
 323
 324 =head1 COPYRIGHT AND LICENSE
 325
 326 Copyright (C) 2013 by Chip Black
 327
 328 This library is free software; you can redistribute it and/or modify
 329 it under the same terms as Perl itself, either Perl version 5.16.1 or,
 330 at your option, any later version of Perl 5 you may have available.
 331
 332 =cut