persistence/lib/Text/Tradition/Directory.pm

   1 package Text::Tradition::Directory;
   2
   3 use strict;
   4 use warnings;
   5 use Moose;
   6 use DBI;
   7 use Encode qw/ decode_utf8 /;
   8 use KiokuDB::GC::Naive;
   9 use KiokuDB::TypeMap;
  10 use KiokuDB::TypeMap::Entry::Naive;
  11 use Safe::Isa;
  12 use Text::Tradition::Error;
  13
  14 ## users
  15 use KiokuX::User::Util qw(crypt_password);
  16 use Text::Tradition::Store;
  17 use Text::Tradition::User;
  18 use Text::Tradition::TypeMap::Entry;
  19
  20 extends 'KiokuX::Model';
  21
  22 use vars qw/ $VERSION /;
  23 $VERSION = "1.1";
  24
  25 =head1 NAME
  26
  27 Text::Tradition::Directory - a KiokuDB interface for storing and retrieving
  28 traditions and their owners
  29
  30 =head1 SYNOPSIS
  31
  32   use Text::Tradition::Directory;
  33   my $d = Text::Tradition::Directory->new(
  34     'dsn' => 'dbi:SQLite:mytraditions.db',
  35     'extra_args' => { 'create' => 1 },
  36   );
  37
  38   my $tradition = Text::Tradition->new( @args );
  39   my $stemma = $tradition->add_stemma( dotfile => $dotfile ); # if Analysis module installed
  40   $d->save_tradition( $tradition );
  41
  42   foreach my $id ( $d->traditions ) {
  43         print $d->tradition( $id )->name;
  44   }
  45
  46   ## Users:
  47   my $userstore = Text::Tradition::UserStore->new(dsn => 'dbi:SQLite:foo.db');
  48   my $newuser = $userstore->add_user({ username => 'fred',
  49                                        password => 'somepassword' });
  50
  51   my $fetchuser = $userstore->find_user({ username => 'fred' });
  52   if($fetchuser->check_password('somepassword')) {
  53      ## login user or .. whatever
  54   }
  55
  56   my $user = $userstore->deactivate_user({ username => 'fred' });
  57   if(!$user->active) {
  58     ## shouldnt be able to login etc
  59   }
  60
  61 =head1 DESCRIPTION
  62
  63 Text::Tradition::Directory is an interface for storing and retrieving text
  64 traditions and all their data, including an associated stemma hypothesis
  65 and a user who has ownership rights to the tradition data. It is an
  66 instantiation of a KiokuDB::Model, storing traditions and associated
  67 stemmas by UUID.
  68
  69 The Text::Tradition::Directory package also includes the
  70 L<Text::Tradition::User> class for user objects, and the
  71 L<Text::Tradition::Ownership> role which extends the Text::Tradition class
  72 to handle user ownership.
  73
  74 =head1 ATTRIBUTES
  75
  76 =head2 MIN_PASS_LEN
  77
  78 Constant for the minimum password length when validating passwords,
  79 defaults to "8".
  80
  81 =cut
  82
  83 has MIN_PASS_LEN => ( is => 'ro', isa => 'Num', default => sub { 8 } );
  84
  85 =head1 METHODS
  86
  87 =head2 new
  88
  89 Returns a Directory object.
  90
  91 =head2 traditionlist
  92
  93 Returns a hashref mapping of ID => name for all traditions in the directory.
  94
  95 =head2 tradition( $id )
  96
  97 Returns the Text::Tradition object of the given ID.
  98
  99 =head2 save( $tradition )
 100
 101 Writes the given tradition to the database, returning its ID.
 102
 103 =head2 delete( $tradition )
 104
 105 Deletes the given tradition object from the database.
 106 WARNING!! Garbage collection does not yet work. Use this sparingly.
 107
 108 =begin testing
 109
 110 use TryCatch;
 111 use File::Temp;
 112 use Safe::Isa;
 113 use Text::Tradition;
 114 use_ok 'Text::Tradition::Directory';
 115
 116 my $fh = File::Temp->new();
 117 my $file = $fh->filename;
 118 $fh->close;
 119 my $dsn = "dbi:SQLite:dbname=$file";
 120 my $uuid;
 121 my $user = 'user@example.org';
 122 my $t = Text::Tradition->new(
 123         'name'  => 'inline',
 124         'input' => 'Tabular',
 125         'file'  => 't/data/simple.txt',
 126         );
 127 my $stemma_enabled = $t->can( 'add_stemma' );
 128
 129 {
 130         my $d = Text::Tradition::Directory->new( 'dsn' => $dsn,
 131                 'extra_args' => { 'create' => 1 } );
 132         ok( $d->$_isa('Text::Tradition::Directory'), "Got directory object" );
 133
 134         my $scope = $d->new_scope;
 135         $uuid = $d->save( $t );
 136         ok( $uuid, "Saved test tradition" );
 137
 138         # Add a test user
 139         my $user = $d->add_user({ username => $user, password => 'UserPass' });
 140         $user->add_tradition( $t );
 141         $d->store( $user );
 142         is( $t->user, $user, "Assigned tradition to test user" );
 143
 144         SKIP: {
 145                 skip "Analysis package not installed", 5 unless $stemma_enabled;
 146                 my $s = $t->add_stemma( dotfile => 't/data/simple.dot' );
 147                 ok( $d->save( $t ), "Updated tradition with stemma" );
 148                 is( $d->tradition( $uuid ), $t, "Correct tradition returned for id" );
 149                 is( $d->tradition( $uuid )->stemma(0), $s, "...and it has the correct stemma" );
 150                 try {
 151                         $d->save( $s );
 152                 } catch( Text::Tradition::Error $e ) {
 153                         is( $e->ident, 'database error', "Got exception trying to save stemma directly" );
 154                         like( $e->message, qr/Cannot directly save non-Tradition object/,
 155                                 "Exception has correct message" );
 156                 }
 157         }
 158 }
 159 my $nt = Text::Tradition->new(
 160         'name' => 'CX',
 161         'input' => 'CollateX',
 162         'file' => 't/data/Collatex-16.xml',
 163         );
 164 ok( $nt->$_isa('Text::Tradition'), "Made new tradition" );
 165
 166 {
 167         my $f = Text::Tradition::Directory->new( 'dsn' => $dsn );
 168         my $scope = $f->new_scope;
 169         is( scalar $f->traditionlist, 1, "Directory index has our tradition" );
 170         my $nuuid = $f->save( $nt );
 171         ok( $nuuid, "Stored second tradition" );
 172         my @tlist = $f->traditionlist;
 173         is( scalar @tlist, 2, "Directory index has both traditions" );
 174         my $tf = $f->tradition( $uuid );
 175         my( $tlobj ) = grep { $_->{'id'} eq $uuid } @tlist;
 176         is( $tlobj->{'name'}, $tf->name, "Directory index has correct tradition name" );
 177         is( $tf->name, $t->name, "Retrieved the tradition from a new directory" );
 178         my $sid;
 179         SKIP: {
 180                 skip "Analysis package not installed", 4 unless $stemma_enabled;
 181                 $sid = $f->object_to_id( $tf->stemma(0) );
 182                 try {
 183                         $f->tradition( $sid );
 184                 } catch( Text::Tradition::Error $e ) {
 185                         is( $e->ident, 'database error', "Got exception trying to fetch stemma directly" );
 186                         like( $e->message, qr/not a Text::Tradition/, "Exception has correct message" );
 187                 }
 188                 try {
 189                         $f->delete( $sid );
 190                 } catch( Text::Tradition::Error $e ) {
 191                         is( $e->ident, 'database error', "Got exception trying to delete stemma directly" );
 192                         like( $e->message, qr/Cannot directly delete non-Tradition object/,
 193                                 "Exception has correct message" );
 194                 }
 195         }
 196
 197         $f->delete( $uuid );
 198         ok( !$f->exists( $uuid ), "Object is deleted from DB" );
 199         ok( !$f->exists( $sid ), "Object stemma also deleted from DB" ) if $stemma_enabled;
 200         is( scalar $f->traditionlist, 1, "Object is deleted from index" );
 201 }
 202
 203 {
 204         my $g = Text::Tradition::Directory->new( 'dsn' => $dsn );
 205         my $scope = $g->new_scope;
 206         is( scalar $g->traditionlist, 1, "Now one object in new directory index" );
 207         my $ntobj = $g->tradition( 'CX' );
 208         my @w1 = sort { $a->sigil cmp $b->sigil } $ntobj->witnesses;
 209         my @w2 = sort{ $a->sigil cmp $b->sigil } $nt->witnesses;
 210         is_deeply( \@w1, \@w2, "Looked up remaining tradition by name" );
 211 }
 212
 213 =end testing
 214
 215 =cut
 216 use Text::Tradition::TypeMap::Entry;
 217
 218 has +typemap => (
 219   is      => 'rw',
 220   isa     => 'KiokuDB::TypeMap',
 221   default => sub {
 222     KiokuDB::TypeMap->new(
 223       isa_entries => {
 224         # now that we fall back to YAML deflation, all attributes of
 225         # Text::Tradition will be serialized to YAML as individual objects
 226         # Except if we declare a specific entry type here
 227         "Text::Tradition" =>
 228           KiokuDB::TypeMap::Entry::MOP->new(),
 229         # We need users to be naive entries so that they hold
 230         # references to the original tradition objects, not clones
 231         "Text::Tradition::User" =>
 232           KiokuDB::TypeMap::Entry::MOP->new(),
 233         "Text::Tradition::Collation" =>
 234           KiokuDB::TypeMap::Entry::MOP->new(),
 235         "Text::Tradition::Witness" =>
 236           KiokuDB::TypeMap::Entry::MOP->new(),
 237         "Graph" => Text::Tradition::TypeMap::Entry->new(),
 238         "Set::Scalar" => Text::Tradition::TypeMap::Entry->new(),
 239       }
 240     );
 241   },
 242 );
 243
 244 # Push some columns into the extra_args
 245 around BUILDARGS => sub {
 246         my $orig = shift;
 247         my $class = shift;
 248         my $args;
 249         if( @_ == 1 ) {
 250                 $args = $_[0];
 251         } else {
 252                 $args = { @_ };
 253         }
 254         my @column_args;
 255         if( $args->{'dsn'} =~ /^dbi/ ) { # We're using Backend::DBI
 256                 @column_args = ( 'columns',
 257                         [ 'name' => { 'data_type' => 'varchar', 'is_nullable' => 1 },
 258                           'public' => { 'data_type' => 'bool', 'is_nullable' => 1 } ] );
 259         }
 260         my $ea = $args->{'extra_args'};
 261         if( ref( $ea ) eq 'ARRAY' ) {
 262                 push( @$ea, @column_args );
 263         } elsif( ref( $ea ) eq 'HASH' ) {
 264                 $ea = { %$ea, @column_args };
 265         } else {
 266                 $ea = { @column_args };
 267         }
 268         $args->{'extra_args'} = $ea;
 269
 270         return $class->$orig( $args );
 271 };
 272
 273 override _build_directory => sub {
 274   my($self) = @_;
 275   Text::Tradition::Store->connect(@{ $self->_connect_args },
 276     resolver_constructor => sub {
 277       my($class) = @_;
 278       $class->new({ typemap => $self->directory->merged_typemap,
 279                     fallback_entry => Text::Tradition::TypeMap::Entry->new() });
 280   });
 281 };
 282
 283 ## These checks don't cover store($id, $obj)
 284 # before [ qw/ store update insert delete / ] => sub {
 285 before [ qw/ delete / ] => sub {
 286         my $self = shift;
 287         my @nontrad;
 288         foreach my $obj ( @_ ) {
 289                 if( ref( $obj ) && !$obj->$_isa( 'Text::Tradition' )
 290             && !$obj->$_isa('Text::Tradition::User') ) {
 291                         # Is it an id => Tradition hash?
 292                         if( ref( $obj ) eq 'HASH' && keys( %$obj ) == 1 ) {
 293                                 my( $k ) = keys %$obj;
 294                                 next if $obj->{$k}->$_isa('Text::Tradition');
 295                         }
 296                         push( @nontrad, $obj );
 297                 }
 298         }
 299         if( @nontrad ) {
 300                 throw( "Cannot directly save non-Tradition object of type "
 301                         . ref( $nontrad[0] ) );
 302         }
 303 };
 304
 305 # TODO Garbage collection doesn't work. Suck it up and live with the
 306 # inflated DB.
 307 after delete => sub {
 308         my $self = shift;
 309         my $gc = KiokuDB::GC::Naive->new( backend => $self->directory->backend );
 310         $self->directory->backend->delete( $gc->garbage->members );
 311 };
 312
 313 sub save {
 314         my $self = shift;
 315         return $self->store( @_ );
 316 }
 317
 318 sub tradition {
 319         my( $self, $id ) = @_;
 320         my $obj = $self->lookup( $id );
 321         unless( $obj ) {
 322                 # Try looking up by name.
 323                 foreach my $item ( $self->traditionlist ) {
 324                         if( $item->{'name'} eq $id ) {
 325                                 $obj = $self->lookup( $item->{'id'} );
 326                                 last;
 327                         }
 328                 }
 329         }
 330         if( $obj && !$obj->$_isa('Text::Tradition') ) {
 331                 throw( "Retrieved object is a " . ref( $obj ) . ", not a Text::Tradition" );
 332         }
 333         return $obj;
 334 }
 335
 336 sub traditionlist {
 337         my $self = shift;
 338     my ($user) = @_;
 339
 340     return $self->user_traditionlist($user) if($user);
 341         return $self->_get_object_idlist( 'Text::Tradition' );
 342 }
 343
 344 sub _get_object_idlist {
 345         my( $self, $objclass ) = @_;
 346         my @tlist;
 347         # If we are using DBI, we can do it the easy way; if not, the hard way.
 348         # Easy way still involves making a separate DBI connection. Ew.
 349         if( $self->dsn =~ /^dbi:(\w+):/ ) {
 350                 my $dbtype = $1;
 351                 my @connection = @{$self->directory->backend->connect_info};
 352                 # Get rid of KiokuDB-specific arg
 353                 pop @connection if scalar @connection > 4;
 354                 $connection[3]->{'sqlite_unicode'} = 1 if $dbtype eq 'SQLite';
 355                 $connection[3]->{'pg_enable_utf8'} = 1 if $dbtype eq 'Pg';
 356                 my $dbh = DBI->connect( @connection );
 357                 my $q = $dbh->prepare( 'SELECT id, name, public from entries WHERE class = "'
 358                         . $objclass . '"' );
 359                 $q->execute();
 360                 while( my @row = $q->fetchrow_array ) {
 361                         my( $id, $name ) = @row;
 362                         # Horrible horrible hack
 363                         $name = decode_utf8( $name ) if $dbtype eq 'mysql';
 364                         push( @tlist, { 'id' => $row[0], 'name' => $row[1], 'public' => $row[2] } );
 365                 }
 366         } else {
 367                 $self->scan( sub { my $o = shift;
 368                                                    push( @tlist, { 'id' => $self->object_to_id( $o ),
 369                                                                                    'name' => $o->name,
 370                                                                                    'public' => $o->public } )
 371                                                                 if( ref $o eq $objclass ) } );
 372         }
 373         return @tlist;
 374 }
 375
 376 sub throw {
 377         Text::Tradition::Error->throw(
 378                 'ident' => 'database error',
 379                 'message' => $_[0],
 380                 );
 381 }
 382
 383
 384 # has 'directory' => (
 385 #     is => 'rw',
 386 #     isa => 'KiokuX::Model',
 387 #     handles => []
 388 #     );
 389
 390 ## TODO: Some of these methods should probably optionally take $user objects
 391 ## instead of hashrefs.
 392
 393 ## It also occurs to me that all these methods don't need to be named
 394 ## XX_user, but leaving that way for now incase we merge this code
 395 ## into ::Directory for one-store.
 396
 397 =head1 USER DIRECTORY METHODS
 398
 399 =head2 add_user( $userinfo )
 400
 401 Takes a hashref of C<username>, C<password>.
 402
 403 Create a new user object, store in the KiokuDB backend, and return it.
 404
 405 =cut
 406
 407 sub add_user {
 408     my ($self, $userinfo) = @_;
 409
 410     my $username = $userinfo->{username};
 411     my $password = $userinfo->{password};
 412     my $role = $userinfo->{role} || 'user';
 413
 414         throw( "No username given" ) unless $username;
 415         throw( "Invalid password - must be at least " . $self->MIN_PASS_LEN
 416                 . " characters long" )
 417                 unless ( $self->validate_password($password) || $username =~ /^https?:/ );
 418
 419     my $user = Text::Tradition::User->new(
 420         id => $username,
 421         password => ($password ? crypt_password($password) : ''),
 422         email => ($userinfo->{email} ? $userinfo->{email} : $username),
 423         role => $role,
 424     );
 425
 426     $self->store($user->kiokudb_object_id, $user);
 427
 428     return $user;
 429 }
 430
 431 =head2 create_user( $userinfo )
 432
 433 Takes a hashref that can either be suitable for add_user (see above) or be
 434 a hash of OpenID user information from Credential::OpenID.
 435
 436 =cut
 437
 438 sub create_user {
 439     my ($self, $userinfo) = @_;
 440
 441     ## No username means probably an OpenID based user
 442     if(!exists $userinfo->{username}) {
 443         _extract_openid_data($userinfo);
 444     }
 445
 446     return $self->add_user($userinfo);
 447 }
 448
 449 ## Not quite sure where this method should be.. Auth /
 450 ## Credential::OpenID just pass us back the chunk of extension data
 451 sub _extract_openid_data {
 452     my ($userinfo) = @_;
 453
 454     ## Spec says SHOULD use url as identifier
 455     $userinfo->{username} = $userinfo->{url};
 456
 457     ## Use email addy as display if available
 458     if(exists $userinfo->{extensions} &&
 459          exists $userinfo->{extensions}{'http://openid.net/srv/ax/1.0'} &&
 460          defined $userinfo->{extensions}{'http://openid.net/srv/ax/1.0'}{'value.email'}) {
 461         ## Somewhat ugly attribute extension reponse, contains
 462         ## google-email string which we can use as the id
 463
 464         $userinfo->{email} = $userinfo->{extensions}{'http://openid.net/srv/ax/1.0'}{'value.email'};
 465     }
 466
 467     return;
 468 }
 469
 470 =head2 find_user( $userinfo )
 471
 472 Takes a hashref of C<username> or C<email>, and possibly openIDish results from
 473 L<Net::OpenID::Consumer>.
 474
 475 Fetches the user object for the given username and returns it.
 476
 477 =cut
 478
 479 sub find_user {
 480     my ($self, $userinfo) = @_;
 481
 482     ## A URL field means probably an OpenID based user
 483     if( exists $userinfo->{url} ) {
 484         _extract_openid_data($userinfo);
 485     }
 486
 487         my $user;
 488         if( exists $userinfo->{username} ) {
 489         my $username = $userinfo->{username};
 490                 ## No logins if user is deactivated (use lookup to fetch to re-activate)
 491                 $user = $self->lookup(Text::Tradition::User->id_for_user($username));
 492                 ## If there is an inactive user, skip it
 493                 return if( $user && !$user->active );
 494         } elsif( exists $userinfo->{email} ) {
 495                 ## Scan the users looking for a matching email
 496                 my @matches;
 497                 $self->scan( sub { push( @matches, @_ )
 498                         if $_[0]->isa('Text::Tradition::User')
 499                         && $_[0]->email eq $userinfo->{email} } );
 500                 $user = shift @matches;
 501         }
 502 #    print STDERR "Found user, $username, email is :", $user->email, ":\n";
 503     return $user;
 504 }
 505
 506 =head2 modify_user( $userinfo )
 507
 508 Takes a hashref of C<username> and C<password> (same as add_user).
 509
 510 Retrieves the user, and updates it with the new information. Username
 511 changing is not currently supported.
 512
 513 Returns the updated user object, or undef if not found.
 514
 515 =cut
 516
 517 sub modify_user {
 518     my ($self, $userinfo) = @_;
 519     my $username = $userinfo->{username};
 520     my $password = $userinfo->{password};
 521     my $role = $userinfo->{role};
 522
 523     throw( "Missing username" ) unless $username;
 524
 525     my $user = $self->find_user({ username => $username });
 526     throw( "Could not find user $username" ) unless $user;
 527
 528     if($password) {
 529         throw( "Bad password" ) unless $self->validate_password($password);
 530         $user->password(crypt_password($password));
 531     }
 532     if($role) {
 533         $user->role($role);
 534     }
 535
 536     $self->update($user);
 537
 538     return $user;
 539 }
 540
 541 =head2 deactivate_user( $userinfo )
 542
 543 Takes a hashref of C<username>.
 544
 545 Sets the users C<active> flag to false (0), and sets all traditions
 546 assigned to them to non-public, updates the storage and returns the
 547 deactivated user.
 548
 549 Returns undef if user not found.
 550
 551 =cut
 552
 553 sub deactivate_user {
 554     my ($self, $userinfo) = @_;
 555     my $username = $userinfo->{username};
 556
 557     throw( "Need to specify a username for deactivation" ) unless $username;
 558
 559     my $user = $self->find_user({ username => $username });
 560     throw( "User $username not found" ) unless $user;
 561
 562     $user->active(0);
 563     foreach my $tradition (@{ $user->traditions }) {
 564         ## Not implemented yet
 565         # $tradition->public(0);
 566     }
 567
 568     ## Should we be using Text::Tradition::Directory also?
 569     $self->update(@{ $user->traditions });
 570
 571     $self->update($user);
 572
 573     return $user;
 574 }
 575
 576 =head2 reactivate_user( $userinfo )
 577
 578 Takes a hashref of C<username>.
 579
 580 Returns the user object if already activated. Activates (sets the
 581 active flag to true (1)), updates the storage and returns the user.
 582
 583 Returns undef if the user is not found.
 584
 585 =cut
 586
 587 sub reactivate_user {
 588     my ($self, $userinfo) = @_;
 589     my $username = $userinfo->{username};
 590
 591     throw( "Need to specify a username for reactivation" ) unless $username;
 592
 593     my $user = $self->lookup(Text::Tradition::User->id_for_user($username));
 594     throw( "User $username not found" ) unless $user;
 595
 596     return $user if $user->active;
 597
 598     $user->active(1);
 599     $self->update($user);
 600
 601     return $user;
 602 }
 603
 604 =head2 delete_user( $userinfo )
 605
 606 CAUTION: Deletes actual data!
 607
 608 Takes a hashref of C<username>.
 609
 610 Returns undef if the user doesn't exist.
 611
 612 Removes the user from the store and returns 1.
 613
 614 =cut
 615
 616 sub delete_user {
 617     my ($self, $userinfo) = @_;
 618     my $username = $userinfo->{username};
 619
 620     throw( "Need to specify a username for deletion" ) unless $username;
 621
 622     my $user = $self->find_user({ username => $username });
 623     throw( "User $username not found" ) unless $user;
 624
 625     ## Should we be using Text::Tradition::Directory for this bit?
 626     $self->delete( @{ $user->traditions });
 627
 628     ## Poof, gone.
 629     $self->delete($user);
 630
 631     return 1;
 632 }
 633
 634 =head2 validate_password( $password )
 635
 636 Takes a password string. Returns true if it is longer than
 637 L</MIN_PASS_LEN>, false otherwise.
 638
 639 Used internally by L</add_user>.
 640
 641 =cut
 642
 643 sub validate_password {
 644     my ($self, $password) = @_;
 645
 646     return if !$password;
 647     return if length($password) < $self->MIN_PASS_LEN;
 648
 649     return 1;
 650 }
 651
 652 =head2 user_traditionlist( $user )
 653
 654 Returns a tradition list (see specification above) but containing only
 655 those traditions visible to the specified user.  If $user is the string
 656 'public', returns only publicly-viewable traditions.
 657
 658 =cut
 659
 660 sub user_traditionlist {
 661     my ($self, $user) = @_;
 662
 663     my @tlist;
 664     if(ref $user && $user->is_admin) {
 665         ## Admin sees all
 666         return $self->traditionlist();
 667     } elsif(ref $user) {
 668         ## We have a user object already, so just fetch its traditions and use tose
 669         foreach my $t (@{ $user->traditions }) {
 670             push( @tlist, { 'id' => $self->object_to_id( $t ),
 671                             'name' => $t->name } );
 672         }
 673         return @tlist;
 674     } elsif($user ne 'public') {
 675         die "Passed neither a user object nor 'public' to user_traditionlist";
 676     }
 677
 678     ## Search for all traditions which allow public viewing
 679         my @list = grep { $_->{public} } $self->traditionlist();
 680         return @list;
 681 }
 682
 683 1;
 684
 685 =head1 LICENSE
 686
 687 This package is free software and is provided "as is" without express
 688 or implied warranty.  You can redistribute it and/or modify it under
 689 the same terms as Perl itself.
 690
 691 =head1 AUTHORS
 692
 693 Tara L Andrews E<lt>aurum@cpan.orgE<gt> (initial release)
 694
 695 Shadowcat Systems L<http://www.scsys.co.uk/> (user functionality; making it all work)
 696