PAUSE is closed for maintainance for about <%= $closed->{will_last} %>. Estimated time of opening is in <%= $closed->{delta} %>.
Sorry for the inconvenience and Thanks for your patience.
diff --git a/lib/pause_2025/templates/_debug.html.ep b/lib/pause_2025/templates/_debug.html.ep new file mode 100644 index 000000000..6d665966c --- /dev/null +++ b/lib/pause_2025/templates/_debug.html.ep @@ -0,0 +1,285 @@ +%# stolen from Mojolicious' default debug template +% unless ($ENV{TEST_PAUSE_WEB}) { + + +
+ % my $kv = begin
+ % my ($key, $value) = @_;
+
+ <%= $key %>:
+
+ % end
+ % if (my $exception = stash 'exception') {
+
+ % my $cv = begin
+ % my ($key, $value, $i) = @_;
+ %= tag 'tr', $i ? (class => 'important') : (), begin
+ <%= $key %>
+
+
+ % end
+ % end
+
+% }
\ No newline at end of file
diff --git a/lib/pause_2025/templates/_user_menu.html.ep b/lib/pause_2025/templates/_user_menu.html.ep
new file mode 100644
index 000000000..6331d6f14
--- /dev/null
+++ b/lib/pause_2025/templates/_user_menu.html.ep
@@ -0,0 +1,47 @@
+% my $pause = stash(".pause") || {};
+% my $user = $pause->{User} || {};
+% my $user_groups = $pause->{UserGroups} || {};
+% my $session = $c->session || {};
+% my $logged_in = $session->{user} ? 1 : 0;
+% my @offer_groups = app->pause->config->public_groups;
+% $pause->{Action} ||= "menu";
+% if (%$user) {
+% unshift @offer_groups, "user";
+% for my $group (app->pause->config->extra_groups) {
+% push @offer_groups, $group if exists $user_groups->{$group} || exists $user_groups->{admin};
+% }
+% }
+
diff --git a/lib/pause_2025/templates/_user_status.html.ep b/lib/pause_2025/templates/_user_status.html.ep
new file mode 100644
index 000000000..fb0148f20
--- /dev/null
+++ b/lib/pause_2025/templates/_user_status.html.ep
@@ -0,0 +1,23 @@
+% my $pause = stash(".pause") || {};
+% my $session = $c->session || {};
+% my $remote_user = $session->{user};
+% if ($remote_user and $remote_user ne "-") {
+ % my $user = $pause->{User};
+ % my $status_class = $pause->{is_ssl} ? "statusencr" : "statusunencr";
+ % my $email = $user->{secretemail} || $user->{email} || "No email???";
+ % my $hidden_user = $pause->{HiddenUser};
+ % my $hidden_user_email = $hidden_user->{secretemail} || $hidden_user->{email} || "No email???";
+ <%= $value %>
<%= $value %>
+
+ <%= $exception->message %>+
+
+ % for my $line (@{$exception->lines_before}) {
+ %= $cv->($line->[0], $line->[1])
+ % }
+ % if (defined $exception->line->[1]) {
+ %= $cv->($exception->line->[0], $exception->line->[1], 1)
+ % }
+ % for my $line (@{$exception->lines_after}) {
+ %= $cv->($line->[0], $line->[1])
+ % }
+
+
+ % if (defined $exception->line->[2]) {
+
+
+ % for my $line (@{$exception->lines_before}) {
+ %= $cv->($line->[0], $line->[2])
+ % }
+ %= $cv->($exception->line->[0], $exception->line->[2], 1)
+ % for my $line (@{$exception->lines_after}) {
+ %= $cv->($line->[0], $line->[2])
+ % }
+
+
+ tap for more
+
+ % }
+
+ % if (@{$exception->frames}) {
+
+ % }
+ % else {
+%if (0) {
+
+
+ % for my $frame (@{$exception->frames}) {
+
+
+ % }
+
+ <%= $frame->[1] . ':' . $frame->[2] %>+ |
+
+ % my $walk = begin
+ % my ($walk, $route, $depth) = @_;
+
+
+ % my $pattern = $route->pattern->unparsed || '/';
+ % $pattern = "+$pattern" if $depth;
+
+
+
+
+ % my $name = $route->name;
+
+
+ % $depth++;
+ %= $walk->($walk, $_, $depth) for @{$route->children};
+ % $depth--;
+ % end
+
+
+
+
+%}
+ % }
+ <%= ' ' x $depth %><%= $pattern %>+
<%= uc(join ',', @{$route->via || []}) || '*' %>
+ <%= $route->has_custom_name ? qq{"$name"} : $name %>
+ | Pattern | +Methods | +Name | +
|---|
+
+ % my $req = $c->req;
+ %= $kv->(Method => $req->method)
+ % my $url = $req->url;
+ %= $kv->(URL => $url->to_string)
+ %= $kv->('Base URL' => $url->base->to_string)
+ %= $kv->(Parameters => dumper $req->params->to_hash)
+ %= $kv->(Stash => dumper $c->stash)
+ %= $kv->(Session => dumper session)
+ %= $kv->(Version => $req->version)
+ % for my $name (sort @{$c->req->headers->names}) {
+ % my $value = $c->req->headers->header($name);
+ %= $kv->($name, $value)
+ % }
+ %= $kv->(Env => dumper $req->env)
+ %= $kv->(UserInfo => dumper $req->url->userinfo)
+
+
+% if (0) {
+
+
+% }
+% if (0) {
+ % if (@{app->log->history}) {
+
+
+ %= $kv->(Perl => "$^V ($^O)")
+ % my $version = $Mojolicious::VERSION;
+ % my $codename = $Mojolicious::CODENAME;
+ %= $kv->(Mojolicious => "$version ($codename)")
+ %= $kv->(Home => app->home)
+ %= $kv->('Template paths' => dumper app->renderer->paths)
+ %= $kv->('Template classes' => dumper app->renderer->classes)
+ %= $kv->('Static paths' => dumper app->static->paths)
+ %= $kv->('Static classes' => dumper app->static->classes)
+ %= $kv->(Include => dumper \@INC)
+ %= $kv->(Config => dumper app->config)
+ %= $kv->(Moniker => app->moniker)
+ %= $kv->(Name => $0)
+ %= $kv->(Executable => $^X)
+ %= $kv->(PID => $$)
+ %= $kv->(Time => scalar localtime(time))
+
+
+
+
+ % for my $msg (@{app->log->history}) {
+
+
+ % }
+% }
+
+ <%= app->log->format->(@$msg) %>+ |
+
+ <%= $remote_user %> <<%= $email %>>
+ % if ($hidden_user and $user and $hidden_user->{userid} and $user->{userid} and $hidden_user->{userid} ne $user->{userid}) { + acting as <%= $hidden_user->{userid} %> <<%= $hidden_user_email %>>
+ % } + + % if ($pause->{is_ssl}) { + encrypted session + % } else { + unencrypted session + % } + +
+% }
diff --git a/lib/pause_2025/templates/admin/change_user_status.html.ep b/lib/pause_2025/templates/admin/change_user_status.html.ep
new file mode 100644
index 000000000..36d51f0bd
--- /dev/null
+++ b/lib/pause_2025/templates/admin/change_user_status.html.ep
@@ -0,0 +1,19 @@
+% layout 'layout';
+% my $pause = stash(".pause") || {};
+
+
+
+% if ($pause->{user_not_found}) {
+
+% } elsif ($pause->{changed}) {
+
+% }
+
+%= csrf_field
+%= text_field "pause99_change_user_status_user" => $pause->{user};
+%= select_field "pause99_change_user_status_new_ustatus" => ['nologin', 'active'];
+%= submit_button "Change", name => "pause99_change_user_status_sub";
diff --git a/lib/pause_2025/templates/admin/edit_ml.html.ep b/lib/pause_2025/templates/admin/edit_ml.html.ep
new file mode 100644
index 000000000..c445e33aa
--- /dev/null
+++ b/lib/pause_2025/templates/admin/edit_ml.html.ep
@@ -0,0 +1,74 @@
+% layout 'layout';
+% my $pause = stash(".pause") || {};
+
+Excerpt from a mail:+ % if ($hidden_user and $user and $hidden_user->{userid} and $user->{userid} and $hidden_user->{userid} ne $user->{userid}) { + acting as <%= $hidden_user->{userid} %> <<%= $hidden_user_email %>>
+ % } + + % if ($pause->{is_ssl}) { + encrypted session + % } else { + unencrypted session + % } + +
+ + From: andreas.koenig@anima.de (Andreas J. Koenig) + To: kstar@chapin.edu + Subject: Re: [elagache@ipn.caida.org: No email found for CAIDA? (Re: Missing CAIDA password?)] + Date: 02 Nov 2000 17:59:28 +0100 + + A mailing list occupies the same namespace as users because we do + not want that users and mailing lists get confused. But a mailing + list does not have a password and does not have a directory of its + own. Only people can upload and occupy a directory and have a + password. (It's clear that the user namespace is not related to the + modules namespace, right?) + + The Module List may list a mailinglist as "the contact", so the + field userid in the table mods identifies either a mailing list or + a user. This has been useful in the past when several clueful + people represent several related modules and use a common mailing + list as the contact. + + The table list2user maps mailing lists to their owners so that the + owners can edit the data associated with the mailing list like + address and comment. The table list2user does not have a web + interface because we are not really established as the primary + source for mailing list information and so it has not been used + much. But I'm open to offer one if you believe it's useful. + [...] ++ + + +<%= select_field "pause99_edit_ml_3" => $pause->{mls}, + size => (@{$pause->{mls}} > 18 ? 15 : scalar @{$pause->{mls}}), +=%> +
+
+% if (%{$pause->{selected} || {}}) { +
Record for <%= $pause->{selected}{maillistid} %>
+ +The name of the mailing list
+The name appears in the CPAN authors list, so it is good if the name contains the term mailing list or something equivalent
+<%= text_field pause99_edit_ml_maillistname => $pause->{selected}{maillistname}, + size => 50, + maxsize => 64, +=%> ++ +
The address of the mailing list
+This is the address where people post to (where all members of the group can be contacted)
+<%= text_field pause99_edit_ml_address => $pause->{selected}{address}, + size => 50, +=%> ++ +
How to subscribe
+This is a text that describes how to join the mailing list. E.g. the mailing list subscribe address or a URL with more details.
+<%= text_area pause99_edit_ml_subscribe => $pause->{selected}{subscribe}, + rows => 5, + cols => 60, +=%> ++ +
+% if ($pause->{changed}) { +
The record has been updated in the database
+% } elsif ($pause->{updated_sel}) { +It seems to me the record was NOT updated. Maybe +nothing changed? Please take a closer look and inform an admin if +things didn't proceed as expected.
+% } +% } diff --git a/lib/pause_2025/templates/admin/email_for_admin.html.ep b/lib/pause_2025/templates/admin/email_for_admin.html.ep new file mode 100644 index 000000000..1562ca147 --- /dev/null +++ b/lib/pause_2025/templates/admin/email_for_admin.html.ep @@ -0,0 +1,35 @@ +% layout 'layout'; +% my $pause = stash(".pause") || {}; + +Query a combination of usertable table and user for public or private emails according to the preferences
+
+
+
+
+
+
+
+% content_for javascript => begin
+%= javascript "/pause/list.min.js"
+%= javascript begin
+var List = new List('emails', {
+ valueNames: ['userid', 'email']
+});
+% end
+% end
diff --git a/lib/pause_2025/templates/admin/manage_id/manage.html.ep b/lib/pause_2025/templates/admin/manage_id/manage.html.ep
new file mode 100644
index 000000000..717651465
--- /dev/null
+++ b/lib/pause_2025/templates/admin/manage_id/manage.html.ep
@@ -0,0 +1,54 @@
+% layout 'layout';
+% my $pause = stash(".pause") || {};
+% my %ALL = %{$pause->{all} || {}};
+% my $json_encoder = JSON::XS->new->indent->canonical;
+
+| id | +id@cpan.org gets forwarded to | +
|---|---|
| <%= $_->{id} %> | +<%= $_->{mail} %> | +
View all pending applications for new user IDs and for modules registrations
+ +
+
+
+
+
+
+% content_for javascript => begin
+%= javascript "/pause/list.min.js"
+%= javascript begin
+var requestList = new List('requests', {valueNames: ['type', 'userid', 'session']});
+% end
+% end
diff --git a/lib/pause_2025/templates/admin/select_user.html.ep b/lib/pause_2025/templates/admin/select_user.html.ep
new file mode 100644
index 000000000..2fbe46f90
--- /dev/null
+++ b/lib/pause_2025/templates/admin/select_user.html.ep
@@ -0,0 +1,16 @@
+% layout 'layout';
+% my $pause = stash(".pause") || {};
+
+<%= select_field "HIDDENNAME" => $pause->{hidden_name_list},
+ size => 10,
+=%>
+
+| Type | +Userid | +Time | +Raw Session | +Actions | +
|---|---|---|---|---|
| <%= $ALL{$k}{type} %> | +<%= $ALL{$k}{session}{APPLY}{userid} %> | +<%= POSIX::strftime("%FT%TZ", gmtime $ALL{$k}{mtime}) %> | +<%= do {
+ my $json = $json_encoder->encode($ALL{$k}{session});
+ $json =~ s/\\n/\n/g;
+ $json;
+ } %> |
+
+ $ALL{$k}{session}{_session_id},
+ (exists $ALL{$k}{session}{APPLY}{fullname} ? "SUBMIT_pause99_add_user_sub" : "SUBMIT_pause99_add_mod_preview") => 1
+ ) %>">Go To Registration
+ + "delete", + USERID => $ALL{$k}{session}{_session_id}, + ) %>">Delete Registration + |
+
+ +<%= select_field "ACTIONREQ" => $pause->{action_req_list}, + size => 13, +=%> + +
+ + diff --git a/lib/pause_2025/templates/admin/user/add.html.ep b/lib/pause_2025/templates/admin/user/add.html.ep new file mode 100644 index 000000000..6cfef7230 --- /dev/null +++ b/lib/pause_2025/templates/admin/user/add.html.ep @@ -0,0 +1,202 @@ +% layout 'layout'; +% my $pause = stash(".pause") || {}; + +% if (param("pause99_add_user_userid")) { +% unless (@{$pause->{error} || []}) { +% if (my @urows = @{$pause->{urows} || []}) { # Soundex found something + +
Not submitting <%= $pause->{userid} %>, maybe we have a duplicate here
+<%= $pause->{s_package} %> converted the fullname [<%= $pause->{fullname} %>] to [<%= $pause->{s_code} %>]
+| userid | +fullname | +(public) email | +other | +||||||
| <%= $row->{userid} %> | +% } elsif ($row->{userid}) { +<%= $row->{userid} %> | +% } else { ++% } + +% if ($row->{same_fullname}) { + | <%= $row->{fullname} %> | +% } elsif ($row->{surname}) { +<%= $row->{before_surname} %><%= $row->{surname} %><%= $row->{after_surname} %> | +% } elsif ($row->{fullname}) { +<%= $row->{fullname} %> | +% } else { ++% } + +% if ($row->{same_email}) { + | <%= $row->{email_parts}[0] %> @<%= $row->{email_parts}[1] %> |
+% } else {
+<%= $row->{email_parts}[0] %> @<%= $row->{email_parts}[1] %> |
+% }
+
+
+% if ($row->{same_secretemail}) {
+secret email: <%= $row->{secretemail} %> +% } elsif ($row->{secretemail}) { +secret email: <%= $row->{secret_email} %> +% } + +% if ($row->{same_homepage}) { +homepage: <%= $row->{homepage} %> +% } elsif ($row->{homepage}) { +homepage: <%= $row->{homepage} %> +% } + +% if ($row->{introduced}) { +% my $time = $row->{introduced}; +% $time =~ s/\s/\ /g; +introduced on: <%== $time %> +% } + +% if ($row->{changed}) { +% my $time = $row->{changed}; +% $time =~ s/\s/\ /g; +changed on: <%== $time %> by <%= $row->{changedby} %> +% } else { +changed by <%= $row->{changedby} %> +% } + |
+
Submitting query
+New user creation succeeded.
+ +% if ($pause->{subscribe}) { # mailing list +Mailing list entered by <%= $pause->{User}{fullname} %>:
+Userid: <%= $pause->{userid} %>
+Name: <%= $pause->{maillistname} %>
+Description: <%= $pause->{subscribe} %>
+% } else { # new user + +Sending separate mails to: <%= $pause->{send_to} %> +
+From: <%= $PAUSE::Config->{UPLOAD} %>
+Subject: <%= $pause->{subject} %>
+
+<%= $pause->{blurb} %>
+
+% }
+% } else {
+Query [<%= $pause->{query} %>] failed. Reason:
<%= $pause->{query_error} %>
+ +% } + +Content of user record in table users:+% if ($pause->{usertable}) { +
| <%= $_ %> | <%= $pause->{usertable}{$_} || b(" ") %> |
Error processing form
+% for my $error (@errors) { +- +% if ($error->{invalid}) { +userid[<%= $pause->{userid} %>] does not match +<%= $c->app->pause->config->valid_userid %>. +% } elsif ($error->{no_fullname}) { +No fullname, nothing done. +% } +
Please retry.
+% } +% } + +Add a user or mailinglist
+ +<%= submit_button " Insert with soundex care ", + name => "SUBMIT_pause99_add_user_Soundex", +=%> +<%= submit_button " Insert with metaphone care ", + name => "SUBMIT_pause99_add_user_Metaphone", +=%> +<%= submit_button " Insert most definitely ", + name => "SUBMIT_pause99_add_user_Definitely", +=%> + ++ +userid (entering lowercase is OK, but it will be uppercased by the server):
+ +<%= text_field "pause99_add_user_userid", + size => 12, + maxlength => 9, +=%> + +
+ +full name (mailinglist name):
+ +<%= text_field "pause99_add_user_fullname", + size => 50, + maxlength => 50 +=%> + +
+ +email address (for mailing lists this is the real address):
+ +<%= text_field "pause99_add_user_email", + size => 50, + maxlength => 50, +=%> + +
+ +homepage url (ignored for mailing lists):
+ +<%= text_field "pause99_add_user_homepage", + size => 50, + maxlength => 256 +=%> + +
+ +subscribe information if this user is a mailing list +(leave blank for ordinary users):
+ +<%= text_field "pause99_add_user_subscribe", + size => 50, + maxlength => 256, +=%> + +
+ +<%= submit_button " Insert with soundex care ", + name => "SUBMIT_pause99_add_user_Soundex", +=%> +<%= submit_button " Insert with metaphone care ", + name => "SUBMIT_pause99_add_user_Metaphone", +=%> +<%= submit_button " Insert most definitely ", + name => "SUBMIT_pause99_add_user_Definitely", +=%> + +
+ +
If this is a bad request: "delete", + USERID => $pause->{userid}, +) %>">Delete the ID request
diff --git a/lib/pause_2025/templates/closed.html.ep b/lib/pause_2025/templates/closed.html.ep new file mode 100644 index 000000000..599a23d80 --- /dev/null +++ b/lib/pause_2025/templates/closed.html.ep @@ -0,0 +1,7 @@ +Closed for Maintainance
+%= include '_closed'; +Andreas Koenig
+ + diff --git a/lib/pause_2025/templates/disabled.html.ep b/lib/pause_2025/templates/disabled.html.ep new file mode 100644 index 000000000..51465ae01 --- /dev/null +++ b/lib/pause_2025/templates/disabled.html.ep @@ -0,0 +1,5 @@ +% layouts 'layout', title => "Closed for Maintenance"; +% my $pause = stash(".pause") || {}; + +Dear visitor,
+%== $pause->{message}; diff --git a/lib/pause_2025/templates/email/admin/change_user_status.email.ep b/lib/pause_2025/templates/email/admin/change_user_status.email.ep new file mode 100644 index 000000000..a3b87cec3 --- /dev/null +++ b/lib/pause_2025/templates/email/admin/change_user_status.email.ep @@ -0,0 +1,13 @@ +% my $pause = stash(".pause") || {}; +% +%#------------------------------------------------------------------ +% +Record update in the PAUSE users database: + +The ustatus of <%= $pause->{user} %> has changed from <%= $pause->{ustatus} %> to <%= $pause->{new_ustatus} %>. + +Data entered by <%= $pause->{User}{fullname} %>. + +Thanks, +-- +The PAUSE Team diff --git a/lib/pause_2025/templates/email/admin/edit_ml.email.ep b/lib/pause_2025/templates/email/admin/edit_ml.email.ep new file mode 100644 index 000000000..f6cb6e0c8 --- /dev/null +++ b/lib/pause_2025/templates/email/admin/edit_ml.email.ep @@ -0,0 +1,25 @@ +% my $pause = stash(".pause") || {}; +% +%#------------------------------------------------------------------ +% +Record update in the PAUSE mailinglists database: + +<%== sprintf "%12s: [%s]", "userid", $pause->{selected}{maillistid} %> +% for my $field (qw(maillistname address subscribe)) { +% my $fieldname = "pause99_edit_ml_$field"; +% my $param = param($fieldname); +% if ($param ne $pause->{selected}{$field}) { +<%== sprintf "%12s: [%s]", $field, $param %> was [<%== $pause->{selected}{$field} %>] +% } else { +<%== sprintf "%12s: [%s]", $field, $pause->{selected}{$field} %> +% } +% } +% if ($pause->{changed}) { + +Data entered by <%= $pause->{User}{fullname} %>. +Please check if they are correct. + +Thanks, +-- +The PAUSE Team +% } diff --git a/lib/pause_2025/templates/email/admin/user/onetime_password.email.ep b/lib/pause_2025/templates/email/admin/user/onetime_password.email.ep new file mode 100644 index 000000000..c9708c173 --- /dev/null +++ b/lib/pause_2025/templates/email/admin/user/onetime_password.email.ep @@ -0,0 +1,26 @@ +% my $pause = stash(".pause") || {}; +% +%#------------------------------------------------------------------ +% + +(This mail has been generated automatically by the Perl Authors Upload +Server on behalf of the admin <%== $PAUSE::Config->{ADMIN} %>) + +As already described in a separate message, you're a registered Perl +Author with the userid <%== $pause->{userid} %>. For the sake of approval I have +assigned to you a change-password-only-password that enables +you to pick your own password. This password is "<%== $pause->{onetime} %>" +(without the enclosing quotes). Please visit + + <%== my_full_url(ACTION => "change_passwd")->scheme("https") %> + +and use this password to initialize your account in the authentication +database. Once you have entered your password there, your one-time +password is expired automatically. If you cannot connect to the above +URL, you can replace 'https' with 'http', but then you are not using +SSL encryption. Be careful to always use an SSL connection if +possible, otherwise your password can be intercepted by third parties. + +Thanks & Regards, +-- +<%== $PAUSE::Config->{ADMIN} %> diff --git a/lib/pause_2025/templates/email/admin/user/welcome_ml.email.ep b/lib/pause_2025/templates/email/admin/user/welcome_ml.email.ep new file mode 100644 index 000000000..3c9fef42e --- /dev/null +++ b/lib/pause_2025/templates/email/admin/user/welcome_ml.email.ep @@ -0,0 +1,13 @@ +% my $pause = stash(".pause") || {}; +% +%#------------------------------------------------------------------ +% +Mailing list entered by +<%== $pause->{User}{fullname} %>: + +Userid: <%== $pause->{userid} %> +Name: <%== $pause->{maillistname} %> +Description: +%= text_format begin +<%== $pause->{subscribe} %> +% end diff --git a/lib/pause_2025/templates/email/admin/user/welcome_user.email.ep b/lib/pause_2025/templates/email/admin/user/welcome_user.email.ep new file mode 100644 index 000000000..293aba8c7 --- /dev/null +++ b/lib/pause_2025/templates/email/admin/user/welcome_user.email.ep @@ -0,0 +1,35 @@ +% my $pause = stash(".pause") || {}; +% +%#------------------------------------------------------------------ +% +Welcome <%== $pause->{fullname} %>, + +PAUSE, the Perl Authors Upload Server, has a userid for you: + + <%== $pause->{userid} %> + +Once you've gone through the procedure of password approval (see the +separate mail you should receive about right now), this userid will be +the one that you can use to upload your work or edit your credentials +in the PAUSE database. + +This is what we have stored in the database now: + + Name: <%== $pause->{fullname} // '' %> + email: <%== $pause->{email} // '' %> + homepage: <%== $pause->{homepage} // '' %> + +Please note that your email address is exposed in various listings and +database dumps. You can register with both a public and a secret email +if you want to protect yourself from SPAM. If you want to do this, +please visit + <%== my_full_url(ACTION => "edit_cred" )->scheme("https") %> +or + <%== my_full_url(ACTION => "edit_cred" )->scheme("http") %> + +If you need any further information, please visit + $CPAN/modules/04pause.html. +If this doesn't answer your questions, contact modules@perl.org. + +Thank you for your prospective contributions, +The PAUSE Team diff --git a/lib/pause_2025/templates/email/public/mailpw.email.ep b/lib/pause_2025/templates/email/public/mailpw.email.ep new file mode 100644 index 000000000..8df994157 --- /dev/null +++ b/lib/pause_2025/templates/email/public/mailpw.email.ep @@ -0,0 +1,28 @@ +% my $pause = stash(".pause") || {}; +% +%#------------------------------------------------------------------ +% + +(this an automatic mail sent by a program because somebody asked for +it. If you did not intend to get it, please let us know and we will +take more precautions to prevent abuse.) + +Somebody, probably you, has visited the URL + + <%== my_full_url(ACTION => "mailpw") %> + +and asked that you, "<%= $pause->{mailpw_userid} %>", should get a token that enables the +setting of a new password. Here it is (please watch out for line +wrapping errors of your mail reader and other cut and paste errors, +this URL must not contain any spaces): + + <%== my_full_url(ACTION => "change_passwd")->query(ABRA => "$pause->{mailpw_userid}.$pause->{passwd}")->scheme("https") %> + +Please visit this URL, it should open you the door to a password +changer that lets you set a new password for yourself. This token +will expire within a few hours. If you don't need it, do nothing. By +the way, your old password is still valid. + +Thanks, +-- +The PAUSE Team diff --git a/lib/pause_2025/templates/email/public/request_id.email.ep b/lib/pause_2025/templates/email/public/request_id.email.ep new file mode 100644 index 000000000..0da2a780a --- /dev/null +++ b/lib/pause_2025/templates/email/public/request_id.email.ep @@ -0,0 +1,25 @@ +% my $pause = stash(".pause") || {}; +% +%#------------------------------------------------------------------ +% +Request to register new user + +fullname: <%== $pause->{fullname} %> + userid: <%== $pause->{userid} %> + mail: CENSORED +homepage: <%== $pause->{homepage} %> + why: +<%== $pause->{rationale} %> + +The following links are only valid for PAUSE maintainers: + +Registration form with editing capabilities: + <%== my_full_url( + ACTION => "add_user", + USERID => $pause->{session_id}, + SUBMIT_pause99_add_user_sub => 1)->scheme('https') %> +Immediate (one click) registration: + <%== my_full_url( + ACTION => "add_user", + USERID => $pause->{session_id}, + SUBMIT_pause99_add_user_Definitely => 1 )->scheme('https') %> diff --git a/lib/pause_2025/templates/email/user/change_passwd.email.ep b/lib/pause_2025/templates/email/user/change_passwd.email.ep new file mode 100644 index 000000000..cc37fe1b9 --- /dev/null +++ b/lib/pause_2025/templates/email/user/change_passwd.email.ep @@ -0,0 +1,15 @@ +% my $pause = stash(".pause") || {}; +% +%#------------------------------------------------------------------ +% +Password update on PAUSE: + +<%== $pause->{User}{userid} %> (<%== $pause->{User}{fullname} || "fullname N/A" %>) visited the +password changer on PAUSE at <%== scalar gmtime %> UTC +and changed the password for <%== $pause->{HiddenUser}{userid} %> (<%== $pause->{HiddenUser}{fullname} || "fullname N/A" %>). + +No action is required, but it would be a good idea if somebody +would check the correctness of the new password. + +Thanks, +The PAUSE Team diff --git a/lib/pause_2025/templates/email/user/cred/edit.email.ep b/lib/pause_2025/templates/email/user/cred/edit.email.ep new file mode 100644 index 000000000..62460d799 --- /dev/null +++ b/lib/pause_2025/templates/email/user/cred/edit.email.ep @@ -0,0 +1,18 @@ +% my $pause = stash(".pause") || {}; +% +%#------------------------------------------------------------------ +% +Record update in the PAUSE users database: + +<%== sprintf "%11s: [%s]", "userid", $pause->{HiddenUser}{userid} %> + +% for (@{$pause->{mailblurb}}) { +<%== sprintf "%11s: [%s]", $_->{field}, $_->{value} %><%== ($_->{was}) ? " was [$_->{was}]" : "" %> + +% } + +Data were entered by <%== $pause->{User}{userid} %> (<%== $pause->{User}{fullname} %>). +Please check if they are correct. + +Thanks, +The PAUSE Team diff --git a/lib/pause_2025/templates/email/user/delete_files.email.ep b/lib/pause_2025/templates/email/user/delete_files.email.ep new file mode 100644 index 000000000..5fada0747 --- /dev/null +++ b/lib/pause_2025/templates/email/user/delete_files.email.ep @@ -0,0 +1,21 @@ +% my $pause = stash(".pause") || {}; +% +%#------------------------------------------------------------------ +% +%= text_format begin +According to a request entered by <%== $pause->{User}{fullname} %> the +following files and the symlinks pointing to them have been scheduled +for deletion. They will expire after 72 hours and then be deleted by a +cronjob. Until then you can undelete them via +<%== my_full_url(ACTION => "delete_files")->scheme("https") %> or +<%== my_full_url(ACTION => "delete_files")->scheme("http") %> +% end + +<%== $pause->{blurb} %> + +%= text_format begin +Note: to encourage deletions, all of past CPAN +glory is collected on http://history.perl.org/backpan/ +% end + +The PAUSE Team diff --git a/lib/pause_2025/templates/email/user/edit_uris.email.ep b/lib/pause_2025/templates/email/user/edit_uris.email.ep new file mode 100644 index 000000000..0ae3ba9f5 --- /dev/null +++ b/lib/pause_2025/templates/email/user/edit_uris.email.ep @@ -0,0 +1,34 @@ +% my $pause = stash(".pause") || {}; +% +% #----------------------------------------------------------------- +% +Record update in the PAUSE uploads database: + +% if ($pause->{selected}) { +<%== sprintf("%12s: [%s]", "uriid", $pause->{selected}{uriid} %> +% for my $field (qw( +% uri +% nosuccesstime +% nosuccesscount +% changed +% changedby +% )) { +% my $fieldname = "pause99_edit_uris_$field"; +% my $param = param($fieldname); +% if ($param ne $pause->{selected}{$field}) { +<%== sprintf("%12s: [%s]", $field, $param) %> was [<%= $pause->{selected}{$field} %>] +% } else { +<%== sprintf("%12s: [%s]", $field, $pause->{selected}{$field} %> +% } +% } +% if ($pause->{changed}) { + +Data entered by <%== $pause->{User}{fullname} %> (<%== $pause->{User}{userid} %>). +Please check if they are correct. + +Thanks, +-- +The PAUSE Team +% } +% } + diff --git a/lib/pause_2025/templates/email/user/mfa/edit.email.ep b/lib/pause_2025/templates/email/user/mfa/edit.email.ep new file mode 100644 index 000000000..454cf824d --- /dev/null +++ b/lib/pause_2025/templates/email/user/mfa/edit.email.ep @@ -0,0 +1,19 @@ +% my $pause = stash(".pause") || {}; +% +%#------------------------------------------------------------------ +% +Record update in the PAUSE users database: + +<%== sprintf "%11s: [%s]", "userid", $pause->{HiddenUser}{userid} %> + +% if ($pause->{mfa_enabled}) { +Multifactor Authentication is enabled. +% } elsif ($pause->{mfa_disabled}) { +Multifactor Authentication is disabled. +% } + +Data were entered by <%== $pause->{User}{userid} %> (<%== $pause->{User}{fullname} %>). +Please check if they are correct. + +Thanks, +The PAUSE Team diff --git a/lib/pause_2025/templates/email/user/reindex.email.ep b/lib/pause_2025/templates/email/user/reindex.email.ep new file mode 100644 index 000000000..01c1b0dc1 --- /dev/null +++ b/lib/pause_2025/templates/email/user/reindex.email.ep @@ -0,0 +1,15 @@ +% my $pause = stash(".pause") || {}; +% +%#------------------------------------------------------------------ +% +According to a request entered by <%== $pause->{User}{fullname} %> the +following files have been scheduled for reindexing. + +<%== $pause->{blurb} %> + +Estimated time of job completion: <%== $pause->{eta} %> + +Thanks, +-- +The PAUSE Team + diff --git a/lib/pause_2025/templates/email/user/reset_version.email.ep b/lib/pause_2025/templates/email/user/reset_version.email.ep new file mode 100644 index 000000000..64d19a014 --- /dev/null +++ b/lib/pause_2025/templates/email/user/reset_version.email.ep @@ -0,0 +1,12 @@ +% my $pause = stash(".pause") || {}; +% +%#------------------------------------------------------------------ +% +According to a request by <%== $pause->{User}{fullname} %> the following +packages have their recorded version set to 'undef'. + +<%== $pause->{blurb} %> + +Thanks, +-- +The PAUSE Team diff --git a/lib/pause_2025/templates/email/user/uri/submission.email.ep b/lib/pause_2025/templates/email/user/uri/submission.email.ep new file mode 100644 index 000000000..1ed7652d5 --- /dev/null +++ b/lib/pause_2025/templates/email/user/uri/submission.email.ep @@ -0,0 +1,30 @@ +% my $pause = stash(".pause") || {}; +% +%#------------------------------------------------------------------ +% +%= text_format begin +<%== $pause->{User}{userid} %> (<%== $pause->{User}{fullname} %>) visited the PAUSE and requested an upload +into <%== $pause->{whose} %> directory. The request used the following parameters:} + +% end +% for (@{$pause->{mb} || []}) { +<%== sprintf qq{ %-*s [%s]}, $pause->{longest}, $_->[0], $_->[1] %> +% } + +% if ($pause->{query_succeeded}) { +%= text_format begin +The request is now entered into the database where the PAUSE daemon +will pick it up as soon as possible (usually 1-2 minutes). + + +During upload you can watch the logfile in <%== $pause->{tailurl} %>. + +You'll be notified as soon as the upload has succeeded, and if the +uploaded package contains modules, you'll get another notification +from the indexer a little later (usually within 1 hour). +% end +% } + +Thanks for your contribution, +-- +The PAUSE Team diff --git a/lib/pause_2025/templates/layouts/layout.html.ep b/lib/pause_2025/templates/layouts/layout.html.ep new file mode 100644 index 000000000..93fcd94d9 --- /dev/null +++ b/lib/pause_2025/templates/layouts/layout.html.ep @@ -0,0 +1,98 @@ +% my $pause = stash(".pause") || {}; +% my $session = $c->session || {}; +% my $title = $PAUSE::Config->{TESTHOST} ? "pause\@home: " : "PAUSE: "; +% my $action = $pause->{action} || "The CPAN back stage entrance"; +% +% #----------------------------------------------------------------- +% + + + + + +
+
+
+
+
+ 
+ The [Perl programming] Authors Upload Server
+
+ %= include "_user_status";
+
+
+
+% } elsif ($pause->{closed}) {
+ % my $user = $session->{user};
+
+
+
+ Scheduled downtime
+ On <%= $downtime->{http_time} %> (that is in <%= $downtime->{delta} %>) PAUSE will be closed for maintainance work. The estimated downtime is <%= $downtime->{will_last} %>.
+
+
+% }
+
+% if ($pause->{ERROR}) {
+
+
+Hi <%= $user %>, you see the site now but it is closed for maintainance. +Please be careful not to disturb the database operation. Expect failures everywhere. Do not edit anything, it may get lost. Other users get the following text:
+%= include "_closed"; +
+
+% } else {
+
+
+Error
+ +Please try again, probably by using the Back button of your browser and repeating the last action you took.
+
+
+% }
+% if ($ENV{PAUSE_WEB_DEBUG} // $PAUSE::Config->{PAUSE_WEB_DEBUG}) {
+ %= include "_debug";
+% }
+%== content 'javascript'
+
+
diff --git a/lib/pause_2025/templates/mlrepr/select_ml_action.html.ep b/lib/pause_2025/templates/mlrepr/select_ml_action.html.ep
new file mode 100644
index 000000000..ca3d936a9
--- /dev/null
+++ b/lib/pause_2025/templates/mlrepr/select_ml_action.html.ep
@@ -0,0 +1,44 @@
+% layout 'layout';
+% my $pause = stash(".pause") || {};
+
+
+ %= include "_user_menu";
+
+
+ % my $action_conf = app->pause->config->action($pause->{Action});
+ % my $me = my_url();
+ % my $method = $action_conf->{method} // 'GET';
+ % my $enctype;
+ % if ($pause->{need_form_data}) {
+ % $enctype = "multipart/form-data";
+ % }
+ % if ($PAUSE::Config->{TESTHOST}) {
+ % warn "DEBUG: me[$me]enctype[$enctype]";
+
+[ATTN: Form going to post to <%= $me %>]
+ % } + ++Mailinglist support is intended to be available on a +delegates/representatives basis, that means, one or more users +are "elected" (no formal election though) to be allowed to act +on behalf of a mailing list. There is no password for a mailing +list, there are no user credentials for a mailing list. There +are no uploads for mailing lists, thus no deletes or repairs of +uploads. +
++There are only the infos about the mailing list +editable via the method edit_ml and ther are a number of +modules associated with a mailing list and these are accessible +in the edit_mod method. +
++The menu item Select +Mailinglist/Action lets you access the available methods and +the mailing lists you are associated with. Only people elected +as a representative of a mailing list should be able to ever see +the menu entry.
This feature is available since Oct 25th, +1999 and hardly tested, so please take care and let us know how +it goes. +
+ +Choose your mailing list and the action and click the submit +button.
+ +<%= select_field HIDDENNAME => [ + map { + $_ eq $pause->{User}{userid} + ? [$_ => $_, selected => "selected"] + : $_ + } @{$pause->{users}} +], size => (@{$pause->{users}} > 18 ? 15 : scalar @{$pause->{users}}), +%> +<%= select_field ACTIONREQ => $pause->{action_reqs}, + size => (@{$pause->{action_reqs}} > 18 ? 15 : scalar @{$pause->{action_reqs}}), +%> + + diff --git a/lib/pause_2025/templates/mlrepr/show_ml_repr.html.ep b/lib/pause_2025/templates/mlrepr/show_ml_repr.html.ep new file mode 100644 index 000000000..bd891e2df --- /dev/null +++ b/lib/pause_2025/templates/mlrepr/show_ml_repr.html.ep @@ -0,0 +1,32 @@ +% layout 'layout'; +% my $pause = stash(".pause") || {}; + +These are the contents of the table list2user. +There's currently no way to edit the table except +direct SQL. The table says who is representative of a +mailing list.
+ +
+
+
+
+
+% content_for javascript => begin
+%= javascript "/pause/list.min.js"
+%= javascript begin
+var userList = new List('users', {valueNames: ['ml', 'userid']});
+% end
+% end
diff --git a/lib/pause_2025/templates/pause_doc.html.ep b/lib/pause_2025/templates/pause_doc.html.ep
new file mode 100644
index 000000000..315ad5a81
--- /dev/null
+++ b/lib/pause_2025/templates/pause_doc.html.ep
@@ -0,0 +1,4 @@
+% layout 'layout';
+% my $pause = stash(".pause") || {};
+
+%== $pause->{doc}
diff --git a/lib/pause_2025/templates/public/admin.html.ep b/lib/pause_2025/templates/public/admin.html.ep
new file mode 100644
index 000000000..fe9fdc51e
--- /dev/null
+++ b/lib/pause_2025/templates/public/admin.html.ep
@@ -0,0 +1,7 @@
+% layout 'layout';
+% my $pause = stash(".pause") || {};
+
+| Mailing list | +User-ID | +
|---|---|
| <%= $rec->{maillistid} %> | +<%= $rec->{userid} %> | +
Registered admins: <%= join ", ", @{$pause->{admins} || []} %>
+"YAML") %>" style="text-decoration: none;"> + +
diff --git a/lib/pause_2025/templates/public/mailpw.html.ep b/lib/pause_2025/templates/public/mailpw.html.ep new file mode 100644 index 000000000..89576372e --- /dev/null +++ b/lib/pause_2025/templates/public/mailpw.html.ep @@ -0,0 +1,21 @@ +% layout 'layout'; +% my $pause = stash(".pause") || {}; +%= csrf_field + +"> + +% if ($pause->{mailpw_userid}) { +% if ($pause->{valid_email}) { +A token to change the password for <%= $pause->{mailpw_userid} %> is on its way to its owner. Should the mail not arrive, please tell us.
+% } else { +We have not found the email of <%= $pause->{mailpw_user_id} %>. Please try with a different name or mail to the administrator directly.
+% } +% } + +This form lets you request a token that enables you to set a new +password. It only operates correctly if the database knows you and +your email adress. Please fill in your userid on the CPAN. The token +will be mailed to that userid.
+ +<%= text_field "pause99_mailpw_1", size => 32 %> + diff --git a/lib/pause_2025/templates/public/pumpkin.html.ep b/lib/pause_2025/templates/public/pumpkin.html.ep new file mode 100644 index 000000000..737cf794a --- /dev/null +++ b/lib/pause_2025/templates/public/pumpkin.html.ep @@ -0,0 +1,7 @@ +% layout 'layout'; +% my $pause = stash(".pause") || {}; + +Registered pumpkins: <%= join ", ", @{$pause->{pumpkins} || []} %>
+"YAML") %>" style="text-decoration: none;"> + +
diff --git a/lib/pause_2025/templates/public/request_id/_form.html.ep b/lib/pause_2025/templates/public/request_id/_form.html.ep new file mode 100644 index 000000000..b090853b1 --- /dev/null +++ b/lib/pause_2025/templates/public/request_id/_form.html.ep @@ -0,0 +1,63 @@ +% my $pause = stash(".pause") || {}; +% my $alt = 0; + +A PAUSE account is only required to distribute and manage Perl module +distributions on CPAN. You do not need a PAUSE account to submit +bug reports to RT or participate +in many Perl community sites.
+ +
+
+
+Your full name (civil name)
+Unicode Characters OK.
++<%= text_field "pause99_request_id_fullname", size => 32 %> +
+
+Note: You can enter fairly free-form text here but it must consist of at least two space-separated words. This is a spam protection measure we discovered accidentally. Back when PAUSE was developed in the nineties, people would generally fill out a field asking for a full name with a first name and a second name, like Ben Cartwright or Tony Nelson. When this trivial expectation was coded into the server as a sanity check, it turned out to block many spam bots because they often did not try to enter a space in the middle of the field. It was only around 2003 that people started complaining that they had tried Peter and it did not work. Apologies for insisting, Peter – but feel free to make something up to satisfy the requirement.
+
+
+Email
+
+
+required, otherwise we cannot send you the password
++<%= text_field "pause99_request_id_email", size => 32 %> +
+
+
+
+Web site
+optional
++<%= text_field "pause99_request_id_homepage", size => 32 %> +
+
+
+
+Desired ID
+3-9 characters matching [A-Z], please
+<%= text_field "pause99_request_id_userid", size => 32 %> +
+
+
+% if ( $PAUSE::Config->{RECAPTCHA_ENABLED} ) {
+% if ( $PAUSE::Config->{RECAPTCHA_SITE_KEY} ) {
+A short description of why you would like a +PAUSE ID:
required; include what you are planning to contribute; do not use HTML
+ +<%= text_area "pause99_request_id_rationale", rows=>8, cols=>60 =%> + +
+
+
+
+% }
+% else {
+% warn "request_id: RECAPTCHA_SITE_KEY not available\n";
+% }
+% }
+
+
+
diff --git a/lib/pause_2025/templates/public/request_id/request.html.ep b/lib/pause_2025/templates/public/request_id/request.html.ep
new file mode 100644
index 000000000..756318212
--- /dev/null
+++ b/lib/pause_2025/templates/public/request_id/request.html.ep
@@ -0,0 +1,48 @@
+% layout 'layout';
+% my $pause = stash(".pause") || {};
+
+% if (@{$pause->{errors} || []}) {
+Error processing form
+% for (@{$pause->{errors}}) { +- <%= $_ %>
Please retry.
+% } + +% if ($pause->{showform}) { + +%= include "public/request_id/_form"; + +% } +% if ($pause->{reg_ok}) { +% if ($pause->{recaptcha_enabled}) { +% if ($pause->{added_user}) { +New user creation succeeded.
+ +LOOK FOR AN EMAIL WITH YOUR TEMPORARY PASSWORD.
+ +You'll also receive a welcome email like the one below.
+ +
+From: <%= $PAUSE::Config->{UPLOAD} %>
+Subject: <%= $pause->{subject_for_user_addition} %>
+
+<%== $pause->{blurb_for_user_addition} %>
+
++% } else { +
New user creation failed.
+% } +% } +% elsif ($pause->{blurbcopy}) { +Sending mail to: <%= $pause->{send_to} %> +
+From: <%= $PAUSE::Config->{UPLOAD} %>
+Subject: <%= $pause->{subject} %>
+
+<%== $pause->{blurbcopy} %>
+
++ +% } +% } diff --git a/lib/pause_2025/templates/root/index.html.ep b/lib/pause_2025/templates/root/index.html.ep new file mode 100644 index 000000000..0e6778c09 --- /dev/null +++ b/lib/pause_2025/templates/root/index.html.ep @@ -0,0 +1,34 @@ +% layout 'layout'; +% my $pause = stash(".pause") || {}; +% my $mgr = $c->app->pause; +% if ($pause->{User}{fullname}) { +
Hi <%= $pause->{User}{fullname} %>,
please choose an action from the menu.
+% } else {
+Please choose an action from the menu.
+% } + +The usermenu to the left shows all menus available to +you, the table below shows descriptions for all menues available +to anybody on PAUSE.
+ +% my $alter = 1; +
+
|
PAUSE ID: <%= text_field "pause_id", size => 15, maxlength => 9 =%>
+Password: <%= password_field "password", size => 15 =%>
+ +% } else { +Authentication code
+%= text_field 'otp', autocomplete => 'off'; + +% for my $name (@{ $c->req->params->names }) { + % for my $value (@{ $c->req->every_param($name) }) { + % next if $name eq 'ACTION'; + % next if $name eq 'otp'; + %= hidden_field $name => $value; + % } +% } + +%= submit_button 'verify'; +% } +%= csrf_field + diff --git a/lib/pause_2025/templates/root/logout.html.ep b/lib/pause_2025/templates/root/logout.html.ep new file mode 100644 index 000000000..3edc773fb --- /dev/null +++ b/lib/pause_2025/templates/root/logout.html.ep @@ -0,0 +1,7 @@ +% layout 'layout'; +% my $pause = stash(".pause") || {}; +% my $mgr = $c->app->pause; + + +%= csrf_field + diff --git a/lib/pause_2025/templates/user/change_passwd.html.ep b/lib/pause_2025/templates/user/change_passwd.html.ep new file mode 100644 index 000000000..bc8695d4f --- /dev/null +++ b/lib/pause_2025/templates/user/change_passwd.html.ep @@ -0,0 +1,43 @@ +% layout 'layout'; +% my $pause = stash(".pause") || {}; + + + +Changing Password of <%= $pause->{HiddenUser}{userid} %>
+% if (param("ABRA")) { +"> +% } + +% if ($pause->{password_stored}) { +New password stored and enabled. Be prepared that +you will be asked for a new authentication on the next request. If +this doesn't work out, it may be that you have to restart the +browser.
+% } else { +% if ( $pause->{UserSecrets}{forcechange} ) { + +Your password in the database is tainted which +means you have to renew it. If you believe this is wrong, please +complain, it's always possible that you are seeing a bug.
+ +% } + +Please fill in your new password in both textboxes. +Only if both fields contain the same password, we will be able to +proceed.
+ +<%= password_field "pause99_change_passwd_pw1", + maxlength => 72, + size => 16, +=%> + +<%= password_field "pause99_change_passwd_pw2", + maxlength => 72, + size => 16, +=%> + +%= csrf_field + + +% } + diff --git a/lib/pause_2025/templates/user/cred/edit.html.ep b/lib/pause_2025/templates/user/cred/edit.html.ep new file mode 100644 index 000000000..6d020e443 --- /dev/null +++ b/lib/pause_2025/templates/user/cred/edit.html.ep @@ -0,0 +1,151 @@ +% layout 'layout'; +% my $pause = stash(".pause") || {}; +% my $cpan_alias = lc($pause->{HiddenUser}{userid}) . '@cpan.org'; + + + +Editing <%= $pause->{HiddenUser}{userid} %> +% if (exists $pause->{UserGroups}{admin}) { + (lastvisit <%= $pause->{HiddenUser}{lastvisit} || "before 2005-12-02" %>) +% } +
+ +% if (param("pause99_edit_cred_sub")) { +% if (my $error = $pause->{error}) { + ++% } +% } + +% if ($pause->{consistentsubmit}) { +% for my $table ("users", $PAUSE::Config->{AUTHEN_USER_TABLE}) { +% if ($pause->{registered}{$table}) { + +
+ +% } +% } +% if (!$pause->{saw_a_change}) { + +
+% } +% } + +
+
Full Name++PAUSE supports names containing UTF-8 characters. +See also the field ASCII transliteration below. + +<%= text_field "pause99_edit_cred_fullname", + size => 50, + maxlength => 127, # caution! +%> + |
ASCII transliteration of Full Name++If your Full Name contains +characters above 0x7f, please supply an +ASCII transliteration that can be used in +mail written in ASCII. Leave empty if you +trust the Text::Unidecode module. + +<%= text_field "pause99_edit_cred_asciiname", + size => 50, + maxlength => 255, +%> + |
Publicly visible email address (published in many listings)+<%= text_field "pause99_edit_cred_email", + size => 50, + maxlength => 255, +%> + |
Secret email address only used by the PAUSE, never published.++If you leave this field empty, +PAUSE will use the public email address +for communicating with you. + +<%= text_field "pause99_edit_cred_secretemail", + size => 50, + maxlength => 255, +%> + |
Homepage or any contact URL except mailto:+<%= text_field "pause99_edit_cred_homepage", + size => 50, + maxlength => 255, +%> + |
The email address <%= $cpan_alias %> should be configured to forward mail to ...+
+cpan.org has a mail
+address for you and it's your choice if you want it to point to your
+public email address or to your secret one. Please allow a few hours
+for any change you make to this setting for propagation. BTW, let us
+reassure you that cpan.org gets the data through a secure
+channel. +<%= radio_button "pause99_edit_cred_cpan_mail_alias" => "secr" %> +my secret email address +<%= radio_button "pause99_edit_cred_cpan_mail_alias" => "none", + checked => "checked", +%> neither nor + |
Remove account?++You have not yet uploaded any files +to the CPAN, so your account can still be +cancelled. If you want to retire your +account, please click here. If you do +this, your account will not be removed +immediately but instead be removed +manually by the database maintainer at a +later date. + +<%= check_box pause99_edit_cred_ustatus => "delete" %> +Account can be removed + |
+% if ($pause->{error}) {
+
+<%= $pause->{error} %>
+% } elsif (@{$pause->{results} || []}) { +-
+% for (@{$pause->{results}}) {
+% if ($_->{error}) {
+
- Error trying to remove <%= $_->{user} %> from co-maintainers of <%= $_->{mod} %> (<%= $_->{dist} %>): <%= $_->{error} %> +% } else { +
- Removed <%= $_->{user} %> from co-maintainers of <%= $_->{mod} %> (<%= $_->{dist} %>). +% } +% } +
You need to select one or more distributions. Nothing done.
+% } ++% } + +% if (@{$pause->{dists} || []}) { +
Give up co-maintainer status
+Please select one or +more distributions for which you want to be removed from +the co-maintainer table and press Give Up
+ +If you need finer control (eg. to give up comaintainership +for a removed module), visit + +Give up Co-maintainership status per module page.
+ +Select one or more distributions:
+ +
+
+
+
+
+
| + | Distribution | +Owners | +
|---|---|---|
| <%= check_box "pause99_giveup_dist_comaint_d" => $_->[0] %> | +<%= $_->[0] %><% if ($_->[1] =~ /,/) { %> (incomplete ownership)<% } %> | +<%= $_->[1] %> | +
+
+
+% content_for javascript => begin
+%= javascript "/pause/list.min.js"
+%= javascript begin
+var List = new List('dists', {
+ valueNames: ['dist','owners']
+});
+% end
+% end
+
+% } else {
+
+% } + +% if (@{$pause->{dists} || []}) { + +
+% } + +% if (@{$pause->{dists} || []}) { +
+% } + +% if (@{$pause->{dists} || []}) { +
+% } + +% if (@{$pause->{dists} || []}) { + +
+ +% if (%{$pause->{selected}}) { +
+% } + +
+ +<%= text_field "pause99_edit_uris_uri" => $pause->{selected}{uri}, + size => 60, + maxlength => 255, +%> +
+ +
+
+ +
+
+ +
+
+ +
+
+
+% } +% } diff --git a/lib/pause_2025/templates/user/files/delete.html.ep b/lib/pause_2025/templates/user/files/delete.html.ep new file mode 100644 index 000000000..dbc87de9f --- /dev/null +++ b/lib/pause_2025/templates/user/files/delete.html.ep @@ -0,0 +1,69 @@ +% layout 'layout'; +% my $pause = stash(".pause") || {}; +% my $files = $pause->{files} || {}; + + +
+% } +% if (!$pause->{HiddenUser}{mfa}) { +
+% } + +% if (@{$pause->{mods} || []}) { + +
+% } + +% if (@{$pause->{mods}}) { +
+% } + +% if (@{$pause->{mods} || []}) { +
+% } + +% if (@{$pause->{mods} || []}) { +
+% } + +% if (@{$pause->{mods} || []}) { + +
+% } + +% if (@{$pause->{mods} || []}) { +
Sorry, <%= $pause->{HiddenUser}{userid} || $pause->{User}{userid} %> does not seem to be co-maintainer of any distribution.
+% } diff --git a/lib/pause_2025/templates/user/distperms/make_dist_comaint.html.ep b/lib/pause_2025/templates/user/distperms/make_dist_comaint.html.ep new file mode 100644 index 000000000..9e28b135a --- /dev/null +++ b/lib/pause_2025/templates/user/distperms/make_dist_comaint.html.ep @@ -0,0 +1,92 @@ +% layout 'layout'; +% my $pause = stash(".pause") || {}; + + + +% if (param("SUBMIT_pause99_make_dist_comaint")) { +
+% if ($pause->{error}) {
+
+<%= $pause->{error} %>
+% } elsif (@{$pause->{results} || []}) { +-
+% for (@{$pause->{results}}) {
+% if ($_->{error}) {
+
- Error trying to add <%= $_->{user} %> to co-maintainers of <%= $_->{mod} %> (<%= $_->{dist} %>): <%= $_->{error} %> +% } elsif ($_->{duplicated}) { +
- <%= $_->{user} %> was already a co-maintainer of <%= $_->{mod} %> (<%= $_->{dist} %>): skipping +% } else { +
- Added <%= $_->{user} %> to co-maintainers of <%= $_->{mod} %> (<%= $_->{dist} %>). +% } +% } +
You need to select one or more distributions and enter a userid. + Nothing done.
+% } ++% } + +% if (@{$pause->{dists} || []}) { + +
Select a co-maintainer
+Please select one or +more distributions for which you want to select a +co-maintainer, enter the CPAN userid of the co-maintainer +into the text field and press Make Co-Maintainer
+ +If you are open to someone else asking for your first-come +permissions, but you wish to decide on any such request, you +can give a co-maint to a special user called +HANDOFF.
+ +You can also grant co-maint to +NEEDHELP +if you would like additional volunteers to help you work on a particular module.
+ +If you need finer control (eg. to add comaintainers for only +a small part of a distribution just to allow them to handle RT tickets +while prohibiting them to upload the distribution), visit + +Add Comaintainers per module page.
+ +Select one or more distributions:
+
+
+
+
+
+
+% content_for javascript => begin
+%= javascript "/pause/list.min.js"
+%= javascript begin
+var List = new List('dists', {
+ valueNames: ['dist','owners']
+});
+% end
+% end
+
+% } else {
+| + | Distribution | +Owners | +
|---|---|---|
| <%= check_box "pause99_make_dist_comaint_d" => $_->[0] %> | +<%= $_->[0] %><% if (($_->[1] // '') =~ /,/) { %> (incomplete ownership)<% } %> | +<%= $_->[1] %> | +
Select a userid:
+<%= text_field "pause99_make_dist_comaint_a", size => 15, maxlength => 9 %>
+
+
+
+Sorry, there are no distributions registered belonging to <%= $pause->{HiddenUser}{userid} || $pause->{User}{userid} %>.
+% } diff --git a/lib/pause_2025/templates/user/distperms/move_dist_primary.html.ep b/lib/pause_2025/templates/user/distperms/move_dist_primary.html.ep new file mode 100644 index 000000000..cf151ebb0 --- /dev/null +++ b/lib/pause_2025/templates/user/distperms/move_dist_primary.html.ep @@ -0,0 +1,87 @@ +% layout 'layout'; +% my $pause = stash(".pause") || {}; + + + +% if (param("SUBMIT_pause99_move_dist_primary")) { +
+% if ($pause->{error}) {
+
+<%= $pause->{error} %>
+% } elsif (@{$pause->{results} || []}) { +-
+% for my $res (@{$pause->{results}}) {
+% if ($res->{error}) {
+
- Error trying to make <%= $res->{user} %> primary maintainer of <%= $res->{mod} %> (<%= $res->{dist} %>): <%= $res->{error} %> "; +% } else { +
- Made <%= $res->{user} %> primary maintainer of <%= $res->{mod} %> (<%= $res->{dist} %>). +% } +% } +
You need to select one or more distributions and enter a userid. +Nothing done.
+% } ++% } + +% if (@{$pause->{dists} || []}) { +
Pass maintainership status
Please select one +or more distributions for which you want to pass primary +maintainership status, enter the CPAN userid of the new +maintainer into the text field and press Pass Maintainership +Status. Note: you keep co-maintainer status after this move. +If you want to get rid of that too, please visit Give up +co-maintainership status next.
+ +You can only transfer what you actually own. +If multiple owners are listed, you (or the person you are going to +transfer the distribution) need to ask those owners to transfer +their permissions as well.
+ +If you need finer control (eg. to transfer only a small part of +a distribution you and other people own, for clarity's sake), visit + +Transfer Primary Permissions per module page.
+ +Select one or more distributions:
+
+
+
+
+
+
+% content_for javascript => begin
+%= javascript "/pause/list.min.js"
+%= javascript begin
+var List = new List('dists', {
+ valueNames: ['dist', 'owners']
+});
+% end
+% end
+
+% } else {
+| + | Distribution | +Owners | +
|---|---|---|
| <%= check_box "pause99_move_dist_primary_d" => $_->[0] %> | +<%= $_->[0] %><% if ($_->[1] =~ /,/) { %> (incomplete ownership)<% } %> | +<%= $_->[1] %> | +
Select a userid:
+<%= text_field "pause99_move_dist_primary_a", size => 15, maxlength => 9 =%>
+
+
+ +Sorry, there are no distributions registered belonging to <%= $pause->{HiddenUser}{userid} || $pause->{User}{userid} %>.
+% } + diff --git a/lib/pause_2025/templates/user/distperms/peek.html.ep b/lib/pause_2025/templates/user/distperms/peek.html.ep new file mode 100644 index 000000000..b560e1c4f --- /dev/null +++ b/lib/pause_2025/templates/user/distperms/peek.html.ep @@ -0,0 +1,112 @@ +% layout 'layout'; +% my $pause = stash(".pause") || {}; + +Select the option and fill in a distribution name or +user ID as appropriate. The answer is all distributions that an +user ID is registered for or all user IDs registered for a +distribution, as appropriate.
+ +Registration comes in one of two types: type +first-come is the automatic registration on a +first-come-first-serve basis that happens on the initial +upload. And type co-maint is the registration as +co-maintainer which means that the primary maintainer of +the namespace has granted permission to upload this module +to other userid(s). Per namespace there can only be one +primary maintainer (userid in the +first-come category) and any number of userids in +the co-maint category. Being registered in any of +the categories means that a user is able not only to +upload a module in that namespace but also be accepted by +the indexer. In other words, the indexer will not ignore +uploads for that namespace by that person.
+ +Permission is granted per namespace, +not per distribution. So you might not have enough +permission to upload a distribution or grant permissions to +other people if you are listed here (when you have permissions for +only a part of the distribution). If you want more detailed +information, visit +View permission per module page.
+ +The +contents of the tables presented on this page are mostly +generated automatically, so please report any errors you +observe to <%= "@{$PAUSE::Config->{ADMINS}}" %> so that the tables +can be corrected.--Thank you!
+ +<%= select_field 'pause99_peek_dist_perms_by' => [ + ["for a distribution--exact match" => "de"], + [qq{for a distribution--SQL "LIKE" match} => "dl"], + ["of an author" => "a"], +], size => 1 =%> + +<%= text_field 'pause99_peek_dist_perms_query', size => 44, maxlength => 112, =%> + + + +
+% if (@{$pause->{rows} || []}) { +
+
+
+
+
+
+
+% content_for javascript => begin
+%= javascript "/pause/list.min.js"
+%= javascript begin
+var List = new List('perms', {
+ valueNames: ['dist', 'owner', 'comaint']
+});
+% end
+% end
+
+% } else {
+No records found.
+% }
diff --git a/lib/pause_2025/templates/user/distperms/remove_dist_comaint.html.ep b/lib/pause_2025/templates/user/distperms/remove_dist_comaint.html.ep
new file mode 100644
index 000000000..355f92c08
--- /dev/null
+++ b/lib/pause_2025/templates/user/distperms/remove_dist_comaint.html.ep
@@ -0,0 +1,79 @@
+% layout 'layout';
+% my $pause = stash(".pause") || {};
+
+
+
+% if (param("SUBMIT_pause99_remove_dist_comaint")) {
+| <%= $_ %> | +% } +||
|---|---|---|
| $row->[0], + pause99_peek_dist_perms_sub => 1, + ]) %>"><%= $row->[0] %> | ++% my @owners = split /,/, $row->[1] // ''; +% while(my $owner = shift @owners) { + $owner, + pause99_peek_dist_perms_sub => 1, + ]) %>"><%= $owner %><% if (@owners) { %>,<% } %> +% } + | ++% my @comaints = split /,/, $row->[2] // ''; +% while(my $comaint = shift @comaints) { + $comaint, + pause99_peek_dist_perms_sub => 1, + ]) %>"><%= $comaint %><% if (@comaints) { %>,<% } %> +% } + | +
+% if ($pause->{error}) {
+
+<%= $pause->{error} %>
+% } elsif (@{$pause->{results} || []}) { +-
+% for (@{$pause->{results}}) {
+% if ($_->{not_exists}) {
+
- Cannot handle tuple <%= $_->{sel} %>. If you believe, this is a bug, please complain. +% } elsif ($_->{error}) { +
- Error trying to remove <%= $_->{user} %> from co-maintainers of <%= $_->{mod} %> (<%= $_->{dist} %>): <%= $_->{error} %> +% } else { +
- Removed <%= $_->{user} %> from co-maintainers of <%= $_->{mod} %> (<%= $_->{dist} %>). +% } +% } +
You need to select one or more distributions. Nothing done.
+% } ++% } + +% if (@{$pause->{dists} || []}) { +
Remove co-maintainer status
+The scrolling +list shows you, which distributions are associated with other +maintainers besides yourself. Every line denotes a tuple +of a distribution and a userid. Select those that you want to +remove and press Remove
+ +If you need finer control (eg. to remove comaintainers +only for a small part of a distribution, or remove comaintainers +for a removed module), visit + +Remove Comaintainers per module page.
+ +
+
+
+
+
+
+% content_for javascript => begin
+%= javascript "/pause/list.min.js"
+%= javascript begin
+var List = new List('dists', {
+ valueNames: ['dist', 'userid']
+});
+% end
+% end
+
+% } else {
+| + | Distribution | +UserID | +
|---|---|---|
| <%= check_box "pause99_remove_dist_comaint_tuples" => $_ %> | +<%= $dist %> | +<%= $userid %> | +
+
+There are no co-maintainers registered to any of <%= $pause->{HiddenUser}{userid} || $pause->{User}{userid} %>'s distributions.
+% } diff --git a/lib/pause_2025/templates/user/distperms/remove_dist_primary.html.ep b/lib/pause_2025/templates/user/distperms/remove_dist_primary.html.ep new file mode 100644 index 000000000..67254d0f7 --- /dev/null +++ b/lib/pause_2025/templates/user/distperms/remove_dist_primary.html.ep @@ -0,0 +1,96 @@ +% layout 'layout'; +% my $pause = stash(".pause") || {}; + + + +% if (param("SUBMIT_pause99_remove_dist_primary")) { +
+% if ($pause->{error}) {
+
+<%= $pause->{error} %>
+% } elsif (@{$pause->{results} || []}) { +-
+% for (@{$pause->{results}}) {
+% if ($_->{error}) {
+
- Error trying to remove primary maintainership of <%= $_->{user} %> from <%= $_->{mod} %> (<%= $_->{dist} %>): <%= $_->{error} %> +% } else { +
- Removed primary maintainership of <%= $_->{user} %> from <%= $_->{mod} %> (<%= $_->{dist} %>). +% } +% } +
You need to select one or more distributions. Nothing done.
+% } ++% } + +% if (@{$pause->{dists} || []}) { + +
Give up maintainership status
+Please select one or more distributions for which you +want to give up primary maintainership status and press +Give Up Maintainership Status. Note: you keep co-maintainer +status after this move. If you want to get rid of that too, +please visit ">Give up +co-maintainership status next.
+ +Giving up primary permissions now means that the permissions are +transferred to a special user called +ADOPTME. +
+ +You can only give up what you actually own. +If multiple owners are listed, those owners keep their primary +maintainership for their part of the distribution. In this case, +you are strongly advised to +">transfer your primary permissions +to one of the other owners.
+ ++If you have are unsure about what to do, or have any questions, +please email the PAUSE admins at modules@cpan.org. +
+ +If you need finer control (eg. to give up only a small part of +a distribution for whatever reasons), visit + +<%= $c->app->pause->config->action('remove_primary')->{verb} %> page.
+ +Select one or more distributions:
+
+
+
+
+
+
+
+
+% content_for javascript => begin
+%= javascript "/pause/list.min.js"
+%= javascript begin
+var List = new List('dists', {
+ valueNames: ['dist', 'owners']
+});
+% end
+% end
+
+% } else {
+| + | Distribution | +Owners | +
|---|---|---|
| <%= check_box "pause99_remove_dist_primary_d" => $_->[0] %> | +<%= $_->[0] %><% if ($_->[1] =~ /,/) { %> (incomplete ownership)<% } %> | +<%= $_->[1] %> | +
Sorry, there are no distributions registered belonging to <%= $pause->{HiddenUser}{userid} || $pause->{User}{userid} %>.
+% } + diff --git a/lib/pause_2025/templates/user/edit_uris.html.ep b/lib/pause_2025/templates/user/edit_uris.html.ep new file mode 100644 index 000000000..baf4724bb --- /dev/null +++ b/lib/pause_2025/templates/user/edit_uris.html.ep @@ -0,0 +1,83 @@ +% layout 'layout'; +% my $pause = stash(".pause") || {}; + + +for user <%= $pause->{HiddenUser}{userid} %>
+ +% if ($pause->{no_pending_uploads}) { +No pending uploads for <%= $pause->{HiddenUser}{userid} %> found
+% } else { + +<%= select_field "pause99_edit_uris_3" => $pause->{all_recs}, + size => 1, +%> + ++ +% if (%{$pause->{selected}}) { +
Record for <%= $pause->{selected}{uriid} %>
+ +% if ($pause->{changed}) { +The record has been updated in the database
+% } elsif ($pause->{update_sel}) { +It seems to me the record was NOT updated. Maybe nothing has changed? +Please take a closer look and inform an admin if things didn't proceed as expected.+% } + +
URI to download
+ +If you change this field to a different URI, +PAUSE will try to fetch this URI instead. Note that the +filename on PAUSE will remain unaltered. So you can fix a +typo, but you cannot alter the name of the uploaded file, it +will be the original filename. So this is only an opportunity +to fix broken uploads that cannot be completed, not an +opportunity to turn the time back. + +To re-iterate: If you change the content of this field to +http://www.slashdot.org/, PAUSE will fetch the current +Slashdot page and will put it into +<%= $pause->{selected}{uriid} %>. If you change it to +FooBar-3.14.tar.gz, PAUSE will try to get +<%= $PAUSE::Config->{INCOMING} %>/FooBar-3.14.tar.gz and if it +finds it, it puts it into <%= $pause->{selected}{uriid} %>.
+ +An example: if you made a typo and requested to upload +http://badsite.org/foo instead of +http://goodsite.org/foo, just correct the thing in the +textfield below.
+ +Another example: If your upload was unsuccessful and you now have +a bad file in the incoming directory, then you have the +problem that PAUSE tries to fetch your file (say foo) +but doesn't succeed and then it retries and retries. Your +solution: transfer the file into the incoming directory with +a different name (say bar) using ftp. Fill in +the different name below. PAUSE will fetch bar and +upload it as foo. So you're done.
++ +<%= text_field "pause99_edit_uris_uri" => $pause->{selected}{uri}, + size => 60, + maxlength => 255, +%> +
+ +
UNIX time of last unsuccessful attempt to retrieve this item
+<%= $pause->{selected}{nosuccesstime} || 0 %>+
+ +
Number of unsuccessful attempts so far
+<%= $pause->{selected}{nosuccesscount} || 0 %>+
+ +
Record was last changed on
+<%= $pause->{selected}{changed} || 0 %>+
+ +
Record was last changed by
+<%= $pause->{selected}{changedby} || 0 %>+
+
+% } +% } diff --git a/lib/pause_2025/templates/user/files/delete.html.ep b/lib/pause_2025/templates/user/files/delete.html.ep new file mode 100644 index 000000000..dbc87de9f --- /dev/null +++ b/lib/pause_2025/templates/user/files/delete.html.ep @@ -0,0 +1,69 @@ +% layout 'layout'; +% my $pause = stash(".pause") || {}; +% my $files = $pause->{files} || {}; + + +
Files in directory authors/id/<%= $pause->{userhome} %>
+ +% if (%$files) { +% if ($pause->{deleting_indexed_files}) { + +% } else { + +% } +
+
+
+
+
+
+
+
+% content_for javascript => begin
+%= javascript "/pause/list.min.js"
+%= javascript begin
+var List = new List('files', {
+ valueNames: ['file', 'size', { name: 'modified', attr: 'data-modified' }]
+});
+
+document.querySelectorAll('input[type=checkbox]').forEach(function(e) {
+ e.addEventListener('change', function(ev) {
+ var checked = ev.currentTarget.checked;
+ var distv = ev.currentTarget.getAttribute('data-distv');
+ document.querySelectorAll('input[data-distv="'+distv+'"]').forEach(function(e) {
+ e.checked = checked;
+ });
+ })
+});
+
+% end
+% end
+
+% } else {
+No files found in authors/id/<%= $pause->{userhome} %>
+% }
diff --git a/lib/pause_2025/templates/user/files/show.html.ep b/lib/pause_2025/templates/user/files/show.html.ep
new file mode 100644
index 000000000..ecdb54e45
--- /dev/null
+++ b/lib/pause_2025/templates/user/files/show.html.ep
@@ -0,0 +1,43 @@
+% layout 'layout';
+% my $pause = stash(".pause") || {};
+% my $files = $pause->{files} || {};
+
+| + | File | +Size | +Modified | +|
|---|---|---|---|---|
| <%= check_box "pause99_delete_files_FILE" => $file, 'data-distv' => $files->{$file}{distv} %> | +% if ($files->{$file}{indexed}) { +<%= $file %> [indexed] | +% } else { +<%= $file %> | +% } +<%= $files->{$file}{stat} %> | +<%= $files->{$file}{blurb} %> | +
Files in directory authors/id/<%= $pause->{userhome} %>
+% if (%$files) { +
+
+
+
+
+
+% content_for javascript => begin
+%= javascript "/pause/list.min.js"
+%= javascript begin
+var List = new List('files', {
+ valueNames: ['file', 'size', { name: 'modified', attr: 'data-modified' }]
+});
+% end
+% end
+
+% } else {
+No files found in authors/id/<%= $pause->{userhome} %>
+% }
diff --git a/lib/pause_2025/templates/user/mfa/edit.html.ep b/lib/pause_2025/templates/user/mfa/edit.html.ep
new file mode 100644
index 000000000..d6d1fe733
--- /dev/null
+++ b/lib/pause_2025/templates/user/mfa/edit.html.ep
@@ -0,0 +1,64 @@
+% layout 'layout';
+% my $pause = stash(".pause") || {};
+% my $cpan_alias = lc($pause->{HiddenUser}{userid}) . '@cpan.org';
+
+
+
+% if (flash('mfa_enabled')) {
+
+% } elsif (flash('mfa_disabled')) {
+
+% }
+
+% if ($pause->{HiddenUser}{mfa}) {
+| File | +Size | +Modified | +|
|---|---|---|---|
| <%= $file %> [indexed] | +% } else { +<%= $file %> | +% } +<%= $files->{$file}{stat} %> | +<%= $files->{$file}{blurb} %> | +
You have already enabled multifactor authentication.
+% } else { +Enable Multifactor Authentication for <%= $pause->{HiddenUser}{userid} %> +% if (exists $pause->{UserGroups}{admin}) { + (lastvisit <%= $pause->{HiddenUser}{lastvisit} || "before 2005-12-02" %>) +% } +
+% } + +% if (my $error = $pause->{error}) { + ++% } +% if (!$pause->{HiddenUser}{mfa}) { +
+
+
+% } else {
+Scan the QR code and submit 6-digit code to enable Multifactor Authentication.
+If you really need to disable multifactor authentication, please look at your authenticator and submit 6-digit code shown there (or one of the recovery codes you have never used before).
+<%= hidden_field "pause99_mfa_reset" => 1, autocomplete => 'off' %> +% } + +
+
+
+%= csrf_field
diff --git a/lib/pause_2025/templates/user/perms/_share_makeco.html.ep b/lib/pause_2025/templates/user/perms/_share_makeco.html.ep
new file mode 100644
index 000000000..bda6b865c
--- /dev/null
+++ b/lib/pause_2025/templates/user/perms/_share_makeco.html.ep
@@ -0,0 +1,64 @@
+% my $pause = stash(".pause") || {};
+
+% if (param("SUBMIT_pause99_share_perms_makeco")) {
+CODE: <%= text_field "pause99_mfa_code" => '', + size => 10, + maxlength => 10, + autocomplete => 'off', +%> +
+
+% if ($pause->{error}) {
+
+<%= $pause->{error} %>
+% } elsif (@{$pause->{results} || []}) { +% for (@{$pause->{results}}) { +% if ($_->{error}) { +Error trying to add <%= $_->{user} %> to co-maintainers of <%= $_->{mod} %>: <%= $_->{error} %>
+% } elsif ($_->{duplicated}) { +<%= $_->{user} %> was already a co-maintainer of <%= $_->{mod} %>: skipping
+ +% } else { +Added <%= $_->{user} %> to co-maintainers of <%= $_->{mod} %>.
+% } +% } +% } else { +You need to select one or more packages and enter a userid. + Nothing done.
+% } ++% } + +% if (@{$pause->{mods} || []}) { + +
Select a co-maintainer
+Please select one or +more namespaces for which you want to select a +co-maintainer, enter the CPAN userid of the co-maintainer +into the text field and press Make Co-Maintainer
+ +If you are open to someone else asking for your first-come +permissions, but you wish to decide on any such request, you +can give a co-maint to a special user called +HANDOFF.
+ +You can also grant co-maint to +NEEDHELP +if you would like additional volunteers to help you work on a particular module.
+ +If you want to add comaintainers for all the modules in a +distribution, visit +Add Comaintainers per distribution page.
+ +Select one or more namespaces:
+ +<%= select_field "pause99_share_perms_makeco_m" => $pause->{mods}, + multiple => "multiple", + size => (@{$pause->{mods}} > 18 ? 15 : scalar @{$pause->{mods}}), +=%> + +
+Select a userid:
+<%= text_field "pause99_share_perms_makeco_a", size => 15, maxlength => 9 %>
+
+
+
+ +% } else { +Sorry, there are no modules registered belonging to <%= $pause->{HiddenUser}{userid} || $pause->{User}{userid} %>.
+% } diff --git a/lib/pause_2025/templates/user/perms/_share_movepr.html.ep b/lib/pause_2025/templates/user/perms/_share_movepr.html.ep new file mode 100644 index 000000000..d7239e0cc --- /dev/null +++ b/lib/pause_2025/templates/user/perms/_share_movepr.html.ep @@ -0,0 +1,52 @@ +% my $pause = stash(".pause") || {}; + +% if (param("SUBMIT_pause99_share_perms_movepr")) { +
+% if ($pause->{error}) {
+
+<%= $pause->{error} %>
+% } elsif (@{$pause->{results} || []}) { +% for my $res (@{$pause->{results}}) { +% if ($res->{error}) { +Error trying to make <%= $res->{user} %> primary maintainer of <%= $res->{mod} %>: <%= $res->{error} %>
\n"; +% } else { +Made <%= $res->{user} %> primary maintainer of <%= $res->{mod} %>.
+% } +% } +% } else { +You need to select one or more packages and enter a userid. +Nothing done.
+% } ++% } + +% if (@{$pause->{mods}}) { +
Pass maintainership status
Please select one +or more namespaces for which you want to pass primary +maintainership status, enter the CPAN userid of the new +maintainer into the text field and press Pass Maintainership +Status. Note: you keep co-maintainer status after this move. +If you want to get rid of that too, please visit Give up +co-maintainership status next.
+ +If you want to transfer all the modules in a distribution, visit + +Transfer Primary Permissions per distribution page.
+ +Select one or more namespaces:
+<%= select_field "pause99_share_perms_pr_m" => $pause->{mods}, + multiple => "multiple", + size => (@{$pause->{mods}} > 18 ? 15 : scalar @{$pause->{mods}}), +=%> + +
+Select a userid:
+<%= text_field "pause99_share_perms_movepr_a", size => 15, maxlength => 9 =%>
+
+
+ +% } else { +Sorry, there are no modules registered belonging to <%= $pause->{HiddenUser}{userid} || $pause->{User}{userid} %>.
+% } + diff --git a/lib/pause_2025/templates/user/perms/_share_remocos.html.ep b/lib/pause_2025/templates/user/perms/_share_remocos.html.ep new file mode 100644 index 000000000..498c83c0b --- /dev/null +++ b/lib/pause_2025/templates/user/perms/_share_remocos.html.ep @@ -0,0 +1,48 @@ +% my $pause = stash(".pause") || {}; + +% if (param("SUBMIT_pause99_share_perms_remocos")) { +
+% if ($pause->{error}) {
+
+<%= $pause->{error} %>
+% } elsif (@{$pause->{results} || []}) { +% for (@{$pause->{results}}) { +% if ($_->{not_exists}) { +Cannot handle tuple <%= $_->{mod} %>. If you believe, this is a bug, please complain.
+% } elsif ($_->{error}) { +Error trying to remove <%= $_->{user} %> from co-maintainers of <%= $_->{mod} %>: <%= $_->{error} %>
+% } else { +Removed <%= $_->{user} %> from co-maintainers of <%= $_->{mod} %>.
+% } +% } +% } else { +You need to select one or more packages. Nothing done.
+% } ++% } + +% if (@{$pause->{mods} || []}) { +
Remove co-maintainer status
+The scrolling +list shows you, which packages are associated with other +maintainers besides yourself. Every line denotes a tuple +of a namespace and a userid. Select those that you want to +remove and press Remove
+ +
If you want to remove comaintainers from all the modules +in a distribution, visit + +Remove Comaintainers per distribution page.
+ +<%= select_field "pause99_share_perms_remocos_tuples" => $pause->{mods}, + multiple => "multiple", + size => (@{$pause->{mods}} > 18 ? 15 : scalar (@{$pause->{mods}})), +%> + ++
+ +% } else { +There are no co-maintainers registered to any of <%= $pause->{HiddenUser}{userid} || $pause->{User}{userid} %>'s modules.
+% } diff --git a/lib/pause_2025/templates/user/perms/_share_remome.html.ep b/lib/pause_2025/templates/user/perms/_share_remome.html.ep new file mode 100644 index 000000000..b09b655df --- /dev/null +++ b/lib/pause_2025/templates/user/perms/_share_remome.html.ep @@ -0,0 +1,47 @@ +% my $pause = stash(".pause") || {}; + +% if (param("SUBMIT_pause99_share_perms_remome")) { +
+% if ($pause->{error}) {
+
+<%= $pause->{error} %>
+% } elsif (@{$pause->{results} || []}) { +% for (@{$pause->{results}}) { +% if ($_->{error}) { +Error trying to remove <%= $_->{user} %> from co-maintainers of <%= $_->{mod} %>: <%= $_->{error} %>
+% } else { +Removed <%= $_->{user} %> from co-maintainers of <%= $_->{mod} %>.
+% } +% } +% } else { +You need to select one or more packages. Nothing done.
+% } ++% } + +% if (@{$pause->{mods} || []}) { +
Give up co-maintainer status
+Please select one or +more namespaces for which you want to be removed from +the co-maintainer table and press Give Up
+ +If you want to give up comaintainership for all the modules +in a distribution, visit + +Give up Co-maintainership status per distribution page.
+ +Select one or more namespaces:
+ +<%= select_field "pause99_share_perms_remome_m" => $pause->{mods}, + multiple => "multiple", + size => (@{$pause->{mods}} > 18 ? 15 : scalar @{$pause->{mods}}), +=%> + +
++
+ +% } else { +Sorry, <%= $pause->{HiddenUser}{userid} || $pause->{User}{userid} %> does not seem to be co-maintainer of any module.
+% } diff --git a/lib/pause_2025/templates/user/perms/_share_remopr.html.ep b/lib/pause_2025/templates/user/perms/_share_remopr.html.ep new file mode 100644 index 000000000..d5d3c4526 --- /dev/null +++ b/lib/pause_2025/templates/user/perms/_share_remopr.html.ep @@ -0,0 +1,50 @@ +% my $pause = stash(".pause") || {}; + +% if (param("SUBMIT_pause99_share_perms_remopr")) { +
+% if ($pause->{error}) {
+
+<%= $pause->{error} %>
+% } elsif (!@{$pause->{results} || []}) { +You need to select one or more packages. Nothing done.
+% } else { +% for (@{$pause->{results}}) { +% if ($_->{error}) { +Error trying to remove primary maintainership of <%= $_->{user} %> from <%= $_->{mod} %>: <%= $_->{error} %>
+% } else { +Removed primary maintainership of <%= $_->{user} %> from <%= $_->{mod} %>.
+% } +% } +% } ++% } + +% if (@{$pause->{mods} || []}) { + +
Give up maintainership status
+Please select one or more namespaces for which you +want to give up primary maintainership status and press +Give Up Maintainership Status. Note: you keep co-maintainer +status after this move. If you want to get rid of that too, +please visit Give up +co-maintainership status next.
+ +If you want to give up comaintainership for all the modules +in a distribution, visit + +Give up Co-maintainership status per distribution page.
+ +Select one or more namespaces:
+<%= select_field "pause99_share_perms_pr_m" => $pause->{mods}, + multilple => "multiple", + size => (@{$pause->{mods}} > 18 ? 15 : scalar @{$pause->{mods}}), +=%> + +
+
+ +% } else { +Sorry, there are no modules registered belonging to <%= $pause->{HiddenUser}{userid} || $pause->{User}{userid} %>.
+% } + diff --git a/lib/pause_2025/templates/user/perms/giveup_comaint.html.ep b/lib/pause_2025/templates/user/perms/giveup_comaint.html.ep new file mode 100644 index 000000000..b82d0590e --- /dev/null +++ b/lib/pause_2025/templates/user/perms/giveup_comaint.html.ep @@ -0,0 +1,75 @@ +% layout 'layout'; +% my $pause = stash(".pause") || {}; + + + +% if (param("SUBMIT_pause99_share_perms_remome")) { +
+% if ($pause->{error}) {
+
+<%= $pause->{error} %>
+% } elsif (@{$pause->{results} || []}) { +-
+% for (@{$pause->{results}}) {
+% if ($_->{error}) {
+
- Error trying to remove <%= $_->{user} %> from co-maintainers of <%= $_->{mod} %>: <%= $_->{error} %> +% } else { +
- Removed <%= $_->{user} %> from co-maintainers of <%= $_->{mod} %>. +% } +% } +
You need to select one or more packages. Nothing done.
+% } ++% } + +% if (@{$pause->{mods} || []}) { +
Give up co-maintainer status
+Please select one or +more namespaces for which you want to be removed from +the co-maintainer table and press Give Up
+ +If you want to give up comaintainership for all the modules +in a distribution, visit + +Give up Co-maintainership status per distribution page.
+ +Select one or more namespaces:
+ +
+
+
+
+
+
| + | Package | +Indexed Distribution | +
|---|---|---|
| <%= check_box "pause99_share_perms_remome_m" => $_ %> | +<%= $_ %> | +<%= $pause->{dist_for_package}{$_} // '' %> | +
+
+
+% content_for javascript => begin
+%= javascript "/pause/list.min.js"
+%= javascript begin
+var List = new List('packages', {
+ valueNames: ['package', 'dist']
+});
+% end
+% end
+
+% } else {
+
+% } + +% if (@{$pause->{mods} || []}) { + +
+% } + +% if (@{$pause->{mods}}) { +
+% } + +% if (@{$pause->{mods} || []}) { +
+% } + +% if (@{$pause->{mods} || []}) { + +
+
+
+
+
+% } else {
+%= include "user/perms/_share_$subaction";
+% }
diff --git a/lib/pause_2025/templates/user/reindex.html.ep b/lib/pause_2025/templates/user/reindex.html.ep
new file mode 100644
index 000000000..31befcf4f
--- /dev/null
+++ b/lib/pause_2025/templates/user/reindex.html.ep
@@ -0,0 +1,58 @@
+% layout 'layout';
+% my $pause = stash(".pause") || {};
+% my $files = $pause->{files} || {};
+
+
+
+% } + +
+% } +% if (%{$pause->{packages} || {}}) { +
diff --git a/lib/pause_2025/templates/user/uri/add.html.ep b/lib/pause_2025/templates/user/uri/add.html.ep new file mode 100644 index 000000000..d2d59be85 --- /dev/null +++ b/lib/pause_2025/templates/user/uri/add.html.ep @@ -0,0 +1,132 @@ +% layout 'layout'; +% my $pause = stash(".pause") || {}; + + +<%# just for compatibility; will be removed eventually =%> + + sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ $t->get_ok("/pause/authenquery?ACTION=tail_logfile");
+ # note $t->content;
+ }
+};
+
+subtest 'post: basic' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+
+ my %form = %$default;
+ $t->post_ok("$path?ACTION=tail_logfile", \%form);
+ # note $t->content;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2017/who_admin.t b/t/pause_2025/action_2017/who_admin.t
new file mode 100644
index 000000000..f8a41cb07
--- /dev/null
+++ b/t/pause_2025/action_2017/who_admin.t
@@ -0,0 +1,44 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use YAML::Syck ();
+
+Test::PAUSE::Web->setup;
+
+# SELECT user FROM grouptable WHERE ugroup='admin' order by user");
+subtest 'get' => sub {
+ Test::PAUSE::Web->authen_db->insert('grouptable', {
+ user => "FOO",
+ ugroup => "admin",
+ });
+ Test::PAUSE::Web->authen_db->insert('grouptable', {
+ user => "BAR",
+ ugroup => "admin",
+ });
+ Test::PAUSE::Web->authen_db->insert('grouptable', {
+ user => "BAZ",
+ ugroup => "bar",
+ });
+
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+
+ $t->get_ok("$path?ACTION=who_admin")
+ ->text_like('body', qr/Registered admins:\s+BAR, FOO/);
+
+ $t->get_ok("$path?ACTION=who_admin&OF=YAML");
+ my $list_amp = YAML::Syck::Load( $t->content );
+ is_deeply( $list_amp, [qw/BAR FOO TESTADMIN/], "YAML output works" );
+
+ SKIP: {
+ skip "; is not supported anymore", 1;
+ $t->get_ok("$path?ACTION=who_admin;OF=YAML");
+ my $list_sem = YAML::Syck::Load( $t->content );
+ is_deeply( $list_sem, [qw/BAR FOO TESTADMIN/], "YAML output works" );
+ }
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2017/who_pumpkin.t b/t/pause_2025/action_2017/who_pumpkin.t
new file mode 100644
index 000000000..4e60d2bc5
--- /dev/null
+++ b/t/pause_2025/action_2017/who_pumpkin.t
@@ -0,0 +1,44 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use YAML::Syck ();
+
+Test::PAUSE::Web->setup;
+
+# SELECT user FROM grouptable WHERE ugroup='pumpking' order by user");
+subtest 'get' => sub {
+ Test::PAUSE::Web->authen_db->insert('grouptable', {
+ user => "FOO",
+ ugroup => "pumpking",
+ });
+ Test::PAUSE::Web->authen_db->insert('grouptable', {
+ user => "BAR",
+ ugroup => "pumpking",
+ });
+ Test::PAUSE::Web->authen_db->insert('grouptable', {
+ user => "BAZ",
+ ugroup => "baz",
+ });
+
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+
+ $t->get_ok("$path?ACTION=who_pumpkin")
+ ->text_like("body", qr/Registered pumpkins:\s+BAR, FOO/);
+
+ $t->get_ok("$path?ACTION=who_pumpkin&OF=YAML");
+ my $list_amp = YAML::Syck::Load( $t->content );
+ is_deeply( $list_amp, [qw/BAR FOO/], "YAML output works" );
+
+ SKIP: {
+ skip "; is not supported anymore", 1;
+ $t->get_ok("$path?ACTION=who_pumpkin;OF=YAML");
+ my $list_sem = YAML::Syck::Load( $t->content );
+ is_deeply( $list_sem, [qw/BAR FOO/], "YAML output works" );
+ }
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2025/add_uri.t b/t/pause_2025/action_2025/add_uri.t
new file mode 100644
index 000000000..e911c50e0
--- /dev/null
+++ b/t/pause_2025/action_2025/add_uri.t
@@ -0,0 +1,308 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use File::Path qw/rmtree mkpath/;
+use File::Spec;
+use Mojo::File qw/path/;
+use utf8;
+
+my $http_upload = {
+ pause99_add_uri_httpupload => ["$Test::PAUSE::Web::AppRoot/htdocs/index.html", "index.html"],
+ SUBMIT_pause99_add_uri_httpupload => 1,
+};
+
+my $uri_upload = {
+ pause99_add_uri_uri => "file://".File::Spec->rel2abs(__FILE__),
+ SUBMIT_pause99_add_uri_uri => 1,
+};
+
+Test::PAUSE::Web->setup;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ $t->get_ok("user/add_uri");
+ # note $t->content;
+ }
+};
+
+subtest 'get: user with subdirs' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $user_home = $PAUSE::Config->{MLROOT}."/".PAUSE::user2dir($user);
+ my $subdir = path("$user_home/test");
+ $subdir->make_path;
+ $subdir->child("stuff.txt")->spew("Foo");
+
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ $t->get_ok("/user/add_uri");
+ $t->text_is('select[name="pause99_add_uri_subdirscrl"] option[value="."]', "."); # default
+ $t->text_is('select[name="pause99_add_uri_subdirscrl"] option[value="test"]', "test");
+ # note $t->content;
+ }
+};
+
+subtest 'post: basic' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ my %form = %$http_upload;
+ my $file = $PAUSE::Config->{INCOMING_LOC}."/".$form{pause99_add_uri_httpupload}[1];
+ ok !-f $file, "file to upload does not exist";
+
+ $t->mod_dbh->do('TRUNCATE uris');
+ $t->post_ok("/user/add_uri", \%form, "Content-Type" => "form-data");
+ # note $t->content;
+
+ ok -f $file, "uploaded file exists";
+ unlink $file;
+
+ my $rows = $t->mod_db->select('uris', ['*'], {
+ userid => $user,
+ uri => $form{pause99_add_uri_httpupload}[1],
+ });
+ is @$rows => 1;
+ }
+};
+
+subtest 'post: under a new subdir' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ my %form = %$http_upload;
+ $form{pause99_add_uri_subdirtext} = "new_dir";
+
+ my $file = $PAUSE::Config->{INCOMING_LOC}."/".$form{pause99_add_uri_httpupload}[1];
+ ok !-f $file, "file to upload does not exist";
+
+ $t->mod_dbh->do('TRUNCATE uris');
+ $t->post_ok("/user/add_uri", \%form, "Content-Type" => "form-data");
+ # note $t->content;
+
+ ok -f $file, "uploaded file exists";
+ unlink $file;
+
+ my $rows = $t->mod_db->select('uris', ['*'], {
+ userid => $user,
+ uri => $form{pause99_add_uri_httpupload}[1],
+ });
+ is @$rows => 1;
+ like $rows->[0]{uriid} => qr!/new_dir/!, "uriid contains /new_dir/";
+ }
+};
+
+subtest 'post: under a Perl6 subdir' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ my %form = %$http_upload;
+ $form{pause99_add_uri_subdirscrl} = "Perl6";
+
+ my $user_home = $PAUSE::Config->{MLROOT}."/".PAUSE::user2dir($user);
+ my $subdir = path("$user_home/Perl6");
+ $subdir->make_path;
+ $subdir->child("stuff.txt")->spew("Foo");
+
+ my $file = $PAUSE::Config->{INCOMING_LOC}."/".$form{pause99_add_uri_httpupload}[1];
+ ok !-f $file, "file to upload does not exist";
+
+ $t->mod_dbh->do('TRUNCATE uris');
+ $t->post_ok("/user/add_uri", \%form, "Content-Type" => "form-data");
+ # note $t->content;
+
+ ok -f $file, "uploaded file exists";
+ unlink $file;
+
+ my $rows = $t->mod_db->select('uris', ['*'], {
+ userid => $user,
+ uri => $form{pause99_add_uri_httpupload}[1],
+ });
+ is @$rows => 1;
+ like $rows->[0]{uriid} => qr!/Perl6/!, "uriid contains /Perl6/";
+ ok $rows->[0]{is_perl6};
+ }
+};
+
+subtest 'post: empty' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ my %form = %$http_upload;
+ $form{pause99_add_uri_httpupload} = [undef, 'index.html'];
+
+ $t->mod_dbh->do('TRUNCATE uris');
+ $t->post_ok("/user/add_uri", \%form, "Content-Type" => "form-data");
+ # note $t->content;
+
+ my $rows = $t->mod_db->select('uris', ['*'], {
+ userid => $user,
+ uri => $form{pause99_add_uri_httpupload}[1],
+ });
+ is @$rows => 0;
+ }
+};
+
+subtest 'post: renamed' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ my %form = %$http_upload;
+ $form{pause99_add_uri_httpupload} = ["$Test::PAUSE::Web::AppRoot/htdocs/index.html", 'html/index.html'];
+ my $file = $PAUSE::Config->{INCOMING_LOC}."/index.html";
+ ok !-f $file, "file to upload does not exist";
+
+ $t->mod_dbh->do('TRUNCATE uris');
+ $t->post_ok("/user/add_uri", \%form, "Content-Type" => "form-data");
+ # note $t->content;
+
+ # renamed file exists
+ ok -f $file, "uploaded file exists";
+ unlink $file;
+
+ my $rows = $t->mod_db->select('uris', ['*'], {
+ userid => $user,
+ uri => "index.html",
+ });
+ is @$rows => 1;
+ }
+};
+
+subtest 'post: uri' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ my %form = %$uri_upload;
+
+ $t->mod_dbh->do('TRUNCATE uris');
+ $t->post_ok("/user/add_uri", \%form, "Content-Type" => "form-data");
+ # note $t->content;
+
+ my $rows = $t->mod_db->select('uris', ['*'], {
+ userid => $user,
+ uri => $form{pause99_add_uri_uri},
+ });
+ is @$rows => 1;
+ }
+};
+
+subtest 'post: CHECKSUMS' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ my %form = %$http_upload;
+ $form{pause99_add_uri_httpupload} = ["$Test::PAUSE::Web::AppRoot/htdocs/index.html", "CHECKSUMS"],
+
+ $t->mod_dbh->do('TRUNCATE uris');
+ $t->post_ok("/user/add_uri", \%form, "Content-Type" => "form-data");
+ $t->text_like('.error_message' => qr/Files with the name CHECKSUMS cannot be/);
+ # note $t->content;
+
+ my $rows = $t->mod_db->select('uris', ['*'], {
+ userid => $user,
+ uri => $form{pause99_add_uri_httpupload}[1],
+ });
+ is @$rows => 0;
+ }
+};
+
+subtest 'post: allow overwrite' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ my %form = %$http_upload;
+ my $file = $PAUSE::Config->{INCOMING_LOC}."/".$form{pause99_add_uri_httpupload}[1];
+ ok !-f $file, "file to upload does not exists";
+
+ $t->mod_dbh->do('TRUNCATE uris');
+ for (0 .. 1) {
+ $t->post_ok("/user/add_uri", \%form, "Content-Type" => "form-data");
+ # note $t->content;
+
+ # uploaded file exists
+ ok -f $file, "uploaded file exists";
+ unlink $file;
+ }
+
+ my $rows = $t->mod_db->select('uris', ['*'], {
+ userid => $user,
+ uri => $form{pause99_add_uri_httpupload}[1],
+ });
+ is @$rows => 1;
+ }
+};
+
+subtest 'post: duplicate' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ my %form = %$http_upload;
+ $form{pause99_add_uri_httpupload} = ["$Test::PAUSE::Web::AppRoot/htdocs/index.html", "index.tar.gz"],
+ my $file = $PAUSE::Config->{INCOMING_LOC}."/".$form{pause99_add_uri_httpupload}[1];
+ ok !-f $file, "file to upload does not exist";
+
+ $t->mod_dbh->do('TRUNCATE uris');
+ $t->post_ok("/user/add_uri", \%form, "Content-Type" => "form-data");
+ # note $t->content;
+
+ ok -f $file, "uploaded file exists";
+ unlink $file;
+
+ my $rows = $t->mod_db->select('uris', ['*'], {
+ userid => $user,
+ uri => $form{pause99_add_uri_httpupload}[1],
+ });
+ is @$rows => 1;
+
+ my $res = $t->post("/user/add_uri", \%form, "Content-Type" => "form-data");
+ is $res->code => 409;
+ # note $t->content;
+
+ ok -f $file, "uploaded file exists";
+ unlink $file;
+
+ $rows = $t->mod_db->select('uris', ['*'], {
+ userid => $user,
+ uri => $form{pause99_add_uri_httpupload}[1],
+ });
+ is @$rows => 1;
+ }
+};
+
+subtest 'post: to the site top, as various CPAN uploaders do/did' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ my %form = %$http_upload;
+ my $file = $PAUSE::Config->{INCOMING_LOC}."/".$form{pause99_add_uri_httpupload}[1];
+ ok !-f $file, "file to upload does not exist";
+
+ $t->mod_dbh->do('TRUNCATE uris');
+ $t->post_ok("/", \%form, "Content-Type" => "form-data");
+ # note $t->content;
+
+ ok -f $file, "uploaded file exists";
+ unlink $file;
+
+ my $rows = $t->mod_db->select('uris', ['*'], {
+ userid => $user,
+ uri => $form{pause99_add_uri_httpupload}[1],
+ });
+ is @$rows => 1;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2025/add_user.t b/t/pause_2025/action_2025/add_user.t
new file mode 100644
index 000000000..55c21afd2
--- /dev/null
+++ b/t/pause_2025/action_2025/add_user.t
@@ -0,0 +1,286 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+
+my $new_user = {
+ SUBMIT_pause99_add_user_Definitely => 1,
+ pause99_add_user_userid => "NEWUSER",
+ pause99_add_user_fullname => "new user",
+ pause99_add_user_email => "new_user\@localhost.localdomain",
+ pause99_add_user_homepage => "http://home.page",
+};
+
+my $new_mailing_list = {
+ SUBMIT_pause99_add_user_Definitely => 1,
+ pause99_add_user_userid => "MAILLIST",
+ pause99_add_user_fullname => "Mailing List",
+ pause99_add_user_email => "ml\@localhost.localdomain",
+ pause99_add_user_subscribe => "how to subscribe",
+};
+
+my $default = {
+ HIDDENNAME => "TESTUSER",
+ ACTIONREQ => "edit_ml",
+ pause99_select_ml_action_sub => 1,
+};
+
+Test::PAUSE::Web->setup;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('admin')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ $t->get_ok("/admin/add_user");
+ # note $t->content;
+ }
+};
+
+subtest 'post: ordinary user' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('admin')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+
+ $t->reset_fixture;
+ $t->post_ok("/admin/add_user", $new_user);
+ # note $t->content;
+
+ # new user exists
+ my $rows = $t->mod_db->select('users', ['*'], {
+ userid => $new_user->{pause99_add_user_userid},
+ });
+ is @$rows => 1;
+ for my $key (qw/userid homepage fullname/) {
+ is $rows->[0]{$key} => $new_user->{"pause99_add_user_$key"}, "$key is stored correctly";
+ }
+ is $rows->[0]{email} => 'CENSORED'; # email in the user table is always CENSORED
+
+ # email tests; censored email shouldn't be disclosed to admins
+ my @deliveries = $t->deliveries;
+ my @welcome_emails = grep { $_->header('Subject') =~ /Welcome/ } @deliveries;
+ is @welcome_emails => 2;
+ my ($welcome_for_user) = grep { $_->header('To') =~ /new_user/ } @welcome_emails;
+ like $welcome_for_user->body => qr/email:\s+new_user\@localhost/;
+
+ my ($welcome_for_admins) = grep { $_->header('To') =~ /admin/ } @welcome_emails;
+ unlike $welcome_for_admins->body => qr/email:\s+new_user\@localhost/;
+ like $welcome_for_admins->body => qr/email:\s+CENSORED/;
+ }
+};
+
+subtest 'post: user with an accent in their name' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('admin')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+
+ $t->reset_fixture;
+ $t->post_ok("/admin/add_user", {
+ %$new_user,
+ pause99_add_user_fullname => "T\xc3\xa9st Name",
+ });
+ # note $t->content;
+
+ # new user exists
+ my $rows = $t->mod_db->select('users', ['*'], {
+ userid => $new_user->{pause99_add_user_userid},
+ });
+ is @$rows => 1;
+ SKIP: {
+ skip "FIXME: seems not so stable; probably needs more explicit configuration", 1;
+ is $rows->[0]{fullname} => "T\xc3\xa9st Name";
+ }
+ }
+};
+
+subtest 'post: soundex' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('admin')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+
+ my %copied_user = %$new_user;
+ $copied_user{pause99_add_user_fullname} = 'new user';
+ $copied_user{SUBMIT_pause99_add_user_Soundex} = 1;
+ delete $copied_user{SUBMIT_pause99_add_user_Definitely};
+
+ $t->reset_fixture;
+ $t->post_ok("/admin/add_user", {
+ %copied_user,
+ });
+ # note $t->content;
+
+ # new user exists
+ my $rows = $t->mod_db->select('users', ['*'], {
+ userid => $new_user->{pause99_add_user_userid},
+ });
+ is @$rows => 1;
+ }
+};
+
+subtest 'post: soundex error: similar name' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('admin')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+
+ my %copied_user = %$new_user;
+ $copied_user{pause99_add_user_fullname} = 'new nome';
+ $copied_user{SUBMIT_pause99_add_user_Soundex} = 1;
+ delete $copied_user{SUBMIT_pause99_add_user_Definitely};
+
+ $t->reset_fixture;
+ $t->post_ok("/admin/add_user", {
+ %copied_user,
+ });
+ $t->text_like('h3', qr/Not submitting NEWUSER, maybe we have a duplicate/);
+ # note $t->content;
+
+ # new user does not exist
+ my $rows = $t->mod_db->select('users', ['*'], {
+ userid => $new_user->{pause99_add_user_userid},
+ });
+ is @$rows => 0;
+ }
+};
+
+subtest 'post: metaphone' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('admin')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+
+ my %copied_user = %$new_user;
+ $copied_user{pause99_add_user_fullname} = 'new user';
+ $copied_user{SUBMIT_pause99_add_user_Metaphone} = 1;
+ delete $copied_user{SUBMIT_pause99_add_user_Definitely};
+
+ $t->reset_fixture;
+ $t->post_ok("/admin/add_user", {
+ %copied_user,
+ });
+ # note $t->content;
+
+ # new user exists
+ my $rows = $t->mod_db->select('users', ['*'], {
+ userid => $new_user->{pause99_add_user_userid},
+ });
+ is @$rows => 1;
+ }
+};
+
+subtest 'post: metaphone error: similar name' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('admin')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+
+ my %copied_user = %$new_user;
+ $copied_user{pause99_add_user_fullname} = 'new nome';
+ $copied_user{SUBMIT_pause99_add_user_Metaphone} = 1;
+ delete $copied_user{SUBMIT_pause99_add_user_Definitely};
+
+ $t->reset_fixture;
+ $t->post_ok("/admin/add_user", {
+ %copied_user,
+ });
+ $t->text_like('h3', qr/Not submitting NEWUSER, maybe we have a duplicate/);
+ # note $t->content;
+
+ # new user does not exist
+ my $rows = $t->mod_db->select('users', ['*'], {
+ userid => $new_user->{pause99_add_user_userid},
+ });
+ is @$rows => 0;
+ }
+};
+
+subtest 'post: metaphone error: completely duplicated' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('admin')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+
+ my %copied_user = %$new_user;
+ $copied_user{SUBMIT_pause99_add_user_Metaphone} = 1;
+ delete $copied_user{SUBMIT_pause99_add_user_Definitely};
+
+ $t->reset_fixture;
+ $t->post_ok("/admin/add_user", {
+ %copied_user,
+ });
+
+ # new user exists
+ my $rows = $t->mod_db->select('users', ['*'], {
+ userid => $new_user->{pause99_add_user_userid},
+ });
+ is @$rows => 1;
+
+ $t->post_ok("/admin/add_user", {
+ %copied_user,
+ });
+ $t->text_like('h3', qr/Not submitting NEWUSER, maybe we have a duplicate/);
+ # note $t->content;
+ }
+};
+
+subtest 'post: mailing list' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('admin')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+
+ $t->reset_fixture;
+ $t->post_ok("/admin/add_user", $new_mailing_list);
+ # note $t->content;
+
+ # new mailing list exists
+ my $rows = $t->mod_db->select('maillists', ['*'], {
+ maillistid => $new_mailing_list->{pause99_add_user_userid},
+ });
+ is @$rows => 1;
+
+ # new user also exists
+ $rows = $t->mod_db->select('users', ['*'], {
+ userid => $new_mailing_list->{pause99_add_user_userid},
+ });
+ is @$rows => 1;
+ }
+};
+
+subtest 'get: retrieve a stored session' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('admin')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+
+ my %requested_user;
+ for my $key (keys %$new_user) {
+ next if $key =~ /SUBMIT/;
+ my $new_key = $key =~ s/add_user/request_id/r;
+ $requested_user{$new_key} = $new_user->{$key};
+ }
+ $requested_user{pause99_request_id_rationale} = 'Rational to request PAUSE ID';
+ $requested_user{SUBMIT_pause99_request_id_sub} = 1;
+
+ $t->reset_fixture;
+ $t->post_ok("/public/request_id", \%requested_user);
+ my ($email) = map {$_->body} $t->deliveries;
+ my ($userid) = $email =~ m!https://.+?/admin/add_user\?USERID=([^&\s]+)!;
+ like $userid => qr/\A\d+_\w+\z/;
+ $t->clear_deliveries;
+
+ $t->get_ok("/admin/add_user?USERID=$userid");
+ # note $t->content;
+
+ for my $key (keys %$new_user) {
+ next if $key =~ /SUBMIT/;
+ is $t->dom->at("input[name=$key]")->attr('value') => $new_user->{$key}, "$key is set correctly";
+ }
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2025/change_passwd.t b/t/pause_2025/action_2025/change_passwd.t
new file mode 100644
index 000000000..95168ecc2
--- /dev/null
+++ b/t/pause_2025/action_2025/change_passwd.t
@@ -0,0 +1,239 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use Time::Piece;
+use utf8;
+
+my $default = {
+ pause99_change_passwd_pw1 => "new_pass",
+ pause99_change_passwd_pw2 => "new_pass",
+ pause99_change_passwd_sub => 1,
+};
+
+Test::PAUSE::Web->setup;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ $t->get_ok("/user/change_passwd");
+ # note $t->content;
+ }
+};
+
+subtest 'get: public without ABRA' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ next if $user; # public only
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ $t->authen_dbh->do('TRUNCATE abrakadabra');
+ my $res = $t->get("/public/change_passwd");
+ is $res->code => 403;
+ # note $t->content;
+ }
+};
+
+subtest 'get: public with ABRA' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ next if $user; # public only
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+
+ my $chuser = 'TESTUSER';
+ my $chpass = 'testpassword';
+ $t->authen_dbh->do('TRUNCATE abrakadabra');
+ ok $t->authen_db->insert('abrakadabra', {
+ user => $chuser,
+ chpasswd => $chpass,
+ expires => Time::Piece->new(time + 3600)->strftime('%Y-%m-%d %H:%M:%S'),
+ });
+
+ $t->get_ok("/public/change_passwd?ABRA=$chuser.$chpass");
+ # note $t->content;
+
+ # No links should keep ABRA (71a745d)
+ my @links = map {$_->attr('href')} $t->dom->at('a');
+ ok !grep {$_ =~ /ABRA=/} @links;
+ }
+};
+
+subtest 'post: basic' => sub {
+ Test::PAUSE::Web->setup;
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my %form = %$default;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ my $res = $t->post("/user/change_passwd", \%form);
+ ok !$res->is_success && $res->code == 403, "Forbidden";
+ like $res->content => qr/Failed CSRF check/;
+ # note $t->content;
+ }
+};
+
+subtest 'post_with_token: basic' => sub {
+ Test::PAUSE::Web->setup;
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my %form = %$default;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ $t->post_with_token_ok("/user/change_passwd", \%form)
+ ->text_like("p.password_stored", qr/New password stored/);
+ is $t->deliveries => 1, "one delivery for admin";
+ # note $t->content;
+ }
+};
+
+subtest 'post_with_token: user with CENSORED email' => sub {
+ Test::PAUSE::Web->setup;
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ $user = "TESTCNSRD" if $user eq "TESTUSER";
+
+ my %form = %$default;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ $t->post_with_token_ok("/user/change_passwd", \%form)
+ ->text_like("p.password_stored", qr/New password stored/);
+ my @deliveries = $t->deliveries;
+ is @deliveries => 1, "one delivery for admin";
+ my $email = $deliveries[0]->as_string;
+ unlike $email => qr/CENSORED/;
+ like $email => qr/testcnsrd\@localhost/;
+ note $email;
+ # note $t->content;
+ }
+};
+
+subtest 'post_with_token: public without ABRA' => sub {
+ Test::PAUSE::Web->setup;
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ next if $user; # public only
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ $t->authen_dbh->do('TRUNCATE abrakadabra');
+
+ my %form = %$default;
+ my $res = $t->post_with_token("/public/change_passwd", \%form);
+ is $res->code => 403;
+ # note $t->content;
+ }
+};
+
+subtest 'post_with_token: public with ABRA' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ next if $user; # public only
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+
+ my $chuser = 'TESTUSER';
+ my $chpass = 'testpassword';
+ $t->authen_dbh->do('TRUNCATE abrakadabra');
+ ok $t->authen_db->insert('abrakadabra', {
+ user => $chuser,
+ chpasswd => $chpass,
+ expires => Time::Piece->new(time + 3600)->strftime('%Y-%m-%d %H:%M:%S'),
+ });
+
+ my %form = %$default;
+ $t->post_with_token_ok("/public/change_passwd?ABRA=$chuser.$chpass", \%form);
+ $t->text_like("p.password_stored", qr/New password stored/);
+ # note $t->content;
+
+ # No links should keep ABRA (71a745d)
+ my @links = map {$_->attr('href')} $t->dom->at('a');
+ ok !grep {$_ =~ /ABRA=/} @links;
+
+ # Used ABRA is gone (8234a6a)
+ my $res = $t->post_with_token("/public/change_passwd?ABRA=$chuser.$chpass", \%form);
+ ok !$res->is_success;
+ is $res->code => 401;
+ }
+};
+
+subtest 'post_with_token: public with incorrect ABRA' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ next if $user; # public only
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+
+ my $chuser = 'TESTUSER';
+ my $chpass = 'testpassword';
+ $t->authen_dbh->do('TRUNCATE abrakadabra');
+ ok $t->authen_db->insert('abrakadabra', {
+ user => $chuser,
+ chpasswd => $chpass,
+ expires => Time::Piece->new(time + 3600)->strftime('%Y-%m-%d %H:%M:%S'),
+ });
+
+ my %form = %$default;
+ my $res = $t->post_with_token("/public/change_passwd?ABRA=$chuser.wrong$chpass", \%form);
+ is $res->code => 401;
+ # note $t->content;
+ }
+};
+
+subtest 'post_with_token: passwords mismatch' => sub {
+ Test::PAUSE::Web->setup;
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ my %form = (
+ %$default,
+ pause99_change_passwd_pw2 => "wrong_pass",
+ );
+ $t->post_with_token_ok("/user/change_passwd", \%form)
+ ->text_is("h2", "Error")
+ ->text_like("p.error_message", qr/The two passwords didn't match./);
+ ok !$t->deliveries, "no delivery for admin";
+ # note $t->content;
+ }
+};
+
+subtest 'post_with_token: only one password' => sub {
+ Test::PAUSE::Web->setup;
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ my %form = (
+ %$default,
+ pause99_change_passwd_pw2 => undef,
+ );
+ $t->post_with_token_ok("/user/change_passwd", \%form)
+ ->text_is("h2", "Error")
+ ->text_like("p.error_message", qr/You need to fill in the same password in both fields./);
+ ok !$t->deliveries, "no delivery for admin";
+ # note $t->content;
+ }
+};
+
+subtest 'post_with_token: no password' => sub {
+ Test::PAUSE::Web->setup;
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ my %form = (
+ %$default,
+ pause99_change_passwd_pw1 => undef,
+ pause99_change_passwd_pw2 => undef,
+ );
+ $t->post_with_token_ok("/user/change_passwd", \%form)
+ ->text_is("h2", "Error")
+ ->text_like("p.error_message", qr/Please fill in the form with passwords./);
+ ok !$t->deliveries, "no delivery for admin";
+ # note $t->content;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2025/change_user_status.t b/t/pause_2025/action_2025/change_user_status.t
new file mode 100644
index 000000000..ae24f8ac4
--- /dev/null
+++ b/t/pause_2025/action_2025/change_user_status.t
@@ -0,0 +1,104 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+
+my $default = {
+ pause99_change_user_status_user => "TESTUSER",
+ pause99_change_user_status_new_ustatus => "nologin",
+ pause99_change_user_status_sub => 1,
+};
+
+Test::PAUSE::Web->setup;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('admin')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ $t->get_ok("/admin/change_user_status");
+ # note $t->content;
+ }
+};
+
+subtest 'post: basic' => sub {
+ Test::PAUSE::Web->setup;
+ for my $test (Test::PAUSE::Web->tests_for('admin')) {
+ my ($path, $user) = @$test;
+ my %form = %$default;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ my $res = $t->post("/admin/change_user_status", \%form);
+ ok !$res->is_success && $res->code == 403, "Forbidden";
+ like $res->content => qr/Failed CSRF check/;
+ # note $t->content;
+ }
+};
+
+subtest 'post_with_token: basic' => sub {
+ Test::PAUSE::Web->setup;
+ for my $test (Test::PAUSE::Web->tests_for('admin')) {
+ my ($path, $user) = @$test;
+ my %form = %$default;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ $t->post_with_token_ok("/admin/change_user_status", \%form)
+ ->text_like("div.messagebox p", qr/status has changed from \w+ to nologin/);
+ is $t->deliveries => 2, "two deliveries for admin";
+ # note $t->content;
+ }
+};
+
+subtest 'post_with_token: user not found' => sub {
+ Test::PAUSE::Web->setup;
+ for my $test (Test::PAUSE::Web->tests_for('admin')) {
+ my ($path, $user) = @$test;
+ my %form = (
+ %$default,
+ pause99_change_user_status_user => 'UNKNOWN',
+ );
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ $t->post_with_token_ok("/admin/change_user_status", \%form)
+ ->text_like("div.messagebox p", qr/User UNKNOWN is not found/);
+ is $t->deliveries => 0, "no deliveries for admin";
+ # note $t->content;
+ }
+};
+
+subtest 'post_with_token: ustatus not changed' => sub {
+ Test::PAUSE::Web->setup;
+ for my $test (Test::PAUSE::Web->tests_for('admin')) {
+ my ($path, $user) = @$test;
+ my %form = %$default;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ $t->post_with_token_ok("/admin/change_user_status", \%form)
+ ->text_like("div.messagebox p", qr/status has changed from \w+ to nologin/);
+ is $t->deliveries => 2, "two deliveries for admin";
+ # note $t->content;
+
+ # nologin to nologin
+ $t->post_with_token_ok("/admin/change_user_status", \%form)
+ ->dom_not_found("div.messagebox p");
+ is $t->deliveries => 0, "no deliveries for admin";
+ }
+};
+
+subtest 'post_with_token: unknown ustatus' => sub {
+ Test::PAUSE::Web->setup;
+ for my $test (Test::PAUSE::Web->tests_for('admin')) {
+ my ($path, $user) = @$test;
+ my %form = (
+ %$default,
+ pause99_change_user_status_new_ustatus => 'unknown',
+ );
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ $t->post_with_token_ok("/admin/change_user_status", \%form)
+ ->dom_not_found("div.messagebox p");
+ is $t->deliveries => 0, "no deliveries for admin";
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2025/delete_files.t b/t/pause_2025/action_2025/delete_files.t
new file mode 100644
index 000000000..7c6e03197
--- /dev/null
+++ b/t/pause_2025/action_2025/delete_files.t
@@ -0,0 +1,252 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+
+my $default_for_add_uri = {
+ pause99_add_uri_httpupload => [Test::PAUSE::Web->file_to_upload],
+ SUBMIT_pause99_add_uri_httpupload => 1,
+};
+
+my $default = {
+ pause99_delete_files_FILE => ["Hash-RenameKey-0.02.tar.gz"],
+};
+
+Test::PAUSE::Web->setup;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ $t->get_ok("/user/delete_files");
+ # note $t->content;
+ }
+};
+
+subtest 'post: basic' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+
+ $t->mod_dbh->do("TRUNCATE uris");
+ $t->mod_dbh->do("TRUNCATE deletes");
+ $t->remove_authors_dir($user);
+
+ # prepare distribution
+ $t->post_ok("/user/add_uri", $default_for_add_uri, "Content-Type" => "form-data");
+
+ $t->copy_to_authors_dir($user, scalar Test::PAUSE::Web->file_to_upload);
+
+ # delete
+ my %form = %$default;
+ $form{SUBMIT_pause99_delete_files_delete} = 1;
+ $t->post_ok("/user/delete_files", \%form);
+ # note $t->content;
+
+ my @deliveries = $t->deliveries;
+ is @deliveries => 2;
+ my ($mail_body) = map {$_->body} @deliveries;
+ like $mail_body => qr!/user/delete_files!;
+
+ my $rows = $t->mod_db->select('deletes', ['*']);
+ is @$rows => 1;
+ like $rows->[0]{deleteid} => qr!/$form{pause99_delete_files_FILE}[0]$!;
+
+ # undelete
+ delete $form{SUBMIT_pause99_delete_files_delete};
+ $form{SUBMIT_pause99_delete_files_undelete} = 1;
+ $t->post_ok("/user/delete_files", \%form);
+ # note $t->content;
+
+ ok $rows = $t->mod_db->select('deletes', ['*']);
+ ok !@$rows;
+ }
+};
+
+subtest 'post: absolute path' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+
+ $t->mod_dbh->do("TRUNCATE uris");
+ $t->mod_dbh->do("TRUNCATE deletes");
+ $t->remove_authors_dir($user);
+
+ # prepare distribution
+ $t->post_ok("/user/add_uri", $default_for_add_uri, "Content-Type" => "form-data");
+
+ my $copied = $t->copy_to_authors_dir($user, scalar Test::PAUSE::Web->file_to_upload);
+ ok(File::Spec->file_name_is_absolute($copied));
+
+ # delete
+ my %form = (
+ pause99_delete_files_FILE => [$copied],
+ SUBMIT_pause99_delete_files_delete => 1
+ );
+ $t->post_ok("/user/delete_files", \%form);
+ # note $t->content;
+
+ my @deliveries = $t->deliveries;
+ is @deliveries => 2;
+ my ($mail_body) = map {$_->body} @deliveries;
+ like $mail_body => qr/WARNING: illegal filename/;
+
+ my $rows = $t->mod_db->select('deletes', ['*']);
+ ok !@$rows;
+ }
+};
+
+subtest 'post: file not found' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+
+ $t->mod_dbh->do("TRUNCATE uris");
+ $t->mod_dbh->do("TRUNCATE deletes");
+ $t->remove_authors_dir($user);
+
+ # prepare distribution
+ $t->post_ok("/user/add_uri", $default_for_add_uri, "Content-Type" => "form-data");
+
+ my $copied = $t->copy_to_authors_dir($user, scalar Test::PAUSE::Web->file_to_upload);
+
+ # delete
+ my %form = (
+ pause99_delete_files_FILE => ['Something-Else-0.02.tar.gz'],
+ SUBMIT_pause99_delete_files_delete => 1
+ );
+ $t->post_ok("/user/delete_files", \%form);
+ # note $t->content;
+
+ my @deliveries = $t->deliveries;
+ is @deliveries => 2;
+ my ($mail_body) = map {$_->body} @deliveries;
+ like $mail_body => qr/WARNING: file not found/;
+
+ my $rows = $t->mod_db->select('deletes', ['*']);
+ ok !@$rows;
+ }
+};
+
+subtest 'post: CHECKSUMS' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+
+ $t->mod_dbh->do("TRUNCATE uris");
+ $t->mod_dbh->do("TRUNCATE deletes");
+ $t->remove_authors_dir($user);
+
+ # prepare distribution
+ $t->post_ok("/user/add_uri", $default_for_add_uri, "Content-Type" => "form-data");
+
+ my $copied = $t->copy_to_authors_dir($user, scalar Test::PAUSE::Web->file_to_upload);
+ $t->save_to_authors_dir($user, "CHECKSUMS", "CHECKSUMS");
+
+ # delete
+ my %form = (
+ pause99_delete_files_FILE => ['CHECKSUMS'],
+ SUBMIT_pause99_delete_files_delete => 1
+ );
+ $t->post_ok("/user/delete_files", \%form);
+ # note $t->content;
+
+ my @deliveries = $t->deliveries;
+ is @deliveries => 2;
+ my ($mail_body) = map {$_->body} @deliveries;
+ like $mail_body => qr/WARNING: CHECKSUMS not erasable/;
+
+ my $rows = $t->mod_db->select('deletes', ['*']);
+ ok !@$rows;
+ }
+};
+
+subtest 'post: readme' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+
+ $t->mod_dbh->do("TRUNCATE uris");
+ $t->mod_dbh->do("TRUNCATE deletes");
+ $t->remove_authors_dir($user);
+
+ # prepare distribution
+ $t->post_ok("/user/add_uri", $default_for_add_uri, "Content-Type" => "form-data");
+
+ my $copied = $t->copy_to_authors_dir($user, scalar Test::PAUSE::Web->file_to_upload);
+ $t->save_to_authors_dir($user, "Hash-RenameKey-0.02.readme", "README");
+
+ # delete
+ my %form = %$default;
+ $form{SUBMIT_pause99_delete_files_delete} = 1;
+ $t->post_ok("/user/delete_files", \%form);
+ # note $t->content;
+
+ # .readme is deleted when a related tarball is removed
+ my @deliveries = $t->deliveries;
+ is @deliveries => 2;
+ my ($mail_body) = map {$_->body} @deliveries;
+ like $mail_body => qr/\.readme/;
+
+ my $rows = $t->mod_db->select('deletes', ['*']);
+ is @$rows => 2;
+ ok grep {$_->{deleteid} =~ /\.readme$/} @$rows;
+ }
+};
+
+subtest 'post: delete by admin using select_user' => sub {
+ {
+ my $test = Test::PAUSE::Web->tests_for('user');
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+
+ $t->mod_dbh->do("TRUNCATE uris");
+ $t->mod_dbh->do("TRUNCATE deletes");
+ $t->remove_authors_dir($user);
+
+ # prepare distribution
+ $t->post_ok("/user/add_uri", $default_for_add_uri, "Content-Type" => "form-data");
+
+ my $copied = $t->copy_to_authors_dir($user, scalar Test::PAUSE::Web->file_to_upload);
+ }
+ {
+ my $test = Test::PAUSE::Web->tests_for('admin');
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+
+ my %action_form = (
+ HIDDENNAME => "TESTUSER",
+ ACTIONREQ => "delete_files",
+ pause99_select_user_sub => 1,
+ );
+ $t->post_ok("/admin/select_user", \%action_form);
+ # note $t->content;
+
+ # delete
+ my %form = %$default;
+ $form{SUBMIT_pause99_delete_files_delete} = 1;
+ $form{HIDDENNAME} = "TESTUSER";
+ $t->post_ok("/user/delete_files", \%form);
+ # note $t->content;
+
+ my @deliveries = $t->deliveries;
+ is @deliveries => 3; # for TESTUSER, TESTADMIN, pause_admin
+ my ($mail_body) = map {$_->body} @deliveries;
+ like $mail_body => qr!/user/delete_files!;
+
+ my $rows = $t->mod_db->select('deletes', ['*']);
+ is @$rows => 1;
+ like $rows->[0]{deleteid} => qr!/$form{pause99_delete_files_FILE}[0]$!;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2025/edit_cred.t b/t/pause_2025/action_2025/edit_cred.t
new file mode 100644
index 000000000..83d9ae42e
--- /dev/null
+++ b/t/pause_2025/action_2025/edit_cred.t
@@ -0,0 +1,69 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+
+my $default = {
+ pause99_edit_cred_fullname => "new fullname",
+ pause99_edit_cred_asciiname => "new ascii name",
+ pause99_edit_cred_email => "new_email\@localhost.localdomain",
+ pause99_edit_cred_homepage => "none",
+ pause99_edit_cred_cpan_mail_alias => "none",
+ pause99_edit_cred_sub => 1,
+};
+
+Test::PAUSE::Web->setup;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ $t->get_ok("/user/edit_cred");
+ # note $t->content;
+ }
+};
+
+subtest 'post: basic' => sub {
+ plan skip_all => 'SKIP for now';
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+
+ my %form = %$default;
+ $t->post_ok("/user/edit_cred", \%form);
+ # note $t->content;
+ }
+};
+
+subtest 'post_with_token: basic' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+
+ my %form = %$default;
+ $t->post_with_token_ok("/user/edit_cred", \%form);
+ # note $t->content;
+ }
+};
+
+subtest 'post_with_token: edit with CENSORED email' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+
+ Test::PAUSE::Web->setup;
+ $t->mod_db->update('users', { email => 'CENSORED' }, { userid => $user });
+ my %form = (%$default, pause99_edit_cred_email => 'CENSORED');
+ $t->post_with_token_ok("/user/edit_cred", \%form);
+ my @deliveries = $t->deliveries;
+ like $deliveries[0]->as_string => qr/\[CENSORED\]/;
+ # note $t->content;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2025/edit_ml.t b/t/pause_2025/action_2025/edit_ml.t
new file mode 100644
index 000000000..ec8187fa9
--- /dev/null
+++ b/t/pause_2025/action_2025/edit_ml.t
@@ -0,0 +1,19 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+
+Test::PAUSE::Web->setup;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('admin')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ $t->get_ok("/admin/edit_ml");
+ # note $t->content;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2025/edit_uris.t b/t/pause_2025/action_2025/edit_uris.t
new file mode 100644
index 000000000..be74f58d8
--- /dev/null
+++ b/t/pause_2025/action_2025/edit_uris.t
@@ -0,0 +1,47 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+
+my $default_for_add_uri = {
+ pause99_add_uri_httpupload => ["$Test::PAUSE::Web::AppRoot/t/staging/Hash-RenameKey-0.02.tar.gz", "Hash-RenameKey-0.02.tar.gz"],
+ SUBMIT_pause99_add_uri_httpupload => 1,
+};
+
+my $default = {
+ pause99_edit_uris_3 => "T/TE/TESTUSER/Hash-RenameKey-0.02.tar.gz",
+ pause99_edit_uris_2 => 1,
+};
+
+Test::PAUSE::Web->setup;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ $t->get_ok("/user/edit_uris");
+ # note $t->content;
+ }
+};
+
+subtest 'post: basic' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+
+ $t->mod_dbh->do("TRUNCATE uris");
+
+ # prepare distribution
+ $t->post_ok("/user/add_uri", $default_for_add_uri, "Content-Type" => "form-data");
+
+ my %form = %$default;
+ $form{pause99_edit_uris_3} =~ s/TESTUSER/$user/;
+ $t->post_ok("/user/edit_uris", \%form);
+ # note $t->content;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2025/email_for_admin.t b/t/pause_2025/action_2025/email_for_admin.t
new file mode 100644
index 000000000..9c6cf5999
--- /dev/null
+++ b/t/pause_2025/action_2025/email_for_admin.t
@@ -0,0 +1,33 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+
+Test::PAUSE::Web->setup;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('admin')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ $t->get_ok("/admin/email_for_admin")
+ ->text_like("body", qr/TESTADMIN\s+testadmin\@localhost/)
+ ->text_like("body", qr/TESTUSER\s+testuser\@localhost/);
+ # note $t->content;
+
+ $t->get_ok("/admin/email_for_admin?OF=YAML");
+ my $list_amp = YAML::Syck::Load( $t->content );
+ is_deeply( $list_amp, {
+ TESTADMIN => 'testadmin@localhost',
+ TESTCNSRD => 'testcnsrd@localhost',
+ TESTUSER => 'testuser@localhost',
+ TESTUSER2 => 'testuser2@localhost',
+ TESTUSER3 => 'testuser3@localhost',
+ TESTUSER4 => 'testuser4@localhost',
+ }, "YAML output works" );
+ # note $t->content;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2025/giveup_comaint.t b/t/pause_2025/action_2025/giveup_comaint.t
new file mode 100644
index 000000000..76e13b9c3
--- /dev/null
+++ b/t/pause_2025/action_2025/giveup_comaint.t
@@ -0,0 +1,115 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+use Test::Deep;
+use Test::Differences;
+
+my $default = {
+ pause99_share_perms_remome_m => "Module::Comaint",
+ SUBMIT_pause99_share_perms_remome => 1,
+};
+
+Test::PAUSE::Web->setup;
+Test::PAUSE::Web->reset_module_fixture;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ $t->get_ok("/user/giveup_comaint");
+ my @modules = map {$_->all_text} $t->dom->find('td.package')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_bag(\@modules, [qw/
+ Module::Comaint
+ Module::Comaint::Foo
+ Module::User::Foo
+ /]) or note explain \@modules;
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_bag(\@modules, [qw/
+ Module::Comaint
+ Module::Comaint::Foo
+ /]) or note explain \@modules;
+ }
+ # note $t->content;
+ }
+};
+
+subtest 'normal case (comaint)' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+
+ my %form = (
+ %$default,
+ pause99_share_perms_remome_m => [qw/Module::Comaint Module::Comaint::Foo/],
+ );
+
+ Test::PAUSE::Web->reset_module_fixture;
+ $t->post_ok("/user/giveup_comaint", \%form);
+ my @modules = map {$_->all_text} $t->dom->find('td.package')->each;
+ my @results = map {$_->all_text} $t->dom->find('.result')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_bag(\@modules, [qw/
+ Module::User::Foo
+ /]) or note explain \@modules;
+ eq_or_diff(\@results, [
+ 'Removed TESTADMIN from co-maintainers of Module::Comaint.',
+ 'Removed TESTADMIN from co-maintainers of Module::Comaint::Foo.',
+ ]);
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_bag(\@modules, [qw/
+ /]) or note explain \@modules;
+ eq_or_diff(\@results, [
+ 'Removed TESTUSER from co-maintainers of Module::Comaint.',
+ 'Removed TESTUSER from co-maintainers of Module::Comaint::Foo.',
+ ]);
+ }
+ # note $t->content;
+ }
+};
+
+subtest 'unrelated modules' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+
+ my %form = (
+ %$default,
+ pause99_share_perms_remome_m => [qw/Module::Unrelated Module::Unrelated::Foo/],
+ );
+
+ Test::PAUSE::Web->reset_module_fixture;
+ $t->post_ok("/user/giveup_comaint", \%form);
+ my @modules = map {$_->all_text} $t->dom->find('td.package')->each;
+ my @results = map {$_->all_text} $t->dom->find('.result')->each;
+ my @errors = map {$_->all_text} $t->dom->find('.error')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_bag(\@modules, [qw/
+ Module::Comaint
+ Module::Comaint::Foo
+ Module::User::Foo
+ /]) or note explain \@modules;
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_bag(\@modules, [qw/
+ Module::Comaint
+ Module::Comaint::Foo
+ /]) or note explain \@modules;
+ }
+ ok !@results;
+ eq_or_diff(\@errors, [
+ 'You do not seem to be co-maintainer of Module::Unrelated'
+ ]) or note explain \@errors;
+ # note $t->content;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2025/giveup_dist_comaint.t b/t/pause_2025/action_2025/giveup_dist_comaint.t
new file mode 100644
index 000000000..e6dd81ca1
--- /dev/null
+++ b/t/pause_2025/action_2025/giveup_dist_comaint.t
@@ -0,0 +1,112 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+use Test::Deep;
+use Test::Differences;
+
+my $default = {
+ pause99_giveup_dist_comaint_d => "Module-Comaint",
+ SUBMIT_pause99_giveup_dist_comaint => 1,
+};
+
+Test::PAUSE::Web->setup;
+Test::PAUSE::Web->reset_module_fixture;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+
+ Test::PAUSE::Web->reset_module_fixture;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ $t->get_ok("/user/giveup_dist_comaint");
+ my @dists = map {$_->all_text} $t->dom->find('td.dist')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_bag(\@dists, [qw/
+ Module-Comaint
+ Module-User
+ /]) or note explain \@dists;
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_bag(\@dists, [qw/
+ Module-Comaint
+ /]) or note explain \@dists;
+ }
+ # note $t->content;
+ }
+};
+
+subtest 'normal case (comaint)' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+
+ my %form = (
+ %$default,
+ pause99_giveup_dist_comaint_d => [qw/Module-Comaint/],
+ );
+
+ Test::PAUSE::Web->reset_module_fixture;
+ $t->post_ok("/user/giveup_dist_comaint", \%form);
+ my @dists = map {$_->all_text} $t->dom->find('td.dist')->each;
+ my @results = map {$_->all_text} $t->dom->find('.result')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_bag(\@dists, [qw/
+ Module-User
+ /]) or note explain \@dists;
+ eq_or_diff(\@results, [
+ 'Removed TESTADMIN from co-maintainers of Module::Comaint (Module-Comaint).',
+ 'Removed TESTADMIN from co-maintainers of Module::Comaint::Foo (Module-Comaint).',
+ ]);
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_bag(\@dists, [qw/
+ /]) or note explain \@dists;
+ eq_or_diff(\@results, [
+ 'Removed TESTUSER from co-maintainers of Module::Comaint (Module-Comaint).',
+ 'Removed TESTUSER from co-maintainers of Module::Comaint::Foo (Module-Comaint).',
+ ]);
+ }
+ # note $t->content;
+ }
+};
+
+subtest 'unrelated dists' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+
+ my %form = (
+ %$default,
+ pause99_giveup_dist_comaint_d => [qw/Module-Unrelated/],
+ );
+
+ Test::PAUSE::Web->reset_module_fixture;
+ $t->post_ok("/user/giveup_dist_comaint", \%form);
+ my @dists = map {$_->all_text} $t->dom->find('td.dist')->each;
+ my @results = map {$_->all_text} $t->dom->find('.result')->each;
+ my @errors = map {$_->all_text} $t->dom->find('.error')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_bag(\@dists, [qw/
+ Module-Comaint
+ Module-User
+ /]) or note explain \@dists;
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_bag(\@dists, [qw/
+ Module-Comaint
+ /]) or note explain \@dists;
+ }
+ ok !@results;
+ eq_or_diff(\@errors, [
+ 'You do not seem to be co-maintainer of Module-Unrelated'
+ ]) or note explain \@errors;
+ # note $t->content;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2025/logout.t b/t/pause_2025/action_2025/logout.t
new file mode 100644
index 000000000..4c706dc4f
--- /dev/null
+++ b/t/pause_2025/action_2025/logout.t
@@ -0,0 +1,19 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+
+Test::PAUSE::Web->setup;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ $t->get_ok("/user/logout");
+ # note $t->content;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2025/mailpw.t b/t/pause_2025/action_2025/mailpw.t
new file mode 100644
index 000000000..16e73ecdf
--- /dev/null
+++ b/t/pause_2025/action_2025/mailpw.t
@@ -0,0 +1,185 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+
+my $default = {
+ pause99_mailpw_1 => "TESTUSER",
+ pause99_mailpw_sub => 1,
+};
+
+Test::PAUSE::Web->setup;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ $t->get_ok("/public/mailpw");
+ #note $t->content;
+ }
+};
+
+subtest 'post: basic' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ my %form = %$default;
+ $t->authen_dbh->do("TRUNCATE abrakadabra");
+ my $res = $t->post("/public/mailpw", \%form);
+ ok !$res->is_success && $res->code == 403, "Forbidden";
+ like $res->content => qr/Failed CSRF check/;
+ # note $t->content;
+ }
+};
+
+subtest 'post_with_token: basic' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ my %form = %$default;
+ $t->authen_dbh->do("TRUNCATE abrakadabra");
+ $t->post_with_token_ok("/public/mailpw", \%form)
+ ->text_like("p.form_response", qr/A token to change the password/);
+ # note $t->content;
+ }
+};
+
+subtest 'got an email instead of a userid' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ my %form = (
+ %$default,
+ pause99_mailpw_1 => 'INV@LID',
+ );
+ $t->authen_dbh->do("TRUNCATE abrakadabra");
+ $t->post_with_token_ok("/public/mailpw", \%form)
+ ->text_is('h2', 'Error')
+ ->text_like('p.error_message', qr/Please supply a userid/s);
+ }
+};
+
+subtest 'invalid userid' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ my %form = (
+ %$default,
+ pause99_mailpw_1 => 'INV#LID',
+ );
+ $t->authen_dbh->do("TRUNCATE abrakadabra");
+ $t->post_with_token_ok("/public/mailpw", \%form)
+ ->text_is('h2', 'Error')
+ ->text_like('p.error_message', qr/A userid of INV#LID is not allowed/s);
+ }
+};
+
+subtest 'cannot find a userid' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ my %form = (
+ %$default,
+ pause99_mailpw_1 => 'NOTFOUND',
+ );
+ $t->authen_dbh->do("TRUNCATE abrakadabra");
+ $t->post_with_token_ok("/public/mailpw", \%form)
+ ->text_is('h2', 'Error')
+ ->text_like('p.error_message', qr/Cannot find a userid.+NOTFOUND/s);
+ # note $t->content;
+ }
+};
+
+subtest 'no secretmail' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ my %form = (
+ %$default,
+ );
+ $t->authen_dbh->do("TRUNCATE abrakadabra");
+ $t->authen_db->update('usertable', {secretemail => undef}, {user => "TESTUSER"});
+ $t->post_with_token_ok("/public/mailpw", \%form)
+ ->text_like("p.form_response", qr/A token to change the password/);
+ # note $t->content;
+ }
+
+ Test::PAUSE::Web->setup; # restore the original state
+};
+
+subtest 'requested recently' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ my %form = %$default;
+ $t->authen_dbh->do("TRUNCATE abrakadabra");
+ $t->post_with_token_ok("/public/mailpw", \%form)
+ ->text_like("p.form_response", qr/A token to change the password/);
+ $t->post_with_token_ok("/public/mailpw", \%form)
+ ->text_is('h2', 'Error')
+ ->text_like('p.error_message', qr/A token for TESTUSER that allows/s);
+ # note $t->content;
+ }
+};
+
+subtest 'user without an entry in usertable: has email' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('admin')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ my %form = (
+ %$default,
+ pause99_mailpw_1 => "OTHERUSER",
+ );
+ $t->authen_dbh->do("TRUNCATE abrakadabra");
+ $t->mod_db->insert('users', {
+ userid => 'OTHERUSER',
+ email => 'foo@localhost',
+ }, {replace => 1});
+ $t->authen_db->delete('usertable', {user => 'OTHERUSER'});
+ ok !@{ $t->authen_db->select('usertable', ['user'], {user => 'OTHERUSER'}) // [] };
+ $t->post_with_token_ok("/public/mailpw", \%form)
+ ->text_like("p.form_response", qr/A token to change the password/);
+
+ # new usertable entry is created
+ ok @{ $t->authen_db->select('usertable', ['user'], {user => 'OTHERUSER'}) // [] };
+ #note $t->content;
+ }
+};
+
+subtest 'user without an entry in usertable: without email' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('admin')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ my %form = (
+ %$default,
+ pause99_mailpw_1 => "OTHERUSER",
+ );
+ $t->authen_dbh->do("TRUNCATE abrakadabra");
+ $t->mod_db->insert('users', {
+ userid => 'OTHERUSER',
+ email => '',
+ }, {replace => 1});
+ $t->authen_db->delete('usertable', {user => 'OTHERUSER'});
+ ok !@{ $t->authen_db->select('usertable', ['user'], {user => 'OTHERUSER'}) // [] };
+ $t->post_with_token_ok("/public/mailpw", \%form)
+ ->text_is('h2', 'Error')
+ ->text_like('p.error_message', qr/A userid of OTHERUSER\s+is not known/s);
+
+ # new usertable entry is not created
+ ok !@{ $t->authen_db->select('usertable', ['user'], {user => 'OTHERUSER'}) // [] };
+ #note $t->content;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2025/make_comaint.t b/t/pause_2025/action_2025/make_comaint.t
new file mode 100644
index 000000000..1c3350be6
--- /dev/null
+++ b/t/pause_2025/action_2025/make_comaint.t
@@ -0,0 +1,173 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+use Test::Deep;
+use Test::Differences;
+
+my $default = {
+ pause99_share_perms_makeco_m => [],
+ pause99_share_perms_makeco_a => "TESTUSER2",
+ SUBMIT_pause99_share_perms_makeco => 1,
+};
+
+Test::PAUSE::Web->setup;
+Test::PAUSE::Web->reset_module_fixture;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ $t->get_ok("/user/make_comaint");
+ my @modules = map {$_->all_text} $t->dom->find('td.package')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_set(\@modules, [qw/
+ Module::Admin::Bar
+ Module::Admin::Foo
+ /]) or note explain \@modules;
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_set(\@modules, [qw/
+ Module::User::Bar
+ Module::User::Foo
+ Module::User::Foo::Baz
+ /]) or note explain \@modules;
+ }
+ # note $t->content;
+ }
+};
+
+subtest 'normal case' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+
+ my @packages;
+ if ($user eq 'TESTADMIN') {
+ @packages = qw/Module::Admin::Bar/;
+ }
+ if ($user eq 'TESTUSER') {
+ @packages = qw/Module::User::Bar/;
+ }
+
+ my %form = (
+ %$default,
+ pause99_share_perms_makeco_m => \@packages,
+ pause99_share_perms_makeco_a => "TESTUSER4",
+ );
+
+ Test::PAUSE::Web->reset_module_fixture;
+ $t->post_ok("/user/make_comaint", \%form);
+ my @modules = map {$_->all_text} $t->dom->find('td.package')->each;
+ my @results = map {$_->all_text} $t->dom->find('.result')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_set(\@modules, [qw/
+ Module::Admin::Bar
+ Module::Admin::Foo
+ /]) or note explain \@modules;
+ eq_or_diff(\@results, [
+ 'Added TESTUSER4 to co-maintainers of Module::Admin::Bar.',
+ ]);
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_set(\@modules, [qw/
+ Module::User::Bar
+ Module::User::Foo
+ Module::User::Foo::Baz
+ /]) or note explain \@modules;
+ eq_or_diff(\@results, [
+ 'Added TESTUSER4 to co-maintainers of Module::User::Bar.',
+ ]);
+ }
+ note $t->content;
+ }
+};
+
+subtest 'unknown user' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+
+ my @packages;
+ if ($user eq 'TESTADMIN') {
+ @packages = qw/Module::Admin::Bar/;
+ }
+ if ($user eq 'TESTUSER') {
+ @packages = qw/Module::User::Bar/;
+ }
+
+ my %form = (
+ %$default,
+ pause99_share_perms_makeco_m => \@packages,
+ pause99_share_perms_makeco_a => "UNKNOWN",
+ );
+
+ Test::PAUSE::Web->reset_module_fixture;
+ $t->post_ok("/user/make_comaint", \%form);
+ my @modules = map {$_->all_text} $t->dom->find('td.package')->each;
+ my @results = map {$_->all_text} $t->dom->find('.result')->each;
+ my @errors = map {$_->all_text} $t->dom->find('.error')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_bag(\@modules, [qw/
+ Module::Admin::Bar
+ Module::Admin::Foo
+ /]) or note explain \@modules;
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_bag(\@modules, [qw/
+ Module::User::Bar
+ Module::User::Foo
+ Module::User::Foo::Baz
+ /]) or note explain \@modules;
+ }
+ ok !@results;
+ eq_or_diff(\@errors, [
+ 'UNKNOWN is not a valid userid.',
+ ]);
+ # note $t->content;
+ }
+};
+
+subtest 'unrelated modules' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+
+ my %form = (
+ %$default,
+ pause99_share_perms_makeco_m => [qw/Module::Unrelated/],
+ pause99_share_perms_makeco_a => "TESTUSER2",
+ );
+
+ Test::PAUSE::Web->reset_module_fixture;
+ $t->post_ok("/user/make_comaint", \%form);
+ my @modules = map {$_->all_text} $t->dom->find('td.package')->each;
+ my @results = map {$_->all_text} $t->dom->find('.result')->each;
+ my @errors = map {$_->all_text} $t->dom->find('.error')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_bag(\@modules, [qw/
+ Module::Admin::Bar
+ Module::Admin::Foo
+ /]) or note explain \@modules;
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_bag(\@modules, [qw/
+ Module::User::Bar
+ Module::User::Foo
+ Module::User::Foo::Baz
+ /]) or note explain \@modules;
+ }
+ ok !@results;
+ eq_or_diff(\@errors, [
+ 'You do not seem to be maintainer of Module::Unrelated',
+ ]);
+ # note $t->content;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2025/make_dist_comaint.t b/t/pause_2025/action_2025/make_dist_comaint.t
new file mode 100644
index 000000000..f9295e7b7
--- /dev/null
+++ b/t/pause_2025/action_2025/make_dist_comaint.t
@@ -0,0 +1,169 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+use Test::Deep;
+use Test::Differences;
+
+my $default = {
+ pause99_make_dist_comaint_d => [],
+ pause99_make_dist_comaint_a => "TESTUSER2",
+ SUBMIT_pause99_make_dist_comaint => 1,
+};
+
+Test::PAUSE::Web->setup;
+Test::PAUSE::Web->reset_module_fixture;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ $t->get_ok("/user/make_dist_comaint");
+ my @dists = map {$_->all_text} $t->dom->find('td.dist')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_set(\@dists, [qw/
+ Module-Admin
+ /]) or note explain \@dists;
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_set(\@dists, [qw/
+ Module-User
+ Module-User-Foo-Baz
+ /]) or note explain \@dists;
+ }
+
+ # note $t->content;
+ }
+};
+
+subtest 'normal case' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+
+ my @dists;
+ if ($user eq 'TESTADMIN') {
+ @dists = qw/Module-Admin/;
+ }
+ if ($user eq 'TESTUSER') {
+ @dists = qw/Module-User/;
+ }
+
+ my %form = (
+ %$default,
+ pause99_make_dist_comaint_d => \@dists,
+ pause99_make_dist_comaint_a => "TESTUSER4",
+ );
+
+ Test::PAUSE::Web->reset_module_fixture;
+ $t->post_ok("/user/make_dist_comaint", \%form);
+ @dists = map {$_->all_text} $t->dom->find('td.dist')->each;
+ my @results = map {$_->all_text} $t->dom->find('.result')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_set(\@dists, [qw/
+ Module-Admin
+ /]) or note explain \@dists;
+ eq_or_diff(\@results, [
+ 'Added TESTUSER4 to co-maintainers of Module::Admin::Bar (Module-Admin).',
+ 'Added TESTUSER4 to co-maintainers of Module::Admin::Foo (Module-Admin).',
+ ]);
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_set(\@dists, [qw/
+ Module-User
+ Module-User-Foo-Baz
+ /]) or note explain \@dists;
+ eq_or_diff(\@results, [
+ 'Added TESTUSER4 to co-maintainers of Module::User::Bar (Module-User).',
+ 'Added TESTUSER4 to co-maintainers of Module::User::Foo (Module-User).',
+ ]);
+ }
+
+ # note $t->content;
+ }
+};
+
+subtest 'unknown user' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+
+ my @dists;
+ if ($user eq 'TESTADMIN') {
+ @dists = qw/Module-Admin/;
+ }
+ if ($user eq 'TESTUSER') {
+ @dists = qw/Module-User/;
+ }
+
+ my %form = (
+ %$default,
+ pause99_make_dist_comaint_d => \@dists,
+ pause99_make_dist_comaint_a => "UNKNOWN",
+ );
+
+ Test::PAUSE::Web->reset_module_fixture;
+ $t->post_ok("/user/make_dist_comaint", \%form);
+ @dists = map {$_->all_text} $t->dom->find('td.dist')->each;
+ my @results = map {$_->all_text} $t->dom->find('.result')->each;
+ my @errors = map {$_->all_text} $t->dom->find('.error')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_bag(\@dists, [qw/
+ Module-Admin
+ /]) or note explain \@dists;
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_bag(\@dists, [qw/
+ Module-User
+ Module-User-Foo-Baz
+ /]) or note explain \@dists;
+ }
+ ok !@results;
+ eq_or_diff(\@errors, [
+ 'UNKNOWN is not a valid userid.',
+ ]);
+ # note $t->content;
+ }
+};
+
+subtest 'unrelated dists' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+
+ my %form = (
+ %$default,
+ pause99_make_dist_comaint_d => [qw/Module-Unrelated/],
+ pause99_make_dist_comaint_a => "TESTUSER2",
+ );
+
+ Test::PAUSE::Web->reset_module_fixture;
+ $t->post_ok("/user/make_dist_comaint", \%form);
+ my @dists = map {$_->all_text} $t->dom->find('td.dist')->each;
+ my @results = map {$_->all_text} $t->dom->find('.result')->each;
+ my @errors = map {$_->all_text} $t->dom->find('.error')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_bag(\@dists, [qw/
+ Module-Admin
+ /]) or note explain \@dists;
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_bag(\@dists, [qw/
+ Module-User
+ Module-User-Foo-Baz
+ /]) or note explain \@dists;
+ }
+ ok !@results;
+ eq_or_diff(\@errors, [
+ 'You do not seem to be maintainer of Module-Unrelated',
+ ]);
+ # note $t->content;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2025/manage_id_requests.t b/t/pause_2025/action_2025/manage_id_requests.t
new file mode 100644
index 000000000..0b9a69e8f
--- /dev/null
+++ b/t/pause_2025/action_2025/manage_id_requests.t
@@ -0,0 +1,19 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+
+Test::PAUSE::Web->setup;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('admin')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ $t->get_ok("/admin/manage_id_requests");
+ # note $t->content;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2025/move_dist_primary.t b/t/pause_2025/action_2025/move_dist_primary.t
new file mode 100644
index 000000000..f38564aee
--- /dev/null
+++ b/t/pause_2025/action_2025/move_dist_primary.t
@@ -0,0 +1,165 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+use Test::Deep;
+use Test::Differences;
+
+my $default = {
+ pause99_move_dist_primary_d => [],
+ pause99_move_dist_primary_a => "TESTUSER2",
+ SUBMIT_pause99_move_dist_primary => 1,
+};
+
+Test::PAUSE::Web->setup;
+Test::PAUSE::Web->reset_module_fixture;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ $t->get_ok("/user/move_dist_primary");
+ my @dists = map {$_->all_text} $t->dom->find('td.dist')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_bag(\@dists, [qw/
+ Module-Admin
+ /]) or note explain \@dists;
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_bag(\@dists, [qw/
+ Module-User
+ Module-User-Foo-Baz
+ /]) or note explain \@dists;
+ }
+ # note $t->content;
+ }
+};
+
+subtest 'normal case' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+
+ my @dists;
+ if ($user eq 'TESTADMIN') {
+ @dists = qw/Module-Admin/;
+ }
+ if ($user eq 'TESTUSER') {
+ @dists = qw/Module-User/;
+ }
+
+ my %form = (
+ %$default,
+ pause99_move_dist_primary_d => \@dists,
+ pause99_move_dist_primary_a => "TESTUSER2",
+ );
+
+ Test::PAUSE::Web->reset_module_fixture;
+ $t->post_ok("/user/move_dist_primary", \%form);
+ @dists = map {$_->all_text} $t->dom->find('td.dist')->each;
+ my @results = map {$_->all_text} $t->dom->find('.result')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_bag(\@dists, [qw/
+ /]) or note explain \@dists;
+ eq_or_diff(\@results, [
+ 'Made TESTUSER2 primary maintainer of Module::Admin::Bar (Module-Admin).',
+ 'Made TESTUSER2 primary maintainer of Module::Admin::Foo (Module-Admin).',
+ ]);
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_bag(\@dists, [qw/
+ Module-User-Foo-Baz
+ /]) or note explain \@dists;
+ eq_or_diff(\@results, [
+ 'Made TESTUSER2 primary maintainer of Module::User::Bar (Module-User).',
+ 'Made TESTUSER2 primary maintainer of Module::User::Foo (Module-User).',
+ ]);
+ }
+ note $t->content;
+ }
+};
+
+subtest 'unknown user' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+
+ my @dists;
+ if ($user eq 'TESTADMIN') {
+ @dists = qw/Module-Admin/;
+ }
+ if ($user eq 'TESTUSER') {
+ @dists = qw/Module-User/;
+ }
+
+ my %form = (
+ %$default,
+ pause99_move_dist_primary_d => \@dists,
+ pause99_move_dist_primary_a => "UNKNOWN",
+ );
+
+ Test::PAUSE::Web->reset_module_fixture;
+ $t->post_ok("/user/move_dist_primary", \%form);
+ my @new_dists = map {$_->all_text} $t->dom->find('td.dist')->each;
+ my @results = map {$_->all_text} $t->dom->find('.result')->each;
+ my @errors = map {$_->all_text} $t->dom->find('.error')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_bag(\@new_dists, [qw/
+ Module-Admin
+ /]) or note explain \@dists;
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_bag(\@new_dists, [qw/
+ Module-User
+ Module-User-Foo-Baz
+ /]) or note explain \@dists;
+ }
+ ok !@results;
+ eq_or_diff(\@errors, [
+ 'UNKNOWN is not a valid userid.',
+ ]);
+ # note $t->content;
+ }
+};
+
+subtest 'unrelated dists' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+
+ my %form = (
+ %$default,
+ pause99_move_dist_primary_d => [qw/Module-Unrelated/],
+ pause99_move_dist_primary_a => "TESTUSER2",
+ );
+
+ Test::PAUSE::Web->reset_module_fixture;
+ $t->post_ok("/user/move_dist_primary", \%form);
+ my @dists = map {$_->all_text} $t->dom->find('td.dist')->each;
+ my @results = map {$_->all_text} $t->dom->find('.result')->each;
+ my @errors = map {$_->all_text} $t->dom->find('.error')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_bag(\@dists, [qw/
+ Module-Admin
+ /]) or note explain \@dists;
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_bag(\@dists, [qw/
+ Module-User
+ Module-User-Foo-Baz
+ /]) or note explain \@dists;
+ }
+ ok !@results;
+ eq_or_diff(\@errors, [
+ 'You do not seem to be maintainer of Module-Unrelated',
+ ]);
+ # note $t->content;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2025/move_primary.t b/t/pause_2025/action_2025/move_primary.t
new file mode 100644
index 000000000..2512a73c7
--- /dev/null
+++ b/t/pause_2025/action_2025/move_primary.t
@@ -0,0 +1,172 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+use Test::Deep;
+use Test::Differences;
+
+my $default = {
+ pause99_share_perms_pr_m => [],
+ pause99_share_perms_movepr_a => "TESTUSER2",
+ SUBMIT_pause99_share_perms_movepr => 1,
+};
+
+Test::PAUSE::Web->setup;
+Test::PAUSE::Web->reset_module_fixture;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ $t->get_ok("/user/move_primary");
+ my @modules = map {$_->all_text} $t->dom->find('td.package')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_bag(\@modules, [qw/
+ Module::Admin::Bar
+ Module::Admin::Foo
+ /]) or note explain \@modules;
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_bag(\@modules, [qw/
+ Module::User::Bar
+ Module::User::Foo
+ Module::User::Foo::Baz
+ /]) or note explain \@modules;
+ }
+ # note $t->content;
+ }
+};
+
+subtest 'normal case' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+
+ my @packages;
+ if ($user eq 'TESTADMIN') {
+ @packages = qw/Module::Admin::Bar/;
+ }
+ if ($user eq 'TESTUSER') {
+ @packages = qw/Module::User::Bar/;
+ }
+
+ my %form = (
+ %$default,
+ pause99_share_perms_pr_m => \@packages,
+ pause99_share_perms_movepr_a => "TESTUSER2",
+ );
+
+ Test::PAUSE::Web->reset_module_fixture;
+ $t->post_ok("/user/move_primary", \%form);
+ my @modules = map {$_->all_text} $t->dom->find('td.package')->each;
+ my @results = map {$_->all_text} $t->dom->find('.result')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_bag(\@modules, [qw/
+ Module::Admin::Foo
+ /]) or note explain \@modules;
+ eq_or_diff(\@results, [
+ 'Made TESTUSER2 primary maintainer of Module::Admin::Bar.',
+ ]);
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_bag(\@modules, [qw/
+ Module::User::Foo
+ Module::User::Foo::Baz
+ /]) or note explain \@modules;
+ eq_or_diff(\@results, [
+ 'Made TESTUSER2 primary maintainer of Module::User::Bar.',
+ ]);
+ }
+ # note $t->content;
+ }
+};
+
+subtest 'unknown user' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+
+ my @packages;
+ if ($user eq 'TESTADMIN') {
+ @packages = qw/Module::Admin::Bar/;
+ }
+ if ($user eq 'TESTUSER') {
+ @packages = qw/Module::User::Bar/;
+ }
+
+ my %form = (
+ %$default,
+ pause99_share_perms_pr_m => \@packages,
+ pause99_share_perms_movepr_a => "UNKNOWN",
+ );
+
+ Test::PAUSE::Web->reset_module_fixture;
+ $t->post_ok("/user/move_primary", \%form);
+ my @modules = map {$_->all_text} $t->dom->find('td.package')->each;
+ my @results = map {$_->all_text} $t->dom->find('.result')->each;
+ my @errors = map {$_->all_text} $t->dom->find('.error')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_bag(\@modules, [qw/
+ Module::Admin::Bar
+ Module::Admin::Foo
+ /]) or note explain \@modules;
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_bag(\@modules, [qw/
+ Module::User::Bar
+ Module::User::Foo
+ Module::User::Foo::Baz
+ /]) or note explain \@modules;
+ }
+ ok !@results;
+ eq_or_diff(\@errors, [
+ 'UNKNOWN is not a valid userid.',
+ ]);
+ # note $t->content;
+ }
+};
+
+subtest 'unrelated modules' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+
+ my %form = (
+ %$default,
+ pause99_share_perms_pr_m => [qw/Module::Unrelated/],
+ pause99_share_perms_movepr_a => "TESTUSER2",
+ );
+
+ Test::PAUSE::Web->reset_module_fixture;
+ $t->post_ok("/user/move_primary", \%form);
+ my @modules = map {$_->all_text} $t->dom->find('td.package')->each;
+ my @results = map {$_->all_text} $t->dom->find('.result')->each;
+ my @errors = map {$_->all_text} $t->dom->find('.error')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_bag(\@modules, [qw/
+ Module::Admin::Bar
+ Module::Admin::Foo
+ /]) or note explain \@modules;
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_bag(\@modules, [qw/
+ Module::User::Bar
+ Module::User::Foo
+ Module::User::Foo::Baz
+ /]) or note explain \@modules;
+ }
+ ok !@results;
+ eq_or_diff(\@errors, [
+ 'You do not seem to be maintainer of Module::Unrelated',
+ ]);
+ # note $t->content;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2025/pause_04about.t b/t/pause_2025/action_2025/pause_04about.t
new file mode 100644
index 000000000..c13621fed
--- /dev/null
+++ b/t/pause_2025/action_2025/pause_04about.t
@@ -0,0 +1,19 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+
+Test::PAUSE::Web->setup;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ $t->get_ok("/public/pause_04about");
+ # note $t->content;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2025/pause_04imprint.t b/t/pause_2025/action_2025/pause_04imprint.t
new file mode 100644
index 000000000..c2f01cdd8
--- /dev/null
+++ b/t/pause_2025/action_2025/pause_04imprint.t
@@ -0,0 +1,19 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+
+Test::PAUSE::Web->setup;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ $t->get_ok("/public/pause_04imprint");
+ # note $t->content;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2025/pause_05news.t b/t/pause_2025/action_2025/pause_05news.t
new file mode 100644
index 000000000..48a6aa23a
--- /dev/null
+++ b/t/pause_2025/action_2025/pause_05news.t
@@ -0,0 +1,19 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+
+Test::PAUSE::Web->setup;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ $t->get_ok("/public/pause_05news");
+ # note $t->content;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2025/pause_06history.t b/t/pause_2025/action_2025/pause_06history.t
new file mode 100644
index 000000000..f71e80b1d
--- /dev/null
+++ b/t/pause_2025/action_2025/pause_06history.t
@@ -0,0 +1,19 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+
+Test::PAUSE::Web->setup;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ $t->get_ok("/public/pause_06history");
+ # note $t->content;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2025/pause_logout.t b/t/pause_2025/action_2025/pause_logout.t
new file mode 100644
index 000000000..2459230d3
--- /dev/null
+++ b/t/pause_2025/action_2025/pause_logout.t
@@ -0,0 +1,18 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+
+Test::PAUSE::Web->setup;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ $t->get_ok("$path?ACTION=pause_logout");
+ # note $t->content;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2025/pause_namingmodules.t b/t/pause_2025/action_2025/pause_namingmodules.t
new file mode 100644
index 000000000..62de8f0d4
--- /dev/null
+++ b/t/pause_2025/action_2025/pause_namingmodules.t
@@ -0,0 +1,19 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+
+Test::PAUSE::Web->setup;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ $t->get_ok("/public/pause_namingmodules");
+ # note $t->content;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2025/pause_operating_model.t b/t/pause_2025/action_2025/pause_operating_model.t
new file mode 100644
index 000000000..8ce328fe8
--- /dev/null
+++ b/t/pause_2025/action_2025/pause_operating_model.t
@@ -0,0 +1,19 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+
+Test::PAUSE::Web->setup;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ $t->get_ok("/public/pause_operating_model");
+ # note $t->content;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2025/pause_privacy_policy.t b/t/pause_2025/action_2025/pause_privacy_policy.t
new file mode 100644
index 000000000..5f017f975
--- /dev/null
+++ b/t/pause_2025/action_2025/pause_privacy_policy.t
@@ -0,0 +1,19 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+
+Test::PAUSE::Web->setup;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ $t->get_ok("/public/pause_privacy_policy");
+ # note $t->content;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2025/peek_dist_perms.t b/t/pause_2025/action_2025/peek_dist_perms.t
new file mode 100644
index 000000000..74ab30552
--- /dev/null
+++ b/t/pause_2025/action_2025/peek_dist_perms.t
@@ -0,0 +1,176 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+use YAML::Syck;
+use Test::Deep;
+use Test::Differences;
+
+my $default = {
+ pause99_peek_dist_perms_query => "TESTUSER",
+ pause99_peek_dist_perms_by => "a",
+ pause99_peek_dist_perms_sub => 1,
+};
+
+Test::PAUSE::Web->setup;
+Test::PAUSE::Web->reset_module_fixture;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ $t->get_ok("/user/peek_dist_perms");
+ # note $t->content;
+ }
+};
+
+subtest 'search by author' => sub {
+ for my $method (qw/get_ok post_ok/) {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+
+ my %form = (
+ %$default,
+ pause99_peek_dist_perms_query => $user,
+ );
+ $t->$method("/user/peek_dist_perms", \%form);
+ my @dists = map {$_->all_text} $t->dom->find('td.dist')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_bag(\@dists, [qw/
+ Module-Admin
+ Module-Comaint
+ Module-User
+ /]) or note explain \@dists;
+ ok grep(/^Module-Comaint/, @dists), 'Module-Comaint is also listed';
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_bag(\@dists, [qw/
+ Module-Comaint
+ Module-User
+ Module-User-Foo-Baz
+ /]) or note explain \@dists;
+ }
+ # note $t->content;
+
+ $t->$method("/user/peek_dist_perms?OF=YAML", \%form);
+ my $list = YAML::Syck::Load( $t->content );
+ if ($user eq 'TESTADMIN') {
+ eq_or_diff( $list => [
+ {
+ 'dist' => 'Module-Admin',
+ 'owner' => 'TESTADMIN',
+ 'comaint' => 'TESTUSER2',
+ },
+ {
+ 'dist' => 'Module-Comaint',
+ 'owner' => 'TESTUSER2',
+ 'comaint' => 'TESTADMIN',
+ },
+ {
+ 'dist' => 'Module-User',
+ 'owner' => 'TESTUSER',
+ 'comaint' => 'TESTADMIN',
+ },
+ ] );
+ }
+ if ($user eq 'TESTUSER') {
+ eq_or_diff( $list => [
+ {
+ 'dist' => 'Module-Comaint',
+ 'owner' => 'TESTUSER2',
+ 'comaint' => 'TESTUSER',
+ },
+ {
+ 'dist' => 'Module-User',
+ 'owner' => 'TESTUSER',
+ 'comaint' => 'TESTADMIN,TESTUSER2',
+ },
+ {
+ 'dist' => 'Module-User-Foo-Baz',
+ 'owner' => 'TESTUSER',
+ 'comaint' => undef,
+ },
+ ] );
+ }
+ }
+ }
+};
+
+subtest 'search by dist (exact)' => sub {
+ for my $method (qw/get_ok post_ok/) {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+
+ my %form = (
+ %$default,
+ pause99_peek_dist_perms_query => 'Module-User',
+ pause99_peek_dist_perms_by => 'de',
+ );
+ $t->$method("/user/peek_dist_perms", \%form);
+ my @dists = map {$_->all_text} $t->dom->find('td.dist')->each;
+ cmp_set(\@dists, [qw/
+ Module-User
+ /]) or note explain \@dists;
+ # note $t->content;
+
+ $t->$method("/user/peek_dist_perms?OF=YAML", \%form);
+ my $list = YAML::Syck::Load( $t->content );
+ eq_or_diff( $list => [
+ {
+ 'dist' => 'Module-User',
+ 'owner' => 'TESTUSER',
+ 'comaint' => 'TESTADMIN,TESTUSER2',
+ },
+ ]);
+ }
+ }
+};
+
+subtest 'search by module (sql-like)' => sub {
+ for my $method (qw/get_ok post_ok/) {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+
+ my %form = (
+ %$default,
+ pause99_peek_dist_perms_query => 'Module-User%',
+ pause99_peek_dist_perms_by => 'dl',
+ );
+ $t->$method("/user/peek_dist_perms", \%form);
+ my @dists = map {$_->all_text} $t->dom->find('td.dist')->each;
+ cmp_set(\@dists, [qw/
+ Module-User
+ Module-User-Foo-Baz
+ /]) or note explain \@dists;
+ # note $t->content;
+
+ $t->$method("/user/peek_dist_perms?OF=YAML", \%form);
+ my $list = YAML::Syck::Load( $t->content );
+ eq_or_diff( $list => [
+ {
+ 'dist' => 'Module-User',
+ 'owner' => 'TESTUSER',
+ 'comaint' => 'TESTADMIN,TESTUSER2',
+ },
+ {
+ 'dist' => 'Module-User-Foo-Baz',
+ 'owner' => 'TESTUSER',
+ 'comaint' => undef,
+ },
+ ]);
+ }
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2025/peek_perms.t b/t/pause_2025/action_2025/peek_perms.t
new file mode 100644
index 000000000..f25f1c6b9
--- /dev/null
+++ b/t/pause_2025/action_2025/peek_perms.t
@@ -0,0 +1,244 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+use YAML::Syck;
+use Test::Deep;
+use Test::Differences;
+
+my $default = {
+ pause99_peek_perms_query => "TESTUSER",
+ pause99_peek_perms_by => "a",
+ pause99_peek_perms_sub => 1,
+};
+
+Test::PAUSE::Web->setup;
+Test::PAUSE::Web->reset_module_fixture;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ $t->get_ok("/user/peek_perms");
+ # note $t->content;
+ }
+};
+
+subtest 'search by author' => sub {
+ for my $method (qw/get_ok post_ok/) {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+
+ my %form = (
+ %$default,
+ pause99_peek_perms_query => $user,
+ );
+ $t->$method("/user/peek_perms", \%form);
+ my @modules = map {$_->all_text} $t->dom->find('td.module')->each;
+ my @types = map {$_->all_text} $t->dom->find('td.type')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_bag(\@modules, [qw/
+ Module::Admin::Bar
+ Module::Admin::Foo
+ Module::Comaint
+ Module::Comaint::Foo
+ Module::User::Foo
+ /]) or note explain \@modules;
+ ok grep(/co-maint/, @types), 'Has co-maint';
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_bag(\@modules, [qw/
+ Module::Comaint
+ Module::Comaint::Foo
+ Module::User::Bar
+ Module::User::Foo
+ Module::User::Foo::Baz
+ /]) or note explain \@modules;
+ ok grep(/co-maint/, @types), 'No co-maint';
+ }
+ # note $t->content;
+
+ $t->$method("/user/peek_perms?OF=YAML", \%form);
+ my $list = YAML::Syck::Load( $t->content );
+ if ($user eq 'TESTADMIN') {
+ eq_or_diff( $list => [
+ {
+ 'module' => 'Module::Admin::Bar',
+ 'owner' => 'TESTADMIN',
+ 'type' => 'first-come',
+ 'userid' => 'TESTADMIN'
+ },
+ {
+ 'module' => 'Module::Admin::Foo',
+ 'owner' => 'TESTADMIN',
+ 'type' => 'first-come',
+ 'userid' => 'TESTADMIN'
+ },
+ {
+ 'module' => 'Module::User::Foo',
+ 'owner' => 'TESTUSER',
+ 'type' => 'co-maint',
+ 'userid' => 'TESTADMIN'
+ },
+ {
+ 'module' => 'Module::Comaint',
+ 'owner' => 'TESTUSER2',
+ 'type' => 'co-maint',
+ 'userid' => 'TESTADMIN'
+ },
+ {
+ 'module' => 'Module::Comaint::Foo',
+ 'owner' => 'TESTUSER2',
+ 'type' => 'co-maint',
+ 'userid' => 'TESTADMIN'
+ },
+ ] );
+ }
+ if ($user eq 'TESTUSER') {
+ eq_or_diff( $list => [
+ {
+ 'module' => 'Module::User::Bar',
+ 'owner' => 'TESTUSER',
+ 'type' => 'first-come',
+ 'userid' => 'TESTUSER'
+ },
+ {
+ 'module' => 'Module::User::Foo',
+ 'owner' => 'TESTUSER',
+ 'type' => 'first-come',
+ 'userid' => 'TESTUSER'
+ },
+ {
+ 'module' => 'Module::User::Foo::Baz',
+ 'owner' => 'TESTUSER',
+ 'type' => 'first-come',
+ 'userid' => 'TESTUSER'
+ },
+ {
+ 'module' => 'Module::Comaint',
+ 'owner' => 'TESTUSER2',
+ 'type' => 'co-maint',
+ 'userid' => 'TESTUSER'
+ },
+ {
+ 'module' => 'Module::Comaint::Foo',
+ 'owner' => 'TESTUSER2',
+ 'type' => 'co-maint',
+ 'userid' => 'TESTUSER'
+ },
+ ] );
+ }
+ }
+ }
+};
+
+subtest 'search by module (exact)' => sub {
+ for my $method (qw/get_ok post_ok/) {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+
+ my %form = (
+ %$default,
+ pause99_peek_perms_query => 'Module::User::Foo',
+ pause99_peek_perms_by => 'me',
+ );
+ $t->$method("/user/peek_perms", \%form);
+ my @modules = map {$_->all_text} $t->dom->find('td.module')->each;
+ my @types = map {$_->all_text} $t->dom->find('td.type')->each;
+ cmp_set(\@modules, [qw/
+ Module::User::Foo
+ /]) or note explain \@modules;
+ ok grep(/co-maint/, @types), 'Has co-maint';
+ # note $t->content;
+
+ $t->$method("/user/peek_perms?OF=YAML", \%form);
+ my $list = YAML::Syck::Load( $t->content );
+ eq_or_diff( $list => [
+ {
+ 'module' => 'Module::User::Foo',
+ 'owner' => 'TESTUSER',
+ 'type' => 'first-come',
+ 'userid' => 'TESTUSER'
+ },
+ {
+ 'module' => 'Module::User::Foo',
+ 'owner' => 'TESTUSER',
+ 'type' => 'co-maint',
+ 'userid' => 'TESTADMIN'
+ },
+ ]);
+ }
+ }
+};
+
+subtest 'search by module (sql-like)' => sub {
+ for my $method (qw/get_ok post_ok/) {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+
+ my %form = (
+ %$default,
+ pause99_peek_perms_query => 'Module::User::%',
+ pause99_peek_perms_by => 'ml',
+ );
+ $t->$method("/user/peek_perms", \%form);
+ my @modules = map {$_->all_text} $t->dom->find('td.module')->each;
+ my @types = map {$_->all_text} $t->dom->find('td.type')->each;
+ cmp_set(\@modules, [qw/
+ Module::User::Bar
+ Module::User::Foo
+ Module::User::Foo::Baz
+ /]) or note explain \@modules;
+ ok grep(/co-maint/, @types), 'Has co-maint';
+ # note $t->content;
+
+ $t->$method("/user/peek_perms?OF=YAML", \%form);
+ my $list = YAML::Syck::Load( $t->content );
+ eq_or_diff( $list => [
+ {
+ 'module' => 'Module::User::Bar',
+ 'owner' => 'TESTUSER',
+ 'type' => 'first-come',
+ 'userid' => 'TESTUSER'
+ },
+ {
+ 'module' => 'Module::User::Foo',
+ 'owner' => 'TESTUSER',
+ 'type' => 'first-come',
+ 'userid' => 'TESTUSER'
+ },
+ {
+ 'module' => 'Module::User::Foo::Baz',
+ 'owner' => 'TESTUSER',
+ 'type' => 'first-come',
+ 'userid' => 'TESTUSER'
+ },
+ {
+ 'module' => 'Module::User::Bar',
+ 'owner' => 'TESTUSER',
+ 'type' => 'co-maint',
+ 'userid' => 'TESTUSER2'
+ },
+ {
+ 'module' => 'Module::User::Foo',
+ 'owner' => 'TESTUSER',
+ 'type' => 'co-maint',
+ 'userid' => 'TESTADMIN'
+ },
+ ]);
+ }
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2025/reindex.t b/t/pause_2025/action_2025/reindex.t
new file mode 100644
index 000000000..21b1e4999
--- /dev/null
+++ b/t/pause_2025/action_2025/reindex.t
@@ -0,0 +1,49 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+
+my $default_for_add_uri = {
+ pause99_add_uri_httpupload => [Test::PAUSE::Web->file_to_upload],
+ SUBMIT_pause99_add_uri_httpupload => 1,
+};
+
+my $default = {
+ pause99_reindex_FILE => ["Hash-RemoteKey-0.02.tar.gz"],
+ SUBMIT_pause99_reindex_delete => 1,
+};
+
+Test::PAUSE::Web->setup;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ $t->get_ok("/user/reindex");
+ # note $t->content;
+ }
+};
+
+subtest 'post: basic' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+
+ $t->mod_dbh->do("TRUNCATE uris");
+
+ # prepare distribution
+ $t->post_ok("/user/add_uri", $default_for_add_uri, "Content-Type" => "form-data");
+
+ $t->copy_to_authors_dir($user, scalar Test::PAUSE::Web->file_to_upload);
+
+ my %form = %$default;
+ $t->post_ok("/user/reindex", \%form);
+ # note $t->content;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2025/remove_comaint.t b/t/pause_2025/action_2025/remove_comaint.t
new file mode 100644
index 000000000..4d5ed74cb
--- /dev/null
+++ b/t/pause_2025/action_2025/remove_comaint.t
@@ -0,0 +1,176 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+use Test::Deep;
+use Test::Differences;
+
+my $default = {
+ pause99_share_perms_remocos_tuples => [],
+ SUBMIT_pause99_share_perms_remocos => 1,
+};
+
+Test::PAUSE::Web->setup;
+Test::PAUSE::Web->reset_module_fixture;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ $t->get_ok("/user/remove_comaint");
+ my @modules = map {$_->all_text} $t->dom->find('td.package')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_set(\@modules, [qw/
+ Module::Admin::Bar
+ Module::Admin::Foo
+ /]) or note explain \@modules;
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_set(\@modules, [qw/
+ Module::User::Bar
+ Module::User::Foo
+ /]) or note explain \@modules;
+ }
+ # note $t->content;
+ }
+};
+
+subtest 'normal case' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+
+ my @tuples;
+ if ($user eq 'TESTADMIN') {
+ @tuples = (
+ 'Module::Admin::Bar -- TESTUSER2',
+ );
+ }
+ if ($user eq 'TESTUSER') {
+ @tuples = (
+ 'Module::User::Bar -- TESTUSER2',
+ );
+
+ }
+
+ my %form = (
+ %$default,
+ pause99_share_perms_remocos_tuples => \@tuples,
+ );
+
+ Test::PAUSE::Web->reset_module_fixture;
+ $t->post_ok("/user/remove_comaint", \%form);
+ my @modules = map {$_->all_text} $t->dom->find('td.package')->each;
+ my @results = map {$_->all_text} $t->dom->find('.result')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_set(\@modules, [qw/
+ Module::Admin::Foo
+ /]) or note explain \@modules;
+ eq_or_diff(\@results, [
+ 'Removed TESTUSER2 from co-maintainers of Module::Admin::Bar.',
+ ]);
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_set(\@modules, [qw/
+ Module::User::Foo
+ /]) or note explain \@modules;
+ eq_or_diff(\@results, [
+ 'Removed TESTUSER2 from co-maintainers of Module::User::Bar.',
+ ]);
+ }
+ # note $t->content;
+ }
+};
+
+subtest 'broken tuple (not the owner)' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+
+ my %form = (
+ %$default,
+ pause99_share_perms_remocos_tuples => ['Module::Unrelated -- TESTUSER2'],
+ );
+
+ Test::PAUSE::Web->reset_module_fixture;
+ $t->post_ok("/user/remove_comaint", \%form);
+ my @modules = map {$_->all_text} $t->dom->find('td.package')->each;
+ my @results = map {$_->all_text} $t->dom->find('.result')->each;
+ my @errors = map {$_->all_text} $t->dom->find('.error')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_set(\@modules, [qw/
+ Module::Admin::Bar
+ Module::Admin::Foo
+ /]) or note explain \@modules;
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_set(\@modules, [qw/
+ Module::User::Bar
+ Module::User::Foo
+ /]) or note explain \@modules;
+ }
+ ok !@results;
+ eq_or_diff(\@errors, [
+ 'You do not seem to be owner of Module::Unrelated.',
+ ]);
+ # note $t->content;
+ }
+};
+
+subtest 'broken tuple (not the comaint)' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+
+ my @tuples;
+ if ($user eq 'TESTADMIN') {
+ @tuples = (
+ 'Module::Admin::Bar -- TESTUSER4',
+ );
+ }
+ if ($user eq 'TESTUSER') {
+ @tuples = (
+ 'Module::User::Bar -- TESTUSER4',
+ );
+
+ }
+
+ my %form = (
+ %$default,
+ pause99_share_perms_remocos_tuples => \@tuples,
+ );
+
+ Test::PAUSE::Web->reset_module_fixture;
+ $t->post_ok("/user/remove_comaint", \%form);
+ my @modules = map {$_->all_text} $t->dom->find('td.package')->each;
+ my @results = map {$_->all_text} $t->dom->find('.result')->each;
+ my @errors = map {$_->all_text} $t->dom->find('.error')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_set(\@modules, [qw/
+ Module::Admin::Bar
+ Module::Admin::Foo
+ /]) or note explain \@modules;
+ eq_or_diff(\@errors, [
+ 'Cannot handle tuple Module::Admin::Bar -- TESTUSER4. If you believe, this is a bug, please complain.'
+ ]);
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_set(\@modules, [qw/
+ Module::User::Bar
+ Module::User::Foo
+ /]) or note explain \@modules;
+ eq_or_diff(\@errors, [
+ 'Cannot handle tuple Module::User::Bar -- TESTUSER4. If you believe, this is a bug, please complain.'
+ ]);
+ }
+ ok !@results;
+ # note $t->content;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2025/remove_dist_comaint.t b/t/pause_2025/action_2025/remove_dist_comaint.t
new file mode 100644
index 000000000..4cc161f71
--- /dev/null
+++ b/t/pause_2025/action_2025/remove_dist_comaint.t
@@ -0,0 +1,170 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+use Test::Deep;
+use Test::Differences;
+
+my $default = {
+ pause99_remove_dist_comaint_tuples => [],
+ SUBMIT_pause99_remove_dist_comaint => 1,
+};
+
+Test::PAUSE::Web->setup;
+Test::PAUSE::Web->reset_module_fixture;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ $t->get_ok("/user/remove_dist_comaint");
+ my @dists = map {$_->all_text} $t->dom->find('td.dist')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_set(\@dists, [qw/
+ Module-Admin
+ /]) or note explain \@dists;
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_set(\@dists, [qw/
+ Module-User
+ /]) or note explain \@dists;
+ }
+ # note $t->content;
+ }
+};
+
+subtest 'normal case' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+
+ my @tuples;
+ if ($user eq 'TESTADMIN') {
+ @tuples = (
+ 'Module-Admin -- TESTUSER2',
+ );
+ }
+ if ($user eq 'TESTUSER') {
+ @tuples = (
+ 'Module-User -- TESTUSER2',
+ );
+ }
+
+ my %form = (
+ %$default,
+ pause99_remove_dist_comaint_tuples => \@tuples,
+ );
+
+ Test::PAUSE::Web->reset_module_fixture;
+ $t->post_ok("/user/remove_dist_comaint", \%form);
+ my @dists = map {$_->all_text} $t->dom->find('td.dist')->each;
+ my @results = map {$_->all_text} $t->dom->find('.result')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_set(\@dists, [qw/
+ /]) or note explain \@dists;
+ eq_or_diff(\@results, [
+ 'Removed TESTUSER2 from co-maintainers of Module::Admin::Bar (Module-Admin).',
+ 'Removed TESTUSER2 from co-maintainers of Module::Admin::Foo (Module-Admin).',
+ ]);
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_set(\@dists, [qw/
+ Module-User
+ /]) or note explain \@dists;
+ eq_or_diff(\@results, [
+ 'Removed TESTUSER2 from co-maintainers of Module::User::Bar (Module-User).',
+ 'Removed TESTUSER2 from co-maintainers of Module::User::Foo (Module-User).',
+ ]);
+ }
+ # note $t->content;
+ }
+};
+
+subtest 'broken tuple (not an owner)' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+
+ my %form = (
+ %$default,
+ pause99_remove_dist_comaint_tuples => ['Module-Unrelated -- TESTUSER2'],
+ );
+
+ Test::PAUSE::Web->reset_module_fixture;
+ $t->post_ok("/user/remove_dist_comaint", \%form);
+ my @dists = map {$_->all_text} $t->dom->find('td.dist')->each;
+ my @results = map {$_->all_text} $t->dom->find('.result')->each;
+ my @errors = map {$_->all_text} $t->dom->find('.error')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_set(\@dists, [qw/
+ Module-Admin
+ /]) or note explain \@dists;
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_set(\@dists, [qw/
+ Module-User
+ /]) or note explain \@dists;
+ }
+ ok !@results;
+ eq_or_diff(\@errors, [
+ 'You do not seem to be owner of Module-Unrelated.',
+ ]);
+ # note $t->content;
+ }
+};
+
+subtest 'broken tuple (not a comaint)' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+
+ my @tuples;
+ if ($user eq 'TESTADMIN') {
+ @tuples = (
+ 'Module-Admin -- TESTUSER4',
+ );
+ }
+ if ($user eq 'TESTUSER') {
+ @tuples = (
+ 'Module-User -- TESTUSER4',
+ );
+
+ }
+
+ my %form = (
+ %$default,
+ pause99_remove_dist_comaint_tuples => \@tuples,
+ );
+
+ Test::PAUSE::Web->reset_module_fixture;
+ $t->post_ok("/user/remove_dist_comaint", \%form);
+ my @dists = map {$_->all_text} $t->dom->find('td.dist')->each;
+ my @results = map {$_->all_text} $t->dom->find('.result')->each;
+ my @errors = map {$_->all_text} $t->dom->find('.error')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_set(\@dists, [qw/
+ Module-Admin
+ /]) or note explain \@dists;
+ eq_or_diff(\@errors, [
+ 'Cannot handle tuple Module-Admin -- TESTUSER4. If you believe, this is a bug, please complain.',
+ ]);
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_set(\@dists, [qw/
+ Module-User
+ /]) or note explain \@dists;
+ eq_or_diff(\@errors, [
+ 'Cannot handle tuple Module-User -- TESTUSER4. If you believe, this is a bug, please complain.',
+ ]);
+ }
+ ok !@results;
+ # note $t->content;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2025/remove_dist_primary.t b/t/pause_2025/action_2025/remove_dist_primary.t
new file mode 100644
index 000000000..ef8bd6866
--- /dev/null
+++ b/t/pause_2025/action_2025/remove_dist_primary.t
@@ -0,0 +1,137 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+use Test::Deep;
+use Test::Differences;
+
+my $default = {
+ pause99_remove_dist_primary_d => [],
+ SUBMIT_pause99_remove_dist_primary => 1,
+};
+
+Test::PAUSE::Web->setup;
+Test::PAUSE::Web->reset_module_fixture;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ $t->get_ok("/user/remove_dist_primary");
+ my @dists = map {$_->all_text} $t->dom->find('td.dist')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_bag(\@dists, [qw/
+ Module-Admin
+ /]) or note explain \@dists;
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_bag(\@dists, [qw/
+ Module-User
+ Module-User-Foo-Baz
+ /]) or note explain \@dists;
+ }
+ # note $t->content;
+ }
+};
+
+subtest 'normal case' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+
+ my @dists;
+ if ($user eq 'TESTADMIN') {
+ @dists = qw/Module-Admin/;
+ }
+ if ($user eq 'TESTUSER') {
+ @dists = qw/Module-User/;
+ }
+
+ my %form = (
+ %$default,
+ pause99_remove_dist_primary_d => \@dists,
+ );
+
+ Test::PAUSE::Web->reset_module_fixture;
+ $t->post_ok("/user/remove_dist_primary", \%form);
+ @dists = map {$_->all_text} $t->dom->find('td.dist')->each;
+ my @results = map {$_->all_text} $t->dom->find('.result')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_bag(\@dists, [qw/
+ /]) or note explain \@dists;
+ eq_or_diff(\@results, [
+ 'Removed primary maintainership of TESTADMIN from Module::Admin::Bar (Module-Admin).',
+ 'Removed primary maintainership of TESTADMIN from Module::Admin::Foo (Module-Admin).',
+ ]);
+
+ # really transferred to ADOPTME?
+ $t->get_ok("/user/peek_dist_perms", {
+ pause99_peek_dist_perms_query => "ADOPTME",
+ pause99_peek_dist_perms_by => "a",
+ pause99_peek_dist_perms_sub => 1,
+ });
+ my @adoptme_dists = map {$_->all_text} $t->dom->find('td.dist')->each;
+ cmp_set(\@adoptme_dists, [qw/Module-Admin/]) or note explain \@adoptme_dists;
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_bag(\@dists, [qw/
+ Module-User-Foo-Baz
+ /]) or note explain \@dists;
+ eq_or_diff(\@results, [
+ 'Removed primary maintainership of TESTUSER from Module::User::Bar (Module-User).',
+ 'Removed primary maintainership of TESTUSER from Module::User::Foo (Module-User).',
+ ]);
+
+ # really transferred to ADOPTME?
+ $t->get_ok("/user/peek_dist_perms", {
+ pause99_peek_dist_perms_query => "ADOPTME",
+ pause99_peek_dist_perms_by => "a",
+ pause99_peek_dist_perms_sub => 1,
+ });
+ my @adoptme_dists = map {$_->all_text} $t->dom->find('td.dist')->each;
+ cmp_set(\@adoptme_dists, [qw/Module-User/]) or note explain \@adoptme_dists;
+ }
+ # note $t->content;
+ }
+};
+
+subtest 'unrelated dists' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+
+ my %form = (
+ %$default,
+ pause99_remove_dist_primary_d => [qw/Module-Unrelated/],
+ );
+
+ Test::PAUSE::Web->reset_module_fixture;
+ $t->post_ok("/user/remove_dist_primary", \%form);
+ my @dists = map {$_->all_text} $t->dom->find('td.dist')->each;
+ my @results = map {$_->all_text} $t->dom->find('.result')->each;
+ my @warnings = map {$_->all_text} $t->dom->find('.warning')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_bag(\@dists, [qw/
+ Module-Admin
+ /]) or note explain \@dists;
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_bag(\@dists, [qw/
+ Module-User
+ Module-User-Foo-Baz
+ /]) or note explain \@dists;
+ }
+ ok !@results;
+ eq_or_diff(\@warnings, [
+ 'You need to select one or more distributions. Nothing done.',
+ ]);
+ # note $t->content;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2025/remove_primary.t b/t/pause_2025/action_2025/remove_primary.t
new file mode 100644
index 000000000..32b28a2d6
--- /dev/null
+++ b/t/pause_2025/action_2025/remove_primary.t
@@ -0,0 +1,141 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+use Test::Deep;
+use Test::Differences;
+
+my $default = {
+ pause99_share_perms_pr_m => [],
+ SUBMIT_pause99_share_perms_remopr => 1,
+};
+
+Test::PAUSE::Web->setup;
+Test::PAUSE::Web->reset_module_fixture;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ $t->get_ok("/user/remove_primary");
+ my @modules = map {$_->all_text} $t->dom->find('td.package')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_bag(\@modules, [qw/
+ Module::Admin::Bar
+ Module::Admin::Foo
+ /]) or note explain \@modules;
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_bag(\@modules, [qw/
+ Module::User::Bar
+ Module::User::Foo
+ Module::User::Foo::Baz
+ /]) or note explain \@modules;
+ }
+ # note $t->content;
+ }
+};
+
+subtest 'normal case' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+
+ my @packages;
+ if ($user eq 'TESTADMIN') {
+ @packages = qw/Module::Admin::Bar/;
+ }
+ if ($user eq 'TESTUSER') {
+ @packages = qw/Module::User::Bar/;
+ }
+
+ my %form = (
+ %$default,
+ pause99_share_perms_pr_m => \@packages,
+ );
+
+ Test::PAUSE::Web->reset_module_fixture;
+ $t->post_ok("/user/remove_primary", \%form);
+ my @modules = map {$_->all_text} $t->dom->find('td.package')->each;
+ my @results = map {$_->all_text} $t->dom->find('.result')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_bag(\@modules, [qw/
+ Module::Admin::Foo
+ /]) or note explain \@modules;
+ eq_or_diff(\@results, [
+ 'Removed primary maintainership of TESTADMIN from Module::Admin::Bar.',
+ ]);
+
+ # really transferred to ADOPTME?
+ $t->get_ok("/user/peek_perms", {
+ pause99_peek_perms_query => "ADOPTME",
+ pause99_peek_perms_by => "a",
+ pause99_peek_perms_sub => 1,
+ });
+ my @adoptme_modules = map {$_->all_text} $t->dom->find('td.module')->each;
+ cmp_set(\@adoptme_modules, [qw/Module::Admin::Bar/]) or note explain \@adoptme_modules;
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_bag(\@modules, [qw/
+ Module::User::Foo
+ Module::User::Foo::Baz
+ /]) or note explain \@modules;
+ eq_or_diff(\@results, [
+ 'Removed primary maintainership of TESTUSER from Module::User::Bar.',
+ ]);
+
+ # really transferred to ADOPTME?
+ $t->get_ok("/user/peek_perms", {
+ pause99_peek_perms_query => "ADOPTME",
+ pause99_peek_perms_by => "a",
+ pause99_peek_perms_sub => 1,
+ });
+ my @adoptme_modules = map {$_->all_text} $t->dom->find('td.module')->each;
+ cmp_set(\@adoptme_modules, [qw/Module::User::Bar/]) or note explain \@adoptme_modules;
+ }
+ # note $t->content;
+ }
+};
+
+subtest 'unrelated modules' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+
+ my %form = (
+ %$default,
+ pause99_share_perms_pr_m => [qw/Module::Unrelated/],
+ );
+
+ Test::PAUSE::Web->reset_module_fixture;
+ $t->post_ok("/user/remove_primary", \%form);
+ my @modules = map {$_->all_text} $t->dom->find('td.package')->each;
+ my @results = map {$_->all_text} $t->dom->find('.result')->each;
+ my @warnings = map {$_->all_text} $t->dom->find('.warning')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_bag(\@modules, [qw/
+ Module::Admin::Bar
+ Module::Admin::Foo
+ /]) or note explain \@modules;
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_bag(\@modules, [qw/
+ Module::User::Bar
+ Module::User::Foo
+ Module::User::Foo::Baz
+ /]) or note explain \@modules;
+ }
+ ok !@results;
+ eq_or_diff(\@warnings, [
+ 'You need to select one or more packages. Nothing done.',
+ ]);
+ # note $t->content;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2025/request_id.t b/t/pause_2025/action_2025/request_id.t
new file mode 100644
index 000000000..f1257556e
--- /dev/null
+++ b/t/pause_2025/action_2025/request_id.t
@@ -0,0 +1,289 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+
+my $default = {
+ pause99_request_id_fullname => 'full name',
+ pause99_request_id_email => 'test@localhost.localdomain',
+ pause99_request_id_homepage => 'none',
+ pause99_request_id_userid => 'NEWUSER',
+ pause99_request_id_rationale => 'Hello, my ratoinale is to test PAUSE',
+ SUBMIT_pause99_request_id_sub => 1,
+};
+
+Test::PAUSE::Web->setup;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ $t->get_ok("/public/request_id");
+ # note $t->content;
+ }
+};
+
+subtest 'post: basic' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ my %form = %$default;
+ $t->post_ok("/public/request_id", \%form)
+ ->text_like("pre.email_sent", qr/Subject: PAUSE ID request \(NEWUSER/);
+ is $t->deliveries => 2, "two deliveries (one for admin, one for requester)";
+ # note $t->content;
+ }
+};
+
+subtest 'post: thank you, bot' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ my %form = (
+ %$default,
+ url => 'http://host/path',
+ );
+ $t->post_ok("/public/request_id", \%form);
+ is $t->content => "Thank you!";
+ ok !$t->deliveries, "no deliveries";
+ # note $t->content;
+ }
+};
+
+subtest 'post: no space in full name' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ my %form = (
+ %$default,
+ pause99_request_id_fullname => 'FULLNAME',
+ );
+ $t->post_ok("/public/request_id", \%form)
+ ->text_is("h3", "Error processing form")
+ ->text_like("ul.errors li", qr/Name does not look like a full civil name/);
+ ok !$t->deliveries, "no deliveries";
+ # note $t->content;
+ }
+};
+
+subtest 'post: no full name' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ my %form = (
+ %$default,
+ pause99_request_id_fullname => '',
+ );
+ $t->post_ok("/public/request_id", \%form)
+ ->text_is("h3", "Error processing form")
+ ->text_like("ul.errors li", qr/You must supply a name/);
+ ok !$t->deliveries, "no deliveries";
+ # note $t->content;
+ }
+};
+
+subtest 'post: no email' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ my %form = (
+ %$default,
+ pause99_request_id_email => '',
+ );
+ $t->post_ok("/public/request_id", \%form)
+ ->text_is("h3", "Error processing form")
+ ->text_like("ul.errors li", qr/You must supply an email address/);
+ ok !$t->deliveries, "no deliveries";
+ # note $t->content;
+ }
+};
+
+subtest 'post: invalid email' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ my %form = (
+ %$default,
+ pause99_request_id_email => 'no email',
+ );
+ $t->post_ok("/public/request_id", \%form)
+ ->text_is("h3", "Error processing form")
+ ->text_like("ul.errors li", qr/Your email address doesn't look like valid email address./);
+ ok !$t->deliveries, "no deliveries";
+ # note $t->content;
+ }
+};
+
+subtest 'post: rational is too short' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ my %form = (
+ %$default,
+ pause99_request_id_rationale => 'rationale',
+ );
+ $t->post_ok("/public/request_id", \%form)
+ ->text_is("h3", "Error processing form")
+ ->text_like("ul.errors li", qr/this looks a\s+bit too short/);
+ ok !$t->deliveries, "no deliveries";
+ # note $t->content;
+ }
+};
+
+# XXX: might be better to ignore other attributes (or YAGNI)
+subtest 'post: rational has html links' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ my %form = (
+ %$default,
+ pause99_request_id_rationale => '',
+ );
+ $t->post_ok("/public/request_id", \%form)
+ ->text_is("h3", "Error processing form")
+ ->text_like("ul.errors li", qr/Please do not use HTML links/);
+ ok !$t->deliveries, "no deliveries";
+ # note $t->content;
+ }
+};
+
+subtest 'post: multiple links' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ my %form = (
+ %$default,
+ pause99_request_id_rationale => <<'SPAM',
+http://spam/path
+http://spam/path
+SPAM
+ );
+ $t->post_ok("/public/request_id", \%form)
+ ->text_is("h3", "Error processing form")
+ ->text_like("ul.errors li", qr/Please do not include more than one URL/);
+ ok !$t->deliveries, "no deliveries";
+ # note $t->content;
+ }
+};
+
+subtest 'post: no rationale' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ my %form = (
+ %$default,
+ pause99_request_id_rationale => '',
+ );
+ $t->post_ok("/public/request_id", \%form)
+ ->text_is("h3", "Error processing form")
+ ->text_like("ul.errors li", qr/You must supply a short description/);
+ ok !$t->deliveries, "no deliveries";
+ # note $t->content;
+ }
+};
+
+subtest 'post: userid is taken' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ my %form = (
+ %$default,
+ pause99_request_id_userid => 'TESTUSER',
+ );
+ $t->post_ok("/public/request_id", \%form)
+ ->text_is("h3", "Error processing form")
+ ->text_like("ul.errors li", qr/The userid TESTUSER is already taken/);
+ ok !$t->deliveries, "no deliveries";
+ # note $t->content;
+ }
+};
+
+subtest 'post: invalid userid' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ my %form = (
+ %$default,
+ pause99_request_id_userid => 'INV#LID',
+ );
+ $t->post_ok("/public/request_id", \%form)
+ ->text_is("h3", "Error processing form")
+ ->text_like("ul.errors li", qr/The userid INV#LID does not match/);
+ ok !$t->deliveries, "no deliveries";
+ # note $t->content;
+ }
+};
+
+subtest 'post: no userid' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ my %form = (
+ %$default,
+ pause99_request_id_userid => '',
+ );
+ $t->post_ok("/public/request_id", \%form)
+ ->text_is("h3", "Error processing form")
+ ->text_like("ul.errors li", qr/You must supply a desired user-ID/);
+ ok !$t->deliveries, "no deliveries";
+ # note $t->content;
+ }
+};
+
+subtest 'post: lots of .info' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ my %form = (
+ %$default,
+ pause99_request_id_rationale => <<'SPAM',
+ttp://spam.info
+ttp://spam.info
+ttp://spam.info
+ttp://spam.info
+ttp://spam.info
+SPAM
+ );
+ $t->post_ok("/public/request_id", \%form)
+ ->text_is("h2", "Error")
+ ->text_like("p.error_message", qr/rationale looks like spam/);
+ ok !$t->deliveries, "no deliveries";
+ # note $t->content;
+ }
+};
+
+subtest 'post: interesting .cn homepage' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ my %form = (
+ %$default,
+ pause99_request_id_homepage => 'http://some.cn/index.htm',
+ pause99_request_id_rationale => 'interesting site',
+ );
+ $t->post_ok("/public/request_id", \%form)
+ ->text_is("h2", "Error")
+ ->text_like("p.error_message", qr/rationale looks like spam/);
+ ok !$t->deliveries, "no deliveries";
+ # note $t->content;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2025/reset_version.t b/t/pause_2025/action_2025/reset_version.t
new file mode 100644
index 000000000..60f96653e
--- /dev/null
+++ b/t/pause_2025/action_2025/reset_version.t
@@ -0,0 +1,50 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+
+my $default = {
+ pause99_reset_version_PKG => ["Foo"],
+ SUBMIT_pause99_reset_version_forget => 1,
+};
+
+Test::PAUSE::Web->setup;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ $t->get_ok("/user/reset_version");
+ # note $t->content;
+ }
+};
+
+subtest 'post: basic' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+
+ $t->mod_dbh->do("TRUNCATE packages");
+ $t->mod_db->insert('packages', {
+ package => "Foo",
+ version => "0.01",
+ dist => "T/TE/$user/Foo-0.01.tar.gz",
+ file => "Foo-0.01.tar.gz",
+ });
+ $t->mod_db->insert('packages', {
+ package => "Bar",
+ version => "0.02",
+ dist => "T/TE/$user/Bar-0.02.tar.gz",
+ file => "Bar-0.02.tar.gz",
+ });
+
+ my %form = %$default;
+ $t->post_ok("/user/reset_version", \%form);
+ # note $t->content;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2025/select_ml_action.t b/t/pause_2025/action_2025/select_ml_action.t
new file mode 100644
index 000000000..5440333dd
--- /dev/null
+++ b/t/pause_2025/action_2025/select_ml_action.t
@@ -0,0 +1,51 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+
+my $mailing_list = {
+ SUBMIT_pause99_add_user_Definitely => 1,
+ pause99_add_user_userid => "MAILLIST",
+ pause99_add_user_email => "ml\@localhost.localdomain",
+ pause99_add_user_subscribe => "how to subscribe",
+};
+
+my $default = {
+ HIDDENNAME => "TESTUSER",
+ ACTIONREQ => "edit_ml",
+ pause99_select_ml_action_sub => 1,
+};
+
+Test::PAUSE::Web->setup;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('admin')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ $t->get_ok("/mlrepr/select_ml_action");
+ # note $t->content;
+ }
+};
+
+subtest 'post: basic' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('admin')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+
+ $t->post_ok("/admin/add_user", $mailing_list);
+
+ $t->mod_db->insert("list2user", {
+ maillistid => "MAILLIST",
+ userid => "TESTUSER",
+ }, {ignore => 1});
+
+ my %form = %$default;
+ $t->post_ok("/mlrepr/select_ml_action", \%form);
+ note $t->content;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2025/select_user.t b/t/pause_2025/action_2025/select_user.t
new file mode 100644
index 000000000..5ed844b67
--- /dev/null
+++ b/t/pause_2025/action_2025/select_user.t
@@ -0,0 +1,19 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+
+Test::PAUSE::Web->setup;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('admin')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ $t->get_ok("/admin/select_user");
+ # note $t->content;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2025/share_perms.t b/t/pause_2025/action_2025/share_perms.t
new file mode 100644
index 000000000..1af2a33b3
--- /dev/null
+++ b/t/pause_2025/action_2025/share_perms.t
@@ -0,0 +1,19 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+
+Test::PAUSE::Web->setup;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ $t->get_ok("/user/share_perms");
+ # note $t->content;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2025/show_files.t b/t/pause_2025/action_2025/show_files.t
new file mode 100644
index 000000000..8960bc84b
--- /dev/null
+++ b/t/pause_2025/action_2025/show_files.t
@@ -0,0 +1,19 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+
+Test::PAUSE::Web->setup;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ $t->get_ok("/user/show_files");
+ # note $t->content;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2025/show_ml_repr.t b/t/pause_2025/action_2025/show_ml_repr.t
new file mode 100644
index 000000000..b9ced8642
--- /dev/null
+++ b/t/pause_2025/action_2025/show_ml_repr.t
@@ -0,0 +1,19 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+
+Test::PAUSE::Web->setup;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('admin')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ $t->get_ok("/mlrepr/show_ml_repr");
+ # note $t->content;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2025/tail_logfile.t b/t/pause_2025/action_2025/tail_logfile.t
new file mode 100644
index 000000000..f49f812ca
--- /dev/null
+++ b/t/pause_2025/action_2025/tail_logfile.t
@@ -0,0 +1,45 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+
+my $default = {
+ pause99_tail_logfile_1 => 5000,
+ pause99_tail_logfile_sub => 1,
+};
+
+Test::PAUSE::Web->setup;
+
+{
+ open my $fh, '>', $PAUSE::Config->{PAUSE_LOG};
+ say $fh < sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ $t->get_ok("/user/tail_logfile");
+ # note $t->content;
+ }
+};
+
+subtest 'post: basic' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+
+ my %form = %$default;
+ $t->post_ok("/user/tail_logfile", \%form);
+ # note $t->content;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2025/who_admin.t b/t/pause_2025/action_2025/who_admin.t
new file mode 100644
index 000000000..b7918d74c
--- /dev/null
+++ b/t/pause_2025/action_2025/who_admin.t
@@ -0,0 +1,38 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use YAML::Syck ();
+
+Test::PAUSE::Web->setup;
+
+# SELECT user FROM grouptable WHERE ugroup='admin' order by user");
+subtest 'get' => sub {
+ Test::PAUSE::Web->authen_db->insert('grouptable', {
+ user => "FOO",
+ ugroup => "admin",
+ });
+ Test::PAUSE::Web->authen_db->insert('grouptable', {
+ user => "BAR",
+ ugroup => "admin",
+ });
+ Test::PAUSE::Web->authen_db->insert('grouptable', {
+ user => "BAZ",
+ ugroup => "bar",
+ });
+
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+
+ $t->get_ok("/public/who_admin")
+ ->text_like('body', qr/Registered admins:\s+BAR, FOO/);
+
+ $t->get_ok("/public/who_admin?OF=YAML");
+ my $list_amp = YAML::Syck::Load( $t->content );
+ is_deeply( $list_amp, [qw/BAR FOO TESTADMIN/], "YAML output works" );
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2025/who_pumpkin.t b/t/pause_2025/action_2025/who_pumpkin.t
new file mode 100644
index 000000000..05f5d576a
--- /dev/null
+++ b/t/pause_2025/action_2025/who_pumpkin.t
@@ -0,0 +1,38 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use YAML::Syck ();
+
+Test::PAUSE::Web->setup;
+
+# SELECT user FROM grouptable WHERE ugroup='pumpking' order by user");
+subtest 'get' => sub {
+ Test::PAUSE::Web->authen_db->insert('grouptable', {
+ user => "FOO",
+ ugroup => "pumpking",
+ });
+ Test::PAUSE::Web->authen_db->insert('grouptable', {
+ user => "BAR",
+ ugroup => "pumpking",
+ });
+ Test::PAUSE::Web->authen_db->insert('grouptable', {
+ user => "BAZ",
+ ugroup => "baz",
+ });
+
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+
+ $t->get_ok("/public/who_pumpkin")
+ ->text_like("body", qr/Registered pumpkins:\s+BAR, FOO/);
+
+ $t->get_ok("/public/who_pumpkin?OF=YAML");
+ my $list_amp = YAML::Syck::Load( $t->content );
+ is_deeply( $list_amp, [qw/BAR FOO/], "YAML output works" );
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/auth.t b/t/pause_2025/auth.t
new file mode 100644
index 000000000..96b9c16b3
--- /dev/null
+++ b/t/pause_2025/auth.t
@@ -0,0 +1,121 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/lib";
+use Test::PAUSE::Web;
+use HTTP::Status qw/:constants/;
+use utf8;
+
+Test::PAUSE::Web->setup;
+
+subtest 'for 2017 app' => sub {
+ subtest 'basic' => sub {
+ my $test = Test::PAUSE::Web->tests_for('user');
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ my $res = $t->get("$path");
+ ok $res->is_success;
+ };
+
+ subtest 'lower case' => sub {
+ my $test = Test::PAUSE::Web->tests_for('user');
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => lc $user);
+ my $res = $t->get("$path");
+ ok $res->is_success;
+ };
+
+ subtest 'wrong password' => sub {
+ my $test = Test::PAUSE::Web->tests_for('user');
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user, pass => "WRONG PASS");
+ my $res = $t->get("$path");
+ ok !$res->is_success;
+ is $res->code => HTTP_UNAUTHORIZED;
+ };
+
+ subtest 'unknown user' => sub {
+ my $test = Test::PAUSE::Web->tests_for('user');
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => "UNKNOWN");
+ my $res = $t->get("$path");
+ ok !$res->is_success;
+ is $res->code => HTTP_UNAUTHORIZED;
+ };
+
+ subtest 'disallowed action for an anonymous user' => sub {
+ my $test = Test::PAUSE::Web->tests_for('user');
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ my $res = $t->get("/pause/authenquery/?ACTION=add_user");
+ ok !$res->is_success;
+ is $res->code => HTTP_UNAUTHORIZED;
+ };
+
+ subtest 'disallowed action for a user' => sub {
+ my $test = Test::PAUSE::Web->tests_for('user');
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ my $res = $t->get("/pause/authenquery/?ACTION=add_user");
+ ok !$res->is_success;
+ is $res->code => HTTP_FORBIDDEN;
+ };
+};
+
+subtest 'for 2025 app' => sub {
+ subtest 'basic' => sub {
+ my $test = Test::PAUSE::Web->tests_for('user');
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ my $res = $t->login(user => $user);
+ ok $res->is_success;
+ ok my @redirects = $res->redirects, "login succeeded and redirected";
+ is $redirects[0]->header('Location')->path => '/';
+ };
+
+ subtest 'lower case' => sub {
+ my $test = Test::PAUSE::Web->tests_for('user');
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => lc $user);
+ my $res = $t->login(user => lc $user);
+ ok $res->is_success;
+ ok my @redirects = $res->redirects, "login succeeded and redirected";
+ is $redirects[0]->header('Location')->path => '/';
+ };
+
+ subtest 'wrong password' => sub {
+ my $test = Test::PAUSE::Web->tests_for('user');
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ my $res = $t->login(user => $user, pass => "WRONG PASS");
+ ok !(my @redirects = $res->redirects), "login failed and not redirected";
+ };
+
+ subtest 'unknown user' => sub {
+ my $test = Test::PAUSE::Web->tests_for('user');
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ my $res = $t->login(user => "UNKNOWN");
+ ok !(my @redirects = $res->redirects), "login failed and not redirected";
+ };
+
+ subtest 'disallowed action for an anonymous user' => sub {
+ my $test = Test::PAUSE::Web->tests_for('user');
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ my $res = $t->get("/admin/add_user");
+ ok !$res->is_success;
+ is $res->code => HTTP_FORBIDDEN;
+ };
+
+ subtest 'disallowed action for a user' => sub {
+ my $test = Test::PAUSE::Web->tests_for('user');
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ my $res = $t->get("/admin/add_user");
+ ok !$res->is_success;
+ is $res->code => HTTP_FORBIDDEN;
+ };
+};
+
+done_testing;
diff --git a/t/pause_2025/lib/Test/PAUSE/MySQL.pm b/t/pause_2025/lib/Test/PAUSE/MySQL.pm
new file mode 100644
index 000000000..13ae4873a
--- /dev/null
+++ b/t/pause_2025/lib/Test/PAUSE/MySQL.pm
@@ -0,0 +1,230 @@
+package Test::PAUSE::MySQL;
+
+use Test::Builder ();
+use Test::Requires qw(Test::mysqld);
+use Test::Requires qw(File::Which);
+
+BEGIN {
+ unless (File::Which::which 'mysql') {
+ Test::Builder->new->skip_all("no mysql found, needed for this test")
+ }
+}
+
+use Moose;
+use Test::mysqld;
+use Test::More;
+use DBI;
+use File::Temp qw/tempfile/;
+use Capture::Tiny qw/capture_merged/;
+use SQL::Maker;
+use Path::Tiny;
+
+$SIG{INT} = sub { die "caught SIGINT, shutting down mysql\n" };
+
+# These are the only caller-configurable parts
+
+# SQL to load at instantiation
+has 'schemas' => (
+ is => 'ro',
+ isa => 'ArrayRef[Str]',
+ default => sub {[]},
+);
+
+# Location of the mysql client binary
+has 'mysql_client' => (
+ is => 'ro',
+ isa => 'Str',
+ default => ($ENV{'PAUSE_MYSQL_CLIENT'} || 'mysql'),
+);
+
+# These are the public methods
+
+# DBH
+has 'dbh' => (
+ is => 'ro',
+ isa => 'DBI::db',
+ lazy_build => 1,
+);
+
+has 'sql_maker' => (
+ is => 'ro',
+ isa => 'SQL::Maker',
+ lazy_build => 1,
+);
+
+# Drops you in to `mysql` connected to the database
+sub debug_console {
+ my $self = shift;
+ $self->run_mysql();
+}
+
+sub dsn {
+ my $self = shift;
+ return $self->mysqld->dsn( dbname => $self->_db_name );
+}
+
+# Private attributes
+
+# Object-specific database name
+has '_db_name' => (
+ is => 'ro',
+ isa => 'Str',
+ lazy_build => 1,
+);
+
+sub _build__db_name {
+ my $self = shift;
+ return 'db_' . ( $self + 0 ) . int(rand 999_999);
+}
+
+# Location of the config file for the mysql client
+has '_auth_file' => (
+ is => 'ro',
+ isa => 'Str',
+ lazy_build => 1,
+);
+
+sub _build__auth_file {
+ my $self = shift;
+ my ($fh, $filename) = tempfile();
+ my $args = $self->dsn;
+ $args =~ s/DBI:mysql://;
+
+ my %options = map { split /=/ } split( /;/, $args );
+ $options{'database'} = delete $options{'dbname'};
+ $options{'socket'} = delete $options{'mysql_socket'};
+ $options{'default-character-set'} = 'utf8';
+
+ my $auth_content = join "\n", "[client]",
+ map { "$_=" . $options{$_} } keys %options;
+
+ print $fh $auth_content;
+ close $fh;
+ return $filename;
+}
+
+sub BUILD {
+ my $self = shift;
+ my $dbh = $self->dbh;
+
+ for my $schema ( @{$self->schemas} ) {
+ note("Loading schema: $schema");
+ my $body = path($schema)->slurp;
+ for (grep $_, split /;\n/s, $body) {
+ $dbh->do($_);
+ }
+ }
+}
+
+
+
+sub _build_dbh {
+ my $self = shift;
+ my $dbname = $self->_db_name;
+
+ my $master_dbh = DBI->connect(
+ $self->mysqld->dsn(
+ dbname => 'test',
+ 'default-character-set' => 'utf8'
+ )
+ );
+
+ note("Creating new MySQL database: $dbname");
+ $master_dbh->do( 'CREATE DATABASE ' . $dbname )
+ or die $master_dbh->errstr;
+
+ # Connect to it
+ my $dbh = DBI->connect( $self->mysqld->dsn( dbname => $dbname ),
+ '', '', { RaiseError => 1 } );
+
+ return $dbh;
+}
+
+sub _build_sql_maker {
+ my $self = shift;
+ SQL::Maker->new(driver => 'mysql');
+}
+
+sub run_mysql {
+ my $self = shift;
+ my $cmd = shift || '';
+ my $exe = $self->mysql_client;
+ system(sprintf("%s --defaults-extra-file=%s %s", $exe, $self->_auth_file, $cmd));
+}
+
+# mysqld singleton. We might have different tests that want to execute in
+# seperate DBs, but I can't see why we'd want to be running more than one
+# mysqld, so we do a singleton here
+our $mysqld;
+
+sub mysqld {
+ my $self = shift;
+ return $mysqld if $mysqld;
+
+ note("Starting a test mysqld");
+ note(
+ capture_merged(
+ sub { $mysqld = Test::mysqld->new(
+ my_cnf => { 'skip-networking' => '' }
+ );
+ }
+ )
+ );
+ die $Test::mysqld::errstr unless $mysqld;
+ note("mysqld started");
+
+ return $mysqld;
+}
+
+my %DefaultValues = (
+ # authen_pause
+ # mod
+ packages => {
+ filemtime => time,
+ pause_reg => 'TESTUSER',
+ comment => '',
+ status => 'index',
+ },
+ users => {
+ fullname => 'test',
+ homepage => '',
+ isa_list => '',
+ introduced => time,
+ changed => time,
+ changedby => 'TESTADMIN',
+ },
+);
+
+sub insert {
+ my ($self, $table, $values, $opt) = @_;
+ if (my $default = $DefaultValues{$table}) {
+ for my $key (keys %$default) {
+ $values->{$key} //= $default->{$key};
+ }
+ }
+ if ($opt and delete $opt->{replace}) {
+ $opt->{prefix} = 'REPLACE';
+ }
+ my ($sql, @bind) = $self->sql_maker->insert($table, $values, $opt);
+ $self->dbh->do($sql, undef, @bind);
+}
+
+sub update {
+ my ($self, $table, $set, $where) = @_;
+ my ($sql, @bind) = $self->sql_maker->update($table, $set, $where);
+ $self->dbh->do($sql, undef, @bind);
+}
+
+sub delete {
+ my ($self, $table, $where) = @_;
+ my ($sql, @bind) = $self->sql_maker->delete($table, $where);
+ $self->dbh->do($sql, undef, @bind);
+}
+
+sub select {
+ my ($self, $table, $fields, $where, $opt) = @_;
+ my ($sql, @bind) = $self->sql_maker->select($table, $fields, $where, $opt);
+ $self->dbh->selectall_arrayref($sql, {Slice => +{}}, @bind);
+}
+
+1;
diff --git a/t/pause_2025/lib/Test/PAUSE/Web.pm b/t/pause_2025/lib/Test/PAUSE/Web.pm
new file mode 100644
index 000000000..0704514de
--- /dev/null
+++ b/t/pause_2025/lib/Test/PAUSE/Web.pm
@@ -0,0 +1,490 @@
+package Test::PAUSE::Web;
+
+use strict;
+use warnings;
+use FindBin;
+use JSON::PP; # just to avoid redefine warnings
+use Path::Tiny;
+use DBI;
+use Plack::Test;
+use Test::WWW::Mechanize::PSGI;
+use Test::More;
+use Exporter qw/import/;
+use Test::PAUSE::MySQL;
+use Email::Sender::Simple;
+use Mojo::DOM;
+use URI;
+use URI::QueryParam;
+
+our $AppRoot = path(__FILE__)->parent->parent->parent->parent->parent->parent->realpath;
+#our $AppRoot = path(__FILE__)->parent->parent->parent->parent->parent->parent->parent->realpath;
+our $TmpDir = Path::Tiny->tempdir(TEMPLATE => "pause_web_XXXXXXXX");
+our $TestRoot = path($TmpDir)->realpath;
+our $TestEmail = 'pause_admin@localhost.localdomain';
+our @EXPORT = @Test::More::EXPORT;
+
+our $FilenameToUpload = "Hash-RenameKey-0.02.tar.gz";
+our $FileToUpload = "$AppRoot/t/staging/$FilenameToUpload";
+
+push @INC, "$AppRoot/lib", "$AppRoot/lib/pause_2025", "$AppRoot/lib/pause_2017", "$AppRoot/privatelib";
+
+$TmpDir->child($_)->mkpath for qw/rundata incoming etc public log/;
+$TmpDir->child('log')->child('paused.log')->touch();
+
+$INC{"PrivatePAUSE.pm"} = 1;
+$ENV{EMAIL_SENDER_TRANSPORT} = "Test";
+
+require PAUSE;
+require PAUSE::Web2025::Config;
+
+$PAUSE::Config->{DOCUMENT_ROOT} = "$AppRoot/htdocs";
+$PAUSE::Config->{PID_DIR} = $TestRoot;
+$PAUSE::Config->{ADMIN} = $TestEmail;
+$PAUSE::Config->{ADMINS} = [$TestEmail];
+$PAUSE::Config->{CPAN_TESTERS} = $TestEmail;
+$PAUSE::Config->{TO_CPAN_TESTERS} = $TestEmail;
+$PAUSE::Config->{REPLY_TO_CPAN_TESTERS} = $TestEmail;
+$PAUSE::Config->{GONERS_NOTIFY} = $TestEmail;
+$PAUSE::Config->{P5P} = $TestEmail;
+$PAUSE::Config->{MLROOT} = "$TestRoot/public/authors/id";
+$PAUSE::Config->{ML_CHOWN_USER} = 'ishigaki';
+$PAUSE::Config->{ML_CHOWN_GROUP} = 'ishigaki';
+$PAUSE::Config->{ML_MIN_INDEX_LINES} = 0;
+$PAUSE::Config->{ML_MIN_FILES} = 0;
+$PAUSE::Config->{RUNDATA} = "$TestRoot/rundata";
+$PAUSE::Config->{UPLOAD} = $TestEmail;
+$PAUSE::Config->{HAVE_PERLBAL} = 0;
+$PAUSE::Config->{SLEEP} = 1;
+$PAUSE::Config->{INCOMING} = "file://$TestRoot/incoming/";
+$PAUSE::Config->{INCOMING_LOC} = "$TestRoot/incoming/";
+$PAUSE::Config->{PAUSE_LOG} = "$TestRoot/log/paused.log";
+$PAUSE::Config->{PAUSE_LOG_DIR} = "$TestRoot/log";
+$PAUSE::Config->{RECAPTCHA_ENABLED} = 0;
+
+# These will get changed every time you run setup()
+$PAUSE::Config->{AUTHEN_DATA_SOURCE_NAME} = "";
+$PAUSE::Config->{MOD_DATA_SOURCE_NAME} = "";
+
+$ENV{TEST_PAUSE_WEB} = 1;
+
+our $AuthDBH;
+our $ModDBH;
+
+my $dbh_attr = {ShowErrorStatement => 1};
+
+sub authen_dbh { $AuthDBH ||= authen_db()->dbh }
+sub mod_dbh { $ModDBH ||= mod_db()->dbh }
+
+our $AuthDB;
+sub authen_db {
+ my $db = $AuthDB ||= Test::PAUSE::MySQL->new(
+ schemas => ["$AppRoot/doc/authen_pause.schema.txt"]
+ );
+ $PAUSE::Config->{AUTHEN_DATA_SOURCE_NAME} = $db->dsn;
+ $db;
+}
+
+our $ModDB;
+sub mod_db {
+ my $db = $ModDB ||= Test::PAUSE::MySQL->new(
+ schemas => ["$AppRoot/doc/mod.schema.txt"]
+ );
+ $PAUSE::Config->{MOD_DATA_SOURCE_NAME} = $db->dsn;
+ $db;
+}
+
+sub setup { # better to use Test::mysqld
+ my $class = shift;
+
+ require PAUSE::Crypt;
+
+ # Remove old DB handles and objects
+ undef $AuthDBH;
+ undef $AuthDB;
+ undef $ModDBH;
+ undef $ModDB;
+
+ $class->reset_fixture;
+}
+
+sub reset_fixture {
+ my $self = shift;
+
+ # test fixture
+ { # authen_pause.usertable
+ $self->authen_dbh->do(qq{TRUNCATE usertable});
+ for my $user ("TESTUSER", "TESTUSER2", "TESTUSER3", "TESTUSER4", "TESTADMIN", "TESTCNSRD") {
+ $self->authen_db->insert('usertable', {
+ user => $user,
+ password => PAUSE::Crypt::hash_password("test"),
+ secretemail => lc($user) . '@localhost',
+ });
+ my $user_dir = join "/", $PAUSE::Config->{MLROOT}, PAUSE::user2dir($user);
+ path($user_dir)->mkpath;
+ }
+ }
+ { # authen_pause.grouptable
+ $self->authen_dbh->do(qq{TRUNCATE grouptable});
+ $self->authen_db->insert('grouptable', {user => "TESTADMIN", ugroup => "admin"});
+ }
+ { # mod.users
+ $self->mod_dbh->do(qq{TRUNCATE users});
+ for my $user ("TESTUSER", "TESTUSER2", "TESTUSER3", "TESTUSER4", "TESTADMIN", "TESTCNSRD") {
+ $self->mod_db->insert('users', {
+ userid => $user,
+ fullname => "$user Name",
+ email => ($user eq "TESTCNSRD" ? "CENSORED" : (lc($user) . '@localhost')),
+ cpan_mail_alias => 'secr',
+ isa_list => '',
+ });
+ }
+ }
+ $self;
+}
+
+sub new {
+ my ($class, %args) = @_;
+
+ my $psgi = $ENV{TEST_PAUSE_WEB_PSGI} // "app_2025.psgi";
+ my $app = do "$AppRoot/$psgi";
+
+ $args{mech} = Test::WWW::Mechanize::PSGI->new(app => $app, cookie_jar => {});
+ if (!$INC{'Devel/Cover.pm'} and !$ENV{TRAVIS} and $ENV{HARNESS_VERBOSE} and eval {require LWP::ConsoleLogger::Easy; 1}) {
+ LWP::ConsoleLogger::Easy::debug_ua($args{mech});
+ }
+ $args{pass} ||= "test" if $args{user};
+
+ $class->clear_deliveries;
+
+ bless \%args, $class;
+}
+
+sub set_credentials {
+ my $self = shift;
+ return unless $self->{user};
+ note "log in as ".$self->{user};
+ $self->{mech}->credentials($self->{user}, $self->{pass});
+ $self->{mech}->{env}{REMOTE_USER} = $self->{user};
+}
+
+sub login {
+ my ($self, %args) = @_;
+ my $user = $args{user} or return;
+ my $pass = $args{pass} || 'test';
+ note "log in as $user";
+ $self->{mech}->get('/login');
+ $self->{mech}->submit_form(fields => {pause_id => $user, password => $pass});
+}
+
+sub get {
+ my ($self, $url, @args) = @_;
+
+ $self->set_credentials if $self->{user};
+ if (@args and ref $args[0] eq 'HASH') {
+ my $params = shift @args;
+ $url = URI->new($url);
+ $url->query_param($_ => $params->{$_}) for keys %$params;
+ }
+ my $res = $self->{mech}->get($url, @args);
+ unlike $res->decoded_content => qr/(?:HASH|ARRAY|SCALAR|CODE)\(/; # most likely stringified reference
+ ok !grep /(?:HASH|ARRAY|SCALAR|CODE)\(/, map {$_->as_string} $self->deliveries;
+ $res;
+}
+
+sub get_ok {
+ my ($self, $url, @args) = @_;
+
+ $self->clear_deliveries;
+ my $res = $self->get($url, @args);
+ ok $res->is_success, "GET $url";
+ $self->title_is_ok($url);
+ $self->note_deliveries;
+ $self;
+}
+
+sub post {
+ my ($self, $url, @args) = @_;
+
+ $self->set_credentials if $self->{user};
+ my $res = $self->{mech}->post($url, @args);
+ unlike $res->decoded_content => qr/(?:HASH|ARRAY|SCALAR|CODE)\(/; # most likely stringified reference
+ ok !grep /(?:HASH|ARRAY|SCALAR|CODE)\(/, map {$_->as_string} $self->deliveries;
+ $res;
+}
+
+sub post_ok {
+ my ($self, $url, @args) = @_;
+
+ $self->clear_deliveries;
+ my $res = $self->post($url, @args);
+ ok $res->is_success, "POST $url";
+ $self->title_is_ok($url);
+ $self->note_deliveries;
+ $self;
+}
+
+sub post_with_token {
+ my ($self, $url, @args) = @_;
+
+ my $res = $self->get($url);
+ return $res unless $res->is_success;
+ my $input = Mojo::DOM->new($res->decoded_content)->at('input[name="csrf_token"]');
+ my $token = $input ? $input->attr('value') : '';
+ ok $token, "Got a CSRF token";
+ @args = {} if !@args;
+ $args[0]->{csrf_token} = $token if @args and ref $args[0] eq 'HASH';
+
+ $res = $self->post($url, @args);
+}
+
+sub post_with_token_ok {
+ my ($self, $url, @args) = @_;
+
+ $self->clear_deliveries;
+ my $res = $self->post_with_token($url, @args);
+ ok $res->is_success, "POST $url";
+ $self->title_is_ok($url);
+ $self->note_deliveries;
+ $self;
+}
+
+sub tests_for {
+ my ($self, $permission) = @_;
+ my @tests;
+ if ($permission eq "public") {
+ push @tests, (
+ ["/pause/query"],
+ ["/pause/query", "TESTUSER"],
+ ["/pause/query", "TESTADMIN"],
+ );
+ }
+ if ($permission ne "admin") {
+ push @tests, ["/pause/authenquery", "TESTUSER"];
+ }
+ push @tests, ["/pause/authenquery", "TESTADMIN"];
+ $ENV{PAUSE_WEB_TEST_ALL} && wantarray ? @tests : $tests[0];
+}
+
+sub content {
+ my $self = shift;
+ $self->{mech}->content;
+}
+
+sub dom {
+ my $self = shift;
+ Mojo::DOM->new($self->content);
+}
+
+sub text_is {
+ my ($self, $selector, $expects) = @_;
+ my $at = $self->dom->at($selector);
+ if ($at) {
+ my $text = $at->all_text // '';
+ is $text => $expects, "$selector is $expects";
+ } else {
+ fail "'$selector' is not found";
+ }
+ $self;
+}
+
+sub text_like {
+ my ($self, $selector, $expects) = @_;
+ my $at = $self->dom->at($selector);
+ if ($at) {
+ my $text = $at->all_text // '';
+ like $text => $expects, "$selector like $expects";
+ } else {
+ fail "'$selector' is not found";
+ }
+ $self;
+}
+
+sub text_unlike {
+ my ($self, $selector, $expects) = @_;
+ my $at = $self->dom->at($selector);
+ if ($at) {
+ my $text = $at->all_text // '';
+ unlike $text => $expects, "$selector unlike $expects";
+ } else {
+ fail "'$selector' is not found";
+ }
+ $self;
+}
+
+sub dom_not_found {
+ my ($self, $selector) = @_;
+ my $at = $self->dom->at($selector);
+ if ($at) {
+ fail "'$selector' is found";
+ } else {
+ pass "'$selector' is not found";
+ }
+ $self;
+}
+
+sub title_is_ok {
+ my ($self, $url) = @_;
+ return if $self->dom->at('p.error_message'); # ignore if error
+ return if $self->{mech}->content_type !~ /html/i;
+
+ my ($action) = $url =~ /ACTION=(\w+)/;
+ $action ||= $url; # in case action is passed as url
+ return if $action =~ /^select_(user|ml_action)$/;
+ my $conf = PAUSE::Web2025::Config->action($action);
+ return if $conf->{has_title}; # uses different title from its data source
+
+ my $title = $conf->{verb};
+ return unless $title; # maybe top page
+
+ $self->text_is("h2.firstheader", $title);
+}
+
+sub file_to_upload {
+ wantarray ? ($FileToUpload, $FilenameToUpload) : $FileToUpload;
+}
+
+sub copy_to_authors_dir {
+ my ($self, $user, $file) = @_;
+ my $userhome = PAUSE::user2dir($user);
+ my $destination = path("$PAUSE::Config->{MLROOT}/$userhome");
+ $destination->mkpath;
+ note "copy $file to $destination";
+ path($file)->copy($destination);
+}
+
+sub save_to_authors_dir {
+ my ($self, $user, $file, $body) = @_;
+ my $userhome = PAUSE::user2dir($user);
+ my $destination = path("$PAUSE::Config->{MLROOT}/$userhome");
+ $destination->mkpath;
+ note "save $file to $destination";
+ path("$destination/$file")->spew($body);
+}
+
+sub remove_authors_dir {
+ my ($self, $user) = @_;
+ my $userhome = PAUSE::user2dir($user);
+ my $destination = path("$PAUSE::Config->{MLROOT}/$userhome");
+ $destination->remove_tree;
+}
+
+sub deliveries { map { $_->{email}->cast('Email::MIME') } Email::Sender::Simple->default_transport->deliveries }
+sub clear_deliveries { Email::Sender::Simple->default_transport->clear_deliveries }
+sub note_deliveries { note "-- email begin --\n".$_->as_string."\n-- email end --\n\n" for shift->deliveries }
+
+END { $TmpDir->remove_tree if $TmpDir }
+
+sub reset_module_fixture {
+ my $self = shift;
+
+ $self->mod_dbh->do("TRUNCATE primeur");
+ $self->mod_dbh->do("TRUNCATE perms");
+ $self->mod_dbh->do("TRUNCATE packages");
+
+ my @dists = (
+ {
+ name => 'Module-Admin',
+ owner => 'TESTADMIN',
+ packages => [qw/
+ Module::Admin::Foo
+ Module::Admin::Bar
+ /],
+ comaints => [qw/TESTUSER2/],
+ },
+ {
+ name => 'Module-User',
+ owner => 'TESTUSER',
+ packages => [qw/
+ Module::User::Foo
+ Module::User::Bar
+ /],
+ comaints => [
+ [TESTADMIN => [qw/Module::User::Foo/]],
+ [TESTUSER2 => [qw/Module::User::Bar/]],
+ ],
+ },
+ {
+ name => 'Module-User-Foo-Baz',
+ owner => 'TESTUSER',
+ packages => [qw/
+ Module::User::Foo::Baz
+ /],
+ },
+ {
+ name => 'Module-Comaint',
+ owner => 'TESTUSER2',
+ packages => [qw/
+ Module::Comaint
+ Module::Comaint::Foo
+ /],
+ comaints => [qw/TESTADMIN TESTUSER/],
+ },
+ {
+ name => 'Module-Managed',
+ owner => 'TESTUSER2',
+ packages => [qw/
+ Module::Managed
+ Module::Managed::Foo
+ /],
+ comaints => [
+ [TESTUSER3 => [qw/Module::Managed/]],
+ ],
+ },
+ {
+ name => 'Module-Unrelated',
+ owner => 'TESTUSER3',
+ packages => [qw/
+ Module::Unrelated
+ Module::Unrelated::Foo
+ /],
+ },
+ );
+
+ for my $dist (@dists) {
+ for my $package (@{$dist->{packages}}) {
+ my $userdir = _userdir($dist->{owner});
+ $self->mod_db->insert("packages", {
+ package => $package,
+ lc_package => lc $package,
+ version => '0.01',
+ dist => "$userdir/$dist->{name}-0.01.tar.gz",
+ distname => $dist->{name},
+ filemtime => time,
+ pause_reg => time,
+ status => 'index',
+ });
+ $self->mod_db->insert("primeur", {
+ package => $package,
+ lc_package => lc $package,
+ userid => $dist->{owner},
+ });
+ }
+ for my $comaint (@{$dist->{comaints} // []}) {
+ if (ref $comaint eq 'ARRAY') {
+ my ($id, $packages) = @$comaint;
+ for my $package (@$packages) {
+ $self->mod_db->insert("perms", {
+ package => $package,
+ lc_package => lc $package,
+ userid => $id,
+ });
+ }
+ } else {
+ for my $package (@{$dist->{packages}}) {
+ $self->mod_db->insert("perms", {
+ package => $package,
+ lc_package => lc $package,
+ userid => $comaint,
+ });
+ }
+ }
+ }
+ }
+}
+
+sub _userdir {
+ my $user = shift;
+ join '/', substr($user, 0, 1), substr($user, 0, 2), $user;
+}
+
+1;
diff --git a/t/pause_2025/logout.t b/t/pause_2025/logout.t
new file mode 100644
index 000000000..008ec23e9
--- /dev/null
+++ b/t/pause_2025/logout.t
@@ -0,0 +1,62 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/lib";
+use Test::PAUSE::Web;
+use utf8;
+use HTTP::Status qw/:constants/;
+
+Test::PAUSE::Web->setup;
+
+subtest 'for 2017 app' => sub {
+ subtest 'logout 1: redirect with Cookie' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $rand = rand 1;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ $t->get_ok("$path");
+ my $res = $t->get("$path?logout=1$rand");
+ is $res->code => HTTP_UNAUTHORIZED;
+ }
+ };
+
+ subtest 'logout 2: redirect to Badname:Badpass@Server URL' => sub {
+ plan skip_all => "WWW::Mechanize/LWP::UserAgent currently ignores userinfo";
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $rand = rand 1;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ $t->get_ok("$path");
+ my $res = $t->get("$path?logout=2$rand");
+ is $res->code => HTTP_UNAUTHORIZED;
+ }
+ };
+
+ subtest 'logout 3: Quick direct 401' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $rand = rand 1;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ $t->get_ok("$path");
+ my $res = $t->get("$path?logout=3$rand");
+ is $res->code => HTTP_UNAUTHORIZED;
+ }
+ };
+};
+
+subtest 'for 2025 app' => sub {
+ # there's only one way to logout
+ subtest 'logout' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $rand = rand 1;
+ my $t = Test::PAUSE::Web->new;
+ $t->login(user => $user);
+ $t->get_ok("/user/logout");
+ $t->post_with_token_ok("/user/logout", {SUBMIT => 'Logout'});
+ my $res = $t->get("/user/logout");
+ is $res->code => HTTP_FORBIDDEN;
+ }
+ };
+};
+
+done_testing;
Sorry, <%= $pause->{HiddenUser}{userid} || $pause->{User}{userid} %> does not seem to be co-maintainer of any module.
+% } diff --git a/lib/pause_2025/templates/user/perms/make_comaint.html.ep b/lib/pause_2025/templates/user/perms/make_comaint.html.ep new file mode 100644 index 000000000..8fe4a3ff1 --- /dev/null +++ b/lib/pause_2025/templates/user/perms/make_comaint.html.ep @@ -0,0 +1,90 @@ +% layout 'layout'; +% my $pause = stash(".pause") || {}; + + + +% if (param("SUBMIT_pause99_share_perms_makeco")) { +
+% if ($pause->{error}) {
+
+<%= $pause->{error} %>
+% } elsif (@{$pause->{results} || []}) { +-
+% for (@{$pause->{results}}) {
+% if ($_->{error}) {
+
- Error trying to add <%= $_->{user} %> to co-maintainers of <%= $_->{mod} %>: <%= $_->{error} %> +% } elsif ($_->{duplicated}) { +
- <%= $_->{user} %> was already a co-maintainer of <%= $_->{mod} %>: skipping +% } else { +
- Added <%= $_->{user} %> to co-maintainers of <%= $_->{mod} %>. +% } +% } +
You need to select one or more packages and enter a userid. + Nothing done.
+% } ++% } + +% if (@{$pause->{mods} || []}) { + +
Select a co-maintainer
+Please select one or +more namespaces for which you want to select a +co-maintainer, enter the CPAN userid of the co-maintainer +into the text field and press Make Co-Maintainer
+ +If you are open to someone else asking for your first-come +permissions, but you wish to decide on any such request, you +can give a co-maint to a special user called +HANDOFF.
+ +You can also grant co-maint to +NEEDHELP +if you would like additional volunteers to help you work on a particular module.
+ +If you want to add comaintainers for all the modules in a +distribution, visit +Add Comaintainers per distribution page.
+ +Select one or more namespaces:
+
+
+
+
+
+
+% content_for javascript => begin
+%= javascript "/pause/list.min.js"
+%= javascript begin
+var List = new List('packages', {
+ valueNames: ['package', 'dist']
+});
+% end
+% end
+
+% } else {
+| + | Package | +Indexed Distribution | +
|---|---|---|
| <%= check_box "pause99_share_perms_makeco_m" => $_ %> | +<%= $_ %> | +<%= $pause->{dist_for_package}{$_} %> | +
Select a userid:
+<%= text_field "pause99_share_perms_makeco_a", size => 15, maxlength => 9 %>
+
+
+
+Sorry, there are no modules registered belonging to <%= $pause->{HiddenUser}{userid} || $pause->{User}{userid} %>.
+% } diff --git a/lib/pause_2025/templates/user/perms/move_primary.html.ep b/lib/pause_2025/templates/user/perms/move_primary.html.ep new file mode 100644 index 000000000..5172c4290 --- /dev/null +++ b/lib/pause_2025/templates/user/perms/move_primary.html.ep @@ -0,0 +1,81 @@ +% layout 'layout'; +% my $pause = stash(".pause") || {}; + + + +% if (param("SUBMIT_pause99_share_perms_movepr")) { +
+% if ($pause->{error}) {
+
+<%= $pause->{error} %>
+% } elsif (@{$pause->{results} || []}) { +-
+% for my $res (@{$pause->{results}}) {
+% if ($res->{error}) {
+
- Error trying to make <%= $res->{user} %> primary maintainer of <%= $res->{mod} %>: <%= $res->{error} %> "; +% } else { +
- Made <%= $res->{user} %> primary maintainer of <%= $res->{mod} %>. +% } +% } +
You need to select one or more packages and enter a userid. +Nothing done.
+% } ++% } + +% if (@{$pause->{mods}}) { +
Pass maintainership status
Please select one +or more namespaces for which you want to pass primary +maintainership status, enter the CPAN userid of the new +maintainer into the text field and press Pass Maintainership +Status. Note: you keep co-maintainer status after this move. +If you want to get rid of that too, please visit Give up +co-maintainership status next.
+ +If you want to transfer all the modules in a distribution, visit + +Transfer Primary Permissions per distribution page.
+ +Select one or more namespaces:
+
+
+
+
+
+
+% content_for javascript => begin
+%= javascript "/pause/list.min.js"
+%= javascript begin
+var List = new List('packages', {
+ valueNames: ['package', 'dist']
+});
+% end
+% end
+
+% } else {
+| + | Package | +Indexed Distribution | +
|---|---|---|
| <%= check_box "pause99_share_perms_pr_m" => $_ %> | +<%= $_ %> | +<%= $pause->{dist_for_package}{$_} // '' %> | +
Select a userid:
+<%= text_field "pause99_share_perms_movepr_a", size => 15, maxlength => 9 =%>
+
+
+ +Sorry, there are no modules registered belonging to <%= $pause->{HiddenUser}{userid} || $pause->{User}{userid} %>.
+% } + diff --git a/lib/pause_2025/templates/user/perms/peek.html.ep b/lib/pause_2025/templates/user/perms/peek.html.ep new file mode 100644 index 000000000..6e169b00e --- /dev/null +++ b/lib/pause_2025/templates/user/perms/peek.html.ep @@ -0,0 +1,94 @@ +% layout 'layout'; +% my $pause = stash(".pause") || {}; + +Select the option and fill in a module name or +user ID as appropriate. The answer is all modules that an +user ID is registered for or all user IDs registered for a +module, as appropriate.
+ +Registration comes in one of two types: type +first-come is the automatic registration on a +first-come-first-serve basis that happens on the initial +upload. And type co-maint is the registration as +co-maintainer which means that the primary maintainer of +the namespace has granted permission to upload this module +to other userid(s). Per namespace there can only be one +primary maintainer (userid in the +first-come category) and any number of userids in +the co-maint category. Being registered in any of +the categories means that a user is able not only to +upload a module in that namespace but also be accepted by +the indexer. In other words, the indexer will not ignore +uploads for that namespace by that person.
+ +If the list is too long, visit +View permission per distribution page.
+ +The +contents of the tables presented on this page are mostly +generated automatically, so please report any errors you +observe to <%= "@{$PAUSE::Config->{ADMINS}}" %> so that the tables +can be corrected.--Thank you!
+ +<%= select_field 'pause99_peek_perms_by' => [ + ["for a module--exact match" => "me"], + [qq{for a module--SQL "LIKE" match} => "ml"], + ["of an author" => "a"], +], size => 1 =%> + +<%= text_field 'pause99_peek_perms_query', size => 44, maxlength => 112, =%> + + + +
+% if (@{$pause->{rows} || []}) { +
+
+
+
+
+
+
+% content_for javascript => begin
+%= javascript "/pause/list.min.js"
+%= javascript begin
+var List = new List('perms', {
+ valueNames: ['module', 'userid', 'type', 'owner']
+});
+% end
+% end
+
+% } else {
+No records found.
+% }
diff --git a/lib/pause_2025/templates/user/perms/remove_comaint.html.ep b/lib/pause_2025/templates/user/perms/remove_comaint.html.ep
new file mode 100644
index 000000000..19a3c4f16
--- /dev/null
+++ b/lib/pause_2025/templates/user/perms/remove_comaint.html.ep
@@ -0,0 +1,80 @@
+% layout 'layout';
+% my $pause = stash(".pause") || {};
+
+
+
+% if (param("SUBMIT_pause99_share_perms_remocos")) {
+| <%= $_ %> | +% } +|||
|---|---|---|---|
| $row->[0], + pause99_peek_perms_sub => 1, + ]) %>"><%= $row->[0] %> | +$row->[1], + pause99_peek_perms_sub => 1, + ]) %>"><%= $row->[1] %> | +<%= $row->[2] %> | +<%= $row->[3] %> | +
+% if ($pause->{error}) {
+
+<%= $pause->{error} %>
+% } elsif (@{$pause->{results} || []}) { +-
+% for (@{$pause->{results}}) {
+% if ($_->{not_exists}) {
+
- Cannot handle tuple <%= $_->{mod} %>. If you believe, this is a bug, please complain. +% } elsif ($_->{error}) { +
- Error trying to remove <%= $_->{user} %> from co-maintainers of <%= $_->{mod} %>: <%= $_->{error} %> +% } else { +
- Removed <%= $_->{user} %> from co-maintainers of <%= $_->{mod} %>. +% } +% } +
You need to select one or more packages. Nothing done.
+% } ++% } + +% if (@{$pause->{mods} || []}) { +
Remove co-maintainer status
+The scrolling +list shows you, which packages are associated with other +maintainers besides yourself. Every line denotes a tuple +of a namespace and a userid. Select those that you want to +remove and press Remove
+ +If you want to remove comaintainers from all the modules +in a distribution, visit + +Remove Comaintainers per distribution page.
+ +
+
+
+
+
+
+% content_for javascript => begin
+%= javascript "/pause/list.min.js"
+%= javascript begin
+var List = new List('packages', {
+ valueNames: ['pacakge', 'dist', 'userid']
+});
+% end
+% end
+
+% } else {
+| + | Package | +Indexed Distribution | +UserID | +
|---|---|---|---|
| <%= check_box "pause99_share_perms_remocos_tuples" => $_ %> | +<%= $package %> | +<%= $pause->{dist_for_package}{$package} // '' %> | +<%= $userid %> | +
+
+There are no co-maintainers registered to any of <%= $pause->{HiddenUser}{userid} || $pause->{User}{userid} %>'s modules.
+% } diff --git a/lib/pause_2025/templates/user/perms/remove_primary.html.ep b/lib/pause_2025/templates/user/perms/remove_primary.html.ep new file mode 100644 index 000000000..2e56d5274 --- /dev/null +++ b/lib/pause_2025/templates/user/perms/remove_primary.html.ep @@ -0,0 +1,92 @@ +% layout 'layout'; +% my $pause = stash(".pause") || {}; + + + +% if (param("SUBMIT_pause99_share_perms_remopr")) { +
+% if ($pause->{error}) {
+
+<%= $pause->{error} %>
+% } elsif (@{$pause->{results} || []}) { +-
+% for (@{$pause->{results}}) {
+% if ($_->{error}) {
+
- Error trying to remove primary maintainership of <%= $_->{user} %> from <%= $_->{mod} %>: <%= $_->{error} %> +% } else { +
- Removed primary maintainership of <%= $_->{user} %> from <%= $_->{mod} %>. +% } +% } +
You need to select one or more packages. Nothing done.
+% } ++% } + +% if (@{$pause->{mods} || []}) { + +
Give up maintainership status
+Please select one or more namespaces for which you +want to give up primary maintainership status and press +Give Up Maintainership Status. Note: you keep co-maintainer +status after this move. If you want to get rid of that too, +please visit ">Give up +co-maintainership status next.
+ +Giving up primary permissions now means that the permissions are +transferred to a special user called +ADOPTME.
+ +If multiple owners are listed, those owners keep their primary +maintainership for those modules. In this case, you are strongly advised to +">transfer your primary permissions +to one of the other owners.
+ ++If you have are unsure about what to do, or have any questions, +please email the PAUSE admins at modules@perl.org. +
+ +If you want to give up all the modules in a distribution, visit + +<%= $c->app->pause->config->action('remove_dist_primary')->{verb} %> page.
+ +Select one or more namespaces:
+
+
+
+
+
+
+
+
+% content_for javascript => begin
+%= javascript "/pause/list.min.js"
+%= javascript begin
+var List = new List('packages', {
+ valueNames: ['package', 'dist']
+});
+% end
+% end
+
+% } else {
+| + | Package | +Indexed Distribution | +
|---|---|---|
| <%= check_box "pause99_share_perms_pr_m" => $_ %> | +<%= $_ %> | +<%= $pause->{dist_for_package}{$_} // '' %> | +
Sorry, there are no modules registered belonging to <%= $pause->{HiddenUser}{userid} || $pause->{User}{userid} %>.
+% } + diff --git a/lib/pause_2025/templates/user/perms/share.html.ep b/lib/pause_2025/templates/user/perms/share.html.ep new file mode 100644 index 000000000..061ed849c --- /dev/null +++ b/lib/pause_2025/templates/user/perms/share.html.ep @@ -0,0 +1,159 @@ +% layout 'layout'; +% my $pause = stash(".pause") || {}; +% my $subaction = $pause->{subaction} || ""; + + + + +% unless ($subaction) { +Permissions on PAUSE come in three flavors:
+-
+
-
+ only one user per module can be either
+
+-
+
- + registered in modulelist or + +
- + primary maintainer on a first-come-first-serve + basis; + +
+ - + many users can get granted permissions as co-maintainers, + which means their uploads for the given module are honoured by + the indexer. + +
You can view your current set of permissions on the View Permissions page. To + change permissions, select one of the following submit + buttons, each of which leads you to a different page:
+ +| + 1. You are registered in modulelist + | +||
| +% if (my @mods = @{$pause->{mods} || []}) { +<%= select_field "pause99_edit_mod_3" => \@mods, size => (@mods > 18 ? 15 : scalar @mods) %> +% } else { +--NONE-- +% } + | ++ | ++ Module Metadata has been removed from PAUSE and + is no longer editable. Please contact a PAUSE administrator to + choose a new owner. + | +
| 2. You are primary maintainer: | ||
| +% if (my @mods = @{$pause->{remove_primary} || []}) { +<%= select_field "pause99_share_perms_pr_m" => \@mods, size => (@mods > 18 ? 15 : scalar @mods), multiple => "multiple" %> +% } else { +--NONE-- +% } + | ++ + | ++ 2.1 Transfer primary maintainership status to somebody else + (you become co-maintainer) + | +
| + + | ++ 2.2 Give up primary maintainership status (abandoning it without + transfering it to someone else) + | +|
| + 3. Making and unmaking co-maintainers (for both modulelist + owners and primary maintainers): + | +||
| +% if (my @mods = @{$pause->{make_comaintainer} || []}) { +<%= select_field "pause99_share_perms_makeco_m" => \@mods, size => (@mods > 18 ? 15 : scalar @mods), multiple => "multiple" %> +% } else { +--NONE-- +% } + | ++ + | ++ 3.1 Make somebody else co-maintainer + | +
| + + | +3.2 Remove a co-maintainer | +|
| 4. You are co-maintainer | ||
| +% if (my @mods = @{$pause->{remove_comaintainer} || []}) { +<%= select_field "pause99_share_perms_remome_m" => \@mods, size => (@mods > 18 ? 15 : scalar @mods), multiple => "multiple" %> +% } else { +--NONE-- +% } + | ++ | ++ 4.1 Give up co-maintainership status + | +
Indexing normally happens only once, shortly after the upload takes place. Sometimes it is necessary to reindex a file. The reason is typically one of the following:
+-
+
+
- A file that contained a current version of a module got deleted, now an older file should be considered current. + +
- The
permstable got altered, now a file should be visited again to overrule the previous indexing decision.
+
+ - At the time of uploading PAUSE had a bug and made a wrong indexing decision. + +
With this form you can tell the indexer to index selected files again. As it is done by a cron job, it may take up to an hour until the indexer actually executes the command. If this doesn't repair the index, please email me.
+ +% if (%$files) { +% if ($pause->{mailbody}) { +<%= $pause->{mailbody} %>+% } + +
Files in directory authors/id/<%= $pause->{userhome} %>
+ +
+
+
+
+
+
+
+
+% content_for javascript => begin
+%= javascript "/pause/list.min.js"
+%= javascript begin
+var List = new List('files', {
+ valueNames: ['file']
+});
+% end
+% end
+
+% } else {
+No files found in authors/id/<%= $pause->{userhome} %>
+% }
diff --git a/lib/pause_2025/templates/user/reset_version.html.ep b/lib/pause_2025/templates/user/reset_version.html.ep
new file mode 100644
index 000000000..32faca254
--- /dev/null
+++ b/lib/pause_2025/templates/user/reset_version.html.ep
@@ -0,0 +1,71 @@
+% layout 'layout';
+% my $pause = stash(".pause") || {};
+
+
+| + | File | +
|---|---|
| <%= check_box "pause99_reindex_FILE" => $file %> | +<%= $file %> | +
Note: resetting versions is a major inconvenience for +module users. This page will probably be withdrawn from PAUSE if +the perl community does not want to allow decreasing version numbers +on the CPAN. For now: use with care. Thanks.
+ +Below you see the packages and version numbers that +the indexer considers the current and highest version number that +it has seen so far. By selecting an item in the list and clicking +Forget, this value is set to undef. This opens the +way for a Force Reindexing run in which the version of the +package in the reindexed distribution can become the current.
+ +Did I say, this operation should not be done lightly? Because +users of the module out there may still have that higher version +installed and so will not notice the newer but lower-numbered +release. Let me repeat: please make responsible use of this +page.
+ +Q: So why is this page up at all?
+ +A: Combine a multi-module-distro with a small mistake in an +older release or a bug in the PAUSE indexer. In such a case you +will be happy to use this page and nobody else will ever notice +there was a problem.
+% if ($pause->{mailbody}) { +<%= $pause->{mailbody} %>+% } +% if (%{$pause->{packages} || {}}) { +
<%= scalar keys %{$pause->{packages}} %> <%= keys %{$pause->{packages}} == 1 ? "package" : "packages" %> associated with <%= $pause->{User}{userid} %>
+ +
+
+
+
+
+
+
+
+% content_for javascript => begin
+%= javascript "/pause/list.min.js"
+%= javascript begin
+var List = new List('packages', {
+ valueNames: ['package', 'version', 'dist']
+});
+% end
+% end
+
+% } else {
+| + | Package | +Version | +Dist | +
|---|---|---|---|
| <%= check_box pause99_reset_version_PKG => $package %> | +<%= $package %> | +<%= $pause->{packages}{$package}{version} %> | +<%= $pause->{packages}{$package}{dist} %> | +
No packages associated with <%= $pause->{User}{userid} %>
+% } diff --git a/lib/pause_2025/templates/user/show_ml_repr.html.ep b/lib/pause_2025/templates/user/show_ml_repr.html.ep new file mode 100644 index 000000000..aad827860 --- /dev/null +++ b/lib/pause_2025/templates/user/show_ml_repr.html.ep @@ -0,0 +1,2 @@ +% layout 'layout'; +% my $pause = stash(".pause") || {}; diff --git a/lib/pause_2025/templates/user/tail_logfile.html.ep b/lib/pause_2025/templates/user/tail_logfile.html.ep new file mode 100644 index 000000000..84bdab3bd --- /dev/null +++ b/lib/pause_2025/templates/user/tail_logfile.html.ep @@ -0,0 +1,21 @@ +% layout 'layout'; +% my $pause = stash(".pause") || {}; + +
+<%= select_field pause99_tail_logfile_1 => [qw/2000 5000 10000 20000 40000/]; =%>
+
+
+
+
+ % for (split /\n/, $pause->{tail}) {
+
+
+% content_for javascript => begin
+%= javascript "/pause/list.min.js"
+%= javascript begin
+var logList = new List('logs', {valueNames: ['log']});
+% end
+% end
diff --git a/lib/pause_2025/templates/user/uri/_continued.html.ep b/lib/pause_2025/templates/user/uri/_continued.html.ep
new file mode 100644
index 000000000..132845051
--- /dev/null
+++ b/lib/pause_2025/templates/user/uri/_continued.html.ep
@@ -0,0 +1,64 @@
+% my $pause = stash(".pause") || {};
+
+| <%= $_ %> |
+ + +% if ($pause->{invalid_uri}) { +% } else { + ++ +Submitting query
+ +% if ($pause->{query_succeeded}) { + +Query succeeded. Thank you for your contribution
+ +As it is done by a separate process, it may take a few minutes to +complete the upload. The processing of your file is going on while you +read this. There's no need for you to retry. The form below is only +here in case you want to upload further files.
+ +Please tidy up your homedir: CPAN is getting larger every day which +is nice but usually there is no need to keep old an outdated version +of a module on several hundred mirrors. Please consider ">removing old versions of +your module from PAUSE and CPAN. If you are worried that someone might +need an old version, it can always be found on the backpan +
+ +Debugging: your submission should show up soon at <%= $pause->{usrdir} %>. If something's wrong, please +check the logfile of the daemon: see the tail of it with <%= $pause->{tailurl} %>. If you already know what's going wrong, you +may wish to visit the ">repair +tool for pending uploads.
+ +% } else { + +Could not enter the URL into the database. +Reason:
<%= $pause->{errmsg} %>
+ +% if ($pause->{duplicate}) { +This indicates that you probably tried to upload a file that is +already in the database. You will most probably have to rename your +file and try again, because PAUSE doesn't let you upload a file +twice.
+ +This seems to be the record causing the conflict:
++% if (my $rec = $pause->{rec}) { +% for my $k (sort keys %$rec) { +
+ + +% } +% } +% } + + ++% } +% } + <%= $k %> <%= $rec->{$k} || b(" ") %>
diff --git a/lib/pause_2025/templates/user/uri/add.html.ep b/lib/pause_2025/templates/user/uri/add.html.ep new file mode 100644 index 000000000..d2d59be85 --- /dev/null +++ b/lib/pause_2025/templates/user/uri/add.html.ep @@ -0,0 +1,132 @@ +% layout 'layout'; +% my $pause = stash(".pause") || {}; + + +<%# just for compatibility; will be removed eventually =%> + +
Add a file for <%= $pause->{HiddenUser}{userid} %>
+ +% if (my $to = $pause->{successfully_copied_to}) { +File successfully copied to '<%= $to %>'
+% } + +% if (my $renamed = $pause->{upload_is_renamed}) { + +Your filename has been altered as it contained characters besides +the class [A-Za-z0-9_\\-\\.\\@\\+]. DEBUG: your filename[<%= $renamed->{from} %>] corrected +filename[<%= $renamed->{to} %>].
+ +% } + +% if (! $pause->{uploaded_uri} ) { + +% } else { + +%= include "user/uri/_continued"; + +% } + + + +This form enables you to enter one file at a time +into CPAN in one of these ways:
+ +% if ($pause->{tryupload}) { + +HTTP Upload: As an
+HTTP upload: enter the filename in the lower text field.
+Hint: If you encounter problems processing this form,
+it may be due to the fact that your browser can't handle
+multipart/form-data forms that support file
+upload. In such a case, please retry to access this 0) %>">file-upload-disabled form.
HTTP Upload: As +you do not seem to want HTTP upload enabled, we do +not offer it. If this is not what you want, try to + 1) %>">explicitly enable HTTP upload.
+ +% } + +GET URL: PAUSE fetches any http or ftp +URL that can be handled by LWP: use the text field (please specify the complete +URL).
+ +Please, make sure your filename +contains a version number. For security reasons you will never +be able to upload a file with the same name again (not even +after deleting it). Thank you.+ +
There is no need to upload README files separately. The +upload server will unwrap your files (.tar.gz or .zip files +only) within a few hours after uploading and will put the +topmost README file as, say, Foo-Bar-3.14.readme into your +directory. Hint: if you're looking for an even more +convenient way to upload files than this form, you can try the +cpan-upload script. +
+ +Target Directory
If you want to load the +file into a directory below your CPAN directory, +please specify the directory name here. Any number of +subdirectory levels is allowed, they all will be +created on the fly if they don't exist yet. Only sane +directory names are allowed and the number of +characters for the whole path is limited.
+NOTE: To upload a Perl6 distribution a target +directory whose top level subdirectory is "Perl6" must +be specified. In addition, a Perl6 distribution must +contain a META6.json. Pause will only consider it a +Perl6 dist if these two conditions are satisfied. +
+ +
+
+
+
+<%= text_field "pause99_add_uri_subdirtext",
+ size => 32,
+ maxlength => 128,
+%>
+
+% if (@{$pause->{subdirs} || []}) {
+
+<%= select_field "pause99_add_uri_subdirscrl" => $pause->{subdirs},
+ size => (@{$pause->{subdirs}} > 18 ? 15 : scalar @{$pause->{subdirs}}),
+%>
+% }
+
Upload Material
+ +% if ($pause->{tryupload}) { +
+
+
+% }
+
+If your browser can handle
+file upload, enter the filename here and I'll transfer it
+to your homedirectory:
+
+
<%= file_field "pause99_add_uri_httpupload",
+ size => 50,
+%>
+
+
diff --git a/one-off-utils/schemachange-2025-04.sql b/one-off-utils/schemachange-2025-04.sql
new file mode 100644
index 000000000..b981d9722
--- /dev/null
+++ b/one-off-utils/schemachange-2025-04.sql
@@ -0,0 +1,3 @@
+ALTER TABLE usertable ADD COLUMN mfa tinyint(1) DEFAULT 0;
+ALTER TABLE usertable ADD COLUMN mfa_secret32 varchar(16);
+ALTER TABLE usertable ADD COLUMN mfa_recovery_codes text;
diff --git a/one-off-utils/schemachange-2025.sql b/one-off-utils/schemachange-2025.sql
new file mode 100644
index 000000000..b981d9722
--- /dev/null
+++ b/one-off-utils/schemachange-2025.sql
@@ -0,0 +1,3 @@
+ALTER TABLE usertable ADD COLUMN mfa tinyint(1) DEFAULT 0;
+ALTER TABLE usertable ADD COLUMN mfa_secret32 varchar(16);
+ALTER TABLE usertable ADD COLUMN mfa_recovery_codes text;
diff --git a/t/pause_2025/00_load.t b/t/pause_2025/00_load.t
new file mode 100644
index 000000000..be3dfbf20
--- /dev/null
+++ b/t/pause_2025/00_load.t
@@ -0,0 +1,20 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/lib";
+use Test::PAUSE::Web;
+use Test::More;
+use File::Find;
+use Path::Tiny;
+
+note "AppRoot: $Test::PAUSE::Web::AppRoot";
+
+find({wanted => sub {
+ my $file = path($File::Find::name);
+ my $path = $file->relative("$Test::PAUSE::Web::AppRoot/lib/pause_2025");
+ $path =~ s|\.pm$|| or return;
+ $path =~ s|/|::|g;
+ use_ok($path);
+}, no_chdir => 1}, "$Test::PAUSE::Web::AppRoot/lib/pause_2025/PAUSE");
+
+done_testing;
+
diff --git a/t/pause_2025/action_2017/add_uri.t b/t/pause_2025/action_2017/add_uri.t
new file mode 100644
index 000000000..5d1c22f66
--- /dev/null
+++ b/t/pause_2025/action_2017/add_uri.t
@@ -0,0 +1,296 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use File::Path qw/rmtree mkpath/;
+use File::Spec;
+use Mojo::File qw/path/;
+use utf8;
+
+my $http_upload = {
+ pause99_add_uri_httpupload => ["$Test::PAUSE::Web::AppRoot/htdocs/index.html", "index.html"],
+ SUBMIT_pause99_add_uri_httpupload => 1,
+};
+
+my $uri_upload = {
+ pause99_add_uri_uri => "file://".File::Spec->rel2abs(__FILE__),
+ SUBMIT_pause99_add_uri_uri => 1,
+};
+
+Test::PAUSE::Web->setup;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ $t->get_ok("$path?ACTION=add_uri");
+ # note $t->content;
+ }
+};
+
+subtest 'get: user with subdirs' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $user_home = $PAUSE::Config->{MLROOT}."/".PAUSE::user2dir($user);
+ my $subdir = path("$user_home/test");
+ $subdir->make_path;
+ $subdir->child("stuff.txt")->spew("Foo");
+
+ my $t = Test::PAUSE::Web->new(user => $user);
+ $t->get_ok("$path?ACTION=add_uri");
+ $t->text_is('select[name="pause99_add_uri_subdirscrl"] option[value="."]', "."); # default
+ $t->text_is('select[name="pause99_add_uri_subdirscrl"] option[value="test"]', "test");
+ # note $t->content;
+ }
+};
+
+subtest 'post: basic' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ my %form = %$http_upload;
+ my $file = $PAUSE::Config->{INCOMING_LOC}."/".$form{pause99_add_uri_httpupload}[1];
+ ok !-f $file, "file to upload does not exist";
+
+ $t->mod_dbh->do('TRUNCATE uris');
+ $t->post_ok("$path?ACTION=add_uri", \%form, "Content-Type" => "form-data");
+ # note $t->content;
+
+ ok -f $file, "uploaded file exists";
+ unlink $file;
+
+ my $rows = $t->mod_db->select('uris', ['*'], {
+ userid => $user,
+ uri => $form{pause99_add_uri_httpupload}[1],
+ });
+ is @$rows => 1;
+ }
+};
+
+subtest 'post: under a new subdir' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ my %form = %$http_upload;
+ $form{pause99_add_uri_subdirtext} = "new_dir";
+
+ my $file = $PAUSE::Config->{INCOMING_LOC}."/".$form{pause99_add_uri_httpupload}[1];
+ ok !-f $file, "file to upload does not exist";
+
+ $t->mod_dbh->do('TRUNCATE uris');
+ $t->post_ok("$path?ACTION=add_uri", \%form, "Content-Type" => "form-data");
+ # note $t->content;
+
+ ok -f $file, "uploaded file exists";
+ unlink $file;
+
+ my $rows = $t->mod_db->select('uris', ['*'], {
+ userid => $user,
+ uri => $form{pause99_add_uri_httpupload}[1],
+ });
+ is @$rows => 1;
+ like $rows->[0]{uriid} => qr!/new_dir/!, "uriid contains /new_dir/";
+ }
+};
+
+subtest 'post: under a Perl6 subdir' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ my %form = %$http_upload;
+ $form{pause99_add_uri_subdirscrl} = "Perl6";
+
+ my $user_home = $PAUSE::Config->{MLROOT}."/".PAUSE::user2dir($user);
+ my $subdir = path("$user_home/Perl6");
+ $subdir->make_path;
+ $subdir->child("stuff.txt")->spew("Foo");
+
+ my $file = $PAUSE::Config->{INCOMING_LOC}."/".$form{pause99_add_uri_httpupload}[1];
+ ok !-f $file, "file to upload does not exist";
+
+ $t->mod_dbh->do('TRUNCATE uris');
+ $t->post_ok("$path?ACTION=add_uri", \%form, "Content-Type" => "form-data");
+ # note $t->content;
+
+ ok -f $file, "uploaded file exists";
+ unlink $file;
+
+ my $rows = $t->mod_db->select('uris', ['*'], {
+ userid => $user,
+ uri => $form{pause99_add_uri_httpupload}[1],
+ });
+ is @$rows => 1;
+ like $rows->[0]{uriid} => qr!/Perl6/!, "uriid contains /Perl6/";
+ ok $rows->[0]{is_perl6};
+ }
+};
+
+subtest 'post: empty' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ my %form = %$http_upload;
+ $form{pause99_add_uri_httpupload} = [undef, 'index.html'];
+
+ $t->mod_dbh->do('TRUNCATE uris');
+ $t->post_ok("$path?ACTION=add_uri", \%form, "Content-Type" => "form-data");
+ # note $t->content;
+
+ my $rows = $t->mod_db->select('uris', ['*'], {
+ userid => $user,
+ uri => $form{pause99_add_uri_httpupload}[1],
+ });
+ is @$rows => 0;
+ }
+};
+
+subtest 'post: renamed' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ my %form = %$http_upload;
+ $form{pause99_add_uri_httpupload} = ["$Test::PAUSE::Web::AppRoot/htdocs/index.html", 'html/index.html'];
+ my $file = $PAUSE::Config->{INCOMING_LOC}."/index.html";
+ ok !-f $file, "file to upload does not exist";
+
+ $t->mod_dbh->do('TRUNCATE uris');
+ $t->post_ok("$path?ACTION=add_uri", \%form, "Content-Type" => "form-data");
+ # note $t->content;
+
+ # renamed file exists
+ ok -f $file, "uploaded file exists";
+ unlink $file;
+
+ my $rows = $t->mod_db->select('uris', ['*'], {
+ userid => $user,
+ uri => "index.html",
+ });
+ is @$rows => 1;
+ }
+};
+
+subtest 'post: uri' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ my %form = %$uri_upload;
+
+ $t->mod_dbh->do('TRUNCATE uris');
+ $t->post_ok("$path?ACTION=add_uri", \%form, "Content-Type" => "form-data");
+ # note $t->content;
+
+ my $rows = $t->mod_db->select('uris', ['*'], {
+ userid => $user,
+ uri => $form{pause99_add_uri_uri},
+ });
+ is @$rows => 1;
+ }
+};
+
+subtest 'post: CHECKSUMS' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ my %form = %$http_upload;
+ $form{pause99_add_uri_httpupload} = ["$Test::PAUSE::Web::AppRoot/htdocs/index.html", "CHECKSUMS"],
+
+ $t->mod_dbh->do('TRUNCATE uris');
+ $t->post_ok("$path?ACTION=add_uri", \%form, "Content-Type" => "form-data");
+ $t->text_like('.error_message' => qr/Files with the name CHECKSUMS cannot be/);
+ # note $t->content;
+
+ my $rows = $t->mod_db->select('uris', ['*'], {
+ userid => $user,
+ uri => $form{pause99_add_uri_httpupload}[1],
+ });
+ is @$rows => 0;
+ }
+};
+
+subtest 'post: allow overwrite' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ my %form = %$http_upload;
+ my $file = $PAUSE::Config->{INCOMING_LOC}."/".$form{pause99_add_uri_httpupload}[1];
+ ok !-f $file, "file to upload does not exists";
+
+ $t->mod_dbh->do('TRUNCATE uris');
+ for (0 .. 1) {
+ $t->post_ok("$path?ACTION=add_uri", \%form, "Content-Type" => "form-data");
+ # note $t->content;
+
+ # uploaded file exists
+ ok -f $file, "uploaded file exists";
+ unlink $file;
+ }
+
+ my $rows = $t->mod_db->select('uris', ['*'], {
+ userid => $user,
+ uri => $form{pause99_add_uri_httpupload}[1],
+ });
+ is @$rows => 1;
+ }
+};
+
+subtest 'post: duplicate' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ my %form = %$http_upload;
+ $form{pause99_add_uri_httpupload} = ["$Test::PAUSE::Web::AppRoot/htdocs/index.html", "index.tar.gz"],
+ my $file = $PAUSE::Config->{INCOMING_LOC}."/".$form{pause99_add_uri_httpupload}[1];
+ ok !-f $file, "file to upload does not exist";
+
+ $t->mod_dbh->do('TRUNCATE uris');
+ $t->post_ok("$path?ACTION=add_uri", \%form, "Content-Type" => "form-data");
+ # note $t->content;
+
+ ok -f $file, "uploaded file exists";
+ unlink $file;
+
+ my $rows = $t->mod_db->select('uris', ['*'], {
+ userid => $user,
+ uri => $form{pause99_add_uri_httpupload}[1],
+ });
+ is @$rows => 1;
+
+ my $res = $t->post("$path?ACTION=add_uri", \%form, "Content-Type" => "form-data");
+ is $res->code => 409;
+ # note $t->content;
+
+ ok -f $file, "uploaded file exists";
+ unlink $file;
+
+ $rows = $t->mod_db->select('uris', ['*'], {
+ userid => $user,
+ uri => $form{pause99_add_uri_httpupload}[1],
+ });
+ is @$rows => 1;
+ }
+};
+
+subtest 'post: to the site top, as various CPAN uploaders do/did' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ my %form = %$http_upload;
+ my $file = $PAUSE::Config->{INCOMING_LOC}."/".$form{pause99_add_uri_httpupload}[1];
+ ok !-f $file, "file to upload does not exist";
+
+ $t->mod_dbh->do('TRUNCATE uris');
+ $t->post_ok("$path", \%form, "Content-Type" => "form-data");
+ # note $t->content;
+
+ ok -f $file, "uploaded file exists";
+ unlink $file;
+
+ my $rows = $t->mod_db->select('uris', ['*'], {
+ userid => $user,
+ uri => $form{pause99_add_uri_httpupload}[1],
+ });
+ is @$rows => 1;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2017/add_user.t b/t/pause_2025/action_2017/add_user.t
new file mode 100644
index 000000000..0912d03a3
--- /dev/null
+++ b/t/pause_2025/action_2017/add_user.t
@@ -0,0 +1,276 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+
+my $new_user = {
+ SUBMIT_pause99_add_user_Definitely => 1,
+ pause99_add_user_userid => "NEWUSER",
+ pause99_add_user_fullname => "new user",
+ pause99_add_user_email => "new_user\@localhost.localdomain",
+ pause99_add_user_homepage => "http://home.page",
+};
+
+my $new_mailing_list = {
+ SUBMIT_pause99_add_user_Definitely => 1,
+ pause99_add_user_userid => "MAILLIST",
+ pause99_add_user_fullname => "Mailing List",
+ pause99_add_user_email => "ml\@localhost.localdomain",
+ pause99_add_user_subscribe => "how to subscribe",
+};
+
+my $default = {
+ HIDDENNAME => "TESTUSER",
+ ACTIONREQ => "edit_ml",
+ pause99_select_ml_action_sub => 1,
+};
+
+Test::PAUSE::Web->setup;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('admin')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ $t->get_ok("$path?ACTION=add_user");
+ # note $t->content;
+ }
+};
+
+subtest 'post: ordinary user' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('admin')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+
+ $t->reset_fixture;
+ $t->post_ok("$path?ACTION=add_user", $new_user);
+ # note $t->content;
+
+ # new user exists
+ my $rows = $t->mod_db->select('users', ['*'], {
+ userid => $new_user->{pause99_add_user_userid},
+ });
+ is @$rows => 1;
+ for my $key (qw/userid homepage fullname/) {
+ is $rows->[0]{$key} => $new_user->{"pause99_add_user_$key"}, "$key is stored correctly";
+ }
+ is $rows->[0]{email} => 'CENSORED'; # email in the user table is always CENSORED
+
+ # email tests; censored email shouldn't be disclosed to admins
+ my @deliveries = $t->deliveries;
+ my @welcome_emails = grep { $_->header('Subject') =~ /Welcome/ } @deliveries;
+ is @welcome_emails => 2;
+ my ($welcome_for_user) = grep { $_->header('To') =~ /new_user/ } @welcome_emails;
+ like $welcome_for_user->body => qr/email:\s+new_user\@localhost/;
+
+ my ($welcome_for_admins) = grep { $_->header('To') =~ /admin/ } @welcome_emails;
+ unlike $welcome_for_admins->body => qr/email:\s+new_user\@localhost/;
+ like $welcome_for_admins->body => qr/email:\s+CENSORED/;
+ }
+};
+
+subtest 'post: user with an accent in their name' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('admin')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+
+ $t->reset_fixture;
+ $t->post_ok("$path?ACTION=add_user", {
+ %$new_user,
+ pause99_add_user_fullname => "T\xc3\xa9st Name",
+ });
+ # note $t->content;
+
+ # new user exists
+ my $rows = $t->mod_db->select('users', ['*'], {
+ userid => $new_user->{pause99_add_user_userid},
+ });
+ is @$rows => 1;
+ SKIP: {
+ skip "FIXME: seems not so stable; probably needs more explicit configuration", 1;
+ is $rows->[0]{fullname} => "T\xc3\xa9st Name";
+ }
+ }
+};
+
+subtest 'post: soundex' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('admin')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+
+ my %copied_user = %$new_user;
+ $copied_user{pause99_add_user_fullname} = 'new user';
+ $copied_user{SUBMIT_pause99_add_user_Soundex} = 1;
+ delete $copied_user{SUBMIT_pause99_add_user_Definitely};
+
+ $t->reset_fixture;
+ $t->post_ok("$path?ACTION=add_user", {
+ %copied_user,
+ });
+ # note $t->content;
+
+ # new user exists
+ my $rows = $t->mod_db->select('users', ['*'], {
+ userid => $new_user->{pause99_add_user_userid},
+ });
+ is @$rows => 1;
+ }
+};
+
+subtest 'post: soundex error: similar name' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('admin')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+
+ my %copied_user = %$new_user;
+ $copied_user{pause99_add_user_fullname} = 'new nome';
+ $copied_user{SUBMIT_pause99_add_user_Soundex} = 1;
+ delete $copied_user{SUBMIT_pause99_add_user_Definitely};
+
+ $t->reset_fixture;
+ $t->post_ok("$path?ACTION=add_user", {
+ %copied_user,
+ });
+ $t->text_like('h3', qr/Not submitting NEWUSER, maybe we have a duplicate/);
+ # note $t->content;
+
+ # new user does not exist
+ my $rows = $t->mod_db->select('users', ['*'], {
+ userid => $new_user->{pause99_add_user_userid},
+ });
+ is @$rows => 0;
+ }
+};
+
+subtest 'post: metaphone' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('admin')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+
+ my %copied_user = %$new_user;
+ $copied_user{pause99_add_user_fullname} = 'new user';
+ $copied_user{SUBMIT_pause99_add_user_Metaphone} = 1;
+ delete $copied_user{SUBMIT_pause99_add_user_Definitely};
+
+ $t->reset_fixture;
+ $t->post_ok("$path?ACTION=add_user", {
+ %copied_user,
+ });
+ # note $t->content;
+
+ # new user exists
+ my $rows = $t->mod_db->select('users', ['*'], {
+ userid => $new_user->{pause99_add_user_userid},
+ });
+ is @$rows => 1;
+ }
+};
+
+subtest 'post: metaphone error: similar name' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('admin')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+
+ my %copied_user = %$new_user;
+ $copied_user{pause99_add_user_fullname} = 'new nome';
+ $copied_user{SUBMIT_pause99_add_user_Metaphone} = 1;
+ delete $copied_user{SUBMIT_pause99_add_user_Definitely};
+
+ $t->reset_fixture;
+ $t->post_ok("$path?ACTION=add_user", {
+ %copied_user,
+ });
+ $t->text_like('h3', qr/Not submitting NEWUSER, maybe we have a duplicate/);
+ # note $t->content;
+
+ # new user does not exist
+ my $rows = $t->mod_db->select('users', ['*'], {
+ userid => $new_user->{pause99_add_user_userid},
+ });
+ is @$rows => 0;
+ }
+};
+
+subtest 'post: metaphone error: completely duplicated' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('admin')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+
+ my %copied_user = %$new_user;
+ $copied_user{SUBMIT_pause99_add_user_Metaphone} = 1;
+ delete $copied_user{SUBMIT_pause99_add_user_Definitely};
+
+ $t->reset_fixture;
+ $t->post_ok("$path?ACTION=add_user", {
+ %copied_user,
+ });
+
+ # new user exists
+ my $rows = $t->mod_db->select('users', ['*'], {
+ userid => $new_user->{pause99_add_user_userid},
+ });
+ is @$rows => 1;
+
+ $t->post_ok("$path?ACTION=add_user", {
+ %copied_user,
+ });
+ $t->text_like('h3', qr/Not submitting NEWUSER, maybe we have a duplicate/);
+ # note $t->content;
+ }
+};
+
+subtest 'post: mailing list' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('admin')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+
+ $t->reset_fixture;
+ $t->post_ok("$path?ACTION=add_user", $new_mailing_list);
+ # note $t->content;
+
+ # new mailing list exists
+ my $rows = $t->mod_db->select('maillists', ['*'], {
+ maillistid => $new_mailing_list->{pause99_add_user_userid},
+ });
+ is @$rows => 1;
+
+ # new user also exists
+ $rows = $t->mod_db->select('users', ['*'], {
+ userid => $new_mailing_list->{pause99_add_user_userid},
+ });
+ is @$rows => 1;
+ }
+};
+
+subtest 'get: retrieve a stored session' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('admin')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+
+ my %requested_user;
+ for my $key (keys %$new_user) {
+ next if $key =~ /SUBMIT/;
+ my $new_key = $key =~ s/add_user/request_id/r;
+ $requested_user{$new_key} = $new_user->{$key};
+ }
+ $requested_user{pause99_request_id_rationale} = 'Rational to request PAUSE ID';
+ $requested_user{SUBMIT_pause99_request_id_sub} = 1;
+
+ $t->reset_fixture;
+ $t->post_ok("$path?ACTION=request_id", \%requested_user);
+ my ($email) = map {$_->body} $t->deliveries;
+ my ($userid) = $email =~ m!https://.+?/pause/authenquery.+?USERID=([^&\s]+)!;
+ like $userid => qr/\A\d+_\w+\z/;
+ $t->clear_deliveries;
+
+ $t->get_ok("$path?ACTION=add_user&USERID=$userid");
+ # note $t->content;
+
+ for my $key (keys %$new_user) {
+ next if $key =~ /SUBMIT/;
+ is $t->dom->at("input[name=$key]")->attr('value') => $new_user->{$key}, "$key is set correctly";
+ }
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2017/change_passwd.t b/t/pause_2025/action_2017/change_passwd.t
new file mode 100644
index 000000000..c447fb14c
--- /dev/null
+++ b/t/pause_2025/action_2017/change_passwd.t
@@ -0,0 +1,227 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use Time::Piece;
+use utf8;
+
+my $default = {
+ pause99_change_passwd_pw1 => "new_pass",
+ pause99_change_passwd_pw2 => "new_pass",
+ pause99_change_passwd_sub => 1,
+};
+
+Test::PAUSE::Web->setup;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ $t->get_ok("$path?ACTION=change_passwd");
+ # note $t->content;
+ }
+};
+
+subtest 'get: public without ABRA' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ next if $user; # public only
+ my $t = Test::PAUSE::Web->new(user => $user);
+ $t->authen_dbh->do('TRUNCATE abrakadabra');
+ my $res = $t->get("$path?ACTION=change_passwd");
+ is $res->code => 403;
+ # note $t->content;
+ }
+};
+
+subtest 'get: public with ABRA' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ next if $user; # public only
+ my $t = Test::PAUSE::Web->new(user => $user);
+
+ my $chuser = 'TESTUSER';
+ my $chpass = 'testpassword';
+ $t->authen_dbh->do('TRUNCATE abrakadabra');
+ ok $t->authen_db->insert('abrakadabra', {
+ user => $chuser,
+ chpasswd => $chpass,
+ expires => Time::Piece->new(time + 3600)->strftime('%Y-%m-%d %H:%M:%S'),
+ });
+
+ $t->get_ok("$path?ACTION=change_passwd&ABRA=$chuser.$chpass");
+ # note $t->content;
+
+ # No links should keep ABRA (71a745d)
+ my @links = map {$_->attr('href')} $t->dom->at('a');
+ ok !grep {$_ =~ /ABRA=/} @links;
+ }
+};
+
+subtest 'post: basic' => sub {
+ Test::PAUSE::Web->setup;
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my %form = %$default;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ my $res = $t->post("$path?ACTION=change_passwd", \%form);
+ ok !$res->is_success && $res->code == 403, "Forbidden";
+ like $res->content => qr/Failed CSRF check/;
+ # note $t->content;
+ }
+};
+
+subtest 'post_with_token: basic' => sub {
+ Test::PAUSE::Web->setup;
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my %form = %$default;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ $t->post_with_token_ok("$path?ACTION=change_passwd", \%form)
+ ->text_like("p.password_stored", qr/New password stored/);
+ is $t->deliveries => 1, "one delivery for admin";
+ # note $t->content;
+ }
+};
+
+subtest 'post_with_token: user with CENSORED email' => sub {
+ Test::PAUSE::Web->setup;
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ $user = "TESTCNSRD" if $user eq "TESTUSER";
+
+ my %form = %$default;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ $t->post_with_token_ok("$path?ACTION=change_passwd", \%form)
+ ->text_like("p.password_stored", qr/New password stored/);
+ my @deliveries = $t->deliveries;
+ is @deliveries => 1, "one delivery for admin";
+ my $email = $deliveries[0]->as_string;
+ unlike $email => qr/CENSORED/;
+ like $email => qr/testcnsrd\@localhost/;
+ note $email;
+ # note $t->content;
+ }
+};
+
+subtest 'post_with_token: public without ABRA' => sub {
+ Test::PAUSE::Web->setup;
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ next if $user; # public only
+ my $t = Test::PAUSE::Web->new(user => $user);
+ $t->authen_dbh->do('TRUNCATE abrakadabra');
+
+ my %form = %$default;
+ my $res = $t->post_with_token("$path?ACTION=change_passwd", \%form);
+ is $res->code => 403;
+ # note $t->content;
+ }
+};
+
+subtest 'post_with_token: public with ABRA' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ next if $user; # public only
+ my $t = Test::PAUSE::Web->new(user => $user);
+
+ my $chuser = 'TESTUSER';
+ my $chpass = 'testpassword';
+ $t->authen_dbh->do('TRUNCATE abrakadabra');
+ ok $t->authen_db->insert('abrakadabra', {
+ user => $chuser,
+ chpasswd => $chpass,
+ expires => Time::Piece->new(time + 3600)->strftime('%Y-%m-%d %H:%M:%S'),
+ });
+
+ my %form = %$default;
+ $t->post_with_token_ok("$path?ACTION=change_passwd&ABRA=$chuser.$chpass", \%form);
+ $t->text_like("p.password_stored", qr/New password stored/);
+ # note $t->content;
+
+ # No links should keep ABRA (71a745d)
+ my @links = map {$_->attr('href')} $t->dom->at('a');
+ ok !grep {$_ =~ /ABRA=/} @links;
+
+ # Used ABRA is gone (8234a6a)
+ my $res = $t->post_with_token("$path?ACTION=change_passwd&ABRA=$chuser.$chpass", \%form);
+ ok !$res->is_success;
+ is $res->code => 401;
+ }
+};
+
+subtest 'post_with_token: public with incorrect ABRA' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ next if $user; # public only
+ my $t = Test::PAUSE::Web->new(user => $user);
+
+ my $chuser = 'TESTUSER';
+ my $chpass = 'testpassword';
+ $t->authen_dbh->do('TRUNCATE abrakadabra');
+ ok $t->authen_db->insert('abrakadabra', {
+ user => $chuser,
+ chpasswd => $chpass,
+ expires => Time::Piece->new(time + 3600)->strftime('%Y-%m-%d %H:%M:%S'),
+ });
+
+ my %form = %$default;
+ my $res = $t->post_with_token("$path?ACTION=change_passwd&ABRA=$chuser.wrong$chpass", \%form);
+ is $res->code => 401;
+ # note $t->content;
+ }
+};
+
+subtest 'post_with_token: passwords mismatch' => sub {
+ Test::PAUSE::Web->setup;
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ my %form = (
+ %$default,
+ pause99_change_passwd_pw2 => "wrong_pass",
+ );
+ $t->post_with_token_ok("$path?ACTION=change_passwd", \%form)
+ ->text_is("h2", "Error")
+ ->text_like("p.error_message", qr/The two passwords didn't match./);
+ ok !$t->deliveries, "no delivery for admin";
+ # note $t->content;
+ }
+};
+
+subtest 'post_with_token: only one password' => sub {
+ Test::PAUSE::Web->setup;
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ my %form = (
+ %$default,
+ pause99_change_passwd_pw2 => undef,
+ );
+ $t->post_with_token_ok("$path?ACTION=change_passwd", \%form)
+ ->text_is("h2", "Error")
+ ->text_like("p.error_message", qr/You need to fill in the same password in both fields./);
+ ok !$t->deliveries, "no delivery for admin";
+ # note $t->content;
+ }
+};
+
+subtest 'post_with_token: no password' => sub {
+ Test::PAUSE::Web->setup;
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ my %form = (
+ %$default,
+ pause99_change_passwd_pw1 => undef,
+ pause99_change_passwd_pw2 => undef,
+ );
+ $t->post_with_token_ok("$path?ACTION=change_passwd", \%form)
+ ->text_is("h2", "Error")
+ ->text_like("p.error_message", qr/Please fill in the form with passwords./);
+ ok !$t->deliveries, "no delivery for admin";
+ # note $t->content;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2017/change_user_status.t b/t/pause_2025/action_2017/change_user_status.t
new file mode 100644
index 000000000..f5a6fbaa1
--- /dev/null
+++ b/t/pause_2025/action_2017/change_user_status.t
@@ -0,0 +1,98 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+
+my $default = {
+ pause99_change_user_status_user => "TESTUSER",
+ pause99_change_user_status_new_ustatus => "nologin",
+ pause99_change_user_status_sub => 1,
+};
+
+Test::PAUSE::Web->setup;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('admin')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ $t->get_ok("$path?ACTION=change_user_status");
+ # note $t->content;
+ }
+};
+
+subtest 'post: basic' => sub {
+ Test::PAUSE::Web->setup;
+ for my $test (Test::PAUSE::Web->tests_for('admin')) {
+ my ($path, $user) = @$test;
+ my %form = %$default;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ my $res = $t->post("$path?ACTION=change_user_status", \%form);
+ ok !$res->is_success && $res->code == 403, "Forbidden";
+ like $res->content => qr/Failed CSRF check/;
+ # note $t->content;
+ }
+};
+
+subtest 'post_with_token: basic' => sub {
+ Test::PAUSE::Web->setup;
+ for my $test (Test::PAUSE::Web->tests_for('admin')) {
+ my ($path, $user) = @$test;
+ my %form = %$default;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ $t->post_with_token_ok("$path?ACTION=change_user_status", \%form)
+ ->text_like("div.messagebox p", qr/status has changed from \w+ to nologin/);
+ is $t->deliveries => 2, "two deliveries for admin";
+ # note $t->content;
+ }
+};
+
+subtest 'post_with_token: user not found' => sub {
+ Test::PAUSE::Web->setup;
+ for my $test (Test::PAUSE::Web->tests_for('admin')) {
+ my ($path, $user) = @$test;
+ my %form = (
+ %$default,
+ pause99_change_user_status_user => 'UNKNOWN',
+ );
+ my $t = Test::PAUSE::Web->new(user => $user);
+ $t->post_with_token_ok("$path?ACTION=change_user_status", \%form)
+ ->text_like("div.messagebox p", qr/User UNKNOWN is not found/);
+ is $t->deliveries => 0, "no deliveries for admin";
+ # note $t->content;
+ }
+};
+
+subtest 'post_with_token: ustatus not changed' => sub {
+ Test::PAUSE::Web->setup;
+ for my $test (Test::PAUSE::Web->tests_for('admin')) {
+ my ($path, $user) = @$test;
+ my %form = %$default;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ $t->post_with_token_ok("$path?ACTION=change_user_status", \%form)
+ ->text_like("div.messagebox p", qr/status has changed from \w+ to nologin/);
+ is $t->deliveries => 2, "two deliveries for admin";
+ # note $t->content;
+
+ # nologin to nologin
+ $t->post_with_token_ok("$path?ACTION=change_user_status", \%form)
+ ->dom_not_found("div.messagebox p");
+ is $t->deliveries => 0, "no deliveries for admin";
+ }
+};
+
+subtest 'post_with_token: unknown ustatus' => sub {
+ Test::PAUSE::Web->setup;
+ for my $test (Test::PAUSE::Web->tests_for('admin')) {
+ my ($path, $user) = @$test;
+ my %form = (
+ %$default,
+ pause99_change_user_status_new_ustatus => 'unknown',
+ );
+ my $t = Test::PAUSE::Web->new(user => $user);
+ $t->post_with_token_ok("$path?ACTION=change_user_status", \%form)
+ ->dom_not_found("div.messagebox p");
+ is $t->deliveries => 0, "no deliveries for admin";
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2017/delete_files.t b/t/pause_2025/action_2017/delete_files.t
new file mode 100644
index 000000000..07ea06525
--- /dev/null
+++ b/t/pause_2025/action_2017/delete_files.t
@@ -0,0 +1,244 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+
+my $default_for_add_uri = {
+ pause99_add_uri_httpupload => [Test::PAUSE::Web->file_to_upload],
+ SUBMIT_pause99_add_uri_httpupload => 1,
+};
+
+my $default = {
+ pause99_delete_files_FILE => ["Hash-RenameKey-0.02.tar.gz"],
+};
+
+Test::PAUSE::Web->setup;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ $t->get_ok("$path?ACTION=delete_files");
+ # note $t->content;
+ }
+};
+
+subtest 'post: basic' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+
+ $t->mod_dbh->do("TRUNCATE uris");
+ $t->mod_dbh->do("TRUNCATE deletes");
+ $t->remove_authors_dir($user);
+
+ # prepare distribution
+ $t->post_ok("$path?ACTION=add_uri", $default_for_add_uri, "Content-Type" => "form-data");
+
+ $t->copy_to_authors_dir($user, scalar Test::PAUSE::Web->file_to_upload);
+
+ # delete
+ my %form = %$default;
+ $form{SUBMIT_pause99_delete_files_delete} = 1;
+ $t->post_ok("$path?ACTION=delete_files", \%form);
+ # note $t->content;
+
+ my @deliveries = $t->deliveries;
+ is @deliveries => 2;
+ my ($mail_body) = map {$_->body} @deliveries;
+ like $mail_body => qr/ACTION=delete_files/;
+
+ my $rows = $t->mod_db->select('deletes', ['*']);
+ is @$rows => 1;
+ like $rows->[0]{deleteid} => qr!/$form{pause99_delete_files_FILE}[0]$!;
+
+ # undelete
+ delete $form{SUBMIT_pause99_delete_files_delete};
+ $form{SUBMIT_pause99_delete_files_undelete} = 1;
+ $t->post_ok("$path?ACTION=delete_files", \%form);
+ # note $t->content;
+
+ ok $rows = $t->mod_db->select('deletes', ['*']);
+ ok !@$rows;
+ }
+};
+
+subtest 'post: absolute path' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+
+ $t->mod_dbh->do("TRUNCATE uris");
+ $t->mod_dbh->do("TRUNCATE deletes");
+ $t->remove_authors_dir($user);
+
+ # prepare distribution
+ $t->post_ok("$path?ACTION=add_uri", $default_for_add_uri, "Content-Type" => "form-data");
+
+ my $copied = $t->copy_to_authors_dir($user, scalar Test::PAUSE::Web->file_to_upload);
+ ok(File::Spec->file_name_is_absolute($copied));
+
+ # delete
+ my %form = (
+ pause99_delete_files_FILE => [$copied],
+ SUBMIT_pause99_delete_files_delete => 1
+ );
+ $t->post_ok("$path?ACTION=delete_files", \%form);
+ # note $t->content;
+
+ my @deliveries = $t->deliveries;
+ is @deliveries => 2;
+ my ($mail_body) = map {$_->body} @deliveries;
+ like $mail_body => qr/WARNING: illegal filename/;
+
+ my $rows = $t->mod_db->select('deletes', ['*']);
+ ok !@$rows;
+ }
+};
+
+subtest 'post: file not found' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+
+ $t->mod_dbh->do("TRUNCATE uris");
+ $t->mod_dbh->do("TRUNCATE deletes");
+ $t->remove_authors_dir($user);
+
+ # prepare distribution
+ $t->post_ok("$path?ACTION=add_uri", $default_for_add_uri, "Content-Type" => "form-data");
+
+ my $copied = $t->copy_to_authors_dir($user, scalar Test::PAUSE::Web->file_to_upload);
+
+ # delete
+ my %form = (
+ pause99_delete_files_FILE => ['Something-Else-0.02.tar.gz'],
+ SUBMIT_pause99_delete_files_delete => 1
+ );
+ $t->post_ok("$path?ACTION=delete_files", \%form);
+ # note $t->content;
+
+ my @deliveries = $t->deliveries;
+ is @deliveries => 2;
+ my ($mail_body) = map {$_->body} @deliveries;
+ like $mail_body => qr/WARNING: file not found/;
+
+ my $rows = $t->mod_db->select('deletes', ['*']);
+ ok !@$rows;
+ }
+};
+
+subtest 'post: CHECKSUMS' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+
+ $t->mod_dbh->do("TRUNCATE uris");
+ $t->mod_dbh->do("TRUNCATE deletes");
+ $t->remove_authors_dir($user);
+
+ # prepare distribution
+ $t->post_ok("$path?ACTION=add_uri", $default_for_add_uri, "Content-Type" => "form-data");
+
+ my $copied = $t->copy_to_authors_dir($user, scalar Test::PAUSE::Web->file_to_upload);
+ $t->save_to_authors_dir($user, "CHECKSUMS", "CHECKSUMS");
+
+ # delete
+ my %form = (
+ pause99_delete_files_FILE => ['CHECKSUMS'],
+ SUBMIT_pause99_delete_files_delete => 1
+ );
+ $t->post_ok("$path?ACTION=delete_files", \%form);
+ # note $t->content;
+
+ my @deliveries = $t->deliveries;
+ is @deliveries => 2;
+ my ($mail_body) = map {$_->body} @deliveries;
+ like $mail_body => qr/WARNING: CHECKSUMS not erasable/;
+
+ my $rows = $t->mod_db->select('deletes', ['*']);
+ ok !@$rows;
+ }
+};
+
+subtest 'post: readme' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+
+ $t->mod_dbh->do("TRUNCATE uris");
+ $t->mod_dbh->do("TRUNCATE deletes");
+ $t->remove_authors_dir($user);
+
+ # prepare distribution
+ $t->post_ok("$path?ACTION=add_uri", $default_for_add_uri, "Content-Type" => "form-data");
+
+ my $copied = $t->copy_to_authors_dir($user, scalar Test::PAUSE::Web->file_to_upload);
+ $t->save_to_authors_dir($user, "Hash-RenameKey-0.02.readme", "README");
+
+ # delete
+ my %form = %$default;
+ $form{SUBMIT_pause99_delete_files_delete} = 1;
+ $t->post_ok("$path?ACTION=delete_files", \%form);
+ # note $t->content;
+
+ # .readme is deleted when a related tarball is removed
+ my @deliveries = $t->deliveries;
+ is @deliveries => 2;
+ my ($mail_body) = map {$_->body} @deliveries;
+ like $mail_body => qr/\.readme/;
+
+ my $rows = $t->mod_db->select('deletes', ['*']);
+ is @$rows => 2;
+ ok grep {$_->{deleteid} =~ /\.readme$/} @$rows;
+ }
+};
+
+subtest 'post: delete by admin using select_user' => sub {
+ {
+ my $test = Test::PAUSE::Web->tests_for('user');
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+
+ $t->mod_dbh->do("TRUNCATE uris");
+ $t->mod_dbh->do("TRUNCATE deletes");
+ $t->remove_authors_dir($user);
+
+ # prepare distribution
+ $t->post_ok("$path?ACTION=add_uri", $default_for_add_uri, "Content-Type" => "form-data");
+
+ my $copied = $t->copy_to_authors_dir($user, scalar Test::PAUSE::Web->file_to_upload);
+ }
+ {
+ my $test = Test::PAUSE::Web->tests_for('admin');
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+
+ my %action_form = (
+ HIDDENNAME => "TESTUSER",
+ ACTIONREQ => "delete_files",
+ pause99_select_user_sub => 1,
+ );
+ $t->post_ok("$path?ACTION=select_user", \%action_form);
+ # note $t->content;
+
+ # delete
+ my %form = %$default;
+ $form{SUBMIT_pause99_delete_files_delete} = 1;
+ $form{HIDDENNAME} = "TESTUSER";
+ $t->post_ok("$path?ACTION=delete_files", \%form);
+ # note $t->content;
+
+ my @deliveries = $t->deliveries;
+ is @deliveries => 3; # for TESTUSER, TESTADMIN, pause_admin
+ my ($mail_body) = map {$_->body} @deliveries;
+ like $mail_body => qr/ACTION=delete_files/;
+
+ my $rows = $t->mod_db->select('deletes', ['*']);
+ is @$rows => 1;
+ like $rows->[0]{deleteid} => qr!/$form{pause99_delete_files_FILE}[0]$!;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2017/edit_cred.t b/t/pause_2025/action_2017/edit_cred.t
new file mode 100644
index 000000000..507859f8f
--- /dev/null
+++ b/t/pause_2025/action_2017/edit_cred.t
@@ -0,0 +1,65 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+
+my $default = {
+ pause99_edit_cred_fullname => "new fullname",
+ pause99_edit_cred_asciiname => "new ascii name",
+ pause99_edit_cred_email => "new_email\@localhost.localdomain",
+ pause99_edit_cred_homepage => "none",
+ pause99_edit_cred_cpan_mail_alias => "none",
+ pause99_edit_cred_sub => 1,
+};
+
+Test::PAUSE::Web->setup;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ $t->get_ok("$path?ACTION=edit_cred");
+ # note $t->content;
+ }
+};
+
+subtest 'post: basic' => sub {
+ plan skip_all => 'SKIP for now';
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+
+ my %form = %$default;
+ $t->post_ok("$path?ACTION=edit_cred", \%form);
+ # note $t->content;
+ }
+};
+
+subtest 'post_with_token: basic' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+
+ my %form = %$default;
+ $t->post_with_token_ok("$path?ACTION=edit_cred", \%form);
+ # note $t->content;
+ }
+};
+
+subtest 'post_with_token: edit with CENSORED email' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+
+ Test::PAUSE::Web->setup;
+ $t->mod_db->update('users', { email => 'CENSORED' }, { userid => $user });
+ my %form = (%$default, pause99_edit_cred_email => 'CENSORED');
+ $t->post_with_token_ok("$path?ACTION=edit_cred", \%form);
+ my @deliveries = $t->deliveries;
+ like $deliveries[0]->as_string => qr/\[CENSORED\]/;
+ # note $t->content;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2017/edit_ml.t b/t/pause_2025/action_2017/edit_ml.t
new file mode 100644
index 000000000..535653cd9
--- /dev/null
+++ b/t/pause_2025/action_2017/edit_ml.t
@@ -0,0 +1,18 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+
+Test::PAUSE::Web->setup;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('admin')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ $t->get_ok("$path?ACTION=edit_ml");
+ # note $t->content;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2017/edit_uris.t b/t/pause_2025/action_2017/edit_uris.t
new file mode 100644
index 000000000..80c882fdc
--- /dev/null
+++ b/t/pause_2025/action_2017/edit_uris.t
@@ -0,0 +1,45 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+
+my $default_for_add_uri = {
+ pause99_add_uri_httpupload => ["$Test::PAUSE::Web::AppRoot/t/staging/Hash-RenameKey-0.02.tar.gz", "Hash-RenameKey-0.02.tar.gz"],
+ SUBMIT_pause99_add_uri_httpupload => 1,
+};
+
+my $default = {
+ pause99_edit_uris_3 => "T/TE/TESTUSER/Hash-RenameKey-0.02.tar.gz",
+ pause99_edit_uris_2 => 1,
+};
+
+Test::PAUSE::Web->setup;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ $t->get_ok("$path?ACTION=edit_uris");
+ # note $t->content;
+ }
+};
+
+subtest 'post: basic' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+
+ $t->mod_dbh->do("TRUNCATE uris");
+
+ # prepare distribution
+ $t->post_ok("$path?ACTION=add_uri", $default_for_add_uri, "Content-Type" => "form-data");
+
+ my %form = %$default;
+ $form{pause99_edit_uris_3} =~ s/TESTUSER/$user/;
+ $t->post_ok("$path?ACTION=edit_uris", \%form);
+ # note $t->content;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2017/email_for_admin.t b/t/pause_2025/action_2017/email_for_admin.t
new file mode 100644
index 000000000..4d86b2991
--- /dev/null
+++ b/t/pause_2025/action_2017/email_for_admin.t
@@ -0,0 +1,18 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+
+Test::PAUSE::Web->setup;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('admin')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ $t->get_ok("$path?ACTION=email_for_admin");
+ # note $t->content;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2017/giveup_comaint.t b/t/pause_2025/action_2017/giveup_comaint.t
new file mode 100644
index 000000000..c1cb6e4f0
--- /dev/null
+++ b/t/pause_2025/action_2017/giveup_comaint.t
@@ -0,0 +1,112 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+use Test::Deep;
+use Test::Differences;
+
+my $default = {
+ pause99_share_perms_remome_m => "Module::Comaint",
+ SUBMIT_pause99_share_perms_remome => 1,
+};
+
+Test::PAUSE::Web->setup;
+Test::PAUSE::Web->reset_module_fixture;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+
+ my $t = Test::PAUSE::Web->new(user => $user);
+ $t->get_ok("$path?ACTION=giveup_comaint");
+ my @modules = map {$_->all_text} $t->dom->find('td.package')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_bag(\@modules, [qw/
+ Module::Comaint
+ Module::Comaint::Foo
+ Module::User::Foo
+ /]) or note explain \@modules;
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_bag(\@modules, [qw/
+ Module::Comaint
+ Module::Comaint::Foo
+ /]) or note explain \@modules;
+ }
+ # note $t->content;
+ }
+};
+
+subtest 'normal case (comaint)' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+
+ my %form = (
+ %$default,
+ pause99_share_perms_remome_m => [qw/Module::Comaint Module::Comaint::Foo/],
+ );
+
+ Test::PAUSE::Web->reset_module_fixture;
+ $t->post_ok("$path?ACTION=giveup_comaint", \%form);
+ my @modules = map {$_->all_text} $t->dom->find('td.package')->each;
+ my @results = map {$_->all_text} $t->dom->find('.result')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_bag(\@modules, [qw/
+ Module::User::Foo
+ /]) or note explain \@modules;
+ eq_or_diff(\@results, [
+ 'Removed TESTADMIN from co-maintainers of Module::Comaint.',
+ 'Removed TESTADMIN from co-maintainers of Module::Comaint::Foo.',
+ ]);
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_bag(\@modules, [qw/
+ /]) or note explain \@modules;
+ eq_or_diff(\@results, [
+ 'Removed TESTUSER from co-maintainers of Module::Comaint.',
+ 'Removed TESTUSER from co-maintainers of Module::Comaint::Foo.',
+ ]);
+ }
+ # note $t->content;
+ }
+};
+
+subtest 'unrelated modules' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+
+ my %form = (
+ %$default,
+ pause99_share_perms_remome_m => [qw/Module::Unrelated Module::Unrelated::Foo/],
+ );
+
+ Test::PAUSE::Web->reset_module_fixture;
+ $t->post_ok("$path?ACTION=giveup_comaint", \%form);
+ my @modules = map {$_->all_text} $t->dom->find('td.package')->each;
+ my @results = map {$_->all_text} $t->dom->find('.result')->each;
+ my @errors = map {$_->all_text} $t->dom->find('.error')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_bag(\@modules, [qw/
+ Module::Comaint
+ Module::Comaint::Foo
+ Module::User::Foo
+ /]) or note explain \@modules;
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_bag(\@modules, [qw/
+ Module::Comaint
+ Module::Comaint::Foo
+ /]) or note explain \@modules;
+ }
+ ok !@results;
+ eq_or_diff(\@errors, [
+ 'You do not seem to be co-maintainer of Module::Unrelated'
+ ]) or note explain \@errors;
+ # note $t->content;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2017/giveup_dist_comaint.t b/t/pause_2025/action_2017/giveup_dist_comaint.t
new file mode 100644
index 000000000..7e4e97a91
--- /dev/null
+++ b/t/pause_2025/action_2017/giveup_dist_comaint.t
@@ -0,0 +1,109 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+use Test::Deep;
+use Test::Differences;
+
+my $default = {
+ pause99_giveup_dist_comaint_d => "Module-Comaint",
+ SUBMIT_pause99_giveup_dist_comaint => 1,
+};
+
+Test::PAUSE::Web->setup;
+Test::PAUSE::Web->reset_module_fixture;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+
+ Test::PAUSE::Web->reset_module_fixture;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ $t->get_ok("$path?ACTION=giveup_dist_comaint");
+ my @dists = map {$_->all_text} $t->dom->find('td.dist')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_bag(\@dists, [qw/
+ Module-Comaint
+ Module-User
+ /]) or note explain \@dists;
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_bag(\@dists, [qw/
+ Module-Comaint
+ /]) or note explain \@dists;
+ }
+ # note $t->content;
+ }
+};
+
+subtest 'normal case (comaint)' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+
+ my %form = (
+ %$default,
+ pause99_giveup_dist_comaint_d => [qw/Module-Comaint/],
+ );
+
+ Test::PAUSE::Web->reset_module_fixture;
+ $t->post_ok("$path?ACTION=giveup_dist_comaint", \%form);
+ my @dists = map {$_->all_text} $t->dom->find('td.dist')->each;
+ my @results = map {$_->all_text} $t->dom->find('.result')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_bag(\@dists, [qw/
+ Module-User
+ /]) or note explain \@dists;
+ eq_or_diff(\@results, [
+ 'Removed TESTADMIN from co-maintainers of Module::Comaint (Module-Comaint).',
+ 'Removed TESTADMIN from co-maintainers of Module::Comaint::Foo (Module-Comaint).',
+ ]);
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_bag(\@dists, [qw/
+ /]) or note explain \@dists;
+ eq_or_diff(\@results, [
+ 'Removed TESTUSER from co-maintainers of Module::Comaint (Module-Comaint).',
+ 'Removed TESTUSER from co-maintainers of Module::Comaint::Foo (Module-Comaint).',
+ ]);
+ }
+ # note $t->content;
+ }
+};
+
+subtest 'unrelated dists' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+
+ my %form = (
+ %$default,
+ pause99_giveup_dist_comaint_d => [qw/Module-Unrelated/],
+ );
+
+ Test::PAUSE::Web->reset_module_fixture;
+ $t->post_ok("$path?ACTION=giveup_dist_comaint", \%form);
+ my @dists = map {$_->all_text} $t->dom->find('td.dist')->each;
+ my @results = map {$_->all_text} $t->dom->find('.result')->each;
+ my @errors = map {$_->all_text} $t->dom->find('.error')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_bag(\@dists, [qw/
+ Module-Comaint
+ Module-User
+ /]) or note explain \@dists;
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_bag(\@dists, [qw/
+ Module-Comaint
+ /]) or note explain \@dists;
+ }
+ ok !@results;
+ eq_or_diff(\@errors, [
+ 'You do not seem to be co-maintainer of Module-Unrelated'
+ ]) or note explain \@errors;
+ # note $t->content;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2017/mailpw.t b/t/pause_2025/action_2017/mailpw.t
new file mode 100644
index 000000000..5aadcfe7e
--- /dev/null
+++ b/t/pause_2025/action_2017/mailpw.t
@@ -0,0 +1,175 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+
+my $default = {
+ pause99_mailpw_1 => "TESTUSER",
+ pause99_mailpw_sub => 1,
+};
+
+Test::PAUSE::Web->setup;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ $t->get_ok("$path?ACTION=mailpw");
+ #note $t->content;
+ }
+};
+
+subtest 'post: basic' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ my %form = %$default;
+ $t->authen_dbh->do("TRUNCATE abrakadabra");
+ my $res = $t->post("$path?ACTION=mailpw", \%form);
+ ok !$res->is_success && $res->code == 403, "Forbidden";
+ like $res->content => qr/Failed CSRF check/;
+ # note $t->content;
+ }
+};
+
+subtest 'post_with_token: basic' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ my %form = %$default;
+ $t->authen_dbh->do("TRUNCATE abrakadabra");
+ $t->post_with_token_ok("$path?ACTION=mailpw", \%form)
+ ->text_like("p.form_response", qr/A token to change the password/);
+ # note $t->content;
+ }
+};
+
+subtest 'got an email instead of a userid' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ my %form = (
+ %$default,
+ pause99_mailpw_1 => 'INV@LID',
+ );
+ $t->authen_dbh->do("TRUNCATE abrakadabra");
+ $t->post_with_token_ok("$path?ACTION=mailpw", \%form)
+ ->text_is('h2', 'Error')
+ ->text_like('p.error_message', qr/Please supply a userid/s);
+ }
+};
+
+subtest 'invalid userid' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ my %form = (
+ %$default,
+ pause99_mailpw_1 => 'INV#LID',
+ );
+ $t->authen_dbh->do("TRUNCATE abrakadabra");
+ $t->post_with_token_ok("$path?ACTION=mailpw", \%form)
+ ->text_is('h2', 'Error')
+ ->text_like('p.error_message', qr/A userid of INV#LID is not allowed/s);
+ }
+};
+
+subtest 'cannot find a userid' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ my %form = (
+ %$default,
+ pause99_mailpw_1 => 'NOTFOUND',
+ );
+ $t->authen_dbh->do("TRUNCATE abrakadabra");
+ $t->post_with_token_ok("$path?ACTION=mailpw", \%form)
+ ->text_is('h2', 'Error')
+ ->text_like('p.error_message', qr/Cannot find a userid.+NOTFOUND/s);
+ # note $t->content;
+ }
+};
+
+subtest 'no secretmail' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ my %form = (
+ %$default,
+ );
+ $t->authen_dbh->do("TRUNCATE abrakadabra");
+ $t->authen_db->update('usertable', {secretemail => undef}, {user => "TESTUSER"});
+ $t->post_with_token_ok("$path?ACTION=mailpw", \%form)
+ ->text_like("p.form_response", qr/A token to change the password/);
+ # note $t->content;
+ }
+
+ Test::PAUSE::Web->setup; # restore the original state
+};
+
+subtest 'requested recently' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ my %form = %$default;
+ $t->authen_dbh->do("TRUNCATE abrakadabra");
+ $t->post_with_token_ok("$path?ACTION=mailpw", \%form)
+ ->text_like("p.form_response", qr/A token to change the password/);
+ $t->post_with_token_ok("$path?ACTION=mailpw", \%form)
+ ->text_is('h2', 'Error')
+ ->text_like('p.error_message', qr/A token for TESTUSER that allows/s);
+ # note $t->content;
+ }
+};
+
+subtest 'user without an entry in usertable: has email' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('admin')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ my %form = (
+ %$default,
+ pause99_mailpw_1 => "OTHERUSER",
+ );
+ $t->authen_dbh->do("TRUNCATE abrakadabra");
+ $t->mod_db->insert('users', {
+ userid => 'OTHERUSER',
+ email => 'foo@localhost',
+ }, {replace => 1});
+ $t->authen_db->delete('usertable', {user => 'OTHERUSER'});
+ ok !@{ $t->authen_db->select('usertable', ['user'], {user => 'OTHERUSER'}) // [] };
+ $t->post_with_token_ok("$path?ACTION=mailpw", \%form)
+ ->text_like("p.form_response", qr/A token to change the password/);
+
+ # new usertable entry is created
+ ok @{ $t->authen_db->select('usertable', ['user'], {user => 'OTHERUSER'}) // [] };
+ #note $t->content;
+ }
+};
+
+subtest 'user without an entry in usertable: without email' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('admin')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ my %form = (
+ %$default,
+ pause99_mailpw_1 => "OTHERUSER",
+ );
+ $t->authen_dbh->do("TRUNCATE abrakadabra");
+ $t->mod_db->insert('users', {
+ userid => 'OTHERUSER',
+ email => '',
+ }, {replace => 1});
+ $t->authen_db->delete('usertable', {user => 'OTHERUSER'});
+ ok !@{ $t->authen_db->select('usertable', ['user'], {user => 'OTHERUSER'}) // [] };
+ $t->post_with_token_ok("$path?ACTION=mailpw", \%form)
+ ->text_is('h2', 'Error')
+ ->text_like('p.error_message', qr/A userid of OTHERUSER\s+is not known/s);
+
+ # new usertable entry is not created
+ ok !@{ $t->authen_db->select('usertable', ['user'], {user => 'OTHERUSER'}) // [] };
+ #note $t->content;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2017/make_comaint.t b/t/pause_2025/action_2017/make_comaint.t
new file mode 100644
index 000000000..42483c71c
--- /dev/null
+++ b/t/pause_2025/action_2017/make_comaint.t
@@ -0,0 +1,169 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+use Test::Deep;
+use Test::Differences;
+
+my $default = {
+ pause99_share_perms_makeco_m => [],
+ pause99_share_perms_makeco_a => "TESTUSER2",
+ SUBMIT_pause99_share_perms_makeco => 1,
+};
+
+Test::PAUSE::Web->setup;
+Test::PAUSE::Web->reset_module_fixture;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ $t->get_ok("$path?ACTION=make_comaint");
+ my @modules = map {$_->all_text} $t->dom->find('td.package')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_set(\@modules, [qw/
+ Module::Admin::Bar
+ Module::Admin::Foo
+ /]) or note explain \@modules;
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_set(\@modules, [qw/
+ Module::User::Bar
+ Module::User::Foo
+ Module::User::Foo::Baz
+ /]) or note explain \@modules;
+ }
+ # note $t->content;
+ }
+};
+
+subtest 'normal case' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+
+ my @packages;
+ if ($user eq 'TESTADMIN') {
+ @packages = qw/Module::Admin::Bar/;
+ }
+ if ($user eq 'TESTUSER') {
+ @packages = qw/Module::User::Bar/;
+ }
+
+ my %form = (
+ %$default,
+ pause99_share_perms_makeco_m => \@packages,
+ pause99_share_perms_makeco_a => "TESTUSER4",
+ );
+
+ Test::PAUSE::Web->reset_module_fixture;
+ $t->post_ok("$path?ACTION=make_comaint", \%form);
+ my @modules = map {$_->all_text} $t->dom->find('td.package')->each;
+ my @results = map {$_->all_text} $t->dom->find('.result')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_set(\@modules, [qw/
+ Module::Admin::Bar
+ Module::Admin::Foo
+ /]) or note explain \@modules;
+ eq_or_diff(\@results, [
+ 'Added TESTUSER4 to co-maintainers of Module::Admin::Bar.',
+ ]);
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_set(\@modules, [qw/
+ Module::User::Bar
+ Module::User::Foo
+ Module::User::Foo::Baz
+ /]) or note explain \@modules;
+ eq_or_diff(\@results, [
+ 'Added TESTUSER4 to co-maintainers of Module::User::Bar.',
+ ]);
+ }
+ note $t->content;
+ }
+};
+
+subtest 'unknown user' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+
+ my @packages;
+ if ($user eq 'TESTADMIN') {
+ @packages = qw/Module::Admin::Bar/;
+ }
+ if ($user eq 'TESTUSER') {
+ @packages = qw/Module::User::Bar/;
+ }
+
+ my %form = (
+ %$default,
+ pause99_share_perms_makeco_m => \@packages,
+ pause99_share_perms_makeco_a => "UNKNOWN",
+ );
+
+ Test::PAUSE::Web->reset_module_fixture;
+ $t->post_ok("$path?ACTION=make_comaint", \%form);
+ my @modules = map {$_->all_text} $t->dom->find('td.package')->each;
+ my @results = map {$_->all_text} $t->dom->find('.result')->each;
+ my @errors = map {$_->all_text} $t->dom->find('.error')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_bag(\@modules, [qw/
+ Module::Admin::Bar
+ Module::Admin::Foo
+ /]) or note explain \@modules;
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_bag(\@modules, [qw/
+ Module::User::Bar
+ Module::User::Foo
+ Module::User::Foo::Baz
+ /]) or note explain \@modules;
+ }
+ ok !@results;
+ eq_or_diff(\@errors, [
+ 'UNKNOWN is not a valid userid.',
+ ]);
+ # note $t->content;
+ }
+};
+
+subtest 'unrelated modules' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+
+ my %form = (
+ %$default,
+ pause99_share_perms_makeco_m => [qw/Module::Unrelated/],
+ pause99_share_perms_makeco_a => "TESTUSER2",
+ );
+
+ Test::PAUSE::Web->reset_module_fixture;
+ $t->post_ok("$path?ACTION=make_comaint", \%form);
+ my @modules = map {$_->all_text} $t->dom->find('td.package')->each;
+ my @results = map {$_->all_text} $t->dom->find('.result')->each;
+ my @errors = map {$_->all_text} $t->dom->find('.error')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_bag(\@modules, [qw/
+ Module::Admin::Bar
+ Module::Admin::Foo
+ /]) or note explain \@modules;
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_bag(\@modules, [qw/
+ Module::User::Bar
+ Module::User::Foo
+ Module::User::Foo::Baz
+ /]) or note explain \@modules;
+ }
+ ok !@results;
+ eq_or_diff(\@errors, [
+ 'You do not seem to be maintainer of Module::Unrelated',
+ ]);
+ # note $t->content;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2017/make_dist_comaint.t b/t/pause_2025/action_2017/make_dist_comaint.t
new file mode 100644
index 000000000..2bd1cc9d3
--- /dev/null
+++ b/t/pause_2025/action_2017/make_dist_comaint.t
@@ -0,0 +1,165 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+use Test::Deep;
+use Test::Differences;
+
+my $default = {
+ pause99_make_dist_comaint_d => [],
+ pause99_make_dist_comaint_a => "TESTUSER2",
+ SUBMIT_pause99_make_dist_comaint => 1,
+};
+
+Test::PAUSE::Web->setup;
+Test::PAUSE::Web->reset_module_fixture;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ $t->get_ok("$path?ACTION=make_dist_comaint");
+ my @dists = map {$_->all_text} $t->dom->find('td.dist')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_set(\@dists, [qw/
+ Module-Admin
+ /]) or note explain \@dists;
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_set(\@dists, [qw/
+ Module-User
+ Module-User-Foo-Baz
+ /]) or note explain \@dists;
+ }
+
+ # note $t->content;
+ }
+};
+
+subtest 'normal case' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+
+ my @dists;
+ if ($user eq 'TESTADMIN') {
+ @dists = qw/Module-Admin/;
+ }
+ if ($user eq 'TESTUSER') {
+ @dists = qw/Module-User/;
+ }
+
+ my %form = (
+ %$default,
+ pause99_make_dist_comaint_d => \@dists,
+ pause99_make_dist_comaint_a => "TESTUSER4",
+ );
+
+ Test::PAUSE::Web->reset_module_fixture;
+ $t->post_ok("$path?ACTION=make_dist_comaint", \%form);
+ @dists = map {$_->all_text} $t->dom->find('td.dist')->each;
+ my @results = map {$_->all_text} $t->dom->find('.result')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_set(\@dists, [qw/
+ Module-Admin
+ /]) or note explain \@dists;
+ eq_or_diff(\@results, [
+ 'Added TESTUSER4 to co-maintainers of Module::Admin::Bar (Module-Admin).',
+ 'Added TESTUSER4 to co-maintainers of Module::Admin::Foo (Module-Admin).',
+ ]);
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_set(\@dists, [qw/
+ Module-User
+ Module-User-Foo-Baz
+ /]) or note explain \@dists;
+ eq_or_diff(\@results, [
+ 'Added TESTUSER4 to co-maintainers of Module::User::Bar (Module-User).',
+ 'Added TESTUSER4 to co-maintainers of Module::User::Foo (Module-User).',
+ ]);
+ }
+
+ # note $t->content;
+ }
+};
+
+subtest 'unknown user' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+
+ my @dists;
+ if ($user eq 'TESTADMIN') {
+ @dists = qw/Module-Admin/;
+ }
+ if ($user eq 'TESTUSER') {
+ @dists = qw/Module-User/;
+ }
+
+ my %form = (
+ %$default,
+ pause99_make_dist_comaint_d => \@dists,
+ pause99_make_dist_comaint_a => "UNKNOWN",
+ );
+
+ Test::PAUSE::Web->reset_module_fixture;
+ $t->post_ok("$path?ACTION=make_dist_comaint", \%form);
+ @dists = map {$_->all_text} $t->dom->find('td.dist')->each;
+ my @results = map {$_->all_text} $t->dom->find('.result')->each;
+ my @errors = map {$_->all_text} $t->dom->find('.error')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_bag(\@dists, [qw/
+ Module-Admin
+ /]) or note explain \@dists;
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_bag(\@dists, [qw/
+ Module-User
+ Module-User-Foo-Baz
+ /]) or note explain \@dists;
+ }
+ ok !@results;
+ eq_or_diff(\@errors, [
+ 'UNKNOWN is not a valid userid.',
+ ]);
+ # note $t->content;
+ }
+};
+
+subtest 'unrelated dists' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+
+ my %form = (
+ %$default,
+ pause99_make_dist_comaint_d => [qw/Module-Unrelated/],
+ pause99_make_dist_comaint_a => "TESTUSER2",
+ );
+
+ Test::PAUSE::Web->reset_module_fixture;
+ $t->post_ok("$path?ACTION=make_dist_comaint", \%form);
+ my @dists = map {$_->all_text} $t->dom->find('td.dist')->each;
+ my @results = map {$_->all_text} $t->dom->find('.result')->each;
+ my @errors = map {$_->all_text} $t->dom->find('.error')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_bag(\@dists, [qw/
+ Module-Admin
+ /]) or note explain \@dists;
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_bag(\@dists, [qw/
+ Module-User
+ Module-User-Foo-Baz
+ /]) or note explain \@dists;
+ }
+ ok !@results;
+ eq_or_diff(\@errors, [
+ 'You do not seem to be maintainer of Module-Unrelated',
+ ]);
+ # note $t->content;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2017/manage_id_requests.t b/t/pause_2025/action_2017/manage_id_requests.t
new file mode 100644
index 000000000..9113a3a83
--- /dev/null
+++ b/t/pause_2025/action_2017/manage_id_requests.t
@@ -0,0 +1,18 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+
+Test::PAUSE::Web->setup;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('admin')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ $t->get_ok("$path?ACTION=manage_id_requests");
+ # note $t->content;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2017/move_dist_primary.t b/t/pause_2025/action_2017/move_dist_primary.t
new file mode 100644
index 000000000..bcbd2132f
--- /dev/null
+++ b/t/pause_2025/action_2017/move_dist_primary.t
@@ -0,0 +1,161 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+use Test::Deep;
+use Test::Differences;
+
+my $default = {
+ pause99_move_dist_primary_d => [],
+ pause99_move_dist_primary_a => "TESTUSER2",
+ SUBMIT_pause99_move_dist_primary => 1,
+};
+
+Test::PAUSE::Web->setup;
+Test::PAUSE::Web->reset_module_fixture;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ $t->get_ok("$path?ACTION=move_dist_primary");
+ my @dists = map {$_->all_text} $t->dom->find('td.dist')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_bag(\@dists, [qw/
+ Module-Admin
+ /]) or note explain \@dists;
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_bag(\@dists, [qw/
+ Module-User
+ Module-User-Foo-Baz
+ /]) or note explain \@dists;
+ }
+ # note $t->content;
+ }
+};
+
+subtest 'normal case' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+
+ my @dists;
+ if ($user eq 'TESTADMIN') {
+ @dists = qw/Module-Admin/;
+ }
+ if ($user eq 'TESTUSER') {
+ @dists = qw/Module-User/;
+ }
+
+ my %form = (
+ %$default,
+ pause99_move_dist_primary_d => \@dists,
+ pause99_move_dist_primary_a => "TESTUSER2",
+ );
+
+ Test::PAUSE::Web->reset_module_fixture;
+ $t->post_ok("$path?ACTION=move_dist_primary", \%form);
+ @dists = map {$_->all_text} $t->dom->find('td.dist')->each;
+ my @results = map {$_->all_text} $t->dom->find('.result')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_bag(\@dists, [qw/
+ /]) or note explain \@dists;
+ eq_or_diff(\@results, [
+ 'Made TESTUSER2 primary maintainer of Module::Admin::Bar (Module-Admin).',
+ 'Made TESTUSER2 primary maintainer of Module::Admin::Foo (Module-Admin).',
+ ]);
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_bag(\@dists, [qw/
+ Module-User-Foo-Baz
+ /]) or note explain \@dists;
+ eq_or_diff(\@results, [
+ 'Made TESTUSER2 primary maintainer of Module::User::Bar (Module-User).',
+ 'Made TESTUSER2 primary maintainer of Module::User::Foo (Module-User).',
+ ]);
+ }
+ note $t->content;
+ }
+};
+
+subtest 'unknown user' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+
+ my @dists;
+ if ($user eq 'TESTADMIN') {
+ @dists = qw/Module-Admin/;
+ }
+ if ($user eq 'TESTUSER') {
+ @dists = qw/Module-User/;
+ }
+
+ my %form = (
+ %$default,
+ pause99_move_dist_primary_d => \@dists,
+ pause99_move_dist_primary_a => "UNKNOWN",
+ );
+
+ Test::PAUSE::Web->reset_module_fixture;
+ $t->post_ok("$path?ACTION=move_dist_primary", \%form);
+ my @new_dists = map {$_->all_text} $t->dom->find('td.dist')->each;
+ my @results = map {$_->all_text} $t->dom->find('.result')->each;
+ my @errors = map {$_->all_text} $t->dom->find('.error')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_bag(\@new_dists, [qw/
+ Module-Admin
+ /]) or note explain \@dists;
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_bag(\@new_dists, [qw/
+ Module-User
+ Module-User-Foo-Baz
+ /]) or note explain \@dists;
+ }
+ ok !@results;
+ eq_or_diff(\@errors, [
+ 'UNKNOWN is not a valid userid.',
+ ]);
+ # note $t->content;
+ }
+};
+
+subtest 'unrelated dists' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+
+ my %form = (
+ %$default,
+ pause99_move_dist_primary_d => [qw/Module-Unrelated/],
+ pause99_move_dist_primary_a => "TESTUSER2",
+ );
+
+ Test::PAUSE::Web->reset_module_fixture;
+ $t->post_ok("$path?ACTION=move_dist_primary", \%form);
+ my @dists = map {$_->all_text} $t->dom->find('td.dist')->each;
+ my @results = map {$_->all_text} $t->dom->find('.result')->each;
+ my @errors = map {$_->all_text} $t->dom->find('.error')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_bag(\@dists, [qw/
+ Module-Admin
+ /]) or note explain \@dists;
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_bag(\@dists, [qw/
+ Module-User
+ Module-User-Foo-Baz
+ /]) or note explain \@dists;
+ }
+ ok !@results;
+ eq_or_diff(\@errors, [
+ 'You do not seem to be maintainer of Module-Unrelated',
+ ]);
+ # note $t->content;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2017/move_primary.t b/t/pause_2025/action_2017/move_primary.t
new file mode 100644
index 000000000..e9a739229
--- /dev/null
+++ b/t/pause_2025/action_2017/move_primary.t
@@ -0,0 +1,168 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+use Test::Deep;
+use Test::Differences;
+
+my $default = {
+ pause99_share_perms_pr_m => [],
+ pause99_share_perms_movepr_a => "TESTUSER2",
+ SUBMIT_pause99_share_perms_movepr => 1,
+};
+
+Test::PAUSE::Web->setup;
+Test::PAUSE::Web->reset_module_fixture;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+
+ my $t = Test::PAUSE::Web->new(user => $user);
+ $t->get_ok("$path?ACTION=move_primary");
+ my @modules = map {$_->all_text} $t->dom->find('td.package')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_bag(\@modules, [qw/
+ Module::Admin::Bar
+ Module::Admin::Foo
+ /]) or note explain \@modules;
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_bag(\@modules, [qw/
+ Module::User::Bar
+ Module::User::Foo
+ Module::User::Foo::Baz
+ /]) or note explain \@modules;
+ }
+ # note $t->content;
+ }
+};
+
+subtest 'normal case' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+
+ my @packages;
+ if ($user eq 'TESTADMIN') {
+ @packages = qw/Module::Admin::Bar/;
+ }
+ if ($user eq 'TESTUSER') {
+ @packages = qw/Module::User::Bar/;
+ }
+
+ my %form = (
+ %$default,
+ pause99_share_perms_pr_m => \@packages,
+ pause99_share_perms_movepr_a => "TESTUSER2",
+ );
+
+ Test::PAUSE::Web->reset_module_fixture;
+ $t->post_ok("$path?ACTION=move_primary", \%form);
+ my @modules = map {$_->all_text} $t->dom->find('td.package')->each;
+ my @results = map {$_->all_text} $t->dom->find('.result')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_bag(\@modules, [qw/
+ Module::Admin::Foo
+ /]) or note explain \@modules;
+ eq_or_diff(\@results, [
+ 'Made TESTUSER2 primary maintainer of Module::Admin::Bar.',
+ ]);
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_bag(\@modules, [qw/
+ Module::User::Foo
+ Module::User::Foo::Baz
+ /]) or note explain \@modules;
+ eq_or_diff(\@results, [
+ 'Made TESTUSER2 primary maintainer of Module::User::Bar.',
+ ]);
+ }
+ # note $t->content;
+ }
+};
+
+subtest 'unknown user' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+
+ my @packages;
+ if ($user eq 'TESTADMIN') {
+ @packages = qw/Module::Admin::Bar/;
+ }
+ if ($user eq 'TESTUSER') {
+ @packages = qw/Module::User::Bar/;
+ }
+
+ my %form = (
+ %$default,
+ pause99_share_perms_pr_m => \@packages,
+ pause99_share_perms_movepr_a => "UNKNOWN",
+ );
+
+ Test::PAUSE::Web->reset_module_fixture;
+ $t->post_ok("$path?ACTION=move_primary", \%form);
+ my @modules = map {$_->all_text} $t->dom->find('td.package')->each;
+ my @results = map {$_->all_text} $t->dom->find('.result')->each;
+ my @errors = map {$_->all_text} $t->dom->find('.error')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_bag(\@modules, [qw/
+ Module::Admin::Bar
+ Module::Admin::Foo
+ /]) or note explain \@modules;
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_bag(\@modules, [qw/
+ Module::User::Bar
+ Module::User::Foo
+ Module::User::Foo::Baz
+ /]) or note explain \@modules;
+ }
+ ok !@results;
+ eq_or_diff(\@errors, [
+ 'UNKNOWN is not a valid userid.',
+ ]);
+ # note $t->content;
+ }
+};
+
+subtest 'unrelated modules' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+
+ my %form = (
+ %$default,
+ pause99_share_perms_pr_m => [qw/Module::Unrelated/],
+ pause99_share_perms_movepr_a => "TESTUSER2",
+ );
+
+ Test::PAUSE::Web->reset_module_fixture;
+ $t->post_ok("$path?ACTION=move_primary", \%form);
+ my @modules = map {$_->all_text} $t->dom->find('td.package')->each;
+ my @results = map {$_->all_text} $t->dom->find('.result')->each;
+ my @errors = map {$_->all_text} $t->dom->find('.error')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_bag(\@modules, [qw/
+ Module::Admin::Bar
+ Module::Admin::Foo
+ /]) or note explain \@modules;
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_bag(\@modules, [qw/
+ Module::User::Bar
+ Module::User::Foo
+ Module::User::Foo::Baz
+ /]) or note explain \@modules;
+ }
+ ok !@results;
+ eq_or_diff(\@errors, [
+ 'You do not seem to be maintainer of Module::Unrelated',
+ ]);
+ # note $t->content;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2017/pause_04about.t b/t/pause_2025/action_2017/pause_04about.t
new file mode 100644
index 000000000..05773616f
--- /dev/null
+++ b/t/pause_2025/action_2017/pause_04about.t
@@ -0,0 +1,18 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+
+Test::PAUSE::Web->setup;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ $t->get_ok("$path?ACTION=pause_04about");
+ # note $t->content;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2017/pause_04imprint.t b/t/pause_2025/action_2017/pause_04imprint.t
new file mode 100644
index 000000000..780605e78
--- /dev/null
+++ b/t/pause_2025/action_2017/pause_04imprint.t
@@ -0,0 +1,18 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+
+Test::PAUSE::Web->setup;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ $t->get_ok("$path?ACTION=pause_04imprint");
+ # note $t->content;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2017/pause_05news.t b/t/pause_2025/action_2017/pause_05news.t
new file mode 100644
index 000000000..e033387c2
--- /dev/null
+++ b/t/pause_2025/action_2017/pause_05news.t
@@ -0,0 +1,18 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+
+Test::PAUSE::Web->setup;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ $t->get_ok("$path?ACTION=pause_05news");
+ # note $t->content;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2017/pause_06history.t b/t/pause_2025/action_2017/pause_06history.t
new file mode 100644
index 000000000..79aed17ab
--- /dev/null
+++ b/t/pause_2025/action_2017/pause_06history.t
@@ -0,0 +1,18 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+
+Test::PAUSE::Web->setup;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ $t->get_ok("$path?ACTION=pause_06history");
+ # note $t->content;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2017/pause_logout.t b/t/pause_2025/action_2017/pause_logout.t
new file mode 100644
index 000000000..2459230d3
--- /dev/null
+++ b/t/pause_2025/action_2017/pause_logout.t
@@ -0,0 +1,18 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+
+Test::PAUSE::Web->setup;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ $t->get_ok("$path?ACTION=pause_logout");
+ # note $t->content;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2017/pause_namingmodules.t b/t/pause_2025/action_2017/pause_namingmodules.t
new file mode 100644
index 000000000..443064d5d
--- /dev/null
+++ b/t/pause_2025/action_2017/pause_namingmodules.t
@@ -0,0 +1,18 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+
+Test::PAUSE::Web->setup;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ $t->get_ok("$path?ACTION=pause_namingmodules");
+ # note $t->content;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2017/pause_operating_model.t b/t/pause_2025/action_2017/pause_operating_model.t
new file mode 100644
index 000000000..c502086ba
--- /dev/null
+++ b/t/pause_2025/action_2017/pause_operating_model.t
@@ -0,0 +1,18 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+
+Test::PAUSE::Web->setup;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ $t->get_ok("$path?ACTION=pause_operating_model");
+ # note $t->content;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2017/pause_privacy_policy.t b/t/pause_2025/action_2017/pause_privacy_policy.t
new file mode 100644
index 000000000..d33518728
--- /dev/null
+++ b/t/pause_2025/action_2017/pause_privacy_policy.t
@@ -0,0 +1,18 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+
+Test::PAUSE::Web->setup;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ $t->get_ok("$path?ACTION=pause_privacy_policy");
+ # note $t->content;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2017/peek_dist_perms.t b/t/pause_2025/action_2017/peek_dist_perms.t
new file mode 100644
index 000000000..52532ea24
--- /dev/null
+++ b/t/pause_2025/action_2017/peek_dist_perms.t
@@ -0,0 +1,172 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+use YAML::Syck;
+use Test::Deep;
+use Test::Differences;
+
+my $default = {
+ pause99_peek_dist_perms_query => "TESTUSER",
+ pause99_peek_dist_perms_by => "a",
+ pause99_peek_dist_perms_sub => 1,
+};
+
+Test::PAUSE::Web->setup;
+Test::PAUSE::Web->reset_module_fixture;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ $t->get_ok("$path?ACTION=peek_dist_perms");
+ # note $t->content;
+ }
+};
+
+subtest 'search by author' => sub {
+ for my $method (qw/get_ok post_ok/) {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+
+ my $t = Test::PAUSE::Web->new(user => $user);
+
+ my %form = (
+ %$default,
+ pause99_peek_dist_perms_query => $user,
+ );
+ $t->$method("$path?ACTION=peek_dist_perms", \%form);
+ my @dists = map {$_->all_text} $t->dom->find('td.dist')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_bag(\@dists, [qw/
+ Module-Admin
+ Module-Comaint
+ Module-User
+ /]) or note explain \@dists;
+ ok grep(/^Module-Comaint/, @dists), 'Module-Comaint is also listed';
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_bag(\@dists, [qw/
+ Module-Comaint
+ Module-User
+ Module-User-Foo-Baz
+ /]) or note explain \@dists;
+ }
+ # note $t->content;
+
+ $t->$method("$path?ACTION=peek_dist_perms&OF=YAML", \%form);
+ my $list = YAML::Syck::Load( $t->content );
+ if ($user eq 'TESTADMIN') {
+ eq_or_diff( $list => [
+ {
+ 'dist' => 'Module-Admin',
+ 'owner' => 'TESTADMIN',
+ 'comaint' => 'TESTUSER2',
+ },
+ {
+ 'dist' => 'Module-Comaint',
+ 'owner' => 'TESTUSER2',
+ 'comaint' => 'TESTADMIN',
+ },
+ {
+ 'dist' => 'Module-User',
+ 'owner' => 'TESTUSER',
+ 'comaint' => 'TESTADMIN',
+ },
+ ] );
+ }
+ if ($user eq 'TESTUSER') {
+ eq_or_diff( $list => [
+ {
+ 'dist' => 'Module-Comaint',
+ 'owner' => 'TESTUSER2',
+ 'comaint' => 'TESTUSER',
+ },
+ {
+ 'dist' => 'Module-User',
+ 'owner' => 'TESTUSER',
+ 'comaint' => 'TESTADMIN,TESTUSER2',
+ },
+ {
+ 'dist' => 'Module-User-Foo-Baz',
+ 'owner' => 'TESTUSER',
+ 'comaint' => undef,
+ },
+ ] );
+ }
+ }
+ }
+};
+
+subtest 'search by dist (exact)' => sub {
+ for my $method (qw/get_ok post_ok/) {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+
+ my $t = Test::PAUSE::Web->new(user => $user);
+
+ my %form = (
+ %$default,
+ pause99_peek_dist_perms_query => 'Module-User',
+ pause99_peek_dist_perms_by => 'de',
+ );
+ $t->$method("$path?ACTION=peek_dist_perms", \%form);
+ my @dists = map {$_->all_text} $t->dom->find('td.dist')->each;
+ cmp_set(\@dists, [qw/
+ Module-User
+ /]) or note explain \@dists;
+ # note $t->content;
+
+ $t->$method("$path?ACTION=peek_dist_perms&OF=YAML", \%form);
+ my $list = YAML::Syck::Load( $t->content );
+ eq_or_diff( $list => [
+ {
+ 'dist' => 'Module-User',
+ 'owner' => 'TESTUSER',
+ 'comaint' => 'TESTADMIN,TESTUSER2',
+ },
+ ]);
+ }
+ }
+};
+
+subtest 'search by module (sql-like)' => sub {
+ for my $method (qw/get_ok post_ok/) {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+
+ my $t = Test::PAUSE::Web->new(user => $user);
+
+ my %form = (
+ %$default,
+ pause99_peek_dist_perms_query => 'Module-User%',
+ pause99_peek_dist_perms_by => 'dl',
+ );
+ $t->$method("$path?ACTION=peek_dist_perms", \%form);
+ my @dists = map {$_->all_text} $t->dom->find('td.dist')->each;
+ cmp_set(\@dists, [qw/
+ Module-User
+ Module-User-Foo-Baz
+ /]) or note explain \@dists;
+ # note $t->content;
+
+ $t->$method("$path?ACTION=peek_dist_perms&OF=YAML", \%form);
+ my $list = YAML::Syck::Load( $t->content );
+ eq_or_diff( $list => [
+ {
+ 'dist' => 'Module-User',
+ 'owner' => 'TESTUSER',
+ 'comaint' => 'TESTADMIN,TESTUSER2',
+ },
+ {
+ 'dist' => 'Module-User-Foo-Baz',
+ 'owner' => 'TESTUSER',
+ 'comaint' => undef,
+ },
+ ]);
+ }
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2017/peek_perms.t b/t/pause_2025/action_2017/peek_perms.t
new file mode 100644
index 000000000..74f816693
--- /dev/null
+++ b/t/pause_2025/action_2017/peek_perms.t
@@ -0,0 +1,240 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+use YAML::Syck;
+use Test::Deep;
+use Test::Differences;
+
+my $default = {
+ pause99_peek_perms_query => "TESTUSER",
+ pause99_peek_perms_by => "a",
+ pause99_peek_perms_sub => 1,
+};
+
+Test::PAUSE::Web->setup;
+Test::PAUSE::Web->reset_module_fixture;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ $t->get_ok("$path?ACTION=peek_perms");
+ # note $t->content;
+ }
+};
+
+subtest 'search by author' => sub {
+ for my $method (qw/get_ok post_ok/) {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+
+ my $t = Test::PAUSE::Web->new(user => $user);
+
+ my %form = (
+ %$default,
+ pause99_peek_perms_query => $user,
+ );
+ $t->$method("$path?ACTION=peek_perms", \%form);
+ my @modules = map {$_->all_text} $t->dom->find('td.module')->each;
+ my @types = map {$_->all_text} $t->dom->find('td.type')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_bag(\@modules, [qw/
+ Module::Admin::Bar
+ Module::Admin::Foo
+ Module::Comaint
+ Module::Comaint::Foo
+ Module::User::Foo
+ /]) or note explain \@modules;
+ ok grep(/co-maint/, @types), 'Has co-maint';
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_bag(\@modules, [qw/
+ Module::Comaint
+ Module::Comaint::Foo
+ Module::User::Bar
+ Module::User::Foo
+ Module::User::Foo::Baz
+ /]) or note explain \@modules;
+ ok grep(/co-maint/, @types), 'No co-maint';
+ }
+ # note $t->content;
+
+ $t->$method("$path?ACTION=peek_perms&OF=YAML", \%form);
+ my $list = YAML::Syck::Load( $t->content );
+ if ($user eq 'TESTADMIN') {
+ eq_or_diff( $list => [
+ {
+ 'module' => 'Module::Admin::Bar',
+ 'owner' => 'TESTADMIN',
+ 'type' => 'first-come',
+ 'userid' => 'TESTADMIN'
+ },
+ {
+ 'module' => 'Module::Admin::Foo',
+ 'owner' => 'TESTADMIN',
+ 'type' => 'first-come',
+ 'userid' => 'TESTADMIN'
+ },
+ {
+ 'module' => 'Module::User::Foo',
+ 'owner' => 'TESTUSER',
+ 'type' => 'co-maint',
+ 'userid' => 'TESTADMIN'
+ },
+ {
+ 'module' => 'Module::Comaint',
+ 'owner' => 'TESTUSER2',
+ 'type' => 'co-maint',
+ 'userid' => 'TESTADMIN'
+ },
+ {
+ 'module' => 'Module::Comaint::Foo',
+ 'owner' => 'TESTUSER2',
+ 'type' => 'co-maint',
+ 'userid' => 'TESTADMIN'
+ },
+ ] );
+ }
+ if ($user eq 'TESTUSER') {
+ eq_or_diff( $list => [
+ {
+ 'module' => 'Module::User::Bar',
+ 'owner' => 'TESTUSER',
+ 'type' => 'first-come',
+ 'userid' => 'TESTUSER'
+ },
+ {
+ 'module' => 'Module::User::Foo',
+ 'owner' => 'TESTUSER',
+ 'type' => 'first-come',
+ 'userid' => 'TESTUSER'
+ },
+ {
+ 'module' => 'Module::User::Foo::Baz',
+ 'owner' => 'TESTUSER',
+ 'type' => 'first-come',
+ 'userid' => 'TESTUSER'
+ },
+ {
+ 'module' => 'Module::Comaint',
+ 'owner' => 'TESTUSER2',
+ 'type' => 'co-maint',
+ 'userid' => 'TESTUSER'
+ },
+ {
+ 'module' => 'Module::Comaint::Foo',
+ 'owner' => 'TESTUSER2',
+ 'type' => 'co-maint',
+ 'userid' => 'TESTUSER'
+ },
+ ] );
+ }
+ }
+ }
+};
+
+subtest 'search by module (exact)' => sub {
+ for my $method (qw/get_ok post_ok/) {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+
+ my $t = Test::PAUSE::Web->new(user => $user);
+
+ my %form = (
+ %$default,
+ pause99_peek_perms_query => 'Module::User::Foo',
+ pause99_peek_perms_by => 'me',
+ );
+ $t->$method("$path?ACTION=peek_perms", \%form);
+ my @modules = map {$_->all_text} $t->dom->find('td.module')->each;
+ my @types = map {$_->all_text} $t->dom->find('td.type')->each;
+ cmp_set(\@modules, [qw/
+ Module::User::Foo
+ /]) or note explain \@modules;
+ ok grep(/co-maint/, @types), 'Has co-maint';
+ # note $t->content;
+
+ $t->$method("$path?ACTION=peek_perms&OF=YAML", \%form);
+ my $list = YAML::Syck::Load( $t->content );
+ eq_or_diff( $list => [
+ {
+ 'module' => 'Module::User::Foo',
+ 'owner' => 'TESTUSER',
+ 'type' => 'first-come',
+ 'userid' => 'TESTUSER'
+ },
+ {
+ 'module' => 'Module::User::Foo',
+ 'owner' => 'TESTUSER',
+ 'type' => 'co-maint',
+ 'userid' => 'TESTADMIN'
+ },
+ ]);
+ }
+ }
+};
+
+subtest 'search by module (sql-like)' => sub {
+ for my $method (qw/get_ok post_ok/) {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+
+ my $t = Test::PAUSE::Web->new(user => $user);
+
+ my %form = (
+ %$default,
+ pause99_peek_perms_query => 'Module::User::%',
+ pause99_peek_perms_by => 'ml',
+ );
+ $t->$method("$path?ACTION=peek_perms", \%form);
+ my @modules = map {$_->all_text} $t->dom->find('td.module')->each;
+ my @types = map {$_->all_text} $t->dom->find('td.type')->each;
+ cmp_set(\@modules, [qw/
+ Module::User::Bar
+ Module::User::Foo
+ Module::User::Foo::Baz
+ /]) or note explain \@modules;
+ ok grep(/co-maint/, @types), 'Has co-maint';
+ # note $t->content;
+
+ $t->$method("$path?ACTION=peek_perms&OF=YAML", \%form);
+ my $list = YAML::Syck::Load( $t->content );
+ eq_or_diff( $list => [
+ {
+ 'module' => 'Module::User::Bar',
+ 'owner' => 'TESTUSER',
+ 'type' => 'first-come',
+ 'userid' => 'TESTUSER'
+ },
+ {
+ 'module' => 'Module::User::Foo',
+ 'owner' => 'TESTUSER',
+ 'type' => 'first-come',
+ 'userid' => 'TESTUSER'
+ },
+ {
+ 'module' => 'Module::User::Foo::Baz',
+ 'owner' => 'TESTUSER',
+ 'type' => 'first-come',
+ 'userid' => 'TESTUSER'
+ },
+ {
+ 'module' => 'Module::User::Bar',
+ 'owner' => 'TESTUSER',
+ 'type' => 'co-maint',
+ 'userid' => 'TESTUSER2'
+ },
+ {
+ 'module' => 'Module::User::Foo',
+ 'owner' => 'TESTUSER',
+ 'type' => 'co-maint',
+ 'userid' => 'TESTADMIN'
+ },
+ ]);
+ }
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2017/reindex.t b/t/pause_2025/action_2017/reindex.t
new file mode 100644
index 000000000..3d0df8430
--- /dev/null
+++ b/t/pause_2025/action_2017/reindex.t
@@ -0,0 +1,47 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+
+my $default_for_add_uri = {
+ pause99_add_uri_httpupload => [Test::PAUSE::Web->file_to_upload],
+ SUBMIT_pause99_add_uri_httpupload => 1,
+};
+
+my $default = {
+ pause99_reindex_FILE => ["Hash-RemoteKey-0.02.tar.gz"],
+ SUBMIT_pause99_reindex_delete => 1,
+};
+
+Test::PAUSE::Web->setup;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ $t->get_ok("$path?ACTION=reindex");
+ # note $t->content;
+ }
+};
+
+subtest 'post: basic' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+
+ my $t = Test::PAUSE::Web->new(user => $user);
+
+ $t->mod_dbh->do("TRUNCATE uris");
+
+ # prepare distribution
+ $t->post_ok("$path?ACTION=add_uri", $default_for_add_uri, "Content-Type" => "form-data");
+
+ $t->copy_to_authors_dir($user, scalar Test::PAUSE::Web->file_to_upload);
+
+ my %form = %$default;
+ $t->post_ok("$path?ACTION=reindex", \%form);
+ # note $t->content;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2017/remove_comaint.t b/t/pause_2025/action_2017/remove_comaint.t
new file mode 100644
index 000000000..752dcba37
--- /dev/null
+++ b/t/pause_2025/action_2017/remove_comaint.t
@@ -0,0 +1,172 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+use Test::Deep;
+use Test::Differences;
+
+my $default = {
+ pause99_share_perms_remocos_tuples => [],
+ SUBMIT_pause99_share_perms_remocos => 1,
+};
+
+Test::PAUSE::Web->setup;
+Test::PAUSE::Web->reset_module_fixture;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ $t->get_ok("$path?ACTION=remove_comaint");
+ my @modules = map {$_->all_text} $t->dom->find('td.package')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_set(\@modules, [qw/
+ Module::Admin::Bar
+ Module::Admin::Foo
+ /]) or note explain \@modules;
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_set(\@modules, [qw/
+ Module::User::Bar
+ Module::User::Foo
+ /]) or note explain \@modules;
+ }
+ # note $t->content;
+ }
+};
+
+subtest 'normal case' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+
+ my @tuples;
+ if ($user eq 'TESTADMIN') {
+ @tuples = (
+ 'Module::Admin::Bar -- TESTUSER2',
+ );
+ }
+ if ($user eq 'TESTUSER') {
+ @tuples = (
+ 'Module::User::Bar -- TESTUSER2',
+ );
+
+ }
+
+ my %form = (
+ %$default,
+ pause99_share_perms_remocos_tuples => \@tuples,
+ );
+
+ Test::PAUSE::Web->reset_module_fixture;
+ $t->post_ok("$path?ACTION=remove_comaint", \%form);
+ my @modules = map {$_->all_text} $t->dom->find('td.package')->each;
+ my @results = map {$_->all_text} $t->dom->find('.result')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_set(\@modules, [qw/
+ Module::Admin::Foo
+ /]) or note explain \@modules;
+ eq_or_diff(\@results, [
+ 'Removed TESTUSER2 from co-maintainers of Module::Admin::Bar.',
+ ]);
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_set(\@modules, [qw/
+ Module::User::Foo
+ /]) or note explain \@modules;
+ eq_or_diff(\@results, [
+ 'Removed TESTUSER2 from co-maintainers of Module::User::Bar.',
+ ]);
+ }
+ # note $t->content;
+ }
+};
+
+subtest 'broken tuple (not the owner)' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+
+ my %form = (
+ %$default,
+ pause99_share_perms_remocos_tuples => ['Module::Unrelated -- TESTUSER2'],
+ );
+
+ Test::PAUSE::Web->reset_module_fixture;
+ $t->post_ok("$path?ACTION=remove_comaint", \%form);
+ my @modules = map {$_->all_text} $t->dom->find('td.package')->each;
+ my @results = map {$_->all_text} $t->dom->find('.result')->each;
+ my @errors = map {$_->all_text} $t->dom->find('.error')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_set(\@modules, [qw/
+ Module::Admin::Bar
+ Module::Admin::Foo
+ /]) or note explain \@modules;
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_set(\@modules, [qw/
+ Module::User::Bar
+ Module::User::Foo
+ /]) or note explain \@modules;
+ }
+ ok !@results;
+ eq_or_diff(\@errors, [
+ 'You do not seem to be owner of Module::Unrelated.',
+ ]);
+ # note $t->content;
+ }
+};
+
+subtest 'broken tuple (not the comaint)' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+
+ my @tuples;
+ if ($user eq 'TESTADMIN') {
+ @tuples = (
+ 'Module::Admin::Bar -- TESTUSER4',
+ );
+ }
+ if ($user eq 'TESTUSER') {
+ @tuples = (
+ 'Module::User::Bar -- TESTUSER4',
+ );
+
+ }
+
+ my %form = (
+ %$default,
+ pause99_share_perms_remocos_tuples => \@tuples,
+ );
+
+ Test::PAUSE::Web->reset_module_fixture;
+ $t->post_ok("$path?ACTION=remove_comaint", \%form);
+ my @modules = map {$_->all_text} $t->dom->find('td.package')->each;
+ my @results = map {$_->all_text} $t->dom->find('.result')->each;
+ my @errors = map {$_->all_text} $t->dom->find('.error')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_set(\@modules, [qw/
+ Module::Admin::Bar
+ Module::Admin::Foo
+ /]) or note explain \@modules;
+ eq_or_diff(\@errors, [
+ 'Cannot handle tuple Module::Admin::Bar -- TESTUSER4. If you believe, this is a bug, please complain.'
+ ]);
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_set(\@modules, [qw/
+ Module::User::Bar
+ Module::User::Foo
+ /]) or note explain \@modules;
+ eq_or_diff(\@errors, [
+ 'Cannot handle tuple Module::User::Bar -- TESTUSER4. If you believe, this is a bug, please complain.'
+ ]);
+ }
+ ok !@results;
+ # note $t->content;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2017/remove_dist_comaint.t b/t/pause_2025/action_2017/remove_dist_comaint.t
new file mode 100644
index 000000000..db476fde3
--- /dev/null
+++ b/t/pause_2025/action_2017/remove_dist_comaint.t
@@ -0,0 +1,166 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+use Test::Deep;
+use Test::Differences;
+
+my $default = {
+ pause99_remove_dist_comaint_tuples => [],
+ SUBMIT_pause99_remove_dist_comaint => 1,
+};
+
+Test::PAUSE::Web->setup;
+Test::PAUSE::Web->reset_module_fixture;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ $t->get_ok("$path?ACTION=remove_dist_comaint");
+ my @dists = map {$_->all_text} $t->dom->find('td.dist')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_set(\@dists, [qw/
+ Module-Admin
+ /]) or note explain \@dists;
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_set(\@dists, [qw/
+ Module-User
+ /]) or note explain \@dists;
+ }
+ # note $t->content;
+ }
+};
+
+subtest 'normal case' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+
+ my @tuples;
+ if ($user eq 'TESTADMIN') {
+ @tuples = (
+ 'Module-Admin -- TESTUSER2',
+ );
+ }
+ if ($user eq 'TESTUSER') {
+ @tuples = (
+ 'Module-User -- TESTUSER2',
+ );
+ }
+
+ my %form = (
+ %$default,
+ pause99_remove_dist_comaint_tuples => \@tuples,
+ );
+
+ Test::PAUSE::Web->reset_module_fixture;
+ $t->post_ok("$path?ACTION=remove_dist_comaint", \%form);
+ my @dists = map {$_->all_text} $t->dom->find('td.dist')->each;
+ my @results = map {$_->all_text} $t->dom->find('.result')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_set(\@dists, [qw/
+ /]) or note explain \@dists;
+ eq_or_diff(\@results, [
+ 'Removed TESTUSER2 from co-maintainers of Module::Admin::Bar (Module-Admin).',
+ 'Removed TESTUSER2 from co-maintainers of Module::Admin::Foo (Module-Admin).',
+ ]);
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_set(\@dists, [qw/
+ Module-User
+ /]) or note explain \@dists;
+ eq_or_diff(\@results, [
+ 'Removed TESTUSER2 from co-maintainers of Module::User::Bar (Module-User).',
+ 'Removed TESTUSER2 from co-maintainers of Module::User::Foo (Module-User).',
+ ]);
+ }
+ # note $t->content;
+ }
+};
+
+subtest 'broken tuple (not an owner)' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+
+ my %form = (
+ %$default,
+ pause99_remove_dist_comaint_tuples => ['Module-Unrelated -- TESTUSER2'],
+ );
+
+ Test::PAUSE::Web->reset_module_fixture;
+ $t->post_ok("$path?ACTION=remove_dist_comaint", \%form);
+ my @dists = map {$_->all_text} $t->dom->find('td.dist')->each;
+ my @results = map {$_->all_text} $t->dom->find('.result')->each;
+ my @errors = map {$_->all_text} $t->dom->find('.error')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_set(\@dists, [qw/
+ Module-Admin
+ /]) or note explain \@dists;
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_set(\@dists, [qw/
+ Module-User
+ /]) or note explain \@dists;
+ }
+ ok !@results;
+ eq_or_diff(\@errors, [
+ 'You do not seem to be owner of Module-Unrelated.',
+ ]);
+ # note $t->content;
+ }
+};
+
+subtest 'broken tuple (not a comaint)' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+
+ my @tuples;
+ if ($user eq 'TESTADMIN') {
+ @tuples = (
+ 'Module-Admin -- TESTUSER4',
+ );
+ }
+ if ($user eq 'TESTUSER') {
+ @tuples = (
+ 'Module-User -- TESTUSER4',
+ );
+
+ }
+
+ my %form = (
+ %$default,
+ pause99_remove_dist_comaint_tuples => \@tuples,
+ );
+
+ Test::PAUSE::Web->reset_module_fixture;
+ $t->post_ok("$path?ACTION=remove_dist_comaint", \%form);
+ my @dists = map {$_->all_text} $t->dom->find('td.dist')->each;
+ my @results = map {$_->all_text} $t->dom->find('.result')->each;
+ my @errors = map {$_->all_text} $t->dom->find('.error')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_set(\@dists, [qw/
+ Module-Admin
+ /]) or note explain \@dists;
+ eq_or_diff(\@errors, [
+ 'Cannot handle tuple Module-Admin -- TESTUSER4. If you believe, this is a bug, please complain.',
+ ]);
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_set(\@dists, [qw/
+ Module-User
+ /]) or note explain \@dists;
+ eq_or_diff(\@errors, [
+ 'Cannot handle tuple Module-User -- TESTUSER4. If you believe, this is a bug, please complain.',
+ ]);
+ }
+ ok !@results;
+ # note $t->content;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2017/remove_dist_primary.t b/t/pause_2025/action_2017/remove_dist_primary.t
new file mode 100644
index 000000000..06d7c3342
--- /dev/null
+++ b/t/pause_2025/action_2017/remove_dist_primary.t
@@ -0,0 +1,134 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+use Test::Deep;
+use Test::Differences;
+
+my $default = {
+ pause99_remove_dist_primary_d => [],
+ SUBMIT_pause99_remove_dist_primary => 1,
+};
+
+Test::PAUSE::Web->setup;
+Test::PAUSE::Web->reset_module_fixture;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+
+ my $t = Test::PAUSE::Web->new(user => $user);
+ $t->get_ok("$path?ACTION=remove_dist_primary");
+ my @dists = map {$_->all_text} $t->dom->find('td.dist')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_bag(\@dists, [qw/
+ Module-Admin
+ /]) or note explain \@dists;
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_bag(\@dists, [qw/
+ Module-User
+ Module-User-Foo-Baz
+ /]) or note explain \@dists;
+ }
+ # note $t->content;
+ }
+};
+
+subtest 'normal case' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+
+ my @dists;
+ if ($user eq 'TESTADMIN') {
+ @dists = qw/Module-Admin/;
+ }
+ if ($user eq 'TESTUSER') {
+ @dists = qw/Module-User/;
+ }
+
+ my %form = (
+ %$default,
+ pause99_remove_dist_primary_d => \@dists,
+ );
+
+ Test::PAUSE::Web->reset_module_fixture;
+ $t->post_ok("$path?ACTION=remove_dist_primary", \%form);
+ @dists = map {$_->all_text} $t->dom->find('td.dist')->each;
+ my @results = map {$_->all_text} $t->dom->find('.result')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_bag(\@dists, [qw/
+ /]) or note explain \@dists;
+ eq_or_diff(\@results, [
+ 'Removed primary maintainership of TESTADMIN from Module::Admin::Bar (Module-Admin).',
+ 'Removed primary maintainership of TESTADMIN from Module::Admin::Foo (Module-Admin).',
+ ]);
+
+ # really transferred to ADOPTME?
+ $t->get_ok("$path?ACTION=peek_dist_perms", {
+ pause99_peek_dist_perms_query => "ADOPTME",
+ pause99_peek_dist_perms_by => "a",
+ pause99_peek_dist_perms_sub => 1,
+ });
+ my @adoptme_dists = map {$_->all_text} $t->dom->find('td.dist')->each;
+ cmp_set(\@adoptme_dists, [qw/Module-Admin/]) or note explain \@adoptme_dists;
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_bag(\@dists, [qw/
+ Module-User-Foo-Baz
+ /]) or note explain \@dists;
+ eq_or_diff(\@results, [
+ 'Removed primary maintainership of TESTUSER from Module::User::Bar (Module-User).',
+ 'Removed primary maintainership of TESTUSER from Module::User::Foo (Module-User).',
+ ]);
+
+ # really transferred to ADOPTME?
+ $t->get_ok("$path?ACTION=peek_dist_perms", {
+ pause99_peek_dist_perms_query => "ADOPTME",
+ pause99_peek_dist_perms_by => "a",
+ pause99_peek_dist_perms_sub => 1,
+ });
+ my @adoptme_dists = map {$_->all_text} $t->dom->find('td.dist')->each;
+ cmp_set(\@adoptme_dists, [qw/Module-User/]) or note explain \@adoptme_dists;
+ }
+ # note $t->content;
+ }
+};
+
+subtest 'unrelated dists' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+
+ my %form = (
+ %$default,
+ pause99_remove_dist_primary_d => [qw/Module-Unrelated/],
+ );
+
+ Test::PAUSE::Web->reset_module_fixture;
+ $t->post_ok("$path?ACTION=remove_dist_primary", \%form);
+ my @dists = map {$_->all_text} $t->dom->find('td.dist')->each;
+ my @results = map {$_->all_text} $t->dom->find('.result')->each;
+ my @warnings = map {$_->all_text} $t->dom->find('.warning')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_bag(\@dists, [qw/
+ Module-Admin
+ /]) or note explain \@dists;
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_bag(\@dists, [qw/
+ Module-User
+ Module-User-Foo-Baz
+ /]) or note explain \@dists;
+ }
+ ok !@results;
+ eq_or_diff(\@warnings, [
+ 'You need to select one or more distributions. Nothing done.',
+ ]);
+ # note $t->content;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2017/remove_primary.t b/t/pause_2025/action_2017/remove_primary.t
new file mode 100644
index 000000000..e6f82d58d
--- /dev/null
+++ b/t/pause_2025/action_2017/remove_primary.t
@@ -0,0 +1,138 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+use Test::Deep;
+use Test::Differences;
+
+my $default = {
+ pause99_share_perms_pr_m => [],
+ SUBMIT_pause99_share_perms_remopr => 1,
+};
+
+Test::PAUSE::Web->setup;
+Test::PAUSE::Web->reset_module_fixture;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+
+ my $t = Test::PAUSE::Web->new(user => $user);
+ $t->get_ok("$path?ACTION=remove_primary");
+ my @modules = map {$_->all_text} $t->dom->find('td.package')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_bag(\@modules, [qw/
+ Module::Admin::Bar
+ Module::Admin::Foo
+ /]) or note explain \@modules;
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_bag(\@modules, [qw/
+ Module::User::Bar
+ Module::User::Foo
+ Module::User::Foo::Baz
+ /]) or note explain \@modules;
+ }
+ # note $t->content;
+ }
+};
+
+subtest 'normal case' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+
+ my @packages;
+ if ($user eq 'TESTADMIN') {
+ @packages = qw/Module::Admin::Bar/;
+ }
+ if ($user eq 'TESTUSER') {
+ @packages = qw/Module::User::Bar/;
+ }
+
+ my %form = (
+ %$default,
+ pause99_share_perms_pr_m => \@packages,
+ );
+
+ Test::PAUSE::Web->reset_module_fixture;
+ $t->post_ok("$path?ACTION=remove_primary", \%form);
+ my @modules = map {$_->all_text} $t->dom->find('td.package')->each;
+ my @results = map {$_->all_text} $t->dom->find('.result')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_bag(\@modules, [qw/
+ Module::Admin::Foo
+ /]) or note explain \@modules;
+ eq_or_diff(\@results, [
+ 'Removed primary maintainership of TESTADMIN from Module::Admin::Bar.',
+ ]);
+
+ # really transferred to ADOPTME?
+ $t->get_ok("$path?ACTION=peek_perms", {
+ pause99_peek_perms_query => "ADOPTME",
+ pause99_peek_perms_by => "a",
+ pause99_peek_perms_sub => 1,
+ });
+ my @adoptme_modules = map {$_->all_text} $t->dom->find('td.module')->each;
+ cmp_set(\@adoptme_modules, [qw/Module::Admin::Bar/]) or note explain \@adoptme_modules;
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_bag(\@modules, [qw/
+ Module::User::Foo
+ Module::User::Foo::Baz
+ /]) or note explain \@modules;
+ eq_or_diff(\@results, [
+ 'Removed primary maintainership of TESTUSER from Module::User::Bar.',
+ ]);
+
+ # really transferred to ADOPTME?
+ $t->get_ok("$path?ACTION=peek_perms", {
+ pause99_peek_perms_query => "ADOPTME",
+ pause99_peek_perms_by => "a",
+ pause99_peek_perms_sub => 1,
+ });
+ my @adoptme_modules = map {$_->all_text} $t->dom->find('td.module')->each;
+ cmp_set(\@adoptme_modules, [qw/Module::User::Bar/]) or note explain \@adoptme_modules;
+ }
+ # note $t->content;
+ }
+};
+
+subtest 'unrelated modules' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+
+ my %form = (
+ %$default,
+ pause99_share_perms_pr_m => [qw/Module::Unrelated/],
+ );
+
+ Test::PAUSE::Web->reset_module_fixture;
+ $t->post_ok("$path?ACTION=remove_primary", \%form);
+ my @modules = map {$_->all_text} $t->dom->find('td.package')->each;
+ my @results = map {$_->all_text} $t->dom->find('.result')->each;
+ my @warnings = map {$_->all_text} $t->dom->find('.warning')->each;
+ if ($user eq 'TESTADMIN') {
+ cmp_bag(\@modules, [qw/
+ Module::Admin::Bar
+ Module::Admin::Foo
+ /]) or note explain \@modules;
+ }
+ if ($user eq 'TESTUSER') {
+ cmp_bag(\@modules, [qw/
+ Module::User::Bar
+ Module::User::Foo
+ Module::User::Foo::Baz
+ /]) or note explain \@modules;
+ }
+ ok !@results;
+ eq_or_diff(\@warnings, [
+ 'You need to select one or more packages. Nothing done.',
+ ]);
+ # note $t->content;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2017/request_id.t b/t/pause_2025/action_2017/request_id.t
new file mode 100644
index 000000000..8936d08bb
--- /dev/null
+++ b/t/pause_2025/action_2017/request_id.t
@@ -0,0 +1,273 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+
+my $default = {
+ pause99_request_id_fullname => 'full name',
+ pause99_request_id_email => 'test@localhost.localdomain',
+ pause99_request_id_homepage => 'none',
+ pause99_request_id_userid => 'NEWUSER',
+ pause99_request_id_rationale => 'Hello, my ratoinale is to test PAUSE',
+ SUBMIT_pause99_request_id_sub => 1,
+};
+
+Test::PAUSE::Web->setup;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ $t->get_ok("$path?ACTION=request_id");
+ # note $t->content;
+ }
+};
+
+subtest 'post: basic' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ my %form = %$default;
+ $t->post_ok("$path?ACTION=request_id", \%form)
+ ->text_like("pre.email_sent", qr/Subject: PAUSE ID request \(NEWUSER/);
+ is $t->deliveries => 2, "two deliveries (one for admin, one for requester)";
+ # note $t->content;
+ }
+};
+
+subtest 'post: thank you, bot' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ my %form = (
+ %$default,
+ url => 'http://host/path',
+ );
+ $t->post_ok("$path?ACTION=request_id", \%form);
+ is $t->content => "Thank you!";
+ ok !$t->deliveries, "no deliveries";
+ # note $t->content;
+ }
+};
+
+subtest 'post: no space in full name' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ my %form = (
+ %$default,
+ pause99_request_id_fullname => 'FULLNAME',
+ );
+ $t->post_ok("$path?ACTION=request_id", \%form)
+ ->text_is("h3", "Error processing form")
+ ->text_like("ul.errors li", qr/Name does not look like a full civil name/);
+ ok !$t->deliveries, "no deliveries";
+ # note $t->content;
+ }
+};
+
+subtest 'post: no full name' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ my %form = (
+ %$default,
+ pause99_request_id_fullname => '',
+ );
+ $t->post_ok("$path?ACTION=request_id", \%form)
+ ->text_is("h3", "Error processing form")
+ ->text_like("ul.errors li", qr/You must supply a name/);
+ ok !$t->deliveries, "no deliveries";
+ # note $t->content;
+ }
+};
+
+subtest 'post: no email' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ my %form = (
+ %$default,
+ pause99_request_id_email => '',
+ );
+ $t->post_ok("$path?ACTION=request_id", \%form)
+ ->text_is("h3", "Error processing form")
+ ->text_like("ul.errors li", qr/You must supply an email address/);
+ ok !$t->deliveries, "no deliveries";
+ # note $t->content;
+ }
+};
+
+subtest 'post: invalid email' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ my %form = (
+ %$default,
+ pause99_request_id_email => 'no email',
+ );
+ $t->post_ok("$path?ACTION=request_id", \%form)
+ ->text_is("h3", "Error processing form")
+ ->text_like("ul.errors li", qr/Your email address doesn't look like valid email address./);
+ ok !$t->deliveries, "no deliveries";
+ # note $t->content;
+ }
+};
+
+subtest 'post: rational is too short' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ my %form = (
+ %$default,
+ pause99_request_id_rationale => 'rationale',
+ );
+ $t->post_ok("$path?ACTION=request_id", \%form)
+ ->text_is("h3", "Error processing form")
+ ->text_like("ul.errors li", qr/this looks a\s+bit too short/);
+ ok !$t->deliveries, "no deliveries";
+ # note $t->content;
+ }
+};
+
+# XXX: might be better to ignore other attributes (or YAGNI)
+subtest 'post: rational has html links' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ my %form = (
+ %$default,
+ pause99_request_id_rationale => '',
+ );
+ $t->post_ok("$path?ACTION=request_id", \%form)
+ ->text_is("h3", "Error processing form")
+ ->text_like("ul.errors li", qr/Please do not use HTML links/);
+ ok !$t->deliveries, "no deliveries";
+ # note $t->content;
+ }
+};
+
+subtest 'post: multiple links' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ my %form = (
+ %$default,
+ pause99_request_id_rationale => <<'SPAM',
+http://spam/path
+http://spam/path
+SPAM
+ );
+ $t->post_ok("$path?ACTION=request_id", \%form)
+ ->text_is("h3", "Error processing form")
+ ->text_like("ul.errors li", qr/Please do not include more than one URL/);
+ ok !$t->deliveries, "no deliveries";
+ # note $t->content;
+ }
+};
+
+subtest 'post: no rationale' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ my %form = (
+ %$default,
+ pause99_request_id_rationale => '',
+ );
+ $t->post_ok("$path?ACTION=request_id", \%form)
+ ->text_is("h3", "Error processing form")
+ ->text_like("ul.errors li", qr/You must supply a short description/);
+ ok !$t->deliveries, "no deliveries";
+ # note $t->content;
+ }
+};
+
+subtest 'post: userid is taken' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ my %form = (
+ %$default,
+ pause99_request_id_userid => 'TESTUSER',
+ );
+ $t->post_ok("$path?ACTION=request_id", \%form)
+ ->text_is("h3", "Error processing form")
+ ->text_like("ul.errors li", qr/The userid TESTUSER is already taken/);
+ ok !$t->deliveries, "no deliveries";
+ # note $t->content;
+ }
+};
+
+subtest 'post: invalid userid' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ my %form = (
+ %$default,
+ pause99_request_id_userid => 'INV#LID',
+ );
+ $t->post_ok("$path?ACTION=request_id", \%form)
+ ->text_is("h3", "Error processing form")
+ ->text_like("ul.errors li", qr/The userid INV#LID does not match/);
+ ok !$t->deliveries, "no deliveries";
+ # note $t->content;
+ }
+};
+
+subtest 'post: no userid' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ my %form = (
+ %$default,
+ pause99_request_id_userid => '',
+ );
+ $t->post_ok("$path?ACTION=request_id", \%form)
+ ->text_is("h3", "Error processing form")
+ ->text_like("ul.errors li", qr/You must supply a desired user-ID/);
+ ok !$t->deliveries, "no deliveries";
+ # note $t->content;
+ }
+};
+
+subtest 'post: lots of .info' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ my %form = (
+ %$default,
+ pause99_request_id_rationale => <<'SPAM',
+ttp://spam.info
+ttp://spam.info
+ttp://spam.info
+ttp://spam.info
+ttp://spam.info
+SPAM
+ );
+ $t->post_ok("$path?ACTION=request_id", \%form)
+ ->text_is("h2", "Error")
+ ->text_like("p.error_message", qr/rationale looks like spam/);
+ ok !$t->deliveries, "no deliveries";
+ # note $t->content;
+ }
+};
+
+subtest 'post: interesting .cn homepage' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('public')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ my %form = (
+ %$default,
+ pause99_request_id_homepage => 'http://some.cn/index.htm',
+ pause99_request_id_rationale => 'interesting site',
+ );
+ $t->post_ok("$path?ACTION=request_id", \%form)
+ ->text_is("h2", "Error")
+ ->text_like("p.error_message", qr/rationale looks like spam/);
+ ok !$t->deliveries, "no deliveries";
+ # note $t->content;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2017/reset_version.t b/t/pause_2025/action_2017/reset_version.t
new file mode 100644
index 000000000..45c37dc89
--- /dev/null
+++ b/t/pause_2025/action_2017/reset_version.t
@@ -0,0 +1,48 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+
+my $default = {
+ pause99_reset_version_PKG => ["Foo"],
+ SUBMIT_pause99_reset_version_forget => 1,
+};
+
+Test::PAUSE::Web->setup;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ $t->get_ok("$path?ACTION=reset_version");
+ # note $t->content;
+ }
+};
+
+subtest 'post: basic' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+
+ $t->mod_dbh->do("TRUNCATE packages");
+ $t->mod_db->insert('packages', {
+ package => "Foo",
+ version => "0.01",
+ dist => "T/TE/$user/Foo-0.01.tar.gz",
+ file => "Foo-0.01.tar.gz",
+ });
+ $t->mod_db->insert('packages', {
+ package => "Bar",
+ version => "0.02",
+ dist => "T/TE/$user/Bar-0.02.tar.gz",
+ file => "Bar-0.02.tar.gz",
+ });
+
+ my %form = %$default;
+ $t->post_ok("$path?ACTION=reset_version", \%form);
+ # note $t->content;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2017/select_ml_action.t b/t/pause_2025/action_2017/select_ml_action.t
new file mode 100644
index 000000000..75bda972b
--- /dev/null
+++ b/t/pause_2025/action_2017/select_ml_action.t
@@ -0,0 +1,49 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+
+my $mailing_list = {
+ SUBMIT_pause99_add_user_Definitely => 1,
+ pause99_add_user_userid => "MAILLIST",
+ pause99_add_user_email => "ml\@localhost.localdomain",
+ pause99_add_user_subscribe => "how to subscribe",
+};
+
+my $default = {
+ HIDDENNAME => "TESTUSER",
+ ACTIONREQ => "edit_ml",
+ pause99_select_ml_action_sub => 1,
+};
+
+Test::PAUSE::Web->setup;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('admin')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ $t->get_ok("$path?ACTION=select_ml_action");
+ # note $t->content;
+ }
+};
+
+subtest 'post: basic' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('admin')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+
+ $t->post_ok("$path?ACTION=add_user", $mailing_list);
+
+ $t->mod_db->insert("list2user", {
+ maillistid => "MAILLIST",
+ userid => "TESTUSER",
+ }, {ignore => 1});
+
+ my %form = %$default;
+ $t->post_ok("$path?ACTION=select_ml_action", \%form);
+ # note $t->content;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2017/select_user.t b/t/pause_2025/action_2017/select_user.t
new file mode 100644
index 000000000..3d6ac280e
--- /dev/null
+++ b/t/pause_2025/action_2017/select_user.t
@@ -0,0 +1,18 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+
+Test::PAUSE::Web->setup;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('admin')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ $t->get_ok("$path?ACTION=select_user");
+ # note $t->content;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2017/share_perms.t b/t/pause_2025/action_2017/share_perms.t
new file mode 100644
index 000000000..76c4be7bf
--- /dev/null
+++ b/t/pause_2025/action_2017/share_perms.t
@@ -0,0 +1,18 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+
+Test::PAUSE::Web->setup;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ $t->get_ok("$path?ACTION=share_perms");
+ # note $t->content;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2017/show_files.t b/t/pause_2025/action_2017/show_files.t
new file mode 100644
index 000000000..9c6b61797
--- /dev/null
+++ b/t/pause_2025/action_2017/show_files.t
@@ -0,0 +1,18 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+
+Test::PAUSE::Web->setup;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('user')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ $t->get_ok("$path?ACTION=show_files");
+ # note $t->content;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2017/show_ml_repr.t b/t/pause_2025/action_2017/show_ml_repr.t
new file mode 100644
index 000000000..2fc8bce41
--- /dev/null
+++ b/t/pause_2025/action_2017/show_ml_repr.t
@@ -0,0 +1,18 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+
+Test::PAUSE::Web->setup;
+
+subtest 'get' => sub {
+ for my $test (Test::PAUSE::Web->tests_for('admin')) {
+ my ($path, $user) = @$test;
+ my $t = Test::PAUSE::Web->new(user => $user);
+ $t->get_ok("$path?ACTION=show_ml_repr");
+ # note $t->content;
+ }
+};
+
+done_testing;
diff --git a/t/pause_2025/action_2017/tail_logfile.t b/t/pause_2025/action_2017/tail_logfile.t
new file mode 100644
index 000000000..49bb91888
--- /dev/null
+++ b/t/pause_2025/action_2017/tail_logfile.t
@@ -0,0 +1,43 @@
+use Mojo::Base -strict;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Test::PAUSE::Web;
+use utf8;
+
+my $default = {
+ pause99_tail_logfile_1 => 5000,
+ pause99_tail_logfile_sub => 1,
+};
+
+Test::PAUSE::Web->setup;
+
+{
+ open my $fh, '>', $PAUSE::Config->{PAUSE_LOG};
+ say $fh <If you want me to fetch a file from an URL, enter the full URL here.
+
+
<%= text_field "pause99_add_uri_uri",
+ size => 64,
+ maxlength => 255,
+%>
+