summaryrefslogtreecommitdiff
path: root/lib/VNWeb/Tags/Edit.pm
blob: 57e963c004ae67cb80a67ac48e2fba399b37d606 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
package VNWeb::Tags::Edit;

use VNWeb::Prelude;

# TODO: Let users edit their own tag while it's still waiting for approval?

my $FORM = {
    id           => { required => 0, id => 1 },
    name         => { maxlength => 250, regex => qr/^[^,\r\n]+$/ },
    aliases      => { type => 'array', values => { maxlength => 250, regex => qr/^[^,\r\n]+$/ } },
    state        => { uint => 1, range => [0,2] },
    cat          => { enum => \%TAG_CATEGORY, default => 'cont' },
    description  => { maxlength => 10240 },
    searchable   => { anybool => 1, default => 1 },
    applicable   => { anybool => 1, default => 1 },
    defaultspoil => { uint => 1, range => [0,2] },
    parents      => { aoh => {
        id          => { id => 1 },
        name        => { _when => 'out' },
    } },
    # TODO: delete/merge/wipevotes

    addedby      => { _when => 'out' },
    can_mod      => { _when => 'out', anybool => 1 },
};

my $FORM_OUT = form_compile out => $FORM;
my $FORM_IN  = form_compile in  => $FORM;


TUWF::get qr{/$RE{gid}/edit}, sub {
    my $g = tuwf->dbRowi('
        SELECT g.id, g.name, g.description, g.state, g.cat, g.defaultspoil, g.searchable, g.applicable
             , ', sql_user('u', 'addedby_'), '
          FROM tags g
          LEFT JOIN users u ON g.addedby = u.id
         WHERE g.id =', \tuwf->capture('id')
    );
    return tuwf->resNotFound if !$g->{id};

    enrich_flatten aliases => id => tag => 'SELECT tag, alias FROM tags_aliases WHERE tag IN', $g;
    enrich parents => id => tag => 'SELECT gp.tag, g.id, g.name FROM tags_parents gp JOIN tags g ON g.id = gp.parent WHERE gp.tag IN', $g;

    return tuwf->resDenied if !can_edit g => $g;

    $g->{addedby} = xml_string sub { user_ $g, 'addedby_'; };
    $g->{can_mod} = auth->permTagmod;

    framework_ title => "Edit $g->{name}", type => 'g', dbobj => $g, tab => 'edit', sub {
        elm_ TagEdit => $FORM_OUT, $g;
    };
};


TUWF::get qr{/(?:$RE{gid}/add|g/new)}, sub {
    my $id = tuwf->capture('id');
    my $g = tuwf->dbRowi('SELECT id, name, cat FROM tags WHERE id =', \$id);
    return tuwf->resDenied if !can_edit g => {};
    return tuwf->resNotFound if $id && !$g->{id};

    my $e = elm_empty($FORM_OUT);
    $e->{can_mod} = auth->permTagmod;
    if($id) {
        $e->{parents} = [$g];
        $e->{cat} = $g->{cat};
    }

    framework_ title => 'Submit a new tag', sub {
        elm_ TagEdit => $FORM_OUT, $e;
    };
};


elm_api TagEdit => $FORM_OUT, $FORM_IN, sub {
    my($data) = @_;
    my $id = delete $data->{id};
    my $g = !$id ? {} : tuwf->dbRowi('SELECT id, addedby FROM tags WHERE id =', \$id);
    return tuwf->resNotFound if $id && !$g->{id};
    return elm_Unauth if !can_edit g => $g;


    $data->{addedby} = $g->{addedby} // auth->uid;
    if(!auth->permTagmod) {
        $data->{state} = 0;
        $data->{applicable} = $data->{searchable} = 1;
    }

    my $dups = tuwf->dbAlli('
        SELECT id, name
          FROM (SELECT id, name FROM tags UNION SELECT tag, alias FROM tags_aliases) n(id,name)
         WHERE ', sql_and(
             $id ? sql 'id <>', \$id : (),
             sql 'lower(name) IN', [ map lc($_), $data->{name}, $data->{aliases}->@* ]
         )
    );
    return elm_DupNames $dups if @$dups;

    # Make sure parent IDs exists and are not a child tag of the current tag (i.e. don't allow cycles)
    validate_dbid sub {
        'SELECT id FROM tags WHERE', sql_and
            $id ? sql 'id NOT IN(WITH RECURSIVE t(id) AS (SELECT', \$id, '::int UNION SELECT tag FROM tags_parents tp JOIN t ON t.id = tp.parent) SELECT id FROM t)' : (),
            sql 'id IN', $_[0]
    }, map $_->{id}, $data->{parents}->@*;

    my %set = map +($_,$data->{$_}), qw/name description state addedby cat defaultspoil searchable applicable/;
    tuwf->dbExeci('UPDATE tags SET', \%set, 'WHERE id =', \$id) if $id;
    $id = tuwf->dbVali('INSERT INTO tags', \%set, 'RETURNING id') if !$id;

    tuwf->dbExeci('DELETE FROM tags_aliases WHERE tag =', \$id);
    tuwf->dbExeci('INSERT INTO tags_aliases (tag,alias) VALUES(', \$id, ',', \$_, ')') for $data->{aliases}->@*;

    tuwf->dbExeci('DELETE FROM tags_parents WHERE tag =', \$id);
    tuwf->dbExeci('INSERT INTO tags_parents (tag,parent) VALUES(', \$id, ',', \$_->{id}, ')') for $data->{parents}->@*;

    elm_Redirect "/g$id";
};

1;