view release on metacpan or  search on metacpan

lib/Pg/Priv.pm  view on Meta::CPAN

package Pg::Priv;

use 5.8.0;
use strict;
use warnings;

our $VERSION = '0.12';

my %label_for = (
    r => 'SELECT',
    w => 'UPDATE',
    a => 'INSERT',
    d => 'DELETE',
    D => 'TRUNCATE',
    x => 'REFERENCE',
    t => 'TRIGGER',
    X => 'EXECUTE',
    U => 'USAGE',
    C => 'CREATE',
    c => 'CONNECT',
    T => 'TEMPORARY',
);

my %priv_for = map { $label_for{$_} => $_ } keys %label_for;

# Some aliases.
$priv_for{TEMP} = 'T';

sub parse_acl {
    my ($class, $acl, $quote) = @_;
    return unless $acl;

    my @privs;
    my $prev;
    for my $perms (@{ $acl }) {
        # http://www.postgresql.org/docs/current/static/sql-grant.html#SQL-GRANT-NOTES
        my ($role, $privs, $by) = $perms =~ m{^"?(?:(?:group\s+)?([^=]+))?=([^/]+)/(.*)};
        $prev = $privs eq '*' ? $prev : $privs;
        $role ||= 'public';
        push @privs, $class->new(
            to    => $quote ? _quote_ident($role) : $role,
            by    => $quote ? _quote_ident($by)   : $by,
            privs => $prev,
        )
    }
    return wantarray ? @privs : \@privs;
}

sub new {
    my $class = shift;
    my $self = bless { @_ } => $class;
    $self->{parsed} = { map { $_ => 1 } split //, $self->{privs} || '' };
    return $self;
}

sub to    { shift->{to}  }
sub by    { shift->{by}    }
sub privs { shift->{privs} }
sub labels {
    wantarray ? map { $label_for{$_} } keys %{ shift->{parsed} }
              : [ map { $label_for{$_} } keys %{ shift->{parsed} } ];
}
sub can   {
    my $can = shift->{parsed} or return;
    for my $what (@_) {
        return unless $can->{ length $what == 1 ? $what : $priv_for{uc $what} };
    }
    return 1;
}

sub can_select    { shift->can('r') }
sub can_read      { shift->can('r') }
sub can_update    { shift->can('w') }
sub can_write     { shift->can('w') }
sub can_insert    { shift->can('a') }
sub can_append    { shift->can('a') }
sub can_delete    { shift->can('d') }
sub can_reference { shift->can('x') }
sub can_trigger   { shift->can('t') }
sub can_execute   { shift->can('X') }
sub can_usage     { shift->can('U') }
sub can_create    { shift->can('C') }
sub can_connect   { shift->can('c') }
sub can_temporary { shift->can('T') }
sub can_temp      { shift->can('T') }

# ack ' RESERVED_KEYWORD' src/include/parser/kwlist.h | awk -F '"' '{ print "    " $2 }'
my %reserved = ( map { $_ => undef } qw(
    all
    analyse
    analyze
    and
    any
    array
    as
    asc
    asymmetric
    both
    case
    cast
    check
    collate
    column
    constraint
    create
    current_catalog
    current_date
    current_role
    current_time
    current_timestamp
    current_user