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 =over
 210
 211 =item exists(name)
 212
 213 Returns 1 if the named database exists, or C<undef> if it doesn't.
 214
 215 =item tag_list(tag, offset, direction)
 216
 217 Returns a list of hashrefs describing blerg posts related to the given tag.
 218 C<tag> includes the leading '@' or '#'.  Each item has two keys, C<author> and
 219 C<record>.
 220
 221 =item hash_tag_list(name, offset, direction)
 222
 223 Convenience for C<tag_list> so that you don't have to prepend '#' to the name.
 224
 225 =item ref_tag_list(name, offset, direction)
 226
 227 Convenience for C<tag_list> so that you don't have to prepend '@' to the name.
 228
 229 =item subscription_add(from, to)
 230
 231 Adds a subscription from C<from> to C<to>.
 232
 233 =item subscription_remove(from, to)
 234
 235 The opposite of subscription_add.
 236
 237 =item valid_tag_name(name)
 238
 239 Validates that C<name> is a valid tag name.
 240
 241 =item valid_name(name)
 242
 243 Validates that C<name> is a valid username.
 244
 245 =back
 246
 247 =head1 CONSTRUCTOR
 248
 249 =over
 250
 251 =item open(name)
 252
 253 Opens the named database, creating it if it doesn't exist.
 254
 255 =item open_existing(name)
 256
 257 Opens the named database.  If it doesn't exist, returns C<undef>.
 258
 259 =back
 260
 261 =head1 CLASS METHODS
 262
 263 =head2 RECORDS
 264
 265 =over
 266
 267 =item record_count()
 268
 269 Returns the number of records in the database.
 270
 271 =item store(data)
 272
 273 Stores a new record containing C<data>.  Returns the record number of the new
 274 record.
 275
 276 =item fetch(record)
 277
 278 Fetches a record from the database.
 279
 280 =item timestamp(record)
 281
 282 Returns a unix epoch timestamp for when the record was created.
 283
 284 =back
 285
 286 =head2 SUBSCRIPTIONS
 287
 288 =over
 289
 290 =item set_subscription_mark()
 291
 292 Mark all items on the subscription list as read.
 293
 294 =item get_subscription_mark()
 295
 296 Return the subscription list mark.
 297
 298 =item subscription_list()
 299
 300 Return a list of hashrefs describing posts in your subscription feed.  Each
 301 hashref has a C<author> and C<record> key.
 302
 303 =back
 304
 305 =head2 REFS, MUTE, CLEANUP
 306
 307 =over
 308
 309 =item refs()
 310
 311 Convenience for listing references to the database.  Equivalent to
 312 C<tag_list('@' . $obj-E<gt>{name})>.
 313
 314 =item mute(v)
 315
 316 When v = 1, mute the user, otherwise, unmute.  If v is absent, return the mute status.
 317
 318 =item close()
 319
 320 Closes the database.
 321
 322 =back
 323
 324 =head1 SEE ALSO
 325
 326 See the Blërg! website at http://blerg.cc.  More detailed docs about the
 327 database internals are available in the source repo under www/doc, or at
 328 http://blerg.cc/doc/
 329
 330 =head1 AUTHOR
 331
 332 Chip Black, E<lt>bytex64@bytex64.netE<gt>
 333
 334 =head1 COPYRIGHT AND LICENSE
 335
 336 Copyright (C) 2013 by Chip Black
 337
 338 This library is free software; you can redistribute it and/or modify
 339 it under the same terms as Perl itself, either Perl version 5.16.1 or,
 340 at your option, any later version of Perl 5 you may have available.
 341
 342 =cut