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