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_status($obj->{ptr}, $obj->BLERGSTATUS_MUTED, $v);
 134     } else {
 135         return Blerg::Database::_get_status($obj->{ptr}, $obj->BLERGSTATUS_MUTED);
 136     }
 137 }
 138
 139 sub mention {
 140     my ($obj, $v) = @_;
 141     $obj->_ensure_pointer;
 142     if (defined $v) {
 143         return Blerg::Database::_set_status($obj->{ptr}, $obj->BLERGSTATUS_MENTIONED, $v);
 144     } else {
 145         return Blerg::Database::_get_status($obj->{ptr}, $obj->BLERGSTATUS_MENTIONED);
 146     }
 147 }
 148
 149 sub refs {
 150     my ($obj) = @_;
 151     return Blerg::Database::tag_list('@' . $obj->{name}, 50, -1);
 152 }
 153
 154 sub store {
 155     my ($obj, $data) = @_;
 156     $obj->_ensure_pointer;
 157     return Blerg::Database::_store($obj->{ptr}, $data);
 158 }
 159
 160 sub fetch {
 161     my ($obj, $record) = @_;
 162     $obj->_ensure_pointer;
 163     return Blerg::Database::_fetch($obj->{ptr}, $record);
 164 }
 165
 166 sub timestamp {
 167     my ($obj, $record) = @_;
 168     $obj->_ensure_pointer;
 169     return Blerg::Database::_get_timestamp($obj->{ptr}, $record);
 170 }
 171
 172 # Convenience shortcuts
 173 sub hash_tag_list {
 174     my ($name, $str_offset, $direction) = @_;
 175     return Blerg::Database::tag_list("#$name", $str_offset, $direction);
 176 }
 177
 178 sub ref_tag_list {
 179     my ($name, $str_offset, $direction) = @_;
 180     return Blerg::Database::tag_list("@$name", $str_offset, $direction);
 181 }
 182
 183 # Autoload methods go after =cut, and are processed by the autosplit program.
 184
 185 1;
 186 __END__
 187
 188 =head1 NAME
 189
 190 =encoding utf8
 191
 192 Blerg::Database - Perl extension for reading Blërg! databases
 193
 194 =head1 SYNOPSIS
 195
 196   use Blerg::Database;
 197
 198   my $blerg = Blerg::Database->open_existing('foo');
 199   my $record = $blerg->post('This is some data!');
 200   $blerg->fetch($record);
 201
 202 =head1 DESCRIPTION
 203
 204 Blerg::Database is a utility library wrapping the core Blërg! database.  It
 205 provides nicer OO wrappers around the core C library that powers Blërg!.
 206
 207 =head1 MODULE FUNCTIONS
 208
 209 =head2 GENERAL
 210
 211 =over
 212
 213 =item exists(name)
 214
 215 Returns 1 if the named database exists, or C<undef> if it doesn't.
 216
 217 =item tag_list(tag, offset, direction)
 218
 219 Returns a list of hashrefs describing blerg posts related to the given tag.
 220 C<tag> includes the leading '@' or '#'.  Each item has two keys, C<author> and
 221 C<record>.
 222
 223 =item hash_tag_list(name, offset, direction)
 224
 225 Convenience for C<tag_list> so that you don't have to prepend '#' to the name.
 226
 227 =item ref_tag_list(name, offset, direction)
 228
 229 Convenience for C<tag_list> so that you don't have to prepend '@' to the name.
 230
 231 =item subscription_add(from, to)
 232
 233 Adds a subscription from C<from> to C<to>.
 234
 235 =item subscription_remove(from, to)
 236
 237 The opposite of subscription_add.
 238
 239 =item valid_tag_name(name)
 240
 241 Validates that C<name> is a valid tag name.
 242
 243 =item valid_name(name)
 244
 245 Validates that C<name> is a valid username.
 246
 247 =back
 248
 249 =head2 AUTHENTICATION
 250
 251 =over
 252
 253 =item auth_set_password(username, password)
 254
 255 Sets the password for the given username.  Returns 1 on success, 0 otherwise.
 256
 257 =item auth_check_password(username, password)
 258
 259 Checks the password for the given username.  Returns 1 on successful
 260 authentication, 0 on failed authentication or error.
 261
 262 =item auth_login(username, password)
 263
 264 Authenticates and logs the user in.  Returns the authentication token if
 265 successful, or undef on failure or error.
 266
 267 =item auth_logout(username, token)
 268
 269 Logs the given user out if the token represents a valid session.  Returns 1 on
 270 success, or 0 on failure.  Failure can happen if the token is no longer valid
 271 (meaning the user has been automatically logged out), so the return status is
 272 probably best ignored..
 273
 274 =item auth_check_token(username, token)
 275
 276 Checks that the token represents a valid session for the given username.
 277 Returns 1 if the session is valid, 0 otherwise.  Also resets the expiration
 278 time of the session.
 279
 280 =item auth_get_counter(username)
 281
 282 Gets an opaque "counter" value for the auth information of the given username.
 283 This counter is changed every time the authentication information is changed,
 284 making it useful for protecting password changes against replay attacks.
 285 Returns a 32-bit integer on success, or undef on failure.
 286
 287 =back
 288
 289 =head1 CONSTRUCTOR
 290
 291 =over
 292
 293 =item open(name)
 294
 295 Opens the named database, creating it if it doesn't exist.
 296
 297 =item open_existing(name)
 298
 299 Opens the named database.  If it doesn't exist, returns C<undef>.
 300
 301 =back
 302
 303 =head1 CLASS METHODS
 304
 305 =head2 RECORDS
 306
 307 =over
 308
 309 =item record_count()
 310
 311 Returns the number of records in the database.
 312
 313 =item store(data)
 314
 315 Stores a new record containing C<data>.  Returns the record number of the new
 316 record.
 317
 318 =item fetch(record)
 319
 320 Fetches a record from the database.
 321
 322 =item timestamp(record)
 323
 324 Returns a unix epoch timestamp for when the record was created.
 325
 326 =back
 327
 328 =head2 SUBSCRIPTIONS
 329
 330 =over
 331
 332 =item set_subscription_mark()
 333
 334 Mark all items on the subscription list as read.
 335
 336 =item get_subscription_mark()
 337
 338 Return the subscription list mark.
 339
 340 =item subscription_list()
 341
 342 Return a list of hashrefs describing posts in your subscription feed.  Each
 343 hashref has a C<author> and C<record> key.
 344
 345 =back
 346
 347 =head2 REFS, MUTE, CLEANUP
 348
 349 =over
 350
 351 =item refs()
 352
 353 Convenience for listing references to the database.  Equivalent to
 354 C<tag_list('@' . $obj-E<gt>{name})>.
 355
 356 =item mute(v)
 357
 358 When v = 1, mute the user, otherwise, unmute.  If v is absent, return the mute status.
 359
 360 =item close()
 361
 362 Closes the database.
 363
 364 =back
 365
 366 =head1 SEE ALSO
 367
 368 See the Blërg! website at http://blerg.cc.  More detailed docs about the
 369 database internals are available in the source repo under www/doc, or at
 370 http://blerg.cc/doc/
 371
 372 =head1 AUTHOR
 373
 374 Chip Black, E<lt>bytex64@bytex64.netE<gt>
 375
 376 =head1 COPYRIGHT AND LICENSE
 377
 378 Copyright (C) 2013 by Chip Black
 379
 380 This library is free software; you can redistribute it and/or modify
 381 it under the same terms as Perl itself, either Perl version 5.16.1 or,
 382 at your option, any later version of Perl 5 you may have available.
 383
 384 =cut