232 lines
8.6 KiB
Perl
232 lines
8.6 KiB
Perl
|
#!/usr/bin/perl
|
||
|
|
#
|
||
|
|
# DW::User::Edges
|
||
|
|
#
|
||
|
|
# This module defines relationships between accounts. It allows for finding
|
||
|
|
# edges, defining edges, removing edges, and other tasks related to the edges
|
||
|
|
# that can exist between accounts. Methods are added to the LJ::User/DW::User
|
||
|
|
# classes as appropriate.
|
||
|
|
#
|
||
|
|
# Authors:
|
||
|
|
# Mark Smith <mark@dreamwidth.org>
|
||
|
|
#
|
||
|
|
# Copyright (c) 2008 by Dreamwidth Studios, LLC.
|
||
|
|
#
|
||
|
|
# This program is free software; you may redistribute it and/or modify it under
|
||
|
|
# the same terms as Perl itself. For a copy of the license, please reference
|
||
|
|
# 'perldoc perlartistic' or 'perldoc perlgpl'.
|
||
|
|
#
|
||
|
|
|
||
|
|
###############################################################################
|
||
|
|
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
|
||
|
|
###############################################################################
|
||
|
|
|
||
|
|
package DW::User::Edges;
|
||
|
|
use strict;
|
||
|
|
|
||
|
|
# FYI - including edges is done at the end of this file. scroll down to the
|
||
|
|
# comment denoted 'XXX'.
|
||
|
|
|
||
|
|
# overall list of edges that are valid, if it's not in this list (and not one
|
||
|
|
# of the special edges like 'all') then we don't know how to deal with it
|
||
|
|
our %VALID_EDGES;
|
||
|
|
|
||
|
|
# defines a new edge in the valid list above. this function is assumed to be
|
||
|
|
# called at startup, so we are safe using 'die' for any error conditions, as
|
||
|
|
# we WANT to prevent site startup.
|
||
|
|
sub define_edge {
|
||
|
|
my ( $name, $opts ) = @_;
|
||
|
|
|
||
|
|
die "Attempt to define edge with bad name: $name.\n"
|
||
|
|
unless $name =~ /^[\w\d-]+$/;
|
||
|
|
die "Attempt to re-define edge $name.\n"
|
||
|
|
if exists $VALID_EDGES{$name} && !$LJ::IS_DEV_SERVER;
|
||
|
|
die "Defined edge $name contains no type.\n"
|
||
|
|
unless $opts->{type};
|
||
|
|
die "Defined edge $name contains invalid type: $opts->{type}.\n"
|
||
|
|
unless $opts->{type} =~ /^(?:int|bool|hashref)$/;
|
||
|
|
die "Defined edge $name contains invalid db_edge: $opts->{db_edge}.\n"
|
||
|
|
if exists $opts->{db_edge} && $opts->{db_edge} !~ /^\w$/;
|
||
|
|
|
||
|
|
if ( my $hr = $opts->{options} ) {
|
||
|
|
die "Defined edge $name options not a hashref.\n"
|
||
|
|
unless ref $hr && ref $hr eq 'HASH';
|
||
|
|
die "Edge $name must have type 'hashref'.\n"
|
||
|
|
unless $opts->{type} && $opts->{type} eq 'hashref';
|
||
|
|
|
||
|
|
foreach my $opt ( keys %$hr ) {
|
||
|
|
die "Defined edge $name has invalid option name: $opt.\n"
|
||
|
|
unless $opt =~ /^[\w\d-]+$/;
|
||
|
|
die "Defined edge $name option $opt is not a hashref.\n"
|
||
|
|
unless $hr->{$opt} && ref $hr->{$opt} eq 'HASH';
|
||
|
|
die "Defined edge $name option $opt has invalid type: $hr->{$opt}->{type}.\n"
|
||
|
|
unless $hr->{$opt}->{type} && $hr->{$opt}->{type} =~ /^(?:int|bool)$/;
|
||
|
|
|
||
|
|
# by default, not required, fill that in if they didn't specify it
|
||
|
|
$hr->{$opt}->{required} ||= 0;
|
||
|
|
die "Defined edge $name option $opt value 'required' must be 0 or 1.\n"
|
||
|
|
unless $hr->{$opt}->{required} =~ /^(?:0|1)$/;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
foreach (qw/ add_sub del_sub /) {
|
||
|
|
die "Defined edge $name does not define $_.\n"
|
||
|
|
unless $opts->{$_};
|
||
|
|
die "Defined edge $name not given a code reference for $_.\n"
|
||
|
|
if ref $opts->{$_} ne 'CODE';
|
||
|
|
}
|
||
|
|
|
||
|
|
$VALID_EDGES{$name} = $opts;
|
||
|
|
}
|
||
|
|
|
||
|
|
# takes as input a hashref of items to be validated and makes sure that the
|
||
|
|
# inputs are valid according to what we know about the defined edges
|
||
|
|
sub validate_edges {
|
||
|
|
my $edges = $_[0];
|
||
|
|
|
||
|
|
# error stuff
|
||
|
|
my $err = sub {
|
||
|
|
warn "validate_edges: " . shift() . "\n";
|
||
|
|
return 0;
|
||
|
|
};
|
||
|
|
return $err->('Invalid parameter')
|
||
|
|
unless ref $edges eq 'ARRAY' || ref $edges eq 'HASH';
|
||
|
|
|
||
|
|
# iterate over each edge in the hash and validate
|
||
|
|
my @iter = ref $edges eq 'HASH' ? keys %$edges : @$edges;
|
||
|
|
foreach my $edge (@iter) {
|
||
|
|
|
||
|
|
# if it's not in valid edges, it's bunk
|
||
|
|
my $er = $VALID_EDGES{$edge};
|
||
|
|
return $err->("Edge '$edge' unknown.") unless $er;
|
||
|
|
|
||
|
|
# at this point, if they gave us an array of items to check (as opposed to a hash) then we
|
||
|
|
# assume it's good. the array behavior is used in cases where they are deleting edges and
|
||
|
|
# only know the name of the edge.
|
||
|
|
next if ref $edges eq 'ARRAY';
|
||
|
|
|
||
|
|
# type assurance
|
||
|
|
return $err->("Edge $edge of type bool with invalid value [$edges->{$edge}].")
|
||
|
|
if $er->{type} eq 'bool' && $edges->{$edge} !~ /^(?:0|1)$/;
|
||
|
|
return $err->("Edge $edge of type int with invalid value [$edges->{$edge}].")
|
||
|
|
if $er->{type} eq 'int' && $edges->{$edge} !~ /^\d+$/;
|
||
|
|
|
||
|
|
# if it's a hashref/subopt/complex type, check the options
|
||
|
|
if ( $er->{type} eq 'hashref' ) {
|
||
|
|
return $err->("Edge $edge of type hashref with invalid value.")
|
||
|
|
unless ref $edges->{$edge} eq 'HASH';
|
||
|
|
|
||
|
|
## FIXME: we don't assert all of the 'required' options are passed yet
|
||
|
|
|
||
|
|
my $opts = $er->{options};
|
||
|
|
foreach my $opt ( keys %$opts ) {
|
||
|
|
|
||
|
|
# set default if we've been given one
|
||
|
|
$edges->{$edge}->{$opt} = $opts->{$opt}->{default}
|
||
|
|
if !exists $edges->{$edge}->{$opt}
|
||
|
|
&& exists $opts->{$opt}->{default};
|
||
|
|
|
||
|
|
# skip the edge if they didn't provide and it's not required
|
||
|
|
next
|
||
|
|
unless exists $edges->{$edge}->{$opt}
|
||
|
|
|| $opts->{$opt}->{required};
|
||
|
|
|
||
|
|
# now error check
|
||
|
|
return $err->(
|
||
|
|
"Edge $edge option $opt of type bool with invalid value [$edges->{$edge}->{$opt}]."
|
||
|
|
) if $opts->{$opt}->{type} eq 'bool' && $edges->{$edge}->{$opt} !~ /^(?:0|1)$/;
|
||
|
|
return $err->(
|
||
|
|
"Edge $edge option $opt of type int with invalid value [$edges->{$edge}->{$opt}]."
|
||
|
|
) if $opts->{$opt}->{type} eq 'int' && $edges->{$edge}->{$opt} !~ /^\d+$/;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
# should be valid at this point
|
||
|
|
return 1;
|
||
|
|
}
|
||
|
|
|
||
|
|
# XXX: add new edge modules that are global here
|
||
|
|
use DW::User::Edges::WatchTrust;
|
||
|
|
use DW::User::Edges::CommMembership;
|
||
|
|
|
||
|
|
###############################################################################
|
||
|
|
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
|
||
|
|
###############################################################################
|
||
|
|
|
||
|
|
# for now, we push our methods into the DW::User namespace
|
||
|
|
package DW::User;
|
||
|
|
use strict;
|
||
|
|
|
||
|
|
# adds edges between one user and another
|
||
|
|
sub add_edge {
|
||
|
|
my ( $from_u, $to_u, %edges ) = @_;
|
||
|
|
|
||
|
|
# need u objects
|
||
|
|
$from_u = LJ::want_user($from_u);
|
||
|
|
$to_u = LJ::want_user($to_u);
|
||
|
|
|
||
|
|
# error check inputs
|
||
|
|
return 0 unless $from_u && $to_u;
|
||
|
|
return 0 unless DW::User::Edges::validate_edges( \%edges );
|
||
|
|
|
||
|
|
# now we try to add these edges. note that we do this in this way so that
|
||
|
|
# multiple edges can be consumed by one add sub.
|
||
|
|
my @to_add = keys %edges;
|
||
|
|
my $ok = 1;
|
||
|
|
while ( my $key = shift @to_add ) {
|
||
|
|
|
||
|
|
# some modules will define multiple edges, and so one call to add_sub might
|
||
|
|
# get rid of more than one edge, so we have to do this check to ensure that
|
||
|
|
# the edge still exists
|
||
|
|
next unless $edges{$key};
|
||
|
|
|
||
|
|
# simply calls an add_sub to handle the edge. we expect them to remove the
|
||
|
|
# edge from the hashref if they process it.
|
||
|
|
my $success = $DW::User::Edges::VALID_EDGES{$key}->{add_sub}->( $from_u, $to_u, \%edges );
|
||
|
|
$ok &&= $success; # will zero out if any edges fail
|
||
|
|
}
|
||
|
|
|
||
|
|
# all good
|
||
|
|
return $ok;
|
||
|
|
}
|
||
|
|
|
||
|
|
# removes an edge between two users
|
||
|
|
sub remove_edge {
|
||
|
|
my ( $from_u, $to_u, %edges ) = @_;
|
||
|
|
|
||
|
|
# need u objects
|
||
|
|
$from_u = LJ::want_user($from_u);
|
||
|
|
$to_u = LJ::want_user($to_u);
|
||
|
|
|
||
|
|
# error check inputs
|
||
|
|
return 0 unless $from_u && $to_u;
|
||
|
|
return 0 unless DW::User::Edges::validate_edges( \%edges );
|
||
|
|
|
||
|
|
# now we try to remove these edges. note that we do this in this way so that
|
||
|
|
# multiple edges can be consumed by one remove sub.
|
||
|
|
my @to_del = keys %edges;
|
||
|
|
my $ok = 1;
|
||
|
|
while ( my $key = shift @to_del ) {
|
||
|
|
|
||
|
|
# some modules will define multiple edges, and so one call to add_sub might
|
||
|
|
# get rid of more than one edge, so we have to do this check to ensure that
|
||
|
|
# the edge still exists
|
||
|
|
next unless $edges{$key};
|
||
|
|
|
||
|
|
# simply calls an add_sub to handle the edge. we expect them to remove the
|
||
|
|
# edge from the hashref if they process it.
|
||
|
|
my $success = $DW::User::Edges::VALID_EDGES{$key}->{del_sub}->( $from_u, $to_u, \%edges );
|
||
|
|
$ok &&= $success; # will zero out if any edges fail
|
||
|
|
}
|
||
|
|
|
||
|
|
# all good
|
||
|
|
return $ok;
|
||
|
|
}
|
||
|
|
|
||
|
|
# and now we link these into the LJ::User namespace for backwards compatibility
|
||
|
|
*LJ::User::add_edge = \&add_edge;
|
||
|
|
*LJ::User::remove_edge = \&remove_edge;
|
||
|
|
|
||
|
|
1;
|