view release on metacpan or  search on metacpan

lib/Labyrinth/Plugin/CPAN/Preferences.pm  view on Meta::CPAN

        if(ref($opts) eq 'ARRAY') {
            %opts = map {$_ => 1} @$opts;
        } elsif($opts =~ /,/) {
            %opts = map {$_ => 1} split(/,/,$opts);
        } elsif($opts) {
            %opts = ("$opts" => 1);
        }
    }

    my %hash = ( name => $name );
    for(@items) {
        push @{$hash{options}}, { index    => $_,
                                  value    => $_,
                                  selected => (defined $opts && $opts{$_} ? 1 : 0)};
    }

    return \%hash;
}

sub XDropDownMultiRows {
    my ($opts,$name,$index,$value,$count,@items) = @_;
    my %opts;

    if(defined $opts) {
        if(ref($opts) eq 'ARRAY') {
            %opts = map {$_ => 1} @$opts;
        } elsif($opts =~ /,/) {
            %opts = map {$_ => 1} split(/,/,$opts);
        } elsif($opts) {
            %opts = ("$opts" => 1);
        }
    }

    my %hash = ( name => $name );
    for(@items) {
        push @{$hash{options}}, { index    => $_->{$index},
                                  value    => $_->{$value},
                                  selected => (defined $opts && $opts{$_->{$index}} ? 1 : 0)};
    }

    return \%hash;
}


sub DefSave {
    return  unless RealmCheck('author','admin');

    for(keys %pref_fields) {
           if($pref_fields{$_}->{html} == 1) { $cgiparams{$_} = CleanHTML($cgiparams{$_}) }
        elsif($pref_fields{$_}->{html} == 2) { $cgiparams{$_} = CleanTags($cgiparams{$_}) }
        elsif($pref_fields{$_}->{html} == 3) { $cgiparams{$_} = CleanLink($cgiparams{$_}) }
    }

    return  if FieldCheck(\@pref_all,\@pref_man);

    my $author = $tvars{user}{author} || $tvars{user}{name};

    # change reporting activity
    $dbi->DoQuery('UpdateAuthorActive',$tvars{data}{active},$author);

    _save_distprefs($author,'-');
}

sub DistSave {
    return  unless RealmCheck('author','admin');

    for(keys %pref_fields) {
           if($pref_fields{$_}->{html} == 1) { $cgiparams{$_} = CleanHTML($cgiparams{$_}) }
        elsif($pref_fields{$_}->{html} == 2) { $cgiparams{$_} = CleanTags($cgiparams{$_}) }
        elsif($pref_fields{$_}->{html} == 3) { $cgiparams{$_} = CleanLink($cgiparams{$_}) }
    }

    return  if FieldCheck(\@pref_all,\@pref_man);

    my $author  = $tvars{user}{author} || $tvars{user}{name};

    _save_distprefs($author,$tvars{data}{dist});
}

sub _save_distprefs {
    my ($author,$dist) = @_;
    my @fields;

    $tvars{data}{patches} = $tvars{data}{patches} ? 1 : 0;

    # save default settings
    for(qw(grade versions perls platforms)) {
        my @array = CGIArray($_);
        #LogDebug("$_ => @array");
        $tvars{data}{$_} = join(',',@array);
        #LogDebug("tvars($_) => $tvars{data}{$_}");
    }
    for(qw(version perl platform)) {
        next    if($tvars{data}{$_} eq 'ALL');
        next    if($tvars{data}{$_} eq 'LATEST');   # only applicable to version
        next    unless($tvars{data}{$_ . 's'});
        $tvars{data}{$_} .= ',' . $tvars{data}{$_ . 's'};
    }
    push @fields, $tvars{data}{$_}   for(qw(ignored report grade tuple version patches perl platform));

    my @rows = $dbi->GetQuery('hash','GetAuthorDistro',$author,$dist);
    if(@rows)   { $dbi->DoQuery('UpdateDistroPrefs',@fields, $author, $dist) }
    else        { $dbi->DoQuery('InsertDistroPrefs',@fields, $author, $dist) }

    $tvars{thanks} = 1;
}

sub Delete {
    return  unless RealmCheck('author','admin');

    my $author  = $tvars{user}{author} || $tvars{user}{name};
    my $dist    = $cgiparams{dist};

    my @rows = $dbi->GetQuery('hash','GetAuthorDistro',$author,$dist);
    $dbi->DoQuery('DeleteDistroPrefs', $author, $dist)  if(@rows);
}

=head2 Admin Interface Methods

=over 4

=item Admin

Prepare Admin login as author.

=item Imposter

Allow Admin to login as named author.

=item Clear

Clear imposter status and return to Admin.

=back

=cut

sub Admin  {
    return  unless RealmCheck('admin');
    $tvars{where} = "AND u.realm='author' AND u.userid > 3";