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