—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—

              
HideShow 87 lines of Pod
=head1 NAME
Redis::SQLite - Redis-Compatible module which writes to SQLite.
=cut
=head1 SYNOPSIS
=for example begin
    #!/usr/bin/perl -w
    use Redis::SQLite;
    use strict;
    my $db = Redis::SQLite->new();
    $db->set( "foo", "bar" );
    print $db->get( "foo" ) . "\n";
=for example end
=head1 DESCRIPTION
This package is an implementation of the L<Redis> Perl-client API, which
stores all data in an SQLite database rather than in RAM.
It is B<not> a drop-in replacement, because it doesn't implement all the
features you'd expect from the real Redis module.  Just enough to be useful.
=cut
=head1 COMPATIBILITY
This module is designed to be source compatible with the L<Redis> module,
providing you're only operating upon either sets or simple strings.
Specifically we do not support:
=over 8
=item HASH
For example C<hlen>, C<hkeys>, C<hexists>, etc.
=item Lists
For example C<lset>, C<ltrim>, etc.
=item Scripting
Perl is itself a wonderful scripting language, so we've no need for Lua support.
=item ZSET
For example C<zcard>, C<zadd>, C<zcount>, etc.
=back
All of the set-related primitives are supported, with the exception of C<SSCAN>,
and the basic commands for working with string-based keys are also present, such
as:
=over 8
=item append
=item del
=item exists
=item get
=item set
=item etc..
=back
=cut
=head1 METHODS
=cut
package Redis::SQLite;
use strict;
use warnings;
use DBI;
our $VERSION = '0.3';
HideShow 8 lines of Pod
=head2 new
Constructor.  The only (optional) argument is C<path> which will
change the default SQLite database-file location, if unspecified
C<~/.predis.db> will be used.
=cut
sub new
{
    my ( $proto, %supplied ) = (@_);
    my $class = ref($proto) || $proto;
    my $self = {};
    bless( $self, $class );
    # Get the user's home-directory
    my $home =
      $ENV{ 'HOME' } || $ENV{ 'USERPROFILE' } || ( getpwuid($<) )[7] || "C:/";
    # Create ~/.predis.db unless an alternative path was specified.
    my $file = $supplied{ 'path' } || "$home/.predis.db";
    my $create = 1;
    $create = 0 if ( -e $file );
    $self->{ 'db' } =
      DBI->connect( "dbi:SQLite:dbname=$file", "", "", { AutoCommit => 1 } );
    #
    #  Populate the database tables, if it was missing.
    #
    if ($create)
    {
        $self->{ 'db' }->do(
             "CREATE TABLE string (id INTEGER PRIMARY KEY, key UNIQUE, val );");
        $self->{ 'db' }
          ->do("CREATE TABLE sets (id INTEGER PRIMARY KEY, key, val );");
    }
    #
    #  This is potentially risky, but improves the throughput by several
    # orders of magnitude.
    #
    if ( !$ENV{ 'SAFE' } )
    {
        $self->{ 'db' }->do("PRAGMA synchronous = OFF");
        $self->{ 'db' }->do("PRAGMA journal_mode = MEMORY");
    }
    return $self;
}
HideShow 7 lines of Pod
=head2 append
Append the given string to the contents of the existing key, creating it
if didn't previously exist.
=cut
sub append
{
    my ( $self, $key, $data ) = (@_);
    my $r = $self->get($key);
    $r .= $data;
    $self->set( $key, $r );
}
HideShow 6 lines of Pod
=head2 exists
Does the given key exist?
=cut
sub exists
{
    my ( $self, $key ) = (@_);
    my $sql = $self->{ 'db' }->prepare("SELECT key FROM string WHERE key=?");
    $sql->execute($key);
    my $x = $sql->fetchrow_array() || undef;
    $sql->finish();
    if ($x)
    {
        return 1;
    }
    $sql = $self->{ 'db' }->prepare("SELECT key FROM sets WHERE key=?");
    $sql->execute($key);
    $x = $sql->fetchrow_array() || undef;
    $sql->finish();
    if ($x)
    {
        return 1;
    }
    return 0;
}
HideShow 7 lines of Pod
=head2 get
Get the value of a string-key.  Returns C<undef> if the key didn't exist,
or contain data.
=cut
sub get
{
    my ( $self, $key ) = (@_);
    if ( !$self->{ 'get' } )
    {
        $self->{ 'get' } =
          $self->{ 'db' }->prepare("SELECT val FROM string WHERE key=?");
    }
    $self->{ 'get' }->execute($key);
    my $x = $self->{ 'get' }->fetchrow_array();
    $self->{ 'get' }->finish();
    return ($x);
}
HideShow 6 lines of Pod
=head2 getset
Update the value of a key, and return the previous value if any.
=cut
sub getset
{
    my ( $self, $key, $val ) = (@_);
    my $old = $self->get($key);
    $self->set( $key, $val );
    return ($old);
}
HideShow 6 lines of Pod
=head2 getrange
Return the chunk of the key's value between the given offsets.
=cut
sub getrange
{
    my ( $self, $key, $start, $end ) = (@_);
    my $val = $self->get($key);
    my $s   = $start;
    my $e   = $end;
    if ( $s < 0 )
    {
        $s = length($val) + $s;
    }
    if ( $e < 0 )
    {
        $e = length($val) + $e;
    }
    return ( substr( $val, $s, ( $e - $s + 1 ) ) );
}
HideShow 6 lines of Pod
=head2 strlen
Return the length of the given value of the given key.
=cut
sub strlen
{
    my ( $self, $key ) = (@_);
    my $data = $self->get($key);
    if ( defined($data) )
    {
        return ( length($data) );
    }
    return 0;
}
HideShow 6 lines of Pod
=head2 rename
Rename a string key.  Deleting the target if it exists.
=cut
sub rename
{
    my ( $self, $key, $new_name ) = (@_);
    $self->del($new_name);
    my $val = $self->get($key);
    $self->set( $new_name, $val );
    $self->del($key);
}
HideShow 7 lines of Pod
=head2 renamenx
Attempt to rename the given key, if the destination exists then
nothing happens.
=cut
sub renamenx
{
    my ( $self, $key, $new_name ) = (@_);
    return 0 if ( $self->exists($new_name) );
    # Get the value and save it.
    my $val = $self->get($key);
    $self->set( $new_name, $val );
    # Remove the original
    $self->del($key);
    return "OK";
}
HideShow 6 lines of Pod
=head2 set
Set the value of a string-key.
=cut
sub set
{
    my ( $self, $key, $val ) = (@_);
    if ( !$self->{ 'ins' } )
    {
        $self->{ 'ins' } =
          $self->{ 'db' }
          ->prepare("INSERT OR REPLACE INTO string (key,val) VALUES( ?,? )");
    }
    $self->{ 'ins' }->execute( $key, $val );
    $self->{ 'ins' }->finish();
}
HideShow 6 lines of Pod
=head2 setnx
Store the given value in the named key, unless that key exists.
=cut
sub setnx
{
    my ( $self, $key, $val ) = (@_);
    return 0 if ( $self->exists($key) );
    $self->set( $key, $val );
    return 1;
}
HideShow 9 lines of Pod
=head2 setrange
Insert some new data at the given offset of the specific key's value.
If the current length of the key's value is too short it is NULL-padded
first.
=cut
sub setrange
{
    my ( $self, $key, $offset, $data ) = (@_);
    my $val = $self->get($key);
    while ( ( $val ? length($val) : 0 ) < $offset )
    {
        $val .= chr(0x00);
    }
    substr( $val, $offset, length($data), $data );
    $self->set( $key, $val );
    return ( length($val) );
}
HideShow 6 lines of Pod
=head2 type
Return the type of the named key.
=cut
sub type
{
    my ( $self, $key ) = (@_);
    my $sql = $self->{ 'db' }->prepare("SELECT key FROM string WHERE key=?");
    $sql->execute($key);
    my $x = $sql->fetchrow_array() || undef;
    $sql->finish();
    return 'string' if ($x);
    $sql = $self->{ 'db' }->prepare("SELECT key FROM sets WHERE key=?");
    $sql->execute($key);
    $x = $sql->fetchrow_array() || undef;
    $sql->finish();
    return 'set' if ($x);
    return undef;
}
HideShow 6 lines of Pod
=head2 incr
Increment and return the value of an (integer) string-key.
=cut
sub incr
{
    my ( $self, $key ) = (@_);
    return ( $self->incrby( $key, 1 ) );
}
HideShow 6 lines of Pod
=head2 incrby
Increment and return the value of an (integer) string-key.
=cut
sub incrby
{
    my ( $self, $key, $amt ) = (@_);
    $amt = 1 if ( !defined($amt) );
    my $cur = $self->get($key) || 0;
    $cur += $amt;
    $self->set( $key, $cur );
    return ($cur);
}
HideShow 6 lines of Pod
=head2 decr
Decrement and return the value of an (integer) string-key.
=cut
sub decr
{
    my ( $self, $key ) = (@_);
    return ( $self->decrby( $key, 1 ) );
}
HideShow 6 lines of Pod
=head2 decrby
Decrement and return the value of an (integer) string-key.
=cut
sub decrby
{
    my ( $self, $key, $amt ) = (@_);
    $amt = 1 if ( !defined($amt) );
    my $cur = $self->get($key) || 0;
    $cur -= $amt;
    $self->set( $key, $cur );
    return ($cur);
}
HideShow 6 lines of Pod
=head2 del
Delete a given key, regardless of whether it holds a string or a set.
=cut
sub del
{
    my ( $self, $key ) = (@_);
    # strings
    my $str = $self->{ 'db' }->prepare("DELETE FROM string WHERE key=?");
    $str->execute($key);
    $str->finish();
    # Deleted a string-keyu
    return 1 if ( $str->rows > 0 );
    # sets
    my $set = $self->{ 'db' }->prepare("DELETE FROM sets WHERE key=?");
    $set->execute($key);
    $set->finish();
    # Deleted a set-key.
    return 1 if ( $set->rows > 0 );
    # Deleted nothing.
    return 0;
}
HideShow 18 lines of Pod
=head2 keys
Return the names of each known key.
These can be optionally filtered by a (perl) regular expression, for example:
=for example begin
   $redis->set( "foo", 1 );
   $redis->set( "moo", 1 );
   $redis->keys( "^f" );   # -> [ "foo" ]
   $redis->keys( "oo\$" ); # -> [ "foo", "moo" ]
=for example end
=cut
sub keys
{
    my ( $self, $pattern ) = (@_);
    # Get all keys into this hash
    my %known;
    # We run the same query against two tables.
    foreach my $table (qw! string sets !)
    {
        # Get the names of the key.
        my $str = $self->{ 'db' }->prepare("SELECT key FROM $table");
        $str->execute();
        while ( my ($name) = $str->fetchrow_array )
        {
            $known{ $name } += 1;
        }
        $str->finish();
    }
    # The keys we've found
    my @keys = keys %known;
    if ($pattern)
    {
        my @ret;
        foreach my $ent (@keys)
        {
            push( @ret, $ent ) if ( $ent =~ /$pattern/ );
        }
        return (@ret);
    }
    else
    {
        return (@keys);
    }
}
HideShow 6 lines of Pod
=head2 randomkey
Return the name of a random key.
=cut
sub randomkey
{
    my ($self) = (@_);
    # Get all keys into this hash
    my %known;
    # We run the same query against two tables.
    foreach my $table (qw! string sets !)
    {
        # Get the names of the key.
        my $str = $self->{ 'db' }->prepare("SELECT key FROM $table");
        $str->execute();
        while ( my ($name) = $str->fetchrow_array )
        {
            $known{ $name } += 1;
        }
        $str->finish();
    }
    # The keys we've found
    my @keys = CORE::keys %known;
    return ( $keys[rand @keys] );
}
HideShow 6 lines of Pod
=head2 smembers
Return the members of the given set.
=cut
sub smembers
{
    my ( $self, $key ) = (@_);
    if ( !$self->{ 'smembers' } )
    {
        $self->{ 'smembers' } =
          $self->{ 'db' }->prepare("SELECT val FROM sets WHERE key=?");
    }
    $self->{ 'smembers' }->execute($key);
    my @vals;
    while ( my ($name) = $self->{ 'smembers' }->fetchrow_array )
    {
        push( @vals, $name );
    }
    $self->{ 'smembers' }->finish();
    return (@vals);
}
HideShow 6 lines of Pod
=head2 smove
Move a member from a given set to a new one.
=cut
sub smove
{
    my ( $self, $src, $dst, $ent ) = (@_);
    # Get the value from the original set
    my $sql = $self->{ 'db' }
      ->prepare("UPDATE sets SET key=? WHERE ( key=? AND val=?)");
    $sql->execute( $dst, $src, $ent );
    $sql->finish();
    if ( $sql->rows > 0 )
    {
        return 1;
    }
    return 0;
}
HideShow 6 lines of Pod
=head2 sismember
Is the given item a member of the set?
=cut
sub sismember
{
    my ( $self, $set, $key ) = (@_);
    my $sql =
      $self->{ 'db' }->prepare("SELECT val FROM sets WHERE key=? AND val=?");
    $sql->execute( $set, $key );
    my $x = $sql->fetchrow_array() || undef;
    $sql->finish();
    if ( defined($x) && ( $x eq $key ) )
    {
        return 1;
    }
    return 0;
}
HideShow 6 lines of Pod
=head2 sadd
Add a member to a set.
=cut
sub sadd
{
    my ( $self, $key, $val ) = (@_);
    if ( !$self->{ 'sadd' } )
    {
        $self->{ 'sadd' } =
          $self->{ 'db' }->prepare(
            "INSERT INTO sets (key,val) SELECT ?,? WHERE NOT EXISTS( SELECT key, val FROM sets WHERE key=? AND val=? );"
          );
    }
    $self->{ 'sadd' }->execute( $key, $val, $key, $val );
    $self->{ 'sadd' }->finish();
    if ( $self->{ 'sadd' }->rows > 0 )
    {
        return 1;
    }
    return 0;
}
HideShow 6 lines of Pod
=head2 srem
Remove a member from a set.
=cut
sub srem
{
    my ( $self, $key, $val ) = (@_);
    if ( !$self->{ 'srem' } )
    {
        $self->{ 'srem' } =
          $self->{ 'db' }->prepare("DELETE FROM sets WHERE (key=? AND val=?)");
    }
    $self->{ 'srem' }->execute( $key, $val );
    $self->{ 'srem' }->finish();
    if ( $self->{ 'srem' }->rows > 0 )
    {
        return 1;
    }
    return 0;
}
HideShow 6 lines of Pod
=head2 spop
Remove a given number of elements from the named set, and return them.
=cut
sub spop
{
    my ( $self, $key, $count ) = (@_);
    $count = 1 if ( !defined($count) );
    my @res;
    while ( ( $count > 0 ) && ( $count <= $self->scard($key) ) )
    {
        my $rand = $self->srandmember($key);
        push( @res, $rand );
        $self->srem( $key, $rand );
        $count -= 1;
    }
    return (@res);
}
HideShow 6 lines of Pod
=head2 srandmember
Fetch the value of a random member from a set.
=cut
sub srandmember
{
    my ( $self, $key ) = (@_);
    if ( !$self->{ 'srandommember' } )
    {
        $self->{ 'srandommember' } =
          $self->{ 'db' }->prepare(
                "SELECT val FROM sets where key=? ORDER BY RANDOM() LIMIT 1") or
          die "Failed to prepare";
    }
    $self->{ 'srandommember' }->execute($key);
    my $x = $self->{ 'srandommember' }->fetchrow_array() || "";
    $self->{ 'srandommember' }->finish();
    return ($x);
}
HideShow 23 lines of Pod
=head2 sunion
Return the values which are present in each of the sets named, duplicates
will only be returned one time.
For example:
=for example begin
   $redis->sadd( "one", 1 );
   $redis->sadd( "one", 2 );
   $redis->sadd( "one", 3 );
   $redis->sadd( "two", 2 );
   $redis->sadd( "two", 3 );
   $redis->sadd( "two", 4 );
   $redis->sunion( "one", "two" ); # -> [ 1,2,3,4 ]
=for example end
=cut
sub sunion
{
    my ( $self, @keys ) = (@_);
    my %result;
    foreach my $key (@keys)
    {
        my @vals = $self->smembers($key);
        foreach my $val (@vals)
        {
            $result{ $val } += 1;
        }
    }
    return ( CORE::keys(%result) );
}
HideShow 6 lines of Pod
=head2 sunionstore
Store the values which are present in each of the named sets in a new set.
=cut
sub sunionstore
{
    my ( $self, $dest, @keys ) = (@_);
    # Get the union
    my @union = $self->sunion(@keys);
    # Delete the current contents of the destination.
    $self->del($dest);
    # Now store the members
    foreach my $ent (@union)
    {
        $self->sadd( $dest, $ent );
    }
    # Return the number of entries added
    return ( scalar @union );
}
HideShow 20 lines of Pod
=head2 sinter
Return only those members who exist in each of the named sets.
=for example begin
   $redis->sadd( "one", 1 );
   $redis->sadd( "one", 2 );
   $redis->sadd( "one", 3 );
   $redis->sadd( "two", 2 );
   $redis->sadd( "two", 3 );
   $redis->sadd( "two", 4 );
   $redis->sinter( "one", "two" ); # -> [ 2,3 ]
=for example end
=cut
sub sinter
{
    my ( $self, @names ) = (@_);
    my %seen;
    foreach my $key (@names)
    {
        my @vals = $self->smembers($key);
        foreach my $val (@vals)
        {
            $seen{ $val } += 1;
        }
    }
    my @result;
    foreach my $key ( CORE::keys(%seen) )
    {
        if ( $seen{ $key } == scalar @names )
        {
            push( @result, $key );
        }
    }
    return (@result);
}
HideShow 6 lines of Pod
=head2 sinterstore
Store those members who exist in all the named sets in a new set.
=cut
sub sinterstore
{
    my ( $self, $dest, @names ) = (@_);
    # Get the values that intersect
    my @update = $self->sinter(@names);
    # Delete the current contents of the destination.
    $self->del($dest);
    # Now store the members
    foreach my $ent (@update)
    {
        $self->sadd( $dest, $ent );
    }
    # Return the number of entries added
    return ( scalar @update );
}
HideShow 6 lines of Pod
=head2 scard
Count the number of entries in the given set.
=cut
sub scard
{
    my ( $self, $key ) = (@_);
    if ( !$self->{ 'scard' } )
    {
        $self->{ 'scard' } =
          $self->{ 'db' }->prepare("SELECT COUNT(id) FROM sets where key=?");
    }
    $self->{ 'scard' }->execute($key);
    my $count = $self->{ 'scard' }->fetchrow_array() || 0;
    $self->{ 'scard' }->finish();
    return ($count);
}
HideShow 6 lines of Pod
=head2 bitcount
Count the number of set bits in the content of the given key.
=cut
sub bitcount
{
    my ( $self, $key ) = (@_);
    my $val = $self->get($key);
    # Use a lookup-table for each byte.
    my @bitcounts = ( 0, 1, 1, 2, 1, 2, 2, 3, 1, 2, 2, 3, 2, 3, 3, 4, 1, 2,
                      2, 3, 2, 3, 3, 4, 2, 3, 3, 4, 3, 4, 4, 5, 1, 2, 2, 3,
                      2, 3, 3, 4, 2, 3, 3, 4, 3, 4, 4, 5, 2, 3, 3, 4, 3, 4,
                      4, 5, 3, 4, 4, 5, 4, 5, 5, 6, 1, 2, 2, 3, 2, 3, 3, 4,
                      2, 3, 3, 4, 3, 4, 4, 5, 2, 3, 3, 4, 3, 4, 4, 5, 3, 4,
                      4, 5, 4, 5, 5, 6, 2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5,
                      4, 5, 5, 6, 3, 4, 4, 5, 4, 5, 5, 6, 4, 5, 5, 6, 5, 6,
                      6, 7, 1, 2, 2, 3, 2, 3, 3, 4, 2, 3, 3, 4, 3, 4, 4, 5,
                      2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6, 2, 3,
                      3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6, 3, 4, 4, 5,
                      4, 5, 5, 6, 4, 5, 5, 6, 5, 6, 6, 7, 2, 3, 3, 4, 3, 4,
                      4, 5, 3, 4, 4, 5, 4, 5, 5, 6, 3, 4, 4, 5, 4, 5, 5, 6,
                      4, 5, 5, 6, 5, 6, 6, 7, 3, 4, 4, 5, 4, 5, 5, 6, 4, 5,
                      5, 6, 5, 6, 6, 7, 4, 5, 5, 6, 5, 6, 6, 7, 5, 6, 6, 7,
                      6, 7, 7, 8
                    );
    my $sum = 0;
    foreach my $char ( split( //, $val ) )
    {
        $sum += $bitcounts[ord($char)];
    }
    return ($sum);
}
sub setbit
{
    my ( $self, $key, $offset, $value ) = (@_);
    my $val = $self->get($key) || "";
    my $len = length($val)     || 0;
    # Convert to binary.
    my $bin;
    # Convert the current value to binary.
    foreach my $byte ( split( //, $val ) )
    {
        $bin .= unpack( "B*", $byte );
    }
    # Ensure we have a long-enough string.
    while ( $offset >= ( $bin ? length($bin) : 0 ) )
    {
        $bin .= "00000000";
    }
    # Change the bit.
    substr( $bin, $offset, 1, $value );
    my $updated;
    while ( length($bin) )
    {
        my $next = substr( $bin, 0, 8 );
        $bin = substr( $bin, 8 );
        $updated .= pack( "B*", $next );
    }
    $self->set( $key, $updated );
}
sub getbit
{
    my ( $self, $key, $offset ) = (@_);
    my $val = $self->get($key) || "";
    my $len = length($val)     || 0;
    # Convert to binary.
    my $bin;
    # Convert the current value to binary.
    foreach my $byte ( split( //, $val ) )
    {
        $bin .= unpack( "B*", $byte );
    }
    # Ensure we have a long-enough string.
    while ( $offset >= ( $bin ? length($bin) : 0 ) )
    {
        $bin .= "00000000";
    }
    # Get the bit.
    return ( substr( $bin, $offset, 1 ) );
}
HideShow 7 lines of Pod
=head2 ping
This would usually check if the Redis connection was alive, and the
server was present, in this implementation we always return true.
=cut
sub ping
{
    return 1;
}
HideShow 6 lines of Pod
=head2 echo
Return the parameters given.
=cut
sub echo
{
    my ( $self, $arg ) = (@_);
    return ($arg);
}
our $AUTOLOAD;
sub AUTOLOAD
{
    my $command = $AUTOLOAD;
    $command =~ s/.*://;
    warn "NOT IMPLEMENTED:$command";
    return 1;
}
HideShow 7 lines of Pod
=head2 mget
Return the values of multiple-keys.  If a given key doesn't exist
then C<undef> will be returned for that entry.
=cut
sub mget
{
    my ( $self, @keys ) = (@_);
    my @ret;
    foreach my $key (@keys)
    {
        if ( $self->exists($key) )
        {
            push( @ret, $self->get($key) );
        }
        else
        {
            push( @ret, undef );
        }
    }
    return (@ret);
}
HideShow 6 lines of Pod
=head2 mget
Update the values of multiple-keys.
=cut
sub mset
{
    my ( $self, @keys ) = (@_);
    while ( scalar @keys )
    {
        my ( $key, $val ) = splice( @keys, 0, 2 );
        $self->set( $key, $val );
    }
}
HideShow 6 lines of Pod
=head2 mgetnx
Update the values of multiple-keys, only if all the keys don't already exist.
=cut
sub msetnx
{
    my ( $self, @keys ) = (@_);
    my %hash;
    # Update so we can test the keys.
    while ( scalar @keys )
    {
        my ( $key, $val ) = splice( @keys, 0, 2 );
        $hash{ $key } = $val;
    }
    # Does any key already exist?  If so we should do nothing.
    foreach my $key ( CORE::keys %hash )
    {
        return 0 if ( $self->exists($key) );
    }
    foreach my $key ( CORE::keys %hash )
    {
        $self->set( $key, $hash{ $key } );
    }
    return 1;
}
1;
HideShow 8 lines of Pod
=head1 AUTHOR
Steve Kemp
http://www.steve.org.uk/
=cut
HideShow 11 lines of Pod
=head1 LICENSE
Copyright (c) 2016 by Steve Kemp.  All rights reserved.
This module is free software;
you can redistribute it and/or modify it under
the same terms as Perl itself.
The LICENSE file contains the full text of the license.
=cut