From 3c023d5274e119b73ad1e19bd79ce7602085e9a8 Mon Sep 17 00:00:00 2001 From: Glenn Rice Date: Mon, 18 Jul 2022 07:40:10 -0500 Subject: [PATCH 001/490] Reset the version and git branch names in the code for the develop branch. --- VERSION | 2 +- docker-config/docker-compose.yml.dist | 8 ++++---- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/VERSION b/VERSION index 53be6dc71a..ab17467062 100644 --- a/VERSION +++ b/VERSION @@ -1,4 +1,4 @@ -$WW_VERSION = '2.17'; +$WW_VERSION = '2.17+develop'; $WW_COPYRIGHT_YEARS = '1996-2022'; 1; diff --git a/docker-config/docker-compose.yml.dist b/docker-config/docker-compose.yml.dist index 80c191b161..939a38f771 100644 --- a/docker-config/docker-compose.yml.dist +++ b/docker-config/docker-compose.yml.dist @@ -87,13 +87,13 @@ services: # should be commented out. # main branches: - - WEBWORK2_BRANCH=main - - PG_BRANCH=main + #- WEBWORK2_BRANCH=main + #- PG_BRANCH=main # WeBWorK/PG develop branches # (other valid branches can also be used in a similar manner) - #- WEBWORK2_BRANCH=develop - #- PG_BRANCH=develop + - WEBWORK2_BRANCH=develop + - PG_BRANCH=develop # If you would like a 1 stage build process comment out the next line, and just run "docker-compose build". dockerfile: DockerfileStage2 From 5cae46749c74d6a4bc32b9e9e43c6cf6abbed51e Mon Sep 17 00:00:00 2001 From: Glenn Rice Date: Tue, 19 Jul 2022 15:32:56 -0500 Subject: [PATCH 002/490] Add the package-lock.json file back. It seems that bootstrap version 5.2.0 was recently released and is not entirely compatible with version 5.1.3. This causes the bootstrap.scss file to fail to compile. This adds a package-lock.json file from before the version update occured to lock us in to 5.1.3. Another way to fix this is to import the `node_modules/bootstrap/scss/maps` file in our bootstrap.scss file. However, that may only be a temporary fix as bootstrap may update again and change something else that breaks our build. Now that we are also insisting on everyone using node 16 this should not cause the problem that we had before. --- .gitignore | 1 - htdocs/package-lock.json | 2836 ++++++++++++++++++++++++++++++++++++++ htdocs/package.json | 2 +- 3 files changed, 2837 insertions(+), 2 deletions(-) create mode 100644 htdocs/package-lock.json diff --git a/.gitignore b/.gitignore index 6ee0109c61..3d5239531f 100644 --- a/.gitignore +++ b/.gitignore @@ -25,7 +25,6 @@ htdocs/themes/*/images/* !htdocs/themes/*/images/webwork_logo.svg !htdocs/themes/math4/images/webwork_square.svg htdocs/themes/*/*.css -htdocs/package-lock.json htdocs/themes/* !htdocs/themes/math4 !htdocs/themes/math4-red diff --git a/htdocs/package-lock.json b/htdocs/package-lock.json new file mode 100644 index 0000000000..1f817efa1f --- /dev/null +++ b/htdocs/package-lock.json @@ -0,0 +1,2836 @@ +{ + "name": "webwork.javascript_package_manager", + "lockfileVersion": 2, + "requires": true, + "packages": { + "": { + "name": "webwork.javascript_package_manager", + "license": "GPL-2.0+", + "dependencies": { + "@fortawesome/fontawesome-free": "^6.0.0", + "bootstrap": "~5.1.3", + "codemirror": "^5.65.2", + "flatpickr": "^4.6.9", + "iframe-resizer": "^4.3.2", + "jquery": "^3.6.0", + "jquery-ui-dist": "^1.13.1", + "luxon": "^2.3.1", + "mathjax": "^3.2.0", + "sortablejs": "^1.14.0" + }, + "devDependencies": { + "autoprefixer": "^10.4.1", + "chokidar": "^3.5.3", + "cssnano": "^5.1.4", + "postcss": "^8.4.5", + "rtlcss": "^3.5.0", + "sass": "^1.45.2", + "terser": "^5.10.0", + "yargs": "^16.2.0" + } + }, + "node_modules/@fortawesome/fontawesome-free": { + "version": "6.1.1", + "resolved": "https://registry.npmjs.org/@fortawesome/fontawesome-free/-/fontawesome-free-6.1.1.tgz", + "integrity": "sha512-J/3yg2AIXc9wznaVqpHVX3Wa5jwKovVF0AMYSnbmcXTiL3PpRPfF58pzWucCwEiCJBp+hCNRLWClTomD8SseKg==", + "hasInstallScript": true, + "engines": { + "node": ">=6" + } + }, + "node_modules/@jridgewell/gen-mapping": { + "version": "0.3.2", + "resolved": "https://registry.npmjs.org/@jridgewell/gen-mapping/-/gen-mapping-0.3.2.tgz", + "integrity": "sha512-mh65xKQAzI6iBcFzwv28KVWSmCkdRBWoOh+bYQGW3+6OZvbbN3TqMGo5hqYxQniRcH9F2VZIoJCm4pa3BPDK/A==", + "dev": true, + "dependencies": { + "@jridgewell/set-array": "^1.0.1", + "@jridgewell/sourcemap-codec": "^1.4.10", + "@jridgewell/trace-mapping": "^0.3.9" + }, + "engines": { + "node": ">=6.0.0" + } + }, + "node_modules/@jridgewell/resolve-uri": { + "version": "3.1.0", + "resolved": "https://registry.npmjs.org/@jridgewell/resolve-uri/-/resolve-uri-3.1.0.tgz", + "integrity": "sha512-F2msla3tad+Mfht5cJq7LSXcdudKTWCVYUgw6pLFOOHSTtZlj6SWNYAp+AhuqLmWdBO2X5hPrLcu8cVP8fy28w==", + "dev": true, + "engines": { + "node": ">=6.0.0" + } + }, + "node_modules/@jridgewell/set-array": { + "version": "1.1.2", + "resolved": "https://registry.npmjs.org/@jridgewell/set-array/-/set-array-1.1.2.tgz", + "integrity": "sha512-xnkseuNADM0gt2bs+BvhO0p78Mk762YnZdsuzFV018NoG1Sj1SCQvpSqa7XUaTam5vAGasABV9qXASMKnFMwMw==", + "dev": true, + "engines": { + "node": ">=6.0.0" + } + }, + "node_modules/@jridgewell/source-map": { + "version": "0.3.2", + "resolved": "https://registry.npmjs.org/@jridgewell/source-map/-/source-map-0.3.2.tgz", + "integrity": "sha512-m7O9o2uR8k2ObDysZYzdfhb08VuEml5oWGiosa1VdaPZ/A6QyPkAJuwN0Q1lhULOf6B7MtQmHENS743hWtCrgw==", + "dev": true, + "dependencies": { + "@jridgewell/gen-mapping": "^0.3.0", + "@jridgewell/trace-mapping": "^0.3.9" + } + }, + "node_modules/@jridgewell/sourcemap-codec": { + "version": "1.4.14", + "resolved": "https://registry.npmjs.org/@jridgewell/sourcemap-codec/-/sourcemap-codec-1.4.14.tgz", + "integrity": "sha512-XPSJHWmi394fuUuzDnGz1wiKqWfo1yXecHQMRf2l6hztTO+nPru658AyDngaBe7isIxEkRsPR3FZh+s7iVa4Uw==", + "dev": true + }, + "node_modules/@jridgewell/trace-mapping": { + "version": "0.3.14", + "resolved": "https://registry.npmjs.org/@jridgewell/trace-mapping/-/trace-mapping-0.3.14.tgz", + "integrity": "sha512-bJWEfQ9lPTvm3SneWwRFVLzrh6nhjwqw7TUFFBEMzwvg7t7PCDenf2lDwqo4NQXzdpgBXyFgDWnQA+2vkruksQ==", + "dev": true, + "dependencies": { + "@jridgewell/resolve-uri": "^3.0.3", + "@jridgewell/sourcemap-codec": "^1.4.10" + } + }, + "node_modules/@popperjs/core": { + "version": "2.11.5", + "resolved": "https://registry.npmjs.org/@popperjs/core/-/core-2.11.5.tgz", + "integrity": "sha512-9X2obfABZuDVLCgPK9aX0a/x4jaOEweTTWE2+9sr0Qqqevj2Uv5XorvusThmc9XGYpS9yI+fhh8RTafBtGposw==", + "peer": true, + "funding": { + "type": "opencollective", + "url": "https://opencollective.com/popperjs" + } + }, + "node_modules/@trysound/sax": { + "version": "0.2.0", + "resolved": "https://registry.npmjs.org/@trysound/sax/-/sax-0.2.0.tgz", + "integrity": "sha512-L7z9BgrNEcYyUYtF+HaEfiS5ebkh9jXqbszz7pC0hRBPaatV0XjSD3+eHrpqFemQfgwiFF0QPIarnIihIDn7OA==", + "dev": true, + "engines": { + "node": ">=10.13.0" + } + }, + "node_modules/acorn": { + "version": "8.7.1", + "resolved": "https://registry.npmjs.org/acorn/-/acorn-8.7.1.tgz", + "integrity": "sha512-Xx54uLJQZ19lKygFXOWsscKUbsBZW0CPykPhVQdhIeIwrbPmJzqeASDInc8nKBnp/JT6igTs82qPXz069H8I/A==", + "dev": true, + "bin": { + "acorn": "bin/acorn" + }, + "engines": { + "node": ">=0.4.0" + } + }, + "node_modules/ansi-regex": { + "version": "5.0.1", + "resolved": "https://registry.npmjs.org/ansi-regex/-/ansi-regex-5.0.1.tgz", + "integrity": "sha512-quJQXlTSUGL2LH9SUXo8VwsY4soanhgo6LNSm84E1LBcE8s3O0wpdiRzyR9z/ZZJMlMWv37qOOb9pdJlMUEKFQ==", + "dev": true, + "engines": { + "node": ">=8" + } + }, + "node_modules/ansi-styles": { + "version": "4.3.0", + "resolved": "https://registry.npmjs.org/ansi-styles/-/ansi-styles-4.3.0.tgz", + "integrity": "sha512-zbB9rCJAT1rbjiVDb2hqKFHNYLxgtk8NURxZ3IZwD3F6NtxbXZQCnnSi1Lkx+IDohdPlFp222wVALIheZJQSEg==", + "dev": true, + "dependencies": { + "color-convert": "^2.0.1" + }, + "engines": { + "node": ">=8" + }, + "funding": { + "url": "https://github.com/chalk/ansi-styles?sponsor=1" + } + }, + "node_modules/anymatch": { + "version": "3.1.2", + "resolved": "https://registry.npmjs.org/anymatch/-/anymatch-3.1.2.tgz", + "integrity": "sha512-P43ePfOAIupkguHUycrc4qJ9kz8ZiuOUijaETwX7THt0Y/GNK7v0aa8rY816xWjZ7rJdA5XdMcpVFTKMq+RvWg==", + "dev": true, + "dependencies": { + "normalize-path": "^3.0.0", + "picomatch": "^2.0.4" + }, + "engines": { + "node": ">= 8" + } + }, + "node_modules/autoprefixer": { + "version": "10.4.7", + "resolved": "https://registry.npmjs.org/autoprefixer/-/autoprefixer-10.4.7.tgz", + "integrity": "sha512-ypHju4Y2Oav95SipEcCcI5J7CGPuvz8oat7sUtYj3ClK44bldfvtvcxK6IEK++7rqB7YchDGzweZIBG+SD0ZAA==", + "dev": true, + "funding": [ + { + "type": "opencollective", + "url": "https://opencollective.com/postcss/" + }, + { + "type": "tidelift", + "url": "https://tidelift.com/funding/github/npm/autoprefixer" + } + ], + "dependencies": { + "browserslist": "^4.20.3", + "caniuse-lite": "^1.0.30001335", + "fraction.js": "^4.2.0", + "normalize-range": "^0.1.2", + "picocolors": "^1.0.0", + "postcss-value-parser": "^4.2.0" + }, + "bin": { + "autoprefixer": "bin/autoprefixer" + }, + "engines": { + "node": "^10 || ^12 || >=14" + }, + "peerDependencies": { + "postcss": "^8.1.0" + } + }, + "node_modules/binary-extensions": { + "version": "2.2.0", + "resolved": "https://registry.npmjs.org/binary-extensions/-/binary-extensions-2.2.0.tgz", + "integrity": "sha512-jDctJ/IVQbZoJykoeHbhXpOlNBqGNcwXJKJog42E5HDPUwQTSdjCHdihjj0DlnheQ7blbT6dHOafNAiS8ooQKA==", + "dev": true, + "engines": { + "node": ">=8" + } + }, + "node_modules/boolbase": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/boolbase/-/boolbase-1.0.0.tgz", + "integrity": "sha512-JZOSA7Mo9sNGB8+UjSgzdLtokWAky1zbztM3WRLCbZ70/3cTANmQmOdR7y2g+J0e2WXywy1yS468tY+IruqEww==", + "dev": true + }, + "node_modules/bootstrap": { + "version": "5.1.3", + "resolved": "https://registry.npmjs.org/bootstrap/-/bootstrap-5.1.3.tgz", + "integrity": "sha512-fcQztozJ8jToQWXxVuEyXWW+dSo8AiXWKwiSSrKWsRB/Qt+Ewwza+JWoLKiTuQLaEPhdNAJ7+Dosc9DOIqNy7Q==", + "funding": { + "type": "opencollective", + "url": "https://opencollective.com/bootstrap" + }, + "peerDependencies": { + "@popperjs/core": "^2.10.2" + } + }, + "node_modules/braces": { + "version": "3.0.2", + "resolved": "https://registry.npmjs.org/braces/-/braces-3.0.2.tgz", + "integrity": "sha512-b8um+L1RzM3WDSzvhm6gIz1yfTbBt6YTlcEKAvsmqCZZFw46z626lVj9j1yEPW33H5H+lBQpZMP1k8l+78Ha0A==", + "dev": true, + "dependencies": { + "fill-range": "^7.0.1" + }, + "engines": { + "node": ">=8" + } + }, + "node_modules/browserslist": { + "version": "4.21.2", + "resolved": "https://registry.npmjs.org/browserslist/-/browserslist-4.21.2.tgz", + "integrity": "sha512-MonuOgAtUB46uP5CezYbRaYKBNt2LxP0yX+Pmj4LkcDFGkn9Cbpi83d9sCjwQDErXsIJSzY5oKGDbgOlF/LPAA==", + "dev": true, + "funding": [ + { + "type": "opencollective", + "url": "https://opencollective.com/browserslist" + }, + { + "type": "tidelift", + "url": "https://tidelift.com/funding/github/npm/browserslist" + } + ], + "dependencies": { + "caniuse-lite": "^1.0.30001366", + "electron-to-chromium": "^1.4.188", + "node-releases": "^2.0.6", + "update-browserslist-db": "^1.0.4" + }, + "bin": { + "browserslist": "cli.js" + }, + "engines": { + "node": "^6 || ^7 || ^8 || ^9 || ^10 || ^11 || ^12 || >=13.7" + } + }, + "node_modules/buffer-from": { + "version": "1.1.2", + "resolved": "https://registry.npmjs.org/buffer-from/-/buffer-from-1.1.2.tgz", + "integrity": "sha512-E+XQCRwSbaaiChtv6k6Dwgc+bx+Bs6vuKJHHl5kox/BaKbhiXzqQOwK4cO22yElGp2OCmjwVhT3HmxgyPGnJfQ==", + "dev": true + }, + "node_modules/caniuse-api": { + "version": "3.0.0", + "resolved": "https://registry.npmjs.org/caniuse-api/-/caniuse-api-3.0.0.tgz", + "integrity": "sha512-bsTwuIg/BZZK/vreVTYYbSWoe2F+71P7K5QGEX+pT250DZbfU1MQ5prOKpPR+LL6uWKK3KMwMCAS74QB3Um1uw==", + "dev": true, + "dependencies": { + "browserslist": "^4.0.0", + "caniuse-lite": "^1.0.0", + "lodash.memoize": "^4.1.2", + "lodash.uniq": "^4.5.0" + } + }, + "node_modules/caniuse-lite": { + "version": "1.0.30001367", + "resolved": "https://registry.npmjs.org/caniuse-lite/-/caniuse-lite-1.0.30001367.tgz", + "integrity": "sha512-XDgbeOHfifWV3GEES2B8rtsrADx4Jf+juKX2SICJcaUhjYBO3bR96kvEIHa15VU6ohtOhBZuPGGYGbXMRn0NCw==", + "dev": true, + "funding": [ + { + "type": "opencollective", + "url": "https://opencollective.com/browserslist" + }, + { + "type": "tidelift", + "url": "https://tidelift.com/funding/github/npm/caniuse-lite" + } + ] + }, + "node_modules/chokidar": { + "version": "3.5.3", + "resolved": "https://registry.npmjs.org/chokidar/-/chokidar-3.5.3.tgz", + "integrity": "sha512-Dr3sfKRP6oTcjf2JmUmFJfeVMvXBdegxB0iVQ5eb2V10uFJUCAS8OByZdVAyVb8xXNz3GjjTgj9kLWsZTqE6kw==", + "dev": true, + "funding": [ + { + "type": "individual", + "url": "https://paulmillr.com/funding/" + } + ], + "dependencies": { + "anymatch": "~3.1.2", + "braces": "~3.0.2", + "glob-parent": "~5.1.2", + "is-binary-path": "~2.1.0", + "is-glob": "~4.0.1", + "normalize-path": "~3.0.0", + "readdirp": "~3.6.0" + }, + "engines": { + "node": ">= 8.10.0" + }, + "optionalDependencies": { + "fsevents": "~2.3.2" + } + }, + "node_modules/cliui": { + "version": "7.0.4", + "resolved": "https://registry.npmjs.org/cliui/-/cliui-7.0.4.tgz", + "integrity": "sha512-OcRE68cOsVMXp1Yvonl/fzkQOyjLSu/8bhPDfQt0e0/Eb283TKP20Fs2MqoPsr9SwA595rRCA+QMzYc9nBP+JQ==", + "dev": true, + "dependencies": { + "string-width": "^4.2.0", + "strip-ansi": "^6.0.0", + "wrap-ansi": "^7.0.0" + } + }, + "node_modules/codemirror": { + "version": "5.65.7", + "resolved": "https://registry.npmjs.org/codemirror/-/codemirror-5.65.7.tgz", + "integrity": "sha512-zb67cXzgugIQmb6tfD4G11ILjYoMfTjwcjn+cWsa4GewlI2adhR/h3kolkoCQTm1msD/1BuqVTKuO09ELsS++A==" + }, + "node_modules/color-convert": { + "version": "2.0.1", + "resolved": "https://registry.npmjs.org/color-convert/-/color-convert-2.0.1.tgz", + "integrity": "sha512-RRECPsj7iu/xb5oKYcsFHSppFNnsj/52OVTRKb4zP5onXwVF3zVmmToNcOfGC+CRDpfK/U584fMg38ZHCaElKQ==", + "dev": true, + "dependencies": { + "color-name": "~1.1.4" + }, + "engines": { + "node": ">=7.0.0" + } + }, + "node_modules/color-name": { + "version": "1.1.4", + "resolved": "https://registry.npmjs.org/color-name/-/color-name-1.1.4.tgz", + "integrity": "sha512-dOy+3AuW3a2wNbZHIuMZpTcgjGuLU/uBL/ubcZF9OXbDo8ff4O8yVp5Bf0efS8uEoYo5q4Fx7dY9OgQGXgAsQA==", + "dev": true + }, + "node_modules/colord": { + "version": "2.9.2", + "resolved": "https://registry.npmjs.org/colord/-/colord-2.9.2.tgz", + "integrity": "sha512-Uqbg+J445nc1TKn4FoDPS6ZZqAvEDnwrH42yo8B40JSOgSLxMZ/gt3h4nmCtPLQeXhjJJkqBx7SCY35WnIixaQ==", + "dev": true + }, + "node_modules/commander": { + "version": "7.2.0", + "resolved": "https://registry.npmjs.org/commander/-/commander-7.2.0.tgz", + "integrity": "sha512-QrWXB+ZQSVPmIWIhtEO9H+gwHaMGYiF5ChvoJ+K9ZGHG/sVsa6yiesAD1GC/x46sET00Xlwo1u49RVVVzvcSkw==", + "dev": true, + "engines": { + "node": ">= 10" + } + }, + "node_modules/css-declaration-sorter": { + "version": "6.3.0", + "resolved": "https://registry.npmjs.org/css-declaration-sorter/-/css-declaration-sorter-6.3.0.tgz", + "integrity": "sha512-OGT677UGHJTAVMRhPO+HJ4oKln3wkBTwtDFH0ojbqm+MJm6xuDMHp2nkhh/ThaBqq20IbraBQSWKfSLNHQO9Og==", + "dev": true, + "engines": { + "node": "^10 || ^12 || >=14" + }, + "peerDependencies": { + "postcss": "^8.0.9" + } + }, + "node_modules/css-select": { + "version": "4.3.0", + "resolved": "https://registry.npmjs.org/css-select/-/css-select-4.3.0.tgz", + "integrity": "sha512-wPpOYtnsVontu2mODhA19JrqWxNsfdatRKd64kmpRbQgh1KtItko5sTnEpPdpSaJszTOhEMlF/RPz28qj4HqhQ==", + "dev": true, + "dependencies": { + "boolbase": "^1.0.0", + "css-what": "^6.0.1", + "domhandler": "^4.3.1", + "domutils": "^2.8.0", + "nth-check": "^2.0.1" + }, + "funding": { + "url": "https://github.com/sponsors/fb55" + } + }, + "node_modules/css-tree": { + "version": "1.1.3", + "resolved": "https://registry.npmjs.org/css-tree/-/css-tree-1.1.3.tgz", + "integrity": "sha512-tRpdppF7TRazZrjJ6v3stzv93qxRcSsFmW6cX0Zm2NVKpxE1WV1HblnghVv9TreireHkqI/VDEsfolRF1p6y7Q==", + "dev": true, + "dependencies": { + "mdn-data": "2.0.14", + "source-map": "^0.6.1" + }, + "engines": { + "node": ">=8.0.0" + } + }, + "node_modules/css-what": { + "version": "6.1.0", + "resolved": "https://registry.npmjs.org/css-what/-/css-what-6.1.0.tgz", + "integrity": "sha512-HTUrgRJ7r4dsZKU6GjmpfRK1O76h97Z8MfS1G0FozR+oF2kG6Vfe8JE6zwrkbxigziPHinCJ+gCPjA9EaBDtRw==", + "dev": true, + "engines": { + "node": ">= 6" + }, + "funding": { + "url": "https://github.com/sponsors/fb55" + } + }, + "node_modules/cssesc": { + "version": "3.0.0", + "resolved": "https://registry.npmjs.org/cssesc/-/cssesc-3.0.0.tgz", + "integrity": "sha512-/Tb/JcjK111nNScGob5MNtsntNM1aCNUDipB/TkwZFhyDrrE47SOx/18wF2bbjgc3ZzCSKW1T5nt5EbFoAz/Vg==", + "dev": true, + "bin": { + "cssesc": "bin/cssesc" + }, + "engines": { + "node": ">=4" + } + }, + "node_modules/cssnano": { + "version": "5.1.12", + "resolved": "https://registry.npmjs.org/cssnano/-/cssnano-5.1.12.tgz", + "integrity": "sha512-TgvArbEZu0lk/dvg2ja+B7kYoD7BBCmn3+k58xD0qjrGHsFzXY/wKTo9M5egcUCabPol05e/PVoIu79s2JN4WQ==", + "dev": true, + "dependencies": { + "cssnano-preset-default": "^5.2.12", + "lilconfig": "^2.0.3", + "yaml": "^1.10.2" + }, + "engines": { + "node": "^10 || ^12 || >=14.0" + }, + "funding": { + "type": "opencollective", + "url": "https://opencollective.com/cssnano" + }, + "peerDependencies": { + "postcss": "^8.2.15" + } + }, + "node_modules/cssnano-preset-default": { + "version": "5.2.12", + "resolved": "https://registry.npmjs.org/cssnano-preset-default/-/cssnano-preset-default-5.2.12.tgz", + "integrity": "sha512-OyCBTZi+PXgylz9HAA5kHyoYhfGcYdwFmyaJzWnzxuGRtnMw/kR6ilW9XzlzlRAtB6PLT/r+prYgkef7hngFew==", + "dev": true, + "dependencies": { + "css-declaration-sorter": "^6.3.0", + "cssnano-utils": "^3.1.0", + "postcss-calc": "^8.2.3", + "postcss-colormin": "^5.3.0", + "postcss-convert-values": "^5.1.2", + "postcss-discard-comments": "^5.1.2", + "postcss-discard-duplicates": "^5.1.0", + "postcss-discard-empty": "^5.1.1", + "postcss-discard-overridden": "^5.1.0", + "postcss-merge-longhand": "^5.1.6", + "postcss-merge-rules": "^5.1.2", + "postcss-minify-font-values": "^5.1.0", + "postcss-minify-gradients": "^5.1.1", + "postcss-minify-params": "^5.1.3", + "postcss-minify-selectors": "^5.2.1", + "postcss-normalize-charset": "^5.1.0", + "postcss-normalize-display-values": "^5.1.0", + "postcss-normalize-positions": "^5.1.1", + "postcss-normalize-repeat-style": "^5.1.1", + "postcss-normalize-string": "^5.1.0", + "postcss-normalize-timing-functions": "^5.1.0", + "postcss-normalize-unicode": "^5.1.0", + "postcss-normalize-url": "^5.1.0", + "postcss-normalize-whitespace": "^5.1.1", + "postcss-ordered-values": "^5.1.3", + "postcss-reduce-initial": "^5.1.0", + "postcss-reduce-transforms": "^5.1.0", + "postcss-svgo": "^5.1.0", + "postcss-unique-selectors": "^5.1.1" + }, + "engines": { + "node": "^10 || ^12 || >=14.0" + }, + "peerDependencies": { + "postcss": "^8.2.15" + } + }, + "node_modules/cssnano-utils": { + "version": "3.1.0", + "resolved": "https://registry.npmjs.org/cssnano-utils/-/cssnano-utils-3.1.0.tgz", + "integrity": "sha512-JQNR19/YZhz4psLX/rQ9M83e3z2Wf/HdJbryzte4a3NSuafyp9w/I4U+hx5C2S9g41qlstH7DEWnZaaj83OuEA==", + "dev": true, + "engines": { + "node": "^10 || ^12 || >=14.0" + }, + "peerDependencies": { + "postcss": "^8.2.15" + } + }, + "node_modules/csso": { + "version": "4.2.0", + "resolved": "https://registry.npmjs.org/csso/-/csso-4.2.0.tgz", + "integrity": "sha512-wvlcdIbf6pwKEk7vHj8/Bkc0B4ylXZruLvOgs9doS5eOsOpuodOV2zJChSpkp+pRpYQLQMeF04nr3Z68Sta9jA==", + "dev": true, + "dependencies": { + "css-tree": "^1.1.2" + }, + "engines": { + "node": ">=8.0.0" + } + }, + "node_modules/dom-serializer": { + "version": "1.4.1", + "resolved": "https://registry.npmjs.org/dom-serializer/-/dom-serializer-1.4.1.tgz", + "integrity": "sha512-VHwB3KfrcOOkelEG2ZOfxqLZdfkil8PtJi4P8N2MMXucZq2yLp75ClViUlOVwyoHEDjYU433Aq+5zWP61+RGag==", + "dev": true, + "dependencies": { + "domelementtype": "^2.0.1", + "domhandler": "^4.2.0", + "entities": "^2.0.0" + }, + "funding": { + "url": "https://github.com/cheeriojs/dom-serializer?sponsor=1" + } + }, + "node_modules/domelementtype": { + "version": "2.3.0", + "resolved": "https://registry.npmjs.org/domelementtype/-/domelementtype-2.3.0.tgz", + "integrity": "sha512-OLETBj6w0OsagBwdXnPdN0cnMfF9opN69co+7ZrbfPGrdpPVNBUj02spi6B1N7wChLQiPn4CSH/zJvXw56gmHw==", + "dev": true, + "funding": [ + { + "type": "github", + "url": "https://github.com/sponsors/fb55" + } + ] + }, + "node_modules/domhandler": { + "version": "4.3.1", + "resolved": "https://registry.npmjs.org/domhandler/-/domhandler-4.3.1.tgz", + "integrity": "sha512-GrwoxYN+uWlzO8uhUXRl0P+kHE4GtVPfYzVLcUxPL7KNdHKj66vvlhiweIHqYYXWlw+T8iLMp42Lm67ghw4WMQ==", + "dev": true, + "dependencies": { + "domelementtype": "^2.2.0" + }, + "engines": { + "node": ">= 4" + }, + "funding": { + "url": "https://github.com/fb55/domhandler?sponsor=1" + } + }, + "node_modules/domutils": { + "version": "2.8.0", + "resolved": "https://registry.npmjs.org/domutils/-/domutils-2.8.0.tgz", + "integrity": "sha512-w96Cjofp72M5IIhpjgobBimYEfoPjx1Vx0BSX9P30WBdZW2WIKU0T1Bd0kz2eNZ9ikjKgHbEyKx8BB6H1L3h3A==", + "dev": true, + "dependencies": { + "dom-serializer": "^1.0.1", + "domelementtype": "^2.2.0", + "domhandler": "^4.2.0" + }, + "funding": { + "url": "https://github.com/fb55/domutils?sponsor=1" + } + }, + "node_modules/electron-to-chromium": { + "version": "1.4.195", + "resolved": "https://registry.npmjs.org/electron-to-chromium/-/electron-to-chromium-1.4.195.tgz", + "integrity": "sha512-vefjEh0sk871xNmR5whJf9TEngX+KTKS3hOHpjoMpauKkwlGwtMz1H8IaIjAT/GNnX0TbGwAdmVoXCAzXf+PPg==", + "dev": true + }, + "node_modules/emoji-regex": { + "version": "8.0.0", + "resolved": "https://registry.npmjs.org/emoji-regex/-/emoji-regex-8.0.0.tgz", + "integrity": "sha512-MSjYzcWNOA0ewAHpz0MxpYFvwg6yjy1NG3xteoqz644VCo/RPgnr1/GGt+ic3iJTzQ8Eu3TdM14SawnVUmGE6A==", + "dev": true + }, + "node_modules/entities": { + "version": "2.2.0", + "resolved": "https://registry.npmjs.org/entities/-/entities-2.2.0.tgz", + "integrity": "sha512-p92if5Nz619I0w+akJrLZH0MX0Pb5DX39XOwQTtXSdQQOaYH03S1uIQp4mhOZtAXrxq4ViO67YTiLBo2638o9A==", + "dev": true, + "funding": { + "url": "https://github.com/fb55/entities?sponsor=1" + } + }, + "node_modules/escalade": { + "version": "3.1.1", + "resolved": "https://registry.npmjs.org/escalade/-/escalade-3.1.1.tgz", + "integrity": "sha512-k0er2gUkLf8O0zKJiAhmkTnJlTvINGv7ygDNPbeIsX/TJjGJZHuh9B2UxbsaEkmlEo9MfhrSzmhIlhRlI2GXnw==", + "dev": true, + "engines": { + "node": ">=6" + } + }, + "node_modules/fill-range": { + "version": "7.0.1", + "resolved": "https://registry.npmjs.org/fill-range/-/fill-range-7.0.1.tgz", + "integrity": "sha512-qOo9F+dMUmC2Lcb4BbVvnKJxTPjCm+RRpe4gDuGrzkL7mEVl/djYSu2OdQ2Pa302N4oqkSg9ir6jaLWJ2USVpQ==", + "dev": true, + "dependencies": { + "to-regex-range": "^5.0.1" + }, + "engines": { + "node": ">=8" + } + }, + "node_modules/find-up": { + "version": "5.0.0", + "resolved": "https://registry.npmjs.org/find-up/-/find-up-5.0.0.tgz", + "integrity": "sha512-78/PXT1wlLLDgTzDs7sjq9hzz0vXD+zn+7wypEe4fXQxCmdmqfGsEPQxmiCSQI3ajFV91bVSsvNtrJRiW6nGng==", + "dev": true, + "dependencies": { + "locate-path": "^6.0.0", + "path-exists": "^4.0.0" + }, + "engines": { + "node": ">=10" + }, + "funding": { + "url": "https://github.com/sponsors/sindresorhus" + } + }, + "node_modules/flatpickr": { + "version": "4.6.13", + "resolved": "https://registry.npmjs.org/flatpickr/-/flatpickr-4.6.13.tgz", + "integrity": "sha512-97PMG/aywoYpB4IvbvUJi0RQi8vearvU0oov1WW3k0WZPBMrTQVqekSX5CjSG/M4Q3i6A/0FKXC7RyAoAUUSPw==" + }, + "node_modules/fraction.js": { + "version": "4.2.0", + "resolved": "https://registry.npmjs.org/fraction.js/-/fraction.js-4.2.0.tgz", + "integrity": "sha512-MhLuK+2gUcnZe8ZHlaaINnQLl0xRIGRfcGk2yl8xoQAfHrSsL3rYu6FCmBdkdbhc9EPlwyGHewaRsvwRMJtAlA==", + "dev": true, + "engines": { + "node": "*" + }, + "funding": { + "type": "patreon", + "url": "https://www.patreon.com/infusion" + } + }, + "node_modules/fsevents": { + "version": "2.3.2", + "resolved": "https://registry.npmjs.org/fsevents/-/fsevents-2.3.2.tgz", + "integrity": "sha512-xiqMQR4xAeHTuB9uWm+fFRcIOgKBMiOBP+eXiyT7jsgVCq1bkVygt00oASowB7EdtpOHaaPgKt812P9ab+DDKA==", + "dev": true, + "hasInstallScript": true, + "optional": true, + "os": [ + "darwin" + ], + "engines": { + "node": "^8.16.0 || ^10.6.0 || >=11.0.0" + } + }, + "node_modules/get-caller-file": { + "version": "2.0.5", + "resolved": "https://registry.npmjs.org/get-caller-file/-/get-caller-file-2.0.5.tgz", + "integrity": "sha512-DyFP3BM/3YHTQOCUL/w0OZHR0lpKeGrxotcHWcqNEdnltqFwXVfhEBQ94eIo34AfQpo0rGki4cyIiftY06h2Fg==", + "dev": true, + "engines": { + "node": "6.* || 8.* || >= 10.*" + } + }, + "node_modules/glob-parent": { + "version": "5.1.2", + "resolved": "https://registry.npmjs.org/glob-parent/-/glob-parent-5.1.2.tgz", + "integrity": "sha512-AOIgSQCepiJYwP3ARnGx+5VnTu2HBYdzbGP45eLw1vr3zB3vZLeyed1sC9hnbcOc9/SrMyM5RPQrkGz4aS9Zow==", + "dev": true, + "dependencies": { + "is-glob": "^4.0.1" + }, + "engines": { + "node": ">= 6" + } + }, + "node_modules/iframe-resizer": { + "version": "4.3.2", + "resolved": "https://registry.npmjs.org/iframe-resizer/-/iframe-resizer-4.3.2.tgz", + "integrity": "sha512-gOWo2hmdPjMQsQ+zTKbses08mDfDEMh4NneGQNP4qwePYujY1lguqP6gnbeJkf154gojWlBhIltlgnMfYjGHWA==", + "engines": { + "node": ">=0.8.0" + }, + "funding": { + "type": "individual", + "url": "https://github.com/davidjbradshaw/iframe-resizer/blob/master/FUNDING.md" + } + }, + "node_modules/immutable": { + "version": "4.1.0", + "resolved": "https://registry.npmjs.org/immutable/-/immutable-4.1.0.tgz", + "integrity": "sha512-oNkuqVTA8jqG1Q6c+UglTOD1xhC1BtjKI7XkCXRkZHrN5m18/XsnUp8Q89GkQO/z+0WjonSvl0FLhDYftp46nQ==", + "dev": true + }, + "node_modules/is-binary-path": { + "version": "2.1.0", + "resolved": "https://registry.npmjs.org/is-binary-path/-/is-binary-path-2.1.0.tgz", + "integrity": "sha512-ZMERYes6pDydyuGidse7OsHxtbI7WVeUEozgR/g7rd0xUimYNlvZRE/K2MgZTjWy725IfelLeVcEM97mmtRGXw==", + "dev": true, + "dependencies": { + "binary-extensions": "^2.0.0" + }, + "engines": { + "node": ">=8" + } + }, + "node_modules/is-extglob": { + "version": "2.1.1", + "resolved": "https://registry.npmjs.org/is-extglob/-/is-extglob-2.1.1.tgz", + "integrity": "sha512-SbKbANkN603Vi4jEZv49LeVJMn4yGwsbzZworEoyEiutsN3nJYdbO36zfhGJ6QEDpOZIFkDtnq5JRxmvl3jsoQ==", + "dev": true, + "engines": { + "node": ">=0.10.0" + } + }, + "node_modules/is-fullwidth-code-point": { + "version": "3.0.0", + "resolved": "https://registry.npmjs.org/is-fullwidth-code-point/-/is-fullwidth-code-point-3.0.0.tgz", + "integrity": "sha512-zymm5+u+sCsSWyD9qNaejV3DFvhCKclKdizYaJUuHA83RLjb7nSuGnddCHGv0hk+KY7BMAlsWeK4Ueg6EV6XQg==", + "dev": true, + "engines": { + "node": ">=8" + } + }, + "node_modules/is-glob": { + "version": "4.0.3", + "resolved": "https://registry.npmjs.org/is-glob/-/is-glob-4.0.3.tgz", + "integrity": "sha512-xelSayHH36ZgE7ZWhli7pW34hNbNl8Ojv5KVmkJD4hBdD3th8Tfk9vYasLM+mXWOZhFkgZfxhLSnrwRr4elSSg==", + "dev": true, + "dependencies": { + "is-extglob": "^2.1.1" + }, + "engines": { + "node": ">=0.10.0" + } + }, + "node_modules/is-number": { + "version": "7.0.0", + "resolved": "https://registry.npmjs.org/is-number/-/is-number-7.0.0.tgz", + "integrity": "sha512-41Cifkg6e8TylSpdtTpeLVMqvSBEVzTttHvERD741+pnZ8ANv0004MRL43QKPDlK9cGvNp6NZWZUBlbGXYxxng==", + "dev": true, + "engines": { + "node": ">=0.12.0" + } + }, + "node_modules/jquery": { + "version": "3.6.0", + "resolved": "https://registry.npmjs.org/jquery/-/jquery-3.6.0.tgz", + "integrity": "sha512-JVzAR/AjBvVt2BmYhxRCSYysDsPcssdmTFnzyLEts9qNwmjmu4JTAMYubEfwVOSwpQ1I1sKKFcxhZCI2buerfw==" + }, + "node_modules/jquery-ui-dist": { + "version": "1.13.1", + "resolved": "https://registry.npmjs.org/jquery-ui-dist/-/jquery-ui-dist-1.13.1.tgz", + "integrity": "sha512-Y711Pu4BRVrAlL58KSxX4ail74jaCJZaZcdNDLava+MgZeNwmVWmyYiK7KxyoJu1MB73eSunjJvYDbOuNrOA7w==", + "dependencies": { + "jquery": ">=1.8.0 <4.0.0" + } + }, + "node_modules/lilconfig": { + "version": "2.0.6", + "resolved": "https://registry.npmjs.org/lilconfig/-/lilconfig-2.0.6.tgz", + "integrity": "sha512-9JROoBW7pobfsx+Sq2JsASvCo6Pfo6WWoUW79HuB1BCoBXD4PLWJPqDF6fNj67pqBYTbAHkE57M1kS/+L1neOg==", + "dev": true, + "engines": { + "node": ">=10" + } + }, + "node_modules/locate-path": { + "version": "6.0.0", + "resolved": "https://registry.npmjs.org/locate-path/-/locate-path-6.0.0.tgz", + "integrity": "sha512-iPZK6eYjbxRu3uB4/WZ3EsEIMJFMqAoopl3R+zuq0UjcAm/MO6KCweDgPfP3elTztoKP3KtnVHxTn2NHBSDVUw==", + "dev": true, + "dependencies": { + "p-locate": "^5.0.0" + }, + "engines": { + "node": ">=10" + }, + "funding": { + "url": "https://github.com/sponsors/sindresorhus" + } + }, + "node_modules/lodash.memoize": { + "version": "4.1.2", + "resolved": "https://registry.npmjs.org/lodash.memoize/-/lodash.memoize-4.1.2.tgz", + "integrity": "sha512-t7j+NzmgnQzTAYXcsHYLgimltOV1MXHtlOWf6GjL9Kj8GK5FInw5JotxvbOs+IvV1/Dzo04/fCGfLVs7aXb4Ag==", + "dev": true + }, + "node_modules/lodash.uniq": { + "version": "4.5.0", + "resolved": "https://registry.npmjs.org/lodash.uniq/-/lodash.uniq-4.5.0.tgz", + "integrity": "sha512-xfBaXQd9ryd9dlSDvnvI0lvxfLJlYAZzXomUYzLKtUeOQvOP5piqAWuGtrhWeqaXK9hhoM/iyJc5AV+XfsX3HQ==", + "dev": true + }, + "node_modules/luxon": { + "version": "2.5.0", + "resolved": "https://registry.npmjs.org/luxon/-/luxon-2.5.0.tgz", + "integrity": "sha512-IDkEPB80Rb6gCAU+FEib0t4FeJ4uVOuX1CQ9GsvU3O+JAGIgu0J7sf1OarXKaKDygTZIoJyU6YdZzTFRu+YR0A==", + "engines": { + "node": ">=12" + } + }, + "node_modules/mathjax": { + "version": "3.2.2", + "resolved": "https://registry.npmjs.org/mathjax/-/mathjax-3.2.2.tgz", + "integrity": "sha512-Bt+SSVU8eBG27zChVewOicYs7Xsdt40qm4+UpHyX7k0/O9NliPc+x77k1/FEsPsjKPZGJvtRZM1vO+geW0OhGw==" + }, + "node_modules/mdn-data": { + "version": "2.0.14", + "resolved": "https://registry.npmjs.org/mdn-data/-/mdn-data-2.0.14.tgz", + "integrity": "sha512-dn6wd0uw5GsdswPFfsgMp5NSB0/aDe6fK94YJV/AJDYXL6HVLWBsxeq7js7Ad+mU2K9LAlwpk6kN2D5mwCPVow==", + "dev": true + }, + "node_modules/nanoid": { + "version": "3.3.4", + "resolved": "https://registry.npmjs.org/nanoid/-/nanoid-3.3.4.tgz", + "integrity": "sha512-MqBkQh/OHTS2egovRtLk45wEyNXwF+cokD+1YPf9u5VfJiRdAiRwB2froX5Co9Rh20xs4siNPm8naNotSD6RBw==", + "dev": true, + "bin": { + "nanoid": "bin/nanoid.cjs" + }, + "engines": { + "node": "^10 || ^12 || ^13.7 || ^14 || >=15.0.1" + } + }, + "node_modules/node-releases": { + "version": "2.0.6", + "resolved": "https://registry.npmjs.org/node-releases/-/node-releases-2.0.6.tgz", + "integrity": "sha512-PiVXnNuFm5+iYkLBNeq5211hvO38y63T0i2KKh2KnUs3RpzJ+JtODFjkD8yjLwnDkTYF1eKXheUwdssR+NRZdg==", + "dev": true + }, + "node_modules/normalize-path": { + "version": "3.0.0", + "resolved": "https://registry.npmjs.org/normalize-path/-/normalize-path-3.0.0.tgz", + "integrity": "sha512-6eZs5Ls3WtCisHWp9S2GUy8dqkpGi4BVSz3GaqiE6ezub0512ESztXUwUB6C6IKbQkY2Pnb/mD4WYojCRwcwLA==", + "dev": true, + "engines": { + "node": ">=0.10.0" + } + }, + "node_modules/normalize-range": { + "version": "0.1.2", + "resolved": "https://registry.npmjs.org/normalize-range/-/normalize-range-0.1.2.tgz", + "integrity": "sha512-bdok/XvKII3nUpklnV6P2hxtMNrCboOjAcyBuQnWEhO665FwrSNRxU+AqpsyvO6LgGYPspN+lu5CLtw4jPRKNA==", + "dev": true, + "engines": { + "node": ">=0.10.0" + } + }, + "node_modules/normalize-url": { + "version": "6.1.0", + "resolved": "https://registry.npmjs.org/normalize-url/-/normalize-url-6.1.0.tgz", + "integrity": "sha512-DlL+XwOy3NxAQ8xuC0okPgK46iuVNAK01YN7RueYBqqFeGsBjV9XmCAzAdgt+667bCl5kPh9EqKKDwnaPG1I7A==", + "dev": true, + "engines": { + "node": ">=10" + }, + "funding": { + "url": "https://github.com/sponsors/sindresorhus" + } + }, + "node_modules/nth-check": { + "version": "2.1.1", + "resolved": "https://registry.npmjs.org/nth-check/-/nth-check-2.1.1.tgz", + "integrity": "sha512-lqjrjmaOoAnWfMmBPL+XNnynZh2+swxiX3WUE0s4yEHI6m+AwrK2UZOimIRl3X/4QctVqS8AiZjFqyOGrMXb/w==", + "dev": true, + "dependencies": { + "boolbase": "^1.0.0" + }, + "funding": { + "url": "https://github.com/fb55/nth-check?sponsor=1" + } + }, + "node_modules/p-limit": { + "version": "3.1.0", + "resolved": "https://registry.npmjs.org/p-limit/-/p-limit-3.1.0.tgz", + "integrity": "sha512-TYOanM3wGwNGsZN2cVTYPArw454xnXj5qmWF1bEoAc4+cU/ol7GVh7odevjp1FNHduHc3KZMcFduxU5Xc6uJRQ==", + "dev": true, + "dependencies": { + "yocto-queue": "^0.1.0" + }, + "engines": { + "node": ">=10" + }, + "funding": { + "url": "https://github.com/sponsors/sindresorhus" + } + }, + "node_modules/p-locate": { + "version": "5.0.0", + "resolved": "https://registry.npmjs.org/p-locate/-/p-locate-5.0.0.tgz", + "integrity": "sha512-LaNjtRWUBY++zB5nE/NwcaoMylSPk+S+ZHNB1TzdbMJMny6dynpAGt7X/tl/QYq3TIeE6nxHppbo2LGymrG5Pw==", + "dev": true, + "dependencies": { + "p-limit": "^3.0.2" + }, + "engines": { + "node": ">=10" + }, + "funding": { + "url": "https://github.com/sponsors/sindresorhus" + } + }, + "node_modules/path-exists": { + "version": "4.0.0", + "resolved": "https://registry.npmjs.org/path-exists/-/path-exists-4.0.0.tgz", + "integrity": "sha512-ak9Qy5Q7jYb2Wwcey5Fpvg2KoAc/ZIhLSLOSBmRmygPsGwkVVt0fZa0qrtMz+m6tJTAHfZQ8FnmB4MG4LWy7/w==", + "dev": true, + "engines": { + "node": ">=8" + } + }, + "node_modules/picocolors": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/picocolors/-/picocolors-1.0.0.tgz", + "integrity": "sha512-1fygroTLlHu66zi26VoTDv8yRgm0Fccecssto+MhsZ0D/DGW2sm8E8AjW7NU5VVTRt5GxbeZ5qBuJr+HyLYkjQ==", + "dev": true + }, + "node_modules/picomatch": { + "version": "2.3.1", + "resolved": "https://registry.npmjs.org/picomatch/-/picomatch-2.3.1.tgz", + "integrity": "sha512-JU3teHTNjmE2VCGFzuY8EXzCDVwEqB2a8fsIvwaStHhAWJEeVd1o1QD80CU6+ZdEXXSLbSsuLwJjkCBWqRQUVA==", + "dev": true, + "engines": { + "node": ">=8.6" + }, + "funding": { + "url": "https://github.com/sponsors/jonschlinkert" + } + }, + "node_modules/postcss": { + "version": "8.4.14", + "resolved": "https://registry.npmjs.org/postcss/-/postcss-8.4.14.tgz", + "integrity": "sha512-E398TUmfAYFPBSdzgeieK2Y1+1cpdxJx8yXbK/m57nRhKSmk1GB2tO4lbLBtlkfPQTDKfe4Xqv1ASWPpayPEig==", + "dev": true, + "funding": [ + { + "type": "opencollective", + "url": "https://opencollective.com/postcss/" + }, + { + "type": "tidelift", + "url": "https://tidelift.com/funding/github/npm/postcss" + } + ], + "dependencies": { + "nanoid": "^3.3.4", + "picocolors": "^1.0.0", + "source-map-js": "^1.0.2" + }, + "engines": { + "node": "^10 || ^12 || >=14" + } + }, + "node_modules/postcss-calc": { + "version": "8.2.4", + "resolved": "https://registry.npmjs.org/postcss-calc/-/postcss-calc-8.2.4.tgz", + "integrity": "sha512-SmWMSJmB8MRnnULldx0lQIyhSNvuDl9HfrZkaqqE/WHAhToYsAvDq+yAsA/kIyINDszOp3Rh0GFoNuH5Ypsm3Q==", + "dev": true, + "dependencies": { + "postcss-selector-parser": "^6.0.9", + "postcss-value-parser": "^4.2.0" + }, + "peerDependencies": { + "postcss": "^8.2.2" + } + }, + "node_modules/postcss-colormin": { + "version": "5.3.0", + "resolved": "https://registry.npmjs.org/postcss-colormin/-/postcss-colormin-5.3.0.tgz", + "integrity": "sha512-WdDO4gOFG2Z8n4P8TWBpshnL3JpmNmJwdnfP2gbk2qBA8PWwOYcmjmI/t3CmMeL72a7Hkd+x/Mg9O2/0rD54Pg==", + "dev": true, + "dependencies": { + "browserslist": "^4.16.6", + "caniuse-api": "^3.0.0", + "colord": "^2.9.1", + "postcss-value-parser": "^4.2.0" + }, + "engines": { + "node": "^10 || ^12 || >=14.0" + }, + "peerDependencies": { + "postcss": "^8.2.15" + } + }, + "node_modules/postcss-convert-values": { + "version": "5.1.2", + "resolved": "https://registry.npmjs.org/postcss-convert-values/-/postcss-convert-values-5.1.2.tgz", + "integrity": "sha512-c6Hzc4GAv95B7suy4udszX9Zy4ETyMCgFPUDtWjdFTKH1SE9eFY/jEpHSwTH1QPuwxHpWslhckUQWbNRM4ho5g==", + "dev": true, + "dependencies": { + "browserslist": "^4.20.3", + "postcss-value-parser": "^4.2.0" + }, + "engines": { + "node": "^10 || ^12 || >=14.0" + }, + "peerDependencies": { + "postcss": "^8.2.15" + } + }, + "node_modules/postcss-discard-comments": { + "version": "5.1.2", + "resolved": "https://registry.npmjs.org/postcss-discard-comments/-/postcss-discard-comments-5.1.2.tgz", + "integrity": "sha512-+L8208OVbHVF2UQf1iDmRcbdjJkuBF6IS29yBDSiWUIzpYaAhtNl6JYnYm12FnkeCwQqF5LeklOu6rAqgfBZqQ==", + "dev": true, + "engines": { + "node": "^10 || ^12 || >=14.0" + }, + "peerDependencies": { + "postcss": "^8.2.15" + } + }, + "node_modules/postcss-discard-duplicates": { + "version": "5.1.0", + "resolved": "https://registry.npmjs.org/postcss-discard-duplicates/-/postcss-discard-duplicates-5.1.0.tgz", + "integrity": "sha512-zmX3IoSI2aoenxHV6C7plngHWWhUOV3sP1T8y2ifzxzbtnuhk1EdPwm0S1bIUNaJ2eNbWeGLEwzw8huPD67aQw==", + "dev": true, + "engines": { + "node": "^10 || ^12 || >=14.0" + }, + "peerDependencies": { + "postcss": "^8.2.15" + } + }, + "node_modules/postcss-discard-empty": { + "version": "5.1.1", + "resolved": "https://registry.npmjs.org/postcss-discard-empty/-/postcss-discard-empty-5.1.1.tgz", + "integrity": "sha512-zPz4WljiSuLWsI0ir4Mcnr4qQQ5e1Ukc3i7UfE2XcrwKK2LIPIqE5jxMRxO6GbI3cv//ztXDsXwEWT3BHOGh3A==", + "dev": true, + "engines": { + "node": "^10 || ^12 || >=14.0" + }, + "peerDependencies": { + "postcss": "^8.2.15" + } + }, + "node_modules/postcss-discard-overridden": { + "version": "5.1.0", + "resolved": "https://registry.npmjs.org/postcss-discard-overridden/-/postcss-discard-overridden-5.1.0.tgz", + "integrity": "sha512-21nOL7RqWR1kasIVdKs8HNqQJhFxLsyRfAnUDm4Fe4t4mCWL9OJiHvlHPjcd8zc5Myu89b/7wZDnOSjFgeWRtw==", + "dev": true, + "engines": { + "node": "^10 || ^12 || >=14.0" + }, + "peerDependencies": { + "postcss": "^8.2.15" + } + }, + "node_modules/postcss-merge-longhand": { + "version": "5.1.6", + "resolved": "https://registry.npmjs.org/postcss-merge-longhand/-/postcss-merge-longhand-5.1.6.tgz", + "integrity": "sha512-6C/UGF/3T5OE2CEbOuX7iNO63dnvqhGZeUnKkDeifebY0XqkkvrctYSZurpNE902LDf2yKwwPFgotnfSoPhQiw==", + "dev": true, + "dependencies": { + "postcss-value-parser": "^4.2.0", + "stylehacks": "^5.1.0" + }, + "engines": { + "node": "^10 || ^12 || >=14.0" + }, + "peerDependencies": { + "postcss": "^8.2.15" + } + }, + "node_modules/postcss-merge-rules": { + "version": "5.1.2", + "resolved": "https://registry.npmjs.org/postcss-merge-rules/-/postcss-merge-rules-5.1.2.tgz", + "integrity": "sha512-zKMUlnw+zYCWoPN6yhPjtcEdlJaMUZ0WyVcxTAmw3lkkN/NDMRkOkiuctQEoWAOvH7twaxUUdvBWl0d4+hifRQ==", + "dev": true, + "dependencies": { + "browserslist": "^4.16.6", + "caniuse-api": "^3.0.0", + "cssnano-utils": "^3.1.0", + "postcss-selector-parser": "^6.0.5" + }, + "engines": { + "node": "^10 || ^12 || >=14.0" + }, + "peerDependencies": { + "postcss": "^8.2.15" + } + }, + "node_modules/postcss-minify-font-values": { + "version": "5.1.0", + "resolved": "https://registry.npmjs.org/postcss-minify-font-values/-/postcss-minify-font-values-5.1.0.tgz", + "integrity": "sha512-el3mYTgx13ZAPPirSVsHqFzl+BBBDrXvbySvPGFnQcTI4iNslrPaFq4muTkLZmKlGk4gyFAYUBMH30+HurREyA==", + "dev": true, + "dependencies": { + "postcss-value-parser": "^4.2.0" + }, + "engines": { + "node": "^10 || ^12 || >=14.0" + }, + "peerDependencies": { + "postcss": "^8.2.15" + } + }, + "node_modules/postcss-minify-gradients": { + "version": "5.1.1", + "resolved": "https://registry.npmjs.org/postcss-minify-gradients/-/postcss-minify-gradients-5.1.1.tgz", + "integrity": "sha512-VGvXMTpCEo4qHTNSa9A0a3D+dxGFZCYwR6Jokk+/3oB6flu2/PnPXAh2x7x52EkY5xlIHLm+Le8tJxe/7TNhzw==", + "dev": true, + "dependencies": { + "colord": "^2.9.1", + "cssnano-utils": "^3.1.0", + "postcss-value-parser": "^4.2.0" + }, + "engines": { + "node": "^10 || ^12 || >=14.0" + }, + "peerDependencies": { + "postcss": "^8.2.15" + } + }, + "node_modules/postcss-minify-params": { + "version": "5.1.3", + "resolved": "https://registry.npmjs.org/postcss-minify-params/-/postcss-minify-params-5.1.3.tgz", + "integrity": "sha512-bkzpWcjykkqIujNL+EVEPOlLYi/eZ050oImVtHU7b4lFS82jPnsCb44gvC6pxaNt38Els3jWYDHTjHKf0koTgg==", + "dev": true, + "dependencies": { + "browserslist": "^4.16.6", + "cssnano-utils": "^3.1.0", + "postcss-value-parser": "^4.2.0" + }, + "engines": { + "node": "^10 || ^12 || >=14.0" + }, + "peerDependencies": { + "postcss": "^8.2.15" + } + }, + "node_modules/postcss-minify-selectors": { + "version": "5.2.1", + "resolved": "https://registry.npmjs.org/postcss-minify-selectors/-/postcss-minify-selectors-5.2.1.tgz", + "integrity": "sha512-nPJu7OjZJTsVUmPdm2TcaiohIwxP+v8ha9NehQ2ye9szv4orirRU3SDdtUmKH+10nzn0bAyOXZ0UEr7OpvLehg==", + "dev": true, + "dependencies": { + "postcss-selector-parser": "^6.0.5" + }, + "engines": { + "node": "^10 || ^12 || >=14.0" + }, + "peerDependencies": { + "postcss": "^8.2.15" + } + }, + "node_modules/postcss-normalize-charset": { + "version": "5.1.0", + "resolved": "https://registry.npmjs.org/postcss-normalize-charset/-/postcss-normalize-charset-5.1.0.tgz", + "integrity": "sha512-mSgUJ+pd/ldRGVx26p2wz9dNZ7ji6Pn8VWBajMXFf8jk7vUoSrZ2lt/wZR7DtlZYKesmZI680qjr2CeFF2fbUg==", + "dev": true, + "engines": { + "node": "^10 || ^12 || >=14.0" + }, + "peerDependencies": { + "postcss": "^8.2.15" + } + }, + "node_modules/postcss-normalize-display-values": { + "version": "5.1.0", + "resolved": "https://registry.npmjs.org/postcss-normalize-display-values/-/postcss-normalize-display-values-5.1.0.tgz", + "integrity": "sha512-WP4KIM4o2dazQXWmFaqMmcvsKmhdINFblgSeRgn8BJ6vxaMyaJkwAzpPpuvSIoG/rmX3M+IrRZEz2H0glrQNEA==", + "dev": true, + "dependencies": { + "postcss-value-parser": "^4.2.0" + }, + "engines": { + "node": "^10 || ^12 || >=14.0" + }, + "peerDependencies": { + "postcss": "^8.2.15" + } + }, + "node_modules/postcss-normalize-positions": { + "version": "5.1.1", + "resolved": "https://registry.npmjs.org/postcss-normalize-positions/-/postcss-normalize-positions-5.1.1.tgz", + "integrity": "sha512-6UpCb0G4eofTCQLFVuI3EVNZzBNPiIKcA1AKVka+31fTVySphr3VUgAIULBhxZkKgwLImhzMR2Bw1ORK+37INg==", + "dev": true, + "dependencies": { + "postcss-value-parser": "^4.2.0" + }, + "engines": { + "node": "^10 || ^12 || >=14.0" + }, + "peerDependencies": { + "postcss": "^8.2.15" + } + }, + "node_modules/postcss-normalize-repeat-style": { + "version": "5.1.1", + "resolved": "https://registry.npmjs.org/postcss-normalize-repeat-style/-/postcss-normalize-repeat-style-5.1.1.tgz", + "integrity": "sha512-mFpLspGWkQtBcWIRFLmewo8aC3ImN2i/J3v8YCFUwDnPu3Xz4rLohDO26lGjwNsQxB3YF0KKRwspGzE2JEuS0g==", + "dev": true, + "dependencies": { + "postcss-value-parser": "^4.2.0" + }, + "engines": { + "node": "^10 || ^12 || >=14.0" + }, + "peerDependencies": { + "postcss": "^8.2.15" + } + }, + "node_modules/postcss-normalize-string": { + "version": "5.1.0", + "resolved": "https://registry.npmjs.org/postcss-normalize-string/-/postcss-normalize-string-5.1.0.tgz", + "integrity": "sha512-oYiIJOf4T9T1N4i+abeIc7Vgm/xPCGih4bZz5Nm0/ARVJ7K6xrDlLwvwqOydvyL3RHNf8qZk6vo3aatiw/go3w==", + "dev": true, + "dependencies": { + "postcss-value-parser": "^4.2.0" + }, + "engines": { + "node": "^10 || ^12 || >=14.0" + }, + "peerDependencies": { + "postcss": "^8.2.15" + } + }, + "node_modules/postcss-normalize-timing-functions": { + "version": "5.1.0", + "resolved": "https://registry.npmjs.org/postcss-normalize-timing-functions/-/postcss-normalize-timing-functions-5.1.0.tgz", + "integrity": "sha512-DOEkzJ4SAXv5xkHl0Wa9cZLF3WCBhF3o1SKVxKQAa+0pYKlueTpCgvkFAHfk+Y64ezX9+nITGrDZeVGgITJXjg==", + "dev": true, + "dependencies": { + "postcss-value-parser": "^4.2.0" + }, + "engines": { + "node": "^10 || ^12 || >=14.0" + }, + "peerDependencies": { + "postcss": "^8.2.15" + } + }, + "node_modules/postcss-normalize-unicode": { + "version": "5.1.0", + "resolved": "https://registry.npmjs.org/postcss-normalize-unicode/-/postcss-normalize-unicode-5.1.0.tgz", + "integrity": "sha512-J6M3MizAAZ2dOdSjy2caayJLQT8E8K9XjLce8AUQMwOrCvjCHv24aLC/Lps1R1ylOfol5VIDMaM/Lo9NGlk1SQ==", + "dev": true, + "dependencies": { + "browserslist": "^4.16.6", + "postcss-value-parser": "^4.2.0" + }, + "engines": { + "node": "^10 || ^12 || >=14.0" + }, + "peerDependencies": { + "postcss": "^8.2.15" + } + }, + "node_modules/postcss-normalize-url": { + "version": "5.1.0", + "resolved": "https://registry.npmjs.org/postcss-normalize-url/-/postcss-normalize-url-5.1.0.tgz", + "integrity": "sha512-5upGeDO+PVthOxSmds43ZeMeZfKH+/DKgGRD7TElkkyS46JXAUhMzIKiCa7BabPeIy3AQcTkXwVVN7DbqsiCew==", + "dev": true, + "dependencies": { + "normalize-url": "^6.0.1", + "postcss-value-parser": "^4.2.0" + }, + "engines": { + "node": "^10 || ^12 || >=14.0" + }, + "peerDependencies": { + "postcss": "^8.2.15" + } + }, + "node_modules/postcss-normalize-whitespace": { + "version": "5.1.1", + "resolved": "https://registry.npmjs.org/postcss-normalize-whitespace/-/postcss-normalize-whitespace-5.1.1.tgz", + "integrity": "sha512-83ZJ4t3NUDETIHTa3uEg6asWjSBYL5EdkVB0sDncx9ERzOKBVJIUeDO9RyA9Zwtig8El1d79HBp0JEi8wvGQnA==", + "dev": true, + "dependencies": { + "postcss-value-parser": "^4.2.0" + }, + "engines": { + "node": "^10 || ^12 || >=14.0" + }, + "peerDependencies": { + "postcss": "^8.2.15" + } + }, + "node_modules/postcss-ordered-values": { + "version": "5.1.3", + "resolved": "https://registry.npmjs.org/postcss-ordered-values/-/postcss-ordered-values-5.1.3.tgz", + "integrity": "sha512-9UO79VUhPwEkzbb3RNpqqghc6lcYej1aveQteWY+4POIwlqkYE21HKWaLDF6lWNuqCobEAyTovVhtI32Rbv2RQ==", + "dev": true, + "dependencies": { + "cssnano-utils": "^3.1.0", + "postcss-value-parser": "^4.2.0" + }, + "engines": { + "node": "^10 || ^12 || >=14.0" + }, + "peerDependencies": { + "postcss": "^8.2.15" + } + }, + "node_modules/postcss-reduce-initial": { + "version": "5.1.0", + "resolved": "https://registry.npmjs.org/postcss-reduce-initial/-/postcss-reduce-initial-5.1.0.tgz", + "integrity": "sha512-5OgTUviz0aeH6MtBjHfbr57tml13PuedK/Ecg8szzd4XRMbYxH4572JFG067z+FqBIf6Zp/d+0581glkvvWMFw==", + "dev": true, + "dependencies": { + "browserslist": "^4.16.6", + "caniuse-api": "^3.0.0" + }, + "engines": { + "node": "^10 || ^12 || >=14.0" + }, + "peerDependencies": { + "postcss": "^8.2.15" + } + }, + "node_modules/postcss-reduce-transforms": { + "version": "5.1.0", + "resolved": "https://registry.npmjs.org/postcss-reduce-transforms/-/postcss-reduce-transforms-5.1.0.tgz", + "integrity": "sha512-2fbdbmgir5AvpW9RLtdONx1QoYG2/EtqpNQbFASDlixBbAYuTcJ0dECwlqNqH7VbaUnEnh8SrxOe2sRIn24XyQ==", + "dev": true, + "dependencies": { + "postcss-value-parser": "^4.2.0" + }, + "engines": { + "node": "^10 || ^12 || >=14.0" + }, + "peerDependencies": { + "postcss": "^8.2.15" + } + }, + "node_modules/postcss-selector-parser": { + "version": "6.0.10", + "resolved": "https://registry.npmjs.org/postcss-selector-parser/-/postcss-selector-parser-6.0.10.tgz", + "integrity": "sha512-IQ7TZdoaqbT+LCpShg46jnZVlhWD2w6iQYAcYXfHARZ7X1t/UGhhceQDs5X0cGqKvYlHNOuv7Oa1xmb0oQuA3w==", + "dev": true, + "dependencies": { + "cssesc": "^3.0.0", + "util-deprecate": "^1.0.2" + }, + "engines": { + "node": ">=4" + } + }, + "node_modules/postcss-svgo": { + "version": "5.1.0", + "resolved": "https://registry.npmjs.org/postcss-svgo/-/postcss-svgo-5.1.0.tgz", + "integrity": "sha512-D75KsH1zm5ZrHyxPakAxJWtkyXew5qwS70v56exwvw542d9CRtTo78K0WeFxZB4G7JXKKMbEZtZayTGdIky/eA==", + "dev": true, + "dependencies": { + "postcss-value-parser": "^4.2.0", + "svgo": "^2.7.0" + }, + "engines": { + "node": "^10 || ^12 || >=14.0" + }, + "peerDependencies": { + "postcss": "^8.2.15" + } + }, + "node_modules/postcss-unique-selectors": { + "version": "5.1.1", + "resolved": "https://registry.npmjs.org/postcss-unique-selectors/-/postcss-unique-selectors-5.1.1.tgz", + "integrity": "sha512-5JiODlELrz8L2HwxfPnhOWZYWDxVHWL83ufOv84NrcgipI7TaeRsatAhK4Tr2/ZiYldpK/wBvw5BD3qfaK96GA==", + "dev": true, + "dependencies": { + "postcss-selector-parser": "^6.0.5" + }, + "engines": { + "node": "^10 || ^12 || >=14.0" + }, + "peerDependencies": { + "postcss": "^8.2.15" + } + }, + "node_modules/postcss-value-parser": { + "version": "4.2.0", + "resolved": "https://registry.npmjs.org/postcss-value-parser/-/postcss-value-parser-4.2.0.tgz", + "integrity": "sha512-1NNCs6uurfkVbeXG4S8JFT9t19m45ICnif8zWLd5oPSZ50QnwMfK+H3jv408d4jw/7Bttv5axS5IiHoLaVNHeQ==", + "dev": true + }, + "node_modules/readdirp": { + "version": "3.6.0", + "resolved": "https://registry.npmjs.org/readdirp/-/readdirp-3.6.0.tgz", + "integrity": "sha512-hOS089on8RduqdbhvQ5Z37A0ESjsqz6qnRcffsMU3495FuTdqSm+7bhJ29JvIOsBDEEnan5DPu9t3To9VRlMzA==", + "dev": true, + "dependencies": { + "picomatch": "^2.2.1" + }, + "engines": { + "node": ">=8.10.0" + } + }, + "node_modules/require-directory": { + "version": "2.1.1", + "resolved": "https://registry.npmjs.org/require-directory/-/require-directory-2.1.1.tgz", + "integrity": "sha512-fGxEI7+wsG9xrvdjsrlmL22OMTTiHRwAMroiEeMgq8gzoLC/PQr7RsRDSTLUg/bZAZtF+TVIkHc6/4RIKrui+Q==", + "dev": true, + "engines": { + "node": ">=0.10.0" + } + }, + "node_modules/rtlcss": { + "version": "3.5.0", + "resolved": "https://registry.npmjs.org/rtlcss/-/rtlcss-3.5.0.tgz", + "integrity": "sha512-wzgMaMFHQTnyi9YOwsx9LjOxYXJPzS8sYnFaKm6R5ysvTkwzHiB0vxnbHwchHQT65PTdBjDG21/kQBWI7q9O7A==", + "dev": true, + "dependencies": { + "find-up": "^5.0.0", + "picocolors": "^1.0.0", + "postcss": "^8.3.11", + "strip-json-comments": "^3.1.1" + }, + "bin": { + "rtlcss": "bin/rtlcss.js" + } + }, + "node_modules/sass": { + "version": "1.53.0", + "resolved": "https://registry.npmjs.org/sass/-/sass-1.53.0.tgz", + "integrity": "sha512-zb/oMirbKhUgRQ0/GFz8TSAwRq2IlR29vOUJZOx0l8sV+CkHUfHa4u5nqrG+1VceZp7Jfj59SVW9ogdhTvJDcQ==", + "dev": true, + "dependencies": { + "chokidar": ">=3.0.0 <4.0.0", + "immutable": "^4.0.0", + "source-map-js": ">=0.6.2 <2.0.0" + }, + "bin": { + "sass": "sass.js" + }, + "engines": { + "node": ">=12.0.0" + } + }, + "node_modules/sortablejs": { + "version": "1.15.0", + "resolved": "https://registry.npmjs.org/sortablejs/-/sortablejs-1.15.0.tgz", + "integrity": "sha512-bv9qgVMjUMf89wAvM6AxVvS/4MX3sPeN0+agqShejLU5z5GX4C75ow1O2e5k4L6XItUyAK3gH6AxSbXrOM5e8w==" + }, + "node_modules/source-map": { + "version": "0.6.1", + "resolved": "https://registry.npmjs.org/source-map/-/source-map-0.6.1.tgz", + "integrity": "sha512-UjgapumWlbMhkBgzT7Ykc5YXUT46F0iKu8SGXq0bcwP5dz/h0Plj6enJqjz1Zbq2l5WaqYnrVbwWOWMyF3F47g==", + "dev": true, + "engines": { + "node": ">=0.10.0" + } + }, + "node_modules/source-map-js": { + "version": "1.0.2", + "resolved": "https://registry.npmjs.org/source-map-js/-/source-map-js-1.0.2.tgz", + "integrity": "sha512-R0XvVJ9WusLiqTCEiGCmICCMplcCkIwwR11mOSD9CR5u+IXYdiseeEuXCVAjS54zqwkLcPNnmU4OeJ6tUrWhDw==", + "dev": true, + "engines": { + "node": ">=0.10.0" + } + }, + "node_modules/source-map-support": { + "version": "0.5.21", + "resolved": "https://registry.npmjs.org/source-map-support/-/source-map-support-0.5.21.tgz", + "integrity": "sha512-uBHU3L3czsIyYXKX88fdrGovxdSCoTGDRZ6SYXtSRxLZUzHg5P/66Ht6uoUlHu9EZod+inXhKo3qQgwXUT/y1w==", + "dev": true, + "dependencies": { + "buffer-from": "^1.0.0", + "source-map": "^0.6.0" + } + }, + "node_modules/stable": { + "version": "0.1.8", + "resolved": "https://registry.npmjs.org/stable/-/stable-0.1.8.tgz", + "integrity": "sha512-ji9qxRnOVfcuLDySj9qzhGSEFVobyt1kIOSkj1qZzYLzq7Tos/oUUWvotUPQLlrsidqsK6tBH89Bc9kL5zHA6w==", + "deprecated": "Modern JS already guarantees Array#sort() is a stable sort, so this library is deprecated. See the compatibility table on MDN: https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/Array/sort#browser_compatibility", + "dev": true + }, + "node_modules/string-width": { + "version": "4.2.3", + "resolved": "https://registry.npmjs.org/string-width/-/string-width-4.2.3.tgz", + "integrity": "sha512-wKyQRQpjJ0sIp62ErSZdGsjMJWsap5oRNihHhu6G7JVO/9jIB6UyevL+tXuOqrng8j/cxKTWyWUwvSTriiZz/g==", + "dev": true, + "dependencies": { + "emoji-regex": "^8.0.0", + "is-fullwidth-code-point": "^3.0.0", + "strip-ansi": "^6.0.1" + }, + "engines": { + "node": ">=8" + } + }, + "node_modules/strip-ansi": { + "version": "6.0.1", + "resolved": "https://registry.npmjs.org/strip-ansi/-/strip-ansi-6.0.1.tgz", + "integrity": "sha512-Y38VPSHcqkFrCpFnQ9vuSXmquuv5oXOKpGeT6aGrr3o3Gc9AlVa6JBfUSOCnbxGGZF+/0ooI7KrPuUSztUdU5A==", + "dev": true, + "dependencies": { + "ansi-regex": "^5.0.1" + }, + "engines": { + "node": ">=8" + } + }, + "node_modules/strip-json-comments": { + "version": "3.1.1", + "resolved": "https://registry.npmjs.org/strip-json-comments/-/strip-json-comments-3.1.1.tgz", + "integrity": "sha512-6fPc+R4ihwqP6N/aIv2f1gMH8lOVtWQHoqC4yK6oSDVVocumAsfCqjkXnqiYMhmMwS/mEHLp7Vehlt3ql6lEig==", + "dev": true, + "engines": { + "node": ">=8" + }, + "funding": { + "url": "https://github.com/sponsors/sindresorhus" + } + }, + "node_modules/stylehacks": { + "version": "5.1.0", + "resolved": "https://registry.npmjs.org/stylehacks/-/stylehacks-5.1.0.tgz", + "integrity": "sha512-SzLmvHQTrIWfSgljkQCw2++C9+Ne91d/6Sp92I8c5uHTcy/PgeHamwITIbBW9wnFTY/3ZfSXR9HIL6Ikqmcu6Q==", + "dev": true, + "dependencies": { + "browserslist": "^4.16.6", + "postcss-selector-parser": "^6.0.4" + }, + "engines": { + "node": "^10 || ^12 || >=14.0" + }, + "peerDependencies": { + "postcss": "^8.2.15" + } + }, + "node_modules/svgo": { + "version": "2.8.0", + "resolved": "https://registry.npmjs.org/svgo/-/svgo-2.8.0.tgz", + "integrity": "sha512-+N/Q9kV1+F+UeWYoSiULYo4xYSDQlTgb+ayMobAXPwMnLvop7oxKMo9OzIrX5x3eS4L4f2UHhc9axXwY8DpChg==", + "dev": true, + "dependencies": { + "@trysound/sax": "0.2.0", + "commander": "^7.2.0", + "css-select": "^4.1.3", + "css-tree": "^1.1.3", + "csso": "^4.2.0", + "picocolors": "^1.0.0", + "stable": "^0.1.8" + }, + "bin": { + "svgo": "bin/svgo" + }, + "engines": { + "node": ">=10.13.0" + } + }, + "node_modules/terser": { + "version": "5.14.2", + "resolved": "https://registry.npmjs.org/terser/-/terser-5.14.2.tgz", + "integrity": "sha512-oL0rGeM/WFQCUd0y2QrWxYnq7tfSuKBiqTjRPWrRgB46WD/kiwHwF8T23z78H6Q6kGCuuHcPB+KULHRdxvVGQA==", + "dev": true, + "dependencies": { + "@jridgewell/source-map": "^0.3.2", + "acorn": "^8.5.0", + "commander": "^2.20.0", + "source-map-support": "~0.5.20" + }, + "bin": { + "terser": "bin/terser" + }, + "engines": { + "node": ">=10" + } + }, + "node_modules/terser/node_modules/commander": { + "version": "2.20.3", + "resolved": "https://registry.npmjs.org/commander/-/commander-2.20.3.tgz", + "integrity": "sha512-GpVkmM8vF2vQUkj2LvZmD35JxeJOLCwJ9cUkugyk2nuhbv3+mJvpLYYt+0+USMxE+oj+ey/lJEnhZw75x/OMcQ==", + "dev": true + }, + "node_modules/to-regex-range": { + "version": "5.0.1", + "resolved": "https://registry.npmjs.org/to-regex-range/-/to-regex-range-5.0.1.tgz", + "integrity": "sha512-65P7iz6X5yEr1cwcgvQxbbIw7Uk3gOy5dIdtZ4rDveLqhrdJP+Li/Hx6tyK0NEb+2GCyneCMJiGqrADCSNk8sQ==", + "dev": true, + "dependencies": { + "is-number": "^7.0.0" + }, + "engines": { + "node": ">=8.0" + } + }, + "node_modules/update-browserslist-db": { + "version": "1.0.5", + "resolved": "https://registry.npmjs.org/update-browserslist-db/-/update-browserslist-db-1.0.5.tgz", + "integrity": "sha512-dteFFpCyvuDdr9S/ff1ISkKt/9YZxKjI9WlRR99c180GaztJtRa/fn18FdxGVKVsnPY7/a/FDN68mcvUmP4U7Q==", + "dev": true, + "funding": [ + { + "type": "opencollective", + "url": "https://opencollective.com/browserslist" + }, + { + "type": "tidelift", + "url": "https://tidelift.com/funding/github/npm/browserslist" + } + ], + "dependencies": { + "escalade": "^3.1.1", + "picocolors": "^1.0.0" + }, + "bin": { + "browserslist-lint": "cli.js" + }, + "peerDependencies": { + "browserslist": ">= 4.21.0" + } + }, + "node_modules/util-deprecate": { + "version": "1.0.2", + "resolved": "https://registry.npmjs.org/util-deprecate/-/util-deprecate-1.0.2.tgz", + "integrity": "sha512-EPD5q1uXyFxJpCrLnCc1nHnq3gOa6DZBocAIiI2TaSCA7VCJ1UJDMagCzIkXNsUYfD1daK//LTEQ8xiIbrHtcw==", + "dev": true + }, + "node_modules/wrap-ansi": { + "version": "7.0.0", + "resolved": "https://registry.npmjs.org/wrap-ansi/-/wrap-ansi-7.0.0.tgz", + "integrity": "sha512-YVGIj2kamLSTxw6NsZjoBxfSwsn0ycdesmc4p+Q21c5zPuZ1pl+NfxVdxPtdHvmNVOQ6XSYG4AUtyt/Fi7D16Q==", + "dev": true, + "dependencies": { + "ansi-styles": "^4.0.0", + "string-width": "^4.1.0", + "strip-ansi": "^6.0.0" + }, + "engines": { + "node": ">=10" + }, + "funding": { + "url": "https://github.com/chalk/wrap-ansi?sponsor=1" + } + }, + "node_modules/y18n": { + "version": "5.0.8", + "resolved": "https://registry.npmjs.org/y18n/-/y18n-5.0.8.tgz", + "integrity": "sha512-0pfFzegeDWJHJIAmTLRP2DwHjdF5s7jo9tuztdQxAhINCdvS+3nGINqPd00AphqJR/0LhANUS6/+7SCb98YOfA==", + "dev": true, + "engines": { + "node": ">=10" + } + }, + "node_modules/yaml": { + "version": "1.10.2", + "resolved": "https://registry.npmjs.org/yaml/-/yaml-1.10.2.tgz", + "integrity": "sha512-r3vXyErRCYJ7wg28yvBY5VSoAF8ZvlcW9/BwUzEtUsjvX/DKs24dIkuwjtuprwJJHsbyUbLApepYTR1BN4uHrg==", + "dev": true, + "engines": { + "node": ">= 6" + } + }, + "node_modules/yargs": { + "version": "16.2.0", + "resolved": "https://registry.npmjs.org/yargs/-/yargs-16.2.0.tgz", + "integrity": "sha512-D1mvvtDG0L5ft/jGWkLpG1+m0eQxOfaBvTNELraWj22wSVUMWxZUvYgJYcKh6jGGIkJFhH4IZPQhR4TKpc8mBw==", + "dev": true, + "dependencies": { + "cliui": "^7.0.2", + "escalade": "^3.1.1", + "get-caller-file": "^2.0.5", + "require-directory": "^2.1.1", + "string-width": "^4.2.0", + "y18n": "^5.0.5", + "yargs-parser": "^20.2.2" + }, + "engines": { + "node": ">=10" + } + }, + "node_modules/yargs-parser": { + "version": "20.2.9", + "resolved": "https://registry.npmjs.org/yargs-parser/-/yargs-parser-20.2.9.tgz", + "integrity": "sha512-y11nGElTIV+CT3Zv9t7VKl+Q3hTQoT9a1Qzezhhl6Rp21gJ/IVTW7Z3y9EWXhuUBC2Shnf+DX0antecpAwSP8w==", + "dev": true, + "engines": { + "node": ">=10" + } + }, + "node_modules/yocto-queue": { + "version": "0.1.0", + "resolved": "https://registry.npmjs.org/yocto-queue/-/yocto-queue-0.1.0.tgz", + "integrity": "sha512-rVksvsnNCdJ/ohGc6xgPwyN8eheCxsiLM8mxuE/t/mOVqJewPuO1miLpTHQiRgTKCLexL4MeAFVagts7HmNZ2Q==", + "dev": true, + "engines": { + "node": ">=10" + }, + "funding": { + "url": "https://github.com/sponsors/sindresorhus" + } + } + }, + "dependencies": { + "@fortawesome/fontawesome-free": { + "version": "6.1.1", + "resolved": "https://registry.npmjs.org/@fortawesome/fontawesome-free/-/fontawesome-free-6.1.1.tgz", + "integrity": "sha512-J/3yg2AIXc9wznaVqpHVX3Wa5jwKovVF0AMYSnbmcXTiL3PpRPfF58pzWucCwEiCJBp+hCNRLWClTomD8SseKg==" + }, + "@jridgewell/gen-mapping": { + "version": "0.3.2", + "resolved": "https://registry.npmjs.org/@jridgewell/gen-mapping/-/gen-mapping-0.3.2.tgz", + "integrity": "sha512-mh65xKQAzI6iBcFzwv28KVWSmCkdRBWoOh+bYQGW3+6OZvbbN3TqMGo5hqYxQniRcH9F2VZIoJCm4pa3BPDK/A==", + "dev": true, + "requires": { + "@jridgewell/set-array": "^1.0.1", + "@jridgewell/sourcemap-codec": "^1.4.10", + "@jridgewell/trace-mapping": "^0.3.9" + } + }, + "@jridgewell/resolve-uri": { + "version": "3.1.0", + "resolved": "https://registry.npmjs.org/@jridgewell/resolve-uri/-/resolve-uri-3.1.0.tgz", + "integrity": "sha512-F2msla3tad+Mfht5cJq7LSXcdudKTWCVYUgw6pLFOOHSTtZlj6SWNYAp+AhuqLmWdBO2X5hPrLcu8cVP8fy28w==", + "dev": true + }, + "@jridgewell/set-array": { + "version": "1.1.2", + "resolved": "https://registry.npmjs.org/@jridgewell/set-array/-/set-array-1.1.2.tgz", + "integrity": "sha512-xnkseuNADM0gt2bs+BvhO0p78Mk762YnZdsuzFV018NoG1Sj1SCQvpSqa7XUaTam5vAGasABV9qXASMKnFMwMw==", + "dev": true + }, + "@jridgewell/source-map": { + "version": "0.3.2", + "resolved": "https://registry.npmjs.org/@jridgewell/source-map/-/source-map-0.3.2.tgz", + "integrity": "sha512-m7O9o2uR8k2ObDysZYzdfhb08VuEml5oWGiosa1VdaPZ/A6QyPkAJuwN0Q1lhULOf6B7MtQmHENS743hWtCrgw==", + "dev": true, + "requires": { + "@jridgewell/gen-mapping": "^0.3.0", + "@jridgewell/trace-mapping": "^0.3.9" + } + }, + "@jridgewell/sourcemap-codec": { + "version": "1.4.14", + "resolved": "https://registry.npmjs.org/@jridgewell/sourcemap-codec/-/sourcemap-codec-1.4.14.tgz", + "integrity": "sha512-XPSJHWmi394fuUuzDnGz1wiKqWfo1yXecHQMRf2l6hztTO+nPru658AyDngaBe7isIxEkRsPR3FZh+s7iVa4Uw==", + "dev": true + }, + "@jridgewell/trace-mapping": { + "version": "0.3.14", + "resolved": "https://registry.npmjs.org/@jridgewell/trace-mapping/-/trace-mapping-0.3.14.tgz", + "integrity": "sha512-bJWEfQ9lPTvm3SneWwRFVLzrh6nhjwqw7TUFFBEMzwvg7t7PCDenf2lDwqo4NQXzdpgBXyFgDWnQA+2vkruksQ==", + "dev": true, + "requires": { + "@jridgewell/resolve-uri": "^3.0.3", + "@jridgewell/sourcemap-codec": "^1.4.10" + } + }, + "@popperjs/core": { + "version": "2.11.5", + "resolved": "https://registry.npmjs.org/@popperjs/core/-/core-2.11.5.tgz", + "integrity": "sha512-9X2obfABZuDVLCgPK9aX0a/x4jaOEweTTWE2+9sr0Qqqevj2Uv5XorvusThmc9XGYpS9yI+fhh8RTafBtGposw==", + "peer": true + }, + "@trysound/sax": { + "version": "0.2.0", + "resolved": "https://registry.npmjs.org/@trysound/sax/-/sax-0.2.0.tgz", + "integrity": "sha512-L7z9BgrNEcYyUYtF+HaEfiS5ebkh9jXqbszz7pC0hRBPaatV0XjSD3+eHrpqFemQfgwiFF0QPIarnIihIDn7OA==", + "dev": true + }, + "acorn": { + "version": "8.7.1", + "resolved": "https://registry.npmjs.org/acorn/-/acorn-8.7.1.tgz", + "integrity": "sha512-Xx54uLJQZ19lKygFXOWsscKUbsBZW0CPykPhVQdhIeIwrbPmJzqeASDInc8nKBnp/JT6igTs82qPXz069H8I/A==", + "dev": true + }, + "ansi-regex": { + "version": "5.0.1", + "resolved": "https://registry.npmjs.org/ansi-regex/-/ansi-regex-5.0.1.tgz", + "integrity": "sha512-quJQXlTSUGL2LH9SUXo8VwsY4soanhgo6LNSm84E1LBcE8s3O0wpdiRzyR9z/ZZJMlMWv37qOOb9pdJlMUEKFQ==", + "dev": true + }, + "ansi-styles": { + "version": "4.3.0", + "resolved": "https://registry.npmjs.org/ansi-styles/-/ansi-styles-4.3.0.tgz", + "integrity": "sha512-zbB9rCJAT1rbjiVDb2hqKFHNYLxgtk8NURxZ3IZwD3F6NtxbXZQCnnSi1Lkx+IDohdPlFp222wVALIheZJQSEg==", + "dev": true, + "requires": { + "color-convert": "^2.0.1" + } + }, + "anymatch": { + "version": "3.1.2", + "resolved": "https://registry.npmjs.org/anymatch/-/anymatch-3.1.2.tgz", + "integrity": "sha512-P43ePfOAIupkguHUycrc4qJ9kz8ZiuOUijaETwX7THt0Y/GNK7v0aa8rY816xWjZ7rJdA5XdMcpVFTKMq+RvWg==", + "dev": true, + "requires": { + "normalize-path": "^3.0.0", + "picomatch": "^2.0.4" + } + }, + "autoprefixer": { + "version": "10.4.7", + "resolved": "https://registry.npmjs.org/autoprefixer/-/autoprefixer-10.4.7.tgz", + "integrity": "sha512-ypHju4Y2Oav95SipEcCcI5J7CGPuvz8oat7sUtYj3ClK44bldfvtvcxK6IEK++7rqB7YchDGzweZIBG+SD0ZAA==", + "dev": true, + "requires": { + "browserslist": "^4.20.3", + "caniuse-lite": "^1.0.30001335", + "fraction.js": "^4.2.0", + "normalize-range": "^0.1.2", + "picocolors": "^1.0.0", + "postcss-value-parser": "^4.2.0" + } + }, + "binary-extensions": { + "version": "2.2.0", + "resolved": "https://registry.npmjs.org/binary-extensions/-/binary-extensions-2.2.0.tgz", + "integrity": "sha512-jDctJ/IVQbZoJykoeHbhXpOlNBqGNcwXJKJog42E5HDPUwQTSdjCHdihjj0DlnheQ7blbT6dHOafNAiS8ooQKA==", + "dev": true + }, + "boolbase": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/boolbase/-/boolbase-1.0.0.tgz", + "integrity": "sha512-JZOSA7Mo9sNGB8+UjSgzdLtokWAky1zbztM3WRLCbZ70/3cTANmQmOdR7y2g+J0e2WXywy1yS468tY+IruqEww==", + "dev": true + }, + "bootstrap": { + "version": "5.1.3", + "resolved": "https://registry.npmjs.org/bootstrap/-/bootstrap-5.1.3.tgz", + "integrity": "sha512-fcQztozJ8jToQWXxVuEyXWW+dSo8AiXWKwiSSrKWsRB/Qt+Ewwza+JWoLKiTuQLaEPhdNAJ7+Dosc9DOIqNy7Q==", + "requires": {} + }, + "braces": { + "version": "3.0.2", + "resolved": "https://registry.npmjs.org/braces/-/braces-3.0.2.tgz", + "integrity": "sha512-b8um+L1RzM3WDSzvhm6gIz1yfTbBt6YTlcEKAvsmqCZZFw46z626lVj9j1yEPW33H5H+lBQpZMP1k8l+78Ha0A==", + "dev": true, + "requires": { + "fill-range": "^7.0.1" + } + }, + "browserslist": { + "version": "4.21.2", + "resolved": "https://registry.npmjs.org/browserslist/-/browserslist-4.21.2.tgz", + "integrity": "sha512-MonuOgAtUB46uP5CezYbRaYKBNt2LxP0yX+Pmj4LkcDFGkn9Cbpi83d9sCjwQDErXsIJSzY5oKGDbgOlF/LPAA==", + "dev": true, + "requires": { + "caniuse-lite": "^1.0.30001366", + "electron-to-chromium": "^1.4.188", + "node-releases": "^2.0.6", + "update-browserslist-db": "^1.0.4" + } + }, + "buffer-from": { + "version": "1.1.2", + "resolved": "https://registry.npmjs.org/buffer-from/-/buffer-from-1.1.2.tgz", + "integrity": "sha512-E+XQCRwSbaaiChtv6k6Dwgc+bx+Bs6vuKJHHl5kox/BaKbhiXzqQOwK4cO22yElGp2OCmjwVhT3HmxgyPGnJfQ==", + "dev": true + }, + "caniuse-api": { + "version": "3.0.0", + "resolved": "https://registry.npmjs.org/caniuse-api/-/caniuse-api-3.0.0.tgz", + "integrity": "sha512-bsTwuIg/BZZK/vreVTYYbSWoe2F+71P7K5QGEX+pT250DZbfU1MQ5prOKpPR+LL6uWKK3KMwMCAS74QB3Um1uw==", + "dev": true, + "requires": { + "browserslist": "^4.0.0", + "caniuse-lite": "^1.0.0", + "lodash.memoize": "^4.1.2", + "lodash.uniq": "^4.5.0" + } + }, + "caniuse-lite": { + "version": "1.0.30001367", + "resolved": "https://registry.npmjs.org/caniuse-lite/-/caniuse-lite-1.0.30001367.tgz", + "integrity": "sha512-XDgbeOHfifWV3GEES2B8rtsrADx4Jf+juKX2SICJcaUhjYBO3bR96kvEIHa15VU6ohtOhBZuPGGYGbXMRn0NCw==", + "dev": true + }, + "chokidar": { + "version": "3.5.3", + "resolved": "https://registry.npmjs.org/chokidar/-/chokidar-3.5.3.tgz", + "integrity": "sha512-Dr3sfKRP6oTcjf2JmUmFJfeVMvXBdegxB0iVQ5eb2V10uFJUCAS8OByZdVAyVb8xXNz3GjjTgj9kLWsZTqE6kw==", + "dev": true, + "requires": { + "anymatch": "~3.1.2", + "braces": "~3.0.2", + "fsevents": "~2.3.2", + "glob-parent": "~5.1.2", + "is-binary-path": "~2.1.0", + "is-glob": "~4.0.1", + "normalize-path": "~3.0.0", + "readdirp": "~3.6.0" + } + }, + "cliui": { + "version": "7.0.4", + "resolved": "https://registry.npmjs.org/cliui/-/cliui-7.0.4.tgz", + "integrity": "sha512-OcRE68cOsVMXp1Yvonl/fzkQOyjLSu/8bhPDfQt0e0/Eb283TKP20Fs2MqoPsr9SwA595rRCA+QMzYc9nBP+JQ==", + "dev": true, + "requires": { + "string-width": "^4.2.0", + "strip-ansi": "^6.0.0", + "wrap-ansi": "^7.0.0" + } + }, + "codemirror": { + "version": "5.65.7", + "resolved": "https://registry.npmjs.org/codemirror/-/codemirror-5.65.7.tgz", + "integrity": "sha512-zb67cXzgugIQmb6tfD4G11ILjYoMfTjwcjn+cWsa4GewlI2adhR/h3kolkoCQTm1msD/1BuqVTKuO09ELsS++A==" + }, + "color-convert": { + "version": "2.0.1", + "resolved": "https://registry.npmjs.org/color-convert/-/color-convert-2.0.1.tgz", + "integrity": "sha512-RRECPsj7iu/xb5oKYcsFHSppFNnsj/52OVTRKb4zP5onXwVF3zVmmToNcOfGC+CRDpfK/U584fMg38ZHCaElKQ==", + "dev": true, + "requires": { + "color-name": "~1.1.4" + } + }, + "color-name": { + "version": "1.1.4", + "resolved": "https://registry.npmjs.org/color-name/-/color-name-1.1.4.tgz", + "integrity": "sha512-dOy+3AuW3a2wNbZHIuMZpTcgjGuLU/uBL/ubcZF9OXbDo8ff4O8yVp5Bf0efS8uEoYo5q4Fx7dY9OgQGXgAsQA==", + "dev": true + }, + "colord": { + "version": "2.9.2", + "resolved": "https://registry.npmjs.org/colord/-/colord-2.9.2.tgz", + "integrity": "sha512-Uqbg+J445nc1TKn4FoDPS6ZZqAvEDnwrH42yo8B40JSOgSLxMZ/gt3h4nmCtPLQeXhjJJkqBx7SCY35WnIixaQ==", + "dev": true + }, + "commander": { + "version": "7.2.0", + "resolved": "https://registry.npmjs.org/commander/-/commander-7.2.0.tgz", + "integrity": "sha512-QrWXB+ZQSVPmIWIhtEO9H+gwHaMGYiF5ChvoJ+K9ZGHG/sVsa6yiesAD1GC/x46sET00Xlwo1u49RVVVzvcSkw==", + "dev": true + }, + "css-declaration-sorter": { + "version": "6.3.0", + "resolved": "https://registry.npmjs.org/css-declaration-sorter/-/css-declaration-sorter-6.3.0.tgz", + "integrity": "sha512-OGT677UGHJTAVMRhPO+HJ4oKln3wkBTwtDFH0ojbqm+MJm6xuDMHp2nkhh/ThaBqq20IbraBQSWKfSLNHQO9Og==", + "dev": true, + "requires": {} + }, + "css-select": { + "version": "4.3.0", + "resolved": "https://registry.npmjs.org/css-select/-/css-select-4.3.0.tgz", + "integrity": "sha512-wPpOYtnsVontu2mODhA19JrqWxNsfdatRKd64kmpRbQgh1KtItko5sTnEpPdpSaJszTOhEMlF/RPz28qj4HqhQ==", + "dev": true, + "requires": { + "boolbase": "^1.0.0", + "css-what": "^6.0.1", + "domhandler": "^4.3.1", + "domutils": "^2.8.0", + "nth-check": "^2.0.1" + } + }, + "css-tree": { + "version": "1.1.3", + "resolved": "https://registry.npmjs.org/css-tree/-/css-tree-1.1.3.tgz", + "integrity": "sha512-tRpdppF7TRazZrjJ6v3stzv93qxRcSsFmW6cX0Zm2NVKpxE1WV1HblnghVv9TreireHkqI/VDEsfolRF1p6y7Q==", + "dev": true, + "requires": { + "mdn-data": "2.0.14", + "source-map": "^0.6.1" + } + }, + "css-what": { + "version": "6.1.0", + "resolved": "https://registry.npmjs.org/css-what/-/css-what-6.1.0.tgz", + "integrity": "sha512-HTUrgRJ7r4dsZKU6GjmpfRK1O76h97Z8MfS1G0FozR+oF2kG6Vfe8JE6zwrkbxigziPHinCJ+gCPjA9EaBDtRw==", + "dev": true + }, + "cssesc": { + "version": "3.0.0", + "resolved": "https://registry.npmjs.org/cssesc/-/cssesc-3.0.0.tgz", + "integrity": "sha512-/Tb/JcjK111nNScGob5MNtsntNM1aCNUDipB/TkwZFhyDrrE47SOx/18wF2bbjgc3ZzCSKW1T5nt5EbFoAz/Vg==", + "dev": true + }, + "cssnano": { + "version": "5.1.12", + "resolved": "https://registry.npmjs.org/cssnano/-/cssnano-5.1.12.tgz", + "integrity": "sha512-TgvArbEZu0lk/dvg2ja+B7kYoD7BBCmn3+k58xD0qjrGHsFzXY/wKTo9M5egcUCabPol05e/PVoIu79s2JN4WQ==", + "dev": true, + "requires": { + "cssnano-preset-default": "^5.2.12", + "lilconfig": "^2.0.3", + "yaml": "^1.10.2" + } + }, + "cssnano-preset-default": { + "version": "5.2.12", + "resolved": "https://registry.npmjs.org/cssnano-preset-default/-/cssnano-preset-default-5.2.12.tgz", + "integrity": "sha512-OyCBTZi+PXgylz9HAA5kHyoYhfGcYdwFmyaJzWnzxuGRtnMw/kR6ilW9XzlzlRAtB6PLT/r+prYgkef7hngFew==", + "dev": true, + "requires": { + "css-declaration-sorter": "^6.3.0", + "cssnano-utils": "^3.1.0", + "postcss-calc": "^8.2.3", + "postcss-colormin": "^5.3.0", + "postcss-convert-values": "^5.1.2", + "postcss-discard-comments": "^5.1.2", + "postcss-discard-duplicates": "^5.1.0", + "postcss-discard-empty": "^5.1.1", + "postcss-discard-overridden": "^5.1.0", + "postcss-merge-longhand": "^5.1.6", + "postcss-merge-rules": "^5.1.2", + "postcss-minify-font-values": "^5.1.0", + "postcss-minify-gradients": "^5.1.1", + "postcss-minify-params": "^5.1.3", + "postcss-minify-selectors": "^5.2.1", + "postcss-normalize-charset": "^5.1.0", + "postcss-normalize-display-values": "^5.1.0", + "postcss-normalize-positions": "^5.1.1", + "postcss-normalize-repeat-style": "^5.1.1", + "postcss-normalize-string": "^5.1.0", + "postcss-normalize-timing-functions": "^5.1.0", + "postcss-normalize-unicode": "^5.1.0", + "postcss-normalize-url": "^5.1.0", + "postcss-normalize-whitespace": "^5.1.1", + "postcss-ordered-values": "^5.1.3", + "postcss-reduce-initial": "^5.1.0", + "postcss-reduce-transforms": "^5.1.0", + "postcss-svgo": "^5.1.0", + "postcss-unique-selectors": "^5.1.1" + } + }, + "cssnano-utils": { + "version": "3.1.0", + "resolved": "https://registry.npmjs.org/cssnano-utils/-/cssnano-utils-3.1.0.tgz", + "integrity": "sha512-JQNR19/YZhz4psLX/rQ9M83e3z2Wf/HdJbryzte4a3NSuafyp9w/I4U+hx5C2S9g41qlstH7DEWnZaaj83OuEA==", + "dev": true, + "requires": {} + }, + "csso": { + "version": "4.2.0", + "resolved": "https://registry.npmjs.org/csso/-/csso-4.2.0.tgz", + "integrity": "sha512-wvlcdIbf6pwKEk7vHj8/Bkc0B4ylXZruLvOgs9doS5eOsOpuodOV2zJChSpkp+pRpYQLQMeF04nr3Z68Sta9jA==", + "dev": true, + "requires": { + "css-tree": "^1.1.2" + } + }, + "dom-serializer": { + "version": "1.4.1", + "resolved": "https://registry.npmjs.org/dom-serializer/-/dom-serializer-1.4.1.tgz", + "integrity": "sha512-VHwB3KfrcOOkelEG2ZOfxqLZdfkil8PtJi4P8N2MMXucZq2yLp75ClViUlOVwyoHEDjYU433Aq+5zWP61+RGag==", + "dev": true, + "requires": { + "domelementtype": "^2.0.1", + "domhandler": "^4.2.0", + "entities": "^2.0.0" + } + }, + "domelementtype": { + "version": "2.3.0", + "resolved": "https://registry.npmjs.org/domelementtype/-/domelementtype-2.3.0.tgz", + "integrity": "sha512-OLETBj6w0OsagBwdXnPdN0cnMfF9opN69co+7ZrbfPGrdpPVNBUj02spi6B1N7wChLQiPn4CSH/zJvXw56gmHw==", + "dev": true + }, + "domhandler": { + "version": "4.3.1", + "resolved": "https://registry.npmjs.org/domhandler/-/domhandler-4.3.1.tgz", + "integrity": "sha512-GrwoxYN+uWlzO8uhUXRl0P+kHE4GtVPfYzVLcUxPL7KNdHKj66vvlhiweIHqYYXWlw+T8iLMp42Lm67ghw4WMQ==", + "dev": true, + "requires": { + "domelementtype": "^2.2.0" + } + }, + "domutils": { + "version": "2.8.0", + "resolved": "https://registry.npmjs.org/domutils/-/domutils-2.8.0.tgz", + "integrity": "sha512-w96Cjofp72M5IIhpjgobBimYEfoPjx1Vx0BSX9P30WBdZW2WIKU0T1Bd0kz2eNZ9ikjKgHbEyKx8BB6H1L3h3A==", + "dev": true, + "requires": { + "dom-serializer": "^1.0.1", + "domelementtype": "^2.2.0", + "domhandler": "^4.2.0" + } + }, + "electron-to-chromium": { + "version": "1.4.195", + "resolved": "https://registry.npmjs.org/electron-to-chromium/-/electron-to-chromium-1.4.195.tgz", + "integrity": "sha512-vefjEh0sk871xNmR5whJf9TEngX+KTKS3hOHpjoMpauKkwlGwtMz1H8IaIjAT/GNnX0TbGwAdmVoXCAzXf+PPg==", + "dev": true + }, + "emoji-regex": { + "version": "8.0.0", + "resolved": "https://registry.npmjs.org/emoji-regex/-/emoji-regex-8.0.0.tgz", + "integrity": "sha512-MSjYzcWNOA0ewAHpz0MxpYFvwg6yjy1NG3xteoqz644VCo/RPgnr1/GGt+ic3iJTzQ8Eu3TdM14SawnVUmGE6A==", + "dev": true + }, + "entities": { + "version": "2.2.0", + "resolved": "https://registry.npmjs.org/entities/-/entities-2.2.0.tgz", + "integrity": "sha512-p92if5Nz619I0w+akJrLZH0MX0Pb5DX39XOwQTtXSdQQOaYH03S1uIQp4mhOZtAXrxq4ViO67YTiLBo2638o9A==", + "dev": true + }, + "escalade": { + "version": "3.1.1", + "resolved": "https://registry.npmjs.org/escalade/-/escalade-3.1.1.tgz", + "integrity": "sha512-k0er2gUkLf8O0zKJiAhmkTnJlTvINGv7ygDNPbeIsX/TJjGJZHuh9B2UxbsaEkmlEo9MfhrSzmhIlhRlI2GXnw==", + "dev": true + }, + "fill-range": { + "version": "7.0.1", + "resolved": "https://registry.npmjs.org/fill-range/-/fill-range-7.0.1.tgz", + "integrity": "sha512-qOo9F+dMUmC2Lcb4BbVvnKJxTPjCm+RRpe4gDuGrzkL7mEVl/djYSu2OdQ2Pa302N4oqkSg9ir6jaLWJ2USVpQ==", + "dev": true, + "requires": { + "to-regex-range": "^5.0.1" + } + }, + "find-up": { + "version": "5.0.0", + "resolved": "https://registry.npmjs.org/find-up/-/find-up-5.0.0.tgz", + "integrity": "sha512-78/PXT1wlLLDgTzDs7sjq9hzz0vXD+zn+7wypEe4fXQxCmdmqfGsEPQxmiCSQI3ajFV91bVSsvNtrJRiW6nGng==", + "dev": true, + "requires": { + "locate-path": "^6.0.0", + "path-exists": "^4.0.0" + } + }, + "flatpickr": { + "version": "4.6.13", + "resolved": "https://registry.npmjs.org/flatpickr/-/flatpickr-4.6.13.tgz", + "integrity": "sha512-97PMG/aywoYpB4IvbvUJi0RQi8vearvU0oov1WW3k0WZPBMrTQVqekSX5CjSG/M4Q3i6A/0FKXC7RyAoAUUSPw==" + }, + "fraction.js": { + "version": "4.2.0", + "resolved": "https://registry.npmjs.org/fraction.js/-/fraction.js-4.2.0.tgz", + "integrity": "sha512-MhLuK+2gUcnZe8ZHlaaINnQLl0xRIGRfcGk2yl8xoQAfHrSsL3rYu6FCmBdkdbhc9EPlwyGHewaRsvwRMJtAlA==", + "dev": true + }, + "fsevents": { + "version": "2.3.2", + "resolved": "https://registry.npmjs.org/fsevents/-/fsevents-2.3.2.tgz", + "integrity": "sha512-xiqMQR4xAeHTuB9uWm+fFRcIOgKBMiOBP+eXiyT7jsgVCq1bkVygt00oASowB7EdtpOHaaPgKt812P9ab+DDKA==", + "dev": true, + "optional": true + }, + "get-caller-file": { + "version": "2.0.5", + "resolved": "https://registry.npmjs.org/get-caller-file/-/get-caller-file-2.0.5.tgz", + "integrity": "sha512-DyFP3BM/3YHTQOCUL/w0OZHR0lpKeGrxotcHWcqNEdnltqFwXVfhEBQ94eIo34AfQpo0rGki4cyIiftY06h2Fg==", + "dev": true + }, + "glob-parent": { + "version": "5.1.2", + "resolved": "https://registry.npmjs.org/glob-parent/-/glob-parent-5.1.2.tgz", + "integrity": "sha512-AOIgSQCepiJYwP3ARnGx+5VnTu2HBYdzbGP45eLw1vr3zB3vZLeyed1sC9hnbcOc9/SrMyM5RPQrkGz4aS9Zow==", + "dev": true, + "requires": { + "is-glob": "^4.0.1" + } + }, + "iframe-resizer": { + "version": "4.3.2", + "resolved": "https://registry.npmjs.org/iframe-resizer/-/iframe-resizer-4.3.2.tgz", + "integrity": "sha512-gOWo2hmdPjMQsQ+zTKbses08mDfDEMh4NneGQNP4qwePYujY1lguqP6gnbeJkf154gojWlBhIltlgnMfYjGHWA==" + }, + "immutable": { + "version": "4.1.0", + "resolved": "https://registry.npmjs.org/immutable/-/immutable-4.1.0.tgz", + "integrity": "sha512-oNkuqVTA8jqG1Q6c+UglTOD1xhC1BtjKI7XkCXRkZHrN5m18/XsnUp8Q89GkQO/z+0WjonSvl0FLhDYftp46nQ==", + "dev": true + }, + "is-binary-path": { + "version": "2.1.0", + "resolved": "https://registry.npmjs.org/is-binary-path/-/is-binary-path-2.1.0.tgz", + "integrity": "sha512-ZMERYes6pDydyuGidse7OsHxtbI7WVeUEozgR/g7rd0xUimYNlvZRE/K2MgZTjWy725IfelLeVcEM97mmtRGXw==", + "dev": true, + "requires": { + "binary-extensions": "^2.0.0" + } + }, + "is-extglob": { + "version": "2.1.1", + "resolved": "https://registry.npmjs.org/is-extglob/-/is-extglob-2.1.1.tgz", + "integrity": "sha512-SbKbANkN603Vi4jEZv49LeVJMn4yGwsbzZworEoyEiutsN3nJYdbO36zfhGJ6QEDpOZIFkDtnq5JRxmvl3jsoQ==", + "dev": true + }, + "is-fullwidth-code-point": { + "version": "3.0.0", + "resolved": "https://registry.npmjs.org/is-fullwidth-code-point/-/is-fullwidth-code-point-3.0.0.tgz", + "integrity": "sha512-zymm5+u+sCsSWyD9qNaejV3DFvhCKclKdizYaJUuHA83RLjb7nSuGnddCHGv0hk+KY7BMAlsWeK4Ueg6EV6XQg==", + "dev": true + }, + "is-glob": { + "version": "4.0.3", + "resolved": "https://registry.npmjs.org/is-glob/-/is-glob-4.0.3.tgz", + "integrity": "sha512-xelSayHH36ZgE7ZWhli7pW34hNbNl8Ojv5KVmkJD4hBdD3th8Tfk9vYasLM+mXWOZhFkgZfxhLSnrwRr4elSSg==", + "dev": true, + "requires": { + "is-extglob": "^2.1.1" + } + }, + "is-number": { + "version": "7.0.0", + "resolved": "https://registry.npmjs.org/is-number/-/is-number-7.0.0.tgz", + "integrity": "sha512-41Cifkg6e8TylSpdtTpeLVMqvSBEVzTttHvERD741+pnZ8ANv0004MRL43QKPDlK9cGvNp6NZWZUBlbGXYxxng==", + "dev": true + }, + "jquery": { + "version": "3.6.0", + "resolved": "https://registry.npmjs.org/jquery/-/jquery-3.6.0.tgz", + "integrity": "sha512-JVzAR/AjBvVt2BmYhxRCSYysDsPcssdmTFnzyLEts9qNwmjmu4JTAMYubEfwVOSwpQ1I1sKKFcxhZCI2buerfw==" + }, + "jquery-ui-dist": { + "version": "1.13.1", + "resolved": "https://registry.npmjs.org/jquery-ui-dist/-/jquery-ui-dist-1.13.1.tgz", + "integrity": "sha512-Y711Pu4BRVrAlL58KSxX4ail74jaCJZaZcdNDLava+MgZeNwmVWmyYiK7KxyoJu1MB73eSunjJvYDbOuNrOA7w==", + "requires": { + "jquery": ">=1.8.0 <4.0.0" + } + }, + "lilconfig": { + "version": "2.0.6", + "resolved": "https://registry.npmjs.org/lilconfig/-/lilconfig-2.0.6.tgz", + "integrity": "sha512-9JROoBW7pobfsx+Sq2JsASvCo6Pfo6WWoUW79HuB1BCoBXD4PLWJPqDF6fNj67pqBYTbAHkE57M1kS/+L1neOg==", + "dev": true + }, + "locate-path": { + "version": "6.0.0", + "resolved": "https://registry.npmjs.org/locate-path/-/locate-path-6.0.0.tgz", + "integrity": "sha512-iPZK6eYjbxRu3uB4/WZ3EsEIMJFMqAoopl3R+zuq0UjcAm/MO6KCweDgPfP3elTztoKP3KtnVHxTn2NHBSDVUw==", + "dev": true, + "requires": { + "p-locate": "^5.0.0" + } + }, + "lodash.memoize": { + "version": "4.1.2", + "resolved": "https://registry.npmjs.org/lodash.memoize/-/lodash.memoize-4.1.2.tgz", + "integrity": "sha512-t7j+NzmgnQzTAYXcsHYLgimltOV1MXHtlOWf6GjL9Kj8GK5FInw5JotxvbOs+IvV1/Dzo04/fCGfLVs7aXb4Ag==", + "dev": true + }, + "lodash.uniq": { + "version": "4.5.0", + "resolved": "https://registry.npmjs.org/lodash.uniq/-/lodash.uniq-4.5.0.tgz", + "integrity": "sha512-xfBaXQd9ryd9dlSDvnvI0lvxfLJlYAZzXomUYzLKtUeOQvOP5piqAWuGtrhWeqaXK9hhoM/iyJc5AV+XfsX3HQ==", + "dev": true + }, + "luxon": { + "version": "2.5.0", + "resolved": "https://registry.npmjs.org/luxon/-/luxon-2.5.0.tgz", + "integrity": "sha512-IDkEPB80Rb6gCAU+FEib0t4FeJ4uVOuX1CQ9GsvU3O+JAGIgu0J7sf1OarXKaKDygTZIoJyU6YdZzTFRu+YR0A==" + }, + "mathjax": { + "version": "3.2.2", + "resolved": "https://registry.npmjs.org/mathjax/-/mathjax-3.2.2.tgz", + "integrity": "sha512-Bt+SSVU8eBG27zChVewOicYs7Xsdt40qm4+UpHyX7k0/O9NliPc+x77k1/FEsPsjKPZGJvtRZM1vO+geW0OhGw==" + }, + "mdn-data": { + "version": "2.0.14", + "resolved": "https://registry.npmjs.org/mdn-data/-/mdn-data-2.0.14.tgz", + "integrity": "sha512-dn6wd0uw5GsdswPFfsgMp5NSB0/aDe6fK94YJV/AJDYXL6HVLWBsxeq7js7Ad+mU2K9LAlwpk6kN2D5mwCPVow==", + "dev": true + }, + "nanoid": { + "version": "3.3.4", + "resolved": "https://registry.npmjs.org/nanoid/-/nanoid-3.3.4.tgz", + "integrity": "sha512-MqBkQh/OHTS2egovRtLk45wEyNXwF+cokD+1YPf9u5VfJiRdAiRwB2froX5Co9Rh20xs4siNPm8naNotSD6RBw==", + "dev": true + }, + "node-releases": { + "version": "2.0.6", + "resolved": "https://registry.npmjs.org/node-releases/-/node-releases-2.0.6.tgz", + "integrity": "sha512-PiVXnNuFm5+iYkLBNeq5211hvO38y63T0i2KKh2KnUs3RpzJ+JtODFjkD8yjLwnDkTYF1eKXheUwdssR+NRZdg==", + "dev": true + }, + "normalize-path": { + "version": "3.0.0", + "resolved": "https://registry.npmjs.org/normalize-path/-/normalize-path-3.0.0.tgz", + "integrity": "sha512-6eZs5Ls3WtCisHWp9S2GUy8dqkpGi4BVSz3GaqiE6ezub0512ESztXUwUB6C6IKbQkY2Pnb/mD4WYojCRwcwLA==", + "dev": true + }, + "normalize-range": { + "version": "0.1.2", + "resolved": "https://registry.npmjs.org/normalize-range/-/normalize-range-0.1.2.tgz", + "integrity": "sha512-bdok/XvKII3nUpklnV6P2hxtMNrCboOjAcyBuQnWEhO665FwrSNRxU+AqpsyvO6LgGYPspN+lu5CLtw4jPRKNA==", + "dev": true + }, + "normalize-url": { + "version": "6.1.0", + "resolved": "https://registry.npmjs.org/normalize-url/-/normalize-url-6.1.0.tgz", + "integrity": "sha512-DlL+XwOy3NxAQ8xuC0okPgK46iuVNAK01YN7RueYBqqFeGsBjV9XmCAzAdgt+667bCl5kPh9EqKKDwnaPG1I7A==", + "dev": true + }, + "nth-check": { + "version": "2.1.1", + "resolved": "https://registry.npmjs.org/nth-check/-/nth-check-2.1.1.tgz", + "integrity": "sha512-lqjrjmaOoAnWfMmBPL+XNnynZh2+swxiX3WUE0s4yEHI6m+AwrK2UZOimIRl3X/4QctVqS8AiZjFqyOGrMXb/w==", + "dev": true, + "requires": { + "boolbase": "^1.0.0" + } + }, + "p-limit": { + "version": "3.1.0", + "resolved": "https://registry.npmjs.org/p-limit/-/p-limit-3.1.0.tgz", + "integrity": "sha512-TYOanM3wGwNGsZN2cVTYPArw454xnXj5qmWF1bEoAc4+cU/ol7GVh7odevjp1FNHduHc3KZMcFduxU5Xc6uJRQ==", + "dev": true, + "requires": { + "yocto-queue": "^0.1.0" + } + }, + "p-locate": { + "version": "5.0.0", + "resolved": "https://registry.npmjs.org/p-locate/-/p-locate-5.0.0.tgz", + "integrity": "sha512-LaNjtRWUBY++zB5nE/NwcaoMylSPk+S+ZHNB1TzdbMJMny6dynpAGt7X/tl/QYq3TIeE6nxHppbo2LGymrG5Pw==", + "dev": true, + "requires": { + "p-limit": "^3.0.2" + } + }, + "path-exists": { + "version": "4.0.0", + "resolved": "https://registry.npmjs.org/path-exists/-/path-exists-4.0.0.tgz", + "integrity": "sha512-ak9Qy5Q7jYb2Wwcey5Fpvg2KoAc/ZIhLSLOSBmRmygPsGwkVVt0fZa0qrtMz+m6tJTAHfZQ8FnmB4MG4LWy7/w==", + "dev": true + }, + "picocolors": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/picocolors/-/picocolors-1.0.0.tgz", + "integrity": "sha512-1fygroTLlHu66zi26VoTDv8yRgm0Fccecssto+MhsZ0D/DGW2sm8E8AjW7NU5VVTRt5GxbeZ5qBuJr+HyLYkjQ==", + "dev": true + }, + "picomatch": { + "version": "2.3.1", + "resolved": "https://registry.npmjs.org/picomatch/-/picomatch-2.3.1.tgz", + "integrity": "sha512-JU3teHTNjmE2VCGFzuY8EXzCDVwEqB2a8fsIvwaStHhAWJEeVd1o1QD80CU6+ZdEXXSLbSsuLwJjkCBWqRQUVA==", + "dev": true + }, + "postcss": { + "version": "8.4.14", + "resolved": "https://registry.npmjs.org/postcss/-/postcss-8.4.14.tgz", + "integrity": "sha512-E398TUmfAYFPBSdzgeieK2Y1+1cpdxJx8yXbK/m57nRhKSmk1GB2tO4lbLBtlkfPQTDKfe4Xqv1ASWPpayPEig==", + "dev": true, + "requires": { + "nanoid": "^3.3.4", + "picocolors": "^1.0.0", + "source-map-js": "^1.0.2" + } + }, + "postcss-calc": { + "version": "8.2.4", + "resolved": "https://registry.npmjs.org/postcss-calc/-/postcss-calc-8.2.4.tgz", + "integrity": "sha512-SmWMSJmB8MRnnULldx0lQIyhSNvuDl9HfrZkaqqE/WHAhToYsAvDq+yAsA/kIyINDszOp3Rh0GFoNuH5Ypsm3Q==", + "dev": true, + "requires": { + "postcss-selector-parser": "^6.0.9", + "postcss-value-parser": "^4.2.0" + } + }, + "postcss-colormin": { + "version": "5.3.0", + "resolved": "https://registry.npmjs.org/postcss-colormin/-/postcss-colormin-5.3.0.tgz", + "integrity": "sha512-WdDO4gOFG2Z8n4P8TWBpshnL3JpmNmJwdnfP2gbk2qBA8PWwOYcmjmI/t3CmMeL72a7Hkd+x/Mg9O2/0rD54Pg==", + "dev": true, + "requires": { + "browserslist": "^4.16.6", + "caniuse-api": "^3.0.0", + "colord": "^2.9.1", + "postcss-value-parser": "^4.2.0" + } + }, + "postcss-convert-values": { + "version": "5.1.2", + "resolved": "https://registry.npmjs.org/postcss-convert-values/-/postcss-convert-values-5.1.2.tgz", + "integrity": "sha512-c6Hzc4GAv95B7suy4udszX9Zy4ETyMCgFPUDtWjdFTKH1SE9eFY/jEpHSwTH1QPuwxHpWslhckUQWbNRM4ho5g==", + "dev": true, + "requires": { + "browserslist": "^4.20.3", + "postcss-value-parser": "^4.2.0" + } + }, + "postcss-discard-comments": { + "version": "5.1.2", + "resolved": "https://registry.npmjs.org/postcss-discard-comments/-/postcss-discard-comments-5.1.2.tgz", + "integrity": "sha512-+L8208OVbHVF2UQf1iDmRcbdjJkuBF6IS29yBDSiWUIzpYaAhtNl6JYnYm12FnkeCwQqF5LeklOu6rAqgfBZqQ==", + "dev": true, + "requires": {} + }, + "postcss-discard-duplicates": { + "version": "5.1.0", + "resolved": "https://registry.npmjs.org/postcss-discard-duplicates/-/postcss-discard-duplicates-5.1.0.tgz", + "integrity": "sha512-zmX3IoSI2aoenxHV6C7plngHWWhUOV3sP1T8y2ifzxzbtnuhk1EdPwm0S1bIUNaJ2eNbWeGLEwzw8huPD67aQw==", + "dev": true, + "requires": {} + }, + "postcss-discard-empty": { + "version": "5.1.1", + "resolved": "https://registry.npmjs.org/postcss-discard-empty/-/postcss-discard-empty-5.1.1.tgz", + "integrity": "sha512-zPz4WljiSuLWsI0ir4Mcnr4qQQ5e1Ukc3i7UfE2XcrwKK2LIPIqE5jxMRxO6GbI3cv//ztXDsXwEWT3BHOGh3A==", + "dev": true, + "requires": {} + }, + "postcss-discard-overridden": { + "version": "5.1.0", + "resolved": "https://registry.npmjs.org/postcss-discard-overridden/-/postcss-discard-overridden-5.1.0.tgz", + "integrity": "sha512-21nOL7RqWR1kasIVdKs8HNqQJhFxLsyRfAnUDm4Fe4t4mCWL9OJiHvlHPjcd8zc5Myu89b/7wZDnOSjFgeWRtw==", + "dev": true, + "requires": {} + }, + "postcss-merge-longhand": { + "version": "5.1.6", + "resolved": "https://registry.npmjs.org/postcss-merge-longhand/-/postcss-merge-longhand-5.1.6.tgz", + "integrity": "sha512-6C/UGF/3T5OE2CEbOuX7iNO63dnvqhGZeUnKkDeifebY0XqkkvrctYSZurpNE902LDf2yKwwPFgotnfSoPhQiw==", + "dev": true, + "requires": { + "postcss-value-parser": "^4.2.0", + "stylehacks": "^5.1.0" + } + }, + "postcss-merge-rules": { + "version": "5.1.2", + "resolved": "https://registry.npmjs.org/postcss-merge-rules/-/postcss-merge-rules-5.1.2.tgz", + "integrity": "sha512-zKMUlnw+zYCWoPN6yhPjtcEdlJaMUZ0WyVcxTAmw3lkkN/NDMRkOkiuctQEoWAOvH7twaxUUdvBWl0d4+hifRQ==", + "dev": true, + "requires": { + "browserslist": "^4.16.6", + "caniuse-api": "^3.0.0", + "cssnano-utils": "^3.1.0", + "postcss-selector-parser": "^6.0.5" + } + }, + "postcss-minify-font-values": { + "version": "5.1.0", + "resolved": "https://registry.npmjs.org/postcss-minify-font-values/-/postcss-minify-font-values-5.1.0.tgz", + "integrity": "sha512-el3mYTgx13ZAPPirSVsHqFzl+BBBDrXvbySvPGFnQcTI4iNslrPaFq4muTkLZmKlGk4gyFAYUBMH30+HurREyA==", + "dev": true, + "requires": { + "postcss-value-parser": "^4.2.0" + } + }, + "postcss-minify-gradients": { + "version": "5.1.1", + "resolved": "https://registry.npmjs.org/postcss-minify-gradients/-/postcss-minify-gradients-5.1.1.tgz", + "integrity": "sha512-VGvXMTpCEo4qHTNSa9A0a3D+dxGFZCYwR6Jokk+/3oB6flu2/PnPXAh2x7x52EkY5xlIHLm+Le8tJxe/7TNhzw==", + "dev": true, + "requires": { + "colord": "^2.9.1", + "cssnano-utils": "^3.1.0", + "postcss-value-parser": "^4.2.0" + } + }, + "postcss-minify-params": { + "version": "5.1.3", + "resolved": "https://registry.npmjs.org/postcss-minify-params/-/postcss-minify-params-5.1.3.tgz", + "integrity": "sha512-bkzpWcjykkqIujNL+EVEPOlLYi/eZ050oImVtHU7b4lFS82jPnsCb44gvC6pxaNt38Els3jWYDHTjHKf0koTgg==", + "dev": true, + "requires": { + "browserslist": "^4.16.6", + "cssnano-utils": "^3.1.0", + "postcss-value-parser": "^4.2.0" + } + }, + "postcss-minify-selectors": { + "version": "5.2.1", + "resolved": "https://registry.npmjs.org/postcss-minify-selectors/-/postcss-minify-selectors-5.2.1.tgz", + "integrity": "sha512-nPJu7OjZJTsVUmPdm2TcaiohIwxP+v8ha9NehQ2ye9szv4orirRU3SDdtUmKH+10nzn0bAyOXZ0UEr7OpvLehg==", + "dev": true, + "requires": { + "postcss-selector-parser": "^6.0.5" + } + }, + "postcss-normalize-charset": { + "version": "5.1.0", + "resolved": "https://registry.npmjs.org/postcss-normalize-charset/-/postcss-normalize-charset-5.1.0.tgz", + "integrity": "sha512-mSgUJ+pd/ldRGVx26p2wz9dNZ7ji6Pn8VWBajMXFf8jk7vUoSrZ2lt/wZR7DtlZYKesmZI680qjr2CeFF2fbUg==", + "dev": true, + "requires": {} + }, + "postcss-normalize-display-values": { + "version": "5.1.0", + "resolved": "https://registry.npmjs.org/postcss-normalize-display-values/-/postcss-normalize-display-values-5.1.0.tgz", + "integrity": "sha512-WP4KIM4o2dazQXWmFaqMmcvsKmhdINFblgSeRgn8BJ6vxaMyaJkwAzpPpuvSIoG/rmX3M+IrRZEz2H0glrQNEA==", + "dev": true, + "requires": { + "postcss-value-parser": "^4.2.0" + } + }, + "postcss-normalize-positions": { + "version": "5.1.1", + "resolved": "https://registry.npmjs.org/postcss-normalize-positions/-/postcss-normalize-positions-5.1.1.tgz", + "integrity": "sha512-6UpCb0G4eofTCQLFVuI3EVNZzBNPiIKcA1AKVka+31fTVySphr3VUgAIULBhxZkKgwLImhzMR2Bw1ORK+37INg==", + "dev": true, + "requires": { + "postcss-value-parser": "^4.2.0" + } + }, + "postcss-normalize-repeat-style": { + "version": "5.1.1", + "resolved": "https://registry.npmjs.org/postcss-normalize-repeat-style/-/postcss-normalize-repeat-style-5.1.1.tgz", + "integrity": "sha512-mFpLspGWkQtBcWIRFLmewo8aC3ImN2i/J3v8YCFUwDnPu3Xz4rLohDO26lGjwNsQxB3YF0KKRwspGzE2JEuS0g==", + "dev": true, + "requires": { + "postcss-value-parser": "^4.2.0" + } + }, + "postcss-normalize-string": { + "version": "5.1.0", + "resolved": "https://registry.npmjs.org/postcss-normalize-string/-/postcss-normalize-string-5.1.0.tgz", + "integrity": "sha512-oYiIJOf4T9T1N4i+abeIc7Vgm/xPCGih4bZz5Nm0/ARVJ7K6xrDlLwvwqOydvyL3RHNf8qZk6vo3aatiw/go3w==", + "dev": true, + "requires": { + "postcss-value-parser": "^4.2.0" + } + }, + "postcss-normalize-timing-functions": { + "version": "5.1.0", + "resolved": "https://registry.npmjs.org/postcss-normalize-timing-functions/-/postcss-normalize-timing-functions-5.1.0.tgz", + "integrity": "sha512-DOEkzJ4SAXv5xkHl0Wa9cZLF3WCBhF3o1SKVxKQAa+0pYKlueTpCgvkFAHfk+Y64ezX9+nITGrDZeVGgITJXjg==", + "dev": true, + "requires": { + "postcss-value-parser": "^4.2.0" + } + }, + "postcss-normalize-unicode": { + "version": "5.1.0", + "resolved": "https://registry.npmjs.org/postcss-normalize-unicode/-/postcss-normalize-unicode-5.1.0.tgz", + "integrity": "sha512-J6M3MizAAZ2dOdSjy2caayJLQT8E8K9XjLce8AUQMwOrCvjCHv24aLC/Lps1R1ylOfol5VIDMaM/Lo9NGlk1SQ==", + "dev": true, + "requires": { + "browserslist": "^4.16.6", + "postcss-value-parser": "^4.2.0" + } + }, + "postcss-normalize-url": { + "version": "5.1.0", + "resolved": "https://registry.npmjs.org/postcss-normalize-url/-/postcss-normalize-url-5.1.0.tgz", + "integrity": "sha512-5upGeDO+PVthOxSmds43ZeMeZfKH+/DKgGRD7TElkkyS46JXAUhMzIKiCa7BabPeIy3AQcTkXwVVN7DbqsiCew==", + "dev": true, + "requires": { + "normalize-url": "^6.0.1", + "postcss-value-parser": "^4.2.0" + } + }, + "postcss-normalize-whitespace": { + "version": "5.1.1", + "resolved": "https://registry.npmjs.org/postcss-normalize-whitespace/-/postcss-normalize-whitespace-5.1.1.tgz", + "integrity": "sha512-83ZJ4t3NUDETIHTa3uEg6asWjSBYL5EdkVB0sDncx9ERzOKBVJIUeDO9RyA9Zwtig8El1d79HBp0JEi8wvGQnA==", + "dev": true, + "requires": { + "postcss-value-parser": "^4.2.0" + } + }, + "postcss-ordered-values": { + "version": "5.1.3", + "resolved": "https://registry.npmjs.org/postcss-ordered-values/-/postcss-ordered-values-5.1.3.tgz", + "integrity": "sha512-9UO79VUhPwEkzbb3RNpqqghc6lcYej1aveQteWY+4POIwlqkYE21HKWaLDF6lWNuqCobEAyTovVhtI32Rbv2RQ==", + "dev": true, + "requires": { + "cssnano-utils": "^3.1.0", + "postcss-value-parser": "^4.2.0" + } + }, + "postcss-reduce-initial": { + "version": "5.1.0", + "resolved": "https://registry.npmjs.org/postcss-reduce-initial/-/postcss-reduce-initial-5.1.0.tgz", + "integrity": "sha512-5OgTUviz0aeH6MtBjHfbr57tml13PuedK/Ecg8szzd4XRMbYxH4572JFG067z+FqBIf6Zp/d+0581glkvvWMFw==", + "dev": true, + "requires": { + "browserslist": "^4.16.6", + "caniuse-api": "^3.0.0" + } + }, + "postcss-reduce-transforms": { + "version": "5.1.0", + "resolved": "https://registry.npmjs.org/postcss-reduce-transforms/-/postcss-reduce-transforms-5.1.0.tgz", + "integrity": "sha512-2fbdbmgir5AvpW9RLtdONx1QoYG2/EtqpNQbFASDlixBbAYuTcJ0dECwlqNqH7VbaUnEnh8SrxOe2sRIn24XyQ==", + "dev": true, + "requires": { + "postcss-value-parser": "^4.2.0" + } + }, + "postcss-selector-parser": { + "version": "6.0.10", + "resolved": "https://registry.npmjs.org/postcss-selector-parser/-/postcss-selector-parser-6.0.10.tgz", + "integrity": "sha512-IQ7TZdoaqbT+LCpShg46jnZVlhWD2w6iQYAcYXfHARZ7X1t/UGhhceQDs5X0cGqKvYlHNOuv7Oa1xmb0oQuA3w==", + "dev": true, + "requires": { + "cssesc": "^3.0.0", + "util-deprecate": "^1.0.2" + } + }, + "postcss-svgo": { + "version": "5.1.0", + "resolved": "https://registry.npmjs.org/postcss-svgo/-/postcss-svgo-5.1.0.tgz", + "integrity": "sha512-D75KsH1zm5ZrHyxPakAxJWtkyXew5qwS70v56exwvw542d9CRtTo78K0WeFxZB4G7JXKKMbEZtZayTGdIky/eA==", + "dev": true, + "requires": { + "postcss-value-parser": "^4.2.0", + "svgo": "^2.7.0" + } + }, + "postcss-unique-selectors": { + "version": "5.1.1", + "resolved": "https://registry.npmjs.org/postcss-unique-selectors/-/postcss-unique-selectors-5.1.1.tgz", + "integrity": "sha512-5JiODlELrz8L2HwxfPnhOWZYWDxVHWL83ufOv84NrcgipI7TaeRsatAhK4Tr2/ZiYldpK/wBvw5BD3qfaK96GA==", + "dev": true, + "requires": { + "postcss-selector-parser": "^6.0.5" + } + }, + "postcss-value-parser": { + "version": "4.2.0", + "resolved": "https://registry.npmjs.org/postcss-value-parser/-/postcss-value-parser-4.2.0.tgz", + "integrity": "sha512-1NNCs6uurfkVbeXG4S8JFT9t19m45ICnif8zWLd5oPSZ50QnwMfK+H3jv408d4jw/7Bttv5axS5IiHoLaVNHeQ==", + "dev": true + }, + "readdirp": { + "version": "3.6.0", + "resolved": "https://registry.npmjs.org/readdirp/-/readdirp-3.6.0.tgz", + "integrity": "sha512-hOS089on8RduqdbhvQ5Z37A0ESjsqz6qnRcffsMU3495FuTdqSm+7bhJ29JvIOsBDEEnan5DPu9t3To9VRlMzA==", + "dev": true, + "requires": { + "picomatch": "^2.2.1" + } + }, + "require-directory": { + "version": "2.1.1", + "resolved": "https://registry.npmjs.org/require-directory/-/require-directory-2.1.1.tgz", + "integrity": "sha512-fGxEI7+wsG9xrvdjsrlmL22OMTTiHRwAMroiEeMgq8gzoLC/PQr7RsRDSTLUg/bZAZtF+TVIkHc6/4RIKrui+Q==", + "dev": true + }, + "rtlcss": { + "version": "3.5.0", + "resolved": "https://registry.npmjs.org/rtlcss/-/rtlcss-3.5.0.tgz", + "integrity": "sha512-wzgMaMFHQTnyi9YOwsx9LjOxYXJPzS8sYnFaKm6R5ysvTkwzHiB0vxnbHwchHQT65PTdBjDG21/kQBWI7q9O7A==", + "dev": true, + "requires": { + "find-up": "^5.0.0", + "picocolors": "^1.0.0", + "postcss": "^8.3.11", + "strip-json-comments": "^3.1.1" + } + }, + "sass": { + "version": "1.53.0", + "resolved": "https://registry.npmjs.org/sass/-/sass-1.53.0.tgz", + "integrity": "sha512-zb/oMirbKhUgRQ0/GFz8TSAwRq2IlR29vOUJZOx0l8sV+CkHUfHa4u5nqrG+1VceZp7Jfj59SVW9ogdhTvJDcQ==", + "dev": true, + "requires": { + "chokidar": ">=3.0.0 <4.0.0", + "immutable": "^4.0.0", + "source-map-js": ">=0.6.2 <2.0.0" + } + }, + "sortablejs": { + "version": "1.15.0", + "resolved": "https://registry.npmjs.org/sortablejs/-/sortablejs-1.15.0.tgz", + "integrity": "sha512-bv9qgVMjUMf89wAvM6AxVvS/4MX3sPeN0+agqShejLU5z5GX4C75ow1O2e5k4L6XItUyAK3gH6AxSbXrOM5e8w==" + }, + "source-map": { + "version": "0.6.1", + "resolved": "https://registry.npmjs.org/source-map/-/source-map-0.6.1.tgz", + "integrity": "sha512-UjgapumWlbMhkBgzT7Ykc5YXUT46F0iKu8SGXq0bcwP5dz/h0Plj6enJqjz1Zbq2l5WaqYnrVbwWOWMyF3F47g==", + "dev": true + }, + "source-map-js": { + "version": "1.0.2", + "resolved": "https://registry.npmjs.org/source-map-js/-/source-map-js-1.0.2.tgz", + "integrity": "sha512-R0XvVJ9WusLiqTCEiGCmICCMplcCkIwwR11mOSD9CR5u+IXYdiseeEuXCVAjS54zqwkLcPNnmU4OeJ6tUrWhDw==", + "dev": true + }, + "source-map-support": { + "version": "0.5.21", + "resolved": "https://registry.npmjs.org/source-map-support/-/source-map-support-0.5.21.tgz", + "integrity": "sha512-uBHU3L3czsIyYXKX88fdrGovxdSCoTGDRZ6SYXtSRxLZUzHg5P/66Ht6uoUlHu9EZod+inXhKo3qQgwXUT/y1w==", + "dev": true, + "requires": { + "buffer-from": "^1.0.0", + "source-map": "^0.6.0" + } + }, + "stable": { + "version": "0.1.8", + "resolved": "https://registry.npmjs.org/stable/-/stable-0.1.8.tgz", + "integrity": "sha512-ji9qxRnOVfcuLDySj9qzhGSEFVobyt1kIOSkj1qZzYLzq7Tos/oUUWvotUPQLlrsidqsK6tBH89Bc9kL5zHA6w==", + "dev": true + }, + "string-width": { + "version": "4.2.3", + "resolved": "https://registry.npmjs.org/string-width/-/string-width-4.2.3.tgz", + "integrity": "sha512-wKyQRQpjJ0sIp62ErSZdGsjMJWsap5oRNihHhu6G7JVO/9jIB6UyevL+tXuOqrng8j/cxKTWyWUwvSTriiZz/g==", + "dev": true, + "requires": { + "emoji-regex": "^8.0.0", + "is-fullwidth-code-point": "^3.0.0", + "strip-ansi": "^6.0.1" + } + }, + "strip-ansi": { + "version": "6.0.1", + "resolved": "https://registry.npmjs.org/strip-ansi/-/strip-ansi-6.0.1.tgz", + "integrity": "sha512-Y38VPSHcqkFrCpFnQ9vuSXmquuv5oXOKpGeT6aGrr3o3Gc9AlVa6JBfUSOCnbxGGZF+/0ooI7KrPuUSztUdU5A==", + "dev": true, + "requires": { + "ansi-regex": "^5.0.1" + } + }, + "strip-json-comments": { + "version": "3.1.1", + "resolved": "https://registry.npmjs.org/strip-json-comments/-/strip-json-comments-3.1.1.tgz", + "integrity": "sha512-6fPc+R4ihwqP6N/aIv2f1gMH8lOVtWQHoqC4yK6oSDVVocumAsfCqjkXnqiYMhmMwS/mEHLp7Vehlt3ql6lEig==", + "dev": true + }, + "stylehacks": { + "version": "5.1.0", + "resolved": "https://registry.npmjs.org/stylehacks/-/stylehacks-5.1.0.tgz", + "integrity": "sha512-SzLmvHQTrIWfSgljkQCw2++C9+Ne91d/6Sp92I8c5uHTcy/PgeHamwITIbBW9wnFTY/3ZfSXR9HIL6Ikqmcu6Q==", + "dev": true, + "requires": { + "browserslist": "^4.16.6", + "postcss-selector-parser": "^6.0.4" + } + }, + "svgo": { + "version": "2.8.0", + "resolved": "https://registry.npmjs.org/svgo/-/svgo-2.8.0.tgz", + "integrity": "sha512-+N/Q9kV1+F+UeWYoSiULYo4xYSDQlTgb+ayMobAXPwMnLvop7oxKMo9OzIrX5x3eS4L4f2UHhc9axXwY8DpChg==", + "dev": true, + "requires": { + "@trysound/sax": "0.2.0", + "commander": "^7.2.0", + "css-select": "^4.1.3", + "css-tree": "^1.1.3", + "csso": "^4.2.0", + "picocolors": "^1.0.0", + "stable": "^0.1.8" + } + }, + "terser": { + "version": "5.14.2", + "resolved": "https://registry.npmjs.org/terser/-/terser-5.14.2.tgz", + "integrity": "sha512-oL0rGeM/WFQCUd0y2QrWxYnq7tfSuKBiqTjRPWrRgB46WD/kiwHwF8T23z78H6Q6kGCuuHcPB+KULHRdxvVGQA==", + "dev": true, + "requires": { + "@jridgewell/source-map": "^0.3.2", + "acorn": "^8.5.0", + "commander": "^2.20.0", + "source-map-support": "~0.5.20" + }, + "dependencies": { + "commander": { + "version": "2.20.3", + "resolved": "https://registry.npmjs.org/commander/-/commander-2.20.3.tgz", + "integrity": "sha512-GpVkmM8vF2vQUkj2LvZmD35JxeJOLCwJ9cUkugyk2nuhbv3+mJvpLYYt+0+USMxE+oj+ey/lJEnhZw75x/OMcQ==", + "dev": true + } + } + }, + "to-regex-range": { + "version": "5.0.1", + "resolved": "https://registry.npmjs.org/to-regex-range/-/to-regex-range-5.0.1.tgz", + "integrity": "sha512-65P7iz6X5yEr1cwcgvQxbbIw7Uk3gOy5dIdtZ4rDveLqhrdJP+Li/Hx6tyK0NEb+2GCyneCMJiGqrADCSNk8sQ==", + "dev": true, + "requires": { + "is-number": "^7.0.0" + } + }, + "update-browserslist-db": { + "version": "1.0.5", + "resolved": "https://registry.npmjs.org/update-browserslist-db/-/update-browserslist-db-1.0.5.tgz", + "integrity": "sha512-dteFFpCyvuDdr9S/ff1ISkKt/9YZxKjI9WlRR99c180GaztJtRa/fn18FdxGVKVsnPY7/a/FDN68mcvUmP4U7Q==", + "dev": true, + "requires": { + "escalade": "^3.1.1", + "picocolors": "^1.0.0" + } + }, + "util-deprecate": { + "version": "1.0.2", + "resolved": "https://registry.npmjs.org/util-deprecate/-/util-deprecate-1.0.2.tgz", + "integrity": "sha512-EPD5q1uXyFxJpCrLnCc1nHnq3gOa6DZBocAIiI2TaSCA7VCJ1UJDMagCzIkXNsUYfD1daK//LTEQ8xiIbrHtcw==", + "dev": true + }, + "wrap-ansi": { + "version": "7.0.0", + "resolved": "https://registry.npmjs.org/wrap-ansi/-/wrap-ansi-7.0.0.tgz", + "integrity": "sha512-YVGIj2kamLSTxw6NsZjoBxfSwsn0ycdesmc4p+Q21c5zPuZ1pl+NfxVdxPtdHvmNVOQ6XSYG4AUtyt/Fi7D16Q==", + "dev": true, + "requires": { + "ansi-styles": "^4.0.0", + "string-width": "^4.1.0", + "strip-ansi": "^6.0.0" + } + }, + "y18n": { + "version": "5.0.8", + "resolved": "https://registry.npmjs.org/y18n/-/y18n-5.0.8.tgz", + "integrity": "sha512-0pfFzegeDWJHJIAmTLRP2DwHjdF5s7jo9tuztdQxAhINCdvS+3nGINqPd00AphqJR/0LhANUS6/+7SCb98YOfA==", + "dev": true + }, + "yaml": { + "version": "1.10.2", + "resolved": "https://registry.npmjs.org/yaml/-/yaml-1.10.2.tgz", + "integrity": "sha512-r3vXyErRCYJ7wg28yvBY5VSoAF8ZvlcW9/BwUzEtUsjvX/DKs24dIkuwjtuprwJJHsbyUbLApepYTR1BN4uHrg==", + "dev": true + }, + "yargs": { + "version": "16.2.0", + "resolved": "https://registry.npmjs.org/yargs/-/yargs-16.2.0.tgz", + "integrity": "sha512-D1mvvtDG0L5ft/jGWkLpG1+m0eQxOfaBvTNELraWj22wSVUMWxZUvYgJYcKh6jGGIkJFhH4IZPQhR4TKpc8mBw==", + "dev": true, + "requires": { + "cliui": "^7.0.2", + "escalade": "^3.1.1", + "get-caller-file": "^2.0.5", + "require-directory": "^2.1.1", + "string-width": "^4.2.0", + "y18n": "^5.0.5", + "yargs-parser": "^20.2.2" + } + }, + "yargs-parser": { + "version": "20.2.9", + "resolved": "https://registry.npmjs.org/yargs-parser/-/yargs-parser-20.2.9.tgz", + "integrity": "sha512-y11nGElTIV+CT3Zv9t7VKl+Q3hTQoT9a1Qzezhhl6Rp21gJ/IVTW7Z3y9EWXhuUBC2Shnf+DX0antecpAwSP8w==", + "dev": true + }, + "yocto-queue": { + "version": "0.1.0", + "resolved": "https://registry.npmjs.org/yocto-queue/-/yocto-queue-0.1.0.tgz", + "integrity": "sha512-rVksvsnNCdJ/ohGc6xgPwyN8eheCxsiLM8mxuE/t/mOVqJewPuO1miLpTHQiRgTKCLexL4MeAFVagts7HmNZ2Q==", + "dev": true + } + } +} diff --git a/htdocs/package.json b/htdocs/package.json index d759d10e90..3593a5c195 100644 --- a/htdocs/package.json +++ b/htdocs/package.json @@ -12,7 +12,7 @@ }, "dependencies": { "@fortawesome/fontawesome-free": "^6.0.0", - "bootstrap": "^5.1.3", + "bootstrap": "~5.1.3", "codemirror": "^5.65.2", "flatpickr": "^4.6.9", "iframe-resizer": "^4.3.2", From e6618bcb4bfa5d64db5856141e699192d2c184fb Mon Sep 17 00:00:00 2001 From: Nathan Wallach Date: Wed, 20 Jul 2022 16:58:35 +0300 Subject: [PATCH 003/490] Change to using MathJax's SVG output, as Firefox had a bug which caused some thin lines to disappear when it renders from MathJax's CHTML output at certain Zoom levels. See: https://bugzilla.mozilla.org/show_bug.cgi?id=1741887 https://github.com/openwebwork/webwork2/issues/1524 --- htdocs/themes/math4/gateway.template | 2 +- htdocs/themes/math4/system.template | 2 +- htdocs/third-party-assets.json | 2 +- lib/FormatRenderedProblem.pm | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/htdocs/themes/math4/gateway.template b/htdocs/themes/math4/gateway.template index 80bb4d4594..15a2f6fa69 100644 --- a/htdocs/themes/math4/gateway.template +++ b/htdocs/themes/math4/gateway.template @@ -37,7 +37,7 @@ "/> - + diff --git a/htdocs/themes/math4/system.template b/htdocs/themes/math4/system.template index 5e0f18a24f..3639d99b7a 100644 --- a/htdocs/themes/math4/system.template +++ b/htdocs/themes/math4/system.template @@ -42,7 +42,7 @@ - + diff --git a/htdocs/third-party-assets.json b/htdocs/third-party-assets.json index 89957c826b..7eeaa94bdb 100644 --- a/htdocs/third-party-assets.json +++ b/htdocs/third-party-assets.json @@ -99,6 +99,6 @@ "node_modules/jquery-ui-dist/jquery-ui.min.js": "https://cdn.jsdelivr.net/npm/jquery-ui-dist@1.13.1/jquery-ui.min.js", "node_modules/jquery/dist/jquery.min.js": "https://cdn.jsdelivr.net/npm/jquery@3.6.0/dist/jquery.min.js", "node_modules/luxon/build/global/luxon.min.js": "https://cdn.jsdelivr.net/npm/luxon@2.3.1/build/global/luxon.min.js", - "node_modules/mathjax/es5/tex-chtml.js": "https://cdn.jsdelivr.net/npm/mathjax@3.2.0/es5/tex-chtml.js", + "node_modules/mathjax/es5/tex-svg.js": "https://cdn.jsdelivr.net/npm/mathjax@3.2.0/es5/tex-svg.js", "node_modules/sortablejs/Sortable.min.js": "https://cdn.jsdelivr.net/npm/sortablejs@1.14.0/Sortable.min.js" } diff --git a/lib/FormatRenderedProblem.pm b/lib/FormatRenderedProblem.pm index 2084cb676f..a9d5871404 100644 --- a/lib/FormatRenderedProblem.pm +++ b/lib/FormatRenderedProblem.pm @@ -194,7 +194,7 @@ sub formatRenderedProblem { [ 'node_modules/jquery-ui-dist/jquery-ui.min.js', 0, {} ], [ 'node_modules/iframe-resizer/js/iframeResizer.contentWindow.min.js', 0, {} ], [ 'js/apps/MathJaxConfig/mathjax-config.js', 0, { defer => undef } ], - [ 'node_modules/mathjax/es5/tex-chtml.js', 0, { defer => undef, id => 'MathJax-script' } ], + [ 'node_modules/mathjax/es5/tex-svg.js', 0, { defer => undef, id => 'MathJax-script' } ], [ 'node_modules/bootstrap/dist/js/bootstrap.bundle.min.js', 0, { defer => undef } ], [ 'js/apps/Problem/problem.js', 0, { defer => undef } ], [ 'math4.js', 1, { defer => undef } ], From c2ac94ff45a88d4f2c8a54356c14511fa53747df Mon Sep 17 00:00:00 2001 From: Glenn Rice Date: Wed, 20 Jul 2022 12:31:58 -0500 Subject: [PATCH 004/490] Move the "busy indicator" of the pg problem editor into the modal and show the modal immediately, rather than showing the "busy indicator", and then showing the modal after the page loads. This solves several issues with content not being rendered correctly due to the page not having size yet (for example MathJax in SVG mode). --- htdocs/js/apps/PGProblemEditor/pgproblemeditor.js | 4 ++-- htdocs/themes/math4/math4.scss | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/htdocs/js/apps/PGProblemEditor/pgproblemeditor.js b/htdocs/js/apps/PGProblemEditor/pgproblemeditor.js index 062cf4950c..7a50b8cbca 100644 --- a/htdocs/js/apps/PGProblemEditor/pgproblemeditor.js +++ b/htdocs/js/apps/PGProblemEditor/pgproblemeditor.js @@ -23,7 +23,6 @@ frame.contentWindow.addEventListener('resize', () => frame.contentDocument.getElementById('content').classList.remove('col-md-10') ); - bsModal.show(); }); document.getElementById('submit_button_id')?.addEventListener('click', () => { @@ -39,13 +38,14 @@ document.getElementById('editor').target = target; if (target == "pg_editor_frame") { + bsModal.show(); busyIndicator = document.createElement('div'); busyIndicator.classList.add('page-loading-busy-indicator'); busyIndicator.innerHTML = '

Loading...

' + '
' + '
Press escape to cancel
'; busyIndicator.tabIndex = -1; - document.body.appendChild(busyIndicator); + bsModal._element.querySelector('.modal-body')?.appendChild(busyIndicator); busyIndicator.focus(); // Allow the user to cancel loading of the iframe by pressing escape. diff --git a/htdocs/themes/math4/math4.scss b/htdocs/themes/math4/math4.scss index e51a52a366..fa9d18ce95 100644 --- a/htdocs/themes/math4/math4.scss +++ b/htdocs/themes/math4/math4.scss @@ -766,7 +766,7 @@ input.changed[type=text] { /* orange */ /* Page loading busy indicator */ /* Currently only used on the problem editor page. */ .page-loading-busy-indicator { - position: fixed; + position: absolute; width: 100%; height: 100%; left: 0; From 76d826b37511afded571426b57e78ace23ab9d05 Mon Sep 17 00:00:00 2001 From: "K. Andrew Parker" Date: Tue, 2 Aug 2022 16:10:48 -0400 Subject: [PATCH 005/490] add consent request to script, safe filenaming --- bin/upload-OPL-statistics.pl | 83 +++++++++++++++++++++++------------- 1 file changed, 53 insertions(+), 30 deletions(-) diff --git a/bin/upload-OPL-statistics.pl b/bin/upload-OPL-statistics.pl index 998dbfa4ec..8aeefd89bd 100755 --- a/bin/upload-OPL-statistics.pl +++ b/bin/upload-OPL-statistics.pl @@ -28,7 +28,7 @@ BEGIN use WeBWorK::CourseEnvironment; -use Net::Domain; +use Net::Domain qw/domainname/; use String::ShellQuote; my $ce = new WeBWorK::CourseEnvironment({ @@ -43,39 +43,42 @@ BEGIN my $dbuser = $ce->{database_username}; my $dbpass = $ce->{database_password}; -my $domainname = Net::Domain::domainname; +my $domainname = domainname() || 'unknown'; my $time = time(); my $output_file = "$domainname-$time-opl.sql"; + +my $done; +my $desc; +my $input; +my $answered; +do { + print <<'END_REQUEST'; +WeBWorK and the Open Problem Library (OPL) are provided freely under an +open-source license. We ask that you share your OPL usage statistics for +the benefit of all who use WeBWorK. The following information will be shared +with the WeBWorK community if you agree: -print "Dumping local OPL statistics\n"; - -$dbuser = shell_quote($dbuser); -$db = shell_quote($db); - -$ENV{'MYSQL_PWD'}=$dbpass; - -my $mysqldump_command = $ce->{externalPrograms}->{mysqldump}; - -# Conditionally add --column-statistics=0 as MariaDB databases do not support it -# see: https://serverfault.com/questions/912162/mysqldump-throws-unknown-table-column-statistics-in-information-schema-1109 -# https://github.com/drush-ops/drush/issues/4410 - -my $column_statistics_off = ""; -my $test_for_column_statistics = `$mysqldump_command --help | grep 'column-statistics'`; -if ( $test_for_column_statistics ) { - $column_statistics_off = " --column-statistics=0 "; -} +* a list of OPL problems that have been used on your server, with + the following statistics for each: -`$mysqldump_command --host=$host --port=$port --user=$dbuser $column_statistics_off $db OPL_local_statistics > $output_file`; + * the total number of users who attempted the problem + * the average number of attempts made per user on the problem + * the average completion percentage for each user who attempted the problem -print "Database File Created\n"; +Share OPL usage statistics with the WeBWorK community [Y/N]: +END_REQUEST + $input = ; + chomp $input; -my $done; -my $desc; -my $input; + if ( $input =~ m/y/i ) { + $answered = 1; + } + elsif ( $input =~ m/n/i ) { + exit; + } +} while ( !$answered ); do { - print "\nWe would appreciate it if you could provide \nsome basic information to help us \nkeep track of the data we receive.\n\n"; $desc = "File:\n$output_file\n"; @@ -132,8 +135,6 @@ BEGIN print $desc."\n"; - my $answered; - do { print "Please choose one of the following:\n"; print "1. Upload Data\n"; @@ -155,10 +156,8 @@ BEGIN } else { $answered = 0; } - } while (!$answered); - } while (!$done); my $desc_file = "$domainname-$time-desc.txt"; @@ -170,6 +169,30 @@ BEGIN close($fh); +print "Dumping local OPL statistics\n"; + +$dbuser = shell_quote($dbuser); +$db = shell_quote($db); + +$ENV{'MYSQL_PWD'} = $dbpass; + +my $mysqldump_command = $ce->{externalPrograms}->{mysqldump}; + +# Conditionally add --column-statistics=0 as MariaDB databases do not support it +# see: https://serverfault.com/questions/912162/mysqldump-throws-unknown-table-column-statistics-in-information-schema-1109 +# https://github.com/drush-ops/drush/issues/4410 + +my $column_statistics_off = ""; +my $test_for_column_statistics = + `$mysqldump_command --help | grep 'column-statistics'`; +if ($test_for_column_statistics) { + $column_statistics_off = " --column-statistics=0 "; +} + +`$mysqldump_command --host=$host --port=$port --user=$dbuser $column_statistics_off $db OPL_local_statistics > $output_file`; + +print "Database File Created\n"; + my $tar_file = "$domainname-$time-data.tar.gz"; print "Zipping files\n"; From d6b292ae5c6f1d69e17ef741c7dc218ae2e49713 Mon Sep 17 00:00:00 2001 From: Glenn Rice Date: Fri, 5 Aug 2022 16:48:29 -0500 Subject: [PATCH 006/490] Fix the "Grade Problem" link for essay problems on the problem set page. This fixes part of issue #1774. The issue is that the merged problem does not hold the essay flag. The global problem does. So those have to be fetched from the database for this. --- lib/WeBWorK/ContentGenerator/ProblemSet.pm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lib/WeBWorK/ContentGenerator/ProblemSet.pm b/lib/WeBWorK/ContentGenerator/ProblemSet.pm index cf59c8fad7..a2d739ff89 100644 --- a/lib/WeBWorK/ContentGenerator/ProblemSet.pm +++ b/lib/WeBWorK/ContentGenerator/ProblemSet.pm @@ -783,9 +783,10 @@ sub body { if ($authz->hasPermissions($user, "access_instructor_tools") && $authz->hasPermissions($user, "score_sets")) { my @setUsers = $db->listSetUsers($setName); + my @globalProblems = $db->getGlobalProblemsWhere({ set_id => $setName }); my @gradeableProblems; - for my $problem (@problems) { + for my $problem (@globalProblems) { if ($problem->flags =~ /essay/) { $canScoreProblems = 1; $gradeableProblems[ $problem->problem_id ] = 1; From 75f0738a2fa218b794df4eca7f4da587fdf44bee Mon Sep 17 00:00:00 2001 From: "K. Andrew Parker" Date: Thu, 11 Aug 2022 17:48:37 -0400 Subject: [PATCH 007/490] provide errors when called scripts fail --- bin/OPL-update | 22 ++++++++++++++++------ bin/download-OPL-metadata-release.pl | 10 +++++++++- docker-config/docker-entrypoint.sh | 2 +- 3 files changed, 26 insertions(+), 8 deletions(-) diff --git a/bin/OPL-update b/bin/OPL-update index 8921d9a1d8..d34e402351 100755 --- a/bin/OPL-update +++ b/bin/OPL-update @@ -36,25 +36,35 @@ use WeBWorK::CourseEnvironment; my $ce = new WeBWorK::CourseEnvironment({webwork_dir=>$ENV{WEBWORK_ROOT}}); print "\nDownloading the latest OPL release.\n"; -do $ENV{WEBWORK_ROOT} . '/bin/download-OPL-metadata-release.pl'; +runScript("$ENV{WEBWORK_ROOT}/bin/download-OPL-metadata-release.pl"); # Generate set definition list files. -do $ENV{WEBWORK_ROOT} . '/bin/generate-OPL-set-def-lists.pl'; +runScript("$ENV{WEBWORK_ROOT}/bin/generate-OPL-set-def-lists.pl"); if ($ce->{problemLibrary}{showLibraryLocalStats} || $ce->{problemLibrary}{showLibraryGlobalStats}) { print "\nUpdating Library Statistics.\n"; - do $ENV{WEBWORK_ROOT}.'/bin/update-OPL-statistics.pl'; + runScript("$ENV{WEBWORK_ROOT}/bin/update-OPL-statistics.pl"); print "\nLoading global statistics (if possible).\n"; - do $ENV{WEBWORK_ROOT}.'/bin/load-OPL-global-statistics.pl'; + runScript("$ENV{WEBWORK_ROOT}/bin/load-OPL-global-statistics.pl"); - if ( $ENV{SKIP_UPLOAD_OPL_statistics} ) { + if ( $ENV{SKIP_UPLOAD_OPL_STATISTICS} ) { print "\nSkipping upload-OPL-statistics as requested\n"; } else { print "\nSharing aggregated statistics\n"; - do $ENV{WEBWORK_ROOT}.'/bin/upload-OPL-statistics.pl'; + runScript("$ENV{WEBWORK_ROOT}/bin/upload-OPL-statistics.pl"); } } print "\nDone.\n"; + +sub runScript { + my $script_path = shift; + unless ( do $script_path ) { + warn "Execution of $script_path failed:\n"; + die $@ if $@; + } +} + +1; \ No newline at end of file diff --git a/bin/download-OPL-metadata-release.pl b/bin/download-OPL-metadata-release.pl index b87a2ebbe1..326330590f 100755 --- a/bin/download-OPL-metadata-release.pl +++ b/bin/download-OPL-metadata-release.pl @@ -86,7 +86,7 @@ BEGIN copy("$ce->{webworkDirs}{tmp}/webwork-open-problem-library/TABLE-DUMP/OPL-tables.sql", "$libraryDirectory/TABLE-DUMP"); say 'Restoring OPL tables from release database dump.'; -do $ENV{WEBWORK_ROOT} . '/bin/restore-OPL-tables.pl'; +runScript("$ENV{WEBWORK_ROOT}/bin/restore-OPL-tables.pl"); # Remove temporary files. say "Removing temporary files."; @@ -95,4 +95,12 @@ BEGIN say 'Done!'; +sub runScript { + my $script_path = shift; + unless (do $script_path) { + warn "Execution of $script_path failed:\n"; + die $@ if $@; + } +} + 1; diff --git a/docker-config/docker-entrypoint.sh b/docker-config/docker-entrypoint.sh index 3a7979cb7e..9bfee599f0 100755 --- a/docker-config/docker-entrypoint.sh +++ b/docker-config/docker-entrypoint.sh @@ -166,7 +166,7 @@ if [ "$1" = 'apache2' ]; then if [ -f "$APP_ROOT/libraries/Restore_or_build_OPL_tables" ]; then if [ ! -f "$APP_ROOT/libraries/webwork-open-problem-library/TABLE-DUMP/OPL-tables.sql" ]; then # Download the metadata and install it - export SKIP_UPLOAD_OPL_statistics=1 + export SKIP_UPLOAD_OPL_STATISTICS=1 if [ ! -d $APP_ROOT/libraries/webwork-open-problem-library/JSON-SAVED ]; then mkdir $APP_ROOT/libraries/webwork-open-problem-library/JSON-SAVED fi From 1b8496eadabe8d0505a83ecd7e4c25ad4cdebe9c Mon Sep 17 00:00:00 2001 From: Paul Vojta Date: Thu, 11 Aug 2022 23:56:48 -0700 Subject: [PATCH 008/490] Fix misspelling: Managment --> Management --- lib/WeBWorK/Authz.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lib/WeBWorK/Authz.pm b/lib/WeBWorK/Authz.pm index 06619daf73..c5f770cdf7 100644 --- a/lib/WeBWorK/Authz.pm +++ b/lib/WeBWorK/Authz.pm @@ -496,8 +496,8 @@ sub checkSet { if ($LTIGradeMode eq 'homework' && !$self->hasPermissions($userName, "view_unopened_sets")) { my $LMS = ($ce->{LMS_url}) ? CGI::a({ href => $ce->{LMS_url} }, $ce->{LMS_name}) : $ce->{LMS_name}; return $r->maketext( - 'You must use your Learning Managment System ([_1]) to access this set. ' - . 'Try logging in to the Learning Managment System and visiting the set from there.', + 'You must use your Learning Management System ([_1]) to access this set. ' + . 'Try logging in to the Learning Management System and visiting the set from there.', $LMS ) unless $set->lis_source_did; } From 272c90eb0cb726fc5e8b1d4a7e8e271ba021ffec Mon Sep 17 00:00:00 2001 From: "K. Andrew Parker" Date: Fri, 12 Aug 2022 10:42:44 -0400 Subject: [PATCH 009/490] move runScript to module, update check_modules --- bin/Helper.pm | 17 +++++++++++++++++ bin/OPL-update | 11 ++--------- bin/check_modules.pl | 1 + bin/download-OPL-metadata-release.pl | 10 ++-------- 4 files changed, 22 insertions(+), 17 deletions(-) create mode 100644 bin/Helper.pm diff --git a/bin/Helper.pm b/bin/Helper.pm new file mode 100644 index 0000000000..42ea0a38db --- /dev/null +++ b/bin/Helper.pm @@ -0,0 +1,17 @@ +package Helper; + +use warnings; +use strict; +use base 'Exporter'; + +our @EXPORT_OK = 'runScript'; + +sub runScript { + my $script_path = shift; + unless ( do $script_path ) { + warn "Execution of $script_path failed:\n"; + die $@ if $@; + } +} + +1; diff --git a/bin/OPL-update b/bin/OPL-update index d34e402351..2cc22468fc 100755 --- a/bin/OPL-update +++ b/bin/OPL-update @@ -32,6 +32,7 @@ use lib "$ENV{WEBWORK_ROOT}/lib"; use lib "$ENV{PG_ROOT}/lib"; use lib "$ENV{WEBWORK_ROOT}/bin"; use WeBWorK::CourseEnvironment; +use Helper 'runScript'; my $ce = new WeBWorK::CourseEnvironment({webwork_dir=>$ENV{WEBWORK_ROOT}}); @@ -59,12 +60,4 @@ if ($ce->{problemLibrary}{showLibraryLocalStats} || print "\nDone.\n"; -sub runScript { - my $script_path = shift; - unless ( do $script_path ) { - warn "Execution of $script_path failed:\n"; - die $@ if $@; - } -} - -1; \ No newline at end of file +1; diff --git a/bin/check_modules.pl b/bin/check_modules.pl index fce7db8038..86b91136e2 100755 --- a/bin/check_modules.pl +++ b/bin/check_modules.pl @@ -94,6 +94,7 @@ =head1 DESCRIPTION Errno Exception::Class File::Copy + File::Fetch File::Find File::Find::Rule File::Path diff --git a/bin/download-OPL-metadata-release.pl b/bin/download-OPL-metadata-release.pl index 326330590f..227da0f688 100755 --- a/bin/download-OPL-metadata-release.pl +++ b/bin/download-OPL-metadata-release.pl @@ -21,9 +21,11 @@ BEGIN } use lib "$ENV{WEBWORK_ROOT}/lib"; +use lib "$ENV{WEBWORK_ROOT}/bin"; use lib "$pg_dir/lib"; use WeBWorK::CourseEnvironment; +use Helper 'runScript'; my $ce = new WeBWorK::CourseEnvironment({ webwork_dir => $ENV{WEBWORK_ROOT} }); @@ -95,12 +97,4 @@ BEGIN say 'Done!'; -sub runScript { - my $script_path = shift; - unless (do $script_path) { - warn "Execution of $script_path failed:\n"; - die $@ if $@; - } -} - 1; From 155bfdf08e8041fccb0cd753a7e4d49d04aec980 Mon Sep 17 00:00:00 2001 From: Doug Torrance Date: Wed, 10 Aug 2022 08:51:45 -0400 Subject: [PATCH 010/490] Update WeBWorK project URL in footer The current link (webwork.maa.org) says "This page is no longer being maintained". --- lib/WeBWorK/ContentGenerator.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/WeBWorK/ContentGenerator.pm b/lib/WeBWorK/ContentGenerator.pm index 79bb6917db..7351a88c6c 100644 --- a/lib/WeBWorK/ContentGenerator.pm +++ b/lib/WeBWorK/ContentGenerator.pm @@ -1259,7 +1259,7 @@ sub footer { 'WeBWorK © [_1] | theme: [_2] | ww_version: [_3] | pg_version [_4] |', $copyright_years, $theme, $ww_version, $pg_version ), - CGI::a({ href => 'https://webwork.maa.org/' }, $r->maketext('The WeBWorK Project')) + CGI::a({ href => 'https://openwebwork.org/' }, $r->maketext('The WeBWorK Project')) ); return ''; From 0d4e03da32a69b285b6d9ae5a680e02051c751ae Mon Sep 17 00:00:00 2001 From: Glenn Rice Date: Tue, 16 Aug 2022 06:10:45 -0500 Subject: [PATCH 011/490] Add the select all checkbox to the Hmwk Sets Editor export sets page. See issue #1786. Note that this is different than WeBWorK 2.16 and before. Prior versions of WeBWorK had an empty table heading above the select set checkbox. This adds the select all checkbox instead. I can't exactly figure out how the empty header was added by looking at the WeBWorK 2.16 code. So I took the approach of adding the select all checkbox instead, since that was clearly easy to implement. In my opinion this is better anyway. --- lib/WeBWorK/ContentGenerator/Instructor/ProblemSetList.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/WeBWorK/ContentGenerator/Instructor/ProblemSetList.pm b/lib/WeBWorK/ContentGenerator/Instructor/ProblemSetList.pm index b4b30b970f..74fbd2fffc 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/ProblemSetList.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/ProblemSetList.pm @@ -2723,7 +2723,7 @@ sub printTableHTML { my @tableHeadings = map { $fieldHeaders{$_} } @realFieldNames; - if (!($editMode || $exportMode)) { + if (!$editMode) { unshift @tableHeadings, CGI::th(CGI::input({ type => 'checkbox', From d8a3b2b40634bd31acd5ba10c46bf5873d7b0fed Mon Sep 17 00:00:00 2001 From: Nathan Wallach Date: Thu, 1 Sep 2022 16:05:18 +0300 Subject: [PATCH 012/490] Drop the CSS override forcing CodeMirror to have the LTR direction. That is a default of the version of CodeMirror now being used in WeBWorK (loaded via the "npm install"). MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Modify the value of unicode-bidi for CodeMirror lines, as BootStrap sets        unicode-bidi: bidi-override; in node_modules/bootstrap/scss/_reboot.scss for all HTML pre elements, and that gets applied to the elements inside the CodeMirror editor also. The BootStrap settng interferes with the Unicode bidirectional algorithm processing Hebrew (and other right-to-left language) text inside the lines in the CodeMirror editor, so that the characters appear from left to right (logical layout) instead of from right-to-left (the expected visual layout). --- htdocs/js/apps/PGCodeMirror/pgeditor.css | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/htdocs/js/apps/PGCodeMirror/pgeditor.css b/htdocs/js/apps/PGCodeMirror/pgeditor.css index 06f8c070af..c48abd6f2e 100644 --- a/htdocs/js/apps/PGCodeMirror/pgeditor.css +++ b/htdocs/js/apps/PGCodeMirror/pgeditor.css @@ -22,7 +22,10 @@ /* CodeMirror overrides */ .CodeMirror-code { outline: none; - direction: ltr !important; +} + +pre.CodeMirror-line { + unicode-bidi: embed; } /* Match Highligher CSS */ From 555e2c4fc7c04a9700fb4ae30d353da233b32096 Mon Sep 17 00:00:00 2001 From: Nathan Wallach Date: Thu, 1 Sep 2022 16:27:55 +0300 Subject: [PATCH 013/490] Add a checkbox under the CodeMirror Editor which when marked changes the CodeMirror direction setting to "rtl". That setting is suitable for use when viewing lines containing text in a right-to-left language like Hebrew and Arabic. It starts all the text on the right side, and punctuation will be layed out as would be expected for right-to-left text. In the (default) left to right mode, the Unicode bidirectional algorithm will display the words of a right-to-left language correctly, but punctuation is influenced by the "main" direction of the line, which is LTR by default. --- htdocs/js/apps/PGCodeMirror/pgeditor.js | 5 +++++ .../Instructor/CodeMirrorEditor.pm | 15 +++++++++++++++ 2 files changed, 20 insertions(+) diff --git a/htdocs/js/apps/PGCodeMirror/pgeditor.js b/htdocs/js/apps/PGCodeMirror/pgeditor.js index a1de149f02..b65d6b85d3 100644 --- a/htdocs/js/apps/PGCodeMirror/pgeditor.js +++ b/htdocs/js/apps/PGCodeMirror/pgeditor.js @@ -114,4 +114,9 @@ localStorage.setItem('WW_PGEditor_spellcheck', enableSpell.checked); cm.focus(); }); + + const forceRTL = document.getElementById('forceRTL'); + forceRTL.addEventListener('change', () => { + cm.setOption('direction', forceRTL.checked ? 'rtl' : 'ltr'); + }); })(); diff --git a/lib/WeBWorK/ContentGenerator/Instructor/CodeMirrorEditor.pm b/lib/WeBWorK/ContentGenerator/Instructor/CodeMirrorEditor.pm index 887f531e02..55986455e5 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/CodeMirrorEditor.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/CodeMirrorEditor.pm @@ -156,6 +156,21 @@ sub output_codemirror_html { $r->maketext('Enable Spell Checking') ) ) + ), + CGI::div( + { class => 'col-sm-auto mb-2' }, + CGI::div( + { class => 'form-check mb-0' }, + CGI::input({ + type => 'checkbox', + id => 'forceRTL', + class => 'form-check-input' + }), + CGI::label( + { for => 'forceRTL', class => 'form-check-label' }, + 'Force editor to RTL' # FIXME should have $r->maketext() + ) + ) ) ); } From 87ef63ba8fd1632c5fbe47318d9fbdcba8a82f0c Mon Sep 17 00:00:00 2001 From: Alex Jordan Date: Thu, 8 Sep 2022 21:40:24 -0700 Subject: [PATCH 014/490] change GW quizzes to default to 1 question per page --- lib/WeBWorK/ContentGenerator/Instructor/ProblemSetDetail.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/WeBWorK/ContentGenerator/Instructor/ProblemSetDetail.pm b/lib/WeBWorK/ContentGenerator/Instructor/ProblemSetDetail.pm index 022142052a..670817940d 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/ProblemSetDetail.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/ProblemSetDetail.pm @@ -264,7 +264,7 @@ use constant FIELD_PROPERTIES => { type => "edit", size => "3", override => "any", - default => "0", + default => "1", # labels => { "" => 0 }, }, 'hide_score:hide_score_by_problem' => { From f469b6448cbc4f3c0eca7fe28bb52c5dc7c57fe2 Mon Sep 17 00:00:00 2001 From: Alex Jordan Date: Mon, 12 Sep 2022 11:11:32 -0700 Subject: [PATCH 015/490] put sessionKeyTimeout in localOverrides.conf.dist --- conf/localOverrides.conf.dist | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/conf/localOverrides.conf.dist b/conf/localOverrides.conf.dist index 90ad254dd2..a442fd2c5b 100644 --- a/conf/localOverrides.conf.dist +++ b/conf/localOverrides.conf.dist @@ -506,6 +506,11 @@ $mail{feedbackRecipients} = [ #$session_management_via = "key"; +## This is the length of time (in seconds) after which a user's session becomes +## invalid if they have no activity. The default is 30 minutes (60*30 seconds). + +#$sessionKeyTimeout = 60*60*2; + ################################################################################ # Cookie control settings ################################################################################ From 54d9e53b7368306ab10e706a29f7767216ddb91d Mon Sep 17 00:00:00 2001 From: Glenn Rice Date: Mon, 12 Sep 2022 17:55:38 -0500 Subject: [PATCH 016/490] Fix single character directories in templates for Local Problems in the Library Browser See https://github.com/openwebwork/pg/issues/725 for details. --- lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm b/lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm index da6bd70622..a87c7672ae 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm @@ -1218,7 +1218,7 @@ sub make_data_row { my $cnt = shift; my $mltnumleft = shift; - $sourceFileName =~ s|^./||; # clean up top ugliness + $sourceFileName =~ s|^\./||; # clean up top ugliness my $urlpath = $self->r->urlpath; my $db = $self->r->db; @@ -1615,7 +1615,7 @@ sub process_search { my %mlt = (); my $mltind; for my $indx (0..$#dbsearch) { - $dbsearch[$indx]->{filepath} = + $dbsearch[$indx]->{filepath} = $dbsearch[$indx]->{libraryroot} . "/" . $dbsearch[$indx]->{path} . "/" . $dbsearch[$indx]->{filename}; From c3a5645d778c849b7e112de110f37d380f70fa57 Mon Sep 17 00:00:00 2001 From: Danny Glin Date: Fri, 2 Sep 2022 15:04:31 -0600 Subject: [PATCH 017/490] Also filter Contrib when viewing local problems in the Library Browser --- lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm b/lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm index a87c7672ae..7eb3de8c26 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm @@ -119,8 +119,9 @@ sub get_library_sets { my @pgdirs; my @dirs = grep {!$ignoredir{$_} and -d "$dir/$_"} @lis; if ($top == 1) {@dirs = grep {!$problib{$_}} @dirs} - # Never include Library at the top level + # Never include Library or Contrib at the top level if ($top == 1) {@dirs = grep {$_ ne 'Library'} @dirs} + if ($top == 1) {@dirs = grep {$_ ne 'Contrib'} @dirs} foreach my $subdir (@dirs) { my @results = get_library_sets(0, "$dir/$subdir"); $pgcount += shift @results; push(@pgdirs,@results); From a651b8799caf2347ab062f8e743311ea86417ca5 Mon Sep 17 00:00:00 2001 From: Danny Glin Date: Fri, 2 Sep 2022 21:45:21 -0600 Subject: [PATCH 018/490] Update lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm Co-authored-by: K. Andrew Parker --- lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm b/lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm index 7eb3de8c26..cfdde08b78 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm @@ -120,8 +120,7 @@ sub get_library_sets { my @dirs = grep {!$ignoredir{$_} and -d "$dir/$_"} @lis; if ($top == 1) {@dirs = grep {!$problib{$_}} @dirs} # Never include Library or Contrib at the top level - if ($top == 1) {@dirs = grep {$_ ne 'Library'} @dirs} - if ($top == 1) {@dirs = grep {$_ ne 'Contrib'} @dirs} + if ($top == 1) {@Dirs = grep {$_ ne 'Library' && $_ ne 'Contrib'} @Dirs} foreach my $subdir (@dirs) { my @results = get_library_sets(0, "$dir/$subdir"); $pgcount += shift @results; push(@pgdirs,@results); From c0f2de4472158433e03fc6a397fbb650251c0d63 Mon Sep 17 00:00:00 2001 From: Danny Glin Date: Sat, 3 Sep 2022 07:11:26 -0600 Subject: [PATCH 019/490] Fix case typo --- lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm b/lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm index cfdde08b78..d0ae43444d 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm @@ -120,7 +120,7 @@ sub get_library_sets { my @dirs = grep {!$ignoredir{$_} and -d "$dir/$_"} @lis; if ($top == 1) {@dirs = grep {!$problib{$_}} @dirs} # Never include Library or Contrib at the top level - if ($top == 1) {@Dirs = grep {$_ ne 'Library' && $_ ne 'Contrib'} @Dirs} + if ($top == 1) {@dirs = grep {$_ ne 'Library' && $_ ne 'Contrib'} @Dirs} foreach my $subdir (@dirs) { my @results = get_library_sets(0, "$dir/$subdir"); $pgcount += shift @results; push(@pgdirs,@results); From 0628a366786a681d13c420bbe0ba77a33b8e5f1d Mon Sep 17 00:00:00 2001 From: Danny Glin Date: Sat, 3 Sep 2022 13:33:00 -0600 Subject: [PATCH 020/490] Fix the other typo --- lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm b/lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm index d0ae43444d..080eab936d 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm @@ -120,7 +120,7 @@ sub get_library_sets { my @dirs = grep {!$ignoredir{$_} and -d "$dir/$_"} @lis; if ($top == 1) {@dirs = grep {!$problib{$_}} @dirs} # Never include Library or Contrib at the top level - if ($top == 1) {@dirs = grep {$_ ne 'Library' && $_ ne 'Contrib'} @Dirs} + if ($top == 1) {@dirs = grep {$_ ne 'Library' && $_ ne 'Contrib'} @dirs} foreach my $subdir (@dirs) { my @results = get_library_sets(0, "$dir/$subdir"); $pgcount += shift @results; push(@pgdirs,@results); From a541c6e62f619c53999ce2632b78e5d201ff439f Mon Sep 17 00:00:00 2001 From: "K. Andrew Parker" Date: Thu, 29 Sep 2022 14:21:09 -0400 Subject: [PATCH 021/490] check that merge file exists --- lib/WeBWorK/ContentGenerator/Instructor/SendMail.pm | 1 + 1 file changed, 1 insertion(+) diff --git a/lib/WeBWorK/ContentGenerator/Instructor/SendMail.pm b/lib/WeBWorK/ContentGenerator/Instructor/SendMail.pm index af689aeefe..bafdf6f4c8 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/SendMail.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/SendMail.pm @@ -85,6 +85,7 @@ sub initialize { $db->setSettingValue("${user}_mergefile",$mergefile); } elsif ($db->settingExists("${user}_mergefile")) { $mergefile = $db->getSettingValue("${user}_mergefile"); + $mergefile = undef unless (-e "$ce->{courseDirs}{scoring}/$mergefile"); } # Figure out action from submit data From 9f95ff5410bb321da6851bf29fee3efadc0892a0 Mon Sep 17 00:00:00 2001 From: Glenn Rice Date: Mon, 1 Aug 2022 21:49:25 -0500 Subject: [PATCH 022/490] Move the WeBWorK::PG module to PG. Note that the WeBWorK::PG::Local and WeBWorK::PG::Remote modules have been removed. The Local variant is integrated directly into WeBWorK::PG, and the Remote variant was not working and is in disrepair. Remove the pg special environment variables ALWAYS_SHOW_HINT_PERMISSION_LEVEL and ALWAYS_SHOW_SOLUTION_PERMISSION_LEVEL. Use the always_show_hint and always_show_solution permissions directly. Whether solutions and hints are shown is now controlled by webwork2 and not by pg. The pg variable/flag $showHint is removed. When and if hints are shown is now controlled by the instructor with a combination of options at the course, set, and problem level. Note that hints were not implemented in gateway quizzes and still aren't. Also the options to use knowls for solutions and hints have been removed. Always use knowls for solutions and hints. Showing the various pieces of debugging information for a problem is now controlled with translation options. Webwork permissions are converted into these debugging options. The VIEW_PROBLEM_DEBUGGING_INFO special pg environment variable was removed and is one of these debugging options. Although the permissionLevel and effectivePermissionLevel are still passed in, they are no longer used by anything in PG. A translator option named isInstructor is passed into the environment that can be set to get instructor things to happen. Another special translator option for scaffolds named forceScaffoldsOpen can be passed to force all scaffolds to be open. This is set in the library browser and in gateway quizzes. Reduced scoring is implemented on the webwork2 side. PG no longer does that. It is implemented with the old method where the reduced score is saved in the problem status and the score before the reduced scoring period begins is saved in the sub_status. This can be changed later to fix some of the other issues with reduced scoring. Several other environment variables that are clearly not needed have also been removed including the appletPath and session key. Note that PGalias no longer uses the course name, user login, set number, and problem number for generating resource UUID's. It now only uses the problem seed, psvn, and problemUUID. So webwork2 constructs a problemUUID that guarantees the necessary uniqueness. --- Dockerfile | 5 +- DockerfileStage2 | 5 +- bin/setfilepermissions | 4 - conf/defaults.config | 170 ++--- conf/localOverrides.conf.dist | 28 +- conf/snippets/ASimpleCombinedHeaderFile.pg | 2 +- conf/snippets/setHeader.pg | 2 +- .../templates/ASimpleCombinedHeaderFile.pg | 8 +- .../templates/ASimpleHardCopyHeaderFile.pg | 4 +- doc/devel/daemon-problem-environment | 10 +- docker-config/docker-entrypoint.sh | 5 - .../apps/ProblemSetDetail/problemsetdetail.js | 1 + htdocs/js/apps/SetMaker/setmaker.js | 2 + lib/Caliper/Entity.pm | 2 + lib/FormatRenderedProblem.pm | 7 +- lib/WeBWorK.pm | 2 +- lib/WeBWorK/AchievementEvaluator.pm | 16 +- lib/WeBWorK/Constants.pm | 51 -- lib/WeBWorK/ContentGenerator.pm | 2 +- lib/WeBWorK/ContentGenerator/GatewayQuiz.pm | 184 ++--- lib/WeBWorK/ContentGenerator/Hardcopy.pm | 52 +- lib/WeBWorK/ContentGenerator/Instructor.pm | 22 +- .../Instructor/ProblemGrader.pm | 25 +- .../Instructor/ProblemSetDetail.pm | 22 +- .../Instructor/ProblemSetList.pm | 15 +- .../Instructor/ShowAnswers.pm | 33 +- lib/WeBWorK/ContentGenerator/Problem.pm | 569 +++++++-------- lib/WeBWorK/ContentGenerator/ProblemSet.pm | 6 +- .../ProblemUtil/ProblemUtil.pm | 652 ------------------ lib/WeBWorK/ContentGenerator/ShowMeAnother.pm | 62 +- .../ContentGenerator/renderViaXMLRPC.pm | 54 +- lib/WeBWorK/DB/Record/Problem.pm | 1 + lib/WeBWorK/DB/Record/UserProblem.pm | 1 + lib/WeBWorK/PG.pm | 528 -------------- lib/WeBWorK/PG/Local.pm | 557 --------------- lib/WeBWorK/PG/Remote.pm | 176 ----- lib/WeBWorK/Utils/DelayedMailer.pm | 164 ----- lib/WeBWorK/Utils/ProblemProcessing.pm | 504 ++++++++++++++ lib/WeBWorK/Utils/Rendering.pm | 201 ++++++ lib/WeBWorK/Utils/RestrictedClosureClass.pm | 116 ---- lib/WeBWorK/Utils/RestrictedMailer.pm | 305 -------- lib/WeBWorK/Utils/Tasks.pm | 97 +-- lib/WebworkClient.pm | 131 ++-- lib/WebworkWebservice.pm | 1 - lib/WebworkWebservice/RenderProblem.pm | 44 +- lib/WebworkWebservice/SetActions.pm | 3 + 46 files changed, 1463 insertions(+), 3388 deletions(-) delete mode 100644 lib/WeBWorK/ContentGenerator/ProblemUtil/ProblemUtil.pm delete mode 100644 lib/WeBWorK/PG.pm delete mode 100644 lib/WeBWorK/PG/Local.pm delete mode 100644 lib/WeBWorK/PG/Remote.pm delete mode 100644 lib/WeBWorK/Utils/DelayedMailer.pm create mode 100644 lib/WeBWorK/Utils/ProblemProcessing.pm create mode 100644 lib/WeBWorK/Utils/Rendering.pm delete mode 100644 lib/WeBWorK/Utils/RestrictedClosureClass.pm delete mode 100644 lib/WeBWorK/Utils/RestrictedMailer.pm diff --git a/Dockerfile b/Dockerfile index 10c2f4c0d9..2a1939baf1 100644 --- a/Dockerfile +++ b/Dockerfile @@ -239,10 +239,9 @@ COPY --from=base /opt/base/pg $APP_ROOT/pg # 6. Install third party javascript files. RUN echo "PATH=$PATH:$APP_ROOT/webwork2/bin" >> /root/.bashrc \ - && cd $APP_ROOT/pg/lib/chromatic && gcc color.c -o color \ && cd $APP_ROOT/webwork2/ \ - && chown www-data DATA ../courses logs tmp $APP_ROOT/pg/lib/chromatic \ - && chmod -R u+w DATA ../courses logs tmp $APP_ROOT/pg/lib/chromatic \ + && chown www-data DATA ../courses logs tmp \ + && chmod -R u+w DATA ../courses logs tmp \ && echo "en_US ISO-8859-1\nen_US.UTF-8 UTF-8" > /etc/locale.gen \ && /usr/sbin/locale-gen \ && echo "locales locales/default_environment_locale select en_US.UTF-8\ndebconf debconf/frontend select Noninteractive" > /tmp/preseed.txt \ diff --git a/DockerfileStage2 b/DockerfileStage2 index f5d01ac8c7..095fe4cff4 100644 --- a/DockerfileStage2 +++ b/DockerfileStage2 @@ -119,10 +119,9 @@ COPY --from=base /opt/base/pg $APP_ROOT/pg # 6. Install third party javascript files. RUN echo "PATH=$PATH:$APP_ROOT/webwork2/bin" >> /root/.bashrc \ - && cd $APP_ROOT/pg/lib/chromatic && gcc color.c -o color \ && cd $APP_ROOT/webwork2/ \ - && chown www-data DATA ../courses logs tmp $APP_ROOT/pg/lib/chromatic \ - && chmod -R u+w DATA ../courses logs tmp $APP_ROOT/pg/lib/chromatic \ + && chown www-data DATA ../courses logs tmp \ + && chmod -R u+w DATA ../courses logs tmp \ && echo "en_US ISO-8859-1\nen_US.UTF-8 UTF-8" > /etc/locale.gen \ && /usr/sbin/locale-gen \ && echo "locales locales/default_environment_locale select en_US.UTF-8\ndebconf debconf/frontend select Noninteractive" > /tmp/preseed.txt \ diff --git a/bin/setfilepermissions b/bin/setfilepermissions index 3d989d81fb..4e4f9c4a94 100755 --- a/bin/setfilepermissions +++ b/bin/setfilepermissions @@ -84,10 +84,6 @@ for my $dir ( 'DATA', 'htdocs_temp', 'logs', 'tmp' ) { system("chmod g+s $ce->{webworkDirs}{$dir}"); } -# A special directory under pg (so the server can compile the chromatic program) -system("chgrp $servergroup ".$ce->{pg_dir}."/lib/chromatic"); -system("chmod g+w ".$ce->{pg_dir}."/lib/chromatic"); - # The server should not be able to write to the OPL (for most sites) my $libroot = $ce->{problemLibrary}->{root}; diff --git a/conf/defaults.config b/conf/defaults.config index f2b18f4922..df1667ae2c 100644 --- a/conf/defaults.config +++ b/conf/defaults.config @@ -237,6 +237,13 @@ $pg{options}{showMeAnother}=[ "SMAshowHints", ]; +################################################################################ +# showHintsAfter +################################################################################ +# Number of attempts after which hints will be shown to a student. +# Set to -1 to disable hints. +$pg{options}{showHintsAfter} = 2; + ############################################################################### # periodicRandomization ################################################################################ @@ -790,7 +797,6 @@ $authen{xmlrpc_module} = "WeBWorK::Authen::XMLRPC"; edit_restricted_files => "admin", ##### Behavior of the interactive problem processor ##### - show_resource_info => "admin", show_correct_answers_before_answer_date => "ta", show_solutions_before_answer_date => "ta", avoid_recording_answers => "nobody", # record the grade/status/state of everyone's entries. @@ -798,19 +804,19 @@ $authen{xmlrpc_module} = "WeBWorK::Authen::XMLRPC"; # for students but not TA's or professors; # TA's and above could avoid having their answers recorded. - # controls if old answers can be shown + # controls if old answers can be shown can_show_old_answers => "student", check_answers_before_open_date => "ta", check_answers_after_open_date_with_attempts => "guest", check_answers_after_open_date_without_attempts => "guest", check_answers_after_due_date => "guest", check_answers_after_answer_date => "guest", - can_check_and_submit_answers => "ta", - can_use_show_me_another_early => "ta", + can_check_and_submit_answers => "ta", + can_use_show_me_another_early => "ta", create_new_set_version_when_acting_as_student => undef, print_path_to_problem => "professor", # see "Special" PG environment variables - always_show_hint => "professor", # see "Special" PG environment variables - always_show_solution => "professor", # see "Special" PG environment variables + always_show_hint => "professor", + always_show_solution => "professor", record_set_version_answers_when_acting_as_student => undef, record_answers_when_acting_as_student => undef, # "record_answers_when_acting_as_student" takes precedence @@ -829,12 +835,15 @@ $authen{xmlrpc_module} = "WeBWorK::Authen::XMLRPC"; # to avoid contaminating the data with TA and instructor activities. # The professor setting means that professor's answers are not logged or # saved in the past answer database. + + # PG debugging + show_resource_info => "admin", view_problem_debugging_info => "ta", - show_pg_info_checkbox => "admin", - show_answer_hash_info_checkbox => "admin", - show_answer_group_info_checkbox => "admin", - ##### Behavior of the Hardcopy Processor ##### + show_pg_info => "admin", + show_answer_hash_info => "admin", + show_answer_group_info => "admin", + ##### Behavior of the Hardcopy Processor ##### download_hardcopy_multiuser => "ta", download_hardcopy_multiset => "ta", download_hardcopy_view_errors =>"professor", @@ -1017,14 +1026,6 @@ $options{problemGraderScoreDelta} = 5; # just a textarea $options{PGCodeMirror} = 1; -# This sets if mathview is available on the PG editor for use as a minimal latex equation editor -$options{PGMathView} = 0; -# This sets if WirisEditor is available on the PG editor for use as a minimal latex equation editor -$options{PGWirisEditor}= 0; -# This sets if MathQuill is available on the PG editor for use as a minimal latex equation editor -$options{PGMathQuill}= 0; - - ########################################################################################### #### Default settings for the PG translator #### This section controls the display of equations, HINTS, answers, SOLUTIONS, @@ -1041,28 +1042,21 @@ $pg{options}{grader} = "avg_problem_grader"; # Fill in answer blanks with the student's last answer by default? $pg{options}{showOldAnswers} = 1; -# Default for showing the MathView preview system. To completely disable MathView you need to change the PG special environment variable. +# Note for the useMathQuill, useMathView, and useWirisEditor options, the one that is actually used is ultimately +# determined by the entryAssist PG special environment variable. Furthermore the user may disable the chosen method and +# fall back to a basic html input in the user settings if the user has the change_pg_display_settings permission. + +# Default for showing the MathView preview system. $pg{options}{useMathView} = 1; # This is the operations file to use for mathview, each contains a different locale. $pg{options}{mathViewLocale} = "mv_locale_us.js"; -# Default for showing the WirisEditor preview system. To completely disable WirisEditor you need to change the PG special environment variable. +# Default for showing the WirisEditor preview system. $pg{options}{useWirisEditor} = 1; - -# Default for showing the MathQuill preview system. To completely disable MathQuill you need to change the PG special environment variable. +# Default for showing the MathQuill preview system. $pg{options}{useMathQuill} = 1; -# Show correct answers (when allowed) by default? -$pg{options}{showCorrectAnswers} = 0; # this is a backup value use when nothing else has been set. I can think of no case where it should anything but zero. - -# Customize hints and solutions -# Show hints (when allowed) by default? -$pg{options}{showHints} = 0; # this is a backup value use when nothing else has been set. I can think of no case where it should anything but zero. - - -# Show solutions (when allowed) by default? -$pg{options}{showSolutions} = 0; # this is a backup value use when nothing else has been set. I can think of no case where it should anything but zero. $pg{options}{showAnsGroupInfo} = 0; $pg{options}{showAnsHashInfo} = 0; $pg{options}{showPGInfo} = 0; @@ -1074,29 +1068,6 @@ $pg{options}{showPGInfo} = 0; # and always_show_solution to "nobody" (by default this is "professor") # This is done in the %permissions section above. -# If always_show_hint is set to "nobody" then hints are shown, even to professors, only after -# a certain number of submissions have occurred. This number is set in each problem with -# the variable $main::showHints - - -# Use knowls for hints -$pg{options}{use_knowls_for_hints} = 1; - -# Use knowls for solutions -$pg{options}{use_knowls_for_solutions} = 1; - -# The buttons below are active only if knowls are being used. If set to 1 then the hints (and solutions) -# checkboxes are shown and when these are checked and the problem resubmitted THEN the knowls outline -# appears. I can't immediately think of a useful case where these should be set to 1. If knowls are not being -# used then these checkboxes are ALWAYS shown when a hint or solution is available and the value -# of these two options is ignored. - -# Show solution checkbox -$pg{options}{show_solution_checkbox} = 0; - -# Show hint checkbox -$pg{options}{show_hint_checkbox} = 0; - # Display the "Entered" column which automatically shows the evaluated student answer, e.g. 1 if student input is sin(pi/2). # If this is set to 0, e.g. to save space in the response area, the student can still see their evaluated answer by hovering # the mouse pointer over the typeset version of their answer @@ -1112,35 +1083,16 @@ $pg{options}{correct_answer} = "{border-width:2;border-style:solid;border-color: # decorations for incorrect input blanks $pg{options}{incorrect_answer} = "{border-width:2;border-style:solid;border-color:#F55}"; #matches resultsWithError class in math2.css -##### Currently-selected renderer - -# Only the local renderer is supported in this version. -$pg{renderer} = "WeBWorK::PG::Local"; - -# The remote renderer connects to an XML-RPC PG rendering server. -#$pg{renderer} = "WeBWorK::PG::Remote"; - -##### Renderer-dependent options - -# The remote renderer has one option: -$pg{renderers}{"WeBWorK::PG::Remote"} = { - # The "proxy" server to connect to for remote rendering. - proxy => "http://localhost:21000/RenderD", -}; - ##### Settings for various display modes # "images" mode has several settings: $pg{displayModeOptions}{images} = { - # Determines the method used to align images in output. Can be - # "baseline", "absmiddle", or "mysql". - dvipng_align => 'mysql', - - # If mysql is chosen, this information indicates which database contains the - # 'depths' table. Since 2.3.0, the depths table is kept in the main webwork - # database. (If you are upgrading from an earlier version of webwork, and - # used the mysql method in the past, you should move your existing 'depths' - # table to the main database.) + # Determines the method used to align images in output. Can be any valid value for the css vertical-align rule such + # as 'baseline' or 'middle'. + dvipng_align => 'baseline', + + # If dbsource is set to a nonempty value, then this database connection information will be used to store dvipng + # depths. It is assumed that the 'depths' table exists in the database. dvipng_depth_db => { dbsource => $database_dsn, user => $database_username, @@ -1185,26 +1137,6 @@ $pg{directories}{macrosPath} = [ "$courseDirs{templates}/Library/macros/Wiley", ]; -# The applet search path. If a full URL is given, it is used unmodified. If an -# absolute path is given, the URL of the local server is prepended to it. -# -# For example, if an item is "/math/applets", -# and the local server is "https://math.yourschool.edu", -# then the URL "https://math.yourschool.edu/math/applets" will be used. -# - -$pg{directories}{appletPath} = [ # paths to search for applets (requires full url) - "$webworkURLs{htdocs}/applets", - "$webworkURLs{htdocs}/applets/geogebra_stable", - "$courseURLs{html}/applets", - "$webworkURLs{htdocs}/applets/Xgraph", - "$webworkURLs{htdocs}/applets/PointGraph", - "$webworkURLs{htdocs}/applets/Xgraph", - "$webworkURLs{htdocs}/applets/liveJar", - "$webworkURLs{htdocs}/applets/Image_and_Cursor_All", -]; - - $pg{directories}{htmlPath} = [ # paths to search for auxiliary html files (requires full url) ".", "$courseURLs{html}", @@ -1224,22 +1156,10 @@ $pg{directories}{pdfPath} = [ # paths to search for pdf files (requires full # Users for whom to print the file name of the PG file being processed. $pg{specialPGEnvironmentVars}{PRINT_FILE_NAMES_FOR} = [ "professor", ]; - # ie file paths are printed for 'gage' + +# File names are also printed for anyone with this permission or higher $pg{specialPGEnvironmentVars}{PRINT_FILE_NAMES_PERMISSION_LEVEL} = - $userRoles{ $permissionLevels{print_path_to_problem} }; - # (file paths are also printed for anyone with this permission or higher) -$pg{specialPGEnvironmentVars}{ALWAYS_SHOW_HINT_PERMISSION_LEVEL} = - $userRoles{ $permissionLevels{always_show_hint} }; - # (hints are automatically shown to anyone with this permission or higher) -$pg{specialPGEnvironmentVars}{ALWAYS_SHOW_SOLUTION_PERMISSION_LEVEL} = - $userRoles{ $permissionLevels{always_show_solution} }; - # (solutions are automatically shown to anyone with this permission or higher) -$pg{specialPGEnvironmentVars}{VIEW_PROBLEM_DEBUGGING_INFO} = - $userRoles{ $permissionLevels{view_problem_debugging_info} }; - # (variable whether to show the debugging info from a problem to a student) - -$pg{specialPGEnvironmentVars}{use_knowls_for_hints} = $pg{options}{use_knowls_for_hints}; -$pg{specialPGEnvironmentVars}{use_knowls_for_solutions} = $pg{options}{use_knowls_for_solutions}; + $userRoles{ $permissionLevels{print_path_to_problem} }; # whether to use javascript for rendering Live3D graphs $pg{specialPGEnvironmentVars}{use_javascript_for_live3d} = 1; @@ -1373,7 +1293,7 @@ ${pg}{modules} = [ [qw(Parser::Legacy)], [qw(Statistics)], [qw(Chromatic)], # for Northern Arizona graph problems - [qw(Applet GeogebraWebApplet)], + [qw(Applet MIME::Base64)], [qw(PGcore PGalias PGresource PGloadfiles PGanswergroup PGresponsegroup Tie::IxHash)], [qw(Locale::Maketext)], [qw(WeBWorK::Localize)], @@ -1381,6 +1301,8 @@ ${pg}{modules} = [ [qw(Rserve Class::Tiny IO::Handle)], [qw(DragNDrop)], [qw(Types::Serialiser)], + [qw(Apache2::Log)], + [qw(APR::Table)], ]; ##### Problem creation defaults @@ -1417,6 +1339,13 @@ $problemDefaults{counts_parent_grade} = 0; # Setting this to a positive value will override the course-wide setting $problemDefaults{prPeriod} = -1; +# The default number of attempts after which to show hints for newly created problems. +# It is suggested to use the value of -2, which means that the course-wide setting would be used +# Setting this to -2 defaults to the use of course-wide settings (suggested) +# Setting this to -1 disables hints in problems. +# Setting this to 0 or more will show hints after that number of attempts. +$problemDefaults{showHintsAfter} = -2; + ##### Answer evaluatior defaults $pg{ansEvalDefaults} = { @@ -2088,6 +2017,15 @@ $ConfigValues = [ ), type => 'boolean' }, + { + var => 'pg{options}{showHintsAfter}', + doc => x('Default number of attempts before hints are shown in a problem (-1 => hide hints)'), + doc2 => x( + 'This is the default number of attempts a student must make before hints will be shown to the student. ' + . 'Set this to -1 to hide hints. Note that this can be overridden with a per problem setting.' + ), + type => 'number' + }, ], [ x('E-Mail'), diff --git a/conf/localOverrides.conf.dist b/conf/localOverrides.conf.dist index a442fd2c5b..b7609fa9cb 100644 --- a/conf/localOverrides.conf.dist +++ b/conf/localOverrides.conf.dist @@ -279,22 +279,6 @@ $mail{feedbackRecipients} = [ # new location even before the local directory of the problem, so your new location will take # precedence over all other locations. -################################################################################ -# Adding to the applet search path. -################################################################################ - -# If a full URL is given, it is used unmodified. If an -# absolute path is given, the URL of the local server is prepended to it. -# -# For example, if an item is "/math/applets", -# and the local server is "https://math.yourschool.edu", -# then the URL "https://math.yourschool.edu/math/applets" will be used. -# -# If your new applets location is a subdirectory of the webwork htdocs directory, you may -# use notation such as "$webworkURLs{htdocs}/newsubdir" - -#$pg{directories}{appletPath} = [ @{$pg{directories}{appletPath}} , "new/url" ]; - ################################################################################ # Problem creation defaults ################################################################################ @@ -325,6 +309,12 @@ $mail{feedbackRecipients} = [ # Setting this to a positive value will override the course-wide setting #$problemDefaults{prPeriod} = -1; +# The default number of attempts after which to show hints for newly created problems. +# It is suggested to use the value of -2, which means that the course-wide setting would be used +# Setting this to -2 defaults to the use of course-wide settings (suggested) +# Setting this to -1 disables hints in problems. +# Setting this to 0 or more will show hints after that number of attempts. +#$problemDefaults{showHintsAfter} = 2; ################################################################################ # Periodic re-randomization @@ -560,9 +550,9 @@ $mail{feedbackRecipients} = [ ################################################################################ #$permissionLevels{show_resource_info} = "admin"; -#$permissionLevels{show_pg_info_checkbox} = "admin"; -#$permissionLevels{show_answer_hash_info_checkbox} = "admin"; -#$permissionLevels{show_answer_group_info_checkbox} = "admin"; +#$permissionLevels{show_pg_info} = "admin"; +#$permissionLevels{show_answer_hash_info} = "admin"; +#$permissionLevels{show_answer_group_info} = "admin"; #$permissionLevels{modify_tags} = "admin"; ################################################################################ diff --git a/conf/snippets/ASimpleCombinedHeaderFile.pg b/conf/snippets/ASimpleCombinedHeaderFile.pg index 3adc41e842..2f6e168a1f 100644 --- a/conf/snippets/ASimpleCombinedHeaderFile.pg +++ b/conf/snippets/ASimpleCombinedHeaderFile.pg @@ -30,7 +30,7 @@ TEXT(MODES(TeX =>EV3(<<'EOT'),HTML=>"")); % Uncomment the line below if this course has sections. Note that this is a comment in TeX mode since this is only processed by LaTeX % {\large \bf { Section: \{protect_underbar($sectionName)\} } } \par -\noindent{\large \bf {Assignment \{protect_underbar($setNumber)\} due $formatedDueDate}} +\noindent{\large \bf {Assignment \{protect_underbar($setNumber)\} due $formattedDueDate}} %\par\noindent % Uncomment and edit the line below if this course has a web page. Note that this is a comment in TeX mode. %See the course web page for information http://yoururl/yourcourse diff --git a/conf/snippets/setHeader.pg b/conf/snippets/setHeader.pg index 04b91abfe3..51eeae59e1 100644 --- a/conf/snippets/setHeader.pg +++ b/conf/snippets/setHeader.pg @@ -28,7 +28,7 @@ TEXT(MODES(TeX =>EV3(<<'EOT'),HTML=>"")); % Uncomment the line below if this course has sections. Note that this is a comment in TeX mode since this is only processed by LaTeX % {\large \bf { Section: \{protect_underbar($sectionName)\} } } \par -\noindent{\large \bf {Assignment \{protect_underbar($setNumber)\} due $formatedDueDate}} +\noindent{\large \bf {Assignment \{protect_underbar($setNumber)\} due $formattedDueDate}} \par\noindent % Uncomment and edit the line below if this course has a web page. Note that this is a comment in TeX mode. %See the course web page for information http://yoururl/yourcourse diff --git a/courses.dist/modelCourse/templates/ASimpleCombinedHeaderFile.pg b/courses.dist/modelCourse/templates/ASimpleCombinedHeaderFile.pg index a617eb63f6..c0edf73795 100644 --- a/courses.dist/modelCourse/templates/ASimpleCombinedHeaderFile.pg +++ b/courses.dist/modelCourse/templates/ASimpleCombinedHeaderFile.pg @@ -30,7 +30,7 @@ TEXT(MODES(TeX =>EV3(<<'EOT'),HTML=>"")); % Uncomment the line below if this course has sections. Note that this is a comment in TeX mode since this is only processed by LaTeX % {\large \bf { Section: \{protect_underbar($sectionName)\} } } \par -\noindent{\large \bf {Assignment \{protect_underbar($setNumber)\} closes $formatedDueDate}} +\noindent{\large \bf {Assignment \{protect_underbar($setNumber)\} closes $formattedDueDate}} \par\noindent % Uncomment and edit the line below if this course has a web page. Note that this is a comment in TeX mode. %See the course web page for information http://yoururl/yourcourse @@ -47,20 +47,20 @@ EOT #################################################### # # The items below are printed out only when set is displayed on screen -# +# #################################################### TEXT(MODES(TeX =>"",HTML=>EV3(<<'EOT'))); $BBOLD WeBWorK Assignment \{ protect_underbar($setNumber) \} closes : $formattedDueDate. $EBOLD $PAR -Here's the list of +Here's the list of \{ htmlLink(qq!http://webwork.maa.org/wiki/Available_Functions!,"functions and symbols") \} which WeBWorK understands. $BR EOT #################################################### -# Uncomment and edit the lines below if this course has a web page. Note that this is comment in Perl mode. +# Uncomment and edit the lines below if this course has a web page. Note that this is comment in Perl mode. # IMPORTANT: Make sure the EOT at the bottom is at the beginning of a line with no spaces preceeding it. #TEXT(MODES(TeX =>"",HTML=>EV3(<<'EOT'))); #See the course web page for information \{ htmlLink(qq!http://yoururl/yourcourse!,"your course name") \} diff --git a/courses.dist/modelCourse/templates/ASimpleHardCopyHeaderFile.pg b/courses.dist/modelCourse/templates/ASimpleHardCopyHeaderFile.pg index ccb3a93d21..1e4dcb3c57 100644 --- a/courses.dist/modelCourse/templates/ASimpleHardCopyHeaderFile.pg +++ b/courses.dist/modelCourse/templates/ASimpleHardCopyHeaderFile.pg @@ -1,5 +1,5 @@ # ASimpleHardCopyHeaderFile.pg -# This file can be used as a simple Hard Copy Header file which is processed by LaTeX. +# This file can be used as a simple Hard Copy Header file which is processed by LaTeX. # Do not use it as a Screen Header file which is processed by html @@ -20,7 +20,7 @@ $BEGIN_ONE_COLUMN % Uncomment the line below if this course has sections. Note that this is a comment in TeX mode since this is only processed by LaTeX % {\large \bf { Section: \{protect_underbar($sectionName)\} } } \par -\noindent{\large \bf {Assignment \{protect_underbar($setNumber)\} closes $formatedDueDate}} +\noindent{\large \bf {Assignment \{protect_underbar($setNumber)\} closes $formattedDueDate}} \par\noindent % Uncomment and edit the line below if this course has a web page. Note that this is a comment in TeX mode. % See the course web page for information http://yoururl/yourcourse diff --git a/doc/devel/daemon-problem-environment b/doc/devel/daemon-problem-environment index 183050fdf0..82acd2fdd3 100644 --- a/doc/devel/daemon-problem-environment +++ b/doc/devel/daemon-problem-environment @@ -6,14 +6,11 @@ CAPA_Graphics_URL CAPA_MCTools CAPA_Tools - cgiDirectory - cgiURL - classDirectory courseName courseScriptsDirectory -- displayHintsQ +- showHints displayMode -- displaySolutionsQ +- showSolutions dueDate - externalDvipngPath externalGif2EpsPath @@ -57,12 +54,10 @@ - PROBLEM_GRADER_TO_USE probNum psvn - psvnNumber questionNumber - QUIZ_PREFIX - recitationName - recitationNumber - scriptDirectory sectionName sectionNumber sessionKey @@ -73,5 +68,4 @@ tempDirectory templateDirectory tempURL -- texDisposition webworkDocsURL diff --git a/docker-config/docker-entrypoint.sh b/docker-config/docker-entrypoint.sh index 9bfee599f0..d3696c2d53 100755 --- a/docker-config/docker-entrypoint.sh +++ b/docker-config/docker-entrypoint.sh @@ -202,11 +202,6 @@ if [ "$1" = 'apache2' ]; then cp -a $WEBWORK_ROOT/htdocs/DATA/*.json $APP_ROOT/libraries/webwork-open-problem-library/JSON-SAVED fi - # Compile chromatic/color.c if necessary - may be needed for PG directory mounted from outside image - if [ ! -f "$APP_ROOT/pg/lib/chromatic/color" ]; then - cd $APP_ROOT/pg/lib/chromatic - gcc color.c -o color - fi # generate apache2 reload config if needed if [ $DEV -eq 1 ]; then echo "PerlModule Apache2::Reload" >> /etc/apache2/conf-enabled/apache2-reload.conf diff --git a/htdocs/js/apps/ProblemSetDetail/problemsetdetail.js b/htdocs/js/apps/ProblemSetDetail/problemsetdetail.js index d81db8cebb..6263026eae 100644 --- a/htdocs/js/apps/ProblemSetDetail/problemsetdetail.js +++ b/htdocs/js/apps/ProblemSetDetail/problemsetdetail.js @@ -338,6 +338,7 @@ ro.showHints = 1; ro.showSolutions = 1; ro.permissionLevel = 10; + ro.isInstructor = 1; ro.noprepostambles = 1; ro.processAnswers = 0; ro.showFooter = 0; diff --git a/htdocs/js/apps/SetMaker/setmaker.js b/htdocs/js/apps/SetMaker/setmaker.js index da8892733d..cfa13ba980 100644 --- a/htdocs/js/apps/SetMaker/setmaker.js +++ b/htdocs/js/apps/SetMaker/setmaker.js @@ -452,6 +452,8 @@ ro.problemSeed = Math.floor((Math.random()*10000)); ro.showHints = document.querySelector('input[name="showHints"]')?.checked ? 1 : 0; ro.showSolutions = document.querySelector('input[name="showSolutions"]')?.checked ? 1 : 0; + ro.isInstructor = 1; + ro.forceScaffoldsOpen = 1; ro.noprepostambles = 1; ro.processAnswers = 0; ro.showFooter = 0; diff --git a/lib/Caliper/Entity.pm b/lib/Caliper/Entity.pm index 472b6454c0..f2cda8e3d7 100644 --- a/lib/Caliper/Entity.pm +++ b/lib/Caliper/Entity.pm @@ -220,6 +220,7 @@ sub problem 'counts_parent_grade' => $problem->counts_parent_grade(), 'showMeAnother' => $problem->showMeAnother(), 'showMeAnotherCount' => $problem->showMeAnotherCount(), + 'showHintsAfter' => $problem->showHintsAfter(), 'prPeriod' => $problem->prPeriod(), 'prCount' => $problem->prCount(), 'flags' => $problem->flags(), @@ -265,6 +266,7 @@ sub problem_user 'counts_parent_grade' => $problem_user->counts_parent_grade(), 'showMeAnother' => $problem_user->showMeAnother(), 'showMeAnotherCount' => $problem_user->showMeAnotherCount(), + 'showHintsAfter' => $problem_user->prHintsAfter(), 'prPeriod' => $problem_user->prPeriod(), 'prCount' => $problem_user->prCount(), 'flags' => $problem_user->flags(), diff --git a/lib/FormatRenderedProblem.pm b/lib/FormatRenderedProblem.pm index a9d5871404..ff8a5d43eb 100644 --- a/lib/FormatRenderedProblem.pm +++ b/lib/FormatRenderedProblem.pm @@ -242,10 +242,9 @@ sub formatRenderedProblem { my $checkMode = defined($self->{inputs_ref}{WWcheck}) || 0; my $submitMode = defined($self->{inputs_ref}{WWsubmit}) || 0; my $showCorrectMode = defined($self->{inputs_ref}{WWcorrectAns}) || 0; - # problemUUID can be added to the request as a parameter. It adds a prefix - # to the identifier used by the format so that several different problems - # can appear on the same page. - my $problemUUID = $self->{inputs_ref}{problemUUID} // 1; + # A problemUUID should be added to the request as a parameter. It is used by PG to create a proper UUID for use in + # aliases for resources. It should be unique for a course, user, set, and problem. + my $problemUUID = $self->{inputs_ref}{problemUUID} // ''; my $problemResult = $rh_result->{problem_result} // ''; my $problemState = $rh_result->{problem_state} // ''; my $showSummary = $self->{inputs_ref}{showSummary} // 1; diff --git a/lib/WeBWorK.pm b/lib/WeBWorK.pm index c0dafba843..5df8d78fd1 100644 --- a/lib/WeBWorK.pm +++ b/lib/WeBWorK.pm @@ -70,7 +70,7 @@ BEGIN { # other candidates for preloading: # - DB Record, Schema, and Driver classes (esp. Driver::SQL as it loads DBI) # - CourseManagement subclasses (ditto. sql_single.pm) - # - WeBWorK::PG::Local, which loads WeBWorK::PG::Translator + # - WeBWorK::PG, which loads WeBWorK::PG::Translator # - Authen subclasses } diff --git a/lib/WeBWorK/AchievementEvaluator.pm b/lib/WeBWorK/AchievementEvaluator.pm index 337c08b70f..92dfd213c0 100644 --- a/lib/WeBWorK/AchievementEvaluator.pm +++ b/lib/WeBWorK/AchievementEvaluator.pm @@ -79,19 +79,9 @@ sub checkForAchievements { $db->addGlobalUserAchievement($globalUserAchievement); } - #update the problem with stuff from the pg. - # this is kind of a hack. The achievement checking happens *before* the system has - # updated $problem with the new results from $pg. So we cheat and update the - # important bits here. The only thing that gets left behind is last_answer, which is - # still the previous last answer. - - # $pg->{result} reflects the current submission, $pg->{state} holds the best result - # close the unlimited achievement points loophole by only using the current result! - $problem->status($pg->{result}->{score}); - $problem->sub_status($pg->{state}->{sub_recorded_score}); - $problem->attempted(1); - $problem->num_correct($pg->{state}->{num_of_correct_ans}); - $problem->num_incorrect($pg->{state}->{num_of_incorrect_ans}); + # Do not update the problem with stuff from the pg. The achievement checking happens + # *after* the system has already updated $problem with the new results from $pg. + # The code here has no right to modify the problem in any case. #These need to be "our" so that they can share to the safe container our $counter; diff --git a/lib/WeBWorK/Constants.pm b/lib/WeBWorK/Constants.pm index 33862ab35e..aed0996926 100644 --- a/lib/WeBWorK/Constants.pm +++ b/lib/WeBWorK/Constants.pm @@ -65,55 +65,4 @@ $WeBWorK::Debug::DenySubroutineOutput = undef; # $WeBWorK::ContentGenerator::Hardcopy::PreserveTempFiles = 0; -################################################################################ -# WeBWorK::PG::Local -################################################################################ -# The maximum amount of time (in seconds) to work on a single problem. -# At the end of this time a timeout message is sent to the browser. - -$WeBWorK::PG::Local::TIMEOUT = 60; - -################################################################################ -# WeBWorK::PG::ImageGenerator -################################################################################ - -# Arguments to pass to dvipng. This is dependant on the version of dvipng. -# -# For dvipng versions 0.x -# $WeBWorK::PG::ImageGenerator::DvipngArgs = "-x4000.5 -bgTransparent -Q6 -mode toshiba -D180"; -# For dvipng versions 1.0 to 1.5 -# $WeBWorK::PG::ImageGenerator::DvipngArgs = "-bgTransparent -D120 -q -depth"; -# -# For dvipng versions 1.6 (and probably above) -# $WeBWorK::PG::ImageGenerator::DvipngArgs = "-bgtransparent -D120 -q -depth"; -# Note: In 1.6 and later, bgTransparent gives alpha-channel transparency while -# bgtransparent gives single-bit transparency. If you use alpha-channel transparency, -# the images will not be viewable with MSIE. bgtransparent works for version 1.5, -# but does not give transparent backgrounds. It does not work for version 1.2. It has not -# been tested with other versions. -# -$WeBWorK::PG::ImageGenerator::DvipngArgs = "-bgTransparent -D120 -q -depth"; - -# If true, don't delete temporary files -# -$WeBWorK::PG::ImageGenerator::PreserveTempFiles = 0; -# TeX to prepend to equations to be processed. -# -$WeBWorK::PG::ImageGenerator::TexPreamble = <<'EOF'; -\documentclass[12pt]{article} -\nonstopmode -\usepackage{amsmath,amsfonts,amssymb} -\def\gt{>} -\def\lt{<} -\usepackage[active,textmath,displaymath]{preview} -\begin{document} -EOF - -# TeX to append to equations to be processed. -# -$WeBWorK::PG::ImageGenerator::TexPostamble = <<'EOF'; -\end{document} -EOF - - 1; diff --git a/lib/WeBWorK/ContentGenerator.pm b/lib/WeBWorK/ContentGenerator.pm index 7351a88c6c..5bd6491051 100644 --- a/lib/WeBWorK/ContentGenerator.pm +++ b/lib/WeBWorK/ContentGenerator.pm @@ -2383,7 +2383,7 @@ Wrapper that creates an Email::Sender::Transport::SMTP object =cut # this function abstracts the process of creating a transport layer for SendMail -# it is used in Feedback.pm, SendMail.pm and ProblemUtil.pm (for JITAR messages) +# it is used in Feedback.pm, SendMail.pm and Utils/ProblemProcessing.pm (for JITAR messages) sub createEmailSenderTransportSMTP { my $self = shift; diff --git a/lib/WeBWorK/ContentGenerator/GatewayQuiz.pm b/lib/WeBWorK/ContentGenerator/GatewayQuiz.pm index 7af970dd96..18d72bd144 100644 --- a/lib/WeBWorK/ContentGenerator/GatewayQuiz.pm +++ b/lib/WeBWorK/ContentGenerator/GatewayQuiz.pm @@ -25,16 +25,17 @@ deal with versioning sets use strict; use warnings; -use WeBWorK::CGI; -use File::Path qw(rmtree); + use WeBWorK::Form; use WeBWorK::PG; use WeBWorK::PG::ImageGenerator; use WeBWorK::PG::IO; +# Use the ContentGenerator formatDateTime, not the version in Utils. use WeBWorK::Utils qw(writeLog writeCourseLog encodeAnswers decodeAnswers - ref2string makeTempDirectory path_is_subdir before after getAssetURL - between wwRound is_restricted); # use the ContentGenerator formatDateTime, not the version in Utils -use WeBWorK::DB::Utils qw(global2user user2global); + path_is_subdir before after getAssetURL between wwRound is_restricted); +use WeBWorK::Utils::Rendering qw(constructPGOptions getTranslatorDebuggingOptions); +use WeBWorK::Utils::ProblemProcessing qw/create_ans_str_from_responses compute_reduced_score/; +use WeBWorK::DB::Utils qw(global2user); use WeBWorK::Utils::Tasks qw(fake_set fake_set_version fake_problem); use WeBWorK::Debug; use WeBWorK::ContentGenerator::Instructor qw(assignSetVersionToUser); @@ -134,6 +135,8 @@ sub can_showSolutions { $tmplSet, $submitAnswers) = @_; my $authz = $self->r->authz; + return 1 if $authz->hasPermissions($User->user_id, 'always_show_solution'); + # this is the same as can_showCorrectAnswers # gateway change here to allow correct answers to be viewed after all attempts # at a version are exhausted as well as if it's after the answer date @@ -358,6 +361,7 @@ sub attemptResults { cacheDir => $ce->{webworkDirs}{equationCache}, cacheURL => $ce->{webworkURLs}{equationCache}, cacheDB => $ce->{webworkFiles}{equationCacheDB}, + useMarkers => 1, dvipng_align => $imagesModeOptions{dvipng_align}, dvipng_depth_db => $imagesModeOptions{dvipng_depth_db}, ); @@ -384,7 +388,7 @@ sub attemptResults { ); my $answerTemplate = $tbl->answerTemplate; - $tbl->imgGen->render(refresh => 1) if $tbl->displayMode eq 'images'; + $tbl->imgGen->render(body_text => $answerTemplate) if $tbl->displayMode eq 'images'; return $answerTemplate; } @@ -912,25 +916,22 @@ sub pre_header_initialize { # what does the user want to do? my %want = ( - showOldAnswers => $User->showOldAnswers ne '' ? - $User->showOldAnswers : $ce->{pg}->{options}->{showOldAnswers}, + showOldAnswers => $User->showOldAnswers ne '' ? $User->showOldAnswers : $ce->{pg}{options}{showOldAnswers}, # showProblemGrader implies showCorrectAnswers. This is a convenience for grading. - showCorrectAnswers => $r->param('showProblemGrader') || - (($r->param("showCorrectAnswers") || $ce->{pg}->{options}->{showCorrectAnswers}) - && ($submitAnswers || $checkAnswers)), - showProblemGrader => $r->param('showProblemGrader') || 0, - showHints => $r->param("showHints") || $ce->{pg}->{options}->{showHints}, + showCorrectAnswers => ($r->param('showProblemGrader') || 0) + || ($r->param("showCorrectAnswers") && ($submitAnswers || $checkAnswers)), + showProblemGrader => $r->param('showProblemGrader') || 0, + # Hints are not yet implemented in gateway quzzes. + showHints => 0, # showProblemGrader implies showSolutions. Another convenience for grading. - showSolutions => $r->param('showProblemGrader') || - (($r->param("showSolutions") || $ce->{pg}->{options}->{showSolutions}) - && ($submitAnswers || $checkAnswers)), - recordAnswers => $submitAnswers && !$authz->hasPermissions($userName, "avoid_recording_answers"), - # we also want to check answers if we were checking answers and are - # switching between pages - checkAnswers => $checkAnswers, - useMathView => $User->useMathView ne '' ? $User->useMathView : $ce->{pg}->{options}->{useMathView}, - useWirisEditor => $User->useWirisEditor ne '' ? $User->useWirisEditor : $ce->{pg}->{options}->{useWirisEditor}, - useMathQuill => $User->useMathQuill ne '' ? $User->useMathQuill : $ce->{pg}->{options}->{useMathQuill}, + showSolutions => $r->param('showProblemGrader') + || ($r->param("showSolutions") && ($submitAnswers || $checkAnswers)), + recordAnswers => $submitAnswers && !$authz->hasPermissions($userName, "avoid_recording_answers"), + # we also want to check answers if we were checking answers and are switching between pages + checkAnswers => $checkAnswers, + useMathView => $User->useMathView ne '' ? $User->useMathView : $ce->{pg}{options}{useMathView}, + useWirisEditor => $User->useWirisEditor ne '' ? $User->useWirisEditor : $ce->{pg}{options}{useWirisEditor}, + useMathQuill => $User->useMathQuill ne '' ? $User->useMathQuill : $ce->{pg}{options}{useMathQuill}, ); # are certain options enforced? @@ -973,12 +974,11 @@ sub pre_header_initialize { } ##### store fields ##### - ## FIXME: the following is present in Problem.pm, but missing here. how do we - ## deal with it in the context of multiple problems with possible hints? - ## ##### fix hint/solution options ##### - ## $can{showHints} &&= $pg->{flags}->{hintExists} - ## &&= $pg->{flags}->{showHintLimit}<=$pg->{state}->{num_of_incorrect_ans}; - ## $can{showSolutions} &&= $pg->{flags}->{solutionExists}; + # FIXME: the following is present in Problem.pm, but missing here. how do we + # deal with it in the context of multiple problems with possible hints? + # Update and fix hint/solution options after PG processing + # $can{showHints} &&= $pg->{flags}{hintExists}; + # $can{showSolutions} &&= $pg->{flags}{solutionExists}; $self->{want} = \%want; $self->{must} = \%must; @@ -1590,7 +1590,7 @@ sub body { if (ref($pg_results[$i])) { my ($past_answers_string, $scores, $isEssay); #not used here ($past_answers_string, $encoded_last_answer_string, $scores, $isEssay) = - WeBWorK::ContentGenerator::ProblemUtil::ProblemUtil::create_ans_str_from_responses($self, $pg_results[$i]); + create_ans_str_from_responses($self, $pg_results[$i]); } else { my $prefix = sprintf('Q%04d_', $problemNumbers[$i]); my @fields = sort grep {/^(?!previous).*$prefix/} (keys %{$self->{formFields}}); @@ -1602,16 +1602,25 @@ sub body { $problems[$i]->last_answer($encoded_last_answer_string); $pureProblem->last_answer($encoded_last_answer_string); - # next, store the state in the database if that makes sense + # Next, store the state in the database if answers are being recorded. if ($submitAnswers && $will{recordAnswers}) { - $problems[$i]->status(wwRound(2,$pg_results[$i]->{state}->{recorded_score})); + $problems[$i] + ->status(compute_reduced_score($ce, $problems[$i], $set, $pg_results[$i]{state}{recorded_score})); + + $problems[$i]->sub_status($problems[$i]->status) + if (!$ce->{pg}{ansEvalDefaults}{enableReducedScoring} + || !$set->enable_reduced_scoring + || before($set->reduced_scoring_date)); + $problems[$i]->attempted(1); - $problems[$i]->num_correct($pg_results[$i]->{state}->{num_of_correct_ans}); - $problems[$i]->num_incorrect($pg_results[$i]->{state}->{num_of_incorrect_ans}); - $pureProblem->status(wwRound(2,$pg_results[$i]->{state}->{recorded_score})); + $problems[$i]->num_correct($pg_results[$i]{state}{num_of_correct_ans}); + $problems[$i]->num_incorrect($pg_results[$i]{state}{num_of_incorrect_ans}); + + $pureProblem->status($problems[$i]->status); + $pureProblem->sub_status($problems[$i]->sub_status); $pureProblem->attempted(1); - $pureProblem->num_correct($pg_results[$i]->{state}->{num_of_correct_ans}); - $pureProblem->num_incorrect($pg_results[$i]->{state}->{num_of_incorrect_ans}); + $pureProblem->num_correct($pg_results[$i]{state}{num_of_correct_ans}); + $pureProblem->num_incorrect($pg_results[$i]{state}{num_of_incorrect_ans}); if ($db->putProblemVersion($pureProblem)) { $scoreRecordedMessage[$i] = $r->maketext("Your score on this problem was recorded."); @@ -1694,9 +1703,7 @@ sub body { next unless ref($pg_results[$probOrder[$i]]); my ($past_answers_string, $encoded_last_answer_string, $scores, $isEssay) = - WeBWorK::ContentGenerator::ProblemUtil::ProblemUtil::create_ans_str_from_responses( - $self, $pg_results[$probOrder[$i]] - ); + create_ans_str_from_responses($self, $pg_results[ $probOrder[$i] ]); $past_answers_string =~ s/\t+$/\t/; if (!$past_answers_string || $past_answers_string =~ /^\t$/) { @@ -1879,48 +1886,38 @@ sub body { my $canShowWork = $authz->hasPermissions($user, "view_hidden_work") || ($set->hide_work eq 'N' || ($set->hide_work eq 'BeforeAnswerDate' && $timeNow>$tmplSet->answer_date)); - # for nicer answer checking on multi-page tests, we want to keep - # track of any changes that someone made to a different page, - # and what their score was. we use @probStatus to do this. we - # initialize this to any known scores, and then update this when - # calculating the score for checked or submitted tests - my @probStatus = (); - # we also figure out recorded score for the set, if any, and score - # on this attempt + # For answer checking on multi-page tests, track changes that made on other pages, and scores for problems on those + # pages. @probStatus is used for this. Initialize this to the saved score either from a hidden input or the + # database, and then update this when calculating the score for checked or submitted tests. + my @probStatus; + + # Figure out the recorded score for the set, and the score on this attempt. my $recordedScore = 0; my $totPossible = 0; - foreach (@problems) { - my $pv = ($_->value()) ? $_->value() : 1; - $totPossible += $pv; - $recordedScore += $_->status*$pv if (defined($_->status)); - push(@probStatus, ($r->param("probstatus" . $_->problem_id) || $_->status || 0)); + for (@problems) { + my $pv = $_->value // 1; + $totPossible += $pv; + $recordedScore += $_->status * $pv if defined $_->status; + push(@probStatus, ($r->param('probstatus' . $_->problem_id) || $_->status || 0)); } - # to get the attempt score, we have to figure out what the score on - # each part of each problem is, and multiply the total for the - # problem by the weight (value) of the problem. to make things - # even more interesting, we are avoiding translating all of the - # problems when checking answers + # To get the attempt score, determine the score for each problem, and multiply the total for the problem by the + # weight (value) of the problem. Avoid translating all of the problems when checking answers. my $attemptScore = 0; if ($will{recordAnswers} || $will{checkAnswers}) { - my $i=0; - foreach my $pg (@pg_results) { + my $i = 0; + for my $pg (@pg_results) { my $pValue = $problems[$i]->value() ? $problems[$i]->value() : 1; my $pScore = 0; - my $numParts = 0; - if (ref($pg)) { # then we have a pg object - ### - $pScore = $pg->{state}->{recorded_score}; + if (ref $pg) { + # If a pg object is available, then use the pg recorded score and save it in the @probStatus array. + $pScore = compute_reduced_score($ce, $problems[$i], $set, $pg->{state}{recorded_score}); $probStatus[$i] = $pScore; - $numParts = 1; - ### - } else { - # if we don't have a pg object, use any known - # problem status (this defaults to zero) + # If a pg object is not available, then use the saved problem status. $pScore = $probStatus[$i]; } - $attemptScore += $pScore*$pValue/($numParts > 0 ? $numParts : 1); + $attemptScore += $pScore * $pValue; $i++; } } @@ -2023,6 +2020,25 @@ sub body { } } + # Display the reduced scoring message if reduced scoring is enabled and the set is in the reduced scoring period. + if ($ce->{pg}{ansEvalDefaults}{enableReducedScoring} + && $set->enable_reduced_scoring + && after($set->reduced_scoring_date) + && before($set->due_date) + && ($can{recordAnswersNextTime} || $submitAnswers)) + { + print CGI::div( + { class => 'gwMessage' }, + CGI::b($r->maketext( + 'Note: [_1]', + CGI::i($r->maketext( + 'You are in the Reduced Scoring Period. All work counts for [_1]% of the original.', + $ce->{pg}{ansEvalDefaults}{reducedScoringValue} * 100 + )) + )) + ); + } + # Remaining output of test headers: # Display timer or information about elapsed time, print link, and information about any recorded score if not # submitAnswers or checkAnswers. @@ -2347,8 +2363,10 @@ sub body { } print CGI::div({ class => 'problem-content col-lg-10' }, $pg->{body_text}); + print CGI::div({ class => 'mb-2' }, CGI::b($r->maketext('Note: [_1]', CGI::i($pg->{result}{msg})))) if $pg->{result}{msg}; + print CGI::div( { class => 'text-end mb-2' }, CGI::a( @@ -2580,26 +2598,28 @@ sub getProblemHTML { # FIXME I'm not sure that problem_id is what we want here FIXME my $problemNumber = $mergedProblem->problem_id; - my $pg = WeBWorK::PG->new( + my $pg = WeBWorK::PG->new(constructPGOptions( $ce, $EffectiveUser, - $key, $set, $mergedProblem, $psvn, $formFields, { # translation options - displayMode => $self->{displayMode}, - showHints => $showHints, - showSolutions => $showSolutions, - refreshMath2img => $showHints || $showSolutions, - processAnswers => 1, - QUIZ_PREFIX => 'Q' . sprintf("%04d", $problemNumber) . '_', - useMathQuill => $self->{will}{useMathQuill}, - useMathView => $self->{will}{useMathView}, - useWirisEditor => $self->{will}{useWirisEditor}, + displayMode => $self->{displayMode}, + showHints => $showHints, + showSolutions => $showSolutions, + refreshMath2img => $showHints || $showSolutions, + processAnswers => 1, + QUIZ_PREFIX => 'Q' . sprintf("%04d", $problemNumber) . '_', + useMathQuill => $self->{will}{useMathQuill}, + useMathView => $self->{will}{useMathView}, + useWirisEditor => $self->{will}{useWirisEditor}, + forceScaffoldsOpen => 1, + isInstructor => $r->authz->hasPermissions($self->{userName}, 'view_answers'), + debuggingOptions => getTranslatorDebuggingOptions($r->authz, $self->{userName}) }, - ); + )); # FIXME is problem_id the correct thing in the following two stanzas? diff --git a/lib/WeBWorK/ContentGenerator/Hardcopy.pm b/lib/WeBWorK/ContentGenerator/Hardcopy.pm index 4c90967ee5..6f44dc9c22 100644 --- a/lib/WeBWorK/ContentGenerator/Hardcopy.pm +++ b/lib/WeBWorK/ContentGenerator/Hardcopy.pm @@ -40,6 +40,7 @@ use WeBWorK::Form; use WeBWorK::HTML::ScrollingRecordList qw/scrollingRecordList/; use WeBWorK::PG; use WeBWorK::Utils qw/readFile decodeAnswers jitar_id_to_seq is_restricted after x format_set_name_display/; +use WeBWorK::Utils::Rendering qw(constructPGOptions); use PGrandom; =head1 CONFIGURATION VARIABLES @@ -1315,42 +1316,35 @@ sub write_problem_tex { # FIXME -- there can be a problem if the $siteDefaults{timezone} is not defined? Why is this? # why does it only occur with hardcopy? - # we need an additional translation option for versioned sets; also, - # for versioned sets include old answers in the set if we're also - # asking for the answers - my $transOpts = { - displayMode => "tex", - showHints => $showHints, - showSolutions => $showSolutions, - processAnswers => $showCorrectAnswers || $printStudentAnswers, - permissionLevel => $db->getPermissionLevel($userID)->permission, - effectivePermissionLevel => $db->getPermissionLevel($eUserID)->permission, - }; - - if ( $versioned && $MergedProblem->problem_id != 0 ) { - - $transOpts->{QUIZ_PREFIX} = 'Q' . sprintf("%04d",$MergedProblem->problem_id()) . '_'; - + # Include old answers if answers were requested. + my $formFields = {}; + if ($showCorrectAnswers || $printStudentAnswers) { + my %oldAnswers = decodeAnswers($MergedProblem->last_answer); + $formFields->{$_} = $oldAnswers{$_} foreach (keys %oldAnswers); + print $FH "%% decoded old answers, saved. (keys = " . join(',', keys(%oldAnswers)) . "\n"; } - my $formFields = { }; - if ( $showCorrectAnswers ||$printStudentAnswers ) { - my %oldAnswers = decodeAnswers($MergedProblem->last_answer); - $formFields->{$_} = $oldAnswers{$_} foreach (keys %oldAnswers); - print $FH "%% decoded old answers, saved. (keys = " . join(',', keys(%oldAnswers)) . "\n"; - } - -# warn("problem ", $MergedProblem->problem_id, ": source = ", $MergedProblem->source_file, "\n"); - my $pg = WeBWorK::PG->new( + my $pg = WeBWorK::PG->new(constructPGOptions( $ce, $TargetUser, - scalar($r->param('key')), # avoid multiple-values problem $MergedSet, $MergedProblem, $MergedSet->psvn, - $formFields, # no form fields! - $transOpts, - ); + $formFields, + { # translation options + displayMode => 'tex', + showHints => $showHints, + showSolutions => $showSolutions, + processAnswers => $showCorrectAnswers || $printStudentAnswers, + permissionLevel => $db->getPermissionLevel($userID)->permission, + effectivePermissionLevel => $db->getPermissionLevel($eUserID)->permission, + isInstructor => $authz->hasPermissions($userID, 'view_answers'), + # Add the quiz prefix for versioned sets + $versioned && $MergedProblem->problem_id != 0 + ? (QUIZ_PREFIX => 'Q' . sprintf('%04d', $MergedProblem->problem_id()) . '_') + : () + } + )); # only bother to generate this info if there were warnings or errors my $edit_url; diff --git a/lib/WeBWorK/ContentGenerator/Instructor.pm b/lib/WeBWorK/ContentGenerator/Instructor.pm index 261baf9811..8b8586658d 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor.pm @@ -505,6 +505,7 @@ sub addProblemToSet { my $showMeAnother_default = $self->{ce}->{problemDefaults}->{showMeAnother}; my $att_to_open_children_default = $self->{ce}->{problemDefaults}->{att_to_open_children}; my $counts_parent_grade_default = $self->{ce}->{problemDefaults}->{counts_parent_grade}; + my $showHintsAfter_default = $self->{ce}{problemDefaults}{showHintsAfter}; my $prPeriod_default = $self->{ce}->{problemDefaults}->{prPeriod}; # showMeAnotherCount is the number of times that showMeAnother has been clicked; initially 0 my $showMeAnotherCount = 0; @@ -516,20 +517,14 @@ sub addProblemToSet { my $sourceFile = $args{sourceFile} or die "addProblemToSet called without specifying the sourceFile."; - # The rest of the arguments are optional - -# my $value = $args{value} || $value_default; - my $value = $value_default; - if (defined($args{value})){$value = $args{value};} # 0 is a valid value for $args{value} - - my $maxAttempts = $args{maxAttempts} || $max_attempts_default; - my $showMeAnother = $args{showMeAnother} // $showMeAnother_default; - my $prPeriod = $prPeriod_default; - if (defined($args{prPeriod})){ - $prPeriod = $args{prPeriod}; - } - my $problemID = $args{problemID}; + + # The rest of the arguments are optional + my $value = $args{value} // $value_default; + my $maxAttempts = $args{maxAttempts} || $max_attempts_default; + my $showMeAnother = $args{showMeAnother} // $showMeAnother_default; + my $showHintsAfter = $args{showHintsAfter} // $showHintsAfter_default; + my $prPeriod = $args{prPeriod} // $prPeriod_default; my $countsParentGrade = $args{countsParentGrade} // $counts_parent_grade_default; my $attToOpenChildren = $args{attToOpenChildren} // $att_to_open_children_default; @@ -561,6 +556,7 @@ sub addProblemToSet { $problemRecord->counts_parent_grade($countsParentGrade); $problemRecord->showMeAnother($showMeAnother); $problemRecord->{showMeAnotherCount}=$showMeAnotherCount; + $problemRecord->showHintsAfter($showHintsAfter); $problemRecord->prPeriod($prPeriod); $problemRecord->prCount(0); $db->addGlobalProblem($problemRecord); diff --git a/lib/WeBWorK/ContentGenerator/Instructor/ProblemGrader.pm b/lib/WeBWorK/ContentGenerator/Instructor/ProblemGrader.pm index d7f8293154..80ab25bfd0 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/ProblemGrader.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/ProblemGrader.pm @@ -18,6 +18,7 @@ package WeBWorK::ContentGenerator::Instructor::ProblemGrader; use base qw(WeBWorK::ContentGenerator); use WeBWorK::Utils qw(sortByName getAssetURL); +use WeBWorK::Utils::Rendering qw(constructPGOptions); use WeBWorK::PG; use HTML::Entities; @@ -158,22 +159,6 @@ sub body { my $displayMode = $self->{displayMode}; my $formFields = { WeBWorK::Form->new_from_paramable($r)->Vars }; - # to make grabbing these options easier, we'll pull them out now... - my %imagesModeOptions = %{ $ce->{pg}->{displayModeOptions}->{images} }; - - # set up some display stuff - my $imgGen = WeBWorK::PG::ImageGenerator->new( - tempDir => $ce->{webworkDirs}->{tmp}, - latex => $ce->{externalPrograms}->{latex}, - dvipng => $ce->{externalPrograms}->{dvipng}, - useCache => 1, - cacheDir => $ce->{webworkDirs}->{equationCache}, - cacheURL => $ce->{webworkURLs}->{equationCache}, - cacheDB => $ce->{webworkFiles}->{equationCacheDB}, - dvipng_align => $imagesModeOptions{dvipng_align}, - dvipng_depth_db => $imagesModeOptions{dvipng_depth_db}, - ); - return CGI::div({ class => 'alert alert-danger p-1 mb-0' }, CGI::p("You are not authorized to acces the Instructor tools.")) unless $authz->hasPermissions($userID, "access_instructor_tools"); @@ -191,13 +176,12 @@ sub body { unless $set && $problem; #set up a silly problem to render the problem text - my $pg = WeBWorK::PG->new( + my $pg = WeBWorK::PG->new(constructPGOptions( $ce, $user, - $key, $set, $problem, - $set->psvn, # FIXME: this field should be removed + $set->psvn, $formFields, { # translation options displayMode => $displayMode, @@ -207,8 +191,9 @@ sub body { processAnswers => 1, permissionLevel => $db->getPermissionLevel($userID)->permission, effectivePermissionLevel => $db->getPermissionLevel($userID)->permission, + isInstructor => 1 }, - ); + )); # check to see what type the answers are. right now it only checks for essay but could do more my %answerHash = %{ $pg->{answers} }; diff --git a/lib/WeBWorK/ContentGenerator/Instructor/ProblemSetDetail.pm b/lib/WeBWorK/ContentGenerator/Instructor/ProblemSetDetail.pm index 670817940d..feb5b29c84 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/ProblemSetDetail.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/ProblemSetDetail.pm @@ -37,16 +37,16 @@ use WeBWorK::Debug; # these constants determine which fields belong to what type of record use constant SET_FIELDS => [qw(set_header hardcopy_header open_date reduced_scoring_date due_date answer_date visible description enable_reduced_scoring restricted_release restricted_status restrict_ip relax_restrict_ip assignment_type attempts_per_version version_time_limit time_limit_cap versions_per_interval time_interval problem_randorder problems_per_page hide_score:hide_score_by_problem hide_work hide_hint restrict_prob_progression email_instructor)]; -use constant PROBLEM_FIELDS =>[qw(source_file value max_attempts showMeAnother prPeriod att_to_open_children counts_parent_grade)]; +use constant PROBLEM_FIELDS =>[qw(source_file value max_attempts showMeAnother showHintsAfter prPeriod att_to_open_children counts_parent_grade)]; use constant USER_PROBLEM_FIELDS => [qw(problem_seed status num_correct num_incorrect)]; # these constants determine what order those fields should be displayed in use constant HEADER_ORDER => [qw(set_header hardcopy_header)]; -use constant PROBLEM_FIELD_ORDER => [qw(problem_seed status value max_attempts showMeAnother prPeriod attempted last_answer num_correct num_incorrect)]; +use constant PROBLEM_FIELD_ORDER => [qw(problem_seed status value max_attempts showMeAnother showHintsAfter prPeriod attempted last_answer num_correct num_incorrect)]; # for gateway sets, we don't want to allow users to change max_attempts on a per # problem basis, as that's nothing but confusing. use constant GATEWAY_PROBLEM_FIELD_ORDER => [qw(problem_seed status value attempted last_answer num_correct num_incorrect)]; -use constant JITAR_PROBLEM_FIELD_ORDER => [qw(problem_seed status value max_attempts showMeAnother prPeriod att_to_open_children counts_parent_grade attempted last_answer num_correct num_incorrect)]; +use constant JITAR_PROBLEM_FIELD_ORDER => [qw(problem_seed status value max_attempts showMeAnother showHintsAfter prPeriod att_to_open_children counts_parent_grade attempted last_answer num_correct num_incorrect)]; # we exclude the gateway set fields from the set field order, because they @@ -345,6 +345,22 @@ use constant FIELD_PROPERTIES => { }, help_text => x("When a student has more attempts than is specified here they will be able to view another version of this problem. If set to -1 the feature is disabled and if set to -2 the course default is used.") }, + showHintsAfter => { + name => x('Show hints after'), + type => 'edit', + size => '6', + override => 'any', + default => '-2', + labels => { + '-2' => x('Default'), + '-1' => x('Never'), + }, + help_text => x( + 'This specifies the number of attempts before hints are shown to students. ' + . 'The value of -2 uses the default from course configuration. The value of -1 disables hints.' + . 'Note that this will only have effect if the problem has a hint.' + ), + }, prPeriod => { name => x("Rerandomize after"), type => "edit", diff --git a/lib/WeBWorK/ContentGenerator/Instructor/ProblemSetList.pm b/lib/WeBWorK/ContentGenerator/Instructor/ProblemSetList.pm index 74fbd2fffc..73f2665ed0 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/ProblemSetList.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/ProblemSetList.pm @@ -1785,6 +1785,7 @@ sub importSetsFromDef { value => $rh_problem->{value}, maxAttempts => $rh_problem->{max_attempts}, showMeAnother => $rh_problem->{showMeAnother}, + showHintsAfter => $rh_problem->{showHintsAfter}, prPeriod => $rh_problem->{prPeriod}, attToOpenChildren => $rh_problem->{attToOpenChildren}, countsParentGrade => $rh_problem->{countsParentGrade} @@ -1829,6 +1830,7 @@ sub readSetDef { my $counts_parent_grade_default = $self->{ce}->{problemDefaults}->{counts_parent_grade}; my $showMeAnother_default = $self->{ce}->{problemDefaults}->{showMeAnother}; + my $showHintsAfter_default = $self->{ce}{problemDefaults}{showHintsAfter}; my $prPeriod_default=$self->{ce}->{problemDefaults}->{prPeriod}; my $setName = ''; @@ -1861,7 +1863,7 @@ sub readSetDef { $problemsPerPage, $restrictLoc, $emailInstructor, $restrictProbProgression, $countsParentGrade, $attToOpenChildren, - $problemID, $showMeAnother, $prPeriod, $listType + $problemID, $showMeAnother, $showHintsAfter, $prPeriod, $listType ) = ('')x16; # initialize these to '' my ( $timeCap, $restrictIP, $relaxRestrictIP ) = ( 0, 'No', 'No'); @@ -2108,6 +2110,7 @@ sub readSetDef { value => $weight, max_attempts => $attemptLimit, showMeAnother => $showMeAnother, + showHintsAfter => $showHintsAfter, # use default since it's not going to be in the file prPeriod => $prPeriod_default, continuation => $continueFlag, @@ -2144,6 +2147,8 @@ sub readSetDef { $attemptLimit = ( $value ) ? $value : $max_attempts_default; } elsif ( $item eq 'showMeAnother' ) { $showMeAnother = ( $value ) ? $value : 0; + } elsif ( $item eq 'showHintsAfter' ) { + $showHintsAfter = ( $value ) ? $value : 0; } elsif ( $item eq 'prPeriod' ) { $prPeriod = ( $value ) ? $value : 0; } elsif ( $item eq 'restrictProbProgression' ) { @@ -2173,6 +2178,9 @@ sub readSetDef { unless ($showMeAnother =~ /-?\d+/) {$showMeAnother = $showMeAnother_default;} $showMeAnother =~ s/[^-?\d-]*//g; + unless ($showHintsAfter =~ /-?\d+/) {$showHintsAfter = $showMeAnother_default;} + $showHintsAfter =~ s/[^-?\d-]*//g; + unless ($prPeriod =~ /-?\d+/) {$prPeriod = $prPeriod_default;} $prPeriod =~ s/[^-?\d-]*//g; @@ -2194,6 +2202,7 @@ sub readSetDef { value => $weight, max_attempts => $attemptLimit, showMeAnother => $showMeAnother, + showHintsAfter => $showHintsAfter, prPeriod => $prPeriod, attToOpenChildren => $attToOpenChildren, countsParentGrade => $countsParentGrade, @@ -2205,6 +2214,7 @@ sub readSetDef { $weight = ''; $attemptLimit = ''; $showMeAnother = ''; + $showHintsAfter = ''; $attToOpenChildren = ''; $countsParentGrade = ''; @@ -2311,6 +2321,7 @@ SET: foreach my $set (keys %filenames) { my $value = $problemRecord->value(); my $max_attempts = $problemRecord->max_attempts(); my $showMeAnother = $problemRecord->showMeAnother(); + my $showHintsAfter = $problemRecord->showHintsAfter(); my $prPeriod = $problemRecord->prPeriod(); my $countsParentGrade = $problemRecord->counts_parent_grade(); my $attToOpenChildren = $problemRecord->att_to_open_children(); @@ -2320,6 +2331,7 @@ SET: foreach my $set (keys %filenames) { $value =~ s/([,\\])/\\$1/g; $max_attempts =~ s/([,\\])/\\$1/g; $showMeAnother =~ s/([,\\])/\\$1/g; + $showHintsAfter =~ s/([,\\])/\\$1/g; $prPeriod =~ s/([,\\])/\\$1/g; # This is the new way of saving problem information @@ -2331,6 +2343,7 @@ SET: foreach my $set (keys %filenames) { $problemList .= "value = $value\n"; $problemList .= "max_attempts = $max_attempts\n"; $problemList .= "showMeAnother = $showMeAnother\n"; + $problemList .= "showHintsAfter = $showHintsAfter\n"; $problemList .= "prPeriod = $prPeriod\n"; $problemList .= "counts_parent_grade = $countsParentGrade\n"; $problemList .= "att_to_open_children = $attToOpenChildren \n"; diff --git a/lib/WeBWorK/ContentGenerator/Instructor/ShowAnswers.pm b/lib/WeBWorK/ContentGenerator/Instructor/ShowAnswers.pm index 0532e57126..8fc51809da 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/ShowAnswers.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/ShowAnswers.pm @@ -28,6 +28,7 @@ use warnings; use WeBWorK::CGI; use WeBWorK::HTML::ScrollingRecordList qw/scrollingRecordList/; use WeBWorK::Utils qw(sortByName jitar_id_to_seq seq_to_jitar_id getAssetURL format_set_name_display); +use WeBWorK::Utils::Rendering qw(constructPGOptions); use PGcore; use Text::CSV; @@ -141,24 +142,20 @@ sub initialize { #if these things dont exist then the problem doesnt exist and past answers dont make sense next unless defined($set) && defined($problem) && defined($userobj); - my $pg = WeBWorK::PG->new( - $ce, - $userobj, - $key, - $set, - $problem, - $set->psvn, # FIXME: this field should be removed - $formFields, - { # translation options - displayMode => 'plainText', - showHints => 0, - showSolutions => 0, - refreshMath2img => 0, - processAnswers => 1, - permissionLevel => $db->getPermissionLevel($studentUser)->permission, - effectivePermissionLevel => $db->getPermissionLevel($studentUser)->permission, - }, - ); + my $pg = WeBWorK::PG->new(constructPGOptions( + $ce, $userobj, $set, $problem, + $set->psvn, + $formFields, + { # translation options + displayMode => 'plainText', + showHints => 0, + showSolutions => 0, + refreshMath2img => 0, + processAnswers => 1, + permissionLevel => $db->getPermissionLevel($studentUser)->permission, + effectivePermissionLevel => $db->getPermissionLevel($studentUser)->permission, + }, + )); # check to see what type the answers are. right now it only checks for essay but could do more my %answerHash = %{ $pg->{answers} }; diff --git a/lib/WeBWorK/ContentGenerator/Problem.pm b/lib/WeBWorK/ContentGenerator/Problem.pm index 77ff63681a..0fbd8e3be2 100644 --- a/lib/WeBWorK/ContentGenerator/Problem.pm +++ b/lib/WeBWorK/ContentGenerator/Problem.pm @@ -14,10 +14,10 @@ ################################################################################ package WeBWorK::ContentGenerator::Problem; -#use base qw(WeBWorK); use base qw(WeBWorK::ContentGenerator); -use WeBWorK::ContentGenerator::ProblemUtil::ProblemUtil; # not needed? -use WeBWorK::ContentGenerator::Instructor::SingleProblemGrader; + +use strict; +use warnings; =head1 NAME @@ -25,23 +25,20 @@ WeBWorK::ContentGenerator::Problem - Allow a student to interact with a problem. =cut -use strict; -use warnings; -#use CGI qw(-nosticky ); -use WeBWorK::CGI; -use File::Path qw(rmtree); +use WeBWorK::ContentGenerator::Instructor::SingleProblemGrader; use WeBWorK::Debug; use WeBWorK::Form; use WeBWorK::PG; use WeBWorK::PG::ImageGenerator; use WeBWorK::PG::IO; -use WeBWorK::Utils qw(readFile writeLog writeCourseLog encodeAnswers decodeAnswers is_restricted ref2string - makeTempDirectory path_is_subdir before after between wwRound is_jitar_problem_closed is_jitar_problem_hidden - jitar_problem_adjusted_status jitar_id_to_seq seq_to_jitar_id jitar_problem_finished getAssetURL - format_set_name_display); -use WeBWorK::DB::Utils qw(global2user user2global); +use WeBWorK::Utils qw(decodeAnswers is_restricted ref2string path_is_subdir before after between + wwRound is_jitar_problem_closed is_jitar_problem_hidden jitar_problem_adjusted_status + jitar_id_to_seq seq_to_jitar_id jitar_problem_finished getAssetURL format_set_name_display); +use WeBWorK::Utils::Rendering qw(constructPGOptions getTranslatorDebuggingOptions); +use WeBWorK::Utils::ProblemProcessing qw/process_and_log_answer check_invalid jitar_send_warning_email + compute_reduced_score/; +use WeBWorK::DB::Utils qw(global2user); require WeBWorK::Utils::ListingDB; -use URI::Escape; use WeBWorK::Localize; use WeBWorK::Utils::Tasks qw(fake_set fake_problem); use WeBWorK::Utils::LanguageAndDirection; @@ -114,11 +111,8 @@ sub can_showCorrectAnswers { my ($self, $User, $EffectiveUser, $Set, $Problem) = @_; my $authz = $self->r->authz; - return - after($Set->answer_date) - || - $authz->hasPermissions($User->user_id, "show_correct_answers_before_answer_date") - ; + return after($Set->answer_date) + || $authz->hasPermissions($User->user_id, "show_correct_answers_before_answer_date"); } sub can_showProblemGrader { @@ -133,44 +127,45 @@ sub can_showProblemGrader { sub can_showAnsGroupInfo { my ($self, $User, $EffectiveUser, $Set, $Problem) = @_; my $authz = $self->r->authz; -#FIXME -- may want to adjust this - return - $authz->hasPermissions($User->user_id, "show_answer_group_info_checkbox") - ; + + return $authz->hasPermissions($User->user_id, 'show_answer_group_info'); } sub can_showAnsHashInfo { my ($self, $User, $EffectiveUser, $Set, $Problem) = @_; my $authz = $self->r->authz; -#FIXME -- may want to adjust this - return - $authz->hasPermissions($User->user_id, "show_answer_hash_info_checkbox") - ; + + return $authz->hasPermissions($User->user_id, 'show_answer_hash_info'); } sub can_showPGInfo { my ($self, $User, $EffectiveUser, $Set, $Problem) = @_; my $authz = $self->r->authz; -#FIXME -- may want to adjust this - return - $authz->hasPermissions($User->user_id, "show_pg_info_checkbox") - ; + + return $authz->hasPermissions($User->user_id, 'show_pg_info'); } sub can_showResourceInfo { my ($self, $User, $EffectiveUser, $Set, $Problem) = @_; my $authz = $self->r->authz; - return - $authz->hasPermissions($User->user_id, "show_resource_info") - ; + return $authz->hasPermissions($User->user_id, 'show_resource_info'); } sub can_showHints { - my ($self, $User, $EffectiveUser, $Set, $Problem) = @_; - my $authz = $self->r->authz; + my ($self, $User, $EffectiveUser, $Set, $Problem, $submitAnswers) = @_; + my $r = $self->r; + my $authz = $r->authz; - return !$Set->hide_hint; + return 1 if $authz->hasPermissions($User->user_id, 'always_show_hint'); + + my $showHintsAfter = + $Set->hide_hint ? -1 + : $Problem->showHintsAfter > -2 ? $Problem->showHintsAfter + : $r->ce->{pg}{options}{showHintsAfter}; + + return $showHintsAfter > -1 + && $showHintsAfter <= $Problem->num_correct + $Problem->num_incorrect + ($submitAnswers ? 1 : 0); } sub can_showSolutions { @@ -178,10 +173,9 @@ sub can_showSolutions { my $authz = $self->r->authz; return - after($Set->answer_date) - || - $authz->hasPermissions($User->user_id, "show_solutions_before_answer_date") - ; + $authz->hasPermissions($User->user_id, 'always_show_solutions') + || after($Set->answer_date) + || $authz->hasPermissions($User->user_id, "show_solutions_before_answer_date"); } @@ -332,6 +326,7 @@ sub attemptResults { cacheDir => $ce->{webworkDirs}->{equationCache}, cacheURL => $ce->{webworkURLs}->{equationCache}, cacheDB => $ce->{webworkFiles}->{equationCacheDB}, + useMarkers => 1, dvipng_align => $imagesModeOptions{dvipng_align}, dvipng_depth_db => $imagesModeOptions{dvipng_depth_db}, ); @@ -359,7 +354,7 @@ sub attemptResults { # render equation images my $answerTemplate = $tbl->answerTemplate; # answerTemplate collects all the formulas to be displayed in the attempts table - $tbl->imgGen->render(refresh => 1) if $tbl->displayMode eq 'images'; + $tbl->imgGen->render(body_text => \$answerTemplate) if $tbl->displayMode eq 'images'; # after all of the formulas have been collected the render command creates png's for them # refresh=>1 insures that we never reuse old images -- since the answers change frequently return $answerTemplate; @@ -607,22 +602,19 @@ sub pre_header_initialize { # Note: ProblemSet and ProblemSets might set showOldAnswers to '', which # needs to be treated as if it is not set. my %want = ( - showOldAnswers => $user->showOldAnswers ne '' ? $user->showOldAnswers : $ce->{pg}->{options}->{showOldAnswers}, + showOldAnswers => $user->showOldAnswers ne '' ? $user->showOldAnswers : $ce->{pg}{options}{showOldAnswers}, # showProblemGrader implies showCorrectAnswers. This is a convenience for grading. - showCorrectAnswers => $r->param('showCorrectAnswers') || $r->param('showProblemGrader') - || $ce->{pg}->{options}->{showCorrectAnswers}, - showProblemGrader => $r->param('showProblemGrader') || 0, - showAnsGroupInfo => $r->param('showAnsGroupInfo') || $ce->{pg}->{options}->{showAnsGroupInfo}, - showAnsHashInfo => $r->param('showAnsHashInfo') || $ce->{pg}->{options}->{showAnsHashInfo}, - showPGInfo => $r->param('showPGInfo') || $ce->{pg}->{options}->{showPGInfo}, - showResourceInfo => $r->param('showResourceInfo') || $ce->{pg}->{options}->{showResourceInfo}, - showHints => $r->param("showHints") || $ce->{pg}->{options}{use_knowls_for_hints} - || $ce->{pg}->{options}->{showHints}, #set to 0 in defaults.config - showSolutions => $r->param("showSolutions") || $ce->{pg}->{options}{use_knowls_for_solutions} - || $ce->{pg}->{options}->{showSolutions}, #set to 0 in defaults.config - useMathView => $user->useMathView ne '' ? $user->useMathView : $ce->{pg}->{options}->{useMathView}, - useWirisEditor => $user->useWirisEditor ne '' ? $user->useWirisEditor : $ce->{pg}->{options}->{useWirisEditor}, - useMathQuill => $user->useMathQuill ne '' ? $user->useMathQuill : $ce->{pg}->{options}->{useMathQuill}, + showCorrectAnswers => $r->param('showCorrectAnswers') || $r->param('showProblemGrader') || 0, + showProblemGrader => $r->param('showProblemGrader') || 0, + showAnsGroupInfo => $r->param('showAnsGroupInfo') || $ce->{pg}{options}{showAnsGroupInfo}, + showAnsHashInfo => $r->param('showAnsHashInfo') || $ce->{pg}{options}{showAnsHashInfo}, + showPGInfo => $r->param('showPGInfo') || $ce->{pg}{options}{showPGInfo}, + showResourceInfo => $r->param('showResourceInfo') || $ce->{pg}{options}{showResourceInfo}, + showHints => 1, + showSolutions => 1, + useMathView => $user->useMathView ne '' ? $user->useMathView : $ce->{pg}{options}{useMathView}, + useWirisEditor => $user->useWirisEditor ne '' ? $user->useWirisEditor : $ce->{pg}{options}{useWirisEditor}, + useMathQuill => $user->useMathQuill ne '' ? $user->useMathQuill : $ce->{pg}{options}{useMathQuill}, recordAnswers => $submitAnswers, checkAnswers => $checkAnswers, getSubmitButton => 1, @@ -659,7 +651,7 @@ sub pre_header_initialize { showAnsHashInfo => $self->can_showAnsHashInfo(@args), showPGInfo => $self->can_showPGInfo(@args), showResourceInfo => $self->can_showResourceInfo(@args), - showHints => $self->can_showHints(@args), + showHints => $self->can_showHints(@args, $submitAnswers), showSolutions => $self->can_showSolutions(@args), recordAnswers => $self->can_recordAnswers(@args, 0), checkAnswers => $self->can_checkAnswers(@args, $submitAnswers), @@ -726,19 +718,17 @@ sub pre_header_initialize { ##### translation ##### debug("begin pg processing"); - my $pg = WeBWorK::PG->new( + my $pg = WeBWorK::PG->new(constructPGOptions( $ce, $effectiveUser, - $key, - $set, - $problem, + $set, $problem, $set->psvn, $formFields, { # translation options displayMode => $displayMode, showHints => $will{showHints}, - showResourceInfo => $will{showResourceInfo}, showSolutions => $will{showSolutions}, + showResourceInfo => $will{showResourceInfo}, refreshMath2img => $will{showHints} || $will{showSolutions}, processAnswers => 1, permissionLevel => $db->getPermissionLevel($userName)->permission, @@ -746,8 +736,11 @@ sub pre_header_initialize { useMathQuill => $will{useMathQuill}, useMathView => $will{useMathView}, useWirisEditor => $will{useWirisEditor}, - }, - ); + forceScaffoldsOpen => 0, + isInstructor => $authz->hasPermissions($userName, 'view_answers'), + debuggingOptions => getTranslatorDebuggingOptions($authz, $userName) + } + )); debug("end pg processing"); @@ -772,11 +765,9 @@ sub pre_header_initialize { } } - ##### update and fix hint/solution options after PG processing ##### - - $can{showHints} &&= $pg->{flags}->{hintExists} - &&= $pg->{flags}->{showHintLimit}<=$pg->{state}->{num_of_incorrect_ans}; - $can{showSolutions} &&= $pg->{flags}->{solutionExists}; + # Update and fix hint/solution options after PG processing + $can{showHints} &&= $pg->{flags}{hintExists}; + $can{showSolutions} &&= $pg->{flags}{solutionExists}; ##### record errors ######### if (ref ($pg->{pgcore}) ) { @@ -801,7 +792,7 @@ sub pre_header_initialize { $self->{pg} = $pg; #### process and log answers #### - $self->{scoreRecordedMessage} = WeBWorK::ContentGenerator::ProblemUtil::ProblemUtil::process_and_log_answer($self) || ""; + $self->{scoreRecordedMessage} = process_and_log_answer($self) || ""; } @@ -1449,7 +1440,6 @@ sub title { return $out; } -# now altered to outsource most output operations to the template, main functions now are simply error checking and answer processing - ghe3 sub body { my $self = shift; my $set = $self->{set}; @@ -1460,18 +1450,11 @@ sub body { This indicates an old style system.template file -- consider upgrading. ", caller(1), ); - my $valid = WeBWorK::ContentGenerator::ProblemUtil::ProblemUtil::check_invalid($self); + my $valid = check_invalid($self); unless($valid eq "valid"){ return $valid; } - - - ##### answer processing ##### - debug("begin answer processing"); - # if answers were submitted: - #my $scoreRecordedMessage = WeBWorK::ContentGenerator::ProblemUtil::ProblemUtil::process_and_log_answer($self); - debug("end answer processing"); # output for templates that only use body instead of calling the body parts individually $self ->output_JS; $self ->output_tag_info; @@ -1558,16 +1541,57 @@ sub output_problem_body{ } # output_message subroutine - -# prints out a message about the problem - -sub output_message{ +# Prints messages about the problem +sub output_message { my $self = shift; - my $pg = $self->{pg}; - my $r = $self->r; + my $pg = $self->{pg}; + my $r = $self->r; + my $ce = $r->ce; + + print CGI::p(CGI::b($r->maketext('Note') . ': '), CGI::i($pg->{result}{msg})) if $pg->{result}{msg}; + + print CGI::p( + CGI::b($r->maketext('Note') . ': '), + CGI::i( + $r->maketext( + 'You are in the Reduced Scoring Period. All work counts for [_1]% of the original.', + $ce->{pg}{ansEvalDefaults}{reducedScoringValue} * 100 + ) + ) + ) + if ($ce->{pg}{ansEvalDefaults}{enableReducedScoring} + && $self->{set}->enable_reduced_scoring + && after($self->{set}->reduced_scoring_date) + && before($self->{set}->due_date)); + + if ($pg->{flags}{hintExists} && $r->authz->hasPermissions($self->{userName}, 'always_show_hint')) { + my $showHintsAfter = + $self->{set}->hide_hint ? -1 + : $self->{problem}->showHintsAfter > -2 ? $self->{problem}->showHintsAfter + : $ce->{pg}{options}{showHintsAfter}; + print CGI::p( + CGI::b($r->maketext('Note') . ':'), + CGI::i($r->maketext( + $showHintsAfter == -1 + ? 'The hint shown is an instructor preview and will not be shown to students.' + : 'The hint shown is an instructor preview and will be shown to students after ' + . "$showHintsAfter attempts." + )) + ); + } - print CGI::p(CGI::b($r->maketext("Note").": "). CGI::i($pg->{result}->{msg})) if $pg->{result}->{msg}; - return ""; + if ($pg->{flags}{solutionExists} && $r->authz->hasPermissions($self->{userName}, 'always_show_solution')) { + print CGI::p( + CGI::b($r->maketext('Note') . ':'), + CGI::i( + $r->maketext( + 'The solution shown is an instructor preview and will only be shown to students after the due date.' + ) + ) + ); + } + + return ''; } # output_grader subroutine @@ -1654,16 +1678,10 @@ sub output_checkboxes { my %can = %{ $self->{can} }; my %will = %{ $self->{will} }; my $ce = $r->ce; - my $showHintCheckbox = $ce->{pg}{options}{show_hint_checkbox}; - my $showSolutionCheckbox = $ce->{pg}{options}{show_solution_checkbox}; - my $useKnowlsForHints = $ce->{pg}{options}{use_knowls_for_hints}; - my $useKnowlsForSolutions = $ce->{pg}{options}{use_knowls_for_solutions}; if ($can{showCorrectAnswers} || $can{showProblemGrader} || $can{showAnsGroupInfo} - || ($can{showHints} && ($showHintCheckbox || !$useKnowlsForHints)) - || ($can{showSolutions} && ($showSolutionCheckbox || !$useKnowlsForSolutions)) || $can{showAnsHashInfo} || $can{showPGInfo} || $can{showResourceInfo}) @@ -1761,47 +1779,6 @@ sub output_checkboxes { ); } - if ($can{showHints}) { - if ($showHintCheckbox || !$useKnowlsForHints) { - # Always allow checkbox to display if knowls are not used. - print CGI::div( - { class => 'form-check form-check-inline' }, - CGI::checkbox({ - id => 'showHints_id', - label => $r->maketext('Hints'), - name => 'showHints', - checked => $will{showHints}, - value => 1, - class => 'form-check-input', - labelattributes => { class => 'form-check-label' } - }) - ); - } else { - print CGI::hidden({ name => 'showHints', id => 'showHints_id', value => 1 }); - } - } - - if ($can{showSolutions}) { - if ($showSolutionCheckbox || !$useKnowlsForSolutions) { - # Always allow checkbox to display if knowls are not used. - print CGI::div( - { class => 'form-check form-check-inline' }, - CGI::checkbox({ - id => 'showSolutions_id', - label => $r->maketext('Solutions'), - name => 'showSolutions', - checked => $will{showSolutions}, - value => 1, - class => 'form-check-input', - labelattributes => { class => 'form-check-label' } - - }) - ); - } else { - print CGI::hidden({ id => 'showSolutions_id', name => 'showSolutions', value => 1 }); - } - } - return ''; } @@ -1932,179 +1909,205 @@ sub output_submit_buttons { } # output_score_summary subroutine - # prints out a summary of the student's current progress and status on the current problem - -sub output_score_summary{ - my $self = shift; - my $r = $self->r; - my $ce = $r->ce; - my $db = $r->db; - my $problem = $self->{problem}; - my $set = $self->{set}; - my $pg = $self->{pg}; +sub output_score_summary { + my $self = shift; + my $r = $self->r; + my $ce = $r->ce; + my $db = $r->db; + my $problem = $self->{problem}; + my $set = $self->{set}; + my $pg = $self->{pg}; my $effectiveUser = $r->param('effectiveUser') || $r->param('user'); - my $scoreRecordedMessage = $self->{scoreRecordedMessage}; - my $submitAnswers = $self->{submitAnswers}; - my %will = %{ $self->{will} }; - my $prEnabled = $ce->{pg}->{options}->{enablePeriodicRandomization} // 0; - my $rerandomizePeriod = $ce->{pg}->{options}->{periodicRandomizationPeriod} // 0; - $rerandomizePeriod = $problem->{prPeriod} if (defined($problem->{prPeriod}) && $problem->{prPeriod} > -1); - $prEnabled = 0 if ($rerandomizePeriod < 1); + my $prEnabled = $ce->{pg}{options}{enablePeriodicRandomization} // 0; + my $rerandomizePeriod = $ce->{pg}{options}{periodicRandomizationPeriod} // 0; + $rerandomizePeriod = $problem->{prPeriod} if defined $problem->{prPeriod} && $problem->{prPeriod} > -1; + $prEnabled = 0 if $rerandomizePeriod < 1; # score summary - warn "num_correct =", $problem->num_correct,"num_incorrect=",$problem->num_incorrect - unless defined($problem->num_correct) and defined($problem->num_incorrect) ; - my $attempts = $problem->num_correct + $problem->num_incorrect; - #my $attemptsNoun = $attempts != 1 ? $r->maketext("times") : $r->maketext("time"); + warn 'num_correct = ' . $problem->num_correct . 'num_incorrect = ' . $problem->num_incorrect + unless defined $problem->num_correct && defined $problem->num_incorrect; - my $prMessage = ""; + my $prMessage = ''; if ($prEnabled) { - my $attempts_before_rr = (defined($will{requestNewSeed}) && $will{requestNewSeed}) ? 0 - : ($rerandomizePeriod - $problem->{prCount}); + my $attempts_before_rr = $self->{will}{requestNewSeed} ? 0 : ($rerandomizePeriod - $problem->{prCount}); - $prMessage = " " . $r->maketext( - "You have [quant,_1,attempt,attempts] left before new version will be requested.", - $attempts_before_rr) - if ($attempts_before_rr > 0); + $prMessage = ' ' + . $r->maketext('You have [quant,_1,attempt,attempts] left before new version will be requested.', + $attempts_before_rr) + if $attempts_before_rr > 0; - $prMessage = " " . $r->maketext("Request new version now.") - if ($attempts_before_rr == 0); + $prMessage = ' ' . $r->maketext('Request new version now.') if ($attempts_before_rr == 0); } - $prMessage = "" if (after($set->due_date) or before($set->open_date)); - - my $problem_status = $problem->status || 0; - my $lastScore = wwRound(0, $problem_status * 100).'%'; # Round to whole number - my $attemptsLeft = $problem->max_attempts - $attempts; + $prMessage = '' if after($set->due_date) or before($set->open_date); my $setClosed = 0; my $setClosedMessage; - if (before($set->open_date) or after($set->due_date)) { - $setClosed = 1; - if (before($set->open_date)) { - $setClosedMessage = $r->maketext("This homework set is not yet open."); - } elsif (after($set->due_date)) { - $setClosedMessage = $r->maketext("This homework set is closed."); - } - } - #if (before($set->open_date) or after($set->due_date)) { - # $setClosed = 1; - # $setClosedMessage = "This homework set is closed."; - # if ($authz->hasPermissions($user, "view_answers")) { - # $setClosedMessage .= " However, since you are a privileged user, additional attempts will be recorded."; - # } else { - # $setClosedMessage .= " Additional attempts will not be recorded."; - # } - #} - print CGI::start_p(); - unless (defined( $pg->{state}->{state_summary_msg}) and $pg->{state}->{state_summary_msg}=~/\S/) { + if (before($set->open_date) || after($set->due_date)) { + $setClosed = 1; + if (before($set->open_date)) { + $setClosedMessage = $r->maketext("This homework set is not yet open."); + } elsif (after($set->due_date)) { + $setClosedMessage = $r->maketext("This homework set is closed."); + } + } - my $notCountedMessage = ($problem->value) ? "" : $r->maketext("(This problem will not count towards your grade.)"); - print join("", - $submitAnswers ? $scoreRecordedMessage . CGI::br() : "", - $r->maketext("You have attempted this problem [quant,_1,time,times].",$attempts), $prMessage, CGI::br(), - $submitAnswers ? $r->maketext("You received a score of [_1] for this attempt.",wwRound(0, $pg->{result}->{score} * 100).'%') . CGI::br():'', - $problem->attempted + my $attempts = $problem->num_correct + $problem->num_incorrect; - ? $r->maketext("Your overall recorded score is [_1]. [_2]",$lastScore,$notCountedMessage) . CGI::br() - : "", - $setClosed ? $setClosedMessage : $r->maketext("You have [negquant,_1,unlimited attempts,attempt,attempts] remaining.",$attemptsLeft) + print CGI::start_p(); + unless (defined $pg->{state}{state_summary_msg} && $pg->{state}{state_summary_msg} =~ /\S/) { + print join( + '', + $self->{submitAnswers} ? $self->{scoreRecordedMessage} . CGI::br() : '', + $r->maketext('You have attempted this problem [quant,_1,time,times].', $attempts), + $prMessage, + CGI::br(), + $self->{submitAnswers} + ? ( + $r->maketext('You received a score of [_1] for this attempt.', + wwRound(0, compute_reduced_score($ce, $problem, $set, $pg->{result}{score}) * 100) . '%') + . CGI::br() + ) + : '', + $problem->attempted + ? $r->maketext( + 'Your overall recorded score is [_1]. [_2]', + wwRound(0, $problem->status * 100) . '%', + $problem->value ? '' : $r->maketext('(This problem will not count towards your grade.)') + ) + . CGI::br() + : '', + $setClosed ? $setClosedMessage : $r->maketext( + 'You have [negquant,_1,unlimited attempts,attempt,attempts] remaining.', + $problem->max_attempts - $attempts + ) ); - }else { - print $pg->{state}->{state_summary_msg}; + } else { + print $pg->{state}{state_summary_msg}; } - #print jitar specific informaton for students. (and notify instructor - # if necessary + # Print jitar specific informaton for students (and notify instructor if necessary). if ($set->set_id ne 'Undefined_Set' && $set->assignment_type() eq 'jitar') { - my @problemIDs = - map { $_->[2] } $db->listUserProblemsWhere({ user_id => $effectiveUser, set_id => $set->set_id }, 'problem_id'); - - # get some data - my @problemSeqs; - my $index; - # this sets of an array of the sequence assoicated to the - #problem_id - for (my $i=0; $i<=$#problemIDs; $i++) { - $index = $i if ($problemIDs[$i] == $problem->problem_id); - my @seq = jitar_id_to_seq($problemIDs[$i]); - push @problemSeqs, \@seq; - } + my @problemIDs = + map { $_->[2] } + $db->listUserProblemsWhere({ user_id => $effectiveUser, set_id => $set->set_id }, 'problem_id'); - my $next_id = $index+1; - my @seq = @{$problemSeqs[$index]}; - my @children_counts_indexs; - my $hasChildren = 0; + # get some data + my @problemSeqs; + my $index; + # this sets of an array of the sequence assoicated to the problem_id + for (my $i = 0; $i <= $#problemIDs; $i++) { + $index = $i if ($problemIDs[$i] == $problem->problem_id); + my @seq = jitar_id_to_seq($problemIDs[$i]); + push @problemSeqs, \@seq; + } - # this does several things. It finds the index of the next problem - # at the same level as the current one. It checks to see if there - # are any children, and it finds which of those children count - # toward the grade of this problem. + my $next_id = $index + 1; + my @seq = @{ $problemSeqs[$index] }; + my @children_counts_indexs; + my $hasChildren = 0; + + # this does several things. It finds the index of the next problem + # at the same level as the current one. It checks to see if there + # are any children, and it finds which of those children count + # toward the grade of this problem. + while ($next_id <= $#problemIDs && scalar(@{ $problemSeqs[$index] }) < scalar(@{ $problemSeqs[$next_id] })) { + + my $childProblem = $db->getMergedProblem($effectiveUser, $set->set_id, $problemIDs[$next_id]); + $hasChildren = 1; + push @children_counts_indexs, $next_id + if scalar(@{ $problemSeqs[$index] }) + 1 == scalar(@{ $problemSeqs[$next_id] }) + && $childProblem->counts_parent_grade; + $next_id++; + } - while ($next_id <= $#problemIDs && scalar(@{$problemSeqs[$index]}) < scalar(@{$problemSeqs[$next_id]})) { + # print information if this problem has open children and if the grade + # for this problem can be replaced by the grades of its children + if ( + $hasChildren + && ( + ($problem->att_to_open_children != -1 && $problem->num_incorrect >= $problem->att_to_open_children) + || ($problem->max_attempts != -1 + && $problem->num_incorrect >= $problem->max_attempts) + ) + ) + { + print CGI::br() + . $r->maketext('This problem has open subproblems. ' + . 'You can visit them by using the links to the left or visiting the set page.'); + + if (scalar(@children_counts_indexs) == 1) { + print CGI::br() + . $r->maketext( + 'The grade for this problem is the larger of the score for this problem, ' + . 'or the score of problem [_1].', + join('.', @{ $problemSeqs[ $children_counts_indexs[0] ] }) + ); + } elsif (scalar(@children_counts_indexs) > 1) { + print CGI::br() + . $r->maketext( + 'The grade for this problem is the larger of the score for this problem, ' + . 'or the weighted average of the problems: [_1].', + join(', ', map({ join('.', @{ $problemSeqs[$_] }) } @children_counts_indexs)) + ); + } + } - my $childProblem = $db->getMergedProblem($effectiveUser,$set->set_id, $problemIDs[$next_id]); - $hasChildren = 1; - push @children_counts_indexs, $next_id if scalar(@{$problemSeqs[$index]}) + 1 == scalar(@{$problemSeqs[$next_id]}) && $childProblem->counts_parent_grade; - $next_id++; - } - - # print information if this problem has open children and if the grade - # for this problem can be replaced by the grades of its children - if ( $hasChildren - && (($problem->att_to_open_children != -1 && $problem->num_incorrect >= $problem->att_to_open_children) || - ($problem->max_attempts != -1 && - $problem->num_incorrect >= $problem->max_attempts))) { - print CGI::br().$r->maketext('This problem has open subproblems. You can visit them by using the links to the left or visiting the set page.'); - - if (scalar(@children_counts_indexs) == 1) { - print CGI::br().$r->maketext('The grade for this problem is the larger of the score for this problem, or the score of problem [_1].', join('.', @{$problemSeqs[$children_counts_indexs[0]]})); - } elsif (scalar(@children_counts_indexs) > 1) { - print CGI::br().$r->maketext('The grade for this problem is the larger of the score for this problem, or the weighted average of the problems: [_1].', join(', ', map({join('.', @{$problemSeqs[$_]})} @children_counts_indexs))); - } - } - - - # print information if this set has restricted progression and if you need - # to finish this problem (and maybe its children) to proceed - if ($set->restrict_prob_progression() && - $next_id <= $#problemIDs && - is_jitar_problem_closed($db,$ce,$effectiveUser, $set->set_id, $problemIDs[$next_id])) { - if ($hasChildren) { - print CGI::br().$r->maketext('You will not be able to proceed to problem [_1] until you have completed, or run out of attempts, for this problem and its graded subproblems.',join('.',@{$problemSeqs[$next_id]})); - } elsif (scalar(@seq) == 1 || - $problem->counts_parent_grade()) { - print CGI::br().$r->maketext('You will not be able to proceed to problem [_1] until you have completed, or run out of attempts, for this problem.',join('.',@{$problemSeqs[$next_id]})); - } - } - # print information if this problem counts towards the grade of its parent, - # if it doesn't (and its not a top level problem) then its grade doesnt matter. - if ($problem->counts_parent_grade() && scalar(@seq) != 1) { - pop @seq; - print CGI::br().$r->maketext('The score for this problem can count towards score of problem [_1].',join('.',@seq)); - } elsif (scalar(@seq)!=1) { - pop @seq; - print CGI::br().$r->maketext('This score for this problem does not count for the score of problem [_1] or for the set.',join('.',@seq)); - } - - # if the instructor has set this up, email the instructor a warning message if - # the student has run out of attempts on a top level problem and all of its children - # and didn't get 100% - if ($submitAnswers && $set->email_instructor) { - my $parentProb = $db->getMergedProblem($effectiveUser,$set->set_id,seq_to_jitar_id($seq[0])); - warn("Couldn't find problem $seq[0] from set ".$set->set_id." in the database") unless $parentProb; - - #email instructor with a message if the student didnt finish - if (jitar_problem_finished($parentProb,$db) && - jitar_problem_adjusted_status($parentProb,$db) != 1) { - WeBWorK::ContentGenerator::ProblemUtil::ProblemUtil::jitar_send_warning_email($self,$parentProb); - } - - } + # print information if this set has restricted progression and if you need + # to finish this problem (and maybe its children) to proceed + if ($set->restrict_prob_progression() + && $next_id <= $#problemIDs + && is_jitar_problem_closed($db, $ce, $effectiveUser, $set->set_id, $problemIDs[$next_id])) + { + if ($hasChildren) { + print CGI::br() + . $r->maketext( + 'You will not be able to proceed to problem [_1] until you have completed, ' + . 'or run out of attempts, for this problem and its graded subproblems.', + join('.', @{ $problemSeqs[$next_id] }) + ); + } elsif (scalar(@seq) == 1 + || $problem->counts_parent_grade()) + { + print CGI::br() + . $r->maketext( + 'You will not be able to proceed to problem [_1] until you have completed, ' + . 'or run out of attempts, for this problem.', + join('.', @{ $problemSeqs[$next_id] }) + ); + } + } + # print information if this problem counts towards the grade of its parent, + # if it doesn't (and its not a top level problem) then its grade doesnt matter. + if ($problem->counts_parent_grade() && scalar(@seq) != 1) { + pop @seq; + print CGI::br() + . $r->maketext('The score for this problem can count towards score of problem [_1].', join('.', @seq)); + } elsif (scalar(@seq) != 1) { + pop @seq; + print CGI::br() + . $r->maketext( + 'This score for this problem does not count for the score of problem [_1] or for the set.', + join('.', @seq)); + } + + # if the instructor has set this up, email the instructor a warning message if + # the student has run out of attempts on a top level problem and all of its children + # and didn't get 100% + if ($self->{submitAnswers} && $set->email_instructor) { + my $parentProb = $db->getMergedProblem($effectiveUser, $set->set_id, seq_to_jitar_id($seq[0])); + warn("Couldn't find problem $seq[0] from set " . $set->set_id . " in the database") unless $parentProb; + + #email instructor with a message if the student didnt finish + if (jitar_problem_finished($parentProb, $db) && jitar_problem_adjusted_status($parentProb, $db) != 1) { + jitar_send_warning_email($self, $parentProb); + } + + } } print CGI::end_p(); - return ""; + return ''; } # output_misc subroutine diff --git a/lib/WeBWorK/ContentGenerator/ProblemSet.pm b/lib/WeBWorK/ContentGenerator/ProblemSet.pm index a2d739ff89..2e25d4950b 100644 --- a/lib/WeBWorK/ContentGenerator/ProblemSet.pm +++ b/lib/WeBWorK/ContentGenerator/ProblemSet.pm @@ -32,6 +32,7 @@ use WeBWorK::Debug; use WeBWorK::Utils qw(path_is_subdir is_restricted is_jitar_problem_closed is_jitar_problem_hidden jitar_problem_adjusted_status jitar_id_to_seq seq_to_jitar_id wwRound before between after grade_set format_set_name_display); +use WeBWorK::Utils::Rendering qw(constructPGOptions); use WeBWorK::Localize; sub initialize { @@ -238,10 +239,9 @@ sub info { # the rest of Problem's fields are not needed, i think ); - my $pg = WeBWorK::PG->new( + my $pg = WeBWorK::PG->new(constructPGOptions( $ce, $effectiveUser, - $r->param('key'), $set, $problem, $psvn, @@ -252,7 +252,7 @@ sub info { showSolutions => 0, processAnswers => 0, }, - ); + )); my $editorURL; if (defined($set) and $authz->hasPermissions($userID, "modify_problem_sets")) { diff --git a/lib/WeBWorK/ContentGenerator/ProblemUtil/ProblemUtil.pm b/lib/WeBWorK/ContentGenerator/ProblemUtil/ProblemUtil.pm deleted file mode 100644 index cb94ad1f43..0000000000 --- a/lib/WeBWorK/ContentGenerator/ProblemUtil/ProblemUtil.pm +++ /dev/null @@ -1,652 +0,0 @@ -################################################################################ -# WeBWorK Online Homework Delivery System -# Copyright © 2000-2022 The WeBWorK Project, https://github.com/openwebwork -# -# This program is free software; you can redistribute it and/or modify it under -# the terms of either: (a) the GNU General Public License as published by the -# Free Software Foundation; either version 2, or (at your option) any later -# version, or (b) the "Artistic License" which comes with this package. -# -# This program is distributed in the hope that it will be useful, but WITHOUT -# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS -# FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the -# Artistic License for more details. -################################################################################ - -# Created to house most output subroutines for Problem.pm to make that module more lightweight -# Now mostly defunct due to having moved most of the output declarations to the template -# -ghe3 - -package WeBWorK::ContentGenerator::ProblemUtil::ProblemUtil; -use base qw(WeBWorK); -use base qw(WeBWorK::ContentGenerator); - -=head1 NAME - -WeBWorK::ContentGenerator::ProblemUtil::ProblemUtil - contains a bunch of subroutines for generating output for the problem pages, especially those generated by Problem.pm - -=cut - -use strict; -use warnings; -#use CGI qw(-nosticky ); -use WeBWorK::CGI; -use File::Path qw(rmtree); -use WeBWorK::Debug; -use WeBWorK::Form; -use WeBWorK::PG; -use WeBWorK::PG::ImageGenerator; -use WeBWorK::PG::IO; -use WeBWorK::Utils qw(readFile writeLog writeCourseLog encodeAnswers decodeAnswers - ref2string makeTempDirectory path_is_subdir sortByName before after between jitar_problem_adjusted_status jitar_id_to_seq); -use WeBWorK::DB::Utils qw(global2user user2global); -use URI::Escape; -use WeBWorK::Authen::LTIAdvanced::SubmitGrade; -use WeBWorK::Utils::Tasks qw(fake_set fake_problem); - -use Email::Stuffer; -use Try::Tiny; - -use Caliper::Sensor; -use Caliper::Entity; - - -# process_and_log_answer subroutine. - -# performs functions of processing and recording the answer given in the page. -# Also returns the appropriate scoreRecordedMessage. - -sub process_and_log_answer{ - - my $self = shift; #type is ref($self) eq 'WeBWorK::ContentGenerator::Problem' - my $r = $self->r; - my $db = $r->db; - my $effectiveUser = $r->param('effectiveUser'); - my $authz = $r->authz; - - - my %will = %{ $self->{will} }; - my $submitAnswers = $self->{submitAnswers}; - my $problem = $self->{problem}; - my $pg = $self->{pg}; - my $set = $self->{set}; - my $urlpath = $r->urlpath; - my $courseID = $urlpath->arg("courseID"); - - # logging student answers - my $pureProblem = $db->getUserProblem($problem->user_id, $problem->set_id, $problem->problem_id); # checked - my $answer_log = $self->{ce}->{courseFiles}->{logs}->{'answer_log'}; - - my ($encoded_last_answer_string, $scores2, $isEssay2); - my $scoreRecordedMessage = ""; - - if (defined($answer_log) && defined($pureProblem) && $submitAnswers) { - my $past_answers_string; - ($past_answers_string, $encoded_last_answer_string, $scores2, $isEssay2) = - WeBWorK::ContentGenerator::ProblemUtil::ProblemUtil::create_ans_str_from_responses($self, $pg); - - if (!$authz->hasPermissions($effectiveUser, "dont_log_past_answers")) { - # store in answer_log - my $timestamp = time(); - writeCourseLog($self->{ce}, "answer_log", - join("", - '|', $problem->user_id, - '|', $problem->set_id, - '|', $problem->problem_id, - '|', $scores2, "\t", - $timestamp,"\t", - $past_answers_string, - ), - ); - - # add to PastAnswer db - my $pastAnswer = $db->newPastAnswer(); - $pastAnswer->course_id($courseID); - $pastAnswer->user_id($problem->user_id); - $pastAnswer->set_id($problem->set_id); - $pastAnswer->problem_id($problem->problem_id); - $pastAnswer->timestamp($timestamp); - $pastAnswer->scores($scores2); - $pastAnswer->answer_string($past_answers_string); - $pastAnswer->source_file($problem->source_file); - $db->addPastAnswer($pastAnswer); - } - } - -###################################################################### -# this stores previous answers to the problem to -# provide "sticky answers" - - if ($submitAnswers) { - # get a "pure" (unmerged) UserProblem to modify - # this will be undefined if the problem has not been assigned to this user - - if (defined $pureProblem) { - # store answers in DB for sticky answers - my %answersToStore; - - # store last answer to database for use in "sticky" answers - $problem->last_answer($encoded_last_answer_string); - $pureProblem->last_answer($encoded_last_answer_string); - $db->putUserProblem($pureProblem); - - # store state in DB if it makes sense - if ($will{recordAnswers}) { - $problem->status($pg->{state}->{recorded_score}); - $problem->sub_status($pg->{state}->{sub_recorded_score}); - $problem->attempted(1); - $problem->num_correct($pg->{state}->{num_of_correct_ans}); - $problem->num_incorrect($pg->{state}->{num_of_incorrect_ans}); - $pureProblem->status($pg->{state}->{recorded_score}); - $pureProblem->sub_status($pg->{state}->{sub_recorded_score}); - $pureProblem->attempted(1); - $pureProblem->num_correct($pg->{state}->{num_of_correct_ans}); - $pureProblem->num_incorrect($pg->{state}->{num_of_incorrect_ans}); - - #add flags for an essay question. If its an essay question and - # we are submitting then there could be potential changes, and it should - # be flaged as needing grading - # we shoudl also check for the appropriate flag in the global problem and set it - - if ($isEssay2 && $pureProblem->{flags} !~ /needs_grading/) { - $pureProblem->{flags} =~ s/graded,//; - $pureProblem->{flags} .= "needs_grading,"; - } - - my $globalProblem = $db->getGlobalProblem($problem->set_id, $problem->problem_id); - if ($isEssay2 && $globalProblem->{flags} !~ /essay/) { - $globalProblem->{flags} .= "essay,"; - $db->putGlobalProblem($globalProblem); - } elsif (!$isEssay2 && $globalProblem->{flags} =~ /essay/) { - $globalProblem->{flags} =~ s/essay,//; - $db->putGlobalProblem($globalProblem); - } - - if ($db->putUserProblem($pureProblem)) { - $scoreRecordedMessage = $r->maketext("Your score was recorded."); - } else { - $scoreRecordedMessage = $r->maketext("Your score was not recorded because there was a failure in storing the problem record to the database."); - } - # write to the transaction log, just to make sure - writeLog($self->{ce}, "transaction", - $problem->problem_id."\t". - $problem->set_id."\t". - $problem->user_id."\t". - $problem->source_file."\t". - $problem->value."\t". - $problem->max_attempts."\t". - $problem->problem_seed."\t". - $pureProblem->status."\t". - $pureProblem->attempted."\t". - $pureProblem->last_answer."\t". - $pureProblem->num_correct."\t". - $pureProblem->num_incorrect - ); - - my $caliper_sensor = Caliper::Sensor->new($self->{ce}); - if ($caliper_sensor->caliperEnabled() && defined($answer_log) && !$authz->hasPermissions($effectiveUser, "dont_log_past_answers")) { - my $startTime = $r->param('startTime'); - my $endTime = time(); - - my $completed_question_event = { - 'type' => 'AssessmentItemEvent', - 'action' => 'Completed', - 'profile' => 'AssessmentProfile', - 'object' => Caliper::Entity::problem_user( - $self->{ce}, - $db, - $problem->set_id(), - 0, #version is 0 for non-gateway problems - $problem->problem_id(), - $problem->user_id(), - $pg - ), - 'generated' => Caliper::Entity::answer( - $self->{ce}, - $db, - $problem->set_id(), - 0, #version is 0 for non-gateway problems - $problem->problem_id(), - $problem->user_id(), - $pg, - $startTime, - $endTime - ), - }; - my $submitted_set_event = { - 'type' => 'AssessmentEvent', - 'action' => 'Submitted', - 'profile' => 'AssessmentProfile', - 'object' => Caliper::Entity::problem_set( - $self->{ce}, - $db, - $problem->set_id() - ), - 'generated' => Caliper::Entity::problem_set_attempt( - $self->{ce}, - $db, - $problem->set_id(), - 0, #version is 0 for non-gateway problems - $problem->user_id(), - $startTime, - $endTime - ), - }; - my $tool_use_event = { - 'type' => 'ToolUseEvent', - 'action' => 'Used', - 'profile' => 'ToolUseProfile', - 'object' => Caliper::Entity::webwork_app(), - }; - $caliper_sensor->sendEvents($r, [$completed_question_event, $submitted_set_event, $tool_use_event]); - - # reset start time - $r->param('startTime', ''); - } - - #Try to update the student score on the LMS - # if that option is enabled. - my $LTIGradeMode = $self->{ce}{LTIGradeMode} // ''; - if ($LTIGradeMode && $self->{ce}{LTIGradeOnSubmit}) { - my $grader = WeBWorK::Authen::LTIAdvanced::SubmitGrade->new($r); - if ($LTIGradeMode eq 'course') { - if ($grader->submit_course_grade($problem->user_id)) { - $scoreRecordedMessage .= - CGI::br() . $r->maketext('Your score was successfully sent to the LMS.'); - } else { - $scoreRecordedMessage .= - CGI::br() . $r->maketext('Your score was not successfully sent to the LMS.'); - } - } elsif ($LTIGradeMode eq 'homework') { - if ($grader->submit_set_grade($problem->user_id, $problem->set_id)) { - $scoreRecordedMessage .= - CGI::br() . $r->maketext('Your score was successfully sent to the LMS.'); - } else { - $scoreRecordedMessage .= - CGI::br() . $r->maketext('Your score was not successfully sent to the LMS.'); - } - } - } - } else { - if (before($set->open_date) or after($set->due_date)) { - $scoreRecordedMessage = $r->maketext("Your score was not recorded because this homework set is closed."); - } else { - $scoreRecordedMessage = $r->maketext("Your score was not recorded."); - } - } - } else { - $scoreRecordedMessage = $r->maketext("Your score was not recorded because this problem has not been assigned to you."); - } - } - - - $self->{scoreRecordedMessage} = $scoreRecordedMessage; - return $scoreRecordedMessage; -} - -# create answer string from responses hash -# ($past_answers_string, $encoded_last_answer_string, $scores, $isEssay) = create_ans_str_from_responses($problem, $pg) -# -# input: ref($pg)eq 'WeBWorK::PG::Local' -# ref($problem)eq 'WeBWorK::ContentGenerator::Problem -# output: (str, str, str) - - -# 2020_05 MEG -- previous version seems to have omitted saving $pg->{flags}->{KEPT_EXTRA_ANSWERS} which also -# labels stored in $PG->{PERSISTANCE_HASH} -# 2020_05a MEG -- past_answers_string is being created for use in the past_answer table -# and other persistant objects need not be included. -# The extra persistence objects do need to be included in problem->last_answer -# in order to keep those objects persistant -- as long as RECORD_FORM_ANSWER -# is used to preserve objects by piggy backing on the persistence mechanism for answers. - -sub create_ans_str_from_responses { - my $problem = shift; # ref($problem) eq 'WeBWorK::ContentGenerator::Problem' - # must contain $self->{formFields}->{$response_id} - my $pg = shift; # ref($pg) eq 'WeBWorK::PG::Local' - #warn "create_ans_str_from_responses pg has type ", ref($pg); - my $scores2=''; - my $isEssay2=0; - my %answers_to_store; - my @past_answers_order; - my @last_answer_order; - - my %pg_answers_hash = %{ $pg->{pgcore}->{PG_ANSWERS_HASH}}; - foreach my $ans_id (@{$pg->{flags}->{ANSWER_ENTRY_ORDER}//[]} ) { - $scores2.= ($pg_answers_hash{$ans_id}->{ans_eval}{rh_ans}{score}//0) >= 1 ? "1" : "0"; - $isEssay2 = 1 if ($pg_answers_hash{$ans_id}->{ans_eval}{rh_ans}{type}//'') eq 'essay'; - foreach my $response_id ($pg_answers_hash{$ans_id}->response_obj->response_labels) { - $answers_to_store{$response_id} = $problem->{formFields}->{$response_id}; - push @past_answers_order, $response_id; - push @last_answer_order, $response_id; - } - } - # KEPT_EXTRA_ANSWERS need to be stored in last_answer in order to preserve persistence items - # the persistence items do not need to be stored in past_answers_string - foreach my $entry_id (@{ $pg->{flags}->{KEPT_EXTRA_ANSWERS} }) { - next if exists( $answers_to_store{$entry_id} ); - $answers_to_store{$entry_id}= $problem->{formFields}->{$entry_id}; - push @last_answer_order, $entry_id; - } - - my $past_answers_string = ''; - foreach my $response_id (@past_answers_order) { - $past_answers_string.=($answers_to_store{$response_id}//'')."\t"; - } - $past_answers_string=~s/\t$//; # remove last tab - - my $encoded_last_answer_string = encodeAnswers(%answers_to_store, - @last_answer_order); - # warn "$encoded_last_answer_string", $encoded_last_answer_string; - # past_answers_string is stored in past_answer table - # encoded_last_answer_string is used in `last_answer` entry of the problem_user table - return ($past_answers_string,$encoded_last_answer_string, $scores2,$isEssay2); -} - -# process_editorLink subroutine - -# Creates and returns the proper editor link for the current website. Also checks for translation errors and prints an error message and returning a false value if one is detected. - -sub process_editorLink{ - - my $self = shift; - - my $set = $self->{set}; - my $problem = $self->{problem}; - my $pg = $self->{pg}; - - my $r = $self->r; - - my $authz = $r->authz; - my $urlpath = $r->urlpath; - my $user = $r->param('user'); - - my $courseName = $urlpath->arg("courseID"); - - # FIXME: move editor link to top, next to problem number. - # format as "[edit]" like we're doing with course info file, etc. - # add edit link for set as well. - my $editorLink = ""; - # if we are here without a real homework set, carry that through - my $forced_field = []; - $forced_field = ['sourceFilePath' => $r->param("sourceFilePath")] if - ($set->set_id eq 'Undefined_Set'); - if ($authz->hasPermissions($user, "modify_problem_sets")) { - my $editorPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Instructor::PGProblemEditor", - courseID => $courseName, setID => $set->set_id, problemID => $problem->problem_id); - my $editorURL = $self->systemLink($editorPage, params=>$forced_field); - $editorLink = CGI::p(CGI::a({href=>$editorURL,target =>'WW_Editor'}, "Edit this problem")); - } - - ##### translation errors? ##### - - if ($pg->{flags}->{error_flag}) { - if ($authz->hasPermissions($user, "view_problem_debugging_info")) { - print $self->errorOutput($pg->{errors}, $pg->{body_text}); - } else { - print $self->errorOutput($pg->{errors}, "You do not have permission to view the details of this error."); - } - print $editorLink; - return "permission_error"; - } - else{ - return $editorLink; - } -} - -# output_main_form subroutine. - -# prints out the main form for the page. This particular subroutine also takes in $editorLink and $scoreRecordedMessage -# as required parameters. Also prints out the score summary where applicable. - -sub output_main_form{ - - my $self = shift; - my $editorLink = shift; - - my $r = $self->r; - my $pg = $self->{pg}; - my $problem = $self->{problem}; - my $set = $self->{set}; - my $submitAnswers = $self->{submitAnswers}; - my $startTime = $r->param('startTime') || time(); - - my $db = $r->db; - my $ce = $r->ce; - my $user = $r->param('user'); - my $effectiveUser = $r->{'effectiveUser'}; - - my %can = %{ $self->{can} }; - my %will = %{ $self->{will} }; - - print "\n"; - print CGI::start_form({ - method => "POST", - action => $r->uri, - name => "problemMainForm", - class => 'problem-main-form' - }); - print $self->hidden_authen_fields; - print CGI::hidden({-name=>'startTime', -value=>$startTime}); - print CGI::end_form(); -} - -# output_footer subroutine - -# prints out the footer elements to the page. - -sub output_footer{ - - my $self = shift; - my $r = $self->r; - my $problem = $self->{problem}; - my $pg = $self->{pg}; - my %will = %{ $self->{will} }; - - my $authz = $r->authz; - my $urlpath = $r->urlpath; - my $user = $r->param('user'); - - my $courseName = $urlpath->arg("courseID"); - - print CGI::start_div({class=>"problemFooter"}); - - - my $pastAnswersPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Instructor::ShowAnswers", - courseID => $courseName); - my $showPastAnswersURL = $self->systemLink($pastAnswersPage, authen => 0); # no authen info for form action - - # print answer inspection button - if ($authz->hasPermissions($user, "view_answers")) { - print "\n", - CGI::start_form(-method=>"POST",-action=>$showPastAnswersURL,-target=>"WW_Info"),"\n", - $self->hidden_authen_fields,"\n", - CGI::hidden(-name => 'courseID', -value=>$courseName), "\n", - CGI::hidden(-name => 'problemID', -value=>$problem->problem_id), "\n", - CGI::hidden(-name => 'setID', -value=>$problem->set_id), "\n", - CGI::hidden(-name => 'studentUser', -value=>$problem->user_id), "\n", - CGI::p({ -align=>"left" }, - CGI::submit({ name => 'action', value => 'Show Past Answers', class => 'btn btn-primary' }) - ), "\n", - CGI::end_form(); - } - - - print $self->feedbackMacro( - module => __PACKAGE__, - courseId => $courseName, - set => $self->{set}->set_id, - problem => $problem->problem_id, - problemPath => $problem->source_file, - randomSeed => $problem->problem_seed, - emailAddress => join(";",$self->fetchEmailRecipients('receive_feedback',$user)), - emailableURL => $self->generateURLs(url_type => 'absolute', - set_id => $self->{set}->set_id, - problem_id => $problem->problem_id), - studentName => $user->full_name, - displayMode => $self->{displayMode}, - showOldAnswers => $will{showOldAnswers}, - showCorrectAnswers => $will{showCorrectAnswers}, - showHints => $will{showHints}, - showSolutions => $will{showSolutions}, - pg_object => $pg, - ); - - print CGI::end_div(); -} - -# check_invalid subroutine - -# checks to see if the current problem set is valid for the current user, returns "valid" if it is and an error message if it's not. - -sub check_invalid{ - - my $self = shift; - my $r = $self->r; - my $urlpath = $r->urlpath; - my $effectiveUser = $r->param('effectiveUser'); - - if ($self->{invalidSet}) { - return CGI::div( - { class => 'alert alert-danger' }, - CGI::p( - "The selected problem set (" . $urlpath->arg("setID") . ") is not " . "a valid set for $effectiveUser:" - ), - CGI::p($self->{invalidSet}) - ); - } elsif ($self->{invalidProblem}) { - return CGI::div( - { class => 'alert alert-danger' }, - CGI::p( - "The selected problem (" - . $urlpath->arg("problemID") - . ") is not a valid problem for set " - . $self->{set}->set_id . "." - ) - ); - } else { - return "valid"; - } - -} - -sub test{ - print "test"; -} - -# if you provide this subroutine with a userProblem it will notify the -# instructors of the course that the student has finished the problem, -# and its children, and did not get 100% -sub jitar_send_warning_email { - my $self = shift; - my $userProblem = shift; - - my $r= $self->r; - my $ce = $r->ce; - my $db = $r->db; - my $authz = $r->authz; - my $urlpath = $r->urlpath; - my $courseID = $urlpath->arg("courseID"); - my $userID = $userProblem->user_id; - my $setID = $userProblem->set_id; - my $problemID = $userProblem->problem_id; - - my $status = jitar_problem_adjusted_status($userProblem,$r->db); - $status = eval{ sprintf("%.0f%%", $status * 100)}; # round to whole number - - my $user = $db->getUser($userID); - - debug("Couldn't get user $userID from database") unless $user; - - my $emailableURL = $self->systemLink( - $urlpath->newFromModule("WeBWorK::ContentGenerator::Problem", $r, - courseID => $courseID, setID => $setID, problemID => $problemID), params=>{effectiveUser=>$userID}, use_abs_url=>1); - - - my @recipients = $self->fetchEmailRecipients("score_sets", $user); - # send to all users with permission to score_sets and an email address - - my $sender; - if ($user->email_address) { - $sender = $user->rfc822_mailbox; - } elsif ($user->full_name) { - $sender = $user->full_name; - } else { - $sender = $userID; - } - - $problemID = join('.',jitar_id_to_seq($problemID)); - - my %subject_map = ( - 'c' => $courseID, - 'u' => $userID, - 's' => $setID, - 'p' => $problemID, - 'x' => $user->section, - 'r' => $user->recitation, - '%' => '%', - ); - my $chars = join("", keys %subject_map); - my $subject = $ce->{mail}{feedbackSubjectFormat} - || "WeBWorK question from %c: %u set %s/prob %p"; # default if not entered - $subject =~ s/%([$chars])/defined $subject_map{$1} ? $subject_map{$1} : ""/eg; - - my $full_name = $user->full_name; - my $email_address = $user->email_address; - my $student_id = $user->student_id; - my $section = $user->section; - my $recitation = $user->recitation; - my $comment = $user->comment; - - # print message -my $msg = qq/ -This message was automatically generated by WeBWorK. - -User $full_name ($userID) has not sucessfully completed the review for problem $problemID in set $setID. Their final adjusted score on the problem is $status. - -Click this link to visit the problem: $emailableURL - -User ID: $userID -Name: $full_name -Email: $email_address -Student ID: $student_id -Section: $section -Recitation: $recitation -Comment: $comment -/; - - my $email = Email::Stuffer->to(join(",", @recipients))->from($sender)->subject($subject) - ->text_body(Encode::encode('UTF-8', $msg)); - - # Extra headers - $email->header('X-WeBWorK-Course: ', $courseID) if defined $courseID; - if ($user) { - $email->header('X-WeBWorK-User: ', $user->user_id); - $email->header('X-WeBWorK-Section: ', $user->section); - $email->header('X-WeBWorK-Recitation: ', $user->recitation); - } - $email->header('X-WeBWorK-Set: ', $setID) if defined $setID; - $email->header('X-WeBWorK-Problem: ', $problemID) if defined $problemID; - - # $ce->{mail}{set_return_path} is the address used to report returned email if defined and non empty. - # It is an argument used in sendmail() (aka Email::Stuffer::send_or_die). - # For arcane historical reasons sendmail actually sets the field "MAIL FROM" and the smtp server then - # uses that to set "Return-Path". - # references: - # https://stackoverflow.com/questions/1235534/what-is-the-behavior-difference-between-return-path-reply-to-and-from - # https://metacpan.org/pod/Email::Sender::Manual::QuickStart#envelope-information - try { - $email->send_or_die({ - # createEmailSenderTransportSMTP is defined in ContentGenerator - transport => $self->createEmailSenderTransportSMTP(), - $ce->{mail}{set_return_path} ? (from => $ce->{mail}{set_return_path}) : () - }); - debug('Successfully sent JITAR alert message'); - } catch { - $r->log_error("Failed to send JITAR alert message: $_"); - }; - - return ''; -} - -1; diff --git a/lib/WeBWorK/ContentGenerator/ShowMeAnother.pm b/lib/WeBWorK/ContentGenerator/ShowMeAnother.pm index 3d61e5909c..04aa1dc6ed 100644 --- a/lib/WeBWorK/ContentGenerator/ShowMeAnother.pm +++ b/lib/WeBWorK/ContentGenerator/ShowMeAnother.pm @@ -29,6 +29,7 @@ use WeBWorK::CGI; use WeBWorK::PG; use WeBWorK::Debug; use WeBWorK::Utils qw(wwRound before after jitar_id_to_seq format_set_name_display); +use WeBWorK::Utils::Rendering qw(constructPGOptions getTranslatorDebuggingOptions); ################################################################################ # output utilities @@ -137,10 +138,10 @@ sub pre_header_initialize { $can->{showMeAnother} = $self->can_showMeAnother(@args, $submitAnswers); # store text of original problem for later comparison with text from problem with new seed - my $showMeAnotherOriginalPG = WeBWorK::PG->new( + my $showMeAnotherOriginalPG = WeBWorK::PG->new(constructPGOptions( $ce, $effectiveUser, - $key, $set, $problem, + $set, $problem, $set->psvn, $formFields, { # translation options @@ -155,7 +156,7 @@ sub pre_header_initialize { useMathView => $self->{will}{useMathView}, useWirisEditor => $self->{will}{useWirisEditor}, }, - ); + )); my $orig_body_text = $showMeAnotherOriginalPG->{body_text}; for (keys %{ $showMeAnotherOriginalPG->{pgcore}{PG_alias}{resource_list} }) { @@ -174,10 +175,10 @@ sub pre_header_initialize { for my $i (0 .. $ce->{pg}->{options}->{showMeAnotherGeneratesDifferentProblem}) { do { $newProblemSeed = int(rand(10000)) } until ($newProblemSeed != $oldProblemSeed); $problem->{problem_seed} = $newProblemSeed; - my $showMeAnotherNewPG = WeBWorK::PG->new( + my $showMeAnotherNewPG = WeBWorK::PG->new(constructPGOptions( $ce, $effectiveUser, - $key, $set, $problem, + $set, $problem, $set->psvn, $formFields, { # translation options @@ -192,7 +193,7 @@ sub pre_header_initialize { useMathView => $self->{will}{useMathView}, useWirisEditor => $self->{will}{useWirisEditor}, }, - ); + )); my $new_body_text = $showMeAnotherNewPG->{body_text}; for (keys %{ $showMeAnotherNewPG->{pgcore}{PG_alias}{resource_list} }) { @@ -234,10 +235,10 @@ sub pre_header_initialize { $problem->problem_seed($problemSeed); #### One last check to see if students have hard coded in a key #### which matches the original problem - my $showMeAnotherNewPG = WeBWorK::PG->new( + my $showMeAnotherNewPG = WeBWorK::PG->new(constructPGOptions( $ce, $effectiveUser, - $key, $set, $problem, + $set, $problem, $set->psvn, $formFields, { # translation options @@ -252,7 +253,7 @@ sub pre_header_initialize { useMathView => $self->{will}{useMathView}, useWirisEditor => $self->{will}{useWirisEditor}, }, - ); + )); if ($showMeAnotherNewPG->{body_text} eq $showMeAnotherOriginalPG->{body_text}) { $showMeAnother{IsPossible} = 0; @@ -303,10 +304,10 @@ sub pre_header_initialize { ### picked a new problem seed. debug("begin pg processing"); - my $pg = WeBWorK::PG->new( + my $pg = WeBWorK::PG->new(constructPGOptions( $ce, $effectiveUser, - $key, $set, $problem, + $set, $problem, $set->psvn, $formFields, { # translation options @@ -320,15 +321,16 @@ sub pre_header_initialize { useMathQuill => $self->{will}{useMathQuill}, useMathView => $self->{will}{useMathView}, useWirisEditor => $self->{will}{useWirisEditor}, + forceScaffoldsOpen => 0, + isInstructor => $authz->hasPermissions($userName, 'view_answers'), + debuggingOptions => getTranslatorDebuggingOptions($authz, $userName) }, - ); + )); debug("end pg processing"); - ##### update and fix hint/solution options after PG processing ##### - - $can->{showHints} &&= $pg->{flags}->{hintExists} &&= - $pg->{flags}->{showHintLimit} <= $pg->{state}->{num_of_incorrect_ans}; + # Update and fix hint/solution options after PG processing + $can->{showHints} &&= $pg->{flags}->{hintExists}; $can->{showSolutions} &&= $pg->{flags}->{solutionExists}; ##### record errors ######### @@ -421,6 +423,34 @@ sub output_problem_body { return ""; } +# output_message subroutine +# Prints messages about the problem +sub output_message { + my $self = shift; + my $pg = $self->{pg}; + my $r = $self->r; + + print CGI::p(CGI::b($r->maketext('Note') . ': '), CGI::i($pg->{result}{msg})) if $pg->{result}{msg}; + + if ($pg->{flags}{hintExists} + && $r->authz->hasPermissions($self->{userName}, 'always_show_hint') + && !grep { $_ eq 'SMAshowHints' } @{ $r->ce->{pg}{options}{showMeAnother} }) + { + print CGI::p(CGI::b($r->maketext('Note') . ':'), + CGI::i($r->maketext('The hint shown is an instructor preview and will not be shown to students.'))); + } + + if ($pg->{flags}{solutionExists} + && $r->authz->hasPermissions($self->{userName}, 'always_show_solution') + && !grep { $_ eq 'SMAshowSolutions' } @{ $r->ce->{pg}{options}{showMeAnother} }) + { + print CGI::p(CGI::b($r->maketext('Note') . ':'), + CGI::i($r->maketext('The solution shown is an instructor preview and will not be shown to students.'))); + } + + return ''; +} + # output_checkboxes subroutine # prints out the checkbox input elements that are available for the current problem diff --git a/lib/WeBWorK/ContentGenerator/renderViaXMLRPC.pm b/lib/WeBWorK/ContentGenerator/renderViaXMLRPC.pm index bbb347bf86..e9213b6848 100644 --- a/lib/WeBWorK/ContentGenerator/renderViaXMLRPC.pm +++ b/lib/WeBWorK/ContentGenerator/renderViaXMLRPC.pm @@ -15,7 +15,7 @@ =head1 NAME -WeBWorK::ContentGenerator::ProblemRenderer - renderViaXMLRPC is an HTML +WeBWorK::ContentGenerator::ProblemRenderer - renderViaXMLRPC is an HTML front end for calls to the xmlrpc webservice =cut @@ -44,39 +44,39 @@ use CGI; receives WeBWorK problems presented as HTML forms, packages the form variables into an XML_RPC request suitable for the Webservice/RenderProblem.pm - takes the answer returned by the webservice (which has HTML format) and + takes the answer returned by the webservice (which has HTML format) and returns it to the browser. =cut - + # To configure the target webwork server two URLs are required # 1. The url http://test.webwork.maa.org/mod_xmlrpc # points to the Webservice.pm and Webservice/RenderProblem modules # Is used by the client to send the original XML request to the webservice. -# It is constructed in WebworkClient::xmlrpcCall() from the value of $webworkClient->site_url which does -# NOT have the mod_xmlrpc segment (it should be http://test.webwork.maa.org) -# and the constant REQUEST_URI defined in WebworkClient.pm to be mod_xmlrpc. +# It is constructed in WebworkClient::xmlrpcCall() from the value of $webworkClient->site_url which does +# NOT have the mod_xmlrpc segment (it should be http://test.webwork.maa.org) +# and the constant REQUEST_URI defined in WebworkClient.pm to be mod_xmlrpc. # # 2. $FORM_ACTION_URL http:http://test.webwork.maa.org/webwork2/html2xml # points to the renderViaXMLRPC.pm module. # # This url is placed as form action url when the rendered HTML from the original # request is returned to the client from Webservice/RenderProblem. The client -# reorganizes the XML it receives into an HTML page (with a WeBWorK form) and +# reorganizes the XML it receives into an HTML page (with a WeBWorK form) and # pipes it through a local browser. # # The browser uses this url to resubmit the problem (with answers) via the standard -# HTML webform used by WeBWorK to the renderViaXMLRPC.pm handler. +# HTML webform used by WeBWorK to the renderViaXMLRPC.pm handler. # -# This renderViaXMLRPC.pm handler acts as an intermediary between the browser -# and the webservice. It interprets the HTML form sent by the browser, -# rewrites the form data in XML format, submits it to the WebworkWebservice.pm +# This renderViaXMLRPC.pm handler acts as an intermediary between the browser +# and the webservice. It interprets the HTML form sent by the browser, +# rewrites the form data in XML format, submits it to the WebworkWebservice.pm # which processes it and sends the the resulting HTML back to renderViaXMLRPC.pm # which in turn passes it back to the browser. -# 3. The second time a problem is submitted renderViaXMLRPC.pm receives the WeBWorK form -# submitted directly by the browser. +# 3. The second time a problem is submitted renderViaXMLRPC.pm receives the WeBWorK form +# submitted directly by the browser. # The renderViaXMLRPC.pm translates the WeBWorK form, has it processes by the webservice -# and returns the result to the browser. +# and returns the result to the browser. # The The client renderProblem.pl script is no longer involved. # 4. Summary: renderProblem.pl is only involved in the first round trip # of the submitted problem. After that the communication is between the browser and @@ -106,7 +106,7 @@ unless ($server_root_url) { ############################ # These variables are set when the child process is started -# and remain constant through all of the calls handled by the +# and remain constant through all of the calls handled by the # child ############################ @@ -117,11 +117,11 @@ our ($SITE_URL,$FORM_ACTION_URL, $XML_PASSWORD, $XML_COURSE); - $SITE_URL = "$server_root_url"; + $SITE_URL = "$server_root_url"; $FORM_ACTION_URL = "$server_root_url/webwork2/html2xml"; -our @COMMANDS = qw( listLibraries renderProblem ); #listLib readFile tex2pdf +our @COMMANDS = qw( listLibraries renderProblem ); #listLib readFile tex2pdf ################################################## @@ -143,25 +143,25 @@ sub pre_header_initialize { $inputs_ref{course_password} = $inputs_ref{custom_course_password} if $inputs_ref{custom_course_password}; $inputs_ref{answersSubmitted} = $inputs_ref{custom_answerssubmitted} if $inputs_ref{custom_answerssubmitted}; $inputs_ref{problemSeed} = $inputs_ref{custom_problemseed} if $inputs_ref{custom_problemseed}; - $inputs_ref{problemUUID} = $inputs_ref{problemUUID}//$inputs_ref{problemIdentifierPrefix}; # earlier version of problemUUID + $inputs_ref{problemUUID} = $inputs_ref{problemUUID}; $inputs_ref{sourceFilePath} = $inputs_ref{custom_sourcefilepath} if $inputs_ref{custom_sourcefilepath}; $inputs_ref{outputformat} = $inputs_ref{custom_outputformat} if $inputs_ref{custom_outputformat}; - - + + my $user_id = $inputs_ref{userID}; my $courseName = $inputs_ref{courseID}; my $displayMode = $inputs_ref{displayMode}; my $problemSeed = $inputs_ref{problemSeed}; - + # FIXME -- it might be better to send this error if the input is not all correct # rather than trying to set defaults such as displaymode unless ( $user_id && $courseName && $displayMode && $problemSeed) { - print CGI::ul( + print CGI::ul( CGI::h1("Missing essential data in web dataform:"), CGI::li(CGI::escapeHTML([ - "userID: |$user_id|", - "courseID: |$courseName|", - "displayMode: |$displayMode|", + "userID: |$user_id|", + "courseID: |$courseName|", + "displayMode: |$displayMode|", "problemSeed: |$problemSeed|" ]))); return; @@ -185,7 +185,7 @@ sub pre_header_initialize { # print STDERR WebworkClient::pretty_print($r->{paramcache}); $self->{wantsjson} = 1 if $inputs_ref{outputformat} eq 'json' || $inputs_ref{send_pg_flags}; - + ############################## # xmlrpc_client calls webservice to have problem rendered # @@ -198,7 +198,7 @@ sub pre_header_initialize { } else { $self->{output}= $xmlrpc_client->return_object; # error report } - + ################################ } diff --git a/lib/WeBWorK/DB/Record/Problem.pm b/lib/WeBWorK/DB/Record/Problem.pm index 876aac10fa..d009bc3a04 100644 --- a/lib/WeBWorK/DB/Record/Problem.pm +++ b/lib/WeBWorK/DB/Record/Problem.pm @@ -36,6 +36,7 @@ BEGIN { counts_parent_grade => { type => "INT" }, showMeAnother => { type => "INT" }, showMeAnotherCount => { type => "INT" }, + showHintsAfter => { type => "INT NOT NULL DEFAULT -2" }, # periodic re-randomization period prPeriod => { type => "INT" }, # periodic re-randomization number of attempts for the current seed diff --git a/lib/WeBWorK/DB/Record/UserProblem.pm b/lib/WeBWorK/DB/Record/UserProblem.pm index acbbb679f8..1c892cc02b 100644 --- a/lib/WeBWorK/DB/Record/UserProblem.pm +++ b/lib/WeBWorK/DB/Record/UserProblem.pm @@ -37,6 +37,7 @@ BEGIN { max_attempts => { type => "INT" }, showMeAnother => { type => "INT" }, showMeAnotherCount => { type => "INT" }, + showHintsAfter => { type => "INT" }, # periodic re-randomization period prPeriod => { type => "INT" }, # periodic re-randomization number of attempts for the current seed diff --git a/lib/WeBWorK/PG.pm b/lib/WeBWorK/PG.pm deleted file mode 100644 index 6f1ecc2004..0000000000 --- a/lib/WeBWorK/PG.pm +++ /dev/null @@ -1,528 +0,0 @@ -################################################################################ -# WeBWorK Online Homework Delivery System -# Copyright © 2000-2022 The WeBWorK Project, https://github.com/openwebwork -# -# This program is free software; you can redistribute it and/or modify it under -# the terms of either: (a) the GNU General Public License as published by the -# Free Software Foundation; either version 2, or (at your option) any later -# version, or (b) the "Artistic License" which comes with this package. -# -# This program is distributed in the hope that it will be useful, but WITHOUT -# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS -# FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the -# Artistic License for more details. -################################################################################ - -package WeBWorK::PG; - -=head1 NAME - -WeBWorK::PG - Invoke one of several PG rendering methods using an easy-to-use -API. - -=cut - -use strict; -use warnings; -use WeBWorK::Debug; -use WeBWorK::PG::ImageGenerator; -use WeBWorK::Utils qw(runtime_use formatDateTime makeTempDirectory); -use WeBWorK::Utils::RestrictedClosureClass; - -use constant DISPLAY_MODES => { - # display name # mode name - tex => "TeX", - plainText => "HTML", - images => "HTML_dpng", - MathJax => "HTML_MathJax", - PTX => "PTX", -}; - -sub new { - shift; # throw away invocant -- we don't need it - my ($ce, $user, $key, $set, $problem, $psvn, $formFields, - $translationOptions) = @_; - - my $renderer = $ce->{pg}->{renderer}; - - runtime_use $renderer; - - return $renderer->new(@_); -} - -sub free { - my $self = shift; - # - # If certain MathObjects (e.g. LimitedPolynomials) are left in the PG structure, then - # freeing them later can cause "Can't locate package ..." errors in the log during - # perl garbage collection. So free them here. - # - $self->{pgcore}{OUTPUT_ARRAY} = []; - $self->{answers} = {}; - undef $self->{translator}; - foreach (keys %{$self->{pgcore}{PG_ANSWERS_HASH}}) {undef $self->{pgcore}{PG_ANSWERS_HASH}{$_}} -} - -sub defineProblemEnvir { - my ( - $self, - $ce, - $user, - $key, - $set, - $problem, - $psvn, - $formFields, - $translationOptions, - $extras, - ) = @_; - - my %envir; - - debug("in WEBWORK::PG"); - - # ---------------------------------------------------------------------- - - # PG environment variables - # from docs/pglanguage/pgreference/environmentvariables as of 06/25/2002 - # any changes are noted by "ADDED:" or "REMOVED:" - - # Vital state information - # ADDED: displayModeFailover, displayHintsQ, displaySolutionsQ, - # refreshMath2img, texDisposition - - $envir{psvn} = $psvn; #'problem set version number' (associated with homework set) - $envir{psvn} = $envir{psvn}//$set->psvn; # use set value of psvn unless there is an explicit override. - # update problemUUID from submitted form, and fall back to the earlier name problemIdentifierPrefix if necessary - $envir{problemUUID} = $formFields->{problemUUID} // - $formFields->{problemIdentifierPrefix} // - $envir{problemUUID}// - 0; - $envir{psvnNumber} = "psvnNumber-is-deprecated-Please-use-psvn-Instead"; #FIXME - $envir{probNum} = $problem->problem_id; - $envir{questionNumber} = $envir{probNum}; - $envir{fileName} = $problem->source_file; - $envir{probFileName} = $envir{fileName}; - $envir{problemSeed} = $problem->problem_seed; - $envir{displayMode} = translateDisplayModeNames($translationOptions->{displayMode}); -# $envir{languageMode} = $envir{displayMode}; # don't believe this is ever used. - $envir{outputMode} = $envir{displayMode}; - $envir{displayHintsQ} = $translationOptions->{showHints}; - $envir{displaySolutionsQ} = $translationOptions->{showSolutions}; - $envir{texDisposition} = "pdf"; # in webwork2, we use pdflatex - - # Problem Information - # ADDED: courseName, formatedDueDate, enable_reduced_scoring - - $envir{openDate} = $set->open_date; - $envir{formattedOpenDate} = formatDateTime($envir{openDate}, $ce->{siteDefaults}{timezone}); - $envir{OpenDateDayOfWeek} = formatDateTime($envir{openDate}, $ce->{siteDefaults}{timezone}, "%A", $ce->{siteDefaults}{locale}); - $envir{OpenDateDayOfWeekAbbrev} = formatDateTime($envir{openDate}, $ce->{siteDefaults}{timezone}, "%a", $ce->{siteDefaults}{locale}); - $envir{OpenDateDay} = formatDateTime($envir{openDate}, $ce->{siteDefaults}{timezone}, "%d", $ce->{siteDefaults}{locale}); - $envir{OpenDateMonthNumber} = formatDateTime($envir{openDate}, $ce->{siteDefaults}{timezone}, "%m", $ce->{siteDefaults}{locale}); - $envir{OpenDateMonthWord} = formatDateTime($envir{openDate}, $ce->{siteDefaults}{timezone}, "%B", $ce->{siteDefaults}{locale}); - $envir{OpenDateMonthAbbrev} = formatDateTime($envir{openDate}, $ce->{siteDefaults}{timezone}, "%b", $ce->{siteDefaults}{locale}); - $envir{OpenDateYear2Digit} = formatDateTime($envir{openDate}, $ce->{siteDefaults}{timezone}, "%y", $ce->{siteDefaults}{locale}); - $envir{OpenDateYear4Digit} = formatDateTime($envir{openDate}, $ce->{siteDefaults}{timezone}, "%Y", $ce->{siteDefaults}{locale}); - $envir{OpenDateHour12} = formatDateTime($envir{openDate}, $ce->{siteDefaults}{timezone}, "%I", $ce->{siteDefaults}{locale}); - $envir{OpenDateHour24} = formatDateTime($envir{openDate}, $ce->{siteDefaults}{timezone}, "%H", $ce->{siteDefaults}{locale}); - $envir{OpenDateMinute} = formatDateTime($envir{openDate}, $ce->{siteDefaults}{timezone}, "%M", $ce->{siteDefaults}{locale}); - $envir{OpenDateAMPM} = formatDateTime($envir{openDate}, $ce->{siteDefaults}{timezone}, "%P", $ce->{siteDefaults}{locale}); - $envir{OpenDateTimeZone} = formatDateTime($envir{openDate}, $ce->{siteDefaults}{timezone}, "%Z", $ce->{siteDefaults}{locale}); - $envir{OpenDateTime12} = formatDateTime($envir{openDate}, $ce->{siteDefaults}{timezone}, "%I:%M%P", $ce->{siteDefaults}{locale}); - $envir{OpenDateTime24} = formatDateTime($envir{openDate}, $ce->{siteDefaults}{timezone}, "%R", $ce->{siteDefaults}{locale}); - $envir{dueDate} = $set->due_date; - $envir{formattedDueDate} = formatDateTime($envir{dueDate}, $ce->{siteDefaults}{timezone}); - $envir{formatedDueDate} = $envir{formattedDueDate}; # typo in many header files - $envir{DueDateDayOfWeek} = formatDateTime($envir{dueDate}, $ce->{siteDefaults}{timezone}, "%A", $ce->{siteDefaults}{locale}); - $envir{DueDateDayOfWeekAbbrev} = formatDateTime($envir{dueDate}, $ce->{siteDefaults}{timezone}, "%a", $ce->{siteDefaults}{locale}); - $envir{DueDateDay} = formatDateTime($envir{dueDate}, $ce->{siteDefaults}{timezone}, "%d", $ce->{siteDefaults}{locale}); - $envir{DueDateMonthNumber} = formatDateTime($envir{dueDate}, $ce->{siteDefaults}{timezone}, "%m", $ce->{siteDefaults}{locale}); - $envir{DueDateMonthWord} = formatDateTime($envir{dueDate}, $ce->{siteDefaults}{timezone}, "%B", $ce->{siteDefaults}{locale}); - $envir{DueDateMonthAbbrev} = formatDateTime($envir{dueDate}, $ce->{siteDefaults}{timezone}, "%b", $ce->{siteDefaults}{locale}); - $envir{DueDateYear2Digit} = formatDateTime($envir{dueDate}, $ce->{siteDefaults}{timezone}, "%y", $ce->{siteDefaults}{locale}); - $envir{DueDateYear4Digit} = formatDateTime($envir{dueDate}, $ce->{siteDefaults}{timezone}, "%Y", $ce->{siteDefaults}{locale}); - $envir{DueDateHour12} = formatDateTime($envir{dueDate}, $ce->{siteDefaults}{timezone}, "%I", $ce->{siteDefaults}{locale}); - $envir{DueDateHour24} = formatDateTime($envir{dueDate}, $ce->{siteDefaults}{timezone}, "%H", $ce->{siteDefaults}{locale}); - $envir{DueDateMinute} = formatDateTime($envir{dueDate}, $ce->{siteDefaults}{timezone}, "%M", $ce->{siteDefaults}{locale}); - $envir{DueDateAMPM} = formatDateTime($envir{dueDate}, $ce->{siteDefaults}{timezone}, "%P", $ce->{siteDefaults}{locale}); - $envir{DueDateTimeZone} = formatDateTime($envir{dueDate}, $ce->{siteDefaults}{timezone}, "%Z", $ce->{siteDefaults}{locale}); - $envir{DueDateTime12} = formatDateTime($envir{dueDate}, $ce->{siteDefaults}{timezone}, "%I:%M%P", $ce->{siteDefaults}{locale}); - $envir{DueDateTime24} = formatDateTime($envir{dueDate}, $ce->{siteDefaults}{timezone}, "%R", $ce->{siteDefaults}{locale}); - $envir{answerDate} = $set->answer_date; - $envir{formattedAnswerDate} = formatDateTime($envir{answerDate}, $ce->{siteDefaults}{timezone}); - $envir{AnsDateDayOfWeek} = formatDateTime($envir{answerDate}, $ce->{siteDefaults}{timezone}, "%A", $ce->{siteDefaults}{locale}); - $envir{AnsDateDayOfWeekAbbrev} = formatDateTime($envir{answerDate}, $ce->{siteDefaults}{timezone}, "%a", $ce->{siteDefaults}{locale}); - $envir{AnsDateDay} = formatDateTime($envir{answerDate}, $ce->{siteDefaults}{timezone}, "%d", $ce->{siteDefaults}{locale}); - $envir{AnsDateMonthNumber} = formatDateTime($envir{answerDate}, $ce->{siteDefaults}{timezone}, "%m", $ce->{siteDefaults}{locale}); - $envir{AnsDateMonthWord} = formatDateTime($envir{answerDate}, $ce->{siteDefaults}{timezone}, "%B", $ce->{siteDefaults}{locale}); - $envir{AnsDateMonthAbbrev} = formatDateTime($envir{answerDate}, $ce->{siteDefaults}{timezone}, "%b", $ce->{siteDefaults}{locale}); - $envir{AnsDateYear2Digit} = formatDateTime($envir{answerDate}, $ce->{siteDefaults}{timezone}, "%y", $ce->{siteDefaults}{locale}); - $envir{AnsDateYear4Digit} = formatDateTime($envir{answerDate}, $ce->{siteDefaults}{timezone}, "%Y", $ce->{siteDefaults}{locale}); - $envir{AnsDateHour12} = formatDateTime($envir{answerDate}, $ce->{siteDefaults}{timezone}, "%I", $ce->{siteDefaults}{locale}); - $envir{AnsDateHour24} = formatDateTime($envir{answerDate}, $ce->{siteDefaults}{timezone}, "%H", $ce->{siteDefaults}{locale}); - $envir{AnsDateMinute} = formatDateTime($envir{answerDate}, $ce->{siteDefaults}{timezone}, "%M", $ce->{siteDefaults}{locale}); - $envir{AnsDateAMPM} = formatDateTime($envir{answerDate}, $ce->{siteDefaults}{timezone}, "%P", $ce->{siteDefaults}{locale}); - $envir{AnsDateTimeZone} = formatDateTime($envir{answerDate}, $ce->{siteDefaults}{timezone}, "%Z", $ce->{siteDefaults}{locale}); - $envir{AnsDateTime12} = formatDateTime($envir{answerDate}, $ce->{siteDefaults}{timezone}, "%I:%M%P", $ce->{siteDefaults}{locale}); - $envir{AnsDateTime24} = formatDateTime($envir{answerDate}, $ce->{siteDefaults}{timezone}, "%R", $ce->{siteDefaults}{locale}); - my $ungradedAttempts = ($formFields->{submitAnswers})?1:0; # is an attempt about to be graded? - $envir{numOfAttempts} = ($problem->num_correct || 0) + ($problem->num_incorrect || 0) +$ungradedAttempts; - $envir{problemValue} = $problem->value; - $envir{sessionKey} = $key; - $envir{courseName} = $ce->{courseName}; - $envir{enable_reduced_scoring} = $ce->{pg}{ansEvalDefaults}{enableReducedScoring} && $set->enable_reduced_scoring; - - $envir{language} = $ce->{language}; - $envir{language_subroutine} = WeBWorK::Localize::getLoc($envir{language}); - $envir{reducedScoringDate} = $set->reduced_scoring_date; - $envir{formattedReducedScoringDate} = formatDateTime($envir{reducedScoringDate}, $ce->{siteDefaults}{timezone}); - - # Student Information - # ADDED: studentID - - $envir{sectionName} = $user->section; - $envir{sectionNumber} = $envir{sectionName}; - $envir{recitationName} = $user->recitation; - $envir{recitationNumber} = $envir{recitationName}; - $envir{setNumber} = $set->set_id; - $envir{studentLogin} = $user->user_id; - $envir{studentName} = $user->first_name . " " . $user->last_name; - $envir{studentID} = $user->student_id; - $envir{permissionLevel} = $translationOptions->{permissionLevel}; # permission level of actual user - $envir{effectivePermissionLevel} = $translationOptions->{effectivePermissionLevel}; # permission level of user assigned to this question - - - # Answer Information - # REMOVED: refSubmittedAnswers - - $envir{inputs_ref} = $formFields; - - # External Programs - # ADDED: externalLaTeXPath, externalDvipngPath, - # externalGif2EpsPath, externalPng2EpsPath - - $envir{externalLaTeXPath} = $ce->{externalPrograms}->{latex}; - $envir{externalDvipngPath} = $ce->{externalPrograms}->{dvipng}; - $envir{externalGif2EpsPath} = $ce->{externalPrograms}->{gif2eps}; - $envir{externalPng2EpsPath} = $ce->{externalPrograms}->{png2eps}; - $envir{externalGif2PngPath} = $ce->{externalPrograms}->{gif2png}; - $envir{externalCheckUrl} = $ce->{externalPrograms}->{checkurl}; - #$envir{externalCurlCommand} = $ce->{externalPrograms}->{curl}; - # Directories and URLs - # REMOVED: courseName - # ADDED: dvipngTempDir - # ADDED: jsMathURL - # ADDED: MathJaxURL - # ADDED: asciimathURL - # ADDED: macrosPath - # REMOVED: macrosDirectory, courseScriptsDirectory - # ADDED: LaTeXMathML - - $envir{cgiDirectory} = undef; - $envir{cgiURL} = undef; - $envir{classDirectory} = undef; - $envir{macrosPath} = $ce->{pg}->{directories}{macrosPath}; - $envir{appletPath} = $ce->{pg}->{directories}{appletPath}; - $envir{macrosPath} = $ce->{pg}->{directories}{macrosPath}; - $envir{htmlPath} = $ce->{pg}->{directories}{htmlPath}; - $envir{imagesPath} = $ce->{pg}->{directories}{imagesPath}; - $envir{pdfPath} = $ce->{pg}->{directories}{pdfPath}; - $envir{pgDirectories} = $ce->{pg}->{directories}; - $envir{webworkHtmlDirectory} = $ce->{webworkDirs}->{htdocs}."/"; - $envir{webworkHtmlURL} = $ce->{webworkURLs}->{htdocs}."/"; - $envir{htmlDirectory} = $ce->{courseDirs}->{html}."/"; - $envir{htmlURL} = $ce->{courseURLs}->{html}."/"; - $envir{templateDirectory} = $ce->{courseDirs}->{templates}."/"; - $envir{tempDirectory} = $ce->{courseDirs}->{html_temp}."/"; - $envir{tempURL} = $ce->{courseURLs}->{html_temp}."/"; - $envir{scriptDirectory} = undef; - $envir{webworkDocsURL} = $ce->{webworkURLs}->{docs}."/"; - $envir{localHelpURL} = $ce->{webworkURLs}->{local_help}."/"; - $envir{MathJaxURL} = $ce->{webworkURLs}->{MathJax}; - $envir{server_root_url} = $ce->{server_root_url}|| ''; - - # Information for sending mail - - $envir{mailSmtpServer} = $ce->{mail}->{smtpServer}; - $envir{mailSmtpSender} = $ce->{mail}->{smtpSender}; - $envir{ALLOW_MAIL_TO} = $ce->{mail}->{allowedRecipients}; - - # Default values for evaluating answers - - my $ansEvalDefaults = $ce->{pg}->{ansEvalDefaults}; - $envir{$_} = $ansEvalDefaults->{$_} foreach (keys %$ansEvalDefaults); - - # ---------------------------------------------------------------------- - - # ADDED: ImageGenerator for images mode - if (defined $extras->{image_generator}) { - #$envir{imagegen} = $extras->{image_generator}; - # only allow access to the add() method - $envir{imagegen} = new WeBWorK::Utils::RestrictedClosureClass($extras->{image_generator}, 'add','addToTeXPreamble', 'refresh'); - } - - if (defined $extras->{mailer}) { - #my $rmailer = new WeBWorK::Utils::RestrictedClosureClass($extras->{mailer}, - # qw/Open SendEnc Close Cancel skipped_recipients error error_msg/); - #my $safe_hole = new Safe::Hole {}; - #$envir{mailer} = $safe_hole->wrap($rmailer); - $envir{mailer} = new WeBWorK::Utils::RestrictedClosureClass($extras->{mailer}, "add_message"); - } - # ADDED use_opaque_prefix and use_site_prefix - - $envir{use_site_prefix} = $translationOptions->{use_site_prefix}; - $envir{use_opaque_prefix} = $translationOptions->{use_opaque_prefix}; - - # Other things... - $envir{QUIZ_PREFIX} = $translationOptions->{QUIZ_PREFIX}//''; # used by quizzes - $envir{PROBLEM_GRADER_TO_USE} = $ce->{pg}->{options}->{grader}; - $envir{PRINT_FILE_NAMES_FOR} = $ce->{pg}->{specialPGEnvironmentVars}->{PRINT_FILE_NAMES_FOR}; - $envir{useMathQuill} = $translationOptions->{useMathQuill}; - $envir{useMathView} = $translationOptions->{useMathView}; - $envir{mathViewLocale} = $ce->{pg}{options}{mathViewLocale}; - $envir{useWirisEditor} = $translationOptions->{useWirisEditor}; - - # ADDED: __files__ - # an array for mapping (eval nnn) to filenames in error messages - $envir{__files__} = { - root => $ce->{webworkDirs}{root}, # used to shorten filenames - pg => $ce->{pg}{directories}{root}, # ditto - tmpl => $ce->{courseDirs}{templates}, # ditto - }; - - # variables for interpreting capa problems and other things to be - # seen in a pg file - my $specialPGEnvironmentVarHash = $ce->{pg}->{specialPGEnvironmentVars}; - for my $SPGEV (keys %{$specialPGEnvironmentVarHash}) { - $envir{$SPGEV} = $specialPGEnvironmentVarHash->{$SPGEV}; - } - - return \%envir; -} - -sub translateDisplayModeNames($) { - my $name = shift; - return DISPLAY_MODES()->{$name}; -} - -sub oldSafetyFilter { - my $answer = shift; # accepts one answer and checks it - my $submittedAnswer = $answer; - $answer = '' unless defined $answer; - my ($errorno); - $answer =~ tr/\000-\037/ /; - # Return if answer field is empty - unless ($answer =~ /\S/) { - #$errorno = "
No answer was submitted."; - $errorno = 0; ## don't report blank answer as error - return ($answer,$errorno); - } - # replace ^ with ** (for exponentiation) - # $answer =~ s/\^/**/g; - # Return if forbidden characters are found - unless ($answer =~ /^[a-zA-Z0-9_\-\+ \t\/@%\*\.\n^\[\]\(\)\,\|]+$/ ) { - $answer =~ tr/a-zA-Z0-9_\-\+ \t\/@%\*\.\n^\(\)/#/c; - $errorno = "
There are forbidden characters in your answer: $submittedAnswer
"; - return ($answer,$errorno); - } - $errorno = 0; - return($answer, $errorno); -} - -sub nullSafetyFilter { - return shift, 0; # no errors -} - -1; - -__END__ - -=head1 SYNOPSIS - - $pg = WeBWorK::PG->new( - $ce, # a WeBWorK::CourseEnvironment object - $user, # a WeBWorK::DB::Record::User object - $sessionKey, - $set, # a WeBWorK::DB::Record::UserSet object - $problem, # a WeBWorK::DB::Record::UserProblem object - $psvn, - $formFields # in &WeBWorK::Form::Vars format - { # translation options - displayMode => "images", # (plainText|formattedText|images|MathJax) - showHints => 1, # (0|1) - showSolutions => 0, # (0|1) - refreshMath2img => 0, # (0|1) - processAnswers => 1, # (0|1) - }, - ); - - $translator = $pg->{translator}; # WeBWorK::PG::Translator - $body = $pg->{body_text}; # text string - $header = $pg->{head_text}; # text string - $post_header_text = $pg->{post_header_text}; # text string - $answerHash = $pg->{answers}; # WeBWorK::PG::AnswerHash - $result = $pg->{result}; # hash reference - $state = $pg->{state}; # hash reference - $errors = $pg->{errors}; # text string - $warnings = $pg->{warnings}; # text string - $flags = $pg->{flags}; # hash reference - -=head1 DESCRIPTION - -WeBWorK::PG is a factory for modules which use the WeBWorK::PG API. Notable -modules which use this API (and exist) are WeBWorK::PG::Local and -WeBWorK::PG::Remote. The course environment key $pg{renderer} is consulted to -determine which render to use. - -=head1 THE WEBWORK::PG API - -Modules which support this API must implement the following method: - -=over - -=item new ENVIRONMENT, USER, KEY, SET, PROBLEM, PSVN, FIELDS, OPTIONS - -The C method creates a translator, initializes it using the parameters -specified, translates a PG file, and processes answers. It returns a reference -to a blessed hash containing the results of the translation process. - -=back - -=head2 Parameters - -=over - -=item ENVIRONMENT - -a WeBWorK::CourseEnvironment object - -=item USER - -a WeBWorK::User object - -=item KEY - -the session key of the current session - -=item SET - -a WeBWorK::Set object - -=item PROBLEM - -a WeBWorK::DB::Record::UserProblem object. The contents of the source_file -field can specify a PG file either by absolute path or path relative to the -"templates" directory. I - -=item PSVN - -the problem set version number: use variable $psvn - -=item FIELDS - -a reference to a hash (as returned by &WeBWorK::Form::Vars) containing form -fields submitted by a problem processor. The translator will look for fields -like "AnSwEr[0-9]" containing submitted student answers. - -=item OPTIONS - -a reference to a hash containing the following data: - -=over - -=item displayMode - -one of "plainText", "formattedText", "MathJax" or "images" - -=item showHints - -boolean, render hints - -=item showSolutions - -boolean, render solutions - -=item refreshMath2img - -boolean, force images created by math2img (in "images" mode) to be recreated, -even if the PG source has not been updated. FIXME: remove this option. - -=item processAnswers - -boolean, call answer evaluators and graders - -=back - -=back - -=head2 RETURN VALUE - -The C method returns a blessed hash reference containing the following -fields. More information can be found in the documentation for -WeBWorK::PG::Translator. - -=over - -=item translator - -The WeBWorK::PG::Translator object used to render the problem. - -=item head_text - -HTML code for the EheadE block of an resulting web page. Used for -JavaScript features. - -=item body_text - -HTML code for the EbodyE block of an resulting web page. - -=item answers - -An C object containing submitted answers, and results of answer -evaluation. - -=item result - -A hash containing the results of grading the problem. - -=item state - -A hash containing the new problem state. - -=item errors - -A string containing any errors encountered while rendering the problem. - -=item warnings - -A string containing any warnings encountered while rendering the problem. - -=item flags - -A hash containing PG_flags (see the Translator docs). - -=back - -=head1 METHODS PROVIDED BY THE BASE CLASS - -The following methods are provided for use by subclasses of WeBWorK::PG. - -=over - -=item defineProblemEnvir ENVIRONMENT, USER, KEY, SET, PROBLEM, PSVN, FIELDS, OPTIONS - -Generate a problem environment hash to pass to the renderer. - -=item translateDisplayModeNames NAME - -NAME contains - -=back - -=head1 AUTHOR - -Written by Sam Hathaway, sh002i (at) math.rochester.edu. - -=cut diff --git a/lib/WeBWorK/PG/Local.pm b/lib/WeBWorK/PG/Local.pm deleted file mode 100644 index 162c51ac5f..0000000000 --- a/lib/WeBWorK/PG/Local.pm +++ /dev/null @@ -1,557 +0,0 @@ -################################################################################ -# WeBWorK Online Homework Delivery System -# Copyright © 2000-2022 The WeBWorK Project, https://github.com/openwebwork -# -# This program is free software; you can redistribute it and/or modify it under -# the terms of either: (a) the GNU General Public License as published by the -# Free Software Foundation; either version 2, or (at your option) any later -# version, or (b) the "Artistic License" which comes with this package. -# -# This program is distributed in the hope that it will be useful, but WITHOUT -# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS -# FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the -# Artistic License for more details. -################################################################################ - -package WeBWorK::PG::Local; -use base qw(WeBWorK::PG); - -=head1 NAME - -WeBWorK::PG::Local - Use the WeBWorK::PG API to invoke a local -WeBWorK::PG::Translator object. - -=head1 DESCRIPTION - -WeBWorK::PG::Local encapsulates the PG translation process, making multiple -calls to WeBWorK::PG::Translator. Much of the flexibility of the Translator is -hidden, instead making choices that are appropriate for the webwork2 -system - -It implements the WeBWorK::PG interface and uses a local -WeBWorK::PG::Translator to perform problem rendering. See the documentation for -the WeBWorK::PG module for information about the API. - -=cut - -use strict; -use warnings; -use WeBWorK::Constants; -use File::Path qw(rmtree); -use WeBWorK::PG::Translator; -use WeBWorK::Utils qw(readFile writeTimingLogEntry); -#use WeBWorK::Utils::RestrictedMailer; -use WeBWorK::Utils::DelayedMailer; - -# Problem processing will time out after this number of seconds. -use constant TIMEOUT => $WeBWorK::PG::Local::TIMEOUT || 10; - -BEGIN { - # This safe compartment is used to read the large macro files such as - # PG.pl, PGbasicmacros.pl and PGanswermacros and cache the results so that - # future calls have preloaded versions of these large files. This saves a - # significant amount of time. - $WeBWorK::PG::Local::safeCache = new WWSafe; -} - -sub alarm_handler { - my $msg = "Timeout after processing this problem for ". TIMEOUT. " seconds. Check for infinite loops in problem source.\n"; - warn $msg; - CORE::die $msg; -} - -sub new { - my $invocant = shift; - local $SIG{ALRM} = \&alarm_handler; - alarm TIMEOUT; - my $result = eval { $invocant->new_helper(@_) }; - alarm 0; - die $@ if $@; - return $result; -} - - -sub new_helper { - my $invocant = shift; - my $class = ref($invocant) || $invocant; - my ( - $ce, - $user, - $key, - $set, - $problem, - $psvn, #FIXME -- not used - $formFields, # in CGI::Vars format - $translationOptions, # hashref containing options for the - # translator, such as whether to show - # hints and the display mode to use - ) = @_; - - # write timing log entry -# writeTimingLogEntry($ce, "WeBWorK::PG::new", -# "user=".$user->user_id.",problem=".$ce->{courseName}."/".$set->set_id."/".$problem->problem_id.",mode=".$translationOptions->{displayMode}, -# "begin"); - - # install a local warn handler to collect warnings FIXME -- figure out what I meant to do here. - my $warnings = ""; - #local $SIG{__WARN__} = sub { $warnings .= shift()."
\n"}; - #if $ce->{pg}->{options}->{catchWarnings}; - - # create a Translator - #warn "PG: creating a Translator\n"; - my $translator = WeBWorK::PG::Translator->new; - - # set the directory hash - #warn "PG: setting the directory hash\n"; - # FIXME rh_directories does not appear to be used. ever. -# $translator->rh_directories({ -# macrosPath => $ce->{courseDirs}->{macrosPath}, -# templateDirectory => $ce->{courseDirs}->{templates}, -# tempDirectory => $ce->{courseDirs}->{html_temp}, -# }); - - ############################################################################ - # evaluate modules and "extra packages" - ############################################################################ - - #warn "PG: evaluating modules and \"extra packages\"\n"; - my @modules = @{ $ce->{pg}->{modules} }; - # HACK for apache2 - push @modules, ["Apache2::Log"], ["APR::Table"]; - - foreach my $module_packages_ref (@modules) { - my ($module, @extra_packages) = @$module_packages_ref; - # the first item is the main package - $translator->evaluate_modules($module); - # the remaining items are "extra" packages - $translator->load_extra_packages(@extra_packages); - } - - ############################################################################ - # prepare an imagegenerator object (if we're in "images" mode) - ############################################################################ - my $image_generator; - my $site_prefix = ( $translationOptions->{use_site_prefix} )//''; - if ($translationOptions->{displayMode} eq "images" || $translationOptions->{displayMode} eq "opaque_image") { - my %imagesModeOptions = %{$ce->{pg}{displayModeOptions}{images}}; - $image_generator = WeBWorK::PG::ImageGenerator->new( - tempDir => $ce->{webworkDirs}->{tmp}, # global temp dir - latex => $ce->{externalPrograms}->{latex}, - dvipng => $ce->{externalPrograms}->{dvipng}, - useCache => 1, - cacheDir => $ce->{webworkDirs}{equationCache}, - cacheURL => $site_prefix . $ce->{webworkURLs}{equationCache}, - cacheDB => $ce->{webworkFiles}{equationCacheDB}, - useMarkers => ($imagesModeOptions{dvipng_align} && $imagesModeOptions{dvipng_align} eq 'mysql'), - dvipng_align => $imagesModeOptions{dvipng_align}, - dvipng_depth_db => $imagesModeOptions{dvipng_depth_db}, - ); - } - - ############################################################################ - # create a "delayed mailer" object that will send emails after the page is finished. - ############################################################################ - - my $mailer = new WeBWorK::Utils::DelayedMailer( - smtp_server => $ce->{mail}{smtpServer}, - smtp_sender => $ce->{mail}{smtpSender}, - smtp_timeout => $ce->{mail}{smtpTimeout}, - # FIXME I'd like to have an X-Remote-Host header, but before I do that I have to - # factor out the remote host/remote port code from Feedback.pm and Authen.pm and - # put it in Utils! (or maybe in WW::Request?) - headers => "X-WeBWorK-Module: " . __PACKAGE__ . "\n" - . "X-WeBWorK-Course: " . $ce->{courseName} . "\n" - # can't add user-related information because this is used for anonymous questionnaires - #. "X-WeBWorK-User: " . $user->user_id . "\n" - #. "X-WeBWorK-Section: " . $user->section . "\n" - #. "X-WeBWorK-Recitation: " . $user->recitation . "\n" - . "X-WeBWorK-Set: " . $set->set_id . "\n" - . "X-WeBWorK-Problem: " . $problem->problem_id . "\n" - . "X-WeBWorK-PGSourceFile: " . $problem->source_file . "\n", - allowed_recipients => $ce->{mail}{allowedRecipients}, - on_illegal_rcpt => "carp", - ); - - - ############################################################################ - # set the environment (from defineProblemEnvir) - ############################################################################ - - #warn "PG: setting the environment (from defineProblemEnvir)\n"; - my $envir = $class->defineProblemEnvir( - $ce, - $user, - $key, - $set, - $problem, - $psvn, #FIXME -- not used - $formFields, - $translationOptions, - { #extras (this is kind of a hack, but not a serious one) - image_generator => $image_generator, - mailer => $mailer, - problemUUID => 0, - }, - ); - $translator->environment($envir); - - ############################################################################ - # initialize the Translator - ############################################################################ - #warn "PG: initializing the Translator\n"; - $translator->initialize(); - - - ############################################################################ - # preload macros - ############################################################################ - # This is in transition. here are the old instructions - - # Preload the macros files which are used routinely: PG.pl, - # dangerousMacros.pl, IO.pl, PGbasicmacros.pl, and PGanswermacros.pl - # (Preloading the last two files safes a significant amount of time.) - # - # IO.pl, PG.pl, and dangerousMacros.pl are loaded using - # unrestricted_load This is hard wired into the - # Translator::pre_load_macro_files subroutine. I'd like to change this - # at some point to have the same sort of interface to defaults.config that - # the module loading does -- have a list of macros to load - # unrestrictedly. - # - # This has been replaced by the pre_load_macro_files subroutine. It - # loads AND caches the files. While PG.pl and dangerousMacros are not - # large, they are referred to by PGbasicmacros and PGanswermacros. - # Because these are loaded into the cached name space (e.g. - # Safe::Root1::) all calls to, say NEW_ANSWER_NAME are actually calls - # to Safe::Root1::NEW_ANSWER_NAME. It is useful to have these names - # inside the Safe::Root1: cached safe compartment. (NEW_ANSWER_NAME - # and all other subroutine names are also automatically exported into - # the current safe compartment Safe::Rootx:: - # - # The headers of both PGbasicmacros and PGanswermacros has code that - # insures that the constants used are imported into the current safe - # compartment. This involves evaluating references to, say - # $main::displayMode, at runtime to insure that main refers to - # Safe::Rootx:: and NOT to Safe::Root1::, which is the value of main:: - # at compile time. - # - # TO ENABLE CACHEING UNCOMMENT THE FOLLOWING: -- this has not been used in some time -# eval{$translator->pre_load_macro_files( -# $WeBWorK::PG::Local::safeCache, -# $ce->{pg}->{directories}->{macros}, -# #'PG.pl', 'dangerousMacros.pl','IO.pl','PGbasicmacros.pl','PGanswermacros.pl' -# )}; -# warn "Error while preloading macro files: $@" if $@; - - ############################################################################ - # Here are the new instructions for preloading the macros - ############################################################################ - - # STANDARD LOADING CODE: for cached script files, this merely - # initializes the constants. - #2010 -- in the new scheme PG.pl is the only file guaranteed - # initialization -- it reads in everything that dangerous macros - # and IO.pl - # did before. Mostly it just defines access to the PGcore object - - # 2010 the loop is overkill since there is just one file, we'll leave it for now in case there are more. - foreach (qw(PG.pl )) { # dangerousMacros.pl IO.pl - my $macroPath = $ce->{pg}->{directories}->{macros} . "/$_"; - my $err = $translator->unrestricted_load($macroPath); - warn "Error while loading $macroPath: $err" if $err; - } - - ############################################################################ - # set the opcode mask (using default values) - ############################################################################ - #warn "PG: setting the opcode mask (using default values)\n"; - $translator->set_mask(); - - ############################################################################ - # get the problem source - # FIXME -- this operation can be moved out of the translator. - ############################################################################ - #warn "PG: storing the problem source\n"; - my $source =''; - my $sourceFilePath = ''; - my $readErrors = undef; - if (ref($translationOptions->{r_source}) ) { - # the source for the problem is already given to us as a reference to a string - $source = ${$translationOptions->{r_source}}; - } else { - # the source isn't given to us so we need to read it - # from a file defined by the problem - - # we grab the sourceFilePath from the problem - $sourceFilePath = $problem->source_file; - - # the path to the source file is usually given relative to the - # the templates directory. Unless the path starts with / assume - # that it is relative to the templates directory - - $sourceFilePath = $ce->{courseDirs}->{templates}."/" - .$sourceFilePath unless ($sourceFilePath =~ /^\//); - #now grab the source - eval {$source = readFile($sourceFilePath) }; - $readErrors = $@ if $@; - } - - ############################################################################ - # put the source into the translator object - ############################################################################ - - eval { $translator->source_string( $source ) } unless $readErrors; - $readErrors .="\n $@ " if $@; - if ($readErrors) { - # well, we couldn't get the problem source, for some reason. - return bless { - translator => $translator, - head_text => "", - post_header_text => "", - body_text => < {}, - result => {}, - state => {}, - errors => "Failed to read the problem source file.", - warnings => "$warnings", - flags => {error_flag => 1}, - pgcore => $translator->{rh_pgcore}, - }, $class; - } - - ############################################################################ - # install a safety filter - # FIXME -- I believe that since MathObjects this is no longer operational - ############################################################################ - #warn "PG: installing a safety filter\n"; - #$translator->rf_safety_filter(\&oldSafetyFilter); - $translator->rf_safety_filter(\&WeBWorK::PG::nullSafetyFilter); - - ############################################################################ - # write timing log entry -- the translator is now all set up - ############################################################################ -# writeTimingLogEntry($ce, "WeBWorK::PG::new", -# "initialized", -# "intermediate"); - - ############################################################################ - # translate the PG source into text - ############################################################################ - - #warn "PG: translating the PG source into text\n"; - $translator->translate(); - - ############################################################################ - # !!!!!!!! IMPORTANT: $envir shouldn't be trusted after problem code runs! - ############################################################################ - - my ($result, $state); # we'll need these on the other side of the if block! - if ($translationOptions->{processAnswers}) { - - ############################################################################ - # process student answers - ############################################################################ - - #warn "PG: processing student answers\n"; - $translator->process_answers($formFields); - - ############################################################################ - # retrieve the problem state and give it to the translator - ############################################################################ - #warn "PG: retrieving the problem state and giving it to the translator\n"; - - $translator->rh_problem_state({ - recorded_score => $problem->status, - sub_recorded_score => $problem->sub_status, - num_of_correct_ans => $problem->num_correct, - num_of_incorrect_ans => $problem->num_incorrect, - }); - - ############################################################################ - # determine an entry order -- the ANSWER_ENTRY_ORDER flag is built by - # the PG macro package (PG.pl) - ############################################################################ - #warn "PG: determining an entry order\n"; - - my @answerOrder = - $translator->rh_flags->{ANSWER_ENTRY_ORDER} - ? @{ $translator->rh_flags->{ANSWER_ENTRY_ORDER} } - : keys %{ $translator->rh_evaluated_answers }; - - ############################################################################ - # install a grader -- use the one specified in the problem, - # or fall back on the default from the course environment. - # (two magic strings are accepted, to avoid having to - # reference code when it would be difficult.) - ############################################################################ - #warn "PG: installing a grader\n"; - - my $grader = $translator->rh_flags->{PROBLEM_GRADER_TO_USE} - || $ce->{pg}->{options}->{grader}; - $grader = $translator->rf_std_problem_grader - if $grader eq "std_problem_grader"; - $grader = $translator->rf_avg_problem_grader - if $grader eq "avg_problem_grader"; - die "Problem grader $grader is not a CODE reference." - unless ref $grader eq "CODE"; - $translator->rf_problem_grader($grader); - - ############################################################################ - # grade the problem - ############################################################################ - #warn "PG: grading the problem\n"; - - ($result, $state) = $translator->grade_problem( - answers_submitted => $translationOptions->{processAnswers}, - ANSWER_ENTRY_ORDER => \@answerOrder, - %{$formFields}, #FIXME? this is used by sequentialGrader is there a better way - ); - - } - - ############################################################################ - # after we're done translating, we may have to clean up after the - # translator: - ############################################################################ - - ############################################################################ - # HTML_dpng uses an ImageGenerator. We have to render the queued equations. - ############################################################################ - my $body_text_ref = $translator->r_text; - if ($image_generator) { - my $sourceFile = $ce->{courseDirs}->{templates} . "/" . $problem->source_file; - my %mtimeOption = -e $sourceFile ? (mtime => (stat $sourceFile)[9]) : (); - - $image_generator->render( - refresh => $translationOptions->{refreshMath2img}, - %mtimeOption, - body_text => $body_text_ref, - ); - } - - ############################################################################ - # send any queued mail messages - ############################################################################ - - if ($mailer) { - $mailer->send_messages; - } - - ############################################################################ - # end of cleanup phase - ############################################################################ - - ############################################################################ - # write timing log entry - ############################################################################ -# writeTimingLogEntry($ce, "WeBWorK::PG::new", "", "end"); - - ############################################################################ - # return an object which contains the translator and the results of - # the translation process. - ############################################################################ - - return bless { - translator => $translator, - head_text => ${ $translator->r_header }, - post_header_text => ${ $translator->r_post_header}, - body_text => ${ $body_text_ref } , # from $translator->r_text - answers => $translator->rh_evaluated_answers, - result => $result, - state => $state, - errors => $translator->errors, - warnings => $warnings, - flags => $translator->rh_flags, - pgcore => $translator->{rh_pgcore}, - }, $class; -} - -1; - -__END__ - -=head1 OPERATION - -WeBWorK::PG::Local goes through the following operations when constructed: - -=over - -=item Create a translator - -Instantiate a WeBWorK::PG::Translator object. - -=item Set the directory hash - -Set the translator's directory hash (courseScripts, macros, templates, and temp -directories) from the course environment. - -=item Evaluate PG modules - -Using the module list from the course environment (pg->modules), perform a -"use"-like operation to evaluate modules at runtime. - -=item Set the problem environment - -Use data from the user, set, and problem, as well as the course -environemnt and translation options, to set the problem environment. The -default subroutine, &WeBWorK::PG::defineProblemEnvir, is used. - -=item Initialize the translator - -Call &WeBWorK::PG::Translator::initialize. What more do you want? - -=item Load IO.pl, PG.pl and dangerousMacros.pl - -These macros must be loaded without opcode masking, so they are loaded here. - -=item Set the opcode mask - -Set the opcode mask to the default specified by WeBWorK::PG::Translator. - -=item Load the problem source - -Give the problem source to the translator. - -=item Install a safety filter - -The safety filter is used to preprocess student input before evaluation. The -default safety filter, &WeBWorK::PG::safetyFilter, is used. - -=item Translate the problem source - -Call &WeBWorK::PG::Translator::translate to render the problem source into the -format given by the display mode. - -=item Process student answers - -Use form field inputs to evaluate student answers. - -=item Load the problem state - -Use values from the database to initialize the problem state, so that the -grader will have a point of reference. - -=item Determine an entry order - -Use the ANSWER_ENTRY_ORDER flag to determine the order of answers in the -problem. This is important for problems with dependancies among parts. - -=item Install a grader - -Use the PROBLEM_GRADER_TO_USE flag, or a default from the course environment, -to install a grader. - -=item Grade the problem - -Use the selected grader to grade the problem. - -=back - -=head1 AUTHOR - -Written by Sam Hathaway, sh002i (at) math.rochester.edu. - -=cut diff --git a/lib/WeBWorK/PG/Remote.pm b/lib/WeBWorK/PG/Remote.pm deleted file mode 100644 index 014cc240df..0000000000 --- a/lib/WeBWorK/PG/Remote.pm +++ /dev/null @@ -1,176 +0,0 @@ -################################################################################ -# WeBWorK Online Homework Delivery System -# Copyright © 2000-2022 The WeBWorK Project, https://github.com/openwebwork -# -# This program is free software; you can redistribute it and/or modify it under -# the terms of either: (a) the GNU General Public License as published by the -# Free Software Foundation; either version 2, or (at your option) any later -# version, or (b) the "Artistic License" which comes with this package. -# -# This program is distributed in the hope that it will be useful, but WITHOUT -# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS -# FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the -# Artistic License for more details. -################################################################################ - -package WeBWorK::PG::Remote; -use base qw(WeBWorK::PG); - -=head1 NAME - -WeBWorK::PG::Remote - Use the WeBWorK::PG API to invoke a remote problem -renderer via SOAP. - -=cut - -use strict; -use warnings; -use SOAP::Lite; -use WeBWorK::Utils qw(readFile); - -sub new { - my $invocant = shift; - my $class = ref($invocant) || $invocant; - my ( - $ce, - $user, - $key, - $set, - $problem, - $psvn, #FIXME -- not used - $formFields, # in CGI::Vars format - $translationOptions, # hashref containing options for the - # translator, such as whether to show - # hints and the display mode to use - ) = @_; - - ##### READ SOURCE FILE ##### - - my $sourceFile = $problem->source_file; - $sourceFile = $ce->{courseDirs}->{templates}."/".$sourceFile - unless ($sourceFile =~ /^\//); - my $source = eval { readFile($sourceFile) }; - if ($@) { - # well, we couldn't get the problem source, for some reason. - return bless { - translator => undef, - head_text => "", - body_text => < {}, - result => {}, - state => {}, - errors => "Failed to read the problem source file.", - warnings => "", - flags => {error_flag => 1}, - }, $class; - } - - ##### DEFINE REQUEST ##### - - my $envir = $class->defineProblemEnvir( - $ce, - $user, - $key, - $set, - $problem, - $psvn, #FIXME -- not used - $formFields, - $translationOptions, - ); - - my (@modules_to_load, @extra_packages_to_load); - my @modules = @{ $ce->{pg}->{modules} }; - foreach my $module_packages_ref (@modules) { - my ($module, @extra_packages) = @$module_packages_ref; - # the first item is the main package - push @modules_to_load, $module; - # the remaining items are "extra" packages - push @extra_packages_to_load, @extra_packages; - } - - my $request = { - course => $ce->{courseName}, - source => $source, - modules_to_evaluate => [ @modules_to_load ], - extra_packages_to_load => [ @extra_packages_to_load ], - envir => $envir, - problem_state => { - recorded_score => $problem->status, - sub_recorded_score => $problem->sub_status, - num_of_correct_ans => $problem->num_correct, - num_of_incorrect_ans => $problem->num_incorrect, - }, - options => $translationOptions, - }; - - ##### CALL REMOTE RENDERER ##### - - my $package = __PACKAGE__; - my $proxy = $ce->{pg}->{renderers}->{$package}->{proxy}; - - my $soap = SOAP::Lite - ->uri("urn:RenderD") - ->proxy($proxy); - my $query = $soap->render($request); - - ##### HANDLE ERRORS ##### - - if ($query->fault) { - return bless { - translator => undef, - head_text => "", - body_text => $query->faultstring, - answers => {}, - result => {}, - state => {}, - errors => "Failed to call the remote renderer." - . " (error " . $query->faultcode . ")", - warnings => "", - flags => {error_flag => 1}, - }, $class; - } - - ##### RETURN RESULTS ##### - - return $query->result; -} - -1; - -__END__ - -=head1 OPERATION - -WeBWorK::PG::Remote goes through the following operations when constructed: - -=over - -=item Read the problem source file - -Reads the contents of the problem source file from disk. - -=item Compile a problem environment - -Use data from the user, set, and problem, as well as the course -environemnt and translation options, to compile a problem environment. -The default subroutine, &WeBWorK::PG::defineProblemEnvir, is used. - -=item Compile a list of modules to load - -Use the course environment to compile a list of modules to load and -extra packages to import. - -=item Call the remote renderer - -Use SOAP::Lite to call the C remote rendering daemon. - -=back - -=head1 AUTHOR - -Written by Sam Hathaway, sh002i (at) math.rochester.edu. - -=cut diff --git a/lib/WeBWorK/Utils/DelayedMailer.pm b/lib/WeBWorK/Utils/DelayedMailer.pm deleted file mode 100644 index 76f7c7938f..0000000000 --- a/lib/WeBWorK/Utils/DelayedMailer.pm +++ /dev/null @@ -1,164 +0,0 @@ -################################################################################ -# WeBWorK Online Homework Delivery System -# Copyright © 2000-2022 The WeBWorK Project, https://github.com/openwebwork -# -# This program is free software; you can redistribute it and/or modify it under -# the terms of either: (a) the GNU General Public License as published by the -# Free Software Foundation; either version 2, or (at your option) any later -# version, or (b) the "Artistic License" which comes with this package. -# -# This program is distributed in the hope that it will be useful, but WITHOUT -# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS -# FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the -# Artistic License for more details. -################################################################################ - -package WeBWorK::Utils::DelayedMailer; - -use strict; -use warnings; -use Carp; -use Net::SMTP; -use WeBWorK::Utils qw/constituency_hash/; - -sub new { - my ($invocant, %options) = @_; - my $class = ref $invocant || $invocant; - my $self = bless {}, $class; - - # messages get queued here. format: hashref, safe arguments to MailMsg - $$self{msgs} = []; - - # SMTP settings - $$self{smtp_server} = $options{smtp_server}; - $$self{smtp_sender} = $options{smtp_sender}; - $$self{smtp_timeout} = $options{smtp_timeout}; - - # extra headers - $$self{headers} = $options{headers}; - - # recipients are checked against this list before sending - # these should be bare rfc822 addresses, not "Name " - $$self{allowed_recipients} = constituency_hash(@{$options{allowed_recipients}}); - - # what to do if an illegal recipient is specified - # "croak" (default), "carp", or "ignore" - $$self{on_illegal_rcpt} = $options{on_illegal_rcpt}; - - return $self; -} - -# %msg format: -# $msg{to} = either a single address or an arrayref containing multiple addresses -# $msg{subject} = string subject -# $msg{msg} = string body of email (this is what Email::Sender::MailMsg uses) -sub add_message { - my ($self, %msg) = @_; - - # make sure recipients are allowed - $msg{to} = $self->_check_recipients($msg{to}); - - push @{$$self{msgs}}, \%msg; -} - -sub _check_recipients { - my ($self, $rcpts) = @_; - my @rcpts = ref $rcpts eq "ARRAY" ? @$rcpts : $rcpts; - - my @legal; - foreach my $rcpt (@rcpts) { - my ($base) = $rcpt =~ /<([^<>]*)>\s*$/; # works for addresses generated by Record::User - $base ||= $rcpt; # if it doesn't match, it's a plain address - if (exists $$self{allowed_recipients}{$base}) { - push @legal, $rcpt; - } else { - if (not defined $$self{on_illegal_rcpt} or $$self{on_illegal_rcpt} eq "croak") { - die "can't address message to illegal recipient '$rcpt'"; - } elsif ($$self{on_illegal_rcpt} eq "carp") { - warn "can't address message to illegal recipient '$rcpt'"; - } - } - } - - return \@legal; -} - -sub send_messages { - my ($self) = @_; - - return unless @{$$self{msgs}}; - - my $smtp = new Net::SMTP($$self{smtp_server}, Timeout=>$$self{smtp_timeout}) - or die "failed to create Net::SMTP object"; - - my @results; - foreach my $msg (@{$$self{msgs}}) { - push @results, $self->_send_msg($smtp, $msg); - } - - return @results; -} - -sub _send_msg { - my ($self, $smtp, $msg) = @_; - - my $sender = $$self{smtp_sender}; - my @recipients = @{$$msg{to}}; - my $message = $self->_format_msg($msg); - - # reduce "Foo " to "bar@bar" - foreach my $rcpt (@recipients) { - my ($base) = $rcpt =~ /<([^<>]*)>\s*$/; - $rcpt = $base if defined $base; - } - - my %result; - - $smtp->mail($sender); - my @good_rcpts = $smtp->recipient(@recipients, {SkipBad=>1}); - if (@good_rcpts) { - my $data_sent = $smtp->data($message); - unless ($data_sent) { - $result{error} = "(Error number not available with Net::SMTP)"; - $result{error_msg} = "Unknown error sending message data to SMTP server"; - } - } else { - $result{error} = "(Error number not available with Net::SMTP)"; - $result{error_msg} = "No recipient addresses were accepted by SMTP server"; - } - - # figure out which recipients were rejected - my %bad_rcpts; - @bad_rcpts{@recipients} = (); - delete @bad_rcpts{@good_rcpts}; - my @bad_rcpts = keys %bad_rcpts; - if (@bad_rcpts) { - $result{skipped_recipients} = - { map { $_ => "(Server message not available with Net::SMTP)" } @bad_rcpts }; - } - - return \%result; -} - -sub _format_msg { - my ($self, $msg) = @_; - - my $from = $$self{smtp_sender}; - my $to = join(", ", @{$$msg{to}}); - my $subject = $$msg{subject}; - my $headers = $$self{headers}; - my $body = $$msg{msg}; - - my $formatted_msg = "From: $from\n" - . "To: $to\n" - . "Subject: $subject\n"; - if (defined $headers) { - $formatted_msg .= $headers; - $formatted_msg .= "\n" unless $formatted_msg =~ /\n$/; - } - $formatted_msg .= "\n$body"; - - return $formatted_msg; -} - -1; diff --git a/lib/WeBWorK/Utils/ProblemProcessing.pm b/lib/WeBWorK/Utils/ProblemProcessing.pm new file mode 100644 index 0000000000..c5ceff475b --- /dev/null +++ b/lib/WeBWorK/Utils/ProblemProcessing.pm @@ -0,0 +1,504 @@ +################################################################################ +# WeBWorK Online Homework Delivery System +# Copyright © 2000-2022 The WeBWorK Project, https://github.com/openwebwork +# +# This program is free software; you can redistribute it and/or modify it under +# the terms of either: (a) the GNU General Public License as published by the +# Free Software Foundation; either version 2, or (at your option) any later +# version, or (b) the "Artistic License" which comes with this package. +# +# This program is distributed in the hope that it will be useful, but WITHOUT +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +# FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the +# Artistic License for more details. +################################################################################ + +package WeBWorK::Utils::ProblemProcessing; +use base qw(Exporter); + +=head1 NAME + +WeBWorK::Utils::ProblemProcessing - contains subroutines for generating output +for the problem pages, especially those generated by Problem.pm. + +=cut + +use strict; +use warnings; + +use Email::Stuffer; +use Try::Tiny; + +use WeBWorK::CGI; +use WeBWorK::Debug; +use WeBWorK::Utils qw(writeLog writeCourseLog encodeAnswers before after jitar_problem_adjusted_status jitar_id_to_seq); +use WeBWorK::Authen::LTIAdvanced::SubmitGrade; + +use Caliper::Sensor; +use Caliper::Entity; + +our @EXPORT_OK = qw( + process_and_log_answer + compute_reduced_score + create_ans_str_from_responses + check_invalid + jitar_send_warning_email +); + +# WARNING: The usage of $self throughout this file is incorrect and quite misleading. In all cases $self needs to at +# least be a WeBWorK::ContentGenerator object even. In addition it must be ensured that the $self object has the +# correct hash values to work with the method. + +# Performs functions of processing and recording the answer given in the page. +# Returns the appropriate scoreRecordedMessage. +sub process_and_log_answer { + my $self = shift; + my $r = $self->r; + my $ce = $r->ce; + my $db = $r->db; + my $effectiveUser = $r->param('effectiveUser'); + my $authz = $r->authz; + + my %will = %{ $self->{will} }; + my $submitAnswers = $self->{submitAnswers}; + my $problem = $self->{problem}; + my $pg = $self->{pg}; + my $set = $self->{set}; + my $urlpath = $r->urlpath; + my $courseID = $urlpath->arg("courseID"); + + # logging student answers + my $pureProblem = $db->getUserProblem($problem->user_id, $problem->set_id, $problem->problem_id); + my $answer_log = $ce->{courseFiles}{logs}{answer_log}; + + my ($encoded_last_answer_string, $scores2, $isEssay2); + my $scoreRecordedMessage = ''; + + if (defined($answer_log) && defined($pureProblem) && $submitAnswers) { + my $past_answers_string; + ($past_answers_string, $encoded_last_answer_string, $scores2, $isEssay2) = + create_ans_str_from_responses($self, $pg); + + if (!$authz->hasPermissions($effectiveUser, 'dont_log_past_answers')) { + # store in answer_log + my $timestamp = time(); + writeCourseLog( + $ce, + 'answer_log', + join('', + '|', $problem->user_id, '|', $problem->set_id, '|', $problem->problem_id, + '|', $scores2, "\t", $timestamp, "\t", $past_answers_string, + ), + ); + + # add to PastAnswer db + my $pastAnswer = $db->newPastAnswer(); + $pastAnswer->course_id($courseID); + $pastAnswer->user_id($problem->user_id); + $pastAnswer->set_id($problem->set_id); + $pastAnswer->problem_id($problem->problem_id); + $pastAnswer->timestamp($timestamp); + $pastAnswer->scores($scores2); + $pastAnswer->answer_string($past_answers_string); + $pastAnswer->source_file($problem->source_file); + $db->addPastAnswer($pastAnswer); + } + } + + # this stores previous answers to the problem to provide "sticky answers" + if ($submitAnswers) { + # get a "pure" (unmerged) UserProblem to modify + # this will be undefined if the problem has not been assigned to this user + + if (defined $pureProblem) { + # store answers in DB for sticky answers + my %answersToStore; + + # store last answer to database for use in "sticky" answers + $problem->last_answer($encoded_last_answer_string); + $pureProblem->last_answer($encoded_last_answer_string); + $db->putUserProblem($pureProblem); + + # store state in DB if it makes sense + if ($will{recordAnswers}) { + $problem->status(compute_reduced_score($ce, $problem, $set, $pg->{state}{recorded_score})); + + $problem->sub_status($problem->status) + if (!$r->{ce}{pg}{ansEvalDefaults}{enableReducedScoring} + || !$set->enable_reduced_scoring + || before($set->reduced_scoring_date)); + + $problem->attempted(1); + $problem->num_correct($pg->{state}{num_of_correct_ans}); + $problem->num_incorrect($pg->{state}{num_of_incorrect_ans}); + + $pureProblem->status($problem->status); + $pureProblem->sub_status($problem->sub_status); + $pureProblem->attempted(1); + $pureProblem->num_correct($pg->{state}{num_of_correct_ans}); + $pureProblem->num_incorrect($pg->{state}{num_of_incorrect_ans}); + + # Add flags for an essay question. If its an essay question and we are submitting then there could be + # potential changes, and it should be flagged as needing grading. Also check for the appropriate flag + # in the global problem and set it. + + if ($isEssay2 && $pureProblem->{flags} !~ /needs_grading/) { + $pureProblem->{flags} =~ s/graded,//; + $pureProblem->{flags} .= "needs_grading,"; + } + + my $globalProblem = $db->getGlobalProblem($problem->set_id, $problem->problem_id); + if ($isEssay2 && $globalProblem->{flags} !~ /essay/) { + $globalProblem->{flags} .= 'essay,'; + $db->putGlobalProblem($globalProblem); + } elsif (!$isEssay2 && $globalProblem->{flags} =~ /essay/) { + $globalProblem->{flags} =~ s/essay,//; + $db->putGlobalProblem($globalProblem); + } + + if ($db->putUserProblem($pureProblem)) { + $scoreRecordedMessage = $r->maketext('Your score was recorded.'); + } else { + $scoreRecordedMessage = $r->maketext('Your score was not recorded because there was a failure ' + . 'in storing the problem record to the database.'); + } + # write to the transaction log, just to make sure + writeLog($ce, 'transaction', + $problem->problem_id . "\t" + . $problem->set_id . "\t" + . $problem->user_id . "\t" + . $problem->source_file . "\t" + . $problem->value . "\t" + . $problem->max_attempts . "\t" + . $problem->problem_seed . "\t" + . $pureProblem->status . "\t" + . $pureProblem->attempted . "\t" + . $pureProblem->last_answer . "\t" + . $pureProblem->num_correct . "\t" + . $pureProblem->num_incorrect); + + if ($ce->{caliper}{enabled} + && defined($answer_log) + && !$authz->hasPermissions($effectiveUser, 'dont_log_past_answers')) + { + my $caliper_sensor = Caliper::Sensor->new($ce); + my $startTime = $r->param('startTime'); + my $endTime = time(); + + my $completed_question_event = { + type => 'AssessmentItemEvent', + action => 'Completed', + profile => 'AssessmentProfile', + object => Caliper::Entity::problem_user( + $ce, + $db, + $problem->set_id(), + 0, #version is 0 for non-gateway problems + $problem->problem_id(), + $problem->user_id(), + $pg + ), + generated => Caliper::Entity::answer( + $ce, + $db, + $problem->set_id(), + 0, #version is 0 for non-gateway problems + $problem->problem_id(), + $problem->user_id(), + $pg, + $startTime, + $endTime + ), + }; + my $submitted_set_event = { + type => 'AssessmentEvent', + action => 'Submitted', + profile => 'AssessmentProfile', + object => Caliper::Entity::problem_set($ce, $db, $problem->set_id()), + generated => Caliper::Entity::problem_set_attempt( + $ce, + $db, + $problem->set_id(), + 0, #version is 0 for non-gateway problems + $problem->user_id(), + $startTime, + $endTime + ), + }; + my $tool_use_event = { + type => 'ToolUseEvent', + action => 'Used', + profile => 'ToolUseProfile', + object => Caliper::Entity::webwork_app(), + }; + $caliper_sensor->sendEvents($r, + [ $completed_question_event, $submitted_set_event, $tool_use_event ]); + + # reset start time + $r->param('startTime', ''); + } + + #Try to update the student score on the LMS + # if that option is enabled. + my $LTIGradeMode = $ce->{LTIGradeMode} // ''; + if ($LTIGradeMode && $ce->{LTIGradeOnSubmit}) { + my $grader = WeBWorK::Authen::LTIAdvanced::SubmitGrade->new($r); + if ($LTIGradeMode eq 'course') { + if ($grader->submit_course_grade($problem->user_id)) { + $scoreRecordedMessage .= + CGI::br() . $r->maketext('Your score was successfully sent to the LMS.'); + } else { + $scoreRecordedMessage .= + CGI::br() . $r->maketext('Your score was not successfully sent to the LMS.'); + } + } elsif ($LTIGradeMode eq 'homework') { + if ($grader->submit_set_grade($problem->user_id, $problem->set_id)) { + $scoreRecordedMessage .= + CGI::br() . $r->maketext('Your score was successfully sent to the LMS.'); + } else { + $scoreRecordedMessage .= + CGI::br() . $r->maketext('Your score was not successfully sent to the LMS.'); + } + } + } + } else { + if (before($set->open_date) || after($set->due_date)) { + $scoreRecordedMessage = + $r->maketext('Your score was not recorded because this homework set is closed.'); + } else { + $scoreRecordedMessage = $r->maketext('Your score was not recorded.'); + } + } + } else { + $scoreRecordedMessage = + $r->maketext('Your score was not recorded because this problem has not been assigned to you.'); + } + } + + $self->{scoreRecordedMessage} = $scoreRecordedMessage; + return $scoreRecordedMessage; +} + +# Determines if a set is in the reduced scoring period, and if so returns the reduced score. +# Otherwise it returns the unadjusted score. +sub compute_reduced_score { + my ($ce, $problem, $set, $score) = @_; + + # If no adjustments need to be applied, return the full score. + if (!$ce->{pg}{ansEvalDefaults}{enableReducedScoring} + || !$set->enable_reduced_scoring + || !$set->reduced_scoring_date + || $set->reduced_scoring_date == $set->due_date + || before($set->reduced_scoring_date) + || $score <= $problem->sub_status) + { + return $score; + } + + # Return the reduced score. + return $problem->sub_status + $ce->{pg}{ansEvalDefaults}{reducedScoringValue} * ($score - $problem->sub_status); +} + +# create answer string from responses hash +# ($past_answers_string, $encoded_last_answer_string, $scores, $isEssay) = create_ans_str_from_responses($problem, $pg) +# +# input: ref($pg) eq 'WeBWorK::PG::Local' +# ref($problem) eq 'WeBWorK::ContentGenerator::Problem +# output: (str, str, str) +# and other persistant objects need not be included. +# The extra persistence objects do need to be included in problem->last_answer +# in order to keep those objects persistant -- as long as RECORD_FORM_ANSWER +# is used to preserve objects by piggy backing on the persistence mechanism for answers. + +sub create_ans_str_from_responses { + my $problem = shift; # ref($problem) eq 'WeBWorK::ContentGenerator::Problem' + # must contain $self->{formFields}{$response_id} + my $pg = shift; # ref($pg) eq 'WeBWorK::PG::Local' + + my $scores2 = ''; + my $isEssay2 = 0; + my %answers_to_store; + my @past_answers_order; + my @last_answer_order; + + my %pg_answers_hash = %{ $pg->{pgcore}{PG_ANSWERS_HASH} }; + foreach my $ans_id (@{ $pg->{flags}{ANSWER_ENTRY_ORDER} // [] }) { + $scores2 .= ($pg_answers_hash{$ans_id}{ans_eval}{rh_ans}{score} // 0) >= 1 ? "1" : "0"; + $isEssay2 = 1 if ($pg_answers_hash{$ans_id}{ans_eval}{rh_ans}{type} // '') eq 'essay'; + foreach my $response_id ($pg_answers_hash{$ans_id}->response_obj->response_labels) { + $answers_to_store{$response_id} = $problem->{formFields}{$response_id}; + push @past_answers_order, $response_id; + push @last_answer_order, $response_id; + } + } + # KEPT_EXTRA_ANSWERS needs to be stored in last_answer in order to preserve persistence items. + # The persistence items do not need to be stored in past_answers_string. + foreach my $entry_id (@{ $pg->{flags}{KEPT_EXTRA_ANSWERS} }) { + next if exists($answers_to_store{$entry_id}); + $answers_to_store{$entry_id} = $problem->{formFields}{$entry_id}; + push @last_answer_order, $entry_id; + } + + my $past_answers_string = ''; + foreach my $response_id (@past_answers_order) { + $past_answers_string .= ($answers_to_store{$response_id} // '') . "\t"; + } + $past_answers_string =~ s/\t$//; # remove last tab + + my $encoded_last_answer_string = encodeAnswers(%answers_to_store, @last_answer_order); + # past_answers_string is stored in past_answer table. + # encoded_last_answer_string is used in `last_answer` entry of the problem_user table. + return ($past_answers_string, $encoded_last_answer_string, $scores2, $isEssay2); +} + +# Checks to see if the current problem set is valid for the current user, +# Returns 'valid' if it is and an error message if it's not. +sub check_invalid { + my $self = shift; + my $r = $self->r; + my $urlpath = $r->urlpath; + my $effectiveUser = $r->param('effectiveUser'); + + if ($self->{invalidSet}) { + return CGI::div( + { class => 'alert alert-danger' }, + CGI::p($r->maketext( + 'The selected problem set ([_1]) is not a valid set for [_2].', $urlpath->arg('setID'), + $effectiveUser + )), + CGI::p($self->{invalidSet}) + ); + } elsif ($self->{invalidProblem}) { + return CGI::div( + { class => 'alert alert-danger' }, + CGI::p($r->maketext( + 'The selected problem ([_1]) is not a valid problem for set [_2].', $urlpath->arg('problemID'), + $self->{set}->set_id + )) + ); + } else { + return 'valid'; + } +} + +# If you provide this subroutine with a userProblem it will notify the instructors of the course that the student has +# finished the problem, and its children, and did not get 100%. +sub jitar_send_warning_email { + my $self = shift; + my $userProblem = shift; + + my $r = $self->r; + my $ce = $r->ce; + my $db = $r->db; + my $authz = $r->authz; + my $urlpath = $r->urlpath; + my $courseID = $urlpath->arg('courseID'); + my $userID = $userProblem->user_id; + my $setID = $userProblem->set_id; + my $problemID = $userProblem->problem_id; + + my $status = jitar_problem_adjusted_status($userProblem, $r->db); + $status = eval { sprintf('%.0f%%', $status * 100) }; # round to whole number + + my $user = $db->getUser($userID); + + debug("Couldn't get user $userID from database") unless $user; + + my $emailableURL = $self->systemLink( + $urlpath->newFromModule( + 'WeBWorK::ContentGenerator::Problem', $r, + courseID => $courseID, + setID => $setID, + problemID => $problemID + ), + params => { effectiveUser => $userID }, + use_abs_url => 1 + ); + + my @recipients = $self->fetchEmailRecipients('score_sets', $user); + # send to all users with permission to score_sets and an email address + + my $sender; + if ($user->email_address) { + $sender = $user->rfc822_mailbox; + } elsif ($user->full_name) { + $sender = $user->full_name; + } else { + $sender = $userID; + } + + $problemID = join('.', jitar_id_to_seq($problemID)); + + my %subject_map = ( + 'c' => $courseID, + 'u' => $userID, + 's' => $setID, + 'p' => $problemID, + 'x' => $user->section, + 'r' => $user->recitation, + '%' => '%', + ); + my $chars = join('', keys %subject_map); + my $subject = $ce->{mail}{feedbackSubjectFormat} + || 'WeBWorK question from %c: %u set %s/prob %p'; # default if not entered + $subject =~ s/%([$chars])/defined $subject_map{$1} ? $subject_map{$1} : ""/eg; + + my $full_name = $user->full_name; + my $email_address = $user->email_address; + my $student_id = $user->student_id; + my $section = $user->section; + my $recitation = $user->recitation; + my $comment = $user->comment; + + # print message + my $msg = qq/ +This message was automatically generated by WeBWorK. + +User $full_name ($userID) has not sucessfully completed the review for problem $problemID in set $setID. +Their final adjusted score on the problem is $status. + +Click this link to visit the problem: $emailableURL + +User ID: $userID +Name: $full_name +Email: $email_address +Student ID: $student_id +Section: $section +Recitation: $recitation +Comment: $comment +/; + + my $email = Email::Stuffer->to(join(',', @recipients))->from($sender)->subject($subject) + ->text_body(Encode::encode('UTF-8', $msg)); + + # Extra headers + $email->header('X-WeBWorK-Course: ', $courseID) if defined $courseID; + if ($user) { + $email->header('X-WeBWorK-User: ', $user->user_id); + $email->header('X-WeBWorK-Section: ', $user->section); + $email->header('X-WeBWorK-Recitation: ', $user->recitation); + } + $email->header('X-WeBWorK-Set: ', $setID) if defined $setID; + $email->header('X-WeBWorK-Problem: ', $problemID) if defined $problemID; + + # $ce->{mail}{set_return_path} is the address used to report returned email if defined and non empty. It is an + # argument used in sendmail() (aka Email::Stuffer::send_or_die). For arcane historical reasons sendmail actually + # sets the field "MAIL FROM" and the smtp server then uses that to set "Return-Path". + # references: + # https://stackoverflow.com/questions/1235534/what-is-the-behavior-difference-between-return-path-reply-to-and-from + # https://metacpan.org/pod/Email::Sender::Manual::QuickStart#envelope-information + try { + $email->send_or_die({ + # createEmailSenderTransportSMTP is defined in ContentGenerator + transport => $self->createEmailSenderTransportSMTP(), + $ce->{mail}{set_return_path} ? (from => $ce->{mail}{set_return_path}) : () + }); + debug('Successfully sent JITAR alert message'); + } catch { + $r->log_error("Failed to send JITAR alert message: $_"); + }; + + return ''; +} + +1; diff --git a/lib/WeBWorK/Utils/Rendering.pm b/lib/WeBWorK/Utils/Rendering.pm new file mode 100644 index 0000000000..0513101098 --- /dev/null +++ b/lib/WeBWorK/Utils/Rendering.pm @@ -0,0 +1,201 @@ +################################################################################ +# WeBWorK Online Homework Delivery System +# Copyright © 2000-2022 The WeBWorK Project, https://github.com/openwebwork +# +# This program is free software; you can redistribute it and/or modify it under +# the terms of either: (a) the GNU General Public License as published by the +# Free Software Foundation; either version 2, or (at your option) any later +# version, or (b) the "Artistic License" which comes with this package. +# +# This program is distributed in the hope that it will be useful, but WITHOUT +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +# FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the +# Artistic License for more details. +################################################################################ + +package WeBWorK::Utils::Rendering; +use base qw(Exporter); + +=head1 NAME + +WeBWorK::Utils::Rendering - utilities for rendering problems. + +=cut + +use strict; +use warnings; +use feature 'signatures'; +no warnings qw(experimental::signatures); + +use WeBWorK::Utils qw(formatDateTime); + +our @EXPORT_OK = qw(constructPGOptions getTranslatorDebuggingOptions); + +=head1 constructPGOptions + +This method requires a course environment, user, set, problem, psvn, form +fields, and translation options. It constructs the options to pass to the +WeBWorK::PG constructor in the new format. The options are roughly in +correspondence to the PG translator environment variables. + +=cut + +sub constructPGOptions ($ce, $user, $set, $problem, $psvn, $formFields, $translationOptions) { + my %options; + + # Problem information + $options{psvn} = $psvn // $set->psvn; + + # If a problemUUID is provided in the form fields, then that is used. Otherwise we create one that depends on + # the course, user, set, and problem. Note that it is not a true UUID, but will be converted into one by PG. + $options{problemUUID} = $formFields->{problemUUID} + || join('-', $user->user_id, $ce->{courseName}, 'set' . $set->set_id, 'prob' . $problem->problem_id); + + $options{probNum} = $problem->problem_id; + $options{questionNumber} = $options{probNum}; + $options{r_source} = $translationOptions->{r_source}; + $options{sourceFilePath} = $problem->source_file; + $options{problemSeed} = $problem->problem_seed; + + # Display information + $options{displayMode} = $translationOptions->{displayMode}; + $options{showHints} = $translationOptions->{showHints}; + $options{showSolutions} = $translationOptions->{showSolutions}; + $options{forceScaffoldsOpen} = $translationOptions->{forceScaffoldsOpen}; + $options{setOpen} = time > $set->open_date; + $options{pastDue} = time > $set->due_date; + $options{answersAvailable} = time > $set->answer_date; + $options{refreshMath2img} = $translationOptions->{refreshMath2img}; + + # Default values for evaluating answers + $options{ansEvalDefaults} = $ce->{pg}{ansEvalDefaults}; + + # Dates are passed in for set headers. + for my $date (qw(openDate dueDate answerDate)) { + my $db_date = $date =~ s/D/_d/r; + $options{$date} = $set->$db_date; + $options{ 'formatted' . ucfirst($date) } = formatDateTime($options{$date}, $ce->{siteDefaults}{timezone}); + # This is provided due to a typo in many header files. + $options{ 'formated' . ucfirst($date) } = $options{ 'formatted' . ucfirst($date) }; + my $uc_date = ucfirst($date); + for ( + [ 'DayOfWeek', '%A' ], + [ 'DayOfWeekAbbrev', '%a' ], + [ 'Day', '%d' ], + [ 'MonthNumber', '%m' ], + [ 'MonthWord', '%B' ], + [ 'MonthAbbrev', '%b' ], + [ 'Year2Digit', '%y' ], + [ 'Year4Digit', '%Y' ], + [ 'Hour12', '%I' ], + [ 'Hour24', '%H' ], + [ 'Minute', '%M' ], + [ 'AMPM', '%P' ], + [ 'TimeZone', '%Z' ], + [ 'Time12', '%I:%M%P' ], + [ 'Time24', '%R' ], + ) + { + $options{"$uc_date$_->[0]"} = + formatDateTime($options{$date}, $ce->{siteDefaults}{timezone}, $_->[1], $ce->{siteDefaults}{locale}); + } + } + $options{reducedScoringDate} = $set->reduced_scoring_date; + $options{formattedReducedScoringDate} = formatDateTime($options{reducedScoringDate}, $ce->{siteDefaults}{timezone}); + + # State Information + $options{numOfAttempts} = + ($problem->num_correct || 0) + ($problem->num_incorrect || 0) + ($formFields->{submitAnswers} ? 1 : 0); + $options{problemValue} = $problem->value; + $options{recorded_score} = $problem->status; + $options{num_of_correct_ans} = $problem->num_correct; + $options{num_of_incorrect_ans} = $problem->num_incorrect; + + # Language + $options{language} = $ce->{language}; + $options{language_subroutine} = WeBWorK::Localize::getLoc($options{language}); + + # Student and course Information + $options{courseName} = $ce->{courseName}; + $options{sectionName} = $user->section; + $options{sectionNumber} = $options{sectionName}; + $options{recitationName} = $user->recitation; + $options{recitationNumber} = $options{recitationName}; + $options{setNumber} = $set->set_id; + $options{studentLogin} = $user->user_id; + $options{studentName} = $user->first_name . ' ' . $user->last_name; + $options{studentID} = $user->student_id; + + # Permission level of actual user (deprecated) + $options{permissionLevel} = $translationOptions->{permissionLevel}; + # permission level of user assigned to this question (deprecated) + $options{effectivePermissionLevel} = $translationOptions->{effectivePermissionLevel}; + + # Replacement for permission level. This is really all PG needs in addition to the debugging options below. + $options{isInstructor} = $translationOptions->{isInstructor}; + + # Debugging options that determine if various pieces of PG information can be shown. + $options{debuggingOptions} = $translationOptions->{debuggingOptions} // {}; + + # Answer Information + $options{inputs_ref} = $formFields; + $options{processAnswers} = $translationOptions->{processAnswers}; + + # Directories and URLs + $options{macrosPath} = $ce->{pg}{directories}{macrosPath}; + $options{htmlPath} = $ce->{pg}{directories}{htmlPath}; + $options{imagesPath} = $ce->{pg}{directories}{imagesPath}; + $options{htmlDirectory} = "$ce->{courseDirs}{html}/"; + $options{htmlURL} = "$ce->{courseURLs}{html}/"; + $options{templateDirectory} = "$ce->{courseDirs}{templates}/"; + $options{tempDirectory} = "$ce->{courseDirs}{html_temp}/"; + $options{tempURL} = "$ce->{courseURLs}{html_temp}/"; + $options{webworkDocsURL} = "$ce->{webworkURLs}{docs}/"; + $options{localHelpURL} = "$ce->{webworkURLs}{local_help}/"; + $options{MathJaxURL} = $ce->{webworkURLs}{MathJax}; + $options{server_root_url} = $ce->{server_root_url} || ''; + + $options{use_site_prefix} = $translationOptions->{use_site_prefix}; + $options{use_opaque_prefix} = $translationOptions->{use_opaque_prefix}; + + $options{answerPrefix} = $translationOptions->{QUIZ_PREFIX} // ''; # used by quizzes + $options{grader} = $ce->{pg}{options}{grader}; + $options{useMathQuill} = $translationOptions->{useMathQuill}; + $options{useMathView} = $translationOptions->{useMathView}; + $options{mathViewLocale} = $ce->{pg}{options}{mathViewLocale}; + $options{useWirisEditor} = $translationOptions->{useWirisEditor}; + + $options{__files__} = { + root => $ce->{webworkDirs}{root}, # used to shorten filenames + pg => $ce->{pg}{directories}{root}, # ditto + tmpl => $ce->{courseDirs}{templates}, # ditto + }; + + # Variables for interpreting capa problems and other things to be seen in a pg file. + $options{specialPGEnvironmentVars} = $ce->{pg}{specialPGEnvironmentVars}; + + return %options; +} + +=head1 getTranslatorDebuggingOptions + +This method requires an $authz and a $userName, and converts permissions into +the corresponding PG debugging environment variable. + +=cut + +# Set translator debugging options for the user. +sub getTranslatorDebuggingOptions ($authz, $userName) { + return { + map { $_ => $authz->hasPermissions($userName, $_) } + qw( + show_resource_info + view_problem_debugging_info + show_pg_info + show_answer_hash_info + show_answer_group_info + ) + }; +} + +1; diff --git a/lib/WeBWorK/Utils/RestrictedClosureClass.pm b/lib/WeBWorK/Utils/RestrictedClosureClass.pm deleted file mode 100644 index 317b375dee..0000000000 --- a/lib/WeBWorK/Utils/RestrictedClosureClass.pm +++ /dev/null @@ -1,116 +0,0 @@ -################################################################################ -# WeBWorK Online Homework Delivery System -# Copyright © 2000-2022 The WeBWorK Project, https://github.com/openwebwork -# -# This program is free software; you can redistribute it and/or modify it under -# the terms of either: (a) the GNU General Public License as published by the -# Free Software Foundation; either version 2, or (at your option) any later -# version, or (b) the "Artistic License" which comes with this package. -# -# This program is distributed in the hope that it will be useful, but WITHOUT -# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS -# FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the -# Artistic License for more details. -################################################################################ - -package WeBWorK::Utils::RestrictedClosureClass; - -=head1 NAME - -WeBWorK::Utils::RestrictedClosureClass - Protect instance data and only allow -calling of specified methods. - -=head1 SYNPOSIS - - package MyScaryClass; - - sub new { return bless { @_[1..$#_] }, ref $_[0] || $_[0] } - sub get_secret { return $_[0]->{secret_data} } - sub set_secret { $_[0]->{secret_data} = $_[1] } - sub use_secret { print "Secret length is ".length($_[0]->get_secret) } - sub call_for_help { print "HELP!!" } - - package main; - use WeBWorK::Utils::RestrictedClosureClass; - - my $unlocked = new MyScaryClass(secret_data => "pErL iS gReAt"); - my $locked = new WeBWorK::Utils::RestrictedClosureClass($obj, qw/use_secret call_for_help/); - - $unlocked->get_secret; # OK - $unlocked->set_secret("fOoBaR"); # OK - $unlocked->use_secret; # OK - $unlocked->call_for_help; # OK - print $unlocked->{secret_data}; # OK - $unlocked->{secret_data} = "WySiWyG"; # OK - - $locked->get_secret; # NG (not in method list) - $locked->set_secret("fOoBaR"); # NG (not in method list) - $locked->use_secret; # OK - $locked->call_for_help; # OK - print $locked->{secret_data}; # NG (not a hash reference) - $locked->{secret_data} = "WySiWyG"; # NG (not a hash reference) - -=head1 DESCRIPTION - -RestrictedClosureClass generates a wrapper object for a given object that -prevents access to the objects instance data and only allows specified method -calls. The wrapper object is a closure that calls methods of the underlying -object, if permitted. - -This is great for exposing a limited API to an untrusted environment, i.e. the -PG Safe compartment. - -=head1 CONSTRUCTOR - -=over - -=item $wrapper_object = CLASS->new($object, @methods) - -Generate a wrapper object for the given $object. Only calls to the methods -listed in @methods will be permitted. - -=back - -=head1 LIMITATIONS - -You can't call SUPER methods, or methods with an explicit class given: - - $locked->SUPER::call_for_help # NG, would be superclass of RestrictedClosureClass - -=head1 SEE ALSO - -L - -=cut - -use strict; -use warnings; -use Carp; -use Scalar::Util qw/blessed/; - -sub new { - my ($invocant, $object, @methods) = @_; - croak "wrapper class with no methods is dumb" unless @methods; - my $class = ref $invocant || $invocant; - croak "object is not a blessed reference" unless blessed $object; - my %methods; @methods{@methods} = (); - my $self = sub { # CLOSURE over $object, %methods; - my $method = shift; - if (not exists $methods{$method}) { - croak "Can't locate object method \"$method\" via package \"".ref($object)."\" fnord"; - } - return $object->$method(@_); - }; - return bless $self, $class; -} - -sub AUTOLOAD { - my $self = shift; - my $name = our $AUTOLOAD; - $name =~ s/.*:://; - return if $name eq "DESTROY"; # real obj's DESTROY method called when closure goes out of scope - return $self->($name, @_); -} - -1; - diff --git a/lib/WeBWorK/Utils/RestrictedMailer.pm b/lib/WeBWorK/Utils/RestrictedMailer.pm deleted file mode 100644 index 3a49f0201d..0000000000 --- a/lib/WeBWorK/Utils/RestrictedMailer.pm +++ /dev/null @@ -1,305 +0,0 @@ -################################################################################ -# WeBWorK Online Homework Delivery System -# Copyright © 2000-2022 The WeBWorK Project, https://github.com/openwebwork -# -# This program is free software; you can redistribute it and/or modify it under -# the terms of either: (a) the GNU General Public License as published by the -# Free Software Foundation; either version 2, or (at your option) any later -# version, or (b) the "Artistic License" which comes with this package. -# -# This program is distributed in the hope that it will be useful, but WITHOUT -# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS -# FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the -# Artistic License for more details. -################################################################################ - -package WeBWorK::Utils::RestrictedMailer; -use base "Email::Sender"; - -=for comment - -PLEASE NOTE - -This class does not impose any restrictions on its own, it simply provides -restricted versions of Email::Sender's Open, OpenMultipart, MailMsg, and -MailFile methods. - -The restricted methods prevent the caller from overriding parameters that -have already been specified to the constructor. For example, if the "smtp" -parameter is specified in new(), it cannot be re-specified in Open(). To lock -a parameter without specifying a value, set it to undef. - -To avoid having to list all possible parameters to lock them, specify -lock_by_default=>1. To allow a locked parameter to be changed, list it in -allow_change. - -To restrict the recipients that are allowed, list those recipients in -allowed_recipients. - -By wrapping an instance of this class with RestrictedClosureClass, you can -prevent the user from changing the SMTP server settings and sending mail to -or from unauthorized addresses. - -Method summary: - - new (wrapped) - safe - - Open (wrapped) - safe - - OpenMultipart (wrapped) - safe - - MailMsg (wrapped) - safe - - MailFile (wrapped) - unsafe, allows read access to filesystem - - Send - unsafe, can be used to issue SMTP commands - - SendLine - unsafe, can be used to issue SMTP commands - - print/SendEnc - safe - - SendLineEnc - safe - - SendEx - unsafe, can be used to issue SMTP commands - - SendLineEx - unsafe, can be used to issue SMTP commands - - Part - safe, but params cannot be locked - - Body - safe, but params cannot be locked - - SendFile/Attach - unsafe, allows read access to filesystem - - EndPart - safe - - Close - safe, but allows overriding the keepconnection parameter - - Cancel - safe - - QueryAuthProtocols - unsafe, allows connection to arbitrary SMTP server - - GetHandle - safe - -FIXME MailFile needs restriction on what files can be specified. - -FIXME There's currently no way to restrict the arguments to Part, Body, or -SendFile/Attach, but the only time this is actually a problem is with the "file" -parameter to SendFile/Attach. - -FIXME What about ctype and charset, which appear as params to new and also -appear separately as params to MailFile, Part, Body, and SendFile/Attach? - -FIXME Close should check if keepconnection is locked. - -FIXME QueryAuthProtocols could be made safe by prohibiting the $smtpserver -argument. - -=cut - -use strict; -use warnings; -use Carp; -use Scalar::Util qw/refaddr/; -use Storable qw/dclone/; -use WeBWorK::Utils qw/constituency_hash/; - -# params that all methods accept -our @COMMON_PARAMS = qw/from fake_from reply replyto to fake_to cc fake_cc bcc -smtp subject headers boundary multipart ctype charset client priority confirm -debug debug_level auth authid authdomain auth_encoded keepconnection -skip_bad_recipients createmessageid onerrors/; - -# params accepted by each method we're restricting -our %LEGAL_PARAMS = ( - new => constituency_hash(@COMMON_PARAMS), - Open => constituency_hash(@COMMON_PARAMS), - OpenMultipart => constituency_hash(@COMMON_PARAMS), - MailMsg => constituency_hash(@COMMON_PARAMS, qw/msg/), - MailFile => constituency_hash(@COMMON_PARAMS, qw/msg file description ctype charset encoding/), - #Part => constituency_hash(qw/description ctype encoding disposition content_id msg charset/), - Body => constituency_hash(qw/charset encoding ctype msg/), - Attach => constituency_hash(qw/description ctype encoding disposition file content_id/), -); - -# order of positional params -our %POSITIONAL_PARAMS = ( - new => [qw/from reply to smtp subject headers boundary/], - Open => [qw/from reply to smtp subject headers/], - OpenMultipart => [qw/from reply to smtp subject headers boundary/], - MailMsg => [qw/from reply to smtp subject headers msg/], - MailFile => [qw/from reply to smtp subject headers msg file description/], - #Part => [qw/description ctype encoding disposition content_id msg/], - #Body => [qw/charset encoding ctype/], - #Attach => [qw/description ctype encoding disposition file/], -); - -# legal opts: -# - params (parameters to pass to SUPER::new, either as an arrayref of positional params or as hashref) -# - lock_by_default (if true, params not listed in params or allow_change will be locked) -# - allow_change (params listed here will always be changeable) -# - allowed_recipients (if non-empty, recipient addresses must be in this list) -# - fatal_errors (if true, attempts to modify locked params will cause an exception) -# -sub new { - my ($invocant, %opts) = @_; - - my $params = $opts{params}; - $params = munge_params("new", @$params) if ref $params eq "ARRAY"; - - # make a deep copy of the params that will be passed to new - # Email::Sender might delete some elements, and we need the whole thing for later comparison - my $initial_params = dclone $params; - - # create the object, passing the params in - my $self = $invocant->SUPER::new($params); - - # handle errors - die $Email::Sender::Error unless ref $self; - - # store the set of initial params for later perusal - $self->initial_params = $initial_params; - - # lock_by_default states that params listed neither in params nor in allow_change should be locked - $self->lock_by_default = $opts{lock_by_default}; - - # allow_change lists params that can be changed even if they appear in params OR lock_by_default is true - # (this is stored as a HASH with undefined values for easy constituency testing) - $self->allow_change = constituency_hash(@{$opts{allow_change}}); - - # allowed_recipients can't be handled by setting an initial param - $self->allowed_recipients = constituency_hash(@{$opts{allowed_recipients}}); - - # fatal_errors will generate exceptions when locked params are changed - # (otherwise, the changes are ignored and a warning is issued) - $self->fatal_errors = $opts{fatal_errors}; - - return $self; -} - -sub Open { - my $self = shift; - my $params = munge_params("Open", @_); - $self->filter_params("Open", $params); - warn "this is Open: self=$self ISA=@WeBWorK::Utils::RestrictedMailer::ISA"; - return $self->SUPER::Open($params); -} - -sub OpenMultipart { - my $self = shift; - my $params = munge_params("OpenMultipart", @_); - $self->filter_params("OpenMultipart", $params); - return $self->SUPER::Open($params); -} - -sub MailMsg { - my $self = shift; - my $params = munge_params("MailMsg", @_); - $self->filter_params("MailMsg", $params); - return $self->SUPER::MailMsg($params); -} - -sub MailFile { - my $self = shift; - my $params = munge_params("MailFile", @_); - $self->filter_params("MailFile", $params); - return $self->SUPER::MailFile($params); -} - -sub _prepare_addresses { - my ($self, $type) = @_; - $self->SUPER::_prepare_addresses($type); - foreach my $address (@{$self->{'to_list'}}, @{$self->{'cc_list'}}, @{$self->{'bcc_list'}}) { - $address = $1 if $address =~ /<(.*)>/; - croak "mail not permitted to '$address'" unless exists $self->allowed_recipients->{$address}; - } -} - -################################################################################ - -# prefix for the keys we're adding to $self -our $PREFIX = "WeBWorK_Utils_RestrictedMailer_"; - -sub initial_params : lvalue { shift->{$PREFIX."initial_params"} } -sub lock_by_default : lvalue { shift->{$PREFIX."lock_by_default"} } -sub allow_change : lvalue { shift->{$PREFIX."allow_change"} } -sub allowed_recipients : lvalue { shift->{$PREFIX."allowed_recipients"} } -sub fatal_errors : lvalue { shift->{$PREFIX."fatal_errors"} } - -sub skipped_recipients { return shift->{skipped_recipients} } -sub error { return shift->{error} } -sub error_msg { return shift->{error_msg} } - -sub carp_or_croak { shift->fatal_errors ? croak @_ : carp @_ } - -sub munge_params { - my ($sub, @params) = @_; - - my $hash; - if (@params) { - if (ref $params[0] eq "HASH") { - $hash = $params[0]; - } else { - my @names = @{$POSITIONAL_PARAMS{$sub}}; - my $max = $#names < $#params ? $#names : $#params; - @$hash{@names[0..$max]} = @params[0..$max]; - } - } - return $hash || {}; -} - -sub filter_params { - my ($self, $sub, $params) = @_; - - foreach my $param (keys %$params) { - if (exists $LEGAL_PARAMS{$sub}{$param}) { - next if exists $self->{$PREFIX."allow_change"}{$param}; - if (exists $self->{$PREFIX."initial_params"}{$param}) { - my $oldval = $self->{$PREFIX."initial_params"}{$param}; - my $newval = $params->{$param}; - next if deq($oldval, $newval); - $self->carp_or_croak("failed to set param '$param' in method '$sub': param is locked"); - delete $params->{$param}; - } elsif ($self->{$PREFIX."lock_by_default"}) { - $self->carp_or_croak("failed to change param '$param' in method '$sub': param is locked"); - delete $params->{$param}; - } - } else { - $self->carp_or_croak("invalid param '$param' in method '$sub'"); - delete $params->{$param}; - } - } -} - -sub deq { - my ($oldval, $newval) = @_; - - #print "oldval=$oldval newval=$newval\n"; - if (ref $oldval and ref $newval) { - if (ref $oldval eq ref $newval) { - my $reftype = ref $oldval; - if ($reftype eq "HASH") { - my @oldkeys = sort keys %$oldval; - my @newkeys = sort keys %$newval; - #print "oldkeys=@oldkeys\n"; - #print "newkeys=@newkeys\n"; - return 0 unless deq(\@oldkeys, \@newkeys); - my @oldvals = @$oldval{@oldkeys}; - my @newvals = @$newval{@newkeys}; - #print "oldvals=@oldvals\n"; - #print "newvals=@newvals\n"; - return deq(\@oldvals, \@newvals); - } elsif ($reftype eq "ARRAY") { - return 0 unless @$oldval == @$newval; - for (my $i = 0; $i < @$oldval; $i++) { - return 0 unless deq($oldval->[$i], $newval->[$i]); - } - return 1; - } elsif ($reftype eq "SCALAR") { - return deq($$oldval, $$newval); - } elsif ($reftype eq "CODE") { - # the best we can do here is compare the addresses - return refaddr $oldval == refaddr $newval; - } else { - warn "unsupported reftype '$reftype' in deq()"; - return 0; - } - } else { - return 0; - } - } elsif (ref $oldval) { - return 0; - } elsif (ref $newval) { - return 0; - } else { - if (defined $oldval and defined $newval) { - return $oldval eq $newval; - } elsif (not defined $oldval and not defined $newval) { - return 1; - } else { - return 0; - } - } -} - -1; diff --git a/lib/WeBWorK/Utils/Tasks.pm b/lib/WeBWorK/Utils/Tasks.pm index 633e2dcd87..c5b4e10f89 100644 --- a/lib/WeBWorK/Utils/Tasks.pm +++ b/lib/WeBWorK/Utils/Tasks.pm @@ -42,8 +42,8 @@ editor. use strict; use warnings; use Carp; -use WeBWorK::PG; -use WeBWorK::DB::Utils qw(global2user); +use WeBWorK::PG; +use WeBWorK::DB::Utils qw(global2user); use WeBWorK::Form; use WeBWorK::Debug; @@ -71,34 +71,34 @@ Given a database, make a temporary problem set for that database. =cut -sub fake_set { - my $db = shift; - - my $set = $db->newGlobalSet(); - $set = global2user($db->{set_user}->{record}, $set); - $set->psvn(123); - $set->set_id(fakeSetName); +sub fake_set { + my $db = shift; + + my $set = $db->newGlobalSet(); + $set = global2user($db->{set_user}->{record}, $set); + $set->psvn(123); + $set->set_id(fakeSetName); $set->open_date(time()); $set->due_date(time()); $set->answer_date(time()); $set->visible(0); $set->enable_reduced_scoring(0); $set->hardcopy_header("defaultHeader"); - return($set); -} - -sub fake_set_version { - my $db = shift; - - my $set = $db->newSetVersion(); - # $set = global2user($db->{set_user}->{record}, $set); - $set->psvn(123); - $set->set_id(fakeSetName); + return($set); +} + +sub fake_set_version { + my $db = shift; + + my $set = $db->newSetVersion(); + # $set = global2user($db->{set_user}->{record}, $set); + $set->psvn(123); + $set->set_id(fakeSetName); $set->open_date(time()); $set->due_date(time()); $set->answer_date(time()); $set->visible(0); - $set->enable_reduced_scoring(); + $set->enable_reduced_scoring(); $set->hardcopy_header("defaultHeader"); $set->version_id(1); $set->attempts_per_version(0); @@ -109,8 +109,8 @@ sub fake_set_version { $set->hide_work('N'); $set->restrict_ip('No'); - return($set); -} + return($set); +} =item fake_problem @@ -123,29 +123,30 @@ specified, 0 is used. =cut -sub fake_problem { - my $db = shift; +sub fake_problem { + my $db = shift; my %options = @_; - my $problem = $db->newGlobalProblem(); + my $problem = $db->newGlobalProblem(); #debug("In fake_problem"); - $problem = global2user($db->{problem_user}->{record}, $problem); - $problem->set_id(fakeSetName); - $problem->value(""); - $problem->max_attempts("-1"); - $problem->showMeAnother("-1"); - $problem->showMeAnotherCount("0"); - - $problem->problem_seed(0); + $problem = global2user($db->{problem_user}->{record}, $problem); + $problem->set_id(fakeSetName); + $problem->value(""); + $problem->max_attempts("-1"); + $problem->showMeAnother("-1"); + $problem->showMeAnotherCount("0"); + $problem->showHintsAfter(2); + + $problem->problem_seed(0); $problem->problem_seed($options{'problem_seed'}) if(defined($options{'problem_seed'})); $problem->status(0); - $problem->sub_status(0); + $problem->sub_status(0); $problem->attempted(2000); # Large so hints won't be blocked - $problem->last_answer(""); - $problem->num_correct(1000); - $problem->num_incorrect(1000); + $problem->last_answer(""); + $problem->num_correct(1000); + $problem->num_incorrect(1000); $problem->prCount(-10); # Negative to detect fake problems and disable problem randomization. #for my $key (keys(%{$problem})){ @@ -158,7 +159,7 @@ sub fake_problem { - return($problem); + return($problem); } =item fake_user @@ -257,9 +258,9 @@ sub renderProblems { my %args = @_; my $r = $args{r}; my $db = $r->db; - my $ce = $r->ce; + my $ce = $r->ce; - # Don't print file names as part of the problem to avoid redundant + # Don't print file names as part of the problem to avoid redundant # paths in Library Browser and Homework Sets editor $ce->{pg}->{specialPGEnvironmentVars}->{PRINT_FILE_NAMES_FOR}=[]; @@ -267,30 +268,30 @@ sub renderProblems { my $displayMode = $args{displayMode} || $r->param('displayMode') || $ce->{pg}{options}{displayMode}; - + # special case for display mode 'None' -- we don't have to do anything # FIXME i think this should be handled in SetMaker.pm # SetMaker is not the only user of 'None' if ($displayMode eq 'None') { return map { {body_text=>''} } @problem_list; } - + my $user = $args{user} || fake_user($db); my $set = $args{'this_set'} || fake_set($db); my $problem_seed = $args{'problem_seed'} || $r->param('problem_seed') || 0; my $showHints = $args{showHints} || 0; my $showSolutions = $args{showSolutions} || 0; my $problemNumber = $args{'problem_number'} || 1; - + my $key = $r->param('key'); - + # remove any pretty garbage around the problem local $ce->{pg}{specialPGEnvironmentVars}{problemPreamble} = {TeX=>'',HTML=>''}; local $ce->{pg}{specialPGEnvironmentVars}{problemPostamble} = {TeX=>'',HTML=>''}; my $problem = fake_problem($db, 'problem_seed'=>$problem_seed); $problem->{value} = -1; my $formFields = { WeBWorK::Form->new_from_paramable($r)->Vars }; - + my @output; foreach my $onefile (@problem_list) { @@ -301,7 +302,7 @@ sub renderProblems { refreshMath2img => 0, processAnswers => 0, }; - + $problem->problem_id($problemNumber++); if (ref $onefile) { $problem->source_file(''); @@ -309,7 +310,7 @@ sub renderProblems { } else { $problem->source_file($onefile); } - + my $pg = new WeBWorK::PG( $ce, $user, @@ -323,7 +324,7 @@ sub renderProblems { push @output, $pg; } - + return @output; } diff --git a/lib/WebworkClient.pm b/lib/WebworkClient.pm index 8cbddd8418..7379bc52a0 100644 --- a/lib/WebworkClient.pm +++ b/lib/WebworkClient.pm @@ -23,7 +23,7 @@ WebworkClient.pm =head1 SYNPOSIS our $xmlrpc_client = new WebworkClient ( - url => $ce->{server_site_url}, + url => $ce->{server_site_url}, form_action_url => $FORM_ACTION_URL, site_password => $XML_PASSWORD//'', courseID => $credentials{courseID}, @@ -39,13 +39,13 @@ Remember to configure the local output file and display command !!!!!!!! =head1 DESCRIPTION This script will take a file and send it to a WeBWorK daemon webservice -to have it rendered. +to have it rendered. The result returned is split into the basic HTML rendering and evaluation of answers and then passed to a browser for printing. -The formatting allows the browser presentation to be interactive with the -daemon running the script webwork2/lib/renderViaXMLRPC.pm +The formatting allows the browser presentation to be interactive with the +daemon running the script webwork2/lib/renderViaXMLRPC.pm and with instructorXMLRPChandler. See WebworkWebservice.pm for related modules which operate on the server side @@ -66,42 +66,42 @@ use warnings; # points to the Webservice.pm and Webservice/RenderProblem modules # Is used by the client to send the original XML request to the webservice # Note: This is not the same as the webworkClient->url which should NOT have -# the mod_xmlrpc segment. +# the mod_xmlrpc segment. # # 2. $FORM_ACTION_URL http:http://test.webwork.maa.org/webwork2/html2xml # points to the renderViaXMLRPC.pm module. # # This url is placed as form action url when the rendered HTML from the original # request is returned to the client from Webservice/RenderProblem. The client -# reorganizes the XML it receives into an HTML page (with a WeBWorK form) and +# reorganizes the XML it receives into an HTML page (with a WeBWorK form) and # pipes it through a local browser. # # The browser uses this url to resubmit the problem (with answers) via the standard -# HTML webform used by WeBWorK to the renderViaXMLRPC.pm handler. +# HTML webform used by WeBWorK to the renderViaXMLRPC.pm handler. # -# This renderViaXMLRPC.pm handler acts as an intermediary between the browser -# and the webservice. It interprets the HTML form sent by the browser, -# rewrites the form data in XML format, submits it to the WebworkWebservice.pm +# This renderViaXMLRPC.pm handler acts as an intermediary between the browser +# and the webservice. It interprets the HTML form sent by the browser, +# rewrites the form data in XML format, submits it to the WebworkWebservice.pm # which processes it and sends the the resulting HTML back to renderViaXMLRPC.pm # which in turn passes it back to the browser. -# 3. The second time a problem is submitted renderViaXMLRPC.pm receives the WeBWorK form -# submitted directly by the browser. +# 3. The second time a problem is submitted renderViaXMLRPC.pm receives the WeBWorK form +# submitted directly by the browser. # The renderViaXMLRPC.pm translates the WeBWorK form, has it processes by the webservice -# and returns the result to the browser. +# and returns the result to the browser. # The The client renderProblem.pl script is no longer involved. # 4. Summary: The WebworkWebservice (with command renderProblem) is called directly in the first round trip -# of submitting the problem via the https://mysite.edu/mod_xmlrpc route. After that the communication is +# of submitting the problem via the https://mysite.edu/mod_xmlrpc route. After that the communication is # between the browser and renderViaXMLRPC using HTML forms and the route https://mysite.edu/webwork2/html2xml # and from there renderViaXMLRPC calls the WebworkWebservice using the route https://mysite.edu/mod_xmlrpc with the # renderProblem command. -our @COMMANDS = qw( listLibraries renderProblem ); #listLib readFile tex2pdf +our @COMMANDS = qw( listLibraries renderProblem ); #listLib readFile tex2pdf ################################################## -# XMLRPC client -- +# XMLRPC client -- # this code is identical between renderProblem.pl and renderViaXMLRPC.pm???? ################################################## @@ -113,10 +113,8 @@ use XMLRPC::Lite; use WeBWorK::Utils qw( wwRound encode_utf8_base64 decode_utf8_base64); use WeBWorK::Utils::AttemptsTable; use WeBWorK::CourseEnvironment; -use WeBWorK::PG::ImageGenerator; use HTML::Entities; use WeBWorK::Localize; -use WeBWorK::PG::ImageGenerator; use IO::Socket::SSL; use Digest::SHA qw(sha1_base64); use XML::Simple qw(XMLout); @@ -133,20 +131,19 @@ our $UNIT_TESTS_ON = 0; # static variables # create seed_ce -# then create imgGen our $seed_ce; eval { - $seed_ce = WeBWorK::CourseEnvironment->new( - {webwork_dir => $WeBWorK::Constants::WEBWORK_DIRECTORY, + $seed_ce = WeBWorK::CourseEnvironment->new( + {webwork_dir => $WeBWorK::Constants::WEBWORK_DIRECTORY, courseName => '', webworkURL => '', pg_dir => $WeBWorK::Constants::PG_DIRECTORY, }); }; if ($@ or not ref($seed_ce)){ - warn "Unable to find environment for WebworkClient: - webwork_dir => $WeBWorK::Constants::WEBWORK_DIRECTORY + warn "Unable to find environment for WebworkClient: + webwork_dir => $WeBWorK::Constants::WEBWORK_DIRECTORY pg_dir => $WeBWorK::Constants::PG_DIRECTORY"; } @@ -154,18 +151,6 @@ eval { our %imagesModeOptions = %{$seed_ce->{pg}->{displayModeOptions}->{images}}; our $site_url = $seed_ce->{server_root_url}//''; -our $imgGen = WeBWorK::PG::ImageGenerator->new( - tempDir => $seed_ce->{webworkDirs}->{tmp}, - latex => $seed_ce->{externalPrograms}->{latex}, - dvipng => $seed_ce->{externalPrograms}->{dvipng}, - useCache => 1, - cacheDir => $seed_ce->{webworkDirs}->{equationCache}, - cacheURL => $site_url . $seed_ce->{webworkURLs}->{equationCache}, - cacheDB => $seed_ce->{webworkFiles}->{equationCacheDB}, - dvipng_align => $imagesModeOptions{dvipng_align}, - dvipng_depth_db => $imagesModeOptions{dvipng_depth_db}, -); - sub new { #WebworkClient constructor my $invocant = shift; @@ -198,31 +183,31 @@ sub new { #WebworkClient constructor our $result; ################################################## -# Utilities -- +# Utilities -- # this code is identical between renderProblem.pl and renderViaXMLRPC.pm ################################################## =head2 xmlrpcCall - + $xmlrpc_client->encodeSource($source); $xmlrpc_client->{sourceFilePath} = $fileName; - - my $input = { + + my $input = { userID => $credentials{userID}//'', session_key => $credentials{session_key}//'', courseID => $credentials{courseID}//'', courseName => $credentials{courseID}//'', - course_password => $credentials{course_password}//'', + course_password => $credentials{course_password}//'', site_password => $XML_PASSWORD//'', envir => $xmlrpc_client->environment( fileName => $fileName, sourceFilePath => $fileName ), - }; - our($output, $return_string, $result); - + }; + our($output, $return_string, $result); + if ( $result = $xmlrpc_client->xmlrpcCall('renderProblem', $input) ) { $output = $xmlrpc_client->formatRenderedProblem; @@ -263,8 +248,8 @@ sub xmlrpcCall { $requestObject = {%$default_inputs, %$input}; #input values can override default inputs $self->request_object($requestObject); # store the request object for later - - my $requestResult; + + my $requestResult; my $transporter = TRANSPORT_METHOD->new; #FIXME -- transitional error fix to remove mod_xmlrpc from end of url call my $site_url = $self->site_url; @@ -281,12 +266,12 @@ sub xmlrpcCall { -> proxy(($site_url).'/'.REQUEST_URI); }; # END of FIXME section - + print STDERR "WebworkClient: Initiating xmlrpc request to url ",($self->site_url).'/'.REQUEST_URI, " \n Error: $@\n" if $@; - # turn off verification of the ssl cert + # turn off verification of the ssl cert $transporter->transport->ssl_opts(verify_hostname=>0, SSL_verify_mode => IO::Socket::SSL::SSL_VERIFY_NONE); - + if ($UNIT_TESTS_ON) { print STDERR "\n\tWebworkClient.pm ".__LINE__." xmlrpcCall sent to site ", $self->site_url,"\n"; print STDERR "\tWebworkClient.pm ".__LINE__." full xmlrpcCall path ", ($self->site_url).'/'.REQUEST_URI,"\n"; @@ -294,7 +279,7 @@ sub xmlrpcCall { print STDERR "\tWebworkClient.pm ".__LINE__." input is: ",join(" ", map {$_//'--'} %{$self->request_object}),"\n"; print STDERR "\tWebworkClient.pm ".__LINE__." xmlrpcCall $command initiated webwork webservice object $requestResult\n"; } - + local( $result); # use eval to catch errors #print STDERR "WebworkClient: issue command ", REQUEST_CLASS.'.'.$command, " ",join(" ", %$input),"\n"; @@ -307,7 +292,7 @@ sub xmlrpcCall { print CGI::h2("WebworkClient Errors"); print CGI::p("Errors:",CGI::br(),CGI::blockquote({style=>"color:red"},CGI::code($@)),CGI::br(),"End Errors"); } - + if (not ref($result) ) { my $error_string = "xmlrpcCall to $command returned no result for ". ($self->{sourceFilePath}//'')."\n"; @@ -373,12 +358,12 @@ sub jsXmlrpcCall { print "the command was $command"; my $transporter = TRANSPORT_METHOD->new; - + my $requestResult = $transporter -> proxy(($self->site_url).'/'.REQUEST_URI); $transporter->transport->ssl_opts(verify_hostname=>0, SSL_verify_mode => 'SSL_VERIFY_NONE'); - + local( $result); # use eval to catch errors eval { $result = $requestResult->call(REQUEST_CLASS.'.'.$command,$input) }; @@ -392,7 +377,7 @@ sub jsXmlrpcCall { my $rh_result = $result->result(); print "\n success \n"; print pretty_print($rh_result->{'ra_out'}); - $self->return_object( $rh_result ); + $self->return_object( $rh_result ); return 1; # success } else { @@ -485,8 +470,8 @@ sub xml_utf_decode { # Do UTF-8 decoding where xml_filter applied encoding fault site_url (https://mysite.edu) form_data - -=cut + +=cut sub encodeSource { my $self = shift; @@ -512,13 +497,13 @@ sub return_object { # out $self->{return_object} =$object if defined $object and ref($object); # source is non-empty $self->{return_object}; } -sub error_string { +sub error_string { my $self = shift; my $string = shift; $self->{error_string} =$string if defined $string and $string =~/\S/; # source is non-empty $self->{error_string}; } -sub fault { +sub fault { my $self = shift; my $fault_flag = shift; $self->{fault_flag} =$fault_flag if defined $fault_flag and $fault_flag =~/\S/; # source is non-empty @@ -567,7 +552,7 @@ sub default_inputs { die "Can't create seed course environment for webwork in $webwork_dir" unless ref($seed_ce); $self->{seed_ce} = $seed_ce; - + my @modules_to_evaluate; my @extra_packages_to_load; my @modules = @{ $seed_ce->{pg}->{modules} }; @@ -591,12 +576,12 @@ sub default_inputs { modules_to_evaluate => [@modules_to_evaluate], envir => $self->environment(), problem_state => { - + num_of_correct_ans => 0, num_of_incorrect_ans => 4, recorded_score => 1.0, }, - source => $self->encoded_source, #base64 encoded + source => $self->encoded_source, #base64 encoded }; $out; @@ -616,9 +601,6 @@ sub environment { CAPA_GraphicsDirectory =>'/opt/webwork/libraries/webwork-open-problem-library/Contrib/CAPA/', CAPA_MCTools=>'/opt/webwork/libraries/webwork-open-problem-library/Contrib/CAPA/macros/CAPA_MCTools/', CAPA_Tools=>'/opt/webwork/libraries/webwork-open-problem-library/Contrib/CAPA/macros/CAPA_Tools/', - cgiDirectory=>'Not defined', - cgiURL => 'foobarNot defined', - classDirectory=> 'Not defined', courseName=>'Not defined', courseScriptsDirectory=>'not defined', displayMode => $self->{inputs_ref}{displayMode} // "MathJax", @@ -652,7 +634,7 @@ sub environment { numZeroLevelTolDefault =>0.000001, openDate=> '3014438528', permissionLevel => $self->{inputs_ref}{permissionLevel} // 0, - PRINT_FILE_NAMES_FOR => [], + isInstructor => $self->{inputs_ref}{isInstructor} // 0, probFileName => 'WebworkClient.pm:: define probFileName in environment', problemSeed => $self->{inputs_ref}{problemSeed} // 3333, problemUUID => $self->{inputs_ref}{problemUUID} // 0, @@ -660,11 +642,9 @@ sub environment { probNum => $self->{inputs_ref}{probNum} // 1, psvn => $self->{inputs_ref}{psvn} // 54321, questionNumber => 1, - scriptDirectory => 'Not defined', sectionName => '', sectionNumber => 1, - server_root_url =>"foobarfoobar", - sessionKey=> 'Not defined', + server_root_url =>"foobarfoobar", setNumber => $self->{inputs_ref}{setNumber} // 'not defined', studentLogin =>'', studentName => '', @@ -672,8 +652,9 @@ sub environment { templateDirectory=>'not defined', tempURL=>'not defined', webworkDocsURL => 'not defined', - showHints => $self->{inputs_ref}{showHints} // 0, # extra options -- usually passed from the input form + showHints => $self->{inputs_ref}{showHints} // 0, showSolutions => $self->{inputs_ref}{showSolutions} // 0, + forceScaffoldsOpen => $self->{inputs_ref}{forceScaffoldsOpen} // 0, @_, }; $envir; @@ -682,7 +663,7 @@ sub environment { =item formatRenderedLibraries =cut - + sub formatRenderedLibraries { my $self = shift; #my @rh_result = @{$self->return_object}; # wrap problem in formats @@ -713,7 +694,7 @@ sub formatRenderedProblem { =head2 Utility functions: -=over 4 +=over 4 =item writeRenderLogEntry() @@ -726,7 +707,7 @@ sub formatRenderedProblem { Information printed in format: [formatted date & time ] processID unixTime BeginEnd $function $details -=cut +=cut sub writeRenderLogEntry($$$) { my ($function, $details, $beginEnd) = @_; @@ -751,10 +732,10 @@ sub pretty_print { # provides html output -- NOT a method $out =~ s/"; - - + + foreach my $key ( sort ( keys %$r_input )) { # Safety feature - we do not want to display the contents of "%seed_ce" which # contains the database password and lots of other things, and explicitly hide @@ -783,7 +764,7 @@ sub pretty_print { # provides html output -- NOT a method $out = $r_input; $out =~ s/ $r_problem_source, # reference to a source file string. # if reference is not defined then the path is obtained # from the problem object. + problemUUID => $rh->{envir}{inputs_ref}{problemUUID} // 0, permissionLevel => $rh->{envir}{permissionLevel} || 0, effectivePermissionLevel => $rh->{envir}{effectivePermissionLevel} || $rh->{envir}{permissionLevel} || 0, useMathQuill => $ce->{pg}{specialPGEnvironmentVars}{entryAssist} eq 'MathQuill', useMathView => $ce->{pg}{specialPGEnvironmentVars}{entryAssist} eq 'MathView', useWiris => $ce->{pg}{specialPGEnvironmentVars}{entryAssist} eq 'WIRIS', + isInstructor => $rh->{envir}{isInstructor} // 0, + forceScaffoldsOpen => $rh->{envir}{forceScaffoldsOpen} // 0, + debuggingOptions => $rh->{envir}{debuggingOptions} // {} }; my $formFields = $rh->{envir}->{inputs_ref}; - my $key = $rh->{envir}->{key} || ''; local $ce->{pg}{specialPGEnvironmentVars}{problemPreamble} = {TeX=>'',HTML=>''} if($rh->{noprepostambles}); local $ce->{pg}{specialPGEnvironmentVars}{problemPostamble} = {TeX=>'',HTML=>''} if($rh->{noprepostambles}); @@ -371,20 +374,9 @@ sub renderProblem { # num_incorrect # except that it is passed on to defineProblemEnvironment - my $pg = WebworkWebservice::RenderProblem->new( - $ce, - $effectiveUser, - $key, - $setRecord, - $problemRecord, - $setRecord->psvn, - $formFields, - $translationOptions, - { # extras - problemUUID => $rh->{envir}->{inputs_ref}->{problemUUID}//0, - } - - ); + my $pg = WeBWorK::PG->new(constructPGOptions( + $ce, $effectiveUser, $setRecord, $problemRecord, $setRecord->psvn, $formFields, $translationOptions + )); $self->{formFields} = $formFields; @@ -548,22 +540,4 @@ sub logTimingInfo{ $out; } - -###################################################################### -sub new { - shift; # throw away invocant -- we don't need it - my ($ce, $user, $key, $set, $problem, $psvn, $formFields, - $translationOptions) = @_; - - #my $renderer = 'WeBWorK::PG::Local'; - my $renderer = $ce->{pg}->{renderer}; - - runtime_use $renderer; - # the idea is to have Local call back to the defineProblemEnvir below. - #return WeBWorK::PG::Local::new($renderer,@_); - return $renderer->new(@_); -} - - - 1; diff --git a/lib/WebworkWebservice/SetActions.pm b/lib/WebworkWebservice/SetActions.pm index adbc9b8109..969ced7613 100644 --- a/lib/WebworkWebservice/SetActions.pm +++ b/lib/WebworkWebservice/SetActions.pm @@ -672,6 +672,7 @@ sub addProblem { my $value_default = $self->ce->{problemDefaults}->{value}; my $max_attempts_default = $self->ce->{problemDefaults}->{max_attempts}; my $showMeAnother_default = $self->ce->{problemDefaults}->{showMeAnother}; + my $showHintsAfter_default = $self->ce->{problemDefaults}{showHintsAfter}; my $att_to_open_children_default = $self->ce->{problemDefaults}->{att_to_open_children}; my $counts_parent_grade_default = $self->ce->{problemDefaults}->{counts_parent_grade}; # showMeAnotherCount is the number of times that showMeAnother has been clicked; initially 0 @@ -684,6 +685,7 @@ sub addProblem { my $maxAttempts = $params->{maxAttempts} || $max_attempts_default; my $showMeAnother = $params->{showMeAnother} || $showMeAnother_default; + my $showHintsAfter = $params->{showHintsAfter} || $showHintsAfter_default; my $problemID = $params->{problemID}; my $countsParentGrade = $params->{counts_parent_grade} || $counts_parent_grade_default; my $attToOpenChildren = $params->{att_to_open_children} || $att_to_open_children_default; @@ -704,6 +706,7 @@ sub addProblem { $problemRecord->value($value); $problemRecord->max_attempts($maxAttempts); $problemRecord->showMeAnother($showMeAnother); + $problemRecord->showHintsAfter($showHintsAfter); $problemRecord->{showMeAnotherCount}=$showMeAnotherCount; $problemRecord->{att_to_open_children} = $attToOpenChildren; $problemRecord->{counts_parent_grade} = $countsParentGrade; From b280b5b19f43dc54a3fba9252534485316a9e094 Mon Sep 17 00:00:00 2001 From: Glenn Rice Date: Wed, 24 Aug 2022 12:54:05 -0500 Subject: [PATCH 023/490] Add changes from reviews. --- lib/FormatRenderedProblem.pm | 2 +- .../Instructor/ProblemSetDetail.pm | 2 +- .../Instructor/ProblemSetList.pm | 10 ++++----- lib/WeBWorK/ContentGenerator/Problem.pm | 22 +++++++++---------- lib/WeBWorK/Utils/ProblemProcessing.pm | 15 +++++-------- 5 files changed, 24 insertions(+), 27 deletions(-) diff --git a/lib/FormatRenderedProblem.pm b/lib/FormatRenderedProblem.pm index ff8a5d43eb..63ddf7f0b0 100644 --- a/lib/FormatRenderedProblem.pm +++ b/lib/FormatRenderedProblem.pm @@ -243,7 +243,7 @@ sub formatRenderedProblem { my $submitMode = defined($self->{inputs_ref}{WWsubmit}) || 0; my $showCorrectMode = defined($self->{inputs_ref}{WWcorrectAns}) || 0; # A problemUUID should be added to the request as a parameter. It is used by PG to create a proper UUID for use in - # aliases for resources. It should be unique for a course, user, set, and problem. + # aliases for resources. It should be unique for a course, user, set, problem, and version. my $problemUUID = $self->{inputs_ref}{problemUUID} // ''; my $problemResult = $rh_result->{problem_result} // ''; my $problemState = $rh_result->{problem_state} // ''; diff --git a/lib/WeBWorK/ContentGenerator/Instructor/ProblemSetDetail.pm b/lib/WeBWorK/ContentGenerator/Instructor/ProblemSetDetail.pm index feb5b29c84..7df1a217c0 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/ProblemSetDetail.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/ProblemSetDetail.pm @@ -358,7 +358,7 @@ use constant FIELD_PROPERTIES => { help_text => x( 'This specifies the number of attempts before hints are shown to students. ' . 'The value of -2 uses the default from course configuration. The value of -1 disables hints.' - . 'Note that this will only have effect if the problem has a hint.' + . 'Note that this will only have an effect if the problem has a hint.' ), }, prPeriod => { diff --git a/lib/WeBWorK/ContentGenerator/Instructor/ProblemSetList.pm b/lib/WeBWorK/ContentGenerator/Instructor/ProblemSetList.pm index 73f2665ed0..20f630e4b8 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/ProblemSetList.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/ProblemSetList.pm @@ -2148,7 +2148,7 @@ sub readSetDef { } elsif ( $item eq 'showMeAnother' ) { $showMeAnother = ( $value ) ? $value : 0; } elsif ( $item eq 'showHintsAfter' ) { - $showHintsAfter = ( $value ) ? $value : 0; + $showHintsAfter = ( $value ) ? $value : -2; } elsif ( $item eq 'prPeriod' ) { $prPeriod = ( $value ) ? $value : 0; } elsif ( $item eq 'restrictProbProgression' ) { @@ -2176,13 +2176,13 @@ sub readSetDef { $countsParentGrade =~ s/[^\d-]*//g; unless ($showMeAnother =~ /-?\d+/) {$showMeAnother = $showMeAnother_default;} - $showMeAnother =~ s/[^-?\d-]*//g; + $showMeAnother =~ s/[^\d-]*//g; - unless ($showHintsAfter =~ /-?\d+/) {$showHintsAfter = $showMeAnother_default;} - $showHintsAfter =~ s/[^-?\d-]*//g; + unless ($showHintsAfter =~ /-?\d+/) {$showHintsAfter = $showHintsAfter_default;} + $showHintsAfter =~ s/[^\d-]*//g; unless ($prPeriod =~ /-?\d+/) {$prPeriod = $prPeriod_default;} - $prPeriod =~ s/[^-?\d-]*//g; + $prPeriod =~ s/[^\d-]*//g; unless ($attToOpenChildren =~ /\d+/) {$attToOpenChildren = $att_to_open_children_default;} $attToOpenChildren =~ s/[^\d-]*//g; diff --git a/lib/WeBWorK/ContentGenerator/Problem.pm b/lib/WeBWorK/ContentGenerator/Problem.pm index 0fbd8e3be2..a286b54a82 100644 --- a/lib/WeBWorK/ContentGenerator/Problem.pm +++ b/lib/WeBWorK/ContentGenerator/Problem.pm @@ -1550,19 +1550,19 @@ sub output_message { print CGI::p(CGI::b($r->maketext('Note') . ': '), CGI::i($pg->{result}{msg})) if $pg->{result}{msg}; - print CGI::p( - CGI::b($r->maketext('Note') . ': '), - CGI::i( - $r->maketext( + if ($ce->{pg}{ansEvalDefaults}{enableReducedScoring} + && $self->{set}->enable_reduced_scoring + && after($self->{set}->reduced_scoring_date) + && before($self->{set}->due_date)) + { + print CGI::p( + CGI::b($r->maketext('Note') . ': '), + CGI::i($r->maketext( 'You are in the Reduced Scoring Period. All work counts for [_1]% of the original.', $ce->{pg}{ansEvalDefaults}{reducedScoringValue} * 100 - ) - ) - ) - if ($ce->{pg}{ansEvalDefaults}{enableReducedScoring} - && $self->{set}->enable_reduced_scoring - && after($self->{set}->reduced_scoring_date) - && before($self->{set}->due_date)); + )) + ); + } if ($pg->{flags}{hintExists} && $r->authz->hasPermissions($self->{userName}, 'always_show_hint')) { my $showHintsAfter = diff --git a/lib/WeBWorK/Utils/ProblemProcessing.pm b/lib/WeBWorK/Utils/ProblemProcessing.pm index c5ceff475b..b1b9878b2b 100644 --- a/lib/WeBWorK/Utils/ProblemProcessing.pm +++ b/lib/WeBWorK/Utils/ProblemProcessing.pm @@ -46,8 +46,8 @@ our @EXPORT_OK = qw( ); # WARNING: The usage of $self throughout this file is incorrect and quite misleading. In all cases $self needs to at -# least be a WeBWorK::ContentGenerator object even. In addition it must be ensured that the $self object has the -# correct hash values to work with the method. +# least be a WeBWorK::ContentGenerator object. In addition it must be ensured that the $self object has the correct +# hash values to work with the method. # Performs functions of processing and recording the answer given in the page. # Returns the appropriate scoreRecordedMessage. @@ -107,9 +107,6 @@ sub process_and_log_answer { # this stores previous answers to the problem to provide "sticky answers" if ($submitAnswers) { - # get a "pure" (unmerged) UserProblem to modify - # this will be undefined if the problem has not been assigned to this user - if (defined $pureProblem) { # store answers in DB for sticky answers my %answersToStore; @@ -302,18 +299,18 @@ sub compute_reduced_score { # create answer string from responses hash # ($past_answers_string, $encoded_last_answer_string, $scores, $isEssay) = create_ans_str_from_responses($problem, $pg) # -# input: ref($pg) eq 'WeBWorK::PG::Local' +# input: ref($pg) eq 'WeBWorK::PG' # ref($problem) eq 'WeBWorK::ContentGenerator::Problem # output: (str, str, str) -# and other persistant objects need not be included. +# and other persistent objects need not be included. # The extra persistence objects do need to be included in problem->last_answer -# in order to keep those objects persistant -- as long as RECORD_FORM_ANSWER +# in order to keep those objects persistent -- as long as RECORD_FORM_ANSWER # is used to preserve objects by piggy backing on the persistence mechanism for answers. sub create_ans_str_from_responses { my $problem = shift; # ref($problem) eq 'WeBWorK::ContentGenerator::Problem' # must contain $self->{formFields}{$response_id} - my $pg = shift; # ref($pg) eq 'WeBWorK::PG::Local' + my $pg = shift; # ref($pg) eq 'WeBWorK::PG' my $scores2 = ''; my $isEssay2 = 0; From 8a83cd1775c6030942967ecb80cedd3750b1a0f6 Mon Sep 17 00:00:00 2001 From: Glenn Rice Date: Wed, 31 Aug 2022 07:26:44 -0500 Subject: [PATCH 024/490] If a problem has a reduced score recorded then pass the corresponding unreduced score in to PG for the recorded score. Otherwise the recorded score can be updated incorrectly. This is determined simply by checking if the sub_status is less that the status in the case that reduced scoring is enabled for the set. Also, a check is added that the score returned by PG (and reduced if reduced scoring is in effect) is less than the currently saved score. If that is the case, the the score in the database is not changed. --- lib/WeBWorK/ContentGenerator/GatewayQuiz.pm | 6 +++--- lib/WeBWorK/Utils/ProblemProcessing.pm | 3 ++- lib/WeBWorK/Utils/Rendering.pm | 14 ++++++++++++-- 3 files changed, 17 insertions(+), 6 deletions(-) diff --git a/lib/WeBWorK/ContentGenerator/GatewayQuiz.pm b/lib/WeBWorK/ContentGenerator/GatewayQuiz.pm index 18d72bd144..24abfab64f 100644 --- a/lib/WeBWorK/ContentGenerator/GatewayQuiz.pm +++ b/lib/WeBWorK/ContentGenerator/GatewayQuiz.pm @@ -1604,8 +1604,8 @@ sub body { # Next, store the state in the database if answers are being recorded. if ($submitAnswers && $will{recordAnswers}) { - $problems[$i] - ->status(compute_reduced_score($ce, $problems[$i], $set, $pg_results[$i]{state}{recorded_score})); + my $score = compute_reduced_score($ce, $problems[$i], $set, $pg_results[$i]{state}{recorded_score}); + $problems[$i]->status($score) if $score > $problems[$i]->status; $problems[$i]->sub_status($problems[$i]->status) if (!$ce->{pg}{ansEvalDefaults}{enableReducedScoring} @@ -1912,7 +1912,7 @@ sub body { if (ref $pg) { # If a pg object is available, then use the pg recorded score and save it in the @probStatus array. $pScore = compute_reduced_score($ce, $problems[$i], $set, $pg->{state}{recorded_score}); - $probStatus[$i] = $pScore; + $probStatus[$i] = $pScore if $pScore > $probStatus[$i]; } else { # If a pg object is not available, then use the saved problem status. $pScore = $probStatus[$i]; diff --git a/lib/WeBWorK/Utils/ProblemProcessing.pm b/lib/WeBWorK/Utils/ProblemProcessing.pm index b1b9878b2b..1f162a7030 100644 --- a/lib/WeBWorK/Utils/ProblemProcessing.pm +++ b/lib/WeBWorK/Utils/ProblemProcessing.pm @@ -118,7 +118,8 @@ sub process_and_log_answer { # store state in DB if it makes sense if ($will{recordAnswers}) { - $problem->status(compute_reduced_score($ce, $problem, $set, $pg->{state}{recorded_score})); + my $score = compute_reduced_score($ce, $problem, $set, $pg->{state}{recorded_score}); + $problem->status($score) if $score > $problem->status; $problem->sub_status($problem->status) if (!$r->{ce}{pg}{ansEvalDefaults}{enableReducedScoring} diff --git a/lib/WeBWorK/Utils/Rendering.pm b/lib/WeBWorK/Utils/Rendering.pm index 0513101098..b2932c110a 100644 --- a/lib/WeBWorK/Utils/Rendering.pm +++ b/lib/WeBWorK/Utils/Rendering.pm @@ -106,8 +106,18 @@ sub constructPGOptions ($ce, $user, $set, $problem, $psvn, $formFields, $transla # State Information $options{numOfAttempts} = ($problem->num_correct || 0) + ($problem->num_incorrect || 0) + ($formFields->{submitAnswers} ? 1 : 0); - $options{problemValue} = $problem->value; - $options{recorded_score} = $problem->status; + $options{problemValue} = $problem->value; + # If reduced scoring is enabled for the set and the sub_status is less than the status, then the status is the + # reduced score. In that case compute the unreduced score that resulted in that reduced score to submit as the + # currently recorded score. + $options{recorded_score} = + ($set->enable_reduced_scoring + && $ce->{pg}{ansEvalDefaults}{reducedScoringValue} + && defined $problem->sub_status + && $problem->sub_status < $problem->status) + ? (($problem->status - $problem->sub_status) / $ce->{pg}{ansEvalDefaults}{reducedScoringValue} + + $problem->sub_status) + : $problem->status; $options{num_of_correct_ans} = $problem->num_correct; $options{num_of_incorrect_ans} = $problem->num_incorrect; From dc4c86a82d9fa39b8a75a61bb118d359be11295b Mon Sep 17 00:00:00 2001 From: Glenn Rice Date: Fri, 16 Sep 2022 10:42:21 -0500 Subject: [PATCH 025/490] Remove the now unused checkurl external program. --- conf/site.conf.dist | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/conf/site.conf.dist b/conf/site.conf.dist index a39fb2b4ee..b10a3e554b 100644 --- a/conf/site.conf.dist +++ b/conf/site.conf.dist @@ -141,10 +141,8 @@ $externalPrograms{pnmtopng} = "$netpbm_prefix/pnmtopng"; $externalPrograms{pngtopnm} = "$netpbm_prefix/pngtopnm"; #################################################### -# url checker +# curl #################################################### -# set timeout time (-t 40 sec) to be less than timeout for problem (usually 60 seconds) -$externalPrograms{checkurl} = "/usr/bin/lwp-request -d -t 40 -mHEAD "; # or "/usr/local/bin/w3c -head " $externalPrograms{curl} = "/usr/bin/curl"; #################################################### From b3f4f01eca2c4f96c033a6c1be000bd5c7955fb8 Mon Sep 17 00:00:00 2001 From: somiaj Date: Tue, 4 Oct 2022 14:48:52 -0600 Subject: [PATCH 026/490] Show set header in proctored login. Use the set header for the page info-box when at a login prompt for a proctored gateway quiz instead of showing the site info or login info. Run perltidy on LoginProctor.pm --- lib/WeBWorK/ContentGenerator/LoginProctor.pm | 105 ++++++++----------- 1 file changed, 42 insertions(+), 63 deletions(-) diff --git a/lib/WeBWorK/ContentGenerator/LoginProctor.pm b/lib/WeBWorK/ContentGenerator/LoginProctor.pm index 937414bdfe..6c7fc8b119 100644 --- a/lib/WeBWorK/ContentGenerator/LoginProctor.pm +++ b/lib/WeBWorK/ContentGenerator/LoginProctor.pm @@ -25,9 +25,10 @@ GatewayQuiz proctored tests. use strict; use warnings; -use CGI qw(-nosticky ); -use WeBWorK::Utils qw(readFile dequote); -use WeBWorK::DB::Utils qw(grok_vsetID); +use CGI qw(-nosticky ); +use WeBWorK::Utils qw(readFile dequote); +use WeBWorK::Utils::Rendering qw(constructPGOptions); +use WeBWorK::DB::Utils qw(grok_vsetID); use WeBWorK::ContentGenerator::GatewayQuiz qw(can_recordAnswers); # This content generator is NOT logged in. @@ -42,66 +43,44 @@ sub if_loggedin { sub info { my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; - - my $result; - - # This section should be kept in sync with the Home.pm version - my $site_info = $ce->{webworkFiles}->{site_info}; - if (defined $site_info and $site_info) { - # deal with previewing a temporary file - # FIXME: DANGER: this code allows viewing of any file - # FIXME: this code is disabled because PGProblemEditor no longer uses editFileSuffix - #if (defined $r->param("editMode") and $r->param("editMode") eq "temporaryFile" - # and defined $r->param("editFileSuffix")) { - # $site_info .= $r->param("editFileSuffix"); - #} - - if (-f $site_info) { - my $text = eval { readFile($site_info) }; - if ($@) { - $result .= CGI::h2($r->maketext("Site Information")); - $result .= CGI::div({ class => 'alert alert-danger p-1 mb-2' }, $@); - } elsif ($text =~ /\S/) { - $result .= CGI::h2($r->maketext("Site Information")); - $result .= $text; - } - } - } - - # FIXME this is basically the same code as above... TIME TO REFACTOR! - my $login_info = $ce->{courseFiles}->{login_info}; - if (defined $login_info and $login_info) { - # login info is relative to the templates directory, apparently - $login_info = $ce->{courseDirs}->{templates} . "/$login_info"; - - # deal with previewing a temporary file - # FIXME: DANGER: this code allows viewing of any file - # FIXME: this code is disabled because PGProblemEditor no longer uses editFileSuffix - #if (defined $r->param("editMode") and $r->param("editMode") eq "temporaryFile" - # and defined $r->param("editFileSuffix")) { - # $login_info .= $r->param("editFileSuffix"); - #} - - if (-f $login_info) { - my $text = eval { readFile($login_info) }; - if ($@) { - $result .= CGI::h2("Login Info"); - $result .= CGI::div({ class => 'alert alert-danger p-1 mb-2' }, $@); - } elsif ($text =~ /\S/) { - $result .= CGI::h2("Login Info"); - $result .= $text; - } - } - } + my $r = $self->r; + my $ce = $r->ce; + + # Get problem set info. Code taken from ProblemSet.pm + my $effectiveUser = $r->db->getUser($r->param('effectiveUser')); + my $set = $r->authz->{merged_set}; + my $displayMode = $r->param('displayMode') || $ce->{pg}->{options}->{displayMode}; + + # Hack to prevent errors from uninitialized set_headers. + $set->set_header('defaultHeader') unless $set->set_header =~ /\S/; # (some non-white space character required) + my $screenSetHeader = + ($set->set_header eq 'defaultHeader') ? $ce->{webworkFiles}->{screenSnippets}->{setHeader} : $set->set_header; + + # Decide what to do about problem number. + my $problem = WeBWorK::DB::Record::UserProblem->new( + problem_id => 0, + set_id => $set->set_id, + login_id => $effectiveUser->user_id, + source_file => $screenSetHeader, + # the rest of Problem's fields are not needed, i think + ); - if (defined $result and $result ne "") { -# return CGI::div({class=>"info-box", id=>"InfoPanel"}, $result); - return $result; - } else { - return ""; - } + my $pg = WeBWorK::PG->new(constructPGOptions( + $ce, + $effectiveUser, + $set, + $problem, + $set->psvn, + {}, # no form fields! + { # translation options + displayMode => $displayMode, + showHints => 0, + showSolutions => 0, + processAnswers => 0, + }, + )); + + return CGI::h2($r->maketext('Set Info')) . $pg->{body_text}; } sub body { @@ -230,7 +209,7 @@ sub body { # write out the form data posted to the requested URI my @fields_to_print = grep { - !/^(user)|(effectiveUser)|(passwd)|(key)|(force_password_authen)|(proctor_user)|(proctor_key)|(proctor_password)$/ + !/^(user)|(effectiveUser)|(passwd)|(key)|(force_password_authen)|(proctor_user)|(proctor_key)|(proctor_password)$/ } $r->param(); print $self->hidden_fields(@fields_to_print) if (@fields_to_print); From 7e1574db6cd2d3b6774fb9f514dc37f0bce5bc3e Mon Sep 17 00:00:00 2001 From: Glenn Rice Date: Sun, 16 Oct 2022 10:40:07 -0500 Subject: [PATCH 027/490] Fix an issue in gateway quizzes that causes correct answers to be displayed on all submissions. The removal of the $pg{options}{showCorrectAnswers} from defaults.config made it so that the $want->{showProblemGrader} value in GatewayQuiz.pm could possibly be undefined. As a result the AttemptsTable.pm code defaulted to showing correct answers. Both of those are changed. A fallback was added so that the $want->{showProblemGrader} is now defined and 0 in this case. Although that isn't really needed. Why did the AttemptsTable.pm default to displaying correct answers if the showCorrectAnswers option was undefined? That doesn't make sense. So that default is changed. --- lib/WeBWorK/ContentGenerator/GatewayQuiz.pm | 2 +- lib/WeBWorK/Utils/AttemptsTable.pm | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/lib/WeBWorK/ContentGenerator/GatewayQuiz.pm b/lib/WeBWorK/ContentGenerator/GatewayQuiz.pm index 24abfab64f..735e29b978 100644 --- a/lib/WeBWorK/ContentGenerator/GatewayQuiz.pm +++ b/lib/WeBWorK/ContentGenerator/GatewayQuiz.pm @@ -919,7 +919,7 @@ sub pre_header_initialize { showOldAnswers => $User->showOldAnswers ne '' ? $User->showOldAnswers : $ce->{pg}{options}{showOldAnswers}, # showProblemGrader implies showCorrectAnswers. This is a convenience for grading. showCorrectAnswers => ($r->param('showProblemGrader') || 0) - || ($r->param("showCorrectAnswers") && ($submitAnswers || $checkAnswers)), + || ($r->param("showCorrectAnswers") && ($submitAnswers || $checkAnswers)) || 0, showProblemGrader => $r->param('showProblemGrader') || 0, # Hints are not yet implemented in gateway quzzes. showHints => 0, diff --git a/lib/WeBWorK/Utils/AttemptsTable.pm b/lib/WeBWorK/Utils/AttemptsTable.pm index 77618b3548..c7e5d2b7c5 100644 --- a/lib/WeBWorK/Utils/AttemptsTable.pm +++ b/lib/WeBWorK/Utils/AttemptsTable.pm @@ -167,7 +167,7 @@ sub new { showAttemptPreviews => $options{showAttemptPreviews} // 1, # show preview of student answer showAttemptResults => $options{showAttemptResults} // 1, # show whether student answer is correct showMessages => $options{showMessages} // 1, # show any messages generated by evaluation - showCorrectAnswers => $options{showCorrectAnswers} // 1, # show the correct answers + showCorrectAnswers => $options{showCorrectAnswers} // 0, # show the correct answers showSummary => $options{showSummary} // 1, # show summary to students maketext => $options{maketext} // sub {return @_}, # pointer to the maketext subroutine imgGen => undef, # created in _init method From 975a3e1577ffcb4875ed38d98cb99d5e48d6b67c Mon Sep 17 00:00:00 2001 From: Jaimos Skriletz Date: Fri, 21 Oct 2022 21:21:39 -0600 Subject: [PATCH 028/490] Keep manual grader open when using sibling links. When using the manual grader, add showProblemGrader=1 to the siblings links parameters, so it remains visible (just like the next/previous problem links). --- lib/WeBWorK/ContentGenerator/Problem.pm | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/lib/WeBWorK/ContentGenerator/Problem.pm b/lib/WeBWorK/ContentGenerator/Problem.pm index a286b54a82..56b094e8e5 100644 --- a/lib/WeBWorK/ContentGenerator/Problem.pm +++ b/lib/WeBWorK/ContentGenerator/Problem.pm @@ -888,6 +888,9 @@ sub siblings { my @items; + # Keep manual grader open when linking to problems if it's already open. + my %problemGraderLink = $self->{will}{showProblemGrader} ? (params => { showProblemGrader => 1 }) : (); + foreach my $problemID (@problemIDs) { if ($isJitarSet && !$authz->hasPermissions($eUserID, "view_unopened_sets") && is_jitar_problem_hidden($db,$eUserID, $setID, $problemID)) { shift(@problemRecords) if $progressBarEnabled; @@ -950,7 +953,7 @@ sub siblings { $link = CGI::a( { $active ? (class => $class) - : (href => $self->systemLink($problemPage), class => $class) + : (href => $self->systemLink($problemPage, %problemGraderLink), class => $class) }, $r->maketext('Problem [_1]', join('.', @seq)) . ($progressBarEnabled ? $status_symbol : '') ); @@ -959,7 +962,7 @@ sub siblings { $link = CGI::a( { $active ? (class => 'nav-link active') - : (href => $self->systemLink($problemPage), class => 'nav-link') + : (href => $self->systemLink($problemPage, %problemGraderLink), class => 'nav-link') }, $r->maketext('Problem [_1]', $problemID) . ($progressBarEnabled ? $status_symbol : '') ); From 9db8b853edd594936cb8af4899db2b0d2f5fa4fa Mon Sep 17 00:00:00 2001 From: Alex Jordan Date: Sat, 22 Oct 2022 18:07:47 -0700 Subject: [PATCH 029/490] disable autocapitalization from username input field --- lib/WeBWorK/ContentGenerator/Login.pm | 25 +++++++++++++------------ 1 file changed, 13 insertions(+), 12 deletions(-) diff --git a/lib/WeBWorK/ContentGenerator/Login.pm b/lib/WeBWorK/ContentGenerator/Login.pm index 9d79a0093c..699ddd149a 100644 --- a/lib/WeBWorK/ContentGenerator/Login.pm +++ b/lib/WeBWorK/ContentGenerator/Login.pm @@ -220,24 +220,25 @@ sub body { print CGI::div( { class => 'form-floating mb-2' }, CGI::textfield({ - id => 'uname', - name => 'user', - value => $user, - aria_required => 'true', - class => 'form-control', - placeholder => '' + id => 'uname', + name => 'user', + value => $user, + aria_required => 'true', + class => 'form-control', + placeholder => '', + autocapitalize => 'none' }), CGI::label({ for => 'uname' }, $r->maketext('Username')) ); print CGI::div( { class => 'form-floating mb-2' }, CGI::password_field({ - id => 'pswd', - name => 'passwd', - value => $passwd, - aria_required => 'true', - class => 'form-control', - placeholder => '' + id => 'pswd', + name => 'passwd', + value => $passwd, + aria_required => 'true', + class => 'form-control', + placeholder => '' }), CGI::label({ for => 'pswd' }, $r->maketext('Password')) ); From 69fb05d563fcd1390aaba3ba39af7dbbdb7b0066 Mon Sep 17 00:00:00 2001 From: Alex Jordan Date: Mon, 24 Oct 2022 08:53:34 -0700 Subject: [PATCH 030/490] disable spellchecking on username input field --- lib/WeBWorK/ContentGenerator/Login.pm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lib/WeBWorK/ContentGenerator/Login.pm b/lib/WeBWorK/ContentGenerator/Login.pm index 699ddd149a..68bbcf10ad 100644 --- a/lib/WeBWorK/ContentGenerator/Login.pm +++ b/lib/WeBWorK/ContentGenerator/Login.pm @@ -226,7 +226,8 @@ sub body { aria_required => 'true', class => 'form-control', placeholder => '', - autocapitalize => 'none' + autocapitalize => 'none', + spellcheck => 'false' }), CGI::label({ for => 'uname' }, $r->maketext('Username')) ); From 46c8ff33d5eebe2afc6fb2eb9297934b181a0241 Mon Sep 17 00:00:00 2001 From: Alex Jordan Date: Mon, 24 Oct 2022 08:54:17 -0700 Subject: [PATCH 031/490] undo spacing adjustment --- lib/WeBWorK/ContentGenerator/Login.pm | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/lib/WeBWorK/ContentGenerator/Login.pm b/lib/WeBWorK/ContentGenerator/Login.pm index 68bbcf10ad..c1e772c50b 100644 --- a/lib/WeBWorK/ContentGenerator/Login.pm +++ b/lib/WeBWorK/ContentGenerator/Login.pm @@ -234,12 +234,12 @@ sub body { print CGI::div( { class => 'form-floating mb-2' }, CGI::password_field({ - id => 'pswd', - name => 'passwd', - value => $passwd, - aria_required => 'true', - class => 'form-control', - placeholder => '' + id => 'pswd', + name => 'passwd', + value => $passwd, + aria_required => 'true', + class => 'form-control', + placeholder => '' }), CGI::label({ for => 'pswd' }, $r->maketext('Password')) ); From 7ea3ca782ccfdd38a9a6d8763635476146bd3951 Mon Sep 17 00:00:00 2001 From: Alex Jordan Date: Mon, 24 Oct 2022 10:54:20 -0700 Subject: [PATCH 032/490] disable autocapitalization and spellchecking from login proctor username field --- lib/WeBWorK/ContentGenerator/LoginProctor.pm | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/lib/WeBWorK/ContentGenerator/LoginProctor.pm b/lib/WeBWorK/ContentGenerator/LoginProctor.pm index 6c7fc8b119..883b02ed4c 100644 --- a/lib/WeBWorK/ContentGenerator/LoginProctor.pm +++ b/lib/WeBWorK/ContentGenerator/LoginProctor.pm @@ -228,11 +228,13 @@ sub body { print CGI::div( { class => 'col-xl-5 col-lg-6 col-md-7 col-sm-8 form-floating mb-2' }, CGI::textfield({ - name => 'proctor_user', - id => 'proctor_user', - value => '', - class => 'form-control', - placeholder => '' + name => 'proctor_user', + id => 'proctor_user', + value => '', + class => 'form-control', + placeholder => '', + autocapitalize => 'none', + spellcheck => 'false' }), CGI::label({ for => 'proctor_user' }, $r->maketext('Proctor Username')) ); From 0c06beb06d08428370b0e0a31b32c2e43b11e373 Mon Sep 17 00:00:00 2001 From: Glenn Rice Date: Fri, 21 Oct 2022 08:36:45 -0500 Subject: [PATCH 033/490] Do not UTF-8 encode email body text. The Email::Stuffer package tries to automatically detect if the body needs to be UTF-8 encoded (either that or it just does so by default), and so if you UTF-8 encode the message first, then Email::Stuffer does it again resulting in "Mojibake". This is #1817 for develop. --- lib/WeBWorK/ContentGenerator/Feedback.pm | 2 +- lib/WeBWorK/ContentGenerator/Instructor/SendMail.pm | 4 ++-- lib/WeBWorK/Utils/ProblemProcessing.pm | 3 +-- 3 files changed, 4 insertions(+), 5 deletions(-) diff --git a/lib/WeBWorK/ContentGenerator/Feedback.pm b/lib/WeBWorK/ContentGenerator/Feedback.pm index 759a6aaeed..0eb19743d6 100644 --- a/lib/WeBWorK/ContentGenerator/Feedback.pm +++ b/lib/WeBWorK/ContentGenerator/Feedback.pm @@ -215,7 +215,7 @@ $emailableURL } my $email = Email::Stuffer->to(join(',', @recipients))->from($sender)->subject($subject) - ->text_body(Encode::encode('UTF-8', $msg))->header('X-Remote-Host' => $remote_host); + ->text_body($msg)->header('X-Remote-Host' => $remote_host); # Extra headers $email->header('X-WeBWorK-Module', $module) if defined $module; diff --git a/lib/WeBWorK/ContentGenerator/Instructor/SendMail.pm b/lib/WeBWorK/ContentGenerator/Instructor/SendMail.pm index bafdf6f4c8..654a506a4b 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/SendMail.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/SendMail.pm @@ -970,7 +970,7 @@ sub mail_message_to_recipients { $error_messages .= "There were errors in processing user $recipient, merge file $merge_file. \n$@\n" if $@; my $email = Email::Stuffer->to($ur->email_address)->from($from)->subject($subject) - ->text_body(Encode::encode('UTF-8', $msg))->header('X-Remote-Host' => $self->{remote_host}); + ->text_body($msg)->header('X-Remote-Host' => $self->{remote_host}); # $ce->{mail}{set_return_path} is the address used to report returned email if defined and non empty. # It is an argument used in sendmail() (aka Email::Stuffer::send_or_die). @@ -1018,7 +1018,7 @@ sub email_notification { my $ce = $self->r->ce; my $email = Email::Stuffer->to($self->{defaultFrom})->from($self->{defaultFrom})->subject('WeBWorK email sent') - ->text_body(Encode::encode('UTF-8', $result_message))->header('X-Remote-Host' => $self->{remote_host}); + ->text_body($result_message)->header('X-Remote-Host' => $self->{remote_host}); try { $email->send_or_die({ diff --git a/lib/WeBWorK/Utils/ProblemProcessing.pm b/lib/WeBWorK/Utils/ProblemProcessing.pm index 1f162a7030..12043e7109 100644 --- a/lib/WeBWorK/Utils/ProblemProcessing.pm +++ b/lib/WeBWorK/Utils/ProblemProcessing.pm @@ -466,8 +466,7 @@ Recitation: $recitation Comment: $comment /; - my $email = Email::Stuffer->to(join(',', @recipients))->from($sender)->subject($subject) - ->text_body(Encode::encode('UTF-8', $msg)); + my $email = Email::Stuffer->to(join(',', @recipients))->from($sender)->subject($subject)->text_body($msg); # Extra headers $email->header('X-WeBWorK-Course: ', $courseID) if defined $courseID; From 4fad33412785922b5d295718a1f58bae83441775 Mon Sep 17 00:00:00 2001 From: Glenn Rice Date: Thu, 27 Oct 2022 19:11:57 -0500 Subject: [PATCH 034/490] Fix more issues with the gateway problem numbers. There were still cases where non-consecutively ordered gateway quizzes can cause errors. In fact any time that a gateway quiz does not have a problem number 1 in the set definition, you will get an error. In addition answer processing had issues that could cause errors. Basically, arrays storing problem data should generally not be accessed by the direct numerical index, but indirectly via the @probOrder array index. There are some exceptions to this. One exception is noted. Note that this also fixes an issue with randomly ordered gateway quizzes. The issue is perhaps minor, but the data stored in a column of the past_answers table was disjoint. The past_answers_string and scores did not match up with the problem_id and source_file. The source_file in that table is not used anywhere by webwork, but it still should match. The problem_id is used. In the past answers table, this mismatch leads to some rather unexpected results. If a student takes multiple versions of the quiz, and you view the answers for all versions for that student, the answers clearly look like they come from different problems. The same happens if you view answers for multiple students. One downside of this is that now the answers are not in the order that the problems appear for the student. They are in the order they appear in the set definition. That is consistent for all students and quiz versions though. --- lib/WeBWorK/ContentGenerator/GatewayQuiz.pm | 96 +++++++++++---------- 1 file changed, 51 insertions(+), 45 deletions(-) diff --git a/lib/WeBWorK/ContentGenerator/GatewayQuiz.pm b/lib/WeBWorK/ContentGenerator/GatewayQuiz.pm index 735e29b978..070548acef 100644 --- a/lib/WeBWorK/ContentGenerator/GatewayQuiz.pm +++ b/lib/WeBWorK/ContentGenerator/GatewayQuiz.pm @@ -736,7 +736,7 @@ sub pre_header_initialize { my $cleanSet = $db->getSetVersion($effectiveUserName, $setName, $setVersionNumber); $set = $db->getMergedSetVersion($effectiveUserName, $setName, $setVersionNumber); - $Problem = $db->getMergedProblemVersion($effectiveUserName, $setName, $setVersionNumber, 1); + $Problem = $db->getMergedProblemVersion($effectiveUserName, $setName, $setVersionNumber, $setPNum[0]); # because we're creating this on the fly, # it should be visible @@ -1575,22 +1575,24 @@ sub body { foreach my $i (0 .. $#problems) { # process each problem # this code is essentially that from Problem.pm # begin problem loop for sticky answers - my $pureProblem = $pureProblems[$i]; + my $pureProblem = $pureProblems[ $probOrder[$i] ]; + my $problem = $problems[ $probOrder[$i] ]; + my $pg_result = $pg_results[ $probOrder[$i] ]; # store answers in problem for sticky answers later # my %answersToStore; # we have to be a little careful about getting the # answers that we're saving, because we don't have - # a pg_results object for all problems if we're not + # a pg_result object for all problems if we're not # submitting my %answerHash = (); my @answer_order = (); my $encoded_last_answer_string; - if (ref($pg_results[$i])) { + if (ref($pg_result)) { my ($past_answers_string, $scores, $isEssay); #not used here ($past_answers_string, $encoded_last_answer_string, $scores, $isEssay) = - create_ans_str_from_responses($self, $pg_results[$i]); + create_ans_str_from_responses($self, $pg_result); } else { my $prefix = sprintf('Q%04d_', $problemNumbers[$i]); my @fields = sort grep {/^(?!previous).*$prefix/} (keys %{$self->{formFields}}); @@ -1599,49 +1601,50 @@ sub body { $encoded_last_answer_string = encodeAnswers(%answersToStore, @answer_order); } # and get the last answer - $problems[$i]->last_answer($encoded_last_answer_string); + $problem->last_answer($encoded_last_answer_string); $pureProblem->last_answer($encoded_last_answer_string); # Next, store the state in the database if answers are being recorded. if ($submitAnswers && $will{recordAnswers}) { - my $score = compute_reduced_score($ce, $problems[$i], $set, $pg_results[$i]{state}{recorded_score}); - $problems[$i]->status($score) if $score > $problems[$i]->status; + my $score = + compute_reduced_score($ce, $problem, $set, $pg_result->{state}{recorded_score}); + $problem->status($score) if $score > $problem->status; - $problems[$i]->sub_status($problems[$i]->status) + $problem->sub_status($problem->status) if (!$ce->{pg}{ansEvalDefaults}{enableReducedScoring} || !$set->enable_reduced_scoring || before($set->reduced_scoring_date)); - $problems[$i]->attempted(1); - $problems[$i]->num_correct($pg_results[$i]{state}{num_of_correct_ans}); - $problems[$i]->num_incorrect($pg_results[$i]{state}{num_of_incorrect_ans}); + $problem->attempted(1); + $problem->num_correct($pg_result->{state}{num_of_correct_ans}); + $problem->num_incorrect($pg_result->{state}{num_of_incorrect_ans}); - $pureProblem->status($problems[$i]->status); - $pureProblem->sub_status($problems[$i]->sub_status); + $pureProblem->status($problem->status); + $pureProblem->sub_status($problem->sub_status); $pureProblem->attempted(1); - $pureProblem->num_correct($pg_results[$i]{state}{num_of_correct_ans}); - $pureProblem->num_incorrect($pg_results[$i]{state}{num_of_incorrect_ans}); + $pureProblem->num_correct($pg_result->{state}{num_of_correct_ans}); + $pureProblem->num_incorrect($pg_result->{state}{num_of_incorrect_ans}); if ($db->putProblemVersion($pureProblem)) { - $scoreRecordedMessage[$i] = $r->maketext("Your score on this problem was recorded."); + $scoreRecordedMessage[ $probOrder[$i] ] = $r->maketext('Your score on this problem was recorded.'); } else { - $scoreRecordedMessage[$i] = $r->maketext("Your score was not recorded because there was a " . - "failure in storing the problem record to the database."); + $scoreRecordedMessage[ $probOrder[$i] ] = $r->maketext('Your score was not recorded because ' + . 'there was a failure in storing the problem record to the database.'); } # write the transaction log writeLog($self->{ce}, "transaction", - $problems[$i]->problem_id . "\t" . - $problems[$i]->set_id . "\t" . - $problems[$i]->user_id . "\t" . - $problems[$i]->source_file . "\t" . - $problems[$i]->value . "\t" . - $problems[$i]->max_attempts . "\t" . - $problems[$i]->problem_seed . "\t" . - $problems[$i]->status . "\t" . - $problems[$i]->attempted . "\t" . - $problems[$i]->last_answer . "\t" . - $problems[$i]->num_correct . "\t" . - $problems[$i]->num_incorrect + $problem->problem_id . "\t" . + $problem->set_id . "\t" . + $problem->user_id . "\t" . + $problem->source_file . "\t" . + $problem->value . "\t" . + $problem->max_attempts . "\t" . + $problem->problem_seed . "\t" . + $problem->status . "\t" . + $problem->attempted . "\t" . + $problem->last_answer . "\t" . + $problem->num_correct . "\t" . + $problem->num_incorrect ); } elsif ($submitAnswers) { # this is the case where we submitted answers @@ -1649,11 +1652,11 @@ sub body { # message if ($self->{isClosed}) { - $scoreRecordedMessage[$i] = $r->maketext("Your score was not recorded because this problem " . - "set version is not open."); - } elsif ($problems[$i]->num_correct + $problems[$i]->num_incorrect >= $set->attempts_per_version) { - $scoreRecordedMessage[$i] = $r->maketext("Your score was not recorded because you have no " . - "attempts remaining on this set version."); + $scoreRecordedMessage[ $probOrder[$i] ] = $r->maketext( + 'Your score was not recorded because this problem set version is not open.'); + } elsif ($problem->num_correct + $problem->num_incorrect >= $set->attempts_per_version) { + $scoreRecordedMessage[ $probOrder[$i] ] = $r->maketext( + 'Your score was not recorded because you have no attempts remaining on this set version.'); } elsif (! $self->{versionIsOpen}) { my $endTime = ($set->version_last_attempt_time) ? $set->version_last_attempt_time : $timeNow; if ($endTime > $set->due_date && $endTime < $set->due_date + $grace) { @@ -1663,11 +1666,11 @@ sub body { # we assume that allowed is an even # number of minutes my $allowed = ($set->due_date - $set->open_date)/60; - $scoreRecordedMessage[$i] = $r->maketext("Your score was not recorded because you have " . - "exceeded the time limit for this test. (Time taken: [_1] min; allowed: [_2] min.)", + $scoreRecordedMessage[ $probOrder[$i] ] = $r->maketext('Your score was not recorded because ' . + ' you have exceeded the time limit for this test. (Time taken: [_1] min; allowed: [_2] min.)', $elapsed, $allowed); } else { - $scoreRecordedMessage[$i] = $r->maketext("Your score was not recorded."); + $scoreRecordedMessage[ $probOrder[$i] ] = $r->maketext('Your score was not recorded.'); } } else { # finally, we must be previewing or switching @@ -1702,6 +1705,8 @@ sub body { # Begin problem loop for passed answers. next unless ref($pg_results[$probOrder[$i]]); + my $problem = $problems[ $probOrder[$i] ]; + my ($past_answers_string, $encoded_last_answer_string, $scores, $isEssay) = create_ans_str_from_responses($self, $pg_results[ $probOrder[$i] ]); $past_answers_string =~ s/\t+$/\t/; @@ -1712,19 +1717,19 @@ sub body { # Write to courseLog writeCourseLog($self->{ce}, "answer_log", - join("", '|', $problems[$i]->user_id, '|', $setVName, '|', ($i+1), '|', $scores, + join("", '|', $problem->user_id, '|', $setVName, '|', ($i+1), '|', $scores, "\t$timeNow\t", "$past_answers_string")); # Add to PastAnswer db my $pastAnswer = $db->newPastAnswer(); $pastAnswer->course_id($courseID); - $pastAnswer->user_id($problems[$i]->user_id); + $pastAnswer->user_id($problem->user_id); $pastAnswer->set_id($setVName); - $pastAnswer->problem_id($problems[$i]->problem_id); + $pastAnswer->problem_id($problem->problem_id); $pastAnswer->timestamp($timeNow); $pastAnswer->scores($scores); $pastAnswer->answer_string($past_answers_string); - $pastAnswer->source_file($problems[$i]->source_file); + $pastAnswer->source_file($problem->source_file); $db->addPastAnswer($pastAnswer); } } @@ -1737,8 +1742,8 @@ sub body { my $endTime = time(); if ($submitAnswers && $will{recordAnswers}) { foreach my $i (0 .. $#problems) { - my $problem = $problems[$i]; - my $pg = $pg_results[$i]; + my $problem = $problems[ $probOrder[$i] ]; + my $pg = $pg_results[ $probOrder[$i] ]; my $completed_question_event = { 'type' => 'AssessmentItemEvent', 'action' => 'Completed', @@ -1903,6 +1908,7 @@ sub body { # To get the attempt score, determine the score for each problem, and multiply the total for the problem by the # weight (value) of the problem. Avoid translating all of the problems when checking answers. + # Note that it is okay to ignore problem order here as all arrays used are index the same. my $attemptScore = 0; if ($will{recordAnswers} || $will{checkAnswers}) { my $i = 0; From 9ebdfd32deab2caf4945bfeb9780fc0d8a2b5cec Mon Sep 17 00:00:00 2001 From: Glenn Rice Date: Tue, 2 Aug 2022 12:32:19 -0500 Subject: [PATCH 035/490] On the grades page only hide scores for gateway sets. The code that checks to see if scores for a gateway quiz should be hidden on the grades page was not checking to see if the set was actually a gateway quiz. However, it is possible to make a homework set have hide_score set to 'Y'. To make this happen create a homework set, change it to a gateway/quiz, and then set it to not show scores on finished assignments and save. Then change the assignment type back to homework and save (only once). Note that if you click save one more time it will reset the hide_score value in the database back to NULL. If a student is assigned one of these homework sets and tries to view the grades page it causes an error. See https://webwork.maa.org/moodle/mod/forum/discuss.php?d=8092. --- lib/WeBWorK/ContentGenerator/Grades.pm | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lib/WeBWorK/ContentGenerator/Grades.pm b/lib/WeBWorK/ContentGenerator/Grades.pm index ceed131a67..6fe2676129 100644 --- a/lib/WeBWorK/ContentGenerator/Grades.pm +++ b/lib/WeBWorK/ContentGenerator/Grades.pm @@ -280,7 +280,9 @@ sub displayStudentStats { # If the set has hide_score set, then we need to skip printing the score as well. if ( - defined $set->hide_score + defined $set->assignment_type + && $set->assignment_type =~ /gateway/ + && defined $set->hide_score && ( !$authz->hasPermissions($r->param('user'), 'view_hidden_work') && ($set->hide_score eq 'Y' || ($set->hide_score eq 'BeforeAnswerDate' && time < $set->answer_date)) From e8f42fcc8f7ffbd170e671d610e3f63e324da88b Mon Sep 17 00:00:00 2001 From: Glenn Rice Date: Fri, 28 Oct 2022 06:17:33 -0500 Subject: [PATCH 036/490] Add a perltidy workflow for webwork2. The workflow is literally copied from the pg workflow. A `bin/dev_scripts/run-perltidy` is added for developer convenience. That script is also pretty much copied from pg. --- .github/workflows/linter.yml | 32 ++++++++++++++++++++++++++++++++ .perltidyrc | 1 + bin/dev_scripts/run-perltidy | 7 +++++++ 3 files changed, 40 insertions(+) create mode 100644 .github/workflows/linter.yml create mode 100755 bin/dev_scripts/run-perltidy diff --git a/.github/workflows/linter.yml b/.github/workflows/linter.yml new file mode 100644 index 0000000000..ca80925e14 --- /dev/null +++ b/.github/workflows/linter.yml @@ -0,0 +1,32 @@ +--- +name: Lint Code Base + +defaults: + run: + shell: bash + +on: + push: + branches-ignore: [main, develop] + pull_request: + branches: [main, develop] + +jobs: + perltidy: + name: Run perltidy on Perl Files + runs-on: ubuntu-latest + container: + image: perl:5.32 + steps: + - uses: actions/checkout@v3 + - name: perl -V + run: perl -V + - name: Install dependencies + run: cpanm -n Perl::Tidy@20220613 + - name: perltidy --version + run: perltidy --version + - name: Run perltidy + shell: bash + run: | + shopt -s extglob globstar nullglob + perltidy --pro=./.perltidyrc -b -bext='/' ./**/*.p[lm] ./**/*.t && git diff --exit-code diff --git a/.perltidyrc b/.perltidyrc index 8314b7c173..4620751c6f 100644 --- a/.perltidyrc +++ b/.perltidyrc @@ -20,3 +20,4 @@ -nlop # No logical padding (this causes mixed tabs and spaces) -wn # Weld nested containers -xci # Extended continuation indentation +-vxl='q' # No vertical alignment of qw quotes diff --git a/bin/dev_scripts/run-perltidy b/bin/dev_scripts/run-perltidy new file mode 100755 index 0000000000..c19377abee --- /dev/null +++ b/bin/dev_scripts/run-perltidy @@ -0,0 +1,7 @@ +#!/bin/bash + +SCRIPT_DIR="$(cd "$(dirname "${BASH_SOURCE[0]}")" > /dev/null 2>&1 && pwd)" +INPUTDIR=$(dirname $(dirname $SCRIPT_DIR)) + +shopt -s extglob globstar nullglob +perltidy --pro=$INPUTDIR/.perltidyrc -b -bext='/' $INPUTDIR/**/*.p[lm] $INPUTDIR/**/*.t From 2dd38ea5e3fd794073325509b0a3727f1e4beea4 Mon Sep 17 00:00:00 2001 From: Glenn Rice Date: Wed, 2 Nov 2022 12:04:17 -0500 Subject: [PATCH 037/490] Perltidy the code base. --- bin/Helper.pm | 10 +- bin/OPLUtils.pm | 323 +-- bin/check_database_charsets.pl | 12 +- bin/convert-functions.pl | 332 +-- bin/crypt_passwords_in_classlist.pl | 31 +- bin/dev_scripts/PODParser.pm | 8 +- bin/dev_scripts/PODtoHTML.pm | 57 +- bin/dev_scripts/generate-ww-pg-pod.pl | 12 +- bin/dump-OPL-tables.pl | 25 +- bin/generate-OPL-set-def-lists.pl | 2 +- bin/importClassList.pl | 33 +- bin/integrity_check.pl | 13 +- bin/load-OPL-global-statistics.pl | 43 +- bin/readURClassList.pl | 291 +-- bin/restore-OPL-tables.pl | 18 +- bin/test_library_build.pl | 24 +- bin/timing_log_check.pl | 176 +- bin/update-OPL-statistics.pl | 42 +- bin/updateOPLextras.pl | 29 +- bin/upgrade-database-to-utf8mb4.pl | 101 +- bin/upgrade_admin_db.pl | 24 +- bin/upload-OPL-statistics.pl | 150 +- .../hello_world_soap_client.pl | 14 +- .../hello_world_xmlrpc_client.pl | 26 +- .../hello_world_apps/webwork_soap_client.pl | 399 ++- .../hello_world_apps/webwork_xmlrpc_client.pl | 637 ++--- clients/sendXMLRPC.pl | 885 ++++--- clients/sendxmlrpc_bbedit.pl | 5 +- clients/uribase64_encode.pl | 2 +- .../setOrientation/parserOrientation.pl | 242 +- doc/parser/macros/Differentiation.pl | 4 +- doc/parser/macros/DifferentiationDefs.pl | 990 ++++---- doc/parser/macros/parserTables.pl | 117 +- doc/parser/macros/parserUtils.pl | 35 +- doc/parser/macros/unionImage.pl | 75 +- doc/parser/macros/unionTables.pl | 229 +- lib/Apache/AuthenWeBWorK.pm | 56 +- lib/Apache/WeBWorK.pm | 159 +- lib/Caliper/Actor.pm | 13 +- lib/Caliper/Entity.pm | 335 ++- lib/Caliper/Event.pm | 19 +- lib/Caliper/ResourceIri.pm | 60 +- lib/Caliper/Sensor.pm | 79 +- lib/FormatRenderedProblem.pm | 220 +- lib/MySOAP.pm | 105 +- lib/RQP.pm | 119 +- lib/WeBWorK.pm | 163 +- lib/WeBWorK/AchievementEvaluator.pm | 2 +- lib/WeBWorK/AchievementItems.pm | 1823 ++++++------- lib/WeBWorK/Authen.pm | 446 ++-- lib/WeBWorK/Authen/Basic_TheLastOption.pm | 2 - lib/WeBWorK/Authen/CAS.pm | 54 +- lib/WeBWorK/Authen/Cosign.pm | 67 +- lib/WeBWorK/Authen/LDAP.pm | 61 +- lib/WeBWorK/Authen/LTIAdvanced.pm | 1366 +++++----- lib/WeBWorK/Authen/LTIAdvanced/SubmitGrade.pm | 885 +++---- lib/WeBWorK/Authen/LTIBasic.pm | 751 +++--- lib/WeBWorK/Authen/Moodle.pm | 79 +- lib/WeBWorK/Authen/Proctor.pm | 72 +- lib/WeBWorK/Authen/Shibboleth.pm | 94 +- lib/WeBWorK/Authen/XMLRPC.pm | 21 +- lib/WeBWorK/Authz.pm | 220 +- lib/WeBWorK/CGI.pm | 4 +- lib/WeBWorK/Constants.pm | 2 +- lib/WeBWorK/ContentGenerator.pm | 748 +++--- lib/WeBWorK/ContentGenerator/Achievements.pm | 166 +- lib/WeBWorK/ContentGenerator/CourseAdmin.pm | 2260 +++++++++-------- .../ContentGenerator/EquationDisplay.pm | 40 +- lib/WeBWorK/ContentGenerator/Feedback.pm | 119 +- lib/WeBWorK/ContentGenerator/GatewayQuiz.pm | 951 +++---- lib/WeBWorK/ContentGenerator/Grades.pm | 8 +- lib/WeBWorK/ContentGenerator/Hardcopy.pm | 493 ++-- lib/WeBWorK/ContentGenerator/Home.pm | 20 +- lib/WeBWorK/ContentGenerator/Instructor.pm | 352 +-- .../Instructor/AchievementEditor.pm | 520 ++-- .../Instructor/AchievementList.pm | 692 ++--- .../Instructor/AchievementUserEditor.pm | 174 +- .../ContentGenerator/Instructor/AddUsers.pm | 69 +- .../ContentGenerator/Instructor/Assigner.pm | 44 +- .../Instructor/CodeMirrorEditor.pm | 5 +- .../ContentGenerator/Instructor/Config.pm | 339 ++- .../Instructor/FileManager.pm | 839 +++--- .../Instructor/PGProblemEditor.pm | 1158 +++++---- .../Instructor/ProblemGrader.pm | 7 +- .../Instructor/ProblemSetDetail.pm | 1532 +++++------ .../Instructor/ProblemSetList.pm | 1206 ++++----- .../ContentGenerator/Instructor/Scoring.pm | 602 ++--- .../Instructor/ScoringDownload.pm | 28 +- .../ContentGenerator/Instructor/SendMail.pm | 484 ++-- .../ContentGenerator/Instructor/SetMaker.pm | 784 +++--- .../Instructor/SetsAssignedToUser.pm | 41 +- .../Instructor/ShowAnswers.pm | 368 +-- .../Instructor/SingleProblemGrader.pm | 132 +- .../ContentGenerator/Instructor/Stats.pm | 23 +- .../Instructor/StudentProgress.pm | 106 +- .../ContentGenerator/Instructor/UserDetail.pm | 89 +- .../ContentGenerator/Instructor/UserList.pm | 641 ++--- .../Instructor/UsersAssignedToSet.pm | 4 +- lib/WeBWorK/ContentGenerator/Login.pm | 76 +- lib/WeBWorK/ContentGenerator/LoginProctor.pm | 8 +- lib/WeBWorK/ContentGenerator/Logout.pm | 102 +- lib/WeBWorK/ContentGenerator/Options.pm | 10 +- .../ContentGenerator/PGtoTexRenderer.pm | 20 +- lib/WeBWorK/ContentGenerator/Problem.pm | 946 +++---- .../ContentGenerator/ProblemRenderer.pm | 27 +- lib/WeBWorK/ContentGenerator/ProblemSet.pm | 277 +- lib/WeBWorK/ContentGenerator/ProblemSets.pm | 428 ++-- .../ContentGenerator/ProctoredGatewayQuiz.pm | 1 - lib/WeBWorK/ContentGenerator/Skeleton.pm | 76 +- lib/WeBWorK/ContentGenerator/Test.pm | 76 +- .../ContentGenerator/renderViaXMLRPC.pm | 109 +- lib/WeBWorK/CourseEnvironment.pm | 77 +- lib/WeBWorK/DB.pm | 704 +++-- lib/WeBWorK/Debug.pm | 8 +- lib/WeBWorK/FakeRequest.pm | 79 +- lib/WeBWorK/File/Classlist.pm | 22 +- lib/WeBWorK/File/Scoring.pm | 25 +- lib/WeBWorK/Form.pm | 46 +- lib/WeBWorK/HTML/DropdownList.pm | 110 +- lib/WeBWorK/HTML/OptionList.pm | 63 +- lib/WeBWorK/NPL.pm | 122 +- lib/WeBWorK/RPC.pm | 22 +- lib/WeBWorK/Request.pm | 20 +- lib/WeBWorK/Template.pm | 40 +- lib/WeBWorK/URLPath.pm | 409 +-- lib/WeBWorK/Upload.pm | 158 +- lib/WeBWorK/Utils.pm | 1037 ++++---- lib/WeBWorK/Utils/AttemptsTable.pm | 221 +- lib/WeBWorK/Utils/CourseIntegrityCheck.pm | 297 +-- lib/WeBWorK/Utils/CourseManagement.pm | 512 ++-- .../Utils/CourseManagement/sql_moodle.pm | 2 +- .../Utils/CourseManagement/sql_single.pm | 51 +- lib/WeBWorK/Utils/DBImportExport.pm | 95 +- lib/WeBWorK/Utils/DBUpgrade.pm | 363 +-- lib/WeBWorK/Utils/FilterRecords.pm | 81 +- lib/WeBWorK/Utils/FormatRecords.pm | 38 +- lib/WeBWorK/Utils/Grades.pm | 18 +- lib/WeBWorK/Utils/LanguageAndDirection.pm | 98 +- lib/WeBWorK/Utils/LibraryStats.pm | 140 +- lib/WeBWorK/Utils/ListingDB.pm | 416 ++- lib/WeBWorK/Utils/SortRecords.pm | 52 +- lib/WeBWorK/Utils/Tags.pm | 660 ++--- lib/WeBWorK/Utils/Tasks.pm | 79 +- lib/WebworkClient.pm | 560 ++-- lib/WebworkClient/body_text_format.pl | 2 +- lib/WebworkClient/json_format.pl | 58 +- lib/WebworkClient/tex_format.pl | 2 +- lib/WebworkSOAP.pm | 886 +++---- lib/WebworkSOAP/Classes/GlobalProblem.pm | 24 +- lib/WebworkSOAP/Classes/GlobalSet.pm | 44 +- lib/WebworkSOAP/Classes/Key.pm | 16 +- lib/WebworkSOAP/Classes/Password.pm | 15 +- lib/WebworkSOAP/Classes/Permission.pm | 15 +- lib/WebworkSOAP/Classes/User.pm | 28 +- lib/WebworkSOAP/Classes/UserProblem.pm | 38 +- lib/WebworkSOAP/Classes/UserSet.pm | 48 +- lib/WebworkSOAP/WSDL.pm | 38 +- lib/WebworkWebservice.pm | 525 ++-- lib/WebworkWebservice/CourseActions.pm | 516 ++-- lib/WebworkWebservice/LibraryActions.pm | 477 ++-- lib/WebworkWebservice/MathTranslators.pm | 213 +- lib/WebworkWebservice/ProblemActions.pm | 52 +- lib/WebworkWebservice/RenderProblem.pm | 270 +- lib/WebworkWebservice/SetActions.pm | 518 ++-- t/grab_course_environment.pl | 60 +- t/testAttemptsTable.pl | 354 ++- t/test_fileManager.pl | 43 +- t/test_formats.pl | 46 +- t/test_library.t | 94 +- 169 files changed, 21096 insertions(+), 19804 deletions(-) diff --git a/bin/Helper.pm b/bin/Helper.pm index 42ea0a38db..6411065f07 100644 --- a/bin/Helper.pm +++ b/bin/Helper.pm @@ -7,11 +7,11 @@ use base 'Exporter'; our @EXPORT_OK = 'runScript'; sub runScript { - my $script_path = shift; - unless ( do $script_path ) { - warn "Execution of $script_path failed:\n"; - die $@ if $@; - } + my $script_path = shift; + unless (do $script_path) { + warn "Execution of $script_path failed:\n"; + die $@ if $@; + } } 1; diff --git a/bin/OPLUtils.pm b/bin/OPLUtils.pm index e824487351..6d041abe5e 100644 --- a/bin/OPLUtils.pm +++ b/bin/OPLUtils.pm @@ -1,5 +1,4 @@ - package OPLUtils; use base qw(Exporter); @@ -20,96 +19,91 @@ use File::Basename; use open qw/:std :utf8/; use JSON; -our @EXPORT = (); -our @EXPORT_OK = qw(build_library_directory_tree build_library_subject_tree build_library_textbook_tree writeJSONtoFile); +our @EXPORT = (); +our @EXPORT_OK = + qw(build_library_directory_tree build_library_subject_tree build_library_textbook_tree writeJSONtoFile); ### Data for creating the database tables - my %OPLtables = ( - dbsubject => 'OPL_DBsubject', - dbchapter => 'OPL_DBchapter', - dbsection => 'OPL_DBsection', - author => 'OPL_author', - path => 'OPL_path', - pgfile => 'OPL_pgfile', - keyword => 'OPL_keyword', - pgfile_keyword => 'OPL_pgfile_keyword', - textbook => 'OPL_textbook', - chapter => 'OPL_chapter', - section => 'OPL_section', - problem => 'OPL_problem', - morelt => 'OPL_morelt', - pgfile_problem => 'OPL_pgfile_problem', + dbsubject => 'OPL_DBsubject', + dbchapter => 'OPL_DBchapter', + dbsection => 'OPL_DBsection', + author => 'OPL_author', + path => 'OPL_path', + pgfile => 'OPL_pgfile', + keyword => 'OPL_keyword', + pgfile_keyword => 'OPL_pgfile_keyword', + textbook => 'OPL_textbook', + chapter => 'OPL_chapter', + section => 'OPL_section', + problem => 'OPL_problem', + morelt => 'OPL_morelt', + pgfile_problem => 'OPL_pgfile_problem', ); - my %NPLtables = ( - dbsubject => 'NPL-DBsubject', - dbchapter => 'NPL-DBchapter', - dbsection => 'NPL-DBsection', - author => 'NPL-author', - path => 'NPL-path', - pgfile => 'NPL-pgfile', - keyword => 'NPL-keyword', - pgfile_keyword => 'NPL-pgfile-keyword', - textbook => 'NPL-textbook', - chapter => 'NPL-chapter', - section => 'NPL-section', - problem => 'NPL-problem', - morelt => 'NPL-morelt', - pgfile_problem => 'NPL-pgfile-problem', + dbsubject => 'NPL-DBsubject', + dbchapter => 'NPL-DBchapter', + dbsection => 'NPL-DBsection', + author => 'NPL-author', + path => 'NPL-path', + pgfile => 'NPL-pgfile', + keyword => 'NPL-keyword', + pgfile_keyword => 'NPL-pgfile-keyword', + textbook => 'NPL-textbook', + chapter => 'NPL-chapter', + section => 'NPL-section', + problem => 'NPL-problem', + morelt => 'NPL-morelt', + pgfile_problem => 'NPL-pgfile-problem', ); - - - - sub build_library_directory_tree { - my ($ce,$verbose) = @_; + my ($ce, $verbose) = @_; print "Creating the Directory Tree\n" if $verbose; my $libraryRoot = $ce->{problemLibrary}->{root}; $libraryRoot =~ s|/+$||; my @dirArray = (); - push(@dirArray,buildTree($libraryRoot)); + push(@dirArray, buildTree($libraryRoot)); my $webwork_htdocs = $ce->{webworkDirs}{htdocs}; - my $file = "$webwork_htdocs/DATA/library-directory-tree.json"; + my $file = "$webwork_htdocs/DATA/library-directory-tree.json"; - writeJSONtoFile(\@dirArray,$file); + writeJSONtoFile(\@dirArray, $file); print "Wrote Library Directory Tree to $file\n" if $verbose; } sub buildTree { my $absoluteDir = shift; - my $branch = {}; - my ($name,$dir) = fileparse($absoluteDir); + my $branch = {}; + my ($name, $dir) = fileparse($absoluteDir); $branch->{name} = $name; my @dirs = File::Find::Rule->maxdepth(1)->relative(1)->directory->in($absoluteDir); - if (scalar(@dirs)==0){ + if (scalar(@dirs) == 0) { return undef; } my @branches = (); - for my $dir (@dirs){ + for my $dir (@dirs) { my $theBranch = buildTree($absoluteDir . "/" . $dir); if ($theBranch) { my @files = File::Find::Rule->file()->name("*.pg")->in($absoluteDir . "/" . $dir); $theBranch->{num_files} = scalar(@files); - push(@branches,$theBranch) + push(@branches, $theBranch); } else { $b = {}; $b->{name} = $dir; my @files = File::Find::Rule->file()->name("*.pg")->in($absoluteDir . "/" . $dir); - if (scalar(@files)>0){ + if (scalar(@files) > 0) { $b->{num_files} = scalar(@files); - push(@branches,$b); + push(@branches, $b); } } } @@ -121,64 +115,64 @@ sub buildTree { return $branch; } - sub build_library_subject_tree { - my ($ce,$dbh,$verbose) = @_; + my ($ce, $dbh, $verbose) = @_; my $libraryRoot = $ce->{problemLibrary}->{root}; $libraryRoot =~ s|/+$||; my $libraryVersion = $ce->{problemLibrary}->{version}; - my %tables = ($libraryVersion eq '2.5')? %OPLtables : %NPLtables; + my %tables = ($libraryVersion eq '2.5') ? %OPLtables : %NPLtables; # query the database for all of the subject names - my $cmd = qq/select name from $tables{dbsubject};/; - my @subject_names = map { $_->[0]} $dbh->selectall_array($cmd); + my $cmd = qq/select name from $tables{dbsubject};/; + my @subject_names = map { $_->[0] } $dbh->selectall_array($cmd); - my $tree; # the library subject tree will be stored as arrays of objects. + my $tree; # the library subject tree will be stored as arrays of objects. print "Building the subject-tree. There are " . scalar(@subject_names) . " subjects\n" if $verbose; - my @subject_tree; # array to store the individual library tree for each subject + my @subject_tree; # array to store the individual library tree for each subject my $selectClause = ""; - for my $subj_name (@subject_names){ + for my $subj_name (@subject_names) { my $subj = $subj_name; - $subj =~ s/'/\'/g; # escape any single quotes; + $subj =~ s/'/\'/g; # escape any single quotes; - print "subject: $subj_name is being processed.\n" if $verbose; + print "subject: $subj_name is being processed.\n" if $verbose; - my $cmd = qq/SELECT ch.name from $tables{dbchapter} AS ch + my $cmd = qq/SELECT ch.name from $tables{dbchapter} AS ch JOIN $tables{dbsubject} AS subj ON ch.DBsubject_id=subj.DBsubject_id WHERE subj.name='$subj';/; my @chapter_names = map { $_->[0] } $dbh->selectall_array($cmd); - my @chapter_tree; # array to store the individual library tree for each chapter + my @chapter_tree; # array to store the individual library tree for each chapter - for my $ch_name (@chapter_names){ + for my $ch_name (@chapter_names) { my $ch = $ch_name; - $ch =~ s/'/\'/g; # escape any single quotes; + $ch =~ s/'/\'/g; # escape any single quotes; - my $results = $dbh->selectall_arrayref("SELECT sect.name from `$tables{dbsubject}` AS subj " - ."JOIN `$tables{dbchapter}` AS ch ON subj.DBsubject_id = ch.DBsubject_id " - ."JOIN `$tables{dbsection}` AS sect ON sect.DBchapter_id = ch.DBchapter_id " - ."WHERE subj.name='$subj' AND ch.name='$ch';"); + my $results = + $dbh->selectall_arrayref("SELECT sect.name from `$tables{dbsubject}` AS subj " + . "JOIN `$tables{dbchapter}` AS ch ON subj.DBsubject_id = ch.DBsubject_id " + . "JOIN `$tables{dbsection}` AS sect ON sect.DBchapter_id = ch.DBchapter_id " + . "WHERE subj.name='$subj' AND ch.name='$ch';"); - my @section_names = map { $_->[0]} @{$results}; + my @section_names = map { $_->[0] } @{$results}; my @subfields = (); - for my $sect_name (@section_names){ - my $section_tree = {name => $sect_name}; + for my $sect_name (@section_names) { + my $section_tree = { name => $sect_name }; ## Determine the number of files that falls into each my $sect = $sect_name; - $sect =~ s/'/\\'/g; # escape any single quotes + $sect =~ s/'/\\'/g; # escape any single quotes my $cmd = qq/SELECT COUNT(*) from $tables{dbsection} AS sect JOIN $tables{dbchapter} AS ch ON sect.DBchapter_id = ch.DBchapter_id @@ -187,12 +181,12 @@ sub build_library_subject_tree { where subj.name = '$subj' AND ch.name='$ch' AND sect.name='$sect';/; $section_tree->{num_files} = $dbh->selectrow_array($cmd); - my $clone = { %{ $section_tree } }; # need to clone it before pushing into the @subfield array. + my $clone = { %{$section_tree} }; # need to clone it before pushing into the @subfield array. - push(@subfields,$clone); + push(@subfields, $clone); } - my $chapter_tree = {name => $ch_name, subfields => \@subfields}; + my $chapter_tree = { name => $ch_name, subfields => \@subfields }; ## determine the number of files in each chapter @@ -205,11 +199,11 @@ sub build_library_subject_tree { $chapter_tree->{num_files} = $dbh->selectrow_array($cmd); - my $clone = { %{ $chapter_tree } }; # need to clone it before pushing into the @chapter_tree array. - push(@chapter_tree,$clone); + my $clone = { %{$chapter_tree} }; # need to clone it before pushing into the @chapter_tree array. + push(@chapter_tree, $clone); } - my $subject_tree = {name => $subj_name, subfields => \@chapter_tree}; + my $subject_tree = { name => $subj_name, subfields => \@chapter_tree }; ## find the number of files on the subject level @@ -222,127 +216,154 @@ sub build_library_subject_tree { $subject_tree->{num_files} = $dbh->selectrow_array($cmd); - my $clone = { % {$subject_tree}}; - push (@subject_tree, $clone); + my $clone = { %{$subject_tree} }; + push(@subject_tree, $clone); } my $webwork_htdocs = $ce->{webworkDirs}{htdocs}; - my $file = "$webwork_htdocs/DATA/library-subject-tree.json"; + my $file = "$webwork_htdocs/DATA/library-subject-tree.json"; - writeJSONtoFile(\@subject_tree,$file); + writeJSONtoFile(\@subject_tree, $file); print "Wrote Library Subject Tree to $file\n" if $verbose; } sub build_library_textbook_tree { - my ($ce,$dbh,$verbose) = @_; + my ($ce, $dbh, $verbose) = @_; my $libraryRoot = $ce->{problemLibrary}->{root}; $libraryRoot =~ s|/+$||; my $libraryVersion = $ce->{problemLibrary}->{version}; - my %tables = ($libraryVersion eq '2.5')? %OPLtables : %NPLtables; + my %tables = ($libraryVersion eq '2.5') ? %OPLtables : %NPLtables; - my $selectClause = "SELECT pg.pgfile_id from $tables{path} as path " - ."LEFT JOIN $tables{pgfile} AS pg ON pg.path_id=path.path_id " - ."LEFT JOIN $tables{pgfile_problem} AS pgprob ON pgprob.pgfile_id=pg.pgfile_id " - ."LEFT JOIN $tables{problem} AS prob ON prob.problem_id=pgprob.problem_id " - ."LEFT JOIN $tables{section} AS sect ON sect.section_id=prob.section_id " - ."LEFT JOIN $tables{chapter} AS ch ON ch.chapter_id=sect.chapter_id " - ."LEFT JOIN $tables{textbook} AS text ON text.textbook_id=ch.textbook_id "; + my $selectClause = + "SELECT pg.pgfile_id from $tables{path} as path " + . "LEFT JOIN $tables{pgfile} AS pg ON pg.path_id=path.path_id " + . "LEFT JOIN $tables{pgfile_problem} AS pgprob ON pgprob.pgfile_id=pg.pgfile_id " + . "LEFT JOIN $tables{problem} AS prob ON prob.problem_id=pgprob.problem_id " + . "LEFT JOIN $tables{section} AS sect ON sect.section_id=prob.section_id " + . "LEFT JOIN $tables{chapter} AS ch ON ch.chapter_id=sect.chapter_id " + . "LEFT JOIN $tables{textbook} AS text ON text.textbook_id=ch.textbook_id "; my $results = $dbh->selectall_arrayref("select * from `$tables{textbook}` ORDER BY title;"); - my @textbooks=map { {textbook_id=>$_->[0],title=>$_->[1],edition=>$_->[2], - author=>$_->[3],publisher=>$_->[4],isbn=>$_->[5],pubdate=>$_->[6]}} @{$results}; + my @textbooks = map { { + textbook_id => $_->[0], + title => $_->[1], + edition => $_->[2], + author => $_->[3], + publisher => $_->[4], + isbn => $_->[5], + pubdate => $_->[6] + } } @{$results}; my @output = (); - my $i =0; ## index to alert user the length of the build + my $i = 0; ## index to alert user the length of the build - print "Building the Textbook Library Tree\n" if $verbose; - print "There are ". $#textbooks ." textbooks to process.\n" if $verbose; + print "Building the Textbook Library Tree\n" if $verbose; + print "There are " . $#textbooks . " textbooks to process.\n" if $verbose; - for my $textbook (@textbooks){ + for my $textbook (@textbooks) { $i++; - printf("%4d",$i) if $verbose; - print("\n") if ($i % 10==0 && $verbose); + printf("%4d", $i) if $verbose; + print("\n") if ($i % 10 == 0 && $verbose); - my $results = $dbh->selectall_arrayref("select ch.chapter_id,ch.name,ch.number " - . " from `$tables{chapter}` AS ch JOIN `$tables{textbook}` AS text ON ch.textbook_id=text.textbook_id " - . " WHERE text.textbook_id='" . $textbook->{textbook_id} . "' ORDER BY ch.number;"); + my $results = + $dbh->selectall_arrayref("select ch.chapter_id,ch.name,ch.number " + . " from `$tables{chapter}` AS ch JOIN `$tables{textbook}` AS text ON ch.textbook_id=text.textbook_id " + . " WHERE text.textbook_id='" + . $textbook->{textbook_id} + . "' ORDER BY ch.number;"); - my @chapters=map { {chapter_id=>$_->[0],name=>$_->[1],number=>$_->[2]}} @{$results}; + my @chapters = map { { chapter_id => $_->[0], name => $_->[1], number => $_->[2] } } @{$results}; my @chs = (); - for my $chapter (@chapters){ - - my $results = $dbh->selectall_arrayref("select sect.section_id,sect.name,sect.number " - . "FROM `$tables{chapter}` AS ch " - . "LEFT JOIN `$tables{textbook}` AS text ON ch.textbook_id=text.textbook_id " - . "LEFT JOIN `$tables{section}` AS sect ON sect.chapter_id = ch.chapter_id " - . "WHERE text.textbook_id='" .$textbook->{textbook_id}. "' AND " - . "ch.chapter_id='".$chapter->{chapter_id}."' ORDER BY sect.number;"); - - - my @sections = map { {section_id=>$_->[0],name=>$_->[1],number=>$_->[2]}} @{$results}; - - for my $section (@sections){ - - my $whereClause ="WHERE sect.section_id='". $section->{section_id} - ."' AND ch.chapter_id='". $chapter->{chapter_id}."' AND " - ."text.textbook_id='".$textbook->{textbook_id}."'"; - - my $sth = $dbh->prepare($selectClause.$whereClause); + for my $chapter (@chapters) { + + my $results = + $dbh->selectall_arrayref("select sect.section_id,sect.name,sect.number " + . "FROM `$tables{chapter}` AS ch " + . "LEFT JOIN `$tables{textbook}` AS text ON ch.textbook_id=text.textbook_id " + . "LEFT JOIN `$tables{section}` AS sect ON sect.chapter_id = ch.chapter_id " + . "WHERE text.textbook_id='" + . $textbook->{textbook_id} + . "' AND " + . "ch.chapter_id='" + . $chapter->{chapter_id} + . "' ORDER BY sect.number;"); + + my @sections = map { { section_id => $_->[0], name => $_->[1], number => $_->[2] } } @{$results}; + + for my $section (@sections) { + + my $whereClause = + "WHERE sect.section_id='" + . $section->{section_id} + . "' AND ch.chapter_id='" + . $chapter->{chapter_id} + . "' AND " + . "text.textbook_id='" + . $textbook->{textbook_id} . "'"; + + my $sth = $dbh->prepare($selectClause . $whereClause); $sth->execute; - $section->{num_probs}=scalar @{$sth->fetchall_arrayref()}; + $section->{num_probs} = scalar @{ $sth->fetchall_arrayref() }; } - my $whereClause ="WHERE ch.chapter_id='". $chapter->{chapter_id}."' AND " - ."text.textbook_id='".$textbook->{textbook_id}."'"; - - my $sth = $dbh->prepare($selectClause.$whereClause); + my $whereClause = + "WHERE ch.chapter_id='" + . $chapter->{chapter_id} + . "' AND " + . "text.textbook_id='" + . $textbook->{textbook_id} . "'"; + + my $sth = $dbh->prepare($selectClause . $whereClause); $sth->execute; - $chapter->{num_probs}=scalar @{$sth->fetchall_arrayref()}; + $chapter->{num_probs} = scalar @{ $sth->fetchall_arrayref() }; - $chapter->{sections}=\@sections; + $chapter->{sections} = \@sections; - my @sects = map {{ - name=>$_->{name}, - section_id => $_->{section_id}, - num_files=>$_->{num_probs} - }} @sections; + my @sects = + map { { name => $_->{name}, section_id => $_->{section_id}, num_files => $_->{num_probs} } } @sections; - push(@chs,{ - name=>$chapter->{name}, - chapter_id => $chapter->{chapter_id}, - num_files=>$chapter->{num_probs}, - subfields=>\@sects - }); + push( + @chs, + { + name => $chapter->{name}, + chapter_id => $chapter->{chapter_id}, + num_files => $chapter->{num_probs}, + subfields => \@sects + } + ); } - my $whereClause ="WHERE text.textbook_id='".$textbook->{textbook_id}."'"; + my $whereClause = "WHERE text.textbook_id='" . $textbook->{textbook_id} . "'"; - my $sth = $dbh->prepare($selectClause.$whereClause); + my $sth = $dbh->prepare($selectClause . $whereClause); $sth->execute; - $textbook->{num_probs}=scalar @{$sth->fetchall_arrayref()}; + $textbook->{num_probs} = scalar @{ $sth->fetchall_arrayref() }; - $textbook->{chapters}=\@chapters; + $textbook->{chapters} = \@chapters; - push(@output,{ - name=>$textbook->{title}. " - " . $textbook->{author}, - textbook_id => $textbook->{textbook_id}, - subfields=>\@chs, - num_files=>$sth->rows - }); + push( + @output, + { + name => $textbook->{title} . " - " . $textbook->{author}, + textbook_id => $textbook->{textbook_id}, + subfields => \@chs, + num_files => $sth->rows + } + ); } print "\n"; my $webwork_htdocs = $ce->{webworkDirs}{htdocs}; - my $file = "$webwork_htdocs/DATA/textbook-tree.json"; + my $file = "$webwork_htdocs/DATA/textbook-tree.json"; - writeJSONtoFile(\@output,$file); + writeJSONtoFile(\@output, $file); print "\n\nWrote Library Textbook Tree to $file\n" if $verbose; @@ -350,7 +371,7 @@ sub build_library_textbook_tree { # this takes a hash created in the other subroutines and write the result to a file sub writeJSONtoFile { - my ($data,$filename) = @_; + my ($data, $filename) = @_; my $json = JSON->new->utf8->encode($data); open my $fh, ">", $filename or die "Cannot open $filename"; diff --git a/bin/check_database_charsets.pl b/bin/check_database_charsets.pl index c6e0f8eeef..a7eb6b7cb8 100755 --- a/bin/check_database_charsets.pl +++ b/bin/check_database_charsets.pl @@ -1,10 +1,10 @@ #!/usr/bin/perl -w -my $host = $ENV{WEBWORK_DB_HOST}; -my $port = $ENV{WEBWORK_DB_PORT}; -my $database_name = $ENV{WEBWORK_DB_NAME}; -my $database_user = $ENV{WEBWORK_DB_USER}; +my $host = $ENV{WEBWORK_DB_HOST}; +my $port = $ENV{WEBWORK_DB_PORT}; +my $database_name = $ENV{WEBWORK_DB_NAME}; +my $database_user = $ENV{WEBWORK_DB_USER}; my $database_password = $ENV{WEBWORK_DB_PASSWORD}; - -print `mysql -u $database_user -p$database_password $database_name -h $host -e "SHOW VARIABLES WHERE Variable_name LIKE \'character\_set\_%\' OR Variable_name LIKE \'collation%\' or Variable_name LIKE \'init_connect\' "`; \ No newline at end of file +print + `mysql -u $database_user -p$database_password $database_name -h $host -e "SHOW VARIABLES WHERE Variable_name LIKE \'character\_set\_%\' OR Variable_name LIKE \'collation%\' or Variable_name LIKE \'init_connect\' "`; diff --git a/bin/convert-functions.pl b/bin/convert-functions.pl index f2ad857525..7bb33d5b1e 100755 --- a/bin/convert-functions.pl +++ b/bin/convert-functions.pl @@ -37,102 +37,110 @@ # %function = ( - std_num_cmp => ['num_cmp',[undef,'relTol','format','zeroLevel','zeroLevelTol']], - std_num_cmp_abs => ['num_cmp',[undef,'tol','format'],{tolType=>'absolute'}], - std_num_cmp_list => ['num_cmp',['relTol','format','@']], - std_num_cmp_abs_list => ['num_cmp',['tol','format','@'],{tolType=>'absolute'}], + std_num_cmp => [ 'num_cmp', [ undef, 'relTol', 'format', 'zeroLevel', 'zeroLevelTol' ] ], + std_num_cmp_abs => [ 'num_cmp', [ undef, 'tol', 'format' ], { tolType => 'absolute' } ], + std_num_cmp_list => [ 'num_cmp', [ 'relTol', 'format', '@' ] ], + std_num_cmp_abs_list => [ 'num_cmp', [ 'tol', 'format', '@' ], { tolType => 'absolute' } ], - arith_num_cmp => ['num_cmp',[undef,'relTol','format','zeroLevel','zeroLevelTol'],{mode=>'arith'}], - arith_num_cmp_abs => ['num_cmp',[undef,'tol','format'],{mode=>'arith',tolType=>'absolute'}], - arith_num_cmp_list => ['num_cmp',['relTol','format','@'],{mode=>'arith'}], - arith_num_cmp_abs_list => ['num_cmp',['tol','format','@'],{mode=>'arith',tolType=>'absolute'}], + arith_num_cmp => [ 'num_cmp', [ undef, 'relTol', 'format', 'zeroLevel', 'zeroLevelTol' ], { mode => 'arith' } ], + arith_num_cmp_abs => [ 'num_cmp', [ undef, 'tol', 'format' ], { mode => 'arith', tolType => 'absolute' } ], + arith_num_cmp_list => [ 'num_cmp', [ 'relTol', 'format', '@' ], { mode => 'arith' } ], + arith_num_cmp_abs_list => [ 'num_cmp', [ 'tol', 'format', '@' ], { mode => 'arith', tolType => 'absolute' } ], - strict_num_cmp => ['num_cmp',[undef,'relTol','format','zeroLevel','zeroLevelTol'],{mode=>'strict'}], - strict_num_cmp_abs => ['num_cmp',[undef,'tol','format'],{mode=>'strict',tolType=>'absolute'}], - strict_num_cmp_list => ['num_cmp',['relTol','format','@'],{mode=>'strict'}], - strict_num_cmp_abs_list => ['num_cmp',['tol','format','@'],{mode=>'strict',tolType=>'absolute'}], + strict_num_cmp => + [ 'num_cmp', [ undef, 'relTol', 'format', 'zeroLevel', 'zeroLevelTol' ], { mode => 'strict' } ], + strict_num_cmp_abs => [ 'num_cmp', [ undef, 'tol', 'format' ], { mode => 'strict', tolType => 'absolute' } ], + strict_num_cmp_list => [ 'num_cmp', [ 'relTol', 'format', '@' ], { mode => 'strict' } ], + strict_num_cmp_abs_list => [ 'num_cmp', [ 'tol', 'format', '@' ], { mode => 'strict', tolType => 'absolute' } ], - frac_num_cmp => ['num_cmp',[undef,'relTol','format','zeroLevel','zeroLevelTol'],{mode=>'frac'}], - frac_num_cmp_abs => ['num_cmp',[undef,'tol','format'],{mode=>'frac',tolType=>'absolute'}], - frac_num_cmp_list => ['num_cmp',['relTol','format','@'],{mode=>'frac'}], - frac_num_cmp_abs_list => ['num_cmp',['tol','format','@'],{mode=>'frac',tolType=>'absolute'}], + frac_num_cmp => [ 'num_cmp', [ undef, 'relTol', 'format', 'zeroLevel', 'zeroLevelTol' ], { mode => 'frac' } ], + frac_num_cmp_abs => [ 'num_cmp', [ undef, 'tol', 'format' ], { mode => 'frac', tolType => 'absolute' } ], + frac_num_cmp_list => [ 'num_cmp', [ 'relTol', 'format', '@' ], { mode => 'frac' } ], + frac_num_cmp_abs_list => [ 'num_cmp', [ 'tol', 'format', '@' ], { mode => 'frac', tolType => 'absolute' } ], - std_num_str_cmp => - ['num_cmp',[undef,'strings','relTol','format','zeroLevel','zeroLevelTol']], + std_num_str_cmp => [ 'num_cmp', [ undef, 'strings', 'relTol', 'format', 'zeroLevel', 'zeroLevelTol' ] ], - function_cmp => - ['fun_cmp',[undef,'vars','limits[0]','limits[1]','relTol','numPoints','zeroLevel','zeroLevelTol']], + function_cmp => + [ 'fun_cmp', [ undef, 'vars', 'limits[0]', 'limits[1]', 'relTol', 'numPoints', 'zeroLevel', 'zeroLevelTol' ] ], - function_cmp_up_to_constant => - ['fun_cmp',[undef,'vars','limits[0]','limits[1]','relTol','numPoints','maxConstantOfIntegration', - 'zeroLevel','zeroLevelTol'],{mode=>'antider'}], + function_cmp_up_to_constant => [ + 'fun_cmp', + [ + undef, 'vars', 'limits[0]', 'limits[1]', + 'relTol', 'numPoints', 'maxConstantOfIntegration', 'zeroLevel', + 'zeroLevelTol' + ], + { mode => 'antider' } + ], - function_cmp_abs => - [fun_cmp,[undef,'vars','limits[0]','limits[1]','tol','numPoints'],{tolType=>'absolute'}], + function_cmp_abs => + [ fun_cmp, [ undef, 'vars', 'limits[0]', 'limits[1]', 'tol', 'numPoints' ], { tolType => 'absolute' } ], - function_cmp_up_to_constant_abs => - [fun_cmp,[undef,'vars','limits[0]','limits[1]','tol','numPoints','maxConstantOfIntegration'], - {mode=>'antider',tolType=>'absolute'}], + function_cmp_up_to_constant_abs => [ + fun_cmp, + [ undef, 'vars', 'limits[0]', 'limits[1]', 'tol', 'numPoints', 'maxConstantOfIntegration' ], + { mode => 'antider', tolType => 'absolute' } + ], + + multivar_function_cmp => [ 'fun_cmp', [ undef, 'vars' ] ], + + std_str_cmp => [ 'str_cmp', [] ], + std_str_cmp_list => [ 'str_cmp', ['@'] ], + std_cs_str_cmp => [ 'str_cmp', [], { filters => [ 'trim_whitespace', 'compress_whitespace' ] } ], + std_cs_str_cmp_list => [ 'str_cmp', ['@'], { filters => [ 'trim_whitespace', 'compress_whitespace' ] } ], + strict_str_cmp => [ 'str_cmp', [], { filters => ['trim_whitespace'] } ], + strict_str_cmp_list => [ 'str_cmp', ['@'], { filters => ['trim_whitespace'] } ], + unordered_str_cmp => [ 'str_cmp', [], { filters => [ 'remove_whitespace', 'ignore_order', 'ignore_case' ] } ], + unordered_str_cmp_list => + [ 'str_cmp', ['@'], { filters => [ 'remove_whitespace', 'ignore_order', 'ignore_case' ] } ], + unordered_cs_str_cmp => [ 'str_cmp', [], { filters => [ 'remove_whitespace', 'ignore_order' ] } ], + unordered_cs_str_cmp_list => [ 'str_cmp', ['@'], { filters => [ 'remove_whitespace', 'ignore_order' ] } ], + ordered_str_cmp => [ 'str_cmp', [], { filters => [ 'remove_whitespace', 'ignore_case' ] } ], + ordered_str_cmp_list => [ 'str_cmp', ['@'], { filters => [ 'remove_whitespace', 'ignore_case' ] } ], + ordered_cs_str_cmp => [ 'str_cmp', [], { filters => ['remove_whitespace'] } ], + ordered_cs_str_cmp_list => [ 'str_cmp', ['@'], { filters => ['remove_whitespace'] } ], - multivar_function_cmp => ['fun_cmp',[undef,'vars']], - - std_str_cmp => ['str_cmp',[]], - std_str_cmp_list => ['str_cmp',['@']], - std_cs_str_cmp => ['str_cmp',[],{filters=>['trim_whitespace','compress_whitespace']}], - std_cs_str_cmp_list => ['str_cmp',['@'],{filters=>['trim_whitespace','compress_whitespace']}], - strict_str_cmp => ['str_cmp',[],{filters=>['trim_whitespace']}], - strict_str_cmp_list => ['str_cmp',['@'],{filters=>['trim_whitespace']}], - unordered_str_cmp => ['str_cmp',[],{filters=>['remove_whitespace','ignore_order','ignore_case']}], - unordered_str_cmp_list => ['str_cmp',['@'],{filters=>['remove_whitespace','ignore_order','ignore_case']}], - unordered_cs_str_cmp => ['str_cmp',[],{filters=>['remove_whitespace','ignore_order']}], - unordered_cs_str_cmp_list => ['str_cmp',['@'],{filters=>['remove_whitespace','ignore_order']}], - ordered_str_cmp => ['str_cmp',[],{filters=>['remove_whitespace','ignore_case']}], - ordered_str_cmp_list => ['str_cmp',['@'],{filters=>['remove_whitespace','ignore_case']}], - ordered_cs_str_cmp => ['str_cmp',[],{filters=>['remove_whitespace']}], - ordered_cs_str_cmp_list => ['str_cmp',['@'],{filters=>['remove_whitespace']}], - ); #numerical_compare_with_units() needs to be handled by hand -- but there are very few uses. -$default{limits} = ['$funcLLimitDefault','$funcULimitDefault']; +$default{limits} = [ '$funcLLimitDefault', '$funcULimitDefault' ]; # -# Make a patter from all the names (we sort be length of the names, to +# Make a patter from all the names (we sort be length of the names, to # make sure prefixes appear later in the list). # -$pattern = join("|",sort byName keys(%function)); +$pattern = join("|", sort byName keys(%function)); sub byName { - return $a <=> $b if length($a) == length($b); - return length($b) <=> length($a); + return $a <=> $b if length($a) == length($b); + return length($b) <=> length($a); } # # Remove leading and trailing spaces # sub trim { - my $s = shift; - $s =~ s/(^\s+|\s+$)//g; - return $s; + my $s = shift; + $s =~ s/(^\s+|\s+$)//g; + return $s; } # # Remove leading comment lines # sub trimComments { - my $s = shift; - $s =~ s/^(\s*#.*?(\n|$))*//; - return $s; + my $s = shift; + $s =~ s/^(\s*#.*?(\n|$))*//; + return $s; } - # # Command-line options and internal state parameters # -$testing = 0; # true if not writing output files -$quiet = 0; # true if not printing changed function calls -$changed = 0; # true if we have changes a function in the current file +$testing = 0; # true if not writing output files +$quiet = 0; # true if not printing changed function calls +$changed = 0; # true if we have changes a function in the current file # # Read the contents of a file, and search through it for the functions @@ -140,39 +148,43 @@ sub trimComments { # direct parameter lists. # sub Process { - my @lines; - if ($file eq "-") { - @lines = <>; - open(PGFILE,">&STDOUT"); # redirect this to STDOUT - } elsif ($file eq "--test" || $file eq "-t") { - $testing = 1; return; - } elsif ($file eq "--quiet" || $file eq "-q") { - $quiet = 1; return; - } else { - print stderr "\n" if $changed; - print stderr "Converting: $file\n"; - open(PGFILE,$file) || warn "Can't read '$file': $!"; - @lines = ; close(PGFILE); - open(PGFILE,$testing? ">/dev/null": ">$file"); - } - $changed = 0; + my @lines; + if ($file eq "-") { + @lines = <>; + open(PGFILE, ">&STDOUT"); # redirect this to STDOUT + } elsif ($file eq "--test" || $file eq "-t") { + $testing = 1; + return; + } elsif ($file eq "--quiet" || $file eq "-q") { + $quiet = 1; + return; + } else { + print stderr "\n" if $changed; + print stderr "Converting: $file\n"; + open(PGFILE, $file) || warn "Can't read '$file': $!"; + @lines = ; + close(PGFILE); + open(PGFILE, $testing ? ">/dev/null" : ">$file"); + } + $changed = 0; - my $file = join("",@lines); - $file =~ s/\&beginproblem(\(\))?/beginproblem()/gm; # remove unneeded ampersands - $file =~ s/\&ANS\(/ANS\(/gm; # remove unneeded ampersands - $file =~ s/ANS\( */ANS\(/gm; # remove unneeded spaces - my @parts = split(/($pattern)/o,$file); -# -# Because of the parentheses around the pattern above, split returns the pattern -# as well as the stuff it separates. So @parts contains stuff, first function, -# args and more stuff, next function, etc. -# - print PGFILE shift(@parts); - while (my $f = shift(@parts)) { - my ($args,$rest) = GetArgs(shift(@parts)); - unless ($args) {print $f,$rest; next}; # skip it if doesn't look like an actual call - print PGFILE HandleFunction($f,$function{$f},$args),$rest; - } + my $file = join("", @lines); + $file =~ s/\&beginproblem(\(\))?/beginproblem()/gm; # remove unneeded ampersands + $file =~ s/\&ANS\(/ANS\(/gm; # remove unneeded ampersands + $file =~ s/ANS\( */ANS\(/gm; # remove unneeded spaces + my @parts = split(/($pattern)/o, $file); + # + # Because of the parentheses around the pattern above, split returns the pattern + # as well as the stuff it separates. So @parts contains stuff, first function, + # args and more stuff, next function, etc. + # + print PGFILE shift(@parts); + while (my $f = shift(@parts)) { + my ($args, $rest) = GetArgs(shift(@parts)); + unless ($args) { print $f, $rest; next } + ; # skip it if doesn't look like an actual call + print PGFILE HandleFunction($f, $function{$f}, $args), $rest; + } } # @@ -183,51 +195,56 @@ sub Process { # Return the modified function call with the new name and hash # sub HandleFunction { - my $original = shift; my $f = shift; my $args = shift; - my @names = @{$f->[1]}; my @args = @{$args}; - my ($name,$value); - # - # Get the fixed options needed for this function - # - my %options = %{$f->[2] || {}}; - foreach my $id (keys(%options)) { - if (ref($options{$id}) eq 'ARRAY') { - $options{$id} = '["'.join('","',@{$options{$id}}).'"]'; - } else { - $options{$id} = '"'.$options{$id}.'"'; - } - } - # - # Process the list of arguments supplied by the user - # (treating special cases properly) - # - my @options = (); my @params = (); - while (my ($name,$value) = (shift(@names),shift(@args))) { - last unless defined $value; - unless ($name) {push(@params,$value); next} - if ($name eq '@') {push(@params,'['.join(',',$value,@args).']'); @args = (); last} - if ($name =~ s/\[(\d+)\]$//) { - $options{$name} = $default{$name} unless defined $options{$name}; - $options{$name}[$1] = $value; next; - } - $options{$name} = $value unless $value eq '""' || $value eq "''"; - } - # - # Add the hash values to the new argument list - # - while (($name,$value) = each %options) { - $value = '['.join(',',@{$options{$name}}).']' if ref($value) eq 'ARRAY'; - push(@options,"$name=>$value"); - } - # - # Create the new function and display it - # - my $F = $f->[0].'('.join(', ',@params,@options,@args).')'; - unless ($quiet) { - print stderr " $original(",join(',',@{$args}),") -> $F\n"; - $changed = 1; - } - return $F; + my $original = shift; + my $f = shift; + my $args = shift; + my @names = @{ $f->[1] }; + my @args = @{$args}; + my ($name, $value); + # + # Get the fixed options needed for this function + # + my %options = %{ $f->[2] || {} }; + foreach my $id (keys(%options)) { + if (ref($options{$id}) eq 'ARRAY') { + $options{$id} = '["' . join('","', @{ $options{$id} }) . '"]'; + } else { + $options{$id} = '"' . $options{$id} . '"'; + } + } + # + # Process the list of arguments supplied by the user + # (treating special cases properly) + # + my @options = (); + my @params = (); + while (my ($name, $value) = (shift(@names), shift(@args))) { + last unless defined $value; + unless ($name) { push(@params, $value); next } + if ($name eq '@') { push(@params, '[' . join(',', $value, @args) . ']'); @args = (); last } + if ($name =~ s/\[(\d+)\]$//) { + $options{$name} = $default{$name} unless defined $options{$name}; + $options{$name}[$1] = $value; + next; + } + $options{$name} = $value unless $value eq '""' || $value eq "''"; + } + # + # Add the hash values to the new argument list + # + while (($name, $value) = each %options) { + $value = '[' . join(',', @{ $options{$name} }) . ']' if ref($value) eq 'ARRAY'; + push(@options, "$name=>$value"); + } + # + # Create the new function and display it + # + my $F = $f->[0] . '(' . join(', ', @params, @options, @args) . ')'; + unless ($quiet) { + print stderr " $original(", join(',', @{$args}), ") -> $F\n"; + $changed = 1; + } + return $F; } # @@ -236,27 +253,32 @@ sub HandleFunction { # nested within a multi-line function call. # sub GetArgs { - my $text = shift; - my @args = (); my $parenCount = 0; my $arg = ""; - return (undef,$text) unless $text =~ s/^\s*\(//; # remove leading spaces and opening paren - $text = trimComments($text); - while ($text =~ s/^((?:"(?:\\.|[^\"])*"|'(?:\\.|[^\'])*'|\\.|[^\\])*?)([(){}\[\],\n])//) { - if ($2 eq '(' || $2 eq '[' || $2 eq '{') {$parenCount++; $arg .= $1.$2; next} - if ($2 eq ')' && $parenCount == 0) {$arg .= $1; push(@args,trim($arg)); last} - if ($2 eq ')' || $2 eq ']' || $2 eq '}') {$parenCount--; $arg .= $1.$2; next} - if ($2 eq "\n") {$arg .= $1; $text = trimComments($text); next} - if ($parenCount == 0) { - push(@args,trim($arg.$1)); $arg = ""; - $text = trimComments($text); - } else {$arg .= $1.$2} - } - $text =~ s/^ +//; # remove unneeded leading spaces - return(\@args,$text); + my $text = shift; + my @args = (); + my $parenCount = 0; + my $arg = ""; + return (undef, $text) unless $text =~ s/^\s*\(//; # remove leading spaces and opening paren + $text = trimComments($text); + while ($text =~ s/^((?:"(?:\\.|[^\"])*"|'(?:\\.|[^\'])*'|\\.|[^\\])*?)([(){}\[\],\n])//) { + if ($2 eq '(' || $2 eq '[' || $2 eq '{') { $parenCount++; $arg .= $1 . $2; next } + if ($2 eq ')' && $parenCount == 0) { $arg .= $1; push(@args, trim($arg)); last } + if ($2 eq ')' || $2 eq ']' || $2 eq '}') { $parenCount--; $arg .= $1 . $2; next } + if ($2 eq "\n") { $arg .= $1; $text = trimComments($text); next } + if ($parenCount == 0) { + push(@args, trim($arg . $1)); + $arg = ""; + $text = trimComments($text); + } else { + $arg .= $1 . $2; + } + } + $text =~ s/^ +//; # remove unneeded leading spaces + return (\@args, $text); } # # Process each file # -push(@ARGV,"-") if (scalar(@ARGV) == 0); -foreach $file (@ARGV) {print Process($file)} +push(@ARGV, "-") if (scalar(@ARGV) == 0); +foreach $file (@ARGV) { print Process($file) } print stderr "\n"; diff --git a/bin/crypt_passwords_in_classlist.pl b/bin/crypt_passwords_in_classlist.pl index cb459868f3..c88bc6bc97 100755 --- a/bin/crypt_passwords_in_classlist.pl +++ b/bin/crypt_passwords_in_classlist.pl @@ -10,8 +10,8 @@ ($) my ($clearPassword) = @_; #Use an SHA512 salt with 16 digits my $salt = '$6$'; - for (my $i=0; $i<16; $i++) { - $salt .= ('.','/','0'..'9','A'..'Z','a'..'z')[rand 64]; + for (my $i = 0; $i < 16; $i++) { + $salt .= ('.', '/', '0' .. '9', 'A' .. 'Z', 'a' .. 'z')[ rand 64 ]; } my $cryptPassword = crypt(trim_spaces($clearPassword), $salt); @@ -21,33 +21,34 @@ ($) ## Utility function to trim whitespace off the start and end of its input sub trim_spaces { my $in = shift; - return '' unless $in; # skip blank spaces + return '' unless $in; # skip blank spaces $in =~ s/^\s*|\s*$//g; - return($in); + return ($in); } # ================================================================== my $inputfile = shift; -my $outfile = "crypted_" . $inputfile; +my $outfile = "crypted_" . $inputfile; -if ( -e $inputfile && -r $inputfile ) { - my $fh; my $outfh; - open( my $fh, "<", $inputfile ) or die "cannot open $inputfile"; - open( my $outfh, ">", $outfile ) or die "cannot open $outfile"; +if (-e $inputfile && -r $inputfile) { + my $fh; + my $outfh; + open(my $fh, "<", $inputfile) or die "cannot open $inputfile"; + open(my $outfh, ">", $outfile) or die "cannot open $outfile"; my $line; my @fields; - while ( $line = <$fh> ) { - if ( $line =~ /^#/ ) { + while ($line = <$fh>) { + if ($line =~ /^#/) { # Do not process comment lines print $outfh $line; } else { - @fields = split( ",", $line ); - $fields[9] = cryptPassword( $fields[9] ); - print $outfh join(",",@fields); + @fields = split(",", $line); + $fields[9] = cryptPassword($fields[9]); + print $outfh join(",", @fields); } } close $outfh or die "cannot close $outfile"; - close $fh or die "cannot close $inputfile"; + close $fh or die "cannot close $inputfile"; print "Output is in the file $outfile\n"; } else { print "Usage: crypt_passwords_in_classlist.pl filename"; diff --git a/bin/dev_scripts/PODParser.pm b/bin/dev_scripts/PODParser.pm index 5585618e9e..4fdf933fe3 100644 --- a/bin/dev_scripts/PODParser.pm +++ b/bin/dev_scripts/PODParser.pm @@ -26,8 +26,8 @@ use File::Find; sub new { my $invocant = shift; - my $class = ref $invocant || $invocant; - my $self = $class->SUPER::new(@_); + my $class = ref $invocant || $invocant; + my $self = $class->SUPER::new(@_); $self->perldoc_url_prefix("https://metacpan.org/pod/"); $self->index(1); $self->backlink(1); @@ -61,8 +61,8 @@ sub pod_wanted { my $self = shift; return sub { my $filename = $_; - my $path = $File::Find::name; - my $dir = $File::Find::dir; + my $path = $File::Find::name; + my $dir = $File::Find::dir; $File::Find::prune = 1, return if ($self->{pod_found}); diff --git a/bin/dev_scripts/PODtoHTML.pm b/bin/dev_scripts/PODtoHTML.pm index e8c41674b5..b7d4e02c49 100644 --- a/bin/dev_scripts/PODtoHTML.pm +++ b/bin/dev_scripts/PODtoHTML.pm @@ -40,24 +40,24 @@ sub new { my ($invocant, %o) = @_; my $class = ref $invocant || $invocant; - my @section_list = ref($o{sections}) eq 'ARRAY' ? @{$o{sections}} : @sections; - my $section_hash = {@section_list}; - my $section_order = [ map { $section_list[2 * $_] } 0 .. $#section_list / 2 ]; + my @section_list = ref($o{sections}) eq 'ARRAY' ? @{ $o{sections} } : @sections; + my $section_hash = {@section_list}; + my $section_order = [ map { $section_list[ 2 * $_ ] } 0 .. $#section_list / 2 ]; delete $o{sections}; my $self = { %o, - idx => {}, - section_hash => $section_hash, + idx => {}, + section_hash => $section_hash, section_order => $section_order, }; return bless $self, $class; } sub convert_pods { - my $self = shift; + my $self = shift; my $source_root = $self->{source_root}; - my $dest_root = $self->{dest_root}; + my $dest_root = $self->{dest_root}; find({ wanted => $self->gen_pod_wanted, no_chdir => 1 }, $source_root); $self->write_index("$dest_root/index.html"); @@ -66,8 +66,8 @@ sub convert_pods { sub gen_pod_wanted { my $self = shift; return sub { - my $path = $File::Find::name; - my $dir = $File::Find::dir; + my $path = $File::Find::name; + my $dir = $File::Find::dir; my ($name) = $path =~ m|^$dir(?:/(.*))?$|; $name = '' unless defined $name; @@ -126,8 +126,8 @@ sub process_pod { $pod_name =~ s/^(\/|::)//; - my $html_dir = $self->{dest_root} . (defined $subdir ? "/$subdir" : ""); - my $html_path = "$html_dir/$filename"; + my $html_dir = $self->{dest_root} . (defined $subdir ? "/$subdir" : ""); + my $html_path = "$html_dir/$filename"; my $html_rel_path = defined $subdir ? "$subdir/$filename" : $filename; $self->update_index($subdir, $html_rel_path, $pod_name); @@ -144,10 +144,10 @@ sub process_pod { sub update_index { my ($self, $subdir, $html_rel_path, $pod_name) = @_; $subdir =~ s|/.*$||; - my $idx = $self->{idx}; + my $idx = $self->{idx}; my $sections = $self->{section_hash}; if (exists $sections->{$subdir}) { - push @{$idx->{$subdir}}, [ $html_rel_path, $pod_name ]; + push @{ $idx->{$subdir} }, [ $html_rel_path, $pod_name ]; } else { warn "no section for subdir '$subdir'\n"; } @@ -155,21 +155,21 @@ sub update_index { sub write_index { my ($self, $out_path) = @_; - my $idx = $self->{idx}; - my $sections = $self->{section_hash}; + my $idx = $self->{idx}; + my $sections = $self->{section_hash}; my $section_order = $self->{section_order}; - my $source_root = $self->{source_root}; + my $source_root = $self->{source_root}; $source_root =~ s|^.*/||; - my $title = "Index for $source_root"; + my $title = "Index for $source_root"; my $content_start = "
    "; - my $content = ""; + my $content = ""; for my $section (@$section_order) { next unless defined $idx->{$section}; my $section_name = $sections->{$section}; $content_start .= qq{
  • $section_name
    • }; - my @files = sort @{$idx->{$section}}; + my @files = sort @{ $idx->{$section} }; $content .= qq{}; $content .= qq{

    $section_name

      }; for my $file (sort { $a->[1] cmp $b->[1] } @files) { @@ -183,22 +183,16 @@ sub write_index { my $date = strftime "%a %b %e %H:%M:%S %Z %Y", localtime; my $fh = new IO::File($out_path, '>') or die "Failed to open index '$out_path' for writing: $!\n"; - print $fh ( - get_header($title), - $content_start, - $content, - "

      Generated $date

      ", - get_footer() - ); + print $fh (get_header($title), $content_start, $content, "

      Generated $date

      ", get_footer()); } sub do_pod2html { my $self = shift; - my %o = @_; - my $psx = new PODParser; + my %o = @_; + my $psx = new PODParser; $psx->{source_root} = $self->{source_root}; - $psx->{verbose} = $self->{verbose}; - $psx->{base_url} = ($self->{dest_url} // "") . "/" . (($self->{source_root} // "") =~ s|^.*/||r); + $psx->{verbose} = $self->{verbose}; + $psx->{base_url} = ($self->{dest_url} // "") . "/" . (($self->{source_root} // "") =~ s|^.*/||r); $psx->output_string(\my $html); $psx->html_header(get_header($o{pod_name})); $psx->html_footer(get_footer()); @@ -208,7 +202,7 @@ sub do_pod2html { sub get_header { my $title = shift; - return < @@ -244,4 +238,3 @@ EOF 1; - diff --git a/bin/dev_scripts/generate-ww-pg-pod.pl b/bin/dev_scripts/generate-ww-pg-pod.pl index 73b398e87c..f2ca7763a4 100755 --- a/bin/dev_scripts/generate-ww-pg-pod.pl +++ b/bin/dev_scripts/generate-ww-pg-pod.pl @@ -60,7 +60,7 @@ =head1 DESCRIPTION ); $webwork_root = $ENV{WEBWORK_ROOT} if !$webwork_root; -$pg_root = $ENV{PG_ROOT} if !$pg_root; +$pg_root = $ENV{PG_ROOT} if !$pg_root; pod2usage(2) unless (($webwork_root || $pg_root) && $output_dir); @@ -89,16 +89,16 @@ sub process_dir { my $dest_dir = $source_dir; $dest_dir =~ s/^$webwork_root/$output_dir\/webwork2/ if ($source_dir =~ /\/webwork2$/); - $dest_dir =~ s/^$pg_root/$output_dir\/pg/ if ($source_dir =~ /\/pg$/); + $dest_dir =~ s/^$pg_root/$output_dir\/pg/ if ($source_dir =~ /\/pg$/); remove_tree($dest_dir); make_path($dest_dir); my $htmldocs = new PODtoHTML( source_root => $source_dir, - dest_root => $dest_dir, - dest_url => $base_url, - verbose => $verbose + dest_root => $dest_dir, + dest_url => $base_url, + verbose => $verbose ); $htmldocs->convert_pods; } @@ -120,7 +120,7 @@ sub write_index {
        EOF - print $fh q{
      • PG
        • } if $pg_root; + print $fh q{
      • PG
        • } if $pg_root; print $fh q{
      • WeBWorK
        • } if $webwork_root; print $fh "
      "; diff --git a/bin/dump-OPL-tables.pl b/bin/dump-OPL-tables.pl index a98570cf98..4ff8979645 100755 --- a/bin/dump-OPL-tables.pl +++ b/bin/dump-OPL-tables.pl @@ -21,6 +21,7 @@ # Get the necessary packages, including adding webwork to our path. my $pg_dir; + BEGIN { die "WEBWORK_ROOT not found in environment.\n" unless exists $ENV{WEBWORK_ROOT}; $pg_dir = $ENV{PG_ROOT} // "$ENV{WEBWORK_ROOT}/../pg"; @@ -38,18 +39,17 @@ BEGIN my $ce = new WeBWorK::CourseEnvironment({ webwork_dir => $ENV{WEBWORK_ROOT}, - }); +}); my $configured_OPL_path = $ce->{problemLibrary}{root}; - # Drop the "OpenProblemLibrary" from the end of the path $configured_OPL_path =~ s+OpenProblemLibrary++; # Check that it exists -if ( -d "$configured_OPL_path" ) { +if (-d "$configured_OPL_path") { print "OPL path seems to be $configured_OPL_path\n"; } else { print "OPL path seems to be misconfigured as $configured_OPL_path which does not exist.\n"; @@ -59,7 +59,7 @@ BEGIN # Set TABLE-DUMP path and make directory if necessary my $prepared_OPL_tables_dir = "${configured_OPL_path}/TABLE-DUMP"; -if ( ! -d "$prepared_OPL_tables_dir" ) { +if (!-d "$prepared_OPL_tables_dir") { `mkdir -p $prepared_OPL_tables_dir`; } @@ -76,16 +76,16 @@ BEGIN my $dbpass = $ce->{database_password}; $dbuser = shell_quote($dbuser); -$db = shell_quote($db); +$db = shell_quote($db); -$ENV{'MYSQL_PWD'}=$dbpass; +$ENV{'MYSQL_PWD'} = $dbpass; # decide whether the mysql installation can handle # utf8mb4 and that should be used for the OPL -my $ENABLE_UTF8MB4 = $ce->{ENABLE_UTF8MB4}?1:0; +my $ENABLE_UTF8MB4 = $ce->{ENABLE_UTF8MB4} ? 1 : 0; -my $character_set = ($ENABLE_UTF8MB4)? "utf8mb4":"utf8"; +my $character_set = ($ENABLE_UTF8MB4) ? "utf8mb4" : "utf8"; # Get mysqldump_command @@ -93,7 +93,8 @@ BEGIN # The tables to dump are: -my $OPL_tables_to_dump = "OPL_DBsubject OPL_DBchapter OPL_DBsection OPL_author OPL_path OPL_pgfile OPL_keyword OPL_pgfile_keyword OPL_textbook OPL_chapter OPL_section OPL_problem OPL_morelt OPL_pgfile_problem"; +my $OPL_tables_to_dump = + "OPL_DBsubject OPL_DBchapter OPL_DBsection OPL_author OPL_path OPL_pgfile OPL_keyword OPL_pgfile_keyword OPL_textbook OPL_chapter OPL_section OPL_problem OPL_morelt OPL_pgfile_problem"; # Tables NOT dumped: # OPL_problem_user - is created by bin/update-OPL-statistics and need not be archived @@ -106,10 +107,10 @@ BEGIN # see: https://serverfault.com/questions/912162/mysqldump-throws-unknown-table-column-statistics-in-information-schema-1109 # https://github.com/drush-ops/drush/issues/4410 -my $column_statistics_off = ""; +my $column_statistics_off = ""; my $test_for_column_statistics = `$mysqldump_command --help | grep 'column-statistics'`; -if ( $test_for_column_statistics ) { - $column_statistics_off = " --column-statistics=0 "; +if ($test_for_column_statistics) { + $column_statistics_off = " --column-statistics=0 "; } `$mysqldump_command --host=$host --port=$port --user=$dbuser --default-character-set=$character_set $column_statistics_off $db $OPL_tables_to_dump > $prepared_OPL_tables_file`; diff --git a/bin/generate-OPL-set-def-lists.pl b/bin/generate-OPL-set-def-lists.pl index 685753463e..17a71804a8 100755 --- a/bin/generate-OPL-set-def-lists.pl +++ b/bin/generate-OPL-set-def-lists.pl @@ -43,7 +43,7 @@ BEGIN use OPLUtils qw/writeJSONtoFile/; use WeBWorK::CourseEnvironment; -my $ce = new WeBWorK::CourseEnvironment({ webwork_dir => $ENV{WEBWORK_ROOT} }); +my $ce = new WeBWorK::CourseEnvironment({ webwork_dir => $ENV{WEBWORK_ROOT} }); my $libraryRoot = $ce->{problemLibrary}{root}; my $contribRoot = $ce->{contribLibrary}{root}; diff --git a/bin/importClassList.pl b/bin/importClassList.pl index 9a48776c80..b59f67fe94 100755 --- a/bin/importClassList.pl +++ b/bin/importClassList.pl @@ -19,7 +19,7 @@ BEGIN { die "WEBWORK_ROOT not found in environment.\n" - unless exists $ENV{WEBWORK_ROOT}; + unless exists $ENV{WEBWORK_ROOT}; $webwork_dir = $ENV{WEBWORK_ROOT}; print "importClassList.pl: WeBWorK root directory set to $webwork_dir\n"; @@ -41,26 +41,26 @@ BEGIN use strict; use warnings; -if((scalar(@ARGV) != 2)) { - print "\nSyntax is: importClassList.pl course_id path_to_classlist_file.lst\n\n"; - exit(); +if ((scalar(@ARGV) != 2)) { + print "\nSyntax is: importClassList.pl course_id path_to_classlist_file.lst\n\n"; + exit(); } my $courseID = shift; my $fileName = shift; -die "Not able to read from file $fileName : does it exist? is it readable?" unless ( -r "$fileName" ); +die "Not able to read from file $fileName : does it exist? is it readable?" unless (-r "$fileName"); my $ce = WeBWorK::CourseEnvironment->new({ webwork_dir => $ENV{WEBWORK_ROOT}, - courseName => $courseID + courseName => $courseID }); my $db = new WeBWorK::DB($ce->{dbLayout}); -my $createNew = 1; # Always set to true, so add new users -my $replaceExisting = "none"; # Always set to "none" so no existing accounts are changed -my @replaceList =(); # Empty list +my $createNew = 1; # Always set to true, so add new users +my $replaceExisting = "none"; # Always set to "none" so no existing accounts are changed +my @replaceList = (); # Empty list my (@replaced, @added, @skipped); # This was copied with MINOR changes from lib/WeBWorK/ContentGenerator/Instructor/UserList.pm @@ -92,12 +92,12 @@ sub importUsersFromCSV { my $default_status_abbrev = $ce->{statuses}->{Enrolled}->{abbrevs}->[0]; foreach my $record (@classlist) { - my %record = %$record; + my %record = %$record; my $user_id = $record{user_id}; print "Saw user_id = $user_id\n"; - unless (WeBWorK::DB::check_user_id($user_id) ) { # try to catch lines with bad characters + unless (WeBWorK::DB::check_user_id($user_id)) { # try to catch lines with bad characters push @skipped, $user_id; next; } @@ -131,9 +131,9 @@ sub importUsersFromCSV { $record{permission} = $default_permission_level unless defined $record{permission} and $record{permission} ne ""; - my $User = $db->newUser(%record); + my $User = $db->newUser(%record); my $PermissionLevel = $db->newPermissionLevel(user_id => $user_id, permission => $record{permission}); - my $Password = $db->newPassword(user_id => $user_id, password => $record{password}); + my $Password = $db->newPassword(user_id => $user_id, password => $record{password}); # DBFIXME use REPLACE if (exists $allUserIDs{$user_id}) { @@ -149,10 +149,9 @@ sub importUsersFromCSV { } } - - print( "Added:\n\t", join("\n\t", @added), "\n\n" ); - print( "Skipped:\n\t", join("\n\t", @skipped), "\n\n" ); - print( "Replaced:\n\t", join("\n\t", @replaced), "\n\n" ); + print("Added:\n\t", join("\n\t", @added), "\n\n"); + print("Skipped:\n\t", join("\n\t", @skipped), "\n\n"); + print("Replaced:\n\t", join("\n\t", @replaced), "\n\n"); } diff --git a/bin/integrity_check.pl b/bin/integrity_check.pl index b61f201527..0c89273352 100644 --- a/bin/integrity_check.pl +++ b/bin/integrity_check.pl @@ -20,6 +20,7 @@ use Data::Dumper; my $pg_dir; + BEGIN { die "WEBWORK_ROOT not found in environment.\n" unless exists $ENV{WEBWORK_ROOT}; $pg_dir = $ENV{PG_ROOT} // "$ENV{WEBWORK_ROOT}/../pg"; @@ -41,14 +42,12 @@ BEGIN $WeBWorK::Debug::Enabled = 0; } - my $courseName = "tmp_course"; -my $ce = new WeBWorK::CourseEnvironment( - {webwork_dir=>$ENV{WEBWORK_ROOT}, - courseName=> $courseName - }); - +my $ce = new WeBWorK::CourseEnvironment({ + webwork_dir => $ENV{WEBWORK_ROOT}, + courseName => $courseName +}); print "ce ready $ce"; @@ -57,4 +56,4 @@ BEGIN my $return = $CIchecker->checkCourseDirectories(); print "result $return"; -1; \ No newline at end of file +1; diff --git a/bin/load-OPL-global-statistics.pl b/bin/load-OPL-global-statistics.pl index cb8692c0eb..5caf309671 100755 --- a/bin/load-OPL-global-statistics.pl +++ b/bin/load-OPL-global-statistics.pl @@ -21,6 +21,7 @@ # Get the necessary packages, including adding webwork to our path. my $pg_dir; + BEGIN { die "WEBWORK_ROOT not found in environment.\n" unless exists $ENV{WEBWORK_ROOT}; $pg_dir = $ENV{PG_ROOT} // "$ENV{WEBWORK_ROOT}/../pg"; @@ -39,44 +40,44 @@ BEGIN my $ce = new WeBWorK::CourseEnvironment({ webwork_dir => $ENV{WEBWORK_ROOT}, - }); +}); my $dbh = DBI->connect( - $ce->{problemLibrary_db}->{dbsource}, - $ce->{problemLibrary_db}->{user}, - $ce->{problemLibrary_db}->{passwd}, - { + $ce->{problemLibrary_db}->{dbsource}, + $ce->{problemLibrary_db}->{user}, + $ce->{problemLibrary_db}->{passwd}, + { AutoCommit => 0, - PrintError => 0, - RaiseError => 1, - }, + PrintError => 0, + RaiseError => 1, + }, ); # check to see if the global statistics file exists and if it does, upload it. -my $global_sql_file = $ce->{problemLibrary}{root}.'/OPL_global_statistics.sql'; +my $global_sql_file = $ce->{problemLibrary}{root} . '/OPL_global_statistics.sql'; if (-e $global_sql_file) { - my $db = $ce->{database_name}; - my $host = $ce->{database_host}; - my $port = $ce->{database_port}; - my $dbuser = $ce->{database_username}; - my $dbpass = $ce->{database_password}; + my $db = $ce->{database_name}; + my $host = $ce->{database_host}; + my $port = $ce->{database_port}; + my $dbuser = $ce->{database_username}; + my $dbpass = $ce->{database_password}; - $dbh->do(<do(<commit(); + $dbh->commit(); - $dbuser = shell_quote($dbuser); - $db = shell_quote($db); + $dbuser = shell_quote($dbuser); + $db = shell_quote($db); - $ENV{'MYSQL_PWD'}=$dbpass; + $ENV{'MYSQL_PWD'} = $dbpass; - my $mysql_command = $ce->{externalPrograms}->{mysql}; + my $mysql_command = $ce->{externalPrograms}->{mysql}; - `$mysql_command --host=$host --port=$port --user=$dbuser $db < $global_sql_file`; + `$mysql_command --host=$host --port=$port --user=$dbuser $db < $global_sql_file`; } diff --git a/bin/readURClassList.pl b/bin/readURClassList.pl index 565b321a1a..e1436f11ab 100755 --- a/bin/readURClassList.pl +++ b/bin/readURClassList.pl @@ -41,14 +41,12 @@ ## ## NOTE: Be very careful. The registrar's file may get corrupted by e-mail. - require 5.000; - $0 =~ s|.*/||; -if (@ARGV != 3) { +if (@ARGV != 3) { print "\n usage: $0 registrar's-list outputfile sectionName\n - e.g. readURClassList.pl ClassRoster.txt mth140A.lst 'Pizer MWF9'\n\n" ; + e.g. readURClassList.pl ClassRoster.txt mth140A.lst 'Pizer MWF9'\n\n"; exit(0); } @@ -56,194 +54,187 @@ open(REGLIST, "$infile") || die "can't open $infile: $!\n"; open(OURLIST, ">$outfile") - || die "can't write $outfile: $!\n"; + || die "can't write $outfile: $!\n"; while () { - chomp; - next unless($_=~/\w/); ## skip blank lines - s/;$/; /; ## make last field non empty - my @regArray=split(/;/); ## get fields from registrar's file + chomp; + next unless ($_ =~ /\w/); ## skip blank lines + s/;$/; /; ## make last field non empty + my @regArray = split(/;/); ## get fields from registrar's file - foreach (@regArray) { ## clean 'em up! - ($_) = m/^\s*(.*?)\s*$/; ## (remove leading and trailing spaces) - } + foreach (@regArray) { ## clean 'em up! + ($_) = m/^\s*(.*?)\s*$/; ## (remove leading and trailing spaces) + } - ## extract the relevant fields + ## extract the relevant fields - my($crn, $id, $grade, $name, $school, $gradyear, - $major, $degree, $hours, $status, $login ) - = @regArray; + my ($crn, $id, $grade, $name, $school, $gradyear, $major, $degree, $hours, $status, $login) = @regArray; ## Hack. The login comes as a complete email address. Remove the @ and following sysbols. $login =~ s/@.*//; + ## massage the data a bit - ## massage the data a bit - - my($lname, $fname) = ($name =~ /^(.*),\s*(.*)$/); - if ($login =~/\w/) {$email = "$login".'@mail.rochester.edu';} - else - { - $email= " "; + my ($lname, $fname) = ($name =~ /^(.*),\s*(.*)$/); + if ($login =~ /\w/) { $email = "$login" . '@mail.rochester.edu'; } + else { + $email = " "; $login = $id; } - $status = 'C' unless (defined $status and $status =~/\w/); - ## dump it in our classArray format - ## our format is: $id, $lname, $fname, $status, 'comment ', $dept, $course, $section, - ## $hours, $crn, $year, $semester, $school, $gradyear, $major, $degree, $email, $login + $status = 'C' unless (defined $status and $status =~ /\w/); + ## dump it in our classArray format + ## our format is: $id, $lname, $fname, $status, 'comment ', $dept, $course, $section, + ## $hours, $crn, $year, $semester, $school, $gradyear, $major, $degree, $email, $login - ## At the U of R 'comment' is blank - ## At present only $id, $lname, $fname, $status, $email, $section, $recitation and $login are used by WeBWorK + ## At the U of R 'comment' is blank + ## At present only $id, $lname, $fname, $status, $email, $section, $recitation and $login are used by WeBWorK - my @classArray=($id, $lname, $fname, $status, ' ', $section, ' ',$email, $login); + my @classArray = ($id, $lname, $fname, $status, ' ', $section, ' ', $email, $login); - ## and print that sucker! + ## and print that sucker! - print OURLIST join(',', @classArray) , "\n"; + print OURLIST join(',', @classArray), "\n"; } - close(OURLIST); +close(OURLIST); - ## arrange the columns nicely +## arrange the columns nicely + +&columnPrint("$outfile", "$outfile"); - &columnPrint("$outfile","$outfile"); - - - sub columnPrint { -# Takes two parameters. The first is the filename of the -# delimited input file. The second is the name of the -# output file (these names may be the same). The permissions -# and group of the output file will be the same as the -# input file - -# Takes any delimited (with \$DELIM delimiters) file and adds -# extra space if necessary to the fields so that all columns line up. -# The widest field in any column will contain exactly 2 spaces at the -# end of the (non space characters 0f the) field. For example -# ",a very long field entry ," at one extreme and ", ," at the other -# - my($inFileName,$outFileName)=@_; - my($line); + # Takes two parameters. The first is the filename of the + # delimited input file. The second is the name of the + # output file (these names may be the same). The permissions + # and group of the output file will be the same as the + # input file - my ($permission, $gid) = (stat($inFileName))[2,5]; - $permission = ($permission & 0777); ##get rid of file type stuff + # Takes any delimited (with \$DELIM delimiters) file and adds + # extra space if necessary to the fields so that all columns line up. + # The widest field in any column will contain exactly 2 spaces at the + # end of the (non space characters 0f the) field. For example + # ",a very long field entry ," at one extreme and ", ," at the other + # + my ($inFileName, $outFileName) = @_; + my ($line); - open(INFILE,"$inFileName") or wwerror("$0","can't open $inFileName for reading"); - my @inFile=; - close(INFILE); + my ($permission, $gid) = (stat($inFileName))[ 2, 5 ]; + $permission = ($permission & 0777); ##get rid of file type stuff - &createFile($outFileName, $permission, $gid); + open(INFILE, "$inFileName") or wwerror("$0", "can't open $inFileName for reading"); + my @inFile = ; + close(INFILE); - my @outFile = &columnArrayArrange(@inFile); + &createFile($outFileName, $permission, $gid); - open(OUTFILE,">$outFileName") or wwerror("$0","can't open $outFileName for writing"); - foreach $line (@outFile) {print OUTFILE $line;} - close(OUTFILE); + my @outFile = &columnArrayArrange(@inFile); + + open(OUTFILE, ">$outFileName") or wwerror("$0", "can't open $outFileName for writing"); + foreach $line (@outFile) { print OUTFILE $line; } + close(OUTFILE); } - -sub columnArrayArrange { + +sub columnArrayArrange { ## takes as a parameter a delimited array ## (such as you would get by reading in a delimited file) ## where each element is a line from a delimited file. -# Outputs an array which adds -# extra space if necessary to the fields so that all columns line up. -# The widest field in any column will contain exactly 1 spaces at the -# end of the (non space characters of the) field. For example -# ",a very long field entry ," at one extreme and ", ," at the other - - my @inFile=@_; - my($i,$tempFileName,$datString,$line); - my @outFile =(); - my(@fieldLength,@datArray); - $i=1; - - @fieldLength=&getFieldLengths(\@inFile); - foreach $line (@inFile) { ## read through file array and get field lengths - unless ($line =~ /\S/) {next;} ## skip blank lines - chomp $line; - @datArray=&getRecord($line); - for ($i=0; $i <=$#datArray; $i++) { - $datArray[$i].=(" " x ($fieldLength[$i]+1-length("$datArray[$i]"))); - } - $datString=join(',',@datArray); - push @outFile , "$datString\n"; - } - @outFile; + # Outputs an array which adds + # extra space if necessary to the fields so that all columns line up. + # The widest field in any column will contain exactly 1 spaces at the + # end of the (non space characters of the) field. For example + # ",a very long field entry ," at one extreme and ", ," at the other + + my @inFile = @_; + my ($i, $tempFileName, $datString, $line); + my @outFile = (); + my (@fieldLength, @datArray); + $i = 1; + + @fieldLength = &getFieldLengths(\@inFile); + foreach $line (@inFile) { ## read through file array and get field lengths + unless ($line =~ /\S/) { next; } ## skip blank lines + chomp $line; + @datArray = &getRecord($line); + for ($i = 0; $i <= $#datArray; $i++) { + $datArray[$i] .= (" " x ($fieldLength[$i] + 1 - length("$datArray[$i]"))); + } + $datString = join(',', @datArray); + push @outFile, "$datString\n"; + } + @outFile; } sub createFile { - my ($fileName, $permission, $numgid) = @_; - - open(TEMPCREATEFILE, ">$fileName") || - warn " Can't open $fileName"; - my @stat = stat TEMPCREATEFILE; - close(TEMPCREATEFILE); - - ## if the owner of the file is running this script (e.g. when the file is first created) - ## set the permissions and group correctly - if ($< == $stat[4]) { - my $tmp = chmod($permission,$fileName) or - warn "Can't do chmod($permission, $fileName)"; - chown(-1,$numgid,$fileName) or - warn "Can't do chown($numgid, $fileName)"; - } + my ($fileName, $permission, $numgid) = @_; + + open(TEMPCREATEFILE, ">$fileName") + || warn " Can't open $fileName"; + my @stat = stat TEMPCREATEFILE; + close(TEMPCREATEFILE); + + ## if the owner of the file is running this script (e.g. when the file is first created) + ## set the permissions and group correctly + if ($< == $stat[4]) { + my $tmp = chmod($permission, $fileName) + or warn "Can't do chmod($permission, $fileName)"; + chown(-1, $numgid, $fileName) + or warn "Can't do chown($numgid, $fileName)"; + } } sub getFieldLengths { - ## takes as a parameter the reference to a delimited array - ## (such as you would get by reading in a delimited file) - ## where each element is a line from a delimited file. - ## returns an array which holds - ## the maximum field lengths in the file. - - my ($datFileArray_ref)=@_; - my($i); - my(@datArray,@fieldLength,@datFileArray, $line); - @fieldLength=(); - @datFileArray=@$datFileArray_ref; - - foreach $line (@datFileArray) { ## read through file and get field lengths - unless ($line =~ /\S/) {next;} ## skip blank lines - chomp $line; - @datArray=&getRecord($line); - for ($i=0; $i <=$#datArray; $i++) { - $fieldLength[$i] = 0 unless defined $fieldLength[$i]; - $fieldLength[$i]=&max(length("$datArray[$i]"),$fieldLength[$i]); - } - } - return (@fieldLength); + ## takes as a parameter the reference to a delimited array + ## (such as you would get by reading in a delimited file) + ## where each element is a line from a delimited file. + ## returns an array which holds + ## the maximum field lengths in the file. + + my ($datFileArray_ref) = @_; + my ($i); + my (@datArray, @fieldLength, @datFileArray, $line); + @fieldLength = (); + @datFileArray = @$datFileArray_ref; + + foreach $line (@datFileArray) { ## read through file and get field lengths + unless ($line =~ /\S/) { next; } ## skip blank lines + chomp $line; + @datArray = &getRecord($line); + for ($i = 0; $i <= $#datArray; $i++) { + $fieldLength[$i] = 0 unless defined $fieldLength[$i]; + $fieldLength[$i] = &max(length("$datArray[$i]"), $fieldLength[$i]); + } + } + return (@fieldLength); } - - sub getRecord - # Takes a delimited line as a parameter and returns an - # array. Note that all white space is removed. If the - # last field is empty, the last element of the returned - # array is also empty (unlike what the perl split command - # would return). E.G. @lineArray=&getRecord(\$delimitedLine). - { - my $DELIM = ','; - my($line) = $_[0]; - my(@lineArray); - $line.='A'; # add 'A' to end of line so that - # last field is never empty - @lineArray = split(/\s*${DELIM}\s*/,$line); - $lineArray[$#lineArray] =~s/\s*A$//; # remove spaces and the 'A' from last element - $lineArray[0] =~s/^\s*//; # remove white space from first element - @lineArray; - } -sub max { ## find the max element of array - my $out = $_[0]; - my $num; - foreach $num (@_) { - if ((defined $num) and ($num > $out)) {$out = $num;} - } - $out; + # Takes a delimited line as a parameter and returns an + # array. Note that all white space is removed. If the + # last field is empty, the last element of the returned + # array is also empty (unlike what the perl split command + # would return). E.G. @lineArray=&getRecord(\$delimitedLine). +{ + my $DELIM = ','; + my ($line) = $_[0]; + my (@lineArray); + $line .= 'A'; # add 'A' to end of line so that + # last field is never empty + @lineArray = split(/\s*${DELIM}\s*/, $line); + $lineArray[$#lineArray] =~ s/\s*A$//; # remove spaces and the 'A' from last element + $lineArray[0] =~ s/^\s*//; # remove white space from first element + @lineArray; +} + +sub max { ## find the max element of array + my $out = $_[0]; + my $num; + foreach $num (@_) { + if ((defined $num) and ($num > $out)) { $out = $num; } + } + $out; } diff --git a/bin/restore-OPL-tables.pl b/bin/restore-OPL-tables.pl index da568af414..1fcedbc5d4 100755 --- a/bin/restore-OPL-tables.pl +++ b/bin/restore-OPL-tables.pl @@ -21,6 +21,7 @@ # Get the necessary packages, including adding webwork to our path. my $pg_dir; + BEGIN { die "WEBWORK_ROOT not found in environment.\n" unless exists $ENV{WEBWORK_ROOT}; $pg_dir = $ENV{PG_ROOT} // "$ENV{WEBWORK_ROOT}/../pg"; @@ -39,18 +40,17 @@ BEGIN my $ce = new WeBWorK::CourseEnvironment({ webwork_dir => $ENV{WEBWORK_ROOT}, - }); +}); my $configured_OPL_path = $ce->{problemLibrary}{root}; - # Drop the "OpenProblemLibrary" from the end of the path $configured_OPL_path =~ s+OpenProblemLibrary++; # Check that it exists -if ( -d "$configured_OPL_path" ) { +if (-d "$configured_OPL_path") { print "OPL path seems to be $configured_OPL_path\n"; } else { print "OPL path seems to be misconfigured as $configured_OPL_path which does not exist.\n"; @@ -60,7 +60,7 @@ BEGIN # Set TABLE-DUMP path and make directory if necessary my $prepared_OPL_tables_dir = "${configured_OPL_path}/TABLE-DUMP"; -if ( ! -d "$prepared_OPL_tables_dir" ) { +if (!-d "$prepared_OPL_tables_dir") { `mkdir -p $prepared_OPL_tables_dir`; } @@ -77,23 +77,23 @@ BEGIN my $dbpass = $ce->{database_password}; $dbuser = shell_quote($dbuser); -$db = shell_quote($db); +$db = shell_quote($db); -$ENV{'MYSQL_PWD'}=$dbpass; +$ENV{'MYSQL_PWD'} = $dbpass; # decide whether the mysql installation can handle # utf8mb4 and that should be used for the OPL -my $ENABLE_UTF8MB4 = $ce->{ENABLE_UTF8MB4}?1:0; +my $ENABLE_UTF8MB4 = $ce->{ENABLE_UTF8MB4} ? 1 : 0; -my $character_set = ($ENABLE_UTF8MB4)? "utf8mb4":"utf8"; +my $character_set = ($ENABLE_UTF8MB4) ? "utf8mb4" : "utf8"; my $mysql_command = $ce->{externalPrograms}->{mysql}; # check to see if the prepared_OPL_tables_file exists and if it does load it in if (-e $prepared_OPL_tables_file) { - `$mysql_command --host=$host --port=$port --user=$dbuser --default-character-set=$character_set $db < $prepared_OPL_tables_file`; + `$mysql_command --host=$host --port=$port --user=$dbuser --default-character-set=$character_set $db < $prepared_OPL_tables_file`; } 1; diff --git a/bin/test_library_build.pl b/bin/test_library_build.pl index 4f3dd14528..91a21c2bd2 100755 --- a/bin/test_library_build.pl +++ b/bin/test_library_build.pl @@ -1,7 +1,7 @@ #!/usr/bin/env perl - my $pg_dir; + BEGIN { die "WEBWORK_ROOT not found in environment.\n" unless exists $ENV{WEBWORK_ROOT}; $pg_dir = $ENV{PG_ROOT} // "$ENV{WEBWORK_ROOT}/../pg"; @@ -19,15 +19,15 @@ BEGIN use OPLUtils qw/build_library_directory_tree build_library_subject_tree build_library_textbook_tree/; use DBI; -my $ce = new WeBWorK::CourseEnvironment({webwork_dir=>$ENV{WEBWORK_ROOT}}); +my $ce = new WeBWorK::CourseEnvironment({ webwork_dir => $ENV{WEBWORK_ROOT} }); my $dbh = DBI->connect( - $ce->{database_dsn}, - $ce->{database_username}, - $ce->{database_password}, - { - PrintError => 0, - RaiseError => 1, - }, + $ce->{database_dsn}, + $ce->{database_username}, + $ce->{database_password}, + { + PrintError => 0, + RaiseError => 1, + }, ); # auto flush printing @@ -36,7 +36,7 @@ BEGIN select($old_fh); build_library_directory_tree($ce); -build_library_subject_tree($ce,$dbh); -build_library_textbook_tree($ce,$dbh); +build_library_subject_tree($ce, $dbh); +build_library_textbook_tree($ce, $dbh); -$dbh->disconnect; \ No newline at end of file +$dbh->disconnect; diff --git a/bin/timing_log_check.pl b/bin/timing_log_check.pl index 2340876ec9..f16f709412 100755 --- a/bin/timing_log_check.pl +++ b/bin/timing_log_check.pl @@ -6,103 +6,93 @@ # If you have a large timing log, it can tale awhile for the script to complete processing. # To run the script, cd to the WeBWorK logs directory (usually /opt/webwork/webwork2/logs) -# and enter the command: timing_log_check.pl +# and enter the command: timing_log_check.pl # Note that this assumes perl is locates in /usr/bin/perl (check with the command "which perl") # and /opt/webwork/webwork2/bin/ is in your path. - open(PGFILE,'timing.log') || warn "Can't read timing.log: $!"; - my @lines = ; close(PGFILE); +open(PGFILE, 'timing.log') || warn "Can't read timing.log: $!"; +my @lines = ; +close(PGFILE); - my $under0point1sec = 0; - my $under0point2sec = 0; - my $under0point5sec = 0; - my $under1sec = 0; - my $under2sec = 0; - my $under3sec = 0; - my $under4sec = 0; - my $under5sec = 0; - my $under10sec = 0; - my $over10sec = 0; - my $nonvalid = 0; - my $line; - my $count = 0; - my $time = 0; - - foreach $line (@lines) { - $count++; - $line =~ /runTime = (\d+\.\d+) sec/; - $time = $1; - if ($time < 0.1){ - $under0point1sec++; - } - elsif ($time < 0.2){ - $under0point2sec++; - } - elsif ($time < 0.5){ - $under0point5sec++; - } - elsif ($time < 1.0){ - $under1sec++; - } - elsif ($time < 2.0){ - $under2sec++; - } - elsif ($time < 3.0){ - $under3sec++; - } - elsif ($time < 4.0){ - $under4sec++; - } - elsif ($time < 5.0){ - $under5sec++; - } - elsif ($time < 10.0){ - $under10sec++; - } - elsif ($time >= 10.0){ - $over10sec++; - } - else { - $nonvalid++; - } - } - my $percent_under0point1sec = 0; - my $percent_under0point2sec = 0; - my $percent_under0point5sec = 0; - my $percent_under1sec = 0; - my $percent_under2sec = 0; - my $percent_under3sec = 0; - my $percent_under4sec = 0; - my $percent_under5sec = 0; - my $percent_under10sec = 0; - my $percent_over10sec = 0; - my $percent_nonvalid = 0; - - $percent_under0point1sec = (int($under0point1sec/$count*1000 +.5))/10; - $percent_under0point2sec = (int($under0point2sec/$count*1000 +.5))/10; - $percent_under0point5sec = (int($under0point5sec/$count*1000 +.5))/10; - $percent_under1sec = (int($under1sec/$count*1000 +.5))/10; - $percent_under2sec = (int($under2sec/$count*1000 +.5))/10; - $percent_under3sec = (int($under3sec/$count*1000 +.5))/10; - $percent_under4sec = (int($under4sec/$count*1000 +.5))/10; - $percent_under5sec = (int($under5sec/$count*1000 +.5))/10; - $percent_under10sec = (int($under10sec/$count*1000 +.5))/10; - $percent_over10sec = (int($over10sec/$count*1000 +.5))/10; - $percent_nonvalid = (int($nonvalid/$count*1000 +.5))/10; +my $under0point1sec = 0; +my $under0point2sec = 0; +my $under0point5sec = 0; +my $under1sec = 0; +my $under2sec = 0; +my $under3sec = 0; +my $under4sec = 0; +my $under5sec = 0; +my $under10sec = 0; +my $over10sec = 0; +my $nonvalid = 0; +my $line; +my $count = 0; +my $time = 0; - - print "count = $count\n"; - print "under 0.1 seconds = $under0point1sec: ${percent_under0point1sec}%\n"; - print "between 0.1 and 0.2 seconds = $under0point2sec: ${percent_under0point2sec}%\n"; - print "between 0.2 and 0.5 seconds = $under0point5sec: ${percent_under0point5sec}%\n"; - print "between 0.5 and 1.0 seconds = $under1sec: ${percent_under1sec}%\n"; - print "between 1.0 and 2.0 seconds = $under2sec: ${percent_under2sec}%\n"; - print "between 2.0 and 3.0 seconds = $under3sec: ${percent_under3sec}%\n"; - print "between 3.0 and 4.0 seconds = $under4sec: ${percent_under4sec}%\n"; - print "between 4.0 and 5.0 seconds = $under5sec: ${percent_under5sec}%\n"; - print "between 5.0 and 10.0 seconds = $under10sec: ${percent_under10sec}%\n"; - print "over 10.0 seconds = $over10sec: ${percent_over10sec}%\n"; - print "non valid response = $nonvalid: ${percent_nonvalid}%\n"; +foreach $line (@lines) { + $count++; + $line =~ /runTime = (\d+\.\d+) sec/; + $time = $1; + if ($time < 0.1) { + $under0point1sec++; + } elsif ($time < 0.2) { + $under0point2sec++; + } elsif ($time < 0.5) { + $under0point5sec++; + } elsif ($time < 1.0) { + $under1sec++; + } elsif ($time < 2.0) { + $under2sec++; + } elsif ($time < 3.0) { + $under3sec++; + } elsif ($time < 4.0) { + $under4sec++; + } elsif ($time < 5.0) { + $under5sec++; + } elsif ($time < 10.0) { + $under10sec++; + } elsif ($time >= 10.0) { + $over10sec++; + } else { + $nonvalid++; + } +} +my $percent_under0point1sec = 0; +my $percent_under0point2sec = 0; +my $percent_under0point5sec = 0; +my $percent_under1sec = 0; +my $percent_under2sec = 0; +my $percent_under3sec = 0; +my $percent_under4sec = 0; +my $percent_under5sec = 0; +my $percent_under10sec = 0; +my $percent_over10sec = 0; +my $percent_nonvalid = 0; -exit(0); \ No newline at end of file +$percent_under0point1sec = (int($under0point1sec / $count * 1000 + .5)) / 10; +$percent_under0point2sec = (int($under0point2sec / $count * 1000 + .5)) / 10; +$percent_under0point5sec = (int($under0point5sec / $count * 1000 + .5)) / 10; +$percent_under1sec = (int($under1sec / $count * 1000 + .5)) / 10; +$percent_under2sec = (int($under2sec / $count * 1000 + .5)) / 10; +$percent_under3sec = (int($under3sec / $count * 1000 + .5)) / 10; +$percent_under4sec = (int($under4sec / $count * 1000 + .5)) / 10; +$percent_under5sec = (int($under5sec / $count * 1000 + .5)) / 10; +$percent_under10sec = (int($under10sec / $count * 1000 + .5)) / 10; +$percent_over10sec = (int($over10sec / $count * 1000 + .5)) / 10; +$percent_nonvalid = (int($nonvalid / $count * 1000 + .5)) / 10; + +print "count = $count\n"; +print "under 0.1 seconds = $under0point1sec: ${percent_under0point1sec}%\n"; +print "between 0.1 and 0.2 seconds = $under0point2sec: ${percent_under0point2sec}%\n"; +print "between 0.2 and 0.5 seconds = $under0point5sec: ${percent_under0point5sec}%\n"; +print "between 0.5 and 1.0 seconds = $under1sec: ${percent_under1sec}%\n"; +print "between 1.0 and 2.0 seconds = $under2sec: ${percent_under2sec}%\n"; +print "between 2.0 and 3.0 seconds = $under3sec: ${percent_under3sec}%\n"; +print "between 3.0 and 4.0 seconds = $under4sec: ${percent_under4sec}%\n"; +print "between 4.0 and 5.0 seconds = $under5sec: ${percent_under5sec}%\n"; +print "between 5.0 and 10.0 seconds = $under10sec: ${percent_under10sec}%\n"; +print "over 10.0 seconds = $over10sec: ${percent_over10sec}%\n"; +print "non valid response = $nonvalid: ${percent_nonvalid}%\n"; + +exit(0); diff --git a/bin/update-OPL-statistics.pl b/bin/update-OPL-statistics.pl index aa43bf98d4..cb8bdd19f7 100755 --- a/bin/update-OPL-statistics.pl +++ b/bin/update-OPL-statistics.pl @@ -20,6 +20,7 @@ # Get the necessary packages, including adding # webwork and pg library to our path. my $pg_dir; + BEGIN { die "WEBWORK_ROOT not found in environment.\n" unless exists $ENV{WEBWORK_ROOT}; $pg_dir = $ENV{PG_ROOT} // "$ENV{WEBWORK_ROOT}/../pg"; @@ -38,14 +39,13 @@ BEGIN # get course environment and open up database my $ce = new WeBWorK::CourseEnvironment({ - webwork_dir => $ENV{WEBWORK_ROOT}, - }); + webwork_dir => $ENV{WEBWORK_ROOT}, +}); # decide whether the mysql installation can handle # utf8mb4 and that should be used for the OPL -my $ENABLE_UTF8MB4 = $ce->{ENABLE_UTF8MB4}?1:0; - +my $ENABLE_UTF8MB4 = $ce->{ENABLE_UTF8MB4} ? 1 : 0; my $dbh = DBI->connect( $ce->{problemLibrary_db}->{dbsource}, @@ -63,7 +63,7 @@ BEGIN # create tables. We always redo the statistics table. -my $character_set = ($ENABLE_UTF8MB4)? "utf8mb4":"utf8"; +my $character_set = ($ENABLE_UTF8MB4) ? "utf8mb4" : "utf8"; $dbh->do(<do(<do(<commit(); # We no longer automatically load the global statistics data here. -print( "You may want to run load-OPL-global-statistics.pl to update the global statistics data.\n", +print("You may want to run load-OPL-global-statistics.pl to update the global statistics data.\n", "If this is being run by OPL-update, that will be done automatically.\n"); 1; diff --git a/bin/updateOPLextras.pl b/bin/updateOPLextras.pl index d0d2543f8f..876223d186 100755 --- a/bin/updateOPLextras.pl +++ b/bin/updateOPLextras.pl @@ -50,14 +50,14 @@ =head1 DESCRIPTION use DBI; use Getopt::Long; use Pod::Usage; -Getopt::Long::Configure ("bundling"); +Getopt::Long::Configure("bundling"); my ($textbooks, $directories, $subjects, $verbose, $all); -GetOptions ( - 't|textbooks' => \$textbooks, - 'd|directories' => \$directories, - 's|subjects' => \$subjects, - 'a|all' => \$all, +GetOptions( + 't|textbooks' => \$textbooks, + 'd|directories' => \$directories, + 's|subjects' => \$subjects, + 'a|all' => \$all, 'v|verbose' => \$verbose ); pod2usage(2) unless ($textbooks || $directories || $subjects || $all); @@ -70,6 +70,7 @@ =head1 DESCRIPTION #### my $pg_dir; + BEGIN { die "WEBWORK_ROOT not found in environment.\n" unless exists $ENV{WEBWORK_ROOT}; $pg_dir = $ENV{PG_ROOT} // "$ENV{WEBWORK_ROOT}/../pg"; @@ -82,22 +83,22 @@ BEGIN use WeBWorK::CourseEnvironment; use OPLUtils qw/build_library_directory_tree build_library_subject_tree build_library_textbook_tree/; -my $ce = new WeBWorK::CourseEnvironment({webwork_dir=>$ENV{WEBWORK_ROOT}}); +my $ce = new WeBWorK::CourseEnvironment({ webwork_dir => $ENV{WEBWORK_ROOT} }); # decide whether the mysql installation can handle # utf8mb4 and that should be used for the OPL -my $ENABLE_UTF8MB4 = ($ce->{ENABLE_UTF8MB4})?1:0; -print "using utf8mb4 \n\n" if $ENABLE_UTF8MB4; +my $ENABLE_UTF8MB4 = ($ce->{ENABLE_UTF8MB4}) ? 1 : 0; +print "using utf8mb4 \n\n" if $ENABLE_UTF8MB4; # The DBD::MariaDB driver should not get the # mysql_enable_utf8mb4 or mysql_enable_utf8 settings, # but DBD::mysql should. my %utf8_parameters = (); -if ( $ce->{database_driver} =~ /^mysql$/i ) { +if ($ce->{database_driver} =~ /^mysql$/i) { # Only needed for older DBI:mysql driver - if ( $ENABLE_UTF8MB4 ) { + if ($ENABLE_UTF8MB4) { $utf8_parameters{mysql_enable_utf8mb4} = 1; } else { $utf8_parameters{mysql_enable_utf8} = 1; @@ -115,8 +116,8 @@ BEGIN }, ); -build_library_textbook_tree($ce,$dbh,$verbose) if ($all || $textbooks); -build_library_directory_tree($ce,$verbose) if ($all || $directories); -build_library_subject_tree($ce,$dbh,$verbose) if ($all || $subjects); +build_library_textbook_tree($ce, $dbh, $verbose) if ($all || $textbooks); +build_library_directory_tree($ce, $verbose) if ($all || $directories); +build_library_subject_tree($ce, $dbh, $verbose) if ($all || $subjects); 1; diff --git a/bin/upgrade-database-to-utf8mb4.pl b/bin/upgrade-database-to-utf8mb4.pl index c5a2b89b8d..92626fb6fa 100755 --- a/bin/upgrade-database-to-utf8mb4.pl +++ b/bin/upgrade-database-to-utf8mb4.pl @@ -126,7 +126,7 @@ =head1 OPTIONS BEGIN { die "WEBWORK_ROOT not found in environment.\n" unless $ENV{WEBWORK_ROOT}; - die "PG_ROOT not found in environment.\n" unless $ENV{PG_ROOT}; + die "PG_ROOT not found in environment.\n" unless $ENV{PG_ROOT}; } use Getopt::Long qw(:config bundling); @@ -134,8 +134,7 @@ BEGIN use DBI; use String::ShellQuote; -my (@courses, $all, $second_pass, $upgrade_non_native, $no_backup, $dump_file, - $verbose, $show_help); +my (@courses, $all, $second_pass, $upgrade_non_native, $no_backup, $dump_file, $verbose, $show_help); GetOptions( 'c|course-id=s@' => \@courses, 'a|all' => \$all, @@ -177,7 +176,7 @@ BEGIN $replace = <>; chomp($replace); print "Overwriting '$dump_file' with new database dump.\n" if $replace eq 'Y'; - print "Not creating new database dump.\n" if $replace ne 'Y'; + print "Not creating new database dump.\n" if $replace ne 'Y'; if ($replace ne 'Y') { my $proceed = 'n'; @@ -191,8 +190,9 @@ BEGIN if ($replace eq 'Y') { print "Backing up database to '$dump_file'.\n" if $verbose; `$ce->{externalPrograms}{mysqldump} --host=$host --port=$port --user=$dbuser $dbname > $dump_file`; - die("There was an error creating a database backup.\n" . - "Please make a manual backup if needed before proceeding.") if $?; + die("There was an error creating a database backup.\n" + . "Please make a manual backup if needed before proceeding.") + if $?; } } @@ -210,45 +210,47 @@ BEGIN }, ); -my $db = new WeBWorK::DB($ce->{dbLayouts}{$ce->{dbLayoutName}}); +my $db = new WeBWorK::DB($ce->{dbLayouts}{ $ce->{dbLayoutName} }); my @table_types = sort(grep { !$db->{$_}{params}{non_native} } keys %$db); sub checkAndUpdateTableColumnTypes { - my $table = shift; + my $table = shift; my $table_type = shift; - my $pass = shift // 1; + my $pass = shift // 1; print "\tChecking '$table' (pass $pass)\n" if $verbose; my $schema_field_data = $db->{$table_type}{record}->FIELD_DATA; for my $field (keys %$schema_field_data) { my $field_name = $db->{$table_type}{params}{fieldOverride}{$field} || $field; - my @name_type = @{$dbh->selectall_arrayref("SELECT COLUMN_TYPE FROM INFORMATION_SCHEMA.COLUMNS " . - "WHERE TABLE_SCHEMA='$dbname' AND TABLE_NAME='$table' AND COLUMN_NAME='$field_name';")}; - - print("\t\tThe '$field_name' column is missing from '$table'.\n" . - "\t\tYou should upgrade the course via course administration to fix this.\n" . - "\t\tYou may need to run this script again after doing that.\n"), - next if !exists($name_type[0][0]); + my @name_type = @{ + $dbh->selectall_arrayref( + "SELECT COLUMN_TYPE FROM INFORMATION_SCHEMA.COLUMNS " + . "WHERE TABLE_SCHEMA='$dbname' AND TABLE_NAME='$table' AND COLUMN_NAME='$field_name';" + ) + }; + + print("\t\tThe '$field_name' column is missing from '$table'.\n" + . "\t\tYou should upgrade the course via course administration to fix this.\n" + . "\t\tYou may need to run this script again after doing that.\n"), next + if !exists($name_type[0][0]); my $data_type = $name_type[0][0]; - next if !$data_type; + next if !$data_type; $data_type =~ s/\(\d*\)$// if $data_type =~ /^(big|small)?int\(\d*\)$/; $data_type = lc($data_type); my $schema_data_type = lc($schema_field_data->{$field}{type} =~ s/ .*$//r); if ($data_type ne $schema_data_type) { print "\t\tUpdating data type for column '$field_name' in table '$table'\n" if $verbose; - print "\t\t\t$data_type -> $schema_data_type\n" if $verbose; - eval { - $dbh->do("ALTER TABLE `$table` MODIFY $field_name $schema_field_data->{$field}{type};"); - }; + print "\t\t\t$data_type -> $schema_data_type\n" if $verbose; + eval { $dbh->do("ALTER TABLE `$table` MODIFY $field_name $schema_field_data->{$field}{type};"); }; my $indent = $verbose ? "\t\t" : ""; - die("${indent}Failed to modify '$field_name' in '$table' from '$data_type' to '$schema_data_type.\n" . - "${indent}It is recommended that you restore a database backup. Make note of the\n" . - "${indent}error output below as it may help in diagnosing the problem. Note that\n" . - "${indent}the most common reason for this error is the existence of a data value\n" . - "${indent}in a column that does not fit into the smaller size data type that was\n" . - "${indent}needed for the utf8mb4 change.\n$@") - if $@; + die("${indent}Failed to modify '$field_name' in '$table' from '$data_type' to '$schema_data_type.\n" + . "${indent}It is recommended that you restore a database backup. Make note of the\n" + . "${indent}error output below as it may help in diagnosing the problem. Note that\n" + . "${indent}the most common reason for this error is the existence of a data value\n" + . "${indent}in a column that does not fit into the smaller size data type that was\n" + . "${indent}needed for the utf8mb4 change.\n$@") + if $@; } } return 0; @@ -258,19 +260,22 @@ sub checkAndChangeTableCharacterSet { my $table = shift; print "\tChecking character set for '$table'\n" if $verbose; - my @table_data = @{$dbh->selectall_arrayref("SELECT CCSA.character_set_name FROM information_schema.TABLES T, " . - "information_schema.COLLATION_CHARACTER_SET_APPLICABILITY CCSA " . - "WHERE CCSA.collation_name = T.table_collation AND T.table_schema = '$dbname' AND T.table_name = '$table'")}; + my @table_data = @{ + $dbh->selectall_arrayref( + "SELECT CCSA.character_set_name FROM information_schema.TABLES T, " + . "information_schema.COLLATION_CHARACTER_SET_APPLICABILITY CCSA " + . "WHERE CCSA.collation_name = T.table_collation AND T.table_schema = '$dbname' AND T.table_name = '$table'" + ) + }; for (@table_data) { if ($_->[0] ne 'utf8mb4') { print "\t\tConverting '$table' character set to utf8mb4\n" if $verbose; - eval { - $dbh->do("ALTER TABLE `$table` CONVERT TO CHARACTER SET utf8mb4;"); - }; + eval { $dbh->do("ALTER TABLE `$table` CONVERT TO CHARACTER SET utf8mb4;"); }; my $indent = $verbose ? "\t\t" : ""; - die("${indent}Failed to alter charset of '$table' to utf8mb4:\n" . - "${indent}It is recommended that you restore a database backup. Make note of the\n" . - "${indent}error output below as it may help in diagnosing the problem.\n$@") if $@; + die("${indent}Failed to alter charset of '$table' to utf8mb4:\n" + . "${indent}It is recommended that you restore a database backup. Make note of the\n" + . "${indent}error output below as it may help in diagnosing the problem.\n$@") + if $@; } } return 0; @@ -280,15 +285,20 @@ sub checkAndChangeTableCharacterSet { for my $course (@courses) { print("The course '$course' does not exist on the server\n"), next - if !grep($course eq $_, @server_courses); + if !grep($course eq $_, @server_courses); print "Checking tables for '$course'\n" if $verbose; for my $table_type (@table_types) { my $table = "${course}_$table_type"; - next unless @{$dbh->selectall_arrayref("SELECT * FROM INFORMATION_SCHEMA.TABLES " . - "WHERE TABLE_SCHEMA = '$dbname' AND TABLE_NAME='$table';")}; + next + unless @{ + $dbh->selectall_arrayref( + "SELECT * FROM INFORMATION_SCHEMA.TABLES " + . "WHERE TABLE_SCHEMA = '$dbname' AND TABLE_NAME='$table';" + ) + }; - checkAndUpdateTableColumnTypes($table, $table_type); + checkAndUpdateTableColumnTypes($table, $table_type); checkAndChangeTableCharacterSet($table); checkAndUpdateTableColumnTypes($table, $table_type, 2) if ($second_pass); } @@ -300,8 +310,13 @@ sub checkAndChangeTableCharacterSet { my @native_tables = grep { $db->{$_}{params}{non_native} } keys %$db; for my $native_table (@native_tables) { # Skip the fake tables - next unless @{$dbh->selectall_arrayref("SELECT * FROM INFORMATION_SCHEMA.TABLES " . - "WHERE TABLE_SCHEMA = '$dbname' AND TABLE_NAME='$native_table';")}; + next + unless @{ + $dbh->selectall_arrayref( + "SELECT * FROM INFORMATION_SCHEMA.TABLES " + . "WHERE TABLE_SCHEMA = '$dbname' AND TABLE_NAME='$native_table';" + ) + }; checkAndUpdateTableColumnTypes($native_table, $native_table); checkAndChangeTableCharacterSet($native_table); diff --git a/bin/upgrade_admin_db.pl b/bin/upgrade_admin_db.pl index dc160f6e00..4b0792566b 100755 --- a/bin/upgrade_admin_db.pl +++ b/bin/upgrade_admin_db.pl @@ -15,6 +15,7 @@ ################################################################################ my $pg_dir; + BEGIN { die('You need to set the WEBWORK_ROOT environment variable.\n') unless ($ENV{WEBWORK_ROOT}); @@ -44,24 +45,27 @@ BEGIN ############################################################################# my $update_error_msg = ''; -my $CIchecker = new WeBWorK::Utils::CourseIntegrityCheck(ce => $ce); +my $CIchecker = new WeBWorK::Utils::CourseIntegrityCheck(ce => $ce); ############################################################################# # Add missing tables and missing fields to existing tables ############################################################################# -my ($tables_ok,$dbStatus) = $CIchecker->checkCourseTables($upgrade_courseID); -my @schema_table_names = keys %$dbStatus; # update tables missing from database; -my @tables_to_create = grep {$dbStatus->{$_}->[0] == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_A()} @schema_table_names; -my @tables_to_alter = grep {$dbStatus->{$_}->[0] == WeBWorK::Utils::CourseIntegrityCheck::DIFFER_IN_A_AND_B()} @schema_table_names; +my ($tables_ok, $dbStatus) = $CIchecker->checkCourseTables($upgrade_courseID); +my @schema_table_names = keys %$dbStatus; # update tables missing from database; +my @tables_to_create = + grep { $dbStatus->{$_}->[0] == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_A() } @schema_table_names; +my @tables_to_alter = + grep { $dbStatus->{$_}->[0] == WeBWorK::Utils::CourseIntegrityCheck::DIFFER_IN_A_AND_B() } @schema_table_names; $update_error_msg = $CIchecker->updateCourseTables($upgrade_courseID, [@tables_to_create]); -foreach my $table_name (@tables_to_alter) { #warn "do_upgrade_course: adding new fields to table $table_name in course $upgrade_courseID"; - $update_error_msg .= $CIchecker->updateTableFields($upgrade_courseID, $table_name); +foreach my $table_name (@tables_to_alter) +{ #warn "do_upgrade_course: adding new fields to table $table_name in course $upgrade_courseID"; + $update_error_msg .= $CIchecker->updateTableFields($upgrade_courseID, $table_name); } if ($update_error_msg) { - $update_error_msg =~ s/
      /\n/g; - print $update_error_msg."\n"; + $update_error_msg =~ s/
      /\n/g; + print $update_error_msg. "\n"; } else { - print "Admin Course Up to Date\n"; + print "Admin Course Up to Date\n"; } diff --git a/bin/upload-OPL-statistics.pl b/bin/upload-OPL-statistics.pl index 8aeefd89bd..676d96a40c 100755 --- a/bin/upload-OPL-statistics.pl +++ b/bin/upload-OPL-statistics.pl @@ -18,6 +18,7 @@ # This script dumps the local OPL statistics table and uploads it. my $pg_dir; + BEGIN { die "WEBWORK_ROOT not found in environment.\n" unless exists $ENV{WEBWORK_ROOT}; $pg_dir = $ENV{PG_ROOT} // "$ENV{WEBWORK_ROOT}/../pg"; @@ -33,7 +34,7 @@ BEGIN my $ce = new WeBWorK::CourseEnvironment({ webwork_dir => $ENV{WEBWORK_ROOT}, - }); +}); # Get DB connection settings @@ -43,16 +44,16 @@ BEGIN my $dbuser = $ce->{database_username}; my $dbpass = $ce->{database_password}; -my $domainname = domainname() || 'unknown'; -my $time = time(); +my $domainname = domainname() || 'unknown'; +my $time = time(); my $output_file = "$domainname-$time-opl.sql"; - + my $done; my $desc; my $input; my $answered; do { - print <<'END_REQUEST'; + print <<'END_REQUEST'; WeBWorK and the Open Problem Library (OPL) are provided freely under an open-source license. We ask that you share your OPL usage statistics for the benefit of all who use WeBWorK. The following information will be shared @@ -67,103 +68,103 @@ BEGIN Share OPL usage statistics with the WeBWorK community [Y/N]: END_REQUEST - $input = ; - chomp $input; + $input = ; + chomp $input; - if ( $input =~ m/y/i ) { - $answered = 1; - } - elsif ( $input =~ m/n/i ) { - exit; - } -} while ( !$answered ); + if ($input =~ m/y/i) { + $answered = 1; + } elsif ($input =~ m/n/i) { + exit; + } +} while (!$answered); do { - print "\nWe would appreciate it if you could provide \nsome basic information to help us \nkeep track of the data we receive.\n\n"; + print + "\nWe would appreciate it if you could provide \nsome basic information to help us \nkeep track of the data we receive.\n\n"; - $desc = "File:\n$output_file\n"; + $desc = "File:\n$output_file\n"; - print "What university is this data for?\n"; + print "What university is this data for?\n"; - $desc .= "University:\n"; - $input = ; - $desc .= $input; + $desc .= "University:\n"; + $input = ; + $desc .= $input; - print "What department is this data for?\n"; + print "What department is this data for?\n"; - $desc .= "Department:\n"; - $input = ; - $desc .= $input; + $desc .= "Department:\n"; + $input = ; + $desc .= $input; - print "What is your name?\n"; + print "What is your name?\n"; - $desc .= "Name:\n"; - $input = ; - $desc .= $input; + $desc .= "Name:\n"; + $input = ; + $desc .= $input; - print "What is your email address?\n"; + print "What is your email address?\n"; - $desc .= "Email:\n"; - $input = ; - $desc .= $input; + $desc .= "Email:\n"; + $input = ; + $desc .= $input; - print "Have you uploaded data from this server before?\n"; + print "Have you uploaded data from this server before?\n"; - $desc .= "Uploaded Previously:\n"; - $input = ; - $desc .= $input; + $desc .= "Uploaded Previously:\n"; + $input = ; + $desc .= $input; - print "Approximately what years does this data span?\n"; + print "Approximately what years does this data span?\n"; - $desc .= "Years:\n"; - $input = ; - $desc .= $input; + $desc .= "Years:\n"; + $input = ; + $desc .= $input; - print "Approximately how many classes are included?\n"; + print "Approximately how many classes are included?\n"; - $desc .= "Number of Classes:\n"; - $input = ; - $desc .= $input; + $desc .= "Number of Classes:\n"; + $input = ; + $desc .= $input; - print "Additional Comments?\n"; + print "Additional Comments?\n"; - $desc .= "Additional Comments:\n"; - $input = ; - $desc .= $input; + $desc .= "Additional Comments:\n"; + $input = ; + $desc .= $input; - print "The data you just entered is below:\n\n"; + print "The data you just entered is below:\n\n"; - print $desc."\n"; + print $desc. "\n"; - do { - print "Please choose one of the following:\n"; - print "1. Upload Data\n"; - print "2. Reenter above information.\n"; - print "3. Cancel.\n"; - print "[1/2/3]? "; + do { + print "Please choose one of the following:\n"; + print "1. Upload Data\n"; + print "2. Reenter above information.\n"; + print "3. Cancel.\n"; + print "[1/2/3]? "; - $input = ; - chomp $input; + $input = ; + chomp $input; - if ($input eq '3') { - exit; - } elsif ($input eq '2') { - $done = 0; - $answered = 1; - } elsif ($input eq '1') { - $done = 1; - $answered = 1; - } else { - $answered = 0; - } - } while (!$answered); + if ($input eq '3') { + exit; + } elsif ($input eq '2') { + $done = 0; + $answered = 1; + } elsif ($input eq '1') { + $done = 1; + $answered = 1; + } else { + $answered = 0; + } + } while (!$answered); } while (!$done); my $desc_file = "$domainname-$time-desc.txt"; open(my $fh, ">", $desc_file) - or die "Couldn't open file for saving description."; + or die "Couldn't open file for saving description."; print $fh $desc; @@ -182,11 +183,10 @@ BEGIN # see: https://serverfault.com/questions/912162/mysqldump-throws-unknown-table-column-statistics-in-information-schema-1109 # https://github.com/drush-ops/drush/issues/4410 -my $column_statistics_off = ""; -my $test_for_column_statistics = - `$mysqldump_command --help | grep 'column-statistics'`; +my $column_statistics_off = ""; +my $test_for_column_statistics = `$mysqldump_command --help | grep 'column-statistics'`; if ($test_for_column_statistics) { - $column_statistics_off = " --column-statistics=0 "; + $column_statistics_off = " --column-statistics=0 "; } `$mysqldump_command --host=$host --port=$port --user=$dbuser $column_statistics_off $db OPL_local_statistics > $output_file`; diff --git a/clients/hello_world_apps/hello_world_soap_client.pl b/clients/hello_world_apps/hello_world_soap_client.pl index 3b669c673b..400c914e55 100755 --- a/clients/hello_world_apps/hello_world_soap_client.pl +++ b/clients/hello_world_apps/hello_world_soap_client.pl @@ -1,25 +1,19 @@ #!/usr/bin/perl -w - use SOAP::Lite; my $soap = SOAP::Lite -#-> uri('http://math.webwork.rochester.edu/WebworkXMLRPC') -#-> proxy('https://math.webwork.rochester.edu/mod_soap/WebworkWebservice'); --> uri('http://localhost/WebworkXMLRPC') --> proxy('http://localhost/mod_soap/WebworkWebservice'); + #-> uri('http://math.webwork.rochester.edu/WebworkXMLRPC') + #-> proxy('https://math.webwork.rochester.edu/mod_soap/WebworkWebservice'); + ->uri('http://localhost/WebworkXMLRPC')->proxy('http://localhost/mod_soap/WebworkWebservice'); #-> uri('https://devel.webwork.rochester.edu:8002/WebworkXMLRPC') #-> proxy('https://devel.webwork.rochester.edu:8002/mod_soap/WebworkWebservice'); - my $result = $soap->hi(); unless ($result->fault) { print $result->result(); } else { - print join ', ', - $result->faultcode, - $result->faultstring; + print join ', ', $result->faultcode, $result->faultstring; } - diff --git a/clients/hello_world_apps/hello_world_xmlrpc_client.pl b/clients/hello_world_apps/hello_world_xmlrpc_client.pl index 200f34dbd8..a32a9da024 100755 --- a/clients/hello_world_apps/hello_world_xmlrpc_client.pl +++ b/clients/hello_world_apps/hello_world_xmlrpc_client.pl @@ -2,19 +2,15 @@ # use XMLRPC::Lite; - my $soap = XMLRPC::Lite - # -> proxy('https://math.webwork.rochester.edu/mod_xmlrpc/'); - #-> proxy('https://devel.webwork.rochester.edu:8002/mod_xmlrpc/'); - -> proxy('http://localhost/mod_xmlrpc/'); - - - my $result = $soap->call("WebworkXMLRPC.hi"); - +my $soap = XMLRPC::Lite + # -> proxy('https://math.webwork.rochester.edu/mod_xmlrpc/'); + #-> proxy('https://devel.webwork.rochester.edu:8002/mod_xmlrpc/'); + ->proxy('http://localhost/mod_xmlrpc/'); - unless ($result->fault) { - print $result->result(),"\n"; - } else { - print join ', ', - $result->faultcode, - $result->faultstring; - } +my $result = $soap->call("WebworkXMLRPC.hi"); + +unless ($result->fault) { + print $result->result(), "\n"; +} else { + print join ', ', $result->faultcode, $result->faultstring; +} diff --git a/clients/hello_world_apps/webwork_soap_client.pl b/clients/hello_world_apps/webwork_soap_client.pl index 3ed075c12d..cc577d1e14 100755 --- a/clients/hello_world_apps/webwork_soap_client.pl +++ b/clients/hello_world_apps/webwork_soap_client.pl @@ -1,37 +1,35 @@ #!/usr/bin/perl -w use SOAP::Lite; - + # configuration section -use constant HOSTURL => 'localhost'; -use constant HOSTPORT => 80; -use constant TRANSPORT_METHOD => 'SOAP::Lite'; -use constant REQUEST_CLASS =>'WebworkXMLRPC'; # WebworkXMLRPC is used for soap also!! -use constant REQUEST_URI =>'mod_soap'; +use constant HOSTURL => 'localhost'; +use constant HOSTPORT => 80; +use constant TRANSPORT_METHOD => 'SOAP::Lite'; +use constant REQUEST_CLASS => 'WebworkXMLRPC'; # WebworkXMLRPC is used for soap also!! +use constant REQUEST_URI => 'mod_soap'; -my @COMMANDS = qw( listLibraries renderProblem ); #listLib readFile tex2pdf +my @COMMANDS = qw( listLibraries renderProblem ); #listLib readFile tex2pdf # $pg{displayModes} = [ # "plainText", # display raw TeX for math expressions # "images", # display math expressions as images generated by dvipng # "jsMath", # render TeX math expressions on the client side using jsMath # ]; -use constant DISPLAYMODE => 'images'; +use constant DISPLAYMODE => 'images'; # end configuration section use MIME::Base64 qw( encode_base64 decode_base64); - -print STDERR "inputs are ", join (" | ", @ARGV), "\n"; +print STDERR "inputs are ", join(" | ", @ARGV), "\n"; our $source; if (@ARGV) { - my $command = $ARGV[0]; - - warn "executing WebworkXMLRPC.$command"; - $source = (defined $ARGV[1]) ? `cat $ARGV[1]` : '' ; - xmlrpcCall($command); + my $command = $ARGV[0]; + warn "executing WebworkXMLRPC.$command"; + $source = (defined $ARGV[1]) ? `cat $ARGV[1]` : ''; + xmlrpcCall($command); } else { @@ -39,169 +37,156 @@ print STDERR "For example: ./webwork_soap_client renderProblem input.txt\n"; print STDERR "For example: ./webwork_soap_client listLibraries \n"; print STDERR "Commands are: ", join(" ", @COMMANDS), "\n"; - -} - +} sub xmlrpcCall { my $command = shift; - $command = 'listLibraries' unless $command; - - my $requestResult = TRANSPORT_METHOD - ->uri('http://'.HOSTURL.':'.HOSTPORT.'/'.REQUEST_CLASS) - -> proxy('http://'.HOSTURL.':'.HOSTPORT.'/'.REQUEST_URI); - - my $test = [3,4,5,6]; - my $input = setInputTable(); - print "displayMode=",$input->{envir}->{displayMode},"\n"; - local( $result); - # use eval to catch errors - eval { $result = $requestResult->call("$command",$input) }; - print STDERR "There were a lot of errors\n" if $@; - print "Errors: \n $@\n End Errors\n" if $@; - - print "result is|", ref($result),"|"; - - unless (ref($result) and $result->fault) { - - if (ref($result->result())=~/HASH/ and defined($result->result()->{text}) ) { - $result->result()->{text} = decode_base64($result->result()->{text}); - } - print pretty_print_rh($result->result()),"\n"; #$result->result() - } else { - print 'oops ', join ', ', - $result->faultcode, - $result->faultstring; - } + $command = 'listLibraries' unless $command; + + my $requestResult = TRANSPORT_METHOD->uri('http://' . HOSTURL . ':' . HOSTPORT . '/' . REQUEST_CLASS) + ->proxy('http://' . HOSTURL . ':' . HOSTPORT . '/' . REQUEST_URI); + + my $test = [ 3, 4, 5, 6 ]; + my $input = setInputTable(); + print "displayMode=", $input->{envir}->{displayMode}, "\n"; + local ($result); + # use eval to catch errors + eval { $result = $requestResult->call("$command", $input) }; + print STDERR "There were a lot of errors\n" if $@; + print "Errors: \n $@\n End Errors\n" if $@; + + print "result is|", ref($result), "|"; + + unless (ref($result) and $result->fault) { + + if (ref($result->result()) =~ /HASH/ and defined($result->result()->{text})) { + $result->result()->{text} = decode_base64($result->result()->{text}); + } + print pretty_print_rh($result->result()), "\n"; #$result->result() + } else { + print 'oops ', join ', ', $result->faultcode, $result->faultstring; + } } - + sub source { encode_base64($source); } -sub pretty_print_rh { - shift if UNIVERSAL::isa($_[0] => __PACKAGE__); - my $rh = shift; + +sub pretty_print_rh { + shift if UNIVERSAL::isa($_[0] => __PACKAGE__); + my $rh = shift; my $indent = shift || 0; - my $out = ""; - my $type = ref($rh); + my $out = ""; + my $type = ref($rh); if (defined($type) and $type) { $out .= " type = $type; "; - } elsif (! defined($rh )) { + } elsif (!defined($rh)) { $out .= " type = UNDEFINED; "; } - return $out." " unless defined($rh); - - if ( ref($rh) =~/HASH/ or "$rh" =~/HASH/ ) { - $out .= "{\n"; - $indent++; - foreach my $key (sort keys %{$rh}) { - $out .= " "x$indent."$key => " . pretty_print_rh( $rh->{$key}, $indent ) . "\n"; - } - $indent--; - $out .= "\n"." "x$indent."}\n"; - - } elsif (ref($rh) =~ /ARRAY/ or "$rh" =~/ARRAY/) { - $out .= " ( "; - foreach my $elem ( @{$rh} ) { - $out .= pretty_print_rh($elem, $indent); - - } - $out .= " ) \n"; - } elsif ( ref($rh) =~ /SCALAR/ ) { - $out .= "scalar reference ". ${$rh}; - } elsif ( ref($rh) =~/Base64/ ) { - $out .= "base64 reference " .$$rh; + return $out . " " unless defined($rh); + + if (ref($rh) =~ /HASH/ or "$rh" =~ /HASH/) { + $out .= "{\n"; + $indent++; + foreach my $key (sort keys %{$rh}) { + $out .= " " x $indent . "$key => " . pretty_print_rh($rh->{$key}, $indent) . "\n"; + } + $indent--; + $out .= "\n" . " " x $indent . "}\n"; + + } elsif (ref($rh) =~ /ARRAY/ or "$rh" =~ /ARRAY/) { + $out .= " ( "; + foreach my $elem (@{$rh}) { + $out .= pretty_print_rh($elem, $indent); + + } + $out .= " ) \n"; + } elsif (ref($rh) =~ /SCALAR/) { + $out .= "scalar reference " . ${$rh}; + } elsif (ref($rh) =~ /Base64/) { + $out .= "base64 reference " . $$rh; } else { - $out .= $rh; + $out .= $rh; } - - return $out." "; + + return $out . " "; } sub setInputTable_for_listLib { $out = { #password => 'geometry', - pw => 'geometry', - set => 'set0', - library_name => 'rochesterLibrary', - command => 'all', + pw => 'geometry', + set => 'set0', + library_name => 'rochesterLibrary', + command => 'all', }; $out; } + sub setInputTable { $out = { #password => 'geometry', - pw => 'geometry', - set => 'set0', - library_name => 'rochesterLibrary', - command => 'all', - answer_form_submitted => 1, - course => 'daemon_course', - extra_packages_to_load => [qw( AlgParserWithImplicitExpand Expr - ExprWithImplicitExpand AnswerEvaluator - AnswerEvaluatorMaker - )], - mode => 'HTML_dpng', - modules_to_evaluate => [ qw( -Exporter - -DynaLoader - - -GD -WWPlot -Fun -Circle -Label - - -PGrandom -Units -Hermite - -List - - -Match -Multiple -Select - - -AlgParser - -AnswerHash - - -Fraction -VectorField - - -Complex1 -Complex - - -MatrixReal1 Matrix - - -Distributions - -Regression - - )], - envir => environment(), - problem_state => { - - num_of_correct_ans => 2, + pw => 'geometry', + set => 'set0', + library_name => 'rochesterLibrary', + command => 'all', + answer_form_submitted => 1, + course => 'daemon_course', + extra_packages_to_load => [ qw( AlgParserWithImplicitExpand Expr + ExprWithImplicitExpand AnswerEvaluator + AnswerEvaluatorMaker + ) ], + mode => 'HTML_dpng', + modules_to_evaluate => [ qw( + Exporter + + DynaLoader + + GD + WWPlot + Fun + Circle + Label + + PGrandom + Units + Hermite + + List + + Match + Multiple + Select + + AlgParser + + AnswerHash + + Fraction + VectorField + + Complex1 + Complex + + MatrixReal1 Matrix + + Distributions + + Regression + + ) ], + envir => environment(), + problem_state => { + + num_of_correct_ans => 2, num_of_incorrect_ans => 4, recorded_score => 1.0, }, - source => source(), #base64 encoded - - - + source => source(), #base64 encoded + }; $out; @@ -209,67 +194,67 @@ sub setInputTable { sub environment { my $envir = { - answerDate => '4014438528', - CAPA_Graphics_URL=>'http://webwork-db.math.rochester.edu/capa_graphics/', - CAPA_GraphicsDirectory =>'/ww/webwork/CAPA/CAPA_Graphics/', - CAPA_MCTools=>'/ww/webwork/CAPA/CAPA_MCTools/', - CAPA_Tools=>'/ww/webwork/CAPA/CAPA_Tools/', - cgiDirectory=>'Not defined', - cgiURL => 'Not defined', - classDirectory=> 'Not defined', - courseName=>'Not defined', - courseScriptsDirectory=>'/ww/webwork/system/courseScripts/', - displayMode=>DISPLAYMODE, - dueDate=> '4014438528', - externalGif2EpsPath=>'not defined', - externalPng2EpsPath=>'not defined', - fileName=>'set0/prob1a.pg', - formattedAnswerDate=>'6/19/00', - formattedDueDate=>'6/19/00', - formattedOpenDate=>'6/19/00', - functAbsTolDefault=> 0.0000001, - functLLimitDefault=>0, - functMaxConstantOfIntegration=> 1000000000000.0, - functNumOfPoints=> 5, - functRelPercentTolDefault=> 0.000001, - functULimitDefault=>1, - functVarDefault=> 'x', - functZeroLevelDefault=> 0.000001, - functZeroLevelTolDefault=>0.000001, - htmlDirectory =>'/ww/webwork/courses/gage_course/html/', - htmlURL =>'http://webwork-db.math.rochester.edu/gage_course/', - inputs_ref => { - AnSwEr1 => '', - AnSwEr2 => '', - AnSwEr3 => '', + answerDate => '4014438528', + CAPA_Graphics_URL => 'http://webwork-db.math.rochester.edu/capa_graphics/', + CAPA_GraphicsDirectory => '/ww/webwork/CAPA/CAPA_Graphics/', + CAPA_MCTools => '/ww/webwork/CAPA/CAPA_MCTools/', + CAPA_Tools => '/ww/webwork/CAPA/CAPA_Tools/', + cgiDirectory => 'Not defined', + cgiURL => 'Not defined', + classDirectory => 'Not defined', + courseName => 'Not defined', + courseScriptsDirectory => '/ww/webwork/system/courseScripts/', + displayMode => DISPLAYMODE, + dueDate => '4014438528', + externalGif2EpsPath => 'not defined', + externalPng2EpsPath => 'not defined', + fileName => 'set0/prob1a.pg', + formattedAnswerDate => '6/19/00', + formattedDueDate => '6/19/00', + formattedOpenDate => '6/19/00', + functAbsTolDefault => 0.0000001, + functLLimitDefault => 0, + functMaxConstantOfIntegration => 1000000000000.0, + functNumOfPoints => 5, + functRelPercentTolDefault => 0.000001, + functULimitDefault => 1, + functVarDefault => 'x', + functZeroLevelDefault => 0.000001, + functZeroLevelTolDefault => 0.000001, + htmlDirectory => '/ww/webwork/courses/gage_course/html/', + htmlURL => 'http://webwork-db.math.rochester.edu/gage_course/', + inputs_ref => { + AnSwEr1 => '', + AnSwEr2 => '', + AnSwEr3 => '', }, - macroDirectory=>'/ww/webwork/courses/gage_course/templates/macros/', - numAbsTolDefault=>0.0000001, - numFormatDefault=>'%0.13g', - numOfAttempts=> 0, + macroDirectory => '/ww/webwork/courses/gage_course/templates/macros/', + numAbsTolDefault => 0.0000001, + numFormatDefault => '%0.13g', + numOfAttempts => 0, numRelPercentTolDefault => 0.0001, - numZeroLevelDefault =>0.000001, - numZeroLevelTolDefault =>0.000001, - openDate=> '3014438528', - PRINT_FILE_NAMES_FOR => [ 'gage'], - probFileName => 'set0/prob1a.pg', - problemSeed => 1234, - problemValue =>1, - probNum => 13, - psvn => 54321, - psvn=> 54321, - questionNumber => 1, - scriptDirectory => 'Not defined', - sectionName => 'Gage', - sectionNumber => 1, - sessionKey=> 'Not defined', - setNumber =>'MAAtutorial', - studentLogin =>'gage', - studentName => 'Mike Gage', - tempDirectory => '/ww/htdocs/tmp/gage_course/', - templateDirectory=>'/ww/webwork/courses/gage_course/templates/', - tempURL=>'http://webwork-db.math.rochester.edu/tmp/gage_course/', - webworkDocsURL => 'http://webwork.math.rochester.edu/webwork_gage_system_html', + numZeroLevelDefault => 0.000001, + numZeroLevelTolDefault => 0.000001, + openDate => '3014438528', + PRINT_FILE_NAMES_FOR => ['gage'], + probFileName => 'set0/prob1a.pg', + problemSeed => 1234, + problemValue => 1, + probNum => 13, + psvn => 54321, + psvn => 54321, + questionNumber => 1, + scriptDirectory => 'Not defined', + sectionName => 'Gage', + sectionNumber => 1, + sessionKey => 'Not defined', + setNumber => 'MAAtutorial', + studentLogin => 'gage', + studentName => 'Mike Gage', + tempDirectory => '/ww/htdocs/tmp/gage_course/', + templateDirectory => '/ww/webwork/courses/gage_course/templates/', + tempURL => 'http://webwork-db.math.rochester.edu/tmp/gage_course/', + webworkDocsURL => 'http://webwork.math.rochester.edu/webwork_gage_system_html', }; $envir; -}; +} diff --git a/clients/hello_world_apps/webwork_xmlrpc_client.pl b/clients/hello_world_apps/webwork_xmlrpc_client.pl index 1d838471ff..c91abd345c 100755 --- a/clients/hello_world_apps/webwork_xmlrpc_client.pl +++ b/clients/hello_world_apps/webwork_xmlrpc_client.pl @@ -21,20 +21,20 @@ use MIME::Base64 qw( encode_base64 decode_base64); # configuration section -use constant PROTOCOL => 'http'; # or 'http'; -use constant HOSTURL => 'localhost'; -use constant HOSTPORT => '80'; # or 80 -use constant TRANSPORT_METHOD => 'XMLRPC::Lite'; -use constant REQUEST_CLASS => 'WebworkXMLRPC'; # WebworkXMLRPC is used for soap also!! -use constant REQUEST_URI => 'mod_xmlrpc'; -use constant TEMPOUTPUTFILE => '/Users/gage/Desktop/renderProblemOutput.html'; +use constant PROTOCOL => 'http'; # or 'http'; +use constant HOSTURL => 'localhost'; +use constant HOSTPORT => '80'; # or 80 +use constant TRANSPORT_METHOD => 'XMLRPC::Lite'; +use constant REQUEST_CLASS => 'WebworkXMLRPC'; # WebworkXMLRPC is used for soap also!! +use constant REQUEST_URI => 'mod_xmlrpc'; +use constant TEMPOUTPUTFILE => '/Users/gage/Desktop/renderProblemOutput.html'; -our $SITE_URL = 'http://localhost:80'; -our $FORM_ACTION_URL = 'http://localhost:80/webwork2/html2xml'; -our $XML_PASSWORD = 'xmlwebwork'; -our $XML_COURSE = 'gage_course'; +our $SITE_URL = 'http://localhost:80'; +our $FORM_ACTION_URL = 'http://localhost:80/webwork2/html2xml'; +our $XML_PASSWORD = 'xmlwebwork'; +our $XML_COURSE = 'gage_course'; -our $UNIT_TESTS_ON = 0; +our $UNIT_TESTS_ON = 0; #################################################### # get credentials @@ -43,12 +43,12 @@ my $credential_path; my @path_list = ('.ww_credentials', '/Users/gage/.ww_credentials', '/Users/gage/ww_session_credentials'); foreach my $path (@path_list) { - if (-r "$path" ) { + if (-r "$path") { $credential_path = $path; last; } } -unless ( $credential_path ) { +unless ($credential_path) { die < 'images'; - +use constant DISPLAYMODE => 'images'; # end configuration section our $courseID = $credentials{courseID}; -print STDERR "inputs are ", join (" | ", @ARGV), "\n"; +print STDERR "inputs are ", join(" | ", @ARGV), "\n"; our $source; ############################################ # Build client ############################################ -our $xmlrpc_client = new WebworkClient ( - site_url => $SITE_URL, - form_action_url => $FORM_ACTION_URL, - displayMode => DISPLAYMODE(), - - site_password => $credentials{site_password}, - courseID => $credentials{courseID}, - userID => $credentials{userID}, - session_key => $credentials{session_key}, +our $xmlrpc_client = new WebworkClient( + site_url => $SITE_URL, + form_action_url => $FORM_ACTION_URL, + displayMode => DISPLAYMODE(), + + site_password => $credentials{site_password}, + courseID => $credentials{courseID}, + userID => $credentials{userID}, + session_key => $credentials{session_key}, ); # prepare additional input values - - if (@ARGV) { - my $command = $ARGV[0]; - my $result; - print "executing WebworkXMLRPC.$command \n\n-----------------------\n\n"; - given($command) { - when ('renderProblem') { - if ( defined $ARGV[1]) { - if (-r $ARGV[1] ) { - $source = `cat $ARGV[1]`; - $xmlrpc_client->encodeSource($source); - my $input = { - userID => $credentials{userID}||'', - session_key => $credentials{session_key}||'', - courseID => $credentials{courseID}||'', - courseName => $credentials{courseID}||'', - course_password => $credentials{course_password}||'', - site_password => $credentials{site_password}||'', - }; - #print STDERR "input is ", %$input,"\n"; - $result = $xmlrpc_client->xmlrpcCall($command, $input); - print "\n\n Result of renderProblem \n\n"; - print pretty_print_rh($result); + my $command = $ARGV[0]; + my $result; + print "executing WebworkXMLRPC.$command \n\n-----------------------\n\n"; + given ($command) { + when ('renderProblem') { + if (defined $ARGV[1]) { + if (-r $ARGV[1]) { + $source = `cat $ARGV[1]`; + $xmlrpc_client->encodeSource($source); + my $input = { + userID => $credentials{userID} || '', + session_key => $credentials{session_key} || '', + courseID => $credentials{courseID} || '', + courseName => $credentials{courseID} || '', + course_password => $credentials{course_password} || '', + site_password => $credentials{site_password} || '', + }; + #print STDERR "input is ", %$input,"\n"; + $result = $xmlrpc_client->xmlrpcCall($command, $input); + print "\n\n Result of renderProblem \n\n"; + print pretty_print_rh($result); } else { - print STDERR "Can't read source file $ARGV[1]\n"; + print STDERR "Can't read source file $ARGV[1]\n"; } - } else { - print STDERR "Useage: ./webwork_xmlrpc_client.pl command \n"; - } - } when ('listLibraries') { - my $input = { - userID => $credentials{userID}||'', - session_key => $credentials{session_key}||'', - courseID => $credentials{courseID}||'', - course_password => $credentials{course_password}||'', - site_password => $credentials{site_password}||'', - }; - # print STDERR "ww_xmlrpc_client: input for listLibraries command is ", %$input,"\n"; - eval { - $result = $xmlrpc_client->xmlrpcCall($command, $input); + } else { + print STDERR "Useage: ./webwork_xmlrpc_client.pl command \n"; + } + } + when ('listLibraries') { + my $input = { + userID => $credentials{userID} || '', + session_key => $credentials{session_key} || '', + courseID => $credentials{courseID} || '', + course_password => $credentials{course_password} || '', + site_password => $credentials{site_password} || '', }; - if (defined($result) ) { - my @lib_array = @ { $result->{ra_out} }; - print STDOUT "ww_xmlrpc_client: The libraries available in course $courseID are:\n\t ", join("\n\t ", @lib_array ), "\n"; + # print STDERR "ww_xmlrpc_client: input for listLibraries command is ", %$input,"\n"; + eval { $result = $xmlrpc_client->xmlrpcCall($command, $input); }; + if (defined($result)) { + my @lib_array = @{ $result->{ra_out} }; + print STDOUT "ww_xmlrpc_client: The libraries available in course $courseID are:\n\t ", + join("\n\t ", @lib_array), "\n"; } else { print STDOUT "ww_xmlrpc_client: No libraries available for course $courseID\n"; } - } when ('listLib') { - $result = listLib( @ARGV ); - my $command = $ARGV[1]; - print "listLib returned\n"; - print pretty_print_rh($result); - print "\n"; - - } when ('listSets') { - $input = { site_password => 'xmluser', - course_password => $credentials{course_password}, - userID => $credentials{userID}, - courseID => $credentials{courseID}, - }; - my $result = $xmlrpc_client->xmlrpcCall($command, $input); - print pretty_print_rh($result); - } when ('readFile') { - print STDERR "Command $command not yet implemented\n" - } when ('tex2pdf') { - print STDERR "Command $command not yet implemented\n" - } default { - print STDERR "Command '$command' not recognized. Commands ",@COMMANDS; - } - } + } + when ('listLib') { + $result = listLib(@ARGV); + my $command = $ARGV[1]; + print "listLib returned\n"; + print pretty_print_rh($result); + print "\n"; + } + when ('listSets') { + $input = { + site_password => 'xmluser', + course_password => $credentials{course_password}, + userID => $credentials{userID}, + courseID => $credentials{courseID}, + }; + my $result = $xmlrpc_client->xmlrpcCall($command, $input); + print pretty_print_rh($result); + } + when ('readFile') { + print STDERR "Command $command not yet implemented\n" + } + when ('tex2pdf') { + print STDERR "Command $command not yet implemented\n" + } + default { + print STDERR "Command '$command' not recognized. Commands ", @COMMANDS; + } + } - } else { +} else { print STDERR "Useage: ./webwork_xmlrpc_client.pl command [file_name]\n"; - print STDERR "For example: ./webwork_xmlrpc_client.pl renderProblem \n"; print STDERR "Commands are: ", join(" ", @COMMANDS), "\n"; - -} - - +} sub source { return "" unless $source; return encode_base64($source); } + sub listLib { my @ARGS = @_; #print "args for listLib are ", join(" ", @ARGS), "\n"; my $result; - given($ARGS[1]) { - when ("all") { - $input = { site_password => 'xmluser', - course_password => $credentials{course_password}, - userID => $credentials{userID}, - courseID => $credentials{courseID}, - command => 'all', - }; - $result = $xmlrpc_client->xmlrpcCall("listLib", $input); - } - when ('dirOnly') { - my %options = @ARGS[2..$#ARGS]; - my $path = $options{-path} || ''; - my $maxdepth = defined($options{-depth}) ? $options{-depth}: 10000; - $input = { site_password => 'xmluser', - course_password => $credentials{course_password}, - userID => $credentials{userID}, - courseID => $credentials{courseID}, - command => 'dirOnly', - dirPath => $path, - maxdepth => $maxdepth, - }; - $result = $xmlrpc_client->xmlrpcCall("listLib", $input); - } - when('files') { - if ($ARGS[2] ) { - my %options = @ARGS[2..$#ARGS]; - my $path = $options{-path} || ''; - $input = { site_password => 'xmluser', - course_password => $credentials{course_password}, - userID => $credentials{userID}, - courseID => $credentials{courseID}, - command => 'files', - dirPath => $path, - }; + given ($ARGS[1]) { + when ("all") { + $input = { + site_password => 'xmluser', + course_password => $credentials{course_password}, + userID => $credentials{userID}, + courseID => $credentials{courseID}, + command => 'all', + }; + $result = $xmlrpc_client->xmlrpcCall("listLib", $input); + } + when ('dirOnly') { + my %options = @ARGS[ 2 .. $#ARGS ]; + my $path = $options{-path} || ''; + my $maxdepth = defined($options{-depth}) ? $options{-depth} : 10000; + $input = { + site_password => 'xmluser', + course_password => $credentials{course_password}, + userID => $credentials{userID}, + courseID => $credentials{courseID}, + command => 'dirOnly', + dirPath => $path, + maxdepth => $maxdepth, + }; + $result = $xmlrpc_client->xmlrpcCall("listLib", $input); + } + when ('files') { + if ($ARGS[2]) { + my %options = @ARGS[ 2 .. $#ARGS ]; + my $path = $options{-path} || ''; + $input = { + site_password => 'xmluser', + course_password => $credentials{course_password}, + userID => $credentials{userID}, + courseID => $credentials{courseID}, + command => 'files', + dirPath => $path, + }; $result = $xmlrpc_client->xmlrpcCall("listLib", $input); } else { print STDERR "Usage: webwork_xmlrpc_client listLib files \n"; - $result = ""; - } - } - default {print "The possible arguments for listLib are:". - "\n\t all -- print all paths". - "\n\t dirOnly [options]-- print only directories below Library/path". - "\n\t\t options: -depth depth -path directoryPath". - "\n\t\t\t depth counts the number of slashes in the relative path". - "\n\t files -- print .pg files in the given directory \n". - "\n\t\t options: -path directoryPath"; - $result = ""; + $result = ""; + } + } + default { + print "The possible arguments for listLib are:" + . "\n\t all -- print all paths" + . "\n\t dirOnly [options]-- print only directories below Library/path" + . "\n\t\t options: -depth depth -path directoryPath" + . "\n\t\t\t depth counts the number of slashes in the relative path" + . "\n\t files -- print .pg files in the given directory \n" + . "\n\t\t options: -path directoryPath"; + $result = ""; } } return $result; } -sub pretty_print_rh { - shift if UNIVERSAL::isa($_[0] => __PACKAGE__); - my $rh = shift; + +sub pretty_print_rh { + shift if UNIVERSAL::isa($_[0] => __PACKAGE__); + my $rh = shift; my $indent = shift || 0; - my $out = ""; - my $type = ref($rh); + my $out = ""; + my $type = ref($rh); if (defined($type) and $type) { $out .= " type = $type; "; - } elsif (! defined($rh )) { + } elsif (!defined($rh)) { $out .= " type = UNDEFINED; "; } - return $out." " unless defined($rh); - - if ( ref($rh) =~/HASH/ or "$rh" =~/HASH/ ) { - $out .= "{\n"; - $indent++; - foreach my $key (sort keys %{$rh}) { - $out .= " "x$indent."$key => " . pretty_print_rh( $rh->{$key}, $indent ) . "\n"; - } - $indent--; - $out .= "\n"." "x$indent."}\n"; - - } elsif (ref($rh) =~ /ARRAY/ or "$rh" =~/ARRAY/) { - $out .= " ( "; - foreach my $elem ( @{$rh} ) { - $out .= pretty_print_rh($elem, $indent); - - } - $out .= " ) \n"; - } elsif ( ref($rh) =~ /SCALAR/ ) { - $out .= "scalar reference ". ${$rh}; - } elsif ( ref($rh) =~/Base64/ ) { - $out .= "base64 reference " .$$rh; + return $out . " " unless defined($rh); + + if (ref($rh) =~ /HASH/ or "$rh" =~ /HASH/) { + $out .= "{\n"; + $indent++; + foreach my $key (sort keys %{$rh}) { + $out .= " " x $indent . "$key => " . pretty_print_rh($rh->{$key}, $indent) . "\n"; + } + $indent--; + $out .= "\n" . " " x $indent . "}\n"; + + } elsif (ref($rh) =~ /ARRAY/ or "$rh" =~ /ARRAY/) { + $out .= " ( "; + foreach my $elem (@{$rh}) { + $out .= pretty_print_rh($elem, $indent); + + } + $out .= " ) \n"; + } elsif (ref($rh) =~ /SCALAR/) { + $out .= "scalar reference " . ${$rh}; + } elsif (ref($rh) =~ /Base64/) { + $out .= "base64 reference " . $$rh; } else { - $out .= $rh; + $out .= $rh; } - - return $out." "; + + return $out . " "; } -sub pretty_print_json { - shift if UNIVERSAL::isa($_[0] => __PACKAGE__); - my $rh = shift; +sub pretty_print_json { + shift if UNIVERSAL::isa($_[0] => __PACKAGE__); + my $rh = shift; my $indent = shift || 0; - my $out = ""; - my $type = ref($rh); + my $out = ""; + my $type = ref($rh); if (defined($type) and $type) { $out .= " type = $type; "; - } elsif (! defined($rh )) { + } elsif (!defined($rh)) { $out .= " type = UNDEFINED; "; } - return $out." " unless defined($rh); - - if ( ref($rh) =~/HASH/ or "$rh" =~/HASH/ ) { - $out .= "{\n"; - $indent++; - foreach my $key (sort keys %{$rh}) { - $out .= " "x$indent."$key => " . pretty_print_json( $rh->{$key}, $indent ) . "\n"; - } - $indent--; - $out .= "\n"." "x$indent."}\n"; - - } elsif (ref($rh) =~ /ARRAY/ or "$rh" =~/ARRAY/) { - $out .= " ( "; - foreach my $elem ( @{$rh} ) { - $out .= pretty_print_json($elem, $indent); - - } - $out .= " ) \n"; - } elsif ( ref($rh) =~ /SCALAR/ ) { - $out .= "scalar reference ". ${$rh}; - } elsif ( ref($rh) =~/Base64/ ) { - $out .= "base64 reference " .$$rh; + return $out . " " unless defined($rh); + + if (ref($rh) =~ /HASH/ or "$rh" =~ /HASH/) { + $out .= "{\n"; + $indent++; + foreach my $key (sort keys %{$rh}) { + $out .= " " x $indent . "$key => " . pretty_print_json($rh->{$key}, $indent) . "\n"; + } + $indent--; + $out .= "\n" . " " x $indent . "}\n"; + + } elsif (ref($rh) =~ /ARRAY/ or "$rh" =~ /ARRAY/) { + $out .= " ( "; + foreach my $elem (@{$rh}) { + $out .= pretty_print_json($elem, $indent); + + } + $out .= " ) \n"; + } elsif (ref($rh) =~ /SCALAR/) { + $out .= "scalar reference " . ${$rh}; + } elsif (ref($rh) =~ /Base64/) { + $out .= "base64 reference " . $$rh; } else { my $jsonString = $rh; $jsonString =~ s/(\\|\/)/\./g; - $out .= "Library.".$jsonString.";"; + $out .= "Library." . $jsonString . ";"; } - - return $out." "; -} + return $out . " "; +} sub standard_input { $out = { - site_password => 'xmluser', - course_password => $credentials{course_password}, - userID => $credentials{userID}, - set => 'set0', - library_name => 'Library', - command => 'all', - answer_form_submitted => 1, - courseID => $credentials{courseID},, - extra_packages_to_load => [qw( AlgParserWithImplicitExpand Expr - ExprWithImplicitExpand AnswerEvaluator - AnswerEvaluatorMaker - )], - mode => DISPLAYMODE(), - modules_to_evaluate => [ qw( -Exporter -DynaLoader -GD -WWPlot -Fun -Circle -Label -PGrandom -Units -Hermite -List -Match -Multiple -Select -AlgParser -AnswerHash -Fraction -VectorField -Complex1 -Complex -MatrixReal1 Matrix -Distributions -Regression - - )], - envir => environment(), - problem_state => { - - num_of_correct_ans => 2, + site_password => 'xmluser', + course_password => $credentials{course_password}, + userID => $credentials{userID}, + set => 'set0', + library_name => 'Library', + command => 'all', + answer_form_submitted => 1, + courseID => $credentials{courseID}, + , + extra_packages_to_load => [ qw( AlgParserWithImplicitExpand Expr + ExprWithImplicitExpand AnswerEvaluator + AnswerEvaluatorMaker + ) ], + mode => DISPLAYMODE(), + modules_to_evaluate => [ qw( + Exporter + DynaLoader + GD + WWPlot + Fun + Circle + Label + PGrandom + Units + Hermite + List + Match + Multiple + Select + AlgParser + AnswerHash + Fraction + VectorField + Complex1 + Complex + MatrixReal1 Matrix + Distributions + Regression + + ) ], + envir => environment(), + problem_state => { + + num_of_correct_ans => 2, num_of_incorrect_ans => 4, recorded_score => 1.0, }, - source => source(), #base64 encoded - - - + source => source(), #base64 encoded + }; $out; @@ -403,67 +406,67 @@ sub standard_input { sub environment { my $envir = { - answerDate => '4014438528', - CAPA_Graphics_URL=>'http://webwork-db.math.rochester.edu/capa_graphics/', - CAPA_GraphicsDirectory =>'/ww/webwork/CAPA/CAPA_Graphics/', - CAPA_MCTools=>'/ww/webwork/CAPA/CAPA_MCTools/', - CAPA_Tools=>'/ww/webwork/CAPA/CAPA_Tools/', - cgiDirectory=>'Not defined', - cgiURL => 'Not defined', - classDirectory=> 'Not defined', - courseName=>'Not defined', - courseScriptsDirectory=>'/ww/webwork/system/courseScripts/', - displayMode=>DISPLAYMODE, - dueDate=> '4014438528', - externalGif2EpsPath=>'not defined', - externalPng2EpsPath=>'not defined', - fileName=>'set0/prob1a.pg', - formattedAnswerDate=>'6/19/00', - formattedDueDate=>'6/19/00', - formattedOpenDate=>'6/19/00', - functAbsTolDefault=> 0.0000001, - functLLimitDefault=>0, - functMaxConstantOfIntegration=> 1000000000000.0, - functNumOfPoints=> 5, - functRelPercentTolDefault=> 0.000001, - functULimitDefault=>1, - functVarDefault=> 'x', - functZeroLevelDefault=> 0.000001, - functZeroLevelTolDefault=>0.000001, - htmlDirectory =>'/ww/webwork/courses/gage_course/html/', - htmlURL =>'http://webwork-db.math.rochester.edu/gage_course/', - inputs_ref => { - AnSwEr1 => '', - AnSwEr2 => '', - AnSwEr3 => '', + answerDate => '4014438528', + CAPA_Graphics_URL => 'http://webwork-db.math.rochester.edu/capa_graphics/', + CAPA_GraphicsDirectory => '/ww/webwork/CAPA/CAPA_Graphics/', + CAPA_MCTools => '/ww/webwork/CAPA/CAPA_MCTools/', + CAPA_Tools => '/ww/webwork/CAPA/CAPA_Tools/', + cgiDirectory => 'Not defined', + cgiURL => 'Not defined', + classDirectory => 'Not defined', + courseName => 'Not defined', + courseScriptsDirectory => '/ww/webwork/system/courseScripts/', + displayMode => DISPLAYMODE, + dueDate => '4014438528', + externalGif2EpsPath => 'not defined', + externalPng2EpsPath => 'not defined', + fileName => 'set0/prob1a.pg', + formattedAnswerDate => '6/19/00', + formattedDueDate => '6/19/00', + formattedOpenDate => '6/19/00', + functAbsTolDefault => 0.0000001, + functLLimitDefault => 0, + functMaxConstantOfIntegration => 1000000000000.0, + functNumOfPoints => 5, + functRelPercentTolDefault => 0.000001, + functULimitDefault => 1, + functVarDefault => 'x', + functZeroLevelDefault => 0.000001, + functZeroLevelTolDefault => 0.000001, + htmlDirectory => '/ww/webwork/courses/gage_course/html/', + htmlURL => 'http://webwork-db.math.rochester.edu/gage_course/', + inputs_ref => { + AnSwEr1 => '', + AnSwEr2 => '', + AnSwEr3 => '', }, - macroDirectory=>'/ww/webwork/courses/gage_course/templates/macros/', - numAbsTolDefault=>0.0000001, - numFormatDefault=>'%0.13g', - numOfAttempts=> 0, + macroDirectory => '/ww/webwork/courses/gage_course/templates/macros/', + numAbsTolDefault => 0.0000001, + numFormatDefault => '%0.13g', + numOfAttempts => 0, numRelPercentTolDefault => 0.0001, - numZeroLevelDefault =>0.000001, - numZeroLevelTolDefault =>0.000001, - openDate=> '3014438528', - PRINT_FILE_NAMES_FOR => [ 'gage'], - probFileName => 'set0/prob1a.pg', - problemSeed => 1234, - problemValue =>1, - probNum => 13, - psvn => 54321, - psvn=> 54321, - questionNumber => 1, - scriptDirectory => 'Not defined', - sectionName => 'Gage', - sectionNumber => 1, - sessionKey=> 'Not defined', - setNumber =>'MAAtutorial', - studentLogin =>'gage', - studentName => 'Mike Gage', - tempDirectory => '/ww/htdocs/tmp/gage_course/', - templateDirectory=>'/ww/webwork/courses/gage_course/templates/', - tempURL=>'http://webwork-db.math.rochester.edu/tmp/gage_course/', - webworkDocsURL => 'http://webwork.math.rochester.edu/webwork_gage_system_html', + numZeroLevelDefault => 0.000001, + numZeroLevelTolDefault => 0.000001, + openDate => '3014438528', + PRINT_FILE_NAMES_FOR => ['gage'], + probFileName => 'set0/prob1a.pg', + problemSeed => 1234, + problemValue => 1, + probNum => 13, + psvn => 54321, + psvn => 54321, + questionNumber => 1, + scriptDirectory => 'Not defined', + sectionName => 'Gage', + sectionNumber => 1, + sessionKey => 'Not defined', + setNumber => 'MAAtutorial', + studentLogin => 'gage', + studentName => 'Mike Gage', + tempDirectory => '/ww/htdocs/tmp/gage_course/', + templateDirectory => '/ww/webwork/courses/gage_course/templates/', + tempURL => 'http://webwork-db.math.rochester.edu/tmp/gage_course/', + webworkDocsURL => 'http://webwork.math.rochester.edu/webwork_gage_system_html', }; $envir; -}; +} diff --git a/clients/sendXMLRPC.pl b/clients/sendXMLRPC.pl index 5e6e141f20..84a652da8b 100755 --- a/clients/sendXMLRPC.pl +++ b/clients/sendXMLRPC.pl @@ -270,7 +270,6 @@ =head2 Options use strict; use warnings; - ####################################################### # Find the webwork2 root directory ####################################################### @@ -280,31 +279,29 @@ BEGIN } use lib "$main::dirname"; -print "home directory ".$main::dirname."\n"; +print "home directory " . $main::dirname . "\n"; #use lib "."; # is this needed? # some files such as FormatRenderedProblem.pm may need to be in the same directory - BEGIN { - die "WEBWORK_ROOT not found in environment. \n + die "WEBWORK_ROOT not found in environment. \n WEBWORK_ROOT can be defined in your .cshrc or .bashrc file\n It should be set to the webwork2 directory (e.g. /opt/webwork/webwork2)" - unless exists $ENV{WEBWORK_ROOT}; + unless exists $ENV{WEBWORK_ROOT}; # Unused variable, but define it twice to avoid an error message. $WeBWorK::Constants::WEBWORK_DIRECTORY = $ENV{WEBWORK_ROOT}; $WeBWorK::Constants::PG_DIRECTORY = "$ENV{WEBWORK_ROOT}/../pg/"; - unless (-r $WeBWorK::Constants::WEBWORK_DIRECTORY ) { + unless (-r $WeBWorK::Constants::WEBWORK_DIRECTORY) { die "Cannot read webwork root directory at $WeBWorK::Constants::WEBWORK_DIRECTORY"; } - unless (-r $WeBWorK::Constants::PG_DIRECTORY ) { + unless (-r $WeBWorK::Constants::PG_DIRECTORY) { die "Cannot read webwork pg directory at $WeBWorK::Constants::PG_DIRECTORY"; } } use lib "$WeBWorK::Constants::WEBWORK_DIRECTORY/lib"; - use Carp; use LWP::Protocol::https; use Time::HiRes qw/time/; @@ -323,7 +320,6 @@ BEGIN use 5.10.0; $Carp::Verbose = 1; - ### verbose output when UNIT_TESTS_ON =1; our $UNIT_TESTS_ON = 0; @@ -331,22 +327,22 @@ BEGIN # Read command line options ############################################################ -my $display_ans_output1 = ''; +my $display_ans_output1 = ''; my $display_hash_output1 = ''; my $display_html_output1 = ''; -my $record_ok1 = ''; # subroutine needs to be constructed -my $display_ans_output2 = ''; +my $record_ok1 = ''; # subroutine needs to be constructed +my $display_ans_output2 = ''; my $display_hash_output2 = ''; my $display_html_output2 = ''; -my $record_ok2 = ''; -my $verbose = ''; +my $record_ok2 = ''; +my $verbose = ''; my $credentials_path; -my $format = 'standard'; -my $lang = 'en'; -my $edit_source_file = ''; -my $display_tex_output=''; -my $display_pdf_output=''; -my $display_json_output=''; +my $format = 'standard'; +my $lang = 'en'; +my $edit_source_file = ''; +my $display_tex_output = ''; +my $display_pdf_output = ''; +my $display_json_output = ''; my $print_answer_hash; my $print_answer_group; my $print_pg_hash; @@ -361,33 +357,32 @@ BEGIN our @path_list; my $credentials_string; - GetOptions( - 'a' => \$display_ans_output1, - 'A' => \$display_ans_output2, - 'b' => \$display_html_output1, - 'B' => \$display_html_output2, - 'h' => \$display_hash_output1, - 'H' => \$display_hash_output2, - 'c' => \$record_ok1, # record_problem_ok1 needs to be written - 'C' => \$record_ok2, - 'v' => \$verbose, - 'e' => \$edit_source_file, - 'tex' => \$display_tex_output, - 'pdf' => \$display_pdf_output, - 'json' => \$display_json_output, - 'list=s' =>\$read_list_from_this_file, # read file containing list of full file paths - 'pg' => \$print_pg_hash, - 'anshash' => \$print_answer_hash, - 'ansgrp' => \$print_answer_group, + 'a' => \$display_ans_output1, + 'A' => \$display_ans_output2, + 'b' => \$display_html_output1, + 'B' => \$display_html_output2, + 'h' => \$display_hash_output1, + 'H' => \$display_hash_output2, + 'c' => \$record_ok1, # record_problem_ok1 needs to be written + 'C' => \$record_ok2, + 'v' => \$verbose, + 'e' => \$edit_source_file, + 'tex' => \$display_tex_output, + 'pdf' => \$display_pdf_output, + 'json' => \$display_json_output, + 'list=s' => \$read_list_from_this_file, # read file containing list of full file paths + 'pg' => \$print_pg_hash, + 'anshash' => \$print_answer_hash, + 'ansgrp' => \$print_answer_group, 'resource' => \$print_resource_hash, - 'f=s' => \$format, - 'l=s' => \$lang, + 'f=s' => \$format, + 'l=s' => \$lang, 'credentials=s' => \$credentials_path, 'help' => \$print_help_message, 'log=s' => \$path_to_log_file, - 'seed=s' => \$problemSeed, - 'psvn=s' => \$psvn, + 'seed=s' => \$problemSeed, + 'psvn=s' => \$psvn, ); print_help_message() if $print_help_message; @@ -396,24 +391,21 @@ BEGIN # End Read command line options ############################################################ - ################################################################################ # Move up the reading of credential files to here in order to get # WEBWORK_URL defined before it is needed. (For Docker installs when # called from outside Docker, it may not be in the environment variables.) - - #################################################### # get credentials #################################################### # credentials are needed -# credentials file location -- search for one of these files +# credentials file location -- search for one of these files - -@path_list = ("$ENV{HOME}/.ww_credentials", "$ENV{HOME}/ww_session_credentials", 'ww_credentials', 'ww_credentials.dist'); +@path_list = + ("$ENV{HOME}/.ww_credentials", "$ENV{HOME}/ww_session_credentials", 'ww_credentials', 'ww_credentials.dist'); $credentials_string = <$credentials{$_} \n";} + foreach (sort keys %credentials) { print STDERR "$_ =>$credentials{$_} \n"; } } - - ################################################################################ - use lib "$WeBWorK::Constants::WEBWORK_DIRECTORY/lib"; use lib "$WeBWorK::Constants::PG_DIRECTORY/lib"; @@ -553,46 +539,43 @@ BEGIN # The default code is for the macOS and applications commonly available on macOS. ############################################# - #Default display commands. -use constant HTML_DISPLAY_COMMAND => "open -a 'Google Chrome' "; # (MacOS command) -use constant HASH_DISPLAY_COMMAND => ""; # display tempoutputfile to STDOUT +use constant HTML_DISPLAY_COMMAND => "open -a 'Google Chrome' "; # (MacOS command) +use constant HASH_DISPLAY_COMMAND => ""; # display tempoutputfile to STDOUT ### Path to a temporary file for storing the output of sendXMLRPC.pl - use constant TEMPOUTPUTDIR => "$ENV{WEBWORK_ROOT}/DATA/"; - die "You must make the directory ".TEMPOUTPUTDIR(). - " writeable " unless -w TEMPOUTPUTDIR(); - use constant TEMPOUTPUTFILE => TEMPOUTPUTDIR()."temporary_output.html"; - +use constant TEMPOUTPUTDIR => "$ENV{WEBWORK_ROOT}/DATA/"; +die "You must make the directory " . TEMPOUTPUTDIR() . " writeable " unless -w TEMPOUTPUTDIR(); +use constant TEMPOUTPUTFILE => TEMPOUTPUTDIR() . "temporary_output.html"; + ### Default path to a temporary file for storing the output ### of sendXMLRPC.pl use constant LOG_FILE => "$ENV{WEBWORK_ROOT}/DATA/xmlrpc_results.log"; ### Command for editing the pg source file in the browswer -use constant EDIT_COMMAND =>"bbedit"; # for Mac BBedit editor (used as `EDIT_COMMAND() . " $file_path") +use constant EDIT_COMMAND => "bbedit"; # for Mac BBedit editor (used as `EDIT_COMMAND() . " $file_path") ### Command for editing and viewing the tex output of the pg question. -use constant TEX_DISPLAY_COMMAND =>"open -a 'TeXShop'"; +use constant TEX_DISPLAY_COMMAND => "open -a 'TeXShop'"; ### Command for editing and viewing the tex output of the pg question. -use constant PDF_DISPLAY_COMMAND =>"open -a 'Preview'"; +use constant PDF_DISPLAY_COMMAND => "open -a 'Preview'"; ### set display mode -use constant DISPLAYMODE => 'MathJax'; -use constant PROBLEMSEED => '987654321'; +use constant DISPLAYMODE => 'MathJax'; +use constant PROBLEMSEED => '987654321'; ############################################################ # End configure displays for local operating system ############################################################ - -#allow credentials to overrride the default displayMode +#allow credentials to overrride the default displayMode #and the browser display -our $HTML_DISPLAY_COMMAND = $credentials{html_display_command}//HTML_DISPLAY_COMMAND(); -our $HASH_DISPLAY_COMMAND = $credentials{hash_display_command}//HASH_DISPLAY_COMMAND(); -our $DISPLAYMODE = $credentials{ww_display_mode}//DISPLAYMODE(); -our $TEX_DISPLAY_COMMAND = $credentials{tex_display_command}//TEX_DISPLAY_COMMAND(); -our $PDF_DISPLAY_COMMAND = $credentials{pdf_display_command}//PDF_DISPLAY_COMMAND(); +our $HTML_DISPLAY_COMMAND = $credentials{html_display_command} // HTML_DISPLAY_COMMAND(); +our $HASH_DISPLAY_COMMAND = $credentials{hash_display_command} // HASH_DISPLAY_COMMAND(); +our $DISPLAYMODE = $credentials{ww_display_mode} // DISPLAYMODE(); +our $TEX_DISPLAY_COMMAND = $credentials{tex_display_command} // TEX_DISPLAY_COMMAND(); +our $PDF_DISPLAY_COMMAND = $credentials{pdf_display_command} // PDF_DISPLAY_COMMAND(); ################################################## # END gathering credentials for client @@ -604,12 +587,12 @@ BEGIN # course environment is provided by caller and credentials for sendXMLRPC -$path_to_log_file = $path_to_log_file //$credentials{path_to_log_file}//LOG_FILE(); #set log file path. +$path_to_log_file = $path_to_log_file // $credentials{path_to_log_file} // LOG_FILE(); #set log file path. -eval { # attempt to create log file - local(*FH); - open(FH, '>>:encoding(UTF-8)',$path_to_log_file) or die "Can't open file $path_to_log_file for writing"; - close(FH); +eval { # attempt to create log file + local (*FH); + open(FH, '>>:encoding(UTF-8)', $path_to_log_file) or die "Can't open file $path_to_log_file for writing"; + close(FH); }; die "You must first create an output file at $path_to_log_file @@ -622,22 +605,22 @@ BEGIN ############################################ # Build client defaults ############################################ - -my $default_input = { - userID => $credentials{userID}//'', - session_key => $credentials{session_key}//'', - courseID => $credentials{courseID}//'', - courseName => $credentials{courseID}//'', - course_password => $credentials{course_password}//'', + +my $default_input = { + userID => $credentials{userID} // '', + session_key => $credentials{session_key} // '', + courseID => $credentials{courseID} // '', + courseName => $credentials{courseID} // '', + course_password => $credentials{course_password} // '', }; -my $default_form_data = { - displayMode => $DISPLAYMODE, - outputformat => $format//'standard', - problemSeed => $problemSeed//PROBLEMSEED(), - psvn => $psvn//'23456', - forcePortNumber => $credentials{forcePortNumber}//'', - language => $lang//'en', +my $default_form_data = { + displayMode => $DISPLAYMODE, + outputformat => $format // 'standard', + problemSeed => $problemSeed // PROBLEMSEED(), + psvn => $psvn // '23456', + forcePortNumber => $credentials{forcePortNumber} // '', + language => $lang // 'en', }; ################################################## @@ -647,12 +630,12 @@ BEGIN ################################################## # MAIN SECTION gather and process problem template files ################################################## -my $cg_start = time; # this is Time::HiRes's time, which gives floating point values +my $cg_start = time; # this is Time::HiRes's time, which gives floating point values our @files_and_directories = @ARGV; # print "files ", join("|", @files_and_directories), "\n"; -if ($read_list_from_this_file) { - # read a datafile containing list of files to be processed +if ($read_list_from_this_file) { + # read a datafile containing list of files to be processed my $FH = FileHandle->new(" < $read_list_from_this_file"); while (<$FH>) { my $item = $_; @@ -663,7 +646,7 @@ BEGIN warn "skipping $file_path\n" if defined $file_path; next; } - next if $file_path =~ /^\s*#/; # comment lines + next if $file_path =~ /^\s*#/; # comment lines next unless $file_path =~ /\.pg$/; next if $file_path =~ /\-text\.pg$/; next if $file_path =~ /header/i; @@ -671,36 +654,33 @@ BEGIN } FileHandle::close($FH); -} else { +} else { foreach my $item (@files_and_directories) { - if (-d $item) { # if the item is a directory traverse the tree + if (-d $item) { # if the item is a directory traverse the tree my $dir = abs_path($item); find(\&wanted, ($dir)); } elsif ($item eq "-") { - process_pg_file($item); # process STDIN - } elsif (-f $item) { # if the item is a file process it. + process_pg_file($item); # process STDIN + } elsif (-f $item) { # if the item is a file process it. my $file_path = abs_path($item); - next unless $file_path =~ /\.pg$/; # only process pg files - next if $file_path =~ /\-text\.pg$/; # don't process auxiliary include files - next if $file_path =~ /header/i; # don't process header files + next unless $file_path =~ /\.pg$/; # only process pg files + next if $file_path =~ /\-text\.pg$/; # don't process auxiliary include files + next if $file_path =~ /header/i; # don't process header files process_pg_file($file_path); } else { print "$item cannot be found or read\n"; } } } + sub wanted { return '' unless $File::Find::name =~ /\.pg$/; return '' if $File::Find::name =~ /\-text\.pg$/; return '' if $File::Find::name =~ /header/i; - eval{ - process_pg_file($File::Find::name) if -f $File::Find::name; - }; + eval { process_pg_file($File::Find::name) if -f $File::Find::name; }; warn "Error in processing $File::Find::name: $@" if $@; } - - ########################################################## # Subroutines ########################################################## @@ -710,153 +690,158 @@ sub wanted { ####################################################################### sub process_pg_file { - my $file_path = shift; - my $NO_ERRORS = ""; + my $file_path = shift; + my $NO_ERRORS = ""; my $ALL_CORRECT = ""; - my $form_data1 = { %$default_form_data, + my $form_data1 = { + %$default_form_data, - }; + }; if ($display_tex_output or $display_pdf_output) { my $form_data2 = { %$form_data1, - displayMode =>'tex', + displayMode => 'tex', outputformat => 'tex', }; print "process tex files\n" if $UNIT_TESTS_ON; - my ($error_flag, $formatter, $error_string) = - process_problem($file_path, $default_input, $form_data2); - - # create tex file for both and tex and pdf output - my $tex_file_name = create_tex_output($file_path, $formatter); - # display tex file if --tex option is set - if ($display_tex_output) { - system($TEX_DISPLAY_COMMAND." ".TEMPOUTPUTDIR().$tex_file_name); - } elsif($display_pdf_output) { # process tex file to create pdf file and display if --pdf option - my $pdf_path = create_pdf_output($tex_file_name); - system($PDF_DISPLAY_COMMAND." ".$pdf_path); - } + my ($error_flag, $formatter, $error_string) = process_problem($file_path, $default_input, $form_data2); + + # create tex file for both and tex and pdf output + my $tex_file_name = create_tex_output($file_path, $formatter); + # display tex file if --tex option is set + if ($display_tex_output) { + system($TEX_DISPLAY_COMMAND. " " . TEMPOUTPUTDIR() . $tex_file_name); + } elsif ($display_pdf_output) { # process tex file to create pdf file and display if --pdf option + my $pdf_path = create_pdf_output($tex_file_name); + system($PDF_DISPLAY_COMMAND. " " . $pdf_path); + } } if ($display_json_output) { my $form_data2 = { %$form_data1, outputformat => 'json', - displayMode =>'MathJax', + displayMode => 'MathJax', }; print "Creating json\n" if $UNIT_TESTS_ON; - my ($error_flag, $formatter, $error_string) = - process_problem($file_path, $default_input, $form_data2); + my ($error_flag, $formatter, $error_string) = process_problem($file_path, $default_input, $form_data2); my $json_file_name = create_json_output($file_path, $formatter); - print( "Created JSON data in file ", TEMPOUTPUTDIR(), $json_file_name, "\n"); + print("Created JSON data in file ", TEMPOUTPUTDIR(), $json_file_name, "\n"); exit; } - my ($error_flag, $formatter, $error_string) = - process_problem($file_path, $default_input, $form_data1); + my ($error_flag, $formatter, $error_string) = process_problem($file_path, $default_input, $form_data1); # extract and display result - #print "display $file_path\n"; - edit_source_file($file_path) if $edit_source_file; - display_html_output($file_path, $formatter) if $display_html_output1; - display_hash_output($file_path, $formatter) if $display_hash_output1; - display_ans_output($file_path, $formatter) if $display_ans_output1; - $NO_ERRORS = record_problem_ok1($error_flag, $formatter, $file_path) if $record_ok1; - - unless ($display_html_output2 or $display_hash_output2 or $display_ans_output2 or $record_ok2) { - print "DONE -- $NO_ERRORS -- \n"if $verbose; - return; - } + #print "display $file_path\n"; + edit_source_file($file_path) if $edit_source_file; + display_html_output($file_path, $formatter) if $display_html_output1; + display_hash_output($file_path, $formatter) if $display_hash_output1; + display_ans_output($file_path, $formatter) if $display_ans_output1; + $NO_ERRORS = record_problem_ok1($error_flag, $formatter, $file_path) if $record_ok1; + + unless ($display_html_output2 or $display_hash_output2 or $display_ans_output2 or $record_ok2) { + print "DONE -- $NO_ERRORS -- \n" if $verbose; + return; + } ################################################################# # Extract correct answers ################################################################# - my %correct_answers = (); + my %correct_answers = (); my $some_correct_answers_not_specified = 0; - foreach my $ans_id (keys %{$formatter->return_object->{answers}} ) { + foreach my $ans_id (keys %{ $formatter->return_object->{answers} }) { my $ans_obj = $formatter->return_object->{answers}->{$ans_id}; # the answergrps are in PG_ANSWERS_HASH - my $answergroup = $formatter->return_object->{PG_ANSWERS_HASH}->{$ans_id}; - my @response_order = @{$answergroup->{response}->{response_order}}; + my $answergroup = $formatter->return_object->{PG_ANSWERS_HASH}->{$ans_id}; + my @response_order = @{ $answergroup->{response}->{response_order} }; #print scalar(@response_order), " first response $response_order[0] $ans_id\n"; - $ans_obj->{type} = $ans_obj->{type}//''; #make sure it's defined. - if ($ans_obj->{type} eq 'MultiAnswer') { - # singleResponse multianswer type - # an outrageous hack + $ans_obj->{type} = $ans_obj->{type} // ''; #make sure it's defined. + if ($ans_obj->{type} eq 'MultiAnswer') { + # singleResponse multianswer type + # an outrageous hack print "handling MultiAnswer singleResponse type\n" if $verbose; - my $ans_str1 = $ans_obj->{correct_ans}; + my $ans_str1 = $ans_obj->{correct_ans}; my @ans_array1 = split(/\s*;\s*/, $ans_str1); $correct_answers{$ans_id} = shift @ans_array1; my $num_extra_elements = scalar(@ans_array1); - foreach my $i (1..$num_extra_elements) { # pick up the remaining blanks - my $response_id = "MuLtIaNsWeR_${ans_id}_${i}"; #MuLtIaNsWeR_AnSwEr0003_1 + foreach my $i (1 .. $num_extra_elements) { # pick up the remaining blanks + my $response_id = "MuLtIaNsWeR_${ans_id}_${i}"; #MuLtIaNsWeR_AnSwEr0003_1 $correct_answers{$response_id} = shift @ans_array1; #print "\t\t $response_id => $correct_answers{$response_id}\n"; } - } elsif ($ans_obj->{type} =~ /checkbox/i) { #type is probably checkbox_cmp - my $ans_str = $ans_obj->{correct_ans}; #an unseparated answer string + } elsif ($ans_obj->{type} =~ /checkbox/i) { #type is probably checkbox_cmp + my $ans_str = $ans_obj->{correct_ans}; #an unseparated answer string $ans_str =~ s/^\s*//; - $ans_str =~ s/\s*$//; #trim white space off ends (probably unnecessary) - my @temp = split("",$ans_str); #split into array of characters - my $new_ans_str = join("\0", @temp); # join them in "packed" form separated with nulls - $correct_answers{$ans_id}=$new_ans_str; - } elsif (1==@response_order and $ans_id eq $response_order[0] ) { - # only one response -- not MultiAnswer singleResponse - # most answers are of this type - # should we use correct answer or correct value? -- this seems to vary - #warn "just one answer blank for this answer evaluator"; - $correct_answers{$ans_id}=($ans_obj->{correct_ans})//($ans_obj->{correct_value}); - } else { # more than one response - if ($ans_obj->{type} =~ /Matrix/) { - #FIXME -- another outrageous hackkkk but it works + $ans_str =~ s/\s*$//; #trim white space off ends (probably unnecessary) + my @temp = split("", $ans_str); #split into array of characters + my $new_ans_str = join("\0", @temp); # join them in "packed" form separated with nulls + $correct_answers{$ans_id} = $new_ans_str; + } elsif (1 == @response_order and $ans_id eq $response_order[0]) { + # only one response -- not MultiAnswer singleResponse + # most answers are of this type + # should we use correct answer or correct value? -- this seems to vary + #warn "just one answer blank for this answer evaluator"; + $correct_answers{$ans_id} = ($ans_obj->{correct_ans}) // ($ans_obj->{correct_value}); + } else { # more than one response + if ($ans_obj->{type} =~ /Matrix/) { + #FIXME -- another outrageous hackkkk but it works #print "responding to matrix answer with several ans_blanks\n"; #print "responses", join(" ", %{$answergroup->{response}->{responses}}),"\n"; #print "correct answer ", $ans_obj->{correct_value}, "\n"; - my $ans_str = ($ans_obj->{correct_value})//($ans_obj->{correct_ans}); #(correct_ans can have html formatting -- not good) $ans_str =~ s/\[//g; + my $ans_str = ($ans_obj->{correct_value}) + // ($ans_obj->{correct_ans}) + ; #(correct_ans can have html formatting -- not good) $ans_str =~ s/\[//g; $ans_str =~ s/\]//g; my @ans_array = split(/\s*,\s*/, $ans_str); foreach my $response_id (@response_order) { $correct_answers{$response_id} = shift @ans_array; } } else { - warn "responding to an answer evaluator of type |".$ans_obj->{type}. - "| with ".scalar(@response_order)." ans_blanks: ", - join(" ",@response_order),"\n" if $UNIT_TESTS_ON; - $correct_answers{$ans_id}=($ans_obj->{correct_ans})//($ans_obj->{correct_value})//''; + warn "responding to an answer evaluator of type |" + . $ans_obj->{type} + . "| with " + . scalar(@response_order) + . " ans_blanks: ", join(" ", @response_order), "\n" + if $UNIT_TESTS_ON; + $correct_answers{$ans_id} = ($ans_obj->{correct_ans}) // ($ans_obj->{correct_value}) // ''; } } #FIXME hack to get rid of html protection of < and > for vectors - $correct_answers{$ans_id}=~s/>/>/g; - $correct_answers{$ans_id}=~s/</||g; # some answers have breaks in them for clarity - if ($correct_answers{$ans_id} eq "No correct answer specified" ) { + $correct_answers{$ans_id} =~ s/>/>/g; + $correct_answers{$ans_id} =~ s/</||g; # some answers have breaks in them for clarity + if ($correct_answers{$ans_id} eq "No correct answer specified") { warn "this question has an answer blank with no correct answer specified"; - $some_correct_answers_not_specified ++; + $some_correct_answers_not_specified++; } - } #end loop collecting correct answers. - # adjust input and reinitialize form_data - my $form_data2 = { %$default_form_data, - answersSubmitted => 1, - WWsubmit => 1, # grade answers - WWcorrectAns => 1, # show correct answers - %correct_answers - }; + } #end loop collecting correct answers. + # adjust input and reinitialize form_data + my $form_data2 = { + %$default_form_data, + answersSubmitted => 1, + WWsubmit => 1, # grade answers + WWcorrectAns => 1, # show correct answers + %correct_answers + }; - my $pg_start = time; # this is Time::HiRes's time, which gives floating point values + my $pg_start = time; # this is Time::HiRes's time, which gives floating point values - ($error_flag, $formatter, $error_string)=(); - ($error_flag, $formatter, $error_string) = - process_problem($file_path, $default_input, $form_data2); - my $pg_stop = time; - my $pg_duration = $pg_stop-$pg_start; + ($error_flag, $formatter, $error_string) = (); + ($error_flag, $formatter, $error_string) = process_problem($file_path, $default_input, $form_data2); + my $pg_stop = time; + my $pg_duration = $pg_stop - $pg_start; display_html_output($file_path, $formatter) if $display_html_output2; display_hash_output($file_path, $formatter) if $display_hash_output2; - display_ans_output($file_path, $formatter) if $display_ans_output2; - $ALL_CORRECT = record_problem_ok2($error_flag, $formatter, $file_path, $some_correct_answers_not_specified, $pg_duration) if $record_ok2; + display_ans_output($file_path, $formatter) if $display_ans_output2; + $ALL_CORRECT = + record_problem_ok2($error_flag, $formatter, $file_path, $some_correct_answers_not_specified, $pg_duration) + if $record_ok2; #print "display the correct answers here"; - display_inputs(%correct_answers) if $verbose; # choice of correct answers submitted - # should this information on what answers are being submitted have an option switch? + display_inputs(%correct_answers) if $verbose; # choice of correct answers submitted + # should this information on what answers are being submitted have an option switch? - print "DONE -- $NO_ERRORS -- $ALL_CORRECT\n"if $verbose; + print "DONE -- $NO_ERRORS -- $ALL_CORRECT\n" if $verbose; } ####################################################################### @@ -865,8 +850,8 @@ sub process_pg_file { sub process_problem { my $file_path = shift; - my $input = shift; - my $form_data = shift; + my $input = shift; + my $form_data = shift; # %credentials is global ### get source and correct file_path name so that it is relative to templates directory @@ -874,117 +859,113 @@ sub process_problem { my ($adj_file_path, $source) = get_source($file_path); #print "find file at $adj_file_path ", length($source), "\n"; - ### build client - my $xmlrpc_client = new WebworkClient ( - site_url => $credentials{site_url}, - form_action_url => $credentials{form_action_url}, - site_password => $credentials{site_password}//'', - courseID => $credentials{courseID}, - userID => $credentials{userID}, - session_key => $credentials{session_key}//'', - sourceFilePath => $adj_file_path, + my $xmlrpc_client = new WebworkClient( + site_url => $credentials{site_url}, + form_action_url => $credentials{form_action_url}, + site_password => $credentials{site_password} // '', + courseID => $credentials{courseID}, + userID => $credentials{userID}, + session_key => $credentials{session_key} // '', + sourceFilePath => $adj_file_path, ); - + ### update client $xmlrpc_client->encodeSource($source); - $xmlrpc_client->form_data( $form_data ); - + $xmlrpc_client->form_data($form_data); + ### update inputs my $problemSeed = $form_data->{problemSeed}; die "problem seed not defined in sendXMLRPC::process_problem" unless $problemSeed; - - my $local_psvn = $form_data->{psvn}//34567; - my $updated_input = {%$input, - envir => $xmlrpc_client->environment( - fileName => $adj_file_path, - sourceFilePath => $adj_file_path, - psvn => $local_psvn, - problemSeed => $problemSeed,), + my $local_psvn = $form_data->{psvn} // 34567; + my $updated_input = { + %$input, + envir => $xmlrpc_client->environment( + fileName => $adj_file_path, + sourceFilePath => $adj_file_path, + psvn => $local_psvn, + problemSeed => $problemSeed, + ), }; - $form_data->{showAnsGroupInfo} = $print_answer_group; - $form_data->{showAnsHashInfo} = $print_answer_hash; - $form_data->{showPGInfo} = $print_pg_hash; - $form_data->{showResourceInfo} = $print_resource_hash; - - + $form_data->{showAnsGroupInfo} = $print_answer_group; + $form_data->{showAnsHashInfo} = $print_answer_hash; + $form_data->{showPGInfo} = $print_pg_hash; + $form_data->{showResourceInfo} = $print_resource_hash; ################################################## # Process the pg file ################################################## ### store the time before we invoke the content generator - my $cg_start = time; # this is Time::HiRes's time, which gives floating point values + my $cg_start = time; # this is Time::HiRes's time, which gives floating point values ############################################ # Call server via xmlrpc_client to render problem ############################################ - - our($return_object, $error_flag, $error_string); - $error_flag=0; $error_string=''; - - - - - + + our ($return_object, $error_flag, $error_string); + $error_flag = 0; + $error_string = ''; + $return_object = $xmlrpc_client->xmlrpcCall('renderProblem', $updated_input); - + ####################################################################### # Handle errors ####################################################################### - - unless ( $xmlrpc_client->fault ) { + + unless ($xmlrpc_client->fault) { print "\n\n Result of renderProblem \n\n" if $UNIT_TESTS_ON; - print pretty_print_rh($return_object) if $UNIT_TESTS_ON; - if (not defined $return_object) { #FIXME make sure this is the right error message if site is unavailable - $error_string = "0\t Could not connect to rendering site ". $xmlrpc_client->{url}."\n"; - } elsif (defined($return_object->{flags}->{error_flag}) and $return_object->{flags}->{error_flag} ) { + print pretty_print_rh($return_object) if $UNIT_TESTS_ON; + if (not defined $return_object) { #FIXME make sure this is the right error message if site is unavailable + $error_string = "0\t Could not connect to rendering site " . $xmlrpc_client->{url} . "\n"; + } elsif (defined($return_object->{flags}->{error_flag}) and $return_object->{flags}->{error_flag}) { $error_string = "0\t $file_path has errors\n"; - } elsif (defined($return_object->{errors}) and $return_object->{errors} ){ + } elsif (defined($return_object->{errors}) and $return_object->{errors}) { $error_string = "0\t $file_path has syntax errors\n"; } - $error_flag=1 if $return_object->{errors}; + $error_flag = 1 if $return_object->{errors}; } else { - $error_flag=1; - $error_string = $xmlrpc_client->return_object; # error report - } - + $error_flag = 1; + $error_string = $xmlrpc_client->return_object; # error report + } + ################################################## -# Create FormatRenderedProblems object -- not needed for sendXMLRPC + # Create FormatRenderedProblems object -- not needed for sendXMLRPC ################################################## ################################################## # log elapsed time ################################################## - my $scriptName = 'sendXMLRPC'; - my $cg_end = time; + my $scriptName = 'sendXMLRPC'; + my $cg_end = time; my $cg_duration = $cg_end - $cg_start; - WebworkClient::writeRenderLogEntry("", - "{script:$scriptName; file:$file_path; ". - sprintf("duration: %.3f sec;", $cg_duration). - " site_url: $credentials{site_url}; }",''); - + WebworkClient::writeRenderLogEntry( + "", + "{script:$scriptName; file:$file_path; " + . sprintf("duration: %.3f sec;", $cg_duration) + . " site_url: $credentials{site_url}; }", + '' + ); + ####################################################################### # End processing of the pg file ####################################################################### - my $formatter = $xmlrpc_client; ## for compatibility with standalonePGproblemRenderer + my $formatter = $xmlrpc_client; ## for compatibility with standalonePGproblemRenderer return $error_flag, $formatter, $error_string; } - - sub create_pdf_output { my $tex_file_name = shift; - my @errors=(); + my @errors = (); print "pdf mode\n" if $UNIT_TESTS_ON; my $pdf_file_name = $tex_file_name; $pdf_file_name =~ s/\.\w+$/\.pdf/; # replace extension with pdf - + ########################################## # create working directory ########################################## - + # create a randomly-named working directory in the TEMPOUTPUTDIR() directory my $working_dir_path = eval { tempdir("work.XXXXXXXX", DIR => TEMPOUTPUTDIR()) }; if ($@) { @@ -995,63 +976,61 @@ sub create_pdf_output { # do some error checking unless (-e $working_dir_path) { - push @errors, "Temporary directory ".$working_dir_path - ." does not exist, but creation didn't fail. This shouldn't happen."; + push @errors, + "Temporary directory " + . $working_dir_path + . " does not exist, but creation didn't fail. This shouldn't happen."; } unless (-w $working_dir_path) { - push @errors, "Temporary directory ".$working_dir_path - ." is not writeable."; + push @errors, "Temporary directory " . $working_dir_path . " is not writeable."; } - + # catch errors if directory is not made (should be global, outside subroutine) if (@errors) { - print "There were errors in creating the working directory for processing tex to pdf. \n". - join("\n", @errors); - delete_temp_dir($working_dir_path); - return 0; # FAIL if no working directory + print "There were errors in creating the working directory for processing tex to pdf. \n" . join("\n", @errors); + delete_temp_dir($working_dir_path); + return 0; # FAIL if no working directory } - - + ######################################## # try to mv the tex file into the working directory ######################################## - my $src_path = TEMPOUTPUTDIR().$tex_file_name; + my $src_path = TEMPOUTPUTDIR() . $tex_file_name; my $dest_path = "$working_dir_path/$tex_file_name"; - my $mv_cmd = "2>&1 mv ". shell_quote("$src_path", "$dest_path"); - my $mv_out = readpipe $mv_cmd; + my $mv_cmd = "2>&1 mv " . shell_quote("$src_path", "$dest_path"); + my $mv_out = readpipe $mv_cmd; if ($?) { - push @errors, "Failed to rename $src_path to " - ."$dest_path in directory \n" - ."$mv_out"; - print join("\n",@errors); + push @errors, "Failed to rename $src_path to " . "$dest_path in directory \n" . "$mv_out"; + print join("\n", @errors); } ########################################## # process tex file to pdf (if working directory was created) ########################################## - @errors =(); # reset errors - + @errors = (); # reset errors + my $tex_file_path = $dest_path; - my $pdf_path = "$working_dir_path/$pdf_file_name"; + my $pdf_path = "$working_dir_path/$pdf_file_name"; print "pdflatex $tex_file_path\n" if $UNIT_TESTS_ON; - + # call pdflatex - we don't want to chdir in the mod_perl process, as # that might step on the feet of other things (esp. in Apache 2.0) - my $pdflatex_cmd = "cd " . shell_quote($working_dir_path) . " && " + my $pdflatex_cmd = "cd " + . shell_quote($working_dir_path) . " && " . "pdflatex" . " $tex_file_name >pdflatex.stdout 2>pdflatex.stderr hardcopy"; if (my $rawexit = system $pdflatex_cmd) { - my $exit = $rawexit >> 8; + my $exit = $rawexit >> 8; my $signal = $rawexit & 127; - my $core = $rawexit & 128; - push @errors, "Failed to convert TeX to PDF with command $pdflatex_cmd))" - ." (exit=$exit signal=$signal core=$core)."; - + my $core = $rawexit & 128; + push @errors, + "Failed to convert TeX to PDF with command $pdflatex_cmd))" . " (exit=$exit signal=$signal core=$core)."; + # read hardcopy.log and report first error my $hardcopy_log = "$working_dir_path/$tex_file_name"; - $hardcopy_log =~ s/\.tex$/\.log/; # replace extension + $hardcopy_log =~ s/\.tex$/\.log/; # replace extension if (-e $hardcopy_log) { if (open my $LOG, "<", $hardcopy_log) { my $line; @@ -1076,220 +1055,215 @@ sub create_pdf_output { push @errors, "No TeX log was found."; } } - + ######################################## # try to rename the pdf file ######################################## - my $src_path1 = $pdf_path; - my $final_pdf_path = TEMPOUTPUTDIR().$pdf_file_name; - my $mv_cmd1 = "2>&1 mv ". shell_quote("$src_path1", "$final_pdf_path"); - my $mv_out1 = readpipe $mv_cmd1; + my $src_path1 = $pdf_path; + my $final_pdf_path = TEMPOUTPUTDIR() . $pdf_file_name; + my $mv_cmd1 = "2>&1 mv " . shell_quote("$src_path1", "$final_pdf_path"); + my $mv_out1 = readpipe $mv_cmd1; if ($?) { - push @errors, "Failed to rename $src_path to " - ."$final_pdf_path in directory \n" - ."$mv_out1"; + push @errors, "Failed to rename $src_path to " . "$final_pdf_path in directory \n" . "$mv_out1"; } - - ################################################## + ################################################## # remove the temp directory if there are no errors ################################################## if (@errors) { - print "Errors in converting the tex file to pdf: ".join("\n", @errors); + print "Errors in converting the tex file to pdf: " . join("\n", @errors); return 0; } - + unless (@errors or $UNIT_TESTS_ON) { delete_temp_dir($working_dir_path); - } - - - - + } + # return path to pdf file print "pdflatex to $final_pdf_path DONE\n" if $UNIT_TESTS_ON; # this is doable but will require changing directories # look at the solution done using hardcopy - return $final_pdf_path;} + return $final_pdf_path; +} # helper function to remove temp dirs sub delete_temp_dir { my ($temp_dir_path) = @_; - - my $rm_cmd = "2>&1 rm -rf " . shell_quote($temp_dir_path); #can use perl command for this?? + + my $rm_cmd = "2>&1 rm -rf " . shell_quote($temp_dir_path); #can use perl command for this?? my $rm_out = readpipe $rm_cmd; if ($?) { - print "Failed to remove temporary directory '".$temp_dir_path."':\n$rm_out\n"; + print "Failed to remove temporary directory '" . $temp_dir_path . "':\n$rm_out\n"; return 0; } else { return 1; } } - sub create_tex_output { - my $file_path = shift; - my $formatter = shift; + my $file_path = shift; + my $formatter = shift; my $output_text = $formatter->formatRenderedProblem; - $file_path =~s|/$||; # remove final / + $file_path =~ s|/$||; # remove final / $file_path =~ m|/?([^/]+)$|; my $file_name = $1; $file_name =~ s/\.\w+$/\.tex/; # replace extension with tex - my $output_file = TEMPOUTPUTDIR().$file_name; - local(*FH); + my $output_file = TEMPOUTPUTDIR() . $file_name; + local (*FH); open(FH, '>:encoding(UTF-8)', $output_file) or die "Can't open file $output_file for writing"; print FH $output_text; close(FH); print "tex result sent to $output_file\n" if $UNIT_TESTS_ON; -# sleep 5; #wait 5 seconds -# unlink($output_file); + # sleep 5; #wait 5 seconds + # unlink($output_file); return $file_name; } sub create_json_output { - my $file_path = shift; - my $formatter = shift; + my $file_path = shift; + my $formatter = shift; my $output_text = $formatter->formatRenderedProblem; - $file_path =~s|/$||; # remove final / + $file_path =~ s|/$||; # remove final / $file_path =~ m|/?([^/]+)$|; my $file_name = $1; $file_name =~ s/\.\w+$/\.json/; # replace extension with json - my $output_file = TEMPOUTPUTDIR().$file_name; - local(*FH); + my $output_file = TEMPOUTPUTDIR() . $file_name; + local (*FH); open(FH, '>:encoding(UTF-8)', $output_file) or die "Can't open file $output_file for writing"; print FH $output_text; close(FH); print "json result sent to $output_file\n" if $UNIT_TESTS_ON; -# sleep 5; #wait 5 seconds -# unlink($output_file); + # sleep 5; #wait 5 seconds + # unlink($output_file); return $file_name; } -sub display_html_output { #display the problem in a browser - my $file_path = shift; - my $formatter = shift; +sub display_html_output { #display the problem in a browser + my $file_path = shift; + my $formatter = shift; my $output_text = $formatter->formatRenderedProblem; - $file_path =~s|/$||; # remove final / + $file_path =~ s|/$||; # remove final / $file_path =~ m|/?([^/]+)$|; my $file_name = $1; $file_name =~ s/\.\w+$/\.html/; # replace extension with html - my $output_file = TEMPOUTPUTDIR().$file_name; - local(*FH); + my $output_file = TEMPOUTPUTDIR() . $file_name; + local (*FH); open(FH, '>:encoding(UTF-8)', $output_file) or die "Can't open file $output_file for writing"; print FH $output_text; close(FH); - system($HTML_DISPLAY_COMMAND." ".$output_file); - sleep 5; #wait 1 seconds + system($HTML_DISPLAY_COMMAND. " " . $output_file); + sleep 5; #wait 1 seconds unlink($output_file); } -sub display_hash_output { # print the entire hash output to the command line - my $file_path = shift; - my $formatter = shift; +sub display_hash_output { # print the entire hash output to the command line + my $file_path = shift; + my $formatter = shift; my $output_text = $formatter->formatRenderedProblem; - $file_path =~s|/$||; # remove final / + $file_path =~ s|/$||; # remove final / $file_path =~ m|/?([^/]+)$|; my $file_name = $1; $file_name =~ s/\.\w+$/\.txt/; # replace extension with html - my $output_file = TEMPOUTPUTDIR().$file_name; + my $output_file = TEMPOUTPUTDIR() . $file_name; my $output_text2 = pretty_print_rh($output_text); print STDOUT $output_text2; -# local(*FH); -# open(FH, '>', $output_file) or die "Can't open file $output_file writing"; -# print FH $output_text2; -# close(FH); -# -# system($HASH_DISPLAY_COMMAND().$output_file."; rm $output_file;"); + # local(*FH); + # open(FH, '>', $output_file) or die "Can't open file $output_file writing"; + # print FH $output_text2; + # close(FH); + # + # system($HASH_DISPLAY_COMMAND().$output_file."; rm $output_file;"); #sleep 1; #wait 1 seconds #unlink($output_file); } -sub display_ans_output { # print the collection of answer hashes to the command line - my $file_path = shift; - my $formatter = shift; - my $return_object = $formatter->return_object; - $file_path =~s|/$||; # remove final / +sub display_ans_output { # print the collection of answer hashes to the command line + my $file_path = shift; + my $formatter = shift; + my $return_object = $formatter->return_object; + $file_path =~ s|/$||; # remove final / $file_path =~ m|/?([^/]+)$|; my $file_name = $1; $file_name =~ s/\.\w+$/\.txt/; # replace extension with html - my $output_file = TEMPOUTPUTDIR().$file_name; + my $output_file = TEMPOUTPUTDIR() . $file_name; my $output_text = pretty_print_rh($return_object->{answers}); print STDOUT $output_text; -# local(*FH); -# open(FH, '>', $output_file) or die "Can't open file $output_file writing"; -# print FH $output_text; -# close(FH); -# -# system($HASH_DISPLAY_COMMAND().$output_file."; rm $output_file;"); -# sleep 1; #wait 1 seconds -# unlink($output_file); + # local(*FH); + # open(FH, '>', $output_file) or die "Can't open file $output_file writing"; + # print FH $output_text; + # close(FH); + # + # system($HASH_DISPLAY_COMMAND().$output_file."; rm $output_file;"); + # sleep 1; #wait 1 seconds + # unlink($output_file); } - sub record_problem_ok1 { - my $error_flag = shift//''; - my $formatter = shift; # for formatting - my $file_path = shift; + my $error_flag = shift // ''; + my $formatter = shift; # for formatting + my $file_path = shift; my $return_string = ''; my $return_object = $formatter->return_object; - if (defined($return_object->{flags}->{DEBUG_messages}) ) { - my @debug_messages = @{$return_object->{flags}->{DEBUG_messages}}; - $return_string .= (pop @debug_messages ) ||'' ; #avoid error if array was empty + if (defined($return_object->{flags}->{DEBUG_messages})) { + my @debug_messages = @{ $return_object->{flags}->{DEBUG_messages} }; + $return_string .= (pop @debug_messages) || ''; #avoid error if array was empty if (@debug_messages) { $return_string .= join(" ", @debug_messages); } else { - $return_string = ""; + $return_string = ""; } } - if (defined($return_object->{errors}) ) { - $return_string= $return_object->{errors}; + if (defined($return_object->{errors})) { + $return_string = $return_object->{errors}; } - if (defined($return_object->{flags}->{WARNING_messages}) ) { - my @warning_messages = @{$return_object->{flags}->{WARNING_messages}}; - $return_string .= (pop @warning_messages)||''; #avoid error if array was empty - $@=undef; + if (defined($return_object->{flags}->{WARNING_messages})) { + my @warning_messages = @{ $return_object->{flags}->{WARNING_messages} }; + $return_string .= (pop @warning_messages) || ''; #avoid error if array was empty + $@ = undef; if (@warning_messages) { $return_string .= join(" ", @warning_messages); } else { $return_string = ""; } } - my $SHORT_RETURN_STRING = ($return_string)?"has errors":"ok"; + my $SHORT_RETURN_STRING = ($return_string) ? "has errors" : "ok"; unless ($return_string) { $return_string = "1\t $file_path is ok\n"; } else { $return_string = "0\t $file_path has errors\n"; } - - local(*FH); - open(FH, '>>:encoding(UTF-8)',$path_to_log_file) or die "Can't open file $path_to_log_file for writing"; + + local (*FH); + open(FH, '>>:encoding(UTF-8)', $path_to_log_file) or die "Can't open file $path_to_log_file for writing"; print FH $return_string; close(FH); return $SHORT_RETURN_STRING; } + sub record_problem_ok2 { - my $error_flag = shift//''; - my $formatter = shift; - my $file_path = shift; + my $error_flag = shift // ''; + my $formatter = shift; + my $file_path = shift; my $some_correct_answers_not_specified = shift; - my $pg_duration = shift; #processing time - my $return_object = $formatter->return_object; - my %scores = (); - my $ALL_CORRECT= 0; - my $all_correct = ($error_flag)?0:1; - foreach my $ans (keys %{$return_object->{answers}} ) { - $scores{$ans} = - $return_object->{answers}->{$ans}->{score}; - $all_correct =$all_correct && $scores{$ans}; - } + my $pg_duration = shift; #processing time + my $return_object = $formatter->return_object; + my %scores = (); + my $ALL_CORRECT = 0; + my $all_correct = ($error_flag) ? 0 : 1; + + foreach my $ans (keys %{ $return_object->{answers} }) { + $scores{$ans} = + $return_object->{answers}->{$ans}->{score}; + $all_correct = $all_correct && $scores{$ans}; + } $all_correct = ".5" if $some_correct_answers_not_specified; - $ALL_CORRECT = ($all_correct == 1)?'All answers are correct':'Some answers are incorrect'; - local(*FH); - open(FH, '>>:encoding(UTF-8)',$path_to_log_file) or die "Can't open file $path_to_log_file for writing"; - print FH "$all_correct $file_path\n"; # do we need this? compile_errors=$error_flag\n"; + $ALL_CORRECT = ($all_correct == 1) ? 'All answers are correct' : 'Some answers are incorrect'; + local (*FH); + open(FH, '>>:encoding(UTF-8)', $path_to_log_file) or die "Can't open file $path_to_log_file for writing"; + print FH "$all_correct $file_path\n"; # do we need this? compile_errors=$error_flag\n"; close(FH); return $ALL_CORRECT; } @@ -1298,8 +1272,6 @@ sub record_problem_ok2 { # standalonePGproblemRenderer -- not needed for sendXMLRPC ########################################### - - ################################################## # utilities ################################################## @@ -1310,22 +1282,22 @@ sub display_inputs { print "$key => $correct_answers{$key}\n"; } } + sub edit_source_file { my $file_path = shift; - system(EDIT_COMMAND()." $file_path"); + system(EDIT_COMMAND() . " $file_path"); } - ################################################## # Get problem template source and adjust file_path name ################################################## sub get_source { my $file_path = shift; - my $source; + my $source; die "Unable to read file $file_path \n" unless $file_path eq '-' or -r $file_path; - eval { #File::Slurp would be faster (see perl monks) - local $/=undef; + eval { #File::Slurp would be faster (see perl monks) + local $/ = undef; if ($file_path eq '-') { $source = ; } else { @@ -1335,10 +1307,10 @@ sub get_source { # encodeSource() method is called on a data which is still UTF-8 encoded, and leads to double # encoding and gibberish. # NEW: - open(FH, "<:encoding(UTF-8)" ,$file_path) or die "Couldn't open file $file_path: $!"; + open(FH, "<:encoding(UTF-8)", $file_path) or die "Couldn't open file $file_path: $!"; # OLD: #open(FH, "<" ,$file_path) or die "Couldn't open file $file_path: $!"; - $source = ; #slurp input + $source = ; #slurp input close FH; } }; @@ -1347,54 +1319,53 @@ sub get_source { #$file_path =~ s|/opt/webwork/libraries/NationalProblemLibrary|Library|; $file_path =~ s|^.*?/webwork-open-problem-library/OpenProblemLibrary|Library|; print "file_path changed to $file_path\n" if $UNIT_TESTS_ON; - print $source if $UNIT_TESTS_ON; + print $source if $UNIT_TESTS_ON; return $file_path, $source; } - ################################################## # utilities ################################################## -sub pretty_print_rh { - shift if UNIVERSAL::isa($_[0] => __PACKAGE__); - my $rh = shift; +sub pretty_print_rh { + shift if UNIVERSAL::isa($_[0] => __PACKAGE__); + my $rh = shift; my $indent = shift || 0; - my $out = ""; - my $type = ref($rh); + my $out = ""; + my $type = ref($rh); if (defined($type) and $type) { $out .= " type = $type; "; - } elsif (! defined($rh )) { + } elsif (!defined($rh)) { $out .= " type = UNDEFINED; "; } - return $out." " unless defined($rh); - - if ( ref($rh) =~/HASH/ ) { - $out .= "{\n"; - $indent++; - foreach my $key (sort keys %{$rh}) { - $out .= " "x$indent."$key => " . pretty_print_rh( $rh->{$key}, $indent ) . "\n"; - } - $indent--; - $out .= "\n"." "x$indent."}\n"; - - } elsif (ref($rh) =~ /ARRAY/ or "$rh" =~/ARRAY/) { - $out .= " ( "; - foreach my $elem ( @{$rh} ) { - $out .= pretty_print_rh($elem, $indent); - - } - $out .= " ) \n"; - } elsif ( ref($rh) =~ /SCALAR/ ) { - $out .= "scalar reference ". ${$rh}; - } elsif ( ref($rh) =~/Base64/ ) { - $out .= "base64 reference " .$$rh; + return $out . " " unless defined($rh); + + if (ref($rh) =~ /HASH/) { + $out .= "{\n"; + $indent++; + foreach my $key (sort keys %{$rh}) { + $out .= " " x $indent . "$key => " . pretty_print_rh($rh->{$key}, $indent) . "\n"; + } + $indent--; + $out .= "\n" . " " x $indent . "}\n"; + + } elsif (ref($rh) =~ /ARRAY/ or "$rh" =~ /ARRAY/) { + $out .= " ( "; + foreach my $elem (@{$rh}) { + $out .= pretty_print_rh($elem, $indent); + + } + $out .= " ) \n"; + } elsif (ref($rh) =~ /SCALAR/) { + $out .= "scalar reference " . ${$rh}; + } elsif (ref($rh) =~ /Base64/) { + $out .= "base64 reference " . $$rh; } else { - $out .= $rh; + $out .= $rh; } - - return $out." "; + + return $out . " "; } ############################################ @@ -1402,7 +1373,7 @@ sub pretty_print_rh { ############################################ sub print_help_message { -print <<'EOT'; + print <<'EOT'; NAME webwork2/clients/sendXMLRPC.pl diff --git a/clients/sendxmlrpc_bbedit.pl b/clients/sendxmlrpc_bbedit.pl index c01d24ff84..75e29b2617 100755 --- a/clients/sendxmlrpc_bbedit.pl +++ b/clients/sendxmlrpc_bbedit.pl @@ -1,4 +1,5 @@ #!/usr/bin/perl -w die "BB_DOC_PATH is not present. You must first save the document\n" unless defined $ENV{BB_DOC_PATH}; -$command = "/Volumes/WW_test/opt/local/bin/perl /Volumes/WW_test/opt/webwork/webwork2/clients/sendXMLRPC.pl -bB $ENV{BB_DOC_PATH}"; -system($command); \ No newline at end of file +$command = + "/Volumes/WW_test/opt/local/bin/perl /Volumes/WW_test/opt/webwork/webwork2/clients/sendXMLRPC.pl -bB $ENV{BB_DOC_PATH}"; +system($command); diff --git a/clients/uribase64_encode.pl b/clients/uribase64_encode.pl index 00f242c05b..ae09e62880 100755 --- a/clients/uribase64_encode.pl +++ b/clients/uribase64_encode.pl @@ -2,6 +2,6 @@ use MIME::Base64 qw( encode_base64 decode_base64); use URI::Escape qw(uri_escape uri_unescape); -local($/); +local ($/); print uri_escape encode_base64 ; print "\n\n"; diff --git a/courses.dist/modelCourse/templates/setOrientation/parserOrientation.pl b/courses.dist/modelCourse/templates/setOrientation/parserOrientation.pl index 99abee9ff4..1530e2ea32 100644 --- a/courses.dist/modelCourse/templates/setOrientation/parserOrientation.pl +++ b/courses.dist/modelCourse/templates/setOrientation/parserOrientation.pl @@ -6,16 +6,15 @@ # ###################################################################### - #loadMacros("PGcourse.pl"); # # Special use of CARET to have it work in non-math mode # $CARET = MODES( - TeX => '\hbox{\texttt{\char94}}', - Latex2HTML => '^', - HTML => '^' + TeX => '\hbox{\texttt{\char94}}', + Latex2HTML => '^', + HTML => '^' ); # @@ -24,36 +23,33 @@ # recoding the problems themselves). # sub student { - my $message = shift; - MODES( - TeX => '\leavevmode\hbox{\texttt{'.$message.'}}', - Latex2HTML => - $bHTML.''.$eHTML.$message.$bHTML.''.$eHTML, - HTML => ''.$message.'' - ); + my $message = shift; + MODES( + TeX => '\leavevmode\hbox{\texttt{' . $message . '}}', + Latex2HTML => $bHTML . '' . $eHTML . $message . $bHTML . '' . $eHTML, + HTML => '' . $message . '' + ); } sub computer { - my $message = shift; - MODES( - TeX => '\hbox{\texttt{'.$message.'}}', - Latex2HTML => - $bHTML.''.$eHTML.$message.$bHTML.''.$eHTML, - HTML => ''.$message.'' - ); + my $message = shift; + MODES( + TeX => '\hbox{\texttt{' . $message . '}}', + Latex2HTML => $bHTML . '' . $eHTML . $message . $bHTML . '' . $eHTML, + HTML => '' . $message . '' + ); } # # This prints things we need to fill in yet in red # sub moreWork { - my $message = shift; - MODES( - TeX => '{\sl ' . $message . '}', - Latex2HTML => $bHTML . '' . $eHTML . - $message . $bHTML . '' . $eHTML, - HTML => '' . $message . '' - ); + my $message = shift; + MODES( + TeX => '{\sl ' . $message . '}', + Latex2HTML => $bHTML . '' . $eHTML . $message . $bHTML . '' . $eHTML, + HTML => '' . $message . '' + ); } # @@ -61,15 +57,15 @@ sub moreWork { # working on. # $BCOMMENT = MODES( - TeX => '{\footnotesize\it', - Latex2HTML => $bHTML.'
      '.$eHTML, - HTML => '
      ' + TeX => '{\footnotesize\it', + Latex2HTML => $bHTML . '
      ' . $eHTML, + HTML => '
      ' ); $ECOMMENT = MODES( - TeX => '}', - Latex2HTML => $bHTML.'
      '.$eHTML, - HTML => '
      ' + TeX => '}', + Latex2HTML => $bHTML . '
      ' . $eHTML, + HTML => '
      ' ); # $BCOMMENT = MODES( @@ -77,102 +73,114 @@ sub moreWork { # Latex2HTML => $bHTML.''.$eHTML, # HTML => ' -->' # ); - # # Hack to get better spacing in HTML_tth math mode but without # messing up the spacing in other modes. # $SP = MODES( - TeX => ' ', Latex2HTML => ' ', - HTML => ' ', HTML_tth => '\ ', - HTML_jsMath => ' ', HTML_dpng => ' ', + TeX => ' ', + Latex2HTML => ' ', + HTML => ' ', + HTML_tth => '\ ', + HTML_jsMath => ' ', + HTML_dpng => ' ', ); - # -# Special table macros for questions that have +# Special table macros for questions that have # displayed math expressions equal to an answer rule, # with an accompanying explanation on a separate line. # sub BeginExamples { - return "" if ($displayMode eq "TeX"); - BeginTable(@_); + return "" if ($displayMode eq "TeX"); + BeginTable(@_); } sub EndExamples { - return "" if ($displayMode eq "TeX"); - EndTable(); + return "" if ($displayMode eq "TeX"); + EndTable(); } @ExampleDefaults = (ans_rule_len => 40, ans_rule_height => 1); sub BeginExample { - my $math = shift; - my $ans = shift; - my %options = (@ExampleDefaults, @_); - my ($cols,$rows) = ($options{ans_rule_len},$options{ans_rule_height}); - my $rule; - - if ($rows == 1) {$rule = ans_rule($cols)} - else {$rule = ans_box($rows,$cols)} - ANS($ans); - - # - # HTML_tth puts an unwanted
      at the beginning, - # and uses a centered table. Remove the
      and - # align the table to the right. - # - if ($displayMode eq "HTML_tth") { - $math = trimString(EV2('\['.$math.'\]')); - $math =~ s!
      !!; - $math =~ s!table align="center"!table align="right"!; - } elsif ($displayMode eq "HTML") { - $math = '\('.$math.'\)' - } elsif ($displayMode =~ m/^HTML/) { - $math = '\(\displaystyle '.$math.'\)' - } - - MODES( - TeX => "\n".'\['.$math.'=\hbox to 8em{'.$rule.'}\]', - Latex2HTML => $bHTML.''.$eHTML. - '\(\displaystyle '.$math.'\)'.$bHTML.' =  '. - ''.$eHTML.$rule.$bHTML.''. - ''.$eHTML, - HTML => - ''.$math.' =  '. - ''.$rule.'' - ); + my $math = shift; + my $ans = shift; + my %options = (@ExampleDefaults, @_); + my ($cols, $rows) = ($options{ans_rule_len}, $options{ans_rule_height}); + my $rule; + + if ($rows == 1) { $rule = ans_rule($cols) } + else { $rule = ans_box($rows, $cols) } + ANS($ans); + + # + # HTML_tth puts an unwanted
      at the beginning, + # and uses a centered table. Remove the
      and + # align the table to the right. + # + if ($displayMode eq "HTML_tth") { + $math = trimString(EV2('\[' . $math . '\]')); + $math =~ s!
      !!; + $math =~ s!table align="center"!table align="right"!; + } elsif ($displayMode eq "HTML") { + $math = '\(' . $math . '\)'; + } elsif ($displayMode =~ m/^HTML/) { + $math = '\(\displaystyle ' . $math . '\)'; + } + + MODES( + TeX => "\n" . '\[' . $math . '=\hbox to 8em{' . $rule . '}\]', + Latex2HTML => $bHTML + . '' + . $eHTML + . '\(\displaystyle ' + . $math . '\)' + . $bHTML + . ' =  ' . '' + . $eHTML + . $rule + . $bHTML + . '' + . '' + . $eHTML, + HTML => '' + . $math + . ' =  ' . '' + . $rule + . '' + ); } sub EndExample { - MODES( - TeX => "\n", - Latex2HTML => $bHTML.'

      '.$eHTML, - HTML => '

      ' - ); + MODES( + TeX => "\n", + Latex2HTML => $bHTML . '

      ' . $eHTML, + HTML => '

      ' + ); } sub ExampleRule { - MODES( - TeX => '\par', - Latex2HTML => $bHTML.'
      '.$eHTML, - HTML => '
      ' - ); + MODES( + TeX => '\par', + Latex2HTML => $bHTML . '
      ' . $eHTML, + HTML => '
      ' + ); } # # Produce a TeX version and an answer checker for the formula # -sub DisplayQA {my $f = shift; return (DMATH($f->TeX),$f->cmp)} -sub QA {my $f = shift; return ($f->TeX,$f->cmp)} +sub DisplayQA { my $f = shift; return (DMATH($f->TeX), $f->cmp) } +sub QA { my $f = shift; return ($f->TeX, $f->cmp) } ################################################## # @@ -181,49 +189,47 @@ sub ExampleRule { # sub MathIMG { - my ($img,$text,$tex) = @_; - my $useTeX = MODES(TeX => 1, Latex2HTML => 0, HTML => 0, HTML_tth => 0, HTML_dpng => 1); - return '\('.$tex.'\)' if $useTeX; - $img = alias($img); - return qq{$text}; + my ($img, $text, $tex) = @_; + my $useTeX = MODES(TeX => 1, Latex2HTML => 0, HTML => 0, HTML_tth => 0, HTML_dpng => 1); + return '\(' . $tex . '\)' if $useTeX; + $img = alias($img); + return qq{$text}; } - ################################################## # # A simple grader that always returns a score of 1. # This is used in the tutorial to give students # credit for reading a problem (even if it doesn't # ask any questions). -# +# sub forgiving_grader { - my $rh_evaluated_answers = shift; - my $rh_problem_state = shift; - my %form_options = @_; - my %evaluated_answers = %{$rh_evaluated_answers}; - my %problem_state = %{$rh_problem_state}; - - my %problem_result = ( - score => 1, # always return 1 - errors => '', - type => 'forgiving_grader', - msg => '', - ); - - return(\%problem_result,\%problem_state) - if (!$form_options{answers_submitted}); - - $problem_state{recorded_score} = $problem_result{score}; - $problem_state{num_of_correct_ans}++; - - (\%problem_result, \%problem_state); + my $rh_evaluated_answers = shift; + my $rh_problem_state = shift; + my %form_options = @_; + my %evaluated_answers = %{$rh_evaluated_answers}; + my %problem_state = %{$rh_problem_state}; + + my %problem_result = ( + score => 1, # always return 1 + errors => '', + type => 'forgiving_grader', + msg => '', + ); + + return (\%problem_result, \%problem_state) + if (!$form_options{answers_submitted}); + + $problem_state{recorded_score} = $problem_result{score}; + $problem_state{num_of_correct_ans}++; + + (\%problem_result, \%problem_state); } ################################################## # # Syntactic sugar to avoid ugly ~~& construct in PG. # -sub install_forgiving_grader {install_problem_grader(\&forgiving_grader)} - +sub install_forgiving_grader { install_problem_grader(\&forgiving_grader) } 1; diff --git a/doc/parser/macros/Differentiation.pl b/doc/parser/macros/Differentiation.pl index b614caeeb9..a052463b4a 100644 --- a/doc/parser/macros/Differentiation.pl +++ b/doc/parser/macros/Differentiation.pl @@ -1,12 +1,12 @@ # # Example of how to add new functionality to the Parser. -# +# # Here we load new methods for the Parser object classes. Note, however, # that these are PERSISTANT when used with webwork2 (mod_perl), and so we # need to take care not to load them more than once. We look for the # variable $Parser::Differentiation::loaded, which is defined in the # differentiation package, in order to tell. -# +# # DifferentiationDefs.pl is really just a copy of the # Parser::Differentiation.pm file, and you really could just preload the # latter instead by uncommenting the 'use Parser::Differentiation' line at diff --git a/doc/parser/macros/DifferentiationDefs.pl b/doc/parser/macros/DifferentiationDefs.pl index 32c37b91aa..38409648f1 100644 --- a/doc/parser/macros/DifferentiationDefs.pl +++ b/doc/parser/macros/DifferentiationDefs.pl @@ -2,628 +2,730 @@ # Extend differentiation to multiple variables # Check differentiation for complex functions # Do derivatives for norm and unit. -# +# # Make shortcuts for getting numbers 1, 2, and sqrt, etc. -# +# ################################################## # # Differentiate the formula in terms of the given variable # sub Parser::D { - my $self = shift; my $x = shift; - if (!defined($x)) { - my @vars = keys(%{$self->{variables}}); - my $n = scalar(@vars); - if ($n == 0) { - return $self->new('0') if $self->{isNumber}; - $x = 'x'; - } else { - $self->Error("You must specify a variable to differentiate by") unless $n ==1; - $x = $vars[0]; - } - } else { - return $self->new('0') unless defined $self->{variables}{$x}; - } - return $self->new($self->{tree}->D($x)); + my $self = shift; + my $x = shift; + if (!defined($x)) { + my @vars = keys(%{ $self->{variables} }); + my $n = scalar(@vars); + if ($n == 0) { + return $self->new('0') if $self->{isNumber}; + $x = 'x'; + } else { + $self->Error("You must specify a variable to differentiate by") unless $n == 1; + $x = $vars[0]; + } + } else { + return $self->new('0') unless defined $self->{variables}{$x}; + } + return $self->new($self->{tree}->D($x)); } sub Item::D { - my $self = shift; - my $type = ref($self); $type =~ s/.*:://; - $self->Error("Differentiation for '$type' is not implemented",$self->{ref}); + my $self = shift; + my $type = ref($self); + $type =~ s/.*:://; + $self->Error("Differentiation for '$type' is not implemented", $self->{ref}); } - ######################################################################### -sub Parser::BOP::comma::D {Item::D(shift)} -sub Parser::BOP::union::D {Item::D(shift)} +sub Parser::BOP::comma::D { Item::D(shift) } +sub Parser::BOP::union::D { Item::D(shift) } sub Parser::BOP::add::D { - my $self = shift; my $x = shift; - $self = Parser::BOP->new( - $self->{equation},$self->{bop}, - $self->{lop}->D($x),$self->{rop}->D($x) - ); - return $self->reduce; + my $self = shift; + my $x = shift; + $self = Parser::BOP->new($self->{equation}, $self->{bop}, $self->{lop}->D($x), $self->{rop}->D($x)); + return $self->reduce; } - sub Parser::BOP::subtract::D { - my $self = shift; my $x = shift; - $self = Parser::BOP->new( - $self->{equation},$self->{bop}, - $self->{lop}->D($x),$self->{rop}->D($x) - ); - return $self->reduce; + my $self = shift; + my $x = shift; + $self = Parser::BOP->new($self->{equation}, $self->{bop}, $self->{lop}->D($x), $self->{rop}->D($x)); + return $self->reduce; } sub Parser::BOP::multiply::D { - my $self = shift; my $x = shift; - my $equation = $self->{equation}; - $self = - Parser::BOP->new($equation,'+', - Parser::BOP->new($equation,$self->{bop}, - $self->{lop}->D($x),$self->{rop}->copy($equation)), - Parser::BOP->new($equation,$self->{bop}, - $self->{lop}->copy($equation),$self->{rop}->D($x)) - ); - return $self->reduce; + my $self = shift; + my $x = shift; + my $equation = $self->{equation}; + $self = Parser::BOP->new( + $equation, '+', + Parser::BOP->new($equation, $self->{bop}, $self->{lop}->D($x), $self->{rop}->copy($equation)), + Parser::BOP->new($equation, $self->{bop}, $self->{lop}->copy($equation), $self->{rop}->D($x)) + ); + return $self->reduce; } sub Parser::BOP::divide::D { - my $self = shift; my $x = shift; - my $equation = $self->{equation}; - $self = - Parser::BOP->new($equation,$self->{bop}, - Parser::BOP->new($equation,'-', - Parser::BOP->new($equation,'*', - $self->{lop}->D($x),$self->{rop}->copy($equation)), - Parser::BOP->new($equation,'*', - $self->{lop}->copy($equation),$self->{rop}->D($x)) - ), - Parser::BOP->new($equation,'^', - $self->{rop},Parser::Number->new($equation,2) - ) - ); - return $self->reduce; + my $self = shift; + my $x = shift; + my $equation = $self->{equation}; + $self = Parser::BOP->new( + $equation, + $self->{bop}, + Parser::BOP->new( + $equation, '-', + Parser::BOP->new($equation, '*', $self->{lop}->D($x), $self->{rop}->copy($equation)), + Parser::BOP->new($equation, '*', $self->{lop}->copy($equation), $self->{rop}->D($x)) + ), + Parser::BOP->new($equation, '^', $self->{rop}, Parser::Number->new($equation, 2)) + ); + return $self->reduce; } sub Parser::BOP::power::D { - my $self = shift; my $x = shift; - my $equation = $self->{equation}; - my $vars = $self->{rop}->getVariables; - if (defined($vars->{$x})) { - $vars = $self->{lop}->getVariables; - if (defined($vars->{$x})) { - $self = - Parser::Function->new($equation,'exp', - [Parser::BOP->new($equation,'*',$self->{rop}->copy($equation), - Parser::Function->new($equation,'log',[$self->{lop}->copy($equation)],0))]); - return $self->D($x); - } - $self = Parser::BOP->new($equation,'*', - Parser::Function->new($equation,'log',[$self->{lop}->copy($equation)],0), - Parser::BOP->new($equation,'*', - $self->copy($equation),$self->{rop}->D($x)) - ); - } else { - $self = - Parser::BOP->new($equation,'*', - Parser::BOP->new($equation,'*', - $self->{rop}->copy($equation), - Parser::BOP->new($equation,$self->{bop}, - $self->{lop}->copy($equation), - Parser::BOP->new($equation,'-', - $self->{rop}->copy($equation), - Parser::Number->new($equation,1) - ) - ) - ), - $self->{lop}->D($x) - ); - } - return $self->reduce; -} - -sub Parser::BOP::cross::D {Item::D(shift)} -sub Parser::BOP::dot::D {Item::D(shift)} -sub Parser::BOP::underscore::D {Item::D(shift)} + my $self = shift; + my $x = shift; + my $equation = $self->{equation}; + my $vars = $self->{rop}->getVariables; + if (defined($vars->{$x})) { + $vars = $self->{lop}->getVariables; + if (defined($vars->{$x})) { + $self = Parser::Function->new( + $equation, + 'exp', + [ + Parser::BOP->new( + $equation, '*', + $self->{rop}->copy($equation), + Parser::Function->new($equation, 'log', [ $self->{lop}->copy($equation) ], 0) + ) + ] + ); + return $self->D($x); + } + $self = Parser::BOP->new( + $equation, '*', + Parser::Function->new($equation, 'log', [ $self->{lop}->copy($equation) ], 0), + Parser::BOP->new($equation, '*', $self->copy($equation), $self->{rop}->D($x)) + ); + } else { + $self = Parser::BOP->new( + $equation, + '*', + Parser::BOP->new( + $equation, + '*', + $self->{rop}->copy($equation), + Parser::BOP->new( + $equation, + $self->{bop}, + $self->{lop}->copy($equation), + Parser::BOP->new( + $equation, '-', + $self->{rop}->copy($equation), + Parser::Number->new($equation, 1) + ) + ) + ), + $self->{lop}->D($x) + ); + } + return $self->reduce; +} + +sub Parser::BOP::cross::D { Item::D(shift) } +sub Parser::BOP::dot::D { Item::D(shift) } +sub Parser::BOP::underscore::D { Item::D(shift) } ######################################################################### sub Parser::UOP::plus::D { - my $self = shift; my $x = shift; - return $self->{op}->D($x) + my $self = shift; + my $x = shift; + return $self->{op}->D($x); } sub Parser::UOP::minus::D { - my $self = shift; my $x = shift; - $self = Parser::UOP->new($self->{equation},'u-',$self->{op}->D($x)); - return $self->reduce; + my $self = shift; + my $x = shift; + $self = Parser::UOP->new($self->{equation}, 'u-', $self->{op}->D($x)); + return $self->reduce; } -sub Parser::UOP::factorial::D {Item::D(shift)} +sub Parser::UOP::factorial::D { Item::D(shift) } ######################################################################### sub Parser::Function::D { - my $self = shift; - $self->Error("Differentiation of '$self->{name}' not implemented",$self->{ref}); + my $self = shift; + $self->Error("Differentiation of '$self->{name}' not implemented", $self->{ref}); } sub Parser::Function::D_chain { - my $self = shift; my $x = $self->{params}[0]; - my $name = "D_" . $self->{name}; - $self = Parser::BOP->new($self->{equation},'*',$self->$name($x->copy),$x->D(shift)); - return $self->reduce; + my $self = shift; + my $x = $self->{params}[0]; + my $name = "D_" . $self->{name}; + $self = Parser::BOP->new($self->{equation}, '*', $self->$name($x->copy), $x->D(shift)); + return $self->reduce; } ############################# -sub Parser::Function::trig::D {Parser::Function::D_chain(@_)} +sub Parser::Function::trig::D { Parser::Function::D_chain(@_) } sub Parser::Function::trig::D_sin { - my $self = shift; my $x = shift; - return Parser::Function->new($self->{equation},'cos',[$x]); + my $self = shift; + my $x = shift; + return Parser::Function->new($self->{equation}, 'cos', [$x]); } sub Parser::Function::trig::D_cos { - my $self = shift; my $x = shift; - my $equation = $self->{equation}; - return - Parser::UOP->new($equation,'u-', - Parser::Function->new($equation,'sin',[$x]) - ); + my $self = shift; + my $x = shift; + my $equation = $self->{equation}; + return Parser::UOP->new($equation, 'u-', Parser::Function->new($equation, 'sin', [$x])); } sub Parser::Function::trig::D_tan { - my $self = shift; my $x = shift; - my $equation = $self->{equation}; - return - Parser::BOP->new($equation,'^', - Parser::Function->new($equation,'sec',[$x]), - Parser::Number->new($equation,2) - ); + my $self = shift; + my $x = shift; + my $equation = $self->{equation}; + return Parser::BOP->new( + $equation, '^', + Parser::Function->new($equation, 'sec', [$x]), + Parser::Number->new($equation, 2) + ); } sub Parser::Function::trig::D_cot { - my $self = shift; my $x = shift; - my $equation = $self->{equation}; - return - Parser::UOP->new($equation,'u-', - Parser::BOP->new($equation,'^', - Parser::Function->new($equation,'csc',[$x]), - Parser::Number->new($equation,2) - ) - ); -} - + my $self = shift; + my $x = shift; + my $equation = $self->{equation}; + return Parser::UOP->new( + $equation, + 'u-', + Parser::BOP->new( + $equation, '^', + Parser::Function->new($equation, 'csc', [$x]), + Parser::Number->new($equation, 2) + ) + ); +} + sub Parser::Function::trig::D_sec { - my $self = shift; my $x = shift; - my $equation = $self->{equation}; - return - Parser::BOP->new($equation,'*', - Parser::Function->new($equation,'sec',[$x]), - Parser::Function->new($equation,'tan',[$x]) - ); + my $self = shift; + my $x = shift; + my $equation = $self->{equation}; + return Parser::BOP->new( + $equation, '*', + Parser::Function->new($equation, 'sec', [$x]), + Parser::Function->new($equation, 'tan', [$x]) + ); } sub Parser::Function::trig::D_csc { - my $self = shift; my $x = shift; - my $equation = $self->{equation}; - return - Parser::UOP->new($equation,'u-', - Parser::BOP->new($equation,'*', - Parser::Function->new($equation,'csc',[$x]), - Parser::Function->new($equation,'cot',[$x]) - ) - ); + my $self = shift; + my $x = shift; + my $equation = $self->{equation}; + return Parser::UOP->new( + $equation, + 'u-', + Parser::BOP->new( + $equation, '*', + Parser::Function->new($equation, 'csc', [$x]), + Parser::Function->new($equation, 'cot', [$x]) + ) + ); } sub Parser::Function::trig::D_asin { - my $self = shift; my $x = shift; - my $equation = $self->{equation}; - return - Parser::BOP->new($equation,'/', - Parser::Number->new($equation,1), - Parser::Function->new($equation,'sqrt',[ - Parser::BOP->new($equation,'-', - Parser::Number->new($equation,1), - Parser::BOP->new($equation,'^', - $x,Parser::Number->new($equation,2) - ) - )] - ) - ); + my $self = shift; + my $x = shift; + my $equation = $self->{equation}; + return Parser::BOP->new( + $equation, + '/', + Parser::Number->new($equation, 1), + Parser::Function->new( + $equation, + 'sqrt', + [ + Parser::BOP->new( + $equation, '-', + Parser::Number->new($equation, 1), + Parser::BOP->new($equation, '^', $x, Parser::Number->new($equation, 2)) + ) + ] + ) + ); } sub Parser::Function::trig::D_acos { - my $self = shift; my $x = shift; - my $equation = $self->{equation}; - return - Parser::UOP->new($equation,'u-', - Parser::BOP->new($equation,'/', - Parser::Number->new($equation,1), - Parser::Function->new($equation,'sqrt',[ - Parser::BOP->new($equation,'-', - Parser::Number->new($equation,1), - Parser::BOP->new($equation,'^', - $x,Parser::Number->new($equation,2) - ) - )] - ) - ) - ); + my $self = shift; + my $x = shift; + my $equation = $self->{equation}; + return Parser::UOP->new( + $equation, + 'u-', + Parser::BOP->new( + $equation, + '/', + Parser::Number->new($equation, 1), + Parser::Function->new( + $equation, + 'sqrt', + [ + Parser::BOP->new( + $equation, '-', + Parser::Number->new($equation, 1), + Parser::BOP->new($equation, '^', $x, Parser::Number->new($equation, 2)) + ) + ] + ) + ) + ); } sub Parser::Function::trig::D_atan { - my $self = shift; my $x = shift; - my $equation = $self->{equation}; - return - Parser::BOP->new($equation,'/', - Parser::Number->new($equation,1), - Parser::BOP->new($equation,'+', - Parser::Number->new($equation,1), - Parser::BOP->new($equation,'^', - $x, Parser::Number->new($equation,2) - ) - ) - ); + my $self = shift; + my $x = shift; + my $equation = $self->{equation}; + return Parser::BOP->new( + $equation, + '/', + Parser::Number->new($equation, 1), + Parser::BOP->new( + $equation, '+', + Parser::Number->new($equation, 1), + Parser::BOP->new($equation, '^', $x, Parser::Number->new($equation, 2)) + ) + ); } sub Parser::Function::trig::D_acot { - my $self = shift; my $x = shift; - my $equation = $self->{equation}; - return - Parser::UOP->new($equation,'u-', - Parser::BOP->new($equation,'/', - Parser::Number->new($equation,1), - Parser::BOP->new($equation,'+', - Parser::Number->new($equation,1), - Parser::BOP->new($equation,'^', - $x, Parser::Number->new($equation,2) - ) - ) - ) - ); + my $self = shift; + my $x = shift; + my $equation = $self->{equation}; + return Parser::UOP->new( + $equation, + 'u-', + Parser::BOP->new( + $equation, + '/', + Parser::Number->new($equation, 1), + Parser::BOP->new( + $equation, '+', + Parser::Number->new($equation, 1), + Parser::BOP->new($equation, '^', $x, Parser::Number->new($equation, 2)) + ) + ) + ); } sub Parser::Function::trig::D_asec { - my $self = shift; my $x = shift; - my $equation = $self->{equation}; - return - Parser::BOP->new($equation,'/', - Parser::Number->new($equation,1), - Parser::BOP->new($equation,'*', - Parser::Function->new($equation,'abs',[$x]), - Parser::Function->new($equation,'sqrt',[ - Parser::BOP->new($equation,'-', - Parser::BOP->new($equation,'^', - $x, Parser::Number->new($equation,2) - ), - Parser::Number->new($equation,1) - )] - ) - ) - ); + my $self = shift; + my $x = shift; + my $equation = $self->{equation}; + return Parser::BOP->new( + $equation, + '/', + Parser::Number->new($equation, 1), + Parser::BOP->new( + $equation, + '*', + Parser::Function->new($equation, 'abs', [$x]), + Parser::Function->new( + $equation, + 'sqrt', + [ + Parser::BOP->new( + $equation, '-', + Parser::BOP->new($equation, '^', $x, Parser::Number->new($equation, 2)), + Parser::Number->new($equation, 1) + ) + ] + ) + ) + ); } sub Parser::Function::trig::D_acsc { - my $self = shift; my $x = shift; - my $equation = $self->{equation}; - return - Parser::UOP->new($equation,'u-', - Parser::BOP->new($equation,'/', - Parser::Number->new($equation,1), - Parser::BOP->new($equation,'*', - Parser::Function->new($equation,'abs',[$x]), - Parser::Function->new($equation,'sqrt',[ - Parser::BOP->new($equation,'-', - Parser::BOP->new($equation,'^', - $x, Parser::Number->new($equation,2) - ), - Parser::Number->new($equation,1) - )] - ) - ) - ) - ); + my $self = shift; + my $x = shift; + my $equation = $self->{equation}; + return Parser::UOP->new( + $equation, + 'u-', + Parser::BOP->new( + $equation, + '/', + Parser::Number->new($equation, 1), + Parser::BOP->new( + $equation, + '*', + Parser::Function->new($equation, 'abs', [$x]), + Parser::Function->new( + $equation, + 'sqrt', + [ + Parser::BOP->new( + $equation, '-', + Parser::BOP->new($equation, '^', $x, Parser::Number->new($equation, 2)), + Parser::Number->new($equation, 1) + ) + ] + ) + ) + ) + ); } - ############################# -sub Parser::Function::hyperbolic::D {Parser::Function::D_chain(@_)} +sub Parser::Function::hyperbolic::D { Parser::Function::D_chain(@_) } sub Parser::Function::hyperbolic::D_sinh { - my $self = shift; my $x = shift; - return Parser::Function->new($self->{equation},'cosh',[$x]); + my $self = shift; + my $x = shift; + return Parser::Function->new($self->{equation}, 'cosh', [$x]); } sub Parser::Function::hyperbolic::D_cosh { - my $self = shift; my $x = shift; - return Parser::Function->new($self->{equation},'sinh',[$x]); + my $self = shift; + my $x = shift; + return Parser::Function->new($self->{equation}, 'sinh', [$x]); } sub Parser::Function::hyperbolic::D_tanh { - my $self = shift; my $x = shift; - my $equation = $self->{equation}; - return - Parser::BOP->new($equation,'^', - Parser::Function->new($equation,'sech',[$x]), - Parser::Number->new($equation,2) - ); + my $self = shift; + my $x = shift; + my $equation = $self->{equation}; + return Parser::BOP->new( + $equation, '^', + Parser::Function->new($equation, 'sech', [$x]), + Parser::Number->new($equation, 2) + ); } sub Parser::Function::hyperbolic::D_coth { - my $self = shift; my $x = shift; - my $equation = $self->{equation}; - return - Parser::UOP->new($equation,'u-', - Parser::BOP->new($equation,'^', - Parser::Function->new($equation,'csch',[$x]), - Parser::Number->new($equation,2) - ) - ); -} - + my $self = shift; + my $x = shift; + my $equation = $self->{equation}; + return Parser::UOP->new( + $equation, + 'u-', + Parser::BOP->new( + $equation, '^', + Parser::Function->new($equation, 'csch', [$x]), + Parser::Number->new($equation, 2) + ) + ); +} + sub Parser::Function::hyperbolic::D_sech { - my $self = shift; my $x = shift; - my $equation = $self->{equation}; - return - Parser::UOP->new($equation,'u-', - Parser::BOP->new($equation,'*', - Parser::Function->new($equation,'sech',[$x]), - Parser::Function->new($equation,'tanh',[$x]) - ) - ); + my $self = shift; + my $x = shift; + my $equation = $self->{equation}; + return Parser::UOP->new( + $equation, + 'u-', + Parser::BOP->new( + $equation, '*', + Parser::Function->new($equation, 'sech', [$x]), + Parser::Function->new($equation, 'tanh', [$x]) + ) + ); } sub Parser::Function::hyperbolic::D_csch { - my $self = shift; my $x = shift; - my $equation = $self->{equation}; - return - Parser::UOP->new($equation,'u-', - Parser::BOP->new($equation,'*', - Parser::Function->new($equation,'csch',[$x]), - Parser::Function->new($equation,'coth',[$x]) - ) - ); + my $self = shift; + my $x = shift; + my $equation = $self->{equation}; + return Parser::UOP->new( + $equation, + 'u-', + Parser::BOP->new( + $equation, '*', + Parser::Function->new($equation, 'csch', [$x]), + Parser::Function->new($equation, 'coth', [$x]) + ) + ); } sub Parser::Function::hyperbolic::D_asinh { - my $self = shift; my $x = shift; - my $equation = $self->{equation}; - return - Parser::BOP->new($equation,'/', - Parser::Number->new($equation,1), - Parser::Function->new($equation,'sqrt',[ - Parser::BOP->new($equation,'+', - Parser::Number->new($equation,1), - Parser::BOP->new($equation,'^', - $x, Parser::Number->new($equation,2) - ) - )] - ) - ); + my $self = shift; + my $x = shift; + my $equation = $self->{equation}; + return Parser::BOP->new( + $equation, + '/', + Parser::Number->new($equation, 1), + Parser::Function->new( + $equation, + 'sqrt', + [ + Parser::BOP->new( + $equation, '+', + Parser::Number->new($equation, 1), + Parser::BOP->new($equation, '^', $x, Parser::Number->new($equation, 2)) + ) + ] + ) + ); } sub Parser::Function::hyperbolic::D_acosh { - my $self = shift; my $x = shift; - my $equation = $self->{equation}; - return - Parser::BOP->new($equation,'/', - Parser::Number->new($equation,1), - Parser::Function->new($equation,'sqrt',[ - Parser::BOP->new($equation,'-', - Parser::BOP->new($equation,'^', - $x, Parser::Number->new($equation,2) - ), - Parser::Number->new($equation,1) - )] - ) - ); + my $self = shift; + my $x = shift; + my $equation = $self->{equation}; + return Parser::BOP->new( + $equation, + '/', + Parser::Number->new($equation, 1), + Parser::Function->new( + $equation, + 'sqrt', + [ + Parser::BOP->new( + $equation, '-', + Parser::BOP->new($equation, '^', $x, Parser::Number->new($equation, 2)), + Parser::Number->new($equation, 1) + ) + ] + ) + ); } sub Parser::Function::hyperbolic::D_atanh { - my $self = shift; my $x = shift; - my $equation = $self->{equation}; - return - Parser::BOP->new($equation,'/', - Parser::Number->new($equation,1), - Parser::BOP->new($equation,'-', - Parser::Number->new($equation,1), - Parser::BOP->new($equation,'^', - $x, Parser::Number->new($equation,2) - ) - ) - ); + my $self = shift; + my $x = shift; + my $equation = $self->{equation}; + return Parser::BOP->new( + $equation, + '/', + Parser::Number->new($equation, 1), + Parser::BOP->new( + $equation, '-', + Parser::Number->new($equation, 1), + Parser::BOP->new($equation, '^', $x, Parser::Number->new($equation, 2)) + ) + ); } sub Parser::Function::hyperbolic::D_acoth { - my $self = shift; my $x = shift; - my $equation = $self->{equation}; - return - Parser::BOP->new($equation,'/', - Parser::Number->new($equation,1), - Parser::BOP->new($equation,'-', - Parser::Number->new($equation,1), - Parser::BOP->new($equation,'^', - $x, Parser::Number->new($equation,2) - ) - ) - ); + my $self = shift; + my $x = shift; + my $equation = $self->{equation}; + return Parser::BOP->new( + $equation, + '/', + Parser::Number->new($equation, 1), + Parser::BOP->new( + $equation, '-', + Parser::Number->new($equation, 1), + Parser::BOP->new($equation, '^', $x, Parser::Number->new($equation, 2)) + ) + ); } sub Parser::Function::hyperbolic::D_asech { - my $self = shift; my $x = shift; - my $equation = $self->{equation}; - return - Parser::UOP->new($equation,'u-', - Parser::BOP->new($equation,'/', - Parser::Number->new($equation,1), - Parser::BOP->new($equation,'*', - $x, - Parser::Function->new($equation,'sqrt',[ - Parser::BOP->new($equation,'-', - Parser::Number->new($equation,1), - Parser::BOP->new($equation,'^', - $x, Parser::Number->new($equation,2) - ) - )] - ) - ) - ) - ); + my $self = shift; + my $x = shift; + my $equation = $self->{equation}; + return Parser::UOP->new( + $equation, + 'u-', + Parser::BOP->new( + $equation, + '/', + Parser::Number->new($equation, 1), + Parser::BOP->new( + $equation, + '*', $x, + Parser::Function->new( + $equation, + 'sqrt', + [ + Parser::BOP->new( + $equation, '-', + Parser::Number->new($equation, 1), + Parser::BOP->new($equation, '^', $x, Parser::Number->new($equation, 2)) + ) + ] + ) + ) + ) + ); } sub Parser::Function::hyperbolic::D_acsch { - my $self = shift; my $x = shift; - my $equation = $self->{equation}; - return - Parser::UOP->new($equation,'u-', - Parser::BOP->new($equation,'/', - Parser::Number->new($equation,1), - Parser::BOP->new($equation,'*', - Parser::Function->new($equation,'abs',[$x]), - Parser::Function->new($equation,'sqrt',[ - Parser::BOP->new($equation,'+', - Parser::Number->new($equation,1), - Parser::BOP->new($equation,'^', - $x, Parser::Number->new($equation,2) - ) - )] - ) - ) - ) - ); + my $self = shift; + my $x = shift; + my $equation = $self->{equation}; + return Parser::UOP->new( + $equation, + 'u-', + Parser::BOP->new( + $equation, + '/', + Parser::Number->new($equation, 1), + Parser::BOP->new( + $equation, + '*', + Parser::Function->new($equation, 'abs', [$x]), + Parser::Function->new( + $equation, + 'sqrt', + [ + Parser::BOP->new( + $equation, '+', + Parser::Number->new($equation, 1), + Parser::BOP->new($equation, '^', $x, Parser::Number->new($equation, 2)) + ) + ] + ) + ) + ) + ); } - ############################# -sub Parser::Function::numeric::D {Parser::Function::D_chain(@_)} +sub Parser::Function::numeric::D { Parser::Function::D_chain(@_) } sub Parser::Function::numeric::D_log { - my $self = shift; my $x = shift; - my $equation = $self->{equation}; - return Parser::BOP->new($equation,'/',Parser::Number->new($equation,1),$x); + my $self = shift; + my $x = shift; + my $equation = $self->{equation}; + return Parser::BOP->new($equation, '/', Parser::Number->new($equation, 1), $x); } sub Parser::Function::numeric::D_log10 { - my $self = shift; my $x = shift; - my $equation = $self->{equation}; - return - Parser::BOP->new($equation,'/', - Parser::Number->new($equation,1), - Parser::BOP->new($equation,'*', - Parser::Number->new($equation,CORE::log(10)), $x - ) - ); + my $self = shift; + my $x = shift; + my $equation = $self->{equation}; + return Parser::BOP->new( + $equation, '/', + Parser::Number->new($equation, 1), + Parser::BOP->new($equation, '*', Parser::Number->new($equation, CORE::log(10)), $x) + ); } sub Parser::Function::numeric::D_exp { - my $self = shift; my $x = shift; - return $self->copy(); + my $self = shift; + my $x = shift; + return $self->copy(); } sub Parser::Function::numeric::D_sqrt { - my $self = shift; my $x = shift; - my $equation = $self->{equation}; - return - Parser::BOP->new($equation,'/', - Parser::Number->new($equation,1), - Parser::BOP->new($equation,'*', - Parser::Number->new($equation,2), - $self->copy - ) - ); -} - -sub Parser::Function::numeric::D_abs {Parser::Function::D(@_)} -sub Parser::Function::numeric::D_int {Parser::Function::D(@_)} -sub Parser::Function::numeric::D_sgn {Parser::Function::D(@_)} + my $self = shift; + my $x = shift; + my $equation = $self->{equation}; + return Parser::BOP->new( + $equation, '/', + Parser::Number->new($equation, 1), + Parser::BOP->new($equation, '*', Parser::Number->new($equation, 2), $self->copy) + ); +} + +sub Parser::Function::numeric::D_abs { Parser::Function::D(@_) } +sub Parser::Function::numeric::D_int { Parser::Function::D(@_) } +sub Parser::Function::numeric::D_sgn { Parser::Function::D(@_) } ######################################################################### sub Parser::List::D { - my $self = shift; my $x = shift; - $self = $self->copy($self->{equation}); - foreach my $f (@{$self->{coords}}) {$f = $f->D($x)} - return $self->reduce; + my $self = shift; + my $x = shift; + $self = $self->copy($self->{equation}); + foreach my $f (@{ $self->{coords} }) { $f = $f->D($x) } + return $self->reduce; } - sub Parser::List::Interval::D { - my $self = shift; - $self->Error("Can't differentiate intervals",$self->{ref}); + my $self = shift; + $self->Error("Can't differentiate intervals", $self->{ref}); } sub Parser::List::AbsoluteValue::D { - my $self = shift; - $self->Error("Can't differentiate absolute values",$self->{ref}); + my $self = shift; + $self->Error("Can't differentiate absolute values", $self->{ref}); } - ######################################################################### -sub Parser::Number::D {Parser::Number->new(shift->{equation},0)} +sub Parser::Number::D { Parser::Number->new(shift->{equation}, 0) } ######################################################################### -sub Parser::Complex::D {Parser::Number->new(shift->{equation},0)} +sub Parser::Complex::D { Parser::Number->new(shift->{equation}, 0) } ######################################################################### -sub Parser::Constant::D {Parser::Number->new(shift->{equation},0)} +sub Parser::Constant::D { Parser::Number->new(shift->{equation}, 0) } ######################################################################### sub Parser::Value::D { - my $self = shift; my $x = shift; my $equation = $self->{equation}; - return Parser::Value->new($equation,$self->{value}->D($x,$equation)); + my $self = shift; + my $x = shift; + my $equation = $self->{equation}; + return Parser::Value->new($equation, $self->{value}->D($x, $equation)); } sub Value::D { - my $self = shift; my $x = shift; my $equation = shift; - return 0 if $self->isComplex; - my @coords = @{$self->{data}}; - foreach my $n (@coords) - {if (ref($n) eq "") {$n = 0} else {$n = $n->D($x,$equation)->data}} - return $self->new([@coords]); + my $self = shift; + my $x = shift; + my $equation = shift; + return 0 if $self->isComplex; + my @coords = @{ $self->{data} }; + foreach my $n (@coords) { + if (ref($n) eq "") { $n = 0 } + else { $n = $n->D($x, $equation)->data } + } + return $self->new([@coords]); } sub Value::List::D { - my $self = shift; my $x = shift; my $equation = shift; - my @coords = @{$self->{data}}; - foreach my $n (@coords) - {if (ref($n) eq "") {$n = 0} else {$n = $n->D($x)}} - return $self->new([@coords]); + my $self = shift; + my $x = shift; + my $equation = shift; + my @coords = @{ $self->{data} }; + foreach my $n (@coords) { + if (ref($n) eq "") { $n = 0 } + else { $n = $n->D($x) } + } + return $self->new([@coords]); } sub Value::Interval::D { - shift; shift; my $self = shift; - $self->Error("Can't differentiate intervals",$self->{ref}); + shift; + shift; + my $self = shift; + $self->Error("Can't differentiate intervals", $self->{ref}); } sub Value::Union::D { - shift; shift; my $self = shift; - $self->Error("Can't differentiate unions",$self->{ref}); + shift; + shift; + my $self = shift; + $self->Error("Can't differentiate unions", $self->{ref}); } ######################################################################### sub Parser::Variable::D { - my $self = shift; my $x = shift; - my $d = ($self->{name} eq $x)? 1: 0; - return Parser::Number->new($self->{equation},$d); + my $self = shift; + my $x = shift; + my $d = ($self->{name} eq $x) ? 1 : 0; + return Parser::Number->new($self->{equation}, $d); } ######################################################################### -sub Parser::String::D {Parser::Number->new(shift->{equation},0)} +sub Parser::String::D { Parser::Number->new(shift->{equation}, 0) } ######################################################################### diff --git a/doc/parser/macros/parserTables.pl b/doc/parser/macros/parserTables.pl index bd382392f6..22b9b05a6d 100644 --- a/doc/parser/macros/parserTables.pl +++ b/doc/parser/macros/parserTables.pl @@ -5,18 +5,18 @@ # For Parser example tables: # -$BTT = MODES(TeX=>'{\tt ', Latex2HTML => $bHTML.''.$eHTML, HTML => ''); -$ETT = MODES(TeX=>'}', Latex2HTML => $bHTML.''.$eHTML, HTML => ''); +$BTT = MODES(TeX => '{\tt ', Latex2HTML => $bHTML . '' . $eHTML, HTML => ''); +$ETT = MODES(TeX => '}', Latex2HTML => $bHTML . '' . $eHTML, HTML => ''); $BC = MODES( - TeX=>'{\small\it ', - Latex2HTML => $bHTML.''.$eHTML, - HTML => '' + TeX => '{\small\it ', + Latex2HTML => $bHTML . '' . $eHTML, + HTML => '' ); $EC = MODES( - TeX=>'}', - Latex2HTML => $bHTML.''.$eHTML, - HTML => '' + TeX => '}', + Latex2HTML => $bHTML . '' . $eHTML, + HTML => '' ); $LT = MODES(TeX => "<", Latex2HTML => "<", HTML => '<'); @@ -25,63 +25,66 @@ $TEX = MODES(TeX => '{\TeX}', HTML => 'TeX', HTML_dpng => '\(\bf\TeX\)'); @rowOptions = ( - indent => 0, - separation => 0, - align => 'LEFT" NOWRAP="1', # alignment hack to get NOWRAP + indent => 0, + separation => 0, + align => 'LEFT" NOWRAP="1', # alignment hack to get NOWRAP ); sub ParserRow { - my $f = shift; my $t = ''; - Context()->clearError; - my ($s,$err) = PG_restricted_eval($f); - if (defined $s) { - my $ss = $s; - if (ref($s) && \&{$s->string}) { - $t = '\('.$s->TeX.'\)'; - $s = $s->string; - } elsif ($s !~ m/^[a-z]+$/i) { - $t = '\('.Formula($s)->TeX.'\)'; - $s = Formula($s)->string; - } - $s =~ s//$GT/g; - if (ref($ss) && \&{$ss->class}) { - if ($ss->class eq 'Formula') { - $s .= ' '.$BC.'(Formula returning '.$ss->showType.')'.$EC; - } else { - $s .= ' '.$BC.'('.$ss->class.' object)'.$EC; - } - } - } else { - $s = $BC. (Context()->{error}{message} || $err) . $EC; - $t = ''; - } - $f =~ s//$GT/g; - if ($displayMode eq 'TeX') { - $f =~ s/\^/\\char`\\^/g; $s =~ s/\^/\\char`\\^/g; - $f =~ s/#/\\#/g; $s =~ s/#/\\#/g; - } - my $row = Row([$BTT.$f.$ETT,$BTT.$s.$ETT,$t],@rowOptions); - $row =~ s/\$/\${DOLLAR}/g; - return $row; + my $f = shift; + my $t = ''; + Context()->clearError; + my ($s, $err) = PG_restricted_eval($f); + if (defined $s) { + my $ss = $s; + if (ref($s) && \&{ $s->string }) { + $t = '\(' . $s->TeX . '\)'; + $s = $s->string; + } elsif ($s !~ m/^[a-z]+$/i) { + $t = '\(' . Formula($s)->TeX . '\)'; + $s = Formula($s)->string; + } + $s =~ s//$GT/g; + if (ref($ss) && \&{ $ss->class }) { + if ($ss->class eq 'Formula') { + $s .= ' ' . $BC . '(Formula returning ' . $ss->showType . ')' . $EC; + } else { + $s .= ' ' . $BC . '(' . $ss->class . ' object)' . $EC; + } + } + } else { + $s = $BC . (Context()->{error}{message} || $err) . $EC; + $t = ''; + } + $f =~ s//$GT/g; + if ($displayMode eq 'TeX') { + $f =~ s/\^/\\char`\\^/g; + $s =~ s/\^/\\char`\\^/g; + $f =~ s/#/\\#/g; + $s =~ s/#/\\#/g; + } + my $row = Row([ $BTT . $f . $ETT, $BTT . $s . $ETT, $t ], @rowOptions); + $row =~ s/\$/\${DOLLAR}/g; + return $row; } sub ParserTable { - my $table = - BeginTable(border=>1, padding=>20). - Row([$BBOLD."Perl Code".$EBOLD, - $BBOLD."Result".$EBOLD, - $BBOLD.$TEX.' version'.$EBOLD],@rowOptions); - foreach my $f (@_) {$table .= ParserRow($f)} - $table .= EndTable(); - return $table; + my $table = BeginTable(border => 1, padding => 20) + . Row([ $BBOLD . "Perl Code" . $EBOLD, $BBOLD . "Result" . $EBOLD, $BBOLD . $TEX . ' version' . $EBOLD ], + @rowOptions); + foreach my $f (@_) { $table .= ParserRow($f) } + $table .= EndTable(); + return $table; } sub Title { - my $title = shift; + my $title = shift; - MODES( - TeX => "\\par\\centerline{\\bf $title}\\par\\nobreak\n", - Latex2HTML => $bHTML.'

      '.$title.'

      '.$eHTML, - HTML => '

      '.$title.'

      ' - ); + MODES( + TeX => "\\par\\centerline{\\bf $title}\\par\\nobreak\n", + Latex2HTML => $bHTML . '

      ' . $title . '

      ' . $eHTML, + HTML => '

      ' . $title . '

      ' + ); } diff --git a/doc/parser/macros/parserUtils.pl b/doc/parser/macros/parserUtils.pl index 4db7dd5c4d..b47528bc21 100644 --- a/doc/parser/macros/parserUtils.pl +++ b/doc/parser/macros/parserUtils.pl @@ -1,7 +1,4 @@ -loadMacros( - "unionImage.pl", - "unionTables.pl", -); +loadMacros("unionImage.pl", "unionTables.pl",); $bHTML = '\begin{rawhtml}'; $eHTML = '\end{rawhtml}'; @@ -14,28 +11,28 @@ # $tex for the second form. # sub HTML { - my ($html,$tex) = @_; - return('') unless (defined($html) && $html ne ''); - $tex = '' unless (defined($tex)); - MODES(TeX => $tex, Latex2HTML => $bHTML.$html.$eHTML, HTML => $html); + my ($html, $tex) = @_; + return ('') unless (defined($html) && $html ne ''); + $tex = '' unless (defined($tex)); + MODES(TeX => $tex, Latex2HTML => $bHTML . $html . $eHTML, HTML => $html); } # # Begin and end mode # -$BTT = HTML('','\texttt{'); -$ETT = HTML('','}'); +$BTT = HTML('', '\texttt{'); +$ETT = HTML('', '}'); # # Begin and end mode # -$BSMALL = HTML('','{\small '); -$ESMALL = HTML('','}'); +$BSMALL = HTML('', '{\small '); +$ESMALL = HTML('', '}'); # # Block quotes # -$BBLOCKQUOTE = HTML('
      ','\hskip3em '); +$BBLOCKQUOTE = HTML('
      ', '\hskip3em '); $EBLOCKQUOTE = HTML('
      '); # @@ -48,14 +45,14 @@ sub HTML { # make sure all characters are displayed # sub protectHTML { - my $string = shift; - $string =~ s/&/\&/g; - $string =~ s//\>/g; - $string; + my $string = shift; + $string =~ s/&/\&/g; + $string =~ s//\>/g; + $string; } -sub _parserUtils_init {} +sub _parserUtils_init { } 1; diff --git a/doc/parser/macros/unionImage.pl b/doc/parser/macros/unionImage.pl index 31162b76a3..c02b26fd30 100644 --- a/doc/parser/macros/unionImage.pl +++ b/doc/parser/macros/unionImage.pl @@ -12,7 +12,7 @@ # (default is [150,150]) # # tex_size => r the size to use in TeX mode (as a percentage -# of the line width times 10). E.g., 500 is +# of the line width times 10). E.g., 500 is # half the width, etc. (default is 200.) # # link => 0 or 1 whether to include a link to the original @@ -43,33 +43,52 @@ # when needed. # sub Image { - my $image = shift; my $ilink; - my %options = ( - size => [150,150], tex_size => 200, - link => 0, align => "BOTTOM", tex_center => 0, @_); - my ($w,$h) = @{$options{size}}; - my ($ratio,$link) = ($options{tex_size}*(.001),$options{link}); - my ($border,$align) = ($options{border},$options{align}); - my ($tcenter) = $options{tex_center}; - my $HTML; my $TeX; - ($image,$ilink) = @{$image} if (ref($image) eq "ARRAY"); - $image = alias(insertGraph($image)) if (ref($image) eq "WWPlot"); - $image = alias($image) unless ($image =~ m!^/!i); - if ($ilink) { - $ilink = alias(insertGraph($ilink)) if (ref($ilink) eq "WWPlot"); - $ilink = alias($ilink) unless ($ilink =~ m!^/!i); - } else {$ilink = $image} - $border = (($link || $ilink ne $image)? 2: 1) unless defined($border); - $HTML = ''; - $HTML = ''.$HTML.'' if $link or $ilink ne $image; - $TeX = '\includegraphics[width='.$ratio.'\linewidth]{'.$image.'}'; - $TeX = '\centerline{'.$TeX.'}' if $tcenter; - MODES( - TeX => $TeX."\n", - Latex2HTML => $bHTML.$HTML.$eHTML, - HTML => $HTML - ); + my $image = shift; + my $ilink; + my %options = ( + size => [ 150, 150 ], + tex_size => 200, + link => 0, + align => "BOTTOM", + tex_center => 0, + @_ + ); + my ($w, $h) = @{ $options{size} }; + my ($ratio, $link) = ($options{tex_size} * (.001), $options{link}); + my ($border, $align) = ($options{border}, $options{align}); + my ($tcenter) = $options{tex_center}; + my $HTML; + my $TeX; + ($image, $ilink) = @{$image} if (ref($image) eq "ARRAY"); + $image = alias(insertGraph($image)) if (ref($image) eq "WWPlot"); + $image = alias($image) unless ($image =~ m!^/!i); + + if ($ilink) { + $ilink = alias(insertGraph($ilink)) if (ref($ilink) eq "WWPlot"); + $ilink = alias($ilink) unless ($ilink =~ m!^/!i); + } else { + $ilink = $image; + } + $border = (($link || $ilink ne $image) ? 2 : 1) unless defined($border); + $HTML = + ''; + $HTML = '' . $HTML . '' if $link or $ilink ne $image; + $TeX = '\includegraphics[width=' . $ratio . '\linewidth]{' . $image . '}'; + $TeX = '\centerline{' . $TeX . '}' if $tcenter; + MODES( + TeX => $TeX . "\n", + Latex2HTML => $bHTML . $HTML . $eHTML, + HTML => $HTML + ); } 1; diff --git a/doc/parser/macros/unionTables.pl b/doc/parser/macros/unionTables.pl index 8db8c8f46e..456964cdd5 100644 --- a/doc/parser/macros/unionTables.pl +++ b/doc/parser/macros/unionTables.pl @@ -32,15 +32,16 @@ # (default is "MIDDLE") # sub ColumnTable { - my $col1 = shift; my $col2 = shift; - my %options = (indent => 0, separation => 50, valign => "MIDDLE", @_); - my ($ind,$sep) = ($options{"indent"},$options{"separation"}); - my $valign = $options{"valign"}; + my $col1 = shift; + my $col2 = shift; + my %options = (indent => 0, separation => 50, valign => "MIDDLE", @_); + my ($ind, $sep) = ($options{"indent"}, $options{"separation"}); + my $valign = $options{"valign"}; - my ($bhtml,$ehtml) = ('\begin{rawhtml}','\end{rawhtml}'); - ($bhtml,$ehtml) = ('','') unless ($displayMode eq "Latex2HTML"); + my ($bhtml, $ehtml) = ('\begin{rawhtml}', '\end{rawhtml}'); + ($bhtml, $ehtml) = ('', '') unless ($displayMode eq "Latex2HTML"); - my $HTMLtable = qq { + my $HTMLtable = qq { $bhtml
       $ehtml $col1 @@ -49,14 +50,17 @@ sub ColumnTable { $bhtml
      $ehtml }; - MODES( - TeX => '\par\medskip\hbox{\qquad\vtop{'. - '\advance\hsize by -3em '.$col1.'}}'. - '\medskip\hbox{\qquad\vtop{'. - '\advance\hsize by -3em '.$col2.'}}\medskip', - Latex2HTML => $HTMLtable, - HTML => $HTMLtable - ); + MODES( + TeX => '\par\medskip\hbox{\qquad\vtop{' + . '\advance\hsize by -3em ' + . $col1 . '}}' + . '\medskip\hbox{\qquad\vtop{' + . '\advance\hsize by -3em ' + . $col2 + . '}}\medskip', + Latex2HTML => $HTMLtable, + HTML => $HTMLtable + ); } # @@ -68,12 +72,11 @@ sub ColumnTable { # allowed for ColumnTable above. # sub ColumnMatchTable { - my $ml = shift; + my $ml = shift; - ColumnTable($ml->print_q,$ml->print_a,@_); + ColumnTable($ml->print_q, $ml->print_a, @_); } - # # Command for tables with no borders. # @@ -90,21 +93,26 @@ sub ColumnMatchTable { # center => 0 or 1 center table or not (default 1) # sub BeginTable { - my %options = (border => 0, padding => 0, spacing => 0, center => 1, - tex_spacing => "1em", tex_border => "0pt", @_); - my ($bd,$pd,$sp) = ($options{border},$options{padding},$options{spacing}); - my ($tsp,$tbd) = ($options{tex_spacing},$options{tex_border}); - my ($center,$tcenter) = (' ALIGN="CENTER"','\centerline'); - ($center,$tcenter) = ('','') if (!$options{center}); - my $table = - qq{}; - - MODES( - TeX => '\par\medskip'.$tcenter.'{\kern '.$tbd. - '\vbox{\halign{#\hfil&&\kern '.$tsp.' #\hfil', - Latex2HTML => $bHTML.$table.$eHTML."\n", - HTML => $table."\n" - ); + my %options = ( + border => 0, + padding => 0, + spacing => 0, + center => 1, + tex_spacing => "1em", + tex_border => "0pt", + @_ + ); + my ($bd, $pd, $sp) = ($options{border}, $options{padding}, $options{spacing}); + my ($tsp, $tbd) = ($options{tex_spacing}, $options{tex_border}); + my ($center, $tcenter) = (' ALIGN="CENTER"', '\centerline'); + ($center, $tcenter) = ('', '') if (!$options{center}); + my $table = qq{
      }; + + MODES( + TeX => '\par\medskip' . $tcenter . '{\kern ' . $tbd . '\vbox{\halign{#\hfil&&\kern ' . $tsp . ' #\hfil', + Latex2HTML => $bHTML . $table . $eHTML . "\n", + HTML => $table . "\n" + ); } # @@ -115,13 +123,13 @@ sub BeginTable { # tex_border => dimen extra vertical space in TeX mode (default 0pt) # sub EndTable { - my %options = (tex_border => "0pt", @_); - my $tbd = $options{tex_border}; - MODES( - TeX => '\cr}}\kern '.$tbd.'}\medskip'."\n", - Latex2HTML => $bHTML.'
      '.$eHTML."\n", - HTML => ''."\n" - ); + my %options = (tex_border => "0pt", @_); + my $tbd = $options{tex_border}; + MODES( + TeX => '\cr}}\kern ' . $tbd . '}\medskip' . "\n", + Latex2HTML => $bHTML . '' . $eHTML . "\n", + HTML => '' . "\n" + ); } # @@ -146,29 +154,38 @@ sub EndTable { # (default: valign => "MIDDLE") # sub Row { - my $rowref = shift; my @row = @{$rowref}; - my %options = ( - indent => 0, separation => 30, - align => "LEFT", valign => "MIDDLE", - @_ - ); - my ($cind,$csep) = ($options{indent},$options{separation}); - my ($align,$valign) = ($options{align},$options{valign}); - my $sep = ' '; $sep = '' if ($csep < 1); - my $ind = ' '; $ind = '' if ($cind < 1); - my $fill = ''; - $fill = '\hfil' if (uc($align) eq "CENTER"); - $fill = '\hfill' if (uc($align) eq "RIGHT"); - - MODES( - TeX => "\\cr\n". $fill . join('& ',@row), - Latex2HTML => - $bHTML."$ind".$eHTML . - join($bHTML."$sep".$eHTML,@row) . - $bHTML.''.$eHTML."\n", - HTML => "$ind" . - join("$sep",@row) . ''."\n" - ); + my $rowref = shift; + my @row = @{$rowref}; + my %options = ( + indent => 0, + separation => 30, + align => "LEFT", + valign => "MIDDLE", + @_ + ); + my ($cind, $csep) = ($options{indent}, $options{separation}); + my ($align, $valign) = ($options{align}, $options{valign}); + my $sep = ' '; + $sep = '' if ($csep < 1); + my $ind = ' '; + $ind = '' if ($cind < 1); + my $fill = ''; + $fill = '\hfil' if (uc($align) eq "CENTER"); + $fill = '\hfill' if (uc($align) eq "RIGHT"); + + MODES( + TeX => "\\cr\n" . $fill . join('& ', @row), + Latex2HTML => $bHTML + . "$ind" + . $eHTML + . join($bHTML . "$sep" . $eHTML, @row) + . $bHTML + . '' + . $eHTML . "\n", + HTML => "$ind" + . join("$sep", @row) + . '' . "\n" + ); } # @@ -189,29 +206,38 @@ sub Row { # (default: valign => "MIDDLE") # sub AlignedRow { - my $rowref = shift; my @row = @{$rowref}; - my %options = ( - indent => 0, separation => 30, - align => "CENTER", valign => "MIDDLE", - @_ - ); - my ($cind,$csep) = ($options{indent},$options{separation}); - my ($align,$valign) = ($options{align},$options{valign}); - my $sep = ' '; $sep = '' if ($csep < 1); - my $ind = ' '; $ind = '' if ($cind < 1); - my $fill = ''; - $fill = '\hfil ' if (uc($align) eq "CENTER"); - $fill = '\hfill ' if (uc($align) eq "RIGHT"); - - MODES( - TeX => "\\cr\n". $fill . join('&'.$fill,@row), - Latex2HTML => - $bHTML."$ind".$eHTML . - join($bHTML."$sep".$eHTML,@row) . - $bHTML.''.$eHTML."\n", - HTML => "$ind" . - join("$sep",@row) . ''."\n" - ); + my $rowref = shift; + my @row = @{$rowref}; + my %options = ( + indent => 0, + separation => 30, + align => "CENTER", + valign => "MIDDLE", + @_ + ); + my ($cind, $csep) = ($options{indent}, $options{separation}); + my ($align, $valign) = ($options{align}, $options{valign}); + my $sep = ' '; + $sep = '' if ($csep < 1); + my $ind = ' '; + $ind = '' if ($cind < 1); + my $fill = ''; + $fill = '\hfil ' if (uc($align) eq "CENTER"); + $fill = '\hfill ' if (uc($align) eq "RIGHT"); + + MODES( + TeX => "\\cr\n" . $fill . join('&' . $fill, @row), + Latex2HTML => $bHTML + . "$ind" + . $eHTML + . join($bHTML . "$sep" . $eHTML, @row) + . $bHTML + . '' + . $eHTML . "\n", + HTML => "$ind" + . join("$sep", @row) + . '' . "\n" + ); } # @@ -223,16 +249,15 @@ sub AlignedRow { # points is the number of points to use in TeX mode. # sub TableSpace { - my $rsep = shift; - my $tsep = shift; - $rsep = $tsep if (defined($tsep) && $main::displayMode eq "TeX"); - return "" if ($rsep < 1); - MODES( - TeX => '\vadjust{\kern '.$rsep.'pt}' . "\n", - Latex2HTML => - $bHTML.''.$eHTML."\n", - HTML => ''."\n", - ); + my $rsep = shift; + my $tsep = shift; + $rsep = $tsep if (defined($tsep) && $main::displayMode eq "TeX"); + return "" if ($rsep < 1); + MODES( + TeX => '\vadjust{\kern ' . $rsep . 'pt}' . "\n", + Latex2HTML => $bHTML . '' . $eHTML . "\n", + HTML => '' . "\n", + ); } # @@ -241,13 +266,11 @@ sub TableSpace { # one to be consistent.) # sub TableLine { - MODES( - TeX => '\vadjust{\kern2pt\hrule\kern2pt}', - Latex2HTML => $bHTML. - '
      '. - $eHTML."\n", - HTML =>'
      '."\n" - ); + MODES( + TeX => '\vadjust{\kern2pt\hrule\kern2pt}', + Latex2HTML => $bHTML . '
      ' . $eHTML . "\n", + HTML => '
      ' . "\n" + ); } 1; diff --git a/lib/Apache/AuthenWeBWorK.pm b/lib/Apache/AuthenWeBWorK.pm index 9be0264493..35ba100c93 100644 --- a/lib/Apache/AuthenWeBWorK.pm +++ b/lib/Apache/AuthenWeBWorK.pm @@ -54,52 +54,49 @@ use WeBWorK::Utils qw/runtime_use/; sub handler($) { my ($apache) = @_; my $r = new WeBWorK::Request($apache); - + my ($res, $sent_pw) = $r->get_basic_auth_pw; return $res unless $res == Apache2::Const::OK; - - my $webwork_root = $r->dir_config('authen_webwork_root'); + + my $webwork_root = $r->dir_config('authen_webwork_root'); my $webwork_course = $r->dir_config('authen_webwork_course'); - + return fail($r, "authen_webwork_root not set") unless defined $webwork_root and $webwork_root ne ""; return fail($r, "authen_webwork_course not set") unless defined $webwork_course and $webwork_course ne ""; - + # FIXME most of this build-up code is yoinked from lib/WeBWorK.pm # needs to be factored out somehow # (for example, the authen module selection code probably belongs in a factory) - - my $ce = eval { new WeBWorK::CourseEnvironment({ - webwork_dir => $webwork_root, - courseName => $webwork_course, - }) }; + + my $ce = eval { new WeBWorK::CourseEnvironment({ webwork_dir => $webwork_root, courseName => $webwork_course, }) }; $@ and return fail($r, "failed to initialize the course environment: $@"); $r->ce($ce); - + my $authz = new WeBWorK::Authz($r); $r->authz($authz); - + # figure out which authentication module to use my $user_authen_module; my $proctor_authen_module; if (ref $ce->{authen}{user_module} eq "HASH") { - if (exists $ce->{authen}{user_module}{$ce->{dbLayoutName}}) { - $user_authen_module = $ce->{authen}{user_module}{$ce->{dbLayoutName}}; + if (exists $ce->{authen}{user_module}{ $ce->{dbLayoutName} }) { + $user_authen_module = $ce->{authen}{user_module}{ $ce->{dbLayoutName} }; } else { $user_authen_module = $ce->{authen}{user_module}{"*"}; } } else { $user_authen_module = $ce->{authen}{user_module}; } - + runtime_use $user_authen_module; my $authen = $user_authen_module->new($r); $r->authen($authen); - + my $db = new WeBWorK::DB($ce->{dbLayout}); $r->db($db); - + # now, here's the problem... WeBWorK::Authen looks at $r->params directly, whereas we # need to look at $user and $sent_pw. this is a perfect opportunity for a mixin, i think. my $authenOK; @@ -109,13 +106,12 @@ sub handler($) { local *WeBWorK::Authen::maybe_send_cookie = \&Authen::WeBWorK::HTTPBasic::noop; local *WeBWorK::Authen::maybe_kill_cookie = \&Authen::WeBWorK::HTTPBasic::noop; local *WeBWorK::Authen::set_params = \&Authen::WeBWorK::HTTPBasic::noop; - + $authenOK = $authen->verify; } - - + debug("verify said: '$authenOK'"); - + if ($authenOK) { debug("this will work!!!"); #return OK; @@ -128,10 +124,10 @@ sub handler($) { sub fail { my ($r, $msg) = @_; - $r->note_basic_auth_failure; - $r->log_reason($msg, $r->filename); - #return AUTH_REQUIRED; - return Apache2::Const::HTTP_UNAUTHORIZED; + $r->note_basic_auth_failure; + $r->log_reason($msg, $r->filename); + #return AUTH_REQUIRED; + return Apache2::Const::HTTP_UNAUTHORIZED; } =back @@ -151,22 +147,22 @@ use WeBWorK::Debug; sub get_credentials { my ($self) = @_; my $r = $self->{r}; - + my ($res, $sent_pw) = $r->get_basic_auth_pw; #return unless $res == OK; return unless $res == Apache2::Const::OK; my $user_id = $r->user; #my $user_id = $r->connection->user; - + #if (defined $r->connection->user) { if (defined $r->user) { - $self->{user_id} = $r->user; - $self->{password} = $sent_pw; + $self->{user_id} = $r->user; + $self->{password} = $sent_pw; $self->{credential_source} = "http_basic"; return 1; } } -sub noop {} +sub noop { } 1; diff --git a/lib/Apache/WeBWorK.pm b/lib/Apache/WeBWorK.pm index 94b7ea6a1f..26743de8e8 100644 --- a/lib/Apache/WeBWorK.pm +++ b/lib/Apache/WeBWorK.pm @@ -39,14 +39,13 @@ use WeBWorK; use Encode; use utf8; use JSON::MaybeXS; -use UUID::Tiny ':std'; +use UUID::Tiny ':std'; # Should the minimal (more secure) HTML error output be used? -use constant MIN_HTML_ERRORS => ( exists $ENV{"MIN_HTML_ERRORS"} and $ENV{"MIN_HTML_ERRORS"} ); +use constant MIN_HTML_ERRORS => (exists $ENV{"MIN_HTML_ERRORS"} and $ENV{"MIN_HTML_ERRORS"}); # Should Apache logs get JSON formatted record? -use constant JSON_ERROR_LOG => ( exists $ENV{"JSON_ERROR_LOG"} and $ENV{"JSON_ERROR_LOG"} ); - +use constant JSON_ERROR_LOG => (exists $ENV{"JSON_ERROR_LOG"} and $ENV{"JSON_ERROR_LOG"}); ################################################################################ @@ -63,7 +62,6 @@ sub handler($) { my $log = $r->log; my $uri = $r->uri; - # We set the binmode for print to utf8 because some language options # use utf8 characters binmode(STDOUT, ":encoding(UTF-8)"); @@ -75,11 +73,11 @@ sub handler($) { my ($warning) = @_; chomp $warning; my $warnings = $r->notes->get("warnings"); - $warnings = Encode::decode("UTF-8",$warnings); + $warnings = Encode::decode("UTF-8", $warnings); $warnings .= "$warning\n"; #my $backtrace = join("\n",backtrace()); #$warnings .= "$backtrace\n\n"; - $warnings = Encode::encode("UTF-8",$warnings); + $warnings = Encode::encode("UTF-8", $warnings); $r->notes->set(warnings => $warnings); $log->warn("[$uri] $warning"); @@ -94,7 +92,7 @@ sub handler($) { my $result = do { local $SIG{__WARN__} = $warning_handler; - local $SIG{__DIE__} = $exception_handler; + local $SIG{__DIE__} = $exception_handler; eval { WeBWorK::dispatch($r) }; }; @@ -104,30 +102,30 @@ sub handler($) { my $warnings = $r->notes->get("warnings"); my $htmlMessage; - my $uuid = create_uuid_as_string(UUID_SHA1, UUID_NS_URL, $r->uri ) - . "::" . create_uuid_as_string(UUID_TIME); + my $uuid = create_uuid_as_string(UUID_SHA1, UUID_NS_URL, $r->uri) . "::" . create_uuid_as_string(UUID_TIME); my $time = time2str("%a %b %d %H:%M:%S %Y", time); - if ( MIN_HTML_ERRORS ) { + if (MIN_HTML_ERRORS) { $htmlMessage = htmlMinMessage($r, $exception, $uuid, $time); } else { $htmlMessage = htmlMessage($r, $warnings, $exception, $uuid, $time, @backtrace); } unless ($r->bytes_sent) { $r->content_type("text/html"); - $htmlMessage = "WeBWorK error$htmlMessage"; + $htmlMessage = + "WeBWorK error$htmlMessage"; } # log the error to the apache error log my $logMessage; - if ( JSON_ERROR_LOG ) { + if (JSON_ERROR_LOG) { $logMessage = jsonMessage($r, $warnings, $exception, $uuid, $time, @backtrace); } else { $logMessage = textMessage($r, $warnings, $exception, $uuid, $time, @backtrace); } $log->error($logMessage); - $r->custom_response(FORBIDDEN,$htmlMessage); + $r->custom_response(FORBIDDEN, $htmlMessage); $result = FORBIDDEN; } @@ -187,21 +185,21 @@ sub htmlMessage($$$@) { # Warnings have html and look better scrubbed. my $scrubber = HTML::Scrubber->new( - default => 1, - script => 0, - comment => 0 - ); + default => 1, + script => 0, + comment => 0 + ); $scrubber->default( - undef, - { - '*' => 1, - } - ); + undef, + { + '*' => 1, + } + ); - $warnings = $scrubber->scrub($warnings); + $warnings = $scrubber->scrub($warnings); $exception = $scrubber->scrub($exception); - my @warnings = defined $warnings ? split m|
      |, $warnings : (); #fragile + my @warnings = defined $warnings ? split m|
      |, $warnings : (); #fragile $warnings = htmlWarningsList(@warnings); my $backtrace = htmlBacktrace(@backtrace); @@ -209,29 +207,34 @@ sub htmlMessage($$$@) { # and $ENV{SERVER_ADMIN} which is set by ServerAdmin in httpd.conf is used as a backup # if an explicit email address has not been set. - $ENV{WEBWORK_SERVER_ADMIN} = $ENV{WEBWORK_SERVER_ADMIN} || $ENV{SERVER_ADMIN} // ''; #guarantee this variable is defined. + $ENV{WEBWORK_SERVER_ADMIN} = $ENV{WEBWORK_SERVER_ADMIN} || $ENV{SERVER_ADMIN} + // ''; #guarantee this variable is defined. - my $admin = ($ENV{WEBWORK_SERVER_ADMIN} - ? " ($ENV{WEBWORK_SERVER_ADMIN})" - : ""); - my $method = htmlEscape( $r->method ); - my $uri = htmlEscape( $r->uri ); + my $admin = + ($ENV{WEBWORK_SERVER_ADMIN} + ? " ($ENV{WEBWORK_SERVER_ADMIN})" + : ""); + my $method = htmlEscape($r->method); + my $uri = htmlEscape($r->uri); my $headers = do { - my %headers = %{$r->headers_in}; + my %headers = %{ $r->headers_in }; if (defined($headers{"sec-ch-ua"})) { # Was getting warnings about the value of "sec-ch-ua" in my testing... - $headers{"sec-ch-ua"} = join("",$headers{"sec-ch-ua"}); + $headers{"sec-ch-ua"} = join("", $headers{"sec-ch-ua"}); $headers{"sec-ch-ua"} =~ s/\"//g; } - join("", + join( + "", "KeyValue\n", - map { "" . - htmlEscape($_) . - "" . - htmlEscape($headers{$_}) . - "\n" - } keys %headers ); + map { + "" + . htmlEscape($_) + . "" + . htmlEscape($headers{$_}) + . "\n" + } keys %headers + ); }; return <new( - default => 1, - script => 0, - comment => 0 - ); + default => 1, + script => 0, + comment => 0 + ); $scrubber->default( - undef, - { - '*' => 1, - } - ); + undef, + { + '*' => 1, + } + ); $exception = $scrubber->scrub($exception); @@ -310,11 +313,13 @@ sub htmlMinMessage($$$@) { # and $ENV{SERVER_ADMIN} which is set by ServerAdmin in httpd.conf is used as a backup # if an explicit email address has not been set. - $ENV{WEBWORK_SERVER_ADMIN} = $ENV{WEBWORK_SERVER_ADMIN} || $ENV{SERVER_ADMIN} // ''; #guarantee this variable is defined. + $ENV{WEBWORK_SERVER_ADMIN} = $ENV{WEBWORK_SERVER_ADMIN} || $ENV{SERVER_ADMIN} + // ''; #guarantee this variable is defined. - my $admin = ($ENV{WEBWORK_SERVER_ADMIN} - ? " ($ENV{WEBWORK_SERVER_ADMIN})" - : ""); + my $admin = + ($ENV{WEBWORK_SERVER_ADMIN} + ? " ($ENV{WEBWORK_SERVER_ADMIN})" + : ""); return < @@ -347,25 +352,25 @@ sub textMessage($$$@) { chomp $exception; my $backtrace = textBacktrace(@backtrace); - my $uri = $r->uri; + my $uri = $r->uri; my @warnings = defined $warnings ? split m/\n+/, $warnings : (); - my %headers = %{$r->headers_in}; + my %headers = %{ $r->headers_in }; # Was getting JSON errors for the value of "sec-ch-ua" in my testing, so remove it - if ( defined( $headers{"sec-ch-ua"} ) ) { - $headers{"sec-ch-ua"} = join("",$headers{"sec-ch-ua"}); + if (defined($headers{"sec-ch-ua"})) { + $headers{"sec-ch-ua"} = join("", $headers{"sec-ch-ua"}); $headers{"sec-ch-ua"} =~ s/\"//g; } my $additional_json = encode_json({ - "Error record identifier" => $uuid, - "Time" => $time, - "Method" => $r->method, - "URI" => $r->uri, - "HTTP Headers" => {%headers}, - "Warnings" => [ @warnings ], - }); + "Error record identifier" => $uuid, + "Time" => $time, + "Method" => $r->method, + "URI" => $r->uri, + "HTTP Headers" => {%headers}, + "Warnings" => [@warnings], + }); return "[$uuid] [$uri] $additional_json $exception\n$backtrace"; } @@ -383,23 +388,23 @@ sub jsonMessage($$$@) { chomp $exception; my @warnings = defined $warnings ? split m/\n+/, $warnings : (); - my %headers = %{$r->headers_in}; + my %headers = %{ $r->headers_in }; # Was getting JSON errors for the value of "sec-ch-ua" in my testing, so remove it - if ( defined( $headers{"sec-ch-ua"} ) ) { - $headers{"sec-ch-ua"} = join("",$headers{"sec-ch-ua"}); + if (defined($headers{"sec-ch-ua"})) { + $headers{"sec-ch-ua"} = join("", $headers{"sec-ch-ua"}); $headers{"sec-ch-ua"} =~ s/\"//g; } return encode_json({ - "Error record identifier" => $uuid, - "Time" => $time, - "Method" => $r->method, - "URI" => $r->uri, - "HTTP Headers" => {%headers}, - "Warnings" => [ @warnings ], - "Exception" => $exception, - "Backtrace" => [ @backtrace ], - }); + "Error record identifier" => $uuid, + "Time" => $time, + "Method" => $r->method, + "URI" => $r->uri, + "HTTP Headers" => {%headers}, + "Warnings" => [@warnings], + "Exception" => $exception, + "Backtrace" => [@backtrace], + }); } ################################################################################ @@ -475,7 +480,7 @@ line breaks with HTML "
      " tags. sub htmlEscape($) { my ($string) = @_; - $string = $string//''; # make sure it's defined. + $string = $string // ''; # make sure it's defined. $string = encode_entities($string); $string =~ s|\n|
      |g; return $string; diff --git a/lib/Caliper/Actor.pm b/lib/Caliper/Actor.pm index 650d5f2d5b..55f60b2c40 100644 --- a/lib/Caliper/Actor.pm +++ b/lib/Caliper/Actor.pm @@ -10,28 +10,25 @@ use Data::Dumper; use Caliper::ResourceIri; -sub generate_anonymous_actor -{ +sub generate_anonymous_actor { return { - 'id' => 'http://purl.imsglobal.org/caliper/Person', + 'id' => 'http://purl.imsglobal.org/caliper/Person', 'type' => 'Person', }; } -sub generate_default_actor -{ +sub generate_default_actor { my ($ce, $db, $user) = @_; my $resource_iri = Caliper::ResourseIri->new($ce); return { - 'id' => $resource_iri->actor_homepage($user->user_id()), + 'id' => $resource_iri->actor_homepage($user->user_id()), 'type' => 'Person', 'name' => $user->first_name() . " " . $user->last_name(), }; } -sub generate_actor -{ +sub generate_actor { my ($ce, $db, $user_id) = @_; if (!defined($user_id)) { diff --git a/lib/Caliper/Entity.pm b/lib/Caliper/Entity.pm index f2cda8e3d7..68d9f0ee97 100644 --- a/lib/Caliper/Entity.pm +++ b/lib/Caliper/Entity.pm @@ -15,40 +15,37 @@ use Caliper::Sensor; use Caliper::Actor; use WeBWorK::Utils qw(grade_set grade_gateway); -sub webwork_app -{ +sub webwork_app { my ($ce, $db) = @_; my $resource_iri = Caliper::ResourseIri->new($ce); # $ce doesn't have WW_VERSION when doing login/logout for some reason - my $webwork_dir = $WeBWorK::Constants::WEBWORK_DIRECTORY; - my $seed_ce = new WeBWorK::CourseEnvironment({ webwork_dir => $webwork_dir }); - my $ww_version = $seed_ce->{WW_VERSION}||"unknown"; + my $webwork_dir = $WeBWorK::Constants::WEBWORK_DIRECTORY; + my $seed_ce = new WeBWorK::CourseEnvironment({ webwork_dir => $webwork_dir }); + my $ww_version = $seed_ce->{WW_VERSION} || "unknown"; return { - 'id' => $resource_iri->webwork(), - 'type' => 'SoftwareApplication', - 'name' => 'WeBWorK', + 'id' => $resource_iri->webwork(), + 'type' => 'SoftwareApplication', + 'name' => 'WeBWorK', 'version' => $ww_version, }; } -sub session -{ +sub session { my ($ce, $db, $actor, $session_key) = @_; - my $resource_iri = Caliper::ResourseIri->new($ce); + my $resource_iri = Caliper::ResourseIri->new($ce); my $session_key_hash = sha1_base64($session_key); return { - 'id' => $resource_iri->user_session($session_key_hash), - 'type' => 'Session', - 'user' => $actor, + 'id' => $resource_iri->user_session($session_key_hash), + 'type' => 'Session', + 'user' => $actor, 'client' => Caliper::Entity::client($ce, $db, $session_key_hash), }; } -sub client -{ +sub client { my ($ce, $db, $session_key_hash) = @_; my $resource_iri = Caliper::ResourseIri->new($ce); @@ -62,23 +59,22 @@ sub client } return { - 'id' => $resource_iri->user_client($session_key_hash), - 'type' => 'SoftwareApplication', + 'id' => $resource_iri->user_client($session_key_hash), + 'type' => 'SoftwareApplication', 'userAgent' => $ENV{HTTP_USER_AGENT}, 'ipAddress' => $ip_address, - 'host' => $ENV{HTTP_HOST}, + 'host' => $ENV{HTTP_HOST}, }; } -sub membership -{ +sub membership { my ($ce, $db, $actor, $user_id) = @_; my $resource_iri = Caliper::ResourseIri->new($ce); - my $user = $db->getUser($user_id); + my $user = $db->getUser($user_id); my $permission = $db->getPermissionLevel($user_id); - my $roles = []; + my $roles = []; my $status = ''; if ($user->status() ne 'D') { @@ -106,22 +102,21 @@ sub membership # guest and nobody aren't tracked return { - 'id' => $resource_iri->user_membership($user_id), - 'type' => 'Membership', - 'member' => $actor, + 'id' => $resource_iri->user_membership($user_id), + 'type' => 'Membership', + 'member' => $actor, 'organization' => $resource_iri->course(), - 'roles' => $roles, - 'status' => $status, + 'roles' => $roles, + 'status' => $status, }; } -sub course -{ +sub course { my ($ce, $db) = @_; my $resource_iri = Caliper::ResourseIri->new($ce); my $course_entity = { - 'id' => $resource_iri->course(), + 'id' => $resource_iri->course(), 'type' => 'CourseOffering', }; @@ -132,54 +127,56 @@ sub course return $course_entity; } -sub problem_set -{ +sub problem_set { my ($ce, $db, $set_id) = @_; my $resource_iri = Caliper::ResourseIri->new($ce); my $problem_set = $db->getGlobalSet($set_id); - my $items = []; + my $items = []; my @problem_ids = $db->listGlobalProblems($set_id); for my $problem_id (@problem_ids) { - push(@$items, { - 'id' => $resource_iri->problem($set_id, $problem_id), - 'type' => 'AssessmentItem', - }); + push( + @$items, + { + 'id' => $resource_iri->problem($set_id, $problem_id), + 'type' => 'AssessmentItem', + } + ); } my $problem_set_entity = { - 'id' => $resource_iri->problem_set($set_id), - 'type' => 'Assessment', - 'isPartOf' => Caliper::Entity::course($ce, $db), - 'name' => $set_id, - 'items' => $items, + 'id' => $resource_iri->problem_set($set_id), + 'type' => 'Assessment', + 'isPartOf' => Caliper::Entity::course($ce, $db), + 'name' => $set_id, + 'items' => $items, 'dateToStartOn' => Caliper::Sensor::formatted_timestamp($problem_set->open_date()), - 'dateToSubmit' => Caliper::Sensor::formatted_timestamp($problem_set->due_date()), - 'extensions' => { - 'answer_date' => $problem_set->answer_date(), - 'reduced_scoring_date' => $problem_set->reduced_scoring_date(), - 'visible' => $problem_set->visible(), - 'enable_reduced_scoring' => $problem_set->enable_reduced_scoring(), - 'description' => $problem_set->description(), - 'restricted_release' => $problem_set->restricted_release(), - 'restricted_status' => $problem_set->restricted_status(), - 'attempts_per_version' => $problem_set->attempts_per_version(), - 'time_interval' => $problem_set->time_interval(), - 'versions_per_interval' => $problem_set->versions_per_interval(), - 'version_time_limit' => $problem_set->version_time_limit(), - 'version_creation_time' => $problem_set->version_creation_time(), - 'problem_randorder' => $problem_set->problem_randorder(), + 'dateToSubmit' => Caliper::Sensor::formatted_timestamp($problem_set->due_date()), + 'extensions' => { + 'answer_date' => $problem_set->answer_date(), + 'reduced_scoring_date' => $problem_set->reduced_scoring_date(), + 'visible' => $problem_set->visible(), + 'enable_reduced_scoring' => $problem_set->enable_reduced_scoring(), + 'description' => $problem_set->description(), + 'restricted_release' => $problem_set->restricted_release(), + 'restricted_status' => $problem_set->restricted_status(), + 'attempts_per_version' => $problem_set->attempts_per_version(), + 'time_interval' => $problem_set->time_interval(), + 'versions_per_interval' => $problem_set->versions_per_interval(), + 'version_time_limit' => $problem_set->version_time_limit(), + 'version_creation_time' => $problem_set->version_creation_time(), + 'problem_randorder' => $problem_set->problem_randorder(), 'version_last_attempt_time' => $problem_set->version_last_attempt_time(), - 'problems_per_page' => $problem_set->problems_per_page(), - 'hide_score' => $problem_set->hide_score(), - 'hide_score_by_problem' => $problem_set->hide_score_by_problem(), - 'hide_work' => $problem_set->hide_work(), - 'time_limit_cap' => $problem_set->time_limit_cap(), - 'restrict_ip' => $problem_set->restrict_ip(), - 'relax_restrict_ip' => $problem_set->relax_restrict_ip(), - 'restricted_login_proctor' => $problem_set->restricted_login_proctor(), - 'hide_hint' => $problem_set->hide_hint(), + 'problems_per_page' => $problem_set->problems_per_page(), + 'hide_score' => $problem_set->hide_score(), + 'hide_score_by_problem' => $problem_set->hide_score_by_problem(), + 'hide_work' => $problem_set->hide_work(), + 'time_limit_cap' => $problem_set->time_limit_cap(), + 'restrict_ip' => $problem_set->restrict_ip(), + 'relax_restrict_ip' => $problem_set->relax_restrict_ip(), + 'restricted_login_proctor' => $problem_set->restricted_login_proctor(), + 'hide_hint' => $problem_set->hide_hint(), 'restrict_prob_progression' => $problem_set->restrict_prob_progression(), } }; @@ -191,153 +188,159 @@ sub problem_set return $problem_set_entity; } -sub problem -{ +sub problem { my ($ce, $db, $set_id, $problem_id) = @_; my $resource_iri = Caliper::ResourseIri->new($ce); my $problem = $db->getGlobalProblem($set_id, $problem_id); my $templateDir = $ce->{courseDirs}->{templates}; - my $tags = WeBWorK::Utils::Tags->new($templateDir.'/'.$problem->source_file()); - my $keywords = $tags->{'keywords'}; + my $tags = WeBWorK::Utils::Tags->new($templateDir . '/' . $problem->source_file()); + my $keywords = $tags->{'keywords'}; $_ =~ s/(^[\s"']+)|([\s"']+$)//g for @$keywords; - my %tags_ref = %$tags; + my %tags_ref = %$tags; my $unblessed_tags = \%tags_ref; return { - 'id' => $resource_iri->problem($set_id, $problem_id), - 'type' => 'AssessmentItem', - 'name' => 'Problem ' . $problem_id, - 'isPartOf' => Caliper::Entity::problem_set($ce, $db, $set_id), - 'keywords' => $keywords, + 'id' => $resource_iri->problem($set_id, $problem_id), + 'type' => 'AssessmentItem', + 'name' => 'Problem ' . $problem_id, + 'isPartOf' => Caliper::Entity::problem_set($ce, $db, $set_id), + 'keywords' => $keywords, 'extensions' => { - 'source_file' => $problem->source_file(), - 'value' => $problem->value(), - 'max_attempts' => $problem->max_attempts(), + 'source_file' => $problem->source_file(), + 'value' => $problem->value(), + 'max_attempts' => $problem->max_attempts(), 'att_to_open_children' => $problem->att_to_open_children(), - 'counts_parent_grade' => $problem->counts_parent_grade(), - 'showMeAnother' => $problem->showMeAnother(), - 'showMeAnotherCount' => $problem->showMeAnotherCount(), - 'showHintsAfter' => $problem->showHintsAfter(), - 'prPeriod' => $problem->prPeriod(), - 'prCount' => $problem->prCount(), - 'flags' => $problem->flags(), - 'tags' => $unblessed_tags, + 'counts_parent_grade' => $problem->counts_parent_grade(), + 'showMeAnother' => $problem->showMeAnother(), + 'showMeAnotherCount' => $problem->showMeAnotherCount(), + 'showHintsAfter' => $problem->showHintsAfter(), + 'prPeriod' => $problem->prPeriod(), + 'prCount' => $problem->prCount(), + 'flags' => $problem->flags(), + 'tags' => $unblessed_tags, }, }; } -sub problem_user -{ +sub problem_user { my ($ce, $db, $set_id, $version_id, $problem_id, $user_id, $pg) = @_; my $resource_iri = Caliper::ResourseIri->new($ce); - my $problem_user = $version_id ? - $db->getMergedProblemVersion($user_id, $set_id, $version_id, $problem_id) : - $db->getMergedProblem($user_id, $set_id, $problem_id); + my $problem_user = + $version_id + ? $db->getMergedProblemVersion($user_id, $set_id, $version_id, $problem_id) + : $db->getMergedProblem($user_id, $set_id, $problem_id); my $templateDir = $ce->{courseDirs}->{templates}; - my $tags = WeBWorK::Utils::Tags->new($templateDir.'/'.$problem_user->source_file()); - my $keywords = $tags->{'keywords'}; + my $tags = WeBWorK::Utils::Tags->new($templateDir . '/' . $problem_user->source_file()); + my $keywords = $tags->{'keywords'}; $_ =~ s/(^[\s"']+)|([\s"']+$)//g for @$keywords; - my %tags_ref = %$tags; + my %tags_ref = %$tags; my $unblessed_tags = \%tags_ref; my $correct_answers = []; - foreach my $ans_id (@{$pg->{flags}->{ANSWER_ENTRY_ORDER}//[]} ) { + foreach my $ans_id (@{ $pg->{flags}->{ANSWER_ENTRY_ORDER} // [] }) { push @$correct_answers, $pg->{'answers'}->{$ans_id}->{'correct_value'}; } return { - 'id' => $resource_iri->problem_user($set_id, $problem_id, $user_id), - 'type' => 'AssessmentItem', - 'name' => 'Problem ' . $problem_id, - 'isPartOf' => Caliper::Entity::problem($ce, $db, $set_id, $problem_id), - 'keywords' => $keywords, + 'id' => $resource_iri->problem_user($set_id, $problem_id, $user_id), + 'type' => 'AssessmentItem', + 'name' => 'Problem ' . $problem_id, + 'isPartOf' => Caliper::Entity::problem($ce, $db, $set_id, $problem_id), + 'keywords' => $keywords, 'extensions' => { - 'correct_answers' => $correct_answers, - 'source_file' => $problem_user->source_file(), - 'value' => $problem_user->value(), - 'max_attempts' => $problem_user->max_attempts(), + 'correct_answers' => $correct_answers, + 'source_file' => $problem_user->source_file(), + 'value' => $problem_user->value(), + 'max_attempts' => $problem_user->max_attempts(), 'att_to_open_children' => $problem_user->att_to_open_children(), - 'counts_parent_grade' => $problem_user->counts_parent_grade(), - 'showMeAnother' => $problem_user->showMeAnother(), - 'showMeAnotherCount' => $problem_user->showMeAnotherCount(), - 'showHintsAfter' => $problem_user->prHintsAfter(), - 'prPeriod' => $problem_user->prPeriod(), - 'prCount' => $problem_user->prCount(), - 'flags' => $problem_user->flags(), - 'tags' => $unblessed_tags, - 'problem_seed' => $problem_user->problem_seed(), - 'source_text' => $problem_user->status(), - 'problem_source_code' => $pg->{'translator'}->{'source'}, - 'problem_html_text' => $pg->{'body_text'}, - 'status' => $problem_user->status(), - 'attempted' => $problem_user->attempted(), - 'last_answer' => $problem_user->last_answer(), - 'num_correct' => $problem_user->num_correct(), - 'num_incorrect' => $problem_user->num_incorrect(), - 'sub_status' => $problem_user->sub_status(), + 'counts_parent_grade' => $problem_user->counts_parent_grade(), + 'showMeAnother' => $problem_user->showMeAnother(), + 'showMeAnotherCount' => $problem_user->showMeAnotherCount(), + 'showHintsAfter' => $problem_user->prHintsAfter(), + 'prPeriod' => $problem_user->prPeriod(), + 'prCount' => $problem_user->prCount(), + 'flags' => $problem_user->flags(), + 'tags' => $unblessed_tags, + 'problem_seed' => $problem_user->problem_seed(), + 'source_text' => $problem_user->status(), + 'problem_source_code' => $pg->{'translator'}->{'source'}, + 'problem_html_text' => $pg->{'body_text'}, + 'status' => $problem_user->status(), + 'attempted' => $problem_user->attempted(), + 'last_answer' => $problem_user->last_answer(), + 'num_correct' => $problem_user->num_correct(), + 'num_incorrect' => $problem_user->num_incorrect(), + 'sub_status' => $problem_user->sub_status(), } }; } -sub answer -{ +sub answer { my ($ce, $db, $set_id, $version_id, $problem_id, $user_id, $pg, $start_time, $end_time) = @_; my $resource_iri = Caliper::ResourseIri->new($ce); - my $last_answer_id = $db->latestProblemPastAnswer($ce->{"courseName"}, $user_id, ($version_id ? "$set_id,v$version_id" : $set_id), $problem_id); + my $last_answer_id = + $db->latestProblemPastAnswer($ce->{"courseName"}, $user_id, ($version_id ? "$set_id,v$version_id" : $set_id), + $problem_id); my $last_answer = $db->getPastAnswer($last_answer_id); - my @answers = split(/\t/, $last_answer->answer_string()); + my @answers = split(/\t/, $last_answer->answer_string()); my $pg_answers_hash = {}; - foreach my $key (keys %{$pg->{'answers'}}) - { - my %answer_ref = %{$pg->{'answers'}->{$key}}; + foreach my $key (keys %{ $pg->{'answers'} }) { + my %answer_ref = %{ $pg->{'answers'}->{$key} }; my $unblessed_answer = \%answer_ref; $pg_answers_hash->{$key} = $unblessed_answer; } return { - 'id' => $resource_iri->answer($set_id, $problem_id, $user_id), - 'type' => 'FillinBlankResponse', - 'attempt' => Caliper::Entity::answer_attempt($ce, $db, $set_id, $version_id, $problem_id, $user_id, $pg, $start_time, $end_time), - 'values' => \@answers, + 'id' => $resource_iri->answer($set_id, $problem_id, $user_id), + 'type' => 'FillinBlankResponse', + 'attempt' => Caliper::Entity::answer_attempt( + $ce, $db, $set_id, $version_id, $problem_id, $user_id, $pg, $start_time, $end_time + ), + 'values' => \@answers, 'extensions' => { - 'source_file' => $last_answer->source_file(), - 'scores' => $last_answer->scores(), - 'comment' => $last_answer->comment_string(), + 'source_file' => $last_answer->source_file(), + 'scores' => $last_answer->scores(), + 'comment' => $last_answer->comment_string(), 'pg_answers_hash' => $pg_answers_hash, } }; } -sub answer_attempt -{ +sub answer_attempt { my ($ce, $db, $set_id, $version_id, $problem_id, $user_id, $pg, $start_time, $end_time) = @_; my $resource_iri = Caliper::ResourseIri->new($ce); - my $problem_user = $version_id ? - $db->getMergedProblemVersion($user_id, $set_id, $version_id, $problem_id) : - $db->getMergedProblem($user_id, $set_id, $problem_id); - my $last_answer_id = $db->latestProblemPastAnswer($ce->{"courseName"}, $user_id, ($version_id ? "$set_id,v$version_id" : $set_id), $problem_id); + my $problem_user = + $version_id + ? $db->getMergedProblemVersion($user_id, $set_id, $version_id, $problem_id) + : $db->getMergedProblem($user_id, $set_id, $problem_id); + my $last_answer_id = + $db->latestProblemPastAnswer($ce->{"courseName"}, $user_id, ($version_id ? "$set_id,v$version_id" : $set_id), + $problem_id); my $last_answer = $db->getPastAnswer($last_answer_id); - my $attempt = $version_id ? $version_id : scalar $db->listProblemPastAnswers($ce->{"courseName"}, $user_id, $set_id, $problem_id); - my $score = $problem_user->status || 0; - $score = 0 if ($score > 1 || $score < 0 ); + my $attempt = + $version_id + ? $version_id + : scalar $db->listProblemPastAnswers($ce->{"courseName"}, $user_id, $set_id, $problem_id); + my $score = $problem_user->status || 0; + $score = 0 if ($score > 1 || $score < 0); my $answer_attempt = { - 'id' => $resource_iri->answer_attempt($set_id, $problem_id, $user_id, $last_answer->answer_id()), - 'type' => 'Attempt', - 'assignee' => Caliper::Actor::generate_actor($ce, $db, $user_id), - 'assignable' => $resource_iri->problem_user($set_id, $problem_id, $user_id), - 'count' => $attempt + 0, #ensure int + 'id' => $resource_iri->answer_attempt($set_id, $problem_id, $user_id, $last_answer->answer_id()), + 'type' => 'Attempt', + 'assignee' => Caliper::Actor::generate_actor($ce, $db, $user_id), + 'assignable' => $resource_iri->problem_user($set_id, $problem_id, $user_id), + 'count' => $attempt + 0, #ensure int 'dateCreated' => Caliper::Sensor::formatted_timestamp($last_answer->timestamp()), - 'extensions' => { + 'extensions' => { 'attempt_score' => $score, } }; @@ -347,21 +350,19 @@ sub answer_attempt if ($end_time) { $answer_attempt->{'endedAtTime'} = Caliper::Sensor::formatted_timestamp($end_time); - $answer_attempt->{'duration'} = Caliper::Sensor::formatted_duration($end_time - $start_time); + $answer_attempt->{'duration'} = Caliper::Sensor::formatted_duration($end_time - $start_time); } } return $answer_attempt; } -sub problem_set_attempt -{ +sub problem_set_attempt { my ($ce, $db, $set_id, $version_id, $user_id, $start_time, $end_time) = @_; my $resource_iri = Caliper::ResourseIri->new($ce); - my $problem_set_user = $version_id ? - $db->getMergedSetVersion($user_id, $set_id, $version_id) : - $db->getMergedSet($user_id, $set_id); + my $problem_set_user = + $version_id ? $db->getMergedSetVersion($user_id, $set_id, $version_id) : $db->getMergedSet($user_id, $set_id); my $attempt = 0; if ($version_id) { @@ -373,21 +374,19 @@ sub problem_set_attempt } } - my $score = grade_set($db, $problem_set_user, $user_id, $version_id ? 1 : 0); - my $extensions = { - 'attempt_score' => $score, - }; + my $score = grade_set($db, $problem_set_user, $user_id, $version_id ? 1 : 0); + my $extensions = { 'attempt_score' => $score, }; if ($version_id) { $extensions->{'gateway_score'} = grade_gateway($db, $problem_set_user, $problem_set_user->set_id, $user_id); } my $problem_set_attempt = { - 'id' => $resource_iri->problem_set_attempt($set_id, $user_id, $attempt), - 'type' => 'Attempt', - 'assignee' => Caliper::Actor::generate_actor($ce, $db, $user_id), + 'id' => $resource_iri->problem_set_attempt($set_id, $user_id, $attempt), + 'type' => 'Attempt', + 'assignee' => Caliper::Actor::generate_actor($ce, $db, $user_id), 'assignable' => $resource_iri->problem_set($set_id), - 'count' => $attempt + 0, #ensure int + 'count' => $attempt + 0, #ensure int 'extensions' => $extensions, }; @@ -396,7 +395,7 @@ sub problem_set_attempt if ($end_time) { $problem_set_attempt->{'endedAtTime'} = Caliper::Sensor::formatted_timestamp($end_time); - $problem_set_attempt->{'duration'} = Caliper::Sensor::formatted_duration($end_time - $start_time); + $problem_set_attempt->{'duration'} = Caliper::Sensor::formatted_duration($end_time - $start_time); } } diff --git a/lib/Caliper/Event.pm b/lib/Caliper/Event.pm index 08a506cbc5..2745f7bd1c 100644 --- a/lib/Caliper/Event.pm +++ b/lib/Caliper/Event.pm @@ -13,26 +13,25 @@ use Caliper::Actor; use Caliper::Sensor; # Constructor -sub add_defaults -{ +sub add_defaults { my ($r, $event_hash) = @_; my $ce = $r->{ce}; my $db = $r->{db}; my $ug = new Data::UUID; - my $user_id = $r->param('user'); + my $user_id = $r->param('user'); my $session_key = $r->param('key'); - my $uuid = $ug->create_str; - my $actor = Caliper::Actor::generate_actor($ce, $db, $user_id); + my $uuid = $ug->create_str; + my $actor = Caliper::Actor::generate_actor($ce, $db, $user_id); if (!exists($event_hash->{'@context'})) { $event_hash->{'@context'} = 'http://purl.imsglobal.org/ctx/caliper/v1p2'; } - $event_hash->{'id'} = 'urn:uuid:' . $uuid; - $event_hash->{'actor'} = $actor; - $event_hash->{'session'} = Caliper::Entity::session($ce, $db, $actor, $session_key); - $event_hash->{'edApp'} = Caliper::Entity::webwork_app($ce, $db); - $event_hash->{'group'} = Caliper::Entity::course($ce, $db); + $event_hash->{'id'} = 'urn:uuid:' . $uuid; + $event_hash->{'actor'} = $actor; + $event_hash->{'session'} = Caliper::Entity::session($ce, $db, $actor, $session_key); + $event_hash->{'edApp'} = Caliper::Entity::webwork_app($ce, $db); + $event_hash->{'group'} = Caliper::Entity::course($ce, $db); $event_hash->{'membership'} = Caliper::Entity::membership($ce, $db, $actor, $user_id); if (!exists($event_hash->{'eventTime'})) { $event_hash->{'eventTime'} = Caliper::Sensor::formatted_timestamp(time()); diff --git a/lib/Caliper/ResourceIri.pm b/lib/Caliper/ResourceIri.pm index 1eda4e38a0..6fe315ccc0 100644 --- a/lib/Caliper/ResourceIri.pm +++ b/lib/Caliper/ResourceIri.pm @@ -8,16 +8,14 @@ use WeBWorK::DB; use WeBWorK::Debug; use Data::Dumper; - # Constructor -sub new -{ +sub new { my ($class, $ce) = @_; # need to use $seed_ce in case of logout - my $webwork_dir = $WeBWorK::Constants::WEBWORK_DIRECTORY; - my $seed_ce = new WeBWorK::CourseEnvironment({ webwork_dir => $webwork_dir }); - my $base_url = $seed_ce->{server_root_url} . $seed_ce->{webwork_url}; + my $webwork_dir = $WeBWorK::Constants::WEBWORK_DIRECTORY; + my $seed_ce = new WeBWorK::CourseEnvironment({ webwork_dir => $webwork_dir }); + my $base_url = $seed_ce->{server_root_url} . $seed_ce->{webwork_url}; if (defined($seed_ce->{caliper}{base_url}) && $seed_ce->{caliper}{base_url} ne '') { $base_url = $seed_ce->{caliper}{base_url}; } @@ -26,93 +24,79 @@ sub new } my $self = { - ce => $ce, + ce => $ce, base_url => $base_url, }; bless $self, $class; return $self; } -sub getBaseUrl -{ +sub getBaseUrl { my $self = shift; return $self->{base_url}; } -sub webwork -{ +sub webwork { my $self = shift; return $self->getBaseUrl(); } -sub course -{ +sub course { my $self = shift; return $self->getBaseUrl() . $self->{ce}->{"courseName"} . '/'; } -sub actor_homepage -{ +sub actor_homepage { my ($self, $user_id) = @_; - return $self->course() . 'users/'.$user_id; + return $self->course() . 'users/' . $user_id; } -sub user_session -{ +sub user_session { my ($self, $session_key_hash) = @_; - return $self->getBaseUrl() . 'session/'. $session_key_hash; + return $self->getBaseUrl() . 'session/' . $session_key_hash; } -sub user_client -{ +sub user_client { my ($self, $session_key_hash) = @_; return $self->user_session($session_key_hash) . '/client'; } -sub user_membership -{ +sub user_membership { my ($self, $user_id) = @_; - return $self->course() . 'instructor/users2/?visible_users='.$user_id; + return $self->course() . 'instructor/users2/?visible_users=' . $user_id; } -sub problem_set -{ +sub problem_set { my ($self, $set_id) = @_; return $self->course() . $set_id . '/'; } -sub problem_set_user -{ +sub problem_set_user { my ($self, $set_id, $user_id) = @_; return $self->problem_set($set_id) . '?effectiveUser=' . $user_id; } -sub problem -{ +sub problem { my ($self, $set_id, $problem_id) = @_; return $self->problem_set($set_id) . $problem_id . '/'; } -sub problem_user -{ +sub problem_user { my ($self, $set_id, $problem_id, $user_id) = @_; return $self->problem($set_id, $problem_id) . '?effectiveUser=' . $user_id; } -sub answer -{ +sub answer { my ($self, $set_id, $problem_id, $user_id) = @_; return $self->problem($set_id, $problem_id) . 'answer/' . '?effectiveUser=' . $user_id; } -sub answer_attempt -{ +sub answer_attempt { my ($self, $set_id, $problem_id, $user_id, $answer_id) = @_; return $self->answer($set_id, $problem_id, $user_id) . '&answer_id=' . $answer_id; } -sub problem_set_attempt -{ +sub problem_set_attempt { my ($self, $set_id, $user_id, $attempt) = @_; return $self->problem_set_user($set_id, $user_id) . '&attempt=' . $attempt; } diff --git a/lib/Caliper/Sensor.pm b/lib/Caliper/Sensor.pm index 7a65988314..07d1f22bb3 100644 --- a/lib/Caliper/Sensor.pm +++ b/lib/Caliper/Sensor.pm @@ -17,36 +17,31 @@ use HTTP::Async; use Caliper::Event; use Caliper::ResourceIri; - # Constructor -sub new -{ +sub new { my ($class, $ce) = @_; my $self = { - ce => $ce, + ce => $ce, enabled => $ce->{caliper}{enabled}, - host => $ce->{caliper}{host}, + host => $ce->{caliper}{host}, api_key => $ce->{caliper}{api_key} }; bless $self, $class; return $self; } -sub caliperEnabled -{ +sub caliperEnabled { my $self = shift; return $self->{enabled} && exists $self->{host} && exists $self->{api_key}; } -sub sendEvent -{ +sub sendEvent { my ($self, $r, $event_hash) = @_; - return $self->sendEvents($r, [ $event_hash ]); + return $self->sendEvents($r, [$event_hash]); } -sub sendEvents -{ +sub sendEvents { my ($self, $r, $array_of_events) = @_; return 0 unless $self->caliperEnabled(); @@ -54,11 +49,11 @@ sub sendEvents Caliper::Event::add_defaults($r, $event_hash); } - my $ce = $r->{ce}; + my $ce = $r->{ce}; my $resource_iri = Caliper::ResourseIri->new($ce); - my $async = HTTP::Async->new; - $async->timeout( 5 ); - $async->max_request_time( 10 ); + my $async = HTTP::Async->new; + $async->timeout(5); + $async->max_request_time(10); # chunk events to prevent size issues (send a maximum of 3 events at a time) my $event_chunks = []; @@ -66,28 +61,36 @@ sub sendEvents for my $event_chunk (@$event_chunks) { my $envelope = { - 'sensor' => $resource_iri->webwork(), - 'sendTime' => Caliper::Sensor::formatted_timestamp(time()), + 'sensor' => $resource_iri->webwork(), + 'sendTime' => Caliper::Sensor::formatted_timestamp(time()), 'dataVersion' => 'http://purl.imsglobal.org/ctx/caliper/v1p2', - 'data' => $event_chunk, + 'data' => $event_chunk, }; my $json_payload = JSON->new->canonical->encode($envelope); # debug("Caliper event json_payload: " . $json_payload); - my $HTTPRequest = HTTP::Request->new('POST', $self->{host}, [ - 'Accept' => '*/*', - 'Authorization' => 'Bearer ' . $self->{api_key}, - 'Content-Type' => 'application/json', - ], $json_payload); + my $HTTPRequest = HTTP::Request->new( + 'POST', + $self->{host}, + [ + 'Accept' => '*/*', + 'Authorization' => 'Bearer ' . $self->{api_key}, + 'Content-Type' => 'application/json', + ], + $json_payload + ); $async->add($HTTPRequest); } - while ( my $response = $async->wait_for_next_response ) { + while (my $response = $async->wait_for_next_response) { if (!$response->is_success) { debug("Caliper event post failed. Error Message: " . $response->message); debug($response->content); - $self->log_error("Caliper event post failed. Error Message: ". $response->message . "\nResponse Content: ". $response->content); + $self->log_error("Caliper event post failed. Error Message: " + . $response->message + . "\nResponse Content: " + . $response->content); } else { debug("Caliper event post success. Success Message: " . $response->message); debug($response->content); @@ -95,15 +98,14 @@ sub sendEvents } } -sub log_error -{ +sub log_error { my ($self, $error_message) = @_; - my $ce = $self->{ce}; + my $ce = $self->{ce}; my $logfile = $ce->{caliper}{errorlog}; my ($sec, $msec) = gettimeofday; my $date = time2str("%a %b %d %H:%M:%S.$msec %Y", $sec); - my $msg = "[$date] $error_message\n"; + my $msg = "[$date] $error_message\n"; # create if necessary unless (-e $logfile) { @@ -114,36 +116,33 @@ sub log_error if (open my $f, ">>", $logfile) { print $f $msg; close $f; - } - else { + } else { debug("Error, unable to open caliper error log file '$logfile' in append mode: $!"); } } -sub formatted_timestamp -{ +sub formatted_timestamp { my ($time_value) = @_; # Note: webwork epoch timestamps do not include milliseconds return POSIX::strftime("%Y-%m-%dT%H:%M:%S.000Z", gmtime($time_value)); } -sub formatted_duration -{ +sub formatted_duration { my ($duration) = @_; # gererate the time portion of a ISO 8601 formatted duration my $seconds = $duration % 60; my $minutes = int($duration / 60) % 60; - my $hours = int($duration / 3600); + my $hours = int($duration / 3600); my $output = "PT"; if ($hours > 0) { - $output .= $hours ."H"; + $output .= $hours . "H"; } if ($hours > 0 || $minutes > 0) { - $output .= $minutes."M"; + $output .= $minutes . "M"; } - $output .= $seconds ."S"; + $output .= $seconds . "S"; return $output; } diff --git a/lib/FormatRenderedProblem.pm b/lib/FormatRenderedProblem.pm index 63ddf7f0b0..c705fd801c 100644 --- a/lib/FormatRenderedProblem.pm +++ b/lib/FormatRenderedProblem.pm @@ -32,8 +32,8 @@ use JSON; use Digest::SHA qw(sha1_base64); sub new { - my $invocant = shift; - my $class = ref $invocant || $invocant; + my $invocant = shift; + my $class = ref $invocant || $invocant; $self = { return_object => {}, encoded_source => {}, @@ -41,8 +41,8 @@ sub new { site_url => 'https://demo.webwork.rochester.edu', form_action_url => '', maketext => sub { return @_ }, - courseID => 'daemon_course', # optional? - userID => 'daemon', # optional? + courseID => 'daemon_course', # optional? + userID => 'daemon', # optional? course_password => 'daemon', inputs_ref => {}, @_, @@ -50,22 +50,22 @@ sub new { bless $self, $class; } -sub return_object { # out - my $self = shift; +sub return_object { # out + my $self = shift; my $object = shift; - $self->{return_object} = $object if defined $object and ref($object); # source is non-empty + $self->{return_object} = $object if defined $object and ref($object); # source is non-empty $self->{return_object}; } sub encoded_source { - my $self = shift; + my $self = shift; my $source = shift; - $self->{encoded_source} = $source if defined $source and $source =~/\S/; # source is non-empty + $self->{encoded_source} = $source if defined $source and $source =~ /\S/; # source is non-empty $self->{encoded_source}; } sub site_url { - my $self = shift; + my $self = shift; my $new_url = shift; $self->{site_url} = $new_url if defined($new_url) and $new_url =~ /\S/; $self->{site_url}; @@ -74,25 +74,27 @@ sub site_url { sub formatRenderedProblem { my $self = shift; my $problemText = ''; - my $rh_result = $self->return_object() || {}; # wrap problem in formats - $problemText = "No output from rendered Problem" unless $rh_result; + my $rh_result = $self->return_object() || {}; # wrap problem in formats + $problemText = "No output from rendered Problem" unless $rh_result; my $courseID = $self->{courseID} // ""; # Create a course environment my $ce = WeBWorK::CourseEnvironment->new({ - webwork_dir => $WeBWorK::Constants::WEBWORK_DIRECTORY, - courseName => $courseID, - pg_dir => $WeBWorK::Constants::PG_DIRECTORY, - }); + webwork_dir => $WeBWorK::Constants::WEBWORK_DIRECTORY, + courseName => $courseID, + pg_dir => $WeBWorK::Constants::PG_DIRECTORY, + }); my $mt = WeBWorK::Localize::getLangHandle($self->{inputs_ref}{language} // 'en'); - my $forbidGradePassback = 1; # Default is to forbid, due to the security issue + my $forbidGradePassback = 1; # Default is to forbid, due to the security issue - if ( defined( $ce->{html2xmlAllowGradePassback} ) && - $ce->{html2xmlAllowGradePassback} eq "This course intentionally enables the insecure LTI grade pass-back feature of html2xml." ) { - # It is strongly recommended that you clarify the security risks of enabling the current version of this feature before using it. + if (defined($ce->{html2xmlAllowGradePassback}) + && $ce->{html2xmlAllowGradePassback} eq + "This course intentionally enables the insecure LTI grade pass-back feature of html2xml.") + { +# It is strongly recommended that you clarify the security risks of enabling the current version of this feature before using it. $forbidGradePassback = 0; } @@ -101,14 +103,13 @@ sub formatRenderedProblem { if (ref($rh_result) && $rh_result->{text}) { $problemText = $rh_result->{text}; } else { - $problemText .= "Unable to decode problem text:
      $self->{error_string}
      " . - format_hash_ref($rh_result); - $rh_result->{problem_result}->{score} = 0; # force score to 0 for such errors. - $renderErrorOccurred = 1; - $forbidGradePassback = 1; # due to render error + $problemText .= "Unable to decode problem text:
      $self->{error_string}
      " . format_hash_ref($rh_result); + $rh_result->{problem_result}->{score} = 0; # force score to 0 for such errors. + $renderErrorOccurred = 1; + $forbidGradePassback = 1; # due to render error } - my $SITE_URL = $self->site_url // ''; + my $SITE_URL = $self->site_url // ''; my $FORM_ACTION_URL = $self->{form_action_url} // ''; # Local docker usage with a port number sometimes misbehaves if the port number @@ -120,26 +121,27 @@ sub formatRenderedProblem { $SITE_URL .= ":${forcePortNumber}"; } if (!($FORM_ACTION_URL =~ m+:${forcePortNumber}/webwork2/html2xml+)) { - $FORM_ACTION_URL =~ s+/webwork2/html2xml+:${forcePortNumber}/webwork2/html2xml+; # Ex: "http://localhost:8080/webwork2/html2xml" + $FORM_ACTION_URL =~ s+/webwork2/html2xml+:${forcePortNumber}/webwork2/html2xml+ + ; # Ex: "http://localhost:8080/webwork2/html2xml" } } - my $userID = $self->{userID} // ""; - my $course_password = $self->{course_password} // ""; - my $problemSeed = $rh_result->{problem_seed} // $self->{inputs_ref}{problemSeed} // 6666; - my $psvn = $rh_result->{psvn} // $self->{inputs_ref}{psvn} // 54321; - my $session_key = $rh_result->{session_key} // ""; - my $displayMode = $self->{inputs_ref}{displayMode}; + my $userID = $self->{userID} // ""; + my $course_password = $self->{course_password} // ""; + my $problemSeed = $rh_result->{problem_seed} // $self->{inputs_ref}{problemSeed} // 6666; + my $psvn = $rh_result->{psvn} // $self->{inputs_ref}{psvn} // 54321; + my $session_key = $rh_result->{session_key} // ""; + my $displayMode = $self->{inputs_ref}{displayMode}; my $hideWasNotRecordedMessage = $ce->{hideWasNotRecordedMessage} // 0; # HTML document language settings - my $formLanguage = $self->{inputs_ref}{language} // 'en'; + my $formLanguage = $self->{inputs_ref}{language} // 'en'; my $COURSE_LANG_AND_DIR = get_lang_and_dir($formLanguage); # Problem source - my $sourceFilePath = $self->{sourceFilePath} // ""; - my $fileName = $self->{input}{envir}{fileName} // ""; - my $encoded_source = $self->encoded_source // ""; + my $sourceFilePath = $self->{sourceFilePath} // ""; + my $fileName = $self->{input}{envir}{fileName} // ""; + my $encoded_source = $self->encoded_source // ""; # Select the theme. my $theme = $self->{inputs_ref}{theme} || $ce->{defaultTheme}; @@ -153,11 +155,11 @@ sub formatRenderedProblem { # CSS Loads # The second element of each array in the following is whether or not the file is a theme file. my @CSSLoads = map { getAssetURL($ce, $_->[0], $_->[1]) } ( - ['bootstrap.css', 1], - ['node_modules/jquery-ui-dist/jquery-ui.min.css', 0], - ['node_modules/@fortawesome/fontawesome-free/css/all.min.css', 0], - ['math4.css', 1], - ['math4-overrides.css', 1], + [ 'bootstrap.css', 1 ], + [ 'node_modules/jquery-ui-dist/jquery-ui.min.css', 0 ], + [ 'node_modules/@fortawesome/fontawesome-free/css/all.min.css', 0 ], + [ 'math4.css', 1 ], + [ 'math4-overrides.css', 1 ], ); $problemHeadText .= CGI::Link({ href => $_, rel => 'stylesheet' }) for (@CSSLoads); @@ -200,7 +202,7 @@ sub formatRenderedProblem { [ 'math4.js', 1, { defer => undef } ], [ 'math4-overrides.js', 1, { defer => undef } ] ); - $problemHeadText .= CGI::script({ src => $_->[0], %{$_->[1] // {}} }, '') for (@JSLoads); + $problemHeadText .= CGI::script({ src => $_->[0], %{ $_->[1] // {} } }, '') for (@JSLoads); # Add the local storage javascript for the sticky format. $problemHeadText .= @@ -226,7 +228,7 @@ sub formatRenderedProblem { } } - $problemHeadText .= $rh_result->{header_text} // ''; + $problemHeadText .= $rh_result->{header_text} // ''; $problemHeadText .= $rh_result->{post_header_text} // ''; $extra_header_text = $self->{inputs_ref}{extra_header_text} // ''; $problemHeadText .= $extra_header_text; @@ -235,19 +237,20 @@ sub formatRenderedProblem { # PG files can request their language and text direction be set. If we do # not have access to a default course language, fall back to the # $formLanguage instead. - my %PROBLEM_LANG_AND_DIR = get_problem_lang_and_dir($rh_result->{flags}, $ce->{perProblemLangAndDirSettingMode}, $formLanguage); - my $PROBLEM_LANG_AND_DIR = join(" ", map { qq{$_="$PROBLEM_LANG_AND_DIR{$_}"} } keys %PROBLEM_LANG_AND_DIR); + my %PROBLEM_LANG_AND_DIR = + get_problem_lang_and_dir($rh_result->{flags}, $ce->{perProblemLangAndDirSettingMode}, $formLanguage); + my $PROBLEM_LANG_AND_DIR = join(" ", map {qq{$_="$PROBLEM_LANG_AND_DIR{$_}"}} keys %PROBLEM_LANG_AND_DIR); - my $previewMode = defined($self->{inputs_ref}{preview}) || 0; - my $checkMode = defined($self->{inputs_ref}{WWcheck}) || 0; - my $submitMode = defined($self->{inputs_ref}{WWsubmit}) || 0; + my $previewMode = defined($self->{inputs_ref}{preview}) || 0; + my $checkMode = defined($self->{inputs_ref}{WWcheck}) || 0; + my $submitMode = defined($self->{inputs_ref}{WWsubmit}) || 0; my $showCorrectMode = defined($self->{inputs_ref}{WWcorrectAns}) || 0; # A problemUUID should be added to the request as a parameter. It is used by PG to create a proper UUID for use in # aliases for resources. It should be unique for a course, user, set, problem, and version. - my $problemUUID = $self->{inputs_ref}{problemUUID} // ''; - my $problemResult = $rh_result->{problem_result} // ''; - my $problemState = $rh_result->{problem_state} // ''; - my $showSummary = $self->{inputs_ref}{showSummary} // 1; + my $problemUUID = $self->{inputs_ref}{problemUUID} // ''; + my $problemResult = $rh_result->{problem_result} // ''; + my $problemState = $rh_result->{problem_state} // ''; + my $showSummary = $self->{inputs_ref}{showSummary} // 1; my $showAnswerNumbers = $self->{inputs_ref}{showAnswerNumbers} // 1; my $color_input_blanks_script = ""; @@ -261,18 +264,18 @@ sub formatRenderedProblem { } else { my $tbl = WeBWorK::Utils::AttemptsTable->new( $rh_result->{answers} // {}, - answersSubmitted => $self->{inputs_ref}{answersSubmitted} // 0, + answersSubmitted => $self->{inputs_ref}{answersSubmitted} // 0, answerOrder => $rh_result->{flags}{ANSWER_ENTRY_ORDER} // [], displayMode => $displayMode, showAnswerNumbers => $showAnswerNumbers, ce => $ce, showAttemptPreviews => $previewMode || $submitMode || $showCorrectMode, - showAttemptResults => $submitMode || $showCorrectMode, + showAttemptResults => $submitMode || $showCorrectMode, showCorrectAnswers => $showCorrectMode, showMessages => $previewMode || $submitMode || $showCorrectMode, showSummary => (($showSummary and ($submitMode or $showCorrectMode)) // 0) ? 1 : 0, maketext => WeBWorK::Localize::getLoc($formLanguage), - summary => $problemResult->{summary} // '', # can be set by problem grader + summary => $problemResult->{summary} // '', # can be set by problem grader ); $answerTemplate = $tbl->answerTemplate; $tbl->imgGen->render(refresh => 1) if $tbl->displayMode eq 'images'; @@ -282,23 +285,26 @@ sub formatRenderedProblem { if ($submitMode) { if ($renderErrorOccurred) { - $scoreSummary = ''; + $scoreSummary = ''; } elsif ($problemResult) { - $scoreSummary = CGI::p($mt->maketext("You received a score of [_1] for this attempt.", - wwRound(0, $problemResult->{score} * 100) . '%')); + $scoreSummary = CGI::p($mt->maketext( + "You received a score of [_1] for this attempt.", + wwRound(0, $problemResult->{score} * 100) . '%' + )); $scoreSummary .= CGI::p($problemResult->{msg}) if ($problemResult->{msg}); $scoreSummary .= CGI::p($mt->maketext("Your score was not recorded.")) unless $hideWasNotRecordedMessage; - $scoreSummary .= CGI::hidden({id => 'problem-result-score', name => 'problem-result-score', value => $problemResult->{score}}); + $scoreSummary .= CGI::hidden( + { id => 'problem-result-score', name => 'problem-result-score', value => $problemResult->{score} }); } } - if ( !$forbidGradePassback && !$submitMode ) { + if (!$forbidGradePassback && !$submitMode) { $forbidGradePassback = 1; } # Answer hash in XML format used by the PTX format. my $answerhashXML = XMLout($rh_result->{answers} // {}, RootName => 'answerhashes') - if $self->{inputs_ref}{outputformat} // "" eq "ptx"; + if $self->{inputs_ref}{outputformat} // "" eq "ptx"; # Sticky format local storage messages my $localStorageMessages = CGI::div({ id => 'local-storage-messages' }, @@ -326,7 +332,7 @@ sub formatRenderedProblem { ); my $showSolutions = $self->{inputs_ref}{showSolutions} // ""; - my $showHints = $self->{inputs_ref}{showHints} // ""; + my $showHints = $self->{inputs_ref}{showHints} // ""; # Regular Perl warning messages generated with warn. my $warnings = ''; @@ -345,15 +351,15 @@ sub formatRenderedProblem { } # PG debug messages generated with DEBUG_message(); - $rh_result->{debug_messages} = join("
      ", @{$rh_result->{debug_messages} || []}); + $rh_result->{debug_messages} = join("
      ", @{ $rh_result->{debug_messages} || [] }); # PG warning messages generated with WARN_message(); - my $PG_warning_messages = join("
      ", @{$rh_result->{warning_messages} || []}); + my $PG_warning_messages = join("
      ", @{ $rh_result->{warning_messages} || [] }); # Internal debug messages generated within PG_core. # These are sometimes needed if the PG_core warning message system isn't properly set # up before the bug occurs. In general don't use these unless necessary. - my $internal_debug_messages = join("
      ", @{$rh_result->{internal_debug_messages} || []}); + my $internal_debug_messages = join("
      ", @{ $rh_result->{internal_debug_messages} || [] }); # Try to save the grade to an LTI if one provided us data (depending on $forbidGradePassback) my $LTIGradeMessage = saveGradeToLTI($self, $ce, $rh_result, $forbidGradePassback); @@ -361,12 +367,12 @@ sub formatRenderedProblem { my $debug_messages = $rh_result->{debug_messages}; # For debugging purposes (only used in the debug format) - my $clientDebug = $self->{inputs_ref}{clientDebug} // ""; + my $clientDebug = $self->{inputs_ref}{clientDebug} // ""; my $client_debug_data = $clientDebug ? CGI::h3('Webwork client data') . WebworkClient::pretty_print($self) : ''; # Show the footer unless it is explicity disabled. my $showFooter = $self->{inputs_ref}{showFooter} // ""; - my $footer = $showFooter eq "0" ? '' : CGI::div( + my $footer = $showFooter eq "0" ? '' : CGI::div( { id => 'footer' }, "WeBWorK © 2000-2022 | host: $SITE_URL | course: $courseID | " . "format: $self->{inputs_ref}{outputformat} | theme: $theme" @@ -378,19 +384,18 @@ sub formatRenderedProblem { # The json format if ($format_name eq "json") { my $json_output = do("WebworkClient/json_format.pl"); - for my $key (keys %{$json_output->{hidden_input_field}}) { + for my $key (keys %{ $json_output->{hidden_input_field} }) { $json_output->{hidden_input_field}{$key} =~ s/(\$\w+)/$1/gee; } for my $key (keys %$json_output) { - if ( - ($key =~ /^real_webwork/) || - ($key =~ /^internal/) || - ($key =~ /_A?VI$/) - ) { + if (($key =~ /^real_webwork/) + || ($key =~ /^internal/) + || ($key =~ /_A?VI$/)) + { # Interpolate values if ($key =~ /_AVI$/) { - map { s/(\$\w+)/$1/gee } @{$json_output->{$key}}; + map {s/(\$\w+)/$1/gee} @{ $json_output->{$key} }; } else { $json_output->{$key} =~ s/(\$\w+)/$1/gee; } @@ -426,22 +431,22 @@ sub formatRenderedProblem { my $output = {}; # Everything that ships out with other formats can be constructed from these - $output->{rh_result} = $rh_result; + $output->{rh_result} = $rh_result; $output->{inputs_ref} = $self->{inputs_ref}; - $output->{input} = $self->{input}; + $output->{input} = $self->{input}; # The following could be constructed from the above, but this is a convenience - $output->{answerTemplate} = $answerTemplate if ($answerTemplate); - $output->{lang} = $PROBLEM_LANG_AND_DIR{lang}; - $output->{dir} = $PROBLEM_LANG_AND_DIR{dir}; + $output->{answerTemplate} = $answerTemplate if ($answerTemplate); + $output->{lang} = $PROBLEM_LANG_AND_DIR{lang}; + $output->{dir} = $PROBLEM_LANG_AND_DIR{dir}; $output->{extra_css_files} = \@extra_css_files; - $output->{extra_js_files} = \@extra_js_files; + $output->{extra_js_files} = \@extra_js_files; # Include third party css and javascript files. Only jquery, jquery-ui, mathjax, and bootstrap are needed for # PG. See the comments before the subroutine definitions for load_css and load_js in pg/macros/PG.pl. # The other files included are only needed to make themes work in the webwork2 formats. $output->{third_party_css} = \@CSSLoads; - $output->{third_party_js} = \@JSLoads; + $output->{third_party_js} = \@JSLoads; # Say what version of WeBWorK this is $output->{ww_version} = $ce->{WW_VERSION}; @@ -467,22 +472,23 @@ sub saveGradeToLTI { # When $forbidGradePassback is set, we will block the actual submission, # but we still provide the LTI data in the hidden fields. - return "" if !(defined($self->{inputs_ref}{lis_outcome_service_url}) && - defined($self->{inputs_ref}{'oauth_consumer_key'}) && - defined($self->{inputs_ref}{'oauth_signature_method'}) && - defined($self->{inputs_ref}{'lis_result_sourcedid'}) && - defined($ce->{'LISConsumerKeyHash'}{$self->{inputs_ref}{'oauth_consumer_key'}})); + return "" + if !(defined($self->{inputs_ref}{lis_outcome_service_url}) + && defined($self->{inputs_ref}{'oauth_consumer_key'}) + && defined($self->{inputs_ref}{'oauth_signature_method'}) + && defined($self->{inputs_ref}{'lis_result_sourcedid'}) + && defined($ce->{'LISConsumerKeyHash'}{ $self->{inputs_ref}{'oauth_consumer_key'} })); - my $request_url = $self->{inputs_ref}{lis_outcome_service_url}; - my $consumer_key = $self->{inputs_ref}{'oauth_consumer_key'}; + my $request_url = $self->{inputs_ref}{lis_outcome_service_url}; + my $consumer_key = $self->{inputs_ref}{'oauth_consumer_key'}; my $signature_method = $self->{inputs_ref}{'oauth_signature_method'}; - my $sourcedid = $self->{inputs_ref}{'lis_result_sourcedid'}; - my $consumer_secret = $ce->{'LISConsumerKeyHash'}{$consumer_key}; - my $score = $rh_result->{problem_result} ? $rh_result->{problem_result}{score} : 0; + my $sourcedid = $self->{inputs_ref}{'lis_result_sourcedid'}; + my $consumer_secret = $ce->{'LISConsumerKeyHash'}{$consumer_key}; + my $score = $rh_result->{problem_result} ? $rh_result->{problem_result}{score} : 0; my $LTIGradeMessage = ''; - if ( ! $forbidGradePassback ) { + if (!$forbidGradePassback) { # This is boilerplate XML used to submit the $score for $sourcedid my $replaceResultXML = <add_required_message_params('body_hash'); my $gradeRequest = $requestGen->new( - request_url => $request_url, - request_method => "POST", - consumer_secret => $consumer_secret, - consumer_key => $consumer_key, + request_url => $request_url, + request_method => "POST", + consumer_secret => $consumer_secret, + consumer_key => $consumer_key, signature_method => $signature_method, - nonce => int(rand( 2**32)), - timestamp => time(), - body_hash => $bodyhash + nonce => int(rand(2**32)), + timestamp => time(), + body_hash => $bodyhash ); $gradeRequest->sign(); @@ -551,22 +557,22 @@ EOS $response->content =~ /\s*(\w+)\s*<\/imsx_codeMajor>/; my $message = $1; if ($message ne 'success') { - $LTIGradeMessage = CGI::p("Unable to update LMS grade. Error: ".$message); + $LTIGradeMessage = CGI::p("Unable to update LMS grade. Error: " . $message); $rh_result->{debug_messages} .= CGI::escapeHTML($response->content); } else { $LTIGradeMessage = CGI::p("Grade sucessfully saved."); } } else { - $LTIGradeMessage = CGI::p("Unable to update LMS grade. Error: ".$response->message); + $LTIGradeMessage = CGI::p("Unable to update LMS grade. Error: " . $response->message); $rh_result->{debug_messages} .= CGI::escapeHTML($response->content); } } # save parameters for next time - $LTIGradeMessage .= CGI::input({type => 'hidden', name => 'lis_outcome_service_url', value => $request_url}); - $LTIGradeMessage .= CGI::input({type => 'hidden', name => 'oauth_consumer_key', value => $consumer_key}); - $LTIGradeMessage .= CGI::input({type => 'hidden', name => 'oauth_signature_method', value => $signature_method}); - $LTIGradeMessage .= CGI::input({type => 'hidden', name => 'lis_result_sourcedid', value => $sourcedid}); + $LTIGradeMessage .= CGI::input({ type => 'hidden', name => 'lis_outcome_service_url', value => $request_url }); + $LTIGradeMessage .= CGI::input({ type => 'hidden', name => 'oauth_consumer_key', value => $consumer_key }); + $LTIGradeMessage .= CGI::input({ type => 'hidden', name => 'oauth_signature_method', value => $signature_method }); + $LTIGradeMessage .= CGI::input({ type => 'hidden', name => 'lis_result_sourcedid', value => $sourcedid }); return $LTIGradeMessage; } @@ -575,7 +581,7 @@ EOS sub format_hash_ref { my $hash = shift; warn "Use a hash reference" unless ref($hash) =~ /HASH/; - return join(" ", map { $_= "--" unless defined($_); $_ } %$hash) . "\n"; + return join(" ", map { $_ = "--" unless defined($_); $_ } %$hash) . "\n"; } 1; diff --git a/lib/MySOAP.pm b/lib/MySOAP.pm index 0fd13573ae..3a0175e2b3 100644 --- a/lib/MySOAP.pm +++ b/lib/MySOAP.pm @@ -1,73 +1,64 @@ package MySOAP; -use constant DEBUG =>0; +use constant DEBUG => 0; - use Apache::Request; - use Apache::Constants qw(:common); - use Apache::File (); - use SOAP::Transport::HTTP; +use Apache::Request; +use Apache::Constants qw(:common); +use Apache::File (); +use SOAP::Transport::HTTP; - my $server = SOAP::Transport::HTTP::Apache - -> dispatch_to('RQP'); +my $server = SOAP::Transport::HTTP::Apache->dispatch_to('RQP'); - sub handler { - my $save = $_[0]; - my $r = Apache::Request->instance($_[0]); - - my $header = $r->as_string; - my $args = $r->args; - my $content = $r->content; - my $body=""; - # this will read everything, but then it won't be available for SOAP - my $r2 = Apache::Request->instance($save) if DEBUG; - $r2->read($body, $r2->header_in('Content-length')) if DEBUG; - # - local(*DEBUGLOG); - open DEBUGLOG, ">>/home/gage/debug_info.txt" || die "can't open debug file"; - - - - - ################ - # Handle a wsdl rquest - ################ - my %args_hash = $r->args; - if (exists $args_hash{wsdl}) { - $r->print( $wsdl); - print DEBUGLOG "----------start-------------\n"; - print DEBUGLOG "handle wsdl request\n"; - print DEBUGLOG "\n-header =\n $header\n" ; - - - my $wsdl = `cat /home/gage/rqp.wsdl`; - $r->content_type('application/wsdl+xml'); - $r->send_http_header; - $r->print( $wsdl); - - - print DEBUGLOG "---end--- \n"; - close(DEBUGLOG); - return OK; - ############### - # Handle SOAP request - ############### - } else { +sub handler { + my $save = $_[0]; + my $r = Apache::Request->instance($_[0]); + + my $header = $r->as_string; + my $args = $r->args; + my $content = $r->content; + my $body = ""; + # this will read everything, but then it won't be available for SOAP + my $r2 = Apache::Request->instance($save) if DEBUG; + $r2->read($body, $r2->header_in('Content-length')) if DEBUG; + # + local (*DEBUGLOG); + open DEBUGLOG, ">>/home/gage/debug_info.txt" || die "can't open debug file"; + + ################ + # Handle a wsdl rquest + ################ + my %args_hash = $r->args; + if (exists $args_hash{wsdl}) { + $r->print($wsdl); + print DEBUGLOG "----------start-------------\n"; + print DEBUGLOG "handle wsdl request\n"; + print DEBUGLOG "\n-header =\n $header\n"; + + my $wsdl = `cat /home/gage/rqp.wsdl`; + $r->content_type('application/wsdl+xml'); + $r->send_http_header; + $r->print($wsdl); + + print DEBUGLOG "---end--- \n"; + close(DEBUGLOG); + return OK; + ############### + # Handle SOAP request + ############### + } else { print DEBUGLOG "----------start-------------\n"; print DEBUGLOG "handle soap request\n"; - print DEBUGLOG "\n-header =\n $header\n" ; #if DEBUG; + print DEBUGLOG "\n-header =\n $header\n"; #if DEBUG; print DEBUGLOG "args= $args\n"; print DEBUGLOG "\nbody= $body\n" if DEBUG; - + $server->handler(@_); - + print DEBUGLOG "---end--- \n"; close(DEBUGLOG); - } - - - + } - }; +} 1; diff --git a/lib/RQP.pm b/lib/RQP.pm index cc1bc98021..f8c7dcc1be 100644 --- a/lib/RQP.pm +++ b/lib/RQP.pm @@ -1,17 +1,15 @@ #!/usr/local/bin/perl -w - -use SOAP::Lite +trace; +use SOAP::Lite +trace; #+trace => -#[parameters,trace=>sub{ local($|=1); print LOG "start>>", +#[parameters,trace=>sub{ local($|=1); print LOG "start>>", #WebworkWebservice::pretty_print_rh(\@_ ),"<new($WW_DIRECTORY, "", "", $COURSENAME); +$ce = WeBWorK::CourseEnvironment->new($WW_DIRECTORY, "", "", $COURSENAME); #print "\$ce = \n", WeBWorK::Utils::pretty_print_rh($ce); our $db = WeBWorK::DB->new($ce->{dbLayout}); #print MYLOG "restarting server\n\n"; sub test { - open MYLOG, ">>/home/gage/debug_info.txt" ; - local($|=1); - my $som = pop; - my $self = shift; + open MYLOG, ">>/home/gage/debug_info.txt"; + local ($| = 1); + my $som = pop; + my $self = shift; my $rh_parameter = $som->method; #$som->match('/'); #print MYLOG "headers\n", WebworkWebservice::pretty_print_rh($rh_parameter),"\n"; @@ -45,48 +43,49 @@ sub test { } sub RQP_ServerInformation { - my $class = shift; - my $soap_som = pop; - my $rh_params= $soap_som->method; - local(*DEBUGLOG); - open DEBUGLOG, ">>/home/gage/debug_info.txt" || die "can't open debug file"; + my $class = shift; + my $soap_som = pop; + my $rh_params = $soap_som->method; + local (*DEBUGLOG); + open DEBUGLOG, ">>/home/gage/debug_info.txt" || die "can't open debug file"; print DEBUGLOG "--RQP_ServerInformation\n"; - $rh_out = { 'identifier' => 'http://www.openwebwork.org', - 'name' => 'WeBWorK', - 'description' => 'WeBWorK server. See http://webwork.math.rochester.edu', - 'cloning' => 0, - 'implicitCloning' => 1, - 'rendering' => 1, - 'itemFormats' => ['pg'], - 'renderFormats' => ['xml'], - input => '
      '.WebworkWebservice::pretty_print_rh($rh_params).'
      ', + $rh_out = { + 'identifier' => 'http://www.openwebwork.org', + 'name' => 'WeBWorK', + 'description' => 'WeBWorK server. See http://webwork.math.rochester.edu', + 'cloning' => 0, + 'implicitCloning' => 1, + 'rendering' => 1, + 'itemFormats' => ['pg'], + 'renderFormats' => ['xml'], + input => '
      ' . WebworkWebservice::pretty_print_rh($rh_params) . '
      ', }; return $rh_out; } sub RQP_ItemInformation { - my $class = shift; - my $soap_som = pop; - my $rh_params= $soap_som->method; - local(*DEBUGLOG); - open DEBUGLOG, ">>/home/gage/debug_info.txt" || die "can't open debug file"; - print DEBUGLOG "--RQP_ItemInformation\n"; - my $format = 'HTML'; - my $sourceErrors = ''; + my $class = shift; + my $soap_som = pop; + my $rh_params = $soap_som->method; + local (*DEBUGLOG); + open DEBUGLOG, ">>/home/gage/debug_info.txt" || die "can't open debug file"; + print DEBUGLOG "--RQP_ItemInformation\n"; + my $format = 'HTML'; + my $sourceErrors = ''; $rh_out = { - 'format' => $format, - 'sourceErrors' => $sourceErrors, - 'template' => 1, - 'adaptive' => 1, - 'timeDependent' => 0, - 'canComputeScore' => 1, - 'solutionAvailable' => 0, - 'hintAvailable' => 0, - 'validationPossible' => 1, - 'maxScore' => 1, - 'length' => 1, - input => '
      '.WebworkWebservice::pretty_print_rh($rh_params).'
      ', + 'format' => $format, + 'sourceErrors' => $sourceErrors, + 'template' => 1, + 'adaptive' => 1, + 'timeDependent' => 0, + 'canComputeScore' => 1, + 'solutionAvailable' => 0, + 'hintAvailable' => 0, + 'validationPossible' => 1, + 'maxScore' => 1, + 'length' => 1, + input => '
      ' . WebworkWebservice::pretty_print_rh($rh_params) . '
      ', }; close(DEBUGLOG); return $rh_out; @@ -94,37 +93,35 @@ sub RQP_ItemInformation { sub RQP_ProcessTemplate { - } -sub RQP_Clone { +sub RQP_Clone { } + sub RQP_SessionInformation { - my $class = shift; - my $soap_som = pop; - my $rh_params= $soap_som->method; - local(*DEBUGLOG); - open DEBUGLOG, ">>/home/gage/debug_info.txt" || die "can't open debug file"; + my $class = shift; + my $soap_som = pop; + my $rh_params = $soap_som->method; + local (*DEBUGLOG); + open DEBUGLOG, ">>/home/gage/debug_info.txt" || die "can't open debug file"; print DEBUGLOG "--RQP_SessionInformation\n"; my $templatevars = $rh_params->{templatevars}; - $templatevars->{seed}=4321; + $templatevars->{seed} = 4321; my $correctResponses = []; $rh_out = { - 'outcomevars' => {id=>45}, + 'outcomevars' => { id => 45 }, 'templatevars' => $templatevars, 'correctResponses' => $correctResponses, - input => '
      '.WebworkWebservice::pretty_print_rh($rh_params).'
      ', + input => '
      ' . WebworkWebservice::pretty_print_rh($rh_params) . '
      ', }; close(DEBUGLOG); return $rh_out; } - -sub RQP_Render { +sub RQP_Render { RQP::Render::RQP_Render(@_); } - 1; diff --git a/lib/WeBWorK.pm b/lib/WeBWorK.pm index 5df8d78fd1..13c7e22257 100644 --- a/lib/WeBWorK.pm +++ b/lib/WeBWorK.pm @@ -33,7 +33,6 @@ C to call. =cut - use strict; use warnings; use Time::HiRes qw/time/; @@ -57,7 +56,7 @@ use WeBWorK::Utils qw(runtime_use writeTimingLogEntry); use Apache2::Upload; use Apache2::RequestUtil; -use constant LOGIN_MODULE => "WeBWorK::ContentGenerator::Login"; +use constant LOGIN_MODULE => "WeBWorK::ContentGenerator::Login"; use constant PROCTOR_LOGIN_MODULE => "WeBWorK::ContentGenerator::LoginProctor"; BEGIN { @@ -80,14 +79,14 @@ sub dispatch($) { my ($apache) = @_; my $r = WeBWorK::Request->new($apache); - my $method = $r->method; - my $location = $r->location; - my $uri = $r->uri; - my $path_info = $r->path_info | ""; - my $args = $r->args || ""; + my $method = $r->method; + my $location = $r->location; + my $uri = $r->uri; + my $path_info = $r->path_info | ""; + my $args = $r->args || ""; my $dir_config = $r->dir_config; - my %conf_vars = map { $_ => $dir_config->{$_} } grep { /^webwork_/ } keys %$dir_config; - @SeedCE{keys %conf_vars} = values %conf_vars; + my %conf_vars = map { $_ => $dir_config->{$_} } grep {/^webwork_/} keys %$dir_config; + @SeedCE{ keys %conf_vars } = values %conf_vars; debug("\n\n===> Begin " . __PACKAGE__ . "::dispatch() <===\n\n"); debug("Hi, I'm the new dispatcher!\n"); @@ -109,7 +108,7 @@ sub dispatch($) { # Create a URLPath object ###################################################################### my ($path) = $uri =~ m/$location(.*)/; - $path = "/" if $path eq ""; # no path at all + $path = "/" if $path eq ""; # no path at all debug("We can't trust the path-info, so we make our own path.\n"); debug("path-info claims: $path_info\n"); @@ -130,8 +129,8 @@ sub dispatch($) { debug("-------------------- call to WeBWorK::URLPath::newFromPath\n"); my $urlPath = WeBWorK::URLPath->newFromPath($path, $r); - # pointer to parent request for access to the $ce and language translation ability - # need to add this pointer whenever a new URLPath is created. + # pointer to parent request for access to the $ce and language translation ability + # need to add this pointer whenever a new URLPath is created. debug("-------------------- call to WeBWorK::URLPath::newFromPath\n"); unless ($urlPath) { @@ -140,12 +139,12 @@ sub dispatch($) { } my $displayModule = $urlPath->module; - my %displayArgs = $urlPath->args; + my %displayArgs = $urlPath->args; unless ($displayModule) { - debug("The display module is empty, so we can DECLINE here.\n"); - $path = encode_entities($path); - die "No display module found for path '$path'."; + debug("The display module is empty, so we can DECLINE here.\n"); + $path = encode_entities($path); + die "No display module found for path '$path'."; } debug("The display module for this path is: $displayModule\n"); @@ -154,8 +153,8 @@ sub dispatch($) { debug("\t$key => $displayArgs{$key}\n"); } - my $selfPath = $urlPath->path; - my $parent = $urlPath->parent; + my $selfPath = $urlPath->path; + my $parent = $urlPath->parent; my $parentPath = $parent ? $parent->path : ""; debug("Reconstructing the original path gets us: $selfPath\n"); @@ -170,19 +169,20 @@ sub dispatch($) { debug("The raw params:\n"); foreach my $key ($r->param) { - #make it so we dont debug plain text passwords - my $vals; - if ($key eq 'passwd'|| - $key eq 'confirmPassword' || - $key eq 'currPassword' || - $key eq 'newPassword' || - $key =~ /\.new_password/) { - $vals = '**********'; - } else { - my @vals = $r->param($key); - $vals = join(", ", map { "'$_'" } @vals); - } - debug("\t$key => $vals\n"); + #make it so we dont debug plain text passwords + my $vals; + if ($key eq 'passwd' + || $key eq 'confirmPassword' + || $key eq 'currPassword' + || $key eq 'newPassword' + || $key =~ /\.new_password/) + { + $vals = '**********'; + } else { + my @vals = $r->param($key); + $vals = join(", ", map {"'$_'"} @vals); + } + debug("\t$key => $vals\n"); } #mungeParams($r); @@ -207,32 +207,32 @@ sub dispatch($) { $apache_root_url .= ":$apache_port" if $apache_port != 80; } - #################################################################### # Create Course Environment $ce #################################################################### debug("We need to get a course environment (with or without a courseID!)\n"); - my $ce = eval { new WeBWorK::CourseEnvironment({ - %SeedCE, - courseName => $displayArgs{courseID}, - # this is kind of a hack, but it's really the only sane way to get this - # server information into the PG box - apache_hostname => $apache_hostname, - apache_port => $apache_port, - apache_is_ssl => $apache_is_ssl, - apache_root_url => $apache_root_url, - }) }; + my $ce = eval { + new WeBWorK::CourseEnvironment({ + %SeedCE, + courseName => $displayArgs{courseID}, + # this is kind of a hack, but it's really the only sane way to get this + # server information into the PG box + apache_hostname => $apache_hostname, + apache_port => $apache_port, + apache_is_ssl => $apache_is_ssl, + apache_root_url => $apache_root_url, + }); + }; $@ and die "Failed to initialize course environment: $@\n"; debug("Here's the course environment: $ce\n"); $r->ce($ce); - ###################### # Localizing language ###################### - my $language= $ce->{language} || "en"; + my $language = $ce->{language} || "en"; # $r->language_handle( WeBWorK::Localize->get_handle($language) ); - $r->language_handle( WeBWorK::Localize::getLoc($language) ); + $r->language_handle(WeBWorK::Localize::getLoc($language)); my @uploads; @@ -244,12 +244,10 @@ sub dispatch($) { next unless $u->filename; # store the upload - my $upload = WeBWorK::Upload->store($u, - dir => $ce->{webworkDirs}->{uploadCache} - ); + my $upload = WeBWorK::Upload->store($u, dir => $ce->{webworkDirs}->{uploadCache}); # store the upload ID and hash in the file upload field - my $id = $upload->id; + my $id = $upload->id; my $hash = $upload->hash; $r->param($u->name => "$id $hash"); } @@ -335,12 +333,12 @@ sub dispatch($) { # module we double check this, to be sure that someone isn't taking a # proctored quiz but calling the unproctored ContentGenerator my $urlProducedPath = $urlPath->path(); - if ( $urlProducedPath =~ /proctored_quiz_mode/i ) { + if ($urlProducedPath =~ /proctored_quiz_mode/i) { my $proctor_authen_module = WeBWorK::Authen::class($ce, "proctor_module"); runtime_use $proctor_authen_module; my $authenProctor = $proctor_authen_module->new($r); debug("Using proctor_authen_module $proctor_authen_module: $authenProctor\n"); - my $procAuthOK = $authenProctor->verify(); + my $procAuthOK = $authenProctor->verify(); if (not $procAuthOK) { $displayModule = PROCTOR_LOGIN_MODULE; @@ -354,7 +352,7 @@ sub dispatch($) { } # store the time before we invoke the content generator - my $cg_start = time; # this is Time::HiRes's time, which gives floating point values + my $cg_start = time; # this is Time::HiRes's time, which gives floating point values debug(("-" x 80) . "\n"); debug("Finally, we'll load the display module...\n"); @@ -372,9 +370,13 @@ sub dispatch($) { debug("-------------------- call to ${displayModule}::go\n"); - my $cg_end = time; + my $cg_end = time; my $cg_duration = $cg_end - $cg_start; - writeTimingLogEntry($ce, "[".$r->uri."]", sprintf("runTime = %.3f sec", $cg_duration)." ".$ce->{dbLayoutName}, ""); + writeTimingLogEntry( + $ce, + "[" . $r->uri . "]", + sprintf("runTime = %.3f sec", $cg_duration) . " " . $ce->{dbLayoutName}, "" + ); debug("returning result: " . (defined $result ? $result : "UNDEF") . "\n"); return $result; @@ -388,7 +390,7 @@ sub mungeParams { # remove all the params from the request, and store them in the param queue foreach my $key ($r->param) { push @paramQueue, [ $key => [ $r->param($key) ] ]; - $r->parms->unset($key) + $r->parms->unset($key); } # exhaust the param queue, decoding encoded params @@ -403,7 +405,7 @@ sub mungeParams { # we have a whole param encoded in a key # split it up and add it to the end of the queue my ($newKey, $newValue) = split m/\:/, $key; - push @paramQueue, [ $newKey, [ $newValue ] ]; + push @paramQueue, [ $newKey, [$newValue] ]; } else { # this is a "normal" param # add it to the param list @@ -422,32 +424,30 @@ sub mungeParams { # A sort of wrapper for the built-in split function which uses capital letters as a delimiter, and returns a string containing the separated substrings separated by a whitespace. Used to make actionID's more readable. -sub split_cap -{ +sub split_cap { my $str = shift; - my @str_arr = split(//,$str); - my $count = scalar(@str_arr); + my @str_arr = split(//, $str); + my $count = scalar(@str_arr); - my $i = 0; - my $prev = 0; - my @result = (); + my $i = 0; + my $prev = 0; + my @result = (); my $hasCapital = 0; - foreach(@str_arr){ - if($_ =~ /[A-Z]/){ + foreach (@str_arr) { + if ($_ =~ /[A-Z]/) { $hasCapital = 1; - push(@result, join("", @str_arr[$prev..$i-1])); + push(@result, join("", @str_arr[ $prev .. $i - 1 ])); $prev = $i; } $i++; } - unless($hasCapital){ + unless ($hasCapital) { return $str; - } - else{ - push(@result, join("", @str_arr[$prev..$count-1])); - return join(" ",@result); + } else { + push(@result, join("", @str_arr[ $prev .. $count - 1 ])); + return join(" ", @result); } } @@ -455,32 +455,31 @@ sub split_cap # a simple subroutine for converting underscores in a given string to whitespace -sub underscore_to_whitespace{ +sub underscore_to_whitespace { my $str = shift; - my @strArr = split("",$str); - foreach(@strArr){ - if($_ eq "_"){ - $_ = " " + my @strArr = split("", $str); + foreach (@strArr) { + if ($_ eq "_") { + $_ = " "; } } - my $result = join("",@strArr); + my $result = join("", @strArr); return $result; } -sub remove_duplicates{ +sub remove_duplicates { my @arr = @_; my %unique; my @result; - foreach(@arr){ - if(defined $unique{$_}){ + foreach (@arr) { + if (defined $unique{$_}) { next; - } - else{ + } else { push(@result, $_); $unique{$_} = "seen"; } diff --git a/lib/WeBWorK/AchievementEvaluator.pm b/lib/WeBWorK/AchievementEvaluator.pm index 92dfd213c0..8929e163e6 100644 --- a/lib/WeBWorK/AchievementEvaluator.pm +++ b/lib/WeBWorK/AchievementEvaluator.pm @@ -118,7 +118,7 @@ sub checkForAchievements { foreach my $achievement (@achievements) { next unless $achievement->enabled; my $userAchievement = $db->getUserAchievement($user_id, $achievement->achievement_id); - $userAchievements->{$achievement->achievement_id} = $userAchievement->earned if $userAchievement; + $userAchievements->{ $achievement->achievement_id } = $userAchievement->earned if $userAchievement; } #Update a couple of "standard" variables in globalData hash. diff --git a/lib/WeBWorK/AchievementItems.pm b/lib/WeBWorK/AchievementItems.pm index 6177d99a93..b0202ed018 100644 --- a/lib/WeBWorK/AchievementItems.pm +++ b/lib/WeBWorK/AchievementItems.pm @@ -24,24 +24,24 @@ use warnings; # have to add any new items to this list, furthermore # the elements of this list have to match the class name/id of the # item classes defined below. -use constant ITEMS => [qw( -ResetIncorrectAttempts -DuplicateProb -DoubleProb -HalfCreditProb -FullCreditProb -ReducedCred -ExtendDueDate -DoubleSet -ResurrectHW -Surprise -SuperExtendDueDate -HalfCreditSet -FullCreditSet -AddNewTestGW -ExtendDueDateGW -ResurrectGW -)]; +use constant ITEMS => [ qw( + ResetIncorrectAttempts + DuplicateProb + DoubleProb + HalfCreditProb + FullCreditProb + ReducedCred + ExtendDueDate + DoubleSet + ResurrectHW + Surprise + SuperExtendDueDate + HalfCreditSet + FullCreditSet + AddNewTestGW + ExtendDueDateGW + ResurrectGW +) ]; =head2 NAME @@ -54,31 +54,31 @@ Note: the ID has to match the name of the class. =cut -sub id { shift->{id} } -sub name { shift->{name} } +sub id { shift->{id} } +sub name { shift->{name} } sub description { shift->{description} } # This is a global method that returns all of the provided users items. sub UserItems { - my $userName = shift; - my $db = shift; - my $ce = shift; + my $userName = shift; + my $db = shift; + my $ce = shift; - # return unless the user has global achievement data - my $globalUserAchievement = $db->getGlobalUserAchievement($userName); + # return unless the user has global achievement data + my $globalUserAchievement = $db->getGlobalUserAchievement($userName); - return unless ($globalUserAchievement->frozen_hash); + return unless ($globalUserAchievement->frozen_hash); - my $globalData = thaw_base64($globalUserAchievement->frozen_hash); - my @items; + my $globalData = thaw_base64($globalUserAchievement->frozen_hash); + my @items; - # ugly eval to get a new item object for each type of item. - foreach my $item (@{+ITEMS}) { - push (@items, [eval("WeBWorK::AchievementItems::${item}->new"),$globalData->{$item}]) if - ($globalData->{$item}); - } + # ugly eval to get a new item object for each type of item. + foreach my $item (@{ +ITEMS }) { + push(@items, [ eval("WeBWorK::AchievementItems::${item}->new"), $globalData->{$item} ]) + if ($globalData->{$item}); + } - return \@items; + return \@items; } # Utility method for outputing a form row with a label and popup menu. @@ -120,31 +120,31 @@ our @ISA = qw(WeBWorK::AchievementItems); use WeBWorK::Utils qw(sortByName before after between x nfreeze_base64 thaw_base64 format_set_name_display); sub new { - my $class = shift; - my %options = @_; - - my $self = { - id => "ResurrectHW", - name => x("Scroll of Resurrection"), - description => x("Opens any homework set for 24 hours."), - %options, - }; - - bless($self, $class); - return $self; + my $class = shift; + my %options = @_; + + my $self = { + id => "ResurrectHW", + name => x("Scroll of Resurrection"), + description => x("Opens any homework set for 24 hours."), + %options, + }; + + bless($self, $class); + return $self; } sub print_form { - my $self = shift; - my $sets = shift; - my $setProblemCount = shift; - my $r = shift; + my $self = shift; + my $sets = shift; + my $setProblemCount = shift; + my $r = shift; - my @openSets; - my @openSetCount; - my $maxProblems=0; + my @openSets; + my @openSetCount; + my $maxProblems = 0; - #Find all of the closed sets or sets that are past their reduced scoring date and put them in form + #Find all of the closed sets or sets that are past their reduced scoring date and put them in form for (my $i = 0; $i <= $#$sets; $i++) { if (after($$sets[$i]->due_date) && $$sets[$i]->assignment_type eq 'default') { @@ -170,49 +170,49 @@ sub print_form { } sub use_item { - my $self = shift; - my $userName = shift; - my $r = shift; - my $db = $r->db; - my $ce = $r->ce; - - #check and see if student really has the item and if the data is valid - my $globalUserAchievement = $db->getGlobalUserAchievement($userName); - return "No achievement data?!?!?!" - unless ($globalUserAchievement->frozen_hash); - my $globalData = thaw_base64($globalUserAchievement->frozen_hash); - - return "You are $self->{id} trying to use an item you don't have" unless - ($globalData->{$self->{id}}); - - my $setID = $r->param('res_set_id'); - return "You need to input a Set Name" unless - (defined $setID); - - my $set = $db->getUserSet($userName,$setID); - return "Couldn't find that set!" unless - ($set); - - # Set a new reduced scoring date, close date, and answer date for the student; remove the item - $set->reduced_scoring_date(time()+86400); - $set->due_date(time()+86400); - $set->answer_date(time()+86400); - - $db->putUserSet($set); - - my @probIDs = $db->listUserProblems($userName,$setID); - - foreach my $probID (@probIDs) { - my $problem = $db->getUserProblem($userName,$setID,$probID); - $problem->problem_seed($problem->problem_seed + 100); - $db->putUserProblem($problem); - } + my $self = shift; + my $userName = shift; + my $r = shift; + my $db = $r->db; + my $ce = $r->ce; + + #check and see if student really has the item and if the data is valid + my $globalUserAchievement = $db->getGlobalUserAchievement($userName); + return "No achievement data?!?!?!" + unless ($globalUserAchievement->frozen_hash); + my $globalData = thaw_base64($globalUserAchievement->frozen_hash); + + return "You are $self->{id} trying to use an item you don't have" + unless ($globalData->{ $self->{id} }); + + my $setID = $r->param('res_set_id'); + return "You need to input a Set Name" + unless (defined $setID); + + my $set = $db->getUserSet($userName, $setID); + return "Couldn't find that set!" + unless ($set); + + # Set a new reduced scoring date, close date, and answer date for the student; remove the item + $set->reduced_scoring_date(time() + 86400); + $set->due_date(time() + 86400); + $set->answer_date(time() + 86400); + + $db->putUserSet($set); + + my @probIDs = $db->listUserProblems($userName, $setID); + + foreach my $probID (@probIDs) { + my $problem = $db->getUserProblem($userName, $setID, $probID); + $problem->problem_seed($problem->problem_seed + 100); + $db->putUserProblem($problem); + } - $globalData->{$self->{id}}--; - $globalUserAchievement->frozen_hash(nfreeze_base64($globalData)); - $db->putGlobalUserAchievement($globalUserAchievement); + $globalData->{ $self->{id} }--; + $globalUserAchievement->frozen_hash(nfreeze_base64($globalData)); + $db->putGlobalUserAchievement($globalUserAchievement); - return; + return; } #Item to extend a close date by 24 hours. @@ -223,36 +223,36 @@ our @ISA = qw(WeBWorK::AchievementItems); use WeBWorK::Utils qw(sortByName before after between x nfreeze_base64 thaw_base64 format_set_name_display); sub new { - my $class = shift; - my %options = @_; - - my $self = { - id => "ExtendDueDate", - name => x("Tunic of Extension"), - description => x("Adds 24 hours to the close date of a homework."), - %options, - }; - - bless($self, $class); - return $self; + my $class = shift; + my %options = @_; + + my $self = { + id => "ExtendDueDate", + name => x("Tunic of Extension"), + description => x("Adds 24 hours to the close date of a homework."), + %options, + }; + + bless($self, $class); + return $self; } sub print_form { - my $self = shift; - my $sets = shift; - my $setProblemCount = shift; - my $r = shift; - - my @openSets; - my @openSetCount; - my $maxProblems=0; - - #find all currently open sets and print to a form - for (my $i=0; $i<=$#$sets; $i++) { - if (between($$sets[$i]->open_date, $$sets[$i]->answer_date) && $$sets[$i]->assignment_type eq "default") { - push(@openSets,$$sets[$i]->set_id); + my $self = shift; + my $sets = shift; + my $setProblemCount = shift; + my $r = shift; + + my @openSets; + my @openSetCount; + my $maxProblems = 0; + + #find all currently open sets and print to a form + for (my $i = 0; $i <= $#$sets; $i++) { + if (between($$sets[$i]->open_date, $$sets[$i]->answer_date) && $$sets[$i]->assignment_type eq "default") { + push(@openSets, $$sets[$i]->set_id); + } } - } return join( '', @@ -268,42 +268,43 @@ sub print_form { } sub use_item { - my $self = shift; - my $userName = shift; - my $r = shift; - my $db = $r->db; - my $ce = $r->ce; - - #check and see if the student has the achievement and if the data is valid - my $globalUserAchievement = $db->getGlobalUserAchievement($userName); - return "No achievement data?!?!?!" - unless ($globalUserAchievement->frozen_hash); - my $globalData = thaw_base64($globalUserAchievement->frozen_hash); - - return "You are $self->{id} trying to use an item you don't have" unless - ($globalData->{$self->{id}}); - - my $setID = $r->param('ext_set_id'); - return "You need to input a Set Name" unless - (defined $setID); - - my $set = $db->getMergedSet($userName,$setID); - return "Couldn't find that set!" unless - ($set); - my $userSet = $db->getUserSet($userName,$setID); - - #add time to the reduced scoring date, due date, and answer date; remove item from inventory - $userSet->reduced_scoring_date($set->reduced_scoring_date()+86400) if defined($set->reduced_scoring_date()) && $set->reduced_scoring_date(); - $userSet->due_date($set->due_date()+86400); - $userSet->answer_date($set->answer_date()+86400); - - $db->putUserSet($userSet); - - $globalData->{$self->{id}}--; - $globalUserAchievement->frozen_hash(nfreeze_base64($globalData)); - $db->putGlobalUserAchievement($globalUserAchievement); - - return; + my $self = shift; + my $userName = shift; + my $r = shift; + my $db = $r->db; + my $ce = $r->ce; + + #check and see if the student has the achievement and if the data is valid + my $globalUserAchievement = $db->getGlobalUserAchievement($userName); + return "No achievement data?!?!?!" + unless ($globalUserAchievement->frozen_hash); + my $globalData = thaw_base64($globalUserAchievement->frozen_hash); + + return "You are $self->{id} trying to use an item you don't have" + unless ($globalData->{ $self->{id} }); + + my $setID = $r->param('ext_set_id'); + return "You need to input a Set Name" + unless (defined $setID); + + my $set = $db->getMergedSet($userName, $setID); + return "Couldn't find that set!" + unless ($set); + my $userSet = $db->getUserSet($userName, $setID); + + #add time to the reduced scoring date, due date, and answer date; remove item from inventory + $userSet->reduced_scoring_date($set->reduced_scoring_date() + 86400) + if defined($set->reduced_scoring_date()) && $set->reduced_scoring_date(); + $userSet->due_date($set->due_date() + 86400); + $userSet->answer_date($set->answer_date() + 86400); + + $db->putUserSet($userSet); + + $globalData->{ $self->{id} }--; + $globalUserAchievement->frozen_hash(nfreeze_base64($globalData)); + $db->putGlobalUserAchievement($globalUserAchievement); + + return; } #Item to extend a close date by 48 hours. @@ -314,36 +315,36 @@ our @ISA = qw(WeBWorK::AchievementItems); use WeBWorK::Utils qw(sortByName before after between x nfreeze_base64 thaw_base64 format_set_name_display); sub new { - my $class = shift; - my %options = @_; - - my $self = { - id => "SuperExtendDueDate", - name => x("Robe of Longevity"), - description => x("Adds 48 hours to the close date of a homework."), - %options, - }; - - bless($self, $class); - return $self; + my $class = shift; + my %options = @_; + + my $self = { + id => "SuperExtendDueDate", + name => x("Robe of Longevity"), + description => x("Adds 48 hours to the close date of a homework."), + %options, + }; + + bless($self, $class); + return $self; } sub print_form { - my $self = shift; - my $sets = shift; - my $setProblemCount = shift; - my $r = shift; - - my @openSets; - my @openSetCount; - my $maxProblems=0; - - #find all currently open sets and print to a form - for (my $i=0; $i<=$#$sets; $i++) { - if (between($$sets[$i]->open_date, $$sets[$i]->answer_date) && $$sets[$i]->assignment_type eq "default") { - push(@openSets,$$sets[$i]->set_id); + my $self = shift; + my $sets = shift; + my $setProblemCount = shift; + my $r = shift; + + my @openSets; + my @openSetCount; + my $maxProblems = 0; + + #find all currently open sets and print to a form + for (my $i = 0; $i <= $#$sets; $i++) { + if (between($$sets[$i]->open_date, $$sets[$i]->answer_date) && $$sets[$i]->assignment_type eq "default") { + push(@openSets, $$sets[$i]->set_id); + } } - } return join( '', @@ -359,42 +360,43 @@ sub print_form { } sub use_item { - my $self = shift; - my $userName = shift; - my $r = shift; - my $db = $r->db; - my $ce = $r->ce; - - #check and see if the student has the achievement and if the data is valid - my $globalUserAchievement = $db->getGlobalUserAchievement($userName); - return "No achievement data?!?!?!" - unless ($globalUserAchievement->frozen_hash); - my $globalData = thaw_base64($globalUserAchievement->frozen_hash); - - return "You are $self->{id} trying to use an item you don't have" unless - ($globalData->{$self->{id}}); - - my $setID = $r->param('ext_set_id'); - return "You need to input a Set Name" unless - (defined $setID); - - my $set = $db->getMergedSet($userName,$setID); - return "Couldn't find that set!" unless - ($set); - my $userSet = $db->getUserSet($userName,$setID); - - #add time to the reduced scoring date, due date, and answer date; remove item from inventory - $userSet->reduced_scoring_date($set->reduced_scoring_date()+172800) if defined($set->reduced_scoring_date()) && $set->reduced_scoring_date(); - $userSet->due_date($set->due_date()+172800); - $userSet->answer_date($set->answer_date()+172800); - - $db->putUserSet($userSet); - - $globalData->{$self->{id}}--; - $globalUserAchievement->frozen_hash(nfreeze_base64($globalData)); - $db->putGlobalUserAchievement($globalUserAchievement); - - return; + my $self = shift; + my $userName = shift; + my $r = shift; + my $db = $r->db; + my $ce = $r->ce; + + #check and see if the student has the achievement and if the data is valid + my $globalUserAchievement = $db->getGlobalUserAchievement($userName); + return "No achievement data?!?!?!" + unless ($globalUserAchievement->frozen_hash); + my $globalData = thaw_base64($globalUserAchievement->frozen_hash); + + return "You are $self->{id} trying to use an item you don't have" + unless ($globalData->{ $self->{id} }); + + my $setID = $r->param('ext_set_id'); + return "You need to input a Set Name" + unless (defined $setID); + + my $set = $db->getMergedSet($userName, $setID); + return "Couldn't find that set!" + unless ($set); + my $userSet = $db->getUserSet($userName, $setID); + + #add time to the reduced scoring date, due date, and answer date; remove item from inventory + $userSet->reduced_scoring_date($set->reduced_scoring_date() + 172800) + if defined($set->reduced_scoring_date()) && $set->reduced_scoring_date(); + $userSet->due_date($set->due_date() + 172800); + $userSet->answer_date($set->answer_date() + 172800); + + $db->putUserSet($userSet); + + $globalData->{ $self->{id} }--; + $globalUserAchievement->frozen_hash(nfreeze_base64($globalData)); + $db->putGlobalUserAchievement($globalUserAchievement); + + return; } #Item to extend a close date by 24 hours for reduced credit @@ -405,40 +407,41 @@ our @ISA = qw(WeBWorK::AchievementItems); use WeBWorK::Utils qw(sortByName before after between x nfreeze_base64 thaw_base64 format_set_name_display); sub new { - my $class = shift; - my %options = @_; - - my $self = { - id => "ReducedCred", - name => x("Ring of Reduction"), - #Reduced credit needs to be set up in course configuration for this - # item to work, - description => x("Enable reduced scoring for a homework set. This will allow you to submit answers for partial credit for 24 hours after the close date."), - %options, - }; - - bless($self, $class); - return $self; + my $class = shift; + my %options = @_; + + my $self = { + id => "ReducedCred", + name => x("Ring of Reduction"), + #Reduced credit needs to be set up in course configuration for this + # item to work, + description => x( + "Enable reduced scoring for a homework set. This will allow you to submit answers for partial credit for 24 hours after the close date." + ), + %options, + }; + + bless($self, $class); + return $self; } sub print_form { - my $self = shift; - my $sets = shift; - my $setProblemCount = shift; - my $r = shift; - my $ce = $r->{ce}; - - my @openSets; - my @openSetCount; - my $maxProblems=0; + my $self = shift; + my $sets = shift; + my $setProblemCount = shift; + my $r = shift; + my $ce = $r->{ce}; + my @openSets; + my @openSetCount; + my $maxProblems = 0; - #print names of open sets - for (my $i=0; $i<=$#$sets; $i++) { - if (between($$sets[$i]->open_date, $$sets[$i]->answer_date) && $$sets[$i]->assignment_type eq "default") { - push(@openSets,$$sets[$i]->set_id); + #print names of open sets + for (my $i = 0; $i <= $#$sets; $i++) { + if (between($$sets[$i]->open_date, $$sets[$i]->answer_date) && $$sets[$i]->assignment_type eq "default") { + push(@openSets, $$sets[$i]->set_id); + } } - } return join( '', @@ -454,49 +457,49 @@ sub print_form { } sub use_item { - my $self = shift; - my $userName = shift; - my $r = shift; - my $db = $r->db; - my $ce = $r->ce; - - - #check variables - my $globalUserAchievement = $db->getGlobalUserAchievement($userName); - return "No achievement data?!?!?!" - unless ($globalUserAchievement->frozen_hash); - my $globalData = thaw_base64($globalUserAchievement->frozen_hash); - - return "This item won't work unless your instructor enables the reduced scoring feature. Let them know that you recieved this message." unless $ce->{pg}{ansEvalDefaults}{reducedScoringPeriod}; - - - return "You are $self->{id} trying to use an item you don't have" unless - ($globalData->{$self->{id}}); - - my $setID = $r->param('red_set_id'); - return "You need to input a Set Name" unless - (defined $setID); - - my $set = $db->getMergedSet($userName,$setID); - return "Couldn't find that set!" unless - ($set); - my $userSet = $db->getUserSet($userName,$setID); - - # enable reduced scoring on the set and add the reduced scoring period - # to the due date. - my $additionalTime = 60*$ce->{pg}{ansEvalDefaults}{reducedScoringPeriod}; - $userSet->enable_reduced_scoring(1); - $userSet->reduced_scoring_date($set->due_date()); - $userSet->due_date($set->due_date()+$additionalTime); - $userSet->answer_date($set->answer_date()+$additionalTime); - - $db->putUserSet($userSet); - - $globalData->{$self->{id}}--; - $globalUserAchievement->frozen_hash(nfreeze_base64($globalData)); - $db->putGlobalUserAchievement($globalUserAchievement); - - return; + my $self = shift; + my $userName = shift; + my $r = shift; + my $db = $r->db; + my $ce = $r->ce; + + #check variables + my $globalUserAchievement = $db->getGlobalUserAchievement($userName); + return "No achievement data?!?!?!" + unless ($globalUserAchievement->frozen_hash); + my $globalData = thaw_base64($globalUserAchievement->frozen_hash); + + return + "This item won't work unless your instructor enables the reduced scoring feature. Let them know that you recieved this message." + unless $ce->{pg}{ansEvalDefaults}{reducedScoringPeriod}; + + return "You are $self->{id} trying to use an item you don't have" + unless ($globalData->{ $self->{id} }); + + my $setID = $r->param('red_set_id'); + return "You need to input a Set Name" + unless (defined $setID); + + my $set = $db->getMergedSet($userName, $setID); + return "Couldn't find that set!" + unless ($set); + my $userSet = $db->getUserSet($userName, $setID); + + # enable reduced scoring on the set and add the reduced scoring period + # to the due date. + my $additionalTime = 60 * $ce->{pg}{ansEvalDefaults}{reducedScoringPeriod}; + $userSet->enable_reduced_scoring(1); + $userSet->reduced_scoring_date($set->due_date()); + $userSet->due_date($set->due_date() + $additionalTime); + $userSet->answer_date($set->answer_date() + $additionalTime); + + $db->putUserSet($userSet); + + $globalData->{ $self->{id} }--; + $globalUserAchievement->frozen_hash(nfreeze_base64($globalData)); + $db->putGlobalUserAchievement($globalUserAchievement); + + return; } #Item to make a homework set worth twice as much @@ -507,36 +510,36 @@ our @ISA = qw(WeBWorK::AchievementItems); use WeBWorK::Utils qw(sortByName before after between x nfreeze_base64 thaw_base64 format_set_name_display); sub new { - my $class = shift; - my %options = @_; - - my $self = { - id => "DoubleSet", - name => x("Cake of Enlargement"), - description => x("Cause the selected homework set to count for twice as many points as it normally would."), - %options, - }; - - bless($self, $class); - return $self; + my $class = shift; + my %options = @_; + + my $self = { + id => "DoubleSet", + name => x("Cake of Enlargement"), + description => x("Cause the selected homework set to count for twice as many points as it normally would."), + %options, + }; + + bless($self, $class); + return $self; } sub print_form { - my $self = shift; - my $sets = shift; - my $setProblemCount = shift; - my $r = shift; - my $ce = $r->{ce}; + my $self = shift; + my $sets = shift; + my $setProblemCount = shift; + my $r = shift; + my $ce = $r->{ce}; - my @openSets; + my @openSets; - #print open sets + #print open sets - for (my $i=0; $i<=$#$sets; $i++) { - if ($$sets[$i]->assignment_type eq "default") { - push(@openSets,$$sets[$i]->set_id); + for (my $i = 0; $i <= $#$sets; $i++) { + if ($$sets[$i]->assignment_type eq "default") { + push(@openSets, $$sets[$i]->set_id); + } } - } return join( '', @@ -552,46 +555,46 @@ sub print_form { } sub use_item { - my $self = shift; - my $userName = shift; - my $r = shift; - my $db = $r->db; - my $ce = $r->ce; + my $self = shift; + my $userName = shift; + my $r = shift; + my $db = $r->db; + my $ce = $r->ce; - #validate input data + #validate input data - my $globalUserAchievement = $db->getGlobalUserAchievement($userName); - return "No achievement data?!?!?!" - unless ($globalUserAchievement->frozen_hash); - my $globalData = thaw_base64($globalUserAchievement->frozen_hash); + my $globalUserAchievement = $db->getGlobalUserAchievement($userName); + return "No achievement data?!?!?!" + unless ($globalUserAchievement->frozen_hash); + my $globalData = thaw_base64($globalUserAchievement->frozen_hash); - return "You are $self->{id} trying to use an item you don't have" unless - ($globalData->{$self->{id}}); + return "You are $self->{id} trying to use an item you don't have" + unless ($globalData->{ $self->{id} }); - my $setID = $r->param('dub_set_id'); - return "You need to input a Set Name" unless - (defined $setID); + my $setID = $r->param('dub_set_id'); + return "You need to input a Set Name" + unless (defined $setID); - my $set = $db->getMergedSet($userName,$setID); - return "Couldn't find that set!" unless - ($set); + my $set = $db->getMergedSet($userName, $setID); + return "Couldn't find that set!" + unless ($set); - # got through the problems in the set and double the value/weight of each + # got through the problems in the set and double the value/weight of each - my @probIDs = $db->listUserProblems($userName,$setID); + my @probIDs = $db->listUserProblems($userName, $setID); - foreach my $probID (@probIDs) { - my $globalproblem = $db->getMergedProblem($userName, $setID,$probID); - my $problem = $db->getUserProblem($userName,$setID,$probID); - $problem->value($globalproblem->value*2); - $db->putUserProblem($problem); - } + foreach my $probID (@probIDs) { + my $globalproblem = $db->getMergedProblem($userName, $setID, $probID); + my $problem = $db->getUserProblem($userName, $setID, $probID); + $problem->value($globalproblem->value * 2); + $db->putUserProblem($problem); + } - $globalData->{$self->{id}}--; - $globalUserAchievement->frozen_hash(nfreeze_base64($globalData)); - $db->putGlobalUserAchievement($globalUserAchievement); + $globalData->{ $self->{id} }--; + $globalUserAchievement->frozen_hash(nfreeze_base64($globalData)); + $db->putGlobalUserAchievement($globalUserAchievement); - return; + return; } #Item to reset number of incorrect attempts. @@ -601,18 +604,18 @@ our @ISA = qw(WeBWorK::AchievementItems); use WeBWorK::Utils qw(sortByName before after between x nfreeze_base64 thaw_base64 format_set_name_display); sub new { - my $class = shift; - my %options = @_; - - my $self = { - id => "ResetIncorrectAttempts", - name => x("Potion of Forgetfulness"), - description => x("Resets the number of incorrect attempts on a single homework problem."), - %options, - }; - - bless($self, $class); - return $self; + my $class = shift; + my %options = @_; + + my $self = { + id => "ResetIncorrectAttempts", + name => x("Potion of Forgetfulness"), + description => x("Resets the number of incorrect attempts on a single homework problem."), + %options, + }; + + bless($self, $class); + return $self; } sub print_form { @@ -672,43 +675,43 @@ sub print_form { } sub use_item { - my $self = shift; - my $userName = shift; - my $r = shift; - my $db = $r->db; - my $ce = $r->ce; - - #validate data - my $globalUserAchievement = $db->getGlobalUserAchievement($userName); - return "No achievement data?!?!?!" - unless ($globalUserAchievement->frozen_hash); - my $globalData = thaw_base64($globalUserAchievement->frozen_hash); + my $self = shift; + my $userName = shift; + my $r = shift; + my $db = $r->db; + my $ce = $r->ce; + + #validate data + my $globalUserAchievement = $db->getGlobalUserAchievement($userName); + return "No achievement data?!?!?!" + unless ($globalUserAchievement->frozen_hash); + my $globalData = thaw_base64($globalUserAchievement->frozen_hash); + + return "You are $self->{id} trying to use an item you don't have" + unless ($globalData->{ $self->{id} }); + + my $setID = $r->param('ria_set_id'); + return "You need to input a Set Name" + unless (defined $setID); + my $problemID = $r->param('ria_problem_id'); + return "You need to input a Problem Number" + unless ($problemID); + + my $problem = $db->getUserProblem($userName, $setID, $problemID); - return "You are $self->{id} trying to use an item you don't have" unless - ($globalData->{$self->{id}}); - - my $setID = $r->param('ria_set_id'); - return "You need to input a Set Name" unless - (defined $setID); - my $problemID = $r->param('ria_problem_id'); - return "You need to input a Problem Number" unless - ($problemID); - - my $problem = $db->getUserProblem($userName, $setID, $problemID); - - return "There was an error accessing that problem." unless $problem; + return "There was an error accessing that problem." unless $problem; - #set number of incorrect attempts to zero + #set number of incorrect attempts to zero - $problem->num_incorrect(0); + $problem->num_incorrect(0); - $db->putUserProblem($problem); + $db->putUserProblem($problem); - $globalData->{$self->{id}}--; - $globalUserAchievement->frozen_hash(nfreeze_base64($globalData)); - $db->putGlobalUserAchievement($globalUserAchievement); + $globalData->{ $self->{id} }--; + $globalUserAchievement->frozen_hash(nfreeze_base64($globalData)); + $db->putGlobalUserAchievement($globalUserAchievement); - return; + return; } #Item to make a problem worth double. @@ -718,18 +721,18 @@ our @ISA = qw(WeBWorK::AchievementItems); use WeBWorK::Utils qw(sortByName before after between x nfreeze_base64 thaw_base64 format_set_name_display); sub new { - my $class = shift; - my %options = @_; - - my $self = { - id => "DoubleProb", - name => x("Cupcake of Enlargement"), - description => x("Causes a single homework problem to be worth twice as much."), - %options, - }; - - bless($self, $class); - return $self; + my $class = shift; + my %options = @_; + + my $self = { + id => "DoubleProb", + name => x("Cupcake of Enlargement"), + description => x("Causes a single homework problem to be worth twice as much."), + %options, + }; + + bless($self, $class); + return $self; } sub print_form { @@ -789,45 +792,44 @@ sub print_form { } sub use_item { - my $self = shift; - my $userName = shift; - my $r = shift; - my $db = $r->db; - my $ce = $r->ce; + my $self = shift; + my $userName = shift; + my $r = shift; + my $db = $r->db; + my $ce = $r->ce; - #validate data + #validate data - my $globalUserAchievement = $db->getGlobalUserAchievement($userName); - return "No achievement data?!?!?!" - unless ($globalUserAchievement->frozen_hash); - my $globalData = thaw_base64($globalUserAchievement->frozen_hash); + my $globalUserAchievement = $db->getGlobalUserAchievement($userName); + return "No achievement data?!?!?!" + unless ($globalUserAchievement->frozen_hash); + my $globalData = thaw_base64($globalUserAchievement->frozen_hash); - return "You are $self->{id} trying to use an item you don't have" unless - ($globalData->{$self->{id}}); + return "You are $self->{id} trying to use an item you don't have" + unless ($globalData->{ $self->{id} }); - my $setID = $r->param('dbp_set_id'); - return "You need to input a Set Name" unless - (defined $setID); - my $problemID = $r->param('dbp_problem_id'); - return "You need to input a Problem Number" unless - ($problemID); + my $setID = $r->param('dbp_set_id'); + return "You need to input a Set Name" + unless (defined $setID); + my $problemID = $r->param('dbp_problem_id'); + return "You need to input a Problem Number" + unless ($problemID); + my $globalproblem = $db->getMergedProblem($userName, $setID, $problemID); + my $problem = $db->getUserProblem($userName, $setID, $problemID); - my $globalproblem = $db->getMergedProblem($userName, $setID,$problemID); - my $problem = $db->getUserProblem($userName, $setID, $problemID); - - return "There was an error accessing that problem." unless $problem; + return "There was an error accessing that problem." unless $problem; - #double value of problem + #double value of problem - $problem->value($globalproblem->value*2); - $db->putUserProblem($problem); + $problem->value($globalproblem->value * 2); + $db->putUserProblem($problem); - $globalData->{$self->{id}}--; - $globalUserAchievement->frozen_hash(nfreeze_base64($globalData)); - $db->putGlobalUserAchievement($globalUserAchievement); + $globalData->{ $self->{id} }--; + $globalUserAchievement->frozen_hash(nfreeze_base64($globalData)); + $db->putGlobalUserAchievement($globalUserAchievement); - return; + return; } #Item to give half credit on a single problem. @@ -837,18 +839,18 @@ our @ISA = qw(WeBWorK::AchievementItems); use WeBWorK::Utils qw(sortByName before after between x nfreeze_base64 thaw_base64 format_set_name_display); sub new { - my $class = shift; - my %options = @_; - - my $self = { - id => "HalfCreditProb", - name => x("Lesser Rod of Revelation"), - description => x("Gives half credit on a single homework problem."), - %options, - }; - - bless($self, $class); - return $self; + my $class = shift; + my %options = @_; + + my $self = { + id => "HalfCreditProb", + name => x("Lesser Rod of Revelation"), + description => x("Gives half credit on a single homework problem."), + %options, + }; + + bless($self, $class); + return $self; } sub print_form { @@ -906,48 +908,48 @@ sub print_form { } sub use_item { - my $self = shift; - my $userName = shift; - my $r = shift; - my $db = $r->db; - my $ce = $r->ce; + my $self = shift; + my $userName = shift; + my $r = shift; + my $db = $r->db; + my $ce = $r->ce; - #validate data + #validate data - my $globalUserAchievement = $db->getGlobalUserAchievement($userName); - return "No achievement data?!?!?!" - unless ($globalUserAchievement->frozen_hash); - my $globalData = thaw_base64($globalUserAchievement->frozen_hash); + my $globalUserAchievement = $db->getGlobalUserAchievement($userName); + return "No achievement data?!?!?!" + unless ($globalUserAchievement->frozen_hash); + my $globalData = thaw_base64($globalUserAchievement->frozen_hash); - return "You are $self->{id} trying to use an item you don't have" unless - ($globalData->{$self->{id}}); + return "You are $self->{id} trying to use an item you don't have" + unless ($globalData->{ $self->{id} }); - my $setID = $r->param('hcp_set_id'); - return "You need to input a Set Name" unless - (defined $setID); - my $problemID = $r->param('hcp_problem_id'); - return "You need to input a Problem Number" unless - ($problemID); + my $setID = $r->param('hcp_set_id'); + return "You need to input a Set Name" + unless (defined $setID); + my $problemID = $r->param('hcp_problem_id'); + return "You need to input a Problem Number" + unless ($problemID); - my $problem = $db->getUserProblem($userName, $setID, $problemID); + my $problem = $db->getUserProblem($userName, $setID, $problemID); - return "There was an error accessing that problem." unless $problem; + return "There was an error accessing that problem." unless $problem; - #Add .5 to grade with max of 1 + #Add .5 to grade with max of 1 - if ($problem->status < .5) { - $problem->status($problem->status + .5); - } else { - $problem->status(1); - } + if ($problem->status < .5) { + $problem->status($problem->status + .5); + } else { + $problem->status(1); + } - $db->putUserProblem($problem); + $db->putUserProblem($problem); - $globalData->{$self->{id}}--; - $globalUserAchievement->frozen_hash(nfreeze_base64($globalData)); - $db->putGlobalUserAchievement($globalUserAchievement); + $globalData->{ $self->{id} }--; + $globalUserAchievement->frozen_hash(nfreeze_base64($globalData)); + $db->putGlobalUserAchievement($globalUserAchievement); - return; + return; } #Item to give half credit on all problems in a homework set. @@ -957,34 +959,33 @@ our @ISA = qw(WeBWorK::AchievementItems); use WeBWorK::Utils qw(sortByName before after between x nfreeze_base64 thaw_base64 format_set_name_display); sub new { - my $class = shift; - my %options = @_; - - my $self = { - id => "HalfCreditSet", - name => x("Lesser Tome of Enlightenment"), - description => x("Gives half credit on every problem in a set."), - %options, - }; - - bless($self, $class); - return $self; + my $class = shift; + my %options = @_; + + my $self = { + id => "HalfCreditSet", + name => x("Lesser Tome of Enlightenment"), + description => x("Gives half credit on every problem in a set."), + %options, + }; + + bless($self, $class); + return $self; } sub print_form { - my $self = shift; - my $sets = shift; - my $setProblemCount = shift; - my $r = shift; - - my @openSets; - my @openSetCount; - my $maxProblems=0; + my $self = shift; + my $sets = shift; + my $setProblemCount = shift; + my $r = shift; - for (my $i=0; $i<=$#$sets; $i++) { - push(@openSets,$$sets[$i]->set_id); - } + my @openSets; + my @openSetCount; + my $maxProblems = 0; + for (my $i = 0; $i <= $#$sets; $i++) { + push(@openSets, $$sets[$i]->set_id); + } # print form with sets return join( @@ -1001,50 +1002,50 @@ sub print_form { } sub use_item { - my $self = shift; - my $userName = shift; - my $r = shift; - my $db = $r->db; - my $ce = $r->ce; + my $self = shift; + my $userName = shift; + my $r = shift; + my $db = $r->db; + my $ce = $r->ce; - #validate data + #validate data - my $globalUserAchievement = $db->getGlobalUserAchievement($userName); - return "No achievement data?!?!?!" - unless ($globalUserAchievement->frozen_hash); - my $globalData = thaw_base64($globalUserAchievement->frozen_hash); + my $globalUserAchievement = $db->getGlobalUserAchievement($userName); + return "No achievement data?!?!?!" + unless ($globalUserAchievement->frozen_hash); + my $globalData = thaw_base64($globalUserAchievement->frozen_hash); - return "You are $self->{id} trying to use an item you don't have" unless - ($globalData->{$self->{id}}); + return "You are $self->{id} trying to use an item you don't have" + unless ($globalData->{ $self->{id} }); - my $setID = $r->param('hcs_set_id'); - return "You need to input a Set Name" unless - (defined $setID); + my $setID = $r->param('hcs_set_id'); + return "You need to input a Set Name" + unless (defined $setID); - # go through the problems in the set - my @probIDs = $db->listUserProblems($userName,$setID); + # go through the problems in the set + my @probIDs = $db->listUserProblems($userName, $setID); - foreach my $probID (@probIDs) { - my $problem = $db->getUserProblem($userName, $setID, $probID); + foreach my $probID (@probIDs) { + my $problem = $db->getUserProblem($userName, $setID, $probID); - return "There was an error accessing that problem." unless $problem; + return "There was an error accessing that problem." unless $problem; - #Add .5 to grade with max of 1 + #Add .5 to grade with max of 1 - if ($problem->status < .5) { - $problem->status($problem->status + .5); - } else { - $problem->status(1); - } + if ($problem->status < .5) { + $problem->status($problem->status + .5); + } else { + $problem->status(1); + } - $db->putUserProblem($problem); - } + $db->putUserProblem($problem); + } - $globalData->{$self->{id}}--; - $globalUserAchievement->frozen_hash(nfreeze_base64($globalData)); - $db->putGlobalUserAchievement($globalUserAchievement); + $globalData->{ $self->{id} }--; + $globalUserAchievement->frozen_hash(nfreeze_base64($globalData)); + $db->putGlobalUserAchievement($globalUserAchievement); - return; + return; } #Item to give full credit on a single problem @@ -1054,18 +1055,18 @@ our @ISA = qw(WeBWorK::AchievementItems); use WeBWorK::Utils qw(sortByName before after between x nfreeze_base64 thaw_base64 format_set_name_display); sub new { - my $class = shift; - my %options = @_; - - my $self = { - id => "FullCreditProb", - name => x("Greater Rod of Revelation"), - description => x("Gives full credit on a single homework problem."), - %options, - }; - - bless($self, $class); - return $self; + my $class = shift; + my %options = @_; + + my $self = { + id => "FullCreditProb", + name => x("Greater Rod of Revelation"), + description => x("Gives full credit on a single homework problem."), + %options, + }; + + bless($self, $class); + return $self; } sub print_form { @@ -1124,44 +1125,44 @@ sub print_form { } sub use_item { - my $self = shift; - my $userName = shift; - my $r = shift; - my $db = $r->db; - my $ce = $r->ce; + my $self = shift; + my $userName = shift; + my $r = shift; + my $db = $r->db; + my $ce = $r->ce; - #validate data + #validate data - my $globalUserAchievement = $db->getGlobalUserAchievement($userName); - return "No achievement data?!?!?!" - unless ($globalUserAchievement->frozen_hash); - my $globalData = thaw_base64($globalUserAchievement->frozen_hash); + my $globalUserAchievement = $db->getGlobalUserAchievement($userName); + return "No achievement data?!?!?!" + unless ($globalUserAchievement->frozen_hash); + my $globalData = thaw_base64($globalUserAchievement->frozen_hash); - return "You are $self->{id} trying to use an item you don't have" unless - ($globalData->{$self->{id}}); + return "You are $self->{id} trying to use an item you don't have" + unless ($globalData->{ $self->{id} }); - my $setID = $r->param('fcp_set_id'); - return "You need to input a Set Name" unless - (defined $setID); - my $problemID = $r->param('fcp_problem_id'); - return "You need to input a Problem Number" unless - ($problemID); + my $setID = $r->param('fcp_set_id'); + return "You need to input a Set Name" + unless (defined $setID); + my $problemID = $r->param('fcp_problem_id'); + return "You need to input a Problem Number" + unless ($problemID); - my $problem = $db->getUserProblem($userName, $setID, $problemID); + my $problem = $db->getUserProblem($userName, $setID, $problemID); - return "There was an error accessing that problem." unless $problem; + return "There was an error accessing that problem." unless $problem; - #set status of the file to one. + #set status of the file to one. - $problem->status(1); + $problem->status(1); - $db->putUserProblem($problem); + $db->putUserProblem($problem); - $globalData->{$self->{id}}--; - $globalUserAchievement->frozen_hash(nfreeze_base64($globalData)); - $db->putGlobalUserAchievement($globalUserAchievement); + $globalData->{ $self->{id} }--; + $globalUserAchievement->frozen_hash(nfreeze_base64($globalData)); + $db->putGlobalUserAchievement($globalUserAchievement); - return; + return; } #Item to give half credit on all problems in a homework set. @@ -1171,34 +1172,33 @@ our @ISA = qw(WeBWorK::AchievementItems); use WeBWorK::Utils qw(sortByName before after between x nfreeze_base64 thaw_base64 format_set_name_display); sub new { - my $class = shift; - my %options = @_; - - my $self = { - id => "FullCreditSet", - name => x("Greater Tome of Enlightenment"), - description => x("Gives full credit on every problem in a set."), - %options, - }; - - bless($self, $class); - return $self; + my $class = shift; + my %options = @_; + + my $self = { + id => "FullCreditSet", + name => x("Greater Tome of Enlightenment"), + description => x("Gives full credit on every problem in a set."), + %options, + }; + + bless($self, $class); + return $self; } sub print_form { - my $self = shift; - my $sets = shift; - my $setProblemCount = shift; - my $r = shift; - - my @openSets; - my @openSetCount; - my $maxProblems=0; + my $self = shift; + my $sets = shift; + my $setProblemCount = shift; + my $r = shift; - for (my $i=0; $i<=$#$sets; $i++) { - push(@openSets,$$sets[$i]->set_id); - } + my @openSets; + my @openSetCount; + my $maxProblems = 0; + for (my $i = 0; $i <= $#$sets; $i++) { + push(@openSets, $$sets[$i]->set_id); + } # print form with sets return join( @@ -1215,45 +1215,45 @@ sub print_form { } sub use_item { - my $self = shift; - my $userName = shift; - my $r = shift; - my $db = $r->db; - my $ce = $r->ce; + my $self = shift; + my $userName = shift; + my $r = shift; + my $db = $r->db; + my $ce = $r->ce; - #validate data + #validate data - my $globalUserAchievement = $db->getGlobalUserAchievement($userName); - return "No achievement data?!?!?!" - unless ($globalUserAchievement->frozen_hash); - my $globalData = thaw_base64($globalUserAchievement->frozen_hash); + my $globalUserAchievement = $db->getGlobalUserAchievement($userName); + return "No achievement data?!?!?!" + unless ($globalUserAchievement->frozen_hash); + my $globalData = thaw_base64($globalUserAchievement->frozen_hash); - return "You are $self->{id} trying to use an item you don't have" unless - ($globalData->{$self->{id}}); + return "You are $self->{id} trying to use an item you don't have" + unless ($globalData->{ $self->{id} }); - my $setID = $r->param('fcs_set_id'); - return "You need to input a Set Name" unless - (defined $setID); + my $setID = $r->param('fcs_set_id'); + return "You need to input a Set Name" + unless (defined $setID); - # go through the problems in the set - my @probIDs = $db->listUserProblems($userName,$setID); + # go through the problems in the set + my @probIDs = $db->listUserProblems($userName, $setID); - foreach my $probID (@probIDs) { - my $problem = $db->getUserProblem($userName, $setID, $probID); + foreach my $probID (@probIDs) { + my $problem = $db->getUserProblem($userName, $setID, $probID); - return "There was an error accessing that problem." unless $problem; + return "There was an error accessing that problem." unless $problem; - # set status to 1 - $problem->status(1); + # set status to 1 + $problem->status(1); - $db->putUserProblem($problem); - } + $db->putUserProblem($problem); + } - $globalData->{$self->{id}}--; - $globalUserAchievement->frozen_hash(nfreeze_base64($globalData)); - $db->putGlobalUserAchievement($globalUserAchievement); + $globalData->{ $self->{id} }--; + $globalUserAchievement->frozen_hash(nfreeze_base64($globalData)); + $db->putGlobalUserAchievement($globalUserAchievement); - return; + return; } #Item to turn one problem into another problem @@ -1263,18 +1263,18 @@ our @ISA = qw(WeBWorK::AchievementItems); use WeBWorK::Utils qw(sortByName before after between x nfreeze_base64 thaw_base64 format_set_name_display); sub new { - my $class = shift; - my %options = @_; - - my $self = { - id => "DuplicateProb", - name => x("Box of Transmogrification"), - description => x("Causes a homework problem to become a clone of another problem from the same set."), - %options, - }; - - bless($self, $class); - return $self; + my $class = shift; + my %options = @_; + + my $self = { + id => "DuplicateProb", + name => x("Box of Transmogrification"), + description => x("Causes a homework problem to become a clone of another problem from the same set."), + %options, + }; + + bless($self, $class); + return $self; } sub print_form { @@ -1350,51 +1350,51 @@ sub print_form { } sub use_item { - my $self = shift; - my $userName = shift; - my $r = shift; - my $db = $r->db; - my $ce = $r->ce; - - #validate data - - my $globalUserAchievement = $db->getGlobalUserAchievement($userName); - return "No achievement data?!?!?!" - unless ($globalUserAchievement->frozen_hash); - my $globalData = thaw_base64($globalUserAchievement->frozen_hash); - - return "You are $self->{id} trying to use an item you don't have" unless - ($globalData->{$self->{id}}); - - my $setID = $r->param('tran_set_id'); - return "You need to input a Set Name" unless - (defined $setID); - my $problemID = $r->param('tran_problem_id'); - return "You need to input a Problem Number" unless - ($problemID); - my $problemID2 = $r->param('tran_problem_id2'); - return "You need to input a Problem Number" unless - ($problemID2); + my $self = shift; + my $userName = shift; + my $r = shift; + my $db = $r->db; + my $ce = $r->ce; + + #validate data + + my $globalUserAchievement = $db->getGlobalUserAchievement($userName); + return "No achievement data?!?!?!" + unless ($globalUserAchievement->frozen_hash); + my $globalData = thaw_base64($globalUserAchievement->frozen_hash); + + return "You are $self->{id} trying to use an item you don't have" + unless ($globalData->{ $self->{id} }); + + my $setID = $r->param('tran_set_id'); + return "You need to input a Set Name" + unless (defined $setID); + my $problemID = $r->param('tran_problem_id'); + return "You need to input a Problem Number" + unless ($problemID); + my $problemID2 = $r->param('tran_problem_id2'); + return "You need to input a Problem Number" + unless ($problemID2); + + return "You need to pick 2 different problems!" + if ($problemID == $problemID2); + + my $problem = $db->getMergedProblem($userName, $setID, $problemID); + my $problem2 = $db->getUserProblem($userName, $setID, $problemID2); - return "You need to pick 2 different problems!" if - ($problemID == $problemID2); - - my $problem = $db->getMergedProblem($userName, $setID, $problemID); - my $problem2 = $db->getUserProblem($userName, $setID, $problemID2); - - return "There was an error accessing that problem." unless $problem; + return "There was an error accessing that problem." unless $problem; - #set the source of the second problem to that of the first problem. + #set the source of the second problem to that of the first problem. - $problem2->source_file($problem->source_file); + $problem2->source_file($problem->source_file); - $db->putUserProblem($problem2); + $db->putUserProblem($problem2); - $globalData->{$self->{id}}--; - $globalUserAchievement->frozen_hash(nfreeze_base64($globalData)); - $db->putGlobalUserAchievement($globalUserAchievement); + $globalData->{ $self->{id} }--; + $globalUserAchievement->frozen_hash(nfreeze_base64($globalData)); + $db->putGlobalUserAchievement($globalUserAchievement); - return; + return; } #Item to print a suprise message @@ -1404,49 +1404,50 @@ our @ISA = qw(WeBWorK::AchievementItems); use WeBWorK::Utils qw(sortByName before after between x nfreeze_base64 thaw_base64); sub new { - my $class = shift; - my %options = @_; - - my $self = { - id => "Surprise", - name => x("Mysterious Package (with Ribbons)"), - description => x("What could be inside?"), - %options, - }; - - bless($self, $class); - return $self; + my $class = shift; + my %options = @_; + + my $self = { + id => "Surprise", + name => x("Mysterious Package (with Ribbons)"), + description => x("What could be inside?"), + %options, + }; + + bless($self, $class); + return $self; } sub print_form { - my $self = shift; - my $sets = shift; - my $setProblemCount = shift; - my $r = shift; + my $self = shift; + my $sets = shift; + my $setProblemCount = shift; + my $r = shift; - # the form opens the file "suprise_message.txt" in the achievements - # folder and then prints the contetnts of the file. + # the form opens the file "suprise_message.txt" in the achievements + # folder and then prints the contetnts of the file. - my $sourceFilePath = $r->{ce}->{courseDirs}->{achievements}.'/surprise_message.txt'; + my $sourceFilePath = $r->{ce}->{courseDirs}->{achievements} . '/surprise_message.txt'; - open MESSAGE, $sourceFilePath or return CGI::p($r->maketext("I couldn't find the file [ACHEVDIR]/surprise_message.txt!")); + open MESSAGE, $sourceFilePath + or return CGI::p($r->maketext("I couldn't find the file [ACHEVDIR]/surprise_message.txt!")); - my @message = ; + my @message = ; - return CGI::div(@message); + return CGI::div(@message); } sub use_item { - my $self = shift; - my $userName = shift; - my $r = shift; - my $db = $r->db; - my $ce = $r->ce; + my $self = shift; + my $userName = shift; + my $r = shift; + my $db = $r->db; + my $ce = $r->ce; - #doesn't do anything + #doesn't do anything - return; + return; } #Item to allow students to take an addition test @@ -1456,53 +1457,56 @@ our @ISA = qw(WeBWorK::AchievementItems); use WeBWorK::Utils qw(sortByName before after between x nfreeze_base64 thaw_base64 format_set_name_display); sub new { - my $class = shift; - my %options = @_; - - my $self = { - id => "AddNewTestGW", - name => x("Oil of Cleansing"), - description => x("Unlock an additional version of a Gateway Test. If used before the close date of the Gateway Test this will allow you to generate a new version of the test."), - %options, - }; - - bless($self, $class); - return $self; + my $class = shift; + my %options = @_; + + my $self = { + id => "AddNewTestGW", + name => x("Oil of Cleansing"), + description => x( + "Unlock an additional version of a Gateway Test. If used before the close date of the Gateway Test this will allow you to generate a new version of the test." + ), + %options, + }; + + bless($self, $class); + return $self; } sub print_form { - my $self = shift; - my $sets = shift; - my $setProblemCount = shift; - my $r = shift; - my $db = $r->db; - - my $userName = $r->param('user'); - my $effectiveUserName = defined($r->param('effectiveUser') ) ? $r->param('effectiveUser') : $userName; - my @setIDs = $db->listUserSets($effectiveUserName); - my @userSetIDs = map {[$effectiveUserName, $_]} @setIDs; - my @unfilteredsets = $db->getMergedSets(@userSetIDs); - my @sets; - - # we going to have to find the gateways for these achievements. - # we don't want the versioned gateways though. - foreach my $set (@unfilteredsets) { - if ($set->assignment_type() =~ /gateway/ && - $set->set_id !~ /,v\d+$/) { - push @sets, $set; + my $self = shift; + my $sets = shift; + my $setProblemCount = shift; + my $r = shift; + my $db = $r->db; + + my $userName = $r->param('user'); + my $effectiveUserName = defined($r->param('effectiveUser')) ? $r->param('effectiveUser') : $userName; + my @setIDs = $db->listUserSets($effectiveUserName); + my @userSetIDs = map { [ $effectiveUserName, $_ ] } @setIDs; + my @unfilteredsets = $db->getMergedSets(@userSetIDs); + my @sets; + + # we going to have to find the gateways for these achievements. + # we don't want the versioned gateways though. + foreach my $set (@unfilteredsets) { + if ($set->assignment_type() =~ /gateway/ + && $set->set_id !~ /,v\d+$/) + { + push @sets, $set; + } } - } - # now we need to find out which gateways are open - my @openGateways; + # now we need to find out which gateways are open + my @openGateways; - foreach my $set (@sets) { - if (between($set->open_date, $set->due_date)) { - push @openGateways, $set->set_id; + foreach my $set (@sets) { + if (between($set->open_date, $set->due_date)) { + push @openGateways, $set->set_id; + } } - } - #print open gateways in a drop down. + #print open gateways in a drop down. return join( '', @@ -1518,43 +1522,41 @@ sub print_form { } sub use_item { - my $self = shift; - my $userName = shift; - my $r = shift; - my $db = $r->db; - my $ce = $r->ce; - - #validate data - my $globalUserAchievement = $db->getGlobalUserAchievement($userName); - return "No achievement data?!?!?!" - unless ($globalUserAchievement->frozen_hash); - my $globalData = thaw_base64($globalUserAchievement->frozen_hash); - - return "You are $self->{id} trying to use an item you don't have" unless - ($globalData->{$self->{id}}); + my $self = shift; + my $userName = shift; + my $r = shift; + my $db = $r->db; + my $ce = $r->ce; - my $setID = $r->param('adtgw_gw_id'); - return "You need to input a Gateway Name" unless - (defined $setID); + #validate data + my $globalUserAchievement = $db->getGlobalUserAchievement($userName); + return "No achievement data?!?!?!" + unless ($globalUserAchievement->frozen_hash); + my $globalData = thaw_base64($globalUserAchievement->frozen_hash); - my $set = $db->getMergedSet($userName,$setID); - return "Couldn't find that set!" unless - ($set); + return "You are $self->{id} trying to use an item you don't have" + unless ($globalData->{ $self->{id} }); - my $userSet = $db->getUserSet($userName,$setID); + my $setID = $r->param('adtgw_gw_id'); + return "You need to input a Gateway Name" + unless (defined $setID); - $userSet->versions_per_interval($set->versions_per_interval()+1) - unless ($set->versions_per_interval() == 0); + my $set = $db->getMergedSet($userName, $setID); + return "Couldn't find that set!" + unless ($set); - $db->putUserSet($userSet); + my $userSet = $db->getUserSet($userName, $setID); - $globalData->{$self->{id}}--; - $globalUserAchievement->frozen_hash(nfreeze_base64($globalData)); - $db->putGlobalUserAchievement($globalUserAchievement); + $userSet->versions_per_interval($set->versions_per_interval() + 1) + unless ($set->versions_per_interval() == 0); + $db->putUserSet($userSet); + $globalData->{ $self->{id} }--; + $globalUserAchievement->frozen_hash(nfreeze_base64($globalData)); + $db->putGlobalUserAchievement($globalUserAchievement); - return; + return; } #Item to extend the due date on a gateway @@ -1564,53 +1566,56 @@ our @ISA = qw(WeBWorK::AchievementItems); use WeBWorK::Utils qw(sortByName before after between x nfreeze_base64 thaw_base64 format_set_name_display); sub new { - my $class = shift; - my %options = @_; - - my $self = { - id => "ExtendDueDateGW", - name => x("Amulet of Extension"), - description => x("Extends the close date of a gateway test by 24 hours. Note: The test must still be open for this to work."), - %options, - }; - - bless($self, $class); - return $self; + my $class = shift; + my %options = @_; + + my $self = { + id => "ExtendDueDateGW", + name => x("Amulet of Extension"), + description => x( + "Extends the close date of a gateway test by 24 hours. Note: The test must still be open for this to work." + ), + %options, + }; + + bless($self, $class); + return $self; } sub print_form { - my $self = shift; - my $sets = shift; - my $setProblemCount = shift; - my $r = shift; - my $db = $r->db; - - my $userName = $r->param('user'); - my $effectiveUserName = defined($r->param('effectiveUser') ) ? $r->param('effectiveUser') : $userName; - my @setIDs = $db->listUserSets($effectiveUserName); - my @userSetIDs = map {[$effectiveUserName, $_]} @setIDs; - my @unfilteredsets = $db->getMergedSets(@userSetIDs); - my @sets; - - # we going to have to find the gateways for these achievements. - # we don't want the versioned gateways though. - foreach my $set (@unfilteredsets) { - if ($set->assignment_type() =~ /gateway/ && - $set->set_id !~ /,v\d+$/) { - push @sets, $set; + my $self = shift; + my $sets = shift; + my $setProblemCount = shift; + my $r = shift; + my $db = $r->db; + + my $userName = $r->param('user'); + my $effectiveUserName = defined($r->param('effectiveUser')) ? $r->param('effectiveUser') : $userName; + my @setIDs = $db->listUserSets($effectiveUserName); + my @userSetIDs = map { [ $effectiveUserName, $_ ] } @setIDs; + my @unfilteredsets = $db->getMergedSets(@userSetIDs); + my @sets; + + # we going to have to find the gateways for these achievements. + # we don't want the versioned gateways though. + foreach my $set (@unfilteredsets) { + if ($set->assignment_type() =~ /gateway/ + && $set->set_id !~ /,v\d+$/) + { + push @sets, $set; + } } - } - # now we need to find out which gateways are open - my @openGateways; + # now we need to find out which gateways are open + my @openGateways; - foreach my $set (@sets) { - if (between($set->open_date, $set->due_date)) { - push @openGateways, $set->set_id; + foreach my $set (@sets) { + if (between($set->open_date, $set->due_date)) { + push @openGateways, $set->set_id; + } } - } - # Print open gateways in a drop down. + # Print open gateways in a drop down. return join( '', CGI::p($r->maketext('Extend the close date for which Gateway?')), @@ -1625,55 +1630,57 @@ sub print_form { } sub use_item { - my $self = shift; - my $userName = shift; - my $r = shift; - my $db = $r->db; - my $ce = $r->ce; - - #validate data - my $globalUserAchievement = $db->getGlobalUserAchievement($userName); - return "No achievement data?!?!?!" - unless ($globalUserAchievement->frozen_hash); - my $globalData = thaw_base64($globalUserAchievement->frozen_hash); - - return "You are $self->{id} trying to use an item you don't have" unless - ($globalData->{$self->{id}}); - - my $setID = $r->param('eddgw_gw_id'); - return "You need to input a Gateway Name" unless - (defined $setID); - - my $set = $db->getMergedSet($userName,$setID); - return "Couldn't find that set!" unless - ($set); - my $userSet = $db->getUserSet($userName,$setID); - - #add time to the reduced scoring date, due date, and answer date - $userSet->reduced_scoring_date($set->reduced_scoring_date()+86400) if defined($set->reduced_scoring_date()) && $set->reduced_scoring_date(); - $userSet->due_date($set->due_date()+86400); - $userSet->answer_date($set->answer_date()+86400); - - $db->putUserSet($userSet); - - #add time to the reduced scoring date, due date, and answer date of various versions - my @versions = $db->listSetVersions($userName,$setID); - - foreach my $version (@versions) { + my $self = shift; + my $userName = shift; + my $r = shift; + my $db = $r->db; + my $ce = $r->ce; + + #validate data + my $globalUserAchievement = $db->getGlobalUserAchievement($userName); + return "No achievement data?!?!?!" + unless ($globalUserAchievement->frozen_hash); + my $globalData = thaw_base64($globalUserAchievement->frozen_hash); + + return "You are $self->{id} trying to use an item you don't have" + unless ($globalData->{ $self->{id} }); + + my $setID = $r->param('eddgw_gw_id'); + return "You need to input a Gateway Name" + unless (defined $setID); + + my $set = $db->getMergedSet($userName, $setID); + return "Couldn't find that set!" + unless ($set); + my $userSet = $db->getUserSet($userName, $setID); + + #add time to the reduced scoring date, due date, and answer date + $userSet->reduced_scoring_date($set->reduced_scoring_date() + 86400) + if defined($set->reduced_scoring_date()) && $set->reduced_scoring_date(); + $userSet->due_date($set->due_date() + 86400); + $userSet->answer_date($set->answer_date() + 86400); + + $db->putUserSet($userSet); + + #add time to the reduced scoring date, due date, and answer date of various versions + my @versions = $db->listSetVersions($userName, $setID); + + foreach my $version (@versions) { + + $set = $db->getSetVersion($userName, $setID, $version); + $set->reduced_scoring_date($set->reduced_scoring_date() + 86400) + if defined($set->reduced_scoring_date()) && $set->reduced_scoring_date(); + $set->due_date($set->due_date() + 86400); + $set->answer_date($set->answer_date() + 86400); + $db->putSetVersion($set); - $set = $db->getSetVersion($userName,$setID,$version); - $set->reduced_scoring_date($set->reduced_scoring_date()+86400) if defined($set->reduced_scoring_date()) && $set->reduced_scoring_date(); - $set->due_date($set->due_date()+86400); - $set->answer_date($set->answer_date()+86400); - $db->putSetVersion($set); - - } + } - $globalData->{$self->{id}}--; - $globalUserAchievement->frozen_hash(nfreeze_base64($globalData)); - $db->putGlobalUserAchievement($globalUserAchievement); + $globalData->{ $self->{id} }--; + $globalUserAchievement->frozen_hash(nfreeze_base64($globalData)); + $db->putGlobalUserAchievement($globalUserAchievement); - return; + return; } #Item to extend the due date on a gateway @@ -1683,43 +1690,46 @@ our @ISA = qw(WeBWorK::AchievementItems); use WeBWorK::Utils qw(sortByName before after between x nfreeze_base64 thaw_base64 format_set_name_display); sub new { - my $class = shift; - my %options = @_; - - my $self = { - id => "ResurrectGW", - name => x("Necromancers Charm"), - description => x("Reopens any gateway test for an additional 24 hours. This allows you to take a test even if the close date has past. This item does not allow you to take additional versions of the test."), - %options, - }; - - bless($self, $class); - return $self; + my $class = shift; + my %options = @_; + + my $self = { + id => "ResurrectGW", + name => x("Necromancers Charm"), + description => x( + "Reopens any gateway test for an additional 24 hours. This allows you to take a test even if the close date has past. This item does not allow you to take additional versions of the test." + ), + %options, + }; + + bless($self, $class); + return $self; } sub print_form { - my $self = shift; - my $sets = shift; - my $setProblemCount = shift; - my $r = shift; - my $db = $r->db; - - my $userName = $r->param('user'); - my $effectiveUserName = defined($r->param('effectiveUser') ) ? $r->param('effectiveUser') : $userName; - my @setIDs = $db->listUserSets($effectiveUserName); - my @userSetIDs = map {[$effectiveUserName, $_]} @setIDs; - my @unfilteredsets = $db->getMergedSets(@userSetIDs); - my @sets; - - # we going to have to find the gateways for these achievements. - foreach my $set (@unfilteredsets) { - if ($set->assignment_type() =~ /gateway/ && - $set->set_id !~ /,v\d+$/) { - push @sets, $set->set_id; + my $self = shift; + my $sets = shift; + my $setProblemCount = shift; + my $r = shift; + my $db = $r->db; + + my $userName = $r->param('user'); + my $effectiveUserName = defined($r->param('effectiveUser')) ? $r->param('effectiveUser') : $userName; + my @setIDs = $db->listUserSets($effectiveUserName); + my @userSetIDs = map { [ $effectiveUserName, $_ ] } @setIDs; + my @unfilteredsets = $db->getMergedSets(@userSetIDs); + my @sets; + + # we going to have to find the gateways for these achievements. + foreach my $set (@unfilteredsets) { + if ($set->assignment_type() =~ /gateway/ + && $set->set_id !~ /,v\d+$/) + { + push @sets, $set->set_id; + } } - } - # Print gateways in a drop down. + # Print gateways in a drop down. return join( '', CGI::p($r->maketext('Resurrect which Gateway?')), @@ -1734,42 +1744,41 @@ sub print_form { } sub use_item { - my $self = shift; - my $userName = shift; - my $r = shift; - my $db = $r->db; - my $ce = $r->ce; + my $self = shift; + my $userName = shift; + my $r = shift; + my $db = $r->db; + my $ce = $r->ce; - #validate data - my $globalUserAchievement = $db->getGlobalUserAchievement($userName); - return "No achievement data?!?!?!" - unless ($globalUserAchievement->frozen_hash); - my $globalData = thaw_base64($globalUserAchievement->frozen_hash); + #validate data + my $globalUserAchievement = $db->getGlobalUserAchievement($userName); + return "No achievement data?!?!?!" + unless ($globalUserAchievement->frozen_hash); + my $globalData = thaw_base64($globalUserAchievement->frozen_hash); - return "You are $self->{id} trying to use an item you don't have" unless - ($globalData->{$self->{id}}); + return "You are $self->{id} trying to use an item you don't have" + unless ($globalData->{ $self->{id} }); - my $setID = $r->param('resgw_gw_id'); - return "You need to input a Gateway Name" unless - (defined $setID); + my $setID = $r->param('resgw_gw_id'); + return "You need to input a Gateway Name" + unless (defined $setID); - my $set = $db->getUserSet($userName,$setID); - return "Couldn't find that set!" unless - ($set); + my $set = $db->getUserSet($userName, $setID); + return "Couldn't find that set!" + unless ($set); - #add time to the reduced scoring date, due date, and answer date; remove item from inventory - $set->reduced_scoring_date(time()+86400) if defined($set->reduced_scoring_date()) && $set->reduced_scoring_date(); - $set->due_date(time()+86400); - $set->answer_date(time()+86400); + #add time to the reduced scoring date, due date, and answer date; remove item from inventory + $set->reduced_scoring_date(time() + 86400) if defined($set->reduced_scoring_date()) && $set->reduced_scoring_date(); + $set->due_date(time() + 86400); + $set->answer_date(time() + 86400); - $db->putUserSet($set); + $db->putUserSet($set); - $globalData->{$self->{id}}--; - $globalUserAchievement->frozen_hash(nfreeze_base64($globalData)); - $db->putGlobalUserAchievement($globalUserAchievement); + $globalData->{ $self->{id} }--; + $globalUserAchievement->frozen_hash(nfreeze_base64($globalData)); + $db->putGlobalUserAchievement($globalUserAchievement); - return; + return; } - 1; diff --git a/lib/WeBWorK/Authen.pm b/lib/WeBWorK/Authen.pm index 0507845bf9..c00f2737d3 100644 --- a/lib/WeBWorK/Authen.pm +++ b/lib/WeBWorK/Authen.pm @@ -52,7 +52,7 @@ use warnings; use version; use WeBWorK::Cookie; use Date::Format; -use Socket qw/unpack_sockaddr_in inet_ntoa/; # for logging +use Socket qw/unpack_sockaddr_in inet_ntoa/; # for logging use WeBWorK::Debug; use WeBWorK::Utils qw/writeCourseLog runtime_use/; use WeBWorK::Localize; @@ -72,7 +72,7 @@ use Caliper::Entity; ## If GENERIC_ERROR_MESSAGE is constant, we can't translate it #use vars qw($GENERIC_ERROR_MESSAGE); -our $GENERIC_ERROR_MESSAGE = ""; # define in new +our $GENERIC_ERROR_MESSAGE = ""; # define in new ## WeBWorK-tr end modification ##################### @@ -101,26 +101,28 @@ sub class { if (exists $ce->{authen}{$type}) { if (ref $ce->{authen}{$type} eq "ARRAY") { - my $authen_type = shift @{$ce ->{authen}{$type}}; + my $authen_type = shift @{ $ce->{authen}{$type} }; #debug("ref of authen_type = |" . ref($authen_type) . "|"); - if (ref ($authen_type) eq "HASH") { - if (exists $authen_type->{$ce->{dbLayoutName}}) { - return $authen_type->{$ce->{dbLayoutName}}; + if (ref($authen_type) eq "HASH") { + if (exists $authen_type->{ $ce->{dbLayoutName} }) { + return $authen_type->{ $ce->{dbLayoutName} }; } elsif (exists $authen_type->{"*"}) { return $authen_type->{"*"}; } else { - die "authentication type '$type' in the course environment has no entry for db layout '", $ce->{dbLayoutName}, "' and no default entry (*)"; + die "authentication type '$type' in the course environment has no entry for db layout '", + $ce->{dbLayoutName}, "' and no default entry (*)"; } } else { - return $authen_type; + return $authen_type; } } elsif (ref $ce->{authen}{$type} eq "HASH") { - if (exists $ce->{authen}{$type}{$ce->{dbLayoutName}}) { - return $ce->{authen}{$type}{$ce->{dbLayoutName}}; + if (exists $ce->{authen}{$type}{ $ce->{dbLayoutName} }) { + return $ce->{authen}{$type}{ $ce->{dbLayoutName} }; } elsif (exists $ce->{authen}{$type}{"*"}) { return $ce->{authen}{$type}{"*"}; } else { - die "authentication type '$type' in the course environment has no entry for db layout '", $ce->{dbLayoutName}, "' and no default entry (*)"; + die "authentication type '$type' in the course environment has no entry for db layout '", + $ce->{dbLayoutName}, "' and no default entry (*)"; } } else { return $ce->{authen}{$type}; @@ -132,26 +134,26 @@ sub class { sub call_next_authen_method { my $self = shift; - my $r = $self -> {r}; - my $ce = $r -> {ce}; + my $r = $self->{r}; + my $ce = $r->{ce}; my $user_authen_module = WeBWorK::Authen::class($ce, "user_module"); #debug("user_authen_module = |$user_authen_module|"); if (!defined($user_authen_module) or ($user_authen_module eq "")) { - $self->{error} = $r->maketext("No authentication method found for your request. If this recurs, please speak with your instructor."); + $self->{error} = $r->maketext( + "No authentication method found for your request. If this recurs, please speak with your instructor."); $self->{log_error} .= "None of the specified authentication modules could handle the request."; - return(0); + return (0); } else { runtime_use $user_authen_module; my $authen = $user_authen_module->new($r); #debug("Using user_authen_module $user_authen_module: $authen\n"); $r->authen($authen); - return $authen -> verify; + return $authen->verify; } } - =back =cut @@ -169,10 +171,8 @@ Instantiates a new WeBWorK::Authen object for the given WeBWorK::Requst ($r). sub new { my ($invocant, $r) = @_; my $class = ref($invocant) || $invocant; - my $self = { - r => $r, - }; - weaken $self -> {r}; + my $self = { r => $r, }; + weaken $self->{r}; #initialize $GENERIC_ERROR_MESSAGE = $r->maketext("Invalid user ID or password."); bless $self, $class; @@ -189,22 +189,22 @@ sub new { =cut -sub request_has_data_for_this_verification_module { +sub request_has_data_for_this_verification_module { #debug("Authen::request_has_data_for_this_verification_module will return a 1"); - return(1); + return (1); } sub verify { debug("BEGIN VERIFY"); my $self = shift; - my $r = $self->{r}; + my $r = $self->{r}; - if (! ($self-> request_has_data_for_this_verification_module)) { - return ( $self -> call_next_authen_method()); + if (!($self->request_has_data_for_this_verification_module)) { + return ($self->call_next_authen_method()); } - my $result = $self->do_verify; - my $error = $self->{error}; + my $result = $self->do_verify; + my $error = $self->{error}; my $log_error = $self->{log_error}; $self->{was_verified} = $result ? 1 : 0; @@ -221,16 +221,18 @@ sub verify { if (defined $log_error) { $self->write_log_entry("LOGIN FAILED $log_error"); } - if (defined($error) and $error=~/\S/) { # if error message has a least one non-space character. - if ( defined( $log_error ) and $log_error eq "inactivity timeout" ) { + if (defined($error) and $error =~ /\S/) { # if error message has a least one non-space character. + if (defined($log_error) and $log_error eq "inactivity timeout") { # We don't want to override the localized inactivity timeout message. # so do not check next "if" in this case. } elsif (defined($r->param("user")) or defined($r->param("user_id"))) { - $error = $r->maketext("Your authentication failed. Please try again. Please speak with your instructor if you need help.") + $error = $r->maketext( + "Your authentication failed. Please try again. Please speak with your instructor if you need help." + ); } } - #warn "LOGIN FAILED: log_error: $log_error; user error: $error"; + #warn "LOGIN FAILED: log_error: $log_error; user error: $error"; $self->maybe_kill_cookie; # if error message has a least one non-space character. if (defined($error) and $error =~ /\S/ and $r->can('notes')) { @@ -242,10 +244,10 @@ sub verify { my $caliper_sensor = Caliper::Sensor->new($self->{r}->ce); if ($caliper_sensor->caliperEnabled() && $result && $self->{initial_login}) { my $login_event = { - 'type' => 'SessionEvent', - 'action' => 'LoggedIn', + 'type' => 'SessionEvent', + 'action' => 'LoggedIn', 'profile' => 'SessionProfile', - 'object' => Caliper::Entity::webwork_app() + 'object' => Caliper::Entity::webwork_app() }; $caliper_sensor->sendEvents($self->{r}, [$login_event]); } @@ -276,8 +278,8 @@ Future calls to was_verified() will return false, until verify() is called again sub forget_verification { my ($self) = @_; - my $r = $self -> {r}; - my $ce = $r -> {ce}; + my $r = $self->{r}; + my $ce = $r->{ce}; $self->{was_verified} = 0; @@ -293,41 +295,41 @@ sub forget_verification { sub do_verify { my $self = shift; - my $r = $self->{r}; - my $ce = $r->ce; - my $db = $r->db; + my $r = $self->{r}; + my $ce = $r->ce; + my $db = $r->db; return 0 unless $db; debug("db ok"); return 0 unless $self->get_credentials; debug("credentials ok"); return 0 unless $self->check_user; - debug ("check user ok"); - if (defined($self->{login_type}) && $self->{login_type} eq "guest"){ + debug("check user ok"); + if (defined($self->{login_type}) && $self->{login_type} eq "guest") { return $self->verify_practice_user; } else { return $self->verify_normal_user; } } -sub trim { # used to trim leading and trailing white space from user_id and password - # in get_credentials - my $s = shift; - # If the value was NOT defined, we want to leave it undefined, so - # we can still catch session-timeouts and report them properly. - # Thus we only do the following substitution if $s is defined. - # Otherwise return the undefined value so a non-defined password - # can be caught later by authenticate() for the case of a - # session-timeout. - $s =~ s/(^\s+|\s+$)//g if ( defined($s) ); - return $s; +sub trim { # used to trim leading and trailing white space from user_id and password + # in get_credentials + my $s = shift; + # If the value was NOT defined, we want to leave it undefined, so + # we can still catch session-timeouts and report them properly. + # Thus we only do the following substitution if $s is defined. + # Otherwise return the undefined value so a non-defined password + # can be caught later by authenticate() for the case of a + # session-timeout. + $s =~ s/(^\s+|\s+$)//g if (defined($s)); + return $s; } sub get_credentials { my ($self) = @_; - my $r = $self->{r}; - my $ce = $r->ce; - my $db = $r->db; + my $r = $self->{r}; + my $ce = $r->ce; + my $db = $r->db; debug("self is $self "); # allow guest login: if the "Guest Login" button was clicked, we find an unused # practice user and create a session for it. @@ -342,103 +344,110 @@ sub get_credentials { my $newKey = $self->create_session($userID); $self->{initial_login} = 1; - $self->{user_id} = $userID; - $self->{session_key} = $newKey; - $self->{login_type} = "guest"; + $self->{user_id} = $userID; + $self->{session_key} = $newKey; + $self->{login_type} = "guest"; $self->{credential_source} = "none"; - debug("guest user '", $userID. "' key '", $newKey. "'"); + debug("guest user '", $userID . "' key '", $newKey . "'"); return 1; } } $self->{log_error} = "no guest logins are available"; - $self->{error} = $r->maketext("No guest logins are available. Please try again in a few minutes."); + $self->{error} = $r->maketext("No guest logins are available. Please try again in a few minutes."); return 0; } my ($cookieUser, $cookieKey, $cookieTimeStamp) = $self->fetchCookie; - if (defined $cookieUser and defined $r->param("user") ) { + if (defined $cookieUser and defined $r->param("user")) { if ($cookieUser ne $r->param("user")) { #croak ("cookieUser = $cookieUser and paramUser = ". $r->param("user") . " are different."); - $self->maybe_kill_cookie; # use parameter "user" rather than cookie "user"; + $self->maybe_kill_cookie; # use parameter "user" rather than cookie "user"; } -# Use session key for verification -# else use cookieKey for verification -# else use cookie user name but use password provided by request. + # Use session key for verification + # else use cookieKey for verification + # else use cookie user name but use password provided by request. if (defined $r->param("key")) { - $self->{user_id} = $r->param("user"); - $self->{session_key} = $r->param("key"); - $self->{password} = $r->param("passwd"); - $self->{login_type} = "normal"; + $self->{user_id} = $r->param("user"); + $self->{session_key} = $r->param("key"); + $self->{password} = $r->param("passwd"); + $self->{login_type} = "normal"; $self->{credential_source} = "params"; - $self->{user_id} = trim($self->{user_id}); - $self->{password} = trim($self->{password}); + $self->{user_id} = trim($self->{user_id}); + $self->{password} = trim($self->{password}); debug("params user '", $self->{user_id}, "' key '", $self->{session_key}, "'"); return 1; } elsif (defined $cookieKey) { - $self->{user_id} = $cookieUser; - $self->{session_key} = $cookieKey; - $self->{cookie_timestamp} = $cookieTimeStamp; - $self->{login_type} = "normal"; + $self->{user_id} = $cookieUser; + $self->{session_key} = $cookieKey; + $self->{cookie_timestamp} = $cookieTimeStamp; + $self->{login_type} = "normal"; $self->{credential_source} = "cookie"; - $self->{user_id} = trim($self->{user_id}); - debug( "cookie user '", $self->{user_id}, - "' key '", $self->{session_key}, - "' cookie_timestamp '", $self->{cookieTimeStamp}, "' " + $self->{user_id} = trim($self->{user_id}); + debug( + "cookie user '", + $self->{user_id}, "' key '", $self->{session_key}, + "' cookie_timestamp '", + $self->{cookieTimeStamp}, "' " ); return 1; } else { - $self->{user_id} = $cookieUser; - $self->{session_key} = $cookieKey; # will be undefined - $self->{password} = $r->param("passwd"); - $self->{cookie_timestamp} = $cookieTimeStamp; - $self->{login_type} = "normal"; + $self->{user_id} = $cookieUser; + $self->{session_key} = $cookieKey; # will be undefined + $self->{password} = $r->param("passwd"); + $self->{cookie_timestamp} = $cookieTimeStamp; + $self->{login_type} = "normal"; $self->{credential_source} = "params_and_cookie"; - $self->{user_id} = trim($self->{user_id}); - $self->{password} = trim($self->{password}); - debug( "params and cookie user '", $self->{user_id}, - "' params and cookie session key = '", $self->{session_key}, - "' cookie_timestamp '", $self->{cookieTimeStamp}, "' " + $self->{user_id} = trim($self->{user_id}); + $self->{password} = trim($self->{password}); + debug( + "params and cookie user '", + $self->{user_id}, "' params and cookie session key = '", + $self->{session_key}, + "' cookie_timestamp '", + $self->{cookieTimeStamp}, "' " ); return 1; } } # at least the user ID is available in request parameters if (defined $r->param("user")) { - $self->{user_id} = $r->param("user"); - $self->{session_key} = $r->param("key"); - $self->{password} = $r->param("passwd"); - $self->{login_type} = "normal"; + $self->{user_id} = $r->param("user"); + $self->{session_key} = $r->param("key"); + $self->{password} = $r->param("passwd"); + $self->{login_type} = "normal"; $self->{credential_source} = "params"; - $self->{user_id} = trim($self->{user_id}); - $self->{password} = trim($self->{password}); - debug("params user '", $self->{user_id}, "' key '", $self->{session_key}, "'"); + $self->{user_id} = trim($self->{user_id}); + $self->{password} = trim($self->{password}); + debug("params user '", $self->{user_id}, "' key '", $self->{session_key}, "'"); debug("params password '", $self->{password}, "' key '", $self->{session_key}, "'"); return 1; } if (defined $cookieUser) { - $self->{user_id} = $cookieUser; - $self->{session_key} = $cookieKey; - $self->{cookie_timestamp} = $cookieTimeStamp; - $self->{login_type} = "normal"; + $self->{user_id} = $cookieUser; + $self->{session_key} = $cookieKey; + $self->{cookie_timestamp} = $cookieTimeStamp; + $self->{login_type} = "normal"; $self->{credential_source} = "cookie"; - $self->{user_id} = trim($self->{user_id}); - debug( "cookie user '", $self->{user_id}, - "' key '", $self->{session_key}, - "' cookie_timestamp '", $self->{cookieTimeStamp}, "' " + $self->{user_id} = trim($self->{user_id}); + debug( + "cookie user '", + $self->{user_id}, "' key '", $self->{session_key}, + "' cookie_timestamp '", + $self->{cookieTimeStamp}, "' " ); return 1; } } sub check_user { - my $self = shift; - my $r = $self->{r}; - my $ce = $r->ce; - my $db = $r->db; + my $self = shift; + my $r = $self->{r}; + my $ce = $r->ce; + my $db = $r->db; my $authz = $r->authz; my $user_id = $self->{user_id}; @@ -453,7 +462,7 @@ sub check_user { unless ($User) { $self->{log_error} = "user unknown"; - $self->{error} = $GENERIC_ERROR_MESSAGE; + $self->{error} = $GENERIC_ERROR_MESSAGE; return 0; } @@ -461,13 +470,13 @@ sub check_user { unless ($ce->status_abbrev_has_behavior($User->status, "allow_course_access")) { $self->{log_error} = "user not allowed course access"; - $self->{error} = $GENERIC_ERROR_MESSAGE; + $self->{error} = $GENERIC_ERROR_MESSAGE; return 0; } unless ($authz->hasPermissions($user_id, "login")) { $self->{log_error} = "user not permitted to login"; - $self->{error} = $GENERIC_ERROR_MESSAGE; + $self->{error} = $GENERIC_ERROR_MESSAGE; return 0; } @@ -476,10 +485,10 @@ sub check_user { sub verify_practice_user { my $self = shift; - my $r = $self->{r}; - my $ce = $r->ce; + my $r = $self->{r}; + my $ce = $r->ce; - my $user_id = $self->{user_id}; + my $user_id = $self->{user_id}; my $session_key = $self->{session_key}; my ($sessionExists, $keyMatches, $timestampValid) = $self->check_session($user_id, $session_key, 1); @@ -490,7 +499,7 @@ sub verify_practice_user { if ($timestampValid) { return 1; } else { - $self->{session_key} = $self->create_session($user_id); + $self->{session_key} = $self->create_session($user_id); $self->{initial_login} = 1; return 1; } @@ -498,22 +507,22 @@ sub verify_practice_user { if ($timestampValid) { my $debugPracticeUser = $ce->{debugPracticeUser}; if (defined $debugPracticeUser and $user_id eq $debugPracticeUser) { - $self->{session_key} = $self->create_session($user_id); + $self->{session_key} = $self->create_session($user_id); $self->{initial_login} = 1; return 1; } else { $self->{log_error} = "guest account in use"; - $self->{error} = "That guest account is in use."; + $self->{error} = "That guest account is in use."; return 0; } } else { - $self->{session_key} = $self->create_session($user_id); + $self->{session_key} = $self->create_session($user_id); $self->{initial_login} = 1; return 1; } } } else { - $self->{session_key} = $self->create_session($user_id); + $self->{session_key} = $self->create_session($user_id); $self->{initial_login} = 1; return 1; } @@ -521,9 +530,9 @@ sub verify_practice_user { sub verify_normal_user { my $self = shift; - my $r = $self->{r}; + my $r = $self->{r}; - my $user_id = $self->{user_id}; + my $user_id = $self->{user_id}; my $session_key = $self->{session_key}; my ($sessionExists, $keyMatches, $timestampValid) = $self->check_session($user_id, $session_key, 1); @@ -535,14 +544,14 @@ sub verify_normal_user { my $auth_result = $self->authenticate; if ($auth_result > 0) { - $self->{session_key} = $self->create_session($user_id); + $self->{session_key} = $self->create_session($user_id); $self->{initial_login} = 1; return 1; } elsif ($auth_result == 0) { $self->{log_error} = "authentication failed"; - $self->{error} = $GENERIC_ERROR_MESSAGE; + $self->{error} = $GENERIC_ERROR_MESSAGE; return 0; - } else { # ($auth_result < 0) => required data was not present + } else { # ($auth_result < 0) => required data was not present if ($keyMatches and not $timestampValid) { $self->{log_error} = "inactivity timeout"; $self->{error} .= $r->maketext("Your session has timed out due to inactivity. Please log in again."); @@ -557,9 +566,9 @@ sub verify_normal_user { # -1 == required data was not present (i.e. password missing) sub authenticate { my $self = shift; - my $r = $self->{r}; + my $r = $self->{r}; - my $user_id = $self->{user_id}; + my $user_id = $self->{user_id}; my $password = $self->{password}; if (defined $password) { @@ -571,8 +580,8 @@ sub authenticate { sub maybe_send_cookie { my $self = shift; - my $r = $self->{r}; - my $ce = $r -> {ce}; + my $r = $self->{r}; + my $ce = $r->{ce}; my ($cookie_user, $cookie_key, $cookie_timestamp, $setID) = $self->fetchCookie; @@ -584,20 +593,27 @@ sub maybe_send_cookie { # (b) a cookie was sent but not used for authentication, and the # credentials used for authentication were the same as those in # the cookie - my $unused_valid_cookie = ($self->{credential_source} ne "cookie" - and defined $cookie_user and $self->{user_id} eq $cookie_user - and defined $cookie_key and $self->{session_key} eq $cookie_key); + my $unused_valid_cookie = + ($self->{credential_source} ne "cookie" + and defined $cookie_user + and $self->{user_id} eq $cookie_user + and defined $cookie_key + and $self->{session_key} eq $cookie_key); # (c) the user asked to have a cookie sent and is not a guest user. - my $user_requests_cookie = ($self->{login_type} ne "guest" - and ( $r->param("send_cookie")//0 )); # prevent warning if "send_cookie" param is not defined. + my $user_requests_cookie = ($self->{login_type} ne "guest" and ($r->param("send_cookie") // 0)) + ; # prevent warning if "send_cookie" param is not defined. # (d) session management is done via cookies. - my $session_management_via_cookies = - $ce -> {session_management_via} eq "session_cookie"; - - debug("used_cookie='", $used_cookie, "' unused_valid_cookie='", $unused_valid_cookie, "' user_requests_cookie='", $user_requests_cookie, - "' session_management_via_cookies ='", $session_management_via_cookies, "'"); + my $session_management_via_cookies = $ce->{session_management_via} eq "session_cookie"; + + debug( + "used_cookie='", $used_cookie, + "' unused_valid_cookie='", $unused_valid_cookie, + "' user_requests_cookie='", $user_requests_cookie, + "' session_management_via_cookies ='", $session_management_via_cookies, + "'" + ); if ($used_cookie or $unused_valid_cookie or $user_requests_cookie or $session_management_via_cookies) { #debug("Authen::maybe_send_cookie is sending a cookie"); @@ -614,11 +630,11 @@ sub maybe_kill_cookie { sub set_params { my $self = shift; - my $r = $self->{r}; + my $r = $self->{r}; # A2 - params are not non-modifiable, with no explanation or workaround given in docs. WTF! - $r->param("user", $self->{user_id}); - $r->param("key", $self->{session_key}); + $r->param("user", $self->{user_id}); + $r->param("key", $self->{session_key}); $r->param("passwd", ""); debug("params user='", $r->param("user"), "' key='", $r->param("key"), "'"); @@ -632,11 +648,11 @@ sub checkPassword { my ($self, $userID, $possibleClearPassword) = @_; my $db = $self->{r}->db; - my $Password = $db->getPassword($userID); # checked + my $Password = $db->getPassword($userID); # checked if (defined $Password) { # check against WW password database my $possibleCryptPassword = crypt $possibleClearPassword, $Password->password; - my $dbPassword = $Password->password; + my $dbPassword = $Password->password; # This next line explicitly insures that # blank or null passwords from the database can never # succeed in matching an entered password @@ -651,7 +667,8 @@ sub checkPassword { # lib/WeBWorK/Authen.pm we do not assume that an all-white space password would have # already been converted to an empty string and instead explicitly test it for a non-space # character. - if (($possibleClearPassword =~/\S/) && ($dbPassword =~/\S/) && $possibleCryptPassword eq $Password->password) { + if (($possibleClearPassword =~ /\S/) && ($dbPassword =~ /\S/) && $possibleCryptPassword eq $Password->password) + { $self->write_log_entry("AUTH WWDB: password accepted"); return 1; } else { @@ -718,9 +735,9 @@ sub unexpired_session_exists { my $ce = $self->{r}->ce; my $db = $self->{r}->db; - my $Key = $db->getKey($userID); # checked + my $Key = $db->getKey($userID); # checked return 0 unless defined $Key; - if (time <= $Key->timestamp()+$ce->{sessionKeyTimeout}) { + if (time <= $Key->timestamp() + $ce->{sessionKeyTimeout}) { # unexpired, but leave timestamp alone return 1; } else { @@ -740,17 +757,17 @@ sub unexpired_session_exists { # The $userID is modified in that case and will not work in the hasPermissions call. sub create_session { my ($self, $userID, $newKey, $trueUserID) = @_; - my $r = $self->{r}; + my $r = $self->{r}; my $ce = $r->ce; my $db = $r->db; my $timestamp = time; unless ($newKey) { - my @chars = @{ $ce->{sessionKeyChars} }; + my @chars = @{ $ce->{sessionKeyChars} }; my $length = $ce->{sessionKeyLength}; srand; - $newKey = join ("", @chars[map rand(@chars), 1 .. $length]); + $newKey = join("", @chars[ map rand(@chars), 1 .. $length ]); } my $setID = @@ -783,7 +800,7 @@ sub check_session { my $ce = $self->{r}->ce; my $db = $self->{r}->db; - my $Key = $db->getKey($userID); # checked + my $Key = $db->getKey($userID); # checked return 0 unless defined $Key; my $keyMatches = (defined $possibleKey and $possibleKey eq $Key->key); @@ -793,71 +810,70 @@ sub check_session { # Want key not be too old. Use timestamp from DB and # sessionKeyTimeout to determine this even when using cookies # as we do not trust the timestamp provided by a user's browser. - my $timestampValid = ( $time_now <= $Key->timestamp() + $ce->{sessionKeyTimeout} ); - -# first part of if clause is disabled for now until we figure out long term fix for using cookies -# safely (see pull request #576) This means that the database key time is always being used -# even when in "session_cookie" mode -# if ($ce -> {session_management_via} eq "session_cookie" and defined($self->{cookie_timestamp})) { -# $timestampValid = (time <= $self -> {cookie_timestamp} + $ce->{sessionKeyTimeout}); -# } else { - if ($keyMatches and $timestampValid and $updateTimestamp) { - $Key->timestamp(time); - $db->putKey($Key); - } -# } + my $timestampValid = ($time_now <= $Key->timestamp() + $ce->{sessionKeyTimeout}); + + # first part of if clause is disabled for now until we figure out long term fix for using cookies + # safely (see pull request #576) This means that the database key time is always being used + # even when in "session_cookie" mode + # if ($ce -> {session_management_via} eq "session_cookie" and defined($self->{cookie_timestamp})) { + # $timestampValid = (time <= $self -> {cookie_timestamp} + $ce->{sessionKeyTimeout}); + # } else { + if ($keyMatches and $timestampValid and $updateTimestamp) { + $Key->timestamp(time); + $db->putKey($Key); + } + # } return (1, $keyMatches, $timestampValid); } sub killSession { my $self = shift; - my $r = $self -> {r}; - my $ce = $r -> {ce}; - my $db = $r -> {db}; + my $r = $self->{r}; + my $ce = $r->{ce}; + my $db = $r->{db}; my $caliper_sensor = Caliper::Sensor->new($ce); if ($caliper_sensor->caliperEnabled()) { my $login_event = { - 'type' => 'SessionEvent', - 'action' => 'LoggedOut', + 'type' => 'SessionEvent', + 'action' => 'LoggedOut', 'profile' => 'SessionProfile', - 'object' => Caliper::Entity::webwork_app() + 'object' => Caliper::Entity::webwork_app() }; $caliper_sensor->sendEvents($self->{r}, [$login_event]); } $self->forget_verification; - if ($ce->{session_management_via} eq "session_cookie") { + if ($ce->{session_management_via} eq "session_cookie") { $self->killCookie(); } - my $userID = $r -> param("user"); + my $userID = $r->param("user"); if (defined($userID)) { - $db->deleteKey($userID); + $db->deleteKey($userID); } } - ################################################################################ # Cookie management ################################################################################ sub fetchCookie { - my $self = shift; - my $r = $self->{r}; - my $ce = $r->ce; + my $self = shift; + my $r = $self->{r}; + my $ce = $r->ce; my $urlpath = $r->urlpath; my $courseID = $urlpath->arg("courseID"); - my $cookie = undef; + my $cookie = undef; my %cookies = WeBWorK::Cookie->fetch(); $cookie = $cookies{"WeBWorKCourseAuthen.$courseID"}; if ($cookie) { #debug("found a cookie for this course: '", $cookie->as_string, "'"); - debug("cookie has this value: '", $cookie->value, "'"); + debug("cookie has this value: '", $cookie->value, "'"); my ($userID, $key, $timestamp, $setID) = split "\t", $cookie->value; if (defined $userID and defined $key and $userID ne "" and $key ne "") { debug("looks good, returning userID='$userID' key='$key'"); @@ -874,7 +890,7 @@ sub fetchCookie { sub sendCookie { my ($self, $userID, $key, $setID) = @_; - my $r = $self->{r}; + my $r = $self->{r}; my $ce = $r->ce; my $courseID = $r->urlpath->arg("courseID"); @@ -882,64 +898,65 @@ sub sendCookie { # This sets the setID in the cookie on initial login. $setID = $r->urlpath->arg("setID") if !$setID - && $r->authen->was_verified && !$r->authz->hasPermissions($userID, 'navigation_allowed'); + && $r->authen->was_verified + && !$r->authz->hasPermissions($userID, 'navigation_allowed'); - my $timestamp = time(); + my $timestamp = time(); my $cookie = WeBWorK::Cookie->new( -name => "WeBWorKCourseAuthen.$courseID", -value => "$userID\t$key\t$timestamp" . ($setID ? "\t$setID" : ''), -path => $ce->{webworkURLRoot}, -samesite => $ce->{CookieSameSite}, - -secure => $ce->{CookieSecure} # Warning: use 1 only if using https + -secure => $ce->{CookieSecure} # Warning: use 1 only if using https ); # Set how long the browser should retain the cookie. Using max_age is now recommended, # and overrides expires, but some very old browser only support expires. - my $lifetime = $ce->{CookieLifeTime}; - if ( $lifetime ne 'session' ) { - $cookie->expires( $lifetime ); - $cookie->max_age( $lifetime ); - } # as when $lifetime eq 'session' the cookie should be a "session cookie" - # and expire when the browser session is closed. - # At present the CookieLifeTime setting only effects how long the browser is to told to retain the cookie. - # Ideally, when $ce->{session_management_via} eq "session_cookie", and if the timestamp in the cookie was - # secured again client-side tampering, the timestamp and lifetime could be used to provide ongoing session - # authentication. - - if ($r->hostname ne "localhost" && $r->hostname ne "127.0.0.1") { + my $lifetime = $ce->{CookieLifeTime}; + if ($lifetime ne 'session') { + $cookie->expires($lifetime); + $cookie->max_age($lifetime); + } # as when $lifetime eq 'session' the cookie should be a "session cookie" + # and expire when the browser session is closed. + # At present the CookieLifeTime setting only effects how long the browser is to told to retain the cookie. + # Ideally, when $ce->{session_management_via} eq "session_cookie", and if the timestamp in the cookie was + # secured again client-side tampering, the timestamp and lifetime could be used to provide ongoing session + # authentication. + + if ($r->hostname ne "localhost" && $r->hostname ne "127.0.0.1") { $cookie->domain($r->hostname); # if $r->hostname = "localhost" or "127.0.0.1", then this must be omitted. } -# debug("about to add Set-Cookie header with this string: '", $cookie->as_string, "'"); - eval {$r->headers_out->set("Set-Cookie" => $cookie->as_string);}; - if ($@) {croak $@; } + # debug("about to add Set-Cookie header with this string: '", $cookie->as_string, "'"); + eval { $r->headers_out->set("Set-Cookie" => $cookie->as_string); }; + if ($@) { croak $@; } } sub killCookie { my ($self) = @_; - my $r = $self->{r}; - my $ce = $r->ce; + my $r = $self->{r}; + my $ce = $r->ce; my $courseID = $r->urlpath->arg("courseID"); my $cookie = WeBWorK::Cookie->new( -name => "WeBWorKCourseAuthen.$courseID", -value => "\t", - '-max-age' => "-1d", # 1 day ago - -expires => "-1d", # 1 day ago + '-max-age' => "-1d", # 1 day ago + -expires => "-1d", # 1 day ago -path => $ce->{webworkURLRoot}, -samesite => $ce->{CookieSameSite}, - -secure => $ce->{CookieSecure} # Warning: use 1 only if using https + -secure => $ce->{CookieSecure} # Warning: use 1 only if using https ); - if ($r->hostname ne "localhost" && $r->hostname ne "127.0.0.1") { - $cookie -> domain($r->hostname); # if $r->hostname = "localhost" or "127.0.0.1", then this must be omitted. + if ($r->hostname ne "localhost" && $r->hostname ne "127.0.0.1") { + $cookie->domain($r->hostname); # if $r->hostname = "localhost" or "127.0.0.1", then this must be omitted. } #debug( "killCookie is about to set an expired cookie"); #debug("about to add Set-Cookie header with this string: '", $cookie->as_string, "'"); - eval {$r->headers_out->set("Set-Cookie" => $cookie->as_string);}; - if ($@) {croak $@; } + eval { $r->headers_out->set("Set-Cookie" => $cookie->as_string); }; + if ($@) { croak $@; } } # This method is only used for a user that does not have the navigation_allowed permission, @@ -964,30 +981,31 @@ sub get_session_set_id { sub write_log_entry { my ($self, $message) = @_; - my $r = $self->{r}; + my $r = $self->{r}; my $ce = $r->ce; - my $user_id = defined $self->{user_id} ? $self->{user_id} : ""; - my $login_type = defined $self->{login_type} ? $self->{login_type} : ""; + my $user_id = defined $self->{user_id} ? $self->{user_id} : ""; + my $login_type = defined $self->{login_type} ? $self->{login_type} : ""; my $credential_source = defined $self->{credential_source} ? $self->{credential_source} : ""; my ($remote_host, $remote_port); my $connection; my $user_agent; - eval {$connection = $r->connection}; + eval { $connection = $r->connection }; if ($@) { # no connection available $remote_host = "UNKNOWN" unless defined $remote_host; $remote_port = "UNKNOWN" unless defined $remote_port; $user_agent = "UNKNOWN"; } else { - $remote_host = $r->useragent_addr->ip_get || "UNKNOWN"; - $remote_port = $r->connection->client_addr->port || "UNKNOWN"; + $remote_host = $r->useragent_addr->ip_get || "UNKNOWN"; + $remote_port = $r->connection->client_addr->port || "UNKNOWN"; $user_agent = $r->headers_in->{"User-Agent"}; } - my $log_msg = "$message user_id=$user_id login_type=$login_type credential_source=$credential_source host=$remote_host port=$remote_port UA=$user_agent"; + my $log_msg = + "$message user_id=$user_id login_type=$login_type credential_source=$credential_source host=$remote_host port=$remote_port UA=$user_agent"; debug("Writing to login log: '$log_msg'.\n"); writeCourseLog($ce, "login_log", $log_msg); } diff --git a/lib/WeBWorK/Authen/Basic_TheLastOption.pm b/lib/WeBWorK/Authen/Basic_TheLastOption.pm index 689a99f6bb..0bf2d8434b 100644 --- a/lib/WeBWorK/Authen/Basic_TheLastOption.pm +++ b/lib/WeBWorK/Authen/Basic_TheLastOption.pm @@ -28,6 +28,4 @@ be the last one in the array of the Authen module hashes. =cut - - 1; diff --git a/lib/WeBWorK/Authen/CAS.pm b/lib/WeBWorK/Authen/CAS.pm index b4302689fc..1f7e70acb8 100644 --- a/lib/WeBWorK/Authen/CAS.pm +++ b/lib/WeBWorK/Authen/CAS.pm @@ -44,17 +44,11 @@ sub checkSetUser { if (ref $allowed_targets eq 'ARRAY') { foreach my $x (@{$allowed_targets}) { - return 1 if $x =~ m/(.*)\*$/ - ? $new_id =~ m/^$1/ - : $new_id eq $x; + return 1 if $x =~ m/(.*)\*$/ ? $new_id =~ m/^$1/ : $new_id eq $x; } - } - elsif (not ref $allowed_targets) { - return 1 if $allowed_targets =~ m/(.*)\*$/ - ? $new_id =~ m/^$1/ - : $new_id eq $allowed_targets; - } - else { + } elsif (not ref $allowed_targets) { + return 1 if $allowed_targets =~ m/(.*)\*$/ ? $new_id =~ m/^$1/ : $new_id eq $allowed_targets; + } else { $self->{error} = "Malformed sudoers data structure."; $self->write_log_entry("Malformed sudoers data structure."); return 0; @@ -67,8 +61,8 @@ sub checkSetUser { sub get_credentials { my $self = shift; - my $r = $self->{r}; - my $ce = $r->ce; + my $r = $self->{r}; + my $ce = $r->ce; # Disable password authentication $self->{external_auth} = 1; @@ -90,21 +84,23 @@ sub get_credentials { # through the CAS. So just check the provided user and session key. if (defined $r->param('key') && defined $r->param('user')) { # These lines were copied from the superclass get_credentials. - $self->{session_key} = $r->param('key'); - $self->{user_id} = $r->param('user'); - $self->{login_type} = 'normal'; + $self->{session_key} = $r->param('key'); + $self->{user_id} = $r->param('user'); + $self->{login_type} = 'normal'; $self->{credential_source} = 'params'; - debug("CAS params user '", $self->{user_id}, - "' key '", $self->{session_key}, "'"); + debug("CAS params user '", $self->{user_id}, "' key '", $self->{session_key}, "'"); # Check session key and user here. Otherwise, a student can # determine the enrollment status of any other student if # they know the userid (which is public information at # Berkeley). That would be a privacy violation. my $Key = $r->db->getKey($self->{user_id}); unless (defined $Key && $Key->key eq $self->{session_key}) { - debug('undefined or invalid session key: $Key->key = ', - defined $Key ? $Key->key : undef, ', user value = ', - $self->{session_key}); + debug( + 'undefined or invalid session key: $Key->key = ', + defined $Key ? $Key->key : undef, + ', user value = ', + $self->{session_key} + ); $self->{error} = "Invalid session key"; $r->param('key' => undef); return $self->get_credentials(); @@ -117,14 +113,13 @@ sub get_credentials { #my $cas_certs = $ce->{authen}{cas_options}{certs}; #my $cas = new AuthCAS(casUrl => $cas_url, # CAFile => $cas_certs); - my $cas = new AuthCAS( - %{ $ce->{authen}{cas_options}{AuthCAS_opts} }); + my $cas = new AuthCAS(%{ $ce->{authen}{cas_options}{AuthCAS_opts} }); my $service = $r->unparsed_uri(); # Remove the "ticket=..." parameter that the CAS server added # (Not sure if the second test is really needed.) $service =~ s/[?&]ticket=[^&]*$// - or $service =~ s/([?&])ticket=[^&]*&/$1/; + or $service =~ s/([?&])ticket=[^&]*&/$1/; $service = $ce->{apache_root_url} . $service; debug("service = $service"); my $ticket = $r->param('ticket'); @@ -151,15 +146,15 @@ sub get_credentials { my $new_id = $r->param('setUser'); if (defined $new_id) { return 0 - unless checkSetUser($self, $user_id, $new_id); + unless checkSetUser($self, $user_id, $new_id); $self->write_log_entry("setUser: user $user_id logged in as $new_id"); $user_id = $new_id; } $self->{'user_id'} = $user_id; $self->{r}->param('user', $user_id); - $self->{session_key} = undef; - $self->{password} = "not\tvalid"; - $self->{login_type} = 'normal'; + $self->{session_key} = undef; + $self->{password} = "not\tvalid"; + $self->{login_type} = 'normal'; $self->{credential_source} = 'cas'; return 1; } @@ -170,7 +165,7 @@ sub get_credentials { # from checkPassword, which we're replacing. sub checkPassword { - my ( $self, $userID, $clearTextPassword ) = @_; + my ($self, $userID, $clearTextPassword) = @_; # if we got here, we know we've already successfully authenticated # against the CAS return 1; @@ -187,8 +182,7 @@ sub logout_user { # and (more important) it would send us back here after logging out, # so we'd end up back at the CAS login screen. - my $go_to = $ce->{authen}{cas_options}{AuthCAS_opts}{casUrl} - . '/logout'; + my $go_to = $ce->{authen}{cas_options}{AuthCAS_opts}{casUrl} . '/logout'; debug("logging out. Redirecting to $go_to"); $self->{redirect} = $go_to; } diff --git a/lib/WeBWorK/Authen/Cosign.pm b/lib/WeBWorK/Authen/Cosign.pm index 15f1162b25..f5f85ebe29 100644 --- a/lib/WeBWorK/Authen/Cosign.pm +++ b/lib/WeBWorK/Authen/Cosign.pm @@ -34,21 +34,21 @@ use strict; use warnings; use WeBWorK::Debug; -# this is similar to the method in the base class, except that cosign +# this is similar to the method in the base class, except that cosign # ensures that we don't get to the address without a login. this means # that we can't allow guest logins, but don't have to do any password # checking or cookie management. sub get_credentials { my ($self) = @_; - my $r = $self->{r}; - my $ce = $r->ce; - my $db = $r->db; - - if ( $ce->{cosignoff} ) { - return $self->SUPER::get_credentials( ); + my $r = $self->{r}; + my $ce = $r->ce; + my $db = $r->db; + + if ($ce->{cosignoff}) { + return $self->SUPER::get_credentials(); } else { - if ( defined( $ENV{'REMOTE_USER'} ) ) { + if (defined($ENV{'REMOTE_USER'})) { $self->{'user_id'} = $ENV{'REMOTE_USER'}; $self->{r}->param("user", $ENV{'REMOTE_USER'}); } else { @@ -59,23 +59,23 @@ sub get_credentials { # failure. $self->{external_auth} = 1; - # the session key isn't used (cosign is managing this - # for us), and we want to force checking against the + # the session key isn't used (cosign is managing this + # for us), and we want to force checking against the # site_checkPassword - $self->{'session_key'} = undef; - $self->{'password'} = 1; + $self->{'session_key'} = undef; + $self->{'password'} = 1; $self->{'credential_source'} = "params"; - $self->{login_type} = "cosign"; - + $self->{login_type} = "cosign"; + return 1; } } -sub site_checkPassword { - my ( $self, $userID, $clearTextPassword ) = @_; +sub site_checkPassword { + my ($self, $userID, $clearTextPassword) = @_; - if ( $self->{r}->ce->{cosignoff} ) { - return 0; + if ($self->{r}->ce->{cosignoff}) { + return 0; #return $self->SUPER::checkPassword( $userID, $clearTextPassword ); } else { # this is easy; if we're here at all, we've authenticated @@ -87,32 +87,35 @@ sub site_checkPassword { # disable cookie functionality sub maybe_send_cookie { my ($self, @args) = @_; - if ( $self->{r}->ce->{cosignoff} ) { - return $self->SUPER::maybe_send_cookie( @args ); + if ($self->{r}->ce->{cosignoff}) { + return $self->SUPER::maybe_send_cookie(@args); } else { # nothing to do here } } + sub fetchCookie { my ($self, @args) = @_; - if ( $self->{r}->ce->{cosignoff} ) { - return $self->SUPER::fetchCookie( @args ); + if ($self->{r}->ce->{cosignoff}) { + return $self->SUPER::fetchCookie(@args); } else { # nothing to do here } } + sub sendCookie { my ($self, @args) = @_; - if ( $self->{r}->ce->{cosignoff} ) { - return $self->SUPER::sendCookie( @args); + if ($self->{r}->ce->{cosignoff}) { + return $self->SUPER::sendCookie(@args); } else { # nothing to do here } } + sub killCookie { my ($self, @args) = @_; - if ( $self->{r}->ce->{cosignoff} ) { - return $self->SUPER::killCookie( @args ); + if ($self->{r}->ce->{cosignoff}) { + return $self->SUPER::killCookie(@args); } else { # nothing to do here } @@ -120,17 +123,17 @@ sub killCookie { # this is a bit of a cheat, because it does the redirect away from the # logout script or what have you, but I don't see a way around that. -sub forget_verification { +sub forget_verification { my ($self, @args) = @_; my $r = $self->{r}; - if ( $r->ce->{cosignoff} ) { - return $self->SUPER::forget_verification( @args); + if ($r->ce->{cosignoff}) { + return $self->SUPER::forget_verification(@args); } else { $self->{was_verified} = 0; -# $r->headers_out->{"Location"} = $r->ce->{cosign_logout_script}; -# $r->send_http_header; -# return; + # $r->headers_out->{"Location"} = $r->ce->{cosign_logout_script}; + # $r->send_http_header; + # return; $self->{redirect} = $r->ce->{cosign_logout_script}; } } diff --git a/lib/WeBWorK/Authen/LDAP.pm b/lib/WeBWorK/Authen/LDAP.pm index 8ca64d6853..6743ebe299 100644 --- a/lib/WeBWorK/Authen/LDAP.pm +++ b/lib/WeBWorK/Authen/LDAP.pm @@ -23,75 +23,72 @@ use Net::LDAP qw/LDAP_INVALID_CREDENTIALS/; sub checkPassword { my ($self, $userID, $possibleClearPassword) = @_; - my $ce = $self->{r}->ce; + my $ce = $self->{r}->ce; my $failover = $ce->{authen}{ldap_options}{failover}; - + debug("LDAP module is doing the password checking.\n"); - + # check against LDAP server my $ret = $self->ldap_authen_uid($userID, $possibleClearPassword); return 1 if ($ret == 1); - #return 0 if ($userID !~ /admin/); - + #return 0 if ($userID !~ /admin/); + # optional: fail over to superclass checkPassword if (($failover eq "all" or $failover eq "1") || ($failover eq "local" and $ret < 0)) { $self->write_log_entry("AUTH LDAP: authentication failed, deferring to superclass"); return $self->SUPER::checkPassword($userID, $possibleClearPassword); } - + # fail by default return 0; } sub ldap_authen_uid { my ($self, $uid, $password) = @_; - my $ce = $self->{r}->ce; - my $hosts = $ce->{authen}{ldap_options}{net_ldap_hosts}; - my $opts = $ce->{authen}{ldap_options}{net_ldap_opts}; - my $base = $ce->{authen}{ldap_options}{net_ldap_base}; - my $searchdn = $ce->{authen}{ldap_options}{searchDN}; - my $bindAccount = $ce->{authen}{ldap_options}{bindAccount}; - my $bindpassword = $ce->{authen}{ldap_options}{bindPassword}; + my $ce = $self->{r}->ce; + my $hosts = $ce->{authen}{ldap_options}{net_ldap_hosts}; + my $opts = $ce->{authen}{ldap_options}{net_ldap_opts}; + my $base = $ce->{authen}{ldap_options}{net_ldap_base}; + my $searchdn = $ce->{authen}{ldap_options}{searchDN}; + my $bindAccount = $ce->{authen}{ldap_options}{bindAccount}; + my $bindpassword = $ce->{authen}{ldap_options}{bindPassword}; # Be backwards-compatible with releases that hardcode this value. my $rdn = "sAMAccountName"; if (defined $ce->{authen}{ldap_options}{net_ldap_rdn}) { $rdn = $ce->{authen}{ldap_options}{net_ldap_rdn}; } - - # connect to LDAP server my $ldap = new Net::LDAP($hosts, @$opts); if (not defined $ldap) { warn "AUTH LDAP: couldn't connect to any of ", join(", ", @$hosts), ".\n"; return 0; } - + my $msg; - - - if($bindAccount){ - # bind with a bind USER - $msg = $ldap->bind( $searchdn, password => $bindpassword ); - if ($msg->is_error) { - warn "AUTH LDAP: bind error ", $msg->code, ": ", $msg->error_text, ".\n"; - return 0; + + if ($bindAccount) { + # bind with a bind USER + $msg = $ldap->bind($searchdn, password => $bindpassword); + if ($msg->is_error) { + warn "AUTH LDAP: bind error ", $msg->code, ": ", $msg->error_text, ".\n"; + return 0; } - } - else{ - # bind anonymously + } else { + # bind anonymously $msg = $ldap->bind; if ($msg->is_error) { warn "AUTH LDAP: bind error ", $msg->code, ": ", $msg->error_text, ".\n"; return 0; - } + } } - + # look up user's DN $msg = $ldap->search(base => $base, filter => "$rdn=$uid"); if ($msg->is_error) { - warn "AUTH LDAP: search error ", $msg->code, ": ", $msg->error_text, ".\n",$searchdn,"\n",$base,"\n",$uid,"\n"; + warn "AUTH LDAP: search error ", $msg->code, ": ", $msg->error_text, ".\n", $searchdn, "\n", $base, "\n", $uid, + "\n"; return 0; } if ($msg->count > 1) { @@ -107,7 +104,7 @@ sub ldap_authen_uid { warn "AUTH LDAP: got null DN when looking up UID '$uid'.\n"; return 0; } - + # re-bind as user. if that works, we've authenticated! $msg = $ldap->bind($dn, password => $password); if ($msg->code == LDAP_INVALID_CREDENTIALS) { @@ -118,7 +115,7 @@ sub ldap_authen_uid { warn "AUTH LDAP: bind error ", $msg->code, ": ", $msg->error_text, ".\n"; return 0; } - + # it worked! we win! return 1; } diff --git a/lib/WeBWorK/Authen/LTIAdvanced.pm b/lib/WeBWorK/Authen/LTIAdvanced.pm index 10b104698b..15f87de6a6 100644 --- a/lib/WeBWorK/Authen/LTIAdvanced.pm +++ b/lib/WeBWorK/Authen/LTIAdvanced.pm @@ -52,14 +52,12 @@ Instantiates a new WeBWorK::Authen object for the given WeBWorK::Requst ($r). =cut sub new { - my ($invocant, $r) = @_; - my $class = ref($invocant) || $invocant; - my $self = { - r => $r, - }; - #initialize - bless $self, $class; - return $self; + my ($invocant, $r) = @_; + my $class = ref($invocant) || $invocant; + my $self = { r => $r, }; + #initialize + bless $self, $class; + return $self; } =back @@ -84,567 +82,600 @@ sub new { # Some LMS's misspell the lis_person_sourcedid parameter name # so we use a list of variations when needed. our @lis_person_sourcedid_options = ( - "lis_person_sourcedid", # from spec at https://www.imsglobal.org/specs/ltiv1p1/implementation-guide#toc-3 + "lis_person_sourcedid", # from spec at https://www.imsglobal.org/specs/ltiv1p1/implementation-guide#toc-3 "lis_person_sourced_id", "lis_person_source_id", "lis_person_sourceid" ); -sub request_has_data_for_this_verification_module { - debug("LTIAdvanced has been called for data verification"); - my $self = shift; - my $r = $self->{r}; - - # See comment in get_credentials() - if ($r->{xmlrpc}) { - debug("LTIAdvanced returning 1 because it is an xmlrpc call"); - return 1; - } - - # We need at least these things to verify an oauth request - if (!(defined $r->param("oauth_consumer_key")) - || !(defined $r->param("oauth_signature")) - || !(defined $r->param("oauth_nonce")) - || !(defined $r->param("oauth_timestamp")) ) { - debug("LTIAdvanced returning that it has insufficent data"); - return(0); - } else { - debug("LTIAdvanced returning that it has sufficient data"); - return(1); - } +sub request_has_data_for_this_verification_module { + debug("LTIAdvanced has been called for data verification"); + my $self = shift; + my $r = $self->{r}; + + # See comment in get_credentials() + if ($r->{xmlrpc}) { + debug("LTIAdvanced returning 1 because it is an xmlrpc call"); + return 1; + } + + # We need at least these things to verify an oauth request + if (!(defined $r->param("oauth_consumer_key")) + || !(defined $r->param("oauth_signature")) + || !(defined $r->param("oauth_nonce")) + || !(defined $r->param("oauth_timestamp"))) + { + debug("LTIAdvanced returning that it has insufficent data"); + return (0); + } else { + debug("LTIAdvanced returning that it has sufficient data"); + return (1); + } } sub get_credentials { - my $self = shift; - my $r = $self->{r}; - my $ce = $r->{ce}; - - debug("LTIAdvanced::get_credentials has been called\n"); - - ## Printing parameters to main page can help people set things up - ## so we dont use the debug channel here - if ( $ce->{debug_lti_parameters} ) { - my $rh_headers = $r->headers_in; #request headers - - my @parameter_names = $r->param; # form parameter names - my $parameter_report = ''; - foreach my $key (@parameter_names) { - $parameter_report .= "$key => ".$r->param($key). "\n"; - } - warn ("===== parameters received =======\n", $parameter_report); - } - - my $oauth_time = $r->param("oauth_timestamp"); - my $curr_time = time(); - my $delta_time = $curr_time - $oauth_time; - my $delta_min = (0.0 + $delta_time) / (60.0); - if ( $ce->{debug_lti_parameters} ) { - warn join("\n", - "============================", - "===== timestamp info =======", - "oauth_nonce = $oauth_time", - "WW_server_time = $curr_time", - "diff(server-oauth) = $delta_time seconds ($delta_min minutes)", - "============================" - ); - } - - #disable password login - $self->{external_auth} = 1; - - # This next part is necessary because some parts of webwork (e.g., - # WebworkWebservice.pm) need to replace the get_credentials() routine, - # but only replace the one in the parent class (out of caution, - # presumably). Therefore, we end up here even when authenticating - # for WebworkWebservice.pm. This would cause authentication failures - # when authenticating javascript web service requests (e.g., the - # Library Browser). - # Similar changes are needed in check_user() and verify_normal_user(). - - if ($r->{xmlrpc}) { - debug("falling back to superclass get_credentials (xmlrpc call)"); - return $self->SUPER::get_credentials(@_); - } - - # Determine the WW user_id to use, if possible - - if ( ! $ce->{preferred_source_of_username} ) { - warn "LTI is not properly configured (no preferred_source_of_username). Please contact your instructor or system administrator."; - $self->{error} = $r->maketext("There was an error during the login process. Please speak to your instructor or system administrator."); - debug("No preferred_source_of_username in " . $r->ce->{'courseName'} . " so LTIAdvanced::get_credentials is returning a 0\n"); - return 0; - } - - my $user_id_source = ""; - my $type_of_source = ""; - - $self->{email} = ""; # set an initial value to avoid warnings when not provided - if ( defined( $r->param("lis_person_contact_email_primary") ) ) { - $self->{email} = uri_unescape($r->param("lis_person_contact_email_primary")) // ""; - } - - if ( $ce->{preferred_source_of_username} eq "lis_person_sourcedid" ) { - foreach my $key ( @lis_person_sourcedid_options ) { - if ( $r->param($key) ) { - $user_id_source = $key; - $type_of_source = "preferred_source_of_username"; - $self->{user_id} = $r->param($key); - last; + my $self = shift; + my $r = $self->{r}; + my $ce = $r->{ce}; + + debug("LTIAdvanced::get_credentials has been called\n"); + + ## Printing parameters to main page can help people set things up + ## so we dont use the debug channel here + if ($ce->{debug_lti_parameters}) { + my $rh_headers = $r->headers_in; #request headers + + my @parameter_names = $r->param; # form parameter names + my $parameter_report = ''; + foreach my $key (@parameter_names) { + $parameter_report .= "$key => " . $r->param($key) . "\n"; } + warn("===== parameters received =======\n", $parameter_report); } - } elsif ( $ce->{preferred_source_of_username} eq "lis_person_contact_email_primary" - && $self->{email} ne "" ) { - $user_id_source = "lis_person_contact_email_primary"; - $type_of_source = "preferred_source_of_username"; - $self->{user_id} = $self->{email}; - - # Strip off the part of the address after @ if requested to do so: - $self->{user_id} =~ s/@.*$// if $ce->{strip_address_from_email}; - } elsif ( $r->param($ce->{preferred_source_of_username}) ) { - $user_id_source = $ce->{preferred_source_of_username}; - $type_of_source = "preferred_source_of_username"; - $self->{user_id} = $r->param($ce->{preferred_source_of_username}); - } - - # Fallback if necessary - if ( !defined( $self->{user_id} ) && $ce->{fallback_source_of_username} ) { - if ( $ce->{fallback_source_of_username} eq "lis_person_sourcedid" ) { - foreach my $key ( @lis_person_sourcedid_options ) { - if ( $r->param($key) ) { - $user_id_source = $key; - $type_of_source = "fallback_source_of_username"; + + my $oauth_time = $r->param("oauth_timestamp"); + my $curr_time = time(); + my $delta_time = $curr_time - $oauth_time; + my $delta_min = (0.0 + $delta_time) / (60.0); + if ($ce->{debug_lti_parameters}) { + warn join("\n", + "============================", + "===== timestamp info =======", + "oauth_nonce = $oauth_time", + "WW_server_time = $curr_time", + "diff(server-oauth) = $delta_time seconds ($delta_min minutes)", + "============================"); + } + + #disable password login + $self->{external_auth} = 1; + + # This next part is necessary because some parts of webwork (e.g., + # WebworkWebservice.pm) need to replace the get_credentials() routine, + # but only replace the one in the parent class (out of caution, + # presumably). Therefore, we end up here even when authenticating + # for WebworkWebservice.pm. This would cause authentication failures + # when authenticating javascript web service requests (e.g., the + # Library Browser). + # Similar changes are needed in check_user() and verify_normal_user(). + + if ($r->{xmlrpc}) { + debug("falling back to superclass get_credentials (xmlrpc call)"); + return $self->SUPER::get_credentials(@_); + } + + # Determine the WW user_id to use, if possible + + if (!$ce->{preferred_source_of_username}) { + warn + "LTI is not properly configured (no preferred_source_of_username). Please contact your instructor or system administrator."; + $self->{error} = $r->maketext( + "There was an error during the login process. Please speak to your instructor or system administrator."); + debug("No preferred_source_of_username in " + . $r->ce->{'courseName'} + . " so LTIAdvanced::get_credentials is returning a 0\n"); + return 0; + } + + my $user_id_source = ""; + my $type_of_source = ""; + + $self->{email} = ""; # set an initial value to avoid warnings when not provided + if (defined($r->param("lis_person_contact_email_primary"))) { + $self->{email} = uri_unescape($r->param("lis_person_contact_email_primary")) // ""; + } + + if ($ce->{preferred_source_of_username} eq "lis_person_sourcedid") { + foreach my $key (@lis_person_sourcedid_options) { + if ($r->param($key)) { + $user_id_source = $key; + $type_of_source = "preferred_source_of_username"; $self->{user_id} = $r->param($key); last; } } - } elsif ( $ce->{fallback_source_of_username} eq "lis_person_contact_email_primary" - && $self->{email} ne "" ) { - $user_id_source = "lis_person_contact_email_primary"; - $type_of_source = "fallback_source_of_username"; + } elsif ($ce->{preferred_source_of_username} eq "lis_person_contact_email_primary" + && $self->{email} ne "") + { + $user_id_source = "lis_person_contact_email_primary"; + $type_of_source = "preferred_source_of_username"; $self->{user_id} = $self->{email}; # Strip off the part of the address after @ if requested to do so: $self->{user_id} =~ s/@.*$// if $ce->{strip_address_from_email}; - } elsif ( $r->param($ce->{fallback_source_of_username}) ) { - $user_id_source = $ce->{fallback_source_of_username}; - $type_of_source = "fallback_source_of_username"; - $self->{user_id} = $r->param($ce->{fallback_source_of_username}); - } - } - - # if we were able to set a user_id - if ( defined($self->{user_id}) && $self->{user_id} ne "" ) { - # Make user_id lowercase for consistency in naming if configured. - $self->{user_id} = lc($self->{user_id}) if ($ce->{lti_lowercase_username}); - - map {$self->{$_->[0]} = $r->param($_->[1]);} - ( - ['role', 'roles'], - ['last_name' , 'lis_person_name_family'], - ['first_name', 'lis_person_name_given'], - ['context_id', 'context_id'], - ['oauth_consumer_key', 'oauth_consumer_key'], - ['oauth_signature', 'oauth_signature'], - ['oauth_nonce', 'oauth_nonce'], - ['oauth_timestamp', 'oauth_timestamp'], - ['section', 'custom_section'], - ['recitation', 'custom_recitation'], - ); - - if (defined($ce->{preferred_source_of_student_id}) - && defined($r->param($ce->{preferred_source_of_student_id}))) { - $self->{student_id} = $r->param($ce->{preferred_source_of_student_id}); - } else { - $self->{student_id} = ""; # fall back to avoid a warning when debug_lti_parameters enabled - } - - # For setting up its helpful to print out what the system think the - # User id and address is at this point - if ( $ce->{debug_lti_parameters} ) { - warn "=========== summary ============"; - warn "User id is |$self->{user_id}| (obtained from $user_id_source which was $type_of_source)\n"; - warn "User mail address is |$self->{email}|\n"; - warn "strip_address_from_email is |", $ce->{strip_address_from_email}//0,"|\n"; - warn "Student id is |$self->{student_id}|\n"; - warn "preferred_source_of_username is |$ce->{preferred_source_of_username}|\n"; - warn "fallback_source_of_username is |", $ce->{fallback_source_of_username}//'undefined',"|\n"; - warn "preferred_source_of_student_id is |", $ce->{preferred_source_of_student_id}//'undefined',"|\n"; - warn "================================\n"; - } - if (!defined($self->{user_id})) { - croak "LTIAdvanced was unable to create a username from the data provided with the current settings. Set \$debug_lti_parameters=1 in authen_LTI.conf to debug"; - } - - $self->{login_type} = "normal"; - $self->{credential_source} = "LTIAdvanced"; - debug("LTIAdvanced::get_credentials is returning a 1\n"); - return 1; - } - warn "LTI is not properly configured (failed to set user_id from preferred_source_of_username or fallback_source_of_username). Please contact your instructor or system administrator."; - $self->{error} = $r->maketext("There was an error during the login process. Please speak to your instructor or system administrator."); - debug("LTIAdvanced::get_credentials is returning a 0\n"); - return 0; + } elsif ($r->param($ce->{preferred_source_of_username})) { + $user_id_source = $ce->{preferred_source_of_username}; + $type_of_source = "preferred_source_of_username"; + $self->{user_id} = $r->param($ce->{preferred_source_of_username}); + } + + # Fallback if necessary + if (!defined($self->{user_id}) && $ce->{fallback_source_of_username}) { + if ($ce->{fallback_source_of_username} eq "lis_person_sourcedid") { + foreach my $key (@lis_person_sourcedid_options) { + if ($r->param($key)) { + $user_id_source = $key; + $type_of_source = "fallback_source_of_username"; + $self->{user_id} = $r->param($key); + last; + } + } + } elsif ($ce->{fallback_source_of_username} eq "lis_person_contact_email_primary" + && $self->{email} ne "") + { + $user_id_source = "lis_person_contact_email_primary"; + $type_of_source = "fallback_source_of_username"; + $self->{user_id} = $self->{email}; + + # Strip off the part of the address after @ if requested to do so: + $self->{user_id} =~ s/@.*$// if $ce->{strip_address_from_email}; + } elsif ($r->param($ce->{fallback_source_of_username})) { + $user_id_source = $ce->{fallback_source_of_username}; + $type_of_source = "fallback_source_of_username"; + $self->{user_id} = $r->param($ce->{fallback_source_of_username}); + } + } + + # if we were able to set a user_id + if (defined($self->{user_id}) && $self->{user_id} ne "") { + # Make user_id lowercase for consistency in naming if configured. + $self->{user_id} = lc($self->{user_id}) if ($ce->{lti_lowercase_username}); + + map { $self->{ $_->[0] } = $r->param($_->[1]); } ( + [ 'role', 'roles' ], + [ 'last_name', 'lis_person_name_family' ], + [ 'first_name', 'lis_person_name_given' ], + [ 'context_id', 'context_id' ], + [ 'oauth_consumer_key', 'oauth_consumer_key' ], + [ 'oauth_signature', 'oauth_signature' ], + [ 'oauth_nonce', 'oauth_nonce' ], + [ 'oauth_timestamp', 'oauth_timestamp' ], + [ 'section', 'custom_section' ], + [ 'recitation', 'custom_recitation' ], + ); + + if (defined($ce->{preferred_source_of_student_id}) + && defined($r->param($ce->{preferred_source_of_student_id}))) + { + $self->{student_id} = $r->param($ce->{preferred_source_of_student_id}); + } else { + $self->{student_id} = ""; # fall back to avoid a warning when debug_lti_parameters enabled + } + + # For setting up its helpful to print out what the system think the + # User id and address is at this point + if ($ce->{debug_lti_parameters}) { + warn "=========== summary ============"; + warn "User id is |$self->{user_id}| (obtained from $user_id_source which was $type_of_source)\n"; + warn "User mail address is |$self->{email}|\n"; + warn "strip_address_from_email is |", $ce->{strip_address_from_email} // 0, "|\n"; + warn "Student id is |$self->{student_id}|\n"; + warn "preferred_source_of_username is |$ce->{preferred_source_of_username}|\n"; + warn "fallback_source_of_username is |", $ce->{fallback_source_of_username} // 'undefined', "|\n"; + warn "preferred_source_of_student_id is |", $ce->{preferred_source_of_student_id} // 'undefined', "|\n"; + warn "================================\n"; + } + if (!defined($self->{user_id})) { + croak + "LTIAdvanced was unable to create a username from the data provided with the current settings. Set \$debug_lti_parameters=1 in authen_LTI.conf to debug"; + } + + $self->{login_type} = "normal"; + $self->{credential_source} = "LTIAdvanced"; + debug("LTIAdvanced::get_credentials is returning a 1\n"); + return 1; + } + warn + "LTI is not properly configured (failed to set user_id from preferred_source_of_username or fallback_source_of_username). Please contact your instructor or system administrator."; + $self->{error} = $r->maketext( + "There was an error during the login process. Please speak to your instructor or system administrator."); + debug("LTIAdvanced::get_credentials is returning a 0\n"); + return 0; } # minor modification of method in superclass sub check_user { - my $self = shift; - my $r = $self->{r}; - my ($ce, $db, $authz) = map {$r->$_ ;} ('ce', 'db', 'authz'); - - my $user_id = $self->{user_id}; - - debug("LTIAdvanced::check_user has been called for user_id = |$user_id|"); - - # See comment in get_credentials() - if ($r->{xmlrpc}) { - #debug("falling back to superclass check_user (xmlrpc call)"); - return $self->SUPER::check_user(@_); - } - - if (!defined($user_id) || (defined $user_id && $user_id eq "")) { - $self->{log_error} .= "no user id specified"; - $self->{error} = $r->maketext("There was an error during the login process. Please speak to your instructor or system administrator."); - return 0; - } - - my $User = $db->getUser($user_id); - - if (!$User) { - my %options; - $options{$ce->{preferred_source_of_username}} = 1 if ($ce->{preferred_source_of_username}); - $options{$ce->{fallback_source_of_username}} = 1 if ($ce->{fallback_source_of_username}); - - # May need to add alternate "spellings" for lis_person_sourcedid - my $use_lis_person_sourcedid_options = 0; - if ( defined($ce->{preferred_source_of_username}) - && $ce->{preferred_source_of_username} eq "lis_person_sourcedid" ) { - $use_lis_person_sourcedid_options = 1; - } elsif ( defined($ce->{fallback_source_of_username}) - && $ce->{fallback_source_of_username} eq "lis_person_sourcedid" ) { - $use_lis_person_sourcedid_options = 1; - } - - foreach my $key ( keys( %options ), ( $use_lis_person_sourcedid_options ? @lis_person_sourcedid_options : () ) ) { - if ( defined($r->param($key)) ) { - debug("User |$user_id| is unknown but may be an new user from an LSM via LTI. Saw a value for $key About to return a 1"); - return 1; #This may be a new user coming in from a LMS via LTI. - } - } - - $self->{log_error} .= " $user_id - user unknown"; - $self->{error} = $r->maketext("There was an error during the login process. Please speak to your instructor or system administrator."); - return 0; - } - - unless ($ce->status_abbrev_has_behavior($User->status, "allow_course_access")) { - $self->{log_error} .= "LOGIN FAILED $user_id - course access denied"; - $self->{error} = $r->maketext("Authentication failed. Please speak to your instructor."); - return 0; - } - - unless ($authz->hasPermissions($user_id, "login")) { - $self->{log_error} .= "LOGIN FAILED $user_id - no permission to login"; - $self->{error} = $r->maketext("Authentication failed. Please speak to your instructor."); - return 0; - } - - debug("LTIAdvanced::check_user is about to return a 1."); - return 1; + my $self = shift; + my $r = $self->{r}; + my ($ce, $db, $authz) = map { $r->$_; } ('ce', 'db', 'authz'); + + my $user_id = $self->{user_id}; + + debug("LTIAdvanced::check_user has been called for user_id = |$user_id|"); + + # See comment in get_credentials() + if ($r->{xmlrpc}) { + #debug("falling back to superclass check_user (xmlrpc call)"); + return $self->SUPER::check_user(@_); + } + + if (!defined($user_id) || (defined $user_id && $user_id eq "")) { + $self->{log_error} .= "no user id specified"; + $self->{error} = $r->maketext( + "There was an error during the login process. Please speak to your instructor or system administrator."); + return 0; + } + + my $User = $db->getUser($user_id); + + if (!$User) { + my %options; + $options{ $ce->{preferred_source_of_username} } = 1 if ($ce->{preferred_source_of_username}); + $options{ $ce->{fallback_source_of_username} } = 1 if ($ce->{fallback_source_of_username}); + + # May need to add alternate "spellings" for lis_person_sourcedid + my $use_lis_person_sourcedid_options = 0; + if (defined($ce->{preferred_source_of_username}) + && $ce->{preferred_source_of_username} eq "lis_person_sourcedid") + { + $use_lis_person_sourcedid_options = 1; + } elsif (defined($ce->{fallback_source_of_username}) + && $ce->{fallback_source_of_username} eq "lis_person_sourcedid") + { + $use_lis_person_sourcedid_options = 1; + } + + foreach my $key (keys(%options), ($use_lis_person_sourcedid_options ? @lis_person_sourcedid_options : ())) { + if (defined($r->param($key))) { + debug( + "User |$user_id| is unknown but may be an new user from an LSM via LTI. Saw a value for $key About to return a 1" + ); + return 1; #This may be a new user coming in from a LMS via LTI. + } + } + + $self->{log_error} .= " $user_id - user unknown"; + $self->{error} = $r->maketext( + "There was an error during the login process. Please speak to your instructor or system administrator."); + return 0; + } + + unless ($ce->status_abbrev_has_behavior($User->status, "allow_course_access")) { + $self->{log_error} .= "LOGIN FAILED $user_id - course access denied"; + $self->{error} = $r->maketext("Authentication failed. Please speak to your instructor."); + return 0; + } + + unless ($authz->hasPermissions($user_id, "login")) { + $self->{log_error} .= "LOGIN FAILED $user_id - no permission to login"; + $self->{error} = $r->maketext("Authentication failed. Please speak to your instructor."); + return 0; + } + + debug("LTIAdvanced::check_user is about to return a 1."); + return 1; } # disable practice users -sub verify_practice_user { return(0) ;} +sub verify_practice_user { return (0); } sub verify_normal_user { - my $self = shift; - my ($r, $user_id, $session_key) - = map {$self->{$_};} ('r', 'user_id', 'session_key'); + my $self = shift; + my ($r, $user_id, $session_key) = map { $self->{$_}; } ('r', 'user_id', 'session_key'); - debug("LTIAdvanced::verify_normal_user called for user |$user_id|"); + debug("LTIAdvanced::verify_normal_user called for user |$user_id|"); - # See comment in get_credentials() - if ($r->{xmlrpc}) { - #debug("falling back to superclass verify_normal_user (xmlrpc call)"); - return $self->SUPER::verify_normal_user(@_); - } + # See comment in get_credentials() + if ($r->{xmlrpc}) { + #debug("falling back to superclass verify_normal_user (xmlrpc call)"); + return $self->SUPER::verify_normal_user(@_); + } - # Call check_session in order to destroy any existing session cookies and Key table sessions - my ($sessionExists, $keyMatches, $timestampValid) = $self->check_session($user_id, $session_key, 0); + # Call check_session in order to destroy any existing session cookies and Key table sessions + my ($sessionExists, $keyMatches, $timestampValid) = $self->check_session($user_id, $session_key, 0); - debug("sessionExists='", $sessionExists, "' keyMatches='", $keyMatches, "' timestampValid='", $timestampValid, "'"); + debug("sessionExists='", $sessionExists, "' keyMatches='", $keyMatches, "' timestampValid='", $timestampValid, "'"); - my $auth_result = $self->authenticate; + my $auth_result = $self->authenticate; - debug("auth_result=|${auth_result}|"); + debug("auth_result=|${auth_result}|"); - # Parameters CANNOT be modified until after LTIAdvanced authentication - # has been done, because the parameters passed with the request - # are used in computing the OAuth_signature. If there - # are any changes in $r->{paramcache} (see Request.pm) - # before authentication occurs, then authentication will FAIL - # even if the consumer_secret is correct. + # Parameters CANNOT be modified until after LTIAdvanced authentication + # has been done, because the parameters passed with the request + # are used in computing the OAuth_signature. If there + # are any changes in $r->{paramcache} (see Request.pm) + # before authentication occurs, then authentication will FAIL + # even if the consumer_secret is correct. - $r->param("user" => $user_id); + $r->param("user" => $user_id); - if ($auth_result eq "1") { - $self->{session_key} = $self->create_session($user_id); - debug("session_key=|" . $self->{session_key} . "|."); - return 1; - } else { - $self->{error} = $auth_result; - $self-> {log_error} .= "$user_id - authentication failed: ". $self->{error}; - return 0; - } + if ($auth_result eq "1") { + $self->{session_key} = $self->create_session($user_id); + debug("session_key=|" . $self->{session_key} . "|."); + return 1; + } else { + $self->{error} = $auth_result; + $self->{log_error} .= "$user_id - authentication failed: " . $self->{error}; + return 0; + } } sub authenticate { - my $self = shift; - my ($r, $user ) = map {$self->{$_};} ('r', 'user_id'); - - # See comment in get_credentials() - if ($r->{xmlrpc}) { - #debug("falling back to superclass authenticate (xmlrpc call)"); - return $self->SUPER::authenticate(@_); - } - - debug("LTIAdvanced::authenticate called for user |$user|"); - debug "ref(r) = |". ref($r) . "|"; - debug "ref of r->{paramcache} = |" . ref($r->{paramcache}) . "|"; - - my $ce = $r->ce; - my $db = $r->db; - my $courseName = $r->ce->{'courseName'}; - - # Check nonce to see whether request is legitimate - debug("Nonce = |" . $self-> {oauth_nonce} . "|"); - my $nonce = WeBWorK::Authen::LTIAdvanced::Nonce->new($r, $self->{oauth_nonce}, $self->{oauth_timestamp}); - if (!($nonce->ok ) ) { - $self->{error} .= $r->maketext("There was an error during the login process. Please speak to your instructor or system administrator if this recurs."); - debug("Failed to verify nonce"); - return 0; - } - - debug( "r->param(oauth_signature) = |" . $r->param("oauth_signature") . "|"); - my %request_hash; - my @keys = keys %{$r-> {paramcache}}; - foreach my $key (@keys) { - $request_hash{$key} = $r->param($key); - debug("$key->|" . $request_hash{$key} . "|"); - } - my $requestHash = \%request_hash; - - # We need to provide the request URL when verifying the OAuth request. - # We use the url request by default, but also allow it to be overriden - my $path = $ce->{server_root_url}.$ce->{webwork_url}; - $path = $ce->{LTIBasicToThisSiteURL} ? - $ce->{LTIBasicToThisSiteURL} : $path; - - # append the path the the server url - $path = $path.$r->urlpath()->path; - - if ( $ce->{debug_lti_parameters} ) { - warn("The following path was reconstructed by WeBWorK. It should match the path in the LMS:"); - warn($path); - } - - # We also try a version without the trailing / in case that was not - # included when the LMS user created the LMS link - my $altpath = $path; - $altpath =~ s/\/$//; - - my ($request, $altrequest); - eval { - $request = Net::OAuth->request("request token")->from_hash($requestHash, - request_url => $path, - request_method => "POST", - consumer_secret => $ce->{LTIBasicConsumerSecret}, - ); - - $altrequest = Net::OAuth->request("request token")->from_hash($requestHash, - request_url => $altpath, - request_method => "POST", - consumer_secret => $ce->{LTIBasicConsumerSecret}, - ); - }; - - if ($@) { - debug("construction of Net::OAuth object failed: $@"); - debug( "eval failed: ", $@, "

      "); - - $self->{error} .= $r->maketext("There was an error during the login process. Please speak to your instructor or system administrator."); - $self->{log_error} .= "Construction of OAuth request record failed"; - return 0; - } - - if (! $request->verify && ! $altrequest->verify) { - debug("LTIAdvanced::authenticate request-> verify failed"); - debug("OAuth verification Failed "); - - $self->{error} .= $r->maketext("There was an error during the login process. Please speak to your instructor or system administrator."); - $self->{log_error} .= "OAuth verification failed. Check the Consumer Secret and that the URL in the LMS exactly matches the WeBWorK URL."; - if ( $ce->{debug_lti_parameters} ) { - warn("OAuth verification failed. Check the Consumer Secret and that the URL in the LMS exactly matches the WeBWorK URL as defined in site.conf. E.G. Check that if you have https in the LMS url then you have https in \$server_root_url in site.conf"); - } - return 0; - } else { - debug("OAuth verification SUCCEEDED !!"); - - my $userID = $self->{user_id}; - - # Indentation of the internal blocks below was modified to follow - # the WW coding standard; however, the leading indentation of the - # if/elsif/closing '}' was kept as in the original code for now. - # Thus the apparenly overlarge indentation below. - if (! $db->existsUser($userID) ) { # New User. Create User record - if ( $ce->{block_lti_create_user} ) { - # We don't yet have the next string in the PO/POT files - so the next line is disabled. - # $r->maketext("Account creation is currently disabled in this course. Please speak to your instructor or system administrator."); - $self->{log_error} .= "Account creation blocked by block_lti_create_user setting. Did not create user $userID."; - if ( $ce->{debug_lti_parameters} ) { - warn("Account creation is currently disabled in this course. Please speak to your instructor or system administrator."); - } - return 0; - } else { - # Attempt to create the user, and warn if that fails. - unless ($self->create_user()) { - $r->maketext("There was an error during the login process. Please speak to your instructor or system administrator."); - $self->{log_error} .= "Failed to create user $userID."; - if ( $ce->{debug_lti_parameters} ) { - warn("Failed to create user $userID."); + my $self = shift; + my ($r, $user) = map { $self->{$_}; } ('r', 'user_id'); + + # See comment in get_credentials() + if ($r->{xmlrpc}) { + #debug("falling back to superclass authenticate (xmlrpc call)"); + return $self->SUPER::authenticate(@_); + } + + debug("LTIAdvanced::authenticate called for user |$user|"); + debug "ref(r) = |" . ref($r) . "|"; + debug "ref of r->{paramcache} = |" . ref($r->{paramcache}) . "|"; + + my $ce = $r->ce; + my $db = $r->db; + my $courseName = $r->ce->{'courseName'}; + + # Check nonce to see whether request is legitimate + debug("Nonce = |" . $self->{oauth_nonce} . "|"); + my $nonce = WeBWorK::Authen::LTIAdvanced::Nonce->new($r, $self->{oauth_nonce}, $self->{oauth_timestamp}); + if (!($nonce->ok)) { + $self->{error} .= $r->maketext( + "There was an error during the login process. Please speak to your instructor or system administrator if this recurs." + ); + debug("Failed to verify nonce"); + return 0; + } + + debug("r->param(oauth_signature) = |" . $r->param("oauth_signature") . "|"); + my %request_hash; + my @keys = keys %{ $r->{paramcache} }; + foreach my $key (@keys) { + $request_hash{$key} = $r->param($key); + debug("$key->|" . $request_hash{$key} . "|"); + } + my $requestHash = \%request_hash; + + # We need to provide the request URL when verifying the OAuth request. + # We use the url request by default, but also allow it to be overriden + my $path = $ce->{server_root_url} . $ce->{webwork_url}; + $path = $ce->{LTIBasicToThisSiteURL} ? $ce->{LTIBasicToThisSiteURL} : $path; + + # append the path the the server url + $path = $path . $r->urlpath()->path; + + if ($ce->{debug_lti_parameters}) { + warn("The following path was reconstructed by WeBWorK. It should match the path in the LMS:"); + warn($path); + } + + # We also try a version without the trailing / in case that was not + # included when the LMS user created the LMS link + my $altpath = $path; + $altpath =~ s/\/$//; + + my ($request, $altrequest); + eval { + $request = Net::OAuth->request("request token")->from_hash( + $requestHash, + request_url => $path, + request_method => "POST", + consumer_secret => $ce->{LTIBasicConsumerSecret}, + ); + + $altrequest = Net::OAuth->request("request token")->from_hash( + $requestHash, + request_url => $altpath, + request_method => "POST", + consumer_secret => $ce->{LTIBasicConsumerSecret}, + ); + }; + + if ($@) { + debug("construction of Net::OAuth object failed: $@"); + debug("eval failed: ", $@, "

      "); + + $self->{error} .= $r->maketext( + "There was an error during the login process. Please speak to your instructor or system administrator."); + $self->{log_error} .= "Construction of OAuth request record failed"; + return 0; + } + + if (!$request->verify && !$altrequest->verify) { + debug("LTIAdvanced::authenticate request-> verify failed"); + debug("OAuth verification Failed "); + + $self->{error} .= $r->maketext( + "There was an error during the login process. Please speak to your instructor or system administrator."); + $self->{log_error} .= + "OAuth verification failed. Check the Consumer Secret and that the URL in the LMS exactly matches the WeBWorK URL."; + if ($ce->{debug_lti_parameters}) { + warn( + "OAuth verification failed. Check the Consumer Secret and that the URL in the LMS exactly matches the WeBWorK URL as defined in site.conf. E.G. Check that if you have https in the LMS url then you have https in \$server_root_url in site.conf" + ); + } + return 0; + } else { + debug("OAuth verification SUCCEEDED !!"); + + my $userID = $self->{user_id}; + + # Indentation of the internal blocks below was modified to follow + # the WW coding standard; however, the leading indentation of the + # if/elsif/closing '}' was kept as in the original code for now. + # Thus the apparenly overlarge indentation below. + if (!$db->existsUser($userID)) { # New User. Create User record + if ($ce->{block_lti_create_user}) { +# We don't yet have the next string in the PO/POT files - so the next line is disabled. +# $r->maketext("Account creation is currently disabled in this course. Please speak to your instructor or system administrator."); + $self->{log_error} .= + "Account creation blocked by block_lti_create_user setting. Did not create user $userID."; + if ($ce->{debug_lti_parameters}) { + warn( + "Account creation is currently disabled in this course. Please speak to your instructor or system administrator." + ); } + return 0; + } else { + # Attempt to create the user, and warn if that fails. + unless ($self->create_user()) { + $r->maketext( + "There was an error during the login process. Please speak to your instructor or system administrator." + ); + $self->{log_error} .= "Failed to create user $userID."; + if ($ce->{debug_lti_parameters}) { + warn("Failed to create user $userID."); + } + } + } + } elsif ($ce->{LMSManageUserData}) { + $self->{initial_login} = 1 + ; # Set here so login gets logged, even for accounts which maybe_update_user() would not modify or when it fails to update + # Existing user. Possibly modify demographic information and permission level. + unless ($self->maybe_update_user()) { + # Do not fail the login if data update failed + # FIXME - In the future we would like the message below (and other warn messages in this file) to be sent via maketext. + warn( + "The system failed to update some of your account information. Please speak to your instructor or system administrator." + ); } + } else { + $self->{initial_login} = 1; # Set here so login gets logged when $ce->{LMSManageUserData} is false } - } elsif ($ce->{LMSManageUserData}) { - $self->{initial_login} = 1; # Set here so login gets logged, even for accounts which maybe_update_user() would not modify or when it fails to update - # Existing user. Possibly modify demographic information and permission level. - unless ( $self->maybe_update_user() ) { - # Do not fail the login if data update failed - # FIXME - In the future we would like the message below (and other warn messages in this file) to be sent via maketext. - warn("The system failed to update some of your account information. Please speak to your instructor or system administrator."); + + # If we are using grade passback then make sure the data + # we need to submit the grade is kept up to date. + my $LTIGradeMode = $ce->{LTIGradeMode} // ''; + if ($LTIGradeMode eq 'course' + || $LTIGradeMode eq 'homework') + { + my $submitGrade = WeBWorK::Authen::LTIAdvanced::SubmitGrade->new($r); + $submitGrade->update_sourcedid($userID); } - } else { - $self->{initial_login} = 1; # Set here so login gets logged when $ce->{LMSManageUserData} is false - } - - # If we are using grade passback then make sure the data - # we need to submit the grade is kept up to date. - my $LTIGradeMode = $ce->{LTIGradeMode} // ''; - if ($LTIGradeMode eq 'course' || - $LTIGradeMode eq 'homework') { - my $submitGrade = WeBWorK::Authen::LTIAdvanced::SubmitGrade->new($r); - $submitGrade->update_sourcedid($userID); - } - - return 1; - } - - debug("LTIAdvanced is returning a failed authentication"); - $self->{error} = $r->maketext("There was an error during the login process. Please speak to your instructor or system administrator."); - return(0); + + return 1; + } + + debug("LTIAdvanced is returning a failed authentication"); + $self->{error} = $r->maketext( + "There was an error during the login process. Please speak to your instructor or system administrator."); + return (0); } # create a new user trying to log in sub create_user { - my $self = shift; - my $r = $self->{r}; - my $userID = $self->{user_id}; - my $ce = $r->ce; - my $db = $r->db; - my $courseName = $r->ce->{'courseName'}; - - ############################################################ - # Determine the roles defined for this user by the LTI request - # and assign a permission level on that basis. - ############################################################ - my $LTIrolesString = $r->param("roles"); - my @LTIroles = split /,/, $LTIrolesString; - - #remove the urn string if its present - s/^urn:lti:.*:ims\/lis\/// for @LTIroles; - - if ( $ce->{debug_lti_parameters} ) { - warn "The adjusted LTI roles defined for this user are: \n--", - join("\n--", @LTIroles), "\n", - "Any initial ^urn:lti:.*:ims/lis/ segments have been stripped off.\n", - "The user will be assigned the highest role defined for them\n", - "========================\n" - } - - my $nr = scalar(@LTIroles); - if (! defined($ce->{userRoles}->{$ce->{LMSrolesToWeBWorKroles}->{$LTIroles[0]}})) { - croak("Cannot find a WeBWorK role that corresponds to the LMS role of " - . $LTIroles[0] ."."); - } - - my $LTI_webwork_permissionLevel - = $ce->{userRoles}->{$ce->{LMSrolesToWeBWorKroles}->{$LTIroles[0]}}; - if ($nr > 1) { - for (my $j =1; $j < $nr; $j++) { - my $wwRole = $ce->{LMSrolesToWeBWorKroles}->{$LTIroles[$j]}; - next unless defined $wwRole; - if ($LTI_webwork_permissionLevel < $ce->{userRoles}->{$wwRole}) { - $LTI_webwork_permissionLevel = $ce->{userRoles}->{$wwRole}; - } - } - } - - ####### End defining roles and $LTI_webwork_permissionLevel####### - - - warn "New user: $userID -- requested permission level is $LTI_webwork_permissionLevel." if ( $ce->{debug_lti_parameters} ); - - # We dont create users with too high of a permission level - # for security reasons. - if ($LTI_webwork_permissionLevel > $ce->{userRoles}->{$ce->{LTIAccountCreationCutoff}}) { - $self->{log_error}.= "userID: $userID -- Unknown instructor attempting to log in via LTI. Instructor accounts must be created manually"; - croak $r->maketext("The instructor account with user id [_1] does not exist. Please create the account manually via WeBWorK.",$userID); - return 0; - } - - my $newUser = $db->newUser(); - $newUser->user_id($userID); - $self->{last_name} =~ s/\+/ /g; - $newUser->last_name($self->{last_name}); - $self->{first_name} =~ s/\+/ /g; - $newUser->first_name($self->{first_name}); - $newUser->email_address($self->{email}); - $newUser->status("C"); - $newUser-> section($self->{section} // ""); - $newUser->recitation($self->{recitation} // ""); - $newUser->comment(formatDateTime(time, "local")); - $newUser->student_id($self->{student_id} // ""); - - # Allow sites to customize the user - if (defined($ce->{LTI_modify_user})) { - $ce->{LTI_modify_user}($self,$newUser); - } - - $db->addUser($newUser); - $self->write_log_entry("New user $userID added via LTIAdvanced login"); - - # Assign permssion level - my $newPermissionLevel = $db->newPermissionLevel(); - $newPermissionLevel->user_id($userID); - $newPermissionLevel->permission($LTI_webwork_permissionLevel); - $db->addPermissionLevel($newPermissionLevel); - $r->authz->{PermissionLevel} = $newPermissionLevel; #cache the Permission Level Record. - - - # Assign existing sets - my $instructorTools = WeBWorK::ContentGenerator::Instructor->new($r); - my @setsToAssign = (); - - my @globalSetIDs = $db->listGlobalSets; - my @GlobalSets = $db->getGlobalSets(@globalSetIDs); - foreach my $globalSet (@GlobalSets) { - # assign all visible or "published" sets - if ($globalSet->visible) { - push @setsToAssign, $globalSet; - $instructorTools->assignSetToUser($userID,$globalSet); - } - } - $self->{numberOfSetsAssigned} = scalar @setsToAssign; + my $self = shift; + my $r = $self->{r}; + my $userID = $self->{user_id}; + my $ce = $r->ce; + my $db = $r->db; + my $courseName = $r->ce->{'courseName'}; + + ############################################################ + # Determine the roles defined for this user by the LTI request + # and assign a permission level on that basis. + ############################################################ + my $LTIrolesString = $r->param("roles"); + my @LTIroles = split /,/, $LTIrolesString; + + #remove the urn string if its present + s/^urn:lti:.*:ims\/lis\/// for @LTIroles; + + if ($ce->{debug_lti_parameters}) { + warn "The adjusted LTI roles defined for this user are: \n--", + join("\n--", @LTIroles), "\n", + "Any initial ^urn:lti:.*:ims/lis/ segments have been stripped off.\n", + "The user will be assigned the highest role defined for them\n", + "========================\n"; + } + + my $nr = scalar(@LTIroles); + if (!defined($ce->{userRoles}->{ $ce->{LMSrolesToWeBWorKroles}->{ $LTIroles[0] } })) { + croak("Cannot find a WeBWorK role that corresponds to the LMS role of " . $LTIroles[0] . "."); + } + + my $LTI_webwork_permissionLevel = $ce->{userRoles}->{ $ce->{LMSrolesToWeBWorKroles}->{ $LTIroles[0] } }; + if ($nr > 1) { + for (my $j = 1; $j < $nr; $j++) { + my $wwRole = $ce->{LMSrolesToWeBWorKroles}->{ $LTIroles[$j] }; + next unless defined $wwRole; + if ($LTI_webwork_permissionLevel < $ce->{userRoles}->{$wwRole}) { + $LTI_webwork_permissionLevel = $ce->{userRoles}->{$wwRole}; + } + } + } + + ####### End defining roles and $LTI_webwork_permissionLevel####### + + warn "New user: $userID -- requested permission level is $LTI_webwork_permissionLevel." + if ($ce->{debug_lti_parameters}); + + # We dont create users with too high of a permission level + # for security reasons. + if ($LTI_webwork_permissionLevel > $ce->{userRoles}->{ $ce->{LTIAccountCreationCutoff} }) { + $self->{log_error} .= + "userID: $userID -- Unknown instructor attempting to log in via LTI. Instructor accounts must be created manually"; + croak $r->maketext( + "The instructor account with user id [_1] does not exist. Please create the account manually via WeBWorK.", + $userID + ); + return 0; + } + + my $newUser = $db->newUser(); + $newUser->user_id($userID); + $self->{last_name} =~ s/\+/ /g; + $newUser->last_name($self->{last_name}); + $self->{first_name} =~ s/\+/ /g; + $newUser->first_name($self->{first_name}); + $newUser->email_address($self->{email}); + $newUser->status("C"); + $newUser->section($self->{section} // ""); + $newUser->recitation($self->{recitation} // ""); + $newUser->comment(formatDateTime(time, "local")); + $newUser->student_id($self->{student_id} // ""); + + # Allow sites to customize the user + if (defined($ce->{LTI_modify_user})) { + $ce->{LTI_modify_user}($self, $newUser); + } + + $db->addUser($newUser); + $self->write_log_entry("New user $userID added via LTIAdvanced login"); + + # Assign permssion level + my $newPermissionLevel = $db->newPermissionLevel(); + $newPermissionLevel->user_id($userID); + $newPermissionLevel->permission($LTI_webwork_permissionLevel); + $db->addPermissionLevel($newPermissionLevel); + $r->authz->{PermissionLevel} = $newPermissionLevel; #cache the Permission Level Record. + + # Assign existing sets + my $instructorTools = WeBWorK::ContentGenerator::Instructor->new($r); + my @setsToAssign = (); + + my @globalSetIDs = $db->listGlobalSets; + my @GlobalSets = $db->getGlobalSets(@globalSetIDs); + foreach my $globalSet (@GlobalSets) { + # assign all visible or "published" sets + if ($globalSet->visible) { + push @setsToAssign, $globalSet; + $instructorTools->assignSetToUser($userID, $globalSet); + } + } + $self->{numberOfSetsAssigned} = scalar @setsToAssign; # Assign all existing achievements my @achievementIDs = $db->listAchievements; @@ -663,90 +694,94 @@ sub create_user { $globalUserAchievement->achievement_points(0); $db->addGlobalUserAchievement($globalUserAchievement); - # Give schools the chance to modify newly added sets - if (defined($ce->{LTI_modify_user_set})) { - foreach my $globalSet (@setsToAssign) { - my $userSet = $db->getUserSet($userID,$globalSet->set_id); - next unless $userSet; + # Give schools the chance to modify newly added sets + if (defined($ce->{LTI_modify_user_set})) { + foreach my $globalSet (@setsToAssign) { + my $userSet = $db->getUserSet($userID, $globalSet->set_id); + next unless $userSet; - $ce->{LTI_modify_user_set}($self,$globalSet,$userSet); - $db->putUserSet($userSet); - } - } + $ce->{LTI_modify_user_set}($self, $globalSet, $userSet); + $db->putUserSet($userSet); + } + } - $self->{initial_login} = 1; + $self->{initial_login} = 1; - return 1; + return 1; } # possibly update a user logging in sub maybe_update_user { - my $self = shift; - my $r = $self->{r}; - my $userID = $self->{user_id}; - my $ce = $r->ce; - my $db = $r->db; - my $courseName = $r->ce->{'courseName'}; - - my $user = $db->getUser($userID); - my $permissionLevel = $db->getPermissionLevel($userID); - # We don't alter records of users with too high a permission - if (defined($permissionLevel->permission) && - $permissionLevel->permission > $ce->{userRoles}->{$ce->{LTIAccountCreationCutoff}}) { - return 1; # Treat as OK as not allowed to modify - } else { - # Create a temp user and run it through the create process - my $tempUser = $db->newUser(); - $tempUser->user_id($userID); - my $last_name = $self->{last_name} // ''; - $last_name =~ s/\+/ /g; - $tempUser->last_name($last_name); - my $first_name = $self->{first_name} // ''; - $first_name =~ s/\+/ /g; - $tempUser->first_name($first_name); - $tempUser->email_address($self->{email}); - $tempUser->status("C"); - $tempUser->section($self->{section} // ""); - $tempUser->recitation($self->{recitation} // ""); - $tempUser->student_id($self->{student_id} // ""); - - # Allow sites to customize the temp user - if (defined($ce->{LTI_modify_user})) { - $ce->{LTI_modify_user}($self,$tempUser); - } - - my @elements = qw(last_name first_name - email_address status - section recitation student_id); - - my $change_made = 0; - - for my $element (@elements) { - if ($user->$element ne $tempUser->$element) { - $change_made = 1; - warn "WeBWorK User has $element: ".$user->$element." but LMS user has $element ".$tempUser->$element."\n" - if ( $ce->{debug_lti_parameters} ); - } - } - - if ($change_made) { - $tempUser->comment(formatDateTime(time, "local")); - eval { $db->putUser($tempUser) }; - if ($@) { - $self->write_log_entry("Failed to update user $userID in LTIAdvanced login: $@"); - warn "Failed to update user $userID in LTIAdvanced login.\n" - if ( $ce->{debug_lti_parameters} ); - return 0; - } else { - $self->write_log_entry("Demographic data for user $userID modified via LTIAdvanced login"); - warn "Existing user: $userID updated.\n" - if ( $ce->{debug_lti_parameters} ); - return 1; - } - } else { - return 1; # No changes needed - } - } + my $self = shift; + my $r = $self->{r}; + my $userID = $self->{user_id}; + my $ce = $r->ce; + my $db = $r->db; + my $courseName = $r->ce->{'courseName'}; + + my $user = $db->getUser($userID); + my $permissionLevel = $db->getPermissionLevel($userID); + # We don't alter records of users with too high a permission + if (defined($permissionLevel->permission) + && $permissionLevel->permission > $ce->{userRoles}->{ $ce->{LTIAccountCreationCutoff} }) + { + return 1; # Treat as OK as not allowed to modify + } else { + # Create a temp user and run it through the create process + my $tempUser = $db->newUser(); + $tempUser->user_id($userID); + my $last_name = $self->{last_name} // ''; + $last_name =~ s/\+/ /g; + $tempUser->last_name($last_name); + my $first_name = $self->{first_name} // ''; + $first_name =~ s/\+/ /g; + $tempUser->first_name($first_name); + $tempUser->email_address($self->{email}); + $tempUser->status("C"); + $tempUser->section($self->{section} // ""); + $tempUser->recitation($self->{recitation} // ""); + $tempUser->student_id($self->{student_id} // ""); + + # Allow sites to customize the temp user + if (defined($ce->{LTI_modify_user})) { + $ce->{LTI_modify_user}($self, $tempUser); + } + + my @elements = qw(last_name first_name + email_address status + section recitation student_id); + + my $change_made = 0; + + for my $element (@elements) { + if ($user->$element ne $tempUser->$element) { + $change_made = 1; + warn "WeBWorK User has $element: " + . $user->$element + . " but LMS user has $element " + . $tempUser->$element . "\n" + if ($ce->{debug_lti_parameters}); + } + } + + if ($change_made) { + $tempUser->comment(formatDateTime(time, "local")); + eval { $db->putUser($tempUser) }; + if ($@) { + $self->write_log_entry("Failed to update user $userID in LTIAdvanced login: $@"); + warn "Failed to update user $userID in LTIAdvanced login.\n" + if ($ce->{debug_lti_parameters}); + return 0; + } else { + $self->write_log_entry("Demographic data for user $userID modified via LTIAdvanced login"); + warn "Existing user: $userID updated.\n" + if ($ce->{debug_lti_parameters}); + return 1; + } + } else { + return 1; # No changes needed + } + } } ################################################################################ @@ -756,82 +791,83 @@ sub maybe_update_user { package WeBWorK::Authen::LTIAdvanced::Nonce; # This controls how often the key database is scrubbed for old nonce's -use constant NONCE_PURGE_FREQUENCY => 7200; # 2 hours +use constant NONCE_PURGE_FREQUENCY => 7200; # 2 hours # This controls how old a nonce is before it is purged -use constant NONCE_LIFETIME => 21600; # 6 hours +use constant NONCE_LIFETIME => 21600; # 6 hours sub new { - my ($invocant, $r, $nonce, $timestamp) = @_; - my $class = ref($invocant) || $invocant; - my $self = { - r => $r, - nonce => $nonce, - timestamp => $timestamp, - }; - bless $self, $class; - return $self; + my ($invocant, $r, $nonce, $timestamp) = @_; + my $class = ref($invocant) || $invocant; + my $self = { + r => $r, + nonce => $nonce, + timestamp => $timestamp, + }; + bless $self, $class; + return $self; } sub ok { - my $self = shift; - my $r = $self->{r}; - my $ce = $r->{ce}; - my $db = $self->{r}->{db}; - - $self->maybe_purge_nonces(); - - if ($self->{timestamp} < time() - $ce->{NonceLifeTime}) { - if ( $ce->{debug_lti_parameters} ) { - warn("Nonce Expired. Your NonceLifeTime may be too short"); - } - return 0; - } - - my $Key = $db->getKey($self->{nonce}); - # If we *haven't* used this nonce before then we are OK. - if (! defined($Key) ) { - # nonce, timestamp are ok. Add the nonce so its not used again - $Key = $db->newKey(user_id=>$self->{nonce}, - key=>"nonce", - timestamp=>$self->{"timestamp"}, - ); - $db->addKey($Key); - return 1; - } else { - # The nonce is in the database - so was used "recently" so should NOT be allowed - if ( $Key->timestamp < $self->{"timestamp"} ) { - # Update timestamp - so deletion will be delayed from the most recent value - # of oauth_timestamp sent by the LTI consumer and not from an earlier timestamp. - $Key->timestamp($self->{"timestamp"}); - $db->putKey($Key); - } - return 0; - } + my $self = shift; + my $r = $self->{r}; + my $ce = $r->{ce}; + my $db = $self->{r}->{db}; + + $self->maybe_purge_nonces(); + + if ($self->{timestamp} < time() - $ce->{NonceLifeTime}) { + if ($ce->{debug_lti_parameters}) { + warn("Nonce Expired. Your NonceLifeTime may be too short"); + } + return 0; + } + + my $Key = $db->getKey($self->{nonce}); + # If we *haven't* used this nonce before then we are OK. + if (!defined($Key)) { + # nonce, timestamp are ok. Add the nonce so its not used again + $Key = $db->newKey( + user_id => $self->{nonce}, + key => "nonce", + timestamp => $self->{"timestamp"}, + ); + $db->addKey($Key); + return 1; + } else { + # The nonce is in the database - so was used "recently" so should NOT be allowed + if ($Key->timestamp < $self->{"timestamp"}) { + # Update timestamp - so deletion will be delayed from the most recent value + # of oauth_timestamp sent by the LTI consumer and not from an earlier timestamp. + $Key->timestamp($self->{"timestamp"}); + $db->putKey($Key); + } + return 0; + } } sub maybe_purge_nonces { - my $self = shift; - my $r = $self->{r}; - my $ce = $r->{ce}; - my $db = $self->{r}->{db}; - my $time = time; - my $lastPurge = $db->getSettingValue('lastNoncePurge'); - - # only purge if the last purge was never or over NONCE_PURGE_FREQUENCY ago - if ( !defined($lastPurge) || ( $time - $lastPurge > NONCE_PURGE_FREQUENCY ) ) { - my @userIDs = $db->listKeys(); - my @Keys = $db->getKeys(@userIDs); - - # Delete any "nonce" keys that are older than NONCE_LIFETIME - foreach my $Key (@Keys) { - if ($Key->key eq "nonce" && ($time-$Key->timestamp > NONCE_LIFETIME)) { - $db->deleteKey($Key->user_id); - } - } - - $db->setSettingValue('lastNoncePurge',$time); - } + my $self = shift; + my $r = $self->{r}; + my $ce = $r->{ce}; + my $db = $self->{r}->{db}; + my $time = time; + my $lastPurge = $db->getSettingValue('lastNoncePurge'); + + # only purge if the last purge was never or over NONCE_PURGE_FREQUENCY ago + if (!defined($lastPurge) || ($time - $lastPurge > NONCE_PURGE_FREQUENCY)) { + my @userIDs = $db->listKeys(); + my @Keys = $db->getKeys(@userIDs); + + # Delete any "nonce" keys that are older than NONCE_LIFETIME + foreach my $Key (@Keys) { + if ($Key->key eq "nonce" && ($time - $Key->timestamp > NONCE_LIFETIME)) { + $db->deleteKey($Key->user_id); + } + } + + $db->setSettingValue('lastNoncePurge', $time); + } } diff --git a/lib/WeBWorK/Authen/LTIAdvanced/SubmitGrade.pm b/lib/WeBWorK/Authen/LTIAdvanced/SubmitGrade.pm index 4fd71a8a80..1b34c1f1b8 100644 --- a/lib/WeBWorK/Authen/LTIAdvanced/SubmitGrade.pm +++ b/lib/WeBWorK/Authen/LTIAdvanced/SubmitGrade.pm @@ -22,7 +22,6 @@ WeBWorK::Authen::LTIAdvanced::SubmitGrade - pass back grades to an enabled LMS =cut - use strict; use warnings; use WeBWorK::Debug; @@ -32,155 +31,160 @@ use WeBWorK::Utils qw(grade_set grade_gateway grade_all_sets wwRound); use Net::OAuth; use HTTP::Request; use LWP::UserAgent; -use UUID::Tiny ':std'; +use UUID::Tiny ':std'; use Digest::SHA qw(sha1_base64); # This package contains utilities for submitting grades to the LMS sub new { - my ($invocant, $r) = @_; - my $class = ref($invocant) || $invocant; - my $self = { - r => $r, - }; - # sanity check - my $ce = $r->{ce}; - my $db = $self->{r}->{db}; - - unless (ref($ce//'') and ref($db)//'') { - warn("course environment is not defined") unless ref($ce//''); - warn("database reference is not defined") unless ref($db//''); - croak("Could not create WeBWorK::Authen::LTIAdvanced::SubmitGrade object, missing items from request"); - } - - bless $self, $class; - return $self; + my ($invocant, $r) = @_; + my $class = ref($invocant) || $invocant; + my $self = { r => $r, }; + # sanity check + my $ce = $r->{ce}; + my $db = $self->{r}->{db}; + + unless (ref($ce // '') and ref($db) // '') { + warn("course environment is not defined") unless ref($ce // ''); + warn("database reference is not defined") unless ref($db // ''); + croak("Could not create WeBWorK::Authen::LTIAdvanced::SubmitGrade object, missing items from request"); + } + + bless $self, $class; + return $self; } # This updates the sourcedid for the object we are looking at. Its either # the sourcedid for the user for course grades or the sourcedid for the # userset for homework grades. sub update_sourcedid { - my $self = shift; - my $userID = shift; - my $r = $self->{r}; - my $ce = $r->{ce}; - my $db = $self->{r}->{db}; - - # These parameters are used to build the passback request - # warn if no outcome service url - if (!defined($r->param('lis_outcome_service_url'))) { - carp "The parameter lis_outcome_service_url is not defined. Unable to report grades to the LMS.". - " Are external grades enabled in the LMS?" if $ce->{debug_lti_grade_passback}; - } else { - # otherwise keep it up to date - my $lis_outcome_service_url = $db->getSettingValue('lis_outcome_service_url'); - if (!defined($lis_outcome_service_url) || - $lis_outcome_service_url ne $r->param('lis_outcome_service_url')) { - $db->setSettingValue('lis_outcome_service_url', - $r->param('lis_outcome_service_url')); - } - } - - # these parameters have to be here or we couldn't have gotten this far - my $consumer_key = $db->getSettingValue('consumer_key'); - if (!defined($consumer_key) || - $consumer_key ne $r->param('oauth_consumer_key')) { - $db->setSettingValue('consumer_key', - $r->param('oauth_consumer_key')); - } - - my $signature_method = $db->getSettingValue('signature_method'); - if (!defined($signature_method) || - $signature_method ne $r->param('oauth_signature_method')) { - $db->setSettingValue('signature_method', - $r->param('oauth_signature_method')); - } - - # The $sourcedid is what identifies the user and assignment - # to the LMS. It is either a course grade or a set grade - # depending on the request and the mode we are in. - my $sourcedid = $r->param('lis_result_sourcedid'); - if (!defined($sourcedid)) { - warn "No LISSourceID! Some LMS's do not give grades to instructors, but this ". - "could also be a sign that external grades are not enabled in your LMS." if $ce->{debug_lti_grade_passback}; - } elsif ($ce->{LTIGradeMode} eq 'course') { - # Update the SourceDID for the user if we are in course mode - my $User = $db->getUser($userID); - if (!defined($User->lis_source_did) || $User->lis_source_did ne $sourcedid) { - $User->lis_source_did($sourcedid); - $db->putUser($User); - } - } elsif ($ce->{LTIGradeMode} eq 'homework') { - my $urlpath = $r->urlpath; - my $setID = $urlpath->arg("setID"); - if (!defined($setID)) { - warn "Not a link to a Problem Set and in homework grade mode.". - " Links to WeBWorK should point to specific problem sets."; - } else { - my $set = $db->getUserSet($userID,$setID); - # if set is not defined and we are going to a page with - # is set dependent then there are problems that will be caught - # later - if (defined($set) && - (!defined($set->lis_source_did) || - $set->lis_source_did ne $sourcedid)) { - $set->lis_source_did($sourcedid); - $db->putUserSet($set); - - } - } - } -} # end update_sourcedid + my $self = shift; + my $userID = shift; + my $r = $self->{r}; + my $ce = $r->{ce}; + my $db = $self->{r}->{db}; + + # These parameters are used to build the passback request + # warn if no outcome service url + if (!defined($r->param('lis_outcome_service_url'))) { + carp "The parameter lis_outcome_service_url is not defined. Unable to report grades to the LMS." + . " Are external grades enabled in the LMS?" + if $ce->{debug_lti_grade_passback}; + } else { + # otherwise keep it up to date + my $lis_outcome_service_url = $db->getSettingValue('lis_outcome_service_url'); + if (!defined($lis_outcome_service_url) + || $lis_outcome_service_url ne $r->param('lis_outcome_service_url')) + { + $db->setSettingValue('lis_outcome_service_url', $r->param('lis_outcome_service_url')); + } + } + + # these parameters have to be here or we couldn't have gotten this far + my $consumer_key = $db->getSettingValue('consumer_key'); + if (!defined($consumer_key) + || $consumer_key ne $r->param('oauth_consumer_key')) + { + $db->setSettingValue('consumer_key', $r->param('oauth_consumer_key')); + } + + my $signature_method = $db->getSettingValue('signature_method'); + if (!defined($signature_method) + || $signature_method ne $r->param('oauth_signature_method')) + { + $db->setSettingValue('signature_method', $r->param('oauth_signature_method')); + } + + # The $sourcedid is what identifies the user and assignment + # to the LMS. It is either a course grade or a set grade + # depending on the request and the mode we are in. + my $sourcedid = $r->param('lis_result_sourcedid'); + if (!defined($sourcedid)) { + warn "No LISSourceID! Some LMS's do not give grades to instructors, but this " + . "could also be a sign that external grades are not enabled in your LMS." + if $ce->{debug_lti_grade_passback}; + } elsif ($ce->{LTIGradeMode} eq 'course') { + # Update the SourceDID for the user if we are in course mode + my $User = $db->getUser($userID); + if (!defined($User->lis_source_did) || $User->lis_source_did ne $sourcedid) { + $User->lis_source_did($sourcedid); + $db->putUser($User); + } + } elsif ($ce->{LTIGradeMode} eq 'homework') { + my $urlpath = $r->urlpath; + my $setID = $urlpath->arg("setID"); + if (!defined($setID)) { + warn "Not a link to a Problem Set and in homework grade mode." + . " Links to WeBWorK should point to specific problem sets."; + } else { + my $set = $db->getUserSet($userID, $setID); + # if set is not defined and we are going to a page with + # is set dependent then there are problems that will be caught + # later + if ( + defined($set) + && (!defined($set->lis_source_did) + || $set->lis_source_did ne $sourcedid) + ) + { + $set->lis_source_did($sourcedid); + $db->putUserSet($set); + + } + } + } +} # end update_sourcedid # computes and submits the course grade for userID to the LMS # the course grade is the average of all sets assigned to the user. sub submit_course_grade { - my $self = shift; - my $userID = shift; - my $r = $self->{r}; - my $ce = $r->{ce}; - my $db = $self->{r}->{db}; - - my $score = grade_all_sets($db,$userID); - my $user = $db->getUser($userID); - - die("$userID does not exist") unless $user; - warn "submitting all grades for user: $userID \n" if $ce->{debug_lti_grade_passback}; - warn "lis_source_did is not available for user: $userID \n" if !($user->lis_source_did) and $ce->{debug_lti_grade_passback}; - return $self->submit_grade($user->lis_source_did,$score); + my $self = shift; + my $userID = shift; + my $r = $self->{r}; + my $ce = $r->{ce}; + my $db = $self->{r}->{db}; + + my $score = grade_all_sets($db, $userID); + my $user = $db->getUser($userID); + + die("$userID does not exist") unless $user; + warn "submitting all grades for user: $userID \n" if $ce->{debug_lti_grade_passback}; + warn "lis_source_did is not available for user: $userID \n" + if !($user->lis_source_did) + and $ce->{debug_lti_grade_passback}; + return $self->submit_grade($user->lis_source_did, $score); } # computes and submits the set grade for $userID and $setID to the # LMS. For gateways the best score is used. sub submit_set_grade { - my $self = shift; - my $userID = shift; - my $setID = shift; - my $r = $self->{r}; - my $ce = $r->{ce}; - my $db = $self->{r}->{db}; - - my $user = $db->getUser($userID); - - die("$userID does not exist") unless $user; - - my $userSet = $db->getMergedSet($userID,$setID); - my $score = 0; - - if ($userSet->assignment_type() =~ /gateway/) { - $score = grade_gateway($db,$userSet,$userSet->set_id,$userID); - } else { - $score = grade_set($db, $userSet, $userID, 0); - } - # make debug prettier - my $message_string = ''; - $message_string .= "\nmass_update: " if $self->{post_processing_mode}; - $message_string .= "submitting grade for user: $userID set $setID "; - $message_string .= "-- lis_source_did is not available " unless ($userSet->lis_source_did); - warn($message_string."\n") if $ce->{debug_lti_grade_passback}; - return $self->submit_grade($userSet->lis_source_did,$score); + my $self = shift; + my $userID = shift; + my $setID = shift; + my $r = $self->{r}; + my $ce = $r->{ce}; + my $db = $self->{r}->{db}; + + my $user = $db->getUser($userID); + + die("$userID does not exist") unless $user; + + my $userSet = $db->getMergedSet($userID, $setID); + my $score = 0; + + if ($userSet->assignment_type() =~ /gateway/) { + $score = grade_gateway($db, $userSet, $userSet->set_id, $userID); + } else { + $score = grade_set($db, $userSet, $userID, 0); + } + # make debug prettier + my $message_string = ''; + $message_string .= "\nmass_update: " if $self->{post_processing_mode}; + $message_string .= "submitting grade for user: $userID set $setID "; + $message_string .= "-- lis_source_did is not available " unless ($userSet->lis_source_did); + warn($message_string . "\n") if $ce->{debug_lti_grade_passback}; + return $self->submit_grade($userSet->lis_source_did, $score); } # error in reporting michael.gage@rochester.edu, Demo, Global $r object is not available. Set: @@ -188,84 +192,84 @@ sub submit_set_grade { # in httpd.conf at /opt/rh/perl516/root/usr/local/share/perl5/CGI.pm line 346, line 76. # so we don't use CGI::escapeHTML in post processing mode but use this local version instead. -sub local_escape_html { # a local version of escapeHTML that works for post processing - my $self = shift; # a grading object +sub local_escape_html { # a local version of escapeHTML that works for post processing + my $self = shift; # a grading object my @message = @_; if ($self->{post_processing_mode}) { return join('', @message); # this goes to log files in post processing to escapeHTML is not essential } else { - return CGI::escapeHTML(@message); #FIXME -- why won't this work in post_processing_mode (missing $r ??) + return CGI::escapeHTML(@message); #FIXME -- why won't this work in post_processing_mode (missing $r ??) } } # submits a score of $score to the lms with $sourcedid as the # identifier. sub submit_grade { - my $self = shift; - my $sourcedid = shift; - my $score = shift; - my $r = $self->{r}; - my $ce = $r->{ce}; - my $db = $self->{r}->{db}; - - $score = wwRound(2,$score); - - # We have to fail gracefully here because some users, like instructors, - # may not actually have a sourcedid - if (!$sourcedid) { -# debug("No sourcedid for this user/assignment. Some LMS's do not provide ". -# "sourcedid for instructors so this may not be a problem, or it might ". -# "mean your settings are not correct.") if $ce->{debug_lti_grade_passback}; - return 0; - } - - # Needed in both phases - my $bodyhash; - my $requestGen; - my $gradeRequest; - my $HTTPRequest; - my $response; - - my $request_url = $db->getSettingValue('lis_outcome_service_url'); - if ( !defined($request_url) || $request_url eq "" ) { - warn("Cannot send/retrieve grades to/from the LMS, no lis_outcome_service_url"); - return 0; - } - - my $consumer_key = $db->getSettingValue('consumer_key'); - if ( !defined($consumer_key) || $consumer_key eq "" ) { - warn("Cannot send/retrieve grades to/from the LMS, no consumer_key"); - return 0; - } - - my $signature_method = $db->getSettingValue('signature_method'); - if ( !defined($signature_method) || $signature_method eq "" ) { - warn("Cannot send/retrieve grades to/from the LMS, no signature_method"); - return 0; - } - - debug("found data required for submitting grades to LMS"); - - # Generate a better nonce, first a portion unique for the sourcedid - # which should be dependent on the student + the assignment if a - # "homework" level sourcedid. This part can be used twice - my $uuid_p1 = create_uuid_as_string(UUID_SHA1, UUID_NS_URL, $sourcedid); - - # Second part is a time dependent portion - my $uuid_p2 = create_uuid_as_string(UUID_TIME); - - my $lti_check_prior = $ce->{lti_check_prior} // 0; # Should we first poll the LMS for the current grade - - my $lti_do_send = 1; # Default to yes - - if ( $lti_check_prior ) { - - # Poll the LMS for prior grade - - $lti_do_send = 0; # Change default to no, and change below if needed - - # This is boilerplate XML used to retrieve the currently recorded score for $sourcedid (which will later be tested) - my $readResultXML = <{r}; + my $ce = $r->{ce}; + my $db = $self->{r}->{db}; + + $score = wwRound(2, $score); + + # We have to fail gracefully here because some users, like instructors, + # may not actually have a sourcedid + if (!$sourcedid) { + # debug("No sourcedid for this user/assignment. Some LMS's do not provide ". + # "sourcedid for instructors so this may not be a problem, or it might ". + # "mean your settings are not correct.") if $ce->{debug_lti_grade_passback}; + return 0; + } + + # Needed in both phases + my $bodyhash; + my $requestGen; + my $gradeRequest; + my $HTTPRequest; + my $response; + + my $request_url = $db->getSettingValue('lis_outcome_service_url'); + if (!defined($request_url) || $request_url eq "") { + warn("Cannot send/retrieve grades to/from the LMS, no lis_outcome_service_url"); + return 0; + } + + my $consumer_key = $db->getSettingValue('consumer_key'); + if (!defined($consumer_key) || $consumer_key eq "") { + warn("Cannot send/retrieve grades to/from the LMS, no consumer_key"); + return 0; + } + + my $signature_method = $db->getSettingValue('signature_method'); + if (!defined($signature_method) || $signature_method eq "") { + warn("Cannot send/retrieve grades to/from the LMS, no signature_method"); + return 0; + } + + debug("found data required for submitting grades to LMS"); + + # Generate a better nonce, first a portion unique for the sourcedid + # which should be dependent on the student + the assignment if a + # "homework" level sourcedid. This part can be used twice + my $uuid_p1 = create_uuid_as_string(UUID_SHA1, UUID_NS_URL, $sourcedid); + + # Second part is a time dependent portion + my $uuid_p2 = create_uuid_as_string(UUID_TIME); + + my $lti_check_prior = $ce->{lti_check_prior} // 0; # Should we first poll the LMS for the current grade + + my $lti_do_send = 1; # Default to yes + + if ($lti_check_prior) { + + # Poll the LMS for prior grade + + $lti_do_send = 0; # Change default to no, and change below if needed + + # This is boilerplate XML used to retrieve the currently recorded score for $sourcedid (which will later be tested) + my $readResultXML = < @@ -286,105 +290,134 @@ sub submit_grade { EOS - chomp($readResultXML); - - $bodyhash = sha1_base64($readResultXML); - - # since sha1_base64 doesn't pad we have to do so manually - while (length($bodyhash) % 4) { - $bodyhash .= '='; - } - - warn("Retrieving prior grade using sourcedid: $sourcedid") if - $ce->{debug_lti_parameters}; - - $requestGen = Net::OAuth->request("consumer"); - - $requestGen->add_required_message_params('body_hash'); - - $gradeRequest = $requestGen->new( - request_url => $request_url, - request_method => "POST", - consumer_secret => $ce->{LTIBasicConsumerSecret}, - consumer_key => $consumer_key, - signature_method => $signature_method, - nonce => "${uuid_p1}__${uuid_p2}", - timestamp => time(), - body_hash => $bodyhash - ); - $gradeRequest->sign(); - - $HTTPRequest = HTTP::Request->new( - $gradeRequest->request_method, - $gradeRequest->request_url, - [ - 'Authorization' => $gradeRequest->to_authorization_header, - 'Content-Type' => 'application/xml', - ], - $readResultXML, - ); - - $response = LWP::UserAgent->new->request($HTTPRequest); - - # debug section - if ($ce->{debug_lti_grade_passback} and $ce->{debug_lti_parameters}){ - warn "The request was:\n ". ($self->local_escape_html(join(" ",%$HTTPRequest))); - warn "The nonce used is ${uuid_p1}__${uuid_p2}\n"; - warn "The response is:\n ". ($self->local_escape_html(join(" ", %$response ))); - warn "The request was:\n ". ($self->local_escape_html(join(" ",%$HTTPRequest))); - debug( "The request was:\n ". ($self->local_escape_html(join(" ",%$HTTPRequest))) ); - debug( "The nonce used is ${uuid_p1}__${uuid_p2}\n" ); - debug( "The response is:\n ". ($self->local_escape_html(join(" ", %$response ))) ); - } - - if ($response->is_success) { - $response->content =~ /\s*(\w+)\s*<\/imsx_codeMajor>/; - my $message = $1; - if ($message ne 'success') { - warn("Unable to retrieve prior grade from LMS. Note that if your server time is not correct, this may fail for reasons which are less than obvious from the error messages. Error: ".$message); - debug("Unable to retrieve prior grade from LMS. Note that if your server time is not correct, this may fail for reasons which are less than obvious from the error messages. Error: ".$message); - #debug(CGI::escapeHTML($response->content)); - return 0; - } else { - my $oldScore; - # Possibly no score yet. - if ($response->content =~ //) { - $oldScore = "" - } else { - $response->content =~ /\s*(\S+)\s*<\/textString>/; - $oldScore = $1; - } - # Do not update the score if no change. - if ( $oldScore eq "success" ) { - # Blackboard seems to return this when there is no prior grade. - # See: https://webwork.maa.org/moodle/mod/forum/discuss.php?d=5002 - debug("LMS grade will be updated. sourcedid: ".$sourcedid." Old score: ".$oldScore." New score: ".$score) if ($ce->{debug_lti_grade_passback}); - $lti_do_send = 1; # Change back to sending the update - } elsif ( $oldScore ne "" && abs($score-$oldScore) < 0.001 ) { - # LMS has essentially the same score, no reason to update it - debug("LMS grade will NOT be updated - grade unchanges. Old score: ".$oldScore." New score: ".$score) if ($ce->{debug_lti_grade_passback}); - warn("LMS grade will NOT be updated - grade unchanges. Old score: ".$oldScore." New score: ".$score) if ($ce->{debug_lti_grade_passback}); - $lti_do_send = 0; # Do not send - return 1; - } else { - $lti_do_send = 1; # Change back to sending the update - debug("LMS grade will be updated. sourcedid: ".$sourcedid." Old score: ".$oldScore." New score: ".$score) if ($ce->{debug_lti_grade_passback}); - } - } - } else { - warn("Unable to retrieve prior grade from LMS. Note that if your server time is not correct, this may fail for reasons which are less than obvious from the error messages. Error: " . $response->message) if ($ce->{debug_lti_grade_passback}); - debug("Unable to retrieve prior grade from LMS. Note that if your server time is not correct, this may fail for reasons which are less than obvious from the error messages. Error: " . $response->message); - debug(CGI::escapeHTML($response->content)); - return 0; - } - } - - if ( $lti_do_send ) { - - # Send the LMS the new grade - - # This is boilerplate XML used to submit the $score for $sourcedid - my $replaceResultXML = <{debug_lti_parameters}; + + $requestGen = Net::OAuth->request("consumer"); + + $requestGen->add_required_message_params('body_hash'); + + $gradeRequest = $requestGen->new( + request_url => $request_url, + request_method => "POST", + consumer_secret => $ce->{LTIBasicConsumerSecret}, + consumer_key => $consumer_key, + signature_method => $signature_method, + nonce => "${uuid_p1}__${uuid_p2}", + timestamp => time(), + body_hash => $bodyhash + ); + $gradeRequest->sign(); + + $HTTPRequest = HTTP::Request->new( + $gradeRequest->request_method, + $gradeRequest->request_url, + [ + 'Authorization' => $gradeRequest->to_authorization_header, + 'Content-Type' => 'application/xml', + ], + $readResultXML, + ); + + $response = LWP::UserAgent->new->request($HTTPRequest); + + # debug section + if ($ce->{debug_lti_grade_passback} and $ce->{debug_lti_parameters}) { + warn "The request was:\n " . ($self->local_escape_html(join(" ", %$HTTPRequest))); + warn "The nonce used is ${uuid_p1}__${uuid_p2}\n"; + warn "The response is:\n " . ($self->local_escape_html(join(" ", %$response))); + warn "The request was:\n " . ($self->local_escape_html(join(" ", %$HTTPRequest))); + debug("The request was:\n " . ($self->local_escape_html(join(" ", %$HTTPRequest)))); + debug("The nonce used is ${uuid_p1}__${uuid_p2}\n"); + debug("The response is:\n " . ($self->local_escape_html(join(" ", %$response)))); + } + + if ($response->is_success) { + $response->content =~ /\s*(\w+)\s*<\/imsx_codeMajor>/; + my $message = $1; + if ($message ne 'success') { + warn( + "Unable to retrieve prior grade from LMS. Note that if your server time is not correct, this may fail for reasons which are less than obvious from the error messages. Error: " + . $message); + debug( + "Unable to retrieve prior grade from LMS. Note that if your server time is not correct, this may fail for reasons which are less than obvious from the error messages. Error: " + . $message); + #debug(CGI::escapeHTML($response->content)); + return 0; + } else { + my $oldScore; + # Possibly no score yet. + if ($response->content =~ //) { + $oldScore = ""; + } else { + $response->content =~ /\s*(\S+)\s*<\/textString>/; + $oldScore = $1; + } + # Do not update the score if no change. + if ($oldScore eq "success") { + # Blackboard seems to return this when there is no prior grade. + # See: https://webwork.maa.org/moodle/mod/forum/discuss.php?d=5002 + debug("LMS grade will be updated. sourcedid: " + . $sourcedid + . " Old score: " + . $oldScore + . " New score: " + . $score) + if ($ce->{debug_lti_grade_passback}); + $lti_do_send = 1; # Change back to sending the update + } elsif ($oldScore ne "" && abs($score - $oldScore) < 0.001) { + # LMS has essentially the same score, no reason to update it + debug("LMS grade will NOT be updated - grade unchanges. Old score: " + . $oldScore + . " New score: " + . $score) + if ($ce->{debug_lti_grade_passback}); + warn("LMS grade will NOT be updated - grade unchanges. Old score: " + . $oldScore + . " New score: " + . $score) + if ($ce->{debug_lti_grade_passback}); + $lti_do_send = 0; # Do not send + return 1; + } else { + $lti_do_send = 1; # Change back to sending the update + debug("LMS grade will be updated. sourcedid: " + . $sourcedid + . " Old score: " + . $oldScore + . " New score: " + . $score) + if ($ce->{debug_lti_grade_passback}); + } + } + } else { + warn( + "Unable to retrieve prior grade from LMS. Note that if your server time is not correct, this may fail for reasons which are less than obvious from the error messages. Error: " + . $response->message) + if ($ce->{debug_lti_grade_passback}); + debug( + "Unable to retrieve prior grade from LMS. Note that if your server time is not correct, this may fail for reasons which are less than obvious from the error messages. Error: " + . $response->message); + debug(CGI::escapeHTML($response->content)); + return 0; + } + } + + if ($lti_do_send) { + + # Send the LMS the new grade + + # This is boilerplate XML used to submit the $score for $sourcedid + my $replaceResultXML = < @@ -411,144 +444,144 @@ EOS EOS - chomp($replaceResultXML); - - $bodyhash = sha1_base64($replaceResultXML); - - # since sha1_base64 doesn't pad we have to do so manually - while (length($bodyhash) % 4) { - $bodyhash .= '='; - } - my $message2=''; - $message2 .= "mass_update: " if $self->{post_processing_mode}; - $message2 .= "Submitting grade using sourcedid: $sourcedid and score: $score\n"; - warn($message2) if $ce->{debug_lti_grade_passback}; - - $requestGen = Net::OAuth->request("consumer"); - debug( "obtained requestGen $requestGen"); - - $requestGen->add_required_message_params('body_hash'); - debug("add required message params"); - - # Change the time dependent portion of the nonce for the second stage - $uuid_p2 .= "-step2"; - - $gradeRequest = $requestGen->new( - request_url => $request_url, - request_method => "POST", - consumer_secret => $ce->{LTIBasicConsumerSecret}, - consumer_key => $consumer_key, - signature_method => $signature_method, - nonce => "${uuid_p1}__${uuid_p2}", - timestamp => time(), - body_hash => $bodyhash - ); - debug("created grade request ". $gradeRequest); - $gradeRequest->sign(); - debug("signed grade request"); - - $HTTPRequest = HTTP::Request->new( - $gradeRequest->request_method, - $gradeRequest->request_url, - [ - 'Authorization' => $gradeRequest->to_authorization_header, - 'Content-Type' => 'application/xml', - ], - $replaceResultXML, - ); - debug ("posting grade request: $HTTPRequest"); - - $response = eval { - LWP::UserAgent->new->request($HTTPRequest); - }; - if ($@) { - warn "error sending HTTP request to LMS, $@"; - } - - # debug section - if ($ce->{debug_lti_grade_passback} and $ce->{debug_lti_parameters}){ - warn "The request was:\n ". ($self->local_escape_html(join(" ",%$HTTPRequest))); - warn "The nonce used is ${uuid_p1}__${uuid_p2}\n"; - warn "The response is:\n ". ($self->local_escape_html(join(" ", %$response ))); - warn "The request was:\n ". ($self->local_escape_html(join(" ",%$HTTPRequest))); - debug( "The request was:\n ". ($self->local_escape_html(join(" ",%$HTTPRequest))) ); - debug( "The nonce used is ${uuid_p1}__${uuid_p2}\n" ); - debug( "The response is:\n ". ($self->local_escape_html(join(" ", %$response ))) ); - } - - if ($response->is_success) { - $response->content =~ /\s*(\w+)\s*<\/imsx_codeMajor>/; - my $message = $1; - warn ("result is: $message\n") if $ce->{debug_lti_grade_passback}; - if ($message ne 'success') { - debug("Unable to update LMS grade $sourcedid . LMS responded with message: ". $message) ; - return 0; - } else { - # if we got here we got successes from both the post and the lms - debug("Successfully updated LMS grade $sourcedid. LMS responded with message: ".$message ); - } - } else { - debug("Unable to update LMS grade $sourcedid. Error: ".($response->message) ); - debug($self->local_escape_html($response->content)); - return 0; - } - debug("Success submitting grade using sourcedid: $sourcedid and score: $score\n") ; - - return 1; # success - } - return 0; # failure as a fallback value -} - -# does a mass update of all grades. This is all user grades for -# course grade mode and all user set grades for homework grade mode. -sub mass_update { - my $self = shift; - my $r = $self->{r}; - my $ce = $r->{ce}; - my $db = $self->{r}->{db}; - $self->{post_processing_mode}=1; - - # sanity check - warn("course environment is not defined") unless ref($ce//''); - warn("database reference is not defined") unless ref($db//''); + chomp($replaceResultXML); - my $lastUpdate = $db->getSettingValue('LTILastUpdate') // 0; - my $updateInterval = $ce->{LTIMassUpdateInterval} // -1; # -1 suppresses update + $bodyhash = sha1_base64($replaceResultXML); - if ($updateInterval != -1 && - time - $lastUpdate > $updateInterval) { - - warn "\nperforming mass_update via LTI" if $ce->{debug_lti_grade_passback}; - - $db->setSettingValue('LTILastUpdate',time()); + # since sha1_base64 doesn't pad we have to do so manually + while (length($bodyhash) % 4) { + $bodyhash .= '='; + } + my $message2 = ''; + $message2 .= "mass_update: " if $self->{post_processing_mode}; + $message2 .= "Submitting grade using sourcedid: $sourcedid and score: $score\n"; + warn($message2) if $ce->{debug_lti_grade_passback}; + + $requestGen = Net::OAuth->request("consumer"); + debug("obtained requestGen $requestGen"); + + $requestGen->add_required_message_params('body_hash'); + debug("add required message params"); + + # Change the time dependent portion of the nonce for the second stage + $uuid_p2 .= "-step2"; + + $gradeRequest = $requestGen->new( + request_url => $request_url, + request_method => "POST", + consumer_secret => $ce->{LTIBasicConsumerSecret}, + consumer_key => $consumer_key, + signature_method => $signature_method, + nonce => "${uuid_p1}__${uuid_p2}", + timestamp => time(), + body_hash => $bodyhash + ); + debug("created grade request " . $gradeRequest); + $gradeRequest->sign(); + debug("signed grade request"); + + $HTTPRequest = HTTP::Request->new( + $gradeRequest->request_method, + $gradeRequest->request_url, + [ + 'Authorization' => $gradeRequest->to_authorization_header, + 'Content-Type' => 'application/xml', + ], + $replaceResultXML, + ); + debug("posting grade request: $HTTPRequest"); - if ($ce->{LTIGradeMode} eq 'course') { - my @users = $db->listUsers(); + $response = eval { LWP::UserAgent->new->request($HTTPRequest); }; + if ($@) { + warn "error sending HTTP request to LMS, $@"; + } - foreach my $user (@users) { - $self->submit_course_grade($user); - } + # debug section + if ($ce->{debug_lti_grade_passback} and $ce->{debug_lti_parameters}) { + warn "The request was:\n " . ($self->local_escape_html(join(" ", %$HTTPRequest))); + warn "The nonce used is ${uuid_p1}__${uuid_p2}\n"; + warn "The response is:\n " . ($self->local_escape_html(join(" ", %$response))); + warn "The request was:\n " . ($self->local_escape_html(join(" ", %$HTTPRequest))); + debug("The request was:\n " . ($self->local_escape_html(join(" ", %$HTTPRequest)))); + debug("The nonce used is ${uuid_p1}__${uuid_p2}\n"); + debug("The response is:\n " . ($self->local_escape_html(join(" ", %$response)))); + } - } elsif ($ce->{LTIGradeMode} eq 'homework') { - my @users = $db->listUsers(); + if ($response->is_success) { + $response->content =~ /\s*(\w+)\s*<\/imsx_codeMajor>/; + my $message = $1; + warn("result is: $message\n") if $ce->{debug_lti_grade_passback}; + if ($message ne 'success') { + debug("Unable to update LMS grade $sourcedid . LMS responded with message: " . $message); + return 0; + } else { + # if we got here we got successes from both the post and the lms + debug("Successfully updated LMS grade $sourcedid. LMS responded with message: " . $message); + } + } else { + debug("Unable to update LMS grade $sourcedid. Error: " . ($response->message)); + debug($self->local_escape_html($response->content)); + return 0; + } + debug("Success submitting grade using sourcedid: $sourcedid and score: $score\n"); - foreach my $user (@users) { - my @sets = $db->listUserSets($user); - warn "\nmass_update: all sets assigned to user $user :\n".join(" ", @sets)."\n" if $ce->{debug_lti_grade_passback}; - foreach my $set (@sets) { - eval { - #$self->update_sourcedid($user); #CHECK is this the right user id -- this doesn't update properly - $self->submit_set_grade($user,$set); - }; - if ($@) { - warn "error in reporting $user, $set, $@" if $ce->{debug_lti_grade_passback}; - } + return 1; # success + } + return 0; # failure as a fallback value +} +# does a mass update of all grades. This is all user grades for +# course grade mode and all user set grades for homework grade mode. +sub mass_update { + my $self = shift; + my $r = $self->{r}; + my $ce = $r->{ce}; + my $db = $self->{r}->{db}; + $self->{post_processing_mode} = 1; + + # sanity check + warn("course environment is not defined") unless ref($ce // ''); + warn("database reference is not defined") unless ref($db // ''); + + my $lastUpdate = $db->getSettingValue('LTILastUpdate') // 0; + my $updateInterval = $ce->{LTIMassUpdateInterval} // -1; # -1 suppresses update + + if ($updateInterval != -1 + && time - $lastUpdate > $updateInterval) + { + + warn "\nperforming mass_update via LTI" if $ce->{debug_lti_grade_passback}; + + $db->setSettingValue('LTILastUpdate', time()); + + if ($ce->{LTIGradeMode} eq 'course') { + my @users = $db->listUsers(); + + foreach my $user (@users) { + $self->submit_course_grade($user); + } + + } elsif ($ce->{LTIGradeMode} eq 'homework') { + my @users = $db->listUsers(); + + foreach my $user (@users) { + my @sets = $db->listUserSets($user); + warn "\nmass_update: all sets assigned to user $user :\n" . join(" ", @sets) . "\n" + if $ce->{debug_lti_grade_passback}; + foreach my $set (@sets) { + eval { + #$self->update_sourcedid($user); #CHECK is this the right user id -- this doesn't update properly + $self->submit_set_grade($user, $set); + }; + if ($@) { + warn "error in reporting $user, $set, $@" if $ce->{debug_lti_grade_passback}; + } + + } + } } - } - } - } - $self->{post_processing_mode}=0; + } + $self->{post_processing_mode} = 0; } 1; diff --git a/lib/WeBWorK/Authen/LTIBasic.pm b/lib/WeBWorK/Authen/LTIBasic.pm index 5b21d5856c..d7e328881f 100644 --- a/lib/WeBWorK/Authen/LTIBasic.pm +++ b/lib/WeBWorK/Authen/LTIBasic.pm @@ -43,16 +43,12 @@ use Apache2::Connection; use APR::Request::Error; our $GENERIC_ERROR_MESSAGE = - "Your authentication failed. Please return to " - . "your Course Management System ([_1]) and login again."; + "Your authentication failed. Please return to " . "your Course Management System ([_1]) and login again."; our $GENERIC_MISSING_USER_ID_ERROR_MESSAGE = - "Your authentication failed. Please return to " - . "your Course Management System ([_1]) and login again."; + "Your authentication failed. Please return to " . "your Course Management System ([_1]) and login again."; our $GENERIC_DENIED_LOGIN_ERROR_MESSAGE = - "You are not permitted to login into this site at this time. " - . "Please speak with your instructor."; -our $GENERIC_UNKNOWN_USER_ERROR_MESSAGE = - "This username does not appear on the roster for this WeBWorK site." ; + "You are not permitted to login into this site at this time. " . "Please speak with your instructor."; +our $GENERIC_UNKNOWN_USER_ERROR_MESSAGE = "This username does not appear on the roster for this WeBWorK site."; our $GENERIC_UNKNOWN_INSTRUCTOR_ERROR_MESSAGE = "You have attemped to access this site as an instructor without prior authorization."; @@ -69,9 +65,7 @@ Instantiates a new WeBWorK::Authen object for the given WeBWorK::Requst ($r). sub new { my ($invocant, $r) = @_; my $class = ref($invocant) || $invocant; - my $self = { - r => $r, - }; + my $self = { r => $r, }; #initialize bless $self, $class; return $self; @@ -81,9 +75,6 @@ sub new { =cut - - - ## this is only overridden for debug logging #sub verify { # debug("BEGIN LTIBasic VERIFY"); @@ -147,16 +138,16 @@ sub new { # Some LMS's misspell the lis_person_sourcedid parameter name # so we use a list of variations when needed. our @lis_person_sourcedid_options = ( - "lis_person_sourcedid", # from spec at https://www.imsglobal.org/specs/ltiv1p1/implementation-guide#toc-3 + "lis_person_sourcedid", # from spec at https://www.imsglobal.org/specs/ltiv1p1/implementation-guide#toc-3 "lis_person_sourced_id", "lis_person_source_id", "lis_person_sourceid" ); -sub request_has_data_for_this_verification_module { +sub request_has_data_for_this_verification_module { #debug("LTIBasic has been called for data verification"); my $self = shift; - my $r = $self -> {r}; + my $r = $self->{r}; # See comment in get_credentials() if ($r->{xmlrpc}) { @@ -164,34 +155,35 @@ sub request_has_data_for_this_verification_module { return 1; } if (!(defined $r->param("oauth_consumer_key")) - or !(defined $r -> param("oauth_signature")) - or !(defined $r -> param("oauth_nonce")) - or !(defined $r -> param("oauth_timestamp")) ) { + or !(defined $r->param("oauth_signature")) + or !(defined $r->param("oauth_nonce")) + or !(defined $r->param("oauth_timestamp"))) + { #debug("LTIBasic returning that it has insufficent data"); - return(0); + return (0); } else { #debug(("LTIBasic returning that it has sufficient data"); - return(1); + return (1); } } sub get_credentials { my $self = shift; - my $r = $self->{r}; - my $ce = $r -> {ce}; + my $r = $self->{r}; + my $ce = $r->{ce}; #debug("LTIBasic::get_credentials has been called\n"); ## debug code MEG - if ( $ce->{debug_lti_parameters} ) { - my $rh_headers = $r->headers_in; #request headers + if ($ce->{debug_lti_parameters}) { + my $rh_headers = $r->headers_in; #request headers - my @parameter_names = $r->param; # form parameter names + my @parameter_names = $r->param; # form parameter names my $parameter_report = ''; foreach my $key (@parameter_names) { - $parameter_report .= "$key => ".$r->param($key). "\n"; + $parameter_report .= "$key => " . $r->param($key) . "\n"; } - warn ("===== parameters received =======\n", $parameter_report); + warn("===== parameters received =======\n", $parameter_report); } ### @@ -214,134 +206,143 @@ sub get_credentials { # Determine the WW user_id to use, if possible - if ( ! $ce->{preferred_source_of_username} ) { - warn "LTI is not properly configured (no preferred_source_of_username). Please contact your instructor or system administrator."; - $self->{error} = $r->maketext("There was an error during the login process. Please speak to your instructor or system administrator."); - debug("No preferred_source_of_username in " . $r->ce->{'courseName'} . " so LTIBasic::get_credentials is returning a 0\n"); + if (!$ce->{preferred_source_of_username}) { + warn + "LTI is not properly configured (no preferred_source_of_username). Please contact your instructor or system administrator."; + $self->{error} = $r->maketext( + "There was an error during the login process. Please speak to your instructor or system administrator."); + debug("No preferred_source_of_username in " + . $r->ce->{'courseName'} + . " so LTIBasic::get_credentials is returning a 0\n"); return 0; } my $user_id_source = ""; my $type_of_source = ""; - $self->{email} = ""; # set an initial value to avoid warnings when not provided - if ( defined( $r->param("lis_person_contact_email_primary") ) ) { + $self->{email} = ""; # set an initial value to avoid warnings when not provided + if (defined($r->param("lis_person_contact_email_primary"))) { $self->{email} = uri_unescape($r->param("lis_person_contact_email_primary")) // ""; } - if ( $ce->{preferred_source_of_username} eq "lis_person_sourcedid" ) { - foreach my $key ( @lis_person_sourcedid_options ) { - if ( $r->param($key) ) { - $user_id_source = $key; - $type_of_source = "preferred_source_of_username"; + if ($ce->{preferred_source_of_username} eq "lis_person_sourcedid") { + foreach my $key (@lis_person_sourcedid_options) { + if ($r->param($key)) { + $user_id_source = $key; + $type_of_source = "preferred_source_of_username"; $self->{user_id} = $r->param($key); last; } } - } elsif ( $ce->{preferred_source_of_username} eq "lis_person_contact_email_primary" - && $self->{email} ne "" ) { - $user_id_source = "lis_person_contact_email_primary"; - $type_of_source = "preferred_source_of_username"; + } elsif ($ce->{preferred_source_of_username} eq "lis_person_contact_email_primary" + && $self->{email} ne "") + { + $user_id_source = "lis_person_contact_email_primary"; + $type_of_source = "preferred_source_of_username"; $self->{user_id} = $self->{email}; # Strip off the part of the address after @ if requested to do so: $self->{user_id} =~ s/@.*$// if $ce->{strip_address_from_email}; - } elsif ( $r->param($ce->{preferred_source_of_username}) ) { - $user_id_source = $ce->{preferred_source_of_username}; - $type_of_source = "preferred_source_of_username"; + } elsif ($r->param($ce->{preferred_source_of_username})) { + $user_id_source = $ce->{preferred_source_of_username}; + $type_of_source = "preferred_source_of_username"; $self->{user_id} = $r->param($ce->{preferred_source_of_username}); } # Fallback if necessary - if ( !defined( $self->{user_id} ) && $ce->{fallback_source_of_username} ) { - if ( $ce->{fallback_source_of_username} eq "lis_person_sourcedid" ) { - foreach my $key ( @lis_person_sourcedid_options ) { - if ( $r->param($key) ) { - $user_id_source = $key; - $type_of_source = "fallback_source_of_username"; + if (!defined($self->{user_id}) && $ce->{fallback_source_of_username}) { + if ($ce->{fallback_source_of_username} eq "lis_person_sourcedid") { + foreach my $key (@lis_person_sourcedid_options) { + if ($r->param($key)) { + $user_id_source = $key; + $type_of_source = "fallback_source_of_username"; $self->{user_id} = $r->param($key); last; } } - } elsif ( $ce->{fallback_source_of_username} eq "lis_person_contact_email_primary" - && $self->{email} ne "" ) { - $user_id_source = "lis_person_contact_email_primary"; - $type_of_source = "fallback_source_of_username"; + } elsif ($ce->{fallback_source_of_username} eq "lis_person_contact_email_primary" + && $self->{email} ne "") + { + $user_id_source = "lis_person_contact_email_primary"; + $type_of_source = "fallback_source_of_username"; $self->{user_id} = $self->{email}; # Strip off the part of the address after @ if requested to do so: $self->{user_id} =~ s/@.*$// if $ce->{strip_address_from_email}; - } elsif ( $r->param($ce->{fallback_source_of_username}) ) { - $user_id_source = $ce->{fallback_source_of_username}; - $type_of_source = "fallback_source_of_username"; + } elsif ($r->param($ce->{fallback_source_of_username})) { + $user_id_source = $ce->{fallback_source_of_username}; + $type_of_source = "fallback_source_of_username"; $self->{user_id} = $r->param($ce->{fallback_source_of_username}); } } # if we were able to set a user_id - if ( defined($self->{user_id}) && $self->{user_id} ne "" ) { - map {$self -> {$_ -> [0]} = $r -> param($_ -> [1]);} - ( - #['user_id', 'lis_person_sourcedid'], - ['role', 'roles'], - ['last_name' , 'lis_person_name_family'], - ['first_name', 'lis_person_name_given'], - ['context_id', 'context_id'], - ['oauth_consumer_key', 'oauth_consumer_key'], - ['oauth_signature', 'oauth_signature'], - ['oauth_nonce', 'oauth_nonce'], - ['oauth_timestamp', 'oauth_timestamp'], - ['semester', 'custom_semester'], - ['section', 'custom_section'], - ['recitation', 'custom_recitation'], - ); + if (defined($self->{user_id}) && $self->{user_id} ne "") { + map { $self->{ $_->[0] } = $r->param($_->[1]); } ( + #['user_id', 'lis_person_sourcedid'], + [ 'role', 'roles' ], + [ 'last_name', 'lis_person_name_family' ], + [ 'first_name', 'lis_person_name_given' ], + [ 'context_id', 'context_id' ], + [ 'oauth_consumer_key', 'oauth_consumer_key' ], + [ 'oauth_signature', 'oauth_signature' ], + [ 'oauth_nonce', 'oauth_nonce' ], + [ 'oauth_timestamp', 'oauth_timestamp' ], + [ 'semester', 'custom_semester' ], + [ 'section', 'custom_section' ], + [ 'recitation', 'custom_recitation' ], + ); if (defined($ce->{preferred_source_of_student_id}) - && defined($r->param($ce->{preferred_source_of_student_id}))) { + && defined($r->param($ce->{preferred_source_of_student_id}))) + { $self->{student_id} = $r->param($ce->{preferred_source_of_student_id}); } else { - $self->{student_id} = ""; # fall back to avoid a warning when debug_lti_parameters enabled + $self->{student_id} = ""; # fall back to avoid a warning when debug_lti_parameters enabled } # For setting up its helpful to print out what the system think the # User id and address is at this point - if ( $ce->{debug_lti_parameters} ) { + if ($ce->{debug_lti_parameters}) { warn "=========== summary ============"; warn "User id is |$self->{user_id}| (obtained from $user_id_source which was $type_of_source)\n"; warn "User mail address is |$self->{email}|\n"; - warn "strip_address_from_email is |", $ce->{strip_address_from_email}//0,"|\n"; + warn "strip_address_from_email is |", $ce->{strip_address_from_email} // 0, "|\n"; warn "Student id is |$self->{student_id}|\n"; warn "preferred_source_of_username is |$ce->{preferred_source_of_username}|\n"; - warn "fallback_source_of_username is |", $ce->{fallback_source_of_username}//'undefined',"|\n"; - warn "preferred_source_of_student_id is |", $ce->{preferred_source_of_student_id}//'undefined',"|\n"; + warn "fallback_source_of_username is |", $ce->{fallback_source_of_username} // 'undefined', "|\n"; + warn "preferred_source_of_student_id is |", $ce->{preferred_source_of_student_id} // 'undefined', "|\n"; warn "================================\n"; } if (!defined($self->{user_id})) { - croak "LTIBasic was unable to create a username from the data provided with the current settings. Set \$debug_lti_parameters=1 in authen_LTI.conf to debug"; + croak + "LTIBasic was unable to create a username from the data provided with the current settings. Set \$debug_lti_parameters=1 in authen_LTI.conf to debug"; } - if (defined $ce -> {analyze_context_id}) { - $ce -> {analyze_context_id} ($self) ; + if (defined $ce->{analyze_context_id}) { + $ce->{analyze_context_id}($self); } - if (!defined($self -> {section})) { - $self -> {section} = "unknown"; + if (!defined($self->{section})) { + $self->{section} = "unknown"; } - $self->{login_type} = "normal"; - $self -> {credential_source} = "LTIBasic"; + $self->{login_type} = "normal"; + $self->{credential_source} = "LTIBasic"; #debug("LTIBasic::get_credentials is returning a 1\n"); return 1; } #debug("LTIBasic::get_credentials is returning a 0\n"); - warn "LTI is not properly configured (failed to obtain user_id from preferred_source_of_username or fallback_source_of_username). Please contact your instructor or system administrator."; - $self->{error} = $r->maketext("There was an error during the login process. Please speak to your instructor or system administrator."); + warn + "LTI is not properly configured (failed to obtain user_id from preferred_source_of_username or fallback_source_of_username). Please contact your instructor or system administrator."; + $self->{error} = $r->maketext( + "There was an error during the login process. Please speak to your instructor or system administrator."); return 0; } # minor modification of method in superclass sub check_user { my $self = shift; - my $r = $self->{r}; - my ($ce, $db, $authz) = map {$r -> $_ ;} ('ce', 'db', 'authz'); + my $r = $self->{r}; + my ($ce, $db, $authz) = map { $r->$_; } ('ce', 'db', 'authz'); my $user_id = $self->{user_id}; @@ -355,7 +356,7 @@ sub check_user { if (!defined($user_id) or (defined $user_id and $user_id eq "")) { $self->{log_error} .= "no user id specified"; - my $LMS = ($ce->{LMS_url}) ? CGI::a({href => $ce->{LMS_url}},$ce->{LMS_name}) : $ce->{LMS_name}; + my $LMS = ($ce->{LMS_url}) ? CGI::a({ href => $ce->{LMS_url} }, $ce->{LMS_name}) : $ce->{LMS_name}; $self->{error} = $r->maketext($GENERIC_MISSING_USER_ID_ERROR_MESSAGE, $LMS); return 0; } @@ -364,28 +365,33 @@ sub check_user { if (!$User) { my %options; - $options{$ce->{preferred_source_of_username}} = 1 if ($ce->{preferred_source_of_username}); - $options{$ce->{fallback_source_of_username}} = 1 if ($ce->{fallback_source_of_username}); + $options{ $ce->{preferred_source_of_username} } = 1 if ($ce->{preferred_source_of_username}); + $options{ $ce->{fallback_source_of_username} } = 1 if ($ce->{fallback_source_of_username}); # May need to add alternate "spellings" for lis_person_sourcedid my $use_lis_person_sourcedid_options = 0; - if ( defined($ce->{preferred_source_of_username}) - && $ce->{preferred_source_of_username} eq "lis_person_sourcedid" ) { + if (defined($ce->{preferred_source_of_username}) + && $ce->{preferred_source_of_username} eq "lis_person_sourcedid") + { $use_lis_person_sourcedid_options = 1; - } elsif ( defined($ce->{fallback_source_of_username}) - && $ce->{fallback_source_of_username} eq "lis_person_sourcedid" ) { + } elsif (defined($ce->{fallback_source_of_username}) + && $ce->{fallback_source_of_username} eq "lis_person_sourcedid") + { $use_lis_person_sourcedid_options = 1; } - foreach my $key ( keys( %options ), ( $use_lis_person_sourcedid_options ? @lis_person_sourcedid_options : () ) ) { - if ( defined($r->param($key)) ) { - debug("User |$user_id| is unknown but may be an new user from an LSM via LTI. Saw a value for $key About to return a 1"); - return 1; #This may be a new user coming in from a LMS via LTI. + foreach my $key (keys(%options), ($use_lis_person_sourcedid_options ? @lis_person_sourcedid_options : ())) { + if (defined($r->param($key))) { + debug( + "User |$user_id| is unknown but may be an new user from an LSM via LTI. Saw a value for $key About to return a 1" + ); + return 1; #This may be a new user coming in from a LMS via LTI. } } $self->{log_error} .= " $user_id - user unknown"; - $self->{error} = $r->maketext("There was an error during the login process. Please speak to your instructor or system administrator."); + $self->{error} = $r->maketext( + "There was an error during the login process. Please speak to your instructor or system administrator."); return 0; } @@ -405,14 +411,11 @@ sub check_user { } # disable practice users -sub verify_practice_user { return(0) ;} +sub verify_practice_user { return (0); } -sub verify_normal_user -{ +sub verify_normal_user { my $self = shift; - my ($r, $user_id, $session_key) - = map {$self -> {$_};} ('r', 'user_id', 'session_key'); - + my ($r, $user_id, $session_key) = map { $self->{$_}; } ('r', 'user_id', 'session_key'); #debug("LTIBasic::verify_normal_user called for user |$user_id|"); @@ -422,7 +425,7 @@ sub verify_normal_user return $self->SUPER::verify_normal_user(@_); } - # Call check_session in order to destroy any existing session cookies and Key table sessions + # Call check_session in order to destroy any existing session cookies and Key table sessions my ($sessionExists, $keyMatches, $timestampValid) = $self->check_session($user_id, $session_key, 0); debug("sessionExists='", $sessionExists, "' keyMatches='", $keyMatches, "' timestampValid='", $timestampValid, "'"); @@ -439,27 +442,23 @@ sub verify_normal_user # before authentication occurs, then authentication will FAIL # even if the consumer_secret is correct. - $r -> param("user" => $user_id); + $r->param("user" => $user_id); - if ($auth_result eq "1") - { + if ($auth_result eq "1") { #debug("About to call create_session."); $self->{session_key} = $self->create_session($user_id); #debug("session_key=|" . $self -> {session_key} . "|."); return 1; - } - else - { + } else { $self->{error} = $r->maketext($auth_result); - $self-> {log_error} .= "$user_id - authentication failed: ". $self->{error}; + $self->{log_error} .= "$user_id - authentication failed: " . $self->{error}; return 0; - } + } } -sub authenticate -{ +sub authenticate { my $self = shift; - my ($r, $user ) = map {$self -> {$_};} ('r', 'user_id'); + my ($r, $user) = map { $self->{$_}; } ('r', 'user_id'); # See comment in get_credentials() if ($r->{xmlrpc}) { @@ -471,110 +470,107 @@ sub authenticate #debug "ref(r) = |". ref($r) . "|"; #debug "ref of r->{paramcache} = |" . ref($r -> {paramcache}) . "|"; #debug "request_method = |" . $r -> request_method . "|"; - my $ce = $r -> ce; - my $db = $r -> db; - my $courseName = $r -> ce -> {'courseName'}; - my $webmaster= $ce ->{Local_Email_Addresses} -> {Webmaster}; - my $verify_code=0; - my $timestamp=0; + my $ce = $r->ce; + my $db = $r->db; + my $courseName = $r->ce->{'courseName'}; + my $webmaster = $ce->{Local_Email_Addresses}->{Webmaster}; + my $verify_code = 0; + my $timestamp = 0; # Check nonce to see whether request is legitimate #debug("Nonce = |" . $self-> {oauth_nonce} . "|"); - my $nonce = WeBWorK::Authen::LTIBasic::Nonce -> new($r, $self -> {oauth_nonce}, $self -> {oauth_timestamp}); - if (!($nonce -> ok ) ) { - my $LMS = ($ce->{LMS_url}) ? CGI::a({href => $ce->{LMS_url}},$ce->{LMS_name}) : $ce->{LMS_name}; + my $nonce = WeBWorK::Authen::LTIBasic::Nonce->new($r, $self->{oauth_nonce}, $self->{oauth_timestamp}); + if (!($nonce->ok)) { + my $LMS = ($ce->{LMS_url}) ? CGI::a({ href => $ce->{LMS_url} }, $ce->{LMS_name}) : $ce->{LMS_name}; #debug( "eval failed: ", $@, "

      "; print_keys($r);); - $self -> {error} .= $r->maketext($GENERIC_ERROR_MESSAGE - . ": Something was wrong with your Nonce LTI parameters. If this recurs, please speak with your instructor", $LMS); + $self->{error} .= $r->maketext( + $GENERIC_ERROR_MESSAGE + . ": Something was wrong with your Nonce LTI parameters. If this recurs, please speak with your instructor", + $LMS + ); return 0; } #debug( "r->param(oauth_signature) = |" . $r -> param("oauth_signature") . "|"); my %request_hash; - my @keys = keys %{$r-> {paramcache}}; + my @keys = keys %{ $r->{paramcache} }; foreach my $key (@keys) { - $request_hash{$key} = $r -> param($key); + $request_hash{$key} = $r->param($key); #debug("$key -> |" . $requestHash -> {$key} . "|"); } my $requestHash = \%request_hash; - my $path = $ce->{server_root_url}.$ce->{webwork_url}.$r->urlpath()->path; - $path = $ce->{LTIBasicToThisSiteURL} ? - $ce->{LTIBasicToThisSiteURL} : $path; + my $path = $ce->{server_root_url} . $ce->{webwork_url} . $r->urlpath()->path; + $path = $ce->{LTIBasicToThisSiteURL} ? $ce->{LTIBasicToThisSiteURL} : $path; my $altpath = $path; $altpath =~ s/\/$//; my ($request, $altrequest); - eval - { - $request = Net::OAuth -> request("request token") -> from_hash($requestHash, + eval { + $request = Net::OAuth->request("request token")->from_hash( + $requestHash, request_url => $path, - request_method => "POST", - consumer_secret => $ce -> {LTIBasicConsumerSecret}, - ); + request_method => "POST", + consumer_secret => $ce->{LTIBasicConsumerSecret}, + ); - $altrequest = Net::OAuth -> request("request token") -> from_hash($requestHash, + $altrequest = Net::OAuth->request("request token")->from_hash( + $requestHash, request_url => $altpath, - request_method => "POST", - consumer_secret => $ce -> {LTIBasicConsumerSecret}, - ); - }; + request_method => "POST", + consumer_secret => $ce->{LTIBasicConsumerSecret}, + ); + }; - if ($@) - { + if ($@) { #debug("construction of Net::OAuth object failed: $@"); #debug( "eval failed: ", $@, "

      "; print_keys($r);); - $self -> {error} .= $r->maketext("Your authentication failed. Please return to Oncourse and login again."); - $self -> {error} .= $r->maketext("Something was wrong with your LTI parameters. If this recurs, please speak with your instructor"); - $self -> {log_error} .= "Construction of OAuth request record failed"; + $self->{error} .= $r->maketext("Your authentication failed. Please return to Oncourse and login again."); + $self->{error} .= $r->maketext( + "Something was wrong with your LTI parameters. If this recurs, please speak with your instructor"); + $self->{log_error} .= "Construction of OAuth request record failed"; return 0; - } - else - { - if (! $request -> verify && ! $altrequest -> verify) - { + } else { + if (!$request->verify && !$altrequest->verify) { #debug("LTIBasic::authenticate request-> verify failed"); #debug("

      OAuth verification Failed

      "; print_keys($r)); - $self -> {error} .= $r->maketext("Your authentication failed. Please return to Oncourse and login again."); - $self -> {error} .= $r->maketext("Your LTI OAuth verification failed. If this recurs, please speak with your instructor"); - $self -> {log_error} .= "OAuth verification failed. Check the Consumer Secret."; + $self->{error} .= $r->maketext("Your authentication failed. Please return to Oncourse and login again."); + $self->{error} .= + $r->maketext("Your LTI OAuth verification failed. If this recurs, please speak with your instructor"); + $self->{log_error} .= "OAuth verification failed. Check the Consumer Secret."; return 0; - } - else - { + } else { #debug("

      OAuth verification SUCCEEDED !!

      "); ############################################################ # Determine the roles defined for this user by the LTI request # and assign a permission level on that basis. ############################################################ - my $userID = $self->{user_id}; - my $LTIrolesString = $r -> param("roles"); - my @LTIroles = split /,/, $LTIrolesString; + my $userID = $self->{user_id}; + my $LTIrolesString = $r->param("roles"); + my @LTIroles = split /,/, $LTIrolesString; #remove the urn string if its present s/^urn:lti:.*:ims\/lis\/// for @LTIroles; - if ( $ce->{debug_lti_parameters} ) { + if ($ce->{debug_lti_parameters}) { warn "The adjusted LTI roles defined for this user are: \n--", - join("\n--", @LTIroles), "\n", - "Any initial ^urn:lti:.*:ims/lis/ segments have been stripped off.\n", - "The user will be assigned the highest role defined for them\n", - "========================\n" + join("\n--", @LTIroles), "\n", + "Any initial ^urn:lti:.*:ims/lis/ segments have been stripped off.\n", + "The user will be assigned the highest role defined for them\n", + "========================\n"; } my $nr = scalar(@LTIroles); - if (! defined($ce -> {userRoles} -> {$ce -> {LMSrolesToWeBWorKroles} -> {$LTIroles[0]}})) { - croak("Cannot find a WeBWorK role that corresponds to the LMS role of " - . $LTIroles[0] ."."); + if (!defined($ce->{userRoles}->{ $ce->{LMSrolesToWeBWorKroles}->{ $LTIroles[0] } })) { + croak("Cannot find a WeBWorK role that corresponds to the LMS role of " . $LTIroles[0] . "."); } - my $LTI_webwork_permissionLevel - = $ce -> {userRoles} -> {$ce -> {LMSrolesToWeBWorKroles} -> {$LTIroles[0]}}; + my $LTI_webwork_permissionLevel = $ce->{userRoles}->{ $ce->{LMSrolesToWeBWorKroles}->{ $LTIroles[0] } }; if ($nr > 1) { - for (my $j =1; $j < $nr; $j++) { - my $wwRole = $ce -> {LMSrolesToWeBWorKroles} -> {$LTIroles[$j]}; + for (my $j = 1; $j < $nr; $j++) { + my $wwRole = $ce->{LMSrolesToWeBWorKroles}->{ $LTIroles[$j] }; next unless defined $wwRole; - if ($LTI_webwork_permissionLevel < $ce -> {userRoles} -> {$wwRole}) { - $LTI_webwork_permissionLevel = $ce -> {userRoles} -> {$wwRole}; + if ($LTI_webwork_permissionLevel < $ce->{userRoles}->{$wwRole}) { + $LTI_webwork_permissionLevel = $ce->{userRoles}->{$wwRole}; } } } @@ -587,236 +583,244 @@ sub authenticate # The code works for the U. of Rochester Blackboard ################################################################## -# my $LTI_section = $r->param("context_label"); # for example: MTH208.2014FALL.54648 -# my ($course_number, $semester, $CRN) = split(/\./, $LTI_section); -# if ($self->{section} eq "unknown" and $CRN ) { -# $self->{section}= $CRN//"unknown"; # update unknown sections from CRN if possible -# } -# if ( $ce->{debug_lti_parameters} ) { -# warn "LTI context_label is $LTI_section"; -# warn "course number $course_number\n"; -# warn "semester $semester\n"; -# warn "CRN $CRN\n"; -# warn "section $self->{section}"; -# } + # my $LTI_section = $r->param("context_label"); # for example: MTH208.2014FALL.54648 + # my ($course_number, $semester, $CRN) = split(/\./, $LTI_section); + # if ($self->{section} eq "unknown" and $CRN ) { + # $self->{section}= $CRN//"unknown"; # update unknown sections from CRN if possible + # } + # if ( $ce->{debug_lti_parameters} ) { + # warn "LTI context_label is $LTI_section"; + # warn "course number $course_number\n"; + # warn "semester $semester\n"; + # warn "CRN $CRN\n"; + # warn "section $self->{section}"; + # } ########### end determine section name - if (! $db -> existsUser($userID) ) - { # New User. Create User record + if (!$db->existsUser($userID)) { # New User. Create User record warn "New user: $userID -- requested permission level is $LTI_webwork_permissionLevel. - Only new users with permission levels less than or equal to 'ta = 5' can be created." if ( $ce->{debug_lti_parameters} ); - if ($LTI_webwork_permissionLevel > $ce ->{userRoles} -> {"ta"}) { - $self->{log_error}.= "userID: $userID --".' '. $GENERIC_UNKNOWN_INSTRUCTOR_ERROR_MESSAGE; - croak $r->maketext("userID: [_1] --", $userID).$r->maketext($GENERIC_UNKNOWN_INSTRUCTOR_ERROR_MESSAGE); + Only new users with permission levels less than or equal to 'ta = 5' can be created." + if ($ce->{debug_lti_parameters}); + if ($LTI_webwork_permissionLevel > $ce->{userRoles}->{"ta"}) { + $self->{log_error} .= "userID: $userID --" . ' ' . $GENERIC_UNKNOWN_INSTRUCTOR_ERROR_MESSAGE; + croak $r->maketext("userID: [_1] --", $userID) + . $r->maketext($GENERIC_UNKNOWN_INSTRUCTOR_ERROR_MESSAGE); } - my $newUser = $db -> newUser(); - $newUser -> user_id($userID); - $self -> {last_name} =~ s/\+/ /g; - $newUser -> last_name($self -> {last_name}); - $self -> {first_name} =~ s/\+/ /g; - $newUser -> first_name($self -> {first_name}); - $newUser -> email_address($self -> {email}); - $newUser -> status("C"); - $newUser -> section(($LTI_webwork_permissionLevel > $ce -> {userRoles} -> {"student"}) ? - "Admin" : (defined($self -> {section})) ? $self -> {section} : ""); - $newUser -> recitation($self -> {recitation}); - $newUser -> comment(formatDateTime(time, "local")); - $db -> addUser($newUser); + my $newUser = $db->newUser(); + $newUser->user_id($userID); + $self->{last_name} =~ s/\+/ /g; + $newUser->last_name($self->{last_name}); + $self->{first_name} =~ s/\+/ /g; + $newUser->first_name($self->{first_name}); + $newUser->email_address($self->{email}); + $newUser->status("C"); + $newUser->section(($LTI_webwork_permissionLevel > $ce->{userRoles}->{"student"}) ? "Admin" + : (defined($self->{section})) ? $self->{section} + : ""); + $newUser->recitation($self->{recitation}); + $newUser->comment(formatDateTime(time, "local")); + $db->addUser($newUser); $self->write_log_entry("New user $userID added via LTIBasic login"); - # Assign permssion level - my $newPermissionLevel = $db -> newPermissionLevel(); - $newPermissionLevel -> user_id($userID); - $newPermissionLevel -> permission($LTI_webwork_permissionLevel); - $db -> addPermissionLevel($newPermissionLevel); - $r -> authz -> {PermissionLevel} = $newPermissionLevel; #cache the Permission Level Record. - # Assign existing sets - # This module is not a subclass of WeBWorK::ContentGenerator::Instuctor, - # do the methods defined therein for assigning problem sets and problems - # to users are not available for use here. - # Therefore, we have to resort to the lower level methods in WeBWorK::DB. + # Assign permssion level + my $newPermissionLevel = $db->newPermissionLevel(); + $newPermissionLevel->user_id($userID); + $newPermissionLevel->permission($LTI_webwork_permissionLevel); + $db->addPermissionLevel($newPermissionLevel); + $r->authz->{PermissionLevel} = $newPermissionLevel; #cache the Permission Level Record. + # Assign existing sets + # This module is not a subclass of WeBWorK::ContentGenerator::Instuctor, + # do the methods defined therein for assigning problem sets and problems + # to users are not available for use here. + # Therefore, we have to resort to the lower level methods in WeBWorK::DB. my $numberOfProblemsAssigned = 0; - my %globalProblemsBySet=(); - my @globalSetIDs = $db->listGlobalSets; - my @GlobalSets = $db->getGlobalSets(@globalSetIDs); - my $open_cut = time() + 24*3600; + my %globalProblemsBySet = (); + my @globalSetIDs = $db->listGlobalSets; + my @GlobalSets = $db->getGlobalSets(@globalSetIDs); + my $open_cut = time() + 24 * 3600; my $globalSet; + foreach $globalSet (@GlobalSets) { - if (defined($globalSet) and $globalSet -> open_date < $open_cut) { - my @GlobalProblems = grep { defined $_ } $db->getAllGlobalProblems($globalSet -> set_id); - $globalProblemsBySet{$globalSet->set_id} = \@GlobalProblems; + if (defined($globalSet) and $globalSet->open_date < $open_cut) { + my @GlobalProblems = grep { defined $_ } $db->getAllGlobalProblems($globalSet->set_id); + $globalProblemsBySet{ $globalSet->set_id } = \@GlobalProblems; $numberOfProblemsAssigned += scalar(@GlobalProblems); } } - my $reasonableNumberOfDays = int($numberOfProblemsAssigned / $ce->{reasonableProblemsPerDayMakeup}) +1; - if ($reasonableNumberOfDays < 2) {$reasonableNumberOfDays = 2;} + my $reasonableNumberOfDays = int($numberOfProblemsAssigned / $ce->{reasonableProblemsPerDayMakeup}) + 1; + if ($reasonableNumberOfDays < 2) { $reasonableNumberOfDays = 2; } my ($sec, $min, $day, $monthDay, $month, $year, $weekDay, $yearDay, $isdst) = localtime(); - my $niceDueDay = $yearDay + 1 + $reasonableNumberOfDays; - my $niceDueTime = Time::Local::timelocal_nocheck(0,30,8,$niceDueDay,0,$year); - ($sec, $min, $day, $monthDay, $month, $year, $weekDay, $yearDay, $isdst) = localtime($niceDueTime); - if ($weekDay == 0) {$niceDueDay +=1;} - elsif ($weekDay == 6) {$niceDueDay += 2;} + my $niceDueDay = $yearDay + 1 + $reasonableNumberOfDays; + my $niceDueTime = Time::Local::timelocal_nocheck(0, 30, 8, $niceDueDay, 0, $year); + ($sec, $min, $day, $monthDay, $month, $year, $weekDay, $yearDay, $isdst) = localtime($niceDueTime); + if ($weekDay == 0) { $niceDueDay += 1; } + elsif ($weekDay == 6) { $niceDueDay += 2; } my $niceAnswerTime = $niceDueTime + 600; - my $due_cut = time() + 2*24*3600; + my $due_cut = time() + 2 * 24 * 3600; my $userSet; my $userProblem; - foreach $globalSet (@GlobalSets) - { - if (defined($globalSet)) + + foreach $globalSet (@GlobalSets) { + if (defined($globalSet)) { + if (defined($ce->{"adjustDueDatesForLateAdds"}) + and $ce->{"adjustDueDatesForLateAdds"} + and $globalSet->open_date < $open_cut + and $globalSet->due_date < $due_cut) { - if (defined($ce -> {"adjustDueDatesForLateAdds"}) and $ce -> {"adjustDueDatesForLateAdds"} - and $globalSet -> open_date < $open_cut and $globalSet -> due_date < $due_cut - ) - { - if (not $db -> existsUserSet($userID, $globalSet -> set_id ) ) - { - $userSet = $db -> newUserSet(); - $userSet -> user_id($userID); - $userSet -> set_id($globalSet -> set_id); + if (not $db->existsUserSet($userID, $globalSet->set_id)) { + $userSet = $db->newUserSet(); + $userSet->user_id($userID); + $userSet->set_id($globalSet->set_id); # $userSet -> psvn(int(10**12 * rand())); # $userSet -> open_date(0); - $userSet -> due_date($niceDueTime); - $userSet -> answer_date($niceAnswerTime); - $db -> addUserSet($userSet); - } + $userSet->due_date($niceDueTime); + $userSet->answer_date($niceAnswerTime); + $db->addUserSet($userSet); } - elsif ( $globalSet -> open_date < $open_cut ) - { - if (not $db -> existsUserSet($userID, $globalSet -> set_id ) ) { - $userSet = $db -> newUserSet(); - $userSet -> user_id($userID); - $userSet -> set_id($globalSet -> set_id); + } elsif ($globalSet->open_date < $open_cut) { + if (not $db->existsUserSet($userID, $globalSet->set_id)) { + $userSet = $db->newUserSet(); + $userSet->user_id($userID); + $userSet->set_id($globalSet->set_id); # $userSet -> psvn(int(10**12 * rand())); # $userSet -> open_date(0); # $userSet -> due_date(0); # $userSet -> answer_date(0); - $db -> addUserSet($userSet); + $db->addUserSet($userSet); } } - foreach my $globalProblem ( @{$globalProblemsBySet{$globalSet -> set_id}} ) { + foreach my $globalProblem (@{ $globalProblemsBySet{ $globalSet->set_id } }) { if (defined($globalProblem)) { - if (not $db -> existsUserProblem($userID, $globalSet -> set_id, $globalProblem -> problem_id)) { - $userProblem = $db -> newUserProblem(); - $userProblem -> user_id($userID); - $userProblem -> set_id($globalSet -> set_id); - $userProblem -> problem_id($globalProblem -> problem_id); - $userProblem -> problem_seed(int(10**4 * rand())); - $userProblem -> {status} = 0; - $userProblem -> {attempted} = 0; - $userProblem -> {num_correct} = 0; - $userProblem -> {num_incorrect} = 0; - $userProblem -> {last_answer} = ""; - - $db -> addUserProblem($userProblem); + if (not $db->existsUserProblem($userID, $globalSet->set_id, $globalProblem->problem_id)) + { + $userProblem = $db->newUserProblem(); + $userProblem->user_id($userID); + $userProblem->set_id($globalSet->set_id); + $userProblem->problem_id($globalProblem->problem_id); + $userProblem->problem_seed(int(10**4 * rand())); + $userProblem->{status} = 0; + $userProblem->{attempted} = 0; + $userProblem->{num_correct} = 0; + $userProblem->{num_incorrect} = 0; + $userProblem->{last_answer} = ""; + + $db->addUserProblem($userProblem); } } } } } - $self -> {initial_login} = 1; - } - else - { # Existing user. Possibly modify demographic information and permission level. - my $user = $db -> getUser($userID); - my $permissionLevel = $db -> getPermissionLevel($userID); - if (($user -> last_name() eq "Teacher" and $user -> first_name() eq "The") - or (defined($permissionLevel -> permission) - and $permissionLevel -> permission > $ce -> {userRoles} -> {professor})) - { #This is the instructor of record or an administrator. No changes permitted via LTI. - } - else - { - my $change_made = 0; - $self -> {last_name} =~ s/\+/ /g; - if (defined($user -> last_name) and defined($self -> {last_name}) - and $user -> last_name ne $self -> {last_name}) + $self->{initial_login} = 1; + } else { # Existing user. Possibly modify demographic information and permission level. + my $user = $db->getUser($userID); + my $permissionLevel = $db->getPermissionLevel($userID); + if ( + ($user->last_name() eq "Teacher" and $user->first_name() eq "The") + or (defined($permissionLevel->permission) + and $permissionLevel->permission > $ce->{userRoles}->{professor}) + ) + { #This is the instructor of record or an administrator. No changes permitted via LTI. + } else { + my $change_made = 0; + $self->{last_name} =~ s/\+/ /g; + if (defined($user->last_name) + and defined($self->{last_name}) + and $user->last_name ne $self->{last_name}) { - $user -> last_name($self -> {last_name}); - $change_made = 1; + $user->last_name($self->{last_name}); + $change_made = 1; } - $self -> {first_name} =~ s/\+/ /g; - if (defined($user -> first_name) and defined($self -> {first_name}) - and $user -> first_name ne $self -> {first_name}) + $self->{first_name} =~ s/\+/ /g; + if (defined($user->first_name) + and defined($self->{first_name}) + and $user->first_name ne $self->{first_name}) { - $user -> first_name($self -> {first_name}); - $change_made = 1; + $user->first_name($self->{first_name}); + $change_made = 1; } - if (defined($user -> email_address) and defined($self -> {email}) - and $user -> email_address ne $self -> {email}) + if (defined($user->email_address) + and defined($self->{email}) + and $user->email_address ne $self->{email}) { - $user -> email_address($self -> {email}); - $change_made = 1; + $user->email_address($self->{email}); + $change_made = 1; } - if ($user -> status ne "C") - { - $user -> status("C"); - $change_made = 1; + if ($user->status ne "C") { + $user->status("C"); + $change_made = 1; } - if (defined($permissionLevel -> permission) - and $permissionLevel -> permission > $ce ->{userRoles} -> {"student"}) - {if ($user -> section ne "Admin") - { - $user -> section("Admin"); + if (defined($permissionLevel->permission) + and $permissionLevel->permission > $ce->{userRoles}->{"student"}) + { + if ($user->section ne "Admin") { + $user->section("Admin"); $change_made = 1; - } } - elsif ($LTI_webwork_permissionLevel > $ce -> {userRoles}->{"student"} - and (!defined($user -> section) or $user -> section ne "Admin") ) - { - $user -> section("Admin"); + } elsif ($LTI_webwork_permissionLevel > $ce->{userRoles}->{"student"} + and (!defined($user->section) or $user->section ne "Admin")) + { + $user->section("Admin"); $change_made = 1; - } - elsif (defined ($self -> {"section"}) - and (! defined($user -> section) - or ($user -> section ne $self -> {"section"} - and $self -> {"section"} ne "" - and $user -> section ne "Admin" - ) + } elsif ( + defined($self->{"section"}) + and ( + !defined($user->section) + or ($user->section ne $self->{"section"} + and $self->{"section"} ne "" + and $user->section ne "Admin") ) - ) - { - $user -> section($self -> {"section"}); + ) + { + $user->section($self->{"section"}); $change_made = 1; - } - if (defined($self -> {"recitation"}) and defined($user -> recitation) - and $user -> recitation ne $self -> {"recitation"}) - {$user -> recitation($self ->{"recitation"}); - $change_made = 1; - } - if ($change_made) + } + if (defined($self->{"recitation"}) + and defined($user->recitation) + and $user->recitation ne $self->{"recitation"}) { - $user -> comment(formatDateTime(time, "local")); - $db -> putUser($user); - $self->write_log_entry("Demographic data for user $userID modified via LTIBasic login"); - } - # Assign permission level + $user->recitation($self->{"recitation"}); + $change_made = 1; + } + if ($change_made) { + $user->comment(formatDateTime(time, "local")); + $db->putUser($user); + $self->write_log_entry("Demographic data for user $userID modified via LTIBasic login"); + } + # Assign permission level ######## Changed due to Instructor roles passed from Sakai/Oncourse to LTIBasic ###### -# if (!defined($permissionLevel -> permission) or $permissionLevel -> permission != $LTI_webwork_permissionLevel) + # if (!defined($permissionLevel -> permission) or $permissionLevel -> permission != $LTI_webwork_permissionLevel) -# you seldom fine a defined user without a permissionLevel assigned -# I don'think the following if statement is ever run. - if (!defined($permissionLevel -> permission) ) + # you seldom fine a defined user without a permissionLevel assigned + # I don'think the following if statement is ever run. + if (!defined($permissionLevel->permission)) ################################################################# { - $permissionLevel -> permission($LTI_webwork_permissionLevel); - $db -> putPermissionLevel($permissionLevel); # store in database - $self->{PermissionLevel} = $permissionLevel; #cache the revised Permission Level Record. - $self->write_log_entry("\n\n\nPermission level for user $userID set to $LTI_webwork_permissionLevel via LTIBasic login"); - warn "Setting permission level for $userID to $LTI_webwork_permissionLevel" if ( $ce->{debug_lti_parameters} ); + $permissionLevel->permission($LTI_webwork_permissionLevel); + $db->putPermissionLevel($permissionLevel); # store in database + $self->{PermissionLevel} = $permissionLevel; #cache the revised Permission Level Record. + $self->write_log_entry( + "\n\n\nPermission level for user $userID set to $LTI_webwork_permissionLevel via LTIBasic login" + ); + warn "Setting permission level for $userID to $LTI_webwork_permissionLevel" + if ($ce->{debug_lti_parameters}); + } + warn "Existing user: $userID updated.\n LTIpermission level is $LTI_webwork_permissionLevel. + webwork level is " + . $permissionLevel->permission . ".\n" + . "User section is |" + . $user->{section} + . "|\n recitation is |" + . $user->{recitation} . "|\n" + if ($ce->{debug_lti_parameters}); } - warn "Existing user: $userID updated.\n LTIpermission level is $LTI_webwork_permissionLevel. - webwork level is ". $permissionLevel -> permission. ".\n". - "User section is |".$user->{section}. "|\n recitation is |".$user->{recitation}."|\n" if ( $ce->{debug_lti_parameters} ); - } - $self -> {initial_login} = 1; + $self->{initial_login} = 1; } return 1; } } #debug("LTIBasic is returning a failed authentication"); - $self -> {error} = $r->maketext($GENERIC_ERROR_MESSAGE, $ce->{LMS_name}); - return(0); + $self->{error} = $r->maketext($GENERIC_ERROR_MESSAGE, $ce->{LMS_name}); + return (0); } - ################################################################################ ################################################################################ # NONCE SUB-PACKAGE @@ -828,9 +832,9 @@ package WeBWorK::Authen::LTIBasic::Nonce; sub new { my ($invocant, $r, $nonce, $timestamp) = @_; my $class = ref($invocant) || $invocant; - my $self = { - r => $r, - nonce => $nonce, + my $self = { + r => $r, + nonce => $nonce, timestamp => $timestamp, }; bless $self, $class; @@ -839,26 +843,27 @@ sub new { sub ok { my $self = shift; - my $r = $self -> {r}; - my $ce = $r -> {ce}; - if ($self -> {timestamp} < time() - $ce->{NonceLifeTime}) { + my $r = $self->{r}; + my $ce = $r->{ce}; + if ($self->{timestamp} < time() - $ce->{NonceLifeTime}) { return 0; } - my $db = $self->{r}->{db}; + my $db = $self->{r}->{db}; my $Key = $db->getKey($self->{nonce}); # If we *haven't* used this nonce before then we are OK. - if (! defined($Key) ) { + if (!defined($Key)) { # nonce, timestamp are ok. Add the nonce so its not used again. - $Key = $db->newKey(user_id=>$self->{nonce}, - key=>"nonce", - timestamp=>$self->{"timestamp"}, - ); + $Key = $db->newKey( + user_id => $self->{nonce}, + key => "nonce", + timestamp => $self->{"timestamp"}, + ); $db->addKey($Key); return 1; } else { # The nonce is in the database - so was used "recently" so should NOT be allowed - if ( $Key->timestamp < $self->{"timestamp"} ) { + if ($Key->timestamp < $self->{"timestamp"}) { # Update timestamp - so deletion will be delayed from the most recent value # of oauth_timestamp sent by the LTI consumer and not from an earlier timestamp. $Key->timestamp($self->{"timestamp"}); @@ -878,11 +883,11 @@ sub ok { sub print_keys { my ($self, $r) = @_; - my @keys = keys %{$r-> {paramcache}}; + my @keys = keys %{ $r->{paramcache} }; my %request_hash; my $key; foreach $key (@keys) { - $request_hash{$key} = $r -> param($key); + $request_hash{$key} = $r->param($key); warn("$key -> |" . $request_hash{$key} . "|"); } my $requestHash = \%request_hash; diff --git a/lib/WeBWorK/Authen/Moodle.pm b/lib/WeBWorK/Authen/Moodle.pm index 21f17e5da5..5e878b49a8 100644 --- a/lib/WeBWorK/Authen/Moodle.pm +++ b/lib/WeBWorK/Authen/Moodle.pm @@ -38,7 +38,7 @@ use warnings; use Digest::MD5 qw/md5_hex/; use WeBWorK::Cookie; use WeBWorK::Debug; -use Date::Parse; # for moodle 1.7 date parsing +use Date::Parse; # for moodle 1.7 date parsing sub new { my $self = shift->SUPER::new(@_); @@ -53,7 +53,7 @@ sub new { # (this is similar to what happens when a guest user is selected.) sub get_credentials { my $self = shift; - my $r = $self->{r}; + my $r = $self->{r}; my $super_result = $self->SUPER::get_credentials; if ($super_result) { @@ -62,22 +62,24 @@ sub get_credentials { } my ($moodle_user_id, $moodle_expiration_time) = $self->fetch_moodle_session; - #debug("fetch_moodle_session returned: moodle_user_id='$moodle_user_id' moodle_expiration_time='$moodle_expiration_time'.\n"); # causes errors when undefined +#debug("fetch_moodle_session returned: moodle_user_id='$moodle_user_id' moodle_expiration_time='$moodle_expiration_time'.\n"); # causes errors when undefined if (defined $moodle_user_id and defined $moodle_expiration_time and time <= $moodle_expiration_time) { my $newKey = $self->create_session($moodle_user_id); debug("Unexpired moodle session found. Created new WeBWorK session with newKey='$newKey'.\n"); - $self->{user_id} = $moodle_user_id; - $self->{session_key} = $newKey; - $self->{login_type} = "normal"; + $self->{user_id} = $moodle_user_id; + $self->{session_key} = $newKey; + $self->{login_type} = "normal"; $self->{credential_source} = "moodle"; return 1; } else { debug("No moodle session found or moodle session expired. No credentials to be had.\n"); - warn("No moodle session found or moodle sessioin expired. If this happens repeatedly and you are constantly being asked + warn( + "No moodle session found or moodle sessioin expired. If this happens repeatedly and you are constantly being asked to log back in ask your moodle admin to check that the Moodle item: - Server -> Session Handling -> dbsessions (Use database for session information) has been checked."); + Server -> Session Handling -> dbsessions (Use database for session information) has been checked." + ); } return 0; @@ -101,7 +103,7 @@ sub checkPassword { debug("Moodle module is doing the password checking.\n"); - my $Password = $db->getPassword($userID); # checked + my $Password = $db->getPassword($userID); # checked if (defined $Password) { # check against Moodle password database my $possibleMD5Password = md5_hex($possibleClearPassword); @@ -126,15 +128,26 @@ sub checkPassword { sub check_session { my ($self, $user_id, $session_key, $update_timestamp) = @_; - my ($sessionExists, $keyMatches, $timestampValid) = $self->SUPER::check_session($user_id, $session_key, $update_timestamp); - debug("SUPER::check_session returned: sessionExists='", $sessionExists, "' keyMatches='", $keyMatches, "' timestampValid='", $timestampValid, "'"); + my ($sessionExists, $keyMatches, $timestampValid) = + $self->SUPER::check_session($user_id, $session_key, $update_timestamp); + debug( + "SUPER::check_session returned: sessionExists='", + $sessionExists, "' keyMatches='", + $keyMatches, "' timestampValid='", + $timestampValid, "'" + ); if ($update_timestamp and $sessionExists and $keyMatches and not $timestampValid) { debug("special case: webwork key matches an expired session (check for a unexpired moodle session)"); my ($moodle_user_id, $moodle_expiration_time) = $self->fetch_moodle_session; - debug("fetch_moodle_session returned: moodle_user_id='$moodle_user_id' moodle_expiration_time='$moodle_expiration_time'.\n"); - if (defined $moodle_user_id and $moodle_user_id eq $user_id - and defined $moodle_expiration_time and time <= $moodle_expiration_time) { + debug( + "fetch_moodle_session returned: moodle_user_id='$moodle_user_id' moodle_expiration_time='$moodle_expiration_time'.\n" + ); + if (defined $moodle_user_id + and $moodle_user_id eq $user_id + and defined $moodle_expiration_time + and time <= $moodle_expiration_time) + { $self->{session_key} = $self->create_session($moodle_user_id); $timestampValid = 1; } @@ -154,9 +167,9 @@ sub init_mdl_session { my $self = shift; # version-specific stuff - $self->{moodle17} = $self->{r}->ce->{authen}{moodle_options}{moodle17}; + $self->{moodle17} = $self->{r}->ce->{authen}{moodle_options}{moodle17}; $self->{sql_session_table} = $self->{moodle17} ? "sessions2" : "sessions"; - $self->{sql_data_field} = $self->{moodle17} ? "sessdata" : "data"; + $self->{sql_data_field} = $self->{moodle17} ? "sessdata" : "data"; $self->{mdl_dbh} = DBI->connect_cached( $self->{r}->ce->{authen}{moodle_options}{dsn}, @@ -176,19 +189,19 @@ sub fetch_moodle_session { # Note that we don't worry about the user being in this course at this point. # That is taken care of in Schema::Moodle::User. my ($self) = @_; - my $r = $self->{r}; - my $db = $r->db; + my $r = $self->{r}; + my $db = $r->db; my %cookies = WeBWorK::Cookie->fetch($r); - my $cookie = $cookies{"MoodleSession"}; + my $cookie = $cookies{"MoodleSession"}; return unless $cookie; my $session_table = $self->prefix_table($self->{sql_session_table}); - my $data_field = $self->{sql_data_field}; - my $stmt = "SELECT `expiry`,`$data_field` FROM `$session_table` WHERE `sesskey`=?"; - my @bind_vals = $cookie->value; + my $data_field = $self->{sql_data_field}; + my $stmt = "SELECT `expiry`,`$data_field` FROM `$session_table` WHERE `sesskey`=?"; + my @bind_vals = $cookie->value; - my $sth = $self->{mdl_dbh}->prepare_cached($stmt, undef, 3); # 3: see DBI docs + my $sth = $self->{mdl_dbh}->prepare_cached($stmt, undef, 3); # 3: see DBI docs $sth->execute(@bind_vals); my $row = $sth->fetchrow_arrayref; $sth->finish; @@ -199,7 +212,7 @@ sub fetch_moodle_session { # Moodle 1.7 stores expiry as a DATETIME, but WeBWorK wants a UNIX timestamp. $expires = str2time($expires) if $self->{moodle17}; - my $data = unserialize_session($data_string); + my $data = unserialize_session($data_string); my $username = $data->{"USER"}{"username"}; return $username, $expires; @@ -208,24 +221,24 @@ sub fetch_moodle_session { sub update_moodle_session { # extend the timeout of the current moodle session, if one exists. my ($self) = @_; - my $r = $self->{r}; - my $db = $r->db; + my $r = $self->{r}; + my $db = $r->db; my %cookies = WeBWorK::Cookie->fetch($r); - my $cookie = $cookies{"MoodleSession"}; + my $cookie = $cookies{"MoodleSession"}; return unless $cookie; my $config_table = $self->prefix_table("config"); - my $value = "IFNULL((SELECT `value` FROM `$config_table` WHERE `name`=?),?)+?"; + my $value = "IFNULL((SELECT `value` FROM `$config_table` WHERE `name`=?),?)+?"; # Moodle 1.7 stores expiry as a DATETIME, but WeBWorK supplies a UNIX timestamp. $value = "FROM_UNIXTIME($value)" if $self->{moodle17}; my $session_table = $self->prefix_table($self->{sql_session_table}); - my $stmt = "UPDATE `$session_table` SET `expiry`=$value WHERE `sesskey`=?"; - my @bind_vals = ("sessiontimeout", DEFAULT_EXPIRY, time, $cookie->value); + my $stmt = "UPDATE `$session_table` SET `expiry`=$value WHERE `sesskey`=?"; + my @bind_vals = ("sessiontimeout", DEFAULT_EXPIRY, time, $cookie->value); - my $sth = $self->{mdl_dbh}->prepare_cached($stmt, undef, 3); # 3: see DBI docs + my $sth = $self->{mdl_dbh}->prepare_cached($stmt, undef, 3); # 3: see DBI docs my $result = $sth->execute(@bind_vals); $sth->finish; @@ -249,8 +262,8 @@ sub unserialize_session { my @serialArray = split(/(\w+)\|/, $serialData); my %variables; # finally, actually deserialize it: - for( my $i = 1; $i < $#serialArray; $i += 2 ) { - $variables{$serialArray[$i]} = unserialize($serialArray[$i+1]); + for (my $i = 1; $i < $#serialArray; $i += 2) { + $variables{ $serialArray[$i] } = unserialize($serialArray[ $i + 1 ]); } return \%variables; } diff --git a/lib/WeBWorK/Authen/Proctor.pm b/lib/WeBWorK/Authen/Proctor.pm index 2100277eed..72651e2373 100644 --- a/lib/WeBWorK/Authen/Proctor.pm +++ b/lib/WeBWorK/Authen/Proctor.pm @@ -43,25 +43,24 @@ use constant GENERIC_ERROR_MESSAGE => "Invalid user ID or password."; # 3. user_id/session_key/password come from params proctor_user/proctor_key/proctor_passwd sub get_credentials { my ($self) = @_; - my $r = $self->{r}; - my $ce = $r->ce; - my $db = $r->db; + my $r = $self->{r}; + my $ce = $r->ce; + my $db = $r->db; my $urlpath = $r->urlpath; - my ($set_id, $version_id) = grok_vsetID( $urlpath->arg('setID') ); + my ($set_id, $version_id) = grok_vsetID($urlpath->arg('setID')); # at least the user ID is available in request parameters if (defined $r->param("proctor_user")) { my $student_user_id = $r->param("effectiveUser"); $self->{user_id} = $r->param("proctor_user"); - if ( $self->{user_id} eq $set_id ) { + if ($self->{user_id} eq $set_id) { $self->{user_id} = "set_id:$set_id"; } $self->{session_key} = $r->param("proctor_key"); - $self->{password} = $r->param("proctor_passwd"); - $self->{login_type} = $r->param("submitAnswers") - ? "proctor_grading:$student_user_id" - : "proctor_login:$student_user_id"; + $self->{password} = $r->param("proctor_passwd"); + $self->{login_type} = + $r->param("submitAnswers") ? "proctor_grading:$student_user_id" : "proctor_login:$student_user_id"; $self->{credential_source} = "params"; return 1; } @@ -70,14 +69,14 @@ sub get_credentials { # duplicates method in superclass, adding additional check for permission # to proctor quizzes sub check_user { - my $self = shift; - my $r = $self->{r}; - my $ce = $r->ce; - my $db = $r->db; + my $self = shift; + my $r = $self->{r}; + my $ce = $r->ce; + my $db = $r->db; my $authz = $r->authz; - my $submitAnswers = $r->param("submitAnswers"); - my $user_id = $self->{user_id}; + my $submitAnswers = $r->param("submitAnswers"); + my $user_id = $self->{user_id}; my $past_proctor_id = $r->param("past_proctor_user") || $user_id; # for set-level authentication we prepended "set_id:" @@ -86,7 +85,7 @@ sub check_user { if (defined $user_id and ($user_id eq "" || $show_user_id eq "")) { $self->{log_error} = "no user id specified"; - $self->{error} = "You must specify a user ID."; + $self->{error} = "You must specify a user ID."; return 0; } @@ -94,7 +93,7 @@ sub check_user { unless ($User) { $self->{log_error} = "user unknown"; - $self->{error} = GENERIC_ERROR_MESSAGE; + $self->{error} = GENERIC_ERROR_MESSAGE; return 0; } @@ -106,32 +105,27 @@ sub check_user { unless ($authz->hasPermissions($user_id, "login")) { $self->{log_error} = "user not permitted to login"; - $self->{error} = GENERIC_ERROR_MESSAGE; + $self->{error} = GENERIC_ERROR_MESSAGE; return 0; } - if ( $submitAnswers ) { - unless ($authz->hasPermissions($user_id,"proctor_quiz_grade")) { + if ($submitAnswers) { + unless ($authz->hasPermissions($user_id, "proctor_quiz_grade")) { # only set the error if this proctor is different # than the past proctor, implying that we have # tried to grade with a new proctor id - if ( $past_proctor_id ne $user_id ) { - $self->{log_error} = "user not permitted " . - "to proctor quiz grading."; - $self->{error} = "User $show_user_id is not " . - "authorized to proctor test grade " . - "submissions in this course."; + if ($past_proctor_id ne $user_id) { + $self->{log_error} = "user not permitted " . "to proctor quiz grading."; + $self->{error} = + "User $show_user_id is not " . "authorized to proctor test grade " . "submissions in this course."; } return 0; } } else { - unless ($authz->hasPermissions($user_id,"proctor_quiz_login")) { - $self->{log_error} = "user not permitted to proctor " . - "quiz logins."; - $self->{error} = "User $show_user_id is not " . - "authorized to proctor test logins in this " . - "course."; + unless ($authz->hasPermissions($user_id, "proctor_quiz_login")) { + $self->{log_error} = "user not permitted to proctor " . "quiz logins."; + $self->{error} = "User $show_user_id is not " . "authorized to proctor test logins in this " . "course."; return 0; } } @@ -141,10 +135,10 @@ sub check_user { # proctor_user, proctor_key, and proctor_passwd are used sub set_params { my $self = shift; - my $r = $self->{r}; + my $r = $self->{r}; - $r->param("proctor_user", $self->{user_id}); - $r->param("proctor_key", $self->{session_key}); + $r->param("proctor_user", $self->{user_id}); + $r->param("proctor_key", $self->{session_key}); $r->param("proctor_passwd", ""); } @@ -176,9 +170,9 @@ sub proctor_key_id { } # disable cookie functionality for proctors -sub maybe_send_cookie {} -sub fetchCookie {} -sub sendCookie {} -sub killCookie {} +sub maybe_send_cookie { } +sub fetchCookie { } +sub sendCookie { } +sub killCookie { } 1; diff --git a/lib/WeBWorK/Authen/Shibboleth.pm b/lib/WeBWorK/Authen/Shibboleth.pm index c7d723354f..a85d830c5c 100644 --- a/lib/WeBWorK/Authen/Shibboleth.pm +++ b/lib/WeBWorK/Authen/Shibboleth.pm @@ -56,12 +56,12 @@ use WeBWorK::Debug; sub get_credentials { my ($self) = @_; - my $r = $self->{r}; - my $ce = $r->ce; - my $db = $r->db; - - if ( $ce->{shiboff} || $r->param('bypassShib')) { - return $self->SUPER::get_credentials( @_ ); + my $r = $self->{r}; + my $ce = $r->ce; + my $db = $r->db; + + if ($ce->{shiboff} || $r->param('bypassShib')) { + return $self->SUPER::get_credentials(@_); } debug("Shib is on!"); @@ -71,48 +71,51 @@ sub get_credentials { # failure. $self->{external_auth} = 1; - if ( $r->param("user") && ! $r->param("force_passwd_authen") ) { - return $self->SUPER::get_credentials( @_ ); + if ($r->param("user") && !$r->param("force_passwd_authen")) { + return $self->SUPER::get_credentials(@_); } - if ( defined ($ce->{shibboleth}{session_header}) && defined( $ce->{shibboleth}{mapping}{user_id} ) ) { + if (defined($ce->{shibboleth}{session_header}) && defined($ce->{shibboleth}{mapping}{user_id})) { debug('Got shib header and user_id'); my $user_id = $ce->{shibboleth}{mapping}{user_id}; - if ( defined ($ce->{shibboleth}{hash_user_id_method}) && - $ce->{shibboleth}{hash_user_id_method} ne "none" && - $ce->{shibboleth}{hash_user_id_method} ne "" ) { + if (defined($ce->{shibboleth}{hash_user_id_method}) + && $ce->{shibboleth}{hash_user_id_method} ne "none" + && $ce->{shibboleth}{hash_user_id_method} ne "") + { use Digest; - my $digest = Digest->new($ce->{shibboleth}{hash_user_id_method}); - $digest->add(uc($user_id). ( defined $ce->{shibboleth}{hash_user_id_salt} ? $ce->{shibboleth}{hash_user_id_salt} : "")); + my $digest = Digest->new($ce->{shibboleth}{hash_user_id_method}); + $digest->add( + uc($user_id) + . (defined $ce->{shibboleth}{hash_user_id_salt} ? $ce->{shibboleth}{hash_user_id_salt} : "")); $user_id = $digest->hexdigest; } $self->{'user_id'} = $user_id; $self->{r}->param("user", $user_id); - # the session key isn't used (Shibboleth is managing this - # for us), and we want to force checking against the + # the session key isn't used (Shibboleth is managing this + # for us), and we want to force checking against the # site_checkPassword - $self->{'session_key'} = undef; - $self->{'password'} = 1; - $self->{login_type} = "normal"; + $self->{'session_key'} = undef; + $self->{'password'} = 1; + $self->{login_type} = "normal"; $self->{'credential_source'} = "params"; return 1; } debug("Couldn't shib header or user_id"); - my $q = new CGI; - my $go_to = $ce->{shibboleth}{login_script}."?target=".$q->url(-path=>1); + my $q = new CGI; + my $go_to = $ce->{shibboleth}{login_script} . "?target=" . $q->url(-path => 1); $self->{redirect} = $go_to; print $q->redirect($go_to); return 0; } -sub site_checkPassword { - my ( $self, $userID, $clearTextPassword ) = @_; +sub site_checkPassword { + my ($self, $userID, $clearTextPassword) = @_; - if ( $self->{r}->ce->{shiboff} || $self->{r}->param('bypassShib') ) { - return $self->SUPER::checkPassword( @_ ); + if ($self->{r}->ce->{shiboff} || $self->{r}->param('bypassShib')) { + return $self->SUPER::checkPassword(@_); } else { # this is easy; if we're here at all, we've authenticated # through shib @@ -123,32 +126,35 @@ sub site_checkPassword { # disable cookie functionality sub maybe_send_cookie { my ($self, @args) = @_; - if ( $self->{r}->ce->{shiboff} ) { - return $self->SUPER::maybe_send_cookie( @_ ); + if ($self->{r}->ce->{shiboff}) { + return $self->SUPER::maybe_send_cookie(@_); } else { # nothing to do here } } + sub fetchCookie { my ($self, @args) = @_; - if ( $self->{r}->ce->{shiboff} ) { - return $self->SUPER::fetchCookie( @_ ); + if ($self->{r}->ce->{shiboff}) { + return $self->SUPER::fetchCookie(@_); } else { # nothing to do here } } + sub sendCookie { my ($self, @args) = @_; - if ( $self->{r}->ce->{shiboff} ) { - return $self->SUPER::sendCookie( @_ ); + if ($self->{r}->ce->{shiboff}) { + return $self->SUPER::sendCookie(@_); } else { # nothing to do here } } + sub killCookie { my ($self, @args) = @_; - if ( $self->{r}->ce->{shiboff} ) { - return $self->SUPER::killCookie( @_ ); + if ($self->{r}->ce->{shiboff}) { + return $self->SUPER::killCookie(@_); } else { # nothing to do here } @@ -156,15 +162,15 @@ sub killCookie { # this is a bit of a cheat, because it does the redirect away from the # logout script or what have you, but I don't see a way around that. -sub forget_verification { +sub forget_verification { my ($self, @args) = @_; my $r = $self->{r}; - if ( $r->ce->{shiboff} ) { - return $self->SUPER::forget_verification( @_ ); + if ($r->ce->{shiboff}) { + return $self->SUPER::forget_verification(@_); } else { $self->{was_verified} = 0; - $self->{redirect} = $r->ce->{shibboleth}{logout_script}; + $self->{redirect} = $r->ce->{shibboleth}{logout_script}; } } @@ -175,15 +181,15 @@ sub check_session { my ($self, $userID, $possibleKey, $updateTimestamp) = @_; my $ce = $self->{r}->ce; my $db = $self->{r}->db; - - if ( $ce->{shiboff} ) { - return $self->SUPER::check_session( @_ ); + + if ($ce->{shiboff}) { + return $self->SUPER::check_session(@_); } else { - my $Key = $db->getKey($userID); # checked - return 0 unless defined $Key; + my $Key = $db->getKey($userID); # checked + return 0 unless defined $Key; - my $keyMatches = (defined $possibleKey and $possibleKey eq $Key->key); - my $timestampValid = (time <= $Key->timestamp()+$ce->{sessionKeyTimeout}); + my $keyMatches = (defined $possibleKey and $possibleKey eq $Key->key); + my $timestampValid = (time <= $Key->timestamp() + $ce->{sessionKeyTimeout}); if ($ce->{shibboleth}{manage_session_timeout}) { # always valid to allow shib to take control of timeout $timestampValid = 1; diff --git a/lib/WeBWorK/Authen/XMLRPC.pm b/lib/WeBWorK/Authen/XMLRPC.pm index 3775d79e66..a952c0a50c 100644 --- a/lib/WeBWorK/Authen/XMLRPC.pm +++ b/lib/WeBWorK/Authen/XMLRPC.pm @@ -26,14 +26,13 @@ use strict; use warnings; use WeBWorK::Debug; -# Instead of being called with an apache request object $r -# this authentication method gets its data -# from an HTML data form. It creates a WeBWorK::Authen::XMLRPC object +# Instead of being called with an apache request object $r +# this authentication method gets its data +# from an HTML data form. It creates a WeBWorK::Authen::XMLRPC object # which fakes the essential properties of the WeBWorK::Request object needed for authentication - # sub new { -# my $class = shift; +# my $class = shift; # my $fake_r = shift; # my $user_authen_module = WeBWorK::Authen::class($ce, "user_module"); # # runtime_use $user_authen_module; @@ -44,13 +43,11 @@ use WeBWorK::Debug; # disable cookie functionality for xmlrpc sub connection { - return 0; #indicate that there is no connection + return 0; #indicate that there is no connection } -sub maybe_send_cookie {} -sub fetchCookie {} -sub sendCookie {} -sub killCookie {} - - +sub maybe_send_cookie { } +sub fetchCookie { } +sub sendCookie { } +sub killCookie { } 1; diff --git a/lib/WeBWorK/Authz.pm b/lib/WeBWorK/Authz.pm index c5f770cdf7..4bb8699a43 100644 --- a/lib/WeBWorK/Authz.pm +++ b/lib/WeBWorK/Authz.pm @@ -82,12 +82,10 @@ already have its C and C fields set. sub new { my ($invocant, $r) = @_; my $class = ref($invocant) || $invocant; - my $self = { - r => $r, - }; - weaken $self -> {r}; + my $self = { r => $r, }; + weaken $self->{r}; - $r -> {permission_retrieval_error} = 0; + $r->{permission_retrieval_error} = 0; bless $self, $class; return $self; } @@ -113,7 +111,7 @@ WeBWorK to cache the "real" user. sub setCachedUser { my ($self, $userID) = @_; - my $r = $self->{r}; + my $r = $self->{r}; my $db = $r->db; delete $self->{userID}; @@ -121,49 +119,51 @@ sub setCachedUser { if (defined $userID) { $self->{userID} = $userID; - if (! $db -> existsUser($userID) && defined($r -> param("lis_person_sourcedid"))) { + if (!$db->existsUser($userID) && defined($r->param("lis_person_sourcedid"))) { # This is a new user referred via an LTI link. # Do not attempt to cache the permission here. # Rather, the LTIBasic authentication module should cache the permission. return 1; } my $PermissionLevel; - my $tryAgain=1; - my $count=0; + my $tryAgain = 1; + my $count = 0; while ($tryAgain && $count < 2) { - eval {$PermissionLevel = $db->getPermissionLevel($userID); # checked - }; + eval { + $PermissionLevel = $db->getPermissionLevel($userID); # checked + }; if ($@) { $count++; - } - else { - $tryAgain=0; + } else { + $tryAgain = 0; } } - if (defined $PermissionLevel and defined $PermissionLevel -> permission - and $PermissionLevel -> permission ne "") { + if (defined $PermissionLevel + and defined $PermissionLevel->permission + and $PermissionLevel->permission ne "") + { # cache the permission level record in this request to avoid later database calls $self->{PermissionLevel} = $PermissionLevel; - } - elsif (defined($r -> param("lis_person_sourcedid")) - or defined($r -> param("lis_person_sourced_id")) - or defined($r -> param("lis_person_source_id")) - or defined($r -> param("lis_person_sourceid")) - or defined($r -> param("lis_person_contact_email_primary")) ) { + } elsif (defined($r->param("lis_person_sourcedid")) + or defined($r->param("lis_person_sourced_id")) + or defined($r->param("lis_person_source_id")) + or defined($r->param("lis_person_sourceid")) + or defined($r->param("lis_person_contact_email_primary"))) + { # This is a new user referred via an LTI link. # Do not attempt to cache the permission here. # Rather, the LTIBasic authentication module should cache the permission. return 1; - } - elsif (defined($r -> param("oauth_nonce"))) { + } elsif (defined($r->param("oauth_nonce"))) { # This is a LTI attempt that doesn't have an lis_person_sourcedid username. - croak ("Your request did not specify your username. Perhaps you were attempting to authenticate via LTI but the LTI tool did not transmit " - . "any variant of the lis_person_sourced_id parameter and did not transmit the lis_person_contact_email_primary parameter."); - } + croak( + "Your request did not specify your username. Perhaps you were attempting to authenticate via LTI but the LTI tool did not transmit " + . "any variant of the lis_person_sourced_id parameter and did not transmit the lis_person_contact_email_primary parameter." + ); - else { + } else { if ($r->{permission_retrieval_error} == 0) { - $r->{permission_retrieval_error}=1; + $r->{permission_retrieval_error} = 1; croak "Unable to retrieve your permissions, perhaps due to a collision " . "between your request and that of another user " . "(or possibly an unfinished request of yours). " @@ -195,15 +195,15 @@ assumes that the user does not have permission. # This currently only uses two of it's arguments, but it accepts any number, in # case in the future calculating certain permissions requires more information. sub hasPermissions { - if (@_ != 3 and not( @_==4 and $_[3] eq 'equal') ) { - shift @_; # get rid of self + if (@_ != 3 and not(@_ == 4 and $_[3] eq 'equal')) { + shift @_; # get rid of self my $nargs = @_; - croak "hasPermissions called with $nargs arguments instead of the expected 2: '@_'" + croak "hasPermissions called with $nargs arguments instead of the expected 2: '@_'"; } my ($self, $userID, $activity, $exactness) = @_; - if (!defined($exactness) ) {$exactness='ge';} - my $r = $self->{r}; + if (!defined($exactness)) { $exactness = 'ge'; } + my $r = $self->{r}; my $ce = $r->ce; my $db = $r->db; @@ -218,7 +218,7 @@ sub hasPermissions { if (not defined($self->{userID})) { #warn "self->{userID} is undefined"; - $self-> setCachedUser($userID); + $self->setCachedUser($userID); } my $cachedUserID = $self->{userID}; @@ -226,24 +226,22 @@ sub hasPermissions { # this is the same user -- we can skip the database call $PermissionLevel = $self->{PermissionLevel}; } else { - # a different user, or no user was defined before - #my $prettyCachedUserID = defined $cachedUserID ? "'$cachedUserID'" : "undefined"; - #warn "hasPermissions called with user $userID , but cached user is $prettyCachedUserID. Accessing database.\n"; - $PermissionLevel = $db->getPermissionLevel($userID); # checked + # a different user, or no user was defined before + #my $prettyCachedUserID = defined $cachedUserID ? "'$cachedUserID'" : "undefined"; + #warn "hasPermissions called with user $userID , but cached user is $prettyCachedUserID. Accessing database.\n"; + $PermissionLevel = $db->getPermissionLevel($userID); # checked } my $permission_level; if (defined $PermissionLevel) { $permission_level = $PermissionLevel->permission; - } - elsif (defined($r -> param("lis_person_sourcedid"))){ + } elsif (defined($r->param("lis_person_sourcedid"))) { # This is an LTI login. Let's see if the LITBasic authentication module will handle this. #return 1; - } - else { + } else { # uh, oh. this user has no permission level record! - if ($r -> {permission_retrieval_error} != 1) { + if ($r->{permission_retrieval_error} != 1) { warn "User '$userID' has no PermissionLevel record -- assuming no permission."; } return 0; @@ -254,7 +252,7 @@ sub hasPermissions { return 0; } - my $userRoles = $ce->{userRoles}; + my $userRoles = $ce->{userRoles}; my $permissionLevels = $ce->{permissionLevels}; if (exists $permissionLevels->{$activity}) { @@ -263,29 +261,27 @@ sub hasPermissions { if (exists $userRoles->{$activity_role}) { my $role_permlevel = $userRoles->{$activity_role}; if (defined $role_permlevel) { - if ($exactness eq 'ge') { - return $permission_level >= $role_permlevel; - } - elsif ($exactness eq 'equal') { - return $permission_level == $role_permlevel; - } - else { - return 0; - } + if ($exactness eq 'ge') { + return $permission_level >= $role_permlevel; + } elsif ($exactness eq 'equal') { + return $permission_level == $role_permlevel; + } else { + return 0; + } } else { -# warn "Role '$activity_role' has undefined permission level -- assuming no permission."; + # warn "Role '$activity_role' has undefined permission level -- assuming no permission."; return 0; } } else { -# warn "Role '$activity_role' for activity '$activity' not found in \%userRoles -- assuming no permission."; + # warn "Role '$activity_role' for activity '$activity' not found in \%userRoles -- assuming no permission."; return 0; } } else { -# warn "Undefined Role, -- assuming no one has permission to perform $activity."; - return 0; # undefiend $activity_role, no one has permission to perform $activity + # warn "Undefined Role, -- assuming no one has permission to perform $activity."; + return 0; # undefiend $activity_role, no one has permission to perform $activity } } else { -# warn "Activity '$activity' not found in \%permissionLevels -- assuming no permission."; + # warn "Activity '$activity' not found in \%permissionLevels -- assuming no permission."; return 0; } } @@ -293,20 +289,20 @@ sub hasPermissions { ######################### IU Addition ############### sub hasExactPermissions { my ($self, $userID, $activity) = @_; - my $r = $self->{r}; + my $r = $self->{r}; my $ce = $r->ce; my $db = $r->db; -# my $Permission = $db->getPermissionLevel($user); # checked -# return 0 unless defined $Permission; -# my $permissionLevel = $Permission->permission(); + # my $Permission = $db->getPermissionLevel($user); # checked + # return 0 unless defined $Permission; + # my $permissionLevel = $Permission->permission(); ## my $PermissionLevel; if (not defined($self->{userID})) { #warn "self->{userID} is undefined"; - $self-> setCachedUser($userID); + $self->setCachedUser($userID); } my $cachedUserID = $self->{userID}; @@ -314,10 +310,10 @@ sub hasExactPermissions { # this is the same user -- we can skip the database call $PermissionLevel = $self->{PermissionLevel}; } else { - # a different user, or no user was defined before - #my $prettyCachedUserID = defined $cachedUserID ? "'$cachedUserID'" : "undefined"; - #warn "hasPermissions called with user $userID , but cached user is $prettyCachedUserID. Accessing database.\n"; - $PermissionLevel = $db->getPermissionLevel($userID); # checked + # a different user, or no user was defined before + #my $prettyCachedUserID = defined $cachedUserID ? "'$cachedUserID'" : "undefined"; + #warn "hasPermissions called with user $userID , but cached user is $prettyCachedUserID. Accessing database.\n"; + $PermissionLevel = $db->getPermissionLevel($userID); # checked } my $permission_level; @@ -326,7 +322,7 @@ sub hasExactPermissions { $permission_level = $PermissionLevel->permission; } else { # uh, oh. this user has no permission level record! - if ($r -> {permission_retrieval_error} != 1) { + if ($r->{permission_retrieval_error} != 1) { warn "User '$userID' has no PermissionLevel record -- assuming no permission."; } return 0; @@ -506,49 +502,55 @@ sub checkSet { } sub invalidIPAddress { -# this exists as a separate routine because we need to check multiple -# sets in Hardcopy; having this routine to check the set allows us to do -# that for all sets individually there. + # this exists as a separate routine because we need to check multiple + # sets in Hardcopy; having this routine to check the set allows us to do + # that for all sets individually there. my $self = shift; - my $set = shift; + my $set = shift; - my $r = $self->{r}; - my $db = $r->db; - my $ce = $r->ce; + my $r = $self->{r}; + my $db = $r->db; + my $ce = $r->ce; my $urlPath = $r->urlpath; -# my $setName = $urlPath->arg("setID"); # not always defined - my $setName = $set->set_id; - my $userName = $r->param("user"); + # my $setName = $urlPath->arg("setID"); # not always defined + my $setName = $set->set_id; + my $userName = $r->param("user"); my $effectiveUserName = $r->param("effectiveUser"); - return 0 if (!defined($set->restrict_ip) || - $set->restrict_ip eq '' || $set->restrict_ip eq 'No' || - $self->hasPermissions($userName,'view_ip_restricted_sets')); + return 0 + if (!defined($set->restrict_ip) + || $set->restrict_ip eq '' + || $set->restrict_ip eq 'No' + || $self->hasPermissions($userName, 'view_ip_restricted_sets')); my $clientIP = new Net::IP($r->useragent_ip); # make sure that we're using the non-versioned set name $setName =~ s/,v\d+$//; - my $restrictType = $set->restrict_ip; - my @restrictLocations = $db->getAllMergedSetLocations($effectiveUserName,$setName); - my @locationIDs = ( map {$_->location_id} @restrictLocations ); - my @restrictAddresses = ( map {$db->listLocationAddresses($_)} @locationIDs ); + my $restrictType = $set->restrict_ip; + my @restrictLocations = $db->getAllMergedSetLocations($effectiveUserName, $setName); + my @locationIDs = (map { $_->location_id } @restrictLocations); + my @restrictAddresses = (map { $db->listLocationAddresses($_) } @locationIDs); # if there are no addresses in the locations, return an error that # says this - return $r->maketext("Client ip address [_1] is not allowed to work this assignment, because the assignment has ip address restrictions and there are no allowed locations associated with the restriction. Contact your professor to have this problem resolved.",$clientIP->ip() ) if ( ! @restrictAddresses ); + return $r->maketext( + "Client ip address [_1] is not allowed to work this assignment, because the assignment has ip address restrictions and there are no allowed locations associated with the restriction. Contact your professor to have this problem resolved.", + $clientIP->ip() + ) if (!@restrictAddresses); # build a set of IP objects to match against - my @restrictIPs = ( map {new Net::IP($_)} @restrictAddresses ); + my @restrictIPs = (map { new Net::IP($_) } @restrictAddresses); # and check the clientAddress against these: is $clientIP # in @restrictIPs? my $inRestrict = 0; - foreach my $rIP ( @restrictIPs ) { - if ($rIP->overlaps($clientIP) == $IP_B_IN_A_OVERLAP || - $rIP->overlaps($clientIP) == $IP_IDENTICAL) { + foreach my $rIP (@restrictIPs) { + if ($rIP->overlaps($clientIP) == $IP_B_IN_A_OVERLAP + || $rIP->overlaps($clientIP) == $IP_IDENTICAL) + { $inRestrict = $rIP->ip(); last; } @@ -556,14 +558,18 @@ sub invalidIPAddress { # this is slightly complicated by having to check relax_restrict_ip my $badIP = ''; - if ( $restrictType eq 'RestrictTo' && ! $inRestrict ) { - $badIP = "Client ip address " . $clientIP->ip() . - " is not in the list of addresses from " . - "which this assignment may be worked."; - } elsif ( $restrictType eq 'DenyFrom' && $inRestrict ) { - $badIP = "Client ip address " . $clientIP->ip() . - " is in the list of addresses from " . - "which this assignment may not be worked."; + if ($restrictType eq 'RestrictTo' && !$inRestrict) { + $badIP = + "Client ip address " + . $clientIP->ip() + . " is not in the list of addresses from " + . "which this assignment may be worked."; + } elsif ($restrictType eq 'DenyFrom' && $inRestrict) { + $badIP = + "Client ip address " + . $clientIP->ip() + . " is in the list of addresses from " + . "which this assignment may not be worked."; } else { return 0; } @@ -574,26 +580,25 @@ sub invalidIPAddress { # depending on whether the set is versioned or not my $relaxRestrict = $set->relax_restrict_ip; - return $badIP if ( $relaxRestrict eq 'No' ); + return $badIP if ($relaxRestrict eq 'No'); - if ( $set->assignment_type =~ /gateway/ ) { - if ( $relaxRestrict eq 'AfterAnswerDate' ) { + if ($set->assignment_type =~ /gateway/) { + if ($relaxRestrict eq 'AfterAnswerDate') { # in this case we need to go and get the userset, # not the versioned set (which we already have) # drat! - my $userset = $db->getMergedSet($set->user_id,$setName); - return( ! $userset || before($userset->answer_date) - ? $badIP : 0 ); + my $userset = $db->getMergedSet($set->user_id, $setName); + return (!$userset || before($userset->answer_date) ? $badIP : 0); } else { # this is easier; just look at the current answer date - return( before($set->answer_date) ? $badIP : 0 ); + return (before($set->answer_date) ? $badIP : 0); } } else { # the set isn't versioned, so assume that $relaxRestrict # is 'AfterAnswerDate', regardless of what it actually # is; 'AfterVersionAnswerDate' doesn't make sense in # this case - return( before($set->answer_date) ? $badIP : 0 ); + return (before($set->answer_date) ? $badIP : 0); } } @@ -608,5 +613,4 @@ Hathaway, sh002i at math.rochester.edu. =cut - 1; diff --git a/lib/WeBWorK/CGI.pm b/lib/WeBWorK/CGI.pm index 0231404e8a..21da43cc0f 100644 --- a/lib/WeBWorK/CGI.pm +++ b/lib/WeBWorK/CGI.pm @@ -21,10 +21,10 @@ use warnings; # from http://search.cpan.org/src/LDS/CGI.pm-3.20/cgi_docs.html#subclassing use vars qw/@ISA $VERSION/; require CGI; -@ISA = 'CGI'; +@ISA = 'CGI'; $VERSION = "0.1"; -$CGI::DefaultClass = __PACKAGE__; +$CGI::DefaultClass = __PACKAGE__; $WeBWorK::CGI::AutoloadClass = 'CGI'; sub new { diff --git a/lib/WeBWorK/Constants.pm b/lib/WeBWorK/Constants.pm index aed0996926..208d81e039 100644 --- a/lib/WeBWorK/Constants.pm +++ b/lib/WeBWorK/Constants.pm @@ -25,7 +25,7 @@ use strict; use warnings; $WeBWorK::Constants::WEBWORK_DIRECTORY = $ENV{WEBWORK_ROOT} unless defined($WeBWorK::Constants::WEBWORK_DIRECTORY); -$WeBWorK::Constants::PG_DIRECTORY = $ENV{PG_ROOT} unless defined($WeBWorK::Constants::PG_DIRECTORY); +$WeBWorK::Constants::PG_DIRECTORY = $ENV{PG_ROOT} unless defined($WeBWorK::Constants::PG_DIRECTORY); ################################################################################ # WeBWorK::Debug diff --git a/lib/WeBWorK/ContentGenerator.pm b/lib/WeBWorK/ContentGenerator.pm index 5bd6491051..f73da5fee2 100644 --- a/lib/WeBWorK/ContentGenerator.pm +++ b/lib/WeBWorK/ContentGenerator.pm @@ -64,7 +64,7 @@ use WeBWorK::Authen::LTIAdvanced::SubmitGrade; use Encode; use Email::Sender::Transport::SMTP; -our $TRACE_WARNINGS = 0; # set to 1 to trace channel used by warning message +our $TRACE_WARNINGS = 0; # set to 1 to trace channel used by warning message ############################################################################### @@ -82,14 +82,14 @@ $r. sub new { my ($invocant, $r) = @_; my $class = ref($invocant) || $invocant; - my $self = { - r => $r, # this is now a WeBWorK::Request - ce => $r->ce(), # these three are here for - db => $r->db(), # backward-compatability - authz => $r->authz(), # with unconverted CGs - noContent => undef, # FIXME this should get clobbered at some point - }; - weaken $self -> {r}; + my $self = { + r => $r, # this is now a WeBWorK::Request + ce => $r->ce(), # these three are here for + db => $r->db(), # backward-compatability + authz => $r->authz(), # with unconverted CGs + noContent => undef, # FIXME this should get clobbered at some point + }; + weaken $self->{r}; bless $self, $class; return $self; } @@ -154,30 +154,30 @@ The method content() is called to send the page content to client. sub go { my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; + my $r = $self->r; + my $ce = $r->ce; # If grades are begin passed back to the lti then we peroidically # update all of the grades because things can get out of sync if # instructors add or modify sets. - if ($ce->{LTIGradeMode} and ref($r->{db}//'') ) { - - my $grader = WeBWorK::Authen::LTIAdvanced::SubmitGrade->new($r); - - my $post_connection_action = sub { - my $grader = shift; - - # catch exceptions generated during the sending process - my $result_message = eval { $grader->mass_update() }; - if ($@) { - # add the die message to the result message - $result_message .= "An error occurred while trying to update grades via LTI.\n" - . "The error message is:\n\n$@\n\n"; - # and also write it to the apache log - $r->log->error("An error occurred while trying to update grades via LTI: $@\n"); - } - }; - $r->connection->pool->cleanup_register($post_connection_action, $grader); + if ($ce->{LTIGradeMode} and ref($r->{db} // '')) { + + my $grader = WeBWorK::Authen::LTIAdvanced::SubmitGrade->new($r); + + my $post_connection_action = sub { + my $grader = shift; + + # catch exceptions generated during the sending process + my $result_message = eval { $grader->mass_update() }; + if ($@) { + # add the die message to the result message + $result_message .= + "An error occurred while trying to update grades via LTI.\n" . "The error message is:\n\n$@\n\n"; + # and also write it to the apache log + $r->log->error("An error occurred while trying to update grades via LTI: $@\n"); + } + }; + $r->connection->pool->cleanup_register($post_connection_action, $grader); } # check to verify if there are set-level problems with running @@ -192,9 +192,9 @@ sub go { # we are in a specific course. The latter check is to prevent attempts # to write to a course log file when viewing the top-level list of # courses page. - WeBWorK::Utils::writeCourseLog($ce, 'activity_log', - $self->prepare_activity_entry) if ( $r->urlpath->arg("courseID") and - $r->ce->{courseFiles}->{logs}->{activity_log}); + WeBWorK::Utils::writeCourseLog($ce, 'activity_log', $self->prepare_activity_entry) + if ($r->urlpath->arg("courseID") + and $r->ce->{courseFiles}->{logs}->{activity_log}); $self->pre_header_initialize(@_) if $self->can("pre_header_initialize"); @@ -243,9 +243,9 @@ sub do_reply_with_file { my ($self, $fileHash) = @_; my $r = $self->r; - my $type = $fileHash->{type}; - my $source = $fileHash->{source}; - my $name = $fileHash->{name}; + my $type = $fileHash->{type}; + my $source = $fileHash->{source}; + my $name = $fileHash->{name}; my $delete_after = $fileHash->{delete_after}; # if there was a problem, we return here and let go() worry about sending the reply @@ -265,7 +265,7 @@ sub do_reply_with_file { unlink $source or warn "failed to unlink $source after sending: $!"; } - return; # (see comment on return statement in do_reply_with_redirect, below.) + return; # (see comment on return statement in do_reply_with_redirect, below.) } =item do_reply_with_redirect($url) @@ -281,23 +281,23 @@ sub do_reply_with_redirect { $r->status(Apache2::Const::REDIRECT); $r->headers_out->{"Location"} = $url; - return; # we need to explicitly return noting here, otherwise we return $url under Apache2. - # the return value from the mod_perl handler is used to set the HTTP status code, - # but we're setting it explicitly above. i think we should dispense with setting it - # with the return value altogether, and always do it with $r->status. the other way - # is too oblique and error-prone. this is probably a FIXME. - # - # Apache::WeBWorK::handler always returns the value it got from WeBWorK::dispatch - # WeBWorK::dispatch always returns the value it got from WW::ContentGenerator::go - # WW::ContentGenerator::go works like this: - # - if reply_with_file, return the return value from do_reply_with_file - # (do_reply_with_file actually uses this to return NOT_FOUND/FORBIDDEN) - # - if reply_with_redirect, return the return value from do_reply_with_redirect - # (do_reply_with_redirect does NOT use this -- it sets $r->status instead!) - # - if header returns a defined value, return that - # (CG::header always returns OK!) - # - otherwise, return OK (this never happens!) - # there are no longer any legitimate header() methods other than the one in CG.pm + return; # we need to explicitly return noting here, otherwise we return $url under Apache2. + # the return value from the mod_perl handler is used to set the HTTP status code, + # but we're setting it explicitly above. i think we should dispense with setting it + # with the return value altogether, and always do it with $r->status. the other way + # is too oblique and error-prone. this is probably a FIXME. + # + # Apache::WeBWorK::handler always returns the value it got from WeBWorK::dispatch + # WeBWorK::dispatch always returns the value it got from WW::ContentGenerator::go + # WW::ContentGenerator::go works like this: + # - if reply_with_file, return the return value from do_reply_with_file + # (do_reply_with_file actually uses this to return NOT_FOUND/FORBIDDEN) + # - if reply_with_redirect, return the return value from do_reply_with_redirect + # (do_reply_with_redirect does NOT use this -- it sets $r->status instead!) + # - if header returns a defined value, return that + # (CG::header always returns OK!) + # - otherwise, return OK (this never happens!) + # there are no longer any legitimate header() methods other than the one in CG.pm } =back @@ -330,9 +330,9 @@ sub reply_with_file { $delete_after ||= ""; $self->{reply_with_file} = { - type => $type, - source => $source, - name => $name, + type => $type, + source => $source, + name => $name, delete_after => $delete_after, }; } @@ -362,27 +362,25 @@ Must be called before the message() template escape is invoked. =cut - - sub addmessage { - #addmessages takes html so we use htmlscrubber to get rid of - # any scripts or html comments. However, we leave everything else - # by default. + #addmessages takes html so we use htmlscrubber to get rid of + # any scripts or html comments. However, we leave everything else + # by default. my ($self, $message) = @_; return unless defined($message); my $scrubber = HTML::Scrubber->new( - default => 1, - script => 0, - comment => 0 - ); + default => 1, + script => 0, + comment => 0 + ); $scrubber->default( - undef, - { - '*' => 1, - } - ); + undef, + { + '*' => 1, + } + ); $message = $scrubber->scrub($message); $self->{status_message} .= $message; @@ -419,14 +417,15 @@ This can be overriden by different modules. =cut - sub prepare_activity_entry { - my $self = shift; - my $r = $self->r; - my $string = $r->urlpath->path . " ---> ". - join("\t", (map { $_ eq 'key' || $_ eq 'passwd' ? '' : $_ ." => " . $r->param($_) } $r->param())); + my $self = shift; + my $r = $self->r; + my $string = + $r->urlpath->path + . " ---> " + . join("\t", (map { $_ eq 'key' || $_ eq 'passwd' ? '' : $_ . " => " . $r->param($_) } $r->param())); $string =~ s/\t+/\t/g; - return($string); + return ($string); } =back @@ -465,7 +464,7 @@ type. sub header { my $self = shift; - my $r = $self->r; + my $r = $self->r; $r->content_type("text/html; charset=utf-8"); return Apache2::Const::OK; @@ -491,7 +490,7 @@ This calls WeBWorK::Utils::LanguageAndDirection::get_lang_and_dir. =cut -sub output_course_lang_and_dir{ +sub output_course_lang_and_dir { my $self = shift; print WeBWorK::Utils::LanguageAndDirection::get_lang_and_dir($self->r->ce->{language}); return ""; @@ -536,13 +535,13 @@ Create the link to the host institution with a logo and alt text =cut sub institution_logo { - my $self = shift; - my $r = $self->r; - my $ce = $r->ce; - my $theme = $r->param("theme") || $ce->{defaultTheme}; + my $self = shift; + my $r = $self->r; + my $ce = $r->ce; + my $theme = $r->param("theme") || $ce->{defaultTheme}; my $htdocs = $ce->{webwork_htdocs_url}; print CGI::a( - {href => $ce->{institutionURL}}, + { href => $ce->{institutionURL} }, CGI::img({ src => "$htdocs/themes/$theme/images/" . $ce->{institutionLogo}, alt => $r->maketext("to [_1] main web site", $ce->{institutionName}) @@ -568,33 +567,33 @@ location of the template is looked up in the course environment. sub content { my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; + my $r = $self->r; + my $ce = $r->ce; my $themesDir = $ce->{webworkDirs}{themes}; - my $theme = $r->param("theme") || $ce->{defaultTheme}; + my $theme = $r->param("theme") || $ce->{defaultTheme}; $theme = $ce->{defaultTheme} if $theme =~ m!(?:^|/)\.\.(?:/|$)!; #$ce->{webworkURLs}->{stylesheet} = ($ce->{webworkURLs}->{htdocs})."/css/$theme.css"; # reset the style sheet # the line above is clever -- but I think it is better to link directly to the style sheet from the system.template # then the link between template and css is made in .template file instead of hard coded as above # this means that the {stylesheet} option in defaults.config is never used - my $template = $self->can("templateName") ? $self->templateName : $ce->{defaultThemeTemplate}; + my $template = $self->can("templateName") ? $self->templateName : $ce->{defaultThemeTemplate}; my $templateFile = "$themesDir/$theme/$template.template"; - unless (-r $templateFile) { #hack to prevent disaster when missing theme directory - if (-r "$themesDir/math4/$template.template") { - $templateFile = "$themesDir/math4/$template.template"; - $theme = HTML::Entities::encode_entities($theme); - warn "Theme $theme is not one of the available themes. ". - "Please check the theme configuration ". - "in the files localOverrides.conf, course.conf and ". - "simple.conf and on the course configuration page.\n" - } else { + unless (-r $templateFile) { #hack to prevent disaster when missing theme directory + if (-r "$themesDir/math4/$template.template") { + $templateFile = "$themesDir/math4/$template.template"; + $theme = HTML::Entities::encode_entities($theme); + warn "Theme $theme is not one of the available themes. " + . "Please check the theme configuration " + . "in the files localOverrides.conf, course.conf and " + . "simple.conf and on the course configuration page.\n"; + } else { $theme = HTML::Entities::encode_entities($theme); - die "Neither the theme $theme nor the defaultTheme math4 are available. ". - "Please notify your site administrator that the structure of the ". - "themes directory needs attention."; + die "Neither the theme $theme nor the defaultTheme math4 are available. " + . "Please notify your site administrator that the structure of the " + . "themes directory needs attention."; - } + } } template($templateFile, $self); } @@ -648,12 +647,12 @@ Links that should appear on every page. =cut sub links { - my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; - my $db = $r->db; - my $authen = $r->authen; - my $authz = $r->authz; + my ($self) = @_; + my $r = $self->r; + my $ce = $r->ce; + my $db = $r->db; + my $authen = $r->authen; + my $authz = $r->authz; my $urlpath = $r->urlpath; # we don't currently have any links to display if the user's not logged in. this may change, though. @@ -675,7 +674,7 @@ sub links { # then get the setID this user is restricted to view from the authen cookie. $setID = $authen->get_session_set_id if (!$setID && $restricted_navigation); - my $prettySetID = format_set_name_display($setID // ''); + my $prettySetID = format_set_name_display($setID // ''); my $prettyAchievementID = $achievementID; $prettyAchievementID =~ s/_/ /g if defined $prettyAchievementID; @@ -696,23 +695,22 @@ sub links { my $makelink = sub { my ($module, %options) = @_; - my $urlpath_args = $options{urlpath_args} || {}; + my $urlpath_args = $options{urlpath_args} || {}; my $systemlink_args = $options{systemlink_args} || {}; - my $text = HTML::Entities::encode_entities($options{text}); - my $active = $options{active}; - my %target = ($options{target} ? (target => $options{target}) : ()); + my $text = HTML::Entities::encode_entities($options{text}); + my $active = $options{active}; + my %target = ($options{target} ? (target => $options{target}) : ()); - my $new_urlpath = $self->r->urlpath->newFromModule($module, $r, %$urlpath_args); + my $new_urlpath = $self->r->urlpath->newFromModule($module, $r, %$urlpath_args); my $new_systemlink = $self->systemLink($new_urlpath, %$systemlink_args); defined $text or $text = $new_urlpath->name(1); - # try to set $active automatically by comparing if (not defined $active) { if ($urlpath->module eq $new_urlpath->module) { - my @args = sort keys %{{$urlpath->args}}; - my @new_args = sort keys %{{$new_urlpath->args}}; + my @args = sort keys %{ { $urlpath->args } }; + my @new_args = sort keys %{ { $new_urlpath->args } }; if (@args == @new_args) { foreach my $i (0 .. $#args) { $active = 0; @@ -733,20 +731,20 @@ sub links { { href => $new_systemlink, class => 'nav-link active', %target, %{ $options{link_attrs} // {} } }, $text); } else { - return CGI::a({ href => $new_systemlink, class => 'nav-link', %target, %{ $options{link_attrs} // {} } }, - $text); + return CGI::a( + { href => $new_systemlink, class => 'nav-link', %target, %{ $options{link_attrs} // {} } }, $text); } }; # to make things more concise - my $pfx = "WeBWorK::ContentGenerator::"; - my %args = ( courseID => $courseID ); + my $pfx = "WeBWorK::ContentGenerator::"; + my %args = (courseID => $courseID); # we'd like to preserve displayMode and showOldAnswers between pages, and we # don't have a general way of preserving non-authen params between requests, # so here is the hack: my %params; - $params{displayMode} = $r->param("displayMode") if defined $r->param("displayMode"); + $params{displayMode} = $r->param("displayMode") if defined $r->param("displayMode"); $params{showOldAnswers} = $r->param("showOldAnswers") if defined $r->param("showOldAnswers"); # in the past, we were checking $self->{displayMode} and $self->{will}->{showOldAnswers} # to set these args, but I don't wanna do that anymore, since it relies on @@ -855,29 +853,39 @@ sub links { unless $restricted_navigation; if ($ce->{achievementsEnabled}) { - print CGI::li({ class => 'nav-item' }, - &$makelink("${pfx}Achievements", urlpath_args => { %args }, systemlink_args => \%systemlink_args)); + print CGI::li( + { class => 'nav-item' }, + &$makelink("${pfx}Achievements", urlpath_args => {%args}, systemlink_args => \%systemlink_args) + ); } if ($authz->hasPermissions($userID, "access_instructor_tools")) { $pfx .= "Instructor::"; - print CGI::start_li({ class => 'nav-item' }); # Instructor Tools - print &$makelink("${pfx}Index", urlpath_args=>{%args}, systemlink_args=>\%systemlink_args); + print CGI::start_li({ class => 'nav-item' }); # Instructor Tools + print &$makelink("${pfx}Index", urlpath_args => {%args}, systemlink_args => \%systemlink_args); print CGI::end_li(); print CGI::start_li({ class => 'nav-item' }); print CGI::start_ul({ class => 'nav flex-column' }); - #class list editor - print CGI::li({ class => 'nav-item' }, &$makelink("${pfx}UserList", urlpath_args=>{%args}, systemlink_args=>\%systemlink_args)); + #class list editor + print CGI::li({ class => 'nav-item' }, + &$makelink("${pfx}UserList", urlpath_args => {%args}, systemlink_args => \%systemlink_args)); # Homework Set Editor - print CGI::li({ class => 'nav-item' }, &$makelink("${pfx}ProblemSetList", urlpath_args=>{%args}, systemlink_args=>\%systemlink_args)); + print CGI::li( + { class => 'nav-item' }, + &$makelink( + "${pfx}ProblemSetList", + urlpath_args => {%args}, + systemlink_args => \%systemlink_args + ) + ); ## only show editor link for non-versioned sets - if (defined $setID && $setID !~ /,v\d+$/ ) { - print CGI::start_li({ class => 'nav-item' }); - print CGI::start_ul({ class => 'nav flex-column' }); + if (defined $setID && $setID !~ /,v\d+$/) { + print CGI::start_li({ class => 'nav-item' }); + print CGI::start_ul({ class => 'nav flex-column' }); print CGI::start_li({ class => 'nav-item' }); print &$makelink( @@ -890,57 +898,68 @@ sub links { print CGI::end_li(); if (defined $problemID) { - print CGI::start_li({ class => 'nav-item' }); - print CGI::start_ul({ class => 'nav flex-column' }); - print CGI::li({ class => 'nav-item' }, - &$makelink("${pfx}PGProblemEditor", - text => $r->maketext('Problem [_1]', $prettyProblemID), - urlpath_args => { %args, setID => $setID, problemID => $problemID }, + print CGI::start_li({ class => 'nav-item' }); + print CGI::start_ul({ class => 'nav flex-column' }); + print CGI::li( + { class => 'nav-item' }, + &$makelink( + "${pfx}PGProblemEditor", + text => $r->maketext('Problem [_1]', $prettyProblemID), + urlpath_args => { %args, setID => $setID, problemID => $problemID }, systemlink_args => \%systemlink_args, - target => "WW_Editor") + target => "WW_Editor" + ) ); - print CGI::end_ul(); - print CGI::end_li(); + print CGI::end_ul(); + print CGI::end_li(); } print CGI::end_ul(); - print CGI::end_li(); + print CGI::end_li(); } - print CGI::li({ class => 'nav-item' }, - &$makelink("${pfx}SetMaker", - text => $r->maketext("Library Browser"), - urlpath_args => { %args }, - systemlink_args => \%systemlink_args)); + print CGI::li( + { class => 'nav-item' }, + &$makelink( + "${pfx}SetMaker", + text => $r->maketext("Library Browser"), + urlpath_args => {%args}, + systemlink_args => \%systemlink_args + ) + ); - print CGI::start_li({ class => 'nav-item' }); # Stats - print &$makelink("${pfx}Stats", urlpath_args=>{%args}, systemlink_args=>\%systemlink_args); + print CGI::start_li({ class => 'nav-item' }); # Stats + print &$makelink("${pfx}Stats", urlpath_args => {%args}, systemlink_args => \%systemlink_args); if ($userID ne $eUserID or defined $setID or defined $urlUserID) { print CGI::start_ul({ class => 'nav flex-column' }); if (defined $urlUserID) { - print CGI::li({ class => 'nav-item' }, - &$makelink("${pfx}Stats", - text => $urlUserID, - urlpath_args => { %args, statType => "student", userID => $urlUserID }, + print CGI::li( + { class => 'nav-item' }, + &$makelink( + "${pfx}Stats", + text => $urlUserID, + urlpath_args => { %args, statType => "student", userID => $urlUserID }, systemlink_args => \%systemlink_args ) ); } if ($userID ne $eUserID && (!defined $urlUserID || $urlUserID ne $eUserID)) { - print CGI::li({ class => 'nav-item' }, - &$makelink("${pfx}Stats", - text => $eUserID, - urlpath_args => { %args, statType => "student", userID => $eUserID }, + print CGI::li( + { class => 'nav-item' }, + &$makelink( + "${pfx}Stats", + text => $eUserID, + urlpath_args => { %args, statType => "student", userID => $eUserID }, systemlink_args => \%systemlink_args, - active => $urlpath->type eq 'instructor_user_statistics' && !defined $urlUserID + active => $urlpath->type eq 'instructor_user_statistics' && !defined $urlUserID ) ); } if (defined $setID) { # make sure we don't try to send a versioned # set id in to the stats link - my ( $nvSetID ) = ( $setID =~ /(.+?)(,v\d+)?$/ ); - my ( $nvPretty ) = ( $prettySetID =~ /(.+?)(,v\d+)?$/ ); + my ($nvSetID) = ($setID =~ /(.+?)(,v\d+)?$/); + my ($nvPretty) = ($prettySetID =~ /(.+?)(,v\d+)?$/); print CGI::li( { class => 'nav-item', dir => 'ltr' }, &$makelink( @@ -953,36 +972,44 @@ sub links { } print CGI::end_ul(); } - print CGI::end_li(); # end Stats + print CGI::end_li(); # end Stats - print CGI::start_li({ class => 'nav-item' }); # Student Progress - print &$makelink("${pfx}StudentProgress", urlpath_args=>{%args}, systemlink_args=>\%systemlink_args); + print CGI::start_li({ class => 'nav-item' }); # Student Progress + print &$makelink( + "${pfx}StudentProgress", + urlpath_args => {%args}, + systemlink_args => \%systemlink_args + ); if ($userID ne $eUserID or defined $setID or defined $urlUserID) { print CGI::start_ul({ class => 'nav flex-column' }); if (defined $urlUserID) { - print CGI::li({ class => 'nav-item' }, - &$makelink("${pfx}StudentProgress", - text => $urlUserID, - urlpath_args => { %args, statType => "student", userID => $urlUserID }, + print CGI::li( + { class => 'nav-item' }, + &$makelink( + "${pfx}StudentProgress", + text => $urlUserID, + urlpath_args => { %args, statType => "student", userID => $urlUserID }, systemlink_args => \%systemlink_args ) ); } if ($userID ne $eUserID && (!defined $urlUserID || $urlUserID ne $eUserID)) { - print CGI::li({ class => 'nav-item' }, - &$makelink("${pfx}StudentProgress", - text => $eUserID, - urlpath_args => { %args, statType => "student", userID => $eUserID }, + print CGI::li( + { class => 'nav-item' }, + &$makelink( + "${pfx}StudentProgress", + text => $eUserID, + urlpath_args => { %args, statType => "student", userID => $eUserID }, systemlink_args => \%systemlink_args, - active => $urlpath->type eq 'instructor_user_progress' && !defined $urlUserID + active => $urlpath->type eq 'instructor_user_progress' && !defined $urlUserID ) ); } if (defined $setID) { # make sure we don't try to send a versioned # set id in to the stats link - my ( $nvSetID ) = ( $setID =~ /(.+?)(,v\d+)?$/ ); - my ( $nvPretty ) = ( $prettySetID =~ /(.+?)(,v\d+)?$/ ); + my ($nvSetID) = ($setID =~ /(.+?)(,v\d+)?$/); + my ($nvPretty) = ($prettySetID =~ /(.+?)(,v\d+)?$/); print CGI::li( { class => 'nav-item', dir => 'ltr' }, &$makelink( @@ -995,72 +1022,101 @@ sub links { } print CGI::end_ul(); } - print CGI::end_li(); # end Student Progress + print CGI::end_li(); # end Student Progress if ($authz->hasPermissions($userID, "score_sets")) { - print CGI::li({ class => 'nav-item' }, - &$makelink("${pfx}Scoring", - urlpath_args => { %args }, - systemlink_args => \%systemlink_args)); + print CGI::li( + { class => 'nav-item' }, + &$makelink( + "${pfx}Scoring", + urlpath_args => {%args}, + systemlink_args => \%systemlink_args + ) + ); } #Show achievement editor for instructors if ($ce->{achievementsEnabled} && $authz->hasPermissions($userID, "edit_achievements")) { - print CGI::li({ class => 'nav-item' }, - &$makelink("${pfx}AchievementList", - urlpath_args => { %args }, - systemlink_args => \%systemlink_args)); - if (defined $achievementID ) { - print CGI::start_li({ class => 'nav-item' }); - print CGI::start_ul({ class => 'nav flex-column' }); - print CGI::start_li({ class => 'nav-item' }); # $achievementID - print &$makelink("${pfx}AchievementEditor", - text => "$prettyAchievementID", - urlpath_args => { %args, achievementID => $achievementID }, - systemlink_args => \%systemlink_args); - print CGI::end_ul(); - print CGI::end_li(); - } + print CGI::li( + { class => 'nav-item' }, + &$makelink( + "${pfx}AchievementList", + urlpath_args => {%args}, + systemlink_args => \%systemlink_args + ) + ); + if (defined $achievementID) { + print CGI::start_li({ class => 'nav-item' }); + print CGI::start_ul({ class => 'nav flex-column' }); + print CGI::start_li({ class => 'nav-item' }); # $achievementID + print &$makelink( + "${pfx}AchievementEditor", + text => "$prettyAchievementID", + urlpath_args => { %args, achievementID => $achievementID }, + systemlink_args => \%systemlink_args + ); + print CGI::end_ul(); + print CGI::end_li(); + } } if ($authz->hasPermissions($userID, "send_mail")) { - print CGI::li({ class => 'nav-item' }, - &$makelink("${pfx}SendMail", - urlpath_args => { %args }, - systemlink_args => \%systemlink_args)); + print CGI::li( + { class => 'nav-item' }, + &$makelink( + "${pfx}SendMail", + urlpath_args => {%args}, + systemlink_args => \%systemlink_args + ) + ); } if ($authz->hasPermissions($userID, "manage_course_files")) { - print CGI::li({ class => 'nav-item' }, - &$makelink("${pfx}FileManager", - urlpath_args => { %args }, - systemlink_args => \%systemlink_args)); + print CGI::li( + { class => 'nav-item' }, + &$makelink( + "${pfx}FileManager", + urlpath_args => {%args}, + systemlink_args => \%systemlink_args + ) + ); } if ($authz->hasPermissions($userID, "manage_course_files")) { - print CGI::li({ class => 'nav-item' }, - &$makelink("${pfx}Config", - urlpath_args => { %args }, - systemlink_args => \%systemlink_args)); + print CGI::li( + { class => 'nav-item' }, + &$makelink( + "${pfx}Config", + urlpath_args => {%args}, + systemlink_args => \%systemlink_args + ) + ); } print CGI::li({ class => 'nav-item' }, $self->helpMacro('instructor_links', { label => $r->maketext('Help'), class => 'nav-link' })); print CGI::li({ class => 'nav-item' }, $self->help({ class => 'nav-link' })); - if ($authz->hasPermissions($userID, "manage_course_files") # show this only on the FileManager page - && $r->urlpath->module eq "WeBWorK::ContentGenerator::Instructor::FileManager") { - my %augmentedSystemLinks = %systemlink_args; - $augmentedSystemLinks{params}->{archiveCourse}=1; - print CGI::li({ class => 'nav-item' }, - &$makelink("${pfx}FileManager", - text => $r->maketext("Archive this Course"), - urlpath_args => { %args }, + if ( + $authz->hasPermissions($userID, "manage_course_files") # show this only on the FileManager page + && $r->urlpath->module eq "WeBWorK::ContentGenerator::Instructor::FileManager" + ) + { + my %augmentedSystemLinks = %systemlink_args; + $augmentedSystemLinks{params}->{archiveCourse} = 1; + print CGI::li( + { class => 'nav-item' }, + &$makelink( + "${pfx}FileManager", + text => $r->maketext("Archive this Course"), + urlpath_args => {%args}, systemlink_args => \%augmentedSystemLinks, - active => 0)); + active => 0 + ) + ); } print CGI::end_ul(); - print CGI::end_li(); # end Instructor Tools - } # /* access_instructor_tools */ + print CGI::end_li(); # end Instructor Tools + } # /* access_instructor_tools */ if (exists $ce->{webworkURLs}{bugReporter} && $ce->{webworkURLs}{bugReporter} ne '' @@ -1075,13 +1131,12 @@ sub links { ); } - } # /* authentication was_verified */ + } # /* authentication was_verified */ - } # /* defined $courseID */ + } # /* defined $courseID */ print CGI::end_ul(); - return ""; } @@ -1095,9 +1150,9 @@ user, a link to stop acting as the effective user, and a link to logout. =cut sub loginstatus { - my ($self) = @_; - my $r = $self->r; - my $authen = $r->authen; + my ($self) = @_; + my $r = $self->r; + my $authen = $r->authen; my $urlpath = $r->urlpath; #This will contain any extra parameters which are needed to make # the page function properly. This will normally be empty. @@ -1105,23 +1160,26 @@ sub loginstatus { if ($authen and $authen->was_verified) { my $courseID = $urlpath->arg("courseID"); - my $userID = $r->param("user"); - my $eUserID = $r->param("effectiveUser"); + my $userID = $r->param("user"); + my $eUserID = $r->param("effectiveUser"); $extraStopActingParams->{effectiveUser} = $userID; - my $stopActingURL = $self->systemLink($urlpath, # current path - params=>$extraStopActingParams); + my $stopActingURL = $self->systemLink( + $urlpath, # current path + params => $extraStopActingParams + ); my $logoutURL = $self->systemLink($urlpath->newFromModule(__PACKAGE__ . "::Logout", $r, courseID => $courseID)); - my $signOutIcon = CGI::i({ class=> "icon fas fa-sign-out-alt", aria_hidden => "true", data_alt => "signout" }, ""); + my $signOutIcon = + CGI::i({ class => "icon fas fa-sign-out-alt", aria_hidden => "true", data_alt => "signout" }, ""); - my $user = $r->db->getUser($userID); + my $user = $r->db->getUser($userID); my $prettyUserName = $user->full_name || $user->user_id; if ($eUserID eq $userID) { print $r->maketext("Logged in as [_1].", HTML::Entities::encode_entities($prettyUserName)) . CGI::a({ href => $logoutURL, class => "btn btn-light btn-sm ms-2" }, - $r->maketext("Log Out") . " " . $signOutIcon); + $r->maketext("Log Out") . " " . $signOutIcon); } else { my $eUser = $r->db->getUser($eUserID); my $prettyEUserName = @@ -1129,11 +1187,11 @@ sub loginstatus { print $r->maketext("Logged in as [_1].", HTML::Entities::encode_entities($prettyUserName)) . CGI::a({ href => $logoutURL, class => "btn btn-light btn-sm ms-2" }, - $r->maketext("Log Out") . " " . $signOutIcon); + $r->maketext("Log Out") . " " . $signOutIcon); print CGI::br(); print $r->maketext("Acting as [_1].", HTML::Entities::encode_entities($prettyEUserName)) . CGI::a({ href => $stopActingURL, class => "btn btn-light btn-sm ms-2" }, - $r->maketext("Stop Acting") . " " . $signOutIcon); + $r->maketext("Stop Acting") . " " . $signOutIcon); } } else { print $r->maketext("Not logged in."); @@ -1265,7 +1323,6 @@ sub footer { return ''; } - =item timestamp() Defined in this package. @@ -1288,9 +1345,10 @@ can be done in the template itself. # } sub timestamp { my ($self, $args) = @_; - # need to use the formatDateTime in this file (some subclasses access Util's version. - return( $self->formatDateTime( time() ) ); + # need to use the formatDateTime in this file (some subclasses access Util's version. + return ($self->formatDateTime(time())); } + =item message() Defined in this package. @@ -1355,7 +1413,7 @@ sub warnings { print CGI::p("Entering ContentGenerator::warnings") if $TRACE_WARNINGS; print "\n\n"; my $warnings = $r->notes->get("warnings"); - $warnings = Encode::decode("UTF-8",$warnings); + $warnings = Encode::decode("UTF-8", $warnings); print $self->warningOutput($warnings) if $warnings; print "\n"; @@ -1558,9 +1616,9 @@ and false otherwise sub if_exists { my ($self, $arg) = @_; - my $r = $self->r; + my $r = $self->r; my $ce = $r->ce; - return -e $ce->{webworkDirs}{themes}.'/'.$ce->{defaultTheme}.'/'.$arg; + return -e $ce->{webworkDirs}{themes} . '/' . $ce->{defaultTheme} . '/' . $arg; } =back @@ -1666,24 +1724,21 @@ sub siblingsMacro { my ($self, @siblings) = @_; my $auth = $self->url_authen_args; - my $sep = CGI::br(); + my $sep = CGI::br(); my @result; while (@siblings) { my $name = shift @siblings; - my $url = shift @siblings; - my $id = $name; + my $url = shift @siblings; + my $id = $name; $id =~ s/\W/\_/g; - push @result, $url - ? CGI::span( {id=>$id}, CGI::a({-href=>"$url?$auth"}, $name) ) - : CGI::span( {id=>$id},$name ); + push @result, + $url ? CGI::span({ id => $id }, CGI::a({ -href => "$url?$auth" }, $name)) : CGI::span({ id => $id }, $name); } return join($sep, @result) . "\n"; } - - =item navMacro($args, $tail, @links) Helper macro for the C<#nav> escape sequence: C<$args> is a hash reference @@ -1701,20 +1756,21 @@ implementing the C<#nav> escape. sub navMacro { my ($self, $args, $tail, @links) = @_; - my $r = $self->r; - my $ce = $r->ce; + my $r = $self->r; + my $ce = $r->ce; my %args = %$args; - my $auth = $self->url_authen_args; - my $prefix = $ce->{webworkURLs}->{htdocs}."/images"; + my $auth = $self->url_authen_args; + my $prefix = $ce->{webworkURLs}->{htdocs} . "/images"; my @result; while (@links) { - my $name = shift @links; - my $url = shift @links; + my $name = shift @links; + my $url = shift @links; my $direction = shift @links; - my $html = ($direction && $args{style} eq "buttons") ? $direction : $name; - push @result, $url + my $html = ($direction && $args{style} eq "buttons") ? $direction : $name; + push @result, + $url ? CGI::a({ href => "$url?$auth$tail", class => "btn btn-primary" }, $html) : CGI::span({ class => "btn btn-primary disabled" }, $html); } @@ -1763,7 +1819,7 @@ This function has been depreciated =cut sub optionsMacro { - return ''; + return ''; } =item feedbackMacro(%params) @@ -1776,19 +1832,19 @@ module and their values. sub feedbackMacro { my ($self, %params) = @_; - my $r = $self->r; - my $authz = $r->authz; + my $r = $self->r; + my $authz = $r->authz; my $userID = $r->param("user"); # don't do anything unless the user has permission to return "" unless $authz->hasPermissions($userID, "submit_feedback"); - my $feedbackURL = $r->ce->{courseURLs}{feedbackURL}; + my $feedbackURL = $r->ce->{courseURLs}{feedbackURL}; my $feedbackFormURL = $r->ce->{courseURLs}{feedbackFormURL}; if (defined $feedbackURL and $feedbackURL ne "") { return $self->feedbackMacro_url($feedbackURL); } elsif (defined $feedbackFormURL and $feedbackFormURL ne "") { - return $self->feedbackMacro_form($feedbackFormURL,%params); + return $self->feedbackMacro_form($feedbackFormURL, %params); } else { return $self->feedbackMacro_email(%params); } @@ -1796,25 +1852,25 @@ sub feedbackMacro { sub feedbackMacro_email { my ($self, %params) = @_; - my $r = $self->r; - my $ce = $r->ce; - my $urlpath = $r->urlpath; + my $r = $self->r; + my $ce = $r->ce; + my $urlpath = $r->urlpath; my $courseID = $urlpath->arg("courseID"); # feedback form url - my $feedbackPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Feedback", $r, courseID => $courseID); - my $feedbackURL = $self->systemLink($feedbackPage, authen => 0); # no authen info for form action + my $feedbackPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Feedback", $r, courseID => $courseID); + my $feedbackURL = $self->systemLink($feedbackPage, authen => 0); # no authen info for form action my $feedbackName = $r->maketext($ce->{feedback_button_name}) || $r->maketext("Email instructor"); - my $result = CGI::start_form(-method=>"POST", -action=>$feedbackURL) . "\n"; + my $result = CGI::start_form(-method => "POST", -action => $feedbackURL) . "\n"; #This is being used on forms with hidden_authen_fields already included # in many pages so we need to change the fields to be hidden my $hiddenFields = $self->hidden_authen_fields; $hiddenFields =~ s/\"hidden_/\"email-hidden_/g; - $result .= $hiddenFields."\n"; + $result .= $hiddenFields . "\n"; while (my ($key, $value) = each %params) { - next if $key eq 'pg_object'; # not used in internal feedback mechanism + next if $key eq 'pg_object'; # not used in internal feedback mechanism $result .= CGI::hidden($key, $value) . "\n"; } $result .= CGI::p(CGI::submit({ name => "feedbackForm", value => $feedbackName, class => 'btn btn-primary' })); @@ -1825,26 +1881,26 @@ sub feedbackMacro_email { sub feedbackMacro_form { my ($self, $feedbackFormURL, %params) = @_; - my $r = $self->r; + my $r = $self->r; my $ce = $r->ce; # feedback form url my $feedbackName = $r->maketext($ce->{feedback_button_name}) || $r->maketext("Email instructor"); - my $result = CGI::start_form(-method=>"POST", -action=>$feedbackFormURL,-target=>"WW_info") . "\n"; + my $result = CGI::start_form(-method => "POST", -action => $feedbackFormURL, -target => "WW_info") . "\n"; $result .= $self->hidden_authen_fields . "\n"; while (my ($key, $value) = each %params) { - if ($key eq 'pg_object') { - my $tmp = $value->{body_text}; - $tmp .= CGI::p(CGI::b("Note: "). CGI::i($value->{result}->{msg})) if $value->{result}->{msg} ; - $result .= CGI::hidden($key, encode_base64(Encode::encode('UTF-8', $tmp), "") ); - } else { + if ($key eq 'pg_object') { + my $tmp = $value->{body_text}; + $tmp .= CGI::p(CGI::b("Note: ") . CGI::i($value->{result}->{msg})) if $value->{result}->{msg}; + $result .= CGI::hidden($key, encode_base64(Encode::encode('UTF-8', $tmp), "")); + } else { $result .= CGI::hidden($key, $value) . "\n"; } } - $result .= CGI::p({-align=>"left"}, + $result .= CGI::p({ -align => "left" }, CGI::submit({ name => "feedbackForm", value => $feedbackName, class => 'btn btn-primary' })); $result .= CGI::end_form() . "\n"; @@ -1853,9 +1909,9 @@ sub feedbackMacro_form { sub feedbackMacro_url { my ($self, $url) = @_; - my $r = $self->r; + my $r = $self->r; my $feedbackName = $r->maketext($r->ce->{feedback_button_name}) || $r->maketext("Email instructor"); - return CGI::a({-href=>$url}, $feedbackName); + return CGI::a({ -href => $url }, $feedbackName); } =back @@ -1918,7 +1974,7 @@ proctor authentication. sub hidden_proctor_authen_fields { my $self = shift; - if ( $self->r->param('proctor_user') ) { + if ($self->r->param('proctor_user')) { return $self->hidden_fields("proctor_user", "proctor_key"); } else { return ''; @@ -1981,7 +2037,7 @@ sub url_authen_args { # When cookie based session management is in use, there should be no need # to reveal the user and key in the URL. Putting it there makes session # hijacking easier, in particular should a student share such a URL. - if ( $ce->{session_management_via} eq "session_cookie" ) { + if ($ce->{session_management_via} eq "session_cookie") { return $self->url_args("effectiveUser", "theme"); } else { return $self->url_args("user", "effectiveUser", "key", "theme"); @@ -2125,12 +2181,12 @@ sub systemLink { # to reveal the user and key in the URL. Putting it there makes session # hijacking easier, in particular should a student share such a URL. - if ( $r->ce->{session_management_via} eq "session_cookie" ) { - undef( $params{user} ) if exists $params{user}; - undef( $params{key} ) if exists $params{key}; + if ($r->ce->{session_management_via} eq "session_cookie") { + undef($params{user}) if exists $params{user}; + undef($params{key}) if exists $params{key}; } else { - $params{user} = undef unless exists $params{user}; - $params{key} = undef unless exists $params{key}; + $params{user} = undef unless exists $params{user}; + $params{key} = undef unless exists $params{key}; } $params{effectiveUser} = undef unless exists $params{effectiveUser}; @@ -2157,13 +2213,14 @@ sub systemLink { @values = $r->param($name); } #FIXME -- evntually we'd like to catch where this happens - if ($name eq 'user' and @values >1 ) { - warn "internal error -- user has been multiply defined! You may need to logout and log back in to correct this."; + if ($name eq 'user' and @values > 1) { + warn + "internal error -- user has been multiply defined! You may need to logout and log back in to correct this."; my $user = $r->param("user"); $r->param(user => $user); - @values = ($user); - warn "requesting page is ", $r->headers_in->{'Referer'}; - warn "Parameters are ", join("|",$r->param()); + @values = ($user); + warn "requesting page is ", $r->headers_in->{'Referer'}; + warn "Parameters are ", join("|", $r->param()); } @@ -2174,7 +2231,7 @@ sub systemLink { } else { $url .= "&"; } - $url .= join "&", map { "$name=".HTML::Entities::encode_entities($_) } @values; + $url .= join "&", map { "$name=" . HTML::Entities::encode_entities($_) } @values; } } @@ -2190,7 +2247,7 @@ Otherwise $string is returned. sub nbsp { my ($self, $str) = @_; - return (defined $str && $str =~/\S/) ? $str : " "; + return (defined $str && $str =~ /\S/) ? $str : " "; } =item errorOutput($error, $details) @@ -2204,12 +2261,12 @@ sub errorOutput($$$) { my ($self, $error, $details) = @_; my $r = $self->{r}; print "Entering ContentGenerator::errorOutput subroutine
      " if $TRACE_WARNINGS; - my $time = time2str("%a %b %d %H:%M:%S %Y", time); - my $method = $r->method; - my $uri = $r->uri; + my $time = time2str("%a %b %d %H:%M:%S %Y", time); + my $method = $r->method; + my $uri = $r->uri; my $headers = do { - my %headers = %{$r->headers_in}; - join("", map { CGI::Tr({},CGI::td(CGI::small($_)), CGI::td(CGI::small($headers{$_}))) } keys %headers); + my %headers = %{ $r->headers_in }; + join("", map { CGI::Tr({}, CGI::td(CGI::small($_)), CGI::td(CGI::small($headers{$_}))) } keys %headers); }; # if it is a long report pass details by reference rather than by value @@ -2218,41 +2275,38 @@ sub errorOutput($$$) { if (ref($details) =~ /SCALAR/i) { $details = [$$details]; - } elsif (ref($details) =~/ARRAY/i) { + } elsif (ref($details) =~ /ARRAY/i) { # no change needed } else { - $details = [$details]; + $details = [$details]; } return CGI::h2($r->maketext("WeBWorK Error")), CGI::p($r->maketext( 'WeBWorK has encountered a software error while attempting to process this problem. It is likely that ' - . 'there is an error in the problem itself. If you are a student, report this error message to your ' - . 'professor to have it corrected. If you are a professor, please consult the error output below for ' - . 'more information.' + . 'there is an error in the problem itself. If you are a student, report this error message to your ' + . 'professor to have it corrected. If you are a professor, please consult the error output below for ' + . 'more information.' )), CGI::h3($r->maketext("Error messages")), - CGI::p(CGI::code($error)), - CGI::h3("Error details"), + CGI::p(CGI::code($error)), CGI::h3("Error details"), - CGI::start_code(), CGI::start_p(), - @{ $details }, + CGI::start_code(), CGI::start_p(), @{$details}, #CGI::code(CGI::p(@expandedDetails)), # not using inclusive CGI calls here saves about 30Meg of memory! - CGI::end_p(),CGI::end_code(), + CGI::end_p(), CGI::end_code(), CGI::h3($r->maketext("Request information")), - CGI::table({border=>"1"}, - CGI::Tr({},CGI::td($r->maketext("Time")), CGI::td($time)), - CGI::Tr({},CGI::td($r->maketext("Method")), CGI::td($method)), - CGI::Tr({},CGI::td($r->maketext("URI")), CGI::td($uri)), - CGI::Tr({},CGI::td($r->maketext("HTTP Headers")), CGI::td( - CGI::table($headers), - )), + CGI::table( + { border => "1" }, + CGI::Tr({}, CGI::td($r->maketext("Time")), CGI::td($time)), + CGI::Tr({}, CGI::td($r->maketext("Method")), CGI::td($method)), + CGI::Tr({}, CGI::td($r->maketext("URI")), CGI::td($uri)), + CGI::Tr({}, CGI::td($r->maketext("HTTP Headers")), CGI::td(CGI::table($headers),)), ), - ; + ; } @@ -2263,15 +2317,16 @@ Used to print out a generic warning message at the top of the page =cut sub warningMessage { - my $self = shift; - my $r = $self->r; + my $self = shift; + my $r = $self->r; - return CGI::b($r->maketext("Warning")), ' -- ', - $r->maketext("There may be something wrong with this question. Please inform your instructor including the warning messages below."); + return CGI::b($r->maketext("Warning")), ' -- ', + $r->maketext( + "There may be something wrong with this question. Please inform your instructor including the warning messages below." + ); } - =item warningOutput($warnings) Used by warnings() in this class to report warnings caught during dispatching @@ -2286,28 +2341,28 @@ sub warningOutput($$) { my @warnings = split m/\n+/, $warnings; my $scrubber = HTML::Scrubber->new( - default => 1, - script => 0, - comment => 0 - ); + default => 1, + script => 0, + comment => 0 + ); $scrubber->default( - undef, - { - '*' => 1, - } - ); + undef, + { + '*' => 1, + } + ); foreach my $warning (@warnings) { - # Since these warnings have html they look better scrubbed - #$warning = HTML::Entities::encode_entities($warning); - $warning = $scrubber->scrub($warning); - $warning = CGI::li(CGI::code($warning)); + # Since these warnings have html they look better scrubbed + #$warning = HTML::Entities::encode_entities($warning); + $warning = $scrubber->scrub($warning); + $warning = CGI::li(CGI::code($warning)); } $warnings = join("", @warnings); - my $time = time2str("%a %b %d %H:%M:%S %Y", time); + my $time = time2str("%a %b %d %H:%M:%S %Y", time); my $method = $r->method; - my $uri = $r->uri; + my $uri = $r->uri; #my $headers = do { # my %headers = $r->headers_in; # join("", map { CGI::Tr(CGI::td(CGI::small($_)), CGI::td(CGI::small($headers{$_}))) } keys %headers); @@ -2315,14 +2370,17 @@ sub warningOutput($$) { return CGI::h2($r->maketext("WeBWorK Warnings")), - CGI::p($r->maketext('WeBWorK has encountered warnings while processing your request. If this occured when viewing a problem, it was likely caused by an error or ambiguity in that problem. Otherwise, it may indicate a problem with the WeBWorK system itself. If you are a student, report these warnings to your professor to have them corrected. If you are a professor, please consult the warning output below for more information.')), + CGI::p( + $r->maketext( + 'WeBWorK has encountered warnings while processing your request. If this occured when viewing a problem, it was likely caused by an error or ambiguity in that problem. Otherwise, it may indicate a problem with the WeBWorK system itself. If you are a student, report these warnings to your professor to have them corrected. If you are a professor, please consult the warning output below for more information.' + ) + ), CGI::h3($r->maketext("Warning messages")), - CGI::ul($warnings), - CGI::h3($r->maketext("Request information")), - CGI::table({border=>"1"}, - CGI::Tr({},CGI::td($r->maketext("Time")), CGI::td($time)), - CGI::Tr({},CGI::td($r->maketext("Method")), CGI::td($method)), - CGI::Tr({},CGI::td($r->maketext("URI")), CGI::td($uri)), + CGI::ul($warnings), CGI::h3($r->maketext("Request information")), CGI::table( + { border => "1" }, + CGI::Tr({}, CGI::td($r->maketext("Time")), CGI::td($time)), + CGI::Tr({}, CGI::td($r->maketext("Method")), CGI::td($method)), + CGI::Tr({}, CGI::td($r->maketext("URI")), CGI::td($uri)), #CGI::Tr(CGI::td("HTTP Headers"), CGI::td( # CGI::table($headers), #)), @@ -2343,7 +2401,7 @@ sub parseDateTime { my $ce = $self->r->ce; $display_tz ||= $ce->{siteDefaults}{timezone}; return WeBWorK::Utils::parseDateTime($string, $display_tz); -}; +} =item $string = formatDateTime($dateTime, $display_tz) @@ -2356,11 +2414,11 @@ $siteDefaults{timezone} is used. =cut sub formatDateTime { - my ($self, $dateTime, $display_tz,$formatString,$locale) = @_; + my ($self, $dateTime, $display_tz, $formatString, $locale) = @_; my $ce = $self->r->ce; $display_tz ||= $ce->{siteDefaults}{timezone}; - $locale ||= $ce->{siteDefaults}{locale}; - return WeBWorK::Utils::formatDateTime($dateTime, $display_tz,$formatString,$locale); + $locale ||= $ce->{siteDefaults}{locale}; + return WeBWorK::Utils::formatDateTime($dateTime, $display_tz, $formatString, $locale); } =item read_scoring_file($fileName) @@ -2372,8 +2430,8 @@ prepends the path to the scoring directory. sub read_scoring_file { my ($self, $fileName) = @_; - return {} if $fileName eq "None"; # callers expect a hashref in all cases - return parse_scoring_file($self->r->ce->{courseDirs}{scoring}."/$fileName"); + return {} if $fileName eq "None"; # callers expect a hashref in all cases + return parse_scoring_file($self->r->ce->{courseDirs}{scoring} . "/$fileName"); } =item createEmailSenderTransportSMTP diff --git a/lib/WeBWorK/ContentGenerator/Achievements.pm b/lib/WeBWorK/ContentGenerator/Achievements.pm index ef18680cb0..f12bb58f2e 100644 --- a/lib/WeBWorK/ContentGenerator/Achievements.pm +++ b/lib/WeBWorK/ContentGenerator/Achievements.pm @@ -33,14 +33,14 @@ use WeBWorK::Utils qw(sortAchievements thaw_base64 getAssetURL); sub head { my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; + my $r = $self->r; + my $ce = $r->ce; return ""; } sub output_achievement_CSS { - return ""; + return ""; } sub initialize { @@ -78,19 +78,18 @@ sub initialize { } sub body { - my ($self) = @_; - my $r = $self->r; - my $db = $r->db; - my $ce = $r->ce; + my ($self) = @_; + my $r = $self->r; + my $db = $r->db; + my $ce = $r->ce; my $globalUserAchievements = $self->{globalData}; - my $userID = $self->{studentName}; - my $achievementURL = $ce->{courseURLs}->{achievements}; - + my $userID = $self->{studentName}; + my $achievementURL = $ce->{courseURLs}->{achievements}; #If they dont have a globalUserAchievements record then they dont have achievements if (not defined($globalUserAchievements)) { - print CGI::p($r->maketext("You don't have any Achievement data associated to you!")); - return ""; + print CGI::p($r->maketext("You don't have any Achievement data associated to you!")); + return ""; } print CGI::br(); @@ -100,7 +99,7 @@ sub body { my $achievement; if ($globalUserAchievements->level_achievement_id) { - $achievement = $db->getAchievement($globalUserAchievements->level_achievement_id); + $achievement = $db->getAchievement($globalUserAchievements->level_achievement_id); } if ($achievement) { @@ -126,9 +125,9 @@ sub body { my $prev_level = ($globalData->{prev_level_points}) ? $globalData->{prev_level_points} : 0; my $level_goal = $globalUserAchievements->next_level_points - $prev_level; my $level_prog = $globalUserAchievements->achievement_points - $prev_level; - $level_prog = $level_prog >= 0 ? $level_prog : 0; + $level_prog = $level_prog >= 0 ? $level_prog : 0; $level_prog = $level_prog <= $level_goal ? $level_prog : $level_goal; - my $levelpercentage = int(100*$level_prog/$level_goal); + my $levelpercentage = int(100 * $level_prog / $level_goal); print CGI::start_div({ class => 'levelouterbar', @@ -148,19 +147,19 @@ sub body { #print any items they have if they have items if ($ce->{achievementItemsEnabled} && $self->{achievementItems}) { - my @itemsWithCounts = @{$self->{achievementItems}}; + my @itemsWithCounts = @{ $self->{achievementItems} }; # remove count data so @items is structured as originally designed - my @items = (); + my @items = (); my %itemCounts = (); for my $item (@itemsWithCounts) { - push (@items, $item->[0]); - $itemCounts{$item->[0]->id()} = $item->[1]; - }; + push(@items, $item->[0]); + $itemCounts{ $item->[0]->id() } = $item->[1]; + } my $urlpath = $r->urlpath; - my @setIDs = $db->listUserSets($userID); + my @setIDs = $db->listUserSets($userID); my @setProblemCount; - my @userSetIDs = map {[$userID, $_]} @setIDs; + my @userSetIDs = map { [ $userID, $_ ] } @setIDs; my @unfilteredsets = $db->getMergedSets(@userSetIDs); my @sets; @@ -173,8 +172,8 @@ sub body { } # Generate array of problem counts - for (my $i=0; $i<=$#sets; $i++) { - $setProblemCount[$i] = WeBWorK::Utils::max($db->listUserProblems($userID,$sets[$i]->set_id)); + for (my $i = 0; $i <= $#sets; $i++) { + $setProblemCount[$i] = WeBWorK::Utils::max($db->listUserProblems($userID, $sets[$i]->set_id)); } print CGI::h2($r->maketext('Rewards')); @@ -184,25 +183,30 @@ sub body { foreach my $item (@items) { # Print each item's name, count, and description print CGI::start_div({ class => 'achievement-item' }); - if ($itemCounts{$item->id()} > 1) { - print CGI::h3($r->maketext($item->name()) - . ' (' . $r->maketext('[_1] remaining', $itemCounts{$item->id()}) . ')') - } elsif ($itemCounts{$item->id()} < 0) { - print CGI::h3($r->maketext($item->name()) . ' (' . $r->maketext('unlimited reusability') . ')') + if ($itemCounts{ $item->id() } > 1) { + print CGI::h3($r->maketext($item->name()) . ' (' + . $r->maketext('[_1] remaining', $itemCounts{ $item->id() }) + . ')'); + } elsif ($itemCounts{ $item->id() } < 0) { + print CGI::h3($r->maketext($item->name()) . ' (' . $r->maketext('unlimited reusability') . ')'); + } else { + print CGI::h3($r->maketext($item->name())); } - else {print CGI::h3($r->maketext($item->name()))}; print CGI::p($r->maketext($item->description())); # Print a modal popup for each item which contains the form necessary to get the data to use the item. # Print the form in the modal body. - print CGI::a({ + print CGI::a( + { href => '#modal_' . $item->id(), role => 'button', data_bs_toggle => 'modal', class => 'btn btn-secondary', id => 'popup_' . $item->id() - }, $r->maketext('Use Reward')); - print CGI::start_div({ id => 'modal_' . $item->id(), class => 'modal hide fade', tabindex => '-1' }); + }, + $r->maketext('Use Reward') + ); + print CGI::start_div({ id => 'modal_' . $item->id(), class => 'modal hide fade', tabindex => '-1' }); print CGI::start_div({ class => 'modal-dialog modal-dialog-centered' }); print CGI::start_div({ class => 'modal-content' }); print CGI::start_div({ class => 'modal-header' }); @@ -211,11 +215,11 @@ sub body { aria-label="@{[$r->maketext('close')]}">}; print CGI::end_div(); print CGI::start_form({ - method => 'post', - action => $self->systemLink($urlpath, authen => 0), - name => "itemform_$itemnumber", - class => 'achievementitemform' - }); + method => 'post', + action => $self->systemLink($urlpath, authen => 0), + name => "itemform_$itemnumber", + class => 'achievementitemform' + }); print CGI::start_div({ class => 'modal-body' }); # Note: we provide the item with some information about the current sets to help set up the form fields. print $item->print_form(\@sets, \@setProblemCount, $r); @@ -242,15 +246,15 @@ sub body { #Get all the achievements my @allAchievementIDs = $db->listAchievements; - if ( @allAchievementIDs ) { # bail if there are no achievements + if (@allAchievementIDs) { # bail if there are no achievements my @achievements = $db->getAchievements(@allAchievementIDs); @achievements = sortAchievements(@achievements); my $previousCategory = $achievements[0]->category; - my $previousNumber = $achievements[0]->number; - my $chainName = $achievements[0]->achievement_id =~ s/^([^_]*_).*$/$1/r; - my $chainCount = 0; - my $chainStart = 0; + my $previousNumber = $achievements[0]->number; + my $chainName = $achievements[0]->achievement_id =~ s/^([^_]*_).*$/$1/r; + my $chainCount = 0; + my $chainStart = 0; print CGI::h2($r->maketext('Badges')); @@ -258,30 +262,30 @@ sub body { foreach my $achievement (@achievements) { #skip the level achievements and only show achievements assigned to user last if ($achievement->category eq 'level'); - next unless ($db->existsUserAchievement($userID,$achievement->achievement_id)); + next unless ($db->existsUserAchievement($userID, $achievement->achievement_id)); next unless $achievement->enabled; #separate categories with whitespace if ($previousCategory ne $achievement->category) { - print CGI::br(); + print CGI::br(); } #setup up chain achievements my $isChain = 1; - if (! $achievement->max_counter || - $achievement->max_counter == 0 || - $previousCategory ne $achievement->category || - $previousNumber + 1 != $achievement->number || - $achievement->achievement_id !~ /^$chainName/ ) + if (!$achievement->max_counter + || $achievement->max_counter == 0 + || $previousCategory ne $achievement->category + || $previousNumber + 1 != $achievement->number + || $achievement->achievement_id !~ /^$chainName/) { - $isChain = 0; + $isChain = 0; $chainCount = 0; - $chainName = $achievement->achievement_id =~ s/^([^_]*_).*$/$1/r; + $chainName = $achievement->achievement_id =~ s/^([^_]*_).*$/$1/r; } - $previousNumber = $achievement->number; + $previousNumber = $achievement->number; $previousCategory = $achievement->category; - my $userAchievement = $db->getUserAchievement($userID,$achievement->achievement_id); + my $userAchievement = $db->getUserAchievement($userID, $achievement->achievement_id); #dont show unearned secret achievements next if ($achievement->category eq 'secret' and not $userAchievement->earned); @@ -294,46 +298,48 @@ sub body { next if ($isChain && ($chainCount > 1 || ($chainCount == '1' && $chainStart == '0'))); #print achievement and associated progress bar (if there is one) - print CGI::start_div( - { - class => 'cheevoouterbox d-flex justify-content-start align-items-center mb-3 ' - . ($userAchievement->earned ? 'unlocked' : 'locked') - } - ); + print CGI::start_div({ + class => 'cheevoouterbox d-flex justify-content-start align-items-center mb-3 ' + . ($userAchievement->earned ? 'unlocked' : 'locked') + }); my $imgSrc; if ($achievement->{icon}) { - $imgSrc = $ce->{courseURLs}->{achievements}."/".$achievement->{icon}; + $imgSrc = $ce->{courseURLs}->{achievements} . "/" . $achievement->{icon}; } else { - $imgSrc = $ce->{webworkURLs}->{htdocs}."/images/defaulticon.png"; + $imgSrc = $ce->{webworkURLs}->{htdocs} . "/images/defaulticon.png"; } - print CGI::div(CGI::img({src=>$imgSrc, alt=>$userAchievement->earned ? 'Achievement Earned' : 'Achievement Unearned'})); + print CGI::div(CGI::img({ + src => $imgSrc, + alt => $userAchievement->earned ? 'Achievement Earned' : 'Achievement Unearned' + })); print CGI::start_div({ class => 'ms-3' }); print CGI::h3({ class => 'fs-5 mb-1 fw-bold' }, $achievement->name); - print CGI::div(CGI::i($r->maketext("[_1] Points:", $achievement->{points})).' '.$achievement->{description}); + print CGI::div( + CGI::i($r->maketext("[_1] Points:", $achievement->{points})) . ' ' . $achievement->{description}); if ($achievement->max_counter and not $userAchievement->earned) { - my $userCounter = $userAchievement->counter; - $userCounter = 0 unless ($userAchievement->counter); - my $percentage = int(100*$userCounter/$achievement->max_counter); - $percentage = $percentage <= 100 ? $percentage : 100; - print CGI::start_div({ - class => 'cheevoouterbar mt-1', - title => $r->maketext("[_1]% Complete", $percentage), - aria_label => $r->maketext("[_1]% Complete", $percentage), - role => 'figure' - }); - print CGI::div({ class => 'cheevoinnerbar', style => sprintf("width:%i%%;", $percentage) }, ''); - print CGI::end_div(); + my $userCounter = $userAchievement->counter; + $userCounter = 0 unless ($userAchievement->counter); + my $percentage = int(100 * $userCounter / $achievement->max_counter); + $percentage = $percentage <= 100 ? $percentage : 100; + print CGI::start_div({ + class => 'cheevoouterbar mt-1', + title => $r->maketext("[_1]% Complete", $percentage), + aria_label => $r->maketext("[_1]% Complete", $percentage), + role => 'figure' + }); + print CGI::div({ class => 'cheevoinnerbar', style => sprintf("width:%i%%;", $percentage) }, ''); + print CGI::end_div(); } print CGI::end_div(); print CGI::end_div(); - } - } else { # no achievements - print CGI::p($r->maketext('No achievement badges have been assigned yet.')); } + } else { # no achievements + print CGI::p($r->maketext('No achievement badges have been assigned yet.')); + } return ""; @@ -341,7 +347,7 @@ sub body { sub output_JS { my $self = shift; - my $ce = $self->r->ce; + my $ce = $self->r->ce; print CGI::script({ src => getAssetURL($ce, 'js/apps/AchievementItems/achievementitems.js'), defer => undef }, ''); diff --git a/lib/WeBWorK/ContentGenerator/CourseAdmin.pm b/lib/WeBWorK/ContentGenerator/CourseAdmin.pm index ecf72e043d..50c01fc0fa 100644 --- a/lib/WeBWorK/ContentGenerator/CourseAdmin.pm +++ b/lib/WeBWorK/ContentGenerator/CourseAdmin.pm @@ -34,7 +34,7 @@ use URI::Escape; use WeBWorK::Debug; use WeBWorK::Utils qw(cryptPassword writeLog listFilesRecursive trim_spaces getAssetURL); use WeBWorK::Utils::CourseManagement qw(addCourse renameCourse retitleCourse deleteCourse listCourses archiveCourse - listArchivedCourses unarchiveCourse initNonNativeTables); + listArchivedCourses unarchiveCourse initNonNativeTables); use WeBWorK::Utils::CourseIntegrityCheck; use WeBWorK::DB; #use WeBWorK::Utils::DBImportExport qw(dbExport dbImport); @@ -45,13 +45,13 @@ use File::stat; use Time::localtime; sub pre_header_initialize { - my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; - my $db = $r->db; - my $authz = $r->authz; + my ($self) = @_; + my $r = $self->r; + my $ce = $r->ce; + my $db = $r->db; + my $authz = $r->authz; my $urlpath = $r->urlpath; - my $user = $r->param('user'); + my $user = $r->param('user'); # check permissions unless ($authz->hasPermissions($user, "create_and_delete_courses")) { @@ -63,14 +63,12 @@ sub pre_header_initialize { my $status_message = $r->param("status_message"); $self->addmessage(CGI::p("$status_message")) if $status_message; + # Check that the non-native tables are present in the database + # These are the tables which are not course specific - # Check that the non-native tables are present in the database - # These are the tables which are not course specific - - my $table_update_result = initNonNativeTables($ce, $ce->{dbLayoutName}); - - $self->addgoodmessage(CGI::p("$table_update_result")) if $table_update_result; + my $table_update_result = initNonNativeTables($ce, $ce->{dbLayoutName}); + $self->addgoodmessage(CGI::p("$table_update_result")) if $table_update_result; my @errors; my $method_to_call; @@ -89,9 +87,8 @@ sub pre_header_initialize { } else { $method_to_call = "add_course_form"; } - } - elsif ($subDisplay eq "rename_course") { + } elsif ($subDisplay eq "rename_course") { if (defined $r->param("rename_course")) { @errors = $self->rename_course_validate; if (@errors) { @@ -108,11 +105,11 @@ sub pre_header_initialize { $method_to_call = "do_rename_course"; } } elsif (defined $r->param("confirm_retitle_course")) { - $method_to_call = "do_retitle_course"; + $method_to_call = "do_retitle_course"; - } elsif (defined $r->param("upgrade_course_tables") ){ - # upgrade and revalidate - @errors = $self->rename_course_validate; + } elsif (defined $r->param("upgrade_course_tables")) { + # upgrade and revalidate + @errors = $self->rename_course_validate; if (@errors) { $method_to_call = "rename_course_form"; } else { @@ -122,9 +119,8 @@ sub pre_header_initialize { } else { $method_to_call = "rename_course_form"; } - } - elsif ($subDisplay eq "delete_course") { + } elsif ($subDisplay eq "delete_course") { if (defined $r->param("delete_course")) { # validate or confirm @errors = $self->delete_course_validate; @@ -141,16 +137,14 @@ sub pre_header_initialize { } else { $method_to_call = "do_delete_course"; } - } - elsif (defined ($r->param("delete_course_refresh"))) { + } elsif (defined($r->param("delete_course_refresh"))) { $method_to_call = "delete_course_form"; } else { # form only $method_to_call = "delete_course_form"; } - } - elsif ($subDisplay eq "export_database") { + } elsif ($subDisplay eq "export_database") { if (defined $r->param("export_database")) { @errors = $self->export_database_validate; if (@errors) { @@ -165,9 +159,8 @@ sub pre_header_initialize { } else { $method_to_call = "export_database_form"; } - } - elsif ($subDisplay eq "import_database") { + } elsif ($subDisplay eq "import_database") { if (defined $r->param("import_database")) { @errors = $self->import_database_validate; if (@errors) { @@ -178,54 +171,52 @@ sub pre_header_initialize { } else { $method_to_call = "import_database_form"; } - } - elsif ($subDisplay eq "archive_course") { - if (defined $r->param("archive_course") || - defined $r->param("skip_archive_course")) { - - # validate -- if invalid, start over. - # if form is valid a page indicating the status of - # database tables and directories is presented. - # If they are ok, then you can push archive button, otherwise - # you can quit or choose to upgrade the tables - @errors = $self->archive_course_validate; - if (@errors) { - $method_to_call = "archive_course_form"; - } else { - $method_to_call = "archive_course_confirm"; #check tables & directories - } - } elsif (defined $r->param("confirm_archive_course")) { - # validate and archive - # the "archive it" button has been pushed and the - # course will be archived - # a report on success or failure will be generated - @errors = $self->archive_course_validate; - if (@errors) { - $method_to_call = "archive_course_form"; - } else { - $method_to_call = "do_archive_course"; - } - } elsif (defined $r->param("upgrade_course_tables") ){ - # upgrade and revalidate - # the "upgrade course" button has been pushed - # after the course has been upgraded you are returned - # to the confirm page. - @errors = $self->archive_course_validate; - if (@errors) { - $method_to_call = "archive_course_form"; - } else { - $method_to_call = "archive_course_confirm"; # upgrade and recheck tables & directories. - } - } - elsif (defined ($r->param("archive_course_refresh"))) { - $method_to_call = "archive_course_form"; - } else { - # form only - $method_to_call = "archive_course_form"; - } - } - elsif ($subDisplay eq "unarchive_course") { + } elsif ($subDisplay eq "archive_course") { + if (defined $r->param("archive_course") + || defined $r->param("skip_archive_course")) + { + + # validate -- if invalid, start over. + # if form is valid a page indicating the status of + # database tables and directories is presented. + # If they are ok, then you can push archive button, otherwise + # you can quit or choose to upgrade the tables + @errors = $self->archive_course_validate; + if (@errors) { + $method_to_call = "archive_course_form"; + } else { + $method_to_call = "archive_course_confirm"; #check tables & directories + } + } elsif (defined $r->param("confirm_archive_course")) { + # validate and archive + # the "archive it" button has been pushed and the + # course will be archived + # a report on success or failure will be generated + @errors = $self->archive_course_validate; + if (@errors) { + $method_to_call = "archive_course_form"; + } else { + $method_to_call = "do_archive_course"; + } + } elsif (defined $r->param("upgrade_course_tables")) { + # upgrade and revalidate + # the "upgrade course" button has been pushed + # after the course has been upgraded you are returned + # to the confirm page. + @errors = $self->archive_course_validate; + if (@errors) { + $method_to_call = "archive_course_form"; + } else { + $method_to_call = "archive_course_confirm"; # upgrade and recheck tables & directories. + } + } elsif (defined($r->param("archive_course_refresh"))) { + $method_to_call = "archive_course_form"; + } else { + # form only + $method_to_call = "archive_course_form"; + } + } elsif ($subDisplay eq "unarchive_course") { if (defined $r->param("unarchive_course")) { # validate or confirm @errors = $self->unarchive_course_validate; @@ -247,8 +238,7 @@ sub pre_header_initialize { # start at the beginning -- get drop down list of courses to unarchive $method_to_call = "unarchive_course_form"; } - } - elsif ($subDisplay eq "upgrade_course") { + } elsif ($subDisplay eq "upgrade_course") { if (defined $r->param("upgrade_course")) { # validate or confirm # if form is valid present details of analysis of the course structure @@ -272,64 +262,54 @@ sub pre_header_initialize { # start at the beginning -- get list of courses and their status $method_to_call = "upgrade_course_form"; } - } - elsif ($subDisplay eq "manage_locations") { - if (defined ($r->param("manage_location_action"))) { - $method_to_call = - $r->param("manage_location_action"); - } - else{ + } elsif ($subDisplay eq "manage_locations") { + if (defined($r->param("manage_location_action"))) { + $method_to_call = $r->param("manage_location_action"); + } else { $method_to_call = "manage_location_form"; } - } - elsif ($subDisplay eq "hide_inactive_course") { -# warn "subDisplay is $subDisplay"; - if (defined ($r->param("hide_course"))) { + } elsif ($subDisplay eq "hide_inactive_course") { + # warn "subDisplay is $subDisplay"; + if (defined($r->param("hide_course"))) { @errors = $self->hide_course_validate; if (@errors) { $method_to_call = "hide_inactive_course_form"; } else { - $method_to_call = "do_hide_inactive_course"; - } - } - elsif (defined ($r->param("unhide_course"))) { + $method_to_call = "do_hide_inactive_course"; + } + } elsif (defined($r->param("unhide_course"))) { @errors = $self->unhide_course_validate; if (@errors) { $method_to_call = "hide_inactive_course_form"; } else { - $method_to_call = "do_unhide_inactive_course"; - } - } - elsif (defined ($r->param("hide_course_refresh"))) { + $method_to_call = "do_unhide_inactive_course"; + } + } elsif (defined($r->param("hide_course_refresh"))) { $method_to_call = "hide_inactive_course_form"; - } - else{ + } else { $method_to_call = "hide_inactive_course_form"; } - } - elsif ($subDisplay eq "registration") { - if (defined ($r->param("register_site"))) { - $method_to_call = "do_registration"; - } - else{ + } elsif ($subDisplay eq "registration") { + if (defined($r->param("register_site"))) { + $method_to_call = "do_registration"; + } else { $method_to_call = "registration_form"; } - } - else { + } else { @errors = "Unrecognized sub-display @{[ CGI::b($subDisplay) ]}."; } } - $self->{errors} = \@errors; + $self->{errors} = \@errors; $self->{method_to_call} = $method_to_call; } sub body { - my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; - my $db = $r->db; - my $authz = $r->authz; + my ($self) = @_; + my $r = $self->r; + my $ce = $r->ce; + my $db = $r->db; + my $authz = $r->authz; my $urlpath = $r->urlpath; my $user = $r->param('user'); @@ -339,16 +319,17 @@ sub body { return ""; } my $method_to_call = $self->{method_to_call}; - my $methodMessage =""; + my $methodMessage = ""; (defined($method_to_call) and $method_to_call eq "do_export_database") && do { - my @export_courseID = $r->param("export_courseID"); - my $course_ids = join(", ", @export_courseID); - $methodMessage = CGI::p("Exporting database for course(s) $course_ids"). - CGI::p(".... please wait.... + my @export_courseID = $r->param("export_courseID"); + my $course_ids = join(", ", @export_courseID); + $methodMessage = CGI::p("Exporting database for course(s) $course_ids") . CGI::p( + ".... please wait.... If your browser times out you will still be able to download the exported database using the - file manager.").CGI::hr(); + file manager." + ) . CGI::hr(); }; print CGI::ul( @@ -358,7 +339,8 @@ sub body { { class => 'nav-item' }, CGI::a( { - href => $self->systemLink($urlpath, params => { subDisplay => $_->[0], %{ $_->[2] // {} } }), + href => + $self->systemLink($urlpath, params => { subDisplay => $_->[0], %{ $_->[2] // {} } }), class => 'nav-link' . (($r->param('subDisplay') // '') eq $_->[0] ? ' active' : '') }, $_->[1] @@ -390,8 +372,7 @@ sub body { print $self->display_registration_form; - my @errors = @{$self->{errors}}; - + my @errors = @{ $self->{errors} }; if (@errors) { print CGI::div( @@ -404,14 +385,22 @@ sub body { if (defined $method_to_call and $method_to_call ne "") { $self->$method_to_call; } else { - my $msg = ""; - $msg .= CGI::li($r->maketext("unable to write to directory [_1]", $ce->{webworkDirs}{logs})) unless -w $ce->{webworkDirs}{logs}; - $msg .= CGI::li($r->maketext("unable to write to directory [_1]", $ce->{webworkDirs}{tmp})) unless -w $ce->{webworkDirs}{tmp}; - $msg .= CGI::li($r->maketext("unable to write to directory [_1]", $ce->{webworkDirs}{DATA})) unless -w $ce->{webworkDirs}{DATA}; - if ($msg) { - print CGI::h2($r->maketext("Directory permission errors ")).CGI::ul($msg). - CGI::p($r->maketext("The webwork server must be able to write to these directories. Please correct the permssion errors.")) ; - } + my $msg = ""; + $msg .= CGI::li($r->maketext("unable to write to directory [_1]", $ce->{webworkDirs}{logs})) + unless -w $ce->{webworkDirs}{logs}; + $msg .= CGI::li($r->maketext("unable to write to directory [_1]", $ce->{webworkDirs}{tmp})) + unless -w $ce->{webworkDirs}{tmp}; + $msg .= CGI::li($r->maketext("unable to write to directory [_1]", $ce->{webworkDirs}{DATA})) + unless -w $ce->{webworkDirs}{DATA}; + if ($msg) { + print CGI::h2($r->maketext("Directory permission errors ")) + . CGI::ul($msg) + . CGI::p( + $r->maketext( + "The webwork server must be able to write to these directories. Please correct the permssion errors." + ) + ); + } print $self->upgrade_notification(); @@ -420,11 +409,14 @@ sub body { print CGI::start_ol(); my @courseIDs = listCourses($ce); - foreach my $courseID (sort {lc($a) cmp lc($b) } @courseIDs) { - next if $courseID eq "admin"; # done already above - next if $courseID eq "modelCourse"; # modelCourse isn't a real course so don't create missing directories, etc - my $urlpath = $r->urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets", $r, courseID => $courseID); - print CGI::li(CGI::a({href=>$self->systemLink($urlpath, authen => 0)}, $courseID)); + foreach my $courseID (sort { lc($a) cmp lc($b) } @courseIDs) { + next if $courseID eq "admin"; # done already above + next + if $courseID eq + "modelCourse"; # modelCourse isn't a real course so don't create missing directories, etc + my $urlpath = + $r->urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets", $r, courseID => $courseID); + print CGI::li(CGI::a({ href => $self->systemLink($urlpath, authen => 0) }, $courseID)); } print CGI::end_ol(); @@ -433,8 +425,8 @@ sub body { print CGI::start_ol(); @courseIDs = listArchivedCourses($ce); - foreach my $courseID (sort {lc($a) cmp lc($b) } @courseIDs) { - print CGI::li($courseID), + foreach my $courseID (sort { lc($a) cmp lc($b) } @courseIDs) { + print CGI::li($courseID),; } print CGI::end_ol(); @@ -648,31 +640,27 @@ sub add_course_form { sub add_course_validate { my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; + my $r = $self->r; + my $ce = $r->ce; #my $db = $r->db; #my $authz = $r->authz; #my $urlpath = $r->urlpath; + my $add_courseID = trim_spaces($r->param("add_courseID")) || ""; + my $add_courseTitle = trim_spaces($r->param("add_courseTitle")) || ""; + my $add_courseInstitution = trim_spaces($r->param("add_courseInstitution")) || ""; - my $add_courseID = trim_spaces( $r->param("add_courseID") ) || ""; - my $add_courseTitle = trim_spaces( $r->param("add_courseTitle") ) || ""; - my $add_courseInstitution = trim_spaces( $r->param("add_courseInstitution") ) || ""; - - my $add_admin_users = trim_spaces( $r->param("add_admin_users") ) || ""; - - my $add_initial_userID = trim_spaces( $r->param("add_initial_userID") ) || ""; - my $add_initial_password = trim_spaces( $r->param("add_initial_password") ) || ""; - my $add_initial_confirmPassword = trim_spaces( $r->param("add_initial_confirmPassword") ) || ""; - my $add_initial_firstName = trim_spaces( $r->param("add_initial_firstName") ) || ""; - my $add_initial_lastName = trim_spaces( $r->param("add_initial_lastName") ) || ""; - my $add_initial_email = trim_spaces( $r->param("add_initial_email") ) || ""; - my $add_templates_course = trim_spaces( $r->param("add_templates_course") ) || ""; - my $add_config_file = trim_spaces( $r->param("add_config_file") ) || ""; - my $add_dbLayout = trim_spaces( $r->param("add_dbLayout") ) || ""; - - + my $add_admin_users = trim_spaces($r->param("add_admin_users")) || ""; + my $add_initial_userID = trim_spaces($r->param("add_initial_userID")) || ""; + my $add_initial_password = trim_spaces($r->param("add_initial_password")) || ""; + my $add_initial_confirmPassword = trim_spaces($r->param("add_initial_confirmPassword")) || ""; + my $add_initial_firstName = trim_spaces($r->param("add_initial_firstName")) || ""; + my $add_initial_lastName = trim_spaces($r->param("add_initial_lastName")) || ""; + my $add_initial_email = trim_spaces($r->param("add_initial_email")) || ""; + my $add_templates_course = trim_spaces($r->param("add_templates_course")) || ""; + my $add_config_file = trim_spaces($r->param("add_config_file")) || ""; + my $add_dbLayout = trim_spaces($r->param("add_dbLayout")) || ""; ###################### @@ -681,14 +669,14 @@ sub add_course_validate { if ($add_courseID eq "") { push @errors, $r->maketext("You must specify a course ID."); } - unless ($add_courseID =~ /^[\w-]*$/) { # regex copied from CourseAdministration.pm + unless ($add_courseID =~ /^[\w-]*$/) { # regex copied from CourseAdministration.pm push @errors, $r->maketext("Course ID may only contain letters, numbers, hyphens, and underscores."); } if (grep { $add_courseID eq $_ } listCourses($ce)) { push @errors, $r->maketext("A course with ID [_1] already exists.", $add_courseID); } - if ( length($add_courseID) > $ce->{maxCourseIdLength} ) { - push @errors, $r->maketext("Course ID cannot exceed [_1] characters.", $ce->{maxCourseIdLength}); + if (length($add_courseID) > $ce->{maxCourseIdLength}) { + push @errors, $r->maketext("Course ID cannot exceed [_1] characters.", $ce->{maxCourseIdLength}); } if ($add_initial_userID ne "") { @@ -727,40 +715,39 @@ sub add_course_validate { } sub do_add_course { - my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; - my $db = $r->db; - my $authz = $r->authz; + my ($self) = @_; + my $r = $self->r; + my $ce = $r->ce; + my $db = $r->db; + my $authz = $r->authz; my $urlpath = $r->urlpath; - my $add_courseID = trim_spaces( $r->param("add_courseID") ) || ""; - my $add_courseTitle = trim_spaces( $r->param("add_courseTitle") ) || ""; - my $add_courseInstitution = trim_spaces( $r->param("add_courseInstitution") ) || ""; + my $add_courseID = trim_spaces($r->param("add_courseID")) || ""; + my $add_courseTitle = trim_spaces($r->param("add_courseTitle")) || ""; + my $add_courseInstitution = trim_spaces($r->param("add_courseInstitution")) || ""; - my $add_admin_users = trim_spaces( $r->param("add_admin_users") ) || ""; + my $add_admin_users = trim_spaces($r->param("add_admin_users")) || ""; - my $add_initial_userID = trim_spaces( $r->param("add_initial_userID") ) || ""; - my $add_initial_password = trim_spaces( $r->param("add_initial_password") ) || ""; - my $add_initial_confirmPassword = trim_spaces( $r->param("add_initial_confirmPassword") ) || ""; - my $add_initial_firstName = trim_spaces( $r->param("add_initial_firstName") ) || ""; - my $add_initial_lastName = trim_spaces( $r->param("add_initial_lastName") ) || ""; - my $add_initial_email = trim_spaces( $r->param("add_initial_email") ) || ""; + my $add_initial_userID = trim_spaces($r->param("add_initial_userID")) || ""; + my $add_initial_password = trim_spaces($r->param("add_initial_password")) || ""; + my $add_initial_confirmPassword = trim_spaces($r->param("add_initial_confirmPassword")) || ""; + my $add_initial_firstName = trim_spaces($r->param("add_initial_firstName")) || ""; + my $add_initial_lastName = trim_spaces($r->param("add_initial_lastName")) || ""; + my $add_initial_email = trim_spaces($r->param("add_initial_email")) || ""; - my $add_templates_course = trim_spaces( $r->param("add_templates_course") ) || ""; - my $add_config_file = trim_spaces( $r->param("add_config_file") ) || ""; + my $add_templates_course = trim_spaces($r->param("add_templates_course")) || ""; + my $add_config_file = trim_spaces($r->param("add_config_file")) || ""; - my $add_dbLayout = trim_spaces( $r->param("add_dbLayout") ) || ""; + my $add_dbLayout = trim_spaces($r->param("add_dbLayout")) || ""; my $ce2 = new WeBWorK::CourseEnvironment({ - %WeBWorK::SeedCE, - courseName => $add_courseID, + %WeBWorK::SeedCE, courseName => $add_courseID, }); - my %courseOptions = ( dbLayoutName => $add_dbLayout ); + my %courseOptions = (dbLayoutName => $add_dbLayout); if ($add_initial_email ne "") { - $courseOptions{allowedRecipients} = [ $add_initial_email ]; + $courseOptions{allowedRecipients} = [$add_initial_email]; # don't set feedbackRecipients -- this just gets in the way of the more # intelligent "receive_recipients" method. #$courseOptions{feedbackRecipients} = [ $add_initial_email ]; @@ -776,21 +763,23 @@ sub do_add_course { # copy users from current (admin) course if desired if ($add_admin_users ne "") { - foreach my $userID ($db->listUsers) { - if ($userID eq $add_initial_userID) { - $self->addbadmessage($r->maketext("User '[_1]' will not be copied from admin course as it is the initial instructor.",$userID)); - next; + foreach my $userID ($db->listUsers) { + if ($userID eq $add_initial_userID) { + $self->addbadmessage($r->maketext( + "User '[_1]' will not be copied from admin course as it is the initial instructor.", $userID + )); + next; + } + my $PermissionLevel = $db->newPermissionLevel(); + $PermissionLevel->user_id($userID); + $PermissionLevel->permission($ce->{userRoles}->{admin}); + my $User = $db->getUser($userID); + my $Password = $db->getPassword($userID); + + push @users, [ $User, $Password, $PermissionLevel ] + if $authz->hasPermissions($userID, "create_and_delete_courses"); + #only transfer the "instructors" in the admin course classlist. } - my $PermissionLevel = $db->newPermissionLevel(); - $PermissionLevel->user_id($userID); - $PermissionLevel->permission($ce->{userRoles}->{admin}); - my $User = $db->getUser($userID); - my $Password = $db->getPassword($userID); - - push @users, [ $User, $Password, $PermissionLevel ] - if $authz->hasPermissions($userID,"create_and_delete_courses"); - #only transfer the "instructors" in the admin course classlist. - } } # add initial instructor if desired @@ -814,7 +803,7 @@ sub do_add_course { push @users, [ $User, $Password, $PermissionLevel ]; } - push @{$courseOptions{PRINT_FILE_NAMES_FOR}}, map { $_->[0]->user_id } @users; + push @{ $courseOptions{PRINT_FILE_NAMES_FOR} }, map { $_->[0]->user_id } @users; # include any optional arguments, including a template course and the # course title and course institution. @@ -852,36 +841,34 @@ sub do_add_course { # get rid of any partially built courses # FIXME -- this is too fragile unless ($error =~ /course exists/) { - eval { - deleteCourse( - courseID => $add_courseID, - ce => $ce2, - dbOptions => \%dbOptions, - ); - } + eval { deleteCourse(courseID => $add_courseID, ce => $ce2, dbOptions => \%dbOptions,); } } } else { - #log the action - writeLog($ce, "hosted_courses", join("\t", - "\tAdded", - ( defined $add_courseInstitution ? $add_courseInstitution : "(no institution specified)" ), - ( defined $add_courseTitle ? $add_courseTitle : "(no title specified)" ), - $add_courseID, - $add_initial_firstName, - $add_initial_lastName, - $add_initial_email, - )); - # add contact to admin course as student? - # FIXME -- should we do this? - if ($add_initial_userID =~ /\S/) { - my $composite_id = "${add_initial_userID}_${add_courseID}"; # student id includes school name and contact - my $User = $db->newUser( - user_id => $composite_id, # student id includes school name and contact - first_name => $add_initial_firstName, - last_name => $add_initial_lastName, - student_id => $add_initial_userID, - email_address => $add_initial_email, - status => "C", + #log the action + writeLog( + $ce, + "hosted_courses", + join("\t", + "\tAdded", + (defined $add_courseInstitution ? $add_courseInstitution : "(no institution specified)"), + (defined $add_courseTitle ? $add_courseTitle : "(no title specified)"), + $add_courseID, + $add_initial_firstName, + $add_initial_lastName, + $add_initial_email, + ) + ); + # add contact to admin course as student? + # FIXME -- should we do this? + if ($add_initial_userID =~ /\S/) { + my $composite_id = "${add_initial_userID}_${add_courseID}"; # student id includes school name and contact + my $User = $db->newUser( + user_id => $composite_id, # student id includes school name and contact + first_name => $add_initial_firstName, + last_name => $add_initial_lastName, + student_id => $add_initial_userID, + email_address => $add_initial_email, + status => "C", ); my $Password = $db->newPassword( user_id => $composite_id, @@ -894,27 +881,30 @@ sub do_add_course { # add contact to admin course as student # or if this contact and course already exist in a dropped status # change the student's status to enrolled - if (my $oldUser = $db->getUser($composite_id) ) { - warn "Replacing old data for $composite_id status: ". $oldUser->status; + if (my $oldUser = $db->getUser($composite_id)) { + warn "Replacing old data for $composite_id status: " . $oldUser->status; $db->deleteUser($composite_id); } - eval { $db->addUser($User) }; warn $@ if $@; - eval { $db->addPassword($Password) }; warn $@ if $@; - eval { $db->addPermissionLevel($PermissionLevel) }; warn $@ if $@; + eval { $db->addUser($User) }; + warn $@ if $@; + eval { $db->addPassword($Password) }; + warn $@ if $@; + eval { $db->addPermissionLevel($PermissionLevel) }; + warn $@ if $@; } print CGI::div( { class => 'alert alert-success p-1 mb-2' }, $r->maketext("Successfully created the course [_1]", $add_courseID), ); - my $newCoursePath = $urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets", $r, - courseID => $add_courseID); + my $newCoursePath = + $urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets", $r, courseID => $add_courseID); my $newCourseURL = $self->systemLink($newCoursePath, authen => 0); - print CGI::div({ class => 'text-center mb-2'}, - CGI::a({href=>$newCourseURL}, $r->maketext("Log into [_1]",$add_courseID)), + print CGI::div( + { class => 'text-center mb-2' }, + CGI::a({ href => $newCourseURL }, $r->maketext("Log into [_1]", $add_courseID)), ); } - } ################################################################################ @@ -954,7 +944,7 @@ sub rename_course_form { CGI::label( { for => 'rename_oldCourseID', class => 'col-sm-6 col-form-label fw-bold' }, $r->maketext('Course ID:') - ), + ), CGI::div( { class => 'col-sm-6' }, CGI::scrolling_list({ @@ -1033,7 +1023,8 @@ sub rename_course_form { checked => $r->param('rename_newCourseInstitution_checkbox') || '', value => 'on', class => 'form-check-input', - labelattributes => { class => 'form-check-label', id => 'rename_newCourseInstitution_label' } + labelattributes => + { class => 'form-check-label', id => 'rename_newCourseInstitution_label' } }) ) ), @@ -1056,94 +1047,104 @@ sub rename_course_form { sub rename_course_confirm { - my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; - - my $rename_oldCourseID = $r->param("rename_oldCourseID") || ""; - my $rename_newCourseID = $r->param("rename_newCourseID") || ""; - my $rename_newCourseID_checkbox = $r->param("rename_newCourseID_checkbox") || ""; ; + my ($self) = @_; + my $r = $self->r; + my $ce = $r->ce; - my $rename_newCourseTitle = $r->param("rename_newCourseTitle") || ""; - my $rename_newCourseTitle_checkbox = $r->param("rename_newCourseTitle_checkbox") || ""; ; - my $rename_newCourseInstitution = $r->param("rename_newCourseInstitution") || ""; - my $rename_newCourseInstitution_checkbox = $r->param("rename_newCourseInstitution_checkbox") || "" ; + my $rename_oldCourseID = $r->param("rename_oldCourseID") || ""; + my $rename_newCourseID = $r->param("rename_newCourseID") || ""; + my $rename_newCourseID_checkbox = $r->param("rename_newCourseID_checkbox") || ""; + my $rename_newCourseTitle = $r->param("rename_newCourseTitle") || ""; + my $rename_newCourseTitle_checkbox = $r->param("rename_newCourseTitle_checkbox") || ""; + my $rename_newCourseInstitution = $r->param("rename_newCourseInstitution") || ""; + my $rename_newCourseInstitution_checkbox = $r->param("rename_newCourseInstitution_checkbox") || ""; my $ce2 = new WeBWorK::CourseEnvironment({ - %WeBWorK::SeedCE, - courseName => $rename_oldCourseID, + %WeBWorK::SeedCE, courseName => $rename_oldCourseID, }); ###################################################### ## Create strings confirming title and institution change ###################################################### # connect to database to get old title and institution - my $dbLayoutName = $ce->{dbLayoutName}; - my $db = new WeBWorK::DB($ce->{dbLayouts}->{$dbLayoutName}); - my $oldDB =new WeBWorK::DB($ce2->{dbLayouts}->{$dbLayoutName}); - my $rename_oldCourseTitle = $oldDB->getSettingValue('courseTitle')//'""'; - my $rename_oldCourseInstitution = $oldDB->getSettingValue('courseInstitution')//'""'; - - my ($change_course_title_str, $change_course_institution_str)=(""); - if ( $rename_newCourseTitle_checkbox) { - $change_course_title_str =$r->maketext("Change title from [_1] to [_2]", $rename_oldCourseTitle, $rename_newCourseTitle); + my $dbLayoutName = $ce->{dbLayoutName}; + my $db = new WeBWorK::DB($ce->{dbLayouts}->{$dbLayoutName}); + my $oldDB = new WeBWorK::DB($ce2->{dbLayouts}->{$dbLayoutName}); + my $rename_oldCourseTitle = $oldDB->getSettingValue('courseTitle') // '""'; + my $rename_oldCourseInstitution = $oldDB->getSettingValue('courseInstitution') // '""'; + + my ($change_course_title_str, $change_course_institution_str) = (""); + if ($rename_newCourseTitle_checkbox) { + $change_course_title_str = + $r->maketext("Change title from [_1] to [_2]", $rename_oldCourseTitle, $rename_newCourseTitle); } - if ( $rename_newCourseInstitution_checkbox) { - $change_course_institution_str=$r->maketext("Change course institution from [_1] to [_2]", $rename_oldCourseInstitution, $rename_newCourseInstitution); + if ($rename_newCourseInstitution_checkbox) { + $change_course_institution_str = $r->maketext("Change course institution from [_1] to [_2]", + $rename_oldCourseInstitution, $rename_newCourseInstitution); } ############################################################################# -# If we are only changing the title or institution we can cut this short + # If we are only changing the title or institution we can cut this short ############################################################################# - unless ($rename_newCourseID_checkbox) { # in this case do not change course ID - print CGI::start_form(-method=>"POST", -action=>$r->uri); + unless ($rename_newCourseID_checkbox) { # in this case do not change course ID + print CGI::start_form(-method => "POST", -action => $r->uri); print $self->hidden_authen_fields; print $self->hidden_fields("subDisplay"); - print $self->hidden_fields(qw/rename_oldCourseID rename_newCourseID - rename_newCourseTitle rename_newCourseInstitution - rename_newCourseID_checkbox rename_newCourseInstitution_checkbox - rename_newCourseTitle_checkbox /); - print CGI::hidden(-name=>"rename_oldCourseTitle", - -default=>$rename_oldCourseTitle, - -id=>"hidden_rename_oldCourseTitle"); - print CGI::hidden(-name=>"rename_oldCourseInstitution", - -default=>$rename_oldCourseInstitution, - -id=>"hidden_rename_oldCourseInstitution"); - - print CGI::div({style=>"text-align: left"}, - CGI::hr(), - CGI::h4($r->maketext("Make these changes in course:")." $rename_oldCourseID"), - CGI::p($change_course_title_str), - CGI::p($change_course_institution_str), - CGI::submit({ - name => "decline_retitle_course", - value => $r->maketext("Don't make changes"), - class => 'btn btn-primary' - }), - " ", - CGI::submit({ - name => "confirm_retitle_course", - value => $r->maketext("Make changes"), - class => 'btn btn-primary' - }) , - CGI::hr(), - ); - print CGI::end_form(); - return; + print $self->hidden_fields( + qw/rename_oldCourseID rename_newCourseID + rename_newCourseTitle rename_newCourseInstitution + rename_newCourseID_checkbox rename_newCourseInstitution_checkbox + rename_newCourseTitle_checkbox / + ); + print CGI::hidden( + -name => "rename_oldCourseTitle", + -default => $rename_oldCourseTitle, + -id => "hidden_rename_oldCourseTitle" + ); + print CGI::hidden( + -name => "rename_oldCourseInstitution", + -default => $rename_oldCourseInstitution, + -id => "hidden_rename_oldCourseInstitution" + ); + + print CGI::div( + { style => "text-align: left" }, + CGI::hr(), + CGI::h4($r->maketext("Make these changes in course:") . " $rename_oldCourseID"), + CGI::p($change_course_title_str), + CGI::p($change_course_institution_str), + CGI::submit({ + name => "decline_retitle_course", + value => $r->maketext("Don't make changes"), + class => 'btn btn-primary' + }), + " ", + CGI::submit({ + name => "confirm_retitle_course", + value => $r->maketext("Make changes"), + class => 'btn btn-primary' + }), + CGI::hr(), + ); + print CGI::end_form(); + return; } ############################################################################# -# Check database + # Check database ############################################################################# - my ($tables_ok,$dbStatus); - if ($ce2->{dbLayoutName} ) { - my $CIchecker = new WeBWorK::Utils::CourseIntegrityCheck(ce=>$ce2); - ($tables_ok,$dbStatus) = $CIchecker->checkCourseTables($rename_oldCourseID); + my ($tables_ok, $dbStatus); + if ($ce2->{dbLayoutName}) { + my $CIchecker = new WeBWorK::Utils::CourseIntegrityCheck(ce => $ce2); + ($tables_ok, $dbStatus) = $CIchecker->checkCourseTables($rename_oldCourseID); if ($r->param("upgrade_course_tables")) { - my @schema_table_names = keys %$dbStatus; # update tables missing from database; - my @tables_to_create = grep {$dbStatus->{$_}->[0] == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_A} @schema_table_names; - my @tables_to_alter = grep {$dbStatus->{$_}->[0] == WeBWorK::Utils::CourseIntegrityCheck::DIFFER_IN_A_AND_B} @schema_table_names; + my @schema_table_names = keys %$dbStatus; # update tables missing from database; + my @tables_to_create = + grep { $dbStatus->{$_}->[0] == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_A } @schema_table_names; + my @tables_to_alter = + grep { $dbStatus->{$_}->[0] == WeBWorK::Utils::CourseIntegrityCheck::DIFFER_IN_A_AND_B } + @schema_table_names; my $msg = $CIchecker->updateCourseTables($rename_oldCourseID, [@tables_to_create]); foreach my $table_name (@tables_to_alter) { $msg .= $CIchecker->updateTableFields($rename_oldCourseID, $table_name); @@ -1151,8 +1152,7 @@ sub rename_course_confirm { print CGI::p({ class => 'text-success fw-bold' }, $msg); } - ($tables_ok,$dbStatus) = $CIchecker->checkCourseTables($rename_oldCourseID); - + ($tables_ok, $dbStatus) = $CIchecker->checkCourseTables($rename_oldCourseID); # print db status @@ -1180,50 +1180,56 @@ sub rename_course_confirm { $r->maketext("Schema and database field definitions do not agree") ), ); - my $all_tables_ok=1; - my $extra_database_tables=0; - my $extra_database_fields=0; - my $str=CGI::h4($r->maketext("Report on database structure for course [_1]:", $rename_oldCourseID)).CGI::br(); + my $all_tables_ok = 1; + my $extra_database_tables = 0; + my $extra_database_fields = 0; + my $str = + CGI::h4($r->maketext("Report on database structure for course [_1]:", $rename_oldCourseID)) . CGI::br(); foreach my $table (sort keys %$dbStatus) { - my $table_status = $dbStatus->{$table}->[0]; - $str .= CGI::b($table).': '. $msg{ $table_status } . CGI::br(); + my $table_status = $dbStatus->{$table}->[0]; + $str .= CGI::b($table) . ': ' . $msg{$table_status} . CGI::br(); - CASE: { + CASE: { $table_status == WeBWorK::Utils::CourseIntegrityCheck::SAME_IN_A_AND_B - && do{ last CASE; + && do { + last CASE; }; $table_status == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_A - && do{ - $all_tables_ok = 0; last CASE; + && do { + $all_tables_ok = 0; + last CASE; }; $table_status == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_B - && do{ - $extra_database_tables = 1; last CASE; + && do { + $extra_database_tables = 1; + last CASE; }; $table_status == WeBWorK::Utils::CourseIntegrityCheck::DIFFER_IN_A_AND_B - && do{ - my %fieldInfo = %{ $dbStatus->{$table}->[1] }; + && do { + my %fieldInfo = %{ $dbStatus->{$table}->[1] }; foreach my $key (keys %fieldInfo) { - my $field_status = $fieldInfo{$key}->[0]; - CASE2: { - $field_status == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_B - && do{ - $extra_database_fields = 1; last CASE2; - }; - $field_status == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_A - && do{ - $all_tables_ok=0; last CASE2; - }; - } - $str .= CGI::br()."\n   $key => ". $msg2{$field_status }; + my $field_status = $fieldInfo{$key}->[0]; + CASE2: { + $field_status == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_B + && do { + $extra_database_fields = 1; + last CASE2; + }; + $field_status == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_A + && do { + $all_tables_ok = 0; + last CASE2; + }; + } + $str .= CGI::br() . "\n   $key => " . $msg2{$field_status}; } }; } - $str.=CGI::br(); + $str .= CGI::br(); } ############################################################################# -# Report on databases + # Report on databases ############################################################################# print CGI::p($str); @@ -1259,7 +1265,7 @@ sub rename_course_confirm { } ############################################################################# -# Check directories + # Check directories ############################################################################# my ($directories_ok, $str2) = $CIchecker->checkCourseDirectories($ce2); @@ -1271,118 +1277,131 @@ sub rename_course_confirm { ); ############################################################################# -# Print form for choosing next action. + # Print form for choosing next action. ############################################################################# - - - print CGI::start_form(-method=>"POST", -action=>$r->uri); + print CGI::start_form(-method => "POST", -action => $r->uri); print $self->hidden_authen_fields; print $self->hidden_fields("subDisplay"); - print $self->hidden_fields(qw/rename_oldCourseID rename_newCourseID - rename_newCourseTitle rename_newCourseInstitution - rename_newCourseID_checkbox rename_newCourseInstitution_checkbox - rename_newCourseTitle_checkbox /); - print CGI::hidden(-name=>"rename_oldCourseTitle", - -default=>$rename_oldCourseTitle, - -id=>"hidden_rename_oldCourseTitle"); - print CGI::hidden(-name=>"rename_oldCourseInstitution", - -default=>$rename_oldCourseInstitution, - -id=>"hidden_rename_oldCourseInstitution"); - - - # grab some values we'll need - # fail if the source course does not exist - + print $self->hidden_fields( + qw/rename_oldCourseID rename_newCourseID + rename_newCourseTitle rename_newCourseInstitution + rename_newCourseID_checkbox rename_newCourseInstitution_checkbox + rename_newCourseTitle_checkbox / + ); + print CGI::hidden( + -name => "rename_oldCourseTitle", + -default => $rename_oldCourseTitle, + -id => "hidden_rename_oldCourseTitle" + ); + print CGI::hidden( + -name => "rename_oldCourseInstitution", + -default => $rename_oldCourseInstitution, + -id => "hidden_rename_oldCourseInstitution" + ); + # grab some values we'll need + # fail if the source course does not exist - if ($all_tables_ok && $directories_ok ) { # no missing tables or missing fields or directories - print CGI::p({style=>"text-align: center"}, - CGI::hr(), - CGI::h4($r->maketext("Rename [_1] to [_2]", $rename_oldCourseID, $rename_newCourseID)), - CGI::div($change_course_title_str), - CGI::div($change_course_institution_str), + if ($all_tables_ok && $directories_ok) { # no missing tables or missing fields or directories + print CGI::p( + { style => "text-align: center" }, + CGI::hr(), + CGI::h4($r->maketext("Rename [_1] to [_2]", $rename_oldCourseID, $rename_newCourseID)), + CGI::div($change_course_title_str), + CGI::div($change_course_institution_str), CGI::submit({ - name => "decline_rename_course", - value => $r->maketext("Don't rename"), - class => 'btn btn-primary' - }), + name => "decline_rename_course", + value => $r->maketext("Don't rename"), + class => 'btn btn-primary' + }), " ", CGI::submit({ - name => "confirm_rename_course", - value => $r->maketext("Rename"), - class => 'btn btn-primary' - }), + name => "confirm_rename_course", + value => $r->maketext("Rename"), + class => 'btn btn-primary' + }), ); - } elsif( $directories_ok ) { - print CGI::p({style=>"text-align: center"}, + } elsif ($directories_ok) { + print CGI::p( + { style => "text-align: center" }, CGI::submit({ - name => "decline_rename_course", - -value => $r->maketext("Don't rename"), - class => 'btn btn-primary' - }), + name => "decline_rename_course", + -value => $r->maketext("Don't rename"), + class => 'btn btn-primary' + }), " ", CGI::submit({ - name => "upgrade_course_tables", - value => $r->maketext("Upgrade Course Tables"), - class => 'btn btn-primary' - }), + name => "upgrade_course_tables", + value => $r->maketext("Upgrade Course Tables"), + class => 'btn btn-primary' + }), ); - } else { - print CGI::p({style=>"text-align: center"}, + } else { + print CGI::p( + { style => "text-align: center" }, CGI::submit({ - name => "decline_rename_course", - -value => $r->maketext("Don't rename"), - class => 'btn btn-primary' - }), - CGI::br(),$r->maketext("Directory structure needs to be repaired manually before renaming.") + name => "decline_rename_course", + -value => $r->maketext("Don't rename"), + class => 'btn btn-primary' + }), + CGI::br(), + $r->maketext("Directory structure needs to be repaired manually before renaming.") ); } print CGI::end_form(); } } + sub rename_course_validate { my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; + my $r = $self->r; + my $ce = $r->ce; - my $rename_oldCourseID = $r->param("rename_oldCourseID") || ""; - my $rename_newCourseID = $r->param("rename_newCourseID") || ""; - my $rename_newCourseID_checkbox = $r->param("rename_newCourseID_checkbox") || ""; ; + my $rename_oldCourseID = $r->param("rename_oldCourseID") || ""; + my $rename_newCourseID = $r->param("rename_newCourseID") || ""; + my $rename_newCourseID_checkbox = $r->param("rename_newCourseID_checkbox") || ""; - my $rename_newCourseTitle = $r->param("rename_newCourseTitle") || ""; - my $rename_newCourseTitle_checkbox = $r->param("rename_newCourseTitle_checkbox") || "" ; - my $rename_newCourseInstitution = $r->param("rename_newCourseInstitution") || ""; - my $rename_newCourseInstitution_checkbox = $r->param("rename_newCourseInstitution_checkbox") || "" ; + my $rename_newCourseTitle = $r->param("rename_newCourseTitle") || ""; + my $rename_newCourseTitle_checkbox = $r->param("rename_newCourseTitle_checkbox") || ""; + my $rename_newCourseInstitution = $r->param("rename_newCourseInstitution") || ""; + my $rename_newCourseInstitution_checkbox = $r->param("rename_newCourseInstitution_checkbox") || ""; my @errors; if ($rename_oldCourseID eq "") { push @errors, $r->maketext("You must select a course to rename."); } - if ($rename_newCourseID eq "" and $rename_newCourseID_checkbox eq 'on' ) { + if ($rename_newCourseID eq "" and $rename_newCourseID_checkbox eq 'on') { push @errors, $r->maketext("You must specify a new name for the course."); } if ($rename_oldCourseID eq $rename_newCourseID and $rename_newCourseID_checkbox eq 'on') { push @errors, $r->maketext("Can't rename to the same name."); } - if ($rename_newCourseID_checkbox eq 'on' && length($rename_newCourseID) > $ce->{maxCourseIdLength} ) { + if ($rename_newCourseID_checkbox eq 'on' && length($rename_newCourseID) > $ce->{maxCourseIdLength}) { push @errors, $r->maketext("Course ID cannot exceed [_1] characters.", $ce->{maxCourseIdLength}); } - unless ($rename_newCourseID =~ /^[\w-]*$/) { # regex copied from CourseAdministration.pm + unless ($rename_newCourseID =~ /^[\w-]*$/) { # regex copied from CourseAdministration.pm push @errors, $r->maketext("Course ID may only contain letters, numbers, hyphens, and underscores."); } if (grep { $rename_newCourseID eq $_ } listCourses($ce)) { - push @errors, $r->maketext("A course with ID [_1] already exists.",$rename_newCourseID); + push @errors, $r->maketext("A course with ID [_1] already exists.", $rename_newCourseID); } - if ($rename_newCourseTitle eq "" and $rename_newCourseTitle_checkbox eq 'on') { + if ($rename_newCourseTitle eq "" and $rename_newCourseTitle_checkbox eq 'on') { push @errors, $r->maketext("You must specify a new title for the course."); } - if ($rename_newCourseInstitution eq "" and $rename_newCourseInstitution_checkbox eq 'on') { + if ($rename_newCourseInstitution eq "" and $rename_newCourseInstitution_checkbox eq 'on') { push @errors, $r->maketext("You must specify a new institution for the course."); } - unless ($rename_newCourseID or $rename_newCourseID_checkbox or $rename_newCourseTitle_checkbox or $rename_newCourseInstitution_checkbox) { - push @errors, $r->maketext("No changes specified. You must mark the checkbox of the item(s) to be changed and enter the change data."); + unless ($rename_newCourseID + or $rename_newCourseID_checkbox + or $rename_newCourseTitle_checkbox + or $rename_newCourseInstitution_checkbox) + { + push @errors, + $r->maketext( + "No changes specified. You must mark the checkbox of the item(s) to be changed and enter the change data." + ); } return @errors; @@ -1390,95 +1409,96 @@ sub rename_course_validate { sub do_retitle_course { my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; - my $db = $r->db; + my $r = $self->r; + my $ce = $r->ce; + my $db = $r->db; #my $authz = $r->authz; my $urlpath = $r->urlpath; - my $rename_oldCourseID = $r->param("rename_oldCourseID") || ""; -# my $rename_newCourseID = $r->param("rename_newCourseID") || ""; -# There is no new course, but there are new titles and institutions - my $rename_newCourseTitle = $r->param("rename_newCourseTitle") || ""; - my $rename_newCourseInstitution = $r->param("rename_newCourseInstitution") || ""; - my $rename_oldCourseTitle = $r->param("rename_oldCourseTitle") || ""; - my $rename_oldCourseInstitution = $r->param("rename_oldCourseInstitution") || ""; - my $title_checkbox = $r->param("rename_newCourseTitle_checkbox") || "" ; - my $institution_checkbox = $r->param("rename_newCourseInstitution_checkbox") || "" ; - -# $rename_newCourseID = $rename_oldCourseID ; #since they are the same FIXME + my $rename_oldCourseID = $r->param("rename_oldCourseID") || ""; + # my $rename_newCourseID = $r->param("rename_newCourseID") || ""; + # There is no new course, but there are new titles and institutions + my $rename_newCourseTitle = $r->param("rename_newCourseTitle") || ""; + my $rename_newCourseInstitution = $r->param("rename_newCourseInstitution") || ""; + my $rename_oldCourseTitle = $r->param("rename_oldCourseTitle") || ""; + my $rename_oldCourseInstitution = $r->param("rename_oldCourseInstitution") || ""; + my $title_checkbox = $r->param("rename_newCourseTitle_checkbox") || ""; + my $institution_checkbox = $r->param("rename_newCourseInstitution_checkbox") || ""; + + # $rename_newCourseID = $rename_oldCourseID ; #since they are the same FIXME # define new courseTitle and new courseInstitution my %optional_arguments = (); - $optional_arguments{courseTitle} = $rename_newCourseTitle if $title_checkbox; + $optional_arguments{courseTitle} = $rename_newCourseTitle if $title_checkbox; $optional_arguments{courseInstitution} = $rename_newCourseInstitution if $institution_checkbox; my $ce2; - my %dbOptions =(); - eval { - $ce2 = new WeBWorK::CourseEnvironment({ - %WeBWorK::SeedCE, - courseName => $rename_oldCourseID, - }); - }; + my %dbOptions = (); + eval { $ce2 = new WeBWorK::CourseEnvironment({ %WeBWorK::SeedCE, courseName => $rename_oldCourseID, }); }; warn "failed to create environment in do_retitle_course $@" if $@; - eval { - retitleCourse( - courseID => $rename_oldCourseID, - ce => $ce2, - dbOptions => \%dbOptions, - %optional_arguments, - ); - }; + eval { retitleCourse(courseID => $rename_oldCourseID, ce => $ce2, dbOptions => \%dbOptions, + %optional_arguments,); }; if ($@) { my $error = $@; print CGI::div( { class => 'alert alert-danger p-1 mb-2' }, - CGI::p($r->maketext("An error occured while changing the title of the course [_1].", $rename_oldCourseID)), + CGI::p($r->maketext( + "An error occured while changing the title of the course [_1].", $rename_oldCourseID)), CGI::div({ class => 'font-monospace' }, CGI::escapeHTML($error)), ); } else { print CGI::div( { class => 'alert alert-success p-1 mb-2' }, - ($title_checkbox) ? CGI::div($r->maketext("The title of the course [_1] has been changed from [_2] to [_3]",$rename_oldCourseID, $rename_oldCourseTitle, $rename_newCourseTitle)) - :'', - ($institution_checkbox) ? CGI::div($r->maketext("The institution associated with the course [_1] has been changed from [_2] to [_3]",$rename_oldCourseID, $rename_oldCourseInstitution, $rename_newCourseInstitution)) - :'', + ($title_checkbox) ? CGI::div($r->maketext( + "The title of the course [_1] has been changed from [_2] to [_3]", + $rename_oldCourseID, $rename_oldCourseTitle, $rename_newCourseTitle + )) : '', + ($institution_checkbox) ? CGI::div($r->maketext( + "The institution associated with the course [_1] has been changed from [_2] to [_3]", + $rename_oldCourseID, $rename_oldCourseInstitution, $rename_newCourseInstitution + )) : '', ); - writeLog($ce, "hosted_courses", join("\t", - "\t",$r->maketext("Retitled"), - "", - "", - $r->maketext("[_1] title and institution changed from [_2] to [_3] and from [_4] to [_5]",$rename_oldCourseID, $rename_oldCourseTitle, $rename_newCourseTitle, $rename_oldCourseInstitution, $rename_newCourseInstitution) - )); - my $oldCoursePath = $urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets", $r, - courseID => $rename_oldCourseID); + writeLog( + $ce, + "hosted_courses", + join( + "\t", "\t", + $r->maketext("Retitled"), + "", "", + $r->maketext( + "[_1] title and institution changed from [_2] to [_3] and from [_4] to [_5]", + $rename_oldCourseID, $rename_oldCourseTitle, $rename_newCourseTitle, + $rename_oldCourseInstitution, $rename_newCourseInstitution + ) + ) + ); + my $oldCoursePath = + $urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets", $r, courseID => $rename_oldCourseID); my $oldCourseURL = $self->systemLink($oldCoursePath, authen => 0); - print CGI::div({style=>"text-align: center"}, - CGI::a({href=>$oldCourseURL}, $r->maketext("Log into [_1]", $rename_oldCourseID)), + print CGI::div( + { style => "text-align: center" }, + CGI::a({ href => $oldCourseURL }, $r->maketext("Log into [_1]", $rename_oldCourseID)), ); } } sub do_rename_course { my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; - my $db = $r->db; + my $r = $self->r; + my $ce = $r->ce; + my $db = $r->db; #my $authz = $r->authz; my $urlpath = $r->urlpath; - my $rename_oldCourseID = $r->param("rename_oldCourseID") || ""; - my $rename_newCourseID = $r->param("rename_newCourseID") || ""; - my $rename_newCourseTitle = $r->param("rename_newCourseTitle") || ""; - my $rename_newCourseInstitution = $r->param("rename_newCourseInstitution") || ""; - my $title_checkbox = $r->param("rename_newCourseTitle_checkbox") || "" ; - my $institution_checkbox = $r->param("rename_newCourseInstitution_checkbox") || "" ; - + my $rename_oldCourseID = $r->param("rename_oldCourseID") || ""; + my $rename_newCourseID = $r->param("rename_newCourseID") || ""; + my $rename_newCourseTitle = $r->param("rename_newCourseTitle") || ""; + my $rename_newCourseInstitution = $r->param("rename_newCourseInstitution") || ""; + my $title_checkbox = $r->param("rename_newCourseTitle_checkbox") || ""; + my $institution_checkbox = $r->param("rename_newCourseInstitution_checkbox") || ""; my $ce2 = new WeBWorK::CourseEnvironment({ - %WeBWorK::SeedCE, - courseName => $rename_oldCourseID, + %WeBWorK::SeedCE, courseName => $rename_oldCourseID, }); my $dbLayoutName = $ce->{dbLayoutName}; @@ -1487,19 +1507,21 @@ sub do_rename_course { my %optional_arguments = (); my ($title_message, $institution_message); if ($title_checkbox) { - $optional_arguments{courseTitle} = $rename_newCourseTitle; - $title_message = $r->maketext("The title of the course [_1] is now [_2]", $rename_newCourseID, $rename_newCourseTitle) , + $optional_arguments{courseTitle} = $rename_newCourseTitle; + $title_message = + $r->maketext("The title of the course [_1] is now [_2]", $rename_newCourseID, $rename_newCourseTitle),; } else { } if ($institution_checkbox) { $optional_arguments{courseInstitution} = $rename_newCourseInstitution; - $institution_message = $r->maketext("The institution associated with the course [_1] is now [_2]", $rename_newCourseID, $rename_newCourseInstitution), + $institution_message = $r->maketext("The institution associated with the course [_1] is now [_2]", + $rename_newCourseID, $rename_newCourseInstitution), + ; } - # this is kinda left over from when we had 'gdbm' and 'sql' database layouts # below this line, we would grab values from getopt and put them in this hash # but for now the hash can remain empty @@ -1507,10 +1529,10 @@ sub do_rename_course { eval { renameCourse( - courseID => $rename_oldCourseID, - ce => $ce2, - dbOptions => \%dbOptions, - newCourseID => $rename_newCourseID, + courseID => $rename_oldCourseID, + ce => $ce2, + dbOptions => \%dbOptions, + newCourseID => $rename_newCourseID, %optional_arguments, ); }; @@ -1518,7 +1540,10 @@ sub do_rename_course { my $error = $@; print CGI::div( { class => 'alert alert-danger p-1 mb-2' }, - CGI::p( $r->maketext("An error occured while renaming the course [_1] to [_2]:", $rename_oldCourseID, $rename_newCourseID)), + CGI::p($r->maketext( + "An error occured while renaming the course [_1] to [_2]:", $rename_oldCourseID, + $rename_newCourseID + )), CGI::div({ class => 'font-monospace' }, CGI::escapeHTML($error)), ); } else { @@ -1526,19 +1551,18 @@ sub do_rename_course { { class => 'alert alert-success p-1 mb-2' }, CGI::p($title_message), CGI::p($institution_message), - CGI::p($r->maketext("Successfully renamed the course [_1] to [_2]", $rename_oldCourseID, $rename_newCourseID)), + CGI::p($r->maketext( + "Successfully renamed the course [_1] to [_2]", + $rename_oldCourseID, $rename_newCourseID + )), ); - writeLog($ce, "hosted_courses", join("\t", - "\tRenamed", - "", - "", - "$rename_oldCourseID to $rename_newCourseID", - )); - my $newCoursePath = $urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets", $r, - courseID => $rename_newCourseID); + writeLog($ce, "hosted_courses", join("\t", "\tRenamed", "", "", "$rename_oldCourseID to $rename_newCourseID",)); + my $newCoursePath = + $urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets", $r, courseID => $rename_newCourseID); my $newCourseURL = $self->systemLink($newCoursePath, authen => 0); - print CGI::div({style=>"text-align: center"}, - CGI::a({href=>$newCourseURL}, $r->maketext("Log into [_1]", $rename_newCourseID)), + print CGI::div( + { style => "text-align: center" }, + CGI::a({ href => $newCourseURL }, $r->maketext("Log into [_1]", $rename_newCourseID)), ); } } @@ -1546,7 +1570,7 @@ sub do_rename_course { ################################################################################ my %coursesData; -sub byLoginActivity {$coursesData{$a}{'epoch_modify_time'} <=> $coursesData{$b}{'epoch_modify_time'}} +sub byLoginActivity { $coursesData{$a}{'epoch_modify_time'} <=> $coursesData{$b}{'epoch_modify_time'} } sub delete_course_form { my ($self) = @_; @@ -1635,7 +1659,8 @@ sub delete_course_form { ) ) } ( - [ alphabetically => $r->maketext('alphabetically') ], [ last_login => $r->maketext('by last login date') ] + [ alphabetically => $r->maketext('alphabetically') ], + [ last_login => $r->maketext('by last login date') ] ), ); @@ -1696,25 +1721,24 @@ sub delete_course_form { sub delete_course_validate { my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; + my $r = $self->r; + my $ce = $r->ce; #my $db = $r->db; #my $authz = $r->authz; my $urlpath = $r->urlpath; - my $delete_courseID = $r->param("delete_courseID") || ""; + my $delete_courseID = $r->param("delete_courseID") || ""; my @errors; if ($delete_courseID eq "") { - push @errors, $r->maketext("You must specify a course name."); + push @errors, $r->maketext("You must specify a course name."); } elsif ($delete_courseID eq $urlpath->arg("courseID")) { - push @errors, $r->maketext("You cannot delete the course you are currently using."); + push @errors, $r->maketext("You cannot delete the course you are currently using."); } my $ce2 = new WeBWorK::CourseEnvironment({ - %WeBWorK::SeedCE, - courseName => $delete_courseID, + %WeBWorK::SeedCE, courseName => $delete_courseID, }); return @errors; @@ -1762,17 +1786,16 @@ sub delete_course_confirm { sub do_delete_course { my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; - my $db = $r->db; + my $r = $self->r; + my $ce = $r->ce; + my $db = $r->db; #my $authz = $r->authz; #my $urlpath = $r->urlpath; - my $delete_courseID = $r->param("delete_courseID") || ""; + my $delete_courseID = $r->param("delete_courseID") || ""; my $ce2 = new WeBWorK::CourseEnvironment({ - %WeBWorK::SeedCE, - courseName => $delete_courseID, + %WeBWorK::SeedCE, courseName => $delete_courseID, }); # this is kinda left over from when we had 'gdbm' and 'sql' database layouts @@ -1780,13 +1803,7 @@ sub do_delete_course { # but for now the hash can remain empty my %dbOptions; - eval { - deleteCourse( - courseID => $delete_courseID, - ce => $ce2, - dbOptions => \%dbOptions, - ); - }; + eval { deleteCourse(courseID => $delete_courseID, ce => $ce2, dbOptions => \%dbOptions,); }; if ($@) { my $error = $@; @@ -1796,18 +1813,18 @@ sub do_delete_course { CGI::div({ class => 'font-monospace' }, CGI::escapeHTML($error)), ); } else { - # mark the contact person in the admin course as dropped. - # find the contact person for the course by searching the admin classlist. - my @contacts = grep /_$delete_courseID$/, $db->listUsers; - if (@contacts) { - die "Incorrect number of contacts for the course $delete_courseID". join(" ", @contacts) if @contacts !=1; + # mark the contact person in the admin course as dropped. + # find the contact person for the course by searching the admin classlist. + my @contacts = grep /_$delete_courseID$/, $db->listUsers; + if (@contacts) { + die "Incorrect number of contacts for the course $delete_courseID" . join(" ", @contacts) if @contacts != 1; #warn "contacts", join(" ", @contacts); #my $composite_id = "${add_initial_userID}_${add_courseID}"; - my $composite_id = $contacts[0]; + my $composite_id = $contacts[0]; # mark the contact person as dropped. - my $User = $db->getUser($composite_id); - my $status_name = 'Drop'; + my $User = $db->getUser($composite_id); + my $status_name = 'Drop'; my $status_value = ($ce->status_name_to_abbrevs($status_name))[0]; $User->status($status_value); $db->putUser($User); @@ -1817,22 +1834,19 @@ sub do_delete_course { { class => 'alert alert-success p-1 mb-2' }, $r->maketext("Successfully deleted the course [_1].", $delete_courseID), ); - writeLog($ce, "hosted_courses", join("\t", - "\tDeleted", - "", - "", - $delete_courseID, - )); - print CGI::start_form(-method=>"POST", -action=>$r->uri); + writeLog($ce, "hosted_courses", join("\t", "\tDeleted", "", "", $delete_courseID,)); + print CGI::start_form(-method => "POST", -action => $r->uri); print $self->hidden_authen_fields; print $self->hidden_fields("subDisplay"); - print CGI::p({style=>"text-align: center"}, + print CGI::p( + { style => "text-align: center" }, CGI::submit({ - name => "decline_delete_course", - value => $r->maketext("OK"), - class => 'btn btn-primary' - })); + name => "decline_delete_course", + value => $r->maketext("OK"), + class => 'btn btn-primary' + }) + ); print CGI::end_form(); } @@ -1852,7 +1866,7 @@ sub archive_course_form { . 'application.' )); - my @courseIDs = listCourses($ce); + my @courseIDs = listCourses($ce); unless (@courseIDs) { print CGI::p($r->maketext('No courses found')); @@ -1893,8 +1907,8 @@ sub archive_course_form { if ($archive_listing_format eq 'last_login') { # This should be an empty array except for the model course @noLoginLogIDs = sort { lc($a) cmp lc($b) } @noLoginLogIDs; - @loginLogIDs = sort byLoginActivity @loginLogIDs; # oldest first - @courseIDs = (@noLoginLogIDs, @loginLogIDs); + @loginLogIDs = sort byLoginActivity @loginLogIDs; # oldest first + @courseIDs = (@noLoginLogIDs, @loginLogIDs); } else { # in this case we sort alphabetically @courseIDs = sort { lc($a) cmp lc($b) } @courseIDs; @@ -1932,7 +1946,8 @@ sub archive_course_form { ) ) } ( - [ alphabetically => $r->maketext('alphabetically') ], [ last_login => $r->maketext('by last login date') ] + [ alphabetically => $r->maketext('alphabetically') ], + [ last_login => $r->maketext('by last login date') ] ), ); @@ -2012,20 +2027,20 @@ sub archive_course_form { sub archive_course_validate { my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; + my $r = $self->r; + my $ce = $r->ce; #my $db = $r->db; #my $authz = $r->authz; my $urlpath = $r->urlpath; - my @archive_courseIDs = $r->param("archive_courseIDs"); - @archive_courseIDs = () unless @archive_courseIDs; + my @archive_courseIDs = $r->param("archive_courseIDs"); + @archive_courseIDs = () unless @archive_courseIDs; my @errors; foreach my $archive_courseID (@archive_courseIDs) { if ($archive_courseID eq "") { - push @errors, $r->maketext("You must specify a course name."); + push @errors, $r->maketext("You must specify a course name."); } elsif ($archive_courseID eq $urlpath->arg("courseID")) { - push @errors, $r->maketext("You cannot archive the course you are currently using."); + push @errors, $r->maketext("You cannot archive the course you are currently using."); } } @@ -2039,56 +2054,56 @@ sub archive_course_validate { sub archive_course_confirm { my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; + my $r = $self->r; + my $ce = $r->ce; #my $db = $r->db; #my $authz = $r->authz; #my $urlpath = $r->urlpath; - print CGI::h2( $r->maketext("Archive Course")); + print CGI::h2($r->maketext("Archive Course")); - my $delete_course_flag = $r->param("delete_course") || ""; + my $delete_course_flag = $r->param("delete_course") || ""; - my @archive_courseIDs = $r->param("archive_courseIDs"); - @archive_courseIDs = () unless @archive_courseIDs; + my @archive_courseIDs = $r->param("archive_courseIDs"); + @archive_courseIDs = () unless @archive_courseIDs; # if we are skipping a course remove one from # the list of courses if (defined $r->param("skip_archive_course")) { - shift @archive_courseIDs; + shift @archive_courseIDs; } - my $archive_courseID = $archive_courseIDs[0]; + my $archive_courseID = $archive_courseIDs[0]; my $ce2 = new WeBWorK::CourseEnvironment({ - %WeBWorK::SeedCE, - courseName => $archive_courseID, + %WeBWorK::SeedCE, courseName => $archive_courseID, }); - - my ($tables_ok,$dbStatus); + my ($tables_ok, $dbStatus); ############################################################################# -# Check database + # Check database ############################################################################# my %missing_fields; - if ($ce2->{dbLayoutName} ) { - my $CIchecker = new WeBWorK::Utils::CourseIntegrityCheck(ce=>$ce2); - ($tables_ok,$dbStatus) = $CIchecker->checkCourseTables($archive_courseID); + if ($ce2->{dbLayoutName}) { + my $CIchecker = new WeBWorK::Utils::CourseIntegrityCheck(ce => $ce2); + ($tables_ok, $dbStatus) = $CIchecker->checkCourseTables($archive_courseID); if ($r->param("upgrade_course_tables")) { - my @schema_table_names = keys %$dbStatus; # update tables missing from database; - my @tables_to_create = grep {$dbStatus->{$_}->[0] == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_A} @schema_table_names; - my @tables_to_alter = grep {$dbStatus->{$_}->[0] == WeBWorK::Utils::CourseIntegrityCheck::DIFFER_IN_A_AND_B} @schema_table_names; + my @schema_table_names = keys %$dbStatus; # update tables missing from database; + my @tables_to_create = + grep { $dbStatus->{$_}->[0] == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_A } @schema_table_names; + my @tables_to_alter = + grep { $dbStatus->{$_}->[0] == WeBWorK::Utils::CourseIntegrityCheck::DIFFER_IN_A_AND_B } + @schema_table_names; my $msg = $CIchecker->updateCourseTables($archive_courseID, [@tables_to_create]); foreach my $table_name (@tables_to_alter) { $msg .= $CIchecker->updateTableFields($archive_courseID, $table_name); } print CGI::p({ class => 'text-success fw-bold' }, $msg); } - if ($r->param("upgrade_course_tables") ) { + if ($r->param("upgrade_course_tables")) { - $CIchecker -> updateCourseDirectories(); # needs more error messages + $CIchecker->updateCourseDirectories(); # needs more error messages } - ($tables_ok,$dbStatus) = $CIchecker->checkCourseTables($archive_courseID); - + ($tables_ok, $dbStatus) = $CIchecker->checkCourseTables($archive_courseID); # print db status @@ -2116,50 +2131,55 @@ sub archive_course_confirm { $r->maketext("Schema and database field definitions do not agree") ), ); - my $all_tables_ok=1; - my $extra_database_tables=0; - my $extra_database_fields=0; - my $str=CGI::h4($r->maketext("Report on database structure for course [_1]:", $archive_courseID)).CGI::br(); + my $all_tables_ok = 1; + my $extra_database_tables = 0; + my $extra_database_fields = 0; + my $str = CGI::h4($r->maketext("Report on database structure for course [_1]:", $archive_courseID)) . CGI::br(); foreach my $table (sort keys %$dbStatus) { - my $table_status = $dbStatus->{$table}->[0]; - $str .= CGI::b($table) .": ". $msg{ $table_status } . CGI::br(); + my $table_status = $dbStatus->{$table}->[0]; + $str .= CGI::b($table) . ": " . $msg{$table_status} . CGI::br(); - CASE: { + CASE: { $table_status == WeBWorK::Utils::CourseIntegrityCheck::SAME_IN_A_AND_B - && do{ last CASE; + && do { + last CASE; }; $table_status == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_A - && do{ - $all_tables_ok = 0; last CASE; + && do { + $all_tables_ok = 0; + last CASE; }; $table_status == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_B - && do{ - $extra_database_tables = 1; last CASE; + && do { + $extra_database_tables = 1; + last CASE; }; $table_status == WeBWorK::Utils::CourseIntegrityCheck::DIFFER_IN_A_AND_B - && do{ - my %fieldInfo = %{ $dbStatus->{$table}->[1] }; + && do { + my %fieldInfo = %{ $dbStatus->{$table}->[1] }; foreach my $key (keys %fieldInfo) { - my $field_status = $fieldInfo{$key}->[0]; - CASE2: { - $field_status == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_B - && do{ - $extra_database_fields = 1; last CASE2; - }; - $field_status == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_A - && do{ - $all_tables_ok=0; last CASE2; - }; - } - $str .= CGI::br()."\n  $key => ". $msg2{$field_status }; + my $field_status = $fieldInfo{$key}->[0]; + CASE2: { + $field_status == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_B + && do { + $extra_database_fields = 1; + last CASE2; + }; + $field_status == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_A + && do { + $all_tables_ok = 0; + last CASE2; + }; + } + $str .= CGI::br() . "\n  $key => " . $msg2{$field_status}; } }; } - $str.=CGI::br(); + $str .= CGI::br(); } ############################################################################# -# Report on databases + # Report on databases ############################################################################# print CGI::p($str); @@ -2202,7 +2222,7 @@ sub archive_course_confirm { ); } ############################################################################# -# Check directories and report + # Check directories and report ############################################################################# my ($directories_ok, $str2) = $CIchecker->checkCourseDirectories($ce2); @@ -2214,25 +2234,25 @@ sub archive_course_confirm { ); ############################################################################# -# Print form for choosing next action. + # Print form for choosing next action. ############################################################################# - print CGI::start_form(-method=>"POST", -action=>$r->uri); + print CGI::start_form(-method => "POST", -action => $r->uri); print $self->hidden_authen_fields; print $self->hidden_fields("subDisplay"); print $self->hidden_fields(qw/delete_course/); - print CGI::hidden('archive_courseID', $archive_courseID); - print CGI::hidden('archive_courseIDs',@archive_courseIDs); - # grab some values we'll need + print CGI::hidden('archive_courseID', $archive_courseID); + print CGI::hidden('archive_courseIDs', @archive_courseIDs); + # grab some values we'll need my $course_dir = $ce2->{courseDirs}{root}; my $archive_path = $ce2->{webworkDirs}{courses} . "/$archive_courseID.tar.gz"; - # fail if the source course does not exist + # fail if the source course does not exist unless (-e $course_dir) { - print CGI::p( $r->maketext("[_1]: The directory for the course not found.",$archive_courseID)); + print CGI::p($r->maketext("[_1]: The directory for the course not found.", $archive_courseID)); } - if ($all_tables_ok && $directories_ok ) { # no missing fields - # Warn about overwriting an existing archive + if ($all_tables_ok && $directories_ok) { # no missing fields + # Warn about overwriting an existing archive if (-e $archive_path and -w $archive_path) { print CGI::p( { class => 'text-danger fw-bold' }, @@ -2245,52 +2265,57 @@ sub archive_course_confirm { ); } # archive execute button - print CGI::p({ style => "text-align: center" }, + print CGI::p( + { style => "text-align: center" }, CGI::submit({ - name => "decline_archive_course", - value => $r->maketext("Stop Archiving"), - class => 'btn btn-primary' - }), + name => "decline_archive_course", + value => $r->maketext("Stop Archiving"), + class => 'btn btn-primary' + }), " ", scalar(@archive_courseIDs) > 1 - ? CGI::submit({ - name => "skip_archive_course", - value => $r->maketext("Skip archiving this course"), - class => 'btn btn-primary' - }) . " " - : '', + ? CGI::submit({ + name => "skip_archive_course", + value => $r->maketext("Skip archiving this course"), + class => 'btn btn-primary' + }) + . " " + : '', CGI::submit({ - name => "confirm_archive_course", - value => $r->maketext("Archive"), - class => 'btn btn-primary' - }) , + name => "confirm_archive_course", + value => $r->maketext("Archive"), + class => 'btn btn-primary' + }), ); - } elsif( $directories_ok) { - print CGI::p({style=>"text-align: center"}, + } elsif ($directories_ok) { + print CGI::p( + { style => "text-align: center" }, CGI::submit({ - name => "decline_archive_course", - -value => $r->maketext("Don't Archive"), - class => 'btn btn-primary' - }), + name => "decline_archive_course", + -value => $r->maketext("Don't Archive"), + class => 'btn btn-primary' + }), " ", CGI::submit({ - name => "upgrade_course_tables", - value => $r->maketext("Upgrade Course Tables"), - class => 'btn btn-primary' - }) + name => "upgrade_course_tables", + value => $r->maketext("Upgrade Course Tables"), + class => 'btn btn-primary' + }) ); } else { - print CGI::p({style=>"text-align: center"}, - CGI::br(), - $r->maketext("Directory structure needs to be repaired manually before archiving."),CGI::br(), - CGI::submit({ - name => "decline_archive_course", - value => $r->maketext("Don't Archive"), + print CGI::p( + { style => "text-align: center" }, + CGI::br(), + $r->maketext("Directory structure needs to be repaired manually before archiving."), + CGI::br(), + CGI::submit({ + name => "decline_archive_course", + value => $r->maketext("Don't Archive"), class => 'btn btn-primary' }), - CGI::submit({ - name => "upgrade_course_tables", - value => $r->maketext("Attempt to upgrade directories"), + CGI::submit({ + name => "upgrade_course_tables", + value => $r->maketext("Attempt to upgrade directories"), class => 'btn btn-primary' }), ); @@ -2304,21 +2329,19 @@ sub archive_course_confirm { sub do_archive_course { my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; - my $db = $r->db; + my $r = $self->r; + my $ce = $r->ce; + my $db = $r->db; #my $authz = $r->authz; #my $urlpath = $r->urlpath; - - my $delete_course_flag = $r->param("delete_course") || ""; - my @archive_courseIDs = $r->param("archive_courseIDs"); - @archive_courseIDs = () unless @archive_courseIDs; + my $delete_course_flag = $r->param("delete_course") || ""; + my @archive_courseIDs = $r->param("archive_courseIDs"); + @archive_courseIDs = () unless @archive_courseIDs; my $archive_courseID = $archive_courseIDs[0]; my $ce2 = new WeBWorK::CourseEnvironment({ - %WeBWorK::SeedCE, - courseName => $archive_courseID, + %WeBWorK::SeedCE, courseName => $archive_courseID, }); # Remove course specific temp files before archiving @@ -2335,13 +2358,7 @@ sub do_archive_course { # but for now the hash can remain empty my %dbOptions; - eval { - archiveCourse( - courseID => $archive_courseID, - ce => $ce2, - dbOptions => \%dbOptions, - ); - }; + eval { archiveCourse(courseID => $archive_courseID, ce => $ce2, dbOptions => \%dbOptions,); }; if ($@) { my $error = $@; @@ -2351,25 +2368,12 @@ sub do_archive_course { CGI::div({ class => 'font-monospace' }, CGI::escapeHTML($error)), ); } else { - print CGI::div( - { class => 'alert alert-success p-1 mb-2' }, - $r->maketext("Successfully archived the course [_1].", $archive_courseID) - ); - writeLog($ce, "hosted_courses", join("\t", - "\tarchived", - "", - "", - $archive_courseID, - )); + print CGI::div({ class => 'alert alert-success p-1 mb-2' }, + $r->maketext("Successfully archived the course [_1].", $archive_courseID)); + writeLog($ce, "hosted_courses", join("\t", "\tarchived", "", "", $archive_courseID,)); if ($delete_course_flag) { - eval { - deleteCourse( - courseID => $archive_courseID, - ce => $ce2, - dbOptions => \%dbOptions, - ); - }; + eval { deleteCourse(courseID => $archive_courseID, ce => $ce2, dbOptions => \%dbOptions,); }; if ($@) { my $error = $@; @@ -2381,16 +2385,17 @@ sub do_archive_course { } else { # mark the contact person in the admin course as dropped. # find the contact person for the course by searching the admin classlist. - my @contacts = grep /_$archive_courseID$/, $db->listUsers; + my @contacts = grep /_$archive_courseID$/, $db->listUsers; if (@contacts) { - die "Incorrect number of contacts for the course $archive_courseID". join(" ", @contacts) if @contacts !=1; + die "Incorrect number of contacts for the course $archive_courseID" . join(" ", @contacts) + if @contacts != 1; #warn "contacts", join(" ", @contacts); #my $composite_id = "${add_initial_userID}_${add_courseID}"; - my $composite_id = $contacts[0]; + my $composite_id = $contacts[0]; # mark the contact person as dropped. - my $User = $db->getUser($composite_id); - my $status_name = 'Drop'; + my $User = $db->getUser($composite_id); + my $status_name = 'Drop'; my $status_value = ($ce->status_name_to_abbrevs($status_name))[0]; $User->status($status_value); $db->putUser($User); @@ -2402,39 +2407,39 @@ sub do_archive_course { ); } - } - shift @archive_courseIDs; # remove the course which has just been archived. + shift @archive_courseIDs; # remove the course which has just been archived. if (@archive_courseIDs) { - print CGI::start_form(-method=>"POST", -action=>$r->uri); + print CGI::start_form(-method => "POST", -action => $r->uri); print $self->hidden_authen_fields; print $self->hidden_fields("subDisplay"); print $self->hidden_fields(qw/delete_course/); - print CGI::hidden('archive_courseIDs',@archive_courseIDs); - print CGI::p({ style => "text-align: center" }, - CGI::submit({ - name => "decline_archive_course", - value => $r->maketext("Stop archiving courses"), - class => 'btn btn-primary' - }), + print CGI::hidden('archive_courseIDs', @archive_courseIDs); + print CGI::p( + { style => "text-align: center" }, CGI::submit({ - name => "archive_course", - value => $r->maketext("Archive next course"), - class => 'btn btn-primary' - }) + name => "decline_archive_course", + value => $r->maketext("Stop archiving courses"), + class => 'btn btn-primary' + }), + CGI::submit({ + name => "archive_course", + value => $r->maketext("Archive next course"), + class => 'btn btn-primary' + }) ); - print CGI::end_form(); - } else { - print CGI::start_form(-method=>"POST", -action=>$r->uri); + print CGI::end_form(); + } else { + print CGI::start_form(-method => "POST", -action => $r->uri); print $self->hidden_authen_fields; print $self->hidden_fields("subDisplay"); - print CGI::hidden('archive_courseIDs',$archive_courseID); + print CGI::hidden('archive_courseIDs', $archive_courseID); print CGI::p(CGI::submit({ - name => "decline_archive_course", - value => $r->maketext("OK"), - class => 'btn btn-primary' - })); + name => "decline_archive_course", + value => $r->maketext("OK"), + class => 'btn btn-primary' + })); print CGI::end_form(); } } @@ -2495,7 +2500,7 @@ sub unarchive_course_form { class => 'form-select' }) ) - ), + ), CGI::div( { class => 'row mb-2 align-items-center' }, CGI::div( @@ -2525,94 +2530,98 @@ sub unarchive_course_form { ) ); - print CGI::div( - CGI::submit({ - name => 'unarchive_course', - value => $r->maketext('Unarchive Course'), - class => 'btn btn-primary' - }) - ); + print CGI::div(CGI::submit({ + name => 'unarchive_course', + value => $r->maketext('Unarchive Course'), + class => 'btn btn-primary' + })); print CGI::end_form(); } sub unarchive_course_validate { my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; + my $r = $self->r; + my $ce = $r->ce; #my $db = $r->db; #my $authz = $r->authz; my $urlpath = $r->urlpath; - my $unarchive_courseID = $r->param("unarchive_courseID") || ""; - my $create_newCourseID = $r->param("create_newCourseID") || ""; - my $new_courseID = $r->param("new_courseID") || ""; + my $unarchive_courseID = $r->param("unarchive_courseID") || ""; + my $create_newCourseID = $r->param("create_newCourseID") || ""; + my $new_courseID = $r->param("new_courseID") || ""; my @errors; #by default we use the archive name for the course my $courseID = $unarchive_courseID; $courseID =~ s/\.tar\.gz$//; - if ( $create_newCourseID) { + if ($create_newCourseID) { $courseID = $new_courseID; } debug(" unarchive_courseID $unarchive_courseID new_courseID $new_courseID "); if ($courseID eq "") { push @errors, $r->maketext("You must specify a course name."); - } elsif ( -d $ce->{webworkDirs}->{courses}."/$courseID" ) { - #Check that a directory for this course doesn't already exist - push @errors, $r->maketext("A directory already exists with the name [_1]. You must first delete this existing course before you can unarchive.",$courseID); - } elsif ( length($courseID) > $ce->{maxCourseIdLength} ) { + } elsif (-d $ce->{webworkDirs}->{courses} . "/$courseID") { + #Check that a directory for this course doesn't already exist + push @errors, + $r->maketext( + "A directory already exists with the name [_1]. You must first delete this existing course before you can unarchive.", + $courseID + ); + } elsif (length($courseID) > $ce->{maxCourseIdLength}) { push @errors, $r->maketext("Course ID cannot exceed [_1] characters.", $ce->{maxCourseIdLength}); } - return @errors; } sub unarchive_course_confirm { my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; + my $r = $self->r; + my $ce = $r->ce; #my $db = $r->db; #my $authz = $r->authz; #my $urlpath = $r->urlpath; print CGI::h2($r->maketext("Unarchive Course")); - my $unarchive_courseID = $r->param("unarchive_courseID") || ""; - my $create_newCourseID = $r->param("create_newCourseID") || ""; - my $new_courseID = $r->param("new_courseID") || ""; + my $unarchive_courseID = $r->param("unarchive_courseID") || ""; + my $create_newCourseID = $r->param("create_newCourseID") || ""; + my $new_courseID = $r->param("new_courseID") || ""; - my $courseID = $unarchive_courseID; $courseID =~ s/\.tar\.gz$//; + my $courseID = $unarchive_courseID; + $courseID =~ s/\.tar\.gz$//; - if ( $create_newCourseID) { + if ($create_newCourseID) { $courseID = $new_courseID; } - debug(" unarchive_courseID $unarchive_courseID new_courseID $new_courseID "); + debug(" unarchive_courseID $unarchive_courseID new_courseID $new_courseID "); - print CGI::start_form(-method=>"POST", -action=>$r->uri); - print CGI::p($r->maketext("Unarchive [_1] to course:", $unarchive_courseID), - CGI::input({-name=>'new_courseID', -value=>$courseID}) + print CGI::start_form(-method => "POST", -action => $r->uri); + print CGI::p( + $r->maketext("Unarchive [_1] to course:", $unarchive_courseID), + CGI::input({ -name => 'new_courseID', -value => $courseID }) ); print $self->hidden_authen_fields; print $self->hidden_fields("subDisplay"); print $self->hidden_fields(qw/unarchive_courseID create_newCourseID/); - print CGI::p({ style => "text-align: center" }, + print CGI::p( + { style => "text-align: center" }, CGI::submit({ - name => "decline_unarchive_course", - value => $r->maketext("Don't Unarchive"), - class => 'btn btn-primary' - }), + name => "decline_unarchive_course", + value => $r->maketext("Don't Unarchive"), + class => 'btn btn-primary' + }), " ", CGI::submit({ - name => "confirm_unarchive_course", - value => $r->maketext("Unarchive"), - class => 'btn btn-primary' - }), + name => "confirm_unarchive_course", + value => $r->maketext("Unarchive"), + class => 'btn btn-primary' + }), ); print CGI::end_form(); @@ -2620,24 +2629,24 @@ sub unarchive_course_confirm { sub do_unarchive_course { my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; + my $r = $self->r; + my $ce = $r->ce; #my $db = $r->db; #my $authz = $r->authz; - my $urlpath = $r->urlpath; - my $new_courseID = $r->param("new_courseID") || ""; - my $unarchive_courseID = $r->param("unarchive_courseID") || ""; + my $urlpath = $r->urlpath; + my $new_courseID = $r->param("new_courseID") || ""; + my $unarchive_courseID = $r->param("unarchive_courseID") || ""; - my $old_courseID = $unarchive_courseID; + my $old_courseID = $unarchive_courseID; $old_courseID =~ s/.tar.gz//; #eval { - unarchiveCourse( - newCourseID => $new_courseID, - oldCourseID => $old_courseID, - archivePath =>$ce->{webworkDirs}->{courses}."/$unarchive_courseID", - ce => $ce, - ); + unarchiveCourse( + newCourseID => $new_courseID, + oldCourseID => $old_courseID, + archivePath => $ce->{webworkDirs}->{courses} . "/$unarchive_courseID", + ce => $ce, + ); #}; if ($@) { @@ -2652,30 +2661,26 @@ sub do_unarchive_course { { class => 'alert alert-success p-1 mb-2' }, $r->maketext("Successfully unarchived [_1] to the course [_2]", $unarchive_courseID, $new_courseID), ); - writeLog($ce, "hosted_courses", join("\t", - "\tunarchived", - "", - "", - "$unarchive_courseID to $new_courseID", - )); - - my $newCoursePath = $urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets", $r, - courseID => $new_courseID); + writeLog($ce, "hosted_courses", join("\t", "\tunarchived", "", "", "$unarchive_courseID to $new_courseID",)); + + my $newCoursePath = + $urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets", $r, courseID => $new_courseID); my $newCourseURL = $self->systemLink($newCoursePath, authen => 0); - print CGI::div({style=>"text-align: center"}, - CGI::a({href=>$newCourseURL}, $r->maketext("Log into [_1]", $new_courseID)), + print CGI::div( + { style => "text-align: center" }, + CGI::a({ href => $newCourseURL }, $r->maketext("Log into [_1]", $new_courseID)), ); - print CGI::start_form(-method=>"POST", -action=>$r->uri); + print CGI::start_form(-method => "POST", -action => $r->uri); print $self->hidden_authen_fields; print $self->hidden_fields("subDisplay"); - print CGI::hidden("unarchive_courseID",$unarchive_courseID); + print CGI::hidden("unarchive_courseID", $unarchive_courseID); print CGI::p(CGI::submit({ - name => "decline_unarchive_course", - value => $r->maketext("Unarchive Next Course"), - class => 'btn btn-primary' - })); - print CGI::end_form(); + name => "decline_unarchive_course", + value => $r->maketext("Unarchive Next Course"), + class => 'btn btn-primary' + })); + print CGI::end_form(); } } @@ -3202,16 +3207,18 @@ sub manage_location_form { })); unless (@locations) { - print CGI::div({ class => 'row mt-3' }, - CGI::div({ class => 'col-lg-8 col-md-9 fw-bold' }, $r->maketext('No locations are currently defined.'))); + print CGI::div( + { class => 'row mt-3' }, + CGI::div({ class => 'col-lg-8 col-md-9 fw-bold' }, $r->maketext('No locations are currently defined.')) + ); return; } # Existing location table print CGI::start_div({ class => 'table-responsive mt-3' }), CGI::start_table({ class => 'table table-sm font-sm table-bordered table-striped' }); - print CGI::thead(CGI::Tr(CGI::th([ - $r->maketext('Select'), $r->maketext('Location'), $r->maketext('Description'), $r->maketext('Addresses') ]))); + print CGI::thead(CGI::Tr(CGI::th([ $r->maketext('Select'), $r->maketext('Location'), $r->maketext('Description'), + $r->maketext('Addresses') ]))); print CGI::start_tbody(); for my $loc (@locations) { my $editAddr = $self->systemLink( @@ -3243,13 +3250,13 @@ sub manage_location_form { sub add_location_handler { my $self = shift(); - my $r = $self->r; - my $db = $r->db; + my $r = $self->r; + my $db = $r->db; # the location data we're to add - my $locationID = $r->param("new_location_name"); + my $locationID = $r->param("new_location_name"); my $locationDescr = $r->param("new_location_description"); - my $locationAddr = $r->param("new_location_addresses"); + my $locationAddr = $r->param("new_location_addresses"); # break the addresses up $locationAddr =~ s/\s*-\s*/-/g; $locationAddr =~ s/\s*\/\s*/\//g; @@ -3257,8 +3264,8 @@ sub add_location_handler { # sanity checks my $badAddr = ''; - foreach my $addr ( @addresses ) { - unless ( new Net::IP($addr) ) { + foreach my $addr (@addresses) { + unless (new Net::IP($addr)) { $badAddr .= "$addr, "; $locationAddr =~ s/$addr\n//s; } @@ -3268,56 +3275,79 @@ sub add_location_handler { # a check to be sure that the location addresses don't already # exist my $badLocAddr = ''; - if ( ! $badAddr && $locationID ) { - if ( $db->countLocationAddresses( $locationID ) ) { + if (!$badAddr && $locationID) { + if ($db->countLocationAddresses($locationID)) { my @allLocAddr = $db->listLocationAddresses($locationID); - foreach my $addr ( @addresses ) { + foreach my $addr (@addresses) { $badLocAddr .= "$addr, " - if ( grep {/^$addr$/} @allLocAddr ); + if (grep {/^$addr$/} @allLocAddr); } $badLocAddr =~ s/, $//; } } - if ( ! @addresses || ! $locationID || ! $locationDescr ) { - print CGI::div({ class => 'alert alert-danger p-1 mb-2' }, - $r->maketext("Missing required input data. Please check that you have filled in all of the create location fields and resubmit.")); - } elsif ( $badAddr ) { + if (!@addresses || !$locationID || !$locationDescr) { + print CGI::div( + { class => 'alert alert-danger p-1 mb-2' }, + $r->maketext( + "Missing required input data. Please check that you have filled in all of the create location fields and resubmit." + ) + ); + } elsif ($badAddr) { $r->param("new_location_addresses", $locationAddr); - print CGI::div({ class => 'alert alert-danger p-1 mb-2' }, - $r->maketext("Address(es) [_1] is(are) not in a recognized form. Please check your data entry and resubmit.",$badAddr)); - } elsif ( $db->existsLocation( $locationID ) ) { - print CGI::div({ class => 'alert alert-danger p-1 mb-2' }, - $r->maketext("A location with the name [_1] already exists in the database. Did you mean to edit that location instead?",$locationID)); - } elsif ( $badLocAddr ) { - print CGI::div({ class => 'alert alert-danger p-1 mb-2' }, - $r->maketext("Address(es) [_1] already exist in the database. THIS SHOULD NOT HAPPEN! Please double check the integrity of the WeBWorK database before continuing.", $badLocAddr)); + print CGI::div( + { class => 'alert alert-danger p-1 mb-2' }, + $r->maketext( + "Address(es) [_1] is(are) not in a recognized form. Please check your data entry and resubmit.", + $badAddr + ) + ); + } elsif ($db->existsLocation($locationID)) { + print CGI::div( + { class => 'alert alert-danger p-1 mb-2' }, + $r->maketext( + "A location with the name [_1] already exists in the database. Did you mean to edit that location instead?", + $locationID + ) + ); + } elsif ($badLocAddr) { + print CGI::div( + { class => 'alert alert-danger p-1 mb-2' }, + $r->maketext( + "Address(es) [_1] already exist in the database. THIS SHOULD NOT HAPPEN! Please double check the integrity of the WeBWorK database before continuing.", + $badLocAddr + ) + ); } else { # add the location my $locationObj = $db->newLocation; - $locationObj->location_id( $locationID ); - $locationObj->description( $locationDescr ); - $db->addLocation( $locationObj ); + $locationObj->location_id($locationID); + $locationObj->description($locationDescr); + $db->addLocation($locationObj); # and add the addresses - foreach my $addr ( @addresses ) { + foreach my $addr (@addresses) { my $locationAddress = $db->newLocationAddress; $locationAddress->location_id($locationID); $locationAddress->ip_mask($addr); - $db->addLocationAddress( $locationAddress ); + $db->addLocationAddress($locationAddress); } # we've added the location, so clear those param # entries - $r->param('manage_location_action','none'); - $r->param('new_location_name',''); - $r->param('new_location_description',''); - $r->param('new_location_addresses',''); + $r->param('manage_location_action', 'none'); + $r->param('new_location_name', ''); + $r->param('new_location_description', ''); + $r->param('new_location_addresses', ''); print CGI::div( { class => 'alert alert-success p-1 mb-2' }, - $r->maketext("Location [_1] has been created, with addresses [_2].", $locationID, join(', ', @addresses))); + $r->maketext( + "Location [_1] has been created, with addresses [_2].", + $locationID, join(', ', @addresses) + ) + ); } $self->manage_location_form; @@ -3325,48 +3355,49 @@ sub add_location_handler { sub delete_location_handler { my $self = shift; - my $r = $self->r; - my $db = $r->db; + my $r = $self->r; + my $db = $r->db; # what location are we deleting? my $locationID = $r->param("delete_location"); # check for selected deletions if appropriate - my @delLocations = ( $locationID ); - if ( $locationID eq 'selected_locations' ) { + my @delLocations = ($locationID); + if ($locationID eq 'selected_locations') { @delLocations = $r->param("delete_selected"); - $locationID = @delLocations; + $locationID = @delLocations; } # are we sure? my $confirm = $r->param("delete_confirm"); my $badID; - if ( ! $locationID ) { + if (!$locationID) { print CGI::div({ class => 'alert alert-danger p-1 mb-2' }, $r->maketext("Please provide a location name to delete.")); - } elsif ( $badID = $self->existsLocations_helper( @delLocations ) ) { + } elsif ($badID = $self->existsLocations_helper(@delLocations)) { print CGI::div({ class => 'alert alert-danger p-1 mb-2' }, $r->maketext("No location with name [_1] exists in the database", $badID)); - } elsif ( ! $confirm || $confirm ne 'true' ) { + } elsif (!$confirm || $confirm ne 'true') { print CGI::div({ class => 'alert alert-danger p-1 mb-2' }, $r->maketext("Location deletion requires confirmation.")); } else { - foreach ( @delLocations ) { - $db->deleteLocation( $_ ); + foreach (@delLocations) { + $db->deleteLocation($_); } print CGI::div({ class => 'alert alert-success p-1 mb-2' }, $r->maketext("Deleted Location(s): [_1]", join(', ', @delLocations))); - $r->param('manage_location_action','none'); - $r->param('delete_location',''); + $r->param('manage_location_action', 'none'); + $r->param('delete_location', ''); } $self->manage_location_form; } + sub existsLocations_helper { my ($self, @locations) = @_; my $db = $self->r->db; - foreach ( @locations ) { - return $_ if ( ! $db->existsLocation($_) ); + foreach (@locations) { + return $_ if (!$db->existsLocation($_)); } return 0; } @@ -3507,24 +3538,29 @@ sub edit_location_form { sub edit_location_handler { my $self = shift; - my $r = $self->r; - my $db = $r->db; + my $r = $self->r; + my $db = $r->db; - my $locationID = $r->param("edit_location"); + my $locationID = $r->param("edit_location"); my $locationDesc = $r->param("location_description"); my $addAddresses = $r->param("new_location_addresses"); my @delAddresses = $r->param("delete_location_addresses"); - my $deleteAll = $r->param("delete_all_addresses"); + my $deleteAll = $r->param("delete_all_addresses"); # gut check - if ( ! $locationID ) { + if (!$locationID) { print CGI::div({ class => 'alert alert-danger p-1 mb-2' }, $r->maketext("No location specified to edit. Please check your input data.")); $self->manage_location_form; - } elsif ( ! $db->existsLocation( $locationID ) ) { - print CGI::div({ class => 'alert alert-danger p-1 mb-2' }, - $r->maketext("Location [_1] does not exist in the WeBWorK database. Please check your input (perhaps you need to reload the location management page?).", $locationID)); + } elsif (!$db->existsLocation($locationID)) { + print CGI::div( + { class => 'alert alert-danger p-1 mb-2' }, + $r->maketext( + "Location [_1] does not exist in the WeBWorK database. Please check your input (perhaps you need to reload the location management page?).", + $locationID + ) + ); $self->manage_location_form; } else { my $location = $db->getLocation($locationID); @@ -3533,15 +3569,14 @@ sub edit_location_handler { # all of the existing addresses, we don't use this list # to determine which addresses to add, however. my @currentAddr = $db->listLocationAddresses($locationID); - my @compareAddr = ( ! $deleteAll || $deleteAll ne 'true' ) - ? @currentAddr : (); + my @compareAddr = (!$deleteAll || $deleteAll ne 'true') ? @currentAddr : (); my $doneMsg = ''; if ($locationDesc && $location->description ne $locationDesc) { $location->description($locationDesc); $db->putLocation($location); - $doneMsg .= CGI::p({},$r->maketext("Updated location description.")); + $doneMsg .= CGI::p({}, $r->maketext("Updated location description.")); } # get the actual addresses to add out of the text field $addAddresses =~ s/\s*-\s*/-/g; @@ -3551,27 +3586,34 @@ sub edit_location_handler { # make sure that we're adding and deleting only those # addresses that are not yet/currently in the location # addresses - my @toAdd = (); my @noAdd = (); - my @toDel = (); my @noDel = (); - foreach my $addr ( @addAddresses ) { - if (grep {/^$addr$/} @compareAddr) {push(@noAdd,$addr);} - else { push(@toAdd, $addr); } + my @toAdd = (); + my @noAdd = (); + my @toDel = (); + my @noDel = (); + foreach my $addr (@addAddresses) { + if (grep {/^$addr$/} @compareAddr) { + push(@noAdd, $addr); + } else { + push(@toAdd, $addr); + } } - if ( $deleteAll && $deleteAll eq 'true' ) { + if ($deleteAll && $deleteAll eq 'true') { @toDel = @currentAddr; } else { - foreach my $addr ( @delAddresses ) { + foreach my $addr (@delAddresses) { if (grep {/^$addr$/} @currentAddr) { - push(@toDel,$addr); - } else { push(@noDel, $addr); } + push(@toDel, $addr); + } else { + push(@noDel, $addr); + } } } # and make sure that all of the addresses we're adding are # a sensible form my $badAddr = ''; - foreach my $addr ( @toAdd ) { - unless ( new Net::IP($addr) ) { + foreach my $addr (@toAdd) { + unless (new Net::IP($addr)) { $badAddr .= "$addr, "; } } @@ -3582,10 +3624,10 @@ sub edit_location_handler { # note that we don't allow deletion and then addition # of the same address normally, however; in that case # we'll end up just deleting the address. - foreach ( @toDel ) { + foreach (@toDel) { $db->deleteLocationAddress($locationID, $_); } - foreach ( @toAdd ) { + foreach (@toAdd) { my $locAddr = $db->newLocationAddress; $locAddr->location_id($locationID); $locAddr->ip_mask($_); @@ -3594,13 +3636,24 @@ sub edit_location_handler { } my $addrMsg = ''; - $addrMsg .= $r->maketext("Deleted addresses [_1] from location.", join(', ', @toDel)) . CGI::br() if ( @toDel ); - $addrMsg .= $r->maketext("Added addresses [_1] to location [_2].", join(', ', @toAdd), $locationID) if ( @toAdd ); + $addrMsg .= $r->maketext("Deleted addresses [_1] from location.", join(', ', @toDel)) . CGI::br() if (@toDel); + $addrMsg .= $r->maketext("Added addresses [_1] to location [_2].", join(', ', @toAdd), $locationID) if (@toAdd); my $badMsg = ''; - $badMsg .= $r->maketext('Address(es) [_1] in the add list is(are) already in the location [_2], and so were skipped.', join(', ', @noAdd), $locationID) . CGI::br() if ( @noAdd ); - $badMsg .= $r->maketext("Address(es) [_1] is(are) not in a recognized form. Please check your data entry and try again.",$badAddr) . CGI::br() if ( $badAddr ); - $badMsg .= $r->maketext('Address(es) [_1] in the delete list is(are) not in the location [_2], and so were skipped.',join(', ', @noDel),$locationID) if ( @noDel ); + $badMsg .= + $r->maketext('Address(es) [_1] in the add list is(are) already in the location [_2], and so were skipped.', + join(', ', @noAdd), $locationID) + . CGI::br() + if (@noAdd); + $badMsg .= $r->maketext( + "Address(es) [_1] is(are) not in a recognized form. Please check your data entry and try again.", + $badAddr) + . CGI::br() + if ($badAddr); + $badMsg .= + $r->maketext('Address(es) [_1] in the delete list is(are) not in the location [_2], and so were skipped.', + join(', ', @noDel), $locationID) + if (@noDel); print CGI::div({ class => 'alert alert-danger p-1 mb-2' }, $badMsg) if ($badMsg); @@ -3653,7 +3706,7 @@ sub hide_inactive_course_form { if ($hide_listing_format eq 'last_login') { # This should be an empty arrey except for the model course. @noLoginLogIDs = sort { lc($a) cmp lc($b) } @noLoginLogIDs; - @loginLogIDs = sort byLoginActivity @loginLogIDs; # oldest first + @loginLogIDs = sort byLoginActivity @loginLogIDs; # oldest first @hideCourseIDs = (@noLoginLogIDs, @loginLogIDs); } else { # In this case we sort alphabetically @@ -3702,7 +3755,8 @@ sub hide_inactive_course_form { ) ) } ( - [ alphabetically => $r->maketext('alphabetically') ], [ last_login => $r->maketext('by last login date') ] + [ alphabetically => $r->maketext('alphabetically') ], + [ last_login => $r->maketext('by last login date') ] ), ); @@ -3772,14 +3826,14 @@ sub hide_inactive_course_form { sub hide_course_validate { my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; + my $r = $self->r; + my $ce = $r->ce; #my $db = $r->db; #my $authz = $r->authz; my $urlpath = $r->urlpath; - my @hide_courseIDs = $r->param("hide_courseIDs"); - @hide_courseIDs = () unless @hide_courseIDs; + my @hide_courseIDs = $r->param("hide_courseIDs"); + @hide_courseIDs = () unless @hide_courseIDs; my @errors; @@ -3789,54 +3843,59 @@ sub hide_course_validate { return @errors; } - sub do_hide_inactive_course { my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; + my $r = $self->r; + my $ce = $r->ce; - my $coursesDir = $ce->{webworkDirs}->{courses}; + my $coursesDir = $ce->{webworkDirs}->{courses}; my $hide_courseID; - my @hide_courseIDs = $r->param("hide_courseIDs"); - @hide_courseIDs = () unless @hide_courseIDs; + my @hide_courseIDs = $r->param("hide_courseIDs"); + @hide_courseIDs = () unless @hide_courseIDs; - my $hideDirFileContent = $r->maketext('Place a file named "hide_directory" in a course or other directory and it will not show up in the courses list on the WeBWorK home page. It will still appear in the Course Administration listing.'); + my $hideDirFileContent = $r->maketext( + 'Place a file named "hide_directory" in a course or other directory and it will not show up in the courses list on the WeBWorK home page. It will still appear in the Course Administration listing.' + ); - my @succeeded_courses = (); - my $succeeded_count = 0; - my @failed_courses = (); + my @succeeded_courses = (); + my $succeeded_count = 0; + my @failed_courses = (); my $already_hidden_count = 0; - foreach $hide_courseID (@hide_courseIDs) { - my $hideDirFile = "$coursesDir/$hide_courseID/hide_directory"; - if (-f $hideDirFile) { - $already_hidden_count++; - next; - } else { - local *HIDEFILE; - if (open (HIDEFILE, ">", $hideDirFile)) { - print HIDEFILE "$hideDirFileContent"; - close HIDEFILE; - push @succeeded_courses,$hide_courseID; - $succeeded_count++; - } else { - push @failed_courses,$hide_courseID; - } - } - } + foreach $hide_courseID (@hide_courseIDs) { + my $hideDirFile = "$coursesDir/$hide_courseID/hide_directory"; + if (-f $hideDirFile) { + $already_hidden_count++; + next; + } else { + local *HIDEFILE; + if (open(HIDEFILE, ">", $hideDirFile)) { + print HIDEFILE "$hideDirFileContent"; + close HIDEFILE; + push @succeeded_courses, $hide_courseID; + $succeeded_count++; + } else { + push @failed_courses, $hide_courseID; + } + } + } if (@failed_courses) { - print CGI::div({ class => 'alert alert-danger p-1 mb-2' }, - CGI::p($r->maketext("Errors occured while hiding the courses listed below when attempting to create the file hide_directory in the course's directory. Check the ownership and permissions of the course's directory, e.g [_1]", - "$coursesDir/$failed_courses[0]/")), + print CGI::div( + { class => 'alert alert-danger p-1 mb-2' }, + CGI::p($r->maketext( + "Errors occured while hiding the courses listed below when attempting to create the file hide_directory in the course's directory. Check the ownership and permissions of the course's directory, e.g [_1]", + "$coursesDir/$failed_courses[0]/" + )), join(CGI::br(), @failed_courses) ); } my $succeeded_message = ''; if ($succeeded_count < 1 and $already_hidden_count > 0) { - $succeeded_message = $r->maketext("Except for possible errors listed above, all selected courses are already hidden."); + $succeeded_message = + $r->maketext("Except for possible errors listed above, all selected courses are already hidden."); } if ($succeeded_count) { @@ -3850,14 +3909,14 @@ sub do_hide_inactive_course { sub unhide_course_validate { my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; + my $r = $self->r; + my $ce = $r->ce; #my $db = $r->db; #my $authz = $r->authz; my $urlpath = $r->urlpath; - my @unhide_courseIDs = $r->param("hide_courseIDs"); - @unhide_courseIDs = () unless @unhide_courseIDs; + my @unhide_courseIDs = $r->param("hide_courseIDs"); + @unhide_courseIDs = () unless @unhide_courseIDs; my @errors; @@ -3867,41 +3926,41 @@ sub unhide_course_validate { return @errors; } - sub do_unhide_inactive_course { my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; + my $r = $self->r; + my $ce = $r->ce; - my $coursesDir = $ce->{webworkDirs}->{courses}; + my $coursesDir = $ce->{webworkDirs}->{courses}; my $unhide_courseID; - my @unhide_courseIDs = $r->param("hide_courseIDs"); - @unhide_courseIDs = () unless @unhide_courseIDs; + my @unhide_courseIDs = $r->param("hide_courseIDs"); + @unhide_courseIDs = () unless @unhide_courseIDs; - my @succeeded_courses = (); - my $succeeded_count = 0; - my @failed_courses = (); + my @succeeded_courses = (); + my $succeeded_count = 0; + my @failed_courses = (); my $already_visible_count = 0; - foreach $unhide_courseID (@unhide_courseIDs) { - my $hideDirFile = "$coursesDir/$unhide_courseID/hide_directory"; - unless (-f $hideDirFile) { - $already_visible_count++; - next; - } - remove_tree("$hideDirFile", {error => \my $err}); - if (@$err) { - push @failed_courses,$unhide_courseID; - } else { - push @succeeded_courses,$unhide_courseID; - $succeeded_count++; - } - } - my $succeeded_message = ''; - - if ($succeeded_count < 1 and $already_visible_count > 0) { - $succeeded_message = $r->maketext("Except for possible errors listed above, all selected courses are already unhidden."); + foreach $unhide_courseID (@unhide_courseIDs) { + my $hideDirFile = "$coursesDir/$unhide_courseID/hide_directory"; + unless (-f $hideDirFile) { + $already_visible_count++; + next; + } + remove_tree("$hideDirFile", { error => \my $err }); + if (@$err) { + push @failed_courses, $unhide_courseID; + } else { + push @succeeded_courses, $unhide_courseID; + $succeeded_count++; + } + } + my $succeeded_message = ''; + + if ($succeeded_count < 1 and $already_visible_count > 0) { + $succeeded_message = + $r->maketext("Except for possible errors listed above, all selected courses are already unhidden."); } if ($succeeded_count) { @@ -3923,198 +3982,220 @@ sub do_unhide_inactive_course { } } - sub upgrade_notification { - my $self = shift; - my $r = $self->r; - my $ce = $r->ce; - my $db = $r->db; - - # exit if notifications are disabled - return unless $ce->{enableGitUpgradeNotifier}; - - my $git = $ce->{externalPrograms}->{git}; - my $WeBWorKRemote = $ce->{gitWeBWorKRemoteName}; - my $WeBWorKBranch = $ce->{gitWeBWorKBranchName}; - my $PGRemote = $ce->{gitPGRemoteName}; - my $PGBranch = $ce->{gitPGBranchName}; - my $LibraryRemote = $ce->{gitLibraryRemoteName}; - my $LibraryBranch = $ce->{gitLibraryBranchName}; - - # we can tproceed unless we have git; - if (!(defined($git) && -x $git)) { - warn('External Program "git" not found. Check your site.conf'); - return; - } - - my $upgradeMessage = ''; - my $upgradesAvailable = 0; - my $output; - my @lines; - my $commit; - - if ($WeBWorKRemote && $WeBWorKBranch) { - # Check if there is an updated version of webwork available - # this is done by using ls-remote to get the commit sha at the - # head of the remote branch and looking to see if that sha is in - # the currently selected local branch - chdir($ce->{webwork_dir}); - my $currentBranch = `$git symbolic-ref --short HEAD`; - $output = `$git ls-remote --heads $WeBWorKRemote`; - @lines = split /\n/, $output; - $commit=-1; - - foreach my $line (@lines) { - if ($line =~ /refs\/heads\/$WeBWorKBranch$/) { - $line =~ /^(\w+)/; - $commit = $1; - last; - } + my $self = shift; + my $r = $self->r; + my $ce = $r->ce; + my $db = $r->db; + + # exit if notifications are disabled + return unless $ce->{enableGitUpgradeNotifier}; + + my $git = $ce->{externalPrograms}->{git}; + my $WeBWorKRemote = $ce->{gitWeBWorKRemoteName}; + my $WeBWorKBranch = $ce->{gitWeBWorKBranchName}; + my $PGRemote = $ce->{gitPGRemoteName}; + my $PGBranch = $ce->{gitPGBranchName}; + my $LibraryRemote = $ce->{gitLibraryRemoteName}; + my $LibraryBranch = $ce->{gitLibraryBranchName}; + + # we can tproceed unless we have git; + if (!(defined($git) && -x $git)) { + warn('External Program "git" not found. Check your site.conf'); + return; } - $output = `$git branch --contains $commit`; - - if ($commit ne '-1' && $output !~ /\s+$currentBranch(\s+|$)/) { - # There are upgrades, we need to figure out if its a - # new version or not - # This is done by using ls-remote to get the commit sha's - # at the heads of the remote tags. - # Tags of the form WeBWorK-x.y are release tags. If there is - # an sha there which isn't in the current branch then there must - # be a newer version. - - $output = `$git ls-remote --tags $WeBWorKRemote`; - @lines = split /\n/, $output; - my $newversion = 0; - - foreach my $line (@lines) { - next unless $line =~ /\/tags\/WeBWorK-/; - $line =~ /^(\w+)/; - $commit = $1; + my $upgradeMessage = ''; + my $upgradesAvailable = 0; + my $output; + my @lines; + my $commit; + + if ($WeBWorKRemote && $WeBWorKBranch) { + # Check if there is an updated version of webwork available + # this is done by using ls-remote to get the commit sha at the + # head of the remote branch and looking to see if that sha is in + # the currently selected local branch + chdir($ce->{webwork_dir}); + my $currentBranch = `$git symbolic-ref --short HEAD`; + $output = `$git ls-remote --heads $WeBWorKRemote`; + @lines = split /\n/, $output; + $commit = -1; + + foreach my $line (@lines) { + if ($line =~ /refs\/heads\/$WeBWorKBranch$/) { + $line =~ /^(\w+)/; + $commit = $1; + last; + } + } + $output = `$git branch --contains $commit`; - if ($output !~ /\s+$currentBranch(\s+|$)/) { - # There is a version tag which contains a commit that - # isn't in the current branch so there must - # be a new version - $newversion = 1; - last; + if ($commit ne '-1' && $output !~ /\s+$currentBranch(\s+|$)/) { + # There are upgrades, we need to figure out if its a + # new version or not + # This is done by using ls-remote to get the commit sha's + # at the heads of the remote tags. + # Tags of the form WeBWorK-x.y are release tags. If there is + # an sha there which isn't in the current branch then there must + # be a newer version. + + $output = `$git ls-remote --tags $WeBWorKRemote`; + @lines = split /\n/, $output; + my $newversion = 0; + + foreach my $line (@lines) { + next unless $line =~ /\/tags\/WeBWorK-/; + $line =~ /^(\w+)/; + $commit = $1; + $output = `$git branch --contains $commit`; + + if ($output !~ /\s+$currentBranch(\s+|$)/) { + # There is a version tag which contains a commit that + # isn't in the current branch so there must + # be a new version + $newversion = 1; + last; + } + } + + if ($newversion) { + $upgradesAvailable = 1; + $upgradeMessage .= CGI::Tr(CGI::td($r->maketext('There is a new version of WeBWorK available.'))); + } else { + $upgradesAvailable = 1; + $upgradeMessage .= CGI::Tr(CGI::td($r->maketext( + 'There are upgrades available for your current branch of WeBWorK from branch [_1] in remote [_2].', + $WeBWorKBranch, + $WeBWorKRemote + ))); + } + } elsif ($commit eq '-1') { + $upgradesAvailable = 1; + $upgradeMessage .= CGI::Tr(CGI::td($r->maketext( + "Couldn't find WeBWorK Branch [_1] in remote [_2]", $WeBWorKBranch, $WeBWorKRemote))); + } else { + $upgradeMessage .= CGI::Tr(CGI::td($r->maketext( + 'Your current branch of WeBWorK is up to date with branch [_1] in remote [_2].', $WeBWorKBranch, + $WeBWorKRemote + ))); } - } - - if ($newversion) { - $upgradesAvailable = 1; - $upgradeMessage .= CGI::Tr(CGI::td($r->maketext('There is a new version of WeBWorK available.'))); - } else { - $upgradesAvailable = 1; - $upgradeMessage .= CGI::Tr(CGI::td($r->maketext('There are upgrades available for your current branch of WeBWorK from branch [_1] in remote [_2].', $WeBWorKBranch, $WeBWorKRemote))); - } - } elsif ($commit eq '-1') { - $upgradesAvailable = 1; - $upgradeMessage .= CGI::Tr(CGI::td($r->maketext("Couldn't find WeBWorK Branch [_1] in remote [_2]", $WeBWorKBranch, $WeBWorKRemote))); - } else { - $upgradeMessage .= CGI::Tr(CGI::td($r->maketext('Your current branch of WeBWorK is up to date with branch [_1] in remote [_2].', $WeBWorKBranch, $WeBWorKRemote))); - } - } - - if ($PGRemote && $PGBranch) { - # Check if there is an updated version of pg available - # this is done by using ls-remote to get the commit sha at the - # head of the remote branch and looking to see if that sha is in - # the currently selected local branch - chdir($ce->{pg_dir}); - my $currentBranch = `$git symbolic-ref --short HEAD`; - $output = `$git ls-remote --heads $PGRemote`; - @lines = split /\n/, $output; - $commit='-1'; - - foreach my $line (@lines) { - if ($line =~ /refs\/heads\/$PGBranch$/) { - $line =~ /^(\w+)\s+/; - $commit = $1; - last; - } } - $output = `$git branch --contains $commit`; - - if ($commit ne '-1' && $output !~ /\s+$currentBranch(\s+|$)/) { - # There are upgrades, we need to figure out if its a - # new version or not - # This is done by using ls-remote to get the commit sha's - # at the heads of the remote tags. - # Tags of the form WeBWorK-x.y are release tags. If there is - # an sha there which isn't in the local branch then there must - # be a newer version. - $output = `$git ls-remote --tags $PGRemote`; - @lines = split /\n/, $output; - my $newversion = 0; - - foreach my $line (@lines) { - next unless $line =~ /\/tags\/PG-/; - $line =~ /^(\w+)/; - $commit = $1; - $output = `$git branch --contains $commit`; - if ($output !~ /\s+$currentBranch(\s+|$)/) { - # There is a version tag which contains a commit that - # isn't in the current branch so there must - # be a new version - $newversion = 1; - last; + if ($PGRemote && $PGBranch) { + # Check if there is an updated version of pg available + # this is done by using ls-remote to get the commit sha at the + # head of the remote branch and looking to see if that sha is in + # the currently selected local branch + chdir($ce->{pg_dir}); + my $currentBranch = `$git symbolic-ref --short HEAD`; + $output = `$git ls-remote --heads $PGRemote`; + @lines = split /\n/, $output; + $commit = '-1'; + + foreach my $line (@lines) { + if ($line =~ /refs\/heads\/$PGBranch$/) { + $line =~ /^(\w+)\s+/; + $commit = $1; + last; + } } - } - - if ($newversion) { - $upgradesAvailable = 1; - $upgradeMessage .= CGI::Tr(CGI::td($r->maketext('There is a new version of PG available.'))); - } else { - $upgradesAvailable = 1; - $upgradeMessage .= CGI::Tr(CGI::td($r->maketext('There are upgrades available for your current branch of PG from branch [_1] in remote [_2].', $PGBranch, $PGRemote))); - } - } elsif ($commit eq '-1') { - $upgradesAvailable = 1; - $upgradeMessage .= CGI::Tr(CGI::td($r->maketext("Couldn't find PG Branch [_1] in remote [_2]", $PGBranch, $PGRemote))); - } else { - $upgradeMessage .= CGI::Tr(CGI::td($r->maketext('Your current branch of PG is up to date with branch [_1] in remote [_2].', $PGBranch, $PGRemote))); - } - } - - die "Couldn't find ".$ce->{problemLibrary}{root}.'. Are you sure $problemLibrary{root} is set correctly in localOverrides.conf?' unless - chdir($ce->{problemLibrary}{root}); - - if ($LibraryRemote && $LibraryBranch) { - # Check if there is an updated version of the OPL available - # this is done by using ls-remote to get the commit sha at the - # head of the remote branch and looking to see if that sha is in - # the local current branch - my $currentBranch = `$git symbolic-ref --short HEAD`; - $output = `$git ls-remote --heads $LibraryRemote`; - @lines = split /\n/, $output; - $commit='-1'; - - foreach my $line (@lines) { - if ($line =~ /refs\/heads\/$LibraryBranch$/) { - $line =~ /^(\w+)\s+/; - $commit = $1; - last; - } + $output = `$git branch --contains $commit`; + + if ($commit ne '-1' && $output !~ /\s+$currentBranch(\s+|$)/) { + # There are upgrades, we need to figure out if its a + # new version or not + # This is done by using ls-remote to get the commit sha's + # at the heads of the remote tags. + # Tags of the form WeBWorK-x.y are release tags. If there is + # an sha there which isn't in the local branch then there must + # be a newer version. + $output = `$git ls-remote --tags $PGRemote`; + @lines = split /\n/, $output; + my $newversion = 0; + + foreach my $line (@lines) { + next unless $line =~ /\/tags\/PG-/; + $line =~ /^(\w+)/; + $commit = $1; + $output = `$git branch --contains $commit`; + if ($output !~ /\s+$currentBranch(\s+|$)/) { + # There is a version tag which contains a commit that + # isn't in the current branch so there must + # be a new version + $newversion = 1; + last; + } + } + + if ($newversion) { + $upgradesAvailable = 1; + $upgradeMessage .= CGI::Tr(CGI::td($r->maketext('There is a new version of PG available.'))); + } else { + $upgradesAvailable = 1; + $upgradeMessage .= CGI::Tr(CGI::td($r->maketext( + 'There are upgrades available for your current branch of PG from branch [_1] in remote [_2].', + $PGBranch, $PGRemote + ))); + } + } elsif ($commit eq '-1') { + $upgradesAvailable = 1; + $upgradeMessage .= + CGI::Tr(CGI::td($r->maketext("Couldn't find PG Branch [_1] in remote [_2]", $PGBranch, $PGRemote))); + } else { + $upgradeMessage .= CGI::Tr(CGI::td($r->maketext( + 'Your current branch of PG is up to date with branch [_1] in remote [_2].', + $PGBranch, $PGRemote + ))); + + } } - $output = `$git branch --contains $commit`; + die "Couldn't find " + . $ce->{problemLibrary}{root} + . '. Are you sure $problemLibrary{root} is set correctly in localOverrides.conf?' + unless chdir($ce->{problemLibrary}{root}); + + if ($LibraryRemote && $LibraryBranch) { + # Check if there is an updated version of the OPL available + # this is done by using ls-remote to get the commit sha at the + # head of the remote branch and looking to see if that sha is in + # the local current branch + my $currentBranch = `$git symbolic-ref --short HEAD`; + $output = `$git ls-remote --heads $LibraryRemote`; + @lines = split /\n/, $output; + $commit = '-1'; + + foreach my $line (@lines) { + if ($line =~ /refs\/heads\/$LibraryBranch$/) { + $line =~ /^(\w+)\s+/; + $commit = $1; + last; + } + } - if ($commit ne '-1' && $output !~ /\s+$currentBranch(\s+|$)/) { - $upgradesAvailable = 1; - $upgradeMessage .= CGI::Tr(CGI::td($r->maketext('There are upgrades available for the Open Problem Library.'))); - } elsif ($commit eq '-1') { - $upgradesAvailable = 1; - $upgradeMessage .= CGI::Tr(CGI::td($r->maketext("Couldn't find OPL Branch [_1] in remote [_2]", $LibraryBranch, $LibraryRemote))); - } else { - $upgradeMessage .= CGI::Tr(CGI::td($r->maketext('Your current branch of the Open Problem Library is up to date.', $LibraryBranch, $LibraryRemote))); + $output = `$git branch --contains $commit`; + + if ($commit ne '-1' && $output !~ /\s+$currentBranch(\s+|$)/) { + $upgradesAvailable = 1; + $upgradeMessage .= + CGI::Tr(CGI::td($r->maketext('There are upgrades available for the Open Problem Library.'))); + } elsif ($commit eq '-1') { + $upgradesAvailable = 1; + $upgradeMessage .= CGI::Tr( + CGI::td($r->maketext( + "Couldn't find OPL Branch [_1] in remote [_2]", $LibraryBranch, $LibraryRemote))); + } else { + $upgradeMessage .= CGI::Tr(CGI::td($r->maketext( + 'Your current branch of the Open Problem Library is up to date.', + $LibraryBranch, $LibraryRemote + ))); + } } - } - chdir($ce->{webwork_dir}); + chdir($ce->{webwork_dir}); if ($upgradesAvailable) { $upgradeMessage = @@ -4132,7 +4213,6 @@ sub upgrade_notification { # registration forms added by Mike Gage 5-5-2008 ################################################################################ - our $registered_file_name = "registered_???"; sub display_registration_form { @@ -4247,22 +4327,28 @@ sub registration_form { } sub do_registration { - my $self = shift; - my $ce = $self->r->ce; - my $registered_file_path = $ce->{courseDirs}->{root}."/$registered_file_name"; + my $self = shift; + my $ce = $self->r->ce; + my $registered_file_path = $ce->{courseDirs}->{root} . "/$registered_file_name"; # warn qq!`echo "info" >$registered_file_path`!; `echo "info" >$registered_file_path`; - print "\n
      ",CGI::p({style=>"text-align: left; width:60%"},q{Registration banner has been hidden. We appreciate your registering your server with the WeBWorK Project!"}); + print "\n
      ", + CGI::p( + { style => "text-align: left; width:60%" }, + q{Registration banner has been hidden. We appreciate your registering your server with the WeBWorK Project!"} + ); - print CGI::start_form(-method=>"POST", -action=>$self->r->uri); + print CGI::start_form(-method => "POST", -action => $self->r->uri); print $self->hidden_authen_fields; - print CGI::p({ style => "text-align: center" }, + print CGI::p( + { style => "text-align: center" }, CGI::submit({ - name => "registration_completed", - label => "Continue", - class => 'btn btn-primary' - })); + name => "registration_completed", + label => "Continue", + class => 'btn btn-primary' + }) + ); print CGI::end_form(); print "
      "; @@ -4297,7 +4383,7 @@ sub formatReportOnDatabaseTables { my $extra_database_tables = 0; my $extra_database_fields = 0; - my $str = CGI::start_ul(); + my $str = CGI::start_ul(); for my $table (sort keys %$dbStatus) { my $table_status = $dbStatus->{$table}[0]; $str .= CGI::start_li(); diff --git a/lib/WeBWorK/ContentGenerator/EquationDisplay.pm b/lib/WeBWorK/ContentGenerator/EquationDisplay.pm index f457d047af..28180e27ae 100644 --- a/lib/WeBWorK/ContentGenerator/EquationDisplay.pm +++ b/lib/WeBWorK/ContentGenerator/EquationDisplay.pm @@ -31,7 +31,7 @@ use WeBWorK::PG::ImageGenerator; sub display_equation { my ($self, $str) = @_; - + my $imageTag = $self->{image_gen}->add($str, 'inline'); $self->{image_gen}->render(); return $imageTag; @@ -43,27 +43,27 @@ sub display_equation { sub initialize { my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; - + my $r = $self->r; + my $ce = $r->ce; + $self->{image_gen} = WeBWorK::PG::ImageGenerator->new( - tempDir => $ce->{webworkDirs}->{tmp}, # global temp dir - latex => $ce->{externalPrograms}->{latex}, + tempDir => $ce->{webworkDirs}->{tmp}, # global temp dir + latex => $ce->{externalPrograms}->{latex}, dvipng => $ce->{externalPrograms}->{dvipng}, useCache => 1, cacheDir => $ce->{webworkDirs}->{equationCache}, cacheURL => $ce->{webworkURLs}->{equationCache}, cacheDB => $ce->{webworkFiles}->{equationCacheDB}, ); - + my $equationStr = $r->param('eq'); - $self->{equationStr} = $equationStr if defined $equationStr; + $self->{equationStr} = $equationStr if defined $equationStr; $self->{typesetStr} = $self->display_equation($equationStr) if $equationStr; } #sub path { # my ($self, $args) = @_; -# +# # my $ce = $self->{ce}; # my $root = $ce->{webworkURLs}->{root}; # my $courseName = $ce->{courseName}; @@ -81,13 +81,13 @@ sub initialize { sub body { my ($self) = @_; my $r = $self->r; - + ####################################### # Initial data for the textarea field where the equation is entered ####################################### my $initial_str = "Enter equation here"; $initial_str = $r->param('eq') if $self->{equationStr}; - + ####################################### # Prepare to display the typeset image and # the HTML code that links to the source image. @@ -96,34 +96,34 @@ sub body { # by display_equation and ImageGenerator. # The server name and port are included in the new url. ####################################### - my $typesetStr = (defined $self->{typesetStr})?$self->{typesetStr}:''; - + my $typesetStr = (defined $self->{typesetStr}) ? $self->{typesetStr} : ''; + #### add the host name to the string my $hostName = $r->hostname; my $port = $r->get_server_port; - $hostName .= ":$port"; + $hostName .= ":$port"; $typesetStr =~ s|src="|src="http://$hostName|; - + my $typeset2Str = $typesetStr; $typeset2Str =~ s//>/g; - + my $sourceHref = $typesetStr; $sourceHref =~ /"([^"]*)"/; $sourceHref = $1; - + ####################################### # Print the page ####################################### - return join( "", + return join("", "Copy the location of this image (or drag and drop) into your editing area:", CGI::br(), $typeset2Str, CGI::br(), $typesetStr, - CGI::start_form(-method=>'POST', -action=>$r->uri), + CGI::start_form(-method => 'POST', -action => $r->uri), $self->hidden_authen_fields, - CGI::textarea( "eq", $initial_str, 5, 40), + CGI::textarea("eq", $initial_str, 5, 40), CGI::submit('typeset', 'typeset'), CGI::end_form(), ); diff --git a/lib/WeBWorK/ContentGenerator/Feedback.pm b/lib/WeBWorK/ContentGenerator/Feedback.pm index 0eb19743d6..598d618145 100644 --- a/lib/WeBWorK/ContentGenerator/Feedback.pm +++ b/lib/WeBWorK/ContentGenerator/Feedback.pm @@ -36,7 +36,7 @@ use Email::Stuffer; use Try::Tiny; use WeBWorK::Upload; -use Socket qw/unpack_sockaddr_in inet_ntoa/; # for remote host/port info +use Socket qw/unpack_sockaddr_in inet_ntoa/; # for remote host/port info use Text::Wrap qw(wrap); use WeBWorK::Utils qw/ decodeAnswers/; @@ -65,10 +65,10 @@ use WeBWorK::Utils qw/ decodeAnswers/; sub body { my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; - my $db = $r->db; - my $authz = $r->authz; + my $r = $self->r; + my $ce = $r->ce; + my $db = $r->db; + my $authz = $r->authz; # get form fields my $key = $r->param("key"); @@ -86,17 +86,17 @@ sub body { my $courseID = $r->urlpath->arg("courseID"); my ($user, $set, $problem); - $user = $db->getUser($userName) # checked + $user = $db->getUser($userName) # checked if defined $userName and $userName ne ""; if (defined $user) { - $set = $db->getMergedSet($userName, $setName) # checked + $set = $db->getMergedSet($userName, $setName) # checked if defined $setName and $setName ne ""; - $problem = $db->getMergedProblem($userName, $setName, $problemNumber) # checked + $problem = $db->getMergedProblem($userName, $setName, $problemNumber) # checked if defined $set and defined $problemNumber && $problemNumber ne ""; } else { - $set = $db->getGlobalSet($setName) # checked + $set = $db->getGlobalSet($setName) # checked if defined $setName and $setName ne ""; - $problem = $db->getGlobalProblem($setName, $problemNumber) # checked + $problem = $db->getGlobalProblem($setName, $problemNumber) # checked if defined $set and defined $problemNumber && $problemNumber ne ""; } @@ -104,7 +104,7 @@ sub body { my ($emailableURL, $returnURL) = $self->generateURLs(set_id => $setName, problem_id => $problemNumber); my $homeModulePath = $r->urlpath->newFromModule("WeBWorK::ContentGenerator::Home", $r); - my $systemURL = $self->systemLink($homeModulePath, authen=>0, use_abs_url=>1); + my $systemURL = $self->systemLink($homeModulePath, authen => 0, use_abs_url => 1); unless ($authz->hasPermissions($userName, "submit_feedback")) { $self->feedbackNotAllowed($returnURL); @@ -141,13 +141,11 @@ sub body { # sanity checks unless ($sender) { - $self->feedbackForm($user, $returnURL, - "No Sender specified."); + $self->feedbackForm($user, $returnURL, "No Sender specified."); return ""; } unless ($feedback) { - $self->feedbackForm($user, $returnURL, - "Message was blank."); + $self->feedbackForm($user, $returnURL, "Message was blank."); return ""; } @@ -160,9 +158,9 @@ sub body { 'r' => $user ? $user->recitation : undef, '%' => '%', ); - my $chars = join("", keys %subject_map); + my $chars = join("", keys %subject_map); my $subject = $ce->{mail}{feedbackSubjectFormat} - || "WeBWorK question from %c: %u set %s/prob %p"; # default if not entered + || "WeBWorK question from %c: %u set %s/prob %p"; # default if not entered $subject =~ s/%([$chars])/defined $subject_map{$1} ? $subject_map{$1} : ""/eg; # If in the future any fields in the subject can contain non-ASCII characters @@ -173,7 +171,7 @@ sub body { # get info about remote user (stolen from &WeBWorK::Authen::write_log_entry) my ($remote_host, $remote_port); - $remote_host = $r->useragent_addr->ip_get || "UNKNOWN"; + $remote_host = $r->useragent_addr->ip_get || "UNKNOWN"; $remote_port = $r->connection->client_addr->port || "UNKNOWN"; my $msg = qq/This message was automatically generated by the WeBWorK @@ -184,38 +182,41 @@ $emailableURL /; - if ($feedback){ + if ($feedback) { $msg .= qq/***** The feedback message: *****\n\n\n$feedback\n\n\n/; } - if($problem and $verbosity >=1){ - $msg .= qq/***** Data about the problem processor: ***** \n\n/ - . "Display Mode: $displayMode\n" - . "Show Old Answers: ". ($showOldAnswers ? "yes" : "no") . "\n" - . " Show Correct Answers: " . ($showCorrectAnswers ? "yes" : "no") . "\n" - . " Show Hints: " . ($showHints ? "yes" : "no") . "\n" - . " Show Solutions: " . ($showSolutions ? "yes" : "no") . "\n\n"; + if ($problem and $verbosity >= 1) { + $msg .= + qq/***** Data about the problem processor: ***** \n\n/ + . "Display Mode: $displayMode\n" + . "Show Old Answers: " + . ($showOldAnswers ? "yes" : "no") . "\n" + . " Show Correct Answers: " + . ($showCorrectAnswers ? "yes" : "no") . "\n" + . " Show Hints: " + . ($showHints ? "yes" : "no") . "\n" + . " Show Solutions: " + . ($showSolutions ? "yes" : "no") . "\n\n"; } if ($user and $verbosity >= 1) { $msg .= "***** Data about the user: *****\n\n"; - $msg .= $self->format_user($user). "\n"; + $msg .= $self->format_user($user) . "\n"; } if ($problem and $verbosity >= 1) { $msg .= "***** Data about the problem: *****\n\n"; - $msg .= $self->format_userproblem($problem). "\n"; + $msg .= $self->format_userproblem($problem) . "\n"; } if ($set and $verbosity >= 1) { - $msg .= "***** Data about the homework set: *****\n\n" - . $self->format_userset($set). "\n"; + $msg .= "***** Data about the homework set: *****\n\n" . $self->format_userset($set) . "\n"; } if ($ce and $verbosity >= 2) { - $msg .= "***** Data about the environment: *****\n\n", - $msg .= Dumper($ce). "\n\n"; + $msg .= "***** Data about the environment: *****\n\n", $msg .= Dumper($ce) . "\n\n"; } - my $email = Email::Stuffer->to(join(',', @recipients))->from($sender)->subject($subject) - ->text_body($msg)->header('X-Remote-Host' => $remote_host); + my $email = Email::Stuffer->to(join(',', @recipients))->from($sender)->subject($subject)->text_body($msg) + ->header('X-Remote-Host' => $remote_host); # Extra headers $email->header('X-WeBWorK-Module', $module) if defined $module; @@ -269,13 +270,13 @@ $emailableURL $email->attach($contents, filename => $filename); } - # $ce->{mail}{set_return_path} is the address used to report returned email if defined and non empty. - # It is an argument used in sendmail() (aka Email::Stuffer::send_or_die). - # For arcane historical reasons sendmail actually sets the field "MAIL FROM" and the smtp server then - # uses that to set "Return-Path". - # references: - # https://stackoverflow.com/questions/1235534/what-is-the-behavior-difference-between-return-path-reply-to-and-from - # https://metacpan.org/pod/Email::Sender::Manual::QuickStart#envelope-information + # $ce->{mail}{set_return_path} is the address used to report returned email if defined and non empty. + # It is an argument used in sendmail() (aka Email::Stuffer::send_or_die). + # For arcane historical reasons sendmail actually sets the field "MAIL FROM" and the smtp server then + # uses that to set "Return-Path". + # references: + # https://stackoverflow.com/questions/1235534/what-is-the-behavior-difference-between-return-path-reply-to-and-from + # https://metacpan.org/pod/Email::Sender::Manual::QuickStart#envelope-information try { $email->send_or_die({ # createEmailSenderTransportSMTP is defined in ContentGenerator @@ -300,15 +301,16 @@ sub feedbackNotAllowed { my ($self, $returnURL) = @_; print CGI::p("You are not allowed to send e-mail."); - print CGI::p(CGI::a({-href=>$returnURL}, "Cancel E-Mail")) if $returnURL; + print CGI::p(CGI::a({ -href => $returnURL }, "Cancel E-Mail")) if $returnURL; } sub noRecipientsAvailable { my ($self, $returnURL) = @_; print CGI::p("No e-mail recipients are listed for this course."); - print CGI::p(CGI::a({-href=>$returnURL}, "Cancel E-Mail")) if $returnURL; + print CGI::p(CGI::a({ -href => $returnURL }, "Cancel E-Mail")) if $returnURL; } + sub title { my ($self, $user, $returnURL, $message) = @_; my $r = $self->r; @@ -369,7 +371,9 @@ sub feedbackForm { # Attachment print CGI::div( { class => 'row mb-3' }, - CGI::label({ for => 'attachment', class => 'col-form-label col-auto' }, CGI::b($r->maketext('Attachment:'))), + CGI::label( + { for => 'attachment', class => 'col-form-label col-auto' }, CGI::b($r->maketext('Attachment:')) + ), CGI::div( { class => 'col-auto' }, CGI::filefield({ @@ -390,8 +394,8 @@ sub feedbackForm { sub getFeedbackRecipients { my ($self, $user) = @_; - my $ce = $self->r->ce; - my $db = $self->r->db; + my $ce = $self->r->ce; + my $db = $self->r->db; my $authz = $self->r->authz; my @recipients; @@ -399,9 +403,12 @@ sub getFeedbackRecipients { # send to all users with permission to receive_feedback and an email address foreach my $rcptName ($db->listUsers()) { if ($authz->hasPermissions($rcptName, "receive_feedback")) { - my $rcpt = $db->getUser($rcptName); # checked - next if $ce->{feedback_by_section} and defined $user - and defined $rcpt->section and defined $user->section + my $rcpt = $db->getUser($rcptName); # checked + next + if $ce->{feedback_by_section} + and defined $user + and defined $rcpt->section + and defined $user->section and $rcpt->section ne $user->section; if ($rcpt and $rcpt->email_address) { push @recipients, $rcpt->rfc822_mailbox; @@ -410,7 +417,7 @@ sub getFeedbackRecipients { } if (defined $ce->{mail}->{feedbackRecipients}) { - push @recipients, @{$ce->{mail}->{feedbackRecipients}}; + push @recipients, @{ $ce->{mail}->{feedbackRecipients} }; } return @recipients; @@ -423,12 +430,13 @@ sub format_user { my $result = "User ID: " . $User->user_id . "\n"; $result .= "Name: " . $User->full_name . "\n"; $result .= "Email: " . $User->email_address . "\n"; - unless( $ce->{blockStudentIDinFeedback} ) { + unless ($ce->{blockStudentIDinFeedback}) { $result .= "Student ID: " . $User->student_id . "\n"; } my $status_name = $ce->status_abbrev_to_name($User->status); - my $status_string = defined $status_name + my $status_string = + defined $status_name ? "$status_name ('" . $User->status . "')" : $User->status . " (unknown status abbreviation)"; $result .= "Status: $status_string\n"; @@ -449,8 +457,8 @@ sub format_userset { $result .= "Hardcopy header file: " . $Set->hardcopy_header . "\n"; my $tz = $ce->{siteDefaults}{timezone}; - $result .= "Open date: " . $self->formatDateTime($Set->open_date, $tz). "\n"; - $result .= "Due date: " . $self->formatDateTime($Set->due_date, $tz). "\n"; + $result .= "Open date: " . $self->formatDateTime($Set->open_date, $tz) . "\n"; + $result .= "Due date: " . $self->formatDateTime($Set->due_date, $tz) . "\n"; $result .= "Answer date: " . $self->formatDateTime($Set->answer_date, $tz) . "\n"; $result .= "Visible: " . ($Set->visible ? "yes" : "no") . "\n"; $result .= "Assignment type: " . $Set->assignment_type . "\n"; @@ -474,7 +482,8 @@ sub format_userproblem { my $result = "Problem ID: " . $Problem->problem_id . "\n"; $result .= "Source file: " . $Problem->source_file . "\n"; $result .= "Value: " . $Problem->value . "\n"; - $result .= "Max attempts " . ($Problem->max_attempts == -1 ? "unlimited" : $Problem->max_attempts) . "\n"; + $result .= + "Max attempts " . ($Problem->max_attempts == -1 ? "unlimited" : $Problem->max_attempts) . "\n"; $result .= "Random seed: " . $Problem->problem_seed . "\n"; $result .= "Status: " . $Problem->status . "\n"; $result .= "Attempted: " . ($Problem->attempted ? "yes" : "no") . "\n"; diff --git a/lib/WeBWorK/ContentGenerator/GatewayQuiz.pm b/lib/WeBWorK/ContentGenerator/GatewayQuiz.pm index 070548acef..b42949c25a 100644 --- a/lib/WeBWorK/ContentGenerator/GatewayQuiz.pm +++ b/lib/WeBWorK/ContentGenerator/GatewayQuiz.pm @@ -70,26 +70,27 @@ sub can_showOldAnswers { my $authz = $self->r->authz; # we'd like to use "! $Set->hide_work()", but that hides students' work # as they're working on the set, which isn't quite right. so use instead: - return 0 unless $authz->hasPermissions($User->user_id,"can_show_old_answers"); + return 0 unless $authz->hasPermissions($User->user_id, "can_show_old_answers"); - return (before($Set->due_date()) || - $authz->hasPermissions($User->user_id,"view_hidden_work") || - ($Set->hide_work() eq 'N' || - ($Set->hide_work() eq 'BeforeAnswerDate' && time > $tmplSet->answer_date))); + return ( + before($Set->due_date()) + || $authz->hasPermissions($User->user_id, "view_hidden_work") + || ($Set->hide_work() eq 'N' + || ($Set->hide_work() eq 'BeforeAnswerDate' && time > $tmplSet->answer_date)) + ); } # gateway change here: add $submitAnswers as an optional additional argument # to be included if it's defined sub can_showCorrectAnswers { - my ($self, $User, $PermissionLevel, $EffectiveUser, $Set, $Problem, - $tmplSet, $submitAnswers) = @_; + my ($self, $User, $PermissionLevel, $EffectiveUser, $Set, $Problem, $tmplSet, $submitAnswers) = @_; my $authz = $self->r->authz; # gateway change here to allow correct answers to be viewed after all attempts # at a version are exhausted as well as if it's after the answer date # $addOne allows us to count the current submission - my $addOne = defined($submitAnswers) ? $submitAnswers : 0; - my $maxAttempts = $Set->attempts_per_version() || 0; + my $addOne = defined($submitAnswers) ? $submitAnswers : 0; + my $maxAttempts = $Set->attempts_per_version() || 0; my $attemptsUsed = $Problem->num_correct + $Problem->num_incorrect + $addOne || 0; # this is complicated by trying to address hiding scores by problem---that @@ -103,24 +104,31 @@ sub can_showCorrectAnswers { # so we should hide the correct answers if we aren not showing # scores GG. - my $canShowScores = $Set->hide_score_by_problem eq 'N' && - ($Set->hide_score eq 'N' || - ($Set->hide_score eq 'BeforeAnswerDate' && after($tmplSet->answer_date))); + my $canShowScores = $Set->hide_score_by_problem eq 'N' + && ($Set->hide_score eq 'N' + || ($Set->hide_score eq 'BeforeAnswerDate' && after($tmplSet->answer_date))); - return (((after($Set->answer_date) || - ($attemptsUsed >= $maxAttempts && $maxAttempts != 0 && - $Set->due_date() == $Set->answer_date())) || - $authz->hasPermissions($User->user_id, "show_correct_answers_before_answer_date")) && - ($authz->hasPermissions($User->user_id, "view_hidden_work") || $canShowScores)); + return ( + ( + ( + after($Set->answer_date) || ($attemptsUsed >= $maxAttempts + && $maxAttempts != 0 + && $Set->due_date() == $Set->answer_date()) + ) + || $authz->hasPermissions($User->user_id, "show_correct_answers_before_answer_date") + ) + && ($authz->hasPermissions($User->user_id, "view_hidden_work") || $canShowScores) + ); } sub can_showProblemGrader { my ($self, $User, $PermissionLevel, $EffectiveUser, $Set, $Problem) = @_; my $authz = $self->r->authz; - return ($authz->hasPermissions($User->user_id, "access_instructor_tools") && - $authz->hasPermissions($User->user_id, "score_sets") && - $Set->set_id ne "Undefined_Set" && !$self->{invalidSet}); + return ($authz->hasPermissions($User->user_id, "access_instructor_tools") + && $authz->hasPermissions($User->user_id, "score_sets") + && $Set->set_id ne "Undefined_Set" + && !$self->{invalidSet}); } sub can_showHints { @@ -131,8 +139,7 @@ sub can_showHints { # gateway change here: add $submitAnswers as an optional additional argument # to be included if it's defined sub can_showSolutions { - my ($self, $User, $PermissionLevel, $EffectiveUser, $Set, $Problem, - $tmplSet, $submitAnswers) = @_; + my ($self, $User, $PermissionLevel, $EffectiveUser, $Set, $Problem, $tmplSet, $submitAnswers) = @_; my $authz = $self->r->authz; return 1 if $authz->hasPermissions($User->user_id, 'always_show_solution'); @@ -141,9 +148,9 @@ sub can_showSolutions { # gateway change here to allow correct answers to be viewed after all attempts # at a version are exhausted as well as if it's after the answer date # $addOne allows us to count the current submission - my $addOne = defined($submitAnswers) ? $submitAnswers : 0; - my $attempts_per_version = $Set->attempts_per_version() || 0; - my $attemptsUsed = $Problem->num_correct+$Problem->num_incorrect+$addOne || 0; + my $addOne = defined($submitAnswers) ? $submitAnswers : 0; + my $attempts_per_version = $Set->attempts_per_version() || 0; + my $attemptsUsed = $Problem->num_correct + $Problem->num_incorrect + $addOne || 0; # this is complicated by trying to address hiding scores by problem---that # is, if $set->hide_score_by_problem and $set->hide_score are both set, @@ -155,16 +162,21 @@ sub can_showSolutions { # so we should hide the correct answers if we aren not showing # scores GG. - my $canShowScores = $Set->hide_score_by_problem eq 'N' && - ($Set->hide_score eq 'N' || - ($Set->hide_score eq 'BeforeAnswerDate' && after($tmplSet->answer_date))); + my $canShowScores = $Set->hide_score_by_problem eq 'N' + && ($Set->hide_score eq 'N' + || ($Set->hide_score eq 'BeforeAnswerDate' && after($tmplSet->answer_date))); - return (((after($Set->answer_date) || - ($attemptsUsed >= $attempts_per_version && - $attempts_per_version != 0 && - $Set->due_date() == $Set->answer_date())) || - $authz->hasPermissions($User->user_id, "show_correct_answers_before_answer_date")) && - ($authz->hasPermissions($User->user_id, "view_hidden_work") || $canShowScores)); + return ( + ( + ( + after($Set->answer_date) || ($attemptsUsed >= $attempts_per_version + && $attempts_per_version != 0 + && $Set->due_date() == $Set->answer_date()) + ) + || $authz->hasPermissions($User->user_id, "show_correct_answers_before_answer_date") + ) + && ($authz->hasPermissions($User->user_id, "view_hidden_work") || $canShowScores) + ); } # gateway change here: add $submitAnswers as an optional additional argument @@ -174,8 +186,7 @@ sub can_showSolutions { # decide if we can record the answers. this deals with the time between the # submission time and the proctor authorization. sub can_recordAnswers { - my ($self, $User, $PermissionLevel, $EffectiveUser, $Set, $Problem, - $tmplSet, $submitAnswers) = @_; + my ($self, $User, $PermissionLevel, $EffectiveUser, $Set, $Problem, $tmplSet, $submitAnswers) = @_; my $authz = $self->r->authz; # easy first case: never record answers for undefined sets @@ -185,13 +196,15 @@ sub can_recordAnswers { # get the sag time after the due date in which we'll still grade the test my $grace = $self->{ce}->{gatewayGracePeriod}; - my $submitTime = ($Set->assignment_type eq 'proctored_gateway' && - defined($Set->version_last_attempt_time()) && $Set->version_last_attempt_time()) - ? $Set->version_last_attempt_time() : $timeNow; + my $submitTime = + ($Set->assignment_type eq 'proctored_gateway' + && defined($Set->version_last_attempt_time()) + && $Set->version_last_attempt_time()) ? $Set->version_last_attempt_time() : $timeNow; if ($User->user_id ne $EffectiveUser->user_id) { my $recordAsOther = $authz->hasPermissions($User->user_id, "record_answers_when_acting_as_student"); - my $recordVersionsAsOther = $authz->hasPermissions($User->user_id, "record_set_version_answers_when_acting_as_student"); + my $recordVersionsAsOther = + $authz->hasPermissions($User->user_id, "record_set_version_answers_when_acting_as_student"); if ($recordAsOther) { return $recordAsOther; @@ -214,9 +227,9 @@ sub can_recordAnswers { # gateway change here; we look at maximum attempts per version, not for the set, # to determine the number of attempts allowed # $addOne allows us to count the current submission - my $addOne = (defined($submitAnswers) && $submitAnswers) ? 1 : 0; + my $addOne = (defined($submitAnswers) && $submitAnswers) ? 1 : 0; my $attempts_per_version = $Set->attempts_per_version() || 0; - my $attempts_used = $Problem->num_correct+$Problem->num_incorrect+$addOne; + my $attempts_used = $Problem->num_correct + $Problem->num_incorrect + $addOne; if ($attempts_per_version == 0 or $attempts_used < $attempts_per_version) { return $authz->hasPermissions($User->user_id, "record_answers_after_open_date_with_attempts"); } else { @@ -236,15 +249,14 @@ sub can_recordAnswers { # decide if we can check the answers. this deals with the time between the # submission time and the proctor authorization. sub can_checkAnswers { - my ($self, $User, $PermissionLevel, $EffectiveUser, $Set, $Problem, - $tmplSet, $submitAnswers) = @_; + my ($self, $User, $PermissionLevel, $EffectiveUser, $Set, $Problem, $tmplSet, $submitAnswers) = @_; my $authz = $self->r->authz; # if we can record answers then we dont need to be able to check them # unless we have that specific permission. - if ($self->can_recordAnswers($User, $PermissionLevel, $EffectiveUser, - $Set, $Problem, $tmplSet, $submitAnswers) - && !$authz->hasPermissions($User->user_id, "can_check_and_submit_answers")) { + if ($self->can_recordAnswers($User, $PermissionLevel, $EffectiveUser, $Set, $Problem, $tmplSet, $submitAnswers) + && !$authz->hasPermissions($User->user_id, "can_check_and_submit_answers")) + { return 0; } @@ -252,9 +264,10 @@ sub can_checkAnswers { # get the sag time after the due date in which we'll still grade the test my $grace = $self->{ce}->{gatewayGracePeriod}; - my $submitTime = ($Set->assignment_type eq 'proctored_gateway' && - defined($Set->version_last_attempt_time()) && $Set->version_last_attempt_time()) - ? $Set->version_last_attempt_time() : $timeNow; + my $submitTime = + ($Set->assignment_type eq 'proctored_gateway' + && defined($Set->version_last_attempt_time()) + && $Set->version_last_attempt_time()) ? $Set->version_last_attempt_time() : $timeNow; # this is further complicated by trying to address hiding scores by # problem---that is, if $set->hide_score_by_problem and @@ -266,8 +279,9 @@ sub can_checkAnswers { # so we should hide the correct answers if we aren not showing # scores GG. - my $canShowScores = $Set->hide_score_by_problem eq 'N' && ($Set->hide_score eq 'N' || - ($Set->hide_score eq 'BeforeAnswerDate' && after($tmplSet->answer_date))); + my $canShowScores = $Set->hide_score_by_problem eq 'N' + && ($Set->hide_score eq 'N' + || ($Set->hide_score eq 'BeforeAnswerDate' && after($tmplSet->answer_date))); if (before($Set->open_date, $submitTime)) { return $authz->hasPermissions($User->user_id, "check_answers_before_open_date"); @@ -276,62 +290,70 @@ sub can_checkAnswers { # gateway change here; we look at maximum attempts per version, not for the set, # to determine the number of attempts allowed # $addOne allows us to count the current submission - my $addOne = (defined($submitAnswers) && $submitAnswers) ? 1 : 0; + my $addOne = (defined($submitAnswers) && $submitAnswers) ? 1 : 0; my $attempts_per_version = $Set->attempts_per_version() || 0; - my $attempts_used = $Problem->num_correct + $Problem->num_incorrect + $addOne; + my $attempts_used = $Problem->num_correct + $Problem->num_incorrect + $addOne; if ($attempts_per_version == -1 or $attempts_used < $attempts_per_version) { - return ($authz->hasPermissions($User->user_id, "check_answers_after_open_date_with_attempts") && - ($authz->hasPermissions($User->user_id, "view_hidden_work") || - $canShowScores)); + return ( + $authz->hasPermissions($User->user_id, "check_answers_after_open_date_with_attempts") + && ($authz->hasPermissions($User->user_id, "view_hidden_work") + || $canShowScores) + ); } else { - return ($authz->hasPermissions($User->user_id, "check_answers_after_open_date_without_attempts") && - ($authz->hasPermissions($User->user_id, "view_hidden_work") || - $canShowScores)); + return ( + $authz->hasPermissions($User->user_id, "check_answers_after_open_date_without_attempts") + && ($authz->hasPermissions($User->user_id, "view_hidden_work") + || $canShowScores) + ); } } elsif (between(($Set->due_date + $grace), $Set->answer_date, $submitTime)) { - return ($authz->hasPermissions($User->user_id, "check_answers_after_due_date") && - ($authz->hasPermissions($User->user_id, "view_hidden_work") || - $canShowScores)); + return ( + $authz->hasPermissions($User->user_id, "check_answers_after_due_date") + && ($authz->hasPermissions($User->user_id, "view_hidden_work") + || $canShowScores) + ); } elsif (after($Set->answer_date, $submitTime)) { - return ($authz->hasPermissions($User->user_id, "check_answers_after_answer_date") && - ($authz->hasPermissions($User->user_id, "view_hidden_work") || - $canShowScores)); + return ( + $authz->hasPermissions($User->user_id, "check_answers_after_answer_date") + && ($authz->hasPermissions($User->user_id, "view_hidden_work") + || $canShowScores) + ); } } sub can_showScore { - my ($self, $User, $PermissionLevel, $EffectiveUser, $Set, $Problem, - $tmplSet, $submitAnswers) = @_; + my ($self, $User, $PermissionLevel, $EffectiveUser, $Set, $Problem, $tmplSet, $submitAnswers) = @_; my $authz = $self->r->authz; my $timeNow = defined($self->{timeNow}) ? $self->{timeNow} : time(); # address hiding scores by problem - my $canShowScores = ($Set->hide_score eq 'N' || - ($Set->hide_score eq 'BeforeAnswerDate' && - after($tmplSet->answer_date))); + my $canShowScores = ( + $Set->hide_score eq 'N' || ($Set->hide_score eq 'BeforeAnswerDate' + && after($tmplSet->answer_date)) + ); - return ($authz->hasPermissions($User->user_id,"view_hidden_work") || $canShowScores); + return ($authz->hasPermissions($User->user_id, "view_hidden_work") || $canShowScores); } sub can_useMathView { my ($self, $User, $EffectiveUser, $Set, $Problem, $submitAnswers) = @_; - my $ce= $self->r->ce; + my $ce = $self->r->ce; return $ce->{pg}->{specialPGEnvironmentVars}->{entryAssist} eq 'MathView'; } sub can_useWirisEditor { my ($self, $User, $EffectiveUser, $Set, $Problem, $submitAnswers) = @_; - my $ce= $self->r->ce; + my $ce = $self->r->ce; return $ce->{pg}->{specialPGEnvironmentVars}->{entryAssist} eq 'WIRIS'; } sub can_useMathQuill { my ($self, $User, $EffectiveUser, $Set, $Problem, $submitAnswers) = @_; - my $ce= $self->r->ce; + my $ce = $self->r->ce; return $ce->{pg}->{specialPGEnvironmentVars}->{entryAssist} eq 'MathQuill'; } @@ -341,17 +363,17 @@ sub can_useMathQuill { ################################################################################ sub attemptResults { - my $self = shift; - my $pg = shift; + my $self = shift; + my $pg = shift; my $showAttemptAnswers = shift; my $showCorrectAnswers = shift; my $showAttemptResults = $showAttemptAnswers && shift; - my $showSummary = shift; + my $showSummary = shift; my $showAttemptPreview = shift || 0; - my $ce = $self->{ce}; + my $ce = $self->{ce}; # to make grabbing these options easier, we'll pull them out now... - my %imagesModeOptions = %{$ce->{pg}{displayModeOptions}{images}}; + my %imagesModeOptions = %{ $ce->{pg}{displayModeOptions}{images} }; my $imgGen = WeBWorK::PG::ImageGenerator->new( tempDir => $ce->{webworkDirs}{tmp}, @@ -371,20 +393,20 @@ sub attemptResults { # Create AttemptsTable object my $tbl = WeBWorK::Utils::AttemptsTable->new( $pg->{answers}, - answersSubmitted => 1, - answerOrder => $pg->{flags}{ANSWER_ENTRY_ORDER}, - displayMode => $self->{displayMode}, - showHeadline => 0, - showAnswerNumbers => 0, - showAttemptAnswers => $showAttemptAnswers && $showEvaluatedAnswers, - showAttemptPreviews => $showAttemptPreview, - showAttemptResults => $showAttemptResults, - showCorrectAnswers => $showCorrectAnswers, - showMessages => $showAttemptAnswers, # internally checks for messages - showSummary => $showSummary, - imgGen => $imgGen, # not needed if ce is present , - ce => '', # not needed if $imgGen is present - maketext => WeBWorK::Localize::getLoc($ce->{language}), + answersSubmitted => 1, + answerOrder => $pg->{flags}{ANSWER_ENTRY_ORDER}, + displayMode => $self->{displayMode}, + showHeadline => 0, + showAnswerNumbers => 0, + showAttemptAnswers => $showAttemptAnswers && $showEvaluatedAnswers, + showAttemptPreviews => $showAttemptPreview, + showAttemptResults => $showAttemptResults, + showCorrectAnswers => $showCorrectAnswers, + showMessages => $showAttemptAnswers, # internally checks for messages + showSummary => $showSummary, + imgGen => $imgGen, # not needed if ce is present , + ce => '', # not needed if $imgGen is present + maketext => WeBWorK::Localize::getLoc($ce->{language}), ); my $answerTemplate = $tbl->answerTemplate; @@ -397,9 +419,12 @@ sub get_instructor_comment { return unless ref($problem) =~ /ProblemVersion/; - my $db = $self->r->db; - my $userPastAnswerID = $db->latestProblemPastAnswer($self->{ce}{courseName}, $problem->user_id, - $problem->set_id . ",v" . $problem->version_id, $problem->problem_id); + my $db = $self->r->db; + my $userPastAnswerID = $db->latestProblemPastAnswer( + $self->{ce}{courseName}, + $problem->user_id, $problem->set_id . ",v" . $problem->version_id, + $problem->problem_id + ); if ($userPastAnswerID) { my $userPastAnswer = $db->getPastAnswer($userPastAnswerID); @@ -416,21 +441,21 @@ sub get_instructor_comment { # FIXME need to make $Set and $set be used consistently sub pre_header_initialize { - my ($self) = @_; + my ($self) = @_; # if authz->checkSet has failed, this set is invalid, and no need to proceeded. return if $self->{invalidSet}; - my $r = $self->r; - my $ce = $r->ce; - my $db = $r->db; - my $authz = $r->authz; + my $r = $self->r; + my $ce = $r->ce; + my $db = $r->db; + my $authz = $r->authz; my $urlpath = $r->urlpath; - my $setName = $urlpath->arg("setID"); - my $userName = $r->param('user'); + my $setName = $urlpath->arg("setID"); + my $userName = $r->param('user'); my $effectiveUserName = $r->param('effectiveUser'); - my $key = $r->param('key'); + my $key = $r->param('key'); # should we allow a new version to be created when acting as a user? my $verCreateOK = defined($r->param('createnew_ok')) ? $r->param('createnew_ok') : 0; @@ -444,7 +469,7 @@ sub pre_header_initialize { my $PermissionLevel = $db->getPermissionLevel($userName); die "permission level record for $userName does not exist (but the user does? odd...)" - unless defined($PermissionLevel); + unless defined($PermissionLevel); my $permissionLevel = $PermissionLevel->permission; @@ -475,8 +500,7 @@ sub pre_header_initialize { $self->{assignment_type} = 'gateway'; if (!$authz->hasPermissions($userName, "modify_problem_sets")) { - $self->{invalidSet} = "You do not have the " . - "authorization level required to view/edit undefined sets."; + $self->{invalidSet} = "You do not have the " . "authorization level required to view/edit undefined sets."; # define these so that we can drop through # to report the error in body() @@ -487,8 +511,8 @@ sub pre_header_initialize { # in this case we're creating a fake set from the input, so # the input must include a source file. if (!$r->param("sourceFilePath")) { - $self->{invalidSet} = "An Undefined_Set was requested, but no source " . - "file for the contained problem was provided."; + $self->{invalidSet} = + "An Undefined_Set was requested, but no source " . "file for the contained problem was provided."; # define these so that we can drop through # to report the error in body() @@ -498,8 +522,8 @@ sub pre_header_initialize { } else { my $sourceFPath = $r->param("sourceFilePath"); - die("sourceFilePath is unsafe!") unless - path_is_subdir($sourceFPath, $ce->{courseDirs}->{templates}, 1); + die("sourceFilePath is unsafe!") + unless path_is_subdir($sourceFPath, $ce->{courseDirs}->{templates}, 1); $tmplSet = fake_set($db); $set = fake_set_version($db); @@ -551,15 +575,20 @@ sub pre_header_initialize { # double check that any requested version makes sense $requestedVersion = $latestVersion - if ($requestedVersion !~ /^\d+$/ || - $requestedVersion > $latestVersion || - $requestedVersion < 0); + if ($requestedVersion !~ /^\d+$/ + || $requestedVersion > $latestVersion + || $requestedVersion < 0); die("No requested version when returning to problem?!") - if (($r->param("previewAnswers") || - $r->param("checkAnswers") || - $r->param("submitAnswers") || - $r->param("newPage")) && ! $requestedVersion); + if ( + ( + $r->param("previewAnswers") + || $r->param("checkAnswers") + || $r->param("submitAnswers") + || $r->param("newPage") + ) + && !$requestedVersion + ); # to test for a proctored test, we need the set version, not the # template, to allow a finished proctored test to be checked as an @@ -567,25 +596,21 @@ sub pre_header_initialize { if ($requestedVersion) { # if a specific set version was requested, it was stored in the $authz # object when we did the set check - $set = $db->getMergedSetVersion($effectiveUserName, - $setName, - $requestedVersion); + $set = $db->getMergedSetVersion($effectiveUserName, $setName, $requestedVersion); } elsif ($latestVersion) { # otherwise, if there's a current version, which we take to be the # latest version taken, we use that - $set = $db->getMergedSetVersion($effectiveUserName, - $setName, - $latestVersion); + $set = $db->getMergedSetVersion($effectiveUserName, $setName, $latestVersion); } else { # and if neither of those work, get a dummy set so that we have # something to work with my $userSetClass = $ce->{dbLayout}->{set_version}->{record}; # FIXME RETURN TO: should this be global2version? $set = global2user($userSetClass, $db->getGlobalSet($setName)); - die "set $setName not found." unless $set; + die "set $setName not found." unless $set; $set->user_id($effectiveUserName); $set->psvn('000'); - $set->set_id("$setName"); # redundant? + $set->set_id("$setName"); # redundant? $set->version_id(0); } } @@ -610,8 +635,11 @@ sub pre_header_initialize { # FIXME for $isClosed, "record_answers_after_due_date" isn't quite # the right description, but it seems reasonable - my $isClosed = $tmplSet && $tmplSet->due_date && (after($tmplSet->due_date()) && - ! $authz->hasPermissions($userName, "record_answers_after_due_date")); + my $isClosed = + $tmplSet + && $tmplSet->due_date + && (after($tmplSet->due_date()) + && !$authz->hasPermissions($userName, "record_answers_after_due_date")); # to determine if we need a new version, we need to know whether this # version exceeds the number of attempts per version. (among other @@ -628,7 +656,8 @@ sub pre_header_initialize { # the set hasn't been versioned to the user yet--this gets fixed # when we assign the setVersion if (!$Problem) { - $Problem = $setVersionNumber + $Problem = + $setVersionNumber ? $db->getMergedProblemVersion($EffectiveUser->user_id, $setName, $setVersionNumber, $setPNum[0]) : undef; } @@ -636,27 +665,29 @@ sub pre_header_initialize { # note that having $maxAttemptsPerVersion set to an infinite/0 value is # nonsensical; if we did that, why have versions? (might want to do it for one individual?) # Its actually a good thing for "repeatable" practice sets - my $maxAttemptsPerVersion = $tmplSet->attempts_per_version() || 0; - my $timeInterval = $tmplSet->time_interval() || 0; + my $maxAttemptsPerVersion = $tmplSet->attempts_per_version() || 0; + my $timeInterval = $tmplSet->time_interval() || 0; my $versionsPerInterval = $tmplSet->versions_per_interval() || 0; - my $timeLimit = $tmplSet->version_time_limit() || 0; + my $timeLimit = $tmplSet->version_time_limit() || 0; # what happens if someone didn't set one of these? I think this can # happen if we're handed a malformed set, where the values in the # database are null. - $timeInterval = 0 if (! defined($timeInterval) || $timeInterval eq ''); - $versionsPerInterval = 0 if (! defined($versionsPerInterval) || - $versionsPerInterval eq ''); + $timeInterval = 0 if (!defined($timeInterval) || $timeInterval eq ''); + $versionsPerInterval = 0 if (!defined($versionsPerInterval) + || $versionsPerInterval eq ''); # every problem in the set must have the same submission characteristics - my $currentNumAttempts = (defined($Problem) && $Problem->num_correct() ne '') - ? $Problem->num_correct() + $Problem->num_incorrect() : 0; + my $currentNumAttempts = + (defined($Problem) && $Problem->num_correct() ne '') ? $Problem->num_correct() + $Problem->num_incorrect() : 0; # $maxAttempts turns into the maximum number of versions we can create; # if $Problem isn't defined, we can't have made any attempts, so it # doesn't matter - my $maxAttempts = (defined($Problem) && defined($Problem->max_attempts()) && $Problem->max_attempts()) - ? $Problem->max_attempts() : -1; + my $maxAttempts = + (defined($Problem) && defined($Problem->max_attempts()) && $Problem->max_attempts()) + ? $Problem->max_attempts() + : -1; # finding the number of versions per time interval is a little harder. # we interpret the time interval as a rolling interval: that is, @@ -666,22 +697,22 @@ sub pre_header_initialize { # and we can set it to two sets per 12 hours for most "2ce daily" # type applications my $timeNow = time(); - my $grace = $ce->{gatewayGracePeriod}; + my $grace = $ce->{gatewayGracePeriod}; - my $currentNumVersions = 0; # this is the number of versions in the - # time interval - my $totalNumVersions = 0; + my $currentNumVersions = 0; # this is the number of versions in the + # time interval + my $totalNumVersions = 0; # we don't need to check this if $self->{invalidSet} is already set, # or if we're working with an Undefined_Set - if ($setVersionNumber && ! $self->{invalidSet} && $setName ne "Undefined_Set") { + if ($setVersionNumber && !$self->{invalidSet} && $setName ne "Undefined_Set") { my @setVersionIDs = $db->listSetVersions($effectiveUserName, $setName); - my @setVersions = $db->getSetVersions(map {[$effectiveUserName, $setName,, $_]} @setVersionIDs); + my @setVersions = $db->getSetVersions(map { [ $effectiveUserName, $setName,, $_ ] } @setVersionIDs); foreach (@setVersions) { $totalNumVersions++; $currentNumVersions++ - if (!$timeInterval || - $_->version_creation_time() > ($timeNow - $timeInterval)); + if (!$timeInterval + || $_->version_creation_time() > ($timeNow - $timeInterval)); } } @@ -689,13 +720,13 @@ sub pre_header_initialize { # new version creation conditional #################################### - my $versionIsOpen = 0; # can we do anything to this version? + my $versionIsOpen = 0; # can we do anything to this version? # recall $isOpen = timeNow > openDate [for the merged userset] and # $isClosed = timeNow > dueDate [for the merged userset] # again, if $self->{invalidSet} is already set, we don't need to # to check this - if ($isOpen && ! $isClosed && ! $self->{invalidSet}) { + if ($isOpen && !$isClosed && !$self->{invalidSet}) { # if no specific version is requested, we can create a new one if # need be @@ -726,7 +757,7 @@ sub pre_header_initialize { # assign set, get the right name, version # number, etc., and redefine the $set # and $Problem we're working with - my $setTmpl = $db->getUserSet($effectiveUserName,$setName); + my $setTmpl = $db->getUserSet($effectiveUserName, $setName); WeBWorK::ContentGenerator::Instructor::assignSetVersionToUser($self, $effectiveUserName, $setTmpl); $setVersionNumber++; @@ -747,8 +778,10 @@ sub pre_header_initialize { $set->open_date($timeNow); # figure out the due date, taking into account # any time limit cap - my $dueTime = ($timeLimit == 0 || ($set->time_limit_cap && $timeNow+$timeLimit > $set->due_date)) - ? $set->due_date : $timeNow+$timeLimit; + my $dueTime = + ($timeLimit == 0 || ($set->time_limit_cap && $timeNow + $timeLimit > $set->due_date)) + ? $set->due_date + : $timeNow + $timeLimit; $set->due_date($dueTime); $set->answer_date($set->due_date + $ansOffset); @@ -780,42 +813,48 @@ sub pre_header_initialize { $currentNumAttempts = 0; } elsif ($maxAttempts != -1 && $totalNumVersions > $maxAttempts) { - $self->{invalidSet} = "No new versions of this assignment are available, " . - "because you have already taken the maximum number allowed."; - - } elsif ($effectiveUserName ne $userName && - $authz->hasPermissions($userName, "create_new_set_version_when_acting_as_student")) { - - $self->{invalidSet} = "User $effectiveUserName is being acted " . - "as. If you continue, you will create a new version of this set " . - "for that user, which will count against their allowed maximum " . - "number of versions for the current time interval. IN GENERAL, THIS " . - "IS NOT WHAT YOU WANT TO DO. Please be sure that you want to " . - "do this before clicking the \"Create new set version\" link " . - "below. Alternately, PRESS THE \"BACK\" BUTTON and continue."; + $self->{invalidSet} = "No new versions of this assignment are available, " + . "because you have already taken the maximum number allowed."; + + } elsif ($effectiveUserName ne $userName + && $authz->hasPermissions($userName, "create_new_set_version_when_acting_as_student")) + { + + $self->{invalidSet} = + "User $effectiveUserName is being acted " + . "as. If you continue, you will create a new version of this set " + . "for that user, which will count against their allowed maximum " + . "number of versions for the current time interval. IN GENERAL, THIS " + . "IS NOT WHAT YOU WANT TO DO. Please be sure that you want to " + . "do this before clicking the \"Create new set version\" link " + . "below. Alternately, PRESS THE \"BACK\" BUTTON and continue."; $self->{invalidVersionCreation} = 1; } elsif ($effectiveUserName ne $userName) { - $self->{invalidSet} = "User $effectiveUserName is being acted as. " . - "When acting as another user, new versions of the set cannot be created."; + $self->{invalidSet} = "User $effectiveUserName is being acted as. " + . "When acting as another user, new versions of the set cannot be created."; $self->{invalidVersionCreation} = 2; - } elsif (($maxAttemptsPerVersion == 0 || $currentNumAttempts < $maxAttemptsPerVersion) && - $timeNow < $set->due_date() + $grace) { + } elsif (($maxAttemptsPerVersion == 0 || $currentNumAttempts < $maxAttemptsPerVersion) + && $timeNow < $set->due_date() + $grace) + { if (between($set->open_date(), $set->due_date() + $grace, $timeNow)) { $versionIsOpen = 1; } else { - $versionIsOpen = 0; # redundant - $self->{invalidSet} = "No new versions of this assignment" . - " are available,\nbecause the set is not open or its time" . - " limit has expired.\n"; + $versionIsOpen = 0; # redundant + $self->{invalidSet} = + "No new versions of this assignment" + . " are available,\nbecause the set is not open or its time" + . " limit has expired.\n"; } - } elsif ($versionsPerInterval && - ($currentNumVersions >= $versionsPerInterval)){ - $self->{invalidSet} = "You have already taken all available versions of this " . - "test in the current time interval. You may take the test again after " . - "the time interval has expired."; + } elsif ($versionsPerInterval + && ($currentNumVersions >= $versionsPerInterval)) + { + $self->{invalidSet} = + "You have already taken all available versions of this " + . "test in the current time interval. You may take the test again after " + . "the time interval has expired."; } @@ -823,15 +862,16 @@ sub pre_header_initialize { # (we're still in the $isOpen && ! $isClosed conditional here) # if a specific version is requested, then we only check to # see if it's open - if (($currentNumAttempts < $maxAttemptsPerVersion) - && - ($effectiveUserName eq $userName || - $authz->hasPermissions($userName, "record_set_version_answers_when_acting_as_student")) - ) { + if ( + ($currentNumAttempts < $maxAttemptsPerVersion) + && ($effectiveUserName eq $userName + || $authz->hasPermissions($userName, "record_set_version_answers_when_acting_as_student")) + ) + { if (between($set->open_date(), $set->due_date() + $grace, $timeNow)) { $versionIsOpen = 1; } else { - $versionIsOpen = 0; # redundant + $versionIsOpen = 0; # redundant } } } @@ -841,25 +881,24 @@ sub pre_header_initialize { $self->{invalidSet} = "This set is closed. No new set versions may be taken."; } - #################################### # save problem and user data #################################### my $psvn = $set->psvn(); - $self->{tmplSet} = $tmplSet; - $self->{set} = $set; - $self->{problem} = $Problem; + $self->{tmplSet} = $tmplSet; + $self->{set} = $set; + $self->{problem} = $Problem; $self->{requestedVersion} = $requestedVersion; - $self->{userName} = $userName; + $self->{userName} = $userName; $self->{effectiveUserName} = $effectiveUserName; - $self->{user} = $User; - $self->{effectiveUser} = $EffectiveUser; - $self->{permissionLevel} = $permissionLevel; + $self->{user} = $User; + $self->{effectiveUser} = $EffectiveUser; + $self->{permissionLevel} = $permissionLevel; - $self->{isOpen} = $isOpen; - $self->{isClosed} = $isClosed; + $self->{isOpen} = $isOpen; + $self->{isClosed} = $isClosed; $self->{versionIsOpen} = $versionIsOpen; $self->{timeNow} = $timeNow; @@ -882,11 +921,11 @@ sub pre_header_initialize { # [This section lifted from Problem.pm] ############################## # set options from form fields (see comment at top of file for names) - my $displayMode = $User->displayMode || $ce->{pg}->{options}->{displayMode}; - my $redisplay = $r->param("redisplay"); - my $submitAnswers = $r->param("submitAnswers") // 0; - my $checkAnswers = $r->param("checkAnswers") // 0; - my $previewAnswers = $r->param("previewAnswers") // 0; + my $displayMode = $User->displayMode || $ce->{pg}->{options}->{displayMode}; + my $redisplay = $r->param("redisplay"); + my $submitAnswers = $r->param("submitAnswers") // 0; + my $checkAnswers = $r->param("checkAnswers") // 0; + my $previewAnswers = $r->param("previewAnswers") // 0; my $formFields = { WeBWorK::Form->new_from_paramable($r)->Vars }; @@ -909,7 +948,7 @@ sub pre_header_initialize { #################################### # bail without doing anything if the set isn't yet open for this user - if (!($self->{isOpen} || $authz->hasPermissions($userName,"view_unopened_sets"))) { + if (!($self->{isOpen} || $authz->hasPermissions($userName, "view_unopened_sets"))) { $self->{invalidSet} = "This set is not yet open."; return; } @@ -919,8 +958,10 @@ sub pre_header_initialize { showOldAnswers => $User->showOldAnswers ne '' ? $User->showOldAnswers : $ce->{pg}{options}{showOldAnswers}, # showProblemGrader implies showCorrectAnswers. This is a convenience for grading. showCorrectAnswers => ($r->param('showProblemGrader') || 0) - || ($r->param("showCorrectAnswers") && ($submitAnswers || $checkAnswers)) || 0, - showProblemGrader => $r->param('showProblemGrader') || 0, + || ($r->param("showCorrectAnswers") && ($submitAnswers || $checkAnswers)) + || 0, + showProblemGrader => $r->param('showProblemGrader') + || 0, # Hints are not yet implemented in gateway quzzes. showHints => 0, # showProblemGrader implies showSolutions. Another convenience for grading. @@ -951,7 +992,7 @@ sub pre_header_initialize { # does the user have permission to use certain options? my @args = ($User, $PermissionLevel, $EffectiveUser, $set, $Problem, $tmplSet); my $sAns = $submitAnswers ? 1 : 0; - my %can = ( + my %can = ( showOldAnswers => $self->can_showOldAnswers(@args), showCorrectAnswers => $self->can_showCorrectAnswers(@args, $sAns), showProblemGrader => $self->can_showProblemGrader(@args), @@ -970,7 +1011,7 @@ sub pre_header_initialize { # final values for options my %will; foreach (keys %must) { - $will{$_} = $can{$_} && ($must{$_} || $want{$_}) ; + $will{$_} = $can{$_} && ($must{$_} || $want{$_}); } ##### store fields ##### @@ -985,7 +1026,6 @@ sub pre_header_initialize { $self->{can} = \%can; $self->{will} = \%will; - #################################### # set up problem numbering and multipage variables #################################### @@ -1007,20 +1047,19 @@ sub pre_header_initialize { # update startProb and endProb for multipage tests if (defined($set->problems_per_page) && $set->problems_per_page) { $numProbPerPage = $set->problems_per_page; - $pageNumber = ($newPage) ? $newPage : $currentPage; + $pageNumber = ($newPage) ? $newPage : $currentPage; - $numPages = scalar(@problemNumbers)/$numProbPerPage; + $numPages = scalar(@problemNumbers) / $numProbPerPage; $numPages = int($numPages) + 1 if (int($numPages) != $numPages); - $startProb = ($pageNumber - 1)*$numProbPerPage; + $startProb = ($pageNumber - 1) * $numProbPerPage; $startProb = 0 if ($startProb < 0 || $startProb > $#problemNumbers); - $endProb = ($startProb + $numProbPerPage > $#problemNumbers) - ? $#problemNumbers : $startProb + $numProbPerPage - 1; + $endProb = + ($startProb + $numProbPerPage > $#problemNumbers) ? $#problemNumbers : $startProb + $numProbPerPage - 1; } - # set up problem list for randomly ordered tests - my @probOrder = (0..$#problemNumbers); + my @probOrder = (0 .. $#problemNumbers); # there's a routine to do this somewhere, I think... if ($set->problem_randorder) { @@ -1044,7 +1083,7 @@ sub pre_header_initialize { # make a list of those problems we're displaying my @probsToDisplay = (); - for (my $i=0; $i<@probOrder; $i++) { + for (my $i = 0; $i < @probOrder; $i++) { push(@probsToDisplay, $probOrder[$i]) if ($i >= $startProb && $i <= $endProb); } @@ -1053,10 +1092,10 @@ sub pre_header_initialize { # process problems #################################### - my @problems = (); + my @problems = (); my @pg_results = (); # pg errors are stored here; initialize it to empty to start - $self->{errors} = [ ]; + $self->{errors} = []; # process the problems as needed my @mergedProblems; @@ -1068,15 +1107,14 @@ sub pre_header_initialize { for my $pIndex (0 .. $#problemNumbers) { - if ( ! defined( $mergedProblems[$pIndex] ) ) { - $self->{invalidSet} = "One or more of the problems " . - "in this set have not been assigned to you."; + if (!defined($mergedProblems[$pIndex])) { + $self->{invalidSet} = "One or more of the problems " . "in this set have not been assigned to you."; return; } my $ProblemN = $mergedProblems[$pIndex]; # sticky answers are set up here - if (not ($submitAnswers or $previewAnswers or $checkAnswers or $newPage) and $will{showOldAnswers}) { + if (not($submitAnswers or $previewAnswers or $checkAnswers or $newPage) and $will{showOldAnswers}) { my %oldAnswers = decodeAnswers($ProblemN->last_answer); $formFields->{$_} = $oldAnswers{$_} foreach (keys %oldAnswers); } @@ -1088,30 +1126,27 @@ sub pre_header_initialize { # this is the actual translation of each problem. errors are # stored in @{$self->{errors}} in each case if ((grep /^$pIndex$/, @probsToDisplay) || $submitAnswers) { - $pg = $self->getProblemHTML($self->{effectiveUser}, - $set, $formFields, - $ProblemN); + $pg = $self->getProblemHTML($self->{effectiveUser}, $set, $formFields, $ProblemN); } push(@pg_results, $pg); } - $self->{ra_problems} = \@problems; - $self->{ra_pg_results}=\@pg_results; + $self->{ra_problems} = \@problems; + $self->{ra_pg_results} = \@pg_results; - $self->{startProb} = $startProb; - $self->{endProb} = $endProb; - $self->{numPages} = $numPages; - $self->{pageNumber} = $pageNumber; + $self->{startProb} = $startProb; + $self->{endProb} = $endProb; + $self->{numPages} = $numPages; + $self->{pageNumber} = $pageNumber; $self->{ra_problem_numbers} = \@problemNumbers; - $self->{ra_probOrder} = \@probOrder; + $self->{ra_probOrder} = \@probOrder; } sub head { my ($self) = @_; return "" if !defined($self->{ra_pg_results}); my $head_text = ""; - for (@{$self->{ra_pg_results}}) - { - next if !ref($_); + for (@{ $self->{ra_pg_results} }) { + next if !ref($_); $head_text .= $_->{head_text} if $_->{head_text}; } return $head_text; @@ -1130,16 +1165,16 @@ sub path { return $self->pathMacro( $args, - 'WeBWorK' => $navigation_allowed ? $root : '', + 'WeBWorK' => $navigation_allowed ? $root : '', $courseName => $navigation_allowed ? "$root/$courseName" : '', $setName eq "Undefined_Set" || $self->{invalidSet} ? ($setName => '') : ( $self->{set}->set_id => "$root/" . $r->urlpath->newFromModule( - 'WeBWorK::ContentGenerator::ProblemSet', $r, - courseID => $courseName, - setID => $self->{set}->set_id + 'WeBWorK::ContentGenerator::ProblemSet', $r, + courseID => $courseName, + setID => $self->{set}->set_id )->path, 'v' . $self->{set}->version_id => '' ), @@ -1220,7 +1255,8 @@ sub nav { # Mark the current test. $userRecords[$currentTestIndex]{currentTest} = 1; - my $setPage = $r->urlpath->newFromModule(__PACKAGE__, $r, + my $setPage = $r->urlpath->newFromModule( + __PACKAGE__, $r, courseID => $courseName, setID => "$setName,v%s" ); @@ -1412,19 +1448,19 @@ sub nav { } sub body { - my $self = shift(); - my $r = $self->r; - my $ce = $r->ce; - my $db = $r->db; - my $authz = $r->authz; - my $urlpath = $r->urlpath; - my $user = $r->param('user'); + my $self = shift(); + my $r = $self->r; + my $ce = $r->ce; + my $db = $r->db; + my $authz = $r->authz; + my $urlpath = $r->urlpath; + my $user = $r->param('user'); my $effectiveUser = $r->param('effectiveUser'); - my $courseID = $urlpath->arg("courseID"); + my $courseID = $urlpath->arg("courseID"); # report everything with the same time that we started with my $timeNow = $self->{timeNow}; - my $grace = $ce->{gatewayGracePeriod}; + my $grace = $ce->{gatewayGracePeriod}; ######################################### # preliminary error checking and output @@ -1438,23 +1474,28 @@ sub body { if (defined($self->{'assignment_type'}) && $self->{'assignment_type'} eq 'proctored_gateway') { my $proctorID = $r->param('proctor_user'); if ($proctorID) { - eval{ $db->deleteKey("$effectiveUser,$proctorID"); }; - eval{ $db->deleteKey("$effectiveUser,$proctorID,g"); }; + eval { $db->deleteKey("$effectiveUser,$proctorID"); }; + eval { $db->deleteKey("$effectiveUser,$proctorID,g"); }; } } - my $newlink = ''; + my $newlink = ''; my $usernote = ''; - if (defined($self->{invalidVersionCreation}) && - $self->{invalidVersionCreation} == 1) { - my $gwpage = $urlpath->newFromModule($urlpath->module,$r, - courseID=>$urlpath->arg("courseID"), setID=>$urlpath->arg("setID")); + if (defined($self->{invalidVersionCreation}) + && $self->{invalidVersionCreation} == 1) + { + my $gwpage = $urlpath->newFromModule( + $urlpath->module, $r, + courseID => $urlpath->arg("courseID"), + setID => $urlpath->arg("setID") + ); my $link = $self->systemLink($gwpage, - params=>{effectiveUser => $effectiveUser, user => $user, createnew_ok => 1}); - $newlink = CGI::p(CGI::a({href=>$link}, "Create new set version.")); + params => { effectiveUser => $effectiveUser, user => $user, createnew_ok => 1 }); + $newlink = CGI::p(CGI::a({ href => $link }, "Create new set version.")); $usernote = " (acted as by $user)"; - } elsif (defined($self->{invalidVersionCreation}) && - $self->{invalidVersionCreation} == 2) { + } elsif (defined($self->{invalidVersionCreation}) + && $self->{invalidVersionCreation} == 2) + { $usernote = " (acted as by $user)"; } @@ -1463,8 +1504,8 @@ sub body { CGI::div( { class => 'mb-2' }, $r->maketext( - "The selected problem set ([_1]) is not a valid set for [_2][_3]:", - $urlpath->arg("setID"), $effectiveUser, $usernote + "The selected problem set ([_1]) is not a valid set for [_2][_3]:", $urlpath->arg("setID"), + $effectiveUser, $usernote ) ), CGI::div($self->{invalidSet}), @@ -1472,34 +1513,34 @@ sub body { ); } - my $tmplSet = $self->{tmplSet}; - my $set = $self->{set}; - my $Problem = $self->{problem}; + my $tmplSet = $self->{tmplSet}; + my $set = $self->{set}; + my $Problem = $self->{problem}; my $permissionLevel = $self->{permissionLevel}; - my $submitAnswers = $self->{submitAnswers}; - my $checkAnswers = $self->{checkAnswers}; - my $previewAnswers = $self->{previewAnswers}; - my $newPage = $self->{newPage}; - my %want = %{$self->{want}}; - my %can = %{$self->{can}}; - my %must = %{$self->{must}}; - my %will = %{$self->{will}}; - - my @problems = @{$self->{ra_problems}}; - my @pg_results = @{$self->{ra_pg_results}}; - my @pg_errors = @{$self->{errors}}; + my $submitAnswers = $self->{submitAnswers}; + my $checkAnswers = $self->{checkAnswers}; + my $previewAnswers = $self->{previewAnswers}; + my $newPage = $self->{newPage}; + my %want = %{ $self->{want} }; + my %can = %{ $self->{can} }; + my %must = %{ $self->{must} }; + my %will = %{ $self->{will} }; + + my @problems = @{ $self->{ra_problems} }; + my @pg_results = @{ $self->{ra_pg_results} }; + my @pg_errors = @{ $self->{errors} }; my $requestedVersion = $self->{requestedVersion}; - my $startProb = $self->{startProb}; - my $endProb = $self->{endProb}; - my $numPages = $self->{numPages}; - my $pageNumber = $self->{pageNumber}; - my @problemNumbers = @{$self->{ra_problem_numbers}}; - my @probOrder = @{$self->{ra_probOrder}}; + my $startProb = $self->{startProb}; + my $endProb = $self->{endProb}; + my $numPages = $self->{numPages}; + my $pageNumber = $self->{pageNumber}; + my @problemNumbers = @{ $self->{ra_problem_numbers} }; + my @probOrder = @{ $self->{ra_probOrder} }; - my $setName = $set->set_id; - my $versionNumber = $set->version_id; - my $setVName = "$setName,v$versionNumber"; + my $setName = $set->set_id; + my $versionNumber = $set->version_id; + my $setVName = "$setName,v$versionNumber"; my $numProbPerPage = $set->problems_per_page; # translation errors -- we use the same output routine as Problem.pm, @@ -1513,8 +1554,8 @@ sub body { $message .= "$errorNum. " if (@pg_errors > 1); $message .= $_->{message} . CGI::br() . "\n"; - $context .= CGI::p((@pg_errors > 1? "$errorNum.": '') . - $_->{context}) . "\n\n" . CGI::div({ class => 'gwDivider' }, "") . "\n\n"; + $context .= CGI::p((@pg_errors > 1 ? "$errorNum." : '') . $_->{context}) . "\n\n" + . CGI::div({ class => 'gwDivider' }, "") . "\n\n"; } return $self->errorOutput($message, $context); } @@ -1526,7 +1567,7 @@ sub body { debug("begin answer processing"); my @scoreRecordedMessage = ('') x scalar(@problems); - my $LTIGradeResult = -1; + my $LTIGradeResult = -1; #################################### # save results to database as appropriate @@ -1560,7 +1601,7 @@ sub body { # continue working the test if ($r->param("past_proctor_user") && $r->param("past_proctor_key")) { $r->param("proctor_user", $r->param("past_proctor_user")); - $r->param("proctor_key", $r->param("past_proctor_key")); + $r->param("proctor_key", $r->param("past_proctor_key")); } } # this is unsubtle, but we'd rather not have bogus @@ -1572,12 +1613,12 @@ sub body { } my @pureProblems = $db->getAllProblemVersions($effectiveUser, $setName, $versionNumber); - foreach my $i (0 .. $#problems) { # process each problem - # this code is essentially that from Problem.pm - # begin problem loop for sticky answers + foreach my $i (0 .. $#problems) { # process each problem + # this code is essentially that from Problem.pm + # begin problem loop for sticky answers my $pureProblem = $pureProblems[ $probOrder[$i] ]; - my $problem = $problems[ $probOrder[$i] ]; - my $pg_result = $pg_results[ $probOrder[$i] ]; + my $problem = $problems[ $probOrder[$i] ]; + my $pg_result = $pg_results[ $probOrder[$i] ]; # store answers in problem for sticky answers later # my %answersToStore; @@ -1586,18 +1627,18 @@ sub body { # answers that we're saving, because we don't have # a pg_result object for all problems if we're not # submitting - my %answerHash = (); + my %answerHash = (); my @answer_order = (); my $encoded_last_answer_string; if (ref($pg_result)) { - my ($past_answers_string, $scores, $isEssay); #not used here + my ($past_answers_string, $scores, $isEssay); #not used here ($past_answers_string, $encoded_last_answer_string, $scores, $isEssay) = create_ans_str_from_responses($self, $pg_result); } else { - my $prefix = sprintf('Q%04d_', $problemNumbers[$i]); - my @fields = sort grep {/^(?!previous).*$prefix/} (keys %{$self->{formFields}}); - my %answersToStore = map {$_ => $self->{formFields}->{$_}} @fields; - my @answer_order = @fields; + my $prefix = sprintf('Q%04d_', $problemNumbers[$i]); + my @fields = sort grep {/^(?!previous).*$prefix/} (keys %{ $self->{formFields} }); + my %answersToStore = map { $_ => $self->{formFields}->{$_} } @fields; + my @answer_order = @fields; $encoded_last_answer_string = encodeAnswers(%answersToStore, @answer_order); } # and get the last answer @@ -1633,42 +1674,43 @@ sub body { } # write the transaction log writeLog($self->{ce}, "transaction", - $problem->problem_id . "\t" . - $problem->set_id . "\t" . - $problem->user_id . "\t" . - $problem->source_file . "\t" . - $problem->value . "\t" . - $problem->max_attempts . "\t" . - $problem->problem_seed . "\t" . - $problem->status . "\t" . - $problem->attempted . "\t" . - $problem->last_answer . "\t" . - $problem->num_correct . "\t" . - $problem->num_incorrect - ); + $problem->problem_id . "\t" + . $problem->set_id . "\t" + . $problem->user_id . "\t" + . $problem->source_file . "\t" + . $problem->value . "\t" + . $problem->max_attempts . "\t" + . $problem->problem_seed . "\t" + . $problem->status . "\t" + . $problem->attempted . "\t" + . $problem->last_answer . "\t" + . $problem->num_correct . "\t" + . $problem->num_incorrect); } elsif ($submitAnswers) { # this is the case where we submitted answers # but can't save them; report an error # message if ($self->{isClosed}) { - $scoreRecordedMessage[ $probOrder[$i] ] = $r->maketext( - 'Your score was not recorded because this problem set version is not open.'); + $scoreRecordedMessage[ $probOrder[$i] ] = + $r->maketext('Your score was not recorded because this problem set version is not open.'); } elsif ($problem->num_correct + $problem->num_incorrect >= $set->attempts_per_version) { $scoreRecordedMessage[ $probOrder[$i] ] = $r->maketext( 'Your score was not recorded because you have no attempts remaining on this set version.'); - } elsif (! $self->{versionIsOpen}) { + } elsif (!$self->{versionIsOpen}) { my $endTime = ($set->version_last_attempt_time) ? $set->version_last_attempt_time : $timeNow; if ($endTime > $set->due_date && $endTime < $set->due_date + $grace) { $endTime = $set->due_date; } - my $elapsed = int(($endTime - $set->open_date)/0.6 + 0.5)/100; + my $elapsed = int(($endTime - $set->open_date) / 0.6 + 0.5) / 100; # we assume that allowed is an even # number of minutes - my $allowed = ($set->due_date - $set->open_date)/60; - $scoreRecordedMessage[ $probOrder[$i] ] = $r->maketext('Your score was not recorded because ' . - ' you have exceeded the time limit for this test. (Time taken: [_1] min; allowed: [_2] min.)', - $elapsed, $allowed); + my $allowed = ($set->due_date - $set->open_date) / 60; + $scoreRecordedMessage[ $probOrder[$i] ] = $r->maketext( + 'Your score was not recorded because ' + . ' you have exceeded the time limit for this test. (Time taken: [_1] min; allowed: [_2] min.)', + $elapsed, $allowed + ); } else { $scoreRecordedMessage[ $probOrder[$i] ] = $r->maketext('Your score was not recorded.'); } @@ -1678,8 +1720,8 @@ sub body { # problems $db->putProblemVersion($pureProblem); } - } # end loop through problems - # end loop through problems for sticky answer + } # end loop through problems + # end loop through problems for sticky answer #Try to update the student score on the LMS # if that option is enabled. @@ -1703,7 +1745,7 @@ sub body { if (defined($answer_log) && $submitAnswers) { foreach my $i (0 .. $#problems) { # Begin problem loop for passed answers. - next unless ref($pg_results[$probOrder[$i]]); + next unless ref($pg_results[ $probOrder[$i] ]); my $problem = $problems[ $probOrder[$i] ]; @@ -1716,9 +1758,13 @@ sub body { } # Write to courseLog - writeCourseLog($self->{ce}, "answer_log", - join("", '|', $problem->user_id, '|', $setVName, '|', ($i+1), '|', $scores, - "\t$timeNow\t", "$past_answers_string")); + writeCourseLog( + $self->{ce}, + "answer_log", + join("", + '|', $problem->user_id, '|', $setVName, '|', ($i + 1), '|', $scores, + "\t$timeNow\t", "$past_answers_string") + ); # Add to PastAnswer db my $pastAnswer = $db->newPastAnswer(); @@ -1739,22 +1785,19 @@ sub body { my $events = []; my $startTime = $r->param('startTime'); - my $endTime = time(); + my $endTime = time(); if ($submitAnswers && $will{recordAnswers}) { foreach my $i (0 .. $#problems) { - my $problem = $problems[ $probOrder[$i] ]; - my $pg = $pg_results[ $probOrder[$i] ]; + my $problem = $problems[ $probOrder[$i] ]; + my $pg = $pg_results[ $probOrder[$i] ]; my $completed_question_event = { - 'type' => 'AssessmentItemEvent', - 'action' => 'Completed', + 'type' => 'AssessmentItemEvent', + 'action' => 'Completed', 'profile' => 'AssessmentProfile', - 'object' => Caliper::Entity::problem_user( - $self->{ce}, - $db, - $problem->set_id(), - $versionNumber, - $problem->problem_id(), - $problem->user_id(), + 'object' => Caliper::Entity::problem_user( + $self->{ce}, $db, + $problem->set_id(), $versionNumber, + $problem->problem_id(), $problem->user_id(), $pg ), 'generated' => Caliper::Entity::answer( @@ -1765,59 +1808,39 @@ sub body { $problem->problem_id(), $problem->user_id(), $pg, - 0, # don't track start/end time for gateway problems (multiple answers per page) - 0 # don't track start/end time for gateway problems (multiple answers per page) + 0, # don't track start/end time for gateway problems (multiple answers per page) + 0 # don't track start/end time for gateway problems (multiple answers per page) ), }; push @$events, $completed_question_event; } my $submitted_set_event = { - 'type' => 'AssessmentEvent', - 'action' => 'Submitted', - 'profile' => 'AssessmentProfile', - 'object' => Caliper::Entity::problem_set( - $self->{ce}, - $db, - $setName - ), + 'type' => 'AssessmentEvent', + 'action' => 'Submitted', + 'profile' => 'AssessmentProfile', + 'object' => Caliper::Entity::problem_set($self->{ce}, $db, $setName), 'generated' => Caliper::Entity::problem_set_attempt( - $self->{ce}, - $db, - $setName, - $versionNumber, - $effectiveUser, - $startTime, - $endTime + $self->{ce}, $db, $setName, $versionNumber, $effectiveUser, $startTime, $endTime ), }; push @$events, $submitted_set_event; } else { my $paused_set_event = { - 'type' => 'AssessmentEvent', - 'action' => 'Paused', - 'profile' => 'AssessmentProfile', - 'object' => Caliper::Entity::problem_set( - $self->{ce}, - $db, - $setName - ), + 'type' => 'AssessmentEvent', + 'action' => 'Paused', + 'profile' => 'AssessmentProfile', + 'object' => Caliper::Entity::problem_set($self->{ce}, $db, $setName), 'generated' => Caliper::Entity::problem_set_attempt( - $self->{ce}, - $db, - $setName, - $versionNumber, - $effectiveUser, - $startTime, - $endTime + $self->{ce}, $db, $setName, $versionNumber, $effectiveUser, $startTime, $endTime ), }; push @$events, $paused_set_event; } my $tool_use_event = { - 'type' => 'ToolUseEvent', - 'action' => 'Used', + 'type' => 'ToolUseEvent', + 'action' => 'Used', 'profile' => 'ToolUseProfile', - 'object' => Caliper::Entity::webwork_app(), + 'object' => Caliper::Entity::webwork_app(), }; push @$events, $tool_use_event; $caliper_sensor->sendEvents($r, $events); @@ -1884,21 +1907,21 @@ sub body { #################################### # some convenient output variables - my $canShowProblemScores = $can{showScore} && - ($set->hide_score_by_problem eq 'N' || - $authz->hasPermissions($user, "view_hidden_work")); + my $canShowProblemScores = $can{showScore} + && ($set->hide_score_by_problem eq 'N' + || $authz->hasPermissions($user, "view_hidden_work")); - my $canShowWork = $authz->hasPermissions($user, "view_hidden_work") || - ($set->hide_work eq 'N' || ($set->hide_work eq 'BeforeAnswerDate' && $timeNow>$tmplSet->answer_date)); + my $canShowWork = $authz->hasPermissions($user, "view_hidden_work") + || ($set->hide_work eq 'N' || ($set->hide_work eq 'BeforeAnswerDate' && $timeNow > $tmplSet->answer_date)); # For answer checking on multi-page tests, track changes that made on other pages, and scores for problems on those # pages. @probStatus is used for this. Initialize this to the saved score either from a hidden input or the # database, and then update this when calculating the score for checked or submitted tests. - my @probStatus; + my @probStatus; # Figure out the recorded score for the set, and the score on this attempt. my $recordedScore = 0; - my $totPossible = 0; + my $totPossible = 0; for (@problems) { my $pv = $_->value // 1; $totPossible += $pv; @@ -1929,42 +1952,47 @@ sub body { } # we want to print elapsed and allowed times; allowed is easy - my $allowed = sprintf("%.0f", 10*($set->due_date - $set->open_date)/6) / 100; + my $allowed = sprintf("%.0f", 10 * ($set->due_date - $set->open_date) / 6) / 100; # elapsed is a little harder; we're counting to the last submission # time, or to the current time if the test hasn't been submitted, # and if the submission fell in the grace period round it to the # due_date my $exceededAllowedTime = 0; - my $endTime = ($set->version_last_attempt_time) ? $set->version_last_attempt_time : $timeNow; + my $endTime = ($set->version_last_attempt_time) ? $set->version_last_attempt_time : $timeNow; if ($endTime > $set->due_date && $endTime < $set->due_date + $grace) { $endTime = $set->due_date; } elsif ($endTime > $set->due_date) { $exceededAllowedTime = 1; } - my $elapsedTime = int(($endTime - $set->open_date)/0.6 + 0.5)/100; + my $elapsedTime = int(($endTime - $set->open_date) / 0.6 + 0.5) / 100; # Get the number of remaining attempts. - my $numLeft = ($set->attempts_per_version || 0) - $Problem->num_correct - $Problem->num_incorrect - - ($submitAnswers && $will{recordAnswers} ? 1 : 0); + my $numLeft = + ($set->attempts_per_version || 0) - + $Problem->num_correct - + $Problem->num_incorrect - + ($submitAnswers && $will{recordAnswers} ? 1 : 0); my $attemptNumber = $Problem->num_correct + $Problem->num_incorrect + ($submitAnswers && $will{recordAnswers} ? 1 : 0); # a handy noun for when referring to a test my $testNoun = (($set->attempts_per_version || 0) > 1) ? $r->maketext("submission") : $r->maketext("test"); - my $testNounNum = (($set->attempts_per_version ||0) > 1) - ? $r->maketext("submission (version [_1])",$versionNumber) : $r->maketext("version ([_1])",$versionNumber); + my $testNounNum = + (($set->attempts_per_version || 0) > 1) + ? $r->maketext("submission (version [_1])", $versionNumber) + : $r->maketext("version ([_1])", $versionNumber); ##### start output of test headers: ##### display information about recorded and checked scores - $attemptScore = wwRound(2,$attemptScore); + $attemptScore = wwRound(2, $attemptScore); if ($will{recordAnswers}) { # the distinction between $can{recordAnswers} and ! $can{} has # been dealt with above and recorded in @scoreRecordedMessage my $divClass = 'ResultsWithoutError'; - my $recdMsg = ''; + my $recdMsg = ''; foreach (@scoreRecordedMessage) { if ($_ !~ $r->maketext('Your score on this problem was recorded.')) { - $recdMsg = $_; + $recdMsg = $_; $divClass = 'ResultsWithError'; last; } @@ -1973,22 +2001,22 @@ sub body { print CGI::start_div({ class => $divClass . ' mb-3' }); if ($recdMsg) { # then there was an error when saving the results - print CGI::strong($r->maketext("Your score on this [_1] was NOT recorded.",$testNounNum), - $recdMsg), CGI::br(); + print CGI::strong($r->maketext("Your score on this [_1] was NOT recorded.", $testNounNum), $recdMsg), + CGI::br(); } else { # no error; print recorded message - print CGI::strong($r->maketext("Your score on this [_1] WAS recorded.",$testNounNum)), CGI::br(); + print CGI::strong($r->maketext("Your score on this [_1] WAS recorded.", $testNounNum)), CGI::br(); # and show the score if we're allowed to do that if ($can{showScore}) { - print CGI::strong($r->maketext("Your score on this [_1] is [_2]/[_3].", - $testNoun,$attemptScore,$totPossible)); + print CGI::strong($r->maketext( + "Your score on this [_1] is [_2]/[_3].", $testNoun, $attemptScore, $totPossible)); } else { if ($set->hide_score eq 'BeforeAnswerDate') { print $r->maketext("(Your score on this [_1] is not available until [_2].)", $testNoun, $self->formatDateTime($set->answer_date)); } else { - print $r->maketext("(Your score on this [_1] is not available.)",$testNoun); + print $r->maketext("(Your score on this [_1] is not available.)", $testNoun); } } @@ -1996,9 +2024,9 @@ sub body { # an LMS if ($LTIGradeResult != -1) { print CGI::br(); - print $LTIGradeResult ? - $r->maketext("Your score was successfully sent to the LMS.") : - $r->maketext("Your score was not successfully sent to the LMS."); + print $LTIGradeResult + ? $r->maketext("Your score was successfully sent to the LMS.") + : $r->maketext("Your score was not successfully sent to the LMS."); } } print CGI::end_div(); @@ -2017,11 +2045,14 @@ sub body { } } elsif ($will{checkAnswers}) { if ($can{showScore}) { - print CGI::start_div({class=>'gwMessage'}); - print CGI::strong($r->maketext("Your score on this (checked, not recorded) submission is [_1]/[_2].", - $attemptScore,$totPossible)), CGI::br(); - my $recScore = wwRound(2,$recordedScore); - print $r->maketext("The recorded score for this version is [_1]/[_2].",$recScore, $totPossible); + print CGI::start_div({ class => 'gwMessage' }); + print CGI::strong($r->maketext( + "Your score on this (checked, not recorded) submission is [_1]/[_2].", $attemptScore, + $totPossible + )), + CGI::br(); + my $recScore = wwRound(2, $recordedScore); + print $r->maketext("The recorded score for this version is [_1]/[_2].", $recScore, $totPossible); print CGI::end_div(); } } @@ -2067,13 +2098,13 @@ sub body { ), data_alert_two => ('
      ' . $r->maketext('You have less than 45 seconds left!') . '
      ') . ( - ($set->attempts_per_version > 1 && $attemptNumber > 0) ? '' - : '
      ' . $r->maketext('Press "Grade Test" soon!') . '
      ' + ($set->attempts_per_version > 1 && $attemptNumber > 0) ? '' + : '
      ' . $r->maketext('Press "Grade Test" soon!') . '
      ' ), data_alert_one => ('
      ' . $r->maketext('You are out of time!') . '
      ') . ( - ($set->attempts_per_version > 1 && $attemptNumber > 0) ? '' - : '
      ' . $r->maketext('Press "Grade Test" now!') . '
      ' + ($set->attempts_per_version > 1 && $attemptNumber > 0) ? '' + : '
      ' . $r->maketext('Press "Grade Test" now!') . '
      ' ), $user ne $effectiveUser ? (data_acting => 1) : () }, @@ -2091,8 +2122,8 @@ sub body { CGI::b( $r->maketext('You are out of time!') . ' ' . ( - $set->attempts_per_version > 1 && $attemptNumber > 0 - ? '' : $r->maketext('Press "Grade Test" now!') + $set->attempts_per_version > 1 + && $attemptNumber > 0 ? '' : $r->maketext('Press "Grade Test" now!') ) ) ); @@ -2121,12 +2152,12 @@ sub body { } } } else { - if (! $checkAnswers && ! $submitAnswers) { + if (!$checkAnswers && !$submitAnswers) { if ($can{showScore}) { - print CGI::start_div({class=>'gwMessage'}); + print CGI::start_div({ class => 'gwMessage' }); my $scMsg = $r->maketext("Your recorded score on this test (version [_1]) is [_2]/[_3].", - $versionNumber, wwRound(2,$recordedScore), $totPossible); + $versionNumber, wwRound(2, $recordedScore), $totPossible); if ($exceededAllowedTime && $recordedScore == 0) { $scMsg .= " " . $r->maketext("You exceeded the allowed time."); } @@ -2136,11 +2167,11 @@ sub body { } if ($set->version_last_attempt_time) { - print CGI::start_div({class=>'gwMessage'}); - print $r->maketext("Time taken on test: [_1] min ([_2] min allowed).",$elapsedTime,$allowed); + print CGI::start_div({ class => 'gwMessage' }); + print $r->maketext("Time taken on test: [_1] min ([_2] min allowed).", $elapsedTime, $allowed); print CGI::end_div(); } elsif ($exceededAllowedTime && $recordedScore != 0) { - print CGI::start_div({class=>'gwMessage'}); + print CGI::start_div({ class => 'gwMessage' }); print $r->maketext("(This test is overtime because it was not submitted in the allowed time.)"); print CGI::end_div(); } @@ -2185,7 +2216,7 @@ sub body { # form points us to the same set. my $setname = $set->set_id; my $setvnum = $set->version_id; - $action =~ s/(quiz_mode\/$setname)\/?$/$1,v$setvnum\//; #" + $action =~ s/(quiz_mode\/$setname)\/?$/$1,v$setvnum\//; #" if (!$can{recordAnswersNextTime} && !$canShowWork) { # Problems can not be shown. @@ -2522,26 +2553,27 @@ sub body { # print answer inspection button if ($authz->hasPermissions($user, "view_answers")) { my $hiddenFields = $self->hidden_authen_fields; - my $firstProb = $startProb+1; - my $lastProb = $endProb+1; + my $firstProb = $startProb + 1; + my $lastProb = $endProb + 1; $hiddenFields =~ s/\"hidden_/\"pastans-hidden_/g; my $pastAnswersPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Instructor::ShowAnswers", $r, courseID => $ce->{courseName}); - my $showPastAnswersURL = $self->systemLink($pastAnswersPage, authen => 0); # no authen info for form action - print "\n", CGI::start_form(-method=>"POST",-action=>$showPastAnswersURL,-target=>"WW_Info"),"\n", - $hiddenFields,"\n", - CGI::hidden(-name => 'courseID', -value=>$ce->{courseName}), "\n", - CGI::hidden(-name => 'selected_sets', -value=>$setVName), "\n", - CGI::hidden(-name => 'selected_users', -value=>$effectiveUser), "\n"; - for (my $prob=$firstProb; $prob <= $lastProb; $prob++) { - print CGI::hidden(-name => 'selected_problems', -value=>"$prob"), "\n"; + my $showPastAnswersURL = $self->systemLink($pastAnswersPage, authen => 0); # no authen info for form action + print "\n", CGI::start_form(-method => "POST", -action => $showPastAnswersURL, -target => "WW_Info"), "\n", + $hiddenFields, "\n", + CGI::hidden(-name => 'courseID', -value => $ce->{courseName}), "\n", + CGI::hidden(-name => 'selected_sets', -value => $setVName), "\n", + CGI::hidden(-name => 'selected_users', -value => $effectiveUser), "\n"; + for (my $prob = $firstProb; $prob <= $lastProb; $prob++) { + print CGI::hidden(-name => 'selected_problems', -value => "$prob"), "\n"; } print CGI::p(CGI::submit({ - name => 'action', - value => $r->maketext('Show Past Answers'), - class => 'btn btn-primary' - })), "\n"; + name => 'action', + value => $r->maketext('Show Past Answers'), + class => 'btn btn-primary' + })), + "\n"; print CGI::end_form(); } @@ -2551,22 +2583,20 @@ sub body { #Gateways are special. We only provide the first problem just to seed the data, but all of the problems from the #gateway will be provided to the achievement evaluator if ($ce->{achievementsEnabled} && $will{recordAnswers} && $submitAnswers && $set->set_id ne 'Undefined_Set') { - print WeBWorK::AchievementEvaluator::checkForAchievements($problems[0], - $pg_results[0], $r, setVersion=>$versionNumber); + print WeBWorK::AchievementEvaluator::checkForAchievements($problems[0], + $pg_results[0], $r, setVersion => $versionNumber); } return ""; } - ########################################################################### # Evaluation utilities ############################################################################ sub getProblemHTML { - my ($self, $EffectiveUser, $set, $formFields, - $mergedProblem, $pgFile) = @_; + my ($self, $EffectiveUser, $set, $formFields, $mergedProblem, $pgFile) = @_; # in: $EffectiveUser is the effective user we're working as, $set is the # merged set version, %$formFields the form fields from the input form # that we need to worry about putting into the HTML we're generating, @@ -2574,23 +2604,23 @@ sub getProblemHTML { # $pgFile is optional # out: the translated problem is returned - my $r = $self->r; - my $ce = $r->ce; - my $db = $r->db; - my $key = $r->param('key'); - my $setName = $set->set_id; + my $r = $self->r; + my $ce = $r->ce; + my $db = $r->db; + my $key = $r->param('key'); + my $setName = $set->set_id; my $setVersionNumber = $set->version_id; - my $permissionLevel = $self->{permissionLevel}; - my $psvn = $set->psvn(); + my $permissionLevel = $self->{permissionLevel}; + my $psvn = $set->psvn(); if (defined($mergedProblem) && $mergedProblem->problem_id) { # nothing needs to be done } elsif ($pgFile) { $mergedProblem = WeBWorK::DB::Record::ProblemVersion->new( - set_id => $setName, - version_id => $setVersionNumber, - problem_id => 0, - login_id => $EffectiveUser->user_id, + set_id => $setName, + version_id => $setVersionNumber, + problem_id => 0, + login_id => $EffectiveUser->user_id, source_file => $pgFile, # the rest of Problem's fields are not needed, i think ); @@ -2627,31 +2657,32 @@ sub getProblemHTML { }, )); - # FIXME is problem_id the correct thing in the following two stanzas? # FIXME the original version had "problem number", which is what we want. # FIXME I think problem_id will work, too if ($pg->{warnings} ne "") { - push @{$self->{warnings}}, { - set => "$setName,v$setVersionNumber", - problem => $mergedProblem->problem_id, - message => $pg->{warnings}, - }; + push @{ $self->{warnings} }, + { + set => "$setName,v$setVersionNumber", + problem => $mergedProblem->problem_id, + message => $pg->{warnings}, + }; } if ($pg->{flags}->{error_flag}) { - push @{$self->{errors}}, { - set => "$setName,v$setVersionNumber", - problem => $mergedProblem->problem_id, - message => $pg->{errors}, - context => $pg->{body_text}, - }; + push @{ $self->{errors} }, + { + set => "$setName,v$setVersionNumber", + problem => $mergedProblem->problem_id, + message => $pg->{errors}, + context => $pg->{body_text}, + }; # if there was an error, body_text contains # the error context, not TeX code $pg->{body_text} = undef; } - return $pg; + return $pg; } sub output_JS { diff --git a/lib/WeBWorK/ContentGenerator/Grades.pm b/lib/WeBWorK/ContentGenerator/Grades.pm index 6fe2676129..db8c5382e8 100644 --- a/lib/WeBWorK/ContentGenerator/Grades.pm +++ b/lib/WeBWorK/ContentGenerator/Grades.pm @@ -292,7 +292,10 @@ sub displayStudentStats { push( @rows, CGI::Tr( - CGI::td({ dir => 'ltr' }, format_set_name_display($setID) . ' (version ' . $set->version_id . ')'), + CGI::td( + { dir => 'ltr' }, + format_set_name_display($setID) . ' (version ' . $set->version_id . ')' + ), CGI::td( { colspan => $max_problems + 3 }, CGI::em($r->maketext('Display of scores for this set is not allowed.')) @@ -332,8 +335,7 @@ sub displayStudentStats { my $score = defined $problem_scores->[$i] && $show_problem_scores ? $problem_scores->[$i] : ''; $cgi_prob_scores[$i] = CGI::td( { class => 'problem-data' }, - CGI::span( - { class => $score eq '100' ? 'correct' : $score eq ' . ' ? 'unattempted' : '' }, + CGI::span({ class => $score eq '100' ? 'correct' : $score eq ' . ' ? 'unattempted' : '' }, $score) . CGI::br() . ( diff --git a/lib/WeBWorK/ContentGenerator/Hardcopy.pm b/lib/WeBWorK/ContentGenerator/Hardcopy.pm index 6f44dc9c22..d2d5dc3285 100644 --- a/lib/WeBWorK/ContentGenerator/Hardcopy.pm +++ b/lib/WeBWorK/ContentGenerator/Hardcopy.pm @@ -59,8 +59,8 @@ our $PreserveTempFiles = 0 unless defined $PreserveTempFiles; =cut -our $HC_DEFAULT_FORMAT = "pdf"; # problems if this is not an allowed format for the user... -our %HC_FORMATS = ( +our $HC_DEFAULT_FORMAT = "pdf"; # problems if this is not an allowed format for the user... +our %HC_FORMATS = ( tex => { name => x("TeX Source"), subr => "generate_hardcopy_tex", file_type => 'application/zip' }, pdf => { name => x("Adobe PDF"), subr => "generate_hardcopy_pdf", file_type => 'application/pdf' }, ); @@ -300,8 +300,8 @@ sub pre_header_initialize { my $tempFile = $r->param('tempFilePath'); if ($tempFile) { - my $courseID = $r->urlpath->arg('courseID'); - my $baseName = $tempFile =~ s/.*\/([^\/]*)$/$1/r; + my $courseID = $r->urlpath->arg('courseID'); + my $baseName = $tempFile =~ s/.*\/([^\/]*)$/$1/r; my $fullFilePath = "$ce->{webworkDirs}{tmp}/$courseID/hardcopy/$userID/$tempFile"; unless (-e $fullFilePath) { @@ -335,8 +335,8 @@ sub body { $perm_view_errors = defined $perm_view_errors ? $perm_view_errors : 0; if (my $num = $self->get_errors) { - my $file_path = $self->{file_path}; - my %temp_file_map = %{ $self->{temp_file_map} // {} }; + my $file_path = $self->{file_path}; + my %temp_file_map = %{ $self->{temp_file_map} // {} }; if ($perm_view_errors) { print CGI::p($r->maketext('[quant,_1,error] occured while generating hardcopy:', $num)); @@ -407,12 +407,12 @@ sub body { } sub display_form { - my ($self) = @_; - my $r = $self->r; - my $db = $r->db; - my $ce = $r->ce; - my $authz = $r->authz; - my $userID = $r->param("user"); + my ($self) = @_; + my $r = $self->r; + my $db = $r->db; + my $ce = $r->ce; + my $authz = $r->authz; + my $userID = $r->param("user"); my $eUserID = $r->param("effectiveUser"); # first time we show up here, fill in some values @@ -421,7 +421,8 @@ sub display_form { my $singleSet = $r->urlpath->arg("setID"); if (defined $singleSet and $singleSet ne "") { my @selected_sets = $r->param("selected_sets"); - $r->param("selected_sets" => [ @selected_sets, $singleSet]) unless grep { $_ eq $singleSet } @selected_sets; + $r->param("selected_sets" => [ @selected_sets, $singleSet ]) + unless grep { $_ eq $singleSet } @selected_sets; } # if no users are selected, select the effective user @@ -431,13 +432,13 @@ sub display_form { } } - my $perm_multiset = $authz->hasPermissions($userID, "download_hardcopy_multiset"); - my $perm_multiuser = $authz->hasPermissions($userID, "download_hardcopy_multiuser"); - my $perm_texformat = $authz->hasPermissions($userID, "download_hardcopy_format_tex"); - my $perm_change_theme = $authz->hasPermissions($userID, "download_hardcopy_change_theme"); - my $perm_unopened = $authz->hasPermissions($userID, "view_unopened_sets"); - my $perm_view_hidden = $authz->hasPermissions($userID, "view_hidden_sets"); - my $perm_view_answers = $authz->hasPermissions($userID, "show_correct_answers_before_answer_date"); + my $perm_multiset = $authz->hasPermissions($userID, "download_hardcopy_multiset"); + my $perm_multiuser = $authz->hasPermissions($userID, "download_hardcopy_multiuser"); + my $perm_texformat = $authz->hasPermissions($userID, "download_hardcopy_format_tex"); + my $perm_change_theme = $authz->hasPermissions($userID, "download_hardcopy_change_theme"); + my $perm_unopened = $authz->hasPermissions($userID, "view_unopened_sets"); + my $perm_view_hidden = $authz->hasPermissions($userID, "view_hidden_sets"); + my $perm_view_answers = $authz->hasPermissions($userID, "show_correct_answers_before_answer_date"); my $perm_view_solutions = $authz->hasPermissions($userID, "show_solutions_before_answer_date"); # get formats @@ -449,12 +450,12 @@ sub display_form { # get format names hash for radio buttons my %format_labels = map { $_ => $r->maketext($HC_FORMATS{$_}{name}) || $_ } @formats; - print CGI::start_form(-name=>"hardcopy-form", -id=>"hardcopy-form", -method=>"POST", -action=>$r->uri); + print CGI::start_form(-name => "hardcopy-form", -id => "hardcopy-form", -method => "POST", -action => $r->uri); print $self->hidden_authen_fields(); print CGI::hidden("in_hc_form", 1); my $canShowCorrectAnswers = 0; - my $canShowSolutions = 0; + my $canShowSolutions = 0; if ($perm_multiuser and $perm_multiset) { # Get all users for selection. @@ -507,7 +508,7 @@ sub display_form { default_sort => 'lnfn', default_format => 'lnfn_uid', default_filters => ['all'], - attrs => { + attrs => { size => 20, multiple => $perm_multiuser } @@ -529,7 +530,7 @@ sub display_form { default_sort => 'set_id', default_format => 'sid', default_filters => ['all'], - attrs => { + attrs => { size => 20, multiple => $perm_multiset, dir => 'ltr' @@ -602,7 +603,7 @@ sub display_form { # Using maketext on the next line would trigger errors when a local hardcopyTheme is installed. # my %hardcopyThemeNames = map {$_ => $r->maketext($ce->{hardcopyThemeNames}->{$_})} @{$ce->{hardcopyThemes}}; - my %hardcopyThemeNames = map {$_ => $ce->{hardcopyThemeNames}->{$_}} @{$ce->{hardcopyThemes}}; + my %hardcopyThemeNames = map { $_ => $ce->{hardcopyThemeNames}->{$_} } @{ $ce->{hardcopyThemes} }; print CGI::div( { class => 'row' }, @@ -742,8 +743,8 @@ sub display_form { CGI::submit({ name => "generate_hardcopy", value => $perm_multiuser - ? $r->maketext("Generate hardcopy for selected sets and selected users") - : $r->maketext("Generate Hardcopy"), + ? $r->maketext("Generate hardcopy for selected sets and selected users") + : $r->maketext("Generate Hardcopy"), class => 'btn btn-primary' }) ) @@ -766,7 +767,7 @@ sub generate_hardcopy { my $authz = $r->authz; my $courseID = $r->urlpath->arg('courseID'); - my $userID = $r->param('user'); + my $userID = $r->param('user'); # Create the temporary directory. Use mkpath to ensure it exists (mkpath is pretty much `mkdir -p`). my $temp_dir_parent_path = "$ce->{webworkDirs}{tmp}/$courseID/hardcopy/$userID"; @@ -850,7 +851,7 @@ sub generate_hardcopy { # Calculate paths for each temp file of interest. These paths are relative to the $temp_dir_parent_path. # makeTempDirectory's interface forces us to reverse-engineer the relative temp dir path from the absolute path. my $temp_dir_rel_path = $temp_dir_path =~ s/^$temp_dir_parent_path\///r; - my %temp_file_map = map { $_ => "$temp_dir_rel_path/$_" } @temp_files; + my %temp_file_map = map { $_ => "$temp_dir_rel_path/$_" } @temp_files; # Make sure the final file exists. unless (-e $final_file_path) { @@ -923,37 +924,46 @@ sub delete_temp_dir { sub generate_hardcopy_tex { my ($self, $temp_dir_path, $final_file_basename) = @_; - my $src_name = "hardcopy.tex"; + my $src_name = "hardcopy.tex"; my $bundle_path = "$temp_dir_path/$final_file_basename"; # Create directory for the tex bundle if (!mkdir $bundle_path) { - $self->add_errors("Failed to create directory '" . CGI::code(CGI::escapeHTML($bundle_path)) . "': " . - CGI::br() . CGI::pre(CGI::escapeHTML($!))); + $self->add_errors("Failed to create directory '" + . CGI::code(CGI::escapeHTML($bundle_path)) . "': " + . CGI::br() + . CGI::pre(CGI::escapeHTML($!))); return $src_name; } # Move the tex file into the bundle directory - my $mv_cmd = "2>&1 " . $self->r->ce->{externalPrograms}{mv} . " " . - shell_quote("$temp_dir_path/$src_name", $bundle_path); + my $mv_cmd = + "2>&1 " . $self->r->ce->{externalPrograms}{mv} . " " . shell_quote("$temp_dir_path/$src_name", $bundle_path); my $mv_out = readpipe $mv_cmd; if ($?) { - $self->add_errors("Failed to move '" . CGI::code(CGI::escapeHTML($src_name)) . "' into directory '" - . CGI::code(CGI::escapeHTML($bundle_path)) . "':" . CGI::br() - . CGI::pre(CGI::escapeHTML($mv_out))); + $self->add_errors("Failed to move '" + . CGI::code(CGI::escapeHTML($src_name)) + . "' into directory '" + . CGI::code(CGI::escapeHTML($bundle_path)) . "':" + . CGI::br() + . CGI::pre(CGI::escapeHTML($mv_out))); return $src_name; } # Copy the common tex files into the bundle directory my $ce = $self->r->ce; for (qw{packages.tex CAPA.tex PGML.tex}) { - my $cp_cmd = "2>&1 $ce->{externalPrograms}{cp} " . shell_quote("$ce->{webworkDirs}{texinputs_common}/$_", $bundle_path); + my $cp_cmd = + "2>&1 $ce->{externalPrograms}{cp} " . shell_quote("$ce->{webworkDirs}{texinputs_common}/$_", $bundle_path); my $cp_out = readpipe $cp_cmd; if ($?) { - $self->add_errors("Failed to copy '" . CGI::code(CGI::escapeHTML("$ce->{webworkDirs}{texinputs_common}/$_")) . - "' into directory '" . CGI::code(CGI::escapeHTML($bundle_path)) . "':" . CGI::br() - . CGI::pre(CGI::escapeHTML($cp_out))); + $self->add_errors("Failed to copy '" + . CGI::code(CGI::escapeHTML("$ce->{webworkDirs}{texinputs_common}/$_")) + . "' into directory '" + . CGI::code(CGI::escapeHTML($bundle_path)) . "':" + . CGI::br() + . CGI::pre(CGI::escapeHTML($cp_out))); } } @@ -961,7 +971,7 @@ sub generate_hardcopy_tex { # For security reasons only files in the $ce->{courseDirs}{html_temp}/images are included. # The file names of the images are only allowed to contain alphanumeric characters, underscores, dashes, and # periods. No spaces or slashes, etc. This will usually be all of the included images. - if (open(my $in_fh, "<", "$bundle_path/$src_name")) { + if (open(my $in_fh, "<", "$bundle_path/$src_name")) { local $/; my $data = <$in_fh>; close($in_fh); @@ -981,20 +991,25 @@ sub generate_hardcopy_tex { for (@image_files) { # This is a little protection in case a student enters an answer like # \includegraphics[]{$ce->{courseDirs}{html_temp}/images/malicious code or absolute system file name} - $self->add_errors("Unable to safely copy image '" . CGI::code(CGI::escapeHTML("$image_tmp_dir$_")) . - "' into directory '" . CGI::code(CGI::escapeHTML($bundle_path)) . "'."), - warn "Invalid image file name '$_' detected. Possible malicious activity?", - next unless $_ =~ /^[\w._-]*$/ && -f "$image_tmp_dir$_"; + $self->add_errors("Unable to safely copy image '" + . CGI::code(CGI::escapeHTML("$image_tmp_dir$_")) + . "' into directory '" + . CGI::code(CGI::escapeHTML($bundle_path)) + . "'."), warn "Invalid image file name '$_' detected. Possible malicious activity?", next + unless $_ =~ /^[\w._-]*$/ && -f "$image_tmp_dir$_"; # Copy the image file into the bundle directory. my $cp_cmd = "2>&1 $ce->{externalPrograms}{cp} " . shell_quote("$image_tmp_dir$_", $bundle_path); my $cp_out = readpipe $cp_cmd; if ($?) { - $self->add_errors("Failed to copy image '" . CGI::code(CGI::escapeHTML("$image_tmp_dir$_")) . - "' into directory '" . CGI::code(CGI::escapeHTML($bundle_path)) . "':" . CGI::br() - . CGI::pre(CGI::escapeHTML($cp_out))); + $self->add_errors("Failed to copy image '" + . CGI::code(CGI::escapeHTML("$image_tmp_dir$_")) + . "' into directory '" + . CGI::code(CGI::escapeHTML($bundle_path)) . "':" + . CGI::br() + . CGI::pre(CGI::escapeHTML($cp_out))); } - } + } } else { $self->add_errors("Failed to open '" . CGI::code(CGI::escapeHTML("$bundle_path/$src_name")) . "' for reading."); } @@ -1005,8 +1020,8 @@ sub generate_hardcopy_tex { my $zip_file = "$final_file_basename.zip"; unless ($zip->writeToFileNamed("$temp_dir_path/$zip_file") == AZ_OK) { - $self->add_errors("Failed to create zip archive of directory '" . - CGI::code(CGI::escapeHTML($bundle_path)) . "'"); + $self->add_errors( + "Failed to create zip archive of directory '" . CGI::code(CGI::escapeHTML($bundle_path)) . "'"); return "$bundle_path/$src_name"; } @@ -1018,16 +1033,19 @@ sub generate_hardcopy_pdf { # call pdflatex - we don't want to chdir in the mod_perl process, as # that might step on the feet of other things (esp. in Apache 2.0) - my $pdflatex_cmd = "cd " . shell_quote($temp_dir_path) . " && " - . "TEXINPUTS=.:" . shell_quote($self->r->ce->{webworkDirs}{texinputs_common}) . ": " + my $pdflatex_cmd = "cd " + . shell_quote($temp_dir_path) . " && " + . "TEXINPUTS=.:" + . shell_quote($self->r->ce->{webworkDirs}{texinputs_common}) . ": " . $self->r->ce->{externalPrograms}{pdflatex} . " >pdflatex.stdout 2>pdflatex.stderr hardcopy"; if (my $rawexit = system $pdflatex_cmd) { - my $exit = $rawexit >> 8; + my $exit = $rawexit >> 8; my $signal = $rawexit & 127; - my $core = $rawexit & 128; + my $core = $rawexit & 128; $self->add_errors("Failed to convert TeX to PDF with command '" - .CGI::code(CGI::escapeHTML($pdflatex_cmd))."' (exit=$exit signal=$signal core=$core)."); + . CGI::code(CGI::escapeHTML($pdflatex_cmd)) + . "' (exit=$exit signal=$signal core=$core)."); # read hardcopy.log and report first error my $hardcopy_log = "$temp_dir_path/hardcopy.log"; @@ -1044,13 +1062,13 @@ sub generate_hardcopy_pdf { } close $LOG; if (defined $first_error) { - $self->add_errors("First error in TeX log is:".CGI::br(). - CGI::pre(CGI::escapeHTML($first_error))); + $self->add_errors( + "First error in TeX log is:" . CGI::br() . CGI::pre(CGI::escapeHTML($first_error))); } else { $self->add_errors("No errors encoundered in TeX log."); } } else { - $self->add_errors("Could not read TeX log: ".CGI::code(CGI::escapeHTML($!))); + $self->add_errors("Could not read TeX log: " . CGI::code(CGI::escapeHTML($!))); } } else { $self->add_errors("No TeX log was found."); @@ -1060,15 +1078,21 @@ sub generate_hardcopy_pdf { my $final_file_name; # try rename the pdf file - my $src_name = "hardcopy.pdf"; + my $src_name = "hardcopy.pdf"; my $dest_name = "$final_file_basename.pdf"; - my $mv_cmd = "2>&1 " . $self->r->ce->{externalPrograms}{mv} . " " . shell_quote("$temp_dir_path/$src_name", "$temp_dir_path/$dest_name"); + my $mv_cmd = "2>&1 " + . $self->r->ce->{externalPrograms}{mv} . " " + . shell_quote("$temp_dir_path/$src_name", "$temp_dir_path/$dest_name"); my $mv_out = readpipe $mv_cmd; if ($?) { - $self->add_errors("Failed to rename '".CGI::code(CGI::escapeHTML($src_name))."' to '" - .CGI::code(CGI::escapeHTML($dest_name))."' in directory '" - .CGI::code(CGI::escapeHTML($temp_dir_path))."':".CGI::br() - .CGI::pre(CGI::escapeHTML($mv_out))); + $self->add_errors("Failed to rename '" + . CGI::code(CGI::escapeHTML($src_name)) + . "' to '" + . CGI::code(CGI::escapeHTML($dest_name)) + . "' in directory '" + . CGI::code(CGI::escapeHTML($temp_dir_path)) . "':" + . CGI::br() + . CGI::pre(CGI::escapeHTML($mv_out))); $final_file_name = $src_name; } else { $final_file_name = $dest_name; @@ -1083,26 +1107,26 @@ sub generate_hardcopy_pdf { sub write_multiuser_tex { my ($self, $FH, $userIDsRef, $setIDsRef) = @_; - my $r = $self->r; + my $r = $self->r; my $ce = $r->ce; my @userIDs = @$userIDsRef; - my @setIDs = @$setIDsRef; + my @setIDs = @$setIDsRef; # get snippets - my $theme = $r->param('hardcopy_theme') // $ce->{hardcopyTheme}; - my $themeDir = $ce->{webworkDirs}->{conf}.'/snippets/hardcopyThemes/'.$theme; - my $preamble = $ce->{webworkFiles}->{hardcopySnippets}->{preamble} // "$themeDir/hardcopyPreamble.tex"; - my $postamble = $ce->{webworkFiles}->{hardcopySnippets}->{postamble} // "$themeDir/hardcopyPostamble.tex"; - my $divider = $ce->{webworkFiles}->{hardcopySnippets}->{userDivider} // "$themeDir/hardcopyUserDivider.tex"; + my $theme = $r->param('hardcopy_theme') // $ce->{hardcopyTheme}; + my $themeDir = $ce->{webworkDirs}->{conf} . '/snippets/hardcopyThemes/' . $theme; + my $preamble = $ce->{webworkFiles}->{hardcopySnippets}->{preamble} // "$themeDir/hardcopyPreamble.tex"; + my $postamble = $ce->{webworkFiles}->{hardcopySnippets}->{postamble} // "$themeDir/hardcopyPostamble.tex"; + my $divider = $ce->{webworkFiles}->{hardcopySnippets}->{userDivider} // "$themeDir/hardcopyUserDivider.tex"; # write preamble $self->write_tex_file($FH, $preamble); # write section for each user - while (defined (my $userID = shift @userIDs)) { + while (defined(my $userID = shift @userIDs)) { $self->write_multiset_tex($FH, $userID, @setIDs); - $self->write_tex_file($FH, $divider) if @userIDs; # divide users, but not after the last user + $self->write_tex_file($FH, $divider) if @userIDs; # divide users, but not after the last user } # write postamble @@ -1111,91 +1135,99 @@ sub write_multiuser_tex { sub write_multiset_tex { my ($self, $FH, $targetUserID, @setIDs) = @_; - my $r = $self->r; + my $r = $self->r; my $ce = $r->ce; my $db = $r->db; # get user record - my $TargetUser = $db->getUser($targetUserID); # checked + my $TargetUser = $db->getUser($targetUserID); # checked unless ($TargetUser) { - $self->add_errors("Can't generate hardcopy for user '".CGI::code(CGI::escapeHTML($targetUserID))."' -- no such user exists.\n"); + $self->add_errors("Can't generate hardcopy for user '" + . CGI::code(CGI::escapeHTML($targetUserID)) + . "' -- no such user exists.\n"); return; } # get set divider - my $theme = $r->param('hardcopy_theme') // $ce->{hardcopyTheme}; - my $themeDir = $ce->{webworkDirs}->{conf}.'/snippets/hardcopyThemes/'.$theme; - my $divider = $ce->{webworkFiles}->{hardcopySnippets}->{setDivider} // "$themeDir/hardcopySetDivider.tex"; + my $theme = $r->param('hardcopy_theme') // $ce->{hardcopyTheme}; + my $themeDir = $ce->{webworkDirs}->{conf} . '/snippets/hardcopyThemes/' . $theme; + my $divider = $ce->{webworkFiles}->{hardcopySnippets}->{setDivider} // "$themeDir/hardcopySetDivider.tex"; # write each set - while (defined (my $setID = shift @setIDs)) { + while (defined(my $setID = shift @setIDs)) { $self->write_set_tex($FH, $TargetUser, $setID); - $self->write_tex_file($FH, $divider) if @setIDs; # divide sets, but not after the last set + $self->write_tex_file($FH, $divider) if @setIDs; # divide sets, but not after the last set } } sub write_set_tex { my ($self, $FH, $TargetUser, $setID) = @_; - my $r = $self->r; - my $ce = $r->ce; - my $db = $r->db; + my $r = $self->r; + my $ce = $r->ce; + my $db = $r->db; my $authz = $r->authz; my $userID = $r->param("user"); # we may already have the MergedSet from checking hide_work and # hide_score in pre_header_initialize; check to see if that's true, # and otherwise, get the set. - my %mergedSets = %{$self->{mergedSets}}; - my $uid = $TargetUser->user_id; + my %mergedSets = %{ $self->{mergedSets} }; + my $uid = $TargetUser->user_id; my $MergedSet; my $versioned = 0; - if ( defined( $mergedSets{"$uid!$setID"} ) ) { + if (defined($mergedSets{"$uid!$setID"})) { $MergedSet = $mergedSets{"$uid!$setID"}; $versioned = ($setID =~ /,v(\d+)$/) ? $1 : 0; } else { - if ( $setID =~ /(.+),v(\d+)$/ ) { - $setID = $1; + if ($setID =~ /(.+),v(\d+)$/) { + $setID = $1; $versioned = $2; } - if ( $versioned ) { + if ($versioned) { $MergedSet = $db->getMergedSetVersion($TargetUser->user_id, $setID, $versioned); } else { - $MergedSet = $db->getMergedSet($TargetUser->user_id, $setID); # checked + $MergedSet = $db->getMergedSet($TargetUser->user_id, $setID); # checked } } # save versioned info for use in write_problem_tex $self->{versioned} = $versioned; unless ($MergedSet) { - $self->add_errors("Can't generate hardcopy for set ''".CGI::code(CGI::escapeHTML($setID)) - ."' for user '".CGI::code(CGI::escapeHTML($TargetUser->user_id)) - ."' -- set is not assigned to that user."); + $self->add_errors("Can't generate hardcopy for set ''" + . CGI::code(CGI::escapeHTML($setID)) + . "' for user '" + . CGI::code(CGI::escapeHTML($TargetUser->user_id)) + . "' -- set is not assigned to that user."); return; } # see if the *real* user is allowed to access this problem set if ($MergedSet->open_date > time and not $authz->hasPermissions($userID, "view_unopened_sets")) { - $self->add_errors("Can't generate hardcopy for set '".CGI::code(CGI::escapeHTML($setID)) - ."' for user '".CGI::code(CGI::escapeHTML($TargetUser->user_id)) - ."' -- set is not yet open."); + $self->add_errors("Can't generate hardcopy for set '" + . CGI::code(CGI::escapeHTML($setID)) + . "' for user '" + . CGI::code(CGI::escapeHTML($TargetUser->user_id)) + . "' -- set is not yet open."); return; } if (not $MergedSet->visible and not $authz->hasPermissions($userID, "view_hidden_sets")) { - $self->addbadmessage("Can't generate hardcopy for set '".CGI::code(CGI::escapeHTML($setID)) - ."' for user '".CGI::code(CGI::escapeHTML($TargetUser->user_id)) - ."' -- set is not visible to students."); + $self->addbadmessage("Can't generate hardcopy for set '" + . CGI::code(CGI::escapeHTML($setID)) + . "' for user '" + . CGI::code(CGI::escapeHTML($TargetUser->user_id)) + . "' -- set is not visible to students."); return; } # get snippets - my $theme = $r->param('hardcopy_theme') // $ce->{hardcopyTheme}; - my $themeDir = $ce->{webworkDirs}->{conf}.'/snippets/hardcopyThemes/'.$theme; - my $header = $MergedSet->hardcopy_header + my $theme = $r->param('hardcopy_theme') // $ce->{hardcopyTheme}; + my $themeDir = $ce->{webworkDirs}->{conf} . '/snippets/hardcopyThemes/' . $theme; + my $header = + $MergedSet->hardcopy_header ? $MergedSet->hardcopy_header : $ce->{webworkFiles}->{hardcopySnippets}->{setHeader}; - if ($header eq 'defaultHeader') {$header = $ce->{webworkFiles}->{hardcopySnippets}->{setHeader};} - my $footer = $ce->{webworkFiles}->{hardcopySnippets}->{setFooter} // - "$themeDir/hardcopySetFooter.pg"; + if ($header eq 'defaultHeader') { $header = $ce->{webworkFiles}->{hardcopySnippets}->{setHeader}; } + my $footer = $ce->{webworkFiles}->{hardcopySnippets}->{setFooter} // "$themeDir/hardcopySetFooter.pg"; my $divider = $ce->{webworkFiles}->{hardcopySnippets}->{problemDivider} // "$themeDir/hardcopyProblemDivider.tex"; # get list of problem IDs @@ -1204,25 +1236,26 @@ sub write_set_tex { # for versioned sets (gateways), we might have problems in a random # order; reset the order of the problemIDs if this is the case - if ( defined( $MergedSet->problem_randorder ) && - $MergedSet->problem_randorder ) { + if (defined($MergedSet->problem_randorder) + && $MergedSet->problem_randorder) + { my @newOrder = (); # to set the same order each time we set the random seed to the psvn, # and to avoid messing with the system random number generator we use # our own PGrandom object my $pgrand = PGrandom->new(); - $pgrand->srand( $MergedSet->psvn ); - while ( @problemIDs ) { + $pgrand->srand($MergedSet->psvn); + while (@problemIDs) { my $i = int($pgrand->rand(scalar(@problemIDs))); - push( @newOrder, $problemIDs[$i] ); + push(@newOrder, $problemIDs[$i]); splice(@problemIDs, $i, 1); } @problemIDs = @newOrder; } # write set header - $self->write_problem_tex($FH, $TargetUser, $MergedSet, 0, $header); # 0 => pg file specified directly + $self->write_problem_tex($FH, $TargetUser, $MergedSet, 0, $header); # 0 => pg file specified directly print $FH "\\medskip\\hrule\\nobreak\\smallskip"; @@ -1232,25 +1265,25 @@ sub write_set_tex { my $i = 1; while (my $problemID = shift @problemIDs) { $self->write_tex_file($FH, $divider) if $i > 1; - $self->{versioned} = $i if $versioned; + $self->{versioned} = $i if $versioned; $self->write_problem_tex($FH, $TargetUser, $MergedSet, $problemID); $i++; } # write footer - $self->write_problem_tex($FH, $TargetUser, $MergedSet, 0, $footer); # 0 => pg file specified directly + $self->write_problem_tex($FH, $TargetUser, $MergedSet, 0, $footer); # 0 => pg file specified directly } sub write_problem_tex { my ($self, $FH, $TargetUser, $MergedSet, $problemID, $pgFile) = @_; - my $r = $self->r; - my $ce = $r->ce; - my $db = $r->db; - my $authz = $r->authz; - my $userID = $r->param("user"); - my $eUserID = $r->param("effectiveUser"); - my $versioned = $self->{versioned}; - my %canShowScore = %{$self->{canShowScore}}; + my $r = $self->r; + my $ce = $r->ce; + my $db = $r->db; + my $authz = $r->authz; + my $userID = $r->param("user"); + my $eUserID = $r->param("effectiveUser"); + my $versioned = $self->{versioned}; + my %canShowScore = %{ $self->{canShowScore} }; my @errors; @@ -1258,33 +1291,37 @@ sub write_problem_tex { my $MergedProblem; if ($problemID) { # a non-zero problem ID was given -- load that problem - # we use $versioned to determine which merging routine to use - if ( $versioned ) { - $MergedProblem = $db->getMergedProblemVersion($MergedSet->user_id, $MergedSet->set_id, $MergedSet->version_id, $problemID); + # we use $versioned to determine which merging routine to use + if ($versioned) { + $MergedProblem = + $db->getMergedProblemVersion($MergedSet->user_id, $MergedSet->set_id, $MergedSet->version_id, + $problemID); } else { - $MergedProblem = $db->getMergedProblem($MergedSet->user_id, $MergedSet->set_id, $problemID); # checked + $MergedProblem = $db->getMergedProblem($MergedSet->user_id, $MergedSet->set_id, $problemID); # checked } # handle nonexistent problem unless ($MergedProblem) { $self->add_errors("Can't generate hardcopy for problem '" - .CGI::code(CGI::escapeHTML($problemID))."' in set '" - .CGI::code(CGI::escapeHTML($MergedSet->set_id)) - ."' for user '".CGI::code(CGI::escapeHTML($MergedSet->user_id)) - ."' -- problem does not exist in that set or is not assigned to that user."); + . CGI::code(CGI::escapeHTML($problemID)) + . "' in set '" + . CGI::code(CGI::escapeHTML($MergedSet->set_id)) + . "' for user '" + . CGI::code(CGI::escapeHTML($MergedSet->user_id)) + . "' -- problem does not exist in that set or is not assigned to that user."); return; } } elsif ($pgFile) { # otherwise, we try an explicit PG file $MergedProblem = $db->newUserProblem( - user_id => $MergedSet->user_id, - set_id => $MergedSet->set_id, - problem_id => 0, - source_file => $pgFile, + user_id => $MergedSet->user_id, + set_id => $MergedSet->set_id, + problem_id => 0, + source_file => $pgFile, num_correct => 0, num_incorrect => 0, ); - die "newUserProblem failed -- WTF?" unless $MergedProblem; # this should never happen + die "newUserProblem failed -- WTF?" unless $MergedProblem; # this should never happen } else { # this shouldn't happen -- error out for real die "write_problem_tex needs either a non-zero \$problemID or a \$pgFile"; @@ -1292,8 +1329,7 @@ sub write_problem_tex { # figure out if we're allowed to get correct answers, hints, and solutions # (eventually, we'd like to be able to use the same code as Problem) - my $versionName = $MergedSet->set_id . - (( $versioned ) ? ",v" . $MergedSet->version_id : ''); + my $versionName = $MergedSet->set_id . (($versioned) ? ",v" . $MergedSet->version_id : ''); my $showCorrectAnswers = $r->param("showCorrectAnswers") || 0; my $printStudentAnswers = $r->param("printStudentAnswers") || 0; @@ -1301,14 +1337,20 @@ sub write_problem_tex { my $showSolutions = $r->param("showSolutions") || 0; my $showComments = $r->param("showComments") || 0; - unless( ( $authz->hasPermissions($userID, "show_correct_answers_before_answer_date") or - ( time > $MergedSet->answer_date or - ( $versioned && - $MergedProblem->num_correct + - $MergedProblem->num_incorrect >= - $MergedSet->attempts_per_version && - $MergedSet->due_date == $MergedSet->answer_date ) ) ) && - ( $canShowScore{$MergedSet->user_id . "!$versionName"} ) ) { + unless ( + ( + $authz->hasPermissions($userID, "show_correct_answers_before_answer_date") + or ( + time > $MergedSet->answer_date + or ($versioned + && $MergedProblem->num_correct + $MergedProblem->num_incorrect >= + $MergedSet->attempts_per_version + && $MergedSet->due_date == $MergedSet->answer_date) + ) + ) + && ($canShowScore{ $MergedSet->user_id . "!$versionName" }) + ) + { $showCorrectAnswers = 0; $showSolutions = 0; } @@ -1360,7 +1402,8 @@ sub write_problem_tex { if ($MergedProblem->problem_id == 0) { # link for an fake problem (like a header file) - $edit_url = $self->systemLink($edit_urlpath, + $edit_url = $self->systemLink( + $edit_urlpath, params => { sourceFilePath => $MergedProblem->source_file, problemSeed => $MergedProblem->problem_seed, @@ -1373,28 +1416,47 @@ sub write_problem_tex { if ($MergedProblem->problem_id == 0) { $problem_name = "snippet"; - $problem_desc = $problem_name." '".$MergedProblem->source_file - ."' for set '".$MergedProblem->set_id."' and user '" - .$MergedProblem->user_id."'"; + $problem_desc = + $problem_name . " '" + . $MergedProblem->source_file + . "' for set '" + . $MergedProblem->set_id + . "' and user '" + . $MergedProblem->user_id . "'"; } else { $problem_name = "problem"; - $problem_desc = $problem_name." '".$MergedProblem->problem_id - ."' in set '".$MergedProblem->set_id."' for user '" - .$MergedProblem->user_id."'"; + $problem_desc = + $problem_name . " '" + . $MergedProblem->problem_id + . "' in set '" + . $MergedProblem->set_id + . "' for user '" + . $MergedProblem->user_id . "'"; } } # deal with PG warnings if ($pg->{warnings} ne "") { - $self->add_errors(CGI::a({href=>$edit_url, target=>"WW_Editor"}, $r->maketext("~[Edit~]")) - .' '.$r->maketext("Warnings encountered while processing [_1]. Error text: [_2]", $problem_desc , CGI::br().CGI::pre(CGI::escapeHTML($pg->{warnings}))) + $self->add_errors( + CGI::a({ href => $edit_url, target => "WW_Editor" }, $r->maketext("~[Edit~]")) . ' ' + . $r->maketext( + "Warnings encountered while processing [_1]. Error text: [_2]", + $problem_desc, + CGI::br() . CGI::pre(CGI::escapeHTML($pg->{warnings})) + ) ); } # deal with PG errors if ($pg->{flags}->{error_flag}) { - $self->add_errors(CGI::a({href=>$edit_url, target=>"WW_Editor"}, $r->maketext("~[Edit~]")).' ' - .$r->maketext("Errors encountered while processing [_1]. This [_2] has been omitted from the hardcopy. Error text: [_3]", $problem_desc, $problem_name, CGI::br().CGI::pre(CGI::escapeHTML($pg->{errors}))) + $self->add_errors( + CGI::a({ href => $edit_url, target => "WW_Editor" }, $r->maketext("~[Edit~]")) . ' ' + . $r->maketext( + "Errors encountered while processing [_1]. This [_2] has been omitted from the hardcopy. Error text: [_3]", + $problem_desc, + $problem_name, + CGI::br() . CGI::pre(CGI::escapeHTML($pg->{errors})) + ) ); return; } @@ -1407,11 +1469,12 @@ sub write_problem_tex { if ($problemID) { if (defined($MergedSet) && $MergedSet->assignment_type eq 'jitar') { # Use the pretty problem number if its a jitar problem - my $id = $MergedProblem->problem_id; - my $prettyID = join('.',jitar_id_to_seq($id)); + my $id = $MergedProblem->problem_id; + my $prettyID = join('.', jitar_id_to_seq($id)); print $FH "{\\bf " . $r->maketext("Problem [_1].", $prettyID) . "}"; } elsif ($MergedProblem->problem_id != 0) { - print $FH "{\\bf " . $r->maketext("Problem [_1].", $versioned ? $versioned : $MergedProblem->problem_id) . "}"; + print $FH "{\\bf " + . $r->maketext("Problem [_1].", $versioned ? $versioned : $MergedProblem->problem_id) . "}"; } my $problemValue = $MergedProblem->value; @@ -1429,41 +1492,47 @@ sub write_problem_tex { print $FH $body_text; - my @ans_entry_order = defined($pg->{flags}->{ANSWER_ENTRY_ORDER}) ? @{$pg->{flags}->{ANSWER_ENTRY_ORDER}} : ( ); + my @ans_entry_order = defined($pg->{flags}->{ANSWER_ENTRY_ORDER}) ? @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} } : (); # print the list of student answers if it is requested - if ( $printStudentAnswers && - $MergedProblem->problem_id != 0 && @ans_entry_order ) { - my $pgScore = $pg->{state}->{recorded_score}; - my $corrMsg = ' submitted: '; - if ( $pgScore == 1 ) { - $corrMsg .= $r->maketext('(correct)'); - } elsif ( $pgScore == 0 ) { - $corrMsg .= $r->maketext('(incorrect)'); - } else { - $corrMsg .= $r->maketext('(score [_1])',$pgScore); - } + if ($printStudentAnswers + && $MergedProblem->problem_id != 0 + && @ans_entry_order) + { + my $pgScore = $pg->{state}->{recorded_score}; + my $corrMsg = ' submitted: '; + if ($pgScore == 1) { + $corrMsg .= $r->maketext('(correct)'); + } elsif ($pgScore == 0) { + $corrMsg .= $r->maketext('(incorrect)'); + } else { + $corrMsg .= $r->maketext('(score [_1])', $pgScore); + } - $corrMsg .= "\n \\\\ \n recorded: "; - my $recScore = $MergedProblem->status; - if ( $recScore == 1 ) { - $corrMsg .= $r->maketext('(correct)'); - } elsif ( $recScore == 0 ) { - $corrMsg .= $r->maketext('(incorrect)'); - } else { - $corrMsg .= $r->maketext('(score [_1])',$recScore); - } + $corrMsg .= "\n \\\\ \n recorded: "; + my $recScore = $MergedProblem->status; + if ($recScore == 1) { + $corrMsg .= $r->maketext('(correct)'); + } elsif ($recScore == 0) { + $corrMsg .= $r->maketext('(incorrect)'); + } else { + $corrMsg .= $r->maketext('(score [_1])', $recScore); + } - my $stuAnswers = "\\par{\\small{\\it ". - $r->maketext("Answer(s) submitted:"). - "}\n" . - "\\vspace{-\\parskip}\\begin{itemize}\n"; - for my $ansName ( @ans_entry_order ) { + my $stuAnswers = + "\\par{\\small{\\it " + . $r->maketext("Answer(s) submitted:") . "}\n" + . "\\vspace{-\\parskip}\\begin{itemize}\n"; + for my $ansName (@ans_entry_order) { my $stuAns; - if (defined $pg->{answers}{$ansName}{preview_latex_string} && $pg->{answers}{$ansName}{preview_latex_string} ne '') { + if (defined $pg->{answers}{$ansName}{preview_latex_string} + && $pg->{answers}{$ansName}{preview_latex_string} ne '') + { $stuAns = $pg->{answers}{$ansName}{preview_latex_string}; - } elsif (defined $pg->{answers}{$ansName}{original_student_ans} && $pg->{answers}{$ansName}{original_student_ans} ne '') { - $stuAns = "\\text{".$pg->{answers}{$ansName}{original_student_ans}."}"; + } elsif (defined $pg->{answers}{$ansName}{original_student_ans} + && $pg->{answers}{$ansName}{original_student_ans} ne '') + { + $stuAns = "\\text{" . $pg->{answers}{$ansName}{original_student_ans} . "}"; } else { $stuAns = "\\text{no response}"; } @@ -1474,34 +1543,30 @@ sub write_problem_tex { } if ($showComments) { - my $userPastAnswerID = $db->latestProblemPastAnswer( - $r->urlpath->arg("courseID"), - $MergedProblem->user_id, - $versionName, - $MergedProblem->problem_id); - - my $pastAnswer = $userPastAnswerID ? $db->getPastAnswer($userPastAnswerID) : 0; - my $comment = $pastAnswer && $pastAnswer->comment_string ? $pastAnswer->comment_string : ""; - - my $commentMsg = "\\par{\\small{\\it ". - $r->maketext("Instructor Feedback:"). - "}\n". - "\\vspace{-\\parskip}\n". - "\\begin{lstlisting}\n$comment\\end{lstlisting}\n". - "\\par\n"; + my $userPastAnswerID = $db->latestProblemPastAnswer($r->urlpath->arg("courseID"), + $MergedProblem->user_id, $versionName, $MergedProblem->problem_id); + + my $pastAnswer = $userPastAnswerID ? $db->getPastAnswer($userPastAnswerID) : 0; + my $comment = $pastAnswer && $pastAnswer->comment_string ? $pastAnswer->comment_string : ""; + + my $commentMsg = + "\\par{\\small{\\it " + . $r->maketext("Instructor Feedback:") . "}\n" + . "\\vspace{-\\parskip}\n" + . "\\begin{lstlisting}\n$comment\\end{lstlisting}\n" + . "\\par\n"; print $FH $commentMsg if $comment; } # write the list of correct answers is appropriate; ANSWER_ENTRY_ORDER # isn't defined for versioned sets? this seems odd FIXME GWCHANGE if ($showCorrectAnswers && $MergedProblem->problem_id != 0 && @ans_entry_order) { - my $correctTeX = "\\par{\\small{\\it ". - $r->maketext("Correct Answers:"). - "}\n". - "\\vspace{-\\parskip}\\begin{itemize}\n"; + my $correctTeX = + "\\par{\\small{\\it " . $r->maketext("Correct Answers:") . "}\n" . "\\vspace{-\\parskip}\\begin{itemize}\n"; foreach my $ansName (@ans_entry_order) { - my $correctAnswer = $pg->{answers}{$ansName}{correct_ans_latex_string} || "\\text{".$pg->{answers}{$ansName}{correct_ans}."}"; + my $correctAnswer = $pg->{answers}{$ansName}{correct_ans_latex_string} + || "\\text{" . $pg->{answers}{$ansName}{correct_ans} . "}"; $correctTeX .= "\\item\n\$\\displaystyle $correctAnswer\$\n"; } @@ -1516,8 +1581,8 @@ sub write_tex_file { my $tex = eval { readFile($file) }; if ($@) { - $self->add_errors("Failed to include TeX file '".CGI::code(CGI::escapeHTML($file))."': " - .CGI::escapeHTML($@)); + $self->add_errors( + "Failed to include TeX file '" . CGI::code(CGI::escapeHTML($file)) . "': " . CGI::escapeHTML($@)); } else { print $FH $tex; } @@ -1529,12 +1594,12 @@ sub write_tex_file { sub add_errors { my ($self, @errors) = @_; - push @{$self->{hardcopy_errors}}, @errors; + push @{ $self->{hardcopy_errors} }, @errors; } sub get_errors { my ($self) = @_; - return $self->{hardcopy_errors} ? @{$self->{hardcopy_errors}} : (); + return $self->{hardcopy_errors} ? @{ $self->{hardcopy_errors} } : (); } sub get_errors_ref { diff --git a/lib/WeBWorK/ContentGenerator/Home.pm b/lib/WeBWorK/ContentGenerator/Home.pm index c57a676139..39090ec424 100644 --- a/lib/WeBWorK/ContentGenerator/Home.pm +++ b/lib/WeBWorK/ContentGenerator/Home.pm @@ -29,10 +29,11 @@ use WeBWorK::CGI; use WeBWorK::Utils qw(readFile readDirectory); use WeBWorK::Utils::CourseManagement qw/listCourses/; use WeBWorK::Localize; + sub info { my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; + my $r = $self->r; + my $ce = $r->ce; my $result; @@ -58,7 +59,7 @@ sub info { } if (defined $result and $result ne "") { - return CGI::h2($r->maketext("Site Information")). $result; + return CGI::h2($r->maketext("Site Information")) . $result; } else { return ""; } @@ -92,19 +93,20 @@ sub body { if ($haveAdminCourse and !(-f "$coursesDir/admin/hide_directory")) { my $urlpath = $r->urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets", $r, courseID => "admin"); - print CGI::p(CGI::a({href=>$self->systemLink($urlpath, authen => 0)}, $r->maketext("Course Administration"))); + print CGI::p( + CGI::a({ href => $self->systemLink($urlpath, authen => 0) }, $r->maketext("Course Administration"))); } print CGI::h2($r->maketext("Courses")); - print CGI::start_ul({class => "courses-list"}); + print CGI::start_ul({ class => "courses-list" }); - foreach my $courseID (sort {lc($a) cmp lc($b) } @courseIDs) { - next if $courseID eq "admin"; # done already above + foreach my $courseID (sort { lc($a) cmp lc($b) } @courseIDs) { + next if $courseID eq "admin"; # done already above next if -f "$coursesDir/$courseID/hide_directory"; my $urlpath = $r->urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets", $r, courseID => $courseID); - print CGI::li(CGI::a({href=>$self->systemLink($urlpath, authen => 0)}, $courseID =~ s/_/ /gr)); - }###place to use underscore sub + print CGI::li(CGI::a({ href => $self->systemLink($urlpath, authen => 0) }, $courseID =~ s/_/ /gr)); + } ###place to use underscore sub print CGI::end_ul(); diff --git a/lib/WeBWorK/ContentGenerator/Instructor.pm b/lib/WeBWorK/ContentGenerator/Instructor.pm index 8b8586658d..ca6bafb89b 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor.pm @@ -55,7 +55,7 @@ failure messages is returned. sub assignSetToUser { my ($self, $userID, $GlobalSet) = @_; my $setID = $GlobalSet->set_id; - my $db = $self->{db}; + my $db = $self->{db}; my $UserSet = $db->newUserSet; $UserSet->user_id($userID); @@ -84,67 +84,63 @@ sub assignSetToUser { } sub assignSetVersionToUser { - my ( $self, $userID, $GlobalSet ) = @_; -# in: ($self,) $userID = the userID of the user to which to assign the set, -# $GlobalSet = the global set object. -# out: a new set version is assigned to the user. -# note: we assume that the global set and user are well defined. I think this -# is a safe assumption. it would be nice to just call assignSetToUser, -# but we run into trouble doing that because of the distinction between -# the setID and the setVersionID - - my $setID = $GlobalSet->set_id; - my $db = $self->{db}; - -# figure out what version we're on, reset setID, get a new user set -# FIXME: old version; new call follows -# my $setVersionNum = $db->getUserSetVersionNumber( $userID, $setID ); - my @allVersionIDs = $db->listSetVersions( $userID, $setID ); - my $setVersionNum = ( @allVersionIDs ) ? $allVersionIDs[-1] : 0; - $setVersionNum++; - my $userSet = $db->newSetVersion; - $userSet->user_id( $userID ); - $userSet->set_id( $setID ); - $userSet->version_id( $setVersionNum ); - - my @results = (); - my $set_assigned = 0; - -# add the set to the database - eval { $db->addSetVersion( $userSet ) }; - if ( $@ ) { - if ( $@ =~ m/user set exists/ ) { - push( @results, "set $setID,v$setVersionNum is already assigned" . - "to user $userID" ); - $set_assigned = 1; - } else { - die $@; + my ($self, $userID, $GlobalSet) = @_; + # in: ($self,) $userID = the userID of the user to which to assign the set, + # $GlobalSet = the global set object. + # out: a new set version is assigned to the user. + # note: we assume that the global set and user are well defined. I think this + # is a safe assumption. it would be nice to just call assignSetToUser, + # but we run into trouble doing that because of the distinction between + # the setID and the setVersionID + + my $setID = $GlobalSet->set_id; + my $db = $self->{db}; + + # figure out what version we're on, reset setID, get a new user set + # FIXME: old version; new call follows + # my $setVersionNum = $db->getUserSetVersionNumber( $userID, $setID ); + my @allVersionIDs = $db->listSetVersions($userID, $setID); + my $setVersionNum = (@allVersionIDs) ? $allVersionIDs[-1] : 0; + $setVersionNum++; + my $userSet = $db->newSetVersion; + $userSet->user_id($userID); + $userSet->set_id($setID); + $userSet->version_id($setVersionNum); + + my @results = (); + my $set_assigned = 0; + + # add the set to the database + eval { $db->addSetVersion($userSet) }; + if ($@) { + if ($@ =~ m/user set exists/) { + push(@results, "set $setID,v$setVersionNum is already assigned" . "to user $userID"); + $set_assigned = 1; + } else { + die $@; + } } - } - -# populate set with problems - my @GlobalProblems = grep { defined $_ } $db->getAllGlobalProblems($setID); - -# keep track of problems assigned from groups so that we can have multiple -# problems from a given group, without duplicates - my %groupProblems = (); - - foreach my $GlobalProblem ( @GlobalProblems ) { - $GlobalProblem->set_id( $setID ); -# this is getting called from within ContentGenerator, so that $self -# isn't an Instructor object---therefore, calling $self->assign... -# doesn't work. the following is an ugly workaround that works b/c -# both Instructor and ContentGenerator objects have $self->{db} -# FIXME it would be nice to have a better solution to this - my @result = - assignProblemToUserSetVersion( $self, $userID, $userSet, - $GlobalProblem, \%groupProblems ); - push( @results, @result ) if ( @result && not $set_assigned ); - } - - return @results; -} + # populate set with problems + my @GlobalProblems = grep { defined $_ } $db->getAllGlobalProblems($setID); + + # keep track of problems assigned from groups so that we can have multiple + # problems from a given group, without duplicates + my %groupProblems = (); + + foreach my $GlobalProblem (@GlobalProblems) { + $GlobalProblem->set_id($setID); + # this is getting called from within ContentGenerator, so that $self + # isn't an Instructor object---therefore, calling $self->assign... + # doesn't work. the following is an ugly workaround that works b/c + # both Instructor and ContentGenerator objects have $self->{db} + # FIXME it would be nice to have a better solution to this + my @result = assignProblemToUserSetVersion($self, $userID, $userSet, $GlobalProblem, \%groupProblems); + push(@results, @result) if (@result && not $set_assigned); + } + + return @results; +} =item unassignSetFromUser($userID, $setID, $problemID) @@ -180,8 +176,11 @@ sub assignProblemToUser { eval { $db->addUserProblem($UserProblem) }; if ($@) { if ($@ =~ m/user problem exists/) { - return "problem " . $GlobalProblem->problem_id - . " in set " . $GlobalProblem->set_id + return + "problem " + . $GlobalProblem->problem_id + . " in set " + . $GlobalProblem->set_id . " is already assigned to user $userID."; } else { die $@; @@ -196,61 +195,62 @@ sub assignProblemToUserSetVersion { my ($self, $userID, $userSet, $GlobalProblem, $groupProbRef, $seed) = @_; my $db = $self->{db}; -# conditional to allow selection of problems from a group of problems, -# defined in a set. - - # problem groups are indicated by source files "group:problemGroupName" - if ( $GlobalProblem->source_file() =~ /^group:(.+)$/ ) { - my $problemGroupName = $1; - - # get list of problems in group - my @problemList = $db->listGlobalProblems($problemGroupName); - # sanity check: if the group set hasn't been defined or doesn't - # actually contain problems (oops), then we can't very well assign - # this problem to the user. we could go on and assign all other - # problems, but that results in a partial set. so we die here if - # this happens. philosophically we're requiring that the instructor - # set up the sets correctly or have to deal with the carnage after- - # wards. I'm not sure that this is the best long-term solution. - # FIXME: this means that we may have created a set version that - # doesn't have any problems. this is bad. but it's hard to see - # where else to deal with it---fixing the problem requires checking - # at the set version-creation level that all the problems in the - # set are well defined. FIXME - die("Error in set version creation: no problems are available " . - "in problem group $problemGroupName. Set " . - $userSet->set_id . " has been created for $userID, but " . - "does not contain the right problems.\n") if (! @problemList); - - my $nProb = @problemList; - my $whichProblem = int(rand($nProb)); - - # we allow selection of multiple problems from a group, but want them to - # be different. there's probably a better way to do this - if ( defined( $groupProbRef->{$problemGroupName} ) && - $groupProbRef->{$problemGroupName} =~ /\b$whichProblem\b/ ) { - my $nAvail = $nProb - - ( $groupProbRef->{$problemGroupName} =~ tr/,// ) - 1; - - die("Too many problems selected from group.") if ( ! $nAvail ); - - $whichProblem = int(rand($nProb)); - while ( $groupProbRef->{$problemGroupName} =~ /\b$whichProblem\b/ ) { - $whichProblem = ( $whichProblem + 1 )%$nProb; + # conditional to allow selection of problems from a group of problems, + # defined in a set. + + # problem groups are indicated by source files "group:problemGroupName" + if ($GlobalProblem->source_file() =~ /^group:(.+)$/) { + my $problemGroupName = $1; + + # get list of problems in group + my @problemList = $db->listGlobalProblems($problemGroupName); + # sanity check: if the group set hasn't been defined or doesn't + # actually contain problems (oops), then we can't very well assign + # this problem to the user. we could go on and assign all other + # problems, but that results in a partial set. so we die here if + # this happens. philosophically we're requiring that the instructor + # set up the sets correctly or have to deal with the carnage after- + # wards. I'm not sure that this is the best long-term solution. + # FIXME: this means that we may have created a set version that + # doesn't have any problems. this is bad. but it's hard to see + # where else to deal with it---fixing the problem requires checking + # at the set version-creation level that all the problems in the + # set are well defined. FIXME + die("Error in set version creation: no problems are available " + . "in problem group $problemGroupName. Set " + . $userSet->set_id + . " has been created for $userID, but " + . "does not contain the right problems.\n") + if (!@problemList); + + my $nProb = @problemList; + my $whichProblem = int(rand($nProb)); + + # we allow selection of multiple problems from a group, but want them to + # be different. there's probably a better way to do this + if (defined($groupProbRef->{$problemGroupName}) + && $groupProbRef->{$problemGroupName} =~ /\b$whichProblem\b/) + { + my $nAvail = $nProb - ($groupProbRef->{$problemGroupName} =~ tr/,//) - 1; + + die("Too many problems selected from group.") if (!$nAvail); + + $whichProblem = int(rand($nProb)); + while ($groupProbRef->{$problemGroupName} =~ /\b$whichProblem\b/) { + $whichProblem = ($whichProblem + 1) % $nProb; + } } - } - if ( defined( $groupProbRef->{$problemGroupName} ) ) { - $groupProbRef->{$problemGroupName} .= ",$whichProblem"; - } else { - $groupProbRef->{$problemGroupName} = "$whichProblem"; - } - - my $prob = $db->getGlobalProblem($problemGroupName, - $problemList[$whichProblem]); - $GlobalProblem->source_file($prob->source_file()); + if (defined($groupProbRef->{$problemGroupName})) { + $groupProbRef->{$problemGroupName} .= ",$whichProblem"; + } else { + $groupProbRef->{$problemGroupName} = "$whichProblem"; + } + + my $prob = $db->getGlobalProblem($problemGroupName, $problemList[$whichProblem]); + $GlobalProblem->source_file($prob->source_file()); } -# all set; do problem assignment + # all set; do problem assignment my $UserProblem = $db->newProblemVersion; $UserProblem->user_id($userID); $UserProblem->set_id($userSet->set_id); @@ -262,15 +262,18 @@ sub assignProblemToUserSetVersion { eval { $db->addProblemVersion($UserProblem) }; if ($@) { if ($@ =~ m/user problem exists/) { - return "problem " . $GlobalProblem->problem_id - . " in set " . $GlobalProblem->set_id + return + "problem " + . $GlobalProblem->problem_id + . " in set " + . $GlobalProblem->set_id . " is already assigned to user $userID."; } else { die $@; } } - return(); + return (); } =item unassignProblemFromUser($userID, $setID, $problemID) @@ -323,7 +326,7 @@ sub assignSetToAllUsers { foreach my $User (@userRecords) { next unless $self->r->ce->status_abbrev_has_behavior($User->status, "include_in_assignment"); my $UserSet = $db->newUserSet; - my $userID = $User->user_id; + my $userID = $User->user_id; $UserSet->user_id($userID); $UserSet->set_id($setID); debug("$setID: adding UserSet for $userID"); @@ -426,8 +429,8 @@ sub assignSetsToUsers { my ($self, $setIDsRef, $userIDsRef) = @_; my $db = $self->{db}; - my @setIDs = @$setIDsRef; - my @userIDs = @$userIDsRef; + my @setIDs = @$setIDsRef; + my @userIDs = @$userIDsRef; my @GlobalSets = $db->getGlobalSets(@setIDs); my @results; @@ -450,7 +453,7 @@ Unassign each of the given sets from each of the given users. sub unassignSetsFromUsers { my ($self, $setIDsRef, $userIDsRef) = @_; - my @setIDs = @$setIDsRef; + my @setIDs = @$setIDsRef; my @userIDs = @$userIDsRef; foreach my $setID (@setIDs) { @@ -469,8 +472,8 @@ assigned. If any assignments fail, a list of failure messages is returned. sub assignProblemToAllSetUsers { my ($self, $GlobalProblem) = @_; - my $db = $self->{db}; - my $setID = $GlobalProblem->set_id; + my $db = $self->{db}; + my $setID = $GlobalProblem->set_id; my @userIDs = $db->listSetUsers($setID); my @results; @@ -499,23 +502,22 @@ sub assignProblemToAllSetUsers { sub addProblemToSet { my ($self, %args) = @_; - my $db = $self->r->db; - my $value_default = $self->{ce}->{problemDefaults}->{value}; - my $max_attempts_default = $self->{ce}->{problemDefaults}->{max_attempts}; - my $showMeAnother_default = $self->{ce}->{problemDefaults}->{showMeAnother}; + my $db = $self->r->db; + my $value_default = $self->{ce}->{problemDefaults}->{value}; + my $max_attempts_default = $self->{ce}->{problemDefaults}->{max_attempts}; + my $showMeAnother_default = $self->{ce}->{problemDefaults}->{showMeAnother}; my $att_to_open_children_default = $self->{ce}->{problemDefaults}->{att_to_open_children}; - my $counts_parent_grade_default = $self->{ce}->{problemDefaults}->{counts_parent_grade}; - my $showHintsAfter_default = $self->{ce}{problemDefaults}{showHintsAfter}; - my $prPeriod_default = $self->{ce}->{problemDefaults}->{prPeriod}; - # showMeAnotherCount is the number of times that showMeAnother has been clicked; initially 0 + my $counts_parent_grade_default = $self->{ce}->{problemDefaults}->{counts_parent_grade}; + my $showHintsAfter_default = $self->{ce}{problemDefaults}{showHintsAfter}; + my $prPeriod_default = $self->{ce}->{problemDefaults}->{prPeriod}; + # showMeAnotherCount is the number of times that showMeAnother has been clicked; initially 0 my $showMeAnotherCount = 0; - die "addProblemToSet called without specifying the set name." if $args{setName} eq ""; my $setName = $args{setName}; - my $sourceFile = $args{sourceFile} or - die "addProblemToSet called without specifying the sourceFile."; + my $sourceFile = $args{sourceFile} + or die "addProblemToSet called without specifying the sourceFile."; my $problemID = $args{problemID}; @@ -530,20 +532,20 @@ sub addProblemToSet { unless ($problemID) { - my $set = $db->getGlobalSet($setName); - # for jitar sets the new problem id is the one that - # makes it a new top level problem - if ($set && $set->assignment_type eq 'jitar') { - my @problemIDs = $db->listGlobalProblems($setName); - if (@problemIDs) { - my @seq = jitar_id_to_seq($problemIDs[$#problemIDs]); - $problemID = seq_to_jitar_id($seq[0]+1); + my $set = $db->getGlobalSet($setName); + # for jitar sets the new problem id is the one that + # makes it a new top level problem + if ($set && $set->assignment_type eq 'jitar') { + my @problemIDs = $db->listGlobalProblems($setName); + if (@problemIDs) { + my @seq = jitar_id_to_seq($problemIDs[$#problemIDs]); + $problemID = seq_to_jitar_id($seq[0] + 1); + } else { + $problemID = seq_to_jitar_id(1); + } } else { - $problemID = seq_to_jitar_id(1); + $problemID = WeBWorK::Utils::max($db->listGlobalProblems($setName)) + 1; } - } else { - $problemID = WeBWorK::Utils::max($db->listGlobalProblems($setName)) + 1; - } } my $problemRecord = $db->newGlobalProblem; @@ -555,7 +557,7 @@ sub addProblemToSet { $problemRecord->att_to_open_children($attToOpenChildren); $problemRecord->counts_parent_grade($countsParentGrade); $problemRecord->showMeAnother($showMeAnother); - $problemRecord->{showMeAnotherCount}=$showMeAnotherCount; + $problemRecord->{showMeAnotherCount} = $showMeAnotherCount; $problemRecord->showHintsAfter($showHintsAfter); $problemRecord->prPeriod($prPeriod); $problemRecord->prCount(0); @@ -582,7 +584,7 @@ sub hiddenEditForUserFields { my ($self, @editForUser) = @_; my $return = ""; foreach my $editUser (@editForUser) { - $return .= CGI::input({type=>"hidden", name=>"editForUser", value=>$editUser}); + $return .= CGI::input({ type => "hidden", name => "editForUser", value => $editUser }); } return $return; @@ -599,7 +601,7 @@ sub userCountMessage { } elsif ($count == 1) { $message = $self->r->maketext("1 student"); } elsif ($count > $numUsers || $count < 0) { - $message = CGI::em($self->r->maketext("an impossible number of users: [_1] out of [_2]",$count,$numUsers)); + $message = CGI::em($self->r->maketext("an impossible number of users: [_1] out of [_2]", $count, $numUsers)); } else { $message = $self->r->maketext("[_1] students out of [_2]", $count, $numUsers); } @@ -617,21 +619,21 @@ sub setCountMessage { } elsif ($count == $numSets) { $message = $r->maketext("all sets"); } elsif ($count == 1) { - $message = "1 ".$r->maketext("set"); + $message = "1 " . $r->maketext("set"); } elsif ($count > $numSets || $count < 0) { - $message = CGI::em($self->r->maketext("an impossible number of sets: [_1] out of [_2]",$count,$numSets)); + $message = CGI::em($self->r->maketext("an impossible number of sets: [_1] out of [_2]", $count, $numSets)); } else { - $message = $count." ".$r->maketext("sets"); + $message = $count . " " . $r->maketext("sets"); } return $message; } -sub read_dir { # read a directory +sub read_dir { # read a directory my $self = shift; my $directory = shift; my $pattern = shift; - my @files = grep /$pattern/, WeBWorK::Utils::readDirectory($directory); + my @files = grep /$pattern/, WeBWorK::Utils::readDirectory($directory); return sort @files; } @@ -652,8 +654,8 @@ sub read_dir { # read a directory # list classlist files sub getCSVList { my ($self) = @_; - my $ce = $self->{ce}; - my $dir = $ce->{courseDirs}->{templates}; + my $ce = $self->{ce}; + my $dir = $ce->{courseDirs}->{templates}; return grep { not m/^\./ and m/\.lst$/ and -f "$dir/$_" } WeBWorK::Utils::readDirectory($dir); } @@ -713,35 +715,37 @@ sub getDefList { sub getScoringFileList { my ($self) = @_; - my $ce = $self->{ce}; - my $dir = $ce->{courseDirs}->{scoring}; + my $ce = $self->{ce}; + my $dir = $ce->{courseDirs}->{scoring}; return $self->read_dir($dir, qr/.*\.csv/); } -sub getTemplateFileList { # find all .pg files under the template tree (time consuming) +sub getTemplateFileList { # find all .pg files under the template tree (time consuming) my ($self) = shift; my $subDir = shift; - my $ce = $self->{ce}; + my $ce = $self->{ce}; $subDir = '' unless defined $subDir; - my $dir = $ce->{courseDirs}->{templates}."/$subDir"; + my $dir = $ce->{courseDirs}->{templates} . "/$subDir"; # FIXME currently allows one to see most files in the templates directory. # a better facility for handling auxiliary files would be nice. return $self->read_dir($dir, qr/\.pg$|.*\.html|\.png|\.gif|\.txt|\.pl/); } -sub getTemplateDirList { # find all .pg files under the template tree (time consuming) + +sub getTemplateDirList { # find all .pg files under the template tree (time consuming) my ($self) = @_; - my $ce = $self->{ce}; - my $dir = $ce->{courseDirs}->{templates}; - my @list = (); - my $wanted = sub { if (-d $_ ) { - my $current = $_; - return if $current =~/CVS/; - return if -l $current; # don't list links - my $name = $File::Find::name; - $name = " Top" if $current =/^\./; # top directory - $name =~ s/^$dir\///; - push @list, $name - } + my $ce = $self->{ce}; + my $dir = $ce->{courseDirs}->{templates}; + my @list = (); + my $wanted = sub { + if (-d $_) { + my $current = $_; + return if $current =~ /CVS/; + return if -l $current; # don't list links + my $name = $File::Find::name; + $name = " Top" if $current = /^\./; # top directory + $name =~ s/^$dir\///; + push @list, $name; + } }; File::Find::find($wanted, $dir); return sort @list; diff --git a/lib/WeBWorK/ContentGenerator/Instructor/AchievementEditor.pm b/lib/WeBWorK/ContentGenerator/Instructor/AchievementEditor.pm index 1ff2170744..0b01942fe9 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/AchievementEditor.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/AchievementEditor.pm @@ -37,27 +37,26 @@ use WeBWorK::Utils::Tasks qw(fake_user fake_set); use WeBWorK::ContentGenerator::Instructor::CodeMirrorEditor; use Fcntl; - use constant ACTION_FORMS => [qw(save save_as)]; use constant ACTION_FORM_TITLES => { -save => x("Save"), -save_as => x("Save As"), + save => x("Save"), + save_as => x("Save As"), }; use constant DEFAULT_ICON => "defaulticon.png"; sub pre_header_initialize { - my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; - my $urlpath = $r->urlpath; - my $authz = $r->authz; - my $user = $r->param('user'); - $self->{courseID} = $urlpath->arg("courseID"); - $self->{achievementID} = $r->urlpath->arg("achievementID") ; + my ($self) = @_; + my $r = $self->r; + my $ce = $r->ce; + my $urlpath = $r->urlpath; + my $authz = $r->authz; + my $user = $r->param('user'); + $self->{courseID} = $urlpath->arg("courseID"); + $self->{achievementID} = $r->urlpath->arg("achievementID"); - my $submit_button = $r->param('submit'); # obtain submit command from form - my $actionID = $r->param('action'); + my $submit_button = $r->param('submit'); # obtain submit command from form + my $actionID = $r->param('action'); # Check permissions return unless ($authz->hasPermissions($user, "edit_achievements")); @@ -66,40 +65,38 @@ sub pre_header_initialize { my $Achievement = $r->db->getAchievement($self->{achievementID}); if (not $Achievement) { - $self->addbadmessage("Achievement $self->{achievementID} not found!"); - die; + $self->addbadmessage("Achievement $self->{achievementID} not found!"); + die; } - $self->{achievement} = $Achievement; - $self->{sourceFilePath} = $ce->{courseDirs}->{achievements}."/".$Achievement->test; - $self->{r_achievementContents}= undef; + $self->{achievement} = $Achievement; + $self->{sourceFilePath} = $ce->{courseDirs}->{achievements} . "/" . $Achievement->test; + $self->{r_achievementContents} = undef; #perform a save or save_as action - if ($actionID) { - unless (grep { $_ eq $actionID } @{ ACTION_FORMS() } ) { - die "Action $actionID not found"; - } - + if ($actionID) { + unless (grep { $_ eq $actionID } @{ ACTION_FORMS() }) { + die "Action $actionID not found"; + } my $actionHandler = "${actionID}_handler"; - my %genericParams =(); - my %actionParams = $self->getActionParams($actionID); - my %tableParams = (); - $self->{action}= $actionID; + my %genericParams = (); + my %actionParams = $self->getActionParams($actionID); + my %tableParams = (); + $self->{action} = $actionID; $self->$actionHandler(\%genericParams, \%actionParams, \%tableParams); - } else { - # we just opened up this file for the first time - $self->{action}='fresh_edit'; - my $actionHandler = "fresh_edit_handler"; - my %genericParams; - my %actionParams = (); - my %tableParams = (); + } else { + # we just opened up this file for the first time + $self->{action} = 'fresh_edit'; + my $actionHandler = "fresh_edit_handler"; + my %genericParams; + my %actionParams = (); + my %tableParams = (); my $achievementContents = ''; - $self->{r_achievementContents}=\$achievementContents; - $self->$actionHandler(\%genericParams, \%actionParams, \%tableParams); - } - + $self->{r_achievementContents} = \$achievementContents; + $self->$actionHandler(\%genericParams, \%actionParams, \%tableParams); + } ############################################################################## # Return @@ -114,44 +111,42 @@ sub pre_header_initialize { return if $self->{failure}; # FIXME: even with an error we still open a new page because of the target specified in the form my $action = $self->{action}; - return ; + return; } - -sub initialize { - my ($self) = @_; - my $r = $self->r; - my $authz = $r->authz; - my $user = $r->param('user'); +sub initialize { + my ($self) = @_; + my $r = $self->r; + my $authz = $r->authz; + my $user = $r->param('user'); my $sourceFilePath = $self->{sourceFilePath}; - # Check permissions return unless ($authz->hasPermissions($user, "edit_achievements")); - - $self->addmessage($r->param('status_message') ||''); # record status messages carried over if this is a redirect + $self->addmessage($r->param('status_message') || ''); # record status messages carried over if this is a redirect # Check source file path - if ( not( -e $sourceFilePath) ) { - $self->addbadmessage("The file '".$self->shortPath($sourceFilePath)."' cannot be found."); + if (not(-e $sourceFilePath)) { + $self->addbadmessage("The file '" . $self->shortPath($sourceFilePath) . "' cannot be found."); } } sub path { my ($self, $args) = @_; - my $r = $self->r; - my $urlpath = $r->urlpath; - my $courseName = $urlpath->arg("courseID"); + my $r = $self->r; + my $urlpath = $r->urlpath; + my $courseName = $urlpath->arg("courseID"); my $achievementName = $r->urlpath->arg("achievementID") || ''; # we need to build a path to the achievement being edited by hand, since it is not the same as the urlpath # For this page the bread crum path leads back to the problem being edited, not to the Instructor tool. - my @path = ( 'WeBWork', $r->location, - "$courseName", $r->location."/$courseName", - $r->maketext('Achievement'), $r->location."/$courseName/instructor/achievement_list", - "$achievementName", $r->location."/$courseName/instructor/achievement_list", + my @path = ( + 'WeBWork', $r->location, + "$courseName", $r->location . "/$courseName", + $r->maketext('Achievement'), $r->location . "/$courseName/instructor/achievement_list", + "$achievementName", $r->location . "/$courseName/instructor/achievement_list", ); #print "\n\n"; @@ -162,10 +157,10 @@ sub path { } sub title { - my $self = shift; - my $r = $self->r; + my $self = shift; + my $r = $self->r; my $courseName = $r->urlpath->arg("courseID"); - my $achievementID = $r->urlpath->arg("achievementID"); + my $achievementID = $r->urlpath->arg("achievementID"); return $r->maketext("Achievement Evaluator for achievement [_1]", $achievementID); @@ -173,37 +168,36 @@ sub title { sub body { my ($self) = @_; - my $r = $self->r; - my $db = $r->db; - my $ce = $r->ce; - my $authz = $r->authz; - my $user = $r->param('user'); + my $r = $self->r; + my $db = $r->db; + my $ce = $r->ce; + my $authz = $r->authz; + my $user = $r->param('user'); # Check permissions return CGI::div({ class => 'alert alert-danger p-1' }, "You are not authorized to edit achievements.") unless $authz->hasPermissions($user, "edit_achievements"); # Gathering info - my $sourceFilePath = $self->{sourceFilePath}; # path to the permanent file to be edited - my $achievementID = $self->{achievementID} ; - my $Achievement = $self->{achievement}; - + my $sourceFilePath = $self->{sourceFilePath}; # path to the permanent file to be edited + my $achievementID = $self->{achievementID}; + my $Achievement = $self->{achievement}; ######################################################################### # Find the text for the achievement ######################################################################### - my $achievementContents = ${$self->{r_achievementContents}}; + my $achievementContents = ${ $self->{r_achievementContents} }; - unless ( $achievementContents =~/\S/) { # non-empty contents - die "Path is Unsafe!" unless path_is_subdir($sourceFilePath, $ce->{courseDirs}->{achievements}, 1); + unless ($achievementContents =~ /\S/) { # non-empty contents + die "Path is Unsafe!" unless path_is_subdir($sourceFilePath, $ce->{courseDirs}->{achievements}, 1); - eval { $achievementContents = WeBWorK::Utils::readFile($sourceFilePath) }; + eval { $achievementContents = WeBWorK::Utils::readFile($sourceFilePath) }; - $achievementContents = $@ if $@; + $achievementContents = $@ if $@; } else { - #warn "obtaining input from r_problemContents"; + #warn "obtaining input from r_problemContents"; } my $header = CGI::i($r->maketext("Editing achievement in file '[_1]'", $self->shortPath($sourceFilePath))); @@ -229,7 +223,7 @@ sub body { $achievementContents); ######### print action forms - my @formsToShow = @{ ACTION_FORMS() }; + my @formsToShow = @{ ACTION_FORMS() }; my %actionFormTitles = %{ ACTION_FORM_TITLES() }; my $default_choice; @@ -237,40 +231,51 @@ sub body { my @contentArr; for my $actionID (@formsToShow) { - my $actionForm = "${actionID}_form"; + my $actionForm = "${actionID}_form"; my $line_contents = $self->$actionForm($self->getActionParams($actionID)); - my $active = ''; + my $active = ''; if ($line_contents) { $active = ' active', $default_choice = $actionID unless $default_choice; - push(@tabArr, CGI::li({ class => 'nav-item', role => 'presentation' }, - CGI::a({ - href => "#$actionID", - class => "nav-link action-link$active", - id => "$actionID-tab", - data_action => $actionID, - data_bs_toggle => 'tab', - data_bs_target => "#$actionID", - role => 'tab', - aria_controls => $actionID, - aria_selected => $active ? 'true' : 'false' + push( + @tabArr, + CGI::li( + { class => 'nav-item', role => 'presentation' }, + CGI::a( + { + href => "#$actionID", + class => "nav-link action-link$active", + id => "$actionID-tab", + data_action => $actionID, + data_bs_toggle => 'tab', + data_bs_target => "#$actionID", + role => 'tab', + aria_controls => $actionID, + aria_selected => $active ? 'true' : 'false' + }, + $r->maketext($actionFormTitles{$actionID}) + ) + ) + ); + push( + @contentArr, + CGI::div( + { + class => 'tab-pane fade mb-2' . ($active ? " show$active" : ""), + id => $actionID, + role => 'tabpanel', + aria_labelledby => "$actionID-tab" }, - $r->maketext($actionFormTitles{$actionID})))); - push(@contentArr, CGI::div({ - class => 'tab-pane fade mb-2' . ($active ? " show$active" : ""), - id => $actionID, - role => 'tabpanel', - aria_labelledby => "$actionID-tab" - }, $line_contents)); + $line_contents + ) + ); } } print CGI::hidden(-name => 'action', -id => 'current_action', -value => $default_choice); - print CGI::div( - CGI::ul({ class => 'nav nav-tabs mb-2', role => 'tablist' }, @tabArr), - CGI::div({ class => 'tab-content' }, @contentArr) - ); + print CGI::div(CGI::ul({ class => 'nav nav-tabs mb-2', role => 'tablist' }, @tabArr), + CGI::div({ class => 'tab-content' }, @contentArr)); print CGI::div( CGI::submit({ name => 'submit', value => $r->maketext("Take Action!"), class => 'btn btn-primary' })); @@ -284,10 +289,11 @@ sub body { # Convert long paths to [ACHEVDIR] # sub shortPath { - my $self = shift; my $file = shift; - my $ache = $self->r->ce->{courseDirs}{achievements}; - $file =~ s|^$ache|[ACHEVDIR]|; - return $file; + my $self = shift; + my $file = shift; + my $ache = $self->r->ce->{courseDirs}{achievements}; + $file =~ s|^$ache|[ACHEVDIR]|; + return $file; } ################################################################################ @@ -298,7 +304,7 @@ sub getRelativeSourceFilePath { my ($self, $sourceFilePath) = @_; my $achievementsDir = $self->r->ce->{courseDirs}->{achievements}; - $sourceFilePath =~ s|^${achievementsDir}/*||; # remove templates path and any slashes that follow + $sourceFilePath =~ s|^${achievementsDir}/*||; # remove templates path and any slashes that follow return $sourceFilePath; } @@ -306,33 +312,32 @@ sub getRelativeSourceFilePath { sub saveFileChanges { ################################################################################ -# saveFileChanges does most of the work. it is a separate method so that it can -# be called from either pre_header_initialize() or initilize(), depending on -# whether a redirect is needed or not. -# -# it actually does a lot more than save changes to the file being edited, and -# sometimes less. + # saveFileChanges does most of the work. it is a separate method so that it can + # be called from either pre_header_initialize() or initilize(), depending on + # whether a redirect is needed or not. + # + # it actually does a lot more than save changes to the file being edited, and + # sometimes less. ################################################################################ - my ($self, $outputFilePath, $achievementContents ) = @_; - my $r = $self->r; - my $ce = $r->ce; + my ($self, $outputFilePath, $achievementContents) = @_; + my $r = $self->r; + my $ce = $r->ce; - my $action = $self->{action}||'no action'; + my $action = $self->{action} || 'no action'; - if (defined($achievementContents) and ref($achievementContents) ) { + if (defined($achievementContents) and ref($achievementContents)) { $achievementContents = ${$achievementContents}; - } elsif( ! not_blank($achievementContents) ) { # if the AchievementContents is undefined or empty - $achievementContents = ${$self->{r_achievementContents}}; + } elsif (!not_blank($achievementContents)) { # if the AchievementContents is undefined or empty + $achievementContents = ${ $self->{r_achievementContents} }; } - - unless (not_blank($outputFilePath) ) { - $self->addbadmessage($r->maketext("You must specify an file name in order to save a new file.")); - return ""; + unless (not_blank($outputFilePath)) { + $self->addbadmessage($r->maketext("You must specify an file name in order to save a new file.")); + return ""; } - my $do_not_save = 0 ; # flag to prevent saving of file - my $editErrors = ''; + my $do_not_save = 0; # flag to prevent saving of file + my $editErrors = ''; ############################################################################## # write changes to the approriate files @@ -341,23 +346,24 @@ sub saveFileChanges { ############################################################################## my $writeFileErrors; - if ( not_blank($outputFilePath) ) { # save file - - # make sure any missing directories are created - WeBWorK::Utils::surePathToFile($ce->{courseDirs}->{achievements}, - $outputFilePath); - die "outputFilePath is unsafe!" unless path_is_subdir($outputFilePath, $ce->{courseDirs}->{achievements}, 1); # 1==path can be relative to dir - - eval { - local *OUTPUTFILE; - open OUTPUTFILE, ">$outputFilePath" - or die "Failed to open $outputFilePath"; - print OUTPUTFILE $achievementContents; - close OUTPUTFILE; - # any errors are caught in the next block - }; - - $writeFileErrors = $@ if $@; + if (not_blank($outputFilePath)) { # save file + + # make sure any missing directories are created + WeBWorK::Utils::surePathToFile($ce->{courseDirs}->{achievements}, $outputFilePath); + die "outputFilePath is unsafe!" + unless path_is_subdir($outputFilePath, $ce->{courseDirs}->{achievements}, 1) + ; # 1==path can be relative to dir + + eval { + local *OUTPUTFILE; + open OUTPUTFILE, ">$outputFilePath" + or die "Failed to open $outputFilePath"; + print OUTPUTFILE $achievementContents; + close OUTPUTFILE; + # any errors are caught in the next block + }; + + $writeFileErrors = $@ if $@; } ########################################################### @@ -365,34 +371,42 @@ sub saveFileChanges { ########################################################### $self->{saveError} = $do_not_save; # don't do redirects if the file was not saved. - # don't unlink files or send success messages + # don't unlink files or send success messages if ($writeFileErrors) { - # get the current directory from the outputFilePath - $outputFilePath =~ m|^(/.*?/)[^/]+$|; - my $currentDirectory = $1; - - my $errorMessage; - # check why we failed to give better error messages - if ( not -w $ce->{courseDirs}->{achievements} ) { - $errorMessage = $r->maketext("Write permissions have not been enabled in the templates directory. No changes can be made."); - } elsif ( not -w $currentDirectory ) { - $errorMessage = $r->maketext("Write permissions have not been enabled in '[_1]'. Changes must be saved to a different directory for viewing.", $self->shortPath($currentDirectory)); - } elsif ( -e $outputFilePath and not -w $outputFilePath ) { - $errorMessage = $r->maketext("Write permissions have not been enabled for '[_1]'. Changes must be saved to another file for viewing.", $self->shortPath($outputFilePath)); - } else { - $errorMessage = $r->maketext("Unable to write to '[_1]': [_2]", $self->shortPath($outputFilePath),$writeFileErrors); - } - - $self->{failure} = 1; - $self->addbadmessage(CGI::p($errorMessage)); + # get the current directory from the outputFilePath + $outputFilePath =~ m|^(/.*?/)[^/]+$|; + my $currentDirectory = $1; + + my $errorMessage; + # check why we failed to give better error messages + if (not -w $ce->{courseDirs}->{achievements}) { + $errorMessage = $r->maketext( + "Write permissions have not been enabled in the templates directory. No changes can be made."); + } elsif (not -w $currentDirectory) { + $errorMessage = $r->maketext( + "Write permissions have not been enabled in '[_1]'. Changes must be saved to a different directory for viewing.", + $self->shortPath($currentDirectory) + ); + } elsif (-e $outputFilePath and not -w $outputFilePath) { + $errorMessage = $r->maketext( + "Write permissions have not been enabled for '[_1]'. Changes must be saved to another file for viewing.", + $self->shortPath($outputFilePath) + ); + } else { + $errorMessage = + $r->maketext("Unable to write to '[_1]': [_2]", $self->shortPath($outputFilePath), $writeFileErrors); + } + + $self->{failure} = 1; + $self->addbadmessage(CGI::p($errorMessage)); } - unless( $writeFileErrors or $do_not_save) { # everything worked! unlink and announce success! + unless ($writeFileErrors or $do_not_save) { # everything worked! unlink and announce success! - if ( defined($outputFilePath) and ! $self->{failure} ) { - # don't announce saving of temporary editing files + if (defined($outputFilePath) and !$self->{failure}) { + # don't announce saving of temporary editing files my $msg = $r->maketext("Saved to file '[_1]'", $self->shortPath($outputFilePath)); $self->addgoodmessage($msg); @@ -400,18 +414,13 @@ sub saveFileChanges { } - -} # end saveFileChanges - - - - +} # end saveFileChanges sub getActionParams { my ($self, $actionID) = @_; my $r = $self->{r}; - my %actionParams=(); + my %actionParams = (); foreach my $param ($r->param) { next unless $param =~ m/^action\.$actionID\./; $actionParams{$param} = [ $r->param($param) ]; @@ -420,14 +429,14 @@ sub getActionParams { } sub fixAchievementContents { - #NOT a method - my $AchievementContents = shift; - # Handle the problem of line endings. - # Make sure that all of the line endings are of unix type. - # Convert \r\n to \n - $AchievementContents =~ s/\r\n/\n/g; - $AchievementContents =~ s/\r/\n/g; - $AchievementContents; + #NOT a method + my $AchievementContents = shift; + # Handle the problem of line endings. + # Make sure that all of the line endings are of unix type. + # Convert \r\n to \n + $AchievementContents =~ s/\r\n/\n/g; + $AchievementContents =~ s/\r/\n/g; + $AchievementContents; } sub save_form { @@ -443,9 +452,9 @@ sub save_form { sub save_handler { my ($self, $genericParams, $actionParams, $tableParams) = @_; - my $r= $self->r; - my $courseName = $self->{courseID}; - my $achievementName = $self->{achievementID}; + my $r = $self->r; + my $courseName = $self->{courseID}; + my $achievementName = $self->{achievementID}; ################################################# # grab the achievementContents from the form in order to save it to the source path @@ -552,24 +561,24 @@ sub save_as_form { sub save_as_handler { my ($self, $genericParams, $actionParams, $tableParams) = @_; - my $r = $self->r; + my $r = $self->r; my $db = $r->db; - $self->{status_message} = ''; ## DPVC -- remove bogus old messages - my $courseName = $self->{courseID}; - my $achievementName = $self->{achievementID}; + $self->{status_message} = ''; ## DPVC -- remove bogus old messages + my $courseName = $self->{courseID}; + my $achievementName = $self->{achievementID}; my $effectiveUserName = $self->r->param('effectiveUser'); - my $do_not_save = 0; - my $saveMode = $actionParams->{'action.save_as.saveMode'}->[0] || 'no_save_mode_selected'; - my $new_file_name = $actionParams->{'action.save_as.target_file'}->[0] || ''; - my $sourceFilePath = $actionParams->{'action.save_as.source_file'}->[0] || ''; - my $targetAchievementID = $actionParams->{'action.save_as.id'}->[0] || ''; + my $do_not_save = 0; + my $saveMode = $actionParams->{'action.save_as.saveMode'}->[0] || 'no_save_mode_selected'; + my $new_file_name = $actionParams->{'action.save_as.target_file'}->[0] || ''; + my $sourceFilePath = $actionParams->{'action.save_as.source_file'}->[0] || ''; + my $targetAchievementID = $actionParams->{'action.save_as.id'}->[0] || ''; - $self ->{sourceFilePath} = $sourceFilePath; # store for use in saveFileChanges - $new_file_name =~ s/^\s*//; #remove initial and final white space + $self->{sourceFilePath} = $sourceFilePath; # store for use in saveFileChanges + $new_file_name =~ s/^\s*//; #remove initial and final white space $new_file_name =~ s/\s*$//; - if ( $new_file_name !~ /\S/) { # need a non-blank file name - # setting $self->{failure} stops saving and any redirects + if ($new_file_name !~ /\S/) { # need a non-blank file name + # setting $self->{failure} stops saving and any redirects $do_not_save = 1; $self->addbadmessage(CGI::p($r->maketext("Please specify a file to save to."))); } @@ -584,87 +593,104 @@ sub save_as_handler { # Rescue the user in case they forgot to end the file name with .at ################################################# - $new_file_name =~ s/\.at$//; # remove it if it is there - $new_file_name .= '.at'; # put it there - + $new_file_name =~ s/\.at$//; # remove it if it is there + $new_file_name .= '.at'; # put it there ################################################# # Construct the output file path ################################################# - my $outputFilePath = $self->r->ce->{courseDirs}->{achievements} . '/' . - $new_file_name; + my $outputFilePath = $self->r->ce->{courseDirs}->{achievements} . '/' . $new_file_name; if (defined $outputFilePath and -e $outputFilePath) { # setting $do_not_save stops saving and any redirects $do_not_save = 1; - $self->addbadmessage(CGI::p($r->maketext("File '[_1]' exists. File not saved. No changes have been made.", $self->shortPath($outputFilePath)))); + $self->addbadmessage(CGI::p($r->maketext( + "File '[_1]' exists. File not saved. No changes have been made.", + $self->shortPath($outputFilePath) + ))); } elsif ($saveMode eq 'use_in_new' && not $targetAchievementID) { - $self->addbadmessage($r->maketext("No new Achievement ID specified. No new achievement created. File not saved.")); - $do_not_save = 1; + $self->addbadmessage( + $r->maketext("No new Achievement ID specified. No new achievement created. File not saved.")); + $do_not_save = 1; } elsif ($saveMode eq 'use_in_new' && $db->existsAchievement($targetAchievementID)) { - $self->addbadmessage($r->maketext("Achievement ID exists! No new achievement created. File not saved.")); - $do_not_save = 1; + $self->addbadmessage($r->maketext("Achievement ID exists! No new achievement created. File not saved.")); + $do_not_save = 1; } else { - $self->{editFilePath} = $outputFilePath; - $self->{inputFilePath} = ''; + $self->{editFilePath} = $outputFilePath; + $self->{inputFilePath} = ''; } return "" if $do_not_save; - #Save changes $self->saveFileChanges($outputFilePath); if ($saveMode eq 'use_in_current' and -r $outputFilePath) { - ################################################# - # Modify evaluator path in current achievement - ################################################# - my $achievement = $self->r->db->getAchievement($achievementName); - $achievement->test($new_file_name); - if ($self->r->db->putAchievement($achievement)) { - $self->addgoodmessage($r->maketext("The evaluator for [_1] has been renamed to '[_2]'.", $achievementName, $self->shortPath($outputFilePath))) ; - } else { - $self->addbadmessage($r->maketext("Unable to change the evaluator for set [_1]. Unknown error.",$achievementName)); - } + ################################################# + # Modify evaluator path in current achievement + ################################################# + my $achievement = $self->r->db->getAchievement($achievementName); + $achievement->test($new_file_name); + if ($self->r->db->putAchievement($achievement)) { + $self->addgoodmessage($r->maketext( + "The evaluator for [_1] has been renamed to '[_2]'.", $achievementName, + $self->shortPath($outputFilePath) + )); + } else { + $self->addbadmessage( + $r->maketext("Unable to change the evaluator for set [_1]. Unknown error.", $achievementName)); + } } elsif ($saveMode eq 'use_in_new') { - #Create a new achievement to use the evaluator in - my $achievement = $self->r->db->newAchievement(); - $achievement->achievement_id($targetAchievementID); - $achievement->test($new_file_name); - $achievement->icon(DEFAULT_ICON()); - - $self->r->db->addAchievement($achievement); - $self->addgoodmessage($r->maketext("Achievement [_1] created with evaluator '[_2]'.", $targetAchievementID, $self->shortPath($outputFilePath))) ; + #Create a new achievement to use the evaluator in + my $achievement = $self->r->db->newAchievement(); + $achievement->achievement_id($targetAchievementID); + $achievement->test($new_file_name); + $achievement->icon(DEFAULT_ICON()); + + $self->r->db->addAchievement($achievement); + $self->addgoodmessage($r->maketext( + "Achievement [_1] created with evaluator '[_2]'.", $targetAchievementID, + $self->shortPath($outputFilePath) + )); } elsif ($saveMode eq 'dont_use') { - ################################################# - # Don't change any achievements - just report - ################################################# - $self->addgoodmessage($r->maketext("A new file has been created at '[_1]'", $self->shortPath($outputFilePath))); + ################################################# + # Don't change any achievements - just report + ################################################# + $self->addgoodmessage($r->maketext("A new file has been created at '[_1]'", $self->shortPath($outputFilePath))); } else { - $self->addbadmessage($r->maketext("Don't recognize saveMode: |[_1]|. Unknown error.", $saveMode)); + $self->addbadmessage($r->maketext("Don't recognize saveMode: |[_1]|. Unknown error.", $saveMode)); } - - ################################################# # Set up redirect # The redirect gives the server time to detect that the new file exists. ################################################# my $problemPage; - if ($saveMode eq 'dont_use' ) { - $problemPage = $self->r->urlpath->newFromModule("WeBWorK::ContentGenerator::Instructor::AchievementEditor",$r, - courseID => $courseName, achievementID => $achievementName); + if ($saveMode eq 'dont_use') { + $problemPage = $self->r->urlpath->newFromModule( + "WeBWorK::ContentGenerator::Instructor::AchievementEditor", $r, + courseID => $courseName, + achievementID => $achievementName + ); } elsif ($saveMode eq 'use_in_current') { - $problemPage = $self->r->urlpath->newFromModule("WeBWorK::ContentGenerator::Instructor::AchievementEditor",$r, - courseID => $courseName, achievementID => $achievementName); + $problemPage = $self->r->urlpath->newFromModule( + "WeBWorK::ContentGenerator::Instructor::AchievementEditor", $r, + courseID => $courseName, + achievementID => $achievementName + ); } elsif ($saveMode eq 'use_in_new') { - $problemPage = $self->r->urlpath->newFromModule("WeBWorK::ContentGenerator::Instructor::AchievementEditor",$r, - courseID => $courseName, achievementID => $targetAchievementID); + $problemPage = $self->r->urlpath->newFromModule( + "WeBWorK::ContentGenerator::Instructor::AchievementEditor", $r, + courseID => $courseName, + achievementID => $targetAchievementID + ); } else { - $self->addbadmessage(" Please use radio buttons to choose the method for saving this file. Can't recognize saveMode: |$saveMode|."); + $self->addbadmessage( + " Please use radio buttons to choose the method for saving this file. Can't recognize saveMode: |$saveMode|." + ); # can't continue since paths have not been properly defined. return ""; } @@ -673,15 +699,17 @@ sub save_as_handler { my $relativeOutputFilePath = $self->getRelativeSourceFilePath($outputFilePath); - my $viewURL = $self->systemLink($problemPage, - params=>{ - sourceFilePath => $relativeOutputFilePath, - status_message => uri_escape_utf8($self->{status_message})} + my $viewURL = $self->systemLink( + $problemPage, + params => { + sourceFilePath => $relativeOutputFilePath, + status_message => uri_escape_utf8($self->{status_message}) + } - ); + ); $self->reply_with_redirect($viewURL); - return ""; # no redirect needed + return ""; # no redirect needed } sub fresh_edit_handler { diff --git a/lib/WeBWorK/ContentGenerator/Instructor/AchievementList.pm b/lib/WeBWorK/ContentGenerator/Instructor/AchievementList.pm index a499c6e5c1..95853bd230 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/AchievementList.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/AchievementList.pm @@ -57,117 +57,118 @@ use Encode; use open IO => ':encoding(UTF-8)'; #constants for forms and the various handlers -use constant BLANK_ACHIEVEMENT => "blankachievement.at"; +use constant BLANK_ACHIEVEMENT => "blankachievement.at"; use constant DEFAULT_ENABLED_STATE => 0; -use constant EDIT_FORMS => [qw(saveEdit cancelEdit)]; -use constant VIEW_FORMS => [qw(edit assign import export score create delete)]; +use constant EDIT_FORMS => [qw(saveEdit cancelEdit)]; +use constant VIEW_FORMS => [qw(edit assign import export score create delete)]; use constant EXPORT_FORMS => [qw(saveExport cancelExport)]; # Prepare the tab titles for translation by maketext use constant FORM_TITLES => { - saveEdit => x("Save Edit"), - cancelEdit => x("Cancel Edit"), - edit => x("Edit"), - assign => x("Assign"), - import => x("Import"), - export => x("Export"), - score => x("Score"), - create => x("Create"), - delete => x("Delete"), - saveExport => x("Save Export"), - cancelExport => x("Cancel Export") + saveEdit => x("Save Edit"), + cancelEdit => x("Cancel Edit"), + edit => x("Edit"), + assign => x("Assign"), + import => x("Import"), + export => x("Export"), + score => x("Score"), + create => x("Create"), + delete => x("Delete"), + saveExport => x("Save Export"), + cancelExport => x("Cancel Export") }; -use constant VIEW_FIELD_ORDER => [ qw( achievement_id enabled name number category ) ]; -use constant EDIT_FIELD_ORDER => [ qw( icon achievement_id name number assignment_type category enabled points max_counter description icon_file test_file) ]; -use constant EXPORT_FIELD_ORDER => [ qw( select achievement_id name) ]; +use constant VIEW_FIELD_ORDER => [qw( achievement_id enabled name number category )]; +use constant EDIT_FIELD_ORDER => [ + qw( icon achievement_id name number assignment_type category enabled points max_counter description icon_file test_file) +]; +use constant EXPORT_FIELD_ORDER => [qw( select achievement_id name)]; use constant STATE_PARAMS => [qw(user effectiveUser key editMode exportMode)]; use constant ASSIGNMENT_TYPES => [qw(default gateway jitar)]; use constant ASSIGNMENT_NAMES => { - default => 'homework', - gateway => 'gateways', - jitar => 'just-in-time', + default => 'homework', + gateway => 'gateways', + jitar => 'just-in-time', }; #properites for the fields shown in the tables -use constant FIELD_PROPERTIES => { +use constant FIELD_PROPERTIES => { achievement_id => { - type => "text", - size => 8, + type => "text", + size => 8, access => "readonly", }, name => { - type => "text", - size => 30, + type => "text", + size => 30, access => "readwrite", }, assignment_type => { - type => "assignment_type", - size => 30, + type => "assignment_type", + size => 30, access => "readwrite", }, category => { - type => "text", - size => 30, + type => "text", + size => 30, access => "readwrite", }, number => { - type => "text", - size => 8, + type => "text", + size => 8, access => "readwrite", }, icon => { - type => "text", - size => 85, + type => "text", + size => 85, access => "readwrite", }, test => { - type => "text", - size => 85, + type => "text", + size => 85, access => "readwrite", }, description => { - type => "text", - size => 85, + type => "text", + size => 85, access => "readwrite", }, enabled => { - type => "checked", - size => 8, + type => "checked", + size => 8, access => "readwrite", }, points => { - type => "text", - size => 8, + type => "text", + size => 8, access => "readwrite", }, max_counter => { - type => "text", - size => 8, + type => "text", + size => 8, access => "readwrite", }, }; sub initialize { - my ($self) = @_; - my $r = $self->r; - my $urlpath = $r->urlpath; - my $db = $r->db; - my $ce = $r->ce; - my $authz = $r->authz; - my $courseName = $urlpath->arg("courseID"); - my $achievementID= $urlpath->arg("achievementID"); - my $user = $r->param('user'); - + my ($self) = @_; + my $r = $self->r; + my $urlpath = $r->urlpath; + my $db = $r->db; + my $ce = $r->ce; + my $authz = $r->authz; + my $courseName = $urlpath->arg("courseID"); + my $achievementID = $urlpath->arg("achievementID"); + my $user = $r->param('user'); my $root = $ce->{webworkURLs}->{root}; @@ -186,19 +187,17 @@ sub initialize { # to transition over. (I.E. around 2017) foreach my $achievementID (@allAchievementIDs) { - my $achievement = $db->getAchievement($achievementID); - unless ($achievement->assignment_type || $achievement->number) { - $achievement->assignment_type('default'); - $db->putAchievement($achievement); - } + my $achievement = $db->getAchievement($achievementID); + unless ($achievement->assignment_type || $achievement->number) { + $achievement->assignment_type('default'); + $db->putAchievement($achievement); + } } ### End Transition Code. ### - my @users = $db->listUsers; $self->{allAchievementIDs} = \@allAchievementIDs; - $self->{totalUsers} = scalar @users; - + $self->{totalUsers} = scalar @users; if (defined $r->param("selected_achievements")) { $self->{selectedAchievementIDs} = [ $r->param("selected_achievements") ]; @@ -222,27 +221,27 @@ sub initialize { my $actionHandler = "${actionID}_handler"; my %genericParams; foreach my $param (qw(selected_achievements)) { - $genericParams{$param} = [ $r->param($param) ]; + $genericParams{$param} = [ $r->param($param) ]; } my %actionParams = $self->getActionParams($actionID); - my %tableParams = $self->getTableParams(); + my %tableParams = $self->getTableParams(); $self->addmessage(CGI::div({ class => 'mb-1' }, $r->maketext("Results of last action performed: "))); $self->addmessage($self->$actionHandler(\%genericParams, \%actionParams, \%tableParams)); } else { - $self->addgoodmessage($r->maketext("Please select action to be performed.")); + $self->addgoodmessage($r->maketext("Please select action to be performed.")); } } sub body { - my ($self) = @_; - my $r = $self->r; - my $urlpath = $r->urlpath; - my $db = $r->db; - my $ce = $r->ce; - my $authz = $r->authz; - my $courseName = $urlpath->arg("courseID"); - my $achievementID= $urlpath->arg("achievementID"); - my $user = $r->param('user'); + my ($self) = @_; + my $r = $self->r; + my $urlpath = $r->urlpath; + my $db = $r->db; + my $ce = $r->ce; + my $authz = $r->authz; + my $courseName = $urlpath->arg("courseID"); + my $achievementID = $urlpath->arg("achievementID"); + my $user = $r->param('user'); my $root = $ce->{webworkURLs}->{root}; @@ -253,10 +252,11 @@ sub body { ########## retrieve possibly changed values for member fields - my @allAchievementIDs = @{ $self->{allAchievementIDs} }; # do we need this one? YES, deleting or importing a achievement will change this. + my @allAchievementIDs = @{ $self->{allAchievementIDs} } + ; # do we need this one? YES, deleting or importing a achievement will change this. my @selectedAchievementIDs = @{ $self->{selectedAchievementIDs} }; - my $editMode = $self->{editMode}; - my $exportMode = $self->{exportMode}; + my $editMode = $self->{editMode}; + my $exportMode = $self->{exportMode}; ########## get achievements @@ -264,14 +264,14 @@ sub body { # sort Achievments. Achievements are always sorted by in the order they are evaluated if (@Achievements) { - @Achievements = sortAchievements(@Achievements); + @Achievements = sortAchievements(@Achievements); } ########## print site identifying information print CGI::input({ - type => "button", - id => "show_hide", + type => "button", + id => "show_hide", value => $r->maketext("Show/Hide Site Description"), class => "btn btn-info mb-2" }); @@ -303,16 +303,17 @@ sub body { print "\n\n"; - print CGI::hidden(-name=>"editMode", -value=>$editMode); - print CGI::hidden(-name=>"exportMode", -value=>$exportMode); + print CGI::hidden(-name => "editMode", -value => $editMode); + print CGI::hidden(-name => "exportMode", -value => $exportMode); print "\n\n"; ########## print action forms - print CGI::p(CGI::b($r->maketext("Any changes made below will be reflected in the achievement for ALL students."))) if $editMode; + print CGI::p(CGI::b($r->maketext("Any changes made below will be reflected in the achievement for ALL students."))) + if $editMode; - print CGI::p($r->maketext("Select an action to perform").":"); + print CGI::p($r->maketext("Select an action to perform") . ":"); my @formsToShow; if ($editMode) { @@ -330,52 +331,62 @@ sub body { for my $actionID (@formsToShow) { my $actionForm = "${actionID}_form"; - push(@tabArr, CGI::li({ class => 'nav-item', role => 'presentation' }, - CGI::a({ - href => "#$actionID", - class => 'nav-link action-link' . ($actionID eq $formsToShow[0] ? ' active' : ''), - id => "$actionID-tab", - data_action => $actionID, - data_bs_toggle => 'tab', - data_bs_target => "#$actionID", - role => 'tab', - aria_controls => $actionID, - aria_selected => $actionID eq $formsToShow[0] ? 'true' : 'false' + push( + @tabArr, + CGI::li( + { class => 'nav-item', role => 'presentation' }, + CGI::a( + { + href => "#$actionID", + class => 'nav-link action-link' . ($actionID eq $formsToShow[0] ? ' active' : ''), + id => "$actionID-tab", + data_action => $actionID, + data_bs_toggle => 'tab', + data_bs_target => "#$actionID", + role => 'tab', + aria_controls => $actionID, + aria_selected => $actionID eq $formsToShow[0] ? 'true' : 'false' + }, + $r->maketext($formTitles{$actionID}) + ) + ) + ); + push( + @contentArr, + CGI::div( + { + class => 'tab-pane fade mb-2' . ($actionID eq $formsToShow[0] ? ' show active' : ''), + id => $actionID, + role => 'tabpanel', + aria_labelledby => "$actionID-tab" }, - $r->maketext($formTitles{$actionID})))); - push(@contentArr, CGI::div({ - class => 'tab-pane fade mb-2' . ($actionID eq $formsToShow[0] ? ' show active' : ''), - id => $actionID, - role => 'tabpanel', - aria_labelledby => "$actionID-tab" - }, - $self->$actionForm($self->getActionParams($actionID)))); + $self->$actionForm($self->getActionParams($actionID)) + ) + ); } print CGI::hidden(-name => 'action', -id => 'current_action', -value => $formsToShow[0]); - print CGI::div( - CGI::ul({ class => 'nav nav-tabs mb-2', role => 'tablist' }, @tabArr), - CGI::div({ class => 'tab-content' }, @contentArr) - ); + print CGI::div(CGI::ul({ class => 'nav nav-tabs mb-2', role => 'tablist' }, @tabArr), + CGI::div({ class => 'tab-content' }, @contentArr)); print CGI::submit({ - id => "take_action", - value => $r->maketext("Take Action!"), - class => 'btn btn-primary mb-3' - }); + id => "take_action", + value => $r->maketext("Take Action!"), + class => 'btn btn-primary mb-3' + }); ########## print table - $self->printTableHTML(\@Achievements, - editMode => $editMode, - exportMode => $exportMode, + $self->printTableHTML( + \@Achievements, + editMode => $editMode, + exportMode => $exportMode, selectedAchievementIDs => \@selectedAchievementIDs, ); - ########## print end of form - print CGI::end_form(); + print CGI::end_form(); return ""; } @@ -416,7 +427,6 @@ sub getTableParams { # not be real "actions". that way, all actions are shown in view mode and no # actions are shown in edit mode. - # Form for editing achievements. sub edit_form { my ($self, %actionParams) = @_; @@ -453,7 +463,7 @@ sub edit_handler { my $scope = $actionParams->{"action.edit.scope"}->[0]; if ($scope eq "all") { - $self->{selectedAchievementIDs} = $self->{allAchievementIDs}; + $self->{selectedAchievementIDs} = $self->{allAchievementIDs}; $result = $r->maketext("editing all achievements"); } elsif ($scope eq "selected") { $result = $r->maketext("editing selected achievements"); @@ -518,65 +528,62 @@ sub assign_form { sub assign_handler { my ($self, $genericParams, $actionParams, $tableParams) = @_; - my $r = $self->r; - my $db = $r->db; - my $ce = $r->ce; + my $r = $self->r; + my $db = $r->db; + my $ce = $r->ce; - my $scope = $actionParams->{"action.assign.scope"}->[0]; + my $scope = $actionParams->{"action.assign.scope"}->[0]; my $overwrite = (($actionParams->{"action.assign.overwrite"}->[0] eq 'everything') ? 1 : 0); my @achievementIDs; my @users = $db->listUsers; - if ($scope eq "all") { - @achievementIDs = @{$self->{allAchievementIDs}}; + @achievementIDs = @{ $self->{allAchievementIDs} }; } else { - @achievementIDs = @{$self->{selectedAchievementIDs}}; + @achievementIDs = @{ $self->{selectedAchievementIDs} }; } #Enable all achievements my @achievements = $db->getAchievements(@achievementIDs); foreach my $achievement (@achievements) { - $achievement->enabled(1); - $db->putAchievement($achievement); + $achievement->enabled(1); + $db->putAchievement($achievement); } #Assign globalUserAchievement data, overwriting if necc foreach my $user (@users) { - if (not $db->existsGlobalUserAchievement($user)) { - my $globalUserAchievement = $db->newGlobalUserAchievement(); - $globalUserAchievement->user_id($user); - $db->addGlobalUserAchievement($globalUserAchievement); - } elsif ($overwrite) { - my $globalUserAchievement = $db->newGlobalUserAchievement(); - $globalUserAchievement->user_id($user); - $db->putGlobalUserAchievement($globalUserAchievement); - } + if (not $db->existsGlobalUserAchievement($user)) { + my $globalUserAchievement = $db->newGlobalUserAchievement(); + $globalUserAchievement->user_id($user); + $db->addGlobalUserAchievement($globalUserAchievement); + } elsif ($overwrite) { + my $globalUserAchievement = $db->newGlobalUserAchievement(); + $globalUserAchievement->user_id($user); + $db->putGlobalUserAchievement($globalUserAchievement); + } } - #Assign userAchievement data, overwriting if necc foreach my $achievementID (@achievementIDs) { - foreach my $user (@users) { - if (not $db->existsUserAchievement($user,$achievementID)) { - my $userAchievement = $db->newUserAchievement(); - $userAchievement->user_id($user); - $userAchievement->achievement_id($achievementID); - $db->addUserAchievement($userAchievement); - } elsif ($overwrite) { - my $userAchievement = $db->newUserAchievement(); - $userAchievement->user_id($user); - $userAchievement->achievement_id($achievementID); - $db->putUserAchievement($userAchievement); + foreach my $user (@users) { + if (not $db->existsUserAchievement($user, $achievementID)) { + my $userAchievement = $db->newUserAchievement(); + $userAchievement->user_id($user); + $userAchievement->achievement_id($achievementID); + $db->addUserAchievement($userAchievement); + } elsif ($overwrite) { + my $userAchievement = $db->newUserAchievement(); + $userAchievement->user_id($user); + $userAchievement->achievement_id($achievementID); + $db->putUserAchievement($userAchievement); + } } - } } - return CGI::div({ class => 'alert alert-success p-1 mb-0' }, $r->maketext('Assigned achievements to users')); } @@ -613,10 +620,10 @@ sub score_form { sub score_handler { my ($self, $genericParams, $actionParams, $tableParams) = @_; - my $r = $self->r; - my $ce = $r->ce; - my $db = $r->db; - my $urlpath = $r->urlpath; + my $r = $self->r; + my $ce = $r->ce; + my $db = $r->db; + my $urlpath = $r->urlpath; my $courseName = $urlpath->arg("courseID"); my $scope = $actionParams->{"action.score.scope"}->[0]; @@ -631,13 +638,13 @@ sub score_handler { } #define file name - my $scoreFileName = $courseName."_achievement_scores.csv"; - my $scoreFilePath = $ce->{courseDirs}->{scoring}.'/'.$scoreFileName; + my $scoreFileName = $courseName . "_achievement_scores.csv"; + my $scoreFilePath = $ce->{courseDirs}->{scoring} . '/' . $scoreFileName; # back up existing file - if(-e $scoreFilePath) { - rename($scoreFilePath, "$scoreFilePath.bak") or - warn "Existing file $scoreFilePath could not be backed up and was lost."; + if (-e $scoreFilePath) { + rename($scoreFilePath, "$scoreFilePath.bak") + or warn "Existing file $scoreFilePath could not be backed up and was lost."; } # check path and open the file @@ -655,63 +662,62 @@ sub score_handler { @achievements = sortAchievements(@achievements); foreach my $achievement (@achievements) { - print SCORE $achievement->achievement_id.", "; + print SCORE $achievement->achievement_id . ", "; } print SCORE "\n"; my @users = $db->listUsers; # get user records - my @userRecords = (); - foreach my $currentUser ( @users) { - my $userObj = $db->getUser($currentUser); #checked + my @userRecords = (); + foreach my $currentUser (@users) { + my $userObj = $db->getUser($currentUser); #checked die "Unable to find user object for $currentUser. " unless $userObj; - push (@userRecords, $userObj ); + push(@userRecords, $userObj); } - @userRecords = sort { ( lc($a->section) cmp lc($b->section) ) || - ( lc($a->last_name) cmp lc($b->last_name )) } @userRecords; - + @userRecords = + sort { (lc($a->section) cmp lc($b->section)) || (lc($a->last_name) cmp lc($b->last_name)) } @userRecords; #print out achievement information for each user foreach my $userRecord (@userRecords) { - my $user_id = $userRecord->user_id; - next unless $db->existsGlobalUserAchievement($user_id); - next if ($userRecord->{status} eq 'D' || $userRecord->{status} eq 'A'); - print SCORE "$user_id, $userRecord->{last_name}, $userRecord->{first_name}, $userRecord->{section}, "; - my $globalUserAchievement = $db->getGlobalUserAchievement($user_id); - my $level_id = $globalUserAchievement->level_achievement_id; - $level_id = ' ' unless $level_id; - my $points = $globalUserAchievement->achievement_points; - $points = 0 unless $points; - print SCORE "$level_id, $points, "; - - foreach my $achievement (@achievements) { - my $achievement_id = $achievement->achievement_id; - if ($db->existsUserAchievement($user_id,$achievement_id)) { - my $userAchievement = $db->getUserAchievement($user_id,$achievement_id); - print SCORE $userAchievement->earned ? "1, ": "0, "; - } else { - print SCORE ", "; + my $user_id = $userRecord->user_id; + next unless $db->existsGlobalUserAchievement($user_id); + next if ($userRecord->{status} eq 'D' || $userRecord->{status} eq 'A'); + print SCORE "$user_id, $userRecord->{last_name}, $userRecord->{first_name}, $userRecord->{section}, "; + my $globalUserAchievement = $db->getGlobalUserAchievement($user_id); + my $level_id = $globalUserAchievement->level_achievement_id; + $level_id = ' ' unless $level_id; + my $points = $globalUserAchievement->achievement_points; + $points = 0 unless $points; + print SCORE "$level_id, $points, "; + + foreach my $achievement (@achievements) { + my $achievement_id = $achievement->achievement_id; + if ($db->existsUserAchievement($user_id, $achievement_id)) { + my $userAchievement = $db->getUserAchievement($user_id, $achievement_id); + print SCORE $userAchievement->earned ? "1, " : "0, "; + } else { + print SCORE ", "; + } } - } - print SCORE "\n"; + print SCORE "\n"; } close SCORE; # Include a download link # - my $fileManagerPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Instructor::FileManager", $r, courseID => $courseName); - my $fileManagerURL = $self->systemLink($fileManagerPage, params => {action=>"View", files => "${courseName}_achievement_scores.csv", pwd=>"scoring"}); - + my $fileManagerPage = + $urlpath->newFromModule("WeBWorK::ContentGenerator::Instructor::FileManager", $r, courseID => $courseName); + my $fileManagerURL = $self->systemLink($fileManagerPage, + params => { action => "View", files => "${courseName}_achievement_scores.csv", pwd => "scoring" }); return CGI::div({ class => 'alert alert-success p-1 mb-0' }, $r->maketext('Achievement scores saved to [_1]', CGI::a({ href => $fileManagerURL }, $scoreFileName))); } - # Form for deleting achievements. sub delete_form { my ($self, %actionParams) = @_; @@ -750,19 +756,18 @@ sub delete_form { sub delete_handler { my ($self, $genericParams, $actionParams, $tableParams) = @_; - my $r = $self->r; - my $db = $r->db; + my $r = $self->r; + my $db = $r->db; my $scope = $actionParams->{"action.delete.scope"}->[0]; - my @achievementIDsToDelete = (); if ($scope eq "selected") { @achievementIDsToDelete = @{ $self->{selectedAchievementIDs} }; } - my %allAchievementIDs = map { $_ => 1 } @{ $self->{allAchievementIDs} }; + my %allAchievementIDs = map { $_ => 1 } @{ $self->{allAchievementIDs} }; my %selectedAchievementIDs = map { $_ => 1 } @{ $self->{selectedAchievementIDs} }; #run through selected achievements and delete @@ -774,7 +779,7 @@ sub delete_handler { } #update local fields - $self->{allAchievementIDs} = [ keys %allAchievementIDs ]; + $self->{allAchievementIDs} = [ keys %allAchievementIDs ]; $self->{selectedAchievementIDs} = [ keys %selectedAchievementIDs ]; my $num = @achievementIDsToDelete; @@ -833,10 +838,10 @@ sub create_form { sub create_handler { my ($self, $genericParams, $actionParams, $tableParams) = @_; - my $r = $self->r; - my $db = $r->db; - my $ce = $r->ce; - my $user = $r->param('user'); + my $r = $self->r; + my $db = $r->db; + my $ce = $r->ce; + my $user = $r->param('user'); #create achievement my $newAchievementID = $actionParams->{"action.create.id"}->[0]; @@ -847,7 +852,7 @@ sub create_handler { $r->maketext("Achievement [_1] exists. No achievement created", $newAchievementID)) if $db->existsAchievement($newAchievementID); my $newAchievementRecord = $db->newAchievement; - my $oldAchievementID = $self->{selectedAchievementIDs}->[0]; + my $oldAchievementID = $self->{selectedAchievementIDs}->[0]; my $type = $actionParams->{"action.create.type"}->[0]; @@ -939,15 +944,15 @@ sub import_form { # handler for importing achievements sub import_handler { my ($self, $genericParams, $actionParams, $tableParams) = @_; - my $r = $self->r; - my $ce = $r->ce; - my $db = $r->db; + my $r = $self->r; + my $ce = $r->ce; + my $db = $r->db; - my $fileName = $actionParams->{"action.import.source"}->[0]; - my $assign = $actionParams->{"action.import.assign"}->[0]; - my @users = $db->listUsers; + my $fileName = $actionParams->{"action.import.source"}->[0]; + my $assign = $actionParams->{"action.import.assign"}->[0]; + my @users = $db->listUsers; my %allAchievementIDs = map { $_ => 1 } @{ $self->{allAchievementIDs} }; - my $filePath = $ce->{courseDirs}->{achievements}.'/'.$fileName; + my $filePath = $ce->{courseDirs}->{achievements} . '/' . $fileName; #open file name my $fh; @@ -956,70 +961,70 @@ sub import_handler { #read in lines from file my $count = 0; - my $csv = Text::CSV->new(); + my $csv = Text::CSV->new(); while (my $data = $csv->getline($fh)) { - my $achievement_id = $$data[0]; - #skip achievements that already exist - next if $db->existsAchievement($achievement_id); + my $achievement_id = $$data[0]; + #skip achievements that already exist + next if $db->existsAchievement($achievement_id); + + #write achievement data. The "format" for this isn't written down anywhere (!) + my $achievement = $db->newAchievement(); - #write achievement data. The "format" for this isn't written down anywhere (!) - my $achievement = $db->newAchievement(); + $achievement->achievement_id($achievement_id); - $achievement->achievement_id($achievement_id); + # fall back for importing an old list without the number + # or assignment_type fields + if (scalar(@$data) == 9) { + # old lists tend to have an extraneous space at the front. + for (my $i = 1; $i <= 7; $i++) { + $$data[$i] =~ s/^\s+//; + } - # fall back for importing an old list without the number - # or assignment_type fields - if (scalar(@$data) == 9) { - # old lists tend to have an extraneous space at the front. - for (my $i=1; $i<=7; $i++) { - $$data[$i] =~ s/^\s+//; + $$data[1] =~ s/\;/,/; + $achievement->name($$data[1]); + $achievement->category($$data[2]); + $$data[3] =~ s/\;/,/; + $achievement->description($$data[3]); + $achievement->points($$data[4]); + $achievement->max_counter($$data[5]); + $achievement->test($$data[6]); + $achievement->icon($$data[7]); + $achievement->assignment_type('default'); + $achievement->number($count + 1); + } else { + $achievement->name($$data[1]); + $achievement->number($$data[2]); + $achievement->category($$data[3]); + $achievement->assignment_type($$data[4]); + $achievement->description($$data[5]); + $achievement->points($$data[6]); + $achievement->max_counter($$data[7]); + $achievement->test($$data[8]); + $achievement->icon($$data[9]); } - $$data[1] =~ s/\;/,/; - $achievement->name($$data[1]); - $achievement->category($$data[2]); - $$data[3] =~ s/\;/,/; - $achievement->description($$data[3]); - $achievement->points($$data[4]); - $achievement->max_counter($$data[5]); - $achievement->test($$data[6]); - $achievement->icon($$data[7]); - $achievement->assignment_type('default'); - $achievement->number($count+1); - } else { - $achievement->name($$data[1]); - $achievement->number($$data[2]); - $achievement->category($$data[3]); - $achievement->assignment_type($$data[4]); - $achievement->description($$data[5]); - $achievement->points($$data[6]); - $achievement->max_counter($$data[7]); - $achievement->test($$data[8]); - $achievement->icon($$data[9]); - } - - $achievement->enabled($assign eq "all"?1:0); - - #add achievement - $db->addAchievement($achievement); - $count++; - $allAchievementIDs{$achievement_id} = 1; - - #assign to usesrs if necc - if ($assign eq "all") { - foreach my $user (@users) { - if (not $db->existsGlobalUserAchievement($user)) { - my $globalUserAchievement = $db->newGlobalUserAchievement(); - $globalUserAchievement->user_id($user); - $db->addGlobalUserAchievement($globalUserAchievement); - } - my $userAchievement = $db->newUserAchievement(); - $userAchievement->user_id($user); - $userAchievement->achievement_id($achievement_id); - $db->addUserAchievement($userAchievement); + $achievement->enabled($assign eq "all" ? 1 : 0); + + #add achievement + $db->addAchievement($achievement); + $count++; + $allAchievementIDs{$achievement_id} = 1; + + #assign to usesrs if necc + if ($assign eq "all") { + foreach my $user (@users) { + if (not $db->existsGlobalUserAchievement($user)) { + my $globalUserAchievement = $db->newGlobalUserAchievement(); + $globalUserAchievement->user_id($user); + $db->addGlobalUserAchievement($globalUserAchievement); + } + my $userAchievement = $db->newUserAchievement(); + $userAchievement->user_id($user); + $userAchievement->achievement_id($achievement_id); + $db->addUserAchievement($userAchievement); + } } - } } $self->{allAchievementIDs} = [ keys %allAchievementIDs ]; @@ -1069,14 +1074,13 @@ sub export_handler { $self->{selectedAchievementIDs} = $self->{allAchievementIDs}; } elsif ($scope eq "selected") { $result = $r->maketext("exporting selected achievements"); - $self->{selectedAchievementIDs} = $genericParams->{selected_achievements}; # an arrayref + $self->{selectedAchievementIDs} = $genericParams->{selected_achievements}; # an arrayref } $self->{exportMode} = 1; return CGI::div({ class => 'alert alert-success p-1 mb-0' }, $result); } - # Form and handler for leaving the export page. sub cancelExport_form { my ($self, %actionParams) = @_; @@ -1085,7 +1089,7 @@ sub cancelExport_form { sub cancelExport_handler { my ($self, $genericParams, $actionParams, $tableParams) = @_; - my $r = $self->r; + my $r = $self->r; $self->{exportMode} = 0; @@ -1100,22 +1104,22 @@ sub saveExport_form { sub saveExport_handler { my ($self, $genericParams, $actionParams, $tableParams) = @_; - my $r = $self->r; - my $ce = $r->ce; - my $db = $r->db; - my $urlpath = $r->urlpath; + my $r = $self->r; + my $ce = $r->ce; + my $db = $r->db; + my $urlpath = $r->urlpath; my $courseName = $urlpath->arg("courseID"); - my @achievementIDsToExport = $r->param("selected_export") ; + my @achievementIDsToExport = $r->param("selected_export"); #get file path - my $FileName = $courseName."_achievements.axp"; - my $FilePath = $ce->{courseDirs}->{achievements}.'/'.$FileName; + my $FileName = $courseName . "_achievements.axp"; + my $FilePath = $ce->{courseDirs}->{achievements} . '/' . $FileName; # back up existing file - if(-e $FilePath) { - rename($FilePath, "$FilePath.bak") or - warn "Existing file $FilePath could not be backed up and was lost."; + if (-e $FilePath) { + rename($FilePath, "$FilePath.bak") + or warn "Existing file $FilePath could not be backed up and was lost."; } $FilePath = WeBWorK::Utils::surePathToFile($ce->{courseDirs}->{achievements}, $FilePath); @@ -1124,23 +1128,19 @@ sub saveExport_handler { open $fh, ">$FilePath" or return CGI::div({ class => 'alert alert-danger p-1 mb-0' }, $r->maketext("Failed to open [_1]", $FilePath)); - my $csv = Text::CSV->new({eol=>"\n"}); + my $csv = Text::CSV->new({ eol => "\n" }); my @achievements = $db->getAchievements(@achievementIDsToExport); #run through achievements outputing data as csv list. This format is not documented anywhere foreach my $achievement (@achievements) { - my $line = [$achievement->achievement_id, - $achievement->name, - $achievement->number, - $achievement->category, - $achievement->assignment_type, - $achievement->description, - $achievement->points, - $achievement->max_counter, - $achievement->test, - $achievement->icon,]; - - warn("Error Exporting Achievement ".$achievement->achievement_id) - unless $csv->print($fh, $line); + my $line = [ + $achievement->achievement_id, $achievement->name, $achievement->number, + $achievement->category, $achievement->assignment_type, $achievement->description, + $achievement->points, $achievement->max_counter, $achievement->test, + $achievement->icon, + ]; + + warn("Error Exporting Achievement " . $achievement->achievement_id) + unless $csv->print($fh, $line); } close EXPORT; @@ -1159,7 +1159,7 @@ sub cancelEdit_form { sub cancelEdit_handler { my ($self, $genericParams, $actionParams, $tableParams) = @_; - my $r = $self->r; + my $r = $self->r; $self->{editMode} = 0; @@ -1174,15 +1174,15 @@ sub saveEdit_form { sub saveEdit_handler { my ($self, $genericParams, $actionParams, $tableParams) = @_; - my $r = $self->r; - my $db = $r->db; + my $r = $self->r; + my $db = $r->db; my @selectedAchievementIDs = @{ $self->{selectedAchievementIDs} }; #run through selected achievements foreach my $achievementID (@selectedAchievementIDs) { - my $Achievement = $db->getAchievement($achievementID); # checked - # FIXME: we may not want to die on bad sets, they're not as bad as bad users + my $Achievement = $db->getAchievement($achievementID); # checked + # FIXME: we may not want to die on bad sets, they're not as bad as bad users die "record for achievement $achievementID not found" unless $Achievement; #update fields @@ -1190,21 +1190,21 @@ sub saveEdit_handler { my $param = "achievement.${achievementID}.${field}"; if ($field eq 'assignment_type') { - my @types = (); - my $i = 0; + my @types = (); + my $i = 0; - while (defined ($tableParams->{$param}->[$i])) { - push @types, $tableParams->{$param}->[$i]; - $i++; - } + while (defined($tableParams->{$param}->[$i])) { + push @types, $tableParams->{$param}->[$i]; + $i++; + } - $Achievement->assignment_type(join(',',@types)); + $Achievement->assignment_type(join(',', @types)); } else { - if (defined $tableParams->{$param}->[0]) { - $Achievement->$field($tableParams->{$param}->[0]); - } + if (defined $tableParams->{$param}->[0]) { + $Achievement->$field($tableParams->{$param}->[0]); + } } } @@ -1223,11 +1223,11 @@ sub saveEdit_handler { #write out a particular field sub fieldEditHTML { my ($self, $fieldName, $value, $properties) = @_; - my $size = $properties->{size}; - my $type = $properties->{type}; - my $access = $properties->{access}; - my $items = $properties->{items}; - my $synonyms = $properties->{synonyms}; + my $size = $properties->{size}; + my $type = $properties->{type}; + my $access = $properties->{access}; + my $items = $properties->{items}; + my $synonyms = $properties->{synonyms}; my $headerFiles = $self->{headerFiles}; return $value if ($access eq 'readonly'); @@ -1278,29 +1278,41 @@ sub fieldEditHTML { #write out a row of the table sub recordEditHTML { my ($self, $Achievement, %options) = @_; - my $r = $self->r; - my $urlpath = $r->urlpath; - my $ce = $r->ce; - my $db = $r->db; - my $authz = $r->authz; - my $user = $r->param('user'); - my $root = $ce->{webworkURLs}->{root}; - my $courseName = $urlpath->arg("courseID"); - - my $editMode = $options{editMode}; - my $exportMode = $options{exportMode}; + my $r = $self->r; + my $urlpath = $r->urlpath; + my $ce = $r->ce; + my $db = $r->db; + my $authz = $r->authz; + my $user = $r->param('user'); + my $root = $ce->{webworkURLs}->{root}; + my $courseName = $urlpath->arg("courseID"); + + my $editMode = $options{editMode}; + my $exportMode = $options{exportMode}; my $achievementSelected = $options{achievementSelected}; - my $users = $db->countAchievementUsers($Achievement->achievement_id); + my $users = $db->countAchievementUsers($Achievement->achievement_id); my $totalUsers = $self->{totalUsers}; my @tableCells; my $achievement_id = $Achievement->achievement_id; - my $editorPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Instructor::AchievementEditor", $r, courseID => $courseName, achievementID => $achievement_id); - my $editorURL = $self->systemLink($editorPage, params => { - sourceFilePath => $ce->{courseDirs}->{achievements}."/".$Achievement->test}); + my $editorPage = $urlpath->newFromModule( + "WeBWorK::ContentGenerator::Instructor::AchievementEditor", $r, + courseID => $courseName, + achievementID => $achievement_id + ); + my $editorURL = $self->systemLink( + $editorPage, + params => { + sourceFilePath => $ce->{courseDirs}->{achievements} . "/" . $Achievement->test + } + ); - my $userEditorPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Instructor::AchievementUserEditor", $r, courseID=>$courseName, achievementID =>$achievement_id); + my $userEditorPage = $urlpath->newFromModule( + "WeBWorK::ContentGenerator::Instructor::AchievementUserEditor", $r, + courseID => $courseName, + achievementID => $achievement_id + ); my $userEditorURL = $self->systemLink($userEditorPage, params => {}); # The formats are "hard coded" below. Making them more modular would be good. @@ -1413,22 +1425,20 @@ sub recordEditHTML { #this prints out the whole table sub printTableHTML { my ($self, $AchievementsRef, %options) = @_; - my $r = $self->r; - my $authz = $r->authz; - my $user = $r->param('user'); - my @Achievements = @$AchievementsRef; - + my $r = $self->r; + my $authz = $r->authz; + my $user = $r->param('user'); + my @Achievements = @$AchievementsRef; - my $editMode = $options{editMode}; - my $exportMode = $options{exportMode}; - my %selectedAchievementIDs = map { $_ => 1 } @{ $options{selectedAchievementIDs} }; + my $editMode = $options{editMode}; + my $exportMode = $options{exportMode}; + my %selectedAchievementIDs = map { $_ => 1 } @{ $options{selectedAchievementIDs} }; # names of headings: if ($editMode and not %selectedAchievementIDs) { - print CGI::p( - CGI::i("No achievements shown. Select an achievement to edit!")); - return; + print CGI::p(CGI::i("No achievements shown. Select an achievement to edit!")); + return; } my @tableHeadings; @@ -1517,16 +1527,14 @@ sub printTableHTML { # ########################################## - print CGI::p( - CGI::i($r->maketext("No achievements shown. Create an achievement!")) - ) unless @Achievements; + print CGI::p(CGI::i($r->maketext("No achievements shown. Create an achievement!"))) unless @Achievements; } #get list of files that can be imported. sub getAxpList { my ($self) = @_; - my $ce = $self->{ce}; - my $dir = $ce->{courseDirs}->{achievements}; + my $ce = $self->{ce}; + my $dir = $ce->{courseDirs}->{achievements}; return $self->read_dir($dir, qr/.*\.axp/); } diff --git a/lib/WeBWorK/ContentGenerator/Instructor/AchievementUserEditor.pm b/lib/WeBWorK/ContentGenerator/Instructor/AchievementUserEditor.pm index 205f7dc18f..f39bf0a8b8 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/AchievementUserEditor.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/AchievementUserEditor.pm @@ -29,19 +29,19 @@ use CGI qw(-nosticky ); use WeBWorK::Debug; sub initialize { - my ($self) = @_; - my $r = $self->r; - my $urlpath = $r->urlpath; - my $authz = $r->authz; - my $db = $r->db; + my ($self) = @_; + my $r = $self->r; + my $urlpath = $r->urlpath; + my $authz = $r->authz; + my $db = $r->db; my $achievementID = $urlpath->arg("achievementID"); - my $user = $r->param('user'); + my $user = $r->param('user'); # Check permissions return unless $authz->hasPermissions($user, "edit_achievements"); $self->{all_users} = [ $db->listUsers ]; - my %selectedUsers = map {$_ => 1} $r->param('selected'); + my %selectedUsers = map { $_ => 1 } $r->param('selected'); my $doAssignToSelected = 0; @@ -58,20 +58,16 @@ sub initialize { && $r->param('unassignFromAllSafety') == 1) { %selectedUsers = (); - $self->addmessage( - CGI::div( - { class => 'alert alert-danger p-1 mb-0' }, - $r->maketext("Achievement has been unassigned to all students.") - ) - ); + $self->addmessage(CGI::div( + { class => 'alert alert-danger p-1 mb-0' }, + $r->maketext("Achievement has been unassigned to all students.") + )); $doAssignToSelected = 1; } elsif (defined $r->param('assignToSelected')) { - $self->addmessage( - CGI::div( - { class => 'alert alert-success p-1 mb-0' }, - $r->maketext("Achievement has been assigned to selected users.") - ) - ); + $self->addmessage(CGI::div( + { class => 'alert alert-success p-1 mb-0' }, + $r->maketext("Achievement has been assigned to selected users.") + )); $doAssignToSelected = 1; } elsif (defined $r->param("unassignFromAll")) { # no action taken @@ -84,78 +80,80 @@ sub initialize { my %achievementUsers = map { $_ => 1 } $db->listAchievementUsers($achievementID); foreach my $selectedUser (@{ $self->{all_users} }) { if (exists $selectedUsers{$selectedUser} && $achievementUsers{$selectedUser}) { - # update existing user data (in case fields were changed) - my $userAchievement = $db->getUserAchievement($selectedUser,$achievementID); - - my $updatedEarned = $r->param("$selectedUser.earned") ? 1:0; - my $earned = $userAchievement->earned ? 1:0; - if ($updatedEarned != $earned) { - - $userAchievement->earned($updatedEarned); - my $globalUserAchievement = $db->getGlobalUserAchievement($selectedUser); - my $achievement = $db->getAchievement($achievementID); - - my $points = $achievement->points || 0; - my $initialpoints = $globalUserAchievement->achievement_points || 0; - #add the correct number of points if we - # are saying that the user now earned the - # achievement, or remove them otherwise - if ($updatedEarned) { - - $globalUserAchievement->achievement_points( - $initialpoints + $points); - } else { - $globalUserAchievement->achievement_points( - $initialpoints - $points); + # update existing user data (in case fields were changed) + my $userAchievement = $db->getUserAchievement($selectedUser, $achievementID); + + my $updatedEarned = $r->param("$selectedUser.earned") ? 1 : 0; + my $earned = $userAchievement->earned ? 1 : 0; + if ($updatedEarned != $earned) { + + $userAchievement->earned($updatedEarned); + my $globalUserAchievement = $db->getGlobalUserAchievement($selectedUser); + my $achievement = $db->getAchievement($achievementID); + + my $points = $achievement->points || 0; + my $initialpoints = $globalUserAchievement->achievement_points || 0; + #add the correct number of points if we + # are saying that the user now earned the + # achievement, or remove them otherwise + if ($updatedEarned) { + + $globalUserAchievement->achievement_points($initialpoints + $points); + } else { + $globalUserAchievement->achievement_points($initialpoints - $points); + } + + $db->putGlobalUserAchievement($globalUserAchievement); } - $db->putGlobalUserAchievement($globalUserAchievement); - } - - - $userAchievement->counter($r->param("$selectedUser.counter")); - $db->putUserAchievement($userAchievement); + $userAchievement->counter($r->param("$selectedUser.counter")); + $db->putUserAchievement($userAchievement); } elsif (exists $selectedUsers{$selectedUser}) { - # add users that dont exist - my $userAchievement = $db->newUserAchievement(); - $userAchievement->user_id($selectedUser); - $userAchievement->achievement_id($achievementID); - $db->addUserAchievement($userAchievement); - - #If they dont have global achievement data, then add that too - if (not $db->existsGlobalUserAchievement($selectedUser)) { - my $globalUserAchievement = $db->newGlobalUserAchievement(); - $globalUserAchievement->user_id($selectedUser); - $db->addGlobalUserAchievement($globalUserAchievement); - } + # add users that dont exist + my $userAchievement = $db->newUserAchievement(); + $userAchievement->user_id($selectedUser); + $userAchievement->achievement_id($achievementID); + $db->addUserAchievement($userAchievement); + + #If they dont have global achievement data, then add that too + if (not $db->existsGlobalUserAchievement($selectedUser)) { + my $globalUserAchievement = $db->newGlobalUserAchievement(); + $globalUserAchievement->user_id($selectedUser); + $db->addGlobalUserAchievement($globalUserAchievement); + } } else { - # delete users who are not selected - # but dont delete users who dont exist - next unless $achievementUsers{$selectedUser}; - $db->deleteUserAchievement($selectedUser, $achievementID); + # delete users who are not selected + # but dont delete users who dont exist + next unless $achievementUsers{$selectedUser}; + $db->deleteUserAchievement($selectedUser, $achievementID); } } } } sub body { - my ($self) = @_; - my $r = $self->r; - my $urlpath = $r->urlpath; - my $db = $r->db; - my $ce = $r->ce; - my $authz = $r->authz; - my $webworkRoot = $ce->{webworkURLs}->{root}; - my $courseName = $urlpath->arg("courseID"); - my $achievementID = $urlpath->arg("achievementID"); - my $user = $r->param('user'); + my ($self) = @_; + my $r = $self->r; + my $urlpath = $r->urlpath; + my $db = $r->db; + my $ce = $r->ce; + my $authz = $r->authz; + my $webworkRoot = $ce->{webworkURLs}->{root}; + my $courseName = $urlpath->arg("courseID"); + my $achievementID = $urlpath->arg("achievementID"); + my $user = $r->param('user'); return CGI::div({ class => 'alert alert-danger p-1' }, "You are not authorized to edit achievements.") unless $authz->hasPermissions($user, "edit_achievements"); - print CGI::start_form({name=>"user-achievement-form", id=>"user-achievement-form", method=>"post", action => $self->systemLink( $urlpath, authen=>0) }); + print CGI::start_form({ + name => "user-achievement-form", + id => "user-achievement-form", + method => "post", + action => $self->systemLink($urlpath, authen => 0) + }); # Assign to everyone message print CGI::div( @@ -187,19 +185,19 @@ sub body { CGI::th($r->maketext('Login Name')), CGI::th($r->maketext('Student Name')), CGI::th({ class => 'text-center' }, $r->maketext('Section')), - CGI::th({ class => 'text-center', id => 'earned_header' }, $r->maketext('Earned')), + CGI::th({ class => 'text-center', id => 'earned_header' }, $r->maketext('Earned')), CGI::th({ class => 'text-center', id => 'counter_header' }, $r->maketext('Counter')) ); # get user records - my @userRecords = (); + my @userRecords = (); for my $currentUser (@{ $self->{all_users} }) { - my $userObj = $db->getUser($currentUser); #checked + my $userObj = $db->getUser($currentUser); #checked die "Unable to find user object for $currentUser. " unless $userObj; - push (@userRecords, $userObj ); + push(@userRecords, $userObj); } - @userRecords = sort { ( lc($a->section) cmp lc($b->section) ) || - ( lc($a->last_name) cmp lc($b->last_name )) } @userRecords; + @userRecords = + sort { (lc($a->section) cmp lc($b->section)) || (lc($a->last_name) cmp lc($b->last_name)) } @userRecords; #print row for user for my $userRecord (@userRecords) { @@ -216,11 +214,11 @@ sub body { CGI::td( { class => 'text-center' }, CGI::input({ - type => 'checkbox', - name => 'selected', - id => "$user.assigned", - value => $user, - class => 'form-check-input', + type => 'checkbox', + name => 'selected', + id => "$user.assigned", + value => $user, + class => 'form-check-input', defined $userAchievement ? (checked => undef) : (), }) ), @@ -269,8 +267,8 @@ sub body { { class => 'alert alert-danger p-1 mb-3' }, $r->maketext( "There is NO undo for this function. Do not use it unless you know what you are doing! " - . "When you unassign a student using this button, or by unchecking their name, you destroy all " - . "of the data for achievement [_1] for this student.", + . "When you unassign a student using this button, or by unchecking their name, you destroy all " + . "of the data for achievement [_1] for this student.", $achievementID ) ), diff --git a/lib/WeBWorK/ContentGenerator/Instructor/AddUsers.pm b/lib/WeBWorK/ContentGenerator/Instructor/AddUsers.pm index fddc64c461..bd89e0ca38 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/AddUsers.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/AddUsers.pm @@ -43,7 +43,8 @@ sub initialize { if (defined($r->param('addStudents'))) { my @userIDs; my $numberOfStudents = $r->param('number_of_students'); - warn "Internal error -- the number of students to be added has not been included" unless defined $numberOfStudents; + warn "Internal error -- the number of students to be added has not been included" + unless defined $numberOfStudents; foreach my $i (1 .. $numberOfStudents) { my $new_user_id = trim_spaces($r->param("new_user_id_$i")); my $new_password = cryptPassword($r->param("student_id_$i")); @@ -71,21 +72,39 @@ sub initialize { if ($@) { my $addError = $@; $self->{studentEntryReport} .= join("", - CGI::b($r->maketext("Failed to enter student:")), ' ', $newUser->last_name, ", ",$newUser->first_name, - CGI::b(", ".$r->maketext("login/studentID:")),' ', $newUser->user_id, "/",$newUser->student_id, - CGI::b(", ".$r->maketext("email:")),' ', $newUser->email_address, - CGI::b(", ".$r->maketext("section:")),' ', $newUser->section, - CGI::br(), CGI::b($r->maketext("Error message:")), ' ', $addError, - CGI::hr(),CGI::br(), + CGI::b($r->maketext("Failed to enter student:")), + ' ', + $newUser->last_name, + ", ", + $newUser->first_name, + CGI::b(", " . $r->maketext("login/studentID:")), + ' ', + $newUser->user_id, + "/", + $newUser->student_id, + CGI::b(", " . $r->maketext("email:")), + ' ', + $newUser->email_address, + CGI::b(", " . $r->maketext("section:")), + ' ', + $newUser->section, + CGI::br(), + CGI::b($r->maketext("Error message:")), + ' ', + $addError, + CGI::hr(), + CGI::br(), ); } else { $db->addPermissionLevel($newPermissionLevel); $db->addPassword($newPassword); - $self->{studentEntryReport} .= join("", - CGI::b($r->maketext("Entered student:")), ' ', $newUser->last_name, ", ",$newUser->first_name, - CGI::b(", ",$r->maketext("login/studentID:")),' ', $newUser->user_id, "/",$newUser->student_id, - CGI::b(", ",$r->maketext("email:")),' ', $newUser->email_address, - CGI::b(", ",$r->maketext("section:")),' ', $newUser->section,CGI::hr(),CGI::br(), + $self->{studentEntryReport} .= join( + "", + CGI::b($r->maketext("Entered student:")), ' ', $newUser->last_name, ", ", $newUser->first_name, + CGI::b(", ", $r->maketext("login/studentID:")), ' ', $newUser->user_id, "/", + $newUser->student_id, + CGI::b(", ", $r->maketext("email:")), ' ', $newUser->email_address, + CGI::b(", ", $r->maketext("section:")), ' ', $newUser->section, CGI::hr(), CGI::br(), ); } @@ -111,7 +130,8 @@ sub body { my $user = $r->param('user'); # Check permissions - return CGI::div({ class => 'alert alert-danger p-1 mb-0' }, "You are not authorized to access the Instructor tools.") + return CGI::div({ class => 'alert alert-danger p-1 mb-0' }, + "You are not authorized to access the Instructor tools.") unless $authz->hasPermissions($user, "access_instructor_tools"); return CGI::div({ class => 'alert alert-danger p-1 mb-0' }, "You are not authorized to modify student data.") @@ -160,11 +180,11 @@ sub addStudentForm { class => 'form-control form-control-sm w-auto' }), CGI::input({ - type => 'text', - class => "student-id-input", - name => "student_id_$i", - size => "16", - class => 'form-control form-control-sm w-auto' + type => 'text', + class => "student-id-input", + name => "student_id_$i", + size => "16", + class => 'form-control form-control-sm w-auto' }), CGI::input({ type => 'text', @@ -222,7 +242,12 @@ sub addStudentForm { CGI::end_form(), CGI::hr(), - CGI::start_form({ method => "post", action => $r->uri(), name => "new-users-form", id => "new-users-form" }), + CGI::start_form({ + method => "post", + action => $r->uri(), + name => "new-users-form", + id => "new-users-form" + }), $self->hidden_authen_fields(), CGI::input({ type => 'hidden', name => "number_of_students", value => $numberOfStudents }), CGI::start_div({ class => 'table-responsive' }), @@ -250,7 +275,11 @@ sub addStudentForm { class => 'form-select w-auto mb-2' }), CGI::p( - CGI::submit({ name => "addStudents", value => $r->maketext("Add Students"), class => 'btn btn-primary' }), + CGI::submit({ + name => "addStudents", + value => $r->maketext("Add Students"), + class => 'btn btn-primary' + }), ), CGI::end_form(), diff --git a/lib/WeBWorK/ContentGenerator/Instructor/Assigner.pm b/lib/WeBWorK/ContentGenerator/Instructor/Assigner.pm index cd04a6afe7..17bc958547 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/Assigner.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/Assigner.pm @@ -30,40 +30,41 @@ use WeBWorK::HTML::ScrollingRecordList qw/scrollingRecordList/; sub pre_header_initialize { my ($self) = @_; - my $r = $self->r; - my $db = $r->db; - my $authz = $r->authz; - my $ce = $r->ce; - my $user = $r->param('user'); + my $r = $self->r; + my $db = $r->db; + my $authz = $r->authz; + my $ce = $r->ce; + my $user = $r->param('user'); # Permissions dealt with in the body return "" unless $authz->hasPermissions($user, "access_instructor_tools"); return "" unless $authz->hasPermissions($user, "assign_problem_sets"); my @selected_users = $r->param("selected_users"); - my @selected_sets = $r->param("selected_sets"); + my @selected_sets = $r->param("selected_sets"); if (defined $r->param("assign") || defined $r->param("unassign")) { - if (@selected_users && @selected_sets) { - my @results; # This is not used? - if(defined $r->param("assign")) { + if (@selected_users && @selected_sets) { + my @results; # This is not used? + if (defined $r->param("assign")) { $self->assignSetsToUsers(\@selected_sets, \@selected_users); $self->addgoodmessage($r->maketext('All assignments were made successfully.')); } if (defined $r->param("unassign")) { - if(defined $r->param('unassignFromAllSafety') and $r->param('unassignFromAllSafety')==1) { - $self->unassignSetsFromUsers(\@selected_sets, \@selected_users) if(defined $r->param("unassign")); + if (defined $r->param('unassignFromAllSafety') and $r->param('unassignFromAllSafety') == 1) { + $self->unassignSetsFromUsers(\@selected_sets, \@selected_users) if (defined $r->param("unassign")); $self->addgoodmessage($r->maketext('All unassignments were made successfully.')); - } else { # asked for unassign, but no safety radio toggle - $self->addbadmessage($r->maketext('Unassignments were not done. You need to both click to "Allow unassign" and click on the Unassign button.')); + } else { # asked for unassign, but no safety radio toggle + $self->addbadmessage( + $r->maketext( + 'Unassignments were not done. You need to both click to "Allow unassign" and click on the Unassign button.' + ) + ); } } - if (@results) { # Can't get here? - $self->addbadmessage( - "The following error(s) occured while assigning:". - CGI::ul(CGI::li(\@results)) - ); + if (@results) { # Can't get here? + $self->addbadmessage("The following error(s) occured while assigning:" . CGI::ul(CGI::li(\@results))); } } else { $self->addbadmessage("You must select one or more users below.") @@ -111,7 +112,7 @@ sub body { : () }); - my @GlobalSets = $db->getGlobalSetsWhere(); + my @GlobalSets = $db->getGlobalSetsWhere(); print CGI::start_form({ method => 'post', action => $r->uri() }); print $self->hidden_authen_fields(); @@ -173,7 +174,10 @@ sub body { }), CGI::div( { class => 'alert alert-danger p-1 mb-2' }, - CGI::div({ class => 'mb-1' }, $r->maketext('Do not unassign students unless you know what you are doing.')), + CGI::div( + { class => 'mb-1' }, + $r->maketext('Do not unassign students unless you know what you are doing.') + ), CGI::div($r->maketext('There is NO undo for unassigning students.')) ), CGI::div( diff --git a/lib/WeBWorK/ContentGenerator/Instructor/CodeMirrorEditor.pm b/lib/WeBWorK/ContentGenerator/Instructor/CodeMirrorEditor.pm index 55986455e5..47103c7855 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/CodeMirrorEditor.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/CodeMirrorEditor.pm @@ -105,8 +105,7 @@ sub output_codemirror_html { CGI::div( { class => 'row align-items-center' }, CGI::label( - { for => 'selectTheme', class => 'col-form-label col-auto' }, - $r->maketext('Theme:') + { for => 'selectTheme', class => 'col-form-label col-auto' }, $r->maketext('Theme:') ), CGI::div( { class => 'col-auto' }, @@ -168,7 +167,7 @@ sub output_codemirror_html { }), CGI::label( { for => 'forceRTL', class => 'form-check-label' }, - 'Force editor to RTL' # FIXME should have $r->maketext() + 'Force editor to RTL' # FIXME should have $r->maketext() ) ) ) diff --git a/lib/WeBWorK/ContentGenerator/Instructor/Config.pm b/lib/WeBWorK/ContentGenerator/Instructor/Config.pm index 4eb06de1e0..f1a2d4b12a 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/Config.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/Config.pm @@ -37,7 +37,7 @@ use URI::Escape; sub new { my $class = shift; - my $self = shift; + my $self = shift; $self->{Module} = shift; bless $self, $class; return $self; @@ -57,15 +57,14 @@ sub comparison_value { sub convert_newval_source { my ($self, $newvalsource) = @_; - my $inlinevarname = WeBWorK::ContentGenerator::Instructor::Config::inline_var($self->{var}); - my $newval; - if($newvalsource =~ /widget/) { - $newval = $self->{Module}->{r}->param($newvalsource); - } else { - $newval = $self->comparison_value(eval('$self->{Module}->{r}->ce->'. - $inlinevarname)); - } - return($newval); + my $inlinevarname = WeBWorK::ContentGenerator::Instructor::Config::inline_var($self->{var}); + my $newval; + if ($newvalsource =~ /widget/) { + $newval = $self->{Module}->{r}->param($newvalsource); + } else { + $newval = $self->comparison_value(eval('$self->{Module}->{r}->ce->' . $inlinevarname)); + } + return ($newval); } # Bit of text to put in the configuration file. The result should @@ -74,11 +73,11 @@ sub convert_newval_source { # widget produces sub save_string { my ($self, $oldval, $newvalsource) = @_; - my $varname = $self->{var}; - my $newval = $self->convert_newval_source($newvalsource); + my $varname = $self->{var}; + my $newval = $self->convert_newval_source($newvalsource); my $cmpoldval = $self->comparison_value($oldval); - return '' if($cmpoldval eq $newval); - return('$'. $varname . " = '$newval';\n"); + return '' if ($cmpoldval eq $newval); + return ('$' . $varname . " = '$newval';\n"); } # A widget to interact with the user @@ -129,13 +128,13 @@ package configtext; sub save_string { my ($self, $oldval, $newvalsource) = @_; - my $varname = $self->{var}; - my $newval = $self->convert_newval_source($newvalsource); + my $varname = $self->{var}; + my $newval = $self->convert_newval_source($newvalsource); my $cmpoldval = $self->comparison_value($oldval); - return '' if($cmpoldval eq $newval); + return '' if ($cmpoldval eq $newval); # Remove quotes from the string, we will have a new type for text with quotes $newval =~ s/['"`]//g; - return('$'. $varname . " = '$newval';\n"); + return ('$' . $varname . " = '$newval';\n"); } ########################### configtimezone @@ -148,17 +147,18 @@ use DateTime::TimeZone; sub save_string { my ($self, $oldval, $newvalsource) = @_; - my $varname = $self->{var}; - my $newval = $self->convert_newval_source($newvalsource); + my $varname = $self->{var}; + my $newval = $self->convert_newval_source($newvalsource); my $cmpoldval = $self->comparison_value($oldval); - return '' if($cmpoldval eq $newval); - if(not DateTime::TimeZone->is_valid_name($newval)) { - $self->{Module}->addbadmessage("String '$newval' is not a valid time zone. Reverting to the system default value."); + return '' if ($cmpoldval eq $newval); + if (not DateTime::TimeZone->is_valid_name($newval)) { + $self->{Module} + ->addbadmessage("String '$newval' is not a valid time zone. Reverting to the system default value."); return ''; } # Remove quotes from the string, we will have a new type for text with quotes - $newval =~ s/['"`]//g; #`"'geditsucks - return('$'. $varname . " = '$newval';\n"); + $newval =~ s/['"`]//g; #`"'geditsucks + return ('$' . $varname . " = '$newval';\n"); } ########################### configtime @@ -168,17 +168,17 @@ package configtime; sub save_string { my ($self, $oldval, $newvalsource) = @_; - my $varname = $self->{var}; - my $newval = $self->convert_newval_source($newvalsource); + my $varname = $self->{var}; + my $newval = $self->convert_newval_source($newvalsource); my $cmpoldval = $self->comparison_value($oldval); - return '' if($cmpoldval eq $newval); + return '' if ($cmpoldval eq $newval); - if($newval !~ /^(01|1|02|2|03|3|04|4|05|5|06|6|07|7|08|8|09|9|10|11|12):[0-5]\d(am|pm|AM|PM)$/) { + if ($newval !~ /^(01|1|02|2|03|3|04|4|05|5|06|6|07|7|08|8|09|9|10|11|12):[0-5]\d(am|pm|AM|PM)$/) { $self->{Module}->addbadmessage("String '$newval' is not a valid time. Reverting to the system default value."); return ''; } - return('$'. $varname . " = '$newval';\n"); + return ('$' . $varname . " = '$newval';\n"); } ########################### confignumber @@ -187,18 +187,20 @@ package confignumber; sub save_string { my ($self, $oldval, $newvalsource) = @_; - my $varname = $self->{var}; - my $newval = $self->convert_newval_source($newvalsource); + my $varname = $self->{var}; + my $newval = $self->convert_newval_source($newvalsource); my $cmpoldval = $self->comparison_value($oldval); # Remove quotes from the string, we will have a new type for text with quotes - $newval =~ s/['"`]//g; #`"'geditsucks + $newval =~ s/['"`]//g; #`"'geditsucks my $newval2 = eval($newval); - if($@) { - $self->{Module}->addbadmessage("Syntax error in numeric value '$newval' for variable \$$self->{var}. Reverting to the system default value."); + if ($@) { + $self->{Module}->addbadmessage( + "Syntax error in numeric value '$newval' for variable \$$self->{var}. Reverting to the system default value." + ); return ''; } - return '' if($cmpoldval == $newval2); - return('$'. $varname . " = $newval;\n"); + return '' if ($cmpoldval == $newval2); + return ('$' . $varname . " = $newval;\n"); } ########################### configboolean @@ -208,16 +210,16 @@ package configboolean; sub comparison_value { return $_[1] ? 1 : 0; } sub display_value { - my ($self, $val) = @_; - my $r = $self->{Module}->r; - return $r->maketext('True') if $val; - return $r->maketext('False'); + my ($self, $val) = @_; + my $r = $self->{Module}->r; + return $r->maketext('True') if $val; + return $r->maketext('False'); } sub save_string { my ($self, $oldval, $newvalsource) = @_; - my $r = $self->{Module}->r; - my $newval = $self->convert_newval_source($newvalsource); + my $r = $self->{Module}->r; + my $newval = $self->convert_newval_source($newvalsource); my $cmpoldval = $self->comparison_value($oldval); return '' if $cmpoldval eq $newval; return "\$$self->{var} = $newval;\n"; @@ -236,7 +238,6 @@ sub entry_widget { }); } - ########################### configpermission package configpermission; @configpermission::ISA = qw(configobject); @@ -249,30 +250,30 @@ sub comparison_value { # This tries to produce a string from a permission number. If you feed it # a string, that's what you get back. sub display_value { - my ($self, $val) = @_; - my $r = $self->{Module}->r; - return $r->maketext('nobody') if not defined($val); - my %userRoles = %{$self->{Module}->{r}->{ce}->{userRoles}}; - my %reverseUserRoles = reverse %userRoles; - return $r->maketext($reverseUserRoles{$val}) if defined($reverseUserRoles{$val}); - return $r->maketext($val); + my ($self, $val) = @_; + my $r = $self->{Module}->r; + return $r->maketext('nobody') if not defined($val); + my %userRoles = %{ $self->{Module}->{r}->{ce}->{userRoles} }; + my %reverseUserRoles = reverse %userRoles; + return $r->maketext($reverseUserRoles{$val}) if defined($reverseUserRoles{$val}); + return $r->maketext($val); } sub save_string { my ($self, $oldval, $newvalsource) = @_; - my $newval = $self->convert_newval_source($newvalsource); + my $newval = $self->convert_newval_source($newvalsource); my $cmpoldval = $self->comparison_value($oldval); - my $r = $self->{Module}->r; - return '' if($cmpoldval eq $newval); + my $r = $self->{Module}->r; + return '' if ($cmpoldval eq $newval); return "\$$self->{var} = $newval;\n"; } sub entry_widget { my ($self, $name, $default) = @_; - my $ce = $self->{Module}->{r}->{ce}; - my $r = $self->{Module}->r; - my $permHash = {}; - my %userRoles = %{$ce->{userRoles}}; + my $ce = $self->{Module}->{r}->{ce}; + my $r = $self->{Module}->r; + my $permHash = {}; + my %userRoles = %{ $ce->{userRoles} }; my %reverseUserRoles = reverse %userRoles; # the value of a permission can be undefined (for nobody), @@ -281,7 +282,7 @@ sub entry_widget { my @values = sort { $userRoles{$a} <=> $userRoles{$b} } keys %userRoles; - my %labels = map {$_ => $r->maketext($_)} @values; + my %labels = map { $_ => $r->maketext($_) } @values; return CGI::popup_menu({ name => $name, id => $name, @@ -299,8 +300,8 @@ package configlist; sub display_value { my ($self, $val) = @_; return ' ' if not defined($val); - my $str = join(','.CGI::br(), @{$val}); - $str = ' ' if $str !~ /\S/; + my $str = join(',' . CGI::br(), @{$val}); + $str = ' ' if $str !~ /\S/; return $str; } @@ -308,29 +309,29 @@ sub comparison_value { my ($self, $val) = @_; $val = [] if not defined($val); my $str = join(',', @{$val}); - return($str); + return ($str); } sub save_string { my ($self, $oldval, $newvalsource) = @_; - my $newval = $self->convert_newval_source($newvalsource); + my $newval = $self->convert_newval_source($newvalsource); my $varname = $self->{var}; $oldval = $self->comparison_value($oldval); - return '' if($oldval eq $newval); + return '' if ($oldval eq $newval); my $str = ''; $oldval =~ s/^\s*(.*)\s*$/$1/; $newval =~ s/^\s*(.*)\s*$/$1/; $oldval =~ s/[\s,]+/,/sg; $newval =~ s/[\s,]+/,/sg; - return '' if($newval eq $oldval); + return '' if ($newval eq $oldval); # ok we really have a new value, now turn it back into a string my @parts = split ',', $newval; - map { $_ =~ s/['"`]//g } @parts; #`"'geditsucks - @parts = map { "'". $_ ."'" } @parts; - $str = join(',', @parts); - $str = '$'. $varname . " = [$str];\n"; - return($str); + map { $_ =~ s/['"`]//g } @parts; #`"'geditsucks + @parts = map { "'" . $_ . "'" } @parts; + $str = join(',', @parts); + $str = '$' . $varname . " = [$str];\n"; + return ($str); } sub entry_widget { @@ -340,11 +341,11 @@ sub entry_widget { my $str = join(', ', @{$default}); $str = '' if $str !~ /\S/; return CGI::textarea({ - name => $name, - id => $name, - rows => 4, - value => $str, - class => 'form-control form-control-sm' + name => $name, + id => $name, + rows => 4, + value => $str, + class => 'form-control form-control-sm' }); } @@ -364,15 +365,15 @@ sub display_value { sub convert_newval_source { my ($self, $newvalsource) = @_; - my $inlinevarname = WeBWorK::ContentGenerator::Instructor::Config::inline_var($self->{var}); - my @newvals; - if($newvalsource =~ /widget/) { - @newvals = $self->{Module}->{r}->param($newvalsource); - } else { - my $newval = eval('$self->{Module}->{r}->{ce}->'. $inlinevarname); + my $inlinevarname = WeBWorK::ContentGenerator::Instructor::Config::inline_var($self->{var}); + my @newvals; + if ($newvalsource =~ /widget/) { + @newvals = $self->{Module}->{r}->param($newvalsource); + } else { + my $newval = eval('$self->{Module}->{r}->{ce}->' . $inlinevarname); @newvals = @$newval; - } - return(@newvals); + } + return (@newvals); } # Bit of text to put in the configuration file. The result should @@ -380,28 +381,28 @@ sub save_string { my ($self, $oldval, $newvalsource) = @_; my $varname = $self->{var}; my @newvals = $self->convert_newval_source($newvalsource); - if($self->{min} and (scalar(@newvals) < $self->{min})) { + if ($self->{min} and (scalar(@newvals) < $self->{min})) { $self->{Module}->addbadmessage("You need to select at least $self->{min} display mode."); - if($newvalsource =~ /widget/) { - return $self->save_string($oldval, 'current'); # try to return the old saved value + if ($newvalsource =~ /widget/) { + return $self->save_string($oldval, 'current'); # try to return the old saved value } else { - return '' ; # the previous saved value was empty, reset to system default + return ''; # the previous saved value was empty, reset to system default } } $oldval = $self->comparison_value($oldval); - my $newval = $self->comparison_value(\@newvals); - return '' if($oldval eq $newval); - @newvals = map { "'".$_."'" } @newvals; + my $newval = $self->comparison_value(\@newvals); + return '' if ($oldval eq $newval); + @newvals = map { "'" . $_ . "'" } @newvals; my $str = join(',', @newvals); - $str = '$'. $varname . " = [$str];\n"; - return($str); + $str = '$' . $varname . " = [$str];\n"; + return ($str); } sub comparison_value { my ($self, $val) = @_; $val = [] if not defined($val); my $str = join(',', @{$val}); - return($str); + return ($str); } sub entry_widget { @@ -431,11 +432,11 @@ package configpopuplist; sub display_value { my ($self, $val) = @_; - my $r = $self->{Module}->r; + my $r = $self->{Module}->r; $val = 'ur' if not defined($val); if ($self->{labels}->{$val}) { - return join(CGI::br(), $r->maketext($self->{labels}->{$val})); + return join(CGI::br(), $r->maketext($self->{labels}->{$val})); } return join(CGI::br(), $val); @@ -443,17 +444,17 @@ sub display_value { sub save_string { my ($self, $oldval, $newvalsource) = @_; - my $varname = $self->{var}; - my $newval = $self->convert_newval_source($newvalsource); + my $varname = $self->{var}; + my $newval = $self->convert_newval_source($newvalsource); my $cmpoldval = $self->comparison_value($oldval); return '' if $cmpoldval eq $newval; - return('$'. $varname . " = " . "'$newval';\n"); + return ('$' . $varname . " = " . "'$newval';\n"); } sub entry_widget { my ($self, $name, $default) = @_; - my $r = $self->{Module}->r; - my %labels = map {$_ => $r->maketext($self->{labels}->{$_} // $_)} @{$self->{values}}; + my $r = $self->{Module}->r; + my %labels = map { $_ => $r->maketext($self->{labels}->{$_} // $_) } @{ $self->{values} }; return CGI::popup_menu({ name => $name, @@ -496,38 +497,39 @@ use WeBWorK::CourseEnvironment; # write contents to outputFilePath and return error messages if any sub writeFile { my $outputFilePath = shift; - my $contents = shift; + my $contents = shift; my $writeFileErrors; eval { local *OUTPUTFILE; - if( open OUTPUTFILE, ">utf8:", $outputFilePath) { + if (open OUTPUTFILE, ">utf8:", $outputFilePath) { print OUTPUTFILE $contents; close OUTPUTFILE; } else { - $writeFileErrors = "I could not open $outputFilePath". - CGI::br() . CGI::br(). - "We will not be able to make configuration changes unless the permissions are set so that the web server can write to this file."; + $writeFileErrors = + "I could not open $outputFilePath" + . CGI::br() + . CGI::br() + . "We will not be able to make configuration changes unless the permissions are set so that the web server can write to this file."; } - }; # any errors are caught in the next block + }; # any errors are caught in the next block $writeFileErrors = $@ if $@; - return($writeFileErrors); + return ($writeFileErrors); } # Make a new config object from data sub objectify { my ($self, $data) = @_; - return "config$data->{type}"->new($data,$self); + return "config$data->{type}"->new($data, $self); } - # Take var string from ConfigValues and prepare it for $ce->... sub inline_var { my $varstring = shift; - return '{'.$varstring.'}' if $varstring =~ /^\w+$/; + return '{' . $varstring . '}' if $varstring =~ /^\w+$/; $varstring =~ s/^(\w+)/{$1}->/; - return($varstring); + return ($varstring); } sub print_navigation_tabs { @@ -551,37 +553,40 @@ sub print_navigation_tabs { } sub getConfigValues { - my $ce = shift; + my $ce = shift; my $ConfigValues = $ce->{ConfigValues}; # get the list of theme folders in the theme directory and remove . and .. my $themeDir = $ce->{webworkDirs}{themes}; opendir(my $dh, $themeDir) || die "can't opendir $themeDir: $!"; - my $themes =[grep {!/^\.{1,2}$/} sort readdir($dh)]; + my $themes = [ grep { !/^\.{1,2}$/ } sort readdir($dh) ]; # get list of localization dictionaries my $localizeDir = $ce->{webworkDirs}{localize}; opendir(my $dh2, $localizeDir) || die "can't opendir $localizeDir: $!"; - my %seen=(); # find the languages in the localize direction - my $languages =[ grep {!$seen{$_} ++} # remove duplicate items - map {$_=~s/\...$//; $_} # get rid of suffix - grep {/\.mo$|\.po$/; } sort readdir($dh2) #look at only .mo and .po files + my %seen = (); # find the languages in the localize direction + my $languages = [ + grep { !$seen{$_}++ } # remove duplicate items + map { $_ =~ s/\...$//; $_ } # get rid of suffix + grep { /\.mo$|\.po$/; } sort readdir($dh2) #look at only .mo and .po files - ]; + ]; # insert the anonymous array of theme folder names into ConfigValues # FIXME? Is there a reason this is an array? Couldn't we replace this # with a hash and conceptually simplify this routine? MEG - my $modifyThemes = sub { my $item=shift; - if (ref($item)=~/HASH/ and $item->{var} eq 'defaultTheme' ) { - $item->{values} =$themes - } - }; - my $modifyLanguages = sub { my $item=shift; - if (ref($item)=~/HASH/ and $item->{var} eq 'language' ) { - $item->{values} =$languages - } - }; + my $modifyThemes = sub { + my $item = shift; + if (ref($item) =~ /HASH/ and $item->{var} eq 'defaultTheme') { + $item->{values} = $themes; + } + }; + my $modifyLanguages = sub { + my $item = shift; + if (ref($item) =~ /HASH/ and $item->{var} eq 'language') { + $item->{values} = $languages; + } + }; foreach my $oneConfig (@$ConfigValues) { foreach my $hash (@$oneConfig) { &$modifyThemes($hash); @@ -593,14 +598,12 @@ sub getConfigValues { } sub pre_header_initialize { - my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; + my ($self) = @_; + my $r = $self->r; + my $ce = $r->ce; my $ConfigValues = getConfigValues($ce); # Get a course environment without course.conf - $self->{default_ce} = WeBWorK::CourseEnvironment->new({ - %WeBWorK::SeedCE, - }); + $self->{default_ce} = WeBWorK::CourseEnvironment->new({ %WeBWorK::SeedCE, }); $self->{ce_file_dir} = $ce->{courseDirs}->{root}; @@ -608,13 +611,13 @@ sub pre_header_initialize { my $ce3 = eval { new WeBWorK::CourseEnvironment({ %WeBWorK::SeedCE, - courseName => $ce->{courseName}, + courseName => $ce->{courseName}, web_config_filename => 'noSuchFilePlease', - }) + }); }; - if($r->param("make_changes")) { + if ($r->param("make_changes")) { my $widget_count = 0; - my $fileoutput = "#!perl + my $fileoutput = "#!perl # This file is automatically generated by WeBWorK's web-based # configuration module. Do not make changes directly to this # file. It will be overwritten the next time configuration @@ -630,17 +633,18 @@ sub pre_header_initialize { shift @configSectionArray; for my $con (@configSectionArray) { my $conobject = $self->objectify($con); - if($tab) { # This tab is not being shown - my $oldval = eval('$ce3->'.inline_var($con->{var})); + if ($tab) { # This tab is not being shown + my $oldval = eval('$ce3->' . inline_var($con->{var})); $fileoutput .= $conobject->save_string($oldval, 'current'); - } else { # We reached the tab with entry objects - $fileoutput .= $conobject->save_string(eval('$ce3->'.inline_var($con->{var})), "widget$widget_count"); + } else { # We reached the tab with entry objects + $fileoutput .= + $conobject->save_string(eval('$ce3->' . inline_var($con->{var})), "widget$widget_count"); $widget_count++; } } $tab--; } - my $write_result = writeFile($self->{ce_file_dir}."/simple.conf", $fileoutput); + my $write_result = writeFile($self->{ce_file_dir} . "/simple.conf", $fileoutput); if ($write_result) { $self->addbadmessage($write_result); } else { @@ -652,22 +656,20 @@ sub pre_header_initialize { sub body { my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; # course environment - my $db = $r->db; # database + my $r = $self->r; + my $ce = $r->ce; # course environment + my $db = $r->db; # database my $ConfigValues = getConfigValues($ce); - my $userName = $r->param('user'); + my $userName = $r->param('user'); - my $user = $db->getUser($userName); # checked + my $user = $db->getUser($userName); # checked die "record for user $userName (real user) does not exist." unless defined $user; ### Check that this is a professor my $authz = $r->authz; unless ($authz->hasPermissions($userName, "modify_problem_sets")) { - print "User $userName returned " . - $authz->hasPermissions($user, "modify_problem_sets") . - " for permission"; + print "User $userName returned " . $authz->hasPermissions($user, "modify_problem_sets") . " for permission"; return (CGI::div( { class => 'alert alert-danger p-1 mb-0' }, CGI::em($r->maketext("You are not authorized to access the Instructor tools.")) @@ -681,43 +683,42 @@ sub body { shift @configSectionArray; for my $con (@configSectionArray) { $docstring = $con->{doc2} || $con->{doc} - if($con->{var} eq $r->param('var_name')); + if ($con->{var} eq $r->param('var_name')); } } - print CGI::h2($r->maketext("Variable Documentation:").' '. CGI::code('$'.$r->param('var_name'))), + print CGI::h2($r->maketext("Variable Documentation:") . ' ' . CGI::code('$' . $r->param('var_name'))), CGI::p(), - CGI::blockquote( $r->maketext($docstring) ); + CGI::blockquote($r->maketext($docstring)); return ""; } my $default_ce = $self->{default_ce}; # Get the current course environment again in case we just saved changes - my $ce4 = eval { - new WeBWorK::CourseEnvironment({ - %WeBWorK::SeedCE, - courseName => $ce->{courseName}, - }) - }; + my $ce4 = eval { new WeBWorK::CourseEnvironment({ %WeBWorK::SeedCE, courseName => $ce->{courseName}, }) }; my $widget_count = 0; - if(scalar(@$ConfigValues) == 0) { - print CGI::p($r->maketext("The configuration module did not find the data it needs to function. Have your site administrator check that Constants.pm is up to date.")); + if (scalar(@$ConfigValues) == 0) { + print CGI::p( + $r->maketext( + "The configuration module did not find the data it needs to function. Have your site administrator check that Constants.pm is up to date." + ) + ); return ""; } # Start tabs at the top my $current_tab = $r->param('section_tab') || 'tab0'; - my @tab_names = map { $_->[0] } @{$ConfigValues}; + my @tab_names = map { $_->[0] } @{$ConfigValues}; $self->print_navigation_tabs($current_tab, @tab_names); - print CGI::start_form({method=>"post", action=>$r->uri, id=>"config-form", name=>"config-form"}); + print CGI::start_form({ method => "post", action => $r->uri, id => "config-form", name => "config-form" }); print $self->hidden_authen_fields(); - print CGI::hidden(-name=> 'section_tab', -value=> $current_tab); + print CGI::hidden(-name => 'section_tab', -value => $current_tab); my $tabnumber = $current_tab; $tabnumber =~ s/tab//; - my @configSectionArray = @{$ConfigValues->[$tabnumber]}; - my $configTitle = shift @configSectionArray; + my @configSectionArray = @{ $ConfigValues->[$tabnumber] }; + my $configTitle = shift @configSectionArray; print CGI::h2(CGI::b($r->maketext($configTitle))); print CGI::start_div({ class => 'table-responsive' }); @@ -746,17 +747,13 @@ sub body { })); print CGI::end_form(); - return ""; } - =head1 AUTHOR Written by John Jones, jj (at) asu.edu. =cut - - 1; diff --git a/lib/WeBWorK/ContentGenerator/Instructor/FileManager.pm b/lib/WeBWorK/ContentGenerator/Instructor/FileManager.pm index 845f23324e..d741fc1ae9 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/FileManager.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/FileManager.pm @@ -44,12 +44,12 @@ use constant HOME => 'templates'; # The list of file extensions and the directories they usually go in. # my %uploadDir = ( - csv => 'scoring', - lst => 'templates', - pg => 'templates/.*', - pl => 'templates/macros', - def => 'templates', - html => 'html/.*', + csv => 'scoring', + lst => 'templates', + pg => 'templates/.*', + pl => 'templates/macros', + def => 'templates', + html => 'html/.*', ); ################################################## @@ -58,10 +58,10 @@ my %uploadDir = ( # see if there is a download to perform. # sub pre_header_initialize { - my $self = shift; - my $r = $self->r; + my $self = shift; + my $r = $self->r; my $authz = $r->authz; - my $user = $r->param('user'); + my $user = $r->param('user'); # we don't need to return an error here, because body() will print an error for us :) return unless $authz->hasPermissions($user, "manage_course_files"); @@ -70,13 +70,13 @@ sub pre_header_initialize { $self->Download if ($action && ($action eq 'Download' || $action eq $r->maketext("Download"))); my $file = $r->param('download'); $self->downloadFile($file) if (defined $file); - my $ce = $r->ce; - my $urlpath = $r->urlpath; + my $ce = $r->ce; + my $urlpath = $r->urlpath; my $courseID = $r->urlpath->arg("courseID"); - # removed archived_course_ prefix -- it is important that path matches the $courseID for consitency with the database dump +# removed archived_course_ prefix -- it is important that path matches the $courseID for consitency with the database dump my $archive_path = $ce->{webworkDirs}{courses} . "/$courseID/templates/$courseID.tar.gz"; - my %options = (courseID => $courseID, archive_path => $archive_path, ce=>$ce ); - $self->{archive_options}= \%options; + my %options = (courseID => $courseID, archive_path => $archive_path, ce => $ce); + $self->{archive_options} = \%options; } @@ -86,9 +86,9 @@ sub pre_header_initialize { # sub downloadFile { my $self = shift; - my $r = $self->r; + my $r = $self->r; my $file = checkName(shift); - my $pwd = $self->checkPWD(shift || $self->r->param('pwd') || HOME); + my $pwd = $self->checkPWD(shift || $self->r->param('pwd') || HOME); return unless $pwd; $pwd = $self->{ce}{courseDirs}{root} . '/' . $pwd; unless (-e "$pwd/$file") { @@ -133,12 +133,12 @@ sub body { my $fileManagerURL = $self->systemLink($fileManagerPage, authen => 0); print CGI::start_form( - -method=>"POST", - -action=>$fileManagerURL, - -id=>"FileManager", - -enctype=> 'multipart/form-data', - -name=>"FileManager", - -style=>"margin:0", + -method => "POST", + -action => $fileManagerURL, + -id => "FileManager", + -enctype => 'multipart/form-data', + -name => "FileManager", + -style => "margin:0", ); print $self->hidden_authen_fields; @@ -150,87 +150,87 @@ sub body { # my $action = $r->param('action') || $r->param('formAction') || $r->param("confirmed") || 'Init'; #$self->addgoodmessage("|$action|"); - if($action eq "Refresh" || $action eq $r->maketext("Refresh")) {$self->Refresh;} - elsif($action eq "Cancel" || $action eq $r->maketext("Cancel")) {$self->Refresh;} - elsif($action eq "Directory"|| $action eq $r->maketext("Directory")) {$self->Go;} - elsif($action eq "Go" || $action eq $r->maketext("Go")) {$self->Go;} - elsif($action eq "View" || $action eq $r->maketext("View")) {$self->View;} - elsif($action eq "Edit" || $action eq $r->maketext("Edit")) {$self->Edit;} - elsif($action eq "Download" || $action eq $r->maketext("Download")) {$self->Refresh;} - elsif($action eq "Copy" || $action eq $r->maketext("Copy")) {$self->Copy;} - elsif($action eq "Rename" || $action eq $r->maketext("Rename")) {$self->Rename;} - elsif($action eq "Delete" || $action eq $r->maketext("Delete")) {$self->Delete;} - elsif($action eq "Make Archive" || $action eq $r->maketext("Make Archive")) {$self->MakeArchive;} - elsif($action eq "Unpack" || $action eq $r->maketext("Unpack")) {$self->UnpackArchive;} - elsif($action eq "New Folder" || $action eq $r->maketext("New Folder")) {$self->NewFolder;} - elsif($action eq "New File" || $action eq $r->maketext("New File")) {$self->NewFile;} - elsif($action eq "Upload" || $action eq $r->maketext("Upload")) {$self->Upload;} - elsif($action eq "Revert" || $action eq $r->maketext("Revert")) {$self->Edit;} - elsif($action eq "Save As" || $action eq $r->maketext("Save As")) {$self->SaveAs;} - elsif($action eq "Save" || $action eq $r->maketext("Save")) {$self->Save;} - elsif($action eq "Init" || $action eq $r->maketext("Init")) {$self->Init;} - elsif($action eq "^" || $action eq "\\") {$self->ParentDir;} + if ($action eq "Refresh" || $action eq $r->maketext("Refresh")) { $self->Refresh; } + elsif ($action eq "Cancel" || $action eq $r->maketext("Cancel")) { $self->Refresh; } + elsif ($action eq "Directory" || $action eq $r->maketext("Directory")) { $self->Go; } + elsif ($action eq "Go" || $action eq $r->maketext("Go")) { $self->Go; } + elsif ($action eq "View" || $action eq $r->maketext("View")) { $self->View; } + elsif ($action eq "Edit" || $action eq $r->maketext("Edit")) { $self->Edit; } + elsif ($action eq "Download" || $action eq $r->maketext("Download")) { $self->Refresh; } + elsif ($action eq "Copy" || $action eq $r->maketext("Copy")) { $self->Copy; } + elsif ($action eq "Rename" || $action eq $r->maketext("Rename")) { $self->Rename; } + elsif ($action eq "Delete" || $action eq $r->maketext("Delete")) { $self->Delete; } + elsif ($action eq "Make Archive" || $action eq $r->maketext("Make Archive")) { $self->MakeArchive; } + elsif ($action eq "Unpack" || $action eq $r->maketext("Unpack")) { $self->UnpackArchive; } + elsif ($action eq "New Folder" || $action eq $r->maketext("New Folder")) { $self->NewFolder; } + elsif ($action eq "New File" || $action eq $r->maketext("New File")) { $self->NewFile; } + elsif ($action eq "Upload" || $action eq $r->maketext("Upload")) { $self->Upload; } + elsif ($action eq "Revert" || $action eq $r->maketext("Revert")) { $self->Edit; } + elsif ($action eq "Save As" || $action eq $r->maketext("Save As")) { $self->SaveAs; } + elsif ($action eq "Save" || $action eq $r->maketext("Save")) { $self->Save; } + elsif ($action eq "Init" || $action eq $r->maketext("Init")) { $self->Init; } + elsif ($action eq "^" || $action eq "\\") { $self->ParentDir; } else { - $self->addbadmessage("Unknown action"); - $self->Refresh; + $self->addbadmessage("Unknown action"); + $self->Refresh; } #for ($action) { -# /^Refresh/i and do {$self->Refresh; last}; -# /^Cancel/i and do {$self->Refresh; last}; -# /^\^/i and do {$self->ParentDir; last}; -# /^Directory/i and do {$self->Go; last}; -# /^Go/i and do {$self->Go; last}; -# /^View/i and do {$self->View; last}; -# /^Edit/i and do {$self->Edit; last}; -# /^Download/i and do {$self->Refresh; last}; -# /^Copy/i and do {$self->Copy; last}; -# /^Rename/i and do {$self->Rename; last}; -# /^Delete/i and do {$self->Delete; last}; -# /^Make/i and do {$self->MakeArchive; last}; -# /^Unpack/i and do {$self->UnpackArchive; last}; -# /^New Folder/i and do {$self->NewFolder; last}; -# /^New File/i and do {$self->NewFile; last}; -# /^Upload/i and do {$self->Upload; last}; -# /^Revert/i and do {$self->Edit; last}; -# /^Save As/i and do {$self->SaveAs; last}; -# /^Save/i and do {$self->Save; last}; -# /^Init/i and do {$self->Init; last}; + # /^Refresh/i and do {$self->Refresh; last}; + # /^Cancel/i and do {$self->Refresh; last}; + # /^\^/i and do {$self->ParentDir; last}; + # /^Directory/i and do {$self->Go; last}; + # /^Go/i and do {$self->Go; last}; + # /^View/i and do {$self->View; last}; + # /^Edit/i and do {$self->Edit; last}; + # /^Download/i and do {$self->Refresh; last}; + # /^Copy/i and do {$self->Copy; last}; + # /^Rename/i and do {$self->Rename; last}; + # /^Delete/i and do {$self->Delete; last}; + # /^Make/i and do {$self->MakeArchive; last}; + # /^Unpack/i and do {$self->UnpackArchive; last}; + # /^New Folder/i and do {$self->NewFolder; last}; + # /^New File/i and do {$self->NewFile; last}; + # /^Upload/i and do {$self->Upload; last}; + # /^Revert/i and do {$self->Edit; last}; + # /^Save As/i and do {$self->SaveAs; last}; + # /^Save/i and do {$self->Save; last}; + # /^Init/i and do {$self->Init; last}; #} - if ($r->param('archiveCourse') ) { - my %options = %{$self->{archive_options}}; - my $courseID = $options{courseID}; - $self->addgoodmessage($r->maketext("Archiving course as [_1].tar.gz. Reload FileManager to see it.",$courseID)); - WeBWorK::Utils::CourseManagement::archiveCourse(%options); - $self->addgoodmessage($r->maketext("Course archived.")); - - } - print CGI::hidden({name=>'pwd',value=>$self->{pwd}}); - print CGI::hidden({name=>'formAction',value=>""}); + if ($r->param('archiveCourse')) { + my %options = %{ $self->{archive_options} }; + my $courseID = $options{courseID}; + $self->addgoodmessage( + $r->maketext("Archiving course as [_1].tar.gz. Reload FileManager to see it.", $courseID)); + WeBWorK::Utils::CourseManagement::archiveCourse(%options); + $self->addgoodmessage($r->maketext("Course archived.")); + + } + print CGI::hidden({ name => 'pwd', value => $self->{pwd} }); + print CGI::hidden({ name => 'formAction', value => "" }); print CGI::end_form(); return ""; } - ################################################## # # First time through # sub Init { my $self = shift; - $self->r->param('unpack',1); - $self->r->param('autodelete',1); - $self->r->param('format','Automatic'); + $self->r->param('unpack', 1); + $self->r->param('autodelete', 1); + $self->r->param('format', 'Automatic'); $self->Refresh; } sub HiddenFlags { my $self = shift; - print CGI::hidden({name=>"dates", value=>$self->getFlag('dates')}); - print CGI::hidden({name=>"overwrite", value=>$self->getFlag('overwrite')}); - print CGI::hidden({name=>"unpack", value=>$self->getFlag('unpack')}); - print CGI::hidden({name=>"autodelete",value=>$self->getFlag('autodelete')}); - print CGI::hidden({name=>"format", value=>$self->getFlag('format','Automatic')}); + print CGI::hidden({ name => "dates", value => $self->getFlag('dates') }); + print CGI::hidden({ name => "overwrite", value => $self->getFlag('overwrite') }); + print CGI::hidden({ name => "unpack", value => $self->getFlag('unpack') }); + print CGI::hidden({ name => "autodelete", value => $self->getFlag('autodelete') }); + print CGI::hidden({ name => "format", value => $self->getFlag('format', 'Automatic') }); } ################################################## @@ -239,17 +239,18 @@ sub HiddenFlags { # sub Refresh { - my $self = shift; - my $r = $self->r; - my $pwd = shift || $self->{pwd}; + my $self = shift; + my $r = $self->r; + my $pwd = shift || $self->{pwd}; my $isTop = $pwd eq '.' || $pwd eq ''; - my ($dirs,$dirlabels) = directoryMenu($self->{courseName},$pwd); - my ($files,$filelabels) = directoryListing($self->{courseRoot},$pwd,$self->getFlag('dates')); + my ($dirs, $dirlabels) = directoryMenu($self->{courseName}, $pwd); + my ($files, $filelabels) = directoryListing($self->{courseRoot}, $pwd, $self->getFlag('dates')); unless ($files) { $self->addbadmessage($r->maketext("The directory you specified doesn't exist")); - $files = []; $filelabels = {}; + $files = []; + $filelabels = {}; } # Some JavaScript to make things easier for the user @@ -338,7 +339,7 @@ EOF # Directory Listing and column of buttons my %button = (name => "action", style => "width:10em", class => 'file-manager-btn btn btn btn-sm btn-secondary'); - my $width = ($self->getFlag('dates') && scalar(@{$files}) > 0) ? "" : " width:30em"; + my $width = ($self->getFlag('dates') && scalar(@{$files}) > 0) ? "" : " width:30em"; print CGI::div( { class => 'row' }, CGI::div( @@ -502,54 +503,58 @@ sub Go { # Open a directory or view a file # sub View { - my $self = shift; my $pwd = $self->{pwd}; - my $r = $self->r; - my $filename = $self->getFile("view"); return unless $filename; - my $name = "$pwd/$filename"; $name =~ s!^\./?!!; + my $self = shift; + my $pwd = $self->{pwd}; + my $r = $self->r; + my $filename = $self->getFile("view"); + return unless $filename; + my $name = "$pwd/$filename"; + $name =~ s!^\./?!!; my $file = "$self->{courseRoot}/$pwd/$filename"; # # Don't follow symbolic links # if ($self->isSymLink($file)) { - $self->addbadmessage($r->maketext("You may not follow symbolic links")); - $self->Refresh; return; + $self->addbadmessage($r->maketext("You may not follow symbolic links")); + $self->Refresh; + return; } # # Handle directories by making them the working directory # if (-d $file) { - $self->{pwd} .= '/'.$filename; - $self->Refresh; return; + $self->{pwd} .= '/' . $filename; + $self->Refresh; + return; } unless (-f $file) { $self->addbadmessage($r->maketext("You can't view files of that type")); - $self->Refresh; return; + $self->Refresh; + return; } # # Include a download link # - my $urlpath = $self->r->urlpath; + my $urlpath = $self->r->urlpath; my $fileManagerPage = $urlpath->newFromModule($urlpath->module, $r, courseID => $self->{courseName}); - my $fileManagerURL = $self->systemLink($fileManagerPage, params => {download => $filename, pwd => $pwd}); - print CGI::div({style=>"float:right"}, - CGI::a({href=>$fileManagerURL},"Download")); - print CGI::p(),CGI::b($name),CGI::p(); + my $fileManagerURL = $self->systemLink($fileManagerPage, params => { download => $filename, pwd => $pwd }); + print CGI::div({ style => "float:right" }, CGI::a({ href => $fileManagerURL }, "Download")); + print CGI::p(), CGI::b($name), CGI::p(); print CGI::hr(); # # For files, display the file, if possible. # If the file is an image, display it as an image. # - if (-T $file) { #check that it is a text file + if (-T $file) { #check that it is a text file my $data = readFile($file); - print CGI::div({dir=>"auto"}, - CGI::pre(showHTML($data))); + print CGI::div({ dir => "auto" }, CGI::pre(showHTML($data))); } elsif ($file =~ m/\.(gif|jpg|png)/i) { - print CGI::img({src=>$fileManagerURL, border=>0}); + print CGI::img({ src => $fileManagerURL, border => 0 }); } else { print CGI::div({ class => 'alert alert-danger p-1 mb-0' }, "The file $file does not appear to be a text or image file."); @@ -561,39 +566,41 @@ sub View { # Edit a file # sub Edit { - my $self = shift; - my $filename = $self->getFile('edit'); return unless $filename; - my $file = "$self->{courseRoot}/$self->{pwd}/$filename"; - my $r = $self->r; + my $self = shift; + my $filename = $self->getFile('edit'); + return unless $filename; + my $file = "$self->{courseRoot}/$self->{pwd}/$filename"; + my $r = $self->r; my $userID = $r->param('user'); - my $ce = $r->ce; - my $authz = $r->authz; + my $ce = $r->ce; + my $authz = $r->authz; # if its a restricted file, dont allow the web editor to edit it unless # that option has been set for the course. - foreach my $restrictedFile (@{$ce->{uneditableCourseFiles}}) { - if (File::Spec->canonpath($file) eq - File::Spec->canonpath("$self->{courseRoot}/$restrictedFile") && - !$authz->hasPermissions($userID, "edit_restricted_files") ) { - $self->addbadmessage($r->maketext("You do not have permission to edit this file.")); - $self->Refresh; return; - } + foreach my $restrictedFile (@{ $ce->{uneditableCourseFiles} }) { + if (File::Spec->canonpath($file) eq File::Spec->canonpath("$self->{courseRoot}/$restrictedFile") + && !$authz->hasPermissions($userID, "edit_restricted_files")) + { + $self->addbadmessage($r->maketext("You do not have permission to edit this file.")); + $self->Refresh; + return; + } } if (-d $file) { $self->addbadmessage($r->maketext("You can't edit a directory")); - $self->Refresh; return; + $self->Refresh; + return; } - - unless (-f $file) { $self->addbadmessage($r->maketext("You can only edit text files")); - $self->Refresh; return; + $self->Refresh; + return; } if (-T $file) { my $data = readFile($file); - $self->RefreshEdit($data,$filename); + $self->RefreshEdit($data, $filename); } else { $self->addbadmessage($r->maketext("The file does not appear to be a text file")); $self->Refresh; @@ -606,31 +613,39 @@ sub Edit { # Save the edited file # sub Save { - my $self = shift; my $filename = shift; - my $r=$self->r; - my $pwd = $self->{pwd}; + my $self = shift; + my $filename = shift; + my $r = $self->r; + my $pwd = $self->{pwd}; if ($filename) { - $pwd = substr($filename,length($self->{courseRoot})+1); - $pwd =~ s!(/|^)([^/]*)$!!; $filename = $2; - $pwd = '.' if $pwd eq ''; + $pwd = substr($filename, length($self->{courseRoot}) + 1); + $pwd =~ s!(/|^)([^/]*)$!!; + $filename = $2; + $pwd = '.' if $pwd eq ''; } else { - $filename = $self->getFile("save"); return unless $filename; + $filename = $self->getFile("save"); + return unless $filename; } my $file = "$self->{courseRoot}/$pwd/$filename"; my $data = $self->r->param("data"); if (defined($data)) { - $data =~ s/\r\n?/\n/g; # convert DOS and Mac line ends to unix + $data =~ s/\r\n?/\n/g; # convert DOS and Mac line ends to unix local (*OUTFILE); - if (open(OUTFILE,">:encoding(UTF-8)",$file)) { - eval {print OUTFILE $data; close(OUTFILE)}; - if ($@) {$self->addbadmessage($r->maketext("Failed to save: [_1]",$@))} - else {$self->addgoodmessage($r->maketext("File saved"))} - } else {$self->addbadmessage($r->maketext("Can't write to file [_1]", $!))} - } else {$data = ""; $self->addbadmessage($r->maketext("Error: no file data was submitted!"))} + if (open(OUTFILE, ">:encoding(UTF-8)", $file)) { + eval { print OUTFILE $data; close(OUTFILE) }; + if ($@) { $self->addbadmessage($r->maketext("Failed to save: [_1]", $@)) } + else { $self->addgoodmessage($r->maketext("File saved")) } + } else { + $self->addbadmessage($r->maketext("Can't write to file [_1]", $!)); + } + } else { + $data = ""; + $self->addbadmessage($r->maketext("Error: no file data was submitted!")); + } $self->{pwd} = $pwd; - $self->RefreshEdit($data,$filename); + $self->RefreshEdit($data, $filename); } ################################################## @@ -640,11 +655,11 @@ sub Save { sub SaveAs { my $self = shift; - my $newfile = $self->r->param('name'); + my $newfile = $self->r->param('name'); my $original = $self->r->param('files'); - $newfile = $self->verifyPath($newfile,$original); - if ($newfile) {$self->Save($newfile); return} - $self->RefreshEdit($self->r->param('data'),$original); + $newfile = $self->verifyPath($newfile, $original); + if ($newfile) { $self->Save($newfile); return } + $self->RefreshEdit($self->r->param('data'), $original); } ################################################## @@ -652,10 +667,13 @@ sub SaveAs { # Display the Edit page # sub RefreshEdit { - my $self = shift; my $data = shift; my $file = shift; - my $r = $self->r; - my $pwd = shift || $self->{pwd}; - my $name = "$pwd/$file"; $name =~ s!^\./?!!; + my $self = shift; + my $data = shift; + my $file = shift; + my $r = $self->r; + my $pwd = shift || $self->{pwd}; + my $name = "$pwd/$file"; + $name =~ s!^\./?!!; my %button = (name => "action", class => 'btn btn-sm btn-secondary w-100'); @@ -713,10 +731,11 @@ sub RefreshEdit { # Copy a file # sub Copy { - my $self = shift; - my $r = $self->r; - my $dir = "$self->{courseRoot}/$self->{pwd}"; - my $original = $self->getFile('copy'); return unless $original; + my $self = shift; + my $r = $self->r; + my $dir = "$self->{courseRoot}/$self->{pwd}"; + my $original = $self->getFile('copy'); + return unless $original; my $oldfile = "$dir/$original"; if (-d $oldfile) { @@ -728,16 +747,19 @@ sub Copy { if ($self->r->param('confirmed')) { my $newfile = $self->r->param('name'); - if ($newfile = $self->verifyPath($newfile,$original)) { + if ($newfile = $self->verifyPath($newfile, $original)) { if (copy($oldfile, $newfile)) { $self->addgoodmessage($r->maketext("File successfully copied")); - $self->Refresh; return; - } else {$self->addbadmessage($r->maketext("Can't copy file: [_1]", $!))} + $self->Refresh; + return; + } else { + $self->addbadmessage($r->maketext("Can't copy file: [_1]", $!)); + } } } - $self->Confirm($r->maketext("Copy file as:"),uniqueName($dir,$original),$r->maketext("Copy")); - print CGI::hidden({name=>"files",value=>$original}); + $self->Confirm($r->maketext("Copy file as:"), uniqueName($dir, $original), $r->maketext("Copy")); + print CGI::hidden({ name => "files", value => $original }); } ################################################## @@ -745,24 +767,28 @@ sub Copy { # Rename a file # sub Rename { - my $self = shift; - my $r = $self->r; - my $dir = "$self->{courseRoot}/$self->{pwd}"; - my $original = $self->getFile('rename'); return unless $original; + my $self = shift; + my $r = $self->r; + my $dir = "$self->{courseRoot}/$self->{pwd}"; + my $original = $self->getFile('rename'); + return unless $original; my $oldfile = "$dir/$original"; if ($self->r->param('confirmed')) { my $newfile = $self->r->param('name'); - if ($newfile = $self->verifyPath($newfile,$original)) { + if ($newfile = $self->verifyPath($newfile, $original)) { if (rename $oldfile, $newfile) { $self->addgoodmessage($r->maketext("File successfully renamed")); - $self->Refresh; return; - } else {$self->addbadmessage($r->maketext("Can't rename file: [_1]", $!))} + $self->Refresh; + return; + } else { + $self->addbadmessage($r->maketext("Can't rename file: [_1]", $!)); + } } } - $self->Confirm($r->maketext("Rename file as:"),$original,$r->maketext("Rename")); - print CGI::hidden({name=>"files",value=>$original}); + $self->Confirm($r->maketext("Rename file as:"), $original, $r->maketext("Rename")); + print CGI::hidden({ name => "files", value => $original }); } ################################################## @@ -770,32 +796,43 @@ sub Rename { # Delete a file # sub Delete { - my $self = shift; - my $r = $self->r; + my $self = shift; + my $r = $self->r; my @files = $self->r->param('files'); if (scalar(@files) == 0) { $self->addbadmessage($r->maketext("You must select at least one file to delete")); - $self->Refresh; return; + $self->Refresh; + return; } my $pwd = $self->{pwd}; - my $dir = $self->{courseRoot}.'/'.$pwd; + my $dir = $self->{courseRoot} . '/' . $pwd; if ($self->r->param('confirmed')) { # # If confirmed, go ahead and delete the files # foreach my $file (@files) { - if (defined $self->checkPWD("$pwd/$file",1)) { + if (defined $self->checkPWD("$pwd/$file", 1)) { if (-d "$dir/$file" && !-l "$dir/$file") { - my $removed = eval {rmtree("$dir/$file",0,1)}; - if ($removed) {$self->addgoodmessage($r->maketext("Directory '[_1]' removed (items deleted: [_2])",$file, $removed))} - else {$self->addbadmessage($r->maketext("Directory '[_1]' not removed: [_2]",$file, $!))} + my $removed = eval { rmtree("$dir/$file", 0, 1) }; + if ($removed) { + $self->addgoodmessage( + $r->maketext("Directory '[_1]' removed (items deleted: [_2])", $file, $removed)); + } else { + $self->addbadmessage($r->maketext("Directory '[_1]' not removed: [_2]", $file, $!)); + } } else { - if (unlink("$dir/$file")) {$self->addgoodmessage($r->maketext("File '[_1]' successfully removed",$file))} - else {$self->addbadmessage($r->maketext("File '[_1]' not removed: [_2]",$file,$!))} + if (unlink("$dir/$file")) { + $self->addgoodmessage($r->maketext("File '[_1]' successfully removed", $file)); + } else { + $self->addbadmessage($r->maketext("File '[_1]' not removed: [_2]", $file, $!)); + } } - } else {$self->addbadmessage($r->maketext("Illegal file '[_1]' specified",$file)); last} + } else { + $self->addbadmessage($r->maketext("Illegal file '[_1]' specified", $file)); + last; + } } $self->Refresh; @@ -806,31 +843,37 @@ sub Delete { # my @filelist = (); foreach my $file (@files) { - if (defined $self->checkPWD("$pwd/$file",1)) { + if (defined $self->checkPWD("$pwd/$file", 1)) { if (-l "$dir/$file") { - push(@filelist,"$file@"); + push(@filelist, "$file@"); } elsif (-d "$dir/$file") { - my @contents = (); my $dcount = 0; + my @contents = (); + my $dcount = 0; foreach my $item (readDirectory("$dir/$file")) { next if $item eq "." || $item eq ".."; if (-l "$dir/$file/$item") { push(@contents, "$item@"); } elsif (-d "$dir/$file/$item") { - my $count = scalar(listFilesRecursive("$dir/$file/$item",".*")); - my $s = ($count == 1 ? "" : "s"); $dcount += $count; - push (@contents, "$item/".CGI::small({style=>"float:right;margin-right:3em"},CGI::i("($count item$s)"))); + my $count = scalar(listFilesRecursive("$dir/$file/$item", ".*")); + my $s = ($count == 1 ? "" : "s"); + $dcount += $count; + push(@contents, + "$item/" + . CGI::small({ style => "float:right;margin-right:3em" }, CGI::i("($count item$s)")) + ); } else { push(@contents, $item); } $dcount += 1; } - my $s = ($dcount == 1 ? "": "s"); - @contents = (@contents[0..10],"  .","  .","  .") if scalar(@contents) > 15; - push (@filelist,$file."/". - CGI::small({style=>"float:right;margin-right:4em"},CGI::i("($dcount item$s total)")). - CGI::div({style=>"margin-left:1ex"},join(CGI::br(),@contents))); + my $s = ($dcount == 1 ? "" : "s"); + @contents = (@contents[ 0 .. 10 ], "  .", "  .", "  .") if scalar(@contents) > 15; + push(@filelist, + $file . "/" + . CGI::small({ style => "float:right;margin-right:4em" }, CGI::i("($dcount item$s total)")) + . CGI::div({ style => "margin-left:1ex" }, join(CGI::br(), @contents))); } else { - push(@filelist,$file); + push(@filelist, $file); } } } @@ -852,8 +895,10 @@ sub Delete { )) : "" ), - CGI::p({ class => 'alert alert-danger p-1 mb-3' }, - $r->maketext("There is no undo for deleting files or directories!")), + CGI::p( + { class => 'alert alert-danger p-1 mb-3' }, + $r->maketext("There is no undo for deleting files or directories!") + ), CGI::p($r->maketext("Really delete the items listed above?")), CGI::div( { class => 'd-flex justify-content-evenly' }, @@ -874,24 +919,26 @@ sub Delete { # Make a gzipped tar archive # sub MakeArchive { - my $self = shift; - my $r = $self->r; + my $self = shift; + my $r = $self->r; my @files = $self->r->param('files'); if (scalar(@files) == 0) { $self->addbadmessage($r->maketext("You must select at least one file for the archive")); - $self->Refresh; return; + $self->Refresh; + return; } - my $dir = $self->{courseRoot}.'/'.$self->{pwd}; - my $archive = uniqueName($dir,(scalar(@files) == 1)? - $files[0].".tgz": $self->{courseName}.".tgz"); - my $tar = "cd ".shell_quote($dir)." && $self->{ce}{externalPrograms}{tar} -cvzf ".shell_quote($archive,@files); - @files = readpipe $tar." 2>&1"; + my $dir = $self->{courseRoot} . '/' . $self->{pwd}; + my $archive = uniqueName($dir, (scalar(@files) == 1) ? $files[0] . ".tgz" : $self->{courseName} . ".tgz"); + my $tar = + "cd " . shell_quote($dir) . " && $self->{ce}{externalPrograms}{tar} -cvzf " . shell_quote($archive, @files); + @files = readpipe $tar . " 2>&1"; if ($? == 0) { my $n = scalar(@files); - $self->addgoodmessage($r->maketext("Archive '[_1]' created successfully ([quant, _2, file])",$archive, $n)); + $self->addgoodmessage($r->maketext("Archive '[_1]' created successfully ([quant, _2, file])", $archive, $n)); } else { - $self->addbadmessage($r->maketext("Can't create archive '[_1]': command returned [_2]",$archive,systemError($?))); + $self->addbadmessage( + $r->maketext("Can't create archive '[_1]': command returned [_2]", $archive, systemError($?))); } $self->Refresh; } @@ -901,9 +948,10 @@ sub MakeArchive { # Unpack a gzipped tar archive # sub UnpackArchive { - my $self = shift; - my $r = $self->r; - my $archive = $self->getFile("unpack"); return unless $archive; + my $self = shift; + my $r = $self->r; + my $archive = $self->getFile("unpack"); + return unless $archive; if ($archive !~ m/\.(tar|tar\.gz|tgz)$/) { $self->addbadmessage($r->maketext("You can only unpack files ending in '.tgz', '.tar' or '.tar.gz'")); } else { @@ -913,18 +961,21 @@ sub UnpackArchive { } sub unpack { - my $self = shift; - my $r = $self->r; - my $archive = shift; my $z = 'z'; $z = '' if $archive =~ m/\.tar$/; - my $dir = $self->{courseRoot}.'/'.$self->{pwd}; - my $tar = "cd ".shell_quote($dir)." && $self->{ce}{externalPrograms}{tar} -vx${z}f ".shell_quote($archive); - my @files = readpipe $tar." 2>&1"; + my $self = shift; + my $r = $self->r; + my $archive = shift; + my $z = 'z'; + $z = '' if $archive =~ m/\.tar$/; + my $dir = $self->{courseRoot} . '/' . $self->{pwd}; + my $tar = "cd " . shell_quote($dir) . " && $self->{ce}{externalPrograms}{tar} -vx${z}f " . shell_quote($archive); + my @files = readpipe $tar . " 2>&1"; + if ($? == 0) { my $n = scalar(@files); - $self->addgoodmessage($r->maketext("[quant,_1,file] unpacked successfully",$n)); + $self->addgoodmessage($r->maketext("[quant,_1,file] unpacked successfully", $n)); return 1; } else { - $self->addbadmessage($r->maketext("Can't unpack '[_1]': command returned [_2]",$archive,systemError($?))); + $self->addbadmessage($r->maketext("Can't unpack '[_1]': command returned [_2]", $archive, systemError($?))); return 0; } } @@ -935,21 +986,23 @@ sub unpack { # sub NewFile { my $self = shift; - my $r = $self->r; + my $r = $self->r; if ($self->r->param('confirmed')) { my $name = $self->r->param('name'); - if (my $file = $self->verifyName($name,"file")) { + if (my $file = $self->verifyName($name, "file")) { local (*NEWFILE); - if (open(NEWFILE,">:encoding(UTF-8)",$file)) { + if (open(NEWFILE, ">:encoding(UTF-8)", $file)) { close(NEWFILE); - $self->RefreshEdit("",$name); + $self->RefreshEdit("", $name); return; - } else {$self->addbadmessage($r->maketext("Can't create file: [_1]",$!))} + } else { + $self->addbadmessage($r->maketext("Can't create file: [_1]", $!)); + } } } - $self->Confirm($r->maketext("New file name:"),"",$r->maketext("New File")); + $self->Confirm($r->maketext("New file name:"), "", $r->maketext("New File")); } ################################################## @@ -958,19 +1011,22 @@ sub NewFile { # sub NewFolder { my $self = shift; - my $r = $self->r; + my $r = $self->r; if ($self->r->param('confirmed')) { my $name = $self->r->param('name'); - if (my $dir = $self->verifyName($name,"directory")) { + if (my $dir = $self->verifyName($name, "directory")) { if (mkdir $dir, 0750) { - $self->{pwd} .= '/'.$name; - $self->Refresh; return; - } else {$self->addbadmessage($r->maketext("Can't create directory: [_1]",$!))} + $self->{pwd} .= '/' . $name; + $self->Refresh; + return; + } else { + $self->addbadmessage($r->maketext("Can't create directory: [_1]", $!)); + } } } - $self->Confirm($r->maketext("New folder name:"),"",$r->maketext("New Folder")); + $self->Confirm($r->maketext("New folder name:"), "", $r->maketext("New Folder")); } ################################################## @@ -979,16 +1035,17 @@ sub NewFolder { # sub Download { my $self = shift; - my $r = $self->r; - my $pwd = $self->checkPWD($self->r->param('pwd') || HOME); + my $r = $self->r; + my $pwd = $self->checkPWD($self->r->param('pwd') || HOME); return unless $pwd; - my $filename = $self->getFile("download"); return unless $filename; - my $file = $self->{ce}{courseDirs}{root}.'/'.$pwd.'/'.$filename; + my $filename = $self->getFile("download"); + return unless $filename; + my $file = $self->{ce}{courseDirs}{root} . '/' . $pwd . '/' . $filename; - if (-d $file) {$self->addbadmessage($r->maketext("You can't download directories")); return} - unless (-f $file) {$self->addbadmessage($r->maketext("You can't download files of that type")); return} + if (-d $file) { $self->addbadmessage($r->maketext("You can't download directories")); return } + unless (-f $file) { $self->addbadmessage($r->maketext("You can't download files of that type")); return } - $self->r->param('download',$filename); + $self->r->param('download', $filename); } ################################################## @@ -996,9 +1053,9 @@ sub Download { # Upload a file to the server # sub Upload { - my $self = shift; - my $r = $self->r; - my $dir = "$self->{courseRoot}/$self->{pwd}"; + my $self = shift; + my $r = $self->r; + my $dir = "$self->{courseRoot}/$self->{pwd}"; my $fileIDhash = $self->r->param('file'); unless ($fileIDhash) { $self->addbadmessage($r->maketext("You have not chosen a file to upload.")); @@ -1006,10 +1063,10 @@ sub Upload { return; } - my ($id,$hash) = split(/\s+/,$fileIDhash); - my $upload = WeBWorK::Upload->retrieve($id,$hash,dir=>$self->{ce}{webworkDirs}{uploadCache}); + my ($id, $hash) = split(/\s+/, $fileIDhash); + my $upload = WeBWorK::Upload->retrieve($id, $hash, dir => $self->{ce}{webworkDirs}{uploadCache}); - my $name = checkName($upload->filename); + my $name = checkName($upload->filename); my $action = $self->r->param("formAction") || "Cancel"; if ($self->r->param("confirmed")) { if ($action eq "Cancel" || $action eq $r->maketext("Cancel")) { @@ -1023,53 +1080,61 @@ sub Upload { if (-e "$dir/$name") { unless ($self->r->param('overwrite') || $action eq "Overwrite" || $action eq $r->maketext("Overwrite")) { - $self->Confirm($r->maketext("File [_1] already exists. Overwrite it, or rename it as:",$name).CGI::p(),uniqueName($dir,$name),$r->maketext("Rename"),$r->maketext("Overwrite")); - #$self->Confirm("File ".CGI::b($name)." already exists. Overwrite it, or rename it as:".CGI::p(),uniqueName($dir,$name),"Rename","Overwrite"); - print CGI::hidden({name=>"action",value=>"Upload"}); - print CGI::hidden({name=>"file",value=>$fileIDhash}); + $self->Confirm( + $r->maketext("File [_1] already exists. Overwrite it, or rename it as:", $name) . CGI::p(), + uniqueName($dir, $name), + $r->maketext("Rename"), + $r->maketext("Overwrite") + ); +#$self->Confirm("File ".CGI::b($name)." already exists. Overwrite it, or rename it as:".CGI::p(),uniqueName($dir,$name),"Rename","Overwrite"); + print CGI::hidden({ name => "action", value => "Upload" }); + print CGI::hidden({ name => "file", value => $fileIDhash }); return; } } - $self->checkFileLocation($name,$self->{pwd}); + $self->checkFileLocation($name, $self->{pwd}); my $file = "$dir/$name"; - my $type = $self->getFlag('format','Automatic'); + my $type = $self->getFlag('format', 'Automatic'); my $data; # # Check if we need to convert linebreaks # if ($type ne 'Binary') { - my $fh = $upload->fileHandle; - my @lines = <$fh>; $data = join('',@lines); - if ($type eq 'Automatic') {$type = isText($data) ? 'Text' : 'Binary'} + my $fh = $upload->fileHandle; + my @lines = <$fh>; + $data = join('', @lines); + if ($type eq 'Automatic') { $type = isText($data) ? 'Text' : 'Binary' } } if ($type eq 'Text') { $upload->dispose; $data =~ s/\r\n?/\n/g; - if (open(UPLOAD,">:encoding(UTF-8)",$file)) { - my $backup_data=$data; - my $success= utf8::decode($data); # try to decode as utf8 - unless ($success){ + if (open(UPLOAD, ">:encoding(UTF-8)", $file)) { + my $backup_data = $data; + my $success = utf8::decode($data); # try to decode as utf8 + unless ($success) { warn "Trying to convert file $file from latin1? to UTF-8"; - utf8::upgrade($backup_data); # try to convert data from latin1 to utf8. - $data=$backup_data; + utf8::upgrade($backup_data); # try to convert data from latin1 to utf8. + $data = $backup_data; } - print UPLOAD $data; # print massaged data to file. - close(UPLOAD)} - else {$self->addbadmessage($r->maketext("Can't create file '[_1]': [_2]", $name, $!))} + print UPLOAD $data; # print massaged data to file. + close(UPLOAD); + } else { + $self->addbadmessage($r->maketext("Can't create file '[_1]': [_2]", $name, $!)); + } } else { $upload->disposeTo($file); } if (-e $file) { - $self->addgoodmessage($r->maketext("File '[_1]' uploaded successfully",$name)); - if ($name =~ m/\.(tar|tar\.gz|tgz)$/ && $self->getFlag('unpack')) { - if ($self->unpack($name) && $self->getFlag('autodelete')) { - if (unlink($file)) {$self->addgoodmessage($r->maketext("Archive '[_1]' deleted", $name))} - else {$self->addbadmessage($r->maketext("Can't delete archive '[_1]': [_2]", $name, $!))} - } - } + $self->addgoodmessage($r->maketext("File '[_1]' uploaded successfully", $name)); + if ($name =~ m/\.(tar|tar\.gz|tgz)$/ && $self->getFlag('unpack')) { + if ($self->unpack($name) && $self->getFlag('autodelete')) { + if (unlink($file)) { $self->addgoodmessage($r->maketext("Archive '[_1]' deleted", $name)) } + else { $self->addbadmessage($r->maketext("Can't delete archive '[_1]': [_2]", $name, $!)) } + } + } } $self->Refresh; @@ -1081,10 +1146,12 @@ sub Upload { # Print a confirmation dialog box # sub Confirm { - my $self = shift; - my $r = $self->r; - my $message = shift; my $value = shift; - my $button = shift; my $button2 = shift; + my $self = shift; + my $r = $self->r; + my $message = shift; + my $value = shift; + my $button = shift; + my $button2 = shift; print CGI::start_div({ class => 'card w-75 mx-auto' }); print CGI::div( @@ -1093,8 +1160,12 @@ sub Confirm { CGI::input({ type => "text", name => "name", size => 50, value => $value }), CGI::div( { class => 'd-flex justify-content-evenly mt-3' }, - CGI::submit({ name => "formAction", value => $r->maketext("Cancel"), class => 'btn btn-sm btn-secondary' }), - CGI::submit({ name => "formAction", value => $button, class => 'btn btn-sm btn-secondary' }), + CGI::submit({ + name => "formAction", + value => $r->maketext("Cancel"), + class => 'btn btn-sm btn-secondary' + }), + CGI::submit({ name => "formAction", value => $button, class => 'btn btn-sm btn-secondary' }), ( $button2 ? CGI::submit({ name => "formAction", value => $button2, class => 'btn btn-sm btn-secondary' }) @@ -1114,26 +1185,27 @@ sub Confirm { # Check that there is exactly one valid file # sub getFile { - my $self = shift; my $action = shift; - my $r = $self->r; - my @files = $self->r->param("files"); + my $self = shift; + my $action = shift; + my $r = $self->r; + my @files = $self->r->param("files"); if (scalar(@files) > 1) { - $self->addbadmessage($r->maketext("You can only [_1] one file at a time.",$action)); + $self->addbadmessage($r->maketext("You can only [_1] one file at a time.", $action)); $self->Refresh unless $action eq 'download'; return; } if (scalar(@files) == 0 || $files[0] eq "") { - $self->addbadmessage($r->maketext("You need to select a file to [_1].",$action)); + $self->addbadmessage($r->maketext("You need to select a file to [_1].", $action)); $self->Refresh unless $action eq 'download'; return; } my $pwd = $self->checkPWD($self->{pwd} || $self->r->param('pwd') || HOME) || '.'; - if ($self->isSymLink($pwd.'/'.$files[0])) { + if ($self->isSymLink($pwd . '/' . $files[0])) { $self->addbadmessage($r->maketext("You may not follow symbolic links")); $self->Refresh unless $action eq 'download'; return; } - unless ($self->checkPWD($pwd.'/'.$files[0],1)) { + unless ($self->checkPWD($pwd . '/' . $files[0], 1)) { $self->addbadmessage($r->maketext("You have specified an illegal file")); $self->Refresh unless $action eq 'download'; return; @@ -1147,18 +1219,22 @@ sub getFile { # sub directoryMenu { my $course = shift; - my $dir = shift; $dir =~ s!^\.(/|$)!!; - my @dirs = split('/',$dir); - my $menu = ""; my $pwd; + my $dir = shift; + $dir =~ s!^\.(/|$)!!; + my @dirs = split('/', $dir); + my $menu = ""; + my $pwd; - my (@values,%labels); + my (@values, %labels); while (scalar(@dirs)) { - $pwd = join('/',(@dirs)[0..$#dirs]); + $pwd = join('/', (@dirs)[ 0 .. $#dirs ]); $dir = pop(@dirs); - push(@values,$pwd); $labels{$pwd} = $dir; + push(@values, $pwd); + $labels{$pwd} = $dir; } - push(@values,'.'); $labels{'.'} = $course; - return (\@values,\%labels); + push(@values, '.'); + $labels{'.'} = $course; + return (\@values, \%labels); } ################################################## @@ -1166,17 +1242,20 @@ sub directoryMenu { # Get the directory listing # sub directoryListing { - my $root = shift; my $pwd = shift; my $showdates = shift; - my $dir = $root.'/'.$pwd; - my (@values,%labels,$size,$data); + my $root = shift; + my $pwd = shift; + my $showdates = shift; + my $dir = $root . '/' . $pwd; + my (@values, %labels, $size, $data); return unless -d $dir; - my $len = 24; - my @names = sortByName(undef,grep(/^[^.]/,readDirectory($dir))); + my $len = 24; + my @names = sortByName(undef, grep(/^[^.]/, readDirectory($dir))); foreach my $name (@names) { - unless ($name eq 'DATA') { #FIXME don't view the DATA directory + unless ($name eq 'DATA') { #FIXME don't view the DATA directory my $file = "$dir/$name"; - push(@values,$name); $labels{$name} = $name; + push(@values, $name); + $labels{$name} = $name; $labels{$name} .= '@' if (-l $file); $labels{$name} .= '/' if (-d $file && !-l $file); $len = length($labels{$name}) if length($labels{$name}) > $len; @@ -1186,27 +1265,26 @@ sub directoryListing { $len += 3; foreach my $name (@values) { my $file = "$dir/$name"; - my ($size,$date) = (lstat($file))[7,9]; - $labels{$name} = sprintf("%-${len}s%-16s%10s",$labels{$name}, - ((-d $file)? ("",""): - (getDate($date),getSize($size)))); + my ($size, $date) = (lstat($file))[ 7, 9 ]; + $labels{$name} = sprintf("%-${len}s%-16s%10s", + $labels{$name}, ((-d $file) ? ("", "") : (getDate($date), getSize($size)))); } } - return (\@values,\%labels); + return (\@values, \%labels); } sub getDate { - my ($sec,$min,$hour,$day,$month,$year) = localtime(shift); - sprintf("%02d-%02d-%04d %02d:%02d",$month+1,$day,$year+1900,$hour,$min); + my ($sec, $min, $hour, $day, $month, $year) = localtime(shift); + sprintf("%02d-%02d-%04d %02d:%02d", $month + 1, $day, $year + 1900, $hour, $min); } sub getSize { - my $size = shift; - return $size." B " if $size < 1024; - return sprintf("%.1f KB",$size/1024) if $size < 1024*100; - return sprintf("%d KB",int($size/1024)) if $size < 1024*1024; - return sprintf("%.1f MB",$size/1024/1024) if $size < 1024*1024*100; - return sprintf("%d MB",$size/1024/1024); + my $size = shift; + return $size . " B " if $size < 1024; + return sprintf("%.1f KB", $size / 1024) if $size < 1024 * 100; + return sprintf("%d KB", int($size / 1024)) if $size < 1024 * 1024; + return sprintf("%.1f MB", $size / 1024 / 1024) if $size < 1024 * 1024 * 100; + return sprintf("%d MB", $size / 1024 / 1024); } ################################################## @@ -1215,18 +1293,19 @@ sub getSize { # are not allowed to follow. # sub isSymLink { - my $self = shift; my $file = shift; + my $self = shift; + my $file = shift; return 0 unless -l $file; my $courseRoot = $self->{ce}{courseDirs}{root}; $courseRoot = readlink($courseRoot) if -l $courseRoot; - my $pwd = $self->{pwd} || $self->r->param('pwd') || HOME; - my $link = File::Spec->rel2abs(readlink($file),"$courseRoot/$pwd"); + my $pwd = $self->{pwd} || $self->r->param('pwd') || HOME; + my $link = File::Spec->rel2abs(readlink($file), "$courseRoot/$pwd"); # # Remove /./ and dir/../ constructs # $link =~ s!(^|/)(\.(/|$))+!$1!g; - while ($link =~ s!((\.[^./]+|\.\.[^/]+|[^./][^/]*)/\.\.(/|$))!!) {}; + while ($link =~ s!((\.[^./]+|\.\.[^/]+|[^./][^/]*)/\.\.(/|$))!!) { } # # Look through the list of valid paths to see if this link is OK @@ -1234,7 +1313,7 @@ sub isSymLink { my $valid = $self->{ce}{webworkDirs}{valid_symlinks}; if (defined $valid && $valid) { foreach my $path (@{$valid}) { - return 0 if substr($link,0,length($path)) eq $path; + return 0 if substr($link, 0, length($path)) eq $path; } } @@ -1246,33 +1325,33 @@ sub isSymLink { # Normalize the working directory and check if it is OK. # sub checkPWD { - my $self = shift; - my $pwd = shift; + my $self = shift; + my $pwd = shift; my $renameError = shift; - $pwd =~ s!//+!/!g; # remove duplicate slashes - $pwd =~ s!(^|/)~!$1_!g; # remove ~user references - $pwd =~ s!(^|/)(\.(/|$))+!$1!g; # remove dot directories + $pwd =~ s!//+!/!g; # remove duplicate slashes + $pwd =~ s!(^|/)~!$1_!g; # remove ~user references + $pwd =~ s!(^|/)(\.(/|$))+!$1!g; # remove dot directories # remove dir/.. constructions - while ($pwd =~ s!((\.[^./]+|\.\.[^/]+|[^./][^/]*)/\.\.(/|$))!!) {}; + while ($pwd =~ s!((\.[^./]+|\.\.[^/]+|[^./][^/]*)/\.\.(/|$))!!) { } - $pwd =~ s!/$!!; # remove trailing / - return if ($pwd =~ m!(^|/)\.\.(/|$)!); # Error if outside the root + $pwd =~ s!/$!!; # remove trailing / + return if ($pwd =~ m!(^|/)\.\.(/|$)!); # Error if outside the root # check for bad symbolic links - my @dirs = split('/',$pwd); - pop(@dirs) if $renameError; # don't check file iteself in this case + my @dirs = split('/', $pwd); + pop(@dirs) if $renameError; # don't check file iteself in this case my @path = ($self->{ce}{courseDirs}{root}); foreach my $dir (@dirs) { - push @path,$dir; - return if ($self->isSymLink(join('/',@path))); + push @path, $dir; + return if ($self->isSymLink(join('/', @path))); } my $original = $pwd; - $pwd =~ s!(^|/)\.!$1_!g; # don't enter hidden directories - $pwd =~ s!^/!!; # remove leading / - $pwd =~ s![^-_./A-Z0-9~, ]!_!gi; # no illegal characters + $pwd =~ s!(^|/)\.!$1_!g; # don't enter hidden directories + $pwd =~ s!^/!!; # remove leading / + $pwd =~ s![^-_./A-Z0-9~, ]!_!gi; # no illegal characters return if $renameError && $original ne $pwd; $pwd = '.' if $pwd eq ''; @@ -1284,17 +1363,23 @@ sub checkPWD { # Check that a file is uploaded to the correct directory # sub checkFileLocation { - my $self = shift; - my $r = $self->r; - my $extension = shift; $extension =~ s/.*\.//; - my $dir = shift; my $location = $uploadDir{$extension}; + my $self = shift; + my $r = $self->r; + my $extension = shift; + $extension =~ s/.*\.//; + my $dir = shift; + my $location = $uploadDir{$extension}; return unless defined($location); return if $dir =~ m/^$location$/; - $location =~ s!/\.\*!!; + $location =~ s!/\.\*!!; return if $dir =~ m/^$location$/; $self->addbadmessage( - $r->maketext("Files with extension '.[_1]' usually belong in '[_2]'",$extension,$location) - . (($extension eq 'csv') ? $r->maketext(". If this is a class roster, rename it to have extension '.lst'") : '') + $r->maketext("Files with extension '.[_1]' usually belong in '[_2]'", $extension, $location) + . ( + ($extension eq 'csv') + ? $r->maketext(". If this is a class roster, rename it to have extension '.lst'") + : '' + ) ); } @@ -1304,10 +1389,10 @@ sub checkFileLocation { # sub checkName { my $file = shift; - $file =~ s!.*[/\\]!!; # remove directory - $file =~ s/[^-_.a-zA-Z0-9 ]/_/g; # no illegal characters - $file =~ s/^\./_/; # no initial dot - $file = "newfile.txt" unless $file; # no blank names + $file =~ s!.*[/\\]!!; # remove directory + $file =~ s/[^-_.a-zA-Z0-9 ]/_/g; # no illegal characters + $file =~ s/^\./_/; # no initial dot + $file = "newfile.txt" unless $file; # no blank names return $file; } @@ -1316,12 +1401,14 @@ sub checkName { # Get a unique name (in case it already exists) # sub uniqueName { - my $dir = shift; my $name = shift; + my $dir = shift; + my $name = shift; return $name unless (-e "$dir/$name"); - my $type = ""; my $n = 1; + my $type = ""; + my $n = 1; $type = $1 if ($name =~ s/(\.[^.]*)$//); - $n = $1 if ($name =~ s/_(\d+)$/_/); - while (-e "$dir/${name}_$n$type") {$n++} + $n = $1 if ($name =~ s/_(\d+)$/_/); + while (-e "$dir/${name}_$n$type") { $n++ } return "${name}_$n$type"; } @@ -1331,8 +1418,10 @@ sub uniqueName { # directory. # sub verifyName { - my $self = shift; my $name = shift; my $object = shift; - my $r = $self->r; + my $self = shift; + my $name = shift; + my $object = shift; + my $r = $self->r; if ($name) { unless ($name =~ m!/!) { unless ($name =~ m!^\.!) { @@ -1340,11 +1429,19 @@ sub verifyName { my $file = "$self->{courseRoot}/$self->{pwd}/$name"; return $file unless (-e $file); $self->addbadmessage($r->maketext("A file with that name already exists")); - } else {$self->addbadmessage($r->maketext("Your [_1] name contains illegal characters",$object))} - } else {$self->addbadmessage($r->maketext("Your [_1] name may not begin with a dot",$object))} - } else {$self->addbadmessage($r->maketext("Your [_1] name may not contain a path component",$object))} - } else {$self->addbadmessage($r->maketext("You must specify a [_1] name",$object))} - return + } else { + $self->addbadmessage($r->maketext("Your [_1] name contains illegal characters", $object)); + } + } else { + $self->addbadmessage($r->maketext("Your [_1] name may not begin with a dot", $object)); + } + } else { + $self->addbadmessage($r->maketext("Your [_1] name may not contain a path component", $object)); + } + } else { + $self->addbadmessage($r->maketext("You must specify a [_1] name", $object)); + } + return; } ################################################## @@ -1352,23 +1449,33 @@ sub verifyName { # Verify that a file path is valid # sub verifyPath { - my $self = shift; my $path = shift; my $name = shift; - my $r = $self->r; + my $self = shift; + my $path = shift; + my $name = shift; + my $r = $self->r; if ($path) { unless ($path =~ m![^-_.a-zA-Z0-9 /]!) { unless ($path =~ m!^/!) { - $path = $self->checkPWD($self->{pwd}.'/'.$path,1); + $path = $self->checkPWD($self->{pwd} . '/' . $path, 1); if ($path) { - $path = $self->{courseRoot}.'/'.$path; - $path .= '/'.$name if -d $path && $name; + $path = $self->{courseRoot} . '/' . $path; + $path .= '/' . $name if -d $path && $name; return $path unless (-e $path); $self->addbadmessage($r->maketext("A file with that name already exists")); - } else {$self->addbadmessage($r->maketext("You have specified an illegal path"))} - } else {$self->addbadmessage($r->maketext("You can not specify an absolute path"))} - } else {$self->addbadmessage($r->maketext("Your file name contains illegal characters"))} - } else {$self->addbadmessage($r->maketext("You must specify a file name"))} - return + } else { + $self->addbadmessage($r->maketext("You have specified an illegal path")); + } + } else { + $self->addbadmessage($r->maketext("You can not specify an absolute path")); + } + } else { + $self->addbadmessage($r->maketext("Your file name contains illegal characters")); + } + } else { + $self->addbadmessage($r->maketext("You must specify a file name")); + } + return; } ################################################## @@ -1376,11 +1483,13 @@ sub verifyPath { # Get the value of a parameter flag # sub getFlag { - my $self = shift; my $flag = shift; - my $default = shift; $default = 0 unless defined $default; - my $value = $self->r->param($flag); - $value = $default unless defined $value; - return $value; + my $self = shift; + my $flag = shift; + my $default = shift; + $default = 0 unless defined $default; + my $value = $self->r->param($flag); + $value = $default unless defined $value; + return $value; } ################################################## @@ -1436,10 +1545,10 @@ sub fixSpaces { # Interpret command return errors # sub systemError { - my $status = shift; - return "error: $!" if $status == 0xFF00; - return "exit status ".($status >> 8) if ($status & 0xFF) == 0; - return "signal ".($status &= ~0x80); + my $status = shift; + return "error: $!" if $status == 0xFF00; + return "exit status " . ($status >> 8) if ($status & 0xFF) == 0; + return "signal " . ($status &= ~0x80); } ################################################## diff --git a/lib/WeBWorK/ContentGenerator/Instructor/PGProblemEditor.pm b/lib/WeBWorK/ContentGenerator/Instructor/PGProblemEditor.pm index a4d16eb33a..7825846741 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/PGProblemEditor.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/PGProblemEditor.pm @@ -124,7 +124,7 @@ use Fcntl; #hiding add_problem option to see if its needed use constant ACTION_FORMS => [qw(view save save_as add_problem revert)]; -use constant ACTION_FORM_TITLES => { # editor tabs +use constant ACTION_FORM_TITLES => { # editor tabs view => x("View"), add_problem => x("Append"), save => x("Update"), @@ -134,43 +134,43 @@ use constant ACTION_FORM_TITLES => { # editor tabs # permissions needed to perform a given action use constant FORM_PERMS => { - view => "modify_student_data", - add_problem => "modify_student_data", + view => "modify_student_data", + add_problem => "modify_student_data", make_local_copy => "modify_student_data", - save => "modify_student_data", - save_as => "modify_student_data", - revert => "modify_student_data", + save => "modify_student_data", + save_as => "modify_student_data", + revert => "modify_student_data", }; our $BLANKPROBLEM = 'blankProblem.pg'; sub pre_header_initialize { - my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; - my $urlpath = $r->urlpath; - my $authz = $r->authz; - my $user = $r->param('user'); - $self->{courseID} = $urlpath->arg("courseID"); - $self->{setID} = $r->urlpath->arg("setID") ; # using $r->urlpath->arg("setID") ||'' causes trouble with set 0!!! - $self->{problemID} = $r->urlpath->arg("problemID"); + my ($self) = @_; + my $r = $self->r; + my $ce = $r->ce; + my $urlpath = $r->urlpath; + my $authz = $r->authz; + my $user = $r->param('user'); + $self->{courseID} = $urlpath->arg("courseID"); + $self->{setID} = $r->urlpath->arg("setID"); # using $r->urlpath->arg("setID") ||'' causes trouble with set 0!!! + $self->{problemID} = $r->urlpath->arg("problemID"); # parse setID, which may come in with version data my $fullSetID = $self->{setID}; - if (defined($fullSetID) ) { - if ( $fullSetID =~ /,v(\d+)$/ ) { + if (defined($fullSetID)) { + if ($fullSetID =~ /,v(\d+)$/) { $self->{versionID} = $1; $self->{setID} =~ s/,v\d+$//; } $self->{fullSetID} = $fullSetID; } - my $submit_button = $r->param('submit'); # obtain submit command from form - my $actionID = $r->param('action'); - my $file_type = $r->param("file_type") || ''; - my $setName = $self->{setID}; + my $submit_button = $r->param('submit'); # obtain submit command from form + my $actionID = $r->param('action'); + my $file_type = $r->param("file_type") || ''; + my $setName = $self->{setID}; my $versionedSetName = $self->{fullSetID}; - my $problemNumber = $self->{problemID}; + my $problemNumber = $self->{problemID}; # Check permissions return unless ($authz->hasPermissions($user, "access_instructor_tools")); @@ -221,9 +221,9 @@ sub pre_header_initialize { # If this has not been defined we are dealing with a set header # or regular problem - if ( not_blank($file_type) ) { #file_type is defined and is not blank - # file type is already defined -- do nothing - #warn "file type already defined as $file_type" #FIXME debug + if (not_blank($file_type)) { #file_type is defined and is not blank + # file type is already defined -- do nothing + #warn "file type already defined as $file_type" #FIXME debug } else { # if "sourceFilePath" is defined in the form, then we are getting the path directly. # if the problem number is defined and is 0 @@ -232,12 +232,14 @@ sub pre_header_initialize { # to the screen. # If the problem number is not zero, we are dealing with a real problem ###################################### - if ( not_blank($r->param('sourceFilePath') ) ) { - $file_type ='source_path_for_problem_file'; - $file_type = 'set_header' if $r->param('sourceFilePath') =~ m!/headers/|Header\.pg$!; #FIXME this need to be cleaned up - } elsif ( defined($problemNumber) ) { - if ( $problemNumber =~/^\d+$/ and $problemNumber == 0 ) { # if problem number is numeric and zero - $file_type = 'set_header' unless $file_type eq 'set_header' + if (not_blank($r->param('sourceFilePath'))) { + $file_type = 'source_path_for_problem_file'; + $file_type = 'set_header' + if $r->param('sourceFilePath') =~ m!/headers/|Header\.pg$!; #FIXME this need to be cleaned up + } elsif (defined($problemNumber)) { + if ($problemNumber =~ /^\d+$/ and $problemNumber == 0) { # if problem number is numeric and zero + $file_type = 'set_header' + unless $file_type eq 'set_header' or $file_type eq 'hardcopy_header'; } else { $file_type = 'problem'; @@ -249,18 +251,18 @@ sub pre_header_initialize { die "The file_type variable |$file_type| has not been defined or is blank." unless not_blank($file_type); # clean up sourceFilePath, just in case # double check that sourceFilePath is relative to the templates file - if ($file_type eq 'source_path_for_problem_file' ) { + if ($file_type eq 'source_path_for_problem_file') { my $templatesDirectory = $ce->{courseDirs}->{templates}; - my $sourceFilePath = $r->param('sourceFilePath'); + my $sourceFilePath = $r->param('sourceFilePath'); $sourceFilePath =~ s/$templatesDirectory//; - $sourceFilePath =~ s|^/||; # remove intial / + $sourceFilePath =~ s|^/||; # remove intial / $self->{sourceFilePath} = $sourceFilePath; } $self->{file_type} = $file_type; # $self->addgoodmessage("file type is $file_type"); #FIXME debug ########################################## - # File type is one of: blank_problem course_info options_info problem set_header hardcopy_header source_path_for_problem_file +# File type is one of: blank_problem course_info options_info problem set_header hardcopy_header source_path_for_problem_file ########################################## # # Determine the path to the file @@ -274,7 +276,7 @@ sub pre_header_initialize { ########################################## # Default problem contents ########################################## - $self->{r_problemContents}= undef; + $self->{r_problemContents} = undef; ########################################## # @@ -283,28 +285,28 @@ sub pre_header_initialize { ########################################### if ($actionID) { - unless (grep { $_ eq $actionID } @{ ACTION_FORMS() } ) { + unless (grep { $_ eq $actionID } @{ ACTION_FORMS() }) { die "Action $actionID not found"; } # Check permissions if (not FORM_PERMS()->{$actionID} or $authz->hasPermissions($user, FORM_PERMS()->{$actionID})) { my $actionHandler = "${actionID}_handler"; - my %genericParams =(); - my %actionParams = $self->getActionParams($actionID); - my %tableParams = (); # $self->getTableParams(); - $self->{action}= $actionID; + my %genericParams = (); + my %actionParams = $self->getActionParams($actionID); + my %tableParams = (); # $self->getTableParams(); + $self->{action} = $actionID; $self->$actionHandler(\%genericParams, \%actionParams, \%tableParams); } else { - $self->addbadmessage( "You are not authorized to perform this action."); + $self->addbadmessage("You are not authorized to perform this action."); } } else { - $self->{action}='fresh_edit'; + $self->{action} = 'fresh_edit'; my $actionHandler = "fresh_edit_handler"; my %genericParams; - my %actionParams = (); #$self->getActionParams($actionID); - my %tableParams = (); # $self->getTableParams(); + my %actionParams = (); #$self->getActionParams($actionID); + my %tableParams = (); # $self->getTableParams(); my $problemContents = ''; - $self->{r_problemContents}=\$problemContents; + $self->{r_problemContents} = \$problemContents; $self->$actionHandler(\%genericParams, \%actionParams, \%tableParams); } @@ -330,7 +332,7 @@ sub pre_header_initialize { # inside saveFileChanges $self->{problemSeed} = $r->param('problemSeed') if (defined $r->param('problemSeed')); # Make sure that the problem seed has some value - $self->{problemSeed} = DEFAULT_SEED() unless not_blank( $self->{problemSeed}); + $self->{problemSeed} = DEFAULT_SEED() unless not_blank($self->{problemSeed}); ############################################################################## # Return @@ -350,35 +352,42 @@ sub pre_header_initialize { # Some cases do not need a redirect: save, refresh, save_as, add_problem_to_set, add_header_to_set,make_local_copy my $action = $self->{action}; - return ; + return; } -sub initialize { +sub initialize { my ($self) = @_; - my $r = $self->r; - my $authz = $r->authz; - my $user = $r->param('user'); + my $r = $self->r; + my $authz = $r->authz; + my $user = $r->param('user'); # Check permissions return unless ($authz->hasPermissions($user, "access_instructor_tools")); return unless ($authz->hasPermissions($user, "modify_problem_sets")); - my $file_type = $r->param('file_type') || ""; - my $tempFilePath = $self->{tempFilePath}; # path to the file currently being worked with (might be a .tmp file) - my $inputFilePath = $self->{inputFilePath}; # path to the file for input, (might be a .tmp file) + my $file_type = $r->param('file_type') || ""; + my $tempFilePath = $self->{tempFilePath}; # path to the file currently being worked with (might be a .tmp file) + my $inputFilePath = $self->{inputFilePath}; # path to the file for input, (might be a .tmp file) - $self->addmessage($r->param('status_message') ||''); # record status messages carried over if this is a redirect + $self->addmessage($r->param('status_message') || ''); # record status messages carried over if this is a redirect $self->addbadmessage($r->maketext("Changes in this file have not yet been permanently saved.")) if -r $tempFilePath; - if ( not( -e $inputFilePath) ) { + if (not(-e $inputFilePath)) { $self->addbadmessage($r->maketext("The file '[_1]' cannot be found.", $self->shortPath($inputFilePath))); - } elsif ((not -w $inputFilePath) && $file_type ne 'blank_problem' ) { - $self->addbadmessage($r->maketext("The file '[_1]' is protected!", $self->shortPath($inputFilePath)).CGI::br(). - $r->maketext("To edit this text you must first make a copy of this file using the 'NewVersion' action below.")); + } elsif ((not -w $inputFilePath) && $file_type ne 'blank_problem') { + $self->addbadmessage( + $r->maketext("The file '[_1]' is protected!", $self->shortPath($inputFilePath)) + . CGI::br() + . $r->maketext( + "To edit this text you must first make a copy of this file using the 'NewVersion' action below.") + ); } - if ($inputFilePath =~/$BLANKPROBLEM$/ && $file_type ne 'blank_problem') { - $self->addbadmessage($r->maketext("The file '[_1]' is a blank problem!", - $self->shortPath($inputFilePath)).CGI::br(). - $r->maketext("To edit this text you must use the 'NewVersion' action below to save it to another file.")); + if ($inputFilePath =~ /$BLANKPROBLEM$/ && $file_type ne 'blank_problem') { + $self->addbadmessage( + $r->maketext("The file '[_1]' is a blank problem!", $self->shortPath($inputFilePath)) + . CGI::br() + . $r->maketext( + "To edit this text you must use the 'NewVersion' action below to save it to another file.") + ); } } @@ -416,22 +425,22 @@ sub path { } sub title { - my $self = shift; - my $r = $self->r; + my $self = shift; + my $r = $self->r; my $courseName = $r->urlpath->arg("courseID"); my $setID = $r->urlpath->arg("setID"); my $problemNumber = $r->urlpath->arg("problemID"); - my $file_type = $self->{'file_type'} || ''; + my $file_type = $self->{'file_type'} || ''; - return "Set Header for set $setID" if ($file_type eq 'set_header'); - return "Hardcopy Header for set $setID" if ($file_type eq 'hardcopy_header'); + return "Set Header for set $setID" if ($file_type eq 'set_header'); + return "Hardcopy Header for set $setID" if ($file_type eq 'hardcopy_header'); return "Course Information for course $courseName" if ($file_type eq 'course_info'); - return "Options Information" if ($file_type eq 'options_info'); + return "Options Information" if ($file_type eq 'options_info'); if ($setID) { my $set = $r->db->getGlobalSet($setID); if ($set && $set->assignment_type eq 'jitar') { - $problemNumber = join('.',jitar_id_to_seq($problemNumber)); + $problemNumber = join('.', jitar_id_to_seq($problemNumber)); } } @@ -439,12 +448,12 @@ sub title { } sub body { - my ($self) = @_; - my $r = $self->r; - my $db = $r->db; - my $ce = $r->ce; - my $authz = $r->authz; - my $user = $r->param('user'); + my ($self) = @_; + my $r = $self->r; + my $db = $r->db; + my $ce = $r->ce; + my $authz = $r->authz; + my $user = $r->param('user'); my $make_local_copy = $r->param('make_local_copy'); # Check permissions @@ -456,31 +465,33 @@ sub body { unless $authz->hasPermissions($user, "modify_student_data"); # Gathering info - my $editFilePath = $self->{editFilePath}; # path to the permanent file to be edited - my $tempFilePath = $self->{tempFilePath}; # path to the file currently being worked with (might be a .tmp file) - my $inputFilePath = $self->{inputFilePath}; # path to the file for input, (might be a .tmp file) - my $setName = $self->{setID} // ''; # Allow the numeric set name 0. - my $problemNumber = $self->{problemID} ; - my $fullSetName = defined( $self->{fullSetID} ) ? $self->{fullSetID} : $setName; - $problemNumber = defined($problemNumber) ? $problemNumber : ''; + my $editFilePath = $self->{editFilePath}; # path to the permanent file to be edited + my $tempFilePath = $self->{tempFilePath}; # path to the file currently being worked with (might be a .tmp file) + my $inputFilePath = $self->{inputFilePath}; # path to the file for input, (might be a .tmp file) + my $setName = $self->{setID} // ''; # Allow the numeric set name 0. + my $problemNumber = $self->{problemID}; + my $fullSetName = defined($self->{fullSetID}) ? $self->{fullSetID} : $setName; + $problemNumber = defined($problemNumber) ? $problemNumber : ''; ######################################################################### # Construct url for reporting bugs: ######################################################################### my $libraryName = ''; - if ($editFilePath =~ m|([^/]*)Library|) { #find the path to the file - # find the library, if any exists in the path name (first library is picked) + if ($editFilePath =~ m|([^/]*)Library|) { #find the path to the file + # find the library, if any exists in the path name (first library is picked) my $tempLibraryName = $1; $libraryName = (not_blank($tempLibraryName)) ? $tempLibraryName : "Library"; # things that start /Library/setFoo/probBar are labeled as component "Library" # which refers to the SQL based problem library. (is nationalLibrary a better name?) } else { - $libraryName = 'Library'; # make sure there is some default component defined. + $libraryName = 'Library'; # make sure there is some default component defined. } - my $BUGZILLA = "$ce->{webworkURLs}{bugReporter}?product=Problem%20libraries". - "&component=$libraryName&bug_file_loc=${editFilePath}_with_problemSeed=".$self->{problemSeed}; + my $BUGZILLA = + "$ce->{webworkURLs}{bugReporter}?product=Problem%20libraries" + . "&component=$libraryName&bug_file_loc=${editFilePath}_with_problemSeed=" + . $self->{problemSeed}; #FIXME # The construction of this URL is somewhat fragile. A separate module could be devoted to # intelligent bug reporting. @@ -488,55 +499,64 @@ sub body { # Construct reference row for PGproblemEditor. ######################################################################### - my @PG_Editor_Reference_Links = ({ + my @PG_Editor_Reference_Links = ( + { #'http://webwork.maa.org/wiki/Category:Problem_Techniques', label => $r->maketext('Problem Techniques'), url => $ce->{webworkURLs}{problemTechniquesHelpURL}, target => 'techniques_window', tooltip => 'Snippets of PG code illustrating specific techniques', - }, { + }, + { #'http://webwork.maa.org/wiki/Category:MathObjects', label => $r->maketext('Math Objects'), url => $ce->{webworkURLs}{MathObjectsHelpURL}, target => 'math_objects', tooltip => 'Wiki summary page for MathObjects', - }, { + }, + { #'http://webwork.maa.org/pod/pg_TRUNK/', label => $r->maketext('POD'), url => $ce->{webworkURLs}{PODHelpURL}, target => 'pod_docs', - tooltip => 'Documentation from source code for PG modules and macro files. Often the most up-to-date information.', - }, { + tooltip => + 'Documentation from source code for PG modules and macro files. Often the most up-to-date information.', + }, + { #'http://demo.webwork.rochester.edu/webwork2/wikiExamples/MathObjectsLabs2/2/?login_practice_user=true', - # label => $r->maketext('PGLab'), - # url => $ce->{webworkURLs}{PGLabHelpURL}, - # target => 'PGLab', - # tooltip => 'Test snippets of PG code in interactive lab. This is a good way to learn the PG language.', - # }, { + # label => $r->maketext('PGLab'), + # url => $ce->{webworkURLs}{PGLabHelpURL}, + # target => 'PGLab', + # tooltip => 'Test snippets of PG code in interactive lab. This is a good way to learn the PG language.', + # }, { #'https://courses1.webwork.maa.org/webwork2/cervone_course/PGML/1/?login_practice_user=true', label => $r->maketext('PGML'), url => $ce->{webworkURLs}{PGMLHelpURL}, target => 'PGML', - tooltip => 'PG mark down syntax used to format WeBWorK questions. This interactive lab can help you to learn the techniques.', - }, { + tooltip => + 'PG mark down syntax used to format WeBWorK questions. This interactive lab can help you to learn the techniques.', + }, + { #'http://webwork.maa.org/wiki/Category:Authors', label => $r->maketext('Author Info'), url => $ce->{webworkURLs}{AuthorHelpURL}, target => 'author_info', tooltip => 'Top level of author information on the wiki.', - }, { + }, + { label => $r->maketext('Report Bugs in this Problem'), url => $BUGZILLA, target => 'bug_report', - tooltip => 'Report bugs in a WeBWorK question/problem using this link. ' . - 'The very first time you do this you will need to register with an email address so that ' . - 'information on the bug fix can be reported back to you.', + tooltip => 'Report bugs in a WeBWorK question/problem using this link. ' + . 'The very first time you do this you will need to register with an email address so that ' + . 'information on the bug fix can be reported back to you.', }, ); my @PG_Editor_References; foreach my $link (@PG_Editor_Reference_Links) { - push(@PG_Editor_References, + push( + @PG_Editor_References, CGI::a( { href => $link->{url}, @@ -557,24 +577,27 @@ sub body { # or in the problem contents gathered in the initialization phase. ######################################################################### - my $problemContents = ${$self->{r_problemContents}}; + my $problemContents = ${ $self->{r_problemContents} }; - unless ($problemContents =~/\S/) { # non-empty contents + unless ($problemContents =~ /\S/) { # non-empty contents if (-r $tempFilePath and not -d $tempFilePath) { - die "tempFilePath is unsafe!" unless path_is_subdir($tempFilePath, $ce->{courseDirs}->{templates}, 1); # 1==path can be relative to dir + die "tempFilePath is unsafe!" + unless path_is_subdir($tempFilePath, $ce->{courseDirs}->{templates}, 1) + ; # 1==path can be relative to dir eval { $problemContents = WeBWorK::Utils::readFile($tempFilePath) }; $problemContents = $@ if $@; - $inputFilePath = $tempFilePath; - } elsif (-r $editFilePath and not -d $editFilePath) { - die "editFilePath is unsafe!" unless path_is_subdir($editFilePath, $ce->{courseDirs}->{templates}, 1) # 1==path can be relative to dir + $inputFilePath = $tempFilePath; + } elsif (-r $editFilePath and not -d $editFilePath) { + die "editFilePath is unsafe!" + unless path_is_subdir($editFilePath, $ce->{courseDirs}->{templates}, 1) # 1==path can be relative to dir || $editFilePath eq $ce->{webworkFiles}{screenSnippets}{setHeader} || $editFilePath eq $ce->{webworkFiles}{hardcopySnippets}{setHeader} || $editFilePath eq $ce->{webworkFiles}{screenSnippets}{blankProblem}; eval { $problemContents = WeBWorK::Utils::readFile($editFilePath) }; $problemContents = $@ if $@; - $inputFilePath = $editFilePath; - } else { # file not existing is not an error - #warn "No file exists"; + $inputFilePath = $editFilePath; + } else { # file not existing is not an error + #warn "No file exists"; $problemContents = ''; } } else { @@ -584,8 +607,8 @@ sub body { my $protected_file = not -w $inputFilePath; my $prettyProblemNumber = $problemNumber; - my $set = $self->r->db->getGlobalSet($setName); - $prettyProblemNumber = join('.',jitar_id_to_seq($problemNumber)) + my $set = $self->r->db->getGlobalSet($setName); + $prettyProblemNumber = join('.', jitar_id_to_seq($problemNumber)) if ($set && $set->assignment_type eq 'jitar'); my %titles = ( @@ -636,8 +659,8 @@ sub body { ######### print action forms - my @formsToShow = @{ ACTION_FORMS() }; - my %actionFormTitles = %{ACTION_FORM_TITLES()}; + my @formsToShow = @{ ACTION_FORMS() }; + my %actionFormTitles = %{ ACTION_FORM_TITLES() }; my $default_choice; my @tabArr; @@ -674,9 +697,9 @@ sub body { @contentArr, CGI::div( { - class => "tab-pane fade" . ($active ? " show$active" : ''), - id => $actionID, - role => 'tabpanel', + class => "tab-pane fade" . ($active ? " show$active" : ''), + id => $actionID, + role => 'tabpanel', aria_labelledby => "$actionID-tab" }, $line_contents @@ -696,7 +719,7 @@ sub body { class => 'btn btn-primary' })); - print CGI::end_form(); + print CGI::end_form(); print CGI::start_div({ id => 'render-modal', class => 'modal hide fade', tabindex => '-1' }); print CGI::start_div({ class => 'modal-dialog modal-dialog-centered' }); @@ -724,11 +747,14 @@ sub body { # Convert long paths to [TMPL], etc. sub shortPath { - my $self = shift; my $file = shift; + my $self = shift; + my $file = shift; my $tmpl = $self->r->ce->{courseDirs}{templates}; my $root = $self->r->ce->{courseDirs}{root}; - my $ww = $self->r->ce->{webworkDirs}{root}; - $file =~ s|^$tmpl|[TMPL]|; $file =~ s|^$root|[COURSE]|; $file =~ s|^$ww|[WW]|; + my $ww = $self->r->ce->{webworkDirs}{root}; + $file =~ s|^$tmpl|[TMPL]|; + $file =~ s|^$root|[COURSE]|; + $file =~ s|^$ww|[WW]|; return $file; } @@ -740,7 +766,7 @@ sub getRelativeSourceFilePath { my ($self, $sourceFilePath) = @_; my $templatesDir = $self->r->ce->{courseDirs}->{templates}; - $sourceFilePath =~ s|^$templatesDir/*||; # remove templates path and any slashes that follow + $sourceFilePath =~ s|^$templatesDir/*||; # remove templates path and any slashes that follow return $sourceFilePath; } @@ -748,22 +774,23 @@ sub getRelativeSourceFilePath { # determineLocalFilePath constructs a local file path parallel to a library file path sub determineLocalFilePath { - my $self= shift; + my $self = shift; die "determineLocalFilePath is a method" unless ref($self); - my $path = shift; + my $path = shift; my $default_screen_header_path = $self->r->ce->{webworkFiles}->{hardcopySnippets}->{setHeader}; my $default_hardcopy_header_path = $self->r->ce->{webworkFiles}->{screenSnippets}->{setHeader}; - my $setID = $self->{setID}; - $setID = int(rand(1000)) unless $setID =~/\S/; # setID can be 0 + my $setID = $self->{setID}; + $setID = int(rand(1000)) unless $setID =~ /\S/; # setID can be 0 if ($path =~ /Library/) { #$path =~ s|^.*?Library/||; # truncate the url up to a segment such as ...rochesterLibrary/....... - $path =~ s|^.*?Library/|local/|; # truncate the url up to a segment such as ...rochesterLibrary/....... and prepend local + $path =~ s|^.*?Library/|local/| + ; # truncate the url up to a segment such as ...rochesterLibrary/....... and prepend local } elsif ($path eq $default_screen_header_path) { $path = "set$setID/setHeader.pg"; } elsif ($path eq $default_hardcopy_header_path) { $path = "set$setID/hardcopyHeader.tex"; - } else { # if its not in a library we'll just save it locally - $path = "new_problem_".int(rand(1000)).".pg"; #l hope there aren't any collisions. + } else { # if its not in a library we'll just save it locally + $path = "new_problem_" . int(rand(1000)) . ".pg"; #l hope there aren't any collisions. } $path; } @@ -771,12 +798,13 @@ sub determineLocalFilePath { # this does not create the directories in the path to the file # it returns an absolute path to the file sub determineTempEditFilePath { - my $self = shift; die "determineTempEditFilePath is a method" unless ref($self); - my $r = $self->r; - my $path =shift; # this should be an absolute path to the file + my $self = shift; + die "determineTempEditFilePath is a method" unless ref($self); + my $r = $self->r; + my $path = shift; # this should be an absolute path to the file my $user = $self->r->param("user"); - $user = int(rand(1000)) unless defined $user; - my $setID = $self->{setID} || int(rand(1000)); + $user = int(rand(1000)) unless defined $user; + my $setID = $self->{setID} || int(rand(1000)); my $courseDirectory = $self->r->ce->{courseDirs}; ############### # Calculate the location of the temporary file @@ -785,21 +813,26 @@ sub determineTempEditFilePath { my $blank_file_path = $self->r->ce->{webworkFiles}->{screenSnippets}->{blankProblem}; my $default_screen_header_path = $self->r->ce->{webworkFiles}->{hardcopySnippets}->{setHeader}; my $default_hardcopy_header_path = $self->r->ce->{webworkFiles}->{screenSnippets}->{setHeader}; - my $tmpEditFileDirectory = $self->getTempEditFileDirectory(); - $self->addbadmessage($r->maketext("The path to the original file should be absolute")) unless $path =~m|^/|; # debug - if ($path =~/^$tmpEditFileDirectory/) { - $self->addbadmessage("Error: This path is already in the temporary edit directory -- no new temporary file is created. path = $path"); + my $tmpEditFileDirectory = $self->getTempEditFileDirectory(); + $self->addbadmessage($r->maketext("The path to the original file should be absolute")) + unless $path =~ m|^/|; # debug + if ($path =~ /^$tmpEditFileDirectory/) { + $self->addbadmessage( + "Error: This path is already in the temporary edit directory -- no new temporary file is created. path = $path" + ); } else { - if ($path =~ /^$templatesDirectory/ ) { + if ($path =~ /^$templatesDirectory/) { $path =~ s|^$templatesDirectory||; - $path =~ s|^/||; # remove the initial slash if any + $path =~ s|^/||; # remove the initial slash if any $path = "$tmpEditFileDirectory/$path.$user.tmp"; } elsif ($path eq $blank_file_path) { - $path = "$tmpEditFileDirectory/blank.$setID.$user.tmp"; # handle the case of the blank problem + $path = "$tmpEditFileDirectory/blank.$setID.$user.tmp"; # handle the case of the blank problem } elsif ($path eq $default_screen_header_path) { - $path = "$tmpEditFileDirectory/screenHeader.$setID.$user.tmp"; # handle the case of the screen header in snippets + $path = "$tmpEditFileDirectory/screenHeader.$setID.$user.tmp" + ; # handle the case of the screen header in snippets } elsif ($path eq $default_hardcopy_header_path) { - $path = "$tmpEditFileDirectory/hardcopyHeader.$setID.$user.tmp"; # handle the case of the hardcopy header in snippets + $path = "$tmpEditFileDirectory/hardcopyHeader.$setID.$user.tmp" + ; # handle the case of the hardcopy header in snippets } else { die "determineTempEditFilePath should only be used on paths within the templates directory, not on $path"; } @@ -814,23 +847,23 @@ sub determineOriginalEditFilePath { my $path = shift; my $user = $self->r->param("user"); $self->addbadmessage("Can't determine user of temporary edit file $path.") unless defined($user); - my $templatesDirectory = $self->r->ce->{courseDirs} ->{templates}; + my $templatesDirectory = $self->r->ce->{courseDirs}->{templates}; my $tmpEditFileDirectory = $self->getTempEditFileDirectory(); # unless path is absolute assume that it is relative to the template directory my $newpath = $path; - unless ($path =~ m|^/| ) { + unless ($path =~ m|^/|) { $newpath = "$templatesDirectory/$path"; } - if ($self->isTempEditFilePath($newpath) ) { - $newpath =~ s|^$tmpEditFileDirectory/||; # delete temp edit directory - if ($newpath =~m|blank\.[^/]*$|) { # handle the case of the blank problem + if ($self->isTempEditFilePath($newpath)) { + $newpath =~ s|^$tmpEditFileDirectory/||; # delete temp edit directory + if ($newpath =~ m|blank\.[^/]*$|) { # handle the case of the blank problem $newpath = $self->r->ce->{webworkFiles}->{screenSnippets}->{blankProblem}; - } elsif (($newpath =~m|hardcopyHeader\.[^/]*$|)) { # handle the case of the hardcopy header in snippets + } elsif (($newpath =~ m|hardcopyHeader\.[^/]*$|)) { # handle the case of the hardcopy header in snippets $newpath = $self->r->ce->{webworkFiles}->{hardcopySnippets}->{setHeader}; - } elsif (($newpath =~m|screenHeader\.[^/]*$|)) { # handle the case of the screen header in snippets + } elsif (($newpath =~ m|screenHeader\.[^/]*$|)) { # handle the case of the screen header in snippets $newpath = $self->r->ce->{webworkFiles}->{screenSnippets}->{setHeader}; } else { - $newpath =~ s|\.$user\.tmp$||; # delete suffix + $newpath =~ s|\.$user\.tmp$||; # delete suffix } #$self->addgoodmessage("Original file path is $newpath"); #FIXME debug } else { @@ -841,48 +874,51 @@ sub determineOriginalEditFilePath { } sub getTempEditFileDirectory { - my $self = shift; - my $courseDirectory = $self->r->ce->{courseDirs}; - my $templatesDirectory = $courseDirectory->{templates}; - my $tmpEditFileDirectory = (defined ($courseDirectory->{tmpEditFileDir}) ) ? $courseDirectory->{tmpEditFileDir} : "$templatesDirectory/tmpEdit"; + my $self = shift; + my $courseDirectory = $self->r->ce->{courseDirs}; + my $templatesDirectory = $courseDirectory->{templates}; + my $tmpEditFileDirectory = + (defined($courseDirectory->{tmpEditFileDir})) + ? $courseDirectory->{tmpEditFileDir} + : "$templatesDirectory/tmpEdit"; $tmpEditFileDirectory; } -sub isTempEditFilePath { - my $self = shift; - my $path = shift; - my $templatesDirectory = $self->r->ce->{courseDirs} ->{templates}; +sub isTempEditFilePath { + my $self = shift; + my $path = shift; + my $templatesDirectory = $self->r->ce->{courseDirs}->{templates}; # unless path is absolute assume that it is relative to the template directory - unless ($path =~ m|^/| ) { + unless ($path =~ m|^/|) { $path = "$templatesDirectory/$path"; } my $tmpEditFileDirectory = $self->getTempEditFileDirectory(); - ($path =~/^$tmpEditFileDirectory/) ? 1: 0; + ($path =~ /^$tmpEditFileDirectory/) ? 1 : 0; } sub getFilePaths { my ($self, $setName, $problemNumber, $file_type) = @_; - my $r = $self->r; - my $ce = $r->ce; - my $db = $r->db; - my $urlpath = $r->urlpath; - my $courseName = $urlpath->arg("courseID"); - my $user = $r->param('user'); + my $r = $self->r; + my $ce = $r->ce; + my $db = $r->db; + my $urlpath = $r->urlpath; + my $courseName = $urlpath->arg("courseID"); + my $user = $r->param('user'); my $effectiveUserName = $r->param('effectiveUser'); - $setName = '' unless defined $setName; + $setName = '' unless defined $setName; $problemNumber = '' unless defined $problemNumber; # parse possibly versioned set names - my $fullSetName = $setName; + my $fullSetName = $setName; my $editSetVersion = 0; - if ( $setName =~ /,v(\d)+$/ ) { + if ($setName =~ /,v(\d)+$/) { $editSetVersion = $1; $setName =~ s/,v\d+$//; } - die 'Internal error to PGProblemEditor -- file type is not defined' unless defined $file_type; + die 'Internal error to PGProblemEditor -- file type is not defined' unless defined $file_type; #$self->addgoodmessage("file type is $file_type"); #FIXME remove ########################################################## # Determine path to the input file to be edited. @@ -911,25 +947,29 @@ sub getFilePaths { # Determine path to regular file, place it in $editFilePath # problemSeed is defined for the file_type = 'problem' and 'source_path_to_problem' ########################################################################## - CASE: +CASE: { ($file_type eq 'course_info') and do { # we are editing the course_info file # value of courseFiles::course_info is relative to templates directory - $editFilePath .= '/' . $ce->{courseFiles}->{course_info}; + $editFilePath .= '/' . $ce->{courseFiles}->{course_info}; last CASE; }; ($file_type eq 'options_info') and do { # we are editing the options_info file # value of courseFiles::options_info is relative to templates directory - $editFilePath .= '/' . $ce->{courseFiles}->{options_info}; + $editFilePath .= '/' . $ce->{courseFiles}->{options_info}; last CASE; }; ($file_type eq 'blank_problem') and do { $editFilePath = $ce->{webworkFiles}->{screenSnippets}->{blankProblem}; - $self->addbadmessage($r->maketext("This is a blank problem template file and can not be edited directly. Use the 'NewVersion' action below to create a local copy of the file and add it to the current problem set.")); + $self->addbadmessage( + $r->maketext( + "This is a blank problem template file and can not be edited directly. Use the 'NewVersion' action below to create a local copy of the file and add it to the current problem set." + ) + ); last CASE; }; @@ -945,8 +985,8 @@ sub getFilePaths { my $header_file = ""; $header_file = $set_record->{$file_type}; if ($header_file && $header_file ne "" && $header_file ne "defaultHeader") { - if ( $header_file =~ m|^/| ) { # if absolute address - $editFilePath = $header_file; + if ($header_file =~ m|^/|) { # if absolute address + $editFilePath = $header_file; } else { $editFilePath .= '/' . $header_file; } @@ -954,16 +994,18 @@ sub getFilePaths { # if the set record doesn't specify the filename for a header # then the set uses the default from snippets $editFilePath = $ce->{webworkFiles}->{screenSnippets}->{setHeader} if $file_type eq 'set_header'; - $editFilePath = $ce->{webworkFiles}->{hardcopySnippets}->{setHeader} if $file_type eq 'hardcopy_header'; + $editFilePath = $ce->{webworkFiles}->{hardcopySnippets}->{setHeader} + if $file_type eq 'hardcopy_header'; } last CASE; - }; #end 'set_header, hardcopy_header' case + }; #end 'set_header, hardcopy_header' case ($file_type eq 'problem') and do { # first try getting the merged problem for the effective user my $problem_record; - if ( $editSetVersion ) { - $problem_record = $db->getMergedProblemVersion($effectiveUserName, $setName, $editSetVersion, $problemNumber); + if ($editSetVersion) { + $problem_record = + $db->getMergedProblemVersion($effectiveUserName, $setName, $editSetVersion, $problemNumber); } else { $problem_record = $db->getMergedProblem($effectiveUserName, $setName, $problemNumber); } @@ -971,28 +1013,32 @@ sub getFilePaths { # if that doesn't work (the problem is not yet assigned), get the global record $problem_record = $db->getGlobalProblem($setName, $problemNumber) unless defined($problem_record); # bail if no source path for the problem is found ; - die "Cannot find a problem record for set $setName / problem $problemNumber" unless defined($problem_record); + die "Cannot find a problem record for set $setName / problem $problemNumber" + unless defined($problem_record); $editFilePath .= '/' . $problem_record->source_file; # define the problem seed for later use - $self->{problemSeed}= $problem_record->problem_seed if defined($problem_record) and $problem_record->can('problem_seed') ; + $self->{problemSeed} = $problem_record->problem_seed + if defined($problem_record) + and $problem_record->can('problem_seed'); last CASE; - }; # end 'problem' case + }; # end 'problem' case ($file_type eq 'source_path_for_problem_file') and do { my $forcedSourceFile = $self->{sourceFilePath}; # if the source file is in the temporary edit directory find the original source file # the source file is relative to the templates directory. - if ($self->isTempEditFilePath($forcedSourceFile) ) { - $forcedSourceFile = $self->determineOriginalEditFilePath($forcedSourceFile); # original file path - $self->addgoodmessage($r->maketext("the original path to the file is [_1]",$forcedSourceFile)); #FIXME debug + if ($self->isTempEditFilePath($forcedSourceFile)) { + $forcedSourceFile = $self->determineOriginalEditFilePath($forcedSourceFile); # original file path + $self->addgoodmessage($r->maketext("the original path to the file is [_1]", $forcedSourceFile)) + ; #FIXME debug } # bail if no source path for the problem is found ; - die "Cannot find a file path to save to" unless( not_blank($forcedSourceFile) ); + die "Cannot find a file path to save to" unless (not_blank($forcedSourceFile)); $self->{problemSeed} = DEFAULT_SEED(); $editFilePath .= '/' . $forcedSourceFile; last CASE; - }; # end 'source_path_for_problem_file' case - } # end CASE: statement + }; # end 'source_path_for_problem_file' case + } # end CASE: statement if (-d $editFilePath) { my $msg = $r->maketext("The file '[_1]' is a directory!", $self->shortPath($editFilePath)); @@ -1011,10 +1057,10 @@ sub getFilePaths { # Whew!!! ################################################# - my $tempFilePath = $self->determineTempEditFilePath($editFilePath); #"$editFilePath.$TEMPFILESUFFIX"; - $self->{editFilePath} = $editFilePath; - $self->{tempFilePath} = $tempFilePath; - $self->{inputFilePath} = (-r $tempFilePath) ? $tempFilePath : $editFilePath; + my $tempFilePath = $self->determineTempEditFilePath($editFilePath); #"$editFilePath.$TEMPFILESUFFIX"; + $self->{editFilePath} = $editFilePath; + $self->{tempFilePath} = $tempFilePath; + $self->{inputFilePath} = (-r $tempFilePath) ? $tempFilePath : $editFilePath; #warn "editfile path is $editFilePath and tempFile is $tempFilePath and inputFilePath is ". $self->{inputFilePath}; } @@ -1027,19 +1073,19 @@ sub getFilePaths { # sometimes less. ################################################################################ sub saveFileChanges { - my ($self, $outputFilePath, $problemContents ) = @_; - my $r = $self->r; - my $ce = $r->ce; + my ($self, $outputFilePath, $problemContents) = @_; + my $r = $self->r; + my $ce = $r->ce; - my $action = $self->{action}||'no action'; + my $action = $self->{action} || 'no action'; # my $editFilePath = $self->{editFilePath}; # not used?? - my $sourceFilePath = $self->{sourceFilePath}; - my $tempFilePath = $self->{tempFilePath}; + my $sourceFilePath = $self->{sourceFilePath}; + my $tempFilePath = $self->{tempFilePath}; - if (defined($problemContents) and ref($problemContents) ) { + if (defined($problemContents) and ref($problemContents)) { $problemContents = ${$problemContents}; - } elsif( ! not_blank($problemContents) ) { # if the problemContents is undefined or empty - $problemContents = ${$self->{r_problemContents}}; + } elsif (!not_blank($problemContents)) { # if the problemContents is undefined or empty + $problemContents = ${ $self->{r_problemContents} }; } ############################################################################## # read and update the targetFile and targetFile.tmp files in the directory @@ -1047,12 +1093,12 @@ sub saveFileChanges { # The .tmp files are removed when the file is or when the revert occurs. ############################################################################## - unless (not_blank($outputFilePath) ) { + unless (not_blank($outputFilePath)) { $self->addbadmessage($r->maketext("You must specify an file name in order to save a new file.")); return ""; } - my $do_not_save = 0 ; # flag to prevent saving of file - my $editErrors = ''; + my $do_not_save = 0; # flag to prevent saving of file + my $editErrors = ''; ############################################################################## # write changes to the approriate files @@ -1061,20 +1107,21 @@ sub saveFileChanges { ############################################################################## my $writeFileErrors; - if ( not_blank($outputFilePath) ) { # save file - # Handle the problem of line endings. - # Make sure that all of the line endings are of unix type. - # Convert \r\n to \n - #$problemContents =~ s/\r\n/\n/g; - #$problemContents =~ s/\r/\n/g; + if (not_blank($outputFilePath)) { # save file + # Handle the problem of line endings. + # Make sure that all of the line endings are of unix type. + # Convert \r\n to \n + #$problemContents =~ s/\r\n/\n/g; + #$problemContents =~ s/\r/\n/g; # make sure any missing directories are created WeBWorK::Utils::surePathToFile($ce->{courseDirs}->{templates}, $outputFilePath); - die "outputFilePath is unsafe!" unless path_is_subdir($outputFilePath, $ce->{courseDirs}->{templates}, 1); # 1==path can be relative to dir + die "outputFilePath is unsafe!" + unless path_is_subdir($outputFilePath, $ce->{courseDirs}->{templates}, 1); # 1==path can be relative to dir eval { local *OUTPUTFILE; - open OUTPUTFILE, ">:encoding(UTF-8)", $outputFilePath + open OUTPUTFILE, ">:encoding(UTF-8)", $outputFilePath or die "Failed to open $outputFilePath"; print OUTPUTFILE $problemContents; close OUTPUTFILE; @@ -1099,14 +1146,21 @@ sub saveFileChanges { my $errorMessage; # check why we failed to give better error messages - if ( not -w $ce->{courseDirs}->{templates} ) { - $errorMessage = "Write permissions have not been enabled in the templates directory. No changes can be made."; - } elsif ( not -w $currentDirectory ) { - $errorMessage = "Write permissions have not been enabled in '".$self->shortPath($currentDirectory)."'. Changes must be saved to a different directory for viewing."; - } elsif ( -e $outputFilePath and not -w $outputFilePath ) { - $errorMessage = "Write permissions have not been enabled for '".$self->shortPath($outputFilePath)."'. Changes must be saved to another file for viewing."; + if (not -w $ce->{courseDirs}->{templates}) { + $errorMessage = + "Write permissions have not been enabled in the templates directory. No changes can be made."; + } elsif (not -w $currentDirectory) { + $errorMessage = + "Write permissions have not been enabled in '" + . $self->shortPath($currentDirectory) + . "'. Changes must be saved to a different directory for viewing."; + } elsif (-e $outputFilePath and not -w $outputFilePath) { + $errorMessage = + "Write permissions have not been enabled for '" + . $self->shortPath($outputFilePath) + . "'. Changes must be saved to another file for viewing."; } else { - $errorMessage = "Unable to write to '".$self->shortPath($outputFilePath)."': $writeFileErrors"; + $errorMessage = "Unable to write to '" . $self->shortPath($outputFilePath) . "': $writeFileErrors"; } $self->{failure} = 1; @@ -1124,8 +1178,8 @@ sub saveFileChanges { # my $auxiliaryFilesExist = has_aux_files($outputFilePath); - if ($auxiliaryFilesExist and not $do_not_save ) { - my $sourceDirectory = $sourceFilePath || '' ; + if ($auxiliaryFilesExist and not $do_not_save) { + my $sourceDirectory = $sourceFilePath || ''; my $outputDirectory = $outputFilePath || ''; $sourceDirectory =~ s|/[^/]+\.pg$||; $outputDirectory =~ s|/[^/]+\.pg$||; @@ -1135,45 +1189,51 @@ sub saveFileChanges { my @filesToCopy; @filesToCopy = WeBWorK::Utils::readDirectory($sourceDirectory) if -d $sourceDirectory; foreach my $file (@filesToCopy) { - next if $file =~ /\.pg$/; # .pg file should already be transferred + next if $file =~ /\.pg$/; # .pg file should already be transferred my $fromPath = "$sourceDirectory/$file"; my $toPath = "$outputDirectory/$file"; - if (-f $fromPath and -r $fromPath and not -e $toPath) { # don't copy directories, don't copy files that have already been copied - copy($fromPath, $toPath) or $writeFileErrors.= "
      Error copying $fromPath to $toPath"; + if (-f $fromPath and -r $fromPath and not -e $toPath) + { # don't copy directories, don't copy files that have already been copied + copy($fromPath, $toPath) or $writeFileErrors .= "
      Error copying $fromPath to $toPath"; # need to use binary transfer for gif files. File::Copy does this. #warn "copied from $fromPath to $toPath"; #warn "files are different ",system("diff $fromPath $toPath"); } $self->addbadmessage($writeFileErrors) if not_blank($writeFileErrors); } - $self->addgoodmessage($r->maketext("Copied auxiliary files from [_1] to new location at [_2]", $sourceDirectory, $outputDirectory)); + $self->addgoodmessage($r->maketext( + "Copied auxiliary files from [_1] to new location at [_2]", + $sourceDirectory, $outputDirectory + )); } ########################################################### # clean up temp files on revert, save and save_as ########################################################### - unless( $writeFileErrors or $do_not_save) { # everything worked! unlink and announce success! - # unlink the temporary file if there are no errors and the save button has been pushed - if (($action eq 'save' or $action eq 'save_as') and (-w $self->{tempFilePath}) ) { + unless ($writeFileErrors or $do_not_save) { # everything worked! unlink and announce success! + # unlink the temporary file if there are no errors and the save button has been pushed + if (($action eq 'save' or $action eq 'save_as') and (-w $self->{tempFilePath})) { $self->addgoodmessage($r->maketext("Deleting temp file at [_1]", $self->shortPath($self->{tempFilePath}))); - die "tempFilePath is unsafe!" unless path_is_subdir($self->{tempFilePath}, $ce->{courseDirs}->{templates}, 1); # 1==path can be relative to dir - unlink($self->{tempFilePath}) ; + die "tempFilePath is unsafe!" + unless path_is_subdir($self->{tempFilePath}, $ce->{courseDirs}->{templates}, 1) + ; # 1==path can be relative to dir + unlink($self->{tempFilePath}); } - if ( defined($outputFilePath) and ! $self->{failure} and not $self->isTempEditFilePath($outputFilePath) ) { + if (defined($outputFilePath) and !$self->{failure} and not $self->isTempEditFilePath($outputFilePath)) { # don't announce saving of temporary editing files my $msg = $r->maketext("Saved to file '[_1]'", $self->shortPath($outputFilePath)); $self->addgoodmessage($msg); #$self->{inputFilePath} = $outputFilePath; ## DPVC -- avoid file-not-found message } } -} # end saveFileChanges +} # end saveFileChanges sub getActionParams { my ($self, $actionID) = @_; my $r = $self->{r}; - my %actionParams=(); + my %actionParams = (); foreach my $param ($r->param) { next unless $param =~ m/^action\.$actionID\./; $actionParams{$param} = [ $r->param($param) ]; @@ -1272,26 +1332,27 @@ sub view_form { sub view_handler { my ($self, $genericParams, $actionParams, $tableParams) = @_; - my $r = $self->r; - my $courseName = $self->{courseID}; - my $setName = $self->{setID}; - my $fullSetName = $self->{fullSetID}; - my $problemNumber = $self->{problemID}; - my $problemSeed = ($actionParams->{'action.view.seed'}) ? $actionParams->{'action.view.seed'}->[0] : DEFAULT_SEED(); - my $displayMode = ($actionParams->{'action.view.displayMode'}) + my $r = $self->r; + my $courseName = $self->{courseID}; + my $setName = $self->{setID}; + my $fullSetName = $self->{fullSetID}; + my $problemNumber = $self->{problemID}; + my $problemSeed = ($actionParams->{'action.view.seed'}) ? $actionParams->{'action.view.seed'}->[0] : DEFAULT_SEED(); + my $displayMode = + ($actionParams->{'action.view.displayMode'}) ? $actionParams->{'action.view.displayMode'}->[0] : $self->r->ce->{pg}->{options}->{displayMode}; - my $editFilePath = $self->{editFilePath}; - my $tempFilePath = $self->{tempFilePath}; + my $editFilePath = $self->{editFilePath}; + my $tempFilePath = $self->{tempFilePath}; ######################################################## # grab the problemContents from the form in order to save it to the tmp file ######################################################## - my $problemContents = fixProblemContents($self->r->param('problemContents')); - $self->{r_problemContents} = \$problemContents; + my $problemContents = fixProblemContents($self->r->param('problemContents')); + $self->{r_problemContents} = \$problemContents; my $do_not_save = 0; - my $file_type = $self->{file_type}; + my $file_type = $self->{file_type}; $self->saveFileChanges($tempFilePath,); ######################################################## @@ -1324,70 +1385,80 @@ sub view_handler { ); } - $viewURL = $self->systemLink($problemPage, + $viewURL = $self->systemLink( + $problemPage, params => { - displayMode => $displayMode, - problemSeed => $problemSeed, - editMode => "temporaryFile", - edit_level => $edit_level, - sourceFilePath => $relativeTempFilePath, - status_message => uri_escape_utf8($self->{status_message}) + displayMode => $displayMode, + problemSeed => $problemSeed, + editMode => "temporaryFile", + edit_level => $edit_level, + sourceFilePath => $relativeTempFilePath, + status_message => uri_escape_utf8($self->{status_message}) } ); - } elsif ($file_type eq 'set_header' ) { # redirect to ProblemSet - my $problemPage = $self->r->urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSet",$r, - courseID => $courseName, setID => $setName, + } elsif ($file_type eq 'set_header') { # redirect to ProblemSet + my $problemPage = $self->r->urlpath->newFromModule( + "WeBWorK::ContentGenerator::ProblemSet", $r, + courseID => $courseName, + setID => $setName, ); - $viewURL = $self->systemLink($problemPage, + $viewURL = $self->systemLink( + $problemPage, params => { - set_header => $tempFilePath, - displayMode => $displayMode, - problemSeed => $problemSeed, - editMode => "temporaryFile", - edit_level => $edit_level, - sourceFilePath => $relativeTempFilePath, - status_message => uri_escape_utf8($self->{status_message}) + set_header => $tempFilePath, + displayMode => $displayMode, + problemSeed => $problemSeed, + editMode => "temporaryFile", + edit_level => $edit_level, + sourceFilePath => $relativeTempFilePath, + status_message => uri_escape_utf8($self->{status_message}) } ); - } elsif ($file_type eq 'hardcopy_header') { # redirect to ProblemSet?? # it's difficult to view temporary changes for hardcopy headers - my $problemPage = $self->r->urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSet",$r, - courseID => $courseName, setID => $setName, + } elsif ($file_type eq 'hardcopy_header') + { # redirect to ProblemSet?? # it's difficult to view temporary changes for hardcopy headers + my $problemPage = $self->r->urlpath->newFromModule( + "WeBWorK::ContentGenerator::ProblemSet", $r, + courseID => $courseName, + setID => $setName, ); - $viewURL = $self->systemLink($problemPage, + $viewURL = $self->systemLink( + $problemPage, params => { - set_header => $tempFilePath, - displayMode => $displayMode, - problemSeed => $problemSeed, - editMode => "temporaryFile", - edit_level => $edit_level, - sourceFilePath => $relativeTempFilePath, - status_message => uri_escape_utf8($self->{status_message}) + set_header => $tempFilePath, + displayMode => $displayMode, + problemSeed => $problemSeed, + editMode => "temporaryFile", + edit_level => $edit_level, + sourceFilePath => $relativeTempFilePath, + status_message => uri_escape_utf8($self->{status_message}) } ); - } elsif ($file_type eq 'course_info') { # redirec to ProblemSets.pm - my $problemSetsPage = $self->r->urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets",$r, - courseID => $courseName); - $viewURL = $self->systemLink($problemSetsPage, + } elsif ($file_type eq 'course_info') { # redirec to ProblemSets.pm + my $problemSetsPage = + $self->r->urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets", $r, courseID => $courseName); + $viewURL = $self->systemLink( + $problemSetsPage, params => { - course_info => $tempFilePath, - editMode => "temporaryFile", - edit_level => $edit_level, - sourceFilePath => $relativeTempFilePath, - status_message => uri_escape_utf8($self->{status_message}) + course_info => $tempFilePath, + editMode => "temporaryFile", + edit_level => $edit_level, + sourceFilePath => $relativeTempFilePath, + status_message => uri_escape_utf8($self->{status_message}) } ); - } elsif ($file_type eq 'options_info') { # redirec to Options.pm - my $optionsPage = $self->r->urlpath->newFromModule("WeBWorK::ContentGenerator::Options",$r, - courseID => $courseName); - $viewURL = $self->systemLink($optionsPage, + } elsif ($file_type eq 'options_info') { # redirec to Options.pm + my $optionsPage = + $self->r->urlpath->newFromModule("WeBWorK::ContentGenerator::Options", $r, courseID => $courseName); + $viewURL = $self->systemLink( + $optionsPage, params => { - options_info => $tempFilePath, - editMode => "temporaryFile", - edit_level => $edit_level, - sourceFilePath => $relativeTempFilePath, - status_message => uri_escape_utf8($self->{status_message}) + options_info => $tempFilePath, + editMode => "temporaryFile", + edit_level => $edit_level, + sourceFilePath => $relativeTempFilePath, + status_message => uri_escape_utf8($self->{status_message}) } ); } else { @@ -1463,25 +1534,25 @@ sub add_problem_form { sub add_problem_handler { my ($self, $genericParams, $actionParams, $tableParams) = @_; - my $r= $self->r; + my $r = $self->r; my $db = $r->db; #$self->addgoodmessage("add_problem_handler called"); - my $courseName = $self->{courseID}; - my $setName = $self->{setID}; - my $problemNumber = $self->{problemID}; - my $sourceFilePath = $self->{editFilePath}; - my $displayMode = $self->{displayMode}; - my $problemSeed = $self->{problemSeed}; - - my $targetSetName = $actionParams->{'action.add_problem.target_set'}->[0]; - my $targetFileType = $actionParams->{'action.add_problem.file_type'}->[0]; - my $templatesPath = $self->r->ce->{courseDirs}->{templates}; - $sourceFilePath =~ s|^$templatesPath/||; + my $courseName = $self->{courseID}; + my $setName = $self->{setID}; + my $problemNumber = $self->{problemID}; + my $sourceFilePath = $self->{editFilePath}; + my $displayMode = $self->{displayMode}; + my $problemSeed = $self->{problemSeed}; + + my $targetSetName = $actionParams->{'action.add_problem.target_set'}->[0]; + my $targetFileType = $actionParams->{'action.add_problem.file_type'}->[0]; + my $templatesPath = $self->r->ce->{courseDirs}->{templates}; + $sourceFilePath =~ s|^$templatesPath/||; my $edit_level = $self->r->param("edit_level") || 0; $edit_level++; - my $viewURL =''; + my $viewURL = ''; if ($targetFileType eq 'problem') { my $targetProblemNumber; @@ -1493,93 +1564,121 @@ sub add_problem_handler { my @problemIDs = $db->listGlobalProblems($targetSetName); @problemIDs = sort { $a <=> $b } @problemIDs; my @seq = jitar_id_to_seq($problemIDs[$#problemIDs]); - $targetProblemNumber = seq_to_jitar_id($seq[0]+1); + $targetProblemNumber = seq_to_jitar_id($seq[0] + 1); } else { - $targetProblemNumber = 1+ WeBWorK::Utils::max( $db->listGlobalProblems($targetSetName)); + $targetProblemNumber = 1 + WeBWorK::Utils::max($db->listGlobalProblems($targetSetName)); } ################################################# # Update problem record ################################################# - my $problemRecord = $self->addProblemToSet( - setName => $targetSetName, - sourceFile => $sourceFilePath, - problemID => $targetProblemNumber, #added to end of set + my $problemRecord = $self->addProblemToSet( + setName => $targetSetName, + sourceFile => $sourceFilePath, + problemID => $targetProblemNumber, #added to end of set ); $self->assignProblemToAllSetUsers($problemRecord); - $self->addgoodmessage($r->maketext("Added [_1] to [_2] as problem [_3]", $sourceFilePath, $targetSetName,($set->assignment_type eq 'jitar' ? join('.',jitar_id_to_seq($targetProblemNumber)) : $targetProblemNumber))); - $self->{file_type} = 'problem'; # change file type to problem -- if it's not already that + $self->addgoodmessage($r->maketext( + "Added [_1] to [_2] as problem [_3]", + $sourceFilePath, + $targetSetName, + ( + $set->assignment_type eq 'jitar' + ? join('.', jitar_id_to_seq($targetProblemNumber)) + : $targetProblemNumber + ) + )); + $self->{file_type} = 'problem'; # change file type to problem -- if it's not already that ################################################# # Set up redirect to problem editor page. ################################################# - my $problemPage = $self->r->urlpath->newFromModule("WeBWorK::ContentGenerator::Instructor::PGProblemEditor",$r, + my $problemPage = $self->r->urlpath->newFromModule( + "WeBWorK::ContentGenerator::Instructor::PGProblemEditor", $r, courseID => $courseName, setID => $targetSetName, problemID => $targetProblemNumber, ); my $relativeSourceFilePath = $self->getRelativeSourceFilePath($sourceFilePath); - $viewURL = $self->systemLink($problemPage, + $viewURL = $self->systemLink( + $problemPage, params => { - displayMode => $displayMode, - problemSeed => $problemSeed, - editMode => "savedFile", - edit_level => $edit_level, - sourceFilePath => $relativeSourceFilePath, - status_message => uri_escape_utf8($self->{status_message}), - file_type => 'problem', + displayMode => $displayMode, + problemSeed => $problemSeed, + editMode => "savedFile", + edit_level => $edit_level, + sourceFilePath => $relativeSourceFilePath, + status_message => uri_escape_utf8($self->{status_message}), + file_type => 'problem', } ); - } elsif ($targetFileType eq 'set_header') { + } elsif ($targetFileType eq 'set_header') { ################################################# # Update set record ################################################# - my $setRecord = $self->r->db->getGlobalSet($targetSetName); + my $setRecord = $self->r->db->getGlobalSet($targetSetName); $setRecord->set_header($sourceFilePath); - if( $self->r->db->putGlobalSet($setRecord) ) { - $self->addgoodmessage($r->maketext("Added '[_1]' to [_2] as new set header", $self->shortPath($sourceFilePath), $targetSetName)) ; + if ($self->r->db->putGlobalSet($setRecord)) { + $self->addgoodmessage($r->maketext( + "Added '[_1]' to [_2] as new set header", + $self->shortPath($sourceFilePath), + $targetSetName + )); } else { - $self->addbadmessage("Unable to make '".$self->shortPath($sourceFilePath)."' the set header for $targetSetName"); + $self->addbadmessage( + "Unable to make '" . $self->shortPath($sourceFilePath) . "' the set header for $targetSetName"); } - $self->{file_type} = 'set_header'; # change file type to set_header if it not already so + $self->{file_type} = 'set_header'; # change file type to set_header if it not already so ################################################# # Set up redirect ################################################# - my $problemPage = $self->r->urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSet",$r, - courseID => $courseName, setID => $targetSetName + my $problemPage = $self->r->urlpath->newFromModule( + "WeBWorK::ContentGenerator::ProblemSet", $r, + courseID => $courseName, + setID => $targetSetName ); - $viewURL = $self->systemLink($problemPage, + $viewURL = $self->systemLink( + $problemPage, params => { - displayMode => $displayMode, - editMode => "savedFile", - edit_level => $edit_level, - status_message => uri_escape_utf8($self->{status_message}), + displayMode => $displayMode, + editMode => "savedFile", + edit_level => $edit_level, + status_message => uri_escape_utf8($self->{status_message}), } ); - } elsif ($targetFileType eq 'hardcopy_header') { + } elsif ($targetFileType eq 'hardcopy_header') { ################################################# # Update set record ################################################# - my $setRecord = $self->r->db->getGlobalSet($targetSetName); + my $setRecord = $self->r->db->getGlobalSet($targetSetName); $setRecord->hardcopy_header($sourceFilePath); - if( $self->r->db->putGlobalSet($setRecord) ) { - $self->addgoodmessage($r->maketext("Added '[_1]' to [_2] as new hardcopy header", $self->shortPath($sourceFilePath), $targetSetName)) ; + if ($self->r->db->putGlobalSet($setRecord)) { + $self->addgoodmessage($r->maketext( + "Added '[_1]' to [_2] as new hardcopy header", + $self->shortPath($sourceFilePath), + $targetSetName + )); } else { - $self->addbadmessage("Unable to make '".$self->shortPath($sourceFilePath)."' the hardcopy header for $targetSetName"); + $self->addbadmessage("Unable to make '" + . $self->shortPath($sourceFilePath) + . "' the hardcopy header for $targetSetName"); } - $self->{file_type} = 'hardcopy_header'; # change file type to set_header if it not already so + $self->{file_type} = 'hardcopy_header'; # change file type to set_header if it not already so ################################################# # Set up redirect ################################################# - my $problemPage = $self->r->urlpath->newFromModule("WeBWorK::ContentGenerator::Hardcopy",$r, - courseID => $courseName, setID => $targetSetName + my $problemPage = $self->r->urlpath->newFromModule( + "WeBWorK::ContentGenerator::Hardcopy", $r, + courseID => $courseName, + setID => $targetSetName ); - $viewURL = $self->systemLink($problemPage, + $viewURL = $self->systemLink( + $problemPage, params => { - displayMode => $displayMode, - editMode => "savedFile", - edit_level => $edit_level, - status_message => uri_escape_utf8($self->{status_message}), + displayMode => $displayMode, + editMode => "savedFile", + edit_level => $edit_level, + status_message => uri_escape_utf8($self->{status_message}), } ); } else { @@ -1626,14 +1725,14 @@ sub save_form { sub save_handler { my ($self, $genericParams, $actionParams, $tableParams) = @_; - my $r= $self->r; + my $r = $self->r; #$self->addgoodmessage("save_handler called"); - my $courseName = $self->{courseID}; - my $setName = $self->{setID}; - my $fullSetName = $self->{fullSetID}; - my $problemNumber = $self->{problemID}; - my $displayMode = $self->{displayMode}; - my $problemSeed = $self->{problemSeed}; + my $courseName = $self->{courseID}; + my $setName = $self->{setID}; + my $fullSetName = $self->{fullSetID}; + my $problemNumber = $self->{problemID}; + my $displayMode = $self->{displayMode}; + my $problemSeed = $self->{problemSeed}; ################################################# # grab the problemContents from the form in order to save it to a new permanent file @@ -1645,11 +1744,11 @@ sub save_handler { ################################################# # Construct the output file path ################################################# - my $editFilePath = $self->{editFilePath}; - my $outputFilePath = $editFilePath; + my $editFilePath = $self->{editFilePath}; + my $outputFilePath = $editFilePath; my $do_not_save = 0; - my $file_type = $self->{file_type}; + my $file_type = $self->{file_type}; $self->saveFileChanges($outputFilePath); ################################################# # Set up redirect to Problem.pm @@ -1658,91 +1757,112 @@ sub save_handler { ######################################################## # construct redirect URL and redirect ######################################################## - if ($file_type eq 'problem' || $file_type eq 'source_path_for_problem_file') { # redirect to Problem.pm - # we need to know if the set is a gateway set to determine the redirect - my $globalSet = $self->r->db->getGlobalSet( $setName ); + if ($file_type eq 'problem' || $file_type eq 'source_path_for_problem_file') { # redirect to Problem.pm + # we need to know if the set is a gateway set to determine the redirect + my $globalSet = $self->r->db->getGlobalSet($setName); my $problemPage; - if ( defined( $globalSet) && $globalSet->assignment_type =~ /gateway/ ) { - $problemPage = $self->r->urlpath->newFromModule("WeBWorK::ContentGenerator::GatewayQuiz",$r, - courseID => $courseName, setID => "Undefined_Set"); + if (defined($globalSet) && $globalSet->assignment_type =~ /gateway/) { + $problemPage = $self->r->urlpath->newFromModule( + "WeBWorK::ContentGenerator::GatewayQuiz", $r, + courseID => $courseName, + setID => "Undefined_Set" + ); # courseID => $courseName, setID => $fullSetName); } else { - $problemPage = $self->r->urlpath->newFromModule("WeBWorK::ContentGenerator::Problem",$r, - courseID => $courseName, setID => $setName, problemID => $problemNumber); + $problemPage = $self->r->urlpath->newFromModule( + "WeBWorK::ContentGenerator::Problem", $r, + courseID => $courseName, + setID => $setName, + problemID => $problemNumber + ); } my $relativeEditFilePath = $self->getRelativeSourceFilePath($editFilePath); - $viewURL = $self->systemLink($problemPage, + $viewURL = $self->systemLink( + $problemPage, params => { - displayMode => $displayMode, - problemSeed => $problemSeed, - editMode => "savedFile", - edit_level => 0, - sourceFilePath => $relativeEditFilePath, - status_message => uri_escape_utf8($self->{status_message}) + displayMode => $displayMode, + problemSeed => $problemSeed, + editMode => "savedFile", + edit_level => 0, + sourceFilePath => $relativeEditFilePath, + status_message => uri_escape_utf8($self->{status_message}) } ); - } elsif ($file_type eq 'set_header' ) { # redirect to ProblemSet - my $problemPage = $self->r->urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSet",$r, - courseID => $courseName, setID => $setName, + } elsif ($file_type eq 'set_header') { # redirect to ProblemSet + my $problemPage = $self->r->urlpath->newFromModule( + "WeBWorK::ContentGenerator::ProblemSet", $r, + courseID => $courseName, + setID => $setName, ); - $viewURL = $self->systemLink($problemPage, + $viewURL = $self->systemLink( + $problemPage, params => { - displayMode => $displayMode, - problemSeed => $problemSeed, - editMode => "savedFile", - edit_level => 0, - status_message => uri_escape_utf8($self->{status_message}) + displayMode => $displayMode, + problemSeed => $problemSeed, + editMode => "savedFile", + edit_level => 0, + status_message => uri_escape_utf8($self->{status_message}) } ); - } elsif ( $file_type eq 'hardcopy_header') { # redirect to ProblemSet - my $problemPage = $self->r->urlpath->newFromModule('WeBWorK::ContentGenerator::Hardcopy',$r, - courseID => $courseName, setID => $setName, + } elsif ($file_type eq 'hardcopy_header') { # redirect to ProblemSet + my $problemPage = $self->r->urlpath->newFromModule( + 'WeBWorK::ContentGenerator::Hardcopy', $r, + courseID => $courseName, + setID => $setName, ); - $viewURL = $self->systemLink($problemPage, + $viewURL = $self->systemLink( + $problemPage, params => { - displayMode => $displayMode, - problemSeed => $problemSeed, - editMode => "savedFile", - edit_level => 0, - status_message => uri_escape_utf8($self->{status_message}) + displayMode => $displayMode, + problemSeed => $problemSeed, + editMode => "savedFile", + edit_level => 0, + status_message => uri_escape_utf8($self->{status_message}) } ); - } elsif ($file_type eq 'course_info') { # redirect to ProblemSets.pm - my $problemSetsPage = $self->r->urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets",$r, - courseID => $courseName); - $viewURL = $self->systemLink($problemSetsPage, + } elsif ($file_type eq 'course_info') { # redirect to ProblemSets.pm + my $problemSetsPage = + $self->r->urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets", $r, courseID => $courseName); + $viewURL = $self->systemLink( + $problemSetsPage, params => { - editMode => ("savedFile"), - edit_level => 0, - status_message => uri_escape_utf8($self->{status_message}) + editMode => ("savedFile"), + edit_level => 0, + status_message => uri_escape_utf8($self->{status_message}) } ); - } elsif ($file_type eq 'options_info') { # redirect to Options.pm - my $optionsPage = $self->r->urlpath->newFromModule("WeBWorK::ContentGenerator::Options",$r, - courseID => $courseName); - $viewURL = $self->systemLink($optionsPage, + } elsif ($file_type eq 'options_info') { # redirect to Options.pm + my $optionsPage = + $self->r->urlpath->newFromModule("WeBWorK::ContentGenerator::Options", $r, courseID => $courseName); + $viewURL = $self->systemLink( + $optionsPage, params => { - editMode => ("savedFile"), - edit_level => 0, - status_message => uri_escape_utf8($self->{status_message}) + editMode => ("savedFile"), + edit_level => 0, + status_message => uri_escape_utf8($self->{status_message}) } ); - } elsif ($file_type eq 'source_path_for_problem_file') { # redirect to ProblemSets.pm - my $problemPage = $self->r->urlpath->newFromModule("WeBWorK::ContentGenerator::Instructor::PGProblemEditor",$r, - courseID => $courseName, setID => $setName, problemID => $problemNumber); - my $viewURL = $self->systemLink($problemPage, - params=>{ - displayMode => $displayMode, - problemSeed => $problemSeed, - editMode => "savedFile", - edit_level => 0, - sourceFilePath => $outputFilePath, #The path relative to the templates directory is required. - file_type => 'source_path_for_problem_file', - status_message => uri_escape_utf8($self->{status_message}) + } elsif ($file_type eq 'source_path_for_problem_file') { # redirect to ProblemSets.pm + my $problemPage = $self->r->urlpath->newFromModule( + "WeBWorK::ContentGenerator::Instructor::PGProblemEditor", $r, + courseID => $courseName, + setID => $setName, + problemID => $problemNumber + ); + my $viewURL = $self->systemLink( + $problemPage, + params => { + displayMode => $displayMode, + problemSeed => $problemSeed, + editMode => "savedFile", + edit_level => 0, + sourceFilePath => $outputFilePath, #The path relative to the templates directory is required. + file_type => 'source_path_for_problem_file', + status_message => uri_escape_utf8($self->{status_message}) } ); } else { @@ -1803,7 +1923,8 @@ sub save_as_form { name => 'action.save_as.target_file', size => 60, value => $shortFilePath, - class => 'form-control form-control-sm', dir => 'ltr' + class => 'form-control form-control-sm', + dir => 'ltr' }) ) ), @@ -1876,25 +1997,26 @@ sub save_as_handler { my ($self, $genericParams, $actionParams, $tableParams) = @_; my $r = $self->r; #$self->addgoodmessage("save_as_handler called"); - $self->{status_message} = ''; ## DPVC -- remove bogus old messages - my $courseName = $self->{courseID}; - my $setName = $self->{setID}; - my $fullSetName = $self->{fullSetID}; - my $problemNumber = $self->{problemID}; - my $displayMode = $self->{displayMode}; - my $problemSeed = $self->{problemSeed}; + $self->{status_message} = ''; ## DPVC -- remove bogus old messages + my $courseName = $self->{courseID}; + my $setName = $self->{setID}; + my $fullSetName = $self->{fullSetID}; + my $problemNumber = $self->{problemID}; + my $displayMode = $self->{displayMode}; + my $problemSeed = $self->{problemSeed}; my $effectiveUserName = $self->r->param('effectiveUser'); - my $do_not_save = 0; - my $saveMode = $actionParams->{'action.save_as.saveMode'}->[0] || 'no_save_mode_selected'; + my $do_not_save = 0; + my $saveMode = $actionParams->{'action.save_as.saveMode'}->[0] || 'no_save_mode_selected'; my $new_file_name = $actionParams->{'action.save_as.target_file'}->[0] || ''; my $sourceFilePath = $actionParams->{'action.save_as.source_file'}->[0] || ''; - my $file_type = $actionParams->{'action.save_as.file_type'}->[0] || ''; - $self ->{sourceFilePath} = $sourceFilePath; # store for use in saveFileChanges - $new_file_name =~ s/^\s*//; #remove initial and final white space + my $file_type = $actionParams->{'action.save_as.file_type'}->[0] || ''; + $self->{sourceFilePath} = $sourceFilePath; # store for use in saveFileChanges + $new_file_name =~ s/^\s*//; #remove initial and final white space $new_file_name =~ s/\s*$//; - if ( $new_file_name !~ /\S/) { # need a non-blank file name - # setting $self->{failure} stops saving and any redirects + + if ($new_file_name !~ /\S/) { # need a non-blank file name + # setting $self->{failure} stops saving and any redirects $do_not_save = 1; $self->addbadmessage(CGI::p($r->maketext("Please specify a file to save to."))); } @@ -1910,11 +2032,12 @@ sub save_as_handler { # Rescue the user in case they forgot to end the file name with .pg ################################################# - if($file_type eq 'problem' - or $file_type eq 'blank_problem' - or $file_type eq 'set_header') { - $new_file_name =~ s/\.pg$//; # remove it if it is there - $new_file_name .= '.pg'; # put it there + if ($file_type eq 'problem' + or $file_type eq 'blank_problem' + or $file_type eq 'set_header') + { + $new_file_name =~ s/\.pg$//; # remove it if it is there + $new_file_name .= '.pg'; # put it there } ################################################# # Construct the output file path @@ -1923,15 +2046,22 @@ sub save_as_handler { if (defined $outputFilePath and -e $outputFilePath) { # setting $do_not_save stops saving and any redirects $do_not_save = 1; - $self->addbadmessage(CGI::p($r->maketext("File '[_1]' exists. File not saved. No changes have been made. You can change the file path for this problem manually from the 'Hmwk Sets Editor' page", $self->shortPath($outputFilePath)))); - $self->addgoodmessage(CGI::p($r->maketext("The text box now contains the source of the original problem. You can recover lost edits by using the Back button on your browser."))); + $self->addbadmessage(CGI::p($r->maketext( + "File '[_1]' exists. File not saved. No changes have been made. You can change the file path for this problem manually from the 'Hmwk Sets Editor' page", + $self->shortPath($outputFilePath) + ))); + $self->addgoodmessage(CGI::p( + $r->maketext( + "The text box now contains the source of the original problem. You can recover lost edits by using the Back button on your browser." + ) + )); } else { - $self->{editFilePath} = $outputFilePath; - $self->{tempFilePath} = ''; # nothing needs to be unlinked. + $self->{editFilePath} = $outputFilePath; + $self->{tempFilePath} = ''; # nothing needs to be unlinked. $self->{inputFilePath} = ''; } - unless ($do_not_save ) { + unless ($do_not_save) { $self->saveFileChanges($outputFilePath); my $targetProblemNumber; @@ -1939,42 +2069,58 @@ sub save_as_handler { ################################################# # Modify source file path in problem ################################################# - if ($file_type eq 'set_header' ) { + if ($file_type eq 'set_header') { my $setRecord = $self->r->db->getGlobalSet($setName); $setRecord->set_header($new_file_name); if ($self->r->db->putGlobalSet($setRecord)) { - $self->addgoodmessage($r->maketext("The set header for set [_1] has been renamed to '[_2]'.", $setName, $self->shortPath($outputFilePath))) ; + $self->addgoodmessage($r->maketext( + "The set header for set [_1] has been renamed to '[_2]'.", $setName, + $self->shortPath($outputFilePath) + )); } else { $self->addbadmessage("Unable to change the set header for set $setName. Unknown error."); } - } elsif ($file_type eq 'hardcopy_header' ) { + } elsif ($file_type eq 'hardcopy_header') { my $setRecord = $self->r->db->getGlobalSet($setName); $setRecord->hardcopy_header($new_file_name); if ($self->r->db->putGlobalSet($setRecord)) { - $self->addgoodmessage($r->maketext("The hardcopy header for set [_1] has been renamed to '[_2]'.", $setName, $self->shortPath($outputFilePath))) ; + $self->addgoodmessage($r->maketext( + "The hardcopy header for set [_1] has been renamed to '[_2]'.", $setName, + $self->shortPath($outputFilePath) + )); } else { $self->addbadmessage("Unable to change the hardcopy header for set $setName. Unknown error."); } } else { my $problemRecord; - if ( $fullSetName =~ /,v(\d+)$/ ) { - $problemRecord = $self->r->db->getMergedProblemVersion($effectiveUserName, $setName, $1, $problemNumber); + if ($fullSetName =~ /,v(\d+)$/) { + $problemRecord = + $self->r->db->getMergedProblemVersion($effectiveUserName, $setName, $1, $problemNumber); } else { - $problemRecord = $self->r->db->getGlobalProblem($setName,$problemNumber); + $problemRecord = $self->r->db->getGlobalProblem($setName, $problemNumber); } $problemRecord->source_file($new_file_name); - my $result = ( $fullSetName =~ /,v(\d+)$/ ) + my $result = + ($fullSetName =~ /,v(\d+)$/) ? $self->r->db->putProblemVersion($problemRecord) : $self->r->db->putGlobalProblem($problemRecord); my $prettyProblemNumber = $problemNumber; - my $set = $self->r->db->getGlobalSet($setName); - $prettyProblemNumber = join('.',jitar_id_to_seq($problemNumber)) if ($set && $set->assignment_type eq 'jitar'); - - if ($result) { - $self->addgoodmessage($r->maketext("The source file for 'set [_1] / problem [_2] has been changed from '[_3]' to '[_4]'", - $fullSetName, $prettyProblemNumber, $self->shortPath($sourceFilePath), $self->shortPath($outputFilePath))) ; + my $set = $self->r->db->getGlobalSet($setName); + $prettyProblemNumber = join('.', jitar_id_to_seq($problemNumber)) + if ($set && $set->assignment_type eq 'jitar'); + + if ($result) { + $self->addgoodmessage($r->maketext( + "The source file for 'set [_1] / problem [_2] has been changed from '[_3]' to '[_4]'", + $fullSetName, + $prettyProblemNumber, + $self->shortPath($sourceFilePath), + $self->shortPath($outputFilePath) + )); } else { - $self->addbadmessage("Unable to change the source file path for set $fullSetName, problem $prettyProblemNumber. Unknown error."); + $self->addbadmessage( + "Unable to change the source file path for set $fullSetName, problem $prettyProblemNumber. Unknown error." + ); } } } elsif ($saveMode eq 'add_to_set_as_new_problem') { @@ -1987,23 +2133,36 @@ sub save_as_handler { my @problemIDs = $self->r->db->listGlobalProblems($setName); @problemIDs = sort { $a <=> $b } @problemIDs; my @seq = jitar_id_to_seq($problemIDs[$#problemIDs]); - $targetProblemNumber = seq_to_jitar_id($seq[0]+1); + $targetProblemNumber = seq_to_jitar_id($seq[0] + 1); } else { - $targetProblemNumber = 1+ WeBWorK::Utils::max( $self->r->db->listGlobalProblems($setName)); + $targetProblemNumber = 1 + WeBWorK::Utils::max($self->r->db->listGlobalProblems($setName)); } - my $problemRecord = $self->addProblemToSet( - setName => $setName, - sourceFile => $new_file_name, - problemID => $targetProblemNumber, #added to end of set + my $problemRecord = $self->addProblemToSet( + setName => $setName, + sourceFile => $new_file_name, + problemID => $targetProblemNumber, #added to end of set ); $self->assignProblemToAllSetUsers($problemRecord); - $self->addgoodmessage($r->maketext("Added [_1] to [_2] as problem [_3]", $new_file_name, $setName, ($set->assignment_type eq 'jitar' ? join('.',jitar_id_to_seq($targetProblemNumber)) : $targetProblemNumber))) ; + $self->addgoodmessage($r->maketext( + "Added [_1] to [_2] as problem [_3]", + $new_file_name, + $setName, + ( + $set->assignment_type eq 'jitar' + ? join('.', jitar_id_to_seq($targetProblemNumber)) + : $targetProblemNumber + ) + )); } elsif ($saveMode eq 'new_independent_problem') { ################################################# # Don't modify source file path in problem -- just report ################################################# - $self->addgoodmessage($r->maketext("A new file has been created at '[_1]' with the contents below. No changes have been made to set [_2]", $self->shortPath($outputFilePath), $setName)); + $self->addgoodmessage($r->maketext( + "A new file has been created at '[_1]' with the contents below. No changes have been made to set [_2]", + $self->shortPath($outputFilePath), + $setName + )); } else { $self->addbadmessage("Don't recognize saveMode: |$saveMode|. Unknown error."); } @@ -2018,14 +2177,20 @@ sub save_as_handler { my $problemPage; my $new_file_type; - if ($saveMode eq 'new_independent_problem' ) { - $problemPage = $self->r->urlpath->newFromModule("WeBWorK::ContentGenerator::Instructor::PGProblemEditor",$r, - courseID => $courseName, setID => 'Undefined_Set', problemID => 1 + if ($saveMode eq 'new_independent_problem') { + $problemPage = $self->r->urlpath->newFromModule( + "WeBWorK::ContentGenerator::Instructor::PGProblemEditor", $r, + courseID => $courseName, + setID => 'Undefined_Set', + problemID => 1 ); $new_file_type = 'source_path_for_problem_file'; } elsif ($saveMode eq 'rename') { - $problemPage = $self->r->urlpath->newFromModule("WeBWorK::ContentGenerator::Instructor::PGProblemEditor",$r, - courseID => $courseName, setID => $setName, problemID => $problemNumber + $problemPage = $self->r->urlpath->newFromModule( + "WeBWorK::ContentGenerator::Instructor::PGProblemEditor", $r, + courseID => $courseName, + setID => $setName, + problemID => $problemNumber ); $new_file_type = $file_type; } elsif ($saveMode eq 'add_to_set_as_new_problem') { @@ -2039,33 +2204,36 @@ sub save_as_handler { ); $new_file_type = $file_type; } else { - $self->addbadmessage(" Please use radio buttons to choose the method for saving this file. Can't recognize saveMode: |$saveMode|."); + $self->addbadmessage( + " Please use radio buttons to choose the method for saving this file. Can't recognize saveMode: |$saveMode|." + ); # can't continue since paths have not been properly defined. return ""; } my $relativeOutputFilePath = $self->getRelativeSourceFilePath($outputFilePath); - my $viewURL = $self->systemLink($problemPage, - params=>{ - sourceFilePath => $relativeOutputFilePath, #The path relative to the templates directory is required. - problemSeed => $problemSeed, - edit_level => $edit_level, - file_type => $new_file_type, - status_message => uri_escape_utf8($self->{status_message}) + my $viewURL = $self->systemLink( + $problemPage, + params => { + sourceFilePath => $relativeOutputFilePath, #The path relative to the templates directory is required. + problemSeed => $problemSeed, + edit_level => $edit_level, + file_type => $new_file_type, + status_message => uri_escape_utf8($self->{status_message}) } ); $self->reply_with_redirect($viewURL); - return ""; # no redirect needed + return ""; # no redirect needed } sub revert_form { my ($self, %actionParams) = @_; - my $r = $self->r; - my $editFilePath = $self->{editFilePath}; + my $r = $self->r; + my $editFilePath = $self->{editFilePath}; return $r->maketext("Error: The original file [_1] cannot be read.", $editFilePath) unless -r $editFilePath; - return "" unless defined($self->{tempFilePath}) and -e $self->{tempFilePath} ; + return "" unless defined($self->{tempFilePath}) and -e $self->{tempFilePath}; return $r->maketext("Revert to [_1]", CGI::span({ dir => 'ltr' }, $self->shortPath($editFilePath))); } @@ -2073,16 +2241,18 @@ sub revert_handler { my ($self, $genericParams, $actionParams, $tableParams) = @_; my $ce = $self->r->ce; #$self->addgoodmessage("revert_handler called"); - my $editFilePath = $self->{editFilePath}; + my $editFilePath = $self->{editFilePath}; $self->{inputFilePath} = $editFilePath; # unlink the temp files; - die "tempFilePath is unsafe!" unless path_is_subdir($self->{tempFilePath}, $ce->{courseDirs}->{templates}, 1); # 1==path can be relative to dir + die "tempFilePath is unsafe!" + unless path_is_subdir($self->{tempFilePath}, $ce->{courseDirs}->{templates}, 1) + ; # 1==path can be relative to dir unlink($self->{tempFilePath}); $self->addgoodmessage("Deleting temp file at " . $self->shortPath($self->{tempFilePath})); - $self->{tempFilePath} = ''; - my $problemContents =''; + $self->{tempFilePath} = ''; + my $problemContents = ''; $self->{r_problemContents} = \$problemContents; - $self->addgoodmessage("Reverting to original file '".$self->shortPath($editFilePath)."'"); + $self->addgoodmessage("Reverting to original file '" . $self->shortPath($editFilePath) . "'"); # no redirect is needed } diff --git a/lib/WeBWorK/ContentGenerator/Instructor/ProblemGrader.pm b/lib/WeBWorK/ContentGenerator/Instructor/ProblemGrader.pm index 80ab25bfd0..2bccbf9e03 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/ProblemGrader.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/ProblemGrader.pm @@ -177,13 +177,10 @@ sub body { #set up a silly problem to render the problem text my $pg = WeBWorK::PG->new(constructPGOptions( - $ce, - $user, - $set, - $problem, + $ce, $user, $set, $problem, $set->psvn, $formFields, - { # translation options + { # translation options displayMode => $displayMode, showHints => 0, showSolutions => 0, diff --git a/lib/WeBWorK/ContentGenerator/Instructor/ProblemSetDetail.pm b/lib/WeBWorK/ContentGenerator/Instructor/ProblemSetDetail.pm index 7df1a217c0..e8eb8ea635 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/ProblemSetDetail.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/ProblemSetDetail.pm @@ -36,18 +36,25 @@ use WeBWorK::Debug; # but they are functionally and semantically different # these constants determine which fields belong to what type of record -use constant SET_FIELDS => [qw(set_header hardcopy_header open_date reduced_scoring_date due_date answer_date visible description enable_reduced_scoring restricted_release restricted_status restrict_ip relax_restrict_ip assignment_type attempts_per_version version_time_limit time_limit_cap versions_per_interval time_interval problem_randorder problems_per_page hide_score:hide_score_by_problem hide_work hide_hint restrict_prob_progression email_instructor)]; -use constant PROBLEM_FIELDS =>[qw(source_file value max_attempts showMeAnother showHintsAfter prPeriod att_to_open_children counts_parent_grade)]; +use constant SET_FIELDS => [ + qw(set_header hardcopy_header open_date reduced_scoring_date due_date answer_date visible description enable_reduced_scoring restricted_release restricted_status restrict_ip relax_restrict_ip assignment_type attempts_per_version version_time_limit time_limit_cap versions_per_interval time_interval problem_randorder problems_per_page hide_score:hide_score_by_problem hide_work hide_hint restrict_prob_progression email_instructor) +]; +use constant PROBLEM_FIELDS => + [qw(source_file value max_attempts showMeAnother showHintsAfter prPeriod att_to_open_children counts_parent_grade)]; use constant USER_PROBLEM_FIELDS => [qw(problem_seed status num_correct num_incorrect)]; # these constants determine what order those fields should be displayed in use constant HEADER_ORDER => [qw(set_header hardcopy_header)]; -use constant PROBLEM_FIELD_ORDER => [qw(problem_seed status value max_attempts showMeAnother showHintsAfter prPeriod attempted last_answer num_correct num_incorrect)]; +use constant PROBLEM_FIELD_ORDER => [ + qw(problem_seed status value max_attempts showMeAnother showHintsAfter prPeriod attempted last_answer num_correct num_incorrect) +]; # for gateway sets, we don't want to allow users to change max_attempts on a per # problem basis, as that's nothing but confusing. -use constant GATEWAY_PROBLEM_FIELD_ORDER => [qw(problem_seed status value attempted last_answer num_correct num_incorrect)]; -use constant JITAR_PROBLEM_FIELD_ORDER => [qw(problem_seed status value max_attempts showMeAnother showHintsAfter prPeriod att_to_open_children counts_parent_grade attempted last_answer num_correct num_incorrect)]; - +use constant GATEWAY_PROBLEM_FIELD_ORDER => + [qw(problem_seed status value attempted last_answer num_correct num_incorrect)]; +use constant JITAR_PROBLEM_FIELD_ORDER => [ + qw(problem_seed status value max_attempts showMeAnother showHintsAfter prPeriod att_to_open_children counts_parent_grade attempted last_answer num_correct num_incorrect) +]; # we exclude the gateway set fields from the set field order, because they # are only displayed for sets that are gateways. this results in a bit of @@ -56,9 +63,13 @@ use constant JITAR_PROBLEM_FIELD_ORDER => [qw(problem_seed status value max_atte # FIXME: in the long run, we may want to let hide_score and hide_work be # FIXME: set for non-gateway assignments. right now (11/30/06) they are # FIXME: only used for gateways -use constant SET_FIELD_ORDER => [qw(open_date reduced_scoring_date due_date answer_date visible enable_reduced_scoring restricted_release restricted_status restrict_ip relax_restrict_ip hide_hint assignment_type)]; +use constant SET_FIELD_ORDER => [ + qw(open_date reduced_scoring_date due_date answer_date visible enable_reduced_scoring restricted_release restricted_status restrict_ip relax_restrict_ip hide_hint assignment_type) +]; # use constant GATEWAY_SET_FIELD_ORDER => [qw(attempts_per_version version_time_limit time_interval versions_per_interval problem_randorder problems_per_page hide_score hide_work)]; -use constant GATEWAY_SET_FIELD_ORDER => [qw(version_time_limit time_limit_cap attempts_per_version time_interval versions_per_interval problem_randorder problems_per_page hide_score:hide_score_by_problem hide_work)]; +use constant GATEWAY_SET_FIELD_ORDER => [ + qw(version_time_limit time_limit_cap attempts_per_version time_interval versions_per_interval problem_randorder problems_per_page hide_score:hide_score_by_problem hide_work) +]; use constant JITAR_SET_FIELD_ORDER => [qw(restrict_prob_progression email_instructor)]; # this constant is massive hash of information corresponding to each db field. @@ -85,221 +96,235 @@ use constant BLANKPROBLEM => 'blankProblem.pg'; use constant FIELD_PROPERTIES => { # Set information set_header => { - name => x("Set Header"), - type => "edit", - size => "50", - override => "all", - module => "problem_list", - default => "", + name => x("Set Header"), + type => "edit", + size => "50", + override => "all", + module => "problem_list", + default => "", }, hardcopy_header => { - name => x("Hardcopy Header"), - type => "edit", - size => "50", - override => "all", - module => "hardcopy_preselect_set", - default => "", + name => x("Hardcopy Header"), + type => "edit", + size => "50", + override => "all", + module => "hardcopy_preselect_set", + default => "", }, description => { - name => x("Description"), - type => "edit", - override => "all", - default => "", + name => x("Description"), + type => "edit", + override => "all", + default => "", }, open_date => { - name => x("Opens"), - type => "edit", - size => "25", - override => "any", + name => x("Opens"), + type => "edit", + size => "25", + override => "any", }, due_date => { - name => x("Closes"), - type => "edit", - size => "25", - override => "any", + name => x("Closes"), + type => "edit", + size => "25", + override => "any", }, answer_date => { - name => x("Answers Available"), - type => "edit", - size => "25", - override => "any", + name => x("Answers Available"), + type => "edit", + size => "25", + override => "any", }, visible => { - name => x("Visible to Students"), - type => "choose", - override => "all", - choices => [qw( 0 1 )], - labels => { - 1 => x("Yes"), - 0 => x("No"), + name => x("Visible to Students"), + type => "choose", + override => "all", + choices => [qw( 0 1 )], + labels => { + 1 => x("Yes"), + 0 => x("No"), }, }, enable_reduced_scoring => { - name => x("Reduced Scoring Enabled"), - type => "choose", - override => "any", - choices => [qw( 0 1 )], - labels => { - 1 => x("Yes"), - 0 => x("No"), + name => x("Reduced Scoring Enabled"), + type => "choose", + override => "any", + choices => [qw( 0 1 )], + labels => { + 1 => x("Yes"), + 0 => x("No"), }, }, reduced_scoring_date => { - name => x("Reduced Scoring Date"), - type => "edit", - size => "25", - override => "any", + name => x("Reduced Scoring Date"), + type => "edit", + size => "25", + override => "any", }, restricted_release => { name => x("Restrict release by set(s)"), type => "edit", size => "30", override => "any", - help_text => x("This set will be unavailable to students until they have earned a certain score on the sets specified in this field. The sets should be written as a comma separated list. The minimum score required on the sets is specified in the following field.") + help_text => x( + "This set will be unavailable to students until they have earned a certain score on the sets specified in this field. The sets should be written as a comma separated list. The minimum score required on the sets is specified in the following field." + ) }, restricted_status => { - name => x("Score required for release"), - type => "choose", - override => "any", - choices => [qw( 1 0.9 0.8 0.7 0.6 0.5 0.4 0.3 0.2 0.1 )], - labels => { '0.1' => '10%', - '0.2' => '20%', - '0.3' => '30%', - '0.4' => '40%', - '0.5' => '50%', - '0.6' => '60%', - '0.7' => '70%', - '0.8' => '80%', - '0.9' => '90%', - '1' => '100%', + name => x("Score required for release"), + type => "choose", + override => "any", + choices => [qw( 1 0.9 0.8 0.7 0.6 0.5 0.4 0.3 0.2 0.1 )], + labels => { + '0.1' => '10%', + '0.2' => '20%', + '0.3' => '30%', + '0.4' => '40%', + '0.5' => '50%', + '0.6' => '60%', + '0.7' => '70%', + '0.8' => '80%', + '0.9' => '90%', + '1' => '100%', }, }, restrict_ip => { - name => x("Restrict Access by IP"), - type => "choose", - override => "any", - choices => [qw( No RestrictTo DenyFrom )], - labels => { - No => x("No"), - RestrictTo => x("Restrict To"), - DenyFrom => x("Deny From"), + name => x("Restrict Access by IP"), + type => "choose", + override => "any", + choices => [qw( No RestrictTo DenyFrom )], + labels => { + No => x("No"), + RestrictTo => x("Restrict To"), + DenyFrom => x("Deny From"), }, - default => 'No', + default => 'No', }, relax_restrict_ip => { - name => x("Relax IP restrictions when?"), - type => "choose", - override => "any", - choices => [qw( No AfterAnswerDate AfterVersionAnswerDate )], - labels => { - No => x("Never"), - AfterAnswerDate => x("After set answer date"), - AfterVersionAnswerDate => x("(gw/quiz) After version answer date"), + name => x("Relax IP restrictions when?"), + type => "choose", + override => "any", + choices => [qw( No AfterAnswerDate AfterVersionAnswerDate )], + labels => { + No => x("Never"), + AfterAnswerDate => x("After set answer date"), + AfterVersionAnswerDate => x("(gw/quiz) After version answer date"), }, - default => 'No', + default => 'No', }, assignment_type => { - name => x("Assignment type"), - type => "choose", - override => "all", - choices => [qw( default gateway proctored_gateway jitar)], - labels => { default => "homework", - gateway => "gateway/quiz", - proctored_gateway => "proctored gateway/quiz", - jitar => "just-in-time" + name => x("Assignment type"), + type => "choose", + override => "all", + choices => [qw( default gateway proctored_gateway jitar)], + labels => { + default => "homework", + gateway => "gateway/quiz", + proctored_gateway => "proctored gateway/quiz", + jitar => "just-in-time" }, }, version_time_limit => { - name => x("Test Time Limit (min; 0=Close Date)"), - type => "edit", - size => "4", - override => "any", - default => "0", -# labels => { "" => 0 }, # I'm not sure this is quite right + name => x("Test Time Limit (min; 0=Close Date)"), + type => "edit", + size => "4", + override => "any", + default => "0", + # labels => { "" => 0 }, # I'm not sure this is quite right convertby => 60, }, time_limit_cap => { - name => x("Cap Test Time at Set Close Date?"), - type => "choose", - override => "all", - choices => [qw(0 1)], - labels => { '0' => 'No', '1' =>'Yes' }, + name => x("Cap Test Time at Set Close Date?"), + type => "choose", + override => "all", + choices => [qw(0 1)], + labels => { '0' => 'No', '1' => 'Yes' }, }, attempts_per_version => { - name => x("Number of Graded Submissions per Test (0=infty)"), - type => "edit", - size => "3", - override => "any", - default => "0", -# labels => { "" => 1 }, + name => x("Number of Graded Submissions per Test (0=infty)"), + type => "edit", + size => "3", + override => "any", + default => "0", + # labels => { "" => 1 }, }, time_interval => { - name => x("Time Interval for New Test Versions (min; 0=infty)"), - type => "edit", - size => "5", - override => "any", - default => "0", -# labels => { "" => 0 }, + name => x("Time Interval for New Test Versions (min; 0=infty)"), + type => "edit", + size => "5", + override => "any", + default => "0", + # labels => { "" => 0 }, convertby => 60, }, versions_per_interval => { - name => x("Number of Tests per Time Interval (0=infty)"), - type => "edit", - size => "3", - override => "any", - default => "0", - format => '[0-9]+', # an integer, possibly zero -# labels => { "" => 0 }, -# labels => { "" => 1 }, + name => x("Number of Tests per Time Interval (0=infty)"), + type => "edit", + size => "3", + override => "any", + default => "0", + format => '[0-9]+', # an integer, possibly zero + # labels => { "" => 0 }, + # labels => { "" => 1 }, }, problem_randorder => { - name => x("Order Problems Randomly"), - type => "choose", - choices => [qw( 0 1 )], - override => "any", - labels => { 0 => "No", 1 =>"Yes" }, + name => x("Order Problems Randomly"), + type => "choose", + choices => [qw( 0 1 )], + override => "any", + labels => { 0 => "No", 1 => "Yes" }, }, problems_per_page => { - name => x("Number of Problems per Page (0=all)"), - type => "edit", - size => "3", - override => "any", - default => "1", -# labels => { "" => 0 }, + name => x("Number of Problems per Page (0=all)"), + type => "edit", + size => "3", + override => "any", + default => "1", + # labels => { "" => 0 }, }, 'hide_score:hide_score_by_problem' => { - name => x("Show Scores on Finished Assignments?"), - type => "choose", - choices => [ qw( N:N Y:Y BeforeAnswerDate:N N:Y BeforeAnswerDate:Y ) ], - override => "any", - labels => { 'N:N' => 'Yes', 'Y:Y' => 'No', 'BeforeAnswerDate:N' => x('Only after set answer date'), 'N:Y' => x('Totals only (not problem scores)'), 'BeforeAnswerDate:Y' => x('Totals only, only after answer date') }, + name => x("Show Scores on Finished Assignments?"), + type => "choose", + choices => [qw( N:N Y:Y BeforeAnswerDate:N N:Y BeforeAnswerDate:Y )], + override => "any", + labels => { + 'N:N' => 'Yes', + 'Y:Y' => 'No', + 'BeforeAnswerDate:N' => x('Only after set answer date'), + 'N:Y' => x('Totals only (not problem scores)'), + 'BeforeAnswerDate:Y' => x('Totals only, only after answer date') + }, }, - hide_work => { - name => x("Show Problems on Finished Tests"), - type => "choose", - choices => [ qw(N Y BeforeAnswerDate) ], - override => "any", - labels => { 'N' => "Yes", 'Y' =>"No", 'BeforeAnswerDate' =>x('Only after set answer date') }, + hide_work => { + name => x("Show Problems on Finished Tests"), + type => "choose", + choices => [qw(N Y BeforeAnswerDate)], + override => "any", + labels => { 'N' => "Yes", 'Y' => "No", 'BeforeAnswerDate' => x('Only after set answer date') }, }, restrict_prob_progression => { name => x("Restrict Problem Progression"), type => "choose", - choices => [ qw(0 1) ], + choices => [qw(0 1)], override => "all", - default => "0", - labels => { '1' => "Yes", '0' =>"No", }, - help_text => x("If this is enabled then students will be unable to attempt a problem until they have completed all of the previous problems, and their child problems if necessary."), + default => "0", + labels => { '1' => "Yes", '0' => "No", }, + help_text => x( + "If this is enabled then students will be unable to attempt a problem until they have completed all of the previous problems, and their child problems if necessary." + ), }, - email_instructor => { + email_instructor => { name => x("Email Instructor On Failed Attempt"), type => "choose", - choices => [ qw(0 1) ], + choices => [qw(0 1)], override => "any", - default => "0", - labels => { '1' => "Yes", '0' =>"No"}, - help_text => x("If this is enabled then instructors with the ability to receive feedback emails will be notified whenever a student runs out of attempts on a problem and its children without receiving an adjusted status of 100%."), + default => "0", + labels => { '1' => "Yes", '0' => "No" }, + help_text => x( + "If this is enabled then instructors with the ability to receive feedback emails will be notified whenever a student runs out of attempts on a problem and its children without receiving an adjusted status of 100%." + ), }, # in addition to the set fields above, there are a number of things @@ -310,41 +335,43 @@ use constant FIELD_PROPERTIES => { # # Problem information source_file => { - name => x("Source File"), - type => "edit", - size => 50, - override => "any", - default => "", + name => x("Source File"), + type => "edit", + size => 50, + override => "any", + default => "", }, value => { - name => x("Weight"), - type => "edit", - size => 6, - override => "any", - default => "1", + name => x("Weight"), + type => "edit", + size => 6, + override => "any", + default => "1", }, max_attempts => { - name => x("Max attempts"), - type => "edit", - size => 6, - override => "any", - default => "-1", - labels => { - "-1" => x("unlimited"), + name => x("Max attempts"), + type => "edit", + size => 6, + override => "any", + default => "-1", + labels => { + "-1" => x("unlimited"), }, }, - showMeAnother => { - name => x("Show me another"), - type => "edit", - size => "6", - override => "any", - default=>"-1", - labels => { - "-1" => x("Never"), - "-2" => x("Default"), - }, - help_text => x("When a student has more attempts than is specified here they will be able to view another version of this problem. If set to -1 the feature is disabled and if set to -2 the course default is used.") - }, + showMeAnother => { + name => x("Show me another"), + type => "edit", + size => "6", + override => "any", + default => "-1", + labels => { + "-1" => x("Never"), + "-2" => x("Default"), + }, + help_text => x( + "When a student has more attempts than is specified here they will be able to view another version of this problem. If set to -1 the feature is disabled and if set to -2 the course default is used." + ) + }, showHintsAfter => { name => x('Show hints after'), type => 'edit', @@ -362,95 +389,101 @@ use constant FIELD_PROPERTIES => { ), }, prPeriod => { - name => x("Rerandomize after"), - type => "edit", - size => "6", + name => x("Rerandomize after"), + type => "edit", + size => "6", override => "any", - default=>"-1", - labels => { + default => "-1", + labels => { "-1" => x("Default"), - "0" => x("Never"), + "0" => x("Never"), }, - help_text => x("This specifies the rerandomization period: the number of attempts before a new version of the problem is generated by changing the Seed value. The value of -1 uses the default from course configuration. The value of 0 disables rerandomization."), + help_text => x( + "This specifies the rerandomization period: the number of attempts before a new version of the problem is generated by changing the Seed value. The value of -1 uses the default from course configuration. The value of 0 disables rerandomization." + ), }, problem_seed => { - name => x("Seed"), - type => "edit", - size => 6, - override => "one", + name => x("Seed"), + type => "edit", + size => 6, + override => "one", }, status => { - name => x("Status"), - type => "edit", - size => 6, - override => "one", - default => "0", + name => x("Status"), + type => "edit", + size => 6, + override => "one", + default => "0", }, attempted => { - name => x("Attempted"), - type => "hidden", - override => "none", - choices => [qw( 0 1 )], - labels => { - 1 => x("Yes"), - 0 => x("No"), + name => x("Attempted"), + type => "hidden", + override => "none", + choices => [qw( 0 1 )], + labels => { + 1 => x("Yes"), + 0 => x("No"), }, - default => "0", + default => "0", }, last_answer => { - name => x("Last Answer"), - type => "hidden", - override => "none", + name => x("Last Answer"), + type => "hidden", + override => "none", }, num_correct => { - name => x("Correct"), - type => "hidden", - override => "none", - default => "0", + name => x("Correct"), + type => "hidden", + override => "none", + default => "0", }, num_incorrect => { - name => x("Incorrect"), - type => "hidden", - override => "none", - default => "0", + name => x("Incorrect"), + type => "hidden", + override => "none", + default => "0", }, hide_hint => { - name => x("Hide Hints from Students"), - type => "choose", - override => "all", - choices => [qw( 0 1 )], - labels => { - 1 => x("Yes"), - 0 => x("No"), + name => x("Hide Hints from Students"), + type => "choose", + override => "all", + choices => [qw( 0 1 )], + labels => { + 1 => x("Yes"), + 0 => x("No"), }, }, - att_to_open_children => { - name => x("Att. to Open Children"), - type => "edit", - size => 6, - override => "any", - default => "0", - labels => { - "-1" => x("max"), + att_to_open_children => { + name => x("Att. to Open Children"), + type => "edit", + size => 6, + override => "any", + default => "0", + labels => { + "-1" => x("max"), }, - help_text => x("The child problems for this problem will become visible to the student when they either have more incorrect attempts than is specified here, or when they run out of attempts, whichever comes first. If \"max\" is specified here then child problems will only be available after a student runs out of attempts."), + help_text => x( + "The child problems for this problem will become visible to the student when they either have more incorrect attempts than is specified here, or when they run out of attempts, whichever comes first. If \"max\" is specified here then child problems will only be available after a student runs out of attempts." + ), }, - counts_parent_grade => { + counts_parent_grade => { name => x("Counts for Parent"), type => "choose", - choices => [ qw(0 1) ], + choices => [qw(0 1)], override => "any", - default => "0", - labels => { '1' => "Yes", '0' =>"No", }, - help_text => x("If this flag is set then this problem will count towards the grade of its parent problem. In general the adjusted status on a problem is the larger of the problem's status and the weighted average of the status of its child problems which have this flag enabled."), + default => "0", + labels => { '1' => "Yes", '0' => "No", }, + help_text => x( + "If this flag is set then this problem will count towards the grade of its parent problem. In general the adjusted status on a problem is the larger of the problem's status and the weighted average of the status of its child problems which have this flag enabled." + ), }, }; use constant FIELD_PROPERTIES_GWQUIZ => { max_attempts => { - type => "hidden", - override=> "any", + type => "hidden", + override => "any", } }; @@ -541,11 +574,11 @@ sub FieldTable { next if ($field eq 'restrict_ip' && (!$numLocations || $setVersion)); next if ( - $field eq 'relax_restrict_ip' - && (!$numLocations - || $setVersion - || ($forUsers && $userRecord->restrict_ip eq 'No') - || (!$forUsers && ($globalRecord->restrict_ip eq '' || $globalRecord->restrict_ip eq 'No'))) + $field eq 'relax_restrict_ip' + && (!$numLocations + || $setVersion + || ($forUsers && $userRecord->restrict_ip eq 'No') + || (!$forUsers && ($globalRecord->restrict_ip eq '' || $globalRecord->restrict_ip eq 'No'))) ); # Skip the problem seed if we are not editing for one user, or if we are editing a gateway set for users, @@ -563,7 +596,7 @@ sub FieldTable { unless ($properties{type} eq 'hidden') { my @row = $self->FieldHTML($userID, $setID, $problemID, $globalRecord, $userRecord, $field); - $output .= CGI::Tr(CGI::td([ @row ])) if @row > 1; + $output .= CGI::Tr(CGI::td([@row])) if @row > 1; } # Finally, put in extra fields that are exceptions to the usual display mechanism. @@ -654,7 +687,7 @@ sub FieldHTML { # Use defined instead of value in order to allow 0 to printed, e.g. for the 'value' field. $globalValue = defined $globalValue ? ($labels{$globalValue} || $globalValue) : ''; - $userValue = defined $userValue ? ($labels{$userValue} || $userValue) : $blankfield; + $userValue = defined $userValue ? ($labels{$userValue} || $userValue) : $blankfield; if ($field =~ /_date/) { $globalValue = $self->formatDateTime($globalValue, '', 'datetime_format_short', $r->ce->{language}) @@ -841,12 +874,11 @@ sub FieldHTML { # return weird fields that are non-native or which are displayed # for only some sets sub extraSetFields { - my ($self,$userID,$setID,$globalRecord,$userRecord,$forUsers) = @_; + my ($self, $userID, $setID, $globalRecord, $userRecord, $forUsers) = @_; my $db = $self->r->{db}; - my $r = $self->r; + my $r = $self->r; - my ($extraFields, $ipFields, $ipDefaults, $numLocations, $ipOverride, - $procFields) = ( '', '', '', 0, '', '' ); + my ($extraFields, $ipFields, $ipDefaults, $numLocations, $ipOverride, $procFields) = ('', '', '', 0, '', ''); # If we're dealing with a gateway, set up a table of gateway fields my $nF = 0; # This is the number of columns in the set field table @@ -858,7 +890,7 @@ sub extraSetFields { # don't show template gateway fields when editing set versions next if (($gwfield eq "time_interval" || $gwfield eq "versions_per_interval") - && ($forUsers && $userRecord->can('version_id'))); + && ($forUsers && $userRecord->can('version_id'))); my @fieldData = $self->FieldHTML($userID, $setID, undef, $globalRecord, $userRecord, $gwfield); if (@fieldData && defined($fieldData[0]) && $fieldData[0] ne '') { @@ -888,11 +920,11 @@ sub extraSetFields { # if we have a proctored test, then also generate a proctored set password input if ($globalRecord->assignment_type eq 'proctored_gateway' && !$forUsers) { # We use a routine other than FieldHTML because of getting the default value here. - $procFields = CGI::Tr(CGI::td([$self->proctoredFieldHTML($userID, $setID, $globalRecord)])); + $procFields = CGI::Tr(CGI::td([ $self->proctoredFieldHTML($userID, $setID, $globalRecord) ])); } # finally, figure out what ip selector fields we want to include - my @locations = sort {$a cmp $b} ($db->listLocations()); + my @locations = sort { $a cmp $b } ($db->listLocations()); $numLocations = @locations; # we don't show ip selector fields if we're editing a set version @@ -1052,21 +1084,21 @@ sub print_nested_list { # handles rearrangement necessary after changes to problem ordering sub handle_problem_numbers { - my $self = shift; - my $r = $self->r; + my $self = shift; + my $r = $self->r; my $newProblemNumbersref = shift; - my %newProblemNumbers = %$newProblemNumbersref; - my $db = shift; - my $setID = shift; - my $force = 0; - my $maxDepth = 0; - my @sortme=(); + my %newProblemNumbers = %$newProblemNumbersref; + my $db = shift; + my $setID = shift; + my $force = 0; + my $maxDepth = 0; + my @sortme = (); my ($j, $val); my @prob_ids; # check to see that everything has a number and if anything was renumbered. foreach $j (keys %newProblemNumbers) { - return "" if (not defined $newProblemNumbers{$j}); + return "" if (not defined $newProblemNumbers{$j}); $force = 1 if $newProblemNumbers{$j} != $j; } @@ -1074,7 +1106,7 @@ sub handle_problem_numbers { return "" unless $force; # get problems and store them in a hash. - # We do this all at once because its not always clear + # We do this all at once because its not always clear # what is overwriting what and when. # We try to keep things sane by only getting and storing things # which have actually been reordered @@ -1082,86 +1114,86 @@ sub handle_problem_numbers { my @setUsers = $db->listSetUsers($setID); my %userProblemHash; - foreach $j (keys %newProblemNumbers) { - next if $newProblemNumbers{$j} == $j; - - $problemHash{$j} = $db->getGlobalProblem($setID, $j); - die $r->maketext("global [_1] for set [_2] not found.", $j, $setID) unless $problemHash{$j}; - foreach my $user (@setUsers) { - $userProblemHash{$user}{$j} = $db->getUserProblem($user,$setID, $j); - warn $r->maketext("UserProblem missing for user=[_1] set=[_2] problem=[_3]. This may indicate database corruption.", $user, $setID, $j)."\n" - unless $userProblemHash{$user}{$j}; - } + next if $newProblemNumbers{$j} == $j; + + $problemHash{$j} = $db->getGlobalProblem($setID, $j); + die $r->maketext("global [_1] for set [_2] not found.", $j, $setID) unless $problemHash{$j}; + foreach my $user (@setUsers) { + $userProblemHash{$user}{$j} = $db->getUserProblem($user, $setID, $j); + warn $r->maketext( + "UserProblem missing for user=[_1] set=[_2] problem=[_3]. This may indicate database corruption.", + $user, $setID, $j) + . "\n" + unless $userProblemHash{$user}{$j}; + } } # now go through and move problems around # because of the way the reordering works with the draggable # js handler we cant have any conflicts or holes foreach $j (keys %newProblemNumbers) { - next if ($newProblemNumbers{$j} == $j); + next if ($newProblemNumbers{$j} == $j); - $problemHash{$j}->problem_id($newProblemNumbers{$j}); - if ($db->existsGlobalProblem($setID, $newProblemNumbers{$j})) { - $db->putGlobalProblem($problemHash{$j}); - } else { - $db->addGlobalProblem($problemHash{$j}); - } + $problemHash{$j}->problem_id($newProblemNumbers{$j}); + if ($db->existsGlobalProblem($setID, $newProblemNumbers{$j})) { + $db->putGlobalProblem($problemHash{$j}); + } else { + $db->addGlobalProblem($problemHash{$j}); + } - # now deal with the user sets + # now deal with the user sets - foreach my $user (@setUsers) { + foreach my $user (@setUsers) { - $userProblemHash{$user}{$j}->problem_id($newProblemNumbers{$j}); - if ($db->existsUserProblem($user, $setID, $newProblemNumbers{$j})) { - $db->putUserProblem($userProblemHash{$user}{$j}); - } else { - $db->addUserProblem($userProblemHash{$user}{$j}); - } + $userProblemHash{$user}{$j}->problem_id($newProblemNumbers{$j}); + if ($db->existsUserProblem($user, $setID, $newProblemNumbers{$j})) { + $db->putUserProblem($userProblemHash{$user}{$j}); + } else { + $db->addUserProblem($userProblemHash{$user}{$j}); + } - } + } - # now we need to delete "orphan" problems that were not overwritten by something else - my $delete = 1; - foreach my $k (keys %newProblemNumbers) { - $delete = 0 if ($j == $newProblemNumbers{$k}); - } + # now we need to delete "orphan" problems that were not overwritten by something else + my $delete = 1; + foreach my $k (keys %newProblemNumbers) { + $delete = 0 if ($j == $newProblemNumbers{$k}); + } - if ($delete) { - $db->deleteGlobalProblem($setID, $j); - } + if ($delete) { + $db->deleteGlobalProblem($setID, $j); + } } - # return a string form of the old problem IDs in the new order (not used by caller, incidentally) return join(', ', values %newProblemNumbers); } - # primarily saves any changes into the correct set or problem records (global vs user) # also deals with deleting or rearranging problems sub initialize { - my ($self) = @_; - my $r = $self->r; - my $db = $r->db; - my $ce = $r->ce; - my $authz = $r->authz; - my $user = $r->param('user'); - my $setID = $r->urlpath->arg("setID"); + my ($self) = @_; + my $r = $self->r; + my $db = $r->db; + my $ce = $r->ce; + my $authz = $r->authz; + my $user = $r->param('user'); + my $setID = $r->urlpath->arg("setID"); ## we're now allowing setID to come in as setID,v# to edit a set ## version; catch this first my $editingSetVersion = 0; - if ( $setID =~ /,v(\d+)$/ ) { - $editingSetVersion = $1; - $setID =~ s/,v(\d+)$//; + if ($setID =~ /,v(\d+)$/) { + $editingSetVersion = $1; + $setID =~ s/,v(\d+)$//; } - my $setRecord = $db->getGlobalSet($setID); # checked + my $setRecord = $db->getGlobalSet($setID); # checked die $r->maketext("global set [_1] not found.", $setID) unless $setRecord; - $self->{set} = $setRecord; + $self->{set} = $setRecord; my @editForUser = $r->param('editForUser'); # some useful booleans my $forUsers = scalar(@editForUser); @@ -1173,23 +1205,24 @@ sub initialize { ## if we're editing a versioned set, it only makes sense to be ## editing it for one user - return if ( $editingSetVersion && ! $forOneUser ); + return if ($editingSetVersion && !$forOneUser); my %properties = %{ FIELD_PROPERTIES() }; # takes a hash of hashes and inverts it my %undoLabels; foreach my $key (keys %properties) { - %{ $undoLabels{$key} } = map { $r->maketext($properties{$key}->{labels}->{$_}) => $_ } keys %{ $properties{$key}->{labels} }; + %{ $undoLabels{$key} } = + map { $r->maketext($properties{$key}->{labels}->{$_}) => $_ } keys %{ $properties{$key}->{labels} }; } # Unfortunately not everyone uses Javascript enabled browsers so # we must fudge the information coming from the ComboBoxes # Since the textfield and menu both have the same name, we get an array of two elements # We then reset the param to the first if its not-empty or the second (empty or not). - foreach ( @{ HEADER_ORDER() } ) { + foreach (@{ HEADER_ORDER() }) { my @values = $r->param("set.$setID.$_"); - my $value = $values[0] || $values[1] || ""; + my $value = $values[0] || $values[1] || ""; $r->param("set.$setID.$_", $value); } @@ -1210,50 +1243,57 @@ sub initialize { } } - if (!$error) - { - ($open_date, $due_date, $answer_date, $reduced_scoring_date) = map { $dates{$_}||0 } @names; + if (!$error) { + ($open_date, $due_date, $answer_date, $reduced_scoring_date) = map { $dates{$_} || 0 } @names; # make sure dates are numeric by using ||0 if ($answer_date < $due_date || $answer_date < $open_date) { - $self->addbadmessage($r->maketext("Answers cannot be made available until on or after the close date!")); + $self->addbadmessage( + $r->maketext("Answers cannot be made available until on or after the close date!")); $error = $r->param('submit_changes'); } - if ($due_date < $open_date ) { + if ($due_date < $open_date) { $self->addbadmessage($r->maketext("Answers cannot be due until on or after the open date!")); $error = $r->param('submit_changes'); } - my $enable_reduced_scoring = - $ce->{pg}{ansEvalDefaults}{enableReducedScoring} && - (defined($r->param("set.$setID.enable_reduced_scoring")) ? - $r->param("set.$setID.enable_reduced_scoring") : - $setRecord->enable_reduced_scoring); + my $enable_reduced_scoring = $ce->{pg}{ansEvalDefaults}{enableReducedScoring} + && ( + defined($r->param("set.$setID.enable_reduced_scoring")) + ? $r->param("set.$setID.enable_reduced_scoring") + : $setRecord->enable_reduced_scoring); - if ($enable_reduced_scoring && - $reduced_scoring_date + if ( + $enable_reduced_scoring + && $reduced_scoring_date && ($reduced_scoring_date > $due_date - || $reduced_scoring_date < $open_date)) { - $self->addbadmessage($r->maketext("The reduced scoring date should be between the open date and close date.")); + || $reduced_scoring_date < $open_date) + ) + { + $self->addbadmessage( + $r->maketext("The reduced scoring date should be between the open date and close date.")); $error = $r->param('submit_changes'); } # make sure the dates are not more than 10 years in the future - my $curr_time = time; + my $curr_time = time; my $seconds_per_year = 31_556_926; - my $cutoff = $curr_time + $seconds_per_year*10; + my $cutoff = $curr_time + $seconds_per_year * 10; if ($open_date > $cutoff) { - $self->addbadmessage($r->maketext("Error: open date cannot be more than 10 years from now in set [_1]", $setID)); + $self->addbadmessage( + $r->maketext("Error: open date cannot be more than 10 years from now in set [_1]", $setID)); $error = $r->param('submit_changes'); } if ($due_date > $cutoff) { - $self->addbadmessage($r->maketext("Error: close date cannot be more than 10 years from now in set [_1]", $setID)); + $self->addbadmessage( + $r->maketext("Error: close date cannot be more than 10 years from now in set [_1]", $setID)); $error = $r->param('submit_changes'); } if ($answer_date > $cutoff) { - $self->addbadmessage($r->maketext("Error: answer date cannot be more than 10 years from now in set [_1]", $setID)); + $self->addbadmessage( + $r->maketext("Error: answer date cannot be more than 10 years from now in set [_1]", $setID)); $error = $r->param('submit_changes'); } } @@ -1266,7 +1306,7 @@ sub initialize { if (defined $r->param('submit_changes') && !$error) { #my $setRecord = $db->getGlobalSet($setID); # already fetched above --sam - my $oldAssignmentType = $setRecord->assignment_type(); + my $oldAssignmentType = $setRecord->assignment_type(); ##################################################################### # Save general set information (including headers) @@ -1279,41 +1319,39 @@ sub initialize { # not the most robust treatment of the problem # (FIXME) - my @userRecords = $db->getUserSetsWhere({ user_id => [ @editForUser ], set_id => $setID }); + my @userRecords = $db->getUserSetsWhere({ user_id => [@editForUser], set_id => $setID }); # if we're editing a set version, we want to edit # edit that instead of the userset, so get it # too. - my $userSet = $userRecords[0]; + my $userSet = $userRecords[0]; my $setVersion = 0; - if ( $editingSetVersion ) { - $setVersion = - $db->getSetVersion($editForUser[0], - $setID, - $editingSetVersion); - @userRecords = ( $setVersion ); + if ($editingSetVersion) { + $setVersion = $db->getSetVersion($editForUser[0], $setID, $editingSetVersion); + @userRecords = ($setVersion); } foreach my $record (@userRecords) { - foreach my $field ( @{ SET_FIELDS() } ) { + foreach my $field (@{ SET_FIELDS() }) { next unless canChange($forUsers, $field); my $override = $r->param("set.$setID.$field.override"); if (defined $override && $override eq $field) { - my $param = $r->param("set.$setID.$field"); - $param = defined $properties{$field}->{default} ? $properties{$field}->{default} : "" unless defined $param && $param ne ""; + my $param = $r->param("set.$setID.$field"); + $param = defined $properties{$field}->{default} ? $properties{$field}->{default} : "" + unless defined $param && $param ne ""; - my $unlabel = $undoLabels{$field}->{$param}; + my $unlabel = $undoLabels{$field}->{$param}; $param = $unlabel if defined $unlabel; if (defined($properties{$field}->{convertby}) && $properties{$field}->{convertby}) { - $param = $param*$properties{$field}->{convertby}; + $param = $param * $properties{$field}->{convertby}; } # special case; does field fill in multiple values? - if ( $field =~ /:/ ) { + if ($field =~ /:/) { my @values = split(/:/, $param); my @fields = split(/:/, $field); - for ( my $i=0; $i<@values; $i++ ) { - my $f=$fields[$i]; + for (my $i = 0; $i < @values; $i++) { + my $f = $fields[$i]; $record->$f($values[$i]); } } else { @@ -1323,8 +1361,8 @@ sub initialize { #################### # FIXME: allow one selector to set multiple fields # - if ( $field =~ /:/ ) { - foreach my $f ( split(/:/, $field) ) { + if ($field =~ /:/) { + foreach my $f (split(/:/, $field)) { $record->$f(undef); } } else { @@ -1342,70 +1380,71 @@ sub initialize { # $record->hide_score_by_problem('N'); # } #################### - if ( $editingSetVersion ) { - $db->putSetVersion( $record ); + if ($editingSetVersion) { + $db->putSetVersion($record); } else { $db->putUserSet($record); } } - ####################################################### - # Save IP restriction Location information - ####################################################### - # FIXME: it would be nice to have this in the field values - # hash, so that we don't have to assume that we can - # override this information for users + ####################################################### + # Save IP restriction Location information + ####################################################### + # FIXME: it would be nice to have this in the field values + # hash, so that we don't have to assume that we can + # override this information for users ## should we allow resetting set locations for set versions? this ## requires either putting in a new set of database routines ## to deal with the versioned setID, or fudging it at this end ## by manually putting in the versioned ID setID,v#. neither ## of these seems desirable, so for now it's not allowed - if ( ! $editingSetVersion ) { - if ( $r->param("set.$setID.selected_ip_locations.override") ) { - foreach my $record ( @userRecords ) { - my $userID = $record->user_id; + if (!$editingSetVersion) { + if ($r->param("set.$setID.selected_ip_locations.override")) { + foreach my $record (@userRecords) { + my $userID = $record->user_id; my @selectedLocations = $r->param("set.$setID.selected_ip_locations"); - my @userSetLocations = $db->listUserSetLocations($userID,$setID); - my @addSetLocations = (); - my @delSetLocations = (); - foreach my $loc ( @selectedLocations ) { - push( @addSetLocations, $loc ) if ( ! grep( /^$loc$/, @userSetLocations ) ); + my @userSetLocations = $db->listUserSetLocations($userID, $setID); + my @addSetLocations = (); + my @delSetLocations = (); + foreach my $loc (@selectedLocations) { + push(@addSetLocations, $loc) if (!grep(/^$loc$/, @userSetLocations)); } - foreach my $loc ( @userSetLocations ) { - push( @delSetLocations, $loc ) if ( ! grep( /^$loc$/, @selectedLocations ) ); + foreach my $loc (@userSetLocations) { + push(@delSetLocations, $loc) if (!grep(/^$loc$/, @selectedLocations)); } # then update the user set_locations - foreach ( @addSetLocations ) { + foreach (@addSetLocations) { my $Loc = $db->newUserSetLocation; - $Loc->set_id( $setID ); - $Loc->user_id( $userID ); + $Loc->set_id($setID); + $Loc->user_id($userID); $Loc->location_id($_); $db->addUserSetLocation($Loc); } - foreach ( @delSetLocations ) { - $db->deleteUserSetLocation($userID,$setID,$_); + foreach (@delSetLocations) { + $db->deleteUserSetLocation($userID, $setID, $_); } } } else { # if override isn't selected, then we want # to be sure that there are no # set_locations_user entries setting around - foreach my $record ( @userRecords ) { - my $userID = $record->user_id; - my @userLocations = $db->listUserSetLocations($userID,$setID); - foreach ( @userLocations ) { - $db->deleteUserSetLocation($userID,$setID,$_); + foreach my $record (@userRecords) { + my $userID = $record->user_id; + my @userLocations = $db->listUserSetLocations($userID, $setID); + foreach (@userLocations) { + $db->deleteUserSetLocation($userID, $setID, $_); } } } } } else { - foreach my $field ( @{ SET_FIELDS() } ) { + foreach my $field (@{ SET_FIELDS() }) { next unless canChange($forUsers, $field); my $param = $r->param("set.$setID.$field"); - $param = defined $properties{$field}->{default} ? $properties{$field}->{default} : "" unless defined $param && $param ne ""; + $param = defined $properties{$field}->{default} ? $properties{$field}->{default} : "" + unless defined $param && $param ne ""; my $unlabel = $undoLabels{$field}->{$param}; $param = $unlabel if defined $unlabel; if ($field =~ /restricted_release/ && $param) { @@ -1413,13 +1452,13 @@ sub initialize { $self->check_sets($db, $param); } if (defined($properties{$field}->{convertby}) && $properties{$field}->{convertby} && $param) { - $param = $param*$properties{$field}->{convertby}; + $param = $param * $properties{$field}->{convertby}; } # special case; does field fill in multiple values? - if ( $field =~ /:/ ) { + if ($field =~ /:/) { my @values = split(/:/, $param); my @fields = split(/:/, $field); - for ( my $i=0; $i<@fields; $i++ ) { + for (my $i = 0; $i < @fields; $i++) { my $f = $fields[$i]; $setRecord->$f($values[$i]); } @@ -1428,64 +1467,65 @@ sub initialize { } } #################### -# FIXME: this is replaced by our setting both hide_score and hide_score_by_problem -# with a single drop down -# -# # a check for hiding scores: if we have -# # $set->hide_score eq 'N', we also want -# # $set->hide_score_by_problem eq 'N', and if it's -# # changed to 'Y' and hide_score_by_problem is Null, -# # give it a value 'N' -# if ( $setRecord->hide_score eq 'N' || -# ( ! defined($setRecord->hide_score_by_problem) || -# $setRecord->hide_score_by_problem eq '' ) ) { -# $setRecord->hide_score_by_problem('N'); -# } + # FIXME: this is replaced by our setting both hide_score and hide_score_by_problem + # with a single drop down + # + # # a check for hiding scores: if we have + # # $set->hide_score eq 'N', we also want + # # $set->hide_score_by_problem eq 'N', and if it's + # # changed to 'Y' and hide_score_by_problem is Null, + # # give it a value 'N' + # if ( $setRecord->hide_score eq 'N' || + # ( ! defined($setRecord->hide_score_by_problem) || + # $setRecord->hide_score_by_problem eq '' ) ) { + # $setRecord->hide_score_by_problem('N'); + # } #################### $db->putGlobalSet($setRecord); - ####################################################### - # Save IP restriction Location information - ####################################################### + ####################################################### + # Save IP restriction Location information + ####################################################### - if ( defined($r->param("set.$setID.restrict_ip")) and $r->param("set.$setID.restrict_ip") ne 'No' ) { - my @selectedLocations = $r->param("set.$setID.selected_ip_locations"); + if (defined($r->param("set.$setID.restrict_ip")) and $r->param("set.$setID.restrict_ip") ne 'No') { + my @selectedLocations = $r->param("set.$setID.selected_ip_locations"); my @globalSetLocations = $db->listGlobalSetLocations($setID); - my @addSetLocations = (); - my @delSetLocations = (); - foreach my $loc ( @selectedLocations ) { - push( @addSetLocations, $loc ) if ( ! grep( /^$loc$/, @globalSetLocations ) ); + my @addSetLocations = (); + my @delSetLocations = (); + foreach my $loc (@selectedLocations) { + push(@addSetLocations, $loc) if (!grep(/^$loc$/, @globalSetLocations)); } - foreach my $loc ( @globalSetLocations ) { - push( @delSetLocations, $loc ) if ( ! grep( /^$loc$/, @selectedLocations ) ); + foreach my $loc (@globalSetLocations) { + push(@delSetLocations, $loc) if (!grep(/^$loc$/, @selectedLocations)); } # then update the global set_locations - foreach ( @addSetLocations ) { + foreach (@addSetLocations) { my $Loc = $db->newGlobalSetLocation; - $Loc->set_id( $setID ); + $Loc->set_id($setID); $Loc->location_id($_); $db->addGlobalSetLocation($Loc); } - foreach ( @delSetLocations ) { - $db->deleteGlobalSetLocation($setID,$_); + foreach (@delSetLocations) { + $db->deleteGlobalSetLocation($setID, $_); } } else { my @globalSetLocations = $db->listGlobalSetLocations($setID); - foreach ( @globalSetLocations ) { - $db->deleteGlobalSetLocation($setID,$_); + foreach (@globalSetLocations) { + $db->deleteGlobalSetLocation($setID, $_); } } - ####################################################### - # Save proctored problem proctor user information - ####################################################### - if ($r->param("set.$setID.restricted_login_proctor_password") && - $setRecord->assignment_type eq 'proctored_gateway') { + ####################################################### + # Save proctored problem proctor user information + ####################################################### + if ($r->param("set.$setID.restricted_login_proctor_password") + && $setRecord->assignment_type eq 'proctored_gateway') + { # in this case we're adding a set-level proctor # or updating the password my $procID = "set_id:$setID"; - my $pass = $r->param("set.$setID.restricted_login_proctor_password"); + my $pass = $r->param("set.$setID.restricted_login_proctor_password"); # should we carefully check in this case that # the user and password exist? the code # in the add stanza is pretty careful to @@ -1495,17 +1535,20 @@ sub initialize { # restricted_login_proctor field, so we # assume that just checking the latter # here is sufficient. - if ( $setRecord->restricted_login_proctor eq 'Yes' ) { + if ($setRecord->restricted_login_proctor eq 'Yes') { # in this case we already have a set # level proctor, and so should be # resetting the password - if ( $pass ne '********' ) { + if ($pass ne '********') { # then we submitted a new # password, so save it my $dbPass; eval { $dbPass = $db->getPassword($procID) }; - if ( $@ ) { - $self->addbadmessage($r->maketext("Error getting old set-proctor password from the database: [_1]. No update to the password was done.", $@)); + if ($@) { + $self->addbadmessage($r->maketext( + "Error getting old set-proctor password from the database: [_1]. No update to the password was done.", + $@ + )); } else { $dbPass->password(cryptPassword($pass)); $db->putPassword($dbPass); @@ -1528,7 +1571,7 @@ sub initialize { $procPass->password(cryptPassword($pass)); # put these into the database eval { $db->addUser($procUser) }; - if ( $@ ) { + if ($@) { $self->addbadmessage($r->maketext("Error adding set-level proctor: [_1]", $@)); } else { $db->addPermissionLevel($procPerm); @@ -1537,18 +1580,18 @@ sub initialize { # and set the restricted_login_proctor # set field - $db->putGlobalSet( $setRecord ); + $db->putGlobalSet($setRecord); } } else { # if the parameter isn't set, or if the assignment # type is not 'proctored_gateway', then we need to be # sure that there's no set-level proctor defined - if ( $setRecord->restricted_login_proctor eq 'Yes' ) { + if ($setRecord->restricted_login_proctor eq 'Yes') { $setRecord->restricted_login_proctor('No'); - $db->deleteUser( "set_id:$setID" ); - $db->putGlobalSet( $setRecord ); + $db->deleteUser("set_id:$setID"); + $db->putGlobalSet($setRecord); } } @@ -1558,48 +1601,53 @@ sub initialize { # Save problem information ##################################################################### - my @problemIDs = map { $_->[1] } $db->listGlobalProblemsWhere({ set_id => $setID }, 'problem_id'); - my @problemRecords = $db->getGlobalProblems(map { [$setID, $_] } @problemIDs); + my @problemIDs = map { $_->[1] } $db->listGlobalProblemsWhere({ set_id => $setID }, 'problem_id'); + my @problemRecords = $db->getGlobalProblems(map { [ $setID, $_ ] } @problemIDs); foreach my $problemRecord (@problemRecords) { my $problemID = $problemRecord->problem_id; die $r->maketext("Global problem [_1] for set [_2] not found.", $problemID, $setID) unless $problemRecord; if ($forUsers) { - # Since we're editing for specific users, we don't allow the GlobalProblem record to be altered on that same page - # So we only need to make changes to the UserProblem record and only then if we are overriding a value - # in the GlobalProblem record or for fields unique to the UserProblem record. + # Since we're editing for specific users, we don't allow the GlobalProblem record to be altered on that same page + # So we only need to make changes to the UserProblem record and only then if we are overriding a value + # in the GlobalProblem record or for fields unique to the UserProblem record. my @userIDs = @editForUser; my @userProblemRecords; - if ( ! $editingSetVersion ) { - my @userProblemIDs = map { [$_, $setID, $problemID] } @userIDs; + if (!$editingSetVersion) { + my @userProblemIDs = map { [ $_, $setID, $problemID ] } @userIDs; @userProblemRecords = $db->getUserProblemsWhere( { user_id => [@userIDs], set_id => $setID, problem_id => $problemID }); } else { ## (we know that we're only editing for one user) @userProblemRecords = - ( $db->getMergedProblemVersion( $userIDs[0], $setID, $editingSetVersion, $problemID ) ); + ($db->getMergedProblemVersion($userIDs[0], $setID, $editingSetVersion, $problemID)); } foreach my $record (@userProblemRecords) { - my $changed = 0; # keep track of any changes, if none are made, avoid unnecessary db accesses - foreach my $field ( @{ PROBLEM_FIELDS() } ) { + my $changed = 0; # keep track of any changes, if none are made, avoid unnecessary db accesses + foreach my $field (@{ PROBLEM_FIELDS() }) { next unless canChange($forUsers, $field); my $override = $r->param("problem.$problemID.$field.override"); if (defined $override && $override eq $field) { my $param = $r->param("problem.$problemID.$field"); - $param = defined $properties{$field}->{default} ? $properties{$field}->{default} : "" unless defined $param && $param ne ""; + $param = defined $properties{$field}->{default} ? $properties{$field}->{default} : "" + unless defined $param && $param ne ""; my $unlabel = $undoLabels{$field}->{$param}; $param = $unlabel if defined $unlabel; - #protect exploits with source_file + #protect exploits with source_file if ($field eq 'source_file') { # add message - if ( $param =~ /\.\./ || $param =~ /^\// ) { - $self->addbadmessage( $r->maketext("Source file paths cannot include .. or start with /: your source file path was modified.") ); + if ($param =~ /\.\./ || $param =~ /^\//) { + $self->addbadmessage( + $r->maketext( + "Source file paths cannot include .. or start with /: your source file path was modified." + ) + ); } $param =~ s|\.\.||g; # prevent access to files above template $param =~ s|^/||; # prevent access to files above template @@ -1614,18 +1662,23 @@ sub initialize { } - foreach my $field ( @{ USER_PROBLEM_FIELDS() } ) { + foreach my $field (@{ USER_PROBLEM_FIELDS() }) { next unless canChange($forUsers, $field); my $param = $r->param("problem.$problemID.$field"); - $param = defined $properties{$field}->{default} ? $properties{$field}->{default} : "" unless defined $param && $param ne ""; + $param = defined $properties{$field}->{default} ? $properties{$field}->{default} : "" + unless defined $param && $param ne ""; my $unlabel = $undoLabels{$field}->{$param}; $param = $unlabel if defined $unlabel; - #protect exploits with source_file + #protect exploits with source_file if ($field eq 'source_file') { # add message - if ( $param =~ /\.\./ || $param =~ /^\// ) { - $self->addbadmessage( $r->maketext("Source file paths cannot include .. or start with /: your source file path was modified.")); + if ($param =~ /\.\./ || $param =~ /^\//) { + $self->addbadmessage( + $r->maketext( + "Source file paths cannot include .. or start with /: your source file path was modified." + ) + ); } $param =~ s|\.\.||g; # prevent access to files above template $param =~ s|^/||; # prevent access to files above template @@ -1634,7 +1687,7 @@ sub initialize { $changed ||= changed($record->$field, $param); $record->$field($param); } - if ( ! $editingSetVersion ) { + if (!$editingSetVersion) { $db->putUserProblem($record) if $changed; } else { $db->putProblemVersion($record) if $changed; @@ -1646,20 +1699,25 @@ sub initialize { # all users to (at least initially) have the same value # this only edits a globalProblem record - my $changed = 0; # keep track of any changes, if none are made, avoid unnecessary db accesses - foreach my $field ( @{ PROBLEM_FIELDS() } ) { + my $changed = 0; # keep track of any changes, if none are made, avoid unnecessary db accesses + foreach my $field (@{ PROBLEM_FIELDS() }) { next unless canChange($forUsers, $field); my $param = $r->param("problem.$problemID.$field"); - $param = defined $properties{$field}->{default} ? $properties{$field}->{default} : "" unless defined $param && $param ne ""; + $param = defined $properties{$field}->{default} ? $properties{$field}->{default} : "" + unless defined $param && $param ne ""; my $unlabel = $undoLabels{$field}->{$param}; $param = $unlabel if defined $unlabel; #protect exploits with source_file if ($field eq 'source_file') { # add message - if ( $param =~ /\.\./ || $param =~ /^\// ) { - $self->addbadmessage( $r->maketext("Source file paths cannot include .. or start with /: your source file path was modified.") ); + if ($param =~ /\.\./ || $param =~ /^\//) { + $self->addbadmessage( + $r->maketext( + "Source file paths cannot include .. or start with /: your source file path was modified." + ) + ); } $param =~ s|\.\.||g; # prevent access to files above template $param =~ s|^/||; # prevent access to files above template @@ -1678,7 +1736,7 @@ sub initialize { # So we'll enforce that there be something worth putting in all the UserProblem records # This also will make hitting "Save Changes" on the global page MUCH faster my %useful; - foreach my $field ( @{ USER_PROBLEM_FIELDS() } ) { + foreach my $field (@{ USER_PROBLEM_FIELDS() }) { my $param = $r->param("problem.$problemID.$field"); $useful{$field} = 1 if defined $param and $param ne ""; } @@ -1686,12 +1744,13 @@ sub initialize { if (keys %useful) { my @userProblemRecords = $db->getUserProblemsWhere({ set_id => $setID, problem_id => $problemID }); foreach my $record (@userProblemRecords) { - my $changed = 0; # keep track of any changes, if none are made, avoid unnecessary db accesses - foreach my $field ( keys %useful ) { + my $changed = 0; # keep track of any changes, if none are made, avoid unnecessary db accesses + foreach my $field (keys %useful) { next unless canChange($forUsers, $field); my $param = $r->param("problem.$problemID.$field"); - $param = defined $properties{$field}->{default} ? $properties{$field}->{default} : "" unless defined $param && $param ne ""; + $param = defined $properties{$field}->{default} ? $properties{$field}->{default} : "" + unless defined $param && $param ne ""; my $unlabel = $undoLabels{$field}->{$param}; $param = $unlabel if defined $unlabel; $changed ||= changed($record->$field, $param); @@ -1717,7 +1776,7 @@ sub initialize { # it may be that there is an argument for being able to get() all # problem versions for all users in one database call. The current # code may be slow for large classes. - if ( $setRecord->assignment_type !~ /gateway/ ) { + if ($setRecord->assignment_type !~ /gateway/) { my @userProblemRecords = $db->getUserProblems(@userProblemIDs); foreach my $record (@userProblemRecords) { if (defined $record && ($record->status eq "" || $record->status < 1)) { @@ -1728,10 +1787,10 @@ sub initialize { } } else { my @userIDs = $forUsers ? @editForUser : $db->listProblemUsers($setID, $problemID); - foreach my $uid ( @userIDs ) { - my @versions = $db->listSetVersions( $uid, $setID ); + foreach my $uid (@userIDs) { + my @versions = $db->listSetVersions($uid, $setID); my @userProblemVersionIDs = - map{ [ $uid, $setID, $_, $problemID ]} @versions; + map { [ $uid, $setID, $_, $problemID ] } @versions; my @userProblemVersionRecords = $db->getProblemVersions(@userProblemVersionIDs); foreach my $record (@userProblemVersionRecords) { if (defined $record && ($record->status eq "" || $record->status < 1)) { @@ -1751,17 +1810,17 @@ sub initialize { # if its a jitar set we have to delete all of the child problems if ($setRecord->assignment_type eq 'jitar') { - my @ids = $db->listGlobalProblems($setID); - my @problemSeq = jitar_id_to_seq($problemID); - ID: foreach my $id (@ids) { - my @seq = jitar_id_to_seq($id); - #check and see if this is a child - next unless $#seq > $#problemSeq; - for (my $i = 0; $i<=$#problemSeq; $i++) { - next ID unless $seq[$i] == $problemSeq[$i]; - } - $db->deleteGlobalProblem($setID,$id); - } + my @ids = $db->listGlobalProblems($setID); + my @problemSeq = jitar_id_to_seq($problemID); + ID: foreach my $id (@ids) { + my @seq = jitar_id_to_seq($id); + #check and see if this is a child + next unless $#seq > $#problemSeq; + for (my $i = 0; $i <= $#problemSeq; $i++) { + next ID unless $seq[$i] == $problemSeq[$i]; + } + $db->deleteGlobalProblem($setID, $id); + } } } @@ -1769,30 +1828,33 @@ sub initialize { # Change problem_ids from regular style to jitar style if appropraite. (not # applicable when editing for users) # this is a very long operaiton because we are shuffling the whole database around - if ($oldAssignmentType ne $setRecord->assignment_type() &&( - $oldAssignmentType eq 'jitar' || - $setRecord->assignment_type eq 'jitar')) { + if ( + $oldAssignmentType ne $setRecord->assignment_type() + && ($oldAssignmentType eq 'jitar' + || $setRecord->assignment_type eq 'jitar') + ) + { - my %newProblemNumbers; - my @ids = $db->listGlobalProblems($setID); - my $i = 1; - foreach my $id (@ids) { + my %newProblemNumbers; + my @ids = $db->listGlobalProblems($setID); + my $i = 1; + foreach my $id (@ids) { - if ($setRecord->assignment_type eq 'jitar') { - $newProblemNumbers{$id} = seq_to_jitar_id(($id)); - } else { - $newProblemNumbers{$id} = $i; - $i++; + if ($setRecord->assignment_type eq 'jitar') { + $newProblemNumbers{$id} = seq_to_jitar_id(($id)); + } else { + $newProblemNumbers{$id} = $i; + $i++; + } } - } - #we dont want to confuse the script by changing the problem - #ids out from under it so remove the params - foreach my $id (@ids) { - $r->param("prob_num_".$id,""); - } + #we dont want to confuse the script by changing the problem + #ids out from under it so remove the params + foreach my $id (@ids) { + $r->param("prob_num_" . $id, ""); + } - handle_problem_numbers($self,\%newProblemNumbers, $db, $setID); + handle_problem_numbers($self, \%newProblemNumbers, $db, $setID); } @@ -1801,134 +1863,136 @@ sub initialize { ################################################################## my %newProblemNumbers = (); - my $prevNum = 0; - my @prevSeq = (0); - + my $prevNum = 0; + my @prevSeq = (0); for my $jj (sort { $a <=> $b } $db->listGlobalProblems($setID)) { - if ($setRecord->assignment_type eq 'jitar') { - my @idSeq; - my $id = $jj; - - next unless $r->param('prob_num_'.$id); + if ($setRecord->assignment_type eq 'jitar') { + my @idSeq; + my $id = $jj; - unshift @idSeq, $r->param('prob_num_'.$id); - while (defined $r->param('prob_parent_id_'.$id)) { - $id = $r->param('prob_parent_id_'.$id); - unshift @idSeq, $r->param('prob_num_'.$id); - } + next unless $r->param('prob_num_' . $id); - $newProblemNumbers{$jj} = seq_to_jitar_id(@idSeq); + unshift @idSeq, $r->param('prob_num_' . $id); + while (defined $r->param('prob_parent_id_' . $id)) { + $id = $r->param('prob_parent_id_' . $id); + unshift @idSeq, $r->param('prob_num_' . $id); + } - } else { - $newProblemNumbers{$jj} = $r->param('prob_num_' . $jj); - } - } + $newProblemNumbers{$jj} = seq_to_jitar_id(@idSeq); - handle_problem_numbers($self,\%newProblemNumbers, $db, $setID) unless defined $r->param('undo_changes'); + } else { + $newProblemNumbers{$jj} = $r->param('prob_num_' . $jj); + } + } + handle_problem_numbers($self, \%newProblemNumbers, $db, $setID) unless defined $r->param('undo_changes'); ##################################################################### # Make problem numbers consecutive if required ##################################################################### - if ($r->param('force_renumber')) { - my %newProblemNumbers = (); - my $prevNum = 0; - my @prevSeq = (0); + my %newProblemNumbers = (); + my $prevNum = 0; + my @prevSeq = (0); - for my $jj (sort { $a <=> $b } $db->listGlobalProblems($setID)) { + for my $jj (sort { $a <=> $b } $db->listGlobalProblems($setID)) { - if ($setRecord->assignment_type eq 'jitar') { - my @idSeq; - my $id = $jj; + if ($setRecord->assignment_type eq 'jitar') { + my @idSeq; + my $id = $jj; - next unless $r->param('prob_num_'.$id); + next unless $r->param('prob_num_' . $id); - unshift @idSeq, $r->param('prob_num_'.$id); - while (defined $r->param('prob_parent_id_'.$id)) { - $id = $r->param('prob_parent_id_'.$id); - unshift @idSeq, $r->param('prob_num_'.$id); - } + unshift @idSeq, $r->param('prob_num_' . $id); + while (defined $r->param('prob_parent_id_' . $id)) { + $id = $r->param('prob_parent_id_' . $id); + unshift @idSeq, $r->param('prob_num_' . $id); + } - # we dont really care about the content of idSeq - # in this case, just the length - my $depth = $#idSeq; + # we dont really care about the content of idSeq + # in this case, just the length + my $depth = $#idSeq; - if ($depth <= $#prevSeq) { - @prevSeq = @prevSeq[ 0 .. $depth ]; - $prevSeq[$#prevSeq]++; - } else { - $prevSeq[$#prevSeq+1] = 1; - } + if ($depth <= $#prevSeq) { + @prevSeq = @prevSeq[ 0 .. $depth ]; + $prevSeq[$#prevSeq]++; + } else { + $prevSeq[ $#prevSeq + 1 ] = 1; + } - $newProblemNumbers{$jj} = seq_to_jitar_id(@prevSeq); + $newProblemNumbers{$jj} = seq_to_jitar_id(@prevSeq); - } else { - $prevNum++; - $newProblemNumbers{$jj} = $prevNum; - } - } + } else { + $prevNum++; + $newProblemNumbers{$jj} = $prevNum; + } + } - handle_problem_numbers($self,\%newProblemNumbers, $db, $setID) unless defined $r->param('undo_changes'); + handle_problem_numbers($self, \%newProblemNumbers, $db, $setID) unless defined $r->param('undo_changes'); } ##################################################################### # Add blank problem if needed ##################################################################### - if (defined($r->param("add_blank_problem") ) and $r->param("add_blank_problem") == 1) { - # get number of problems to add and clean the entry - my $newBlankProblems = (defined($r->param("add_n_problems")) ) ? $r->param("add_n_problems") :1; - $newBlankProblems = int($newBlankProblems); - my $MAX_NEW_PROBLEMS = 20; - my @ids = $self->r->db->listGlobalProblems($setID); - - if ($setRecord->assignment_type eq 'jitar') { - for (my $i=0; $i <= $#ids; $i++) { - my @seq = jitar_id_to_seq($ids[$i]); - $ids[$i] = $seq[0]; - #this strips off the depth 0 problem numbers if its a jitar set + if (defined($r->param("add_blank_problem")) and $r->param("add_blank_problem") == 1) { + # get number of problems to add and clean the entry + my $newBlankProblems = (defined($r->param("add_n_problems"))) ? $r->param("add_n_problems") : 1; + $newBlankProblems = int($newBlankProblems); + my $MAX_NEW_PROBLEMS = 20; + my @ids = $self->r->db->listGlobalProblems($setID); + + if ($setRecord->assignment_type eq 'jitar') { + for (my $i = 0; $i <= $#ids; $i++) { + my @seq = jitar_id_to_seq($ids[$i]); + $ids[$i] = $seq[0]; + #this strips off the depth 0 problem numbers if its a jitar set + } } - } - - my $targetProblemNumber = WeBWorK::Utils::max(@ids); - - if ($newBlankProblems >=1 and $newBlankProblems <= $MAX_NEW_PROBLEMS ) { - foreach my $newProb (1..$newBlankProblems) { - $targetProblemNumber++; - ################################################## - # make local copy of the blankProblem - ################################################## - my $blank_file_path = $ce->{webworkFiles}->{screenSnippets}->{blankProblem}; - my $problemContents = WeBWorK::Utils::readFile($blank_file_path); - my $new_file_path = "set$setID/".BLANKPROBLEM(); - my $fullPath = WeBWorK::Utils::surePathToFile($ce->{courseDirs}->{templates},'/'.$new_file_path); - local(*TEMPFILE); - open(TEMPFILE, ">$fullPath") or warn $r->maketext("Can't write to file [_1]", $fullPath); - print TEMPFILE $problemContents; - close(TEMPFILE); - - ################################################# - # Update problem record - ################################################# - my $problemRecord = $self->addProblemToSet( - setName => $setID, - sourceFile => $new_file_path, - problemID => - $setRecord->assignment_type eq 'jitar' ? - seq_to_jitar_id(($targetProblemNumber)) : - $targetProblemNumber, #added to end of set - ); - - $self->assignProblemToAllSetUsers($problemRecord); - $self->addgoodmessage($r->maketext("Added [_1] to [_2] as problem [_3]", $new_file_path, $setID, $targetProblemNumber)) ; + + my $targetProblemNumber = WeBWorK::Utils::max(@ids); + + if ($newBlankProblems >= 1 and $newBlankProblems <= $MAX_NEW_PROBLEMS) { + foreach my $newProb (1 .. $newBlankProblems) { + $targetProblemNumber++; + ################################################## + # make local copy of the blankProblem + ################################################## + my $blank_file_path = $ce->{webworkFiles}->{screenSnippets}->{blankProblem}; + my $problemContents = WeBWorK::Utils::readFile($blank_file_path); + my $new_file_path = "set$setID/" . BLANKPROBLEM(); + my $fullPath = WeBWorK::Utils::surePathToFile($ce->{courseDirs}->{templates}, '/' . $new_file_path); + local (*TEMPFILE); + open(TEMPFILE, ">$fullPath") or warn $r->maketext("Can't write to file [_1]", $fullPath); + print TEMPFILE $problemContents; + close(TEMPFILE); + + ################################################# + # Update problem record + ################################################# + my $problemRecord = $self->addProblemToSet( + setName => $setID, + sourceFile => $new_file_path, + problemID => $setRecord->assignment_type eq 'jitar' + ? seq_to_jitar_id(($targetProblemNumber)) + : $targetProblemNumber, #added to end of set + ); + + $self->assignProblemToAllSetUsers($problemRecord); + $self->addgoodmessage($r->maketext( + "Added [_1] to [_2] as problem [_3]", + $new_file_path, $setID, $targetProblemNumber + )); } } else { - $self->addbadmessage($r->maketext("Could not add [_1] problems to this set. The number must be between 1 and [_2]", $newBlankProblems, $MAX_NEW_PROBLEMS)); + $self->addbadmessage($r->maketext( + "Could not add [_1] problems to this set. The number must be between 1 and [_2]", + $newBlankProblems, $MAX_NEW_PROBLEMS + )); } } @@ -1948,7 +2012,7 @@ sub initialize { # if the current naming scheme is changed/broken, this could reek havoc # on all kinds of things foreach my $param ($r->param) { - $r->param($param, "") if $param =~ /^(set|problem|header)\./ && $param !~ /displaymode/; + $r->param($param, "") if $param =~ /^(set|problem|header)\./ && $param !~ /displaymode/; } } } @@ -1958,7 +2022,7 @@ sub definedness ($) { my ($variable) = @_; return "undefined" unless defined $variable; - return "empty" unless $variable ne ""; + return "empty" unless $variable ne ""; return $variable; } @@ -1967,11 +2031,11 @@ sub definedness ($) { sub changed ($$) { my ($first, $second) = @_; - return "def/undef" if defined $first and not defined $second; + return "def/undef" if defined $first and not defined $second; return "undef/def" if not defined $first and defined $second; - return "" if not defined $first and not defined $second; - return "ne" if $first ne $second; - return ""; # if they're equal, there's no change + return "" if not defined $first and not defined $second; + return "ne" if $first ne $second; + return ""; # if they're equal, there's no change } # helper method that determines for how many users at a time a field can be changed @@ -1990,46 +2054,48 @@ sub canChange ($$) { return 1 if $howManyCan eq "any"; return 1 if $howManyCan eq "one" && $forOneUser; return 1 if $howManyCan eq "all" && !$forUsers; - return 0; # FIXME: maybe it should default to 1? + return 0; # FIXME: maybe it should default to 1? } # helper method that determines if a file is valid and returns a pretty error message sub checkFile ($) { my ($self, $filePath, $headerType) = @_; - my $r = $self->r; + my $r = $self->r; my $ce = $r->ce; return $r->maketext("No source filePath specified") unless $filePath; return $r->maketext("Problem source is drawn from a grouping set") if $filePath =~ /^group/; - if ( $filePath eq "defaultHeader" ) { + if ($filePath eq "defaultHeader") { if ($headerType eq 'set_header') { - $filePath = $ce->{webworkFiles}{screenSnippets}{setHeader}; - } elsif ($headerType eq 'hardcopy_header') { + $filePath = $ce->{webworkFiles}{screenSnippets}{setHeader}; + } elsif ($headerType eq 'hardcopy_header') { $filePath = $ce->{webworkFiles}{hardcopySnippets}{setHeader}; - } else { + } else { return $r->maketext("Invalid headerType [_1]", $headerType); } } else { - # $filePath = $ce->{courseDirs}->{templates} . '/' . $filePath unless $filePath =~ m|^/|; # bug: 1725 allows access to all files e.g. /etc/passwd - $filePath = $ce->{courseDirs}->{templates} . '/' . $filePath ; # only filePaths in template directory can be accessed +# $filePath = $ce->{courseDirs}->{templates} . '/' . $filePath unless $filePath =~ m|^/|; # bug: 1725 allows access to all files e.g. /etc/passwd + $filePath = + $ce->{courseDirs}->{templates} . '/' . $filePath; # only filePaths in template directory can be accessed } my $fileError; - return "" if -e $filePath && -f $filePath && -r $filePath; + return "" if -e $filePath && -f $filePath && -r $filePath; return $r->maketext("This source file is not readable!") if -e $filePath && -f $filePath; - return $r->maketext("This source file is a directory!") if -d $filePath; + return $r->maketext("This source file is a directory!") if -d $filePath; return $r->maketext("This source file does not exist!") unless -e $filePath; return $r->maketext("This source file is not a plain file!"); } # Make sure restrictor sets exist sub check_sets { - my ($self,$db,$sets_string) = @_; - my @proposed_sets = split(/\s*,\s*/,$sets_string); - foreach(@proposed_sets) { - $self->addbadmessage("Error: $_ is not a valid set name in restricted release list!") unless $db->existsGlobalSet($_); + my ($self, $db, $sets_string) = @_; + my @proposed_sets = split(/\s*,\s*/, $sets_string); + foreach (@proposed_sets) { + $self->addbadmessage("Error: $_ is not a valid set name in restricted release list!") + unless $db->existsGlobalSet($_); } } @@ -2038,26 +2104,26 @@ sub check_sets { # becomes editable, not all the data sub body { - my ($self) = @_; - my $r = $self->r; - my $db = $r->db; - my $ce = $r->ce; - my $authz = $r->authz; - my $userID = $r->param('user'); - my $urlpath = $r->urlpath; - my $courseID = $urlpath->arg("courseID"); - my $setID = $urlpath->arg("setID"); + my ($self) = @_; + my $r = $self->r; + my $db = $r->db; + my $ce = $r->ce; + my $authz = $r->authz; + my $userID = $r->param('user'); + my $urlpath = $r->urlpath; + my $courseID = $urlpath->arg("courseID"); + my $setID = $urlpath->arg("setID"); ## we're now allowing setID to come in as setID,v# to edit a set ## version; catch this first my $editingSetVersion = 0; - my $fullSetID = $setID; - if ( $setID =~ /,v(\d+)$/ ) { - $editingSetVersion = $1; - $setID =~ s/,v(\d+)$//; + my $fullSetID = $setID; + if ($setID =~ /,v(\d+)$/) { + $editingSetVersion = $1; + $setID =~ s/,v(\d+)$//; } - my $setRecord = $db->getGlobalSet($setID) or die $r->maketext("No record for global set [_1].", $setID); + my $setRecord = $db->getGlobalSet($setID) or die $r->maketext("No record for global set [_1].", $setID); my $userRecord = $db->getUser($userID) or die $r->maketext("No record for user [_1].", $userID); # Check permissions @@ -2111,12 +2177,12 @@ sub body { } # some useful booleans - my $forUsers = scalar(@editForUser); - my $forOneUser = $forUsers == 1; + my $forUsers = scalar(@editForUser); + my $forOneUser = $forUsers == 1; # and check that if we're editing a set version for a user, that # it exists as well - if ( $editingSetVersion && ! $db->existsSetVersion( $editForUser[0], $setID, $editingSetVersion ) ) { + if ($editingSetVersion && !$db->existsSetVersion($editForUser[0], $setID, $editingSetVersion)) { return CGI::div( { class => 'alert alert-danger p-1 mb-0' }, $r->maketext( @@ -2129,11 +2195,11 @@ sub body { # If you're editing for users, initially their records will be different but # if you make any changes to them they will be the same. # if you're editing for one user, the problems shown should be his/hers - my $userToShow = $forUsers ? $editForUser[0] : $userID; + my $userToShow = $forUsers ? $editForUser[0] : $userID; # a useful gateway variable - my $isGatewaySet = ( $setRecord->assignment_type =~ /gateway/ ) ? 1 : 0; - my $isJitarSet = ( $setRecord->assignment_type eq 'jitar' ) ? 1 : 0; + my $isGatewaySet = ($setRecord->assignment_type =~ /gateway/) ? 1 : 0; + my $isJitarSet = ($setRecord->assignment_type eq 'jitar') ? 1 : 0; my $userCount = $db->countUsers(); my $setCount = $db->countGlobalSets(); # if $forOneUser; @@ -2141,47 +2207,59 @@ sub body { # if $forOneUser; my $userSetCount = ($forOneUser && @editForUser) ? $db->countUserSets($editForUser[0]) : 0; - my $editUsersAssignedToSetURL = $self->systemLink( - $urlpath->newFromModule( - "WeBWorK::ContentGenerator::Instructor::UsersAssignedToSet", $r, courseID => $courseID, setID => $setID),params=>{pageVersion=> "instructor_set_detail"}); - my $editSetsAssignedToUserURL = $self->systemLink( - $urlpath->newFromModule( - "WeBWorK::ContentGenerator::Instructor::UserDetail",$r, - courseID => $courseID, userID => $editForUser[0])) if $forOneUser; - + $urlpath->newFromModule( + "WeBWorK::ContentGenerator::Instructor::UsersAssignedToSet", $r, + courseID => $courseID, + setID => $setID + ), + params => { pageVersion => "instructor_set_detail" } + ); + my $editSetsAssignedToUserURL = $self->systemLink($urlpath->newFromModule( + "WeBWorK::ContentGenerator::Instructor::UserDetail", $r, + courseID => $courseID, + userID => $editForUser[0] + )) + if $forOneUser; - my $setDetailPage = $urlpath -> newFromModule($urlpath->module, $r, courseID => $courseID, setID => $setID); - my $fullsetDetailPage = $urlpath -> newFromModule($urlpath->module, $r, courseID => $courseID, setID => $fullSetID); - my $setDetailURL = $self->systemLink($fullsetDetailPage, authen=>0); + my $setDetailPage = $urlpath->newFromModule($urlpath->module, $r, courseID => $courseID, setID => $setID); + my $fullsetDetailPage = $urlpath->newFromModule($urlpath->module, $r, courseID => $courseID, setID => $fullSetID); + my $setDetailURL = $self->systemLink($fullsetDetailPage, authen => 0); if ($forUsers) { - ############################################## + ############################################## # calculate links for the users being edited: ############################################## my @userLinks = (); foreach my $userID (@editForUser) { - my $u = $db->getUser($userID); + my $u = $db->getUser($userID); my $email_address = $u->email_address; - my $line = $u->last_name.", " . $u->first_name . "  (" . - CGI::a({-href=>"mailto:$email_address"},"email "). $u->user_id . - "). "; - if ( ! $editingSetVersion ) { - $line .= $r->maketext("Assigned to").' '; - my $editSetsAssignedToUserURL = $self->systemLink( - $urlpath->newFromModule( - "WeBWorK::ContentGenerator::Instructor::UserDetail", $r, - courseID => $courseID, userID => $u->user_id)); - $line .= CGI::a({href=>$editSetsAssignedToUserURL}, - $self->setCountMessage($db->countUserSets($u->user_id), - $setCount)); + my $line = + $u->last_name . ", " + . $u->first_name + . "  (" + . CGI::a({ -href => "mailto:$email_address" }, "email ") + . $u->user_id . "). "; + if (!$editingSetVersion) { + $line .= $r->maketext("Assigned to") . ' '; + my $editSetsAssignedToUserURL = $self->systemLink($urlpath->newFromModule( + "WeBWorK::ContentGenerator::Instructor::UserDetail", $r, + courseID => $courseID, + userID => $u->user_id + )); + $line .= CGI::a({ href => $editSetsAssignedToUserURL }, + $self->setCountMessage($db->countUserSets($u->user_id), $setCount)); } else { - my $editSetLink = $self->systemLink( $setDetailPage, - params=>{effectiveUser=>$u->user_id, - editForUser =>$u->user_id} ); - $line .= $r->maketext("Edit set [_1] for this user.", CGI::a({href=>$editSetLink},$setID)); + my $editSetLink = $self->systemLink( + $setDetailPage, + params => { + effectiveUser => $u->user_id, + editForUser => $u->user_id + } + ); + $line .= $r->maketext("Edit set [_1] for this user.", CGI::a({ href => $editSetLink }, $setID)); } - unshift @userLinks,$line; + unshift @userLinks, $line; } @userLinks = sort @userLinks; @@ -2246,9 +2324,9 @@ sub body { my %properties = %{ FIELD_PROPERTIES() }; - my %display_modes = %{WeBWorK::PG::DISPLAY_MODES()}; - my @active_modes = grep { exists $display_modes{$_} } @{$r->ce->{pg}->{displayModes}}; - my $default_header_mode = $r->param('header.displaymode') || $r->maketext('None'); + my %display_modes = %{ WeBWorK::PG::DISPLAY_MODES() }; + my @active_modes = grep { exists $display_modes{$_} } @{ $r->ce->{pg}->{displayModes} }; + my $default_header_mode = $r->param('header.displaymode') || $r->maketext('None'); my $default_problem_mode = $r->param('problem.displaymode') || $r->maketext('None'); ##################################################################### @@ -2256,16 +2334,16 @@ sub body { ##################################################################### my $templates = $r->ce->{courseDirs}->{templates}; - my $skip = join("|", keys %{ $r->ce->{courseFiles}->{problibs} }); + my $skip = join("|", keys %{ $r->ce->{courseFiles}->{problibs} }); my @headerFileList = listFilesRecursive( $templates, - qr/header.*\.pg$/i, # match these files - qr/^(?:$skip|svn)$/, # prune these directories - 0, # match against file name only - 1, # prune against path relative to $templates + qr/header.*\.pg$/i, # match these files + qr/^(?:$skip|svn)$/, # prune these directories + 0, # match against file name only + 1, # prune against path relative to $templates ); - @headerFileList = sortByName(undef,@headerFileList); + @headerFileList = sortByName(undef, @headerFileList); # Display a useful warning message print CGI::div( @@ -2275,24 +2353,27 @@ sub body { : $r->maketext('Any changes made below will be reflected in the set for ALL students.') ); - print CGI::start_form({id=>"problem_set_form", name=>"problem_set_form", method=>"POST", action=>$setDetailURL}); + print CGI::start_form( + { id => "problem_set_form", name => "problem_set_form", method => "POST", action => $setDetailURL }); print $self->hiddenEditForUserFields(@editForUser); print $self->hidden_authen_fields; - print CGI::input({type=>"hidden", id=>"hidden_course_id", name=>"courseID", value=>$courseID}); - print CGI::input({type=>"hidden", id=>"hidden_set_id", name=>"setID", value=>$setID}); - print CGI::input({type=>"hidden", id=>"hidden_version_id", name=>"versionID", value=>$editingSetVersion}) if $editingSetVersion; + print CGI::input({ type => "hidden", id => "hidden_course_id", name => "courseID", value => $courseID }); + print CGI::input({ type => "hidden", id => "hidden_set_id", name => "setID", value => $setID }); + print CGI::input({ type => "hidden", id => "hidden_version_id", name => "versionID", value => $editingSetVersion }) + if $editingSetVersion; # Add the course language in a hidden input so that the javascript can get this information. print CGI::hidden({ name => 'hidden_language', value => $ce->{language} }); - print CGI::div({ class => 'my-3 submit-buttons-container' }, + print CGI::div( + { class => 'my-3 submit-buttons-container' }, CGI::submit({ - name => "submit_changes", + name => "submit_changes", value => $r->maketext("Save Changes"), class => 'btn btn-primary' }), CGI::submit({ - name => "undo_changes", + name => "undo_changes", value => $r->maketext("Reset Form"), class => 'btn btn-primary' }) @@ -2309,9 +2390,9 @@ sub body { my $templateUserSetRecord; # send in the set version if we're editing for versions - if ( $editingSetVersion ) { + if ($editingSetVersion) { $templateUserSetRecord = $userSetRecord; - $userSetRecord = $db->getSetVersion( $userToShow, $setID, $editingSetVersion ); + $userSetRecord = $db->getSetVersion($userToShow, $setID, $editingSetVersion); } print CGI::div( @@ -2356,9 +2437,12 @@ sub body { ); # Display header information - my @headers = @{ HEADER_ORDER() }; - my %headerModules = (set_header => 'problem_list', hardcopy_header => 'hardcopy_preselect_set'); - my %headerDefaults = (set_header => $ce->{webworkFiles}->{screenSnippets}->{setHeader}, hardcopy_header => $ce->{webworkFiles}->{hardcopySnippets}->{setHeader}); + my @headers = @{ HEADER_ORDER() }; + my %headerModules = (set_header => 'problem_list', hardcopy_header => 'hardcopy_preselect_set'); + my %headerDefaults = ( + set_header => $ce->{webworkFiles}->{screenSnippets}->{setHeader}, + hardcopy_header => $ce->{webworkFiles}->{hardcopySnippets}->{setHeader} + ); my @headerFiles = map { $setRecord->{$_} } @headers; if (scalar @headers and not $forUsers) { @@ -2470,12 +2554,10 @@ sub body { print CGI::end_div(), CGI::end_div(); } else { - print CGI::p( - CGI::b( - $r->maketext( - "Screen and Hardcopy set header information can not be overridden for individual students.") - ) - ); + print CGI::p(CGI::b( + $r->maketext( + "Screen and Hardcopy set header information can not be overridden for individual students.") + )); } ##################################################################### @@ -2520,8 +2602,10 @@ sub body { { id => 'psd_render_all', class => 'btn btn-secondary', role => 'button', tabindex => 0 }, $r->maketext('Render All') ), - CGI::a({ id => 'psd_hide_all', class => 'btn btn-secondary', role => 'button', tabindex => 0 }, - $r->maketext('Hide All')) + CGI::a( + { id => 'psd_hide_all', class => 'btn btn-secondary', role => 'button', tabindex => 0 }, + $r->maketext('Hide All') + ) ), $forUsers ? '' : CGI::div( { class => 'btn-group w-auto me-3 py-1' }, @@ -2756,7 +2840,9 @@ sub body { data_bs_placement => 'top', data_bs_title => $r->maketext('Edit Problem') }, - CGI::i({ class => 'icon fas fa-pencil-alt', data_alt => $r->maketext('Edit') }, '') + CGI::i( + { class => 'icon fas fa-pencil-alt', data_alt => $r->maketext('Edit') }, '' + ) ) : '' ), ( @@ -2778,7 +2864,8 @@ sub body { { class => 'col-md-2 col-3 order-md-2 order-3' }, $forUsers ? CGI::div( { - class => 'form-check form-check-inline col-form-label col-form-label-sm text-nowrap' + class => + 'form-check form-check-inline col-form-label col-form-label-sm text-nowrap' }, $source_file_parts[0], $source_file_parts[1] @@ -2842,11 +2929,12 @@ sub body { ) ) ), - $forUsers - ? CGI::div( - { class => 'col-md-6 offset-md-0 col-9 offset-3 font-sm order-md-last order-first' }, - $source_file_parts[4]) - : '' + $forUsers ? CGI::div( + { + class => 'col-md-6 offset-md-0 col-9 offset-3 font-sm order-md-last order-first' + }, + $source_file_parts[4] + ) : '' ), CGI::div( { class => 'row' }, @@ -2864,7 +2952,8 @@ sub body { : '', CGI::div( { class => 'psr_render_area', id => "psr_render_area_$problemID" }, - $error ? CGI::div({ class => 'alert alert-danger p-1 mb-0 fw-bold' }, $error) : '' + $error ? CGI::div({ class => 'alert alert-danger p-1 mb-0 fw-bold' }, $error) + : '' ) ) ) @@ -2900,9 +2989,7 @@ sub body { print CGI::ol( { id => 'psd_list', class => 'sortable-branch' . ($forUsers ? ' disable_renumber' : '') }, map { - CGI::li( - { class => 'psd_list_item', id => "psd_list_item_$problemIDList[$_]" }, - $problemRow[$_]) + CGI::li({ class => 'psd_list_item', id => "psd_list_item_$problemIDList[$_]" }, $problemRow[$_]) } 0 .. $#problemIDList ); } @@ -2949,38 +3036,43 @@ sub body { } # Always allow one to add a new problem, unless we're editing a set version. - if ( ! $editingSetVersion ) { - print CGI::div({ class => 'input-group' }, - CGI::div({ class => 'input-group-text' }, + if (!$editingSetVersion) { + print CGI::div( + { class => 'input-group' }, + CGI::div( + { class => 'input-group-text' }, CGI::input({ - type => 'checkbox', - id => 'add_blank_problem', - name => 'add_blank_problem', + type => 'checkbox', + id => 'add_blank_problem', + name => 'add_blank_problem', value => '1', class => 'form-check-input mt-0', }) ), CGI::label({ for => 'add_blank_problem', class => 'input-group-text' }, $r->maketext('Add')), CGI::input({ - name => 'add_n_problems', - id => 'add_n_problems', - type => 'text', + name => 'add_n_problems', + id => 'add_n_problems', + type => 'text', value => 1, class => 'form-control flex-grow-0' }), - CGI::label({ for => 'add_n_problems', class => 'input-group-text' }, - $r->maketext('blank problem template(s) to end of homework set')) - ) + CGI::label( + { for => 'add_n_problems', class => 'input-group-text' }, + $r->maketext('blank problem template(s) to end of homework set') + ) + ); } - print CGI::div({ class => 'mt-3 submit-buttons-container align-items-center' }, + print CGI::div( + { class => 'mt-3 submit-buttons-container align-items-center' }, CGI::submit({ - name => 'submit_changes', + name => 'submit_changes', value => $r->maketext('Save Changes'), class => 'btn btn-primary' }), CGI::submit({ - name => 'undo_changes', + name => 'undo_changes', value => $r->maketext('Reset Form'), class => 'btn btn-primary' }), diff --git a/lib/WeBWorK/ContentGenerator/Instructor/ProblemSetList.pm b/lib/WeBWorK/ContentGenerator/Instructor/ProblemSetList.pm index 20f630e4b8..530197f3c1 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/ProblemSetList.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/ProblemSetList.pm @@ -84,189 +84,194 @@ use WeBWorK::Debug; use WeBWorK::Utils qw(timeToSec readFile listFilesRecursive jitar_id_to_seq seq_to_jitar_id x getAssetURL format_set_name_internal format_set_name_display); -use constant HIDE_SETS_THRESHOLD => 500; -use constant DEFAULT_VISIBILITY_STATE => 1; +use constant HIDE_SETS_THRESHOLD => 500; +use constant DEFAULT_VISIBILITY_STATE => 1; use constant DEFAULT_ENABLED_REDUCED_SCORING_STATE => 0; -use constant ONE_WEEK => 60*60*24*7; +use constant ONE_WEEK => 60 * 60 * 24 * 7; -use constant EDIT_FORMS => [qw(saveEdit cancelEdit)]; -use constant VIEW_FORMS => [qw(filter sort edit publish import export score create delete)]; +use constant EDIT_FORMS => [qw(saveEdit cancelEdit)]; +use constant VIEW_FORMS => [qw(filter sort edit publish import export score create delete)]; use constant EXPORT_FORMS => [qw(saveExport cancelExport)]; # Prepare the tab titles for translation by maketext use constant FORM_TITLES => { - saveEdit => x("Save Edit"), - cancelEdit => x("Cancel Edit"), - filter => x("Filter"), - sort => x("Sort"), - edit => x("Edit"), - publish => x("Publish"), - import => x("Import"), - export => x("Export"), - score => x("Score"), - create => x("Create"), - delete => x("Delete"), - saveExport => x("Save Export"), - cancelExport => x("Cancel Export") + saveEdit => x("Save Edit"), + cancelEdit => x("Cancel Edit"), + filter => x("Filter"), + sort => x("Sort"), + edit => x("Edit"), + publish => x("Publish"), + import => x("Import"), + export => x("Export"), + score => x("Score"), + create => x("Create"), + delete => x("Delete"), + saveExport => x("Save Export"), + cancelExport => x("Cancel Export") }; -use constant VIEW_FIELD_ORDER => [ qw( set_id problems users visible enable_reduced_scoring open_date reduced_scoring_date due_date answer_date) ]; -use constant EDIT_FIELD_ORDER => [ qw( set_id visible enable_reduced_scoring open_date reduced_scoring_date due_date answer_date) ]; -use constant EXPORT_FIELD_ORDER => [ qw( select set_id problems users) ]; +use constant VIEW_FIELD_ORDER => + [qw( set_id problems users visible enable_reduced_scoring open_date reduced_scoring_date due_date answer_date)]; +use constant EDIT_FIELD_ORDER => + [qw( set_id visible enable_reduced_scoring open_date reduced_scoring_date due_date answer_date)]; +use constant EXPORT_FIELD_ORDER => [qw( select set_id problems users)]; # permissions needed to perform a given action use constant FORM_PERMS => { - saveEdit => "modify_problem_sets", - edit => "modify_problem_sets", - publish => "modify_problem_sets", - import => "create_and_delete_problem_sets", - export => "modify_set_def_files", - saveExport => "modify_set_def_files", - score => "score_sets", - create => "create_and_delete_problem_sets", - delete => "create_and_delete_problem_sets", + saveEdit => "modify_problem_sets", + edit => "modify_problem_sets", + publish => "modify_problem_sets", + import => "create_and_delete_problem_sets", + export => "modify_set_def_files", + saveExport => "modify_set_def_files", + score => "score_sets", + create => "create_and_delete_problem_sets", + delete => "create_and_delete_problem_sets", }; # permissions needed to view a given field use constant FIELD_PERMS => { - problems => "modify_problem_sets", - users => "assign_problem_sets", + problems => "modify_problem_sets", + users => "assign_problem_sets", }; -use constant STATE_PARAMS => [qw(user effectiveUser key visible_sets no_visible_sets prev_visible_sets no_prev_visible_set editMode exportMode primarySortField secondarySortField)]; +use constant STATE_PARAMS => [ + qw(user effectiveUser key visible_sets no_visible_sets prev_visible_sets no_prev_visible_set editMode exportMode primarySortField secondarySortField) +]; # note that field_properties for some fields, in particular, gateway # parameters, are not currently shown in the edit or display tables -use constant FIELD_PROPERTIES => { +use constant FIELD_PROPERTIES => { set_id => { - type => "text", - size => 8, + type => "text", + size => 8, access => "readonly", }, open_date => { - type => "date", - size => 22, + type => "date", + size => 22, access => "readwrite", }, reduced_scoring_date => { - type => "date", - size => 22, + type => "date", + size => 22, access => "readwrite", }, due_date => { - type => "date", - size => 22, + type => "date", + size => 22, access => "readwrite", }, answer_date => { - type => "date", - size => 22, + type => "date", + size => 22, access => "readwrite", }, visible => { - type => "checked", - size => 4, + type => "checked", + size => 4, access => "readwrite", }, enable_reduced_scoring => { - type => "checked", - size => 4, + type => "checked", + size => 4, access => "readwrite", }, assignment_type => { - type => "text", - size => 20, + type => "text", + size => 20, access => "readwrite", }, attempts_per_version => { - type => "text", - size => 4, + type => "text", + size => 4, access => "readwrite", }, time_interval => { - type => "text", - size => 10, + type => "text", + size => 10, access => "readwrite", }, versions_per_interval => { - type => "text", - size => 4, + type => "text", + size => 4, access => "readwrite", }, version_time_limit => { - type => "text", - size => 10, + type => "text", + size => 10, access => "readwrite", }, problem_randorder => { - type => "text", - size => 4, + type => "text", + size => 4, access => "readwrite", }, problems_per_page => { - type => "text", - size => 4, + type => "text", + size => 4, access => "readwrite", }, version_creation_time => { - type => "text", - size => 10, + type => "text", + size => 10, access => "readonly", }, version_last_attempt_time => { - type => "text", - size => 10, + type => "text", + size => 10, access => "readonly", }, # hide_score and hide_work should be drop down selects with # options 'N', 'Y' and 'BeforeAnswerDate'. in that we don't # allow editing of these fields in this module, this is moot. hide_score => { - type => "text", - size => 16, + type => "text", + size => 16, access => "readwrite", }, hide_work => { - type => "text", - size => 16, + type => "text", + size => 16, access => "readwrite", }, time_limit_cap => { - type => "checked", - size => 4, + type => "checked", + size => 4, access => "readwrite", }, # this should be 'No', 'RestrictTo' or 'DenyFrom' restrict_ip => { - type => "text", - size => 10, + type => "text", + size => 10, access => "readwrite", }, -# hide_hint => { -# type => "checked", -# size => 4, -# access => "readwrite", -# } + # hide_hint => { + # type => "checked", + # size => 4, + # access => "readwrite", + # } }; sub pre_header_initialize { - my ($self) = @_; - my $r = $self->r; - my $db = $r->db; - my $authz = $r->authz; - my $urlpath = $r->urlpath; - my $user = $r->param('user'); + my ($self) = @_; + my $r = $self->r; + my $db = $r->db; + my $authz = $r->authz; + my $urlpath = $r->urlpath; + my $user = $r->param('user'); my $courseName = $urlpath->arg("courseID"); # Check permissions return unless $authz->hasPermissions($user, "access_instructor_tools"); # Get the list of global sets and the number of users and cache them for later use. - $self->{allSetIDs} = [ $db->listGlobalSets() ]; + $self->{allSetIDs} = [ $db->listGlobalSets() ]; $self->{totalUsers} = $db->countUsers; - if (defined $r->param("action") and $r->param("action") eq "score" and $authz->hasPermissions($user, "score_sets")) { - my $scope = $r->param("action.score.scope"); + if (defined $r->param("action") and $r->param("action") eq "score" and $authz->hasPermissions($user, "score_sets")) + { + my $scope = $r->param("action.score.scope"); my @setsToScore = (); if ($scope eq "none") { @@ -293,15 +298,15 @@ sub pre_header_initialize { sub initialize { - my ($self) = @_; - my $r = $self->r; - my $urlpath = $r->urlpath; - my $db = $r->db; - my $ce = $r->ce; - my $authz = $r->authz; - my $courseName = $urlpath->arg("courseID"); - my $setID = $urlpath->arg("setID"); - my $user = $r->param('user'); + my ($self) = @_; + my $r = $self->r; + my $urlpath = $r->urlpath; + my $db = $r->db; + my $ce = $r->ce; + my $authz = $r->authz; + my $courseName = $urlpath->arg("courseID"); + my $setID = $urlpath->arg("setID"); + my $user = $r->param('user'); # Determine if the user has permisson to do anything here. return unless $authz->hasPermissions($user, 'access_instructor_tools'); @@ -338,7 +343,7 @@ sub initialize { $self->{selectedSetIDs} = []; } - $self->{primarySortField} = $r->param("primarySortField") || "due_date"; + $self->{primarySortField} = $r->param("primarySortField") || "due_date"; $self->{secondarySortField} = $r->param("secondarySortField") || "open_date"; ######################################### @@ -359,7 +364,7 @@ sub initialize { $genericParams{$param} = [ $r->param($param) ]; } my %actionParams = $self->getActionParams($actionID); - my %tableParams = $self->getTableParams(); + my %tableParams = $self->getTableParams(); $self->addmessage(CGI::div({ class => 'mb-1' }, $r->maketext("Results of last action performed") . ": ")); $self->addmessage($self->$actionHandler(\%genericParams, \%actionParams, \%tableParams)); } else { @@ -372,15 +377,15 @@ sub initialize { } sub body { - my ($self) = @_; - my $r = $self->r; - my $urlpath = $r->urlpath; - my $db = $r->db; - my $ce = $r->ce; - my $authz = $r->authz; - my $courseName = $urlpath->arg("courseID"); - my $setID = $urlpath->arg("setID"); - my $user = $r->param('user'); + my ($self) = @_; + my $r = $self->r; + my $urlpath = $r->urlpath; + my $db = $r->db; + my $ce = $r->ce; + my $authz = $r->authz; + my $courseName = $urlpath->arg("courseID"); + my $setID = $urlpath->arg("setID"); + my $user = $r->param('user'); my $root = $ce->{webworkURLs}->{root}; @@ -402,7 +407,7 @@ sub body { # This table can be consulted when display-ready forms of field names are needed. my %fieldHeaders; - @fieldHeaders{qw( + @fieldHeaders{ qw( problems users filename @@ -414,16 +419,16 @@ sub body { visible enable_reduced_scoring hide_hint - )} = ( + ) } = ( CGI::th({ id => 'problems_header' }, $r->maketext("Edit Problems")), - CGI::th({ id => 'users_header' }, $r->maketext("Edit Assigned Users")), + CGI::th({ id => 'users_header' }, $r->maketext("Edit Assigned Users")), CGI::th({ id => 'filename_header' }, $r->maketext("Set Definition Filename")), CGI::th(CGI::label({ for => 'select-all' }, $r->maketext("Edit Set Data"))), - CGI::th({ id => 'open_date_header' }, $r->maketext("Open Date")), + CGI::th({ id => 'open_date_header' }, $r->maketext("Open Date")), CGI::th({ id => 'reduced_scoring_date_header' }, $r->maketext("Reduced Scoring Date")), - CGI::th({ id => 'due_date_header' }, $r->maketext("Close Date")), - CGI::th({ id => 'answer_date_header' }, $r->maketext("Answer Date")), - CGI::th({ id => 'visible_header' }, $r->maketext("Visible")), + CGI::th({ id => 'due_date_header' }, $r->maketext("Close Date")), + CGI::th({ id => 'answer_date_header' }, $r->maketext("Answer Date")), + CGI::th({ id => 'visible_header' }, $r->maketext("Visible")), CGI::th($r->maketext("Reduced Scoring")), CGI::th({ id => 'hide_hint_header' }, $r->maketext("Hide Hints")) ); @@ -431,9 +436,9 @@ sub body { my $actionID = $self->{actionID}; # Retrieve values for member fields - my $editMode = $self->{editMode}; - my $exportMode = $self->{exportMode}; - my $primarySortField = $self->{primarySortField}; + my $editMode = $self->{editMode}; + my $exportMode = $self->{exportMode}; + my $primarySortField = $self->{primarySortField}; my $secondarySortField = $self->{secondarySortField}; # Get requested sets in the requested order. @@ -485,7 +490,7 @@ sub body { if (@{ $self->{visibleSetIDs} }) { print CGI::hidden(-name => "visible_sets", -value => $self->{visibleSetIDs}); } else { - print CGI::hidden(-name=>"no_visible_sets", -value=>"1"); + print CGI::hidden(-name => "no_visible_sets", -value => "1"); } if (@{ $self->{prevVisibleSetIDs} }) { @@ -494,19 +499,20 @@ sub body { print CGI::hidden(-name => "no_prev_visible_sets", -value => "1"); } - print CGI::hidden(-name=>"editMode", -value=>$editMode); - print CGI::hidden(-name=>"exportMode", -value=>$exportMode); + print CGI::hidden(-name => "editMode", -value => $editMode); + print CGI::hidden(-name => "exportMode", -value => $exportMode); - print CGI::hidden(-name=>"primarySortField", -value=>$primarySortField); - print CGI::hidden(-name=>"secondarySortField", -value=>$secondarySortField); + print CGI::hidden(-name => "primarySortField", -value => $primarySortField); + print CGI::hidden(-name => "secondarySortField", -value => $secondarySortField); print "\n\n"; ########## print action forms - print CGI::p(CGI::b($r->maketext("Any changes made below will be reflected in the set for ALL students."))) if $editMode; + print CGI::p(CGI::b($r->maketext("Any changes made below will be reflected in the set for ALL students."))) + if $editMode; - print CGI::p($r->maketext("Select an action to perform").":"); + print CGI::p($r->maketext("Select an action to perform") . ":"); my @formsToShow; if ($editMode) { @@ -566,10 +572,8 @@ sub body { } print CGI::hidden(-name => 'action', -id => 'current_action', -value => $default_choice); - print CGI::div( - CGI::ul({ class => 'nav nav-tabs mb-2', role => 'tablist' }, @tabArr), - CGI::div({ class => 'tab-content' }, @contentArr) - ); + print CGI::div(CGI::ul({ class => 'nav nav-tabs mb-2', role => 'tablist' }, @tabArr), + CGI::div({ class => 'tab-content' }, @contentArr)); print CGI::submit({ id => 'take_action', @@ -585,14 +589,11 @@ sub body { CGI::th({ id => 'enable_reduced_scoring_header' }, $r->maketext('Enable Reduced Scoring')) if $editMode; - - print CGI::p( - $r->maketext( - "Showing [_1] out of [_2] sets.", - scalar @{ $self->{visibleSetIDs} }, - scalar @{ $self->{allSetIDs} } - ) - ); + print CGI::p($r->maketext( + "Showing [_1] out of [_2] sets.", + scalar @{ $self->{visibleSetIDs} }, + scalar @{ $self->{allSetIDs} } + )); $self->printTableHTML( \@Sets, \%fieldHeaders, @@ -603,7 +604,7 @@ sub body { ########## print end of form - print CGI::end_form(); + print CGI::end_form(); return ""; } @@ -799,25 +800,24 @@ sub sort_handler { my ($self, $genericParams, $actionParams, $tableParams) = @_; my $r = $self->r; - my $primary = $actionParams->{"action.sort.primary"}->[0]; + my $primary = $actionParams->{"action.sort.primary"}->[0]; my $secondary = $actionParams->{"action.sort.secondary"}->[0]; - $self->{primarySortField} = $primary; + $self->{primarySortField} = $primary; $self->{secondarySortField} = $secondary; my %names = ( - set_id => $r->maketext("Set Name"), - open_date => $r->maketext("Open Date"), - due_date => $r->maketext("Close Date"), - answer_date => $r->maketext("Answer Date"), - visible => $r->maketext("Visibility"), + set_id => $r->maketext("Set Name"), + open_date => $r->maketext("Open Date"), + due_date => $r->maketext("Close Date"), + answer_date => $r->maketext("Answer Date"), + visible => $r->maketext("Visibility"), ); return CGI::div({ class => 'alert alert-success p-1 mb-0' }, $r->maketext("Sort by [_1] and then by [_2]", $names{$primary}, $names{$secondary})); } - sub edit_form { my ($self, %actionParams) = @_; my $r = $self->r; @@ -861,7 +861,7 @@ sub edit_handler { # leave visibleSetIDs alone } elsif ($scope eq "selected") { $result = $r->maketext("editing selected sets"); - $self->{visibleSetIDs} = $genericParams->{selected_sets}; # an arrayref + $self->{visibleSetIDs} = $genericParams->{selected_sets}; # an arrayref } $self->{editMode} = 1; @@ -998,8 +998,8 @@ sub score_form { sub score_handler { my ($self, $genericParams, $actionParams, $tableParams) = @_; - my $r = $self->r; - my $urlpath = $r->urlpath; + my $r = $self->r; + my $urlpath = $r->urlpath; my $courseName = $urlpath->arg("courseID"); my $scope = $actionParams->{"action.score.scope"}->[0]; @@ -1016,19 +1016,18 @@ sub score_handler { @setsToScore = @{ $genericParams->{selected_sets} }; } - my $uri = $self->systemLink( $urlpath->newFromModule('WeBWorK::ContentGenerator::Instructor::Scoring',$r, courseID=>$courseName), - params=>{ - scoreSelected=>"Score Selected", - selectedSet=>\@setsToScore, -# recordSingleSetScores=>'' - } + my $uri = $self->systemLink( + $urlpath->newFromModule('WeBWorK::ContentGenerator::Instructor::Scoring', $r, courseID => $courseName), + params => { + scoreSelected => "Score Selected", + selectedSet => \@setsToScore, + # recordSingleSetScores=>'' + } ); - return $uri; } - sub delete_form { my ($self, %actionParams) = @_; my $r = $self->r; @@ -1146,9 +1145,9 @@ sub create_form { sub create_handler { my ($self, $genericParams, $actionParams, $tableParams) = @_; - my $r = $self->r; - my $db = $r->db; - my $ce = $r->ce; + my $r = $self->r; + my $db = $r->db; + my $ce = $r->ce; my $newSetID = format_set_name_internal($actionParams->{'action.create.name'}[0] // ''); return CGI::div({ class => 'alert alert-danger p-1 mb-0' }, @@ -1167,16 +1166,16 @@ sub create_handler { ) if $db->existsGlobalSet($newSetID); my $newSetRecord = $db->newGlobalSet; - my $oldSetID = $self->{selectedSetIDs}->[0]; + my $oldSetID = $self->{selectedSetIDs}->[0]; my $type = $actionParams->{"action.create.type"}->[0]; # It's convenient to set the due date two weeks from now so that it is # not accidentally available to students. - my $dueDate = time+2*ONE_WEEK(); + my $dueDate = time + 2 * ONE_WEEK(); my $display_tz = $ce->{siteDefaults}{timezone}; - my $fDueDate = $self->formatDateTime($dueDate, $display_tz, "%m/%d/%Y at %I:%M%P"); - my $dueTime = $ce->{pg}{timeAssignDue}; + my $fDueDate = $self->formatDateTime($dueDate, $display_tz, "%m/%d/%Y at %I:%M%P"); + my $dueTime = $ce->{pg}{timeAssignDue}; # We replace the due time by the one from the config variable # and try to bring it back to unix time if possible @@ -1189,11 +1188,11 @@ sub create_handler { $newSetRecord->set_header("defaultHeader"); $newSetRecord->hardcopy_header("defaultHeader"); #Rest of the dates are set according to to course configuration - $newSetRecord->open_date($dueDate - 60*$ce->{pg}{assignOpenPriorToDue}); - $newSetRecord->reduced_scoring_date($dueDate - 60*$ce->{pg}{ansEvalDefaults}{reducedScoringPeriod}); + $newSetRecord->open_date($dueDate - 60 * $ce->{pg}{assignOpenPriorToDue}); + $newSetRecord->reduced_scoring_date($dueDate - 60 * $ce->{pg}{ansEvalDefaults}{reducedScoringPeriod}); $newSetRecord->due_date($dueDate); - $newSetRecord->answer_date($dueDate + 60*$ce->{pg}{answersOpenAfterDueDate}); - $newSetRecord->visible(DEFAULT_VISIBILITY_STATE()); # don't want students to see an empty set + $newSetRecord->answer_date($dueDate + 60 * $ce->{pg}{answersOpenAfterDueDate}); + $newSetRecord->visible(DEFAULT_VISIBILITY_STATE()); # don't want students to see an empty set $newSetRecord->enable_reduced_scoring(DEFAULT_ENABLED_REDUCED_SCORING_STATE()); $newSetRecord->assignment_type('default'); $db->addGlobalSet($newSetRecord); @@ -1217,11 +1216,11 @@ sub create_handler { $_->set_id($newSetID); $db->addGlobalSetLocation($_); } - if ( $newSetRecord->restricted_login_proctor eq 'Yes' ) { + if ($newSetRecord->restricted_login_proctor eq 'Yes') { my $procUser = $db->getUser("set_id:$oldSetID"); $procUser->user_id("set_id:$newSetID"); - eval { $db->addUser( $procUser ) }; - if ( ! $@ ) { + eval { $db->addUser($procUser) }; + if (!$@) { my $procPerm = $db->getPermissionLevel("set_id:$oldSetID"); $procPerm->user_id("set_id:$newSetID"); $db->addPermissionLevel($procPerm); @@ -1231,7 +1230,7 @@ sub create_handler { } } } - # Assign set to current active user. + # Assign set to current active user. my $userName = $r->param('user'); $self->assignSetToUser($userName, $newSetRecord); # Cures weird date error when no-one assigned to set. $self->addgoodmessage($r->maketext( @@ -1240,7 +1239,7 @@ sub create_handler { )); push @{ $self->{visibleSetIDs} }, $newSetID; - push @{ $self->{allSetIds} }, $newSetID; + push @{ $self->{allSetIds} }, $newSetID; return CGI::div({ class => 'alert alert-danger p-1 mb-0' }, $r->maketext('Failed to create new set: [_1]', $@)) if $@; @@ -1389,7 +1388,7 @@ sub import_handler { my ($added, $skipped) = $self->importSetsFromDef( $actionParams->{"action.import.number"}[0] > 1 - ? '' # Cannot assign set names to multiple imports. + ? '' # Cannot assign set names to multiple imports. : format_set_name_internal($actionParams->{'action.import.name'}[0]), $actionParams->{'action.import.assign'}[0], $actionParams->{'action.import.start.date'}[0] // 0, @@ -1406,8 +1405,8 @@ sub import_handler { return CGI::div( { class => 'alert alert-success p-1 mb-0' }, $r->maketext( - '[_1] sets added, [_2] sets skipped. Skipped sets: ([_3])', - $numAdded, $numSkipped, join(', ', @$skipped) + '[_1] sets added, [_2] sets skipped. Skipped sets: ([_3])', $numAdded, + $numSkipped, join(', ', @$skipped) ) ); } @@ -1456,7 +1455,7 @@ sub export_handler { $self->{selectedSetIDs} = $self->{visibleSetIDs}; } elsif ($scope eq "selected") { $result = $r->maketext("Sets were selected for export."); - $self->{selectedSetIDs} = $self->{visibleSetIDs} = $genericParams->{selected_sets}; # an arrayref + $self->{selectedSetIDs} = $self->{visibleSetIDs} = $genericParams->{selected_sets}; # an arrayref } $self->{exportMode} = 1; @@ -1471,10 +1470,10 @@ sub cancelExport_form { sub cancelExport_handler { my ($self, $genericParams, $actionParams, $tableParams) = @_; - my $r = $self->r; + my $r = $self->r; #$self->{selectedSetIDs) = $self->{visibleSetIDs}; - # only do the above if we arrived here via "edit selected users" + # only do the above if we arrived here via "edit selected users" if (defined $r->param("prev_visible_sets")) { $self->{visibleSetIDs} = [ $r->param("prev_visible_sets") ]; } elsif (defined $r->param("no_prev_visible_sets")) { @@ -1495,7 +1494,7 @@ sub saveExport_form { sub saveExport_handler { my ($self, $genericParams, $actionParams, $tableParams) = @_; - my $r = $self->r; + my $r = $self->r; my @setIDsToExport = @{ $self->{selectedSetIDs} }; @@ -1514,8 +1513,8 @@ sub saveExport_handler { $self->{exportMode} = 0; my $numExported = @$exported; - my $numSkipped = @$skipped; - my $resultFont = $numSkipped ? 'alert-danger' : 'alert-success'; + my $numSkipped = @$skipped; + my $resultFont = $numSkipped ? 'alert-danger' : 'alert-success'; my @reasons = map { "set $_ - " . $reason->{$_} } keys %$reason; @@ -1536,10 +1535,10 @@ sub cancelEdit_form { sub cancelEdit_handler { my ($self, $genericParams, $actionParams, $tableParams) = @_; - my $r = $self->r; + my $r = $self->r; #$self->{selectedSetIDs) = $self->{visibleSetIDs}; - # only do the above if we arrived here via "edit selected users" + # only do the above if we arrived here via "edit selected users" if (defined $r->param("prev_visible_sets")) { $self->{visibleSetIDs} = [ $r->param("prev_visible_sets") ]; } elsif (defined $r->param("no_prev_visible_sets")) { @@ -1560,15 +1559,15 @@ sub saveEdit_form { sub saveEdit_handler { my ($self, $genericParams, $actionParams, $tableParams) = @_; - my $r = $self->r; - my $db = $r->db; - my $ce = $r->ce; + my $r = $self->r; + my $db = $r->db; + my $ce = $r->ce; my @visibleSetIDs = @{ $self->{visibleSetIDs} }; foreach my $setID (@visibleSetIDs) { - next unless defined($setID); - my $Set = $db->getGlobalSet($setID); # checked - # FIXME: we may not want to die on bad sets, they're not as bad as bad users + next unless defined($setID); + my $Set = $db->getGlobalSet($setID); # checked + # FIXME: we may not want to die on bad sets, they're not as bad as bad users die "record for visible set $setID not found" unless $Set; foreach my $field ($Set->NONKEYFIELDS()) { @@ -1592,9 +1591,9 @@ sub saveEdit_handler { } # make sure the dates are not more than 10 years in the future - my $curr_time = time; + my $curr_time = time; my $seconds_per_year = 31_556_926; - my $cutoff = $curr_time + $seconds_per_year*10; + my $cutoff = $curr_time + $seconds_per_year * 10; return CGI::div({ class => 'alert alert-danger p-1 mb-0' }, $r->maketext("Error: open date cannot be more than 10 years from now in set [_1]", $setID)) if $Set->open_date > $cutoff; @@ -1617,20 +1616,24 @@ sub saveEdit_handler { } # check that the reduced scoring date is in the right place - my $enable_reduced_scoring = - $ce->{pg}{ansEvalDefaults}{enableReducedScoring} && - (defined($r->param("set.$setID.enable_reduced_scoring")) ? - $r->param("set.$setID.enable_reduced_scoring") : - $Set->enable_reduced_scoring); - - if ($enable_reduced_scoring && - $Set->reduced_scoring_date - && ($Set->reduced_scoring_date > $Set->due_date - || $Set->reduced_scoring_date < $Set->open_date)) { + my $enable_reduced_scoring = $ce->{pg}{ansEvalDefaults}{enableReducedScoring} + && ( + defined($r->param("set.$setID.enable_reduced_scoring")) + ? $r->param("set.$setID.enable_reduced_scoring") + : $Set->enable_reduced_scoring); + + if ( + $enable_reduced_scoring + && $Set->reduced_scoring_date + && ($Set->reduced_scoring_date > $Set->due_date + || $Set->reduced_scoring_date < $Set->open_date) + ) + { return CGI::div( { class => 'alert alert-danger p-1 mb-0' }, $r->maketext( - "Error: Reduced scoring date must come between the open date and close date in set [_1]", $setID + "Error: Reduced scoring date must come between the open date and close date in set [_1]", + $setID ) ); } @@ -1657,10 +1660,10 @@ sub saveEdit_handler { sub importSetsFromDef { my ($self, $newSetName, $assign, $startdate, @setDefFiles) = @_; - my $r = $self->r; - my $ce = $r->ce; - my $db = $r->db; - my $dir = $ce->{courseDirs}->{templates}; + my $r = $self->r; + my $ce = $r->ce; + my $db = $r->db; + my $dir = $ce->{courseDirs}->{templates}; my $mindate = 0; # if the user includes "following files" in a multiple selection @@ -1710,7 +1713,7 @@ sub importSetsFromDef { # keep track of which as the earliest answer date if ($mindate > $openDate || $mindate == 0) { - $mindate = $openDate; + $mindate = $openDate; } debug("$set_definition_file: adding set"); @@ -1730,8 +1733,8 @@ sub importSetsFromDef { $newSetRecord->restrict_prob_progression($restrictProbProgression); # gateway/version data. these should are all initialized to '' - # by readSetDef, so for non-gateway/versioned sets they'll just - # be stored as null + # by readSetDef, so for non-gateway/versioned sets they'll just + # be stored as null $newSetRecord->assignment_type($assignmentType); $newSetRecord->attempts_per_version($attemptsPerVersion); $newSetRecord->time_interval($timeInterval); @@ -1747,24 +1750,37 @@ sub importSetsFromDef { $newSetRecord->relax_restrict_ip($relaxRestrictIP); #create the set - eval {$db->addGlobalSet($newSetRecord)}; + eval { $db->addGlobalSet($newSetRecord) }; die $r->maketext("addGlobalSet [_1] in ProblemSetList: [_2]", $setName, $@) if $@; #do we need to add locations to the set_locations table? - if ( $restrictIP ne 'No' && $restrictLoc ) { - if ($db->existsLocation( $restrictLoc ) ) { - if ( ! $db->existsGlobalSetLocation($setName,$restrictLoc) ) { + if ($restrictIP ne 'No' && $restrictLoc) { + if ($db->existsLocation($restrictLoc)) { + if (!$db->existsGlobalSetLocation($setName, $restrictLoc)) { my $newSetLocation = $db->newGlobalSetLocation; - $newSetLocation->set_id( $setName ); - $newSetLocation->location_id( $restrictLoc ); - eval {$db->addGlobalSetLocation($newSetLocation)}; - warn($r->maketext("error adding set location [_1] for set [_2]: [_3]", $restrictLoc, $setName, $@)) if $@; + $newSetLocation->set_id($setName); + $newSetLocation->location_id($restrictLoc); + eval { $db->addGlobalSetLocation($newSetLocation) }; + warn($r->maketext( + "error adding set location [_1] for set [_2]: [_3]", + $restrictLoc, $setName, $@ + )) + if $@; } else { # this should never happen. - warn($r->maketext("input set location [_1] already exists for set [_2].", $restrictLoc, $setName)."\n"); + warn( + $r->maketext( + "input set location [_1] already exists for set [_2].", $restrictLoc, $setName + ) + . "\n" + ); } } else { - warn($r->maketext("restriction location [_1] does not exist. IP restrictions have been ignored.", $restrictLoc)."\n"); + warn( + $r->maketext("restriction location [_1] does not exist. IP restrictions have been ignored.", + $restrictLoc) + . "\n" + ); $newSetRecord->restrict_ip('No'); $newSetRecord->relax_restrict_ip('No'); eval { $db->putGlobalSet($newSetRecord) }; @@ -1794,10 +1810,9 @@ sub importSetsFromDef { if ($assign eq "all") { $self->assignSetToAllUsers($setName); - } - else { + } else { my $userName = $r->param('user'); - $self->assignSetToUser($userName, $newSetRecord); ## always assign set to instructor + $self->assignSetToUser($userName, $newSetRecord); ## always assign set to instructor } } @@ -1821,17 +1836,17 @@ sub importSetsFromDef { sub readSetDef { my ($self, $fileName) = @_; - my $templateDir = $self->{ce}->{courseDirs}->{templates}; - my $filePath = "$templateDir/$fileName"; - my $weight_default = $self->{ce}->{problemDefaults}->{value}; + my $templateDir = $self->{ce}->{courseDirs}->{templates}; + my $filePath = "$templateDir/$fileName"; + my $weight_default = $self->{ce}->{problemDefaults}->{value}; my $max_attempts_default = $self->{ce}->{problemDefaults}->{max_attempts}; my $att_to_open_children_default = - $self->{ce}->{problemDefaults}->{att_to_open_children}; + $self->{ce}->{problemDefaults}->{att_to_open_children}; my $counts_parent_grade_default = - $self->{ce}->{problemDefaults}->{counts_parent_grade}; - my $showMeAnother_default = $self->{ce}->{problemDefaults}->{showMeAnother}; + $self->{ce}->{problemDefaults}->{counts_parent_grade}; + my $showMeAnother_default = $self->{ce}->{problemDefaults}->{showMeAnother}; my $showHintsAfter_default = $self->{ce}{problemDefaults}{showHintsAfter}; - my $prPeriod_default=$self->{ce}->{problemDefaults}->{prPeriod}; + my $prPeriod_default = $self->{ce}->{problemDefaults}->{prPeriod}; my $setName = ''; @@ -1841,7 +1856,7 @@ sub readSetDef { $setName = $2; } else { $self->addbadmessage( - qq{The setDefinition file name must begin with set}, + qq{The setDefinition file name must begin with set}, qq{and must end with .def . Every thing in between becomes the name of the set. }, qq{For example set1.def, setExam.def, and setsample7.def }, qq{define sets named 1, Exam, and sample7 respectively. }, @@ -1851,45 +1866,44 @@ sub readSetDef { } my ($line, $name, $weight, $attemptLimit, $continueFlag); - my $paperHeaderFile = ''; + my $paperHeaderFile = ''; my $screenHeaderFile = ''; - my $description = ''; + my $description = ''; my ($dueDate, $openDate, $reducedScoringDate, $answerDate); my @problemData; -# added fields for gateway test/versioned set definitions: - my ( $assignmentType, $attemptsPerVersion, $timeInterval, $enableReducedScoring, - $versionsPerInterval, $versionTimeLimit, $problemRandOrder, - $problemsPerPage, $restrictLoc, - $emailInstructor, $restrictProbProgression, - $countsParentGrade, $attToOpenChildren, - $problemID, $showMeAnother, $showHintsAfter, $prPeriod, $listType - ) = - ('')x16; # initialize these to '' - my ( $timeCap, $restrictIP, $relaxRestrictIP ) = ( 0, 'No', 'No'); -# additional fields currently used only by gateways; later, the world? - my ( $hideScore, $hideScoreByProblem, $hideWork, ) = ( 'N', 'N', 'N' ); + # added fields for gateway test/versioned set definitions: + my ( + $assignmentType, $attemptsPerVersion, $timeInterval, $enableReducedScoring, + $versionsPerInterval, $versionTimeLimit, $problemRandOrder, $problemsPerPage, + $restrictLoc, $emailInstructor, $restrictProbProgression, $countsParentGrade, + $attToOpenChildren, $problemID, $showMeAnother, $showHintsAfter, + $prPeriod, $listType + ) = ('') x 16; # initialize these to '' + my ($timeCap, $restrictIP, $relaxRestrictIP) = (0, 'No', 'No'); + # additional fields currently used only by gateways; later, the world? + my ($hideScore, $hideScoreByProblem, $hideWork,) = ('N', 'N', 'N'); my %setInfo; - if ( open (SETFILENAME, "$filePath") ) { - ##################################################################### - # Read and check set data - ##################################################################### + if (open(SETFILENAME, "$filePath")) { + ##################################################################### + # Read and check set data + ##################################################################### while () { chomp($line = $_); - $line =~ s|(#.*)||; ## don't read past comments - unless ($line =~ /\S/) {next;} ## skip blank lines - $line =~ s|\s*$||; ## trim trailing spaces + $line =~ s|(#.*)||; ## don't read past comments + unless ($line =~ /\S/) { next; } ## skip blank lines + $line =~ s|\s*$||; ## trim trailing spaces $line =~ m|^\s*(\w+)\s*=?\s*(.*)|; ###################### # sanity check entries ###################### my $item = $1; - $item = '' unless defined $item; + $item = '' unless defined $item; my $value = $2; - $value = '' unless defined $value; + $value = '' unless defined $value; if ($item eq 'setNumber') { next; @@ -1902,9 +1916,9 @@ sub readSetDef { } elsif ($item eq 'openDate') { $openDate = $value; } elsif ($item eq 'answerDate') { - $answerDate = $value; + $answerDate = $value; } elsif ($item eq 'enableReducedScoring') { - $enableReducedScoring = $value; + $enableReducedScoring = $value; } elsif ($item eq 'reducedScoringDate') { $reducedScoringDate = $value; } elsif ($item eq 'assignmentType') { @@ -1922,29 +1936,30 @@ sub readSetDef { } elsif ($item eq 'problemsPerPage') { $problemsPerPage = $value; } elsif ($item eq 'hideScore') { - $hideScore = ( $value ) ? $value : 'N'; + $hideScore = ($value) ? $value : 'N'; } elsif ($item eq 'hideScoreByProblem') { - $hideScoreByProblem = ( $value ) ? $value : 'N'; + $hideScoreByProblem = ($value) ? $value : 'N'; } elsif ($item eq 'hideWork') { - $hideWork = ( $value ) ? $value : 'N'; + $hideWork = ($value) ? $value : 'N'; } elsif ($item eq 'capTimeLimit') { - $timeCap = ( $value ) ? 1 : 0; + $timeCap = ($value) ? 1 : 0; } elsif ($item eq 'restrictIP') { - $restrictIP = ( $value ) ? $value : 'No'; - } elsif ($item eq 'restrictLocation' ) { - $restrictLoc = ( $value ) ? $value : ''; - } elsif ( $item eq 'relaxRestrictIP' ) { - $relaxRestrictIP = ( $value ) ? $value : 'No'; - } elsif ( $item eq 'emailInstructor' ) { - $emailInstructor = ( $value ) ? $value : 0; - } elsif ( $item eq 'restrictProbProgression' ) { - $restrictProbProgression = ( $value ) ? $value : 0; - } elsif ( $item eq 'description' ) { - $value =~ s//\n/g; - $description = $value; - } elsif ($item eq 'problemList' || - $item eq 'problemListV2') { - $listType = $item; + $restrictIP = ($value) ? $value : 'No'; + } elsif ($item eq 'restrictLocation') { + $restrictLoc = ($value) ? $value : ''; + } elsif ($item eq 'relaxRestrictIP') { + $relaxRestrictIP = ($value) ? $value : 'No'; + } elsif ($item eq 'emailInstructor') { + $emailInstructor = ($value) ? $value : 0; + } elsif ($item eq 'restrictProbProgression') { + $restrictProbProgression = ($value) ? $value : 0; + } elsif ($item eq 'description') { + $value =~ s//\n/g; + $description = $value; + } elsif ($item eq 'problemList' + || $item eq 'problemListV2') + { + $listType = $item; last; } else { warn $r->maketext("readSetDef error, can't read the line: ||[_1]||", $line); @@ -1954,10 +1969,12 @@ sub readSetDef { ##################################################################### # Check and format dates ##################################################################### - my ($time1, $time2, $time3) = map { $self->parseDateTime($_); } ($openDate, $dueDate, $answerDate); + my ($time1, $time2, $time3) = map { $self->parseDateTime($_); } ($openDate, $dueDate, $answerDate); unless ($time1 <= $time2 and $time2 <= $time3) { - warn $r->maketext("The open date: [_1], close date: [_2], and answer date: [_3] must be defined and in chronological order.", $openDate, $dueDate, $answerDate); + warn $r->maketext( + "The open date: [_1], close date: [_2], and answer date: [_3] must be defined and in chronological order.", + $openDate, $dueDate, $answerDate); } # validate reduced credit date @@ -1965,86 +1982,130 @@ sub readSetDef { # Special handling for values which seem to roughly correspond to epoch 0. # namely if the date string contains 12/31/1969 or 01/01/1970 if ($reducedScoringDate) { - if ( ( $reducedScoringDate =~ m+12/31/1969+ ) || ( $reducedScoringDate =~ m+01/01/1970+ ) ) { + if (($reducedScoringDate =~ m+12/31/1969+) || ($reducedScoringDate =~ m+01/01/1970+)) { my $origReducedScoringDate = $reducedScoringDate; $reducedScoringDate = $self->parseDateTime($reducedScoringDate); - if ( $reducedScoringDate != 0 ) { + if ($reducedScoringDate != 0) { # In this case we want to treat it BY FORCE as if the value did correspond to epoch 0. - warn $r->maketext("The reduced credit date [_1] in the file probably was generated from the Unix epoch 0 value and is being treated as if it was Unix epoch 0.", $origReducedScoringDate ); + warn $r->maketext( + "The reduced credit date [_1] in the file probably was generated from the Unix epoch 0 value and is being treated as if it was Unix epoch 0.", + $origReducedScoringDate + ); $reducedScoringDate = 0; } } else { - # Original behavior, which may cause problems for some time-zones when epoch 0 was set and does not parse back to 0 + # Original behavior, which may cause problems for some time-zones when epoch 0 was set and does not parse back to 0 $reducedScoringDate = $self->parseDateTime($reducedScoringDate); } } if ($reducedScoringDate) { if ($reducedScoringDate < $time1 || $reducedScoringDate > $time2) { - warn $r->maketext("The reduced credit date should be between the open date [_1] and close date [_2]", $openDate, $dueDate); - } elsif ( $reducedScoringDate == 0 && $enableReducedScoring ne 'Y' ) { + warn $r->maketext("The reduced credit date should be between the open date [_1] and close date [_2]", + $openDate, $dueDate); + } elsif ($reducedScoringDate == 0 && $enableReducedScoring ne 'Y') { # In this case - the date in the file was Unix epoch 0 (or treated as such), # and unless $enableReducedScoring eq 'Y' we will leave it as 0. } } else { - $reducedScoringDate = $time2 - 60*$r->{ce}->{pg}{ansEvalDefaults}{reducedScoringPeriod}; + $reducedScoringDate = $time2 - 60 * $r->{ce}->{pg}{ansEvalDefaults}{reducedScoringPeriod}; } if ($enableReducedScoring ne '' && $enableReducedScoring eq 'Y') { - $enableReducedScoring = 1; + $enableReducedScoring = 1; } elsif ($enableReducedScoring ne '' && $enableReducedScoring eq 'N') { - $enableReducedScoring = 0; + $enableReducedScoring = 0; } elsif ($enableReducedScoring ne '') { - warn($r->maketext("The value [_1] for enableReducedScoring is not valid; it will be replaced with 'N'.",$enableReducedScoring)."\n"); - $enableReducedScoring = 0; + warn( + $r->maketext("The value [_1] for enableReducedScoring is not valid; it will be replaced with 'N'.", + $enableReducedScoring) + . "\n" + ); + $enableReducedScoring = 0; } else { - $enableReducedScoring = DEFAULT_ENABLED_REDUCED_SCORING_STATE; + $enableReducedScoring = DEFAULT_ENABLED_REDUCED_SCORING_STATE; } # Check header file names - $paperHeaderFile =~ s/(.*?)\s*$/$1/; #remove trailing white space - $screenHeaderFile =~ s/(.*?)\s*$/$1/; #remove trailing white space + $paperHeaderFile =~ s/(.*?)\s*$/$1/; #remove trailing white space + $screenHeaderFile =~ s/(.*?)\s*$/$1/; #remove trailing white space - ##################################################################### - # Gateway/version variable cleanup: convert times into seconds + ##################################################################### + # Gateway/version variable cleanup: convert times into seconds $assignmentType ||= 'default'; - $timeInterval = WeBWorK::Utils::timeToSec( $timeInterval ) - if ( $timeInterval ); + $timeInterval = WeBWorK::Utils::timeToSec($timeInterval) + if ($timeInterval); $versionTimeLimit = WeBWorK::Utils::timeToSec($versionTimeLimit) - if ( $versionTimeLimit ); + if ($versionTimeLimit); # check that the values for hideWork and hideScore are valid - if ( $hideScore ne 'N' && $hideScore ne 'Y' && - $hideScore ne 'BeforeAnswerDate' ) { - warn($r->maketext("The value [_1] for the hideScore option is not valid; it will be replaced with 'N'.", $hideScore)."\n"); + if ($hideScore ne 'N' + && $hideScore ne 'Y' + && $hideScore ne 'BeforeAnswerDate') + { + warn( + $r->maketext("The value [_1] for the hideScore option is not valid; it will be replaced with 'N'.", + $hideScore) + . "\n" + ); $hideScore = 'N'; } - if ( $hideScoreByProblem ne 'N' && $hideScoreByProblem ne 'Y' && - $hideScoreByProblem ne 'BeforeAnswerDate' ) { - warn($r->maketext("The value [_1] for the hideScore option is not valid; it will be replaced with 'N'.", $hideScoreByProblem)."\n"); + if ($hideScoreByProblem ne 'N' + && $hideScoreByProblem ne 'Y' + && $hideScoreByProblem ne 'BeforeAnswerDate') + { + warn( + $r->maketext("The value [_1] for the hideScore option is not valid; it will be replaced with 'N'.", + $hideScoreByProblem) + . "\n" + ); $hideScoreByProblem = 'N'; } - if ( $hideWork ne 'N' && $hideWork ne 'Y' && - $hideWork ne 'BeforeAnswerDate' ) { - warn($r->maketext("The value [_1] for the hideWork option is not valid; it will be replaced with 'N'.", $hideWork)."\n"); + if ($hideWork ne 'N' + && $hideWork ne 'Y' + && $hideWork ne 'BeforeAnswerDate') + { + warn( + $r->maketext("The value [_1] for the hideWork option is not valid; it will be replaced with 'N'.", + $hideWork) + . "\n" + ); $hideWork = 'N'; } - if ( $timeCap ne '0' && $timeCap ne '1' ) { - warn($r->maketext("The value [_1] for the capTimeLimit option is not valid; it will be replaced with '0'.", $timeCap)."\n"); + if ($timeCap ne '0' && $timeCap ne '1') { + warn( + $r->maketext( + "The value [_1] for the capTimeLimit option is not valid; it will be replaced with '0'.", + $timeCap) + . "\n" + ); $timeCap = '0'; } - if ( $restrictIP ne 'No' && $restrictIP ne 'DenyFrom' && - $restrictIP ne 'RestrictTo' ) { - warn($r->maketext("The value [_1] for the restrictIP option is not valid; it will be replaced with 'No'.", $restrictIP)."\n"); - $restrictIP = 'No'; - $restrictLoc = ''; + if ($restrictIP ne 'No' + && $restrictIP ne 'DenyFrom' + && $restrictIP ne 'RestrictTo') + { + warn( + $r->maketext( + "The value [_1] for the restrictIP option is not valid; it will be replaced with 'No'.", + $restrictIP) + . "\n" + ); + $restrictIP = 'No'; + $restrictLoc = ''; $relaxRestrictIP = 'No'; } - if ( $relaxRestrictIP ne 'No' && - $relaxRestrictIP ne 'AfterAnswerDate' && - $relaxRestrictIP ne 'AfterVersionAnswerDate' ) { - warn($r->maketext("The value [_1] for the relaxRestrictIP option is not valid; it will be replaced with 'No'.", $relaxRestrictIP)."\n"); + if ($relaxRestrictIP ne 'No' + && $relaxRestrictIP ne 'AfterAnswerDate' + && $relaxRestrictIP ne 'AfterVersionAnswerDate') + { + warn( + $r->maketext( + "The value [_1] for the relaxRestrictIP option is not valid; it will be replaced with 'No'.", + $relaxRestrictIP) + . "\n" + ); $relaxRestrictIP = 'No'; } # to verify that restrictLoc is valid requires a database @@ -2054,7 +2115,6 @@ sub readSetDef { # Read and check list of problems for the set ##################################################################### - # NOTE: There are now two versions of problemList, the first is an unlabeled # list which may or may not contain a showMeAnother variable. This is supported # but the unlabeled list is hard to work with. The new version prints a @@ -2062,214 +2122,205 @@ sub readSetDef { if ($listType eq 'problemList') { + while () { + chomp($line = $_); + $line =~ s/(#.*)//; ## don't read past comments + unless ($line =~ /\S/) { next; } ## skip blank lines + + # commas are valid in filenames, so we have to handle commas + # using backslash escaping, so \X will be replaced with X + my @line = (); + my $curr = ''; + for (my $i = 0; $i < length $line; $i++) { + my $c = substr($line, $i, 1); + if ($c eq '\\') { + $curr .= substr($line, ++$i, 1); + } elsif ($c eq ',') { + push @line, $curr; + $curr = ''; + } else { + $curr .= $c; + } + } + ## anything left? + push(@line, $curr) if ($curr); - while() { - chomp($line=$_); - $line =~ s/(#.*)//; ## don't read past comments - unless ($line =~ /\S/) {next;} ## skip blank lines - - # commas are valid in filenames, so we have to handle commas - # using backslash escaping, so \X will be replaced with X - my @line = (); - my $curr = ''; - for (my $i = 0; $i < length $line; $i++) { - my $c = substr($line,$i,1); - if ($c eq '\\') { - $curr .= substr($line,++$i,1); - } elsif ($c eq ',') { - push @line, $curr; - $curr = ''; - } else { - $curr .= $c; - } - } - ## anything left? - push(@line, $curr) if ( $curr ); + # read the line and only look for $showMeAnother if it has the correct number of entries + # otherwise the default value will be used + if (scalar(@line) == 4) { + ($name, $weight, $attemptLimit, $showMeAnother, $continueFlag) = @line; + } else { + ($name, $weight, $attemptLimit, $continueFlag) = @line; + } - # read the line and only look for $showMeAnother if it has the correct number of entries - # otherwise the default value will be used - if(scalar(@line)==4){ - ($name, $weight, $attemptLimit, $showMeAnother, $continueFlag) = @line; - } else { - ($name, $weight, $attemptLimit, $continueFlag) = @line; + ##################### + # clean up problem values + ########################### + $name =~ s/\s*//g; + $weight = "" unless defined($weight); + $weight =~ s/[^\d\.]*//g; + unless ($weight =~ /\d+/) { $weight = $weight_default; } + $attemptLimit = "" unless defined($attemptLimit); + $attemptLimit =~ s/[^\d-]*//g; + unless ($attemptLimit =~ /\d+/) { $attemptLimit = $max_attempts_default; } + $continueFlag = "0" unless (defined($continueFlag) && @problemData); + # can't put continuation flag onto the first problem + push( + @problemData, + { + source_file => $name, + value => $weight, + max_attempts => $attemptLimit, + showMeAnother => $showMeAnother, + showHintsAfter => $showHintsAfter, + # use default since it's not going to be in the file + prPeriod => $prPeriod_default, + continuation => $continueFlag, + } + ); } - - ##################### - # clean up problem values - ########################### - $name =~ s/\s*//g; - $weight = "" unless defined($weight); - $weight =~ s/[^\d\.]*//g; - unless ($weight =~ /\d+/) {$weight = $weight_default;} - $attemptLimit = "" unless defined($attemptLimit); - $attemptLimit =~ s/[^\d-]*//g; - unless ($attemptLimit =~ /\d+/) {$attemptLimit = $max_attempts_default;} - $continueFlag = "0" unless( defined($continueFlag) && @problemData ); - # can't put continuation flag onto the first problem - push(@problemData, {source_file => $name, - value => $weight, - max_attempts => $attemptLimit, - showMeAnother => $showMeAnother, - showHintsAfter => $showHintsAfter, - # use default since it's not going to be in the file - prPeriod => $prPeriod_default, - continuation => $continueFlag, - }); - } } else { - # This is the new version, it looks for pairs of entries - # of the form field name = value - while () { - - chomp($line = $_); - $line =~ s|(#.*)||; ## don't read past comments - unless ($line =~ /\S/) {next;} ## skip blank lines - $line =~ s|\s*$||; ## trim trailing spaces - $line =~ m|^\s*(\w+)\s*=?\s*(.*)|; + # This is the new version, it looks for pairs of entries + # of the form field name = value + while () { + + chomp($line = $_); + $line =~ s|(#.*)||; ## don't read past comments + unless ($line =~ /\S/) { next; } ## skip blank lines + $line =~ s|\s*$||; ## trim trailing spaces + $line =~ m|^\s*(\w+)\s*=?\s*(.*)|; + + ###################### + # sanity check entries + ###################### + my $item = $1; + $item = '' unless defined $item; + my $value = $2; + $value = '' unless defined $value; + + if ($item eq 'problem_start') { + next; + } elsif ($item eq 'source_file') { + warn($r->maketext('No source_file for problem in .def file')) unless $value; + $name = $value; + } elsif ($item eq 'value') { + $weight = ($value) ? $value : $weight_default; + } elsif ($item eq 'max_attempts') { + $attemptLimit = ($value) ? $value : $max_attempts_default; + } elsif ($item eq 'showMeAnother') { + $showMeAnother = ($value) ? $value : 0; + } elsif ($item eq 'showHintsAfter') { + $showHintsAfter = ($value) ? $value : -2; + } elsif ($item eq 'prPeriod') { + $prPeriod = ($value) ? $value : 0; + } elsif ($item eq 'restrictProbProgression') { + $restrictProbProgression = ($value) ? $value : 'No'; + } elsif ($item eq 'problem_id') { + $problemID = ($value) ? $value : ''; + } elsif ($item eq 'counts_parent_grade') { + $countsParentGrade = ($value) ? $value : 0; + } elsif ($item eq 'att_to_open_children') { + $attToOpenChildren = ($value) ? $value : 0; + } elsif ($item eq 'problem_end') { + + ##################### + # clean up problem values + ########################### + $name =~ s/\s*//g; + $weight = "" unless defined($weight); + $weight =~ s/[^\d\.]*//g; + unless ($weight =~ /\d+/) { $weight = $weight_default; } + $attemptLimit = "" unless defined($attemptLimit); + $attemptLimit =~ s/[^\d-]*//g; + unless ($attemptLimit =~ /\d+/) { $attemptLimit = $max_attempts_default; } + + unless ($countsParentGrade =~ /(0|1)/) { $countsParentGrade = $counts_parent_grade_default; } + $countsParentGrade =~ s/[^\d-]*//g; + + unless ($showMeAnother =~ /-?\d+/) { $showMeAnother = $showMeAnother_default; } + $showMeAnother =~ s/[^\d-]*//g; + + unless ($showHintsAfter =~ /-?\d+/) { $showHintsAfter = $showHintsAfter_default; } + $showHintsAfter =~ s/[^\d-]*//g; + + unless ($prPeriod =~ /-?\d+/) { $prPeriod = $prPeriod_default; } + $prPeriod =~ s/[^\d-]*//g; + + unless ($attToOpenChildren =~ /\d+/) { $attToOpenChildren = $att_to_open_children_default; } + $attToOpenChildren =~ s/[^\d-]*//g; + + if ($assignmentType eq 'jitar') { + unless ($problemID =~ /[\d\.]+/) { $problemID = ''; } + $problemID =~ s/[^\d\.-]*//g; + $problemID = seq_to_jitar_id(split(/\./, $problemID)); + } else { + unless ($problemID =~ /\d+/) { $problemID = ''; } + $problemID =~ s/[^\d-]*//g; + } - ###################### - # sanity check entries - ###################### - my $item = $1; - $item = '' unless defined $item; - my $value = $2; - $value = '' unless defined $value; - - if ($item eq 'problem_start') { - next; - } elsif ($item eq 'source_file') { - warn($r->maketext('No source_file for problem in .def file')) unless $value; - $name = $value; - } elsif ($item eq 'value' ) { - $weight = ( $value ) ? $value : $weight_default; - } elsif ( $item eq 'max_attempts' ) { - $attemptLimit = ( $value ) ? $value : $max_attempts_default; - } elsif ( $item eq 'showMeAnother' ) { - $showMeAnother = ( $value ) ? $value : 0; - } elsif ( $item eq 'showHintsAfter' ) { - $showHintsAfter = ( $value ) ? $value : -2; - } elsif ( $item eq 'prPeriod' ) { - $prPeriod = ( $value ) ? $value : 0; - } elsif ( $item eq 'restrictProbProgression' ) { - $restrictProbProgression = ( $value ) ? $value : 'No'; - } elsif ( $item eq 'problem_id' ) { - $problemID = ( $value ) ? $value : ''; - } elsif ( $item eq 'counts_parent_grade' ) { - $countsParentGrade = ( $value ) ? $value : 0; - } elsif ( $item eq 'att_to_open_children' ) { - $attToOpenChildren = ( $value ) ? $value : 0; - } elsif ($item eq 'problem_end') { - - ##################### - # clean up problem values - ########################### - $name =~ s/\s*//g; - $weight = "" unless defined($weight); - $weight =~ s/[^\d\.]*//g; - unless ($weight =~ /\d+/) {$weight = $weight_default;} - $attemptLimit = "" unless defined($attemptLimit); - $attemptLimit =~ s/[^\d-]*//g; - unless ($attemptLimit =~ /\d+/) {$attemptLimit = $max_attempts_default;} - - unless ($countsParentGrade =~ /(0|1)/) {$countsParentGrade = $counts_parent_grade_default;} - $countsParentGrade =~ s/[^\d-]*//g; - - unless ($showMeAnother =~ /-?\d+/) {$showMeAnother = $showMeAnother_default;} - $showMeAnother =~ s/[^\d-]*//g; - - unless ($showHintsAfter =~ /-?\d+/) {$showHintsAfter = $showHintsAfter_default;} - $showHintsAfter =~ s/[^\d-]*//g; - - unless ($prPeriod =~ /-?\d+/) {$prPeriod = $prPeriod_default;} - $prPeriod =~ s/[^\d-]*//g; - - unless ($attToOpenChildren =~ /\d+/) {$attToOpenChildren = $att_to_open_children_default;} - $attToOpenChildren =~ s/[^\d-]*//g; - - if ($assignmentType eq 'jitar') { - unless ($problemID =~ /[\d\.]+/) {$problemID = '';} - $problemID =~ s/[^\d\.-]*//g; - $problemID = seq_to_jitar_id(split(/\./,$problemID)); - } else { - unless ($problemID =~ /\d+/) {$problemID = '';} - $problemID =~ s/[^\d-]*//g; - } - - # can't put continuation flag onto the first problem - push(@problemData, {source_file => $name, - problemID => $problemID, - value => $weight, - max_attempts => $attemptLimit, - showMeAnother => $showMeAnother, - showHintsAfter => $showHintsAfter, - prPeriod => $prPeriod, - attToOpenChildren => $attToOpenChildren, - countsParentGrade => $countsParentGrade, - }); - - # reset the various values - $name = ''; - $problemID = ''; - $weight = ''; - $attemptLimit = ''; - $showMeAnother = ''; - $showHintsAfter = ''; - $attToOpenChildren = ''; - $countsParentGrade = ''; + # can't put continuation flag onto the first problem + push( + @problemData, + { + source_file => $name, + problemID => $problemID, + value => $weight, + max_attempts => $attemptLimit, + showMeAnother => $showMeAnother, + showHintsAfter => $showHintsAfter, + prPeriod => $prPeriod, + attToOpenChildren => $attToOpenChildren, + countsParentGrade => $countsParentGrade, + } + ); + + # reset the various values + $name = ''; + $problemID = ''; + $weight = ''; + $attemptLimit = ''; + $showMeAnother = ''; + $showHintsAfter = ''; + $attToOpenChildren = ''; + $countsParentGrade = ''; - } else { - warn $r->maketext("readSetDef error, can't read the line: ||[_1]||", $line); + } else { + warn $r->maketext("readSetDef error, can't read the line: ||[_1]||", $line); + } } - } - } close(SETFILENAME); - ($setName, - $paperHeaderFile, - $screenHeaderFile, - $time1, - $time2, - $time3, - \@problemData, - $assignmentType, - $enableReducedScoring, - $reducedScoringDate, - $attemptsPerVersion, $timeInterval, - $versionsPerInterval, $versionTimeLimit, $problemRandOrder, - $problemsPerPage, - $hideScore, - $hideScoreByProblem, - $hideWork, - $timeCap, - $restrictIP, - $restrictLoc, - $relaxRestrictIP, - $description, - $emailInstructor, - $restrictProbProgression + ( + $setName, $paperHeaderFile, $screenHeaderFile, $time1, + $time2, $time3, \@problemData, $assignmentType, + $enableReducedScoring, $reducedScoringDate, $attemptsPerVersion, $timeInterval, + $versionsPerInterval, $versionTimeLimit, $problemRandOrder, $problemsPerPage, + $hideScore, $hideScoreByProblem, $hideWork, $timeCap, + $restrictIP, $restrictLoc, $relaxRestrictIP, $description, + $emailInstructor, $restrictProbProgression ); } else { - warn $r->maketext("Can't open file [_1]", $filePath)."\n"; + warn $r->maketext("Can't open file [_1]", $filePath) . "\n"; } } sub exportSetsToDef { my ($self, %filenames) = @_; - my $r = $self->r; - my $ce = $r->ce; - my $db = $r->db; + my $r = $self->r; + my $ce = $r->ce; + my $db = $r->db; my (@exported, @skipped, %reason); SET: foreach my $set (keys %filenames) { my $fileName = $filenames{$set}; - $fileName .= ".def" unless $fileName =~ m/\.def$/; - $fileName = "set" . $fileName unless $fileName =~ m/^set/; + $fileName .= ".def" unless $fileName =~ m/\.def$/; + $fileName = "set" . $fileName unless $fileName =~ m/^set/; # files can be exported to sub directories but not parent directories if ($fileName =~ /\.\./) { push @skipped, $set; @@ -2286,30 +2337,30 @@ SET: foreach my $set (keys %filenames) { my $filePath = $ce->{courseDirs}->{templates} . '/' . $fileName; # back up existing file - if(-e $filePath) { - rename($filePath, "$filePath.bak") or - $reason{$set} = $r->maketext("Existing file [_1] could not be backed up and was lost.", $filePath); + if (-e $filePath) { + rename($filePath, "$filePath.bak") + or $reason{$set} = $r->maketext("Existing file [_1] could not be backed up and was lost.", $filePath); } - my $openDate = $self->formatDateTime($setRecord->open_date); - my $dueDate = $self->formatDateTime($setRecord->due_date); - my $answerDate = $self->formatDateTime($setRecord->answer_date); - my $reducedScoringDate = $self->formatDateTime($setRecord->reduced_scoring_date); - my $description = $setRecord->description; + my $openDate = $self->formatDateTime($setRecord->open_date); + my $dueDate = $self->formatDateTime($setRecord->due_date); + my $answerDate = $self->formatDateTime($setRecord->answer_date); + my $reducedScoringDate = $self->formatDateTime($setRecord->reduced_scoring_date); + my $description = $setRecord->description; if ($description) { - $description =~ s/\r?\n//g; + $description =~ s/\r?\n//g; } - my $assignmentType = $setRecord->assignment_type; - my $enableReducedScoring = $setRecord->enable_reduced_scoring ? 'Y' : 'N'; - my $setHeader = $setRecord->set_header; - my $paperHeader = $setRecord->hardcopy_header; - my $emailInstructor = $setRecord->email_instructor; + my $assignmentType = $setRecord->assignment_type; + my $enableReducedScoring = $setRecord->enable_reduced_scoring ? 'Y' : 'N'; + my $setHeader = $setRecord->set_header; + my $paperHeader = $setRecord->hardcopy_header; + my $emailInstructor = $setRecord->email_instructor; my $restrictProbProgression = $setRecord->restrict_prob_progression; my @problemList = $db->getGlobalProblemsWhere({ set_id => $set }, 'problem_id'); - my $problemList = ''; + my $problemList = ''; for my $problemRecord (@problemList) { my $problem_id = $problemRecord->problem_id(); @@ -2327,12 +2378,12 @@ SET: foreach my $set (keys %filenames) { my $attToOpenChildren = $problemRecord->att_to_open_children(); # backslash-escape commas in fields - $source_file =~ s/([,\\])/\\$1/g; - $value =~ s/([,\\])/\\$1/g; - $max_attempts =~ s/([,\\])/\\$1/g; - $showMeAnother =~ s/([,\\])/\\$1/g; + $source_file =~ s/([,\\])/\\$1/g; + $value =~ s/([,\\])/\\$1/g; + $max_attempts =~ s/([,\\])/\\$1/g; + $showMeAnother =~ s/([,\\])/\\$1/g; $showHintsAfter =~ s/([,\\])/\\$1/g; - $prPeriod =~ s/([,\\])/\\$1/g; + $prPeriod =~ s/([,\\])/\\$1/g; # This is the new way of saving problem information # the labelled list makes it easier to add variables and @@ -2352,18 +2403,18 @@ SET: foreach my $set (keys %filenames) { # gateway fields my $gwFields = ''; - if ( $assignmentType =~ /gateway/ ) { - my $attemptsPerV = $setRecord->attempts_per_version; - my $timeInterval = $setRecord->time_interval; - my $vPerInterval = $setRecord->versions_per_interval; - my $vTimeLimit = $setRecord->version_time_limit; - my $probRandom = $setRecord->problem_randorder; - my $probPerPage = $setRecord->problems_per_page; - my $hideScore = $setRecord->hide_score; - my $hideScoreByProblem = $setRecord->hide_score_by_problem; - my $hideWork = $setRecord->hide_work; - my $timeCap = $setRecord->time_limit_cap; - $gwFields =<attempts_per_version; + my $timeInterval = $setRecord->time_interval; + my $vPerInterval = $setRecord->versions_per_interval; + my $vTimeLimit = $setRecord->version_time_limit; + my $probRandom = $setRecord->problem_randorder; + my $probPerPage = $setRecord->problems_per_page; + my $hideScore = $setRecord->hide_score; + my $hideScoreByProblem = $setRecord->hide_score_by_problem; + my $hideWork = $setRecord->hide_work; + my $timeCap = $setRecord->time_limit_cap; + $gwFields = <restrict_ip; + my $restrictIP = $setRecord->restrict_ip; my $restrictFields = ''; - if ( $restrictIP && $restrictIP ne 'No' ) { + if ($restrictIP && $restrictIP ne 'No') { # only store the first location - my $restrictLoc = ($db->listGlobalSetLocations($setRecord->set_id))[0]; + my $restrictLoc = ($db->listGlobalSetLocations($setRecord->set_id))[0]; my $relaxRestrict = $setRecord->relax_restrict_ip; $restrictLoc || ($restrictLoc = ''); - $restrictFields = "restrictIP = $restrictIP" . - "\nrestrictLocation = $restrictLoc\n" . - "relaxRestrictIP = $relaxRestrict\n"; + $restrictFields = + "restrictIP = $restrictIP" + . "\nrestrictLocation = $restrictLoc\n" + . "relaxRestrictIP = $relaxRestrict\n"; } my $fileContents = <{size}; - my $type = $properties->{type}; - my $access = $properties->{access}; - my $items = $properties->{items}; - my $synonyms = $properties->{synonyms}; + my $size = $properties->{size}; + my $type = $properties->{type}; + my $access = $properties->{access}; + my $items = $properties->{items}; + my $synonyms = $properties->{synonyms}; my $headerFiles = $self->{headerFiles}; if ($access eq "readonly") { @@ -2507,10 +2559,10 @@ sub fieldEditHTML { class => 'form-check-input', $value ? (checked => undef) : () }) - . CGI::hidden({ - name => $fieldName, - value => 0 - }); + . CGI::hidden({ + name => $fieldName, + value => 0 + }); } } @@ -2681,24 +2733,21 @@ sub recordEditHTML { sub printTableHTML { my ($self, $SetsRef, $fieldHeadersRef, %options) = @_; - my $r = $self->r; - my $ce = $r->ce; - my $authz = $r->authz; - my $user = $r->param('user'); - my $setTemplate = $self->{setTemplate}; - my @Sets = @$SetsRef; - my %fieldHeaders = %$fieldHeadersRef; + my $r = $self->r; + my $ce = $r->ce; + my $authz = $r->authz; + my $user = $r->param('user'); + my $setTemplate = $self->{setTemplate}; + my @Sets = @$SetsRef; + my %fieldHeaders = %$fieldHeadersRef; - my $editMode = $options{editMode}; - my $exportMode = $options{exportMode}; - my %selectedSetIDs = map { $_ => 1 } @{ $options{selectedSetIDs} }; - my $currentSort = $options{currentSort}; + my $editMode = $options{editMode}; + my $exportMode = $options{exportMode}; + my %selectedSetIDs = map { $_ => 1 } @{ $options{selectedSetIDs} }; + my $currentSort = $options{currentSort}; # names of headings: - my @realFieldNames = ( - $setTemplate->KEYFIELDS, - $setTemplate->NONKEYFIELDS, - ); + my @realFieldNames = ($setTemplate->KEYFIELDS, $setTemplate->NONKEYFIELDS,); if ($editMode) { @realFieldNames = @{ EDIT_FIELD_ORDER() }; @@ -2710,29 +2759,27 @@ sub printTableHTML { @realFieldNames = @{ EXPORT_FIELD_ORDER() }; } - # Remove the enable reduced scoring box if that feature isnt enabled if (!$ce->{pg}{ansEvalDefaults}{enableReducedScoring}) { - @realFieldNames = grep {!/enable_reduced_scoring|reduced_scoring_date/} @realFieldNames; + @realFieldNames = grep { !/enable_reduced_scoring|reduced_scoring_date/ } @realFieldNames; } # FIXME: should this always presume to use the templates directory? # (no, but that can wait until we have an abstract ProblemLibrary API -- sam) my $templates_dir = $r->ce->{courseDirs}->{templates}; - my $exempt_dirs = join "|", keys %{ $r->ce->{courseFiles}->{problibs} }; - my @headers = listFilesRecursive( + my $exempt_dirs = join "|", keys %{ $r->ce->{courseFiles}->{problibs} }; + my @headers = listFilesRecursive( $templates_dir, - qr/header.*\.pg$/i, # match these files - qr/^(?:$exempt_dirs|CVS)$/, # prune these directories - 0, # match against file name only - 1, # prune against path relative to $templates_dir + qr/header.*\.pg$/i, # match these files + qr/^(?:$exempt_dirs|CVS)$/, # prune these directories + 0, # match against file name only + 1, # prune against path relative to $templates_dir ); @headers = sort @headers; my %headers = map { $_ => $_ } @headers; - $headers{""} = $r->maketext("Use System Default"); - $self->{headerFiles} = \%headers; # store these header files so we don't have to look for them later. - + $headers{""} = $r->maketext("Use System Default"); + $self->{headerFiles} = \%headers; # store these header files so we don't have to look for them later. my @tableHeadings = map { $fieldHeaders{$_} } @realFieldNames; @@ -2762,10 +2809,11 @@ sub printTableHTML { for (my $i = 0; $i < @Sets; $i++) { my $Set = $Sets[$i]; - print $self->recordEditHTML($Set, - editMode => $editMode, - exportMode => $exportMode, - setSelected => exists $selectedSetIDs{$Set->set_id} + print $self->recordEditHTML( + $Set, + editMode => $editMode, + exportMode => $exportMode, + setSelected => exists $selectedSetIDs{ $Set->set_id } ); } print CGI::end_tbody(); @@ -2774,8 +2822,8 @@ sub printTableHTML { # If there are no users, shown print message. print CGI::p( - CGI::i($r->maketext("No sets shown. Choose one of the options above to list the sets in the course.")) - ) unless @Sets; + CGI::i($r->maketext("No sets shown. Choose one of the options above to list the sets in the course."))) + unless @Sets; } # output_JS subroutine diff --git a/lib/WeBWorK/ContentGenerator/Instructor/Scoring.pm b/lib/WeBWorK/ContentGenerator/Instructor/Scoring.pm index 7aa7a5dc56..a577c37a43 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/Scoring.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/Scoring.pm @@ -31,8 +31,9 @@ use WeBWorK::Utils qw(readFile seq_to_jitar_id jitar_id_to_seq jitar_problem_adj format_set_name_display); use WeBWorK::ContentGenerator::Instructor::FileManager; -our @userInfoColumnHeadings = (x("STUDENT ID"), x("login ID"), x("LAST NAME"), x("FIRST NAME"), x("SECTION"), x("RECITATION")); -our @userInfoFields = ("student_id", "user_id","last_name", "first_name", "section", "recitation"); +our @userInfoColumnHeadings = + (x("STUDENT ID"), x("login ID"), x("LAST NAME"), x("FIRST NAME"), x("SECTION"), x("RECITATION")); +our @userInfoFields = ("student_id", "user_id", "last_name", "first_name", "section", "recitation"); sub initialize { my ($self) = @_; @@ -49,27 +50,27 @@ sub initialize { return unless $authz->hasPermissions($user, "access_instructor_tools"); return unless $authz->hasPermissions($user, "score_sets"); - my @selected = $r->param('selectedSet'); - my $scoreSelected = $r->param('scoreSelected'); + my @selected = $r->param('selectedSet'); + my $scoreSelected = $r->param('scoreSelected'); my $scoringFileName = $r->param('scoringFileName') || "${courseName}_totals"; - $scoringFileName =~ s/\.csv\s*$//; $scoringFileName .='.csv'; # must end in .csv - my $scoringFileNameOK = ( - $scoringFileName eq WeBWorK::ContentGenerator::Instructor::FileManager::checkName($scoringFileName) - ); - $self->{scoringFileName}=$scoringFileName; + $scoringFileName =~ s/\.csv\s*$//; + $scoringFileName .= '.csv'; # must end in .csv + my $scoringFileNameOK = + ($scoringFileName eq WeBWorK::ContentGenerator::Instructor::FileManager::checkName($scoringFileName)); + $self->{scoringFileName} = $scoringFileName; - $self->{padFields} = defined($r->param('padFields') ) ? 1 : 0; - $self->{includePercentEachSet} = defined($r->param('includePercentEachSet') ) ? 1 : 0; + $self->{padFields} = defined($r->param('padFields')) ? 1 : 0; + $self->{includePercentEachSet} = defined($r->param('includePercentEachSet')) ? 1 : 0; # Save the list of global sets sorted by set_id. my @setRecords = $db->getGlobalSetsWhere({}, 'set_id'); - $self->{ra_set_ids} = [ map { $_->set_id } @setRecords ]; + $self->{ra_set_ids} = [ map { $_->set_id } @setRecords ]; $self->{rh_set_records} = { map { $_->set_id => $_ } @setRecords }; if (defined $scoreSelected && @selected && $scoringFileNameOK) { - my @totals = (); - my $recordSingleSetScores = $r->param('recordSingleSetScores'); + my @totals = (); + my $recordSingleSetScores = $r->param('recordSingleSetScores'); # Get all users sorted by last_name, then first_name, then user_id. debug("pre-fetching users"); @@ -83,63 +84,62 @@ sub initialize { } debug("done pre-fetching users"); - my $scoringType = ($recordSingleSetScores) ?'everything':'totals'; - my (@everything, @normal,@full,@info,@totalsColumn); - @info = $self->scoreSet($selected[0], "info", undef, \%Users, \@sortedUserIDs) if defined($selected[0]); - @totals = @info; - my $showIndex = defined($r->param('includeIndex')) ? defined($r->param('includeIndex')) : 0; - + my $scoringType = ($recordSingleSetScores) ? 'everything' : 'totals'; + my (@everything, @normal, @full, @info, @totalsColumn); + @info = $self->scoreSet($selected[0], "info", undef, \%Users, \@sortedUserIDs) if defined($selected[0]); + @totals = @info; + my $showIndex = defined($r->param('includeIndex')) ? defined($r->param('includeIndex')) : 0; foreach my $setID (@selected) { - next unless defined $setID; + next unless defined $setID; if ($scoringType eq 'everything') { - @everything = $self->scoreSet($setID, "everything", $showIndex, \%Users, \@sortedUserIDs); - @normal = $self->everything2normal(@everything); - @full = $self->everything2full(@everything); - @info = $self->everything2info(@everything); + @everything = $self->scoreSet($setID, "everything", $showIndex, \%Users, \@sortedUserIDs); + @normal = $self->everything2normal(@everything); + @full = $self->everything2full(@everything); + @info = $self->everything2info(@everything); @totalsColumn = $self->everything2totals(@everything); $self->appendColumns(\@totals, \@totalsColumn); $self->writeCSV("$scoringDir/s${setID}scr.csv", @normal); $self->writeCSV("$scoringDir/s${setID}ful.csv", @full); } else { - @totalsColumn = $self->scoreSet($setID, "totals", $showIndex, \%Users, \@sortedUserIDs); + @totalsColumn = $self->scoreSet($setID, "totals", $showIndex, \%Users, \@sortedUserIDs); $self->appendColumns(\@totals, \@totalsColumn); } } - my @sum_scores = $self->sumScores(\@totals, $showIndex, \%Users, \@sortedUserIDs, $self->{includePercentEachSet}); - $self->appendColumns( \@totals,\@sum_scores); + my @sum_scores = + $self->sumScores(\@totals, $showIndex, \%Users, \@sortedUserIDs, $self->{includePercentEachSet}); + $self->appendColumns(\@totals, \@sum_scores); $self->writeCSV("$scoringDir/$scoringFileName", @totals); } else { - if ($r->param('score-sets') && !@selected) { # nothing selected for scoring + if ($r->param('score-sets') && !@selected) { # nothing selected for scoring $self->addbadmessage($r->maketext("You must select one or more sets for scoring!")); } - if (!$scoringFileNameOK) { # fileName is not properly formed + if (!$scoringFileNameOK) { # fileName is not properly formed $self->addbadmessage($r->maketext("Your file name is not valid! ")); - $self->addbadmessage($r->maketext("A file name cannot begin with a dot, it cannot be empty, it cannot contain a " . - "directory path component and only the characters -_.a-zA-Z0-9 and space are allowed.") - ); + $self->addbadmessage($r->maketext( + "A file name cannot begin with a dot, it cannot be empty, it cannot contain a " + . "directory path component and only the characters -_.a-zA-Z0-9 and space are allowed." + )); } } } - sub body { - my ($self) = @_; - my $r = $self->r; - my $urlpath = $r->urlpath; - my $ce = $r->ce; - my $authz = $r->authz; - my $scoringDir = $ce->{courseDirs}->{scoring}; - my $courseName = $urlpath->arg("courseID"); - my $user = $r->param('user'); - - my $scoringPage = $urlpath->newFromModule($urlpath->module, $r, courseID => $courseName); - my $scoringURL = $self->systemLink($scoringPage, authen=>0); - - my $scoringDownloadPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Instructor::ScoringDownload", $r, - courseID => $courseName - ); + my ($self) = @_; + my $r = $self->r; + my $urlpath = $r->urlpath; + my $ce = $r->ce; + my $authz = $r->authz; + my $scoringDir = $ce->{courseDirs}->{scoring}; + my $courseName = $urlpath->arg("courseID"); + my $user = $r->param('user'); + + my $scoringPage = $urlpath->newFromModule($urlpath->module, $r, courseID => $courseName); + my $scoringURL = $self->systemLink($scoringPage, authen => 0); + + my $scoringDownloadPage = + $urlpath->newFromModule("WeBWorK::ContentGenerator::Instructor::ScoringDownload", $r, courseID => $courseName); my $scoringFileName = $self->{scoringFileName}; @@ -220,7 +220,7 @@ sub body { }) ) ) - ), + ), CGI::div( { class => 'd-flex flex-sm-nowrap flex-wrap' }, CGI::input({ @@ -251,15 +251,16 @@ sub body { my @validFiles; foreach my $type ("scr", "ful") { my $filename = "s$setID$type.csv"; - my $path = "$scoringDir/$filename"; + my $path = "$scoringDir/$filename"; push @validFiles, $filename if -f $path; } if (@validFiles) { print CGI::h2("$setID"); foreach my $filename (@validFiles) { #print CGI::a({href=>"../scoringDownload/?getFile=${filename}&".$self->url_authen_args}, $filename); - print CGI::a({href=>$self->systemLink($scoringDownloadPage, - params=>{getFile => $filename } )}, $filename); + print CGI::a( + { href => $self->systemLink($scoringDownloadPage, params => { getFile => $filename }) }, + $filename); print CGI::br(); } print CGI::hr(); @@ -267,11 +268,12 @@ sub body { } if (-f "$scoringDir/$scoringFileName") { print CGI::h2($r->maketext("Totals")); - #print CGI::a({href=>"../scoringDownload/?getFile=${courseName}_totals.csv&".$self->url_authen_args}, "${courseName}_totals.csv"); - print CGI::a({href=>$self->systemLink($scoringDownloadPage, - params=>{getFile => "$scoringFileName" } )}, "$scoringFileName"); +#print CGI::a({href=>"../scoringDownload/?getFile=${courseName}_totals.csv&".$self->url_authen_args}, "${courseName}_totals.csv"); + print CGI::a( + { href => $self->systemLink($scoringDownloadPage, params => { getFile => "$scoringFileName" }) }, + "$scoringFileName"); print CGI::hr(); - print CGI::pre({style=>'font-size:smaller'},WeBWorK::Utils::readFile("$scoringDir/$scoringFileName")); + print CGI::pre({ style => 'font-size:smaller' }, WeBWorK::Utils::readFile("$scoringDir/$scoringFileName")); } } @@ -291,12 +293,13 @@ sub scoreSet { my $r = $self->r; my $db = $r->db; my @scoringData; - my $scoringItems = { info => 0, - successIndex => 0, - setTotals => 0, - problemScores => 0, - problemAttempts => 0, - header => 0, + my $scoringItems = { + info => 0, + successIndex => 0, + setTotals => 0, + problemScores => 0, + problemAttempts => 0, + header => 0, }; $format = "normal" unless defined $format; $format = "normal" unless $format eq "full" or $format eq "everything" or $format eq "totals" or $format eq "info"; @@ -316,65 +319,69 @@ sub scoreSet { # $userStudentID{$userID} = $userRecord->student_id; #} - my %Users = %$UsersRef; # user objects hashed on user ID - my @sortedUserIDs = @$sortedUserIDsRef; # user IDs sorted by student ID + my %Users = %$UsersRef; # user objects hashed on user ID + my @sortedUserIDs = @$sortedUserIDsRef; # user IDs sorted by student ID my @problemIDs = $db->listGlobalProblems($setID); my $isJitarSet = $setRecord->assignment_type eq 'jitar'; if ($isJitarSet) { - $columnsPerProblem++ - }; - + $columnsPerProblem++; + } # determine what information will be returned if ($format eq 'normal') { - $scoringItems = { info => 1, - successIndex => $showIndex, - setTotals => 1, - problemScores => 1, - problemAttempts => 0, - header => 1, + $scoringItems = { + info => 1, + successIndex => $showIndex, + setTotals => 1, + problemScores => 1, + problemAttempts => 0, + header => 1, }; } elsif ($format eq 'full') { - $scoringItems = { info => 1, - successIndex => $showIndex, - setTotals => 0, - problemScores => 1, - problemAttempts => 1, - header => 1, + $scoringItems = { + info => 1, + successIndex => $showIndex, + setTotals => 0, + problemScores => 1, + problemAttempts => 1, + header => 1, }; } elsif ($format eq 'everything') { - $scoringItems = { info => 1, - successIndex => $showIndex, - setTotals => 1, - problemScores => 1, - problemAttempts => 1, - header => 1, + $scoringItems = { + info => 1, + successIndex => $showIndex, + setTotals => 1, + problemScores => 1, + problemAttempts => 1, + header => 1, }; } elsif ($format eq 'totals') { - $scoringItems = { info => 0, - successIndex => $showIndex, - setTotals => 1, - problemScores => 0, - problemAttempts => 0, - header => 0, + $scoringItems = { + info => 0, + successIndex => $showIndex, + setTotals => 1, + problemScores => 0, + problemAttempts => 0, + header => 0, }; } elsif ($format eq 'info') { - $scoringItems = { info => 0, - successIndex => 0, - setTotals => 0, - problemScores => 0, - problemAttempts => 0, - header => 1, + $scoringItems = { + info => 0, + successIndex => 0, + setTotals => 0, + problemScores => 0, + problemAttempts => 0, + header => 1, }; } else { warn "unrecognized format"; } # Initialize a two-dimensional array of the proper size - for (my $i = 0; $i < @sortedUserIDs + 7; $i++) { # 7 is how many descriptive fields there are in each column + for (my $i = 0; $i < @sortedUserIDs + 7; $i++) { # 7 is how many descriptive fields there are in each column push @scoringData, []; } @@ -388,11 +395,9 @@ sub scoreSet { $scoringData[4][0] = $r->maketext("CLOSE TIME"); $scoringData[5][0] = $r->maketext("PROB VALUE"); + # Write identifying information about the users - - # Write identifying information about the users - - for (my $field=0; $field < @userInfoFields; $field++) { + for (my $field = 0; $field < @userInfoFields; $field++) { if ($field > 0) { for (my $i = 0; $i < 6; $i++) { $scoringData[$i][$field] = ""; @@ -401,7 +406,7 @@ sub scoreSet { $scoringData[6][$field] = $r->maketext($userInfoColumnHeadings[$field]); for (my $user = 0; $user < @sortedUserIDs; $user++) { my $fieldName = $userInfoFields[$field]; - $scoringData[$user + 7][$field] = $Users{$sortedUserIDs[$user]}->$fieldName; + $scoringData[ $user + 7 ][$field] = $Users{ $sortedUserIDs[$user] }->$fieldName; } } } @@ -409,82 +414,80 @@ sub scoreSet { # pre-fetch global problems debug("pre-fetching global problems for set $setID"); - my %GlobalProblems = map { $_->problem_id => $_ } - $db->getAllGlobalProblems($setID); + my %GlobalProblems = map { $_->problem_id => $_ } $db->getAllGlobalProblems($setID); debug("done pre-fetching global problems for set $setID"); # pre-fetch user problems debug("pre-fetching user problems for set $setID"); - my %UserProblems; # $UserProblems{$userID}{$problemID} - - # Gateway change here: for non-gateway (non-versioned) sets, we just - # get each user's problems. For gateway (versioned) sets, we get the - # user's best version and return that - if ( ! defined( $setRecord->assignment_type() ) || - $setRecord->assignment_type() !~ /gateway/) { + my %UserProblems; # $UserProblems{$userID}{$problemID} + + # Gateway change here: for non-gateway (non-versioned) sets, we just + # get each user's problems. For gateway (versioned) sets, we get the + # user's best version and return that + if (!defined($setRecord->assignment_type()) + || $setRecord->assignment_type() !~ /gateway/) + { foreach my $userID (@sortedUserIDs) { - my %CurrUserProblems = map { $_->problem_id => $_ } - $db->getAllMergedUserProblems($userID, $setID); + my %CurrUserProblems = map { $_->problem_id => $_ } $db->getAllMergedUserProblems($userID, $setID); $UserProblems{$userID} = \%CurrUserProblems; } - } elsif ($setRecord->assignment_type() =~ /gateway/) { # versioned sets; get the problems for the best version + } elsif ($setRecord->assignment_type() =~ /gateway/) { # versioned sets; get the problems for the best version foreach my $userID (@sortedUserIDs) { my $CurrUserProblems = {}; - my @versionNums = $db->listSetVersions($userID,$setID); + my @versionNums = $db->listSetVersions($userID, $setID); my $bestScore = -1; - if ( @versionNums ) { - for my $i ( @versionNums ) { - my %versionUserProblems = map { $_->problem_id => $_ } - $db->getAllMergedProblemVersions( $userID, $setID, $i ); - my $score = 0; - foreach ( values ( %versionUserProblems ) ) { - my $status = $_->status || 0; - my $value = $_->value || 1; - # some of these are coming in null; I'm not - # why, or if this should be necessary - $_->status($status); - $_->value($value); - $score += $status*$value; + if (@versionNums) { + for my $i (@versionNums) { + my %versionUserProblems = + map { $_->problem_id => $_ } $db->getAllMergedProblemVersions($userID, $setID, $i); + my $score = 0; + foreach (values(%versionUserProblems)) { + my $status = $_->status || 0; + my $value = $_->value || 1; + # some of these are coming in null; I'm not + # why, or if this should be necessary + $_->status($status); + $_->value($value); + $score += $status * $value; + } + if ($score > $bestScore) { + $CurrUserProblems = \%versionUserProblems; + $bestScore = $score; + } } - if ( $score > $bestScore ) { - $CurrUserProblems = \%versionUserProblems; - $bestScore = $score; - } - } } else { - my %cp = map { $_->problem_id => $_ } - $db->getAllMergedUserProblems($userID, $setID); - $CurrUserProblems = \%cp; + my %cp = map { $_->problem_id => $_ } $db->getAllMergedUserProblems($userID, $setID); + $CurrUserProblems = \%cp; } $UserProblems{$userID} = { %{$CurrUserProblems} }; } } - debug("done pre-fetching user problems for set $setID"); # Write the problem data my $dueDateString = $self->formatDateTime($setRecord->due_date); my ($dueDate, $dueTime) = $dueDateString =~ /^(.*) at (.*)$/; - my $valueTotal = 0; + my $valueTotal = 0; my %userStatusTotals = (); my %userSuccessIndex = (); my %numberOfAttempts = (); my $num_of_problems = @problemIDs; + for (my $problem = 0; $problem < @problemIDs; $problem++) { #my $globalProblem = $db->getGlobalProblem($setID, $problemIDs[$problem]); #checked - my $globalProblem = $GlobalProblems{$problemIDs[$problem]}; + my $globalProblem = $GlobalProblems{ $problemIDs[$problem] }; die "global problem $problemIDs[$problem] not found for set $setID" unless $globalProblem; my $column = 5 + $problem * $columnsPerProblem; if ($scoringItems->{header}) { - my $prettyProblemID = $globalProblem->problem_id; - if ($isJitarSet && $globalProblem->problem_id) { - $prettyProblemID = join('.',jitar_id_to_seq($prettyProblemID)); + my $prettyProblemID = $globalProblem->problem_id; + if ($isJitarSet && $globalProblem->problem_id) { + $prettyProblemID = join('.', jitar_id_to_seq($prettyProblemID)); } $scoringData[0][$column] = ""; @@ -495,47 +498,48 @@ sub scoreSet { $scoringData[5][$column] = $globalProblem->value; $scoringData[6][$column] = $r->maketext("STATUS"); my $extraColumns = 0; + if ($isJitarSet) { - $extraColumns++; - $scoringData[6][$column + $extraColumns] = $r->maketext("ADJ STATUS"); + $extraColumns++; + $scoringData[6][ $column + $extraColumns ] = $r->maketext("ADJ STATUS"); } - if ($scoringItems->{header} and - $scoringItems->{problemAttempts}) { # Fill in with blanks, or maybe the problem number - $extraColumns++; - $scoringData[6][$column + $extraColumns] = $r->maketext("#corr"); - $extraColumns++; - $scoringData[6][$column + $extraColumns] = $r->maketext("#incorr"); + if ($scoringItems->{header} + and $scoringItems->{problemAttempts}) + { # Fill in with blanks, or maybe the problem number + $extraColumns++; + $scoringData[6][ $column + $extraColumns ] = $r->maketext("#corr"); + $extraColumns++; + $scoringData[6][ $column + $extraColumns ] = $r->maketext("#incorr"); } for (my $row = 0; $row < 6; $row++) { - for (my $col = $column+1; $col <= $column + $extraColumns; $col++) { - if ($row == 2) { - $scoringData[$row][$col] = $prettyProblemID; - } else { - $scoringData[$row][$col] = ""; - } - } + for (my $col = $column + 1; $col <= $column + $extraColumns; $col++) { + if ($row == 2) { + $scoringData[$row][$col] = $prettyProblemID; + } else { + $scoringData[$row][$col] = ""; + } + } } - } # if its a jitar set then we only want to add top level problems to the value total # otherwise we add up everything if ($isJitarSet && $globalProblem->problem_id) { - my @seq = jitar_id_to_seq($globalProblem->problem_id); - if ($#seq == 0) { - $valueTotal += $globalProblem->value; - } + my @seq = jitar_id_to_seq($globalProblem->problem_id); + if ($#seq == 0) { + $valueTotal += $globalProblem->value; + } } else { - $valueTotal += $globalProblem->value; + $valueTotal += $globalProblem->value; } for (my $user = 0; $user < @sortedUserIDs; $user++) { #my $userProblem = $userProblems{ $users{$userKeys[$user]}->user_id }; #my $userProblem = $UserProblems{$sers{$userKeys[$user]}->user_id}{$problemIDs[$problem]}; - my $userProblem = $UserProblems{$sortedUserIDs[$user]}{$problemIDs[$problem]}; - unless (defined $userProblem) { # assume an empty problem record if the problem isn't assigned to this user + my $userProblem = $UserProblems{ $sortedUserIDs[$user] }{ $problemIDs[$problem] }; + unless (defined $userProblem) { # assume an empty problem record if the problem isn't assigned to this user $userProblem = $db->newUserProblem; $userProblem->status(0); $userProblem->value(0); @@ -543,78 +547,85 @@ sub scoreSet { $userProblem->num_incorrect(0); } $userStatusTotals{$user} = 0 unless exists $userStatusTotals{$user}; - my $user_problem_status = ($userProblem->status =~/^[\d\.]+$/) ? $userProblem->status : 0; # ensure it's numeric - # the grade is the adjusted status if its a jitar set - # and this is an actual problem + my $user_problem_status = + ($userProblem->status =~ /^[\d\.]+$/) ? $userProblem->status : 0; # ensure it's numeric + # the grade is the adjusted status if its a jitar set + # and this is an actual problem if ($isJitarSet && $userProblem->value) { - $user_problem_status = jitar_problem_adjusted_status($userProblem, $db); + $user_problem_status = jitar_problem_adjusted_status($userProblem, $db); } # if its a jitar set then we only want to add top level problems # to the student total score # otherwise we add up everything if ($isJitarSet && $userProblem->problem_id) { - my @seq = jitar_id_to_seq($userProblem->problem_id); - if ($#seq == 0) { - $userStatusTotals{$user} += $user_problem_status * $userProblem->value; - } + my @seq = jitar_id_to_seq($userProblem->problem_id); + if ($#seq == 0) { + $userStatusTotals{$user} += $user_problem_status * $userProblem->value; + } } else { - $userStatusTotals{$user} += $user_problem_status * $userProblem->value; + $userStatusTotals{$user} += $user_problem_status * $userProblem->value; } - if ($scoringItems->{successIndex}) { - $numberOfAttempts{$user} = 0 unless defined($numberOfAttempts{$user}); - my $num_correct = $userProblem->num_correct; - my $num_incorrect = $userProblem->num_incorrect; - $num_correct = ( defined($num_correct) and $num_correct) ? $num_correct : 0; - $num_incorrect = ( defined($num_incorrect) and $num_incorrect) ? $num_incorrect : 0; + if ($scoringItems->{successIndex}) { + $numberOfAttempts{$user} = 0 unless defined($numberOfAttempts{$user}); + my $num_correct = $userProblem->num_correct; + my $num_incorrect = $userProblem->num_incorrect; + $num_correct = (defined($num_correct) and $num_correct) ? $num_correct : 0; + $num_incorrect = (defined($num_incorrect) and $num_incorrect) ? $num_incorrect : 0; $numberOfAttempts{$user} += $num_correct + $num_incorrect; } if ($scoringItems->{problemScores}) { - $scoringData[7 + $user][$column] = $userProblem->status; - my $extraColumns = 0; - if ($isJitarSet) { - $extraColumns++; - $scoringData[7 + $user][$column + $extraColumns] = $user_problem_status; - } - if ($scoringItems->{problemAttempts}) { - $extraColumns++; - $scoringData[7 + $user][$column + $extraColumns] = $userProblem->num_correct; - $extraColumns++; - $scoringData[7 + $user][$column + $extraColumns] = $userProblem->num_incorrect; - } + $scoringData[ 7 + $user ][$column] = $userProblem->status; + my $extraColumns = 0; + if ($isJitarSet) { + $extraColumns++; + $scoringData[ 7 + $user ][ $column + $extraColumns ] = $user_problem_status; + } + if ($scoringItems->{problemAttempts}) { + $extraColumns++; + $scoringData[ 7 + $user ][ $column + $extraColumns ] = $userProblem->num_correct; + $extraColumns++; + $scoringData[ 7 + $user ][ $column + $extraColumns ] = $userProblem->num_incorrect; + } } } } if ($scoringItems->{successIndex}) { for (my $user = 0; $user < @sortedUserIDs; $user++) { - my $avg_num_attempts = ($num_of_problems) ? $numberOfAttempts{$user}/$num_of_problems : 0; - $userSuccessIndex{$user} = ($avg_num_attempts && $valueTotal) ? ($userStatusTotals{$user}/$valueTotal)**2/$avg_num_attempts : 0; + my $avg_num_attempts = ($num_of_problems) ? $numberOfAttempts{$user} / $num_of_problems : 0; + $userSuccessIndex{$user} = + ($avg_num_attempts && $valueTotal) + ? ($userStatusTotals{$user} / $valueTotal)**2 / $avg_num_attempts + : 0; } } # write the status totals - if ($scoringItems->{setTotals}) { # Ironic, isn't it? + if ($scoringItems->{setTotals}) { # Ironic, isn't it? my $totalsColumn = $format eq "totals" ? 0 : 5 + @problemIDs * $columnsPerProblem; - $scoringData[0][$totalsColumn] = ""; - $scoringData[1][$totalsColumn] = $setRecord->set_id; - $scoringData[2][$totalsColumn] = ""; - $scoringData[3][$totalsColumn] = ""; - $scoringData[4][$totalsColumn] = ""; - $scoringData[5][$totalsColumn] = $valueTotal; - $scoringData[6][$totalsColumn] = $r->maketext("total"); + $scoringData[0][$totalsColumn] = ""; + $scoringData[1][$totalsColumn] = $setRecord->set_id; + $scoringData[2][$totalsColumn] = ""; + $scoringData[3][$totalsColumn] = ""; + $scoringData[4][$totalsColumn] = ""; + $scoringData[5][$totalsColumn] = $valueTotal; + $scoringData[6][$totalsColumn] = $r->maketext("total"); + if ($scoringItems->{successIndex}) { - $scoringData[0][$totalsColumn+1] = ""; - $scoringData[1][$totalsColumn+1] = $setRecord->set_id; - $scoringData[2][$totalsColumn+1] = ""; - $scoringData[3][$totalsColumn+1] = ""; - $scoringData[4][$totalsColumn+1] = ""; - $scoringData[5][$totalsColumn+1] = '100'; - $scoringData[6][$totalsColumn+1] = $r->maketext("index"); + $scoringData[0][ $totalsColumn + 1 ] = ""; + $scoringData[1][ $totalsColumn + 1 ] = $setRecord->set_id; + $scoringData[2][ $totalsColumn + 1 ] = ""; + $scoringData[3][ $totalsColumn + 1 ] = ""; + $scoringData[4][ $totalsColumn + 1 ] = ""; + $scoringData[5][ $totalsColumn + 1 ] = '100'; + $scoringData[6][ $totalsColumn + 1 ] = $r->maketext("index"); } for (my $user = 0; $user < @sortedUserIDs; $user++) { - $userStatusTotals{$user} =$userStatusTotals{$user} ||0; - $scoringData[7+$user][$totalsColumn] = wwRound(2,$userStatusTotals{$user}) if $scoringItems->{setTotals}; - $scoringData[7+$user][$totalsColumn+1] = sprintf("%.0f",100*$userSuccessIndex{$user}) if $scoringItems->{successIndex}; + $userStatusTotals{$user} = $userStatusTotals{$user} || 0; + $scoringData[ 7 + $user ][$totalsColumn] = wwRound(2, $userStatusTotals{$user}) + if $scoringItems->{setTotals}; + $scoringData[ 7 + $user ][ $totalsColumn + 1 ] = sprintf("%.0f", 100 * $userSuccessIndex{$user}) + if $scoringItems->{successIndex}; } } @@ -623,110 +634,111 @@ sub scoreSet { } sub sumScores { # Create a totals column for each student - # Also create columns with percentage grades per assignment if requested - my $self = shift; - my $r_totals = shift; - my $showIndex = shift; - my $r_users = shift; - my $r_sorted_user_ids =shift; + # Also create columns with percentage grades per assignment if requested + my $self = shift; + my $r_totals = shift; + my $showIndex = shift; + my $r_users = shift; + my $r_sorted_user_ids = shift; my $addPercentagePerAssignmentColumns = shift; - my $r = $self->r; - my $db = $r->db; - my @scoringData = (); - my $index_increment = ($showIndex) ? 2 : 1; + my $r = $self->r; + my $db = $r->db; + my @scoringData = (); + my $index_increment = ($showIndex) ? 2 : 1; # This whole thing is a hack, but here goes. We're going to sum the appropriate columns of the totals file: # I believe we have $r_totals->[rows]->[cols] -- the way it's printed out. - my $start_column = 6; #The problem column - my $last_column = $#{$r_totals->[1]}; # try to figure out the number of the last column in the array. - my $row_count = $#{$r_totals}; + my $start_column = 6; #The problem column + my $last_column = $#{ $r_totals->[1] }; # try to figure out the number of the last column in the array. + my $row_count = $#{$r_totals}; # Calculate total number of problems for the course. - my $totalPoints = 0; - my $problemValueRow = 5; - for( my $j = $start_column;$j<=$last_column;$j+= $index_increment) { + my $totalPoints = 0; + my $problemValueRow = 5; + for (my $j = $start_column; $j <= $last_column; $j += $index_increment) { my $score = $r_totals->[$problemValueRow]->[$j]; - $totalPoints += ($score =~/^\s*[\d\.]+\s*$/)? $score : 0; + $totalPoints += ($score =~ /^\s*[\d\.]+\s*$/) ? $score : 0; } - foreach my $i (0..$row_count) { + foreach my $i (0 .. $row_count) { # Skip heading rows - next if ( $i <= ( $problemValueRow +1 ) ); # the row after $problemValueRow has headers - my $studentTotal = 0; - my $hw_Cnum = 2; # The first 2 columns we produce will be for summary and total score from 100 - for( my $j = $start_column;$j<=$last_column;$j+= $index_increment) { + next if ($i <= ($problemValueRow + 1)); # the row after $problemValueRow has headers + my $studentTotal = 0; + my $hw_Cnum = 2; # The first 2 columns we produce will be for summary and total score from 100 + for (my $j = $start_column; $j <= $last_column; $j += $index_increment) { my $score = $r_totals->[$i]->[$j]; - $studentTotal += ($score =~/^\s*[\d\.]+\s*$/)? $score : 0; - if ( $addPercentagePerAssignmentColumns ) { - $scoringData[$i][$hw_Cnum] = ($score) ? - # Note: the multiplication by 100 is OUTSIDE the wwRound() so the computed - # score is an integer percentage, just as that displayed by - # lib/WeBWorK/ContentGenerator/Grades.pm as $totalRightPercent. - ( 100 * wwRound( 2, $score/ ($r_totals->[$problemValueRow]->[$j]) ) ) : 0; + $studentTotal += ($score =~ /^\s*[\d\.]+\s*$/) ? $score : 0; + if ($addPercentagePerAssignmentColumns) { + $scoringData[$i][$hw_Cnum] = ($score) + ? + # Note: the multiplication by 100 is OUTSIDE the wwRound() so the computed + # score is an integer percentage, just as that displayed by + # lib/WeBWorK/ContentGenerator/Grades.pm as $totalRightPercent. + (100 * wwRound(2, $score / ($r_totals->[$problemValueRow]->[$j]))) + : 0; $hw_Cnum++; } } - $scoringData[$i][0] = wwRound(2,$studentTotal); - $scoringData[$i][1] = ($totalPoints) ?wwRound(2,100*$studentTotal/$totalPoints) : 0; - } - - my @HeaderRowsData0 = ('',''); - my @HeaderRowsData1 = ($r->maketext('summary'),$r->maketext('%score')); - my @HeaderRowsData2 = ('',''); - if ( $addPercentagePerAssignmentColumns ) { - for( my $j = $start_column;$j<=$last_column;$j+= $index_increment) { - push( @HeaderRowsData0 , '' ); - push( @HeaderRowsData1 , $r_totals->[1]->[$j] ); # The assignment number - push( @HeaderRowsData2 , $r->maketext('%score') ); + $scoringData[$i][0] = wwRound(2, $studentTotal); + $scoringData[$i][1] = ($totalPoints) ? wwRound(2, 100 * $studentTotal / $totalPoints) : 0; + } + + my @HeaderRowsData0 = ('', ''); + my @HeaderRowsData1 = ($r->maketext('summary'), $r->maketext('%score')); + my @HeaderRowsData2 = ('', ''); + if ($addPercentagePerAssignmentColumns) { + for (my $j = $start_column; $j <= $last_column; $j += $index_increment) { + push(@HeaderRowsData0, ''); + push(@HeaderRowsData1, $r_totals->[1]->[$j]); # The assignment number + push(@HeaderRowsData2, $r->maketext('%score')); } } - $scoringData[1] = [ @HeaderRowsData1 ]; - $scoringData[6] = [ @HeaderRowsData1 ]; # Put the header in this row also + $scoringData[1] = [@HeaderRowsData1]; + $scoringData[6] = [@HeaderRowsData1]; # Put the header in this row also - $scoringData[2] = [ @HeaderRowsData2 ]; + $scoringData[2] = [@HeaderRowsData2]; - foreach my $j ( 0 , 3 .. 5 ) { - $scoringData[$j] = [ @HeaderRowsData0 ]; + foreach my $j (0, 3 .. 5) { + $scoringData[$j] = [@HeaderRowsData0]; } return @scoringData; } - # Often it's more efficient to just get everything out of the database # and then pick out what you want later. Hence, these "everything2*" functions sub everything2info { my ($self, @everything) = @_; my @result = (); foreach my $row (@everything) { - push @result, [@{$row}[0..4]]; + push @result, [ @{$row}[ 0 .. 4 ] ]; } return @result; } sub everything2normal { my ($self, @everything) = @_; - my @result = (); + my @result = (); my $adjstatus = 0; # if its has adjusted status columns we need to include # those as well my $str = $self->r->maketext('ADJ STATUS'); - if (grep(grep(/$str/, @{$_}),@everything)) { - $adjstatus = 1; + if (grep(grep(/$str/, @{$_}), @everything)) { + $adjstatus = 1; } foreach my $row (@everything) { - my @row = @$row; + my @row = @$row; my @newRow = (); - push @newRow, @row[0..4]; + push @newRow, @row[ 0 .. 4 ]; if ($adjstatus) { - for (my $i = 5; $i < @row; $i+=4) { - push @newRow, $row[$i]; - push @newRow, $row[$i+1]; - } + for (my $i = 5; $i < @row; $i += 4) { + push @newRow, $row[$i]; + push @newRow, $row[ $i + 1 ]; + } } else { - for (my $i = 5; $i < @row; $i+=3) { - push @newRow, $row[$i]; - } + for (my $i = 5; $i < @row; $i += 3) { + push @newRow, $row[$i]; + } } #push @newRow, $row[$#row]; push @result, [@newRow]; @@ -738,7 +750,7 @@ sub everything2full { my ($self, @everything) = @_; my @result = (); foreach my $row (@everything) { - push @result, [@{$row}[0..($#{$row}-1)]]; + push @result, [ @{$row}[ 0 .. ($#{$row} - 1) ] ]; } return @result; } @@ -747,7 +759,7 @@ sub everything2totals { my ($self, @everything) = @_; my @result = (); foreach my $row (@everything) { - push @result, [${$row}[$#{$row}]]; + push @result, [ ${$row}[ $#{$row} ] ]; } return @result; } @@ -757,7 +769,7 @@ sub appendColumns { my @a1 = @$a1; my @a2 = @$a2; for (my $i = 0; $i < @a1; $i++) { - push @{$a1[$i]}, @{$a2[$i]}; + push @{ $a1[$i] }, @{ $a2[$i] }; } } @@ -770,9 +782,11 @@ sub writeCSV { my @lengths = (); for (my $row = 0; $row < @csv; $row++) { - for (my $column = 0; $column < @{$csv[$row]}; $column++) { + for (my $column = 0; $column < @{ $csv[$row] }; $column++) { $lengths[$column] = 0 unless defined $lengths[$column]; - $lengths[$column] = length $csv[$row][$column] if defined($csv[$row][$column]) and length $csv[$row][$column] > $lengths[$column]; + $lengths[$column] = length $csv[$row][$column] + if defined($csv[$row][$column]) + and length $csv[$row][$column] > $lengths[$column]; } } @@ -780,11 +794,11 @@ sub writeCSV { # We do not backup any other type of scoring files (e.g. ful or scr). if (($filename =~ m|(.*)/(.*_totals)\.csv$|) and (-e $filename)) { - my $scoringDir = $1; + my $scoringDir = $1; my $short_filename = $2; - my $i=1; - while(-e "${scoringDir}/${short_filename}_bak$i.csv") {$i++;} #don't overwrite existing backups - my $bakFileName ="${scoringDir}/${short_filename}_bak$i.csv"; + my $i = 1; + while (-e "${scoringDir}/${short_filename}_bak$i.csv") { $i++; } #don't overwrite existing backups + my $bakFileName = "${scoringDir}/${short_filename}_bak$i.csv"; rename $filename, $bakFileName or warn "Unable to rename $filename to $bakFileName"; } @@ -807,9 +821,9 @@ sub writeCSV { sub readStandardCSV { my ($self, $fileName) = @_; my @result = (); - my @rows = split m/\n/, readFile($fileName); + my @rows = split m/\n/, readFile($fileName); foreach my $row (@rows) { - push @result, [$self->splitQuoted($row)]; + push @result, [ $self->splitQuoted($row) ]; } return @result; } @@ -818,7 +832,7 @@ sub writeStandardCSV { my ($self, $filename, @csv) = @_; open my $fh, ">:encoding(UTF-8)", $filename; foreach my $row (@csv) { - print $fh (join ",", map {$self->quote($_)} @$row); + print $fh (join ",", map { $self->quote($_) } @$row); print $fh "\n"; } close $fh; @@ -842,7 +856,7 @@ sub unquote { sub splitQuoted { my ($self, $string) = @_; my ($leadingSpace, $preText, $quoted, $postText, $trailingSpace, $result); - my @result = (); + my @result = (); my $continue = 1; while ($continue) { $string =~ m/\G(\s*)/gc; @@ -855,13 +869,13 @@ sub splitQuoted { $string =~ m/\G([^,]*?)(\s*)(,?)/gc; ($postText, $trailingSpace, $continue) = ($1, $2, $3); - $preText = "" unless defined $preText; + $preText = "" unless defined $preText; $postText = "" unless defined $postText; - $quoted = "" unless defined $quoted; + $quoted = "" unless defined $quoted; if ($quoted and (not $preText and not $postText)) { - $quoted =~ s/""/"/; - $result = $quoted; + $quoted =~ s/""/"/; + $result = $quoted; } else { $result = "$preText$quoted$postText"; } @@ -883,11 +897,11 @@ sub quote { sub pad { my ($self, $string, $padTo) = @_; $string = '' unless defined $string; - return $string unless $self->{padFields}==1; + return $string unless $self->{padFields} == 1; my $spaces = $padTo - length $string; -# return " "x$spaces.$string; - return $string." "x$spaces; + # return " "x$spaces.$string; + return $string . " " x $spaces; } sub maxLength { diff --git a/lib/WeBWorK/ContentGenerator/Instructor/ScoringDownload.pm b/lib/WeBWorK/ContentGenerator/Instructor/ScoringDownload.pm index a923cc8831..d8621e2235 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/ScoringDownload.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/ScoringDownload.pm @@ -27,7 +27,7 @@ use strict; use warnings; sub pre_header_initialize { - my ($self) = @_; + my ($self) = @_; my $r = $self->r; my $ce = $r->ce; my $authz = $r->authz; @@ -35,20 +35,20 @@ sub pre_header_initialize { my $file = $r->param('getFile'); my $user = $r->param('user'); - - # the parameter 'getFile" needs to be sanitized. (see bug #3793 ) - # See checkName in FileManager.pm for a more complete sanitization. - if ($authz->hasPermissions($user, "score_sets")) { - unless ( $file eq WeBWorK::ContentGenerator::Instructor::FileManager::checkName($file) ) { # + # the parameter 'getFile" needs to be sanitized. (see bug #3793 ) + # See checkName in FileManager.pm for a more complete sanitization. + if ($authz->hasPermissions($user, "score_sets")) { + unless ($file eq WeBWorK::ContentGenerator::Instructor::FileManager::checkName($file)) { # $self->addbadmessage($r->maketext("Your file name is not valid! ")); - $self->addbadmessage($r->maketext("A file name cannot begin with a dot, it cannot be empty, it cannot contain a " . - "directory path component and only the characters -_.a-zA-Z0-9 and space are allowed.") - ); - } else { - $self->reply_with_file("text/comma-separated-values", "$scoringDir/$file", $file, 0); - # 0==don't delete file after downloading - } - } else { + $self->addbadmessage($r->maketext( + "A file name cannot begin with a dot, it cannot be empty, it cannot contain a " + . "directory path component and only the characters -_.a-zA-Z0-9 and space are allowed." + )); + } else { + $self->reply_with_file("text/comma-separated-values", "$scoringDir/$file", $file, 0); + # 0==don't delete file after downloading + } + } else { $self->addbadmessage("You do not have permission to access scoring data."); } } diff --git a/lib/WeBWorK/ContentGenerator/Instructor/SendMail.pm b/lib/WeBWorK/ContentGenerator/Instructor/SendMail.pm index 654a506a4b..4815de3760 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/SendMail.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/SendMail.pm @@ -33,7 +33,7 @@ use Try::Tiny; use Data::Dump qw/dump/; use WeBWorK::Debug; -use Socket qw/unpack_sockaddr_in inet_ntoa/; # for remote host/port info +use Socket qw/unpack_sockaddr_in inet_ntoa/; # for remote host/port info use Text::Wrap qw(wrap); use WeBWorK::HTML::ScrollingRecordList qw/scrollingRecordList/; use WeBWorK::Utils qw/readFile readDirectory/; @@ -48,9 +48,8 @@ sub initialize { my $user = $r->param('user'); my @selected_filters; - if (defined ($r->param('classList!filter'))){ @selected_filters = $r->param('classList!filter');} - else {@selected_filters = ("all");} - + if (defined($r->param('classList!filter'))) { @selected_filters = $r->param('classList!filter'); } + else { @selected_filters = ("all"); } # Check permissions return unless $authz->hasPermissions($user, "access_instructor_tools"); @@ -59,69 +58,69 @@ sub initialize { ############################################################################################# # gather directory data ############################################################################################# - my $emailDirectory = $ce->{courseDirs}->{email}; - my $scoringDirectory = $ce->{courseDirs}->{scoring}; - my $templateDirectory = $ce->{courseDirs}->{templates}; + my $emailDirectory = $ce->{courseDirs}->{email}; + my $scoringDirectory = $ce->{courseDirs}->{scoring}; + my $templateDirectory = $ce->{courseDirs}->{templates}; - my $openfilename = $r->param('openfilename'); - my $savefilename = $r->param('savefilename'); - my $mergefile = $r->param('merge_file'); + my $openfilename = $r->param('openfilename'); + my $savefilename = $r->param('savefilename'); + my $mergefile = $r->param('merge_file'); #FIXME get these values from global course environment (see subroutines as well) - my $default_msg_file = 'default.msg'; - my $old_default_msg_file = 'old_default.msg'; + my $default_msg_file = 'default.msg'; + my $old_default_msg_file = 'old_default.msg'; #if mergefile or openfilename haven't been defined via parameter # check the database to see if there is a file we should use. # if they have been defined via parameter then we should update the db if (defined($openfilename) && $openfilename) { - $db->setSettingValue("${user}_openfile",$openfilename); + $db->setSettingValue("${user}_openfile", $openfilename); } elsif ($db->settingExists("${user}_openfile")) { - $openfilename = $db->getSettingValue("${user}_openfile"); + $openfilename = $db->getSettingValue("${user}_openfile"); } if (defined($mergefile) && $mergefile) { - $db->setSettingValue("${user}_mergefile",$mergefile); + $db->setSettingValue("${user}_mergefile", $mergefile); } elsif ($db->settingExists("${user}_mergefile")) { - $mergefile = $db->getSettingValue("${user}_mergefile"); - $mergefile = undef unless (-e "$ce->{courseDirs}{scoring}/$mergefile"); + $mergefile = $db->getSettingValue("${user}_mergefile"); + $mergefile = undef unless (-e "$ce->{courseDirs}{scoring}/$mergefile"); } # Figure out action from submit data my $action = ''; if ($r->param('sendEmail')) { - $action = 'sendEmail'; + $action = 'sendEmail'; } elsif ($r->param('saveMessage')) { - $action = 'saveMessage'; + $action = 'saveMessage'; } elsif ($r->param('saveAs')) { - $action = 'saveAs'; + $action = 'saveAs'; } elsif ($r->param('saveDefault')) { - $action = 'saveDefault'; + $action = 'saveDefault'; } elsif ($r->param('openMessage')) { - $action = 'openMessage'; + $action = 'openMessage'; } elsif ($r->param('updateSettings')) { - $action = 'updateSettings'; + $action = 'updateSettings'; } elsif ($r->param('previewMessage')) { - $action = 'previewMessage'; + $action = 'previewMessage'; } # get user record my $ur = $db->getUser($user); # store data - $self->{defaultFrom} = $ur->rfc822_mailbox; - $self->{defaultReply} = $ur->rfc822_mailbox; - $self->{defaultSubject} = $self->r->urlpath->arg("courseID") . " notice"; - - $self->{rows} = (defined($r->param('rows'))) ? $r->param('rows') : $ce->{mail}->{editor_window_rows}; - $self->{columns} = (defined($r->param('columns'))) ? $r->param('columns') : $ce->{mail}->{editor_window_columns}; - $self->{default_msg_file} = $default_msg_file; - $self->{old_default_msg_file} = $old_default_msg_file; - $self->{merge_file} = $mergefile; + $self->{defaultFrom} = $ur->rfc822_mailbox; + $self->{defaultReply} = $ur->rfc822_mailbox; + $self->{defaultSubject} = $self->r->urlpath->arg("courseID") . " notice"; + + $self->{rows} = (defined($r->param('rows'))) ? $r->param('rows') : $ce->{mail}->{editor_window_rows}; + $self->{columns} = (defined($r->param('columns'))) ? $r->param('columns') : $ce->{mail}->{editor_window_columns}; + $self->{default_msg_file} = $default_msg_file; + $self->{old_default_msg_file} = $old_default_msg_file; + $self->{merge_file} = $mergefile; # an expermiment -- share the scrolling list for preivew and sendTo actions. - my @classList = (defined($r->param('classList'))) ? $r->param('classList') : ($user); - $self->{preview_user} = $classList[0] || $user; + my @classList = (defined($r->param('classList'))) ? $r->param('classList') : ($user); + $self->{preview_user} = $classList[0] || $user; ############################################################################################# # Gather database data @@ -206,17 +205,18 @@ sub initialize { ################################################################# # Determine the file name to save message into ################################################################# - my $output_file = 'FIXME no output file specified'; + my $output_file = 'FIXME no output file specified'; if ($action eq 'saveDefault') { - $output_file = $default_msg_file; + $output_file = $default_msg_file; } elsif ($action eq 'saveMessage' or $action eq 'saveAs') { - if (defined($savefilename) and $savefilename ) { - $output_file = $savefilename; + if (defined($savefilename) and $savefilename) { + $output_file = $savefilename; } else { - $self->addbadmessage(CGI::p($r->maketext("No filename was specified for saving! The message was not saved."))); + $self->addbadmessage( + CGI::p($r->maketext("No filename was specified for saving! The message was not saved."))); } - } elsif ( defined($input_file) ) { - $output_file = $input_file; + } elsif (defined($input_file)) { + $output_file = $input_file; } ################################################################# @@ -224,55 +224,62 @@ sub initialize { ################################################################# if ($output_file =~ /^[~.]/ || $output_file =~ /\.\./) { - $self->addbadmessage(CGI::p($r->maketext("For security reasons, you cannot specify a message file from a directory higher than the email directory (you can't use ../blah/blah for example). Please specify a different file or move the needed file to the email directory"))); + $self->addbadmessage(CGI::p( + $r->maketext( + "For security reasons, you cannot specify a message file from a directory higher than the email directory (you can't use ../blah/blah for example). Please specify a different file or move the needed file to the email directory" + ) + )); } - unless ($output_file =~ m|\.msg$| ) { - $self->addbadmessage(CGI::p($r->maketext("Invalid file name. The file name \"[_1]\" does not have a \".msg\" extension All email file names must end in the extension \".msg\" choose a file name with a \".msg\" extension. The message was not saved.",$output_file))); + unless ($output_file =~ m|\.msg$|) { + $self->addbadmessage(CGI::p($r->maketext( + "Invalid file name. The file name \"[_1]\" does not have a \".msg\" extension All email file names must end in the extension \".msg\" choose a file name with a \".msg\" extension. The message was not saved.", + $output_file + ))); } - $self->{output_file} = $output_file; # this is ok. It will be put back in the text input box for re-editing. - + $self->{output_file} = $output_file; # this is ok. It will be put back in the text input box for re-editing. ############################################################################################# # Determine input source ############################################################################################# #warn "Action = $action"; my $input_source; - if ($action){ - $input_source = ( defined( $r->param('body') ) and $action ne 'openMessage' ) ? 'form' : 'file';} - else { $input_source = ( defined($r->param('body')) ) ? 'form' : 'file';} + if ($action) { + $input_source = (defined($r->param('body')) and $action ne 'openMessage') ? 'form' : 'file'; + } else { + $input_source = (defined($r->param('body'))) ? 'form' : 'file'; + } ############################################################################################# # Get inputs ############################################################################################# - my($from, $replyTo, $r_text, $subject); + my ($from, $replyTo, $r_text, $subject); if ($input_source eq 'file') { - ($from, $replyTo,$subject,$r_text) = $self->read_input_file("$emailDirectory/$input_file"); - + ($from, $replyTo, $subject, $r_text) = $self->read_input_file("$emailDirectory/$input_file"); } elsif ($input_source eq 'form') { # read info from the form # bail if there is no message body - $from = $r->param('from'); - $replyTo = $r->param('replyTo'); - $subject = $r->param('subject'); - my $body = $r->param('body'); + $from = $r->param('from'); + $replyTo = $r->param('replyTo'); + $subject = $r->param('subject'); + my $body = $r->param('body'); # Sanity check: body must contain non-white space $self->addbadmessage(CGI::p($r->maketext('You didn\'t enter any message.'))) unless ($r->param('body') =~ /\S/); - $r_text = \$body; + $r_text = \$body; } my $remote_host = $r->useragent_addr->ip_get || "UNKNOWN"; # store data - $self->{from} = $from; - $self->{replyTo} = $replyTo; - $self->{subject} = $subject; - $self->{remote_host} = $remote_host; - $self->{r_text} = $r_text; + $self->{from} = $from; + $self->{replyTo} = $replyTo; + $self->{subject} = $subject; + $self->{remote_host} = $remote_host; + $self->{r_text} = $r_text; ################################################################################### #Determine the appropriate script action from the buttons @@ -299,12 +306,13 @@ sub initialize { ############################################################################################# # if no form is submitted, gather data needed to produce the mail form and return ############################################################################################# - my $to = $r->param('To'); - my $script_action = ''; - + my $to = $r->param('To'); + my $script_action = ''; - if(not $action or $action eq 'openMessage' - or $action eq 'updateSettings'){ + if (not $action + or $action eq 'openMessage' + or $action eq 'updateSettings') + { return ''; } @@ -314,7 +322,6 @@ sub initialize { # and various actions resulting from different buttons ############################################################################################# - if ($action eq 'saveMessage' or $action eq 'saveAs' or $action eq 'saveDefault') { #warn "FIXME Saving files action = $action outputFileName=$output_file"; @@ -322,46 +329,58 @@ sub initialize { ################################################################# # construct message body ################################################################# - my $temp_body = ${ $r_text }; + my $temp_body = ${$r_text}; $temp_body =~ s/\r\n/\n/g; - $temp_body = join("\n", - "From: $from", - "Reply-To: $replyTo", - "Subject: $subject", - "Content-Type: text/plain; charset=UTF-8", - "Message:", - # Do NOT encode to UTF-8 here. - $temp_body); + $temp_body = join( + "\n", + "From: $from", + "Reply-To: $replyTo", + "Subject: $subject", + "Content-Type: text/plain; charset=UTF-8", + "Message:", + # Do NOT encode to UTF-8 here. + $temp_body + ); #warn "FIXME from $from | subject $subject |reply $replyTo|msg $temp_body"; ################################################################# # overwrite protection ################################################################# if ($action eq 'saveAs' and -e "$emailDirectory/$output_file") { - $self->addbadmessage(CGI::p($r->maketext("The file [_1]/[_2] already exists and cannot be overwritten. The message was not saved",$emailDirectory, $openfilename ))); + $self->addbadmessage(CGI::p($r->maketext( + "The file [_1]/[_2] already exists and cannot be overwritten. The message was not saved", + $emailDirectory, $openfilename + ))); return; } ################################################################# - # Back up existing file? - ################################################################# - if ($action eq 'saveDefault' and -e "$emailDirectory/$default_msg_file") { - rename("$emailDirectory/$default_msg_file","$emailDirectory/$old_default_msg_file") or - die "Can't rename $emailDirectory/$default_msg_file to $emailDirectory/$old_default_msg_file ", - "Check permissions for webserver on directory $emailDirectory. $!"; - $self->addgoodmessage(CGI::p($r->maketext("Backup file [_1]/[_2] created.",$emailDirectory,$old_default_msg_file) . CGI::br())); - } - ################################################################# - # Save the message + # Back up existing file? + ################################################################# + if ($action eq 'saveDefault' and -e "$emailDirectory/$default_msg_file") { + rename("$emailDirectory/$default_msg_file", "$emailDirectory/$old_default_msg_file") + or die "Can't rename $emailDirectory/$default_msg_file to $emailDirectory/$old_default_msg_file ", + "Check permissions for webserver on directory $emailDirectory. $!"; + $self->addgoodmessage(CGI::p( + $r->maketext("Backup file [_1]/[_2] created.", $emailDirectory, $old_default_msg_file) + . CGI::br() + )); + } + ################################################################# + # Save the message ################################################################# - $self->saveProblem($temp_body, "${emailDirectory}/$output_file" ) unless ($output_file =~ /^[~.]/ || $output_file =~ /\.\./ || not $output_file =~ m|\.msg$|); - unless ( $self->{submit_message} or not -w "${emailDirectory}/$output_file" ) { # if there are no errors report success - $self->addgoodmessage(CGI::p($r->maketext("Message saved to file [_1]/[_2].",$emailDirectory, $output_file))); - $self->{input_file} = $output_file; - $db->setSettingValue("${user}_openfile",$output_file); + $self->saveProblem($temp_body, "${emailDirectory}/$output_file") + unless ($output_file =~ /^[~.]/ || $output_file =~ /\.\./ || not $output_file =~ m|\.msg$|); + unless ($self->{submit_message} or not -w "${emailDirectory}/$output_file") + { # if there are no errors report success + $self->addgoodmessage( + CGI::p($r->maketext("Message saved to file [_1]/[_2].", $emailDirectory, $output_file)) + ); + $self->{input_file} = $output_file; + $db->setSettingValue("${user}_openfile", $output_file); } } elsif ($action eq 'previewMessage') { - $self->{response} = 'preview'; + $self->{response} = 'preview'; } elsif ($action eq 'sendEmail') { # verify format of From address (one valid rfc2822/rfc5322 address) @@ -380,7 +399,7 @@ sub initialize { } } - # Check that recipients have been selected. + # Check that recipients have been selected. unless (@{ $self->{ra_send_to} }) { $self->addbadmessage( $r->maketext('No recipients selected. Please select one or more recipients from the list below.')); @@ -388,22 +407,22 @@ sub initialize { } # get merge file - my $merge_file = ( defined($self->{merge_file}) ) ? $self->{merge_file} : 'None'; - my $delimiter = ','; - my $rh_merge_data = $self->read_scoring_file("$merge_file", "$delimiter"); - unless (ref($rh_merge_data) ) { + my $merge_file = (defined($self->{merge_file})) ? $self->{merge_file} : 'None'; + my $delimiter = ','; + my $rh_merge_data = $self->read_scoring_file("$merge_file", "$delimiter"); + unless (ref($rh_merge_data)) { $self->addbadmessage(CGI::p($r->maketext("No merge data file"))); - $self->addbadmessage(CGI::p($r->maketext("Can't read merge file [_1]. No message sent",$merge_file))); + $self->addbadmessage(CGI::p($r->maketext("Can't read merge file [_1]. No message sent", $merge_file))); return; - } ; + } $self->{rh_merge_data} = $rh_merge_data; # we don't set the response until we're sure that email can be sent - $self->{response} = 'send_email'; + $self->{response} = 'send_email'; # FIXME i'm not sure why we're pulling this out here -- mail_message_to_recipients does have # access to the course environment and should just grab it directly - $self->{smtpServer} = $ce->{mail}->{smtpServer}; + $self->{smtpServer} = $ce->{mail}->{smtpServer}; # do actual mailing in the cleanup phase, since it could take a long time # FIXME we need to do a better job providing status notifications for long-running email jobs @@ -413,8 +432,8 @@ sub initialize { my $result_message = eval { $self->mail_message_to_recipients() }; if ($@) { # add the die message to the result message - $result_message .= "An error occurred while trying to send email.\n" - . "The error message is:\n\n$@\n\n"; + $result_message .= + "An error occurred while trying to send email.\n" . "The error message is:\n\n$@\n\n"; # and also write it to the apache log $r->log->error("An error occurred while trying to send email: $@\n"); } @@ -428,16 +447,16 @@ sub initialize { } else { $self->addbadmessage(CGI::p($r->maketext("Didn't recognize action"))); } -} #end initialize +} #end initialize sub body { - my ($self) = @_; - my $r = $self->r; - my $urlpath = $r->urlpath; - my $authz = $r->authz; - my $setID = $urlpath->arg("setID"); - my $response = (defined($self->{response}))? $self->{response} : ''; - my $user = $r->param('user'); + my ($self) = @_; + my $r = $self->r; + my $urlpath = $r->urlpath; + my $authz = $r->authz; + my $setID = $urlpath->arg("setID"); + my $response = (defined($self->{response})) ? $self->{response} : ''; + my $user = $r->param('user'); # Check permissions return CGI::div({ class => 'alert alert-danger p-1 mb-0' }, @@ -450,7 +469,7 @@ sub body { if ($response eq 'preview') { $self->print_preview($setID); - } elsif ($response eq 'send_email' and $self->{ra_send_to} and @{$self->{ra_send_to}}){ + } elsif ($response eq 'send_email' and $self->{ra_send_to} and @{ $self->{ra_send_to} }) { my $message = CGI::i($r->maketext( "Email is being sent to [quant,_1,recipient]. You will be notified by email when the task is completed. This may take several minutes if the class is @@ -467,50 +486,50 @@ sub body { } sub print_preview { - my ($self) = @_; - my $r = $self->r; - my $urlpath = $r->urlpath; - my $setID = $urlpath->arg("setID"); + my ($self) = @_; + my $r = $self->r; + my $urlpath = $r->urlpath; + my $setID = $urlpath->arg("setID"); # get preview user - my $ur = $r->db->getUser($self->{preview_user}); #checked - die "record for preview user ".$self->{preview_user}. " not found." unless $ur; + my $ur = $r->db->getUser($self->{preview_user}); #checked + die "record for preview user " . $self->{preview_user} . " not found." unless $ur; # get merge file - my $merge_file = ( defined($self->{merge_file}) ) ? $self->{merge_file} : 'None'; - my $delimiter = ','; - my $rh_merge_data = $self->read_scoring_file("$merge_file", "$delimiter"); + my $merge_file = (defined($self->{merge_file})) ? $self->{merge_file} : 'None'; + my $delimiter = ','; + my $rh_merge_data = $self->read_scoring_file("$merge_file", "$delimiter"); - my ($msg, $preview_header) = $self->process_message($ur,$rh_merge_data,1); # 1 == for preview + my ($msg, $preview_header) = $self->process_message($ur, $rh_merge_data, 1); # 1 == for preview - my $recipients = join(" ", @{ $self->{ra_send_to} }); - my $errorMessage = defined($self->{submit_message}) ? CGI::i($self->{submit_message} ) : '' ; + my $recipients = join(" ", @{ $self->{ra_send_to} }); + my $errorMessage = defined($self->{submit_message}) ? CGI::i($self->{submit_message}) : ''; # Format message keeping the preview_header lined up - $errorMessage = wrap("","",$errorMessage); - $msg = wrap("","",$msg); - - $msg = join("", - "To: ", $ur->email_address,"\n", - "From: ", "$self->{from}" , "\n", - "Reply-To: ", $self->{replyTo} , "\n", - "Subject: ", $self->{subject} , "\n", - # In a real mails we would UTF-8 encode the message - # and give the Content-Type header, for the preview which - # is displayed - just add the header, but do NOT use - # Encode::encode("UTF-8",$msg) as it will be done late. - "Content-Type: text/plain; charset=UTF-8\n\n", - $msg, # will be in HTML output, and gets encoded to UTF-8 later on - "\n" + $errorMessage = wrap("", "", $errorMessage); + $msg = wrap("", "", $msg); + + $msg = join( + "", + "To: ", $ur->email_address, "\n", + "From: ", "$self->{from}", "\n", + "Reply-To: ", $self->{replyTo}, "\n", + "Subject: ", $self->{subject}, "\n", + # In a real mails we would UTF-8 encode the message + # and give the Content-Type header, for the preview which + # is displayed - just add the header, but do NOT use + # Encode::encode("UTF-8",$msg) as it will be done late. + "Content-Type: text/plain; charset=UTF-8\n\n", + $msg, # will be in HTML output, and gets encoded to UTF-8 later on + "\n" ); - # The content in message is going to be put in HTML. # It needs to be encoded to avoid problems with things like # . $msg = encode_entities($msg); - $msg = join("",$errorMessage,$preview_header,$msg); + $msg = join("", $errorMessage, $preview_header, $msg); return CGI::div({ class => 'mb-3', dir => 'ltr' }, CGI::pre($msg)) @@ -887,57 +906,65 @@ sub print_form { sub saveProblem { my $self = shift; - my ($body, $probFileName)= @_; - local(*PROBLEM); - open (PROBLEM, ">:encoding(UTF-8)",$probFileName) || - $self->addbadmessage(CGI::p("Could not open $probFileName for writing. - Check that the permissions for this problem are 660 (-rw-rw----)")); + my ($body, $probFileName) = @_; + local (*PROBLEM); + open(PROBLEM, ">:encoding(UTF-8)", $probFileName) + || $self->addbadmessage( + CGI::p( + "Could not open $probFileName for writing. + Check that the permissions for this problem are 660 (-rw-rw----)" + ) + ); print PROBLEM $body if -w $probFileName; close PROBLEM; - chmod 0660, "$probFileName" || - $self->addbadmessage(CGI::p("CAN'T CHANGE PERMISSIONS ON FILE $probFileName")); + chmod 0660, "$probFileName" + || $self->addbadmessage(CGI::p("CAN'T CHANGE PERMISSIONS ON FILE $probFileName")); } sub read_input_file { - my $self = shift; - my $filePath = shift; - my $r = $self->r; + my $self = shift; + my $filePath = shift; + my $r = $self->r; my ($text, @text); my $header = ''; my ($subject, $from, $replyTo); - local(*FILE); + local (*FILE); if (-e "$filePath" and -r "$filePath") { - open FILE, "<:encoding(UTF-8)", $filePath || do { $self->addbadmessage(CGI::p($r->maketext("Can't open [_1]",$filePath))); return}; + open FILE, "<:encoding(UTF-8)", + $filePath || do { $self->addbadmessage(CGI::p($r->maketext("Can't open [_1]", $filePath))); return }; while ($header !~ s/Message:\s*$//m and not eof(FILE)) { $header .= ; } - $text = join( '', ); - $text =~ s/^\s*//; # remove initial white space if any. - $header =~ /^From:\s(.*)$/m; - $from = $1 or $from = $self->{defaultFrom}; + $text = join('', ); + $text =~ s/^\s*//; # remove initial white space if any. + $header =~ /^From:\s(.*)$/m; + $from = $1 or $from = $self->{defaultFrom}; - $header =~ /^Reply-To:\s(.*)$/m; - $replyTo = $1 or $replyTo = $self->{defaultReply}; + $header =~ /^Reply-To:\s(.*)$/m; + $replyTo = $1 or $replyTo = $self->{defaultReply}; - $header =~ /^Subject:\s(.*)$/m; - $subject = $1; + $header =~ /^Subject:\s(.*)$/m; + $subject = $1; } else { - $from = $self->{defaultFrom}; - $replyTo = $self->{defaultReply}; - $text = (-e "$filePath") ? "FIXME file $filePath can't be read" :"FIXME file $filePath doesn't exist"; - $subject = $self->{defaultSubject}; + $from = $self->{defaultFrom}; + $replyTo = $self->{defaultReply}; + $text = (-e "$filePath") ? "FIXME file $filePath can't be read" : "FIXME file $filePath doesn't exist"; + $subject = $self->{defaultSubject}; } return ($from, $replyTo, $subject, \$text); } sub get_message_file_names { - my $self = shift; + my $self = shift; return $self->read_dir($self->{ce}->{courseDirs}->{email}, '\\.msg$'); } -sub get_merge_file_names { - my $self = shift; - return 'None', $self->read_dir($self->{ce}->{courseDirs}->{scoring}, '\\.csv$'); #FIXME ? check that only readable files are listed. + +sub get_merge_file_names { + my $self = shift; + return 'None', + $self->read_dir($self->{ce}->{courseDirs}->{scoring}, '\\.csv$') + ; #FIXME ? check that only readable files are listed. } sub mail_message_to_recipients { @@ -969,16 +996,16 @@ sub mail_message_to_recipients { my $msg = eval { $self->process_message($ur, $rh_merge_data) }; $error_messages .= "There were errors in processing user $recipient, merge file $merge_file. \n$@\n" if $@; - my $email = Email::Stuffer->to($ur->email_address)->from($from)->subject($subject) - ->text_body($msg)->header('X-Remote-Host' => $self->{remote_host}); + my $email = Email::Stuffer->to($ur->email_address)->from($from)->subject($subject)->text_body($msg) + ->header('X-Remote-Host' => $self->{remote_host}); - # $ce->{mail}{set_return_path} is the address used to report returned email if defined and non empty. - # It is an argument used in sendmail() (aka Email::Stuffer::send_or_die). - # For arcane historical reasons sendmail actually sets the field "MAIL FROM" and the smtp server then - # uses that to set "Return-Path". - # references: - # https://stackoverflow.com/questions/1235534/what-is-the-behavior-difference-between-return-path-reply-to-and-from - # https://metacpan.org/pod/Email::Sender::Manual::QuickStart#envelope-information + # $ce->{mail}{set_return_path} is the address used to report returned email if defined and non empty. + # It is an argument used in sendmail() (aka Email::Stuffer::send_or_die). + # For arcane historical reasons sendmail actually sets the field "MAIL FROM" and the smtp server then + # uses that to set "Return-Path". + # references: + # https://stackoverflow.com/questions/1235534/what-is-the-behavior-difference-between-return-path-reply-to-and-from + # https://metacpan.org/pod/Email::Sender::Manual::QuickStart#envelope-information try { $email->send_or_die({ # createEmailSenderTransportSMTP is defined in ContentGenerator @@ -1034,80 +1061,79 @@ sub email_notification { } sub getRecord { - my $self = shift; - my $line = shift; - my $delimiter = shift; - $delimiter = ',' unless defined($delimiter); - - # Takes a delimited line as a parameter and returns an - # array. Note that all white space is removed. If the - # last field is empty, the last element of the returned - # array is also empty (unlike what the perl split command - # would return). E.G. @lineArray=&getRecord(\$delimitedLine). - - my(@lineArray); - $line.="${delimiter}___"; # add final field which must be non-empty - @lineArray = split(/\s*${delimiter}\s*/,$line); # split line into fields - $lineArray[0] =~s/^\s*//; # remove white space from first element - pop @lineArray; # remove the last artificial field - @lineArray; + my $self = shift; + my $line = shift; + my $delimiter = shift; + $delimiter = ',' unless defined($delimiter); + + # Takes a delimited line as a parameter and returns an + # array. Note that all white space is removed. If the + # last field is empty, the last element of the returned + # array is also empty (unlike what the perl split command + # would return). E.G. @lineArray=&getRecord(\$delimitedLine). + + my (@lineArray); + $line .= "${delimiter}___"; # add final field which must be non-empty + @lineArray = split(/\s*${delimiter}\s*/, $line); # split line into fields + $lineArray[0] =~ s/^\s*//; # remove white space from first element + pop @lineArray; # remove the last artificial field + @lineArray; } sub process_message { - my $self = shift; + my $self = shift; my $ur = shift; my $rh_merge_data = shift; my $for_preview = shift; my $r = $self->r; - my $text = defined($self->{r_text}) ? ${ $self->{r_text} }: - 'FIXME no text was produced by initialization!!'; - my $merge_file = ( defined($self->{merge_file}) ) ? $self->{merge_file} : 'None'; + my $text = defined($self->{r_text}) ? ${ $self->{r_text} } : 'FIXME no text was produced by initialization!!'; + my $merge_file = (defined($self->{merge_file})) ? $self->{merge_file} : 'None'; my $status_name = $self->r->ce->status_abbrev_to_name($ur->status); $status_name = $ur->status unless defined $status_name; #user macros that can be used in the email message - my $SID = $ur->student_id; - my $FN = $ur->first_name; - my $LN = $ur->last_name; - my $SECTION = $ur->section; - my $RECITATION = $ur->recitation; - my $STATUS = $status_name; - my $EMAIL = $ur->email_address; - my $LOGIN = $ur->user_id; + my $SID = $ur->student_id; + my $FN = $ur->first_name; + my $LN = $ur->last_name; + my $SECTION = $ur->section; + my $RECITATION = $ur->recitation; + my $STATUS = $status_name; + my $EMAIL = $ur->email_address; + my $LOGIN = $ur->user_id; # get record from merge file # FIXME this is inefficient. The info should be cached - my @COL = defined($rh_merge_data->{$SID}) ? @{$rh_merge_data->{$SID} } : (); + my @COL = defined($rh_merge_data->{$SID}) ? @{ $rh_merge_data->{$SID} } : (); if ($merge_file ne 'None' and not defined($rh_merge_data->{$SID}) and $for_preview) { $self->addbadmessage(CGI::p("No merge data for student id:$SID; name:$FN $LN; login:$LOGIN")); } - unshift(@COL,""); ## this makes COL[1] the first column + unshift(@COL, ""); ## this makes COL[1] the first column my $endCol = @COL; # for safety, only evaluate special variables - my $msg = $text; + my $msg = $text; $msg =~ s/\$SID/$SID/g; - $msg =~ s/\$LN/$LN/g; - $msg =~ s/\$FN/$FN/g; - $msg =~ s/\$STATUS/$STATUS/g; - $msg =~ s/\$SECTION/$SECTION/g; - $msg =~ s/\$RECITATION/$RECITATION/g; - $msg =~ s/\$EMAIL/$EMAIL/g; - $msg =~ s/\$LOGIN/$LOGIN/g; - if (defined($COL[1])) { # prevents extraneous error messages. - $msg =~ s/\$COL\[(\-?\d+)\]/$COL[$1]/g - } - else { # prevents extraneous $COL's in email message - $msg =~ s/\$COL\[(\-?\d+)\]//g + $msg =~ s/\$LN/$LN/g; + $msg =~ s/\$FN/$FN/g; + $msg =~ s/\$STATUS/$STATUS/g; + $msg =~ s/\$SECTION/$SECTION/g; + $msg =~ s/\$RECITATION/$RECITATION/g; + $msg =~ s/\$EMAIL/$EMAIL/g; + $msg =~ s/\$LOGIN/$LOGIN/g; + + if (defined($COL[1])) { # prevents extraneous error messages. + $msg =~ s/\$COL\[(\-?\d+)\]/$COL[$1]/g; + } else { # prevents extraneous $COL's in email message + $msg =~ s/\$COL\[(\-?\d+)\]//g; } - $msg =~ s/\r//g; + $msg =~ s/\r//g; if ($for_preview) { my @preview_COL = @COL; - shift @preview_COL; ## shift back for preview - my $preview_header = CGI::p('',data_format(1..($#COL)),"
      ", data_format2(@preview_COL)). - CGI::h3( $r->maketext("This sample mail would be sent to [_1]", $EMAIL)); + shift @preview_COL; ## shift back for preview + my $preview_header = CGI::p('', data_format(1 .. ($#COL)), "
      ", data_format2(@preview_COL)) + . CGI::h3($r->maketext("This sample mail would be sent to [_1]", $EMAIL)); return $msg, $preview_header; } else { return $msg; diff --git a/lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm b/lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm index 080eab936d..5aa6378874 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm @@ -13,7 +13,6 @@ # Artistic License for more details. ################################################################################ - package WeBWorK::ContentGenerator::Instructor::SetMaker; use base qw(WeBWorK::ContentGenerator::Instructor); @@ -26,7 +25,6 @@ WeBWorK::ContentGenerator::Instructor::SetMaker - Make homework sets. use strict; use warnings; - #use CGI qw(-nosticky); use WeBWorK::CGI; use WeBWorK::Debug; @@ -45,12 +43,12 @@ require WeBWorK::Utils::ListingDB; # we use x to mark strings for maketext use constant INCLUDE_CONTRIB_DEFAULT => 0; -use constant SHOW_HINTS_DEFAULT => 0; -use constant SHOW_SOLUTIONS_DEFAULT => 0; -use constant MAX_SHOW_DEFAULT => 20; -use constant NO_LOCAL_SET_STRING => x('No sets in this course yet'); -use constant MY_PROBLEMS => x('My Problems'); -use constant MAIN_PROBLEMS => x('Unclassified Problems'); +use constant SHOW_HINTS_DEFAULT => 0; +use constant SHOW_SOLUTIONS_DEFAULT => 0; +use constant MAX_SHOW_DEFAULT => 20; +use constant NO_LOCAL_SET_STRING => x('No sets in this course yet'); +use constant MY_PROBLEMS => x('My Problems'); +use constant MAIN_PROBLEMS => x('Unclassified Problems'); use constant LIB2_DATA => { 'dbchapter' => { name => 'library_chapters', all => x('All Chapters') }, @@ -64,22 +62,30 @@ use constant LIB2_DATA => { ## Flags for operations on files -use constant ADDED => 1; -use constant HIDDEN => (1 << 1); +use constant ADDED => 1; +use constant HIDDEN => (1 << 1); use constant SUCCESS => (1 << 2); ## for additional problib buttons -my %problib; ## This is configured in defaults.config +my %problib; ## This is configured in defaults.config my %ignoredir = ( - '.' => 1, '..' => 1, 'CVS' => 1, 'tmpEdit' => 1, - 'headers' => 1, 'macros' => 1, 'email' => 1, 'graphics'=>1, '.svn' => 1, 'achievements' => 1, + '.' => 1, + '..' => 1, + 'CVS' => 1, + 'tmpEdit' => 1, + 'headers' => 1, + 'macros' => 1, + 'email' => 1, + 'graphics' => 1, + '.svn' => 1, + 'achievements' => 1, ); sub prepare_activity_entry { - my $self=shift; - my $r = $self->r; + my $self = shift; + my $r = $self->r; my $user = $self->r->param('user') || 'NO_USER'; - return("In SetMaker as user $user"); + return ("In SetMaker as user $user"); } ## This is for searching the disk for directories containing pg files. @@ -102,7 +108,8 @@ sub prepare_activity_entry { ## pg file. sub get_library_sets { - my $top = shift; my $dir = shift; + my $top = shift; + my $dir = shift; # ignore directories that give us an error my @lis = eval { readDirectory($dir) }; if ($@) { @@ -111,85 +118,96 @@ sub get_library_sets { } return (0) if grep /^=library-ignore$/, @lis; - my @pgfiles = grep { m/\.pg$/ and (not m/(Header|-text)(File)?\.pg$/) and -f "$dir/$_"} @lis; + my @pgfiles = grep { m/\.pg$/ and (not m/(Header|-text)(File)?\.pg$/) and -f "$dir/$_" } @lis; my $pgcount = scalar(@pgfiles); - my $pgname = $dir; $pgname =~ s!.*/!!; $pgname .= '.pg'; + my $pgname = $dir; + $pgname =~ s!.*/!!; + $pgname .= '.pg'; my $combineUp = ($pgcount == 1 && $pgname eq $pgfiles[0] && !(grep /^=library-no-combine$/, @lis)); my @pgdirs; - my @dirs = grep {!$ignoredir{$_} and -d "$dir/$_"} @lis; - if ($top == 1) {@dirs = grep {!$problib{$_}} @dirs} + my @dirs = grep { !$ignoredir{$_} and -d "$dir/$_" } @lis; + if ($top == 1) { + @dirs = grep { !$problib{$_} } @dirs; + } # Never include Library or Contrib at the top level - if ($top == 1) {@dirs = grep {$_ ne 'Library' && $_ ne 'Contrib'} @dirs} + if ($top == 1) { + @dirs = grep { $_ ne 'Library' && $_ ne 'Contrib' } @dirs; + } foreach my $subdir (@dirs) { my @results = get_library_sets(0, "$dir/$subdir"); - $pgcount += shift @results; push(@pgdirs,@results); + $pgcount += shift @results; + push(@pgdirs, @results); } return ($pgcount, @pgdirs) if $top || $combineUp || grep /^=library-combine-up$/, @lis; - return (0,@pgdirs,$dir); + return (0, @pgdirs, $dir); } sub get_library_pgs { - my $top = shift; my $base = shift; my $dir = shift; - my @lis = readDirectory("$base/$dir"); + my $top = shift; + my $base = shift; + my $dir = shift; + my @lis = readDirectory("$base/$dir"); return () if grep /^=library-ignore$/, @lis; return () if !$top && grep /^=library-no-combine$/, @lis; - my @pgs = grep { m/\.pg$/ and (not m/(Header|-text)\.pg$/) and -f "$base/$dir/$_"} @lis; - my $others = scalar(grep { (!m/\.pg$/ || m/(Header|-text)\.pg$/) && - !m/(\.(tmp|bak)|~)$/ && -f "$base/$dir/$_" } @lis); + my @pgs = grep { m/\.pg$/ and (not m/(Header|-text)\.pg$/) and -f "$base/$dir/$_" } @lis; + my $others = + scalar(grep { (!m/\.pg$/ || m/(Header|-text)\.pg$/) && !m/(\.(tmp|bak)|~)$/ && -f "$base/$dir/$_" } @lis); - my @dirs = grep {!$ignoredir{$_} and -d "$base/$dir/$_"} @lis; - if ($top == 1) {@dirs = grep {!$problib{$_}} @dirs} - foreach my $subdir (@dirs) {push(@pgs, get_library_pgs(0,"$base/$dir",$subdir))} + my @dirs = grep { !$ignoredir{$_} and -d "$base/$dir/$_" } @lis; + if ($top == 1) { + @dirs = grep { !$problib{$_} } @dirs; + } + foreach my $subdir (@dirs) { push(@pgs, get_library_pgs(0, "$base/$dir", $subdir)) } return () unless $top || (scalar(@pgs) == 1 && $others) || grep /^=library-combine-up$/, @lis; return (map {"$dir/$_"} @pgs); } sub list_pg_files { - my ($templates,$dir) = @_; - my $top = ($dir eq '.')? 1 : 2; - my @pgs = get_library_pgs($top,$templates,$dir); - return sortByName(undef,@pgs); + my ($templates, $dir) = @_; + my $top = ($dir eq '.') ? 1 : 2; + my @pgs = get_library_pgs($top, $templates, $dir); + return sortByName(undef, @pgs); } ## Try to make reading of set defs more flexible. Additional strategies ## for fixing a path can be added here. sub munge_pg_file_path { - my $self = shift; - my $pg_path = shift; + my $self = shift; + my $pg_path = shift; my $path_to_set_def = shift; - my $end_path = $pg_path; + my $end_path = $pg_path; # if the path is ok, don't fix it - return($pg_path) if(-e $self->r->ce->{courseDirs}{templates}."/$pg_path"); + return ($pg_path) if (-e $self->r->ce->{courseDirs}{templates} . "/$pg_path"); # if we have followed a link into a self contained course to get # to the set.def file, we need to insert the start of the path to # the set.def file $end_path = "$path_to_set_def/$pg_path"; - return($end_path) if(-e $self->r->ce->{courseDirs}{templates}."/$end_path"); + return ($end_path) if (-e $self->r->ce->{courseDirs}{templates} . "/$end_path"); # if we got this far, this path is bad, but we let it produce # an error so the user knows there is a troublesome path in the # set.def file. - return($pg_path); + return ($pg_path); } ## Problems straight from the OPL database come with MO and static ## tag information. This is for other times, like next/prev page. sub getDBextras { - my $r = shift; + my $r = shift; my $sourceFileName = shift; - if($sourceFileName =~ /^Library/) { - return @{WeBWorK::Utils::ListingDB::getDBextras($r, $sourceFileName)}; + if ($sourceFileName =~ /^Library/) { + return @{ WeBWorK::Utils::ListingDB::getDBextras($r, $sourceFileName) }; } - my $filePath = $r->ce->{courseDirs}{templates}."/$sourceFileName"; - my $tag_obj = WeBWorK::Utils::Tags->new($filePath); - my $isMO = $tag_obj->{MO} || 0; + my $filePath = $r->ce->{courseDirs}{templates} . "/$sourceFileName"; + my $tag_obj = WeBWorK::Utils::Tags->new($filePath); + my $isMO = $tag_obj->{MO} || 0; my $isstatic = $tag_obj->{Static} || 0; return ($isMO, $isstatic); @@ -198,81 +216,82 @@ sub getDBextras { ## With MLT, problems come in groups, so we need to find next/prev ## problems. Return index, or -1 if there are no more. sub next_prob_group { - my $ind = shift; + my $ind = shift; my @pgfiles = @_; - my $len = scalar(@pgfiles); - return -1 if($ind >= $len-1); - my $mlt= $pgfiles[$ind]->{morelt} || 0; - return $ind+1 if($mlt == 0); - while($ind<$len and defined($pgfiles[$ind]->{morelt}) and $pgfiles[$ind]->{morelt} == $mlt) { + my $len = scalar(@pgfiles); + return -1 if ($ind >= $len - 1); + my $mlt = $pgfiles[$ind]->{morelt} || 0; + return $ind + 1 if ($mlt == 0); + while ($ind < $len and defined($pgfiles[$ind]->{morelt}) and $pgfiles[$ind]->{morelt} == $mlt) { $ind++; } - return -1 if($ind==$len); + return -1 if ($ind == $len); return $ind; } sub prev_prob_group { - my $ind = shift; + my $ind = shift; my @pgfiles = @_; - return -1 if $ind==0; + return -1 if $ind == 0; $ind--; my $mlt = $pgfiles[$ind]->{morelt}; - return $ind if $mlt==0; + return $ind if $mlt == 0; # We have to search to the beginning of this group - while($ind>=0 and $mlt == $pgfiles[$ind]->{morelt}) { + while ($ind >= 0 and $mlt == $pgfiles[$ind]->{morelt}) { $ind--; } - return($ind+1); + return ($ind + 1); } sub end_prob_group { - my $ind = shift; + my $ind = shift; my @pgfiles = @_; - my $next = next_prob_group($ind, @pgfiles); - return( ($next==-1) ? $#pgfiles : $next-1); + my $next = next_prob_group($ind, @pgfiles); + return (($next == -1) ? $#pgfiles : $next - 1); } ## Read a set definition file. This could be abstracted since it happens ## elsewhere. Here we don't have to process so much of the file. sub read_set_def { - my $self = shift; - my $r = $self->r; + my $self = shift; + my $r = $self->r; my $filePathOrig = shift; - my $filePath = $r->ce->{courseDirs}{templates}."/$filePathOrig"; + my $filePath = $r->ce->{courseDirs}{templates} . "/$filePathOrig"; $filePathOrig =~ s/set.*\.def$//; $filePathOrig =~ s|/$||; $filePathOrig = "." if ($filePathOrig !~ /\S/); my @pg_files = (); my ($line, $got_to_pgs, $name, @rest) = ("", 0, ""); - if ( open (SETFILENAME, "$filePath") ) { - while($line = ) { - chomp($line); - $line =~ s|(#.*)||; # don't read past comments - if($got_to_pgs == 1) { - unless ($line =~ /\S/) {next;} # skip blank lines - ($name,@rest) = split (/\s*,\s*/,$line); - $name =~ s/\s*//g; - push @pg_files, $name; - } elsif ($got_to_pgs == 2) { - # skip lines which dont identify source files - unless ($line =~ /source_file\s*=\s*(\S+)/) { - next; - } - # otherwise we got the name from the regexp - push @pg_files, $1; - } else { - $got_to_pgs = 1 if ($line =~ /problemList\s*=/); - $got_to_pgs = 2 if ($line =~ /problemListV2/); + + if (open(SETFILENAME, "$filePath")) { + while ($line = ) { + chomp($line); + $line =~ s|(#.*)||; # don't read past comments + if ($got_to_pgs == 1) { + unless ($line =~ /\S/) { next; } # skip blank lines + ($name, @rest) = split(/\s*,\s*/, $line); + $name =~ s/\s*//g; + push @pg_files, $name; + } elsif ($got_to_pgs == 2) { + # skip lines which dont identify source files + unless ($line =~ /source_file\s*=\s*(\S+)/) { + next; + } + # otherwise we got the name from the regexp + push @pg_files, $1; + } else { + $got_to_pgs = 1 if ($line =~ /problemList\s*=/); + $got_to_pgs = 2 if ($line =~ /problemListV2/); + } } - } } else { - $self->addbadmessage($r->maketext("Cannot open [_1]",$filePath)); + $self->addbadmessage($r->maketext("Cannot open [_1]", $filePath)); } # This is where we would potentially munge the pg file paths # One possibility @pg_files = map { $self->munge_pg_file_path($_, $filePathOrig) } @pg_files; - return(@pg_files); + return (@pg_files); } ## go through past page getting a list of identifiers for the problems @@ -280,63 +299,66 @@ sub read_set_def { ## be hidden sub get_past_problem_files { - my $r = shift; - my @found=(); - my $count =1; + my $r = shift; + my @found = (); + my $count = 1; while (defined($r->param("filetrial$count"))) { my $val = 0; - $val |= ADDED if($r->param("trial$count")); - $val |= HIDDEN if($r->param("hideme$count")); - push @found, [$r->param("filetrial$count"), $val]; + $val |= ADDED if ($r->param("trial$count")); + $val |= HIDDEN if ($r->param("hideme$count")); + push @found, [ $r->param("filetrial$count"), $val ]; $count++; } - return(\@found); + return (\@found); } #### For adding new problems sub add_selected { - my $self = shift; - my $db = shift; - my $setName = shift; - my @past_problems = @{$self->{past_problems}}; - my @selected = @past_problems; + my $self = shift; + my $db = shift; + my $setName = shift; + my @past_problems = @{ $self->{past_problems} }; + my @selected = @past_problems; my (@path, $file, $selected, $freeProblemID); - my $addedcount=0; + my $addedcount = 0; for $selected (@selected) { - if($selected->[1] & ADDED) { + if ($selected->[1] & ADDED) { $file = $selected->[0]; - my $problemRecord = $self->addProblemToSet(setName => $setName, - sourceFile => $file); + my $problemRecord = $self->addProblemToSet( + setName => $setName, + sourceFile => $file + ); $freeProblemID++; $self->assignProblemToAllSetUsers($problemRecord); $selected->[1] |= SUCCESS; $addedcount++; } } - return($addedcount); + return ($addedcount); } - ############# List of sets of problems in templates directory sub get_problem_directories { - my $r = shift; - my $ce = $r->ce; - my $lib = shift; + my $r = shift; + my $ce = $r->ce; + my $lib = shift; my $source = $ce->{courseDirs}{templates}; - my $main = $r->maketext(MY_PROBLEMS); my $isTop = 1; - if ($lib) {$source .= "/$lib"; $main = $r->maketext(MAIN_PROBLEMS); $isTop = 2} + my $main = $r->maketext(MY_PROBLEMS); + my $isTop = 1; + if ($lib) { $source .= "/$lib"; $main = $r->maketext(MAIN_PROBLEMS); $isTop = 2 } my @all_problem_directories = get_library_sets($isTop, $source); - my $includetop = shift @all_problem_directories; + my $includetop = shift @all_problem_directories; my $j; - for ($j=0; $j{courseDirs}->{templates}/?||; } @all_problem_directories = sortByName(undef, @all_problem_directories); - unshift @all_problem_directories, $main if($includetop); + unshift @all_problem_directories, $main if ($includetop); return (\@all_problem_directories); } @@ -344,8 +366,8 @@ sub get_problem_directories { sub view_problems_line { my $internal_name = shift; my $label = shift; - my $r = shift; # so we can get parameter values - my $contrib_exist = (-r $r->ce->{courseDirs}{templates}.'/Contrib') ? 1 : 0; + my $r = shift; # so we can get parameter values + my $contrib_exist = (-r $r->ce->{courseDirs}{templates} . '/Contrib') ? 1 : 0; my $result = CGI::start_div({ class => 'd-flex flex-wrap justify-content-center' }); @@ -377,7 +399,9 @@ sub view_problems_line { # Now we give a choice of the number of problems to show. $result .= CGI::div( { class => 'd-inline-block ms-2 mb-2' }, - CGI::label({ for => 'max_shown', class => 'col-form-label col-form-label-sm' }, $r->maketext('Max. Shown:')), + CGI::label( + { for => 'max_shown', class => 'col-form-label col-form-label-sm' }, $r->maketext('Max. Shown:') + ), CGI::popup_menu({ name => 'max_shown', id => 'max_shown', @@ -387,27 +411,31 @@ sub view_problems_line { }) ); - my $maybe_OPL_box = $contrib_exist ? CGI::div( - { class => 'form-check form-check-inline ms-2' }, - CGI::checkbox({ - name => 'includeOPL', - checked => $r->param('includeOPL') // 1, - label => $r->maketext('Include OPL'), - class => 'form-check-input me-1', - labelattributes => { class => 'form-check-label col-form-label-sm' } - }) - ) : (); - - my $maybe_contrib_box = $contrib_exist ? CGI::div( - { class => 'form-check form-check-inline ms-2' }, - CGI::checkbox({ - name => 'includeContrib', - checked => $r->param('includeContrib') // INCLUDE_CONTRIB_DEFAULT, - label => $r->maketext('Include Contrib'), - class => 'form-check-input me-1', - labelattributes => { class => 'form-check-label col-form-label-sm' } - }) - ) : (); + my $maybe_OPL_box = $contrib_exist + ? CGI::div( + { class => 'form-check form-check-inline ms-2' }, + CGI::checkbox({ + name => 'includeOPL', + checked => $r->param('includeOPL') // 1, + label => $r->maketext('Include OPL'), + class => 'form-check-input me-1', + labelattributes => { class => 'form-check-label col-form-label-sm' } + }) + ) + : (); + + my $maybe_contrib_box = $contrib_exist + ? CGI::div( + { class => 'form-check form-check-inline ms-2' }, + CGI::checkbox({ + name => 'includeContrib', + checked => $r->param('includeContrib') // INCLUDE_CONTRIB_DEFAULT, + label => $r->maketext('Include Contrib'), + class => 'form-check-input me-1', + labelattributes => { class => 'form-check-label col-form-label-sm' } + }) + ) + : (); # Option of whether to show hints and solutions $result .= CGI::div( @@ -434,7 +462,7 @@ sub view_problems_line { labelattributes => { class => 'form-check-label col-form-label-sm' } }) ), - CGI::hidden({name => 'includeOPL', default => $contrib_exist ? 0 : 1}) + CGI::hidden({ name => 'includeOPL', default => $contrib_exist ? 0 : 1 }) ); $result .= CGI::end_div(); @@ -491,10 +519,10 @@ sub browse_local_panel { # Version 2 is local homework sets sub browse_mysets_panel { - my $self = shift; - my $r = $self->r; - my $library_selected = shift // ''; - my $list_of_local_sets = shift; + my $self = shift; + my $r = $self->r; + my $library_selected = shift // ''; + my $list_of_local_sets = shift; my $labels_for_local_sets = { map { $_ => format_set_name_display($_) } @$list_of_local_sets }; if (@$list_of_local_sets == 0) { @@ -537,10 +565,8 @@ sub browse_library_panel { my $libraryRoot = $r->{ce}{problemLibrary}{root}; unless ($libraryRoot) { - print CGI::div( - { class => 'alert alert-danger p-1 mb-2', align => "center" }, - "The problem library has not been installed." - ); + print CGI::div({ class => 'alert alert-danger p-1 mb-2', align => "center" }, + "The problem library has not been installed."); return; } # Test if the Library directory link exists. If not, try to make it @@ -965,7 +991,7 @@ sub browse_setdef_panel { my $ce = $r->ce; my $library_selected = shift // ''; - my @list_of_set_defs = $self->getDefList; + my @list_of_set_defs = $self->getDefList; my $labels_for_set_defs = { map { $_ => $_ } @list_of_set_defs }; if (scalar(@list_of_set_defs) == 0) { @@ -994,7 +1020,7 @@ sub browse_setdef_panel { values => \@list_of_set_defs, labels => $labels_for_set_defs, default => $library_selected, - class => 'form-select form-select-sm d-inline w-auto' + class => 'form-select form-select-sm d-inline w-auto' }) ), view_problems_line('view_setdef_set', $r->maketext('View Problems'), $self->r) @@ -1003,15 +1029,15 @@ sub browse_setdef_panel { sub make_top_row { my $self = shift; - my $r = $self->r; - my $ce = $r->ce; + my $r = $self->r; + my $ce = $r->ce; my %data = @_; - my $list_of_local_sets = $data{all_db_sets}; + my $list_of_local_sets = $data{all_db_sets}; my $labels_for_local_sets = { map { $_ => format_set_name_display($_) } @$list_of_local_sets }; - my $browse_which = $data{browse_which}; - my $library_selected = $self->{current_library_set}; - my $set_selected = $r->param('local_sets') // ''; + my $browse_which = $data{browse_which}; + my $library_selected = $self->{current_library_set}; + my $set_selected = $r->param('local_sets') // ''; my (@dis1, @dis2, @dis3, @dis4) = (); @dis1 = (disabled => undef) if ($browse_which eq 'browse_npl_library'); @dis2 = (disabled => undef) if ($browse_which eq 'browse_local'); @@ -1040,18 +1066,18 @@ sub make_top_row { $r->maketext('Add problems to') . ' ' . CGI::b($r->maketext('Target Set:')) ), CGI::popup_menu({ - name => 'local_sets', - id => 'local_sets', - values => $list_of_local_sets, - labels => $labels_for_local_sets, - default => $set_selected, - override => 1, - class => 'form-select form-select-sm d-inline w-auto mx-2', - dir => 'ltr', + name => 'local_sets', + id => 'local_sets', + values => $list_of_local_sets, + labels => $labels_for_local_sets, + default => $set_selected, + override => 1, + class => 'form-select form-select-sm d-inline w-auto mx-2', + dir => 'ltr', data_no_set_selected => $r->maketext('No Target Set Selected'), data_pick_target_set => $r->maketext('Pick a target set above to add this problem to.'), - data_problems_added => $r->maketext('Problems Added'), - data_added_to_single => $r->maketext('Added one problem to set [_1].', '{set}'), + data_problems_added => $r->maketext('Problems Added'), + data_added_to_single => $r->maketext('Added one problem to set [_1].', '{set}'), data_added_to_plural => $r->maketext('Added [_1] problems to set [_2].', '{number}', '{set}'), }) ), @@ -1152,22 +1178,22 @@ sub make_top_row { $self->browse_library_panel(); } elsif ($browse_which eq 'browse_setdefs') { $self->browse_setdef_panel($library_selected); - } else { ## handle other problem libraries - $self->browse_local_panel($library_selected,$browse_which); + } else { ## handle other problem libraries + $self->browse_local_panel($library_selected, $browse_which); } print CGI::hr({ class => 'mt-0 mb-2' }); - # For next/previous buttons + # For next/previous buttons my ($next_button, $prev_button) = ("", ""); my $first_shown = $self->{first_shown}; - my $last_shown = $self->{last_shown}; + my $last_shown = $self->{last_shown}; my $first_index = $self->{first_index}; - my $last_index = $self->{last_index}; - my @pg_files = @{$self->{pg_files}}; + my $last_index = $self->{last_index}; + my @pg_files = @{ $self->{pg_files} }; if ($first_index > 0) { $prev_button = CGI::submit({ - name => "prev_page", + name => "prev_page", style => $these_widths, value => $r->maketext("Previous page"), class => 'btn btn-secondary btn-sm mx-1 mb-2' @@ -1176,8 +1202,8 @@ sub make_top_row { # This will have to be trickier with MLT if ((1 + $last_index) < scalar(@pg_files)) { $next_button = CGI::submit({ - name => "next_page", - style => $these_widths, + name => "next_page", + style => $these_widths, value => $r->maketext("Next page"), class => 'btn btn-secondary btn-sm mx-1 mb-2' }); @@ -1229,7 +1255,7 @@ sub make_data_row { my $isGatewaySet = defined $setRecord && $setRecord->assignment_type =~ /gateway/; my $problem_seed = $self->{'problem_seed'} || 1234; - my $edit_link = CGI::a( + my $edit_link = CGI::a( { href => $self->systemLink( $urlpath->newFromModule( @@ -1363,7 +1389,7 @@ sub make_data_row { src => $r->ce->{webworkURLs}{htdocs} . '/images/pi.svg', alt => $r->maketext('Uses Math Objects') }) - ) + ) : '' ); @@ -1427,11 +1453,14 @@ sub make_data_row { . 'represent a difficult problem. The Status is often fairly high since ' . 'many students will work on a problem until they get it correct or nearly so.' )) - . CGI::p({ class => 'mb-0' }, $r->maketext( - 'Reviewing a problem and looking at both the average Attempts and ' - . 'average Status should give instructors valuable information about ' - . 'the difficulty of the problem.' - )), + . CGI::p( + { class => 'mb-0' }, + $r->maketext( + 'Reviewing a problem and looking at both the average Attempts and ' + . 'average Status should give instructors valuable information about ' + . 'the difficulty of the problem.' + ) + ), data_bs_toggle => 'popover', data_bs_placement => 'top', data_bs_html => 'true', @@ -1463,10 +1492,13 @@ sub make_data_row { . 'represents a problem which has been assigned to many students and is ' . 'both popular with instructors and likely bug free.' )) - . CGI::p({ class => 'mb-0' }, $r->maketext( - 'Local data is generated when your systems admin runs the script ' - . 'update-OPL-statistics.' - )), + . CGI::p( + { class => 'mb-0' }, + $r->maketext( + 'Local data is generated when your systems admin runs the script ' + . 'update-OPL-statistics.' + ) + ), data_bs_toggle => 'popover', data_bs_placement => 'top', data_bs_trigger => 'hover focus', @@ -1509,11 +1541,14 @@ sub make_data_row { . 'represent a difficult problem. The Status is often fairly high since ' . 'many students will work on a problem until they get it correct or nearly so.' )) - . CGI::p({ class => 'mb-0' }, $r->maketext( - 'Reviewing a problem and looking at both the average Attempts and ' - . 'average Status should give instructors valuable information about ' - . 'the difficulty of the problem.' - )), + . CGI::p( + { class => 'mb-0' }, + $r->maketext( + 'Reviewing a problem and looking at both the average Attempts and ' + . 'average Status should give instructors valuable information about ' + . 'the difficulty of the problem.' + ) + ), data_bs_toggle => 'popover', data_bs_placement => 'top', data_bs_html => 'true', @@ -1553,8 +1588,7 @@ sub make_data_row { data_bs_placement => 'top' }), ), - CGI::div({ class => 'd-flex flex-wrap align-items-center mb-1 gap-2' }, - $problem_stats), + CGI::div({ class => 'd-flex flex-wrap align-items-center mb-1 gap-2' }, $problem_stats), CGI::div( { class => 'lb-problem-icons mb-1 d-flex align-items-center' }, $mlt, $MOtag, $rerand, @@ -1589,7 +1623,9 @@ sub make_data_row { CGI::hidden({ name => "filetrial$cnt", default => $sourceFileName, override => 1 }), $tagwidget, CGI::div( - CGI::div({ class => 'psr_render_area', id => "psr_render_area_$cnt", data_pg_file => $pg_file }, ''), + CGI::div( + { class => 'psr_render_area', id => "psr_render_area_$cnt", data_pg_file => $pg_file }, '' + ), '' ) ) @@ -1598,32 +1634,30 @@ sub make_data_row { } sub clear_default { - my $r = shift; - my $param = shift; - my $default = shift; + my $r = shift; + my $param = shift; + my $default = shift; my $newvalue = $r->param($param) || ''; - $newvalue = '' if($newvalue eq $default); + $newvalue = '' if ($newvalue eq $default); $r->param($param, $newvalue); } ### Mainly deal with more like this sub process_search { - my $r = shift; + my $r = shift; my @dbsearch = @_; # Build a hash of MLT entries keyed by morelt_id my %mlt = (); my $mltind; - for my $indx (0..$#dbsearch) { + for my $indx (0 .. $#dbsearch) { $dbsearch[$indx]->{filepath} = - $dbsearch[$indx]->{libraryroot} . "/" . - $dbsearch[$indx]->{path} . "/" . - $dbsearch[$indx]->{filename}; + $dbsearch[$indx]->{libraryroot} . "/" . $dbsearch[$indx]->{path} . "/" . $dbsearch[$indx]->{filename}; # For debugging $dbsearch[$indx]->{oindex} = $indx; - if($mltind = $dbsearch[$indx]->{morelt}) { - if(defined($mlt{$mltind})) { - push @{$mlt{$mltind}}, $indx; + if ($mltind = $dbsearch[$indx]->{morelt}) { + if (defined($mlt{$mltind})) { + push @{ $mlt{$mltind} }, $indx; } else { $mlt{$mltind} = [$indx]; } @@ -1634,26 +1668,26 @@ sub process_search { # Find MLT leaders, mark entries for no show, # set up children array for leaders for my $mltid (keys %mlt) { - my @idlist = @{$mlt{$mltid}}; - if(scalar(@idlist)>1) { + my @idlist = @{ $mlt{$mltid} }; + if (scalar(@idlist) > 1) { my $leader = WeBWorK::Utils::ListingDB::getMLTleader($r, $mltid) || 0; - my $hold = undef; + my $hold = undef; for my $subindx (@idlist) { - if($dbsearch[$subindx]->{pgid} == $leader) { - $dbsearch[$subindx]->{children}=[]; + if ($dbsearch[$subindx]->{pgid} == $leader) { + $dbsearch[$subindx]->{children} = []; $hold = $subindx; } else { - $dbsearch[$subindx]->{noshow}=1; + $dbsearch[$subindx]->{noshow} = 1; } } - do { # we did not find the leader - $hold = $idlist[0]; - $dbsearch[$hold]->{noshow} = undef; - $dbsearch[$hold]->{children}=[]; - } unless($hold); - $mlt{$mltid} = $dbsearch[$hold]; # store ref to leader - } else { # only one, no more - $dbsearch[$idlist[0]]->{morelt} = 0; + do { # we did not find the leader + $hold = $idlist[0]; + $dbsearch[$hold]->{noshow} = undef; + $dbsearch[$hold]->{children} = []; + } unless ($hold); + $mlt{$mltid} = $dbsearch[$hold]; # store ref to leader + } else { # only one, no more + $dbsearch[ $idlist[0] ]->{morelt} = 0; delete $mlt{$mltid}; } } @@ -1661,15 +1695,15 @@ sub process_search { # Put children in leader and delete them, record index of leaders $mltind = 0; while ($mltind < scalar(@dbsearch)) { - if($dbsearch[$mltind]->{noshow}) { + if ($dbsearch[$mltind]->{noshow}) { # move the entry to the leader my $mltval = $dbsearch[$mltind]->{morelt}; - push @{$mlt{$mltval}->{children}}, $dbsearch[$mltind]; + push @{ $mlt{$mltval}->{children} }, $dbsearch[$mltind]; splice @dbsearch, $mltind, 1; } else { - if($dbsearch[$mltind]->{morelt}) { # a leader + if ($dbsearch[$mltind]->{morelt}) { # a leader for my $mltid (keys %mlt) { - if($mltid == $dbsearch[$mltind]->{morelt}) { + if ($mltid == $dbsearch[$mltind]->{morelt}) { $mlt{$mltid}->{index} = $mltind; last; } @@ -1680,10 +1714,10 @@ sub process_search { } # Last pass, reinsert children into dbsearch my @leaders = keys(%mlt); - @leaders = reverse sort {$mlt{$a}->{index} <=> $mlt{$b}->{index}} @leaders; + @leaders = reverse sort { $mlt{$a}->{index} <=> $mlt{$b}->{index} } @leaders; for my $i (@leaders) { my $base = $mlt{$i}->{index}; - splice @dbsearch, $base+1, 0, @{$mlt{$i}->{children}}; + splice @dbsearch, $base + 1, 0, @{ $mlt{$i}->{children} }; } return @dbsearch; @@ -1693,43 +1727,47 @@ sub pre_header_initialize { my ($self) = @_; my $r = $self->r; ## For all cases, lets set some things - $self->{error}=0; - my $ce = $r->ce; - my $db = $r->db; + $self->{error} = 0; + my $ce = $r->ce; + my $db = $r->db; my $maxShown = $r->param('max_shown') || MAX_SHOW_DEFAULT; - $maxShown = 10000000 if($maxShown eq 'All'); # let's hope there aren't more + $maxShown = 10000000 if ($maxShown eq 'All'); # let's hope there aren't more my $library_basic = $r->param('library_is_basic') || 1; $self->{problem_seed} = $r->param('problem_seed') || 1234; ## Fix some parameters for my $key (keys(%{ LIB2_DATA() })) { - clear_default($r, LIB2_DATA->{$key}->{name}, LIB2_DATA->{$key}->{all} ); + clear_default($r, LIB2_DATA->{$key}->{name}, LIB2_DATA->{$key}->{all}); } ## Grab library sets to display from parameters list. We will ## modify this as we go through the if/else tree - $self->{current_library_set} = $r->param('library_sets'); + $self->{current_library_set} = $r->param('library_sets'); ## These directories will have individual buttons - %problib = %{$ce->{courseFiles}{problibs}} if $ce->{courseFiles}{problibs}; + %problib = %{ $ce->{courseFiles}{problibs} } if $ce->{courseFiles}{problibs}; my $userName = $r->param('user'); - my $user = $db->getUser($userName); # checked + my $user = $db->getUser($userName); # checked die "record for user $userName (real user) does not exist." unless defined $user; my $authz = $r->authz; unless ($authz->hasPermissions($userName, "modify_problem_sets")) { - return(""); # Error message already produced in the body + return (""); # Error message already produced in the body } ## Now one action we have to deal with here if ($r->param('edit_local')) { - my $urlpath = $r->urlpath; - my $db = $r->db; + my $urlpath = $r->urlpath; + my $db = $r->db; my $checkset = $db->getGlobalSet($r->param('local_sets')); if (not defined($checkset)) { $self->{error} = 1; $self->addbadmessage($r->maketext('You need to select a "Target Set" before you can edit it.')); } else { - my $page = $urlpath->newFromModule('WeBWorK::ContentGenerator::Instructor::ProblemSetDetail', $r, setID=>$r->param('local_sets'), courseID=>$urlpath->arg("courseID")); + my $page = $urlpath->newFromModule( + 'WeBWorK::ContentGenerator::Instructor::ProblemSetDetail', $r, + setID => $r->param('local_sets'), + courseID => $urlpath->arg("courseID") + ); my $url = $self->systemLink($page); $self->reply_with_redirect($url); } @@ -1742,39 +1780,39 @@ sub pre_header_initialize { $self->{past_problems} = get_past_problem_files($r); # if we don't end up reusing problems, this will be wiped out # if we do redisplay the same problems, we must adjust this accordingly - my $none_shown = scalar(@{$self->{past_problems}})==0; - my @pg_files=(); + my $none_shown = scalar(@{ $self->{past_problems} }) == 0; + my @pg_files = (); my $use_previous_problems = 1; - my $first_shown = $r->param('first_shown') || 0; - my $last_shown = $r->param('last_shown'); + my $first_shown = $r->param('first_shown') || 0; + my $last_shown = $r->param('last_shown'); if (not defined($last_shown)) { $last_shown = -1; } my $first_index = $r->param('first_index') || 0; - my $last_index = $r->param('last_index'); + my $last_index = $r->param('last_index'); if (not defined($last_index)) { $last_index = -1; } - my $total_probs = $r->param('total_probs') || 0; - my @all_past_list = (); # these are include requested, but not shown - my ($j, $count, $omlt, $nmlt, $hold) = (0,0,-1,0,0); + my $total_probs = $r->param('total_probs') || 0; + my @all_past_list = (); # these are include requested, but not shown + my ($j, $count, $omlt, $nmlt, $hold) = (0, 0, -1, 0, 0); while (defined($r->param("all_past_list$j"))) { $nmlt = $r->param("all_past_mlt$j") || 0; - push @all_past_list, {'filepath' => $r->param("all_past_list$j"), 'morelt' => $nmlt}; - if($nmlt != $omlt or $nmlt == 0) { - $count++ if($j>0); - if($j>$hold+1) { - $all_past_list[$hold]->{children} = [2..($j-$hold)]; + push @all_past_list, { 'filepath' => $r->param("all_past_list$j"), 'morelt' => $nmlt }; + if ($nmlt != $omlt or $nmlt == 0) { + $count++ if ($j > 0); + if ($j > $hold + 1) { + $all_past_list[$hold]->{children} = [ 2 .. ($j - $hold) ]; } $omlt = $nmlt; $hold = $j; - } else { # equal and nonzero, so a child + } else { # equal and nonzero, so a child $all_past_list[$j]->{noshow} = 1; } $j++; } - if($nmlt && $j-$hold>1) { $all_past_list[$hold]->{children} = [ 2..($j-$hold)]; } - $count++ if($j>0); + if ($nmlt && $j - $hold > 1) { $all_past_list[$hold]->{children} = [ 2 .. ($j - $hold) ]; } + $count++ if ($j > 0); ############# Default of which problem selector to display @@ -1790,42 +1828,48 @@ sub pre_header_initialize { } ########### Start the logic through if elsif elsif ... - debug("browse_lib", $r->param("$browse_lib")); - debug("browse_npl_library", $r->param("browse_npl_library")); - debug("browse_mysets", $r->param("browse_mysets")); - debug("browse_setdefs", $r->param("browse_setdefs")); + debug("browse_lib", $r->param("$browse_lib")); + debug("browse_npl_library", $r->param("browse_npl_library")); + debug("browse_mysets", $r->param("browse_mysets")); + debug("browse_setdefs", $r->param("browse_setdefs")); ##### Asked to browse certain problems if ($browse_lib ne '') { - $browse_which = $browse_lib; + $browse_which = $browse_lib; $self->{current_library_set} = ""; - $use_previous_problems = 0; @pg_files = (); ## clear old problems + $use_previous_problems = 0; + @pg_files = (); ## clear old problems } elsif ($r->param('browse_npl_library')) { - $browse_which = 'browse_npl_library'; + $browse_which = 'browse_npl_library'; $self->{current_library_set} = ""; - $use_previous_problems = 0; @pg_files = (); ## clear old problems + $use_previous_problems = 0; + @pg_files = (); ## clear old problems } elsif ($r->param('browse_local')) { - $browse_which = 'browse_local'; - $use_previous_problems = 0; @pg_files = (); ## clear old problems + $browse_which = 'browse_local'; + $use_previous_problems = 0; + @pg_files = (); ## clear old problems } elsif ($r->param('browse_mysets')) { - $browse_which = 'browse_mysets'; - $use_previous_problems = 0; @pg_files = (); ## clear old problems + $browse_which = 'browse_mysets'; + $use_previous_problems = 0; + @pg_files = (); ## clear old problems } elsif ($r->param('browse_setdefs')) { - $browse_which = 'browse_setdefs'; + $browse_which = 'browse_setdefs'; $self->{current_library_set} = ""; - $use_previous_problems = 0; @pg_files = (); ## clear old problems + $use_previous_problems = 0; + @pg_files = (); ## clear old problems ##### Change the seed value } elsif ($r->param('rerandomize')) { - $self->{problem_seed}= 1+$self->{problem_seed}; + $self->{problem_seed} = 1 + $self->{problem_seed}; #$r->param('problem_seed', $problem_seed); - $self->addbadmessage($r->maketext('Changing the problem seed for display, but there are no problems showing.')) if $none_shown; + $self->addbadmessage($r->maketext('Changing the problem seed for display, but there are no problems showing.')) + if $none_shown; ##### Clear the display } elsif ($r->param('cleardisplay')) { - @pg_files = (); - $use_previous_problems=0; + @pg_files = (); + $use_previous_problems = 0; $self->addbadmessage($r->maketext('The display was already cleared.')) if $none_shown; ##### View problems selected from the local list @@ -1861,11 +1905,11 @@ sub pre_header_initialize { } elsif ($r->param('lib_view')) { - @pg_files=(); + @pg_files = (); # TODO: deprecate OPLv1 -- replace getSectionListings with getDBListings($r,0) my @dbsearch = WeBWorK::Utils::ListingDB::getSectionListings($r); - @pg_files = process_search($r, @dbsearch); - $use_previous_problems=0; + @pg_files = process_search($r, @dbsearch); + $use_previous_problems = 0; ##### View a set from a set*.def @@ -1883,10 +1927,9 @@ sub pre_header_initialize { ##### Edit the current local homework set - } elsif ($r->param('edit_local')) { ## Jump to set edit page - - ; # already handled + } elsif ($r->param('edit_local')) { ## Jump to set edit page + ; # already handled ##### Make a new local homework set @@ -1901,13 +1944,16 @@ sub pre_header_initialize { # If we want to munge the input set name, do it here. my $newSetName = format_set_name_internal($r->param('new_set_name')); debug("local_sets was ", $r->param('local_sets')); - $r->param('local_sets',$newSetName); ## use of two parameter param + $r->param('local_sets', $newSetName); ## use of two parameter param debug("new value of local_sets is ", $r->param('local_sets')); - if (! $newSetName) { - $self->addbadmessage($r->maketext("You did not specify a new set name.")); + if (!$newSetName) { + $self->addbadmessage($r->maketext("You did not specify a new set name.")); } elsif (defined $db->getGlobalSet($newSetName)) { - $self->addbadmessage($r->maketext("The set name '[_1]' is already in use. Pick a different name if you would like to start a new set.",$newSetName)); - } else { # Do it! + $self->addbadmessage($r->maketext( + "The set name '[_1]' is already in use. Pick a different name if you would like to start a new set.", + $newSetName + )); + } else { # Do it! my $newSetRecord = $db->newGlobalSet(); $newSetRecord->set_id($newSetName); $newSetRecord->set_header("defaultHeader"); @@ -1915,33 +1961,33 @@ sub pre_header_initialize { # It's convenient to set the due date two weeks from now so that it is # not accidentally available to students. - my $dueDate = time+2*60*60*24*7; + my $dueDate = time + 2 * 60 * 60 * 24 * 7; my $display_tz = $ce->{siteDefaults}{timezone}; - my $fDueDate = $self->formatDateTime($dueDate, $display_tz, "%m/%d/%Y at %I:%M%P"); - my $dueTime = $ce->{pg}{timeAssignDue}; + my $fDueDate = $self->formatDateTime($dueDate, $display_tz, "%m/%d/%Y at %I:%M%P"); + my $dueTime = $ce->{pg}{timeAssignDue}; # We replace the due time by the one from the config variable # and try to bring it back to unix time if possible $fDueDate =~ s/\d\d:\d\d(am|pm|AM|PM)/$dueTime/; $dueDate = $self->parseDateTime($fDueDate, $display_tz); - $newSetRecord->open_date($dueDate - 60*$ce->{pg}{assignOpenPriorToDue}); + $newSetRecord->open_date($dueDate - 60 * $ce->{pg}{assignOpenPriorToDue}); $newSetRecord->due_date($dueDate); - $newSetRecord->answer_date($dueDate + 60*$ce->{pg}{answersOpenAfterDueDate}); + $newSetRecord->answer_date($dueDate + 60 * $ce->{pg}{answersOpenAfterDueDate}); $newSetRecord->visible(1); $newSetRecord->enable_reduced_scoring(0); $newSetRecord->assignment_type('default'); - eval {$db->addGlobalSet($newSetRecord)}; + eval { $db->addGlobalSet($newSetRecord) }; if ($@) { $self->addbadmessage("Problem creating set $newSetName
      $@"); } else { $self->addgoodmessage($r->maketext("Set [_1] has been created.", $newSetName)); my $selfassign = $r->param('selfassign') || ""; - $selfassign = "" if($selfassign =~ /false/i); # deal with javascript false - if($selfassign) { + $selfassign = "" if ($selfassign =~ /false/i); # deal with javascript false + if ($selfassign) { $self->assignSetToUser($userName, $newSetRecord); - $self->addgoodmessage($r->maketext("Set [_1] was assigned to [_2]", $newSetName,$userName)); + $self->addgoodmessage($r->maketext("Set [_1] was assigned to [_2]", $newSetName, $userName)); } } } @@ -1949,112 +1995,110 @@ sub pre_header_initialize { } elsif ($r->param('next_page')) { # Can set first/last problem, but not index yet - $first_index = $last_index+1; + $first_index = $last_index + 1; my $oli = 0; my $cnt = 0; - while(($oli = next_prob_group($last_index, @all_past_list)) != -1 and $cnt<$maxShown) { + while (($oli = next_prob_group($last_index, @all_past_list)) != -1 and $cnt < $maxShown) { $cnt++; $last_index = $oli; } $last_index = end_prob_group($last_index, @all_past_list); } elsif ($r->param('prev_page')) { # Can set first/last index, but not problem yet - $last_index = $first_index-1; + $last_index = $first_index - 1; my $oli = 0; my $cnt = 0; - while(($oli = prev_prob_group($first_index, @all_past_list)) != -1 and $cnt<$maxShown) { + while (($oli = prev_prob_group($first_index, @all_past_list)) != -1 and $cnt < $maxShown) { $cnt++; $first_index = $oli; } - $first_index = 0 if($first_index<0); + $first_index = 0 if ($first_index < 0); - #} elsif ($r->param('select_all')) { + #} elsif ($r->param('select_all')) { #; } elsif ($r->param('library_basic')) { $library_basic = 1; for my $jj (qw(textchapter textsection textbook)) { - $r->param('library_'.$jj,''); + $r->param('library_' . $jj, ''); } } elsif ($r->param('library_advanced')) { $library_basic = 2; } elsif ($r->param('library_reset')) { for my $jj (qw(chapters sections subjects textbook keywords)) { - $r->param('library_'.$jj,''); + $r->param('library_' . $jj, ''); } - #} elsif ($r->param('select_none')) { - # ; + #} elsif ($r->param('select_none')) { + # ; } else { ##### No action requested, probably our first time here ; - } ##### end of the if elsif ... - + } ##### end of the if elsif ... # Get the list of local sets sorted by set_id. my @all_db_sets = map { $_->[0] } $db->listGlobalSetsWhere({}, 'set_id'); if ($use_previous_problems) { - @pg_files = @all_past_list; + @pg_files = @all_past_list; $first_shown = 0; - $last_shown = 0; - my ($oli, $cnt) = (0,0); - while($oli < $first_index and ($oli = next_prob_group($first_shown, @pg_files)) != -1) { + $last_shown = 0; + my ($oli, $cnt) = (0, 0); + while ($oli < $first_index and ($oli = next_prob_group($first_shown, @pg_files)) != -1) { $cnt++; $first_shown = $oli; } $first_shown = $cnt; - $last_shown = $oli; - while($oli <= $last_index and $oli != -1) { + $last_shown = $oli; + while ($oli <= $last_index and $oli != -1) { $oli = next_prob_group($last_shown, @pg_files); $cnt++; $last_shown = $oli; } - $last_shown = $cnt-1; + $last_shown = $cnt - 1; $total_probs = $count; } else { ### Main place to set first/last shown for new problems $first_shown = 0; $first_index = 0; - $last_index = 0; - $last_shown = 1; + $last_index = 0; + $last_shown = 1; $total_probs = 0; my $oli = 0; - while(($oli = next_prob_group($last_index, @pg_files)) != -1 and $last_shown<$maxShown) { + while (($oli = next_prob_group($last_index, @pg_files)) != -1 and $last_shown < $maxShown) { $last_shown++; $last_index = $oli; } $total_probs = $last_shown; # $last_index points to start of last group - $last_shown--; # first_shown = 0 + $last_shown--; # first_shown = 0 $last_index = end_prob_group($last_index, @pg_files); - $oli = $last_index; - while(($oli = next_prob_group($oli, @pg_files)) != -1) { + $oli = $last_index; + while (($oli = next_prob_group($oli, @pg_files)) != -1) { $total_probs++; } } + my $library_stats_handler = ''; - my $library_stats_handler = ''; - - if ($ce->{problemLibrary}{showLibraryGlobalStats} || - $ce->{problemLibrary}{showLibraryLocalStats} ) { - $library_stats_handler = WeBWorK::Utils::LibraryStats->new($ce); + if ($ce->{problemLibrary}{showLibraryGlobalStats} + || $ce->{problemLibrary}{showLibraryLocalStats}) + { + $library_stats_handler = WeBWorK::Utils::LibraryStats->new($ce); } ############# Now store data in self for retreival by body - $self->{first_shown} = $first_shown; - $self->{last_shown} = $last_shown; - $self->{first_index} = $first_index; - $self->{last_index} = $last_index; - $self->{total_probs} = $total_probs; + $self->{first_shown} = $first_shown; + $self->{last_shown} = $last_shown; + $self->{first_index} = $first_index; + $self->{last_index} = $last_index; + $self->{total_probs} = $total_probs; $self->{browse_which} = $browse_which; #$self->{problem_seed} = $problem_seed; - $self->{pg_files} = \@pg_files; - $self->{all_db_sets} = \@all_db_sets; - $self->{library_basic} = $library_basic; + $self->{pg_files} = \@pg_files; + $self->{all_db_sets} = \@all_db_sets; + $self->{library_basic} = $library_basic; $self->{library_stats_handler} = $library_stats_handler; } - sub title { my ($self) = @_; return $self->r->maketext("Library Browser"); @@ -2063,15 +2107,15 @@ sub title { sub body { my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; # course environment - my $db = $r->db; # database - my $j; # garden variety counter + my $r = $self->r; + my $ce = $r->ce; # course environment + my $db = $r->db; # database + my $j; # garden variety counter my $courseID = $self->r->urlpath->arg("courseID"); my $userName = $r->param('user'); - my $user = $db->getUser($userName); # checked + my $user = $db->getUser($userName); # checked die "record for user $userName (real user) does not exist." unless defined $user; @@ -2090,17 +2134,17 @@ sub body { ########## Extract information computed in pre_header_initialize - my $first_shown = $self->{first_shown}; - my $last_shown = $self->{last_shown}; - my $first_index = $self->{first_index}; - my $last_index = $self->{last_index}; - my $total_probs = $self->{total_probs}; + my $first_shown = $self->{first_shown}; + my $last_shown = $self->{last_shown}; + my $first_index = $self->{first_index}; + my $last_index = $self->{last_index}; + my $total_probs = $self->{total_probs}; my $browse_which = $self->{browse_which}; - my $problem_seed = $self->{problem_seed}||1234; - my @pg_files = @{$self->{pg_files}}; - my @all_db_sets = @{$self->{all_db_sets}}; + my $problem_seed = $self->{problem_seed} || 1234; + my @pg_files = @{ $self->{pg_files} }; + my @all_db_sets = @{ $self->{all_db_sets} }; - my @plist = map {$_->{filepath}} @pg_files[$first_index..$last_index]; + my @plist = map { $_->{filepath} } @pg_files[ $first_index .. $last_index ]; # If there are problems to view and a target set is selected, then create a hash of source files in the target set. if (@plist) { @@ -2119,48 +2163,48 @@ sub body { # Add the course language in a hidden input so that the javascript can get this information. print CGI::hidden({ name => 'hidden_language', value => $ce->{language} }); - print CGI::hidden(-name=>'browse_which', -value=>$browse_which,-override=>1), - CGI::hidden(-name=>'problem_seed', -value=>$problem_seed, -override=>1); - for ($j = 0 ; $j < scalar(@pg_files) ; $j++) { - print CGI::hidden(-name=>"all_past_list$j", -value=>$pg_files[$j]->{filepath}, -override=>1)."\n"; - print CGI::hidden(-name=>"all_past_mlt$j", -value=>($pg_files[$j]->{morelt} || 0), -override=>1)."\n"; + print CGI::hidden(-name => 'browse_which', -value => $browse_which, -override => 1), + CGI::hidden(-name => 'problem_seed', -value => $problem_seed, -override => 1); + for ($j = 0; $j < scalar(@pg_files); $j++) { + print CGI::hidden(-name => "all_past_list$j", -value => $pg_files[$j]->{filepath}, -override => 1) . "\n"; + print CGI::hidden(-name => "all_past_mlt$j", -value => ($pg_files[$j]->{morelt} || 0), -override => 1) . "\n"; } - print CGI::hidden(-name=>'first_shown', -value=>$first_shown,-override=>1); + print CGI::hidden(-name => 'first_shown', -value => $first_shown, -override => 1); - print CGI::hidden(-name=>'last_shown', -value=>$last_shown, -override=>1); - print CGI::hidden(-name=>'first_index', -value=>$first_index); - print CGI::hidden(-name=>'last_index', -value=>$last_index); - print CGI::hidden(-name=>'total_probs', -value=>$total_probs); + print CGI::hidden(-name => 'last_shown', -value => $last_shown, -override => 1); + print CGI::hidden(-name => 'first_index', -value => $first_index); + print CGI::hidden(-name => 'last_index', -value => $last_index); + print CGI::hidden(-name => 'total_probs', -value => $total_probs); print CGI::start_div({ class => 'library-browser-table' }); $self->make_top_row('all_db_sets' => \@all_db_sets, 'browse_which' => $browse_which); print CGI::end_div(); ########## Now print problems - my ($jj,$mltnumleft)=(0,-1); - for ($jj=0; $jj{filepath} =~ s|^$ce->{courseDirs}->{templates}/?||; + my ($jj, $mltnumleft) = (0, -1); + for ($jj = 0; $jj < scalar(@plist); $jj++) { + $pg_files[ $jj + $first_index ]->{filepath} =~ s|^$ce->{courseDirs}->{templates}/?||; # For MLT boxes, need to know if we are at the end of a group # make_data_row can't figure this out since it only sees one file $mltnumleft--; - my $sourceFileData = $pg_files[$jj+$first_index]; - $self->make_data_row($sourceFileData, $plist[$jj], $jj+1,$mltnumleft); - $mltnumleft = scalar(@{$sourceFileData->{children}}) if($sourceFileData->{children}); + my $sourceFileData = $pg_files[ $jj + $first_index ]; + $self->make_data_row($sourceFileData, $plist[$jj], $jj + 1, $mltnumleft); + $mltnumleft = scalar(@{ $sourceFileData->{children} }) if ($sourceFileData->{children}); } ########## Finish things off my ($next_button, $prev_button) = ("", ""); if ($first_index > 0) { $prev_button = CGI::submit({ - name => "prev_page", + name => "prev_page", value => $r->maketext("Previous page"), class => 'btn btn-secondary btn-sm' }); } - if ((1+$last_index) "next_page", + name => "next_page", value => $r->maketext("Next page"), class => 'btn btn-secondary btn-sm' }); @@ -2181,14 +2225,12 @@ sub body { " ", $next_button, ); - print CGI::p( - $r->maketext( - 'Some problems shown above represent multiple similar problems from the database. If the (top) ' - . 'information line for a problem has a letter M for "More", hover your mouse over the M to ' - . 'see how many similar problems are hidden, or click on the M to see the problems. If you click ' - . 'to view these problems, the M becomes an L, which can be clicked on to hide the problems again.' - ) - ); + print CGI::p($r->maketext( + 'Some problems shown above represent multiple similar problems from the database. If the (top) ' + . 'information line for a problem has a letter M for "More", hover your mouse over the M to ' + . 'see how many similar problems are hidden, or click on the M to see the problems. If you click ' + . 'to view these problems, the M becomes an L, which can be clicked on to hide the problems again.' + )); } print CGI::end_form(); diff --git a/lib/WeBWorK/ContentGenerator/Instructor/SetsAssignedToUser.pm b/lib/WeBWorK/ContentGenerator/Instructor/SetsAssignedToUser.pm index 301f8c61bf..0b865b0459 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/SetsAssignedToUser.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/SetsAssignedToUser.pm @@ -30,14 +30,14 @@ use WeBWorK::CGI; use WeBWorK::Debug; sub initialize { - my ($self) = @_; - my $r = $self->r; - my $urlpath = $r->urlpath; - my $db = $r->db; - my $authz = $r->authz; + my ($self) = @_; + my $r = $self->r; + my $urlpath = $r->urlpath; + my $db = $r->db; + my $authz = $r->authz; - my $userID = $urlpath->arg("userID"); - my $user = $r->param("user"); + my $userID = $urlpath->arg("userID"); + my $user = $r->param("user"); # check authorization return unless $authz->hasPermissions($user, "access_instructor_tools"); @@ -62,7 +62,7 @@ sub initialize { my %selectedSets = map { $_ => 1 } $r->param("selected"); # get current user - my $User = $db->getUser($userID); # checked + my $User = $db->getUser($userID); # checked die "record not found for $userID.\n" unless $User; $self->addgoodmessage($r->maketext("User's sets have been reassigned.")); @@ -74,20 +74,20 @@ sub initialize { my $setID = $setRecord->set_id; # does the user want it to be assigned to the selected user if (exists $selectedSets{$setID}) { - unless ($userSets{$setID}) { # skip users already in the set + unless ($userSets{$setID}) { # skip users already in the set debug("assignSetToUser($userID, $setID)"); $self->assignSetToUser($userID, $setRecord); debug("done assignSetToUser($userID, $setID)"); } } else { # user asked to NOT have the set assigned to the selected user - next unless $userSets{$setID}; # skip users not in the set + next unless $userSets{$setID}; # skip users not in the set $db->deleteUserSet($userID, $setID); } } } elsif (defined $r->param("unassignFromAll")) { - # no action taken - $self->addbadmessage($r->maketext('No action taken')); + # no action taken + $self->addbadmessage($r->maketext('No action taken')); } } @@ -151,8 +151,7 @@ sub body { print CGI::start_div({ class => 'table-responsive' }), CGI::start_table({ class => 'table table-bordered table-sm font-sm w-auto' }); - print CGI::Tr(CGI::th({ class => 'text-center' }, 'Assigned'), - CGI::th([ 'Set Name', 'Close Date', '' ])); + print CGI::Tr(CGI::th({ class => 'text-center' }, 'Assigned'), CGI::th([ 'Set Name', 'Close Date', '' ])); foreach my $Set (@{ $self->{set_records} }) { my $setID = $Set->set_id; @@ -202,9 +201,9 @@ sub body { { class => 'alert alert-danger p-1 mb-3' }, $r->maketext( 'There is NO undo for this function. ' - . 'Do not use it unless you know what you are doing! When you unassign ' - . 'sets using this button, or by unchecking their set names, you destroy all ' - . 'of the data for those sets for this student.', + . 'Do not use it unless you know what you are doing! When you unassign ' + . 'sets using this button, or by unchecking their set names, you destroy all ' + . 'of the data for those sets for this student.', ) ), CGI::div( @@ -231,11 +230,11 @@ sub body { } sub title { - my ($self) = @_; - my $r = $self->{r}; - my $userID = $r->urlpath->arg("userID"); + my ($self) = @_; + my $r = $self->{r}; + my $userID = $r->urlpath->arg("userID"); - return "Assigned Sets for user $userID"; + return "Assigned Sets for user $userID"; } 1; diff --git a/lib/WeBWorK/ContentGenerator/Instructor/ShowAnswers.pm b/lib/WeBWorK/ContentGenerator/Instructor/ShowAnswers.pm index 8fc51809da..90e310092a 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/ShowAnswers.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/ShowAnswers.pm @@ -43,11 +43,11 @@ sub initialize { my $authz = $r->authz; my $courseName = $urlpath->arg("courseID"); my $user = $r->param('user'); - my $root = $ce->{webworkURLs}->{root}; - my $key = $r->param('key'); + my $root = $ce->{webworkURLs}->{root}; + my $key = $r->param('key'); - my $selectedSets = [$r->param('selected_sets')] // []; - my $selectedProblems = [$r->param('selected_problems')] // []; + my $selectedSets = [ $r->param('selected_sets') ] // []; + my $selectedProblems = [ $r->param('selected_problems') ] // []; unless ($authz->hasPermissions($user, "view_answers")) { $self->addbadmessage("You aren't authorized to view past answers"); @@ -59,18 +59,18 @@ sub initialize { # acting the current studentID, setID and problemID will be maintained my $extraStopActingParams; - $extraStopActingParams->{selected_users} = $r->param('selected_users'); - $extraStopActingParams->{selected_sets} = $r->param('selected_sets'); + $extraStopActingParams->{selected_users} = $r->param('selected_users'); + $extraStopActingParams->{selected_sets} = $r->param('selected_sets'); $extraStopActingParams->{selected_problems} = $r->param('selected_problems'); - $r->{extraStopActingParams} = $extraStopActingParams; + $r->{extraStopActingParams} = $extraStopActingParams; - my $selectedUsers = [$r->param('selected_users')] // []; + my $selectedUsers = [ $r->param('selected_users') ] // []; my $instructor = $authz->hasPermissions($user, "access_instructor_tools"); # If not instructor then force table to use current user-id if (!$instructor) { - $selectedUsers = [$user]; + $selectedUsers = [$user]; } return CGI::div({ class => 'alert alert-danger' }, @@ -81,8 +81,8 @@ sub initialize { my %prettyProblemNumbers; my %answerTypes; - foreach my $studentUser (@$selectedUsers) { - my @sets; + foreach my $studentUser (@$selectedUsers) { + my @sets; # search for selected sets assigned to students my @allSets = $db->listUserSets($studentUser); @@ -102,153 +102,153 @@ sub initialize { } - next unless @sets; - - foreach my $setRecord (@sets) { - my @problemNumbers; - my $setName = $setRecord->set_id; - my $isJitarSet = (defined($setRecord->assignment_type) && $setRecord->assignment_type eq 'jitar' ) ? 1 : 0; - - # search for matching problems - my @allProblems = $db->listUserProblems($studentUser, $setName); - next unless @allProblems; - foreach my $problemNumber (@allProblems) { - my $prettyProblemNumber = $problemNumber; - if ($isJitarSet) { - $prettyProblemNumber = join('.',jitar_id_to_seq($problemNumber)); - } - $prettyProblemNumbers{$setName}{$problemNumber} = $prettyProblemNumber; - - if (grep(/^$prettyProblemNumber$/,@$selectedProblems)) { - push (@problemNumbers, $problemNumber); - } - } + next unless @sets; - next unless @problemNumbers; - - foreach my $problemNumber (@problemNumbers) { - my @pastAnswerIDs = $db->listProblemPastAnswers($studentUser, $setName, $problemNumber); - - if (!defined($answerTypes{$setName}{$problemNumber})) { - #set up a silly problem to figure out what type the answers are - #(why isn't this stored somewhere) - my $unversionedSetName = $setName; - $unversionedSetName =~ s/,v[0-9]*$//; - my $displayMode = $self->{displayMode}; - my $formFields = { WeBWorK::Form->new_from_paramable($r)->Vars }; - my $set = $db->getMergedSet($studentUser, $unversionedSetName); - my $problem = $db->getMergedProblem($studentUser, $unversionedSetName, $problemNumber); - my $userobj = $db->getUser($studentUser); - #if these things dont exist then the problem doesnt exist and past answers dont make sense - next unless defined($set) && defined($problem) && defined($userobj); - - my $pg = WeBWorK::PG->new(constructPGOptions( - $ce, $userobj, $set, $problem, - $set->psvn, - $formFields, - { # translation options - displayMode => 'plainText', - showHints => 0, - showSolutions => 0, - refreshMath2img => 0, - processAnswers => 1, - permissionLevel => $db->getPermissionLevel($studentUser)->permission, - effectivePermissionLevel => $db->getPermissionLevel($studentUser)->permission, - }, - )); - - # check to see what type the answers are. right now it only checks for essay but could do more - my %answerHash = %{ $pg->{answers} }; - my @answerTypes; - - foreach (sortByName(undef, keys %answerHash)) { - push(@answerTypes,defined($answerHash{$_}->{type})?$answerHash{$_}->{type}:'undefined'); - } - - $answerTypes{$setName}{$problemNumber} = [@answerTypes]; - } - - my @pastAnswers = $db->getPastAnswers(\@pastAnswerIDs); - - foreach my $pastAnswer (@pastAnswers) { - my $answerID = $pastAnswer->answer_id; - my $answers = $pastAnswer->answer_string; - my $scores = $pastAnswer->scores; - my $time = $pastAnswer->timestamp; - my @scores = split(//, $scores); - my @answers = split(/\t/,$answers); - - - $records{$studentUser}{$setName}{$problemNumber}{$answerID} = { time => $time, - answers => [@answers], - answerTypes => $answerTypes{$setName}{$problemNumber}, - scores => [@scores], - comment => $pastAnswer->comment_string // '' }; - - } + foreach my $setRecord (@sets) { + my @problemNumbers; + my $setName = $setRecord->set_id; + my $isJitarSet = (defined($setRecord->assignment_type) && $setRecord->assignment_type eq 'jitar') ? 1 : 0; + # search for matching problems + my @allProblems = $db->listUserProblems($studentUser, $setName); + next unless @allProblems; + foreach my $problemNumber (@allProblems) { + my $prettyProblemNumber = $problemNumber; + if ($isJitarSet) { + $prettyProblemNumber = join('.', jitar_id_to_seq($problemNumber)); + } + $prettyProblemNumbers{$setName}{$problemNumber} = $prettyProblemNumber; + + if (grep(/^$prettyProblemNumber$/, @$selectedProblems)) { + push(@problemNumbers, $problemNumber); + } + } + + next unless @problemNumbers; + + foreach my $problemNumber (@problemNumbers) { + my @pastAnswerIDs = $db->listProblemPastAnswers($studentUser, $setName, $problemNumber); + + if (!defined($answerTypes{$setName}{$problemNumber})) { + #set up a silly problem to figure out what type the answers are + #(why isn't this stored somewhere) + my $unversionedSetName = $setName; + $unversionedSetName =~ s/,v[0-9]*$//; + my $displayMode = $self->{displayMode}; + my $formFields = { WeBWorK::Form->new_from_paramable($r)->Vars }; + my $set = $db->getMergedSet($studentUser, $unversionedSetName); + my $problem = $db->getMergedProblem($studentUser, $unversionedSetName, $problemNumber); + my $userobj = $db->getUser($studentUser); + #if these things dont exist then the problem doesnt exist and past answers dont make sense + next unless defined($set) && defined($problem) && defined($userobj); + + my $pg = WeBWorK::PG->new(constructPGOptions( + $ce, $userobj, $set, $problem, + $set->psvn, + $formFields, + { # translation options + displayMode => 'plainText', + showHints => 0, + showSolutions => 0, + refreshMath2img => 0, + processAnswers => 1, + permissionLevel => $db->getPermissionLevel($studentUser)->permission, + effectivePermissionLevel => $db->getPermissionLevel($studentUser)->permission, + }, + )); + + # check to see what type the answers are. right now it only checks for essay but could do more + my %answerHash = %{ $pg->{answers} }; + my @answerTypes; + + foreach (sortByName(undef, keys %answerHash)) { + push(@answerTypes, defined($answerHash{$_}->{type}) ? $answerHash{$_}->{type} : 'undefined'); + } + + $answerTypes{$setName}{$problemNumber} = [@answerTypes]; + } + + my @pastAnswers = $db->getPastAnswers(\@pastAnswerIDs); + + foreach my $pastAnswer (@pastAnswers) { + my $answerID = $pastAnswer->answer_id; + my $answers = $pastAnswer->answer_string; + my $scores = $pastAnswer->scores; + my $time = $pastAnswer->timestamp; + my @scores = split(//, $scores); + my @answers = split(/\t/, $answers); + + $records{$studentUser}{$setName}{$problemNumber}{$answerID} = { + time => $time, + answers => [@answers], + answerTypes => $answerTypes{$setName}{$problemNumber}, + scores => [@scores], + comment => $pastAnswer->comment_string // '' + }; + + } + + } } - } - } + } - $self->{records} = \%records; + $self->{records} = \%records; $self->{prettyProblemNumbers} = \%prettyProblemNumbers; # Prepare a csv if we are an instructor if ($instructor && $r->param('createCSV')) { - my $filename = PAST_ANSWERS_FILENAME; - my $scoringDir = $ce->{courseDirs}->{scoring}; - my $fullFilename = "${scoringDir}/${filename}.csv"; - if (-e $fullFilename) { - my $i=1; - while(-e "${scoringDir}/${filename}_bak$i.csv") {$i++;} #don't overwrite existing backups - my $bakFileName ="${scoringDir}/${filename}_bak$i.csv"; - rename $fullFilename, $bakFileName or warn "Unable to rename $filename to $bakFileName"; - } - - $filename .= '.csv'; - - open my $fh, ">:utf8", $fullFilename or warn "Unable to open $fullFilename for writing"; - - my $csv = Text::CSV->new({"eol"=>"\n"}); - my @columns; - - $columns[0] = $r->maketext('User ID'); - $columns[1] = $r->maketext('Set ID'); - $columns[2] = $r->maketext('Problem Number'); - $columns[3] = $r->maketext('Timestamp'); - $columns[4] = $r->maketext('Scores'); - $columns[5] = $r->maketext('Answers'); - $columns[6] = $r->maketext('Comment'); - - $csv->print($fh, \@columns); - - foreach my $studentID (sort keys %records) { - $columns[0] = $studentID; - foreach my $setID (sort keys %{$records{$studentID}}) { - $columns[1] = $setID; - foreach my $probNum (sort {$a <=> $b} keys %{$records{$studentID}{$setID}}) { - $columns[2] = $prettyProblemNumbers{$setID}{$probNum}; - foreach my $answerID (sort {$a <=> $b} keys %{$records{$studentID}{$setID}{$probNum}}) { - my %record = %{$records{$studentID}{$setID}{$probNum}{$answerID}}; - - $columns[3] = $self->formatDateTime($record{time}); - $columns[4] = join(',' ,@{$record{scores}}); - $columns[5] = join("\t" ,@{$record{answers}}); - $columns[6] = $record{comment}; - - $csv->print($fh,\@columns); - } - } + my $filename = PAST_ANSWERS_FILENAME; + my $scoringDir = $ce->{courseDirs}->{scoring}; + my $fullFilename = "${scoringDir}/${filename}.csv"; + if (-e $fullFilename) { + my $i = 1; + while (-e "${scoringDir}/${filename}_bak$i.csv") { $i++; } #don't overwrite existing backups + my $bakFileName = "${scoringDir}/${filename}_bak$i.csv"; + rename $fullFilename, $bakFileName or warn "Unable to rename $filename to $bakFileName"; } - } - close($fh) or warn "Couldn't Close $fullFilename"; + $filename .= '.csv'; - } + open my $fh, ">:utf8", $fullFilename or warn "Unable to open $fullFilename for writing"; -} + my $csv = Text::CSV->new({ "eol" => "\n" }); + my @columns; + + $columns[0] = $r->maketext('User ID'); + $columns[1] = $r->maketext('Set ID'); + $columns[2] = $r->maketext('Problem Number'); + $columns[3] = $r->maketext('Timestamp'); + $columns[4] = $r->maketext('Scores'); + $columns[5] = $r->maketext('Answers'); + $columns[6] = $r->maketext('Comment'); + + $csv->print($fh, \@columns); + foreach my $studentID (sort keys %records) { + $columns[0] = $studentID; + foreach my $setID (sort keys %{ $records{$studentID} }) { + $columns[1] = $setID; + foreach my $probNum (sort { $a <=> $b } keys %{ $records{$studentID}{$setID} }) { + $columns[2] = $prettyProblemNumbers{$setID}{$probNum}; + foreach my $answerID (sort { $a <=> $b } keys %{ $records{$studentID}{$setID}{$probNum} }) { + my %record = %{ $records{$studentID}{$setID}{$probNum}{$answerID} }; + + $columns[3] = $self->formatDateTime($record{time}); + $columns[4] = join(',', @{ $record{scores} }); + $columns[5] = join("\t", @{ $record{answers} }); + $columns[6] = $record{comment}; + + $csv->print($fh, \@columns); + } + } + } + } + + close($fh) or warn "Couldn't Close $fullFilename"; + + } + +} sub body { my $self = shift; @@ -365,7 +365,8 @@ sub body { { class => 'fw-bold fs-5 mb-2' }, $r->maketext('Download:'), CGI::a( - { href => $self->systemLink($scoringDownloadPage, params => { getFile => $filename }) }, $filename + { href => $self->systemLink($scoringDownloadPage, params => { getFile => $filename }) }, + $filename ) ); @@ -383,8 +384,8 @@ sub body { { id => 'site_description', style => 'display:none' }, CGI::em($r->maketext( 'This is the past answer viewer. Students can only see their answers, and they will not be able to ' - . 'see which parts are correct. Instructors can view any users answers using the form below and the ' - . 'answers will be colored according to correctness.' + . 'see which parts are correct. Instructors can view any users answers using the form below and the ' + . 'answers will be colored according to correctness.' )) ); @@ -491,8 +492,8 @@ sub body { my @pastAnswerIDs = sort { $a <=> $b } keys %{ $records->{$studentUser}{$setName}{$problemNumber} }; my $prettyProblemNumber = $prettyProblemNumbers->{$setName}{$problemNumber}; print CGI::h3($r->maketext( - "Past Answers for [_1], set [_2], problem [_3]", - $studentUser, CGI::span({ dir => 'ltr' }, format_set_name_display($setName)), $prettyProblemNumber + "Past Answers for [_1], set [_2], problem [_3]", $studentUser, + CGI::span({ dir => 'ltr' }, format_set_name_display($setName)), $prettyProblemNumber )); my @row; @@ -500,11 +501,10 @@ sub body { my $previousTime = -1; - print CGI::start_div({ class => 'table-responsive' }), - CGI::start_table({ - class => 'past-answer-table table table-striped', - dir => "ltr" # The answers are not well formatted in RTL mode - }); + print CGI::start_div({ class => 'table-responsive' }), CGI::start_table({ + class => 'past-answer-table table table-striped', + dir => "ltr" # The answers are not well formatted in RTL mode + }); foreach my $answerID (@pastAnswerIDs) { $foundMatches = 1 unless $foundMatches; @@ -592,41 +592,41 @@ sub body { } sub byData { - my ($A,$B) = ($a,$b); - $A =~ s/\|[01]*\t([^\t]+)\t.*/|$1/; # remove answers and correct/incorrect status - $B =~ s/\|[01]*\t([^\t]+)\t.*/|$1/; - return $A cmp $B; + my ($A, $B) = ($a, $b); + $A =~ s/\|[01]*\t([^\t]+)\t.*/|$1/; # remove answers and correct/incorrect status + $B =~ s/\|[01]*\t([^\t]+)\t.*/|$1/; + return $A cmp $B; } # sorts problem ID's so that all just-in-time like ids are at the bottom # of the list in order and other problems sub prob_id_sort { - my @seqa = split(/\./,$a); - my @seqb = split(/\./,$b); - - # go through problem number sequence - for (my $i = 0; $i <= $#seqa; $i++) { - # if at some point two numbers are different return the comparison. - # e.g. 2.1.3 vs 1.2.6 - if ($seqa[$i] != $seqb[$i]) { - return $seqa[$i] <=> $seqb[$i]; - } - - # if all of the values are equal but b is shorter then it comes first - # i.e. 2.1.3 vs 2.1 - if ($i == $#seqb) { - return 1; - } - } - - # if all of the values are equal and a and b are the same length then equal - # otherwise a was shorter than b so a comes first. - if ($#seqa == $#seqb) { - return 0; - } else { - return -1; - } + my @seqa = split(/\./, $a); + my @seqb = split(/\./, $b); + + # go through problem number sequence + for (my $i = 0; $i <= $#seqa; $i++) { + # if at some point two numbers are different return the comparison. + # e.g. 2.1.3 vs 1.2.6 + if ($seqa[$i] != $seqb[$i]) { + return $seqa[$i] <=> $seqb[$i]; + } + + # if all of the values are equal but b is shorter then it comes first + # i.e. 2.1.3 vs 2.1 + if ($i == $#seqb) { + return 1; + } + } + + # if all of the values are equal and a and b are the same length then equal + # otherwise a was shorter than b so a comes first. + if ($#seqa == $#seqb) { + return 0; + } else { + return -1; + } } sub output_JS { diff --git a/lib/WeBWorK/ContentGenerator/Instructor/SingleProblemGrader.pm b/lib/WeBWorK/ContentGenerator/Instructor/SingleProblemGrader.pm index 5a91ca5bd8..24b6c3b1fa 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/SingleProblemGrader.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/SingleProblemGrader.pm @@ -105,42 +105,43 @@ sub insertGrader { { class => 'col-fixed col-form-label' }, $self->maketext('Answer [_1] Score (%):', $part + 1) . ' ' . CGI::a( - { - class => 'help-popup', - data_bs_content => $self->maketext( - 'The initial value is the answer sub score for the answer ' + { + class => 'help-popup', + data_bs_content => $self->maketext( + 'The initial value is the answer sub score for the answer ' . 'that is currently shown. If this is modified, it will be used to compute ' . 'the total problem score below. This score is not saved, and will reset to the ' . 'score for the shown answer if the page is reloaded.' - ), - data_bs_placement => 'top', - data_bs_toggle => 'popover' - }, - CGI::i( - { - class => 'icon fas fa-question-circle', - aria_hidden => 'true', - data_alt => 'Help Icon' + ), + data_bs_placement => 'top', + data_bs_toggle => 'popover' }, - '' - ) + CGI::i( + { + class => 'icon fas fa-question-circle', + aria_hidden => 'true', + data_alt => 'Help Icon' + }, + '' + ) ) ) . CGI::div( - { class => 'col-sm' }, - CGI::input({ - type => 'number', - min => 0, - max => 100, - autocomplete => 'off', - class => 'answer-part-score form-control form-control-sm w-auto d-inline', - id => "score_problem$self->{problem_id}_$self->{pg}{flags}{ANSWER_ENTRY_ORDER}[$part]", - data_problem_id => $self->{problem_id}, - data_answer_labels => '["' . join('","', @{ $self->{pg}{flags}{ANSWER_ENTRY_ORDER} }) . '"]', - data_weight => $weights[$part], - value => $scores[$part], - size => 5 - }) + { class => 'col-sm' }, + CGI::input({ + type => 'number', + min => 0, + max => 100, + autocomplete => 'off', + class => 'answer-part-score form-control form-control-sm w-auto d-inline', + id => "score_problem$self->{problem_id}_$self->{pg}{flags}{ANSWER_ENTRY_ORDER}[$part]", + data_problem_id => $self->{problem_id}, + data_answer_labels => '["' + . join('","', @{ $self->{pg}{flags}{ANSWER_ENTRY_ORDER} }) . '"]', + data_weight => $weights[$part], + value => $scores[$part], + size => 5 + }) . ' ' . $self->maketext('Weight: [_1]%', wwRound(2, $weights[$part] * 100)) ) @@ -155,41 +156,42 @@ sub insertGrader { { class => 'col-fixed col-form-label' }, $self->maketext('Problem Score (%):') . ' ' . CGI::a( - { - class => 'help-popup', - data_bs_content => + { + class => 'help-popup', + data_bs_content => $self->maketext('The initial value is the currently saved score for this student.') . ( - @{ $self->{pg}{flags}{ANSWER_ENTRY_ORDER} } > 1 - ? ' ' + @{ $self->{pg}{flags}{ANSWER_ENTRY_ORDER} } > 1 + ? ' ' . $self->maketext( - 'This is the only part of the score that is actually saved. ' + 'This is the only part of the score that is actually saved. ' . 'This is computed from the answer sub scores above using the weights shown if they ' . 'are modified. Alternatively, enter the score you want saved here ' . '(the above sub scores will be ignored).' ) - : '' + : '' ), - data_bs_placement => 'top', - data_bs_toggle => 'popover' - }, - CGI::i({ class => 'icon fas fa-question-circle', aria_hidden => 'true', data_alt => 'Help Icon' }, '') + data_bs_placement => 'top', + data_bs_toggle => 'popover' + }, + CGI::i({ class => 'icon fas fa-question-circle', aria_hidden => 'true', data_alt => 'Help Icon' }, + '') . CGI::span({ class => 'sr-only-glyphicon' }, 'Help Icon') ) ) . CGI::div( - { class => 'col-sm' }, - CGI::input({ - type => 'number', - id => "score_problem$self->{problem_id}", - class => 'problem-score form-control form-control-sm w-auto d-inline', - min => 0, - max => 100, - autocomplete => 'off', - data_problem_id => $self->{problem_id}, - value => wwRound(0, $self->{recorded_score} * 100), - size => 5 - }) + { class => 'col-sm' }, + CGI::input({ + type => 'number', + id => "score_problem$self->{problem_id}", + class => 'problem-score form-control form-control-sm w-auto d-inline', + min => 0, + max => 100, + autocomplete => 'off', + data_problem_id => $self->{problem_id}, + value => wwRound(0, $self->{recorded_score} * 100), + size => 5 + }) ) ); @@ -199,19 +201,19 @@ sub insertGrader { { class => 'row' }, CGI::label({ class => 'col-fixed col-form-label' }, $self->maketext('Comment:')) . CGI::div( - { class => 'col-sm' }, - CGI::textarea({ - id => "comment_problem$self->{problem_id}", - class => 'grader-problem-comment form-control d-inline', - data_problem_id => $self->{problem_id}, - value => $self->{comment_string}, - rows => 3 - }), - CGI::input({ - class => 'preview btn btn-secondary mt-1', - type => 'button', - value => $self->maketext('Preview Comment') - }) + { class => 'col-sm' }, + CGI::textarea({ + id => "comment_problem$self->{problem_id}", + class => 'grader-problem-comment form-control d-inline', + data_problem_id => $self->{problem_id}, + value => $self->{comment_string}, + rows => 3 + }), + CGI::input({ + class => 'preview btn btn-secondary mt-1', + type => 'button', + value => $self->maketext('Preview Comment') + }) ) ); } diff --git a/lib/WeBWorK/ContentGenerator/Instructor/Stats.pm b/lib/WeBWorK/ContentGenerator/Instructor/Stats.pm index 7608098a90..779aacf7a1 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/Stats.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/Stats.pm @@ -96,7 +96,7 @@ sub siblings { # List links depending on if viewing set progress or student progress if ($self->{type} eq 'student') { - my $ce = $r->ce; + my $ce = $r->ce; my $user = $r->param('user'); # Get all users except the set level proctors, and restrict to the # sections or recitations that are allowed for the user if such @@ -144,7 +144,7 @@ sub siblings { ); } } else { - my @setIDs = sort $db->listGlobalSets; + my @setIDs = sort $db->listGlobalSets; for my $setID (@setIDs) { my $problemPage = $urlpath->newFromModule( $urlpath->module, $r, @@ -239,8 +239,7 @@ sub index { statType => 'set', setID => $set ); - push @setLinks, - CGI::a({ href => $self->systemLink($setStatisticsPage) }, format_set_name_display($set)); + push @setLinks, CGI::a({ href => $self->systemLink($setStatisticsPage) }, format_set_name_display($set)); } # Get a list of students sorted by user_id. @@ -281,7 +280,7 @@ sub index { CGI::div( { class => 'col-lg-5 col-sm-6 border border-dark' }, CGI::h2({ class => 'text-center fs-3' }, $r->maketext('View statistics by set')), - CGI::ul({ dir => 'ltr' }, CGI::li([@setLinks])), + CGI::ul({ dir => 'ltr' }, CGI::li([@setLinks])), ), CGI::div( { class => 'col-lg-5 col-sm-6 border border-dark' }, @@ -508,7 +507,7 @@ sub displaySet { $attempts_percentiles_for_problem{$probID} = { determine_percentiles([@brackets2], @{ $attempts_list_for_problem{$probID} }) }; - if ($setRecord->assignment_type =~ /gateway/ || !$db->existsUserSet($r->param('user') , $setName)) { + if ($setRecord->assignment_type =~ /gateway/ || !$db->existsUserSet($r->param('user'), $setName)) { # If this is a gateway quiz, there is not a valid link to the problem, so use the Problem.pm editMode with # an undefined set instead. $problemPage{$probID} = $self->systemLink( @@ -674,9 +673,9 @@ sub displaySet { map { my $probID = $_->problem_id; $problemPage{$probID} - ? CGI::a({ href => $problemPage{$probID}, target => 'ww_stats_problem' }, - $prettyProblemIDs{$probID}) - : $prettyProblemIDs{$probID} + ? CGI::a({ href => $problemPage{$probID}, target => 'ww_stats_problem' }, + $prettyProblemIDs{$probID}) + : $prettyProblemIDs{$probID} } @problems ] ) @@ -796,8 +795,10 @@ sub displaySet { print CGI::Tr( CGI::th( $problemPage{$probID} - ? CGI::a({ href => $problemPage{$probID}, target => 'ww_stats_problem' }, - $r->maketext('Problem [_1]', $prettyProblemIDs{$probID})) + ? CGI::a( + { href => $problemPage{$probID}, target => 'ww_stats_problem' }, + $r->maketext('Problem [_1]', $prettyProblemIDs{$probID}) + ) : $prettyProblemIDs{$probID} ), CGI::td( diff --git a/lib/WeBWorK/ContentGenerator/Instructor/StudentProgress.pm b/lib/WeBWorK/ContentGenerator/Instructor/StudentProgress.pm index d57b14e9af..ba375547f2 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/StudentProgress.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/StudentProgress.pm @@ -33,7 +33,7 @@ use WeBWorK::Utils::Grades qw/list_set_versions/; # The table format has been borrowed from the Grades.pm module sub initialize { - my $self = shift; + my $self = shift; my $r = $self->{r}; my $urlpath = $r->urlpath; my $type = $urlpath->arg("statType") || ''; @@ -41,27 +41,26 @@ sub initialize { my $ce = $self->{ce}; my $authz = $self->{authz}; my $courseName = $urlpath->arg('courseID'); - my $user = $r->param('user'); + my $user = $r->param('user'); - # Check permissions + # Check permissions return unless $authz->hasPermissions($user, "access_instructor_tools"); - $self->{type} = $type; - if ($type eq 'student') { - my $studentName = $r->urlpath->arg("userID") || $user; - $self->{studentName } = $studentName; + $self->{type} = $type; + if ($type eq 'student') { + my $studentName = $r->urlpath->arg("userID") || $user; + $self->{studentName} = $studentName; - } elsif ($type eq 'set') { - my $setName = $r->urlpath->arg("setID") || 0; - $self->{setName} = $setName; - my $setRecord = $db->getGlobalSet($setName); # checked + } elsif ($type eq 'set') { + my $setName = $r->urlpath->arg("setID") || 0; + $self->{setName} = $setName; + my $setRecord = $db->getGlobalSet($setName); # checked die "global set $setName not found." unless $setRecord; $self->{set_due_date} = $setRecord->due_date; - $self->{setRecord} = $setRecord; - } + $self->{setRecord} = $setRecord; + } } - sub title { my ($self) = @_; my $r = $self->r; @@ -71,7 +70,7 @@ sub title { # Check permissions return '' unless $authz->hasPermissions($user, 'access_instructor_tools'); - my $type = $self->{type}; + my $type = $self->{type}; if ($type eq 'student') { return $r->maketext('Student Progress for [_1] student [_2]', $self->{ce}->{courseName}, $self->{studentName}); } elsif ($type eq 'set') { @@ -199,27 +198,28 @@ sub body { unless $authz->hasPermissions($user, "access_instructor_tools"); if ($type eq 'student') { - my $studentName = $self->{studentName}; - my $studentRecord = $db->getUser($studentName) # checked + my $studentName = $self->{studentName}; + my $studentRecord = $db->getUser($studentName) # checked or die "record for user $studentName not found"; - my $fullName = $studentRecord->full_name; - my $courseHomePage = $urlpath->new(type => 'set_list', - args => {courseID=>$courseName}); + my $fullName = $studentRecord->full_name; + my $courseHomePage = $urlpath->new( + type => 'set_list', + args => { courseID => $courseName } + ); my $email = $studentRecord->email_address; - print CGI::a({-href=>"mailto:$email"}, $email), CGI::br(), - $r->maketext("Section").": ", $studentRecord->section, CGI::br(), - $r->maketext("Recitation").": ", $studentRecord->recitation, CGI::br(); + print CGI::a({ -href => "mailto:$email" }, $email), CGI::br(), + $r->maketext("Section") . ": ", $studentRecord->section, CGI::br(), + $r->maketext("Recitation") . ": ", $studentRecord->recitation, CGI::br(); if ($authz->hasPermissions($user, "become_student")) { - my $act_as_student_url = $self->systemLink($courseHomePage, - params => {effectiveUser=>$studentName}); + my $act_as_student_url = $self->systemLink($courseHomePage, params => { effectiveUser => $studentName }); - print $r->maketext("Act as:")." ".CGI::a({-href=>$act_as_student_url},$studentRecord->user_id); + print $r->maketext("Act as:") . " " . CGI::a({ -href => $act_as_student_url }, $studentRecord->user_id); } - print WeBWorK::ContentGenerator::Grades::displayStudentStats($self,$studentName); - } elsif( $type eq 'set') { + print WeBWorK::ContentGenerator::Grades::displayStudentStats($self, $studentName); + } elsif ($type eq 'set') { $self->displaySets($self->{setName}); } elsif ($type eq '') { $self->index; @@ -228,18 +228,17 @@ sub body { } - return ''; } sub index { - my $self = shift; - my $r = $self->r; - my $urlpath = $r->urlpath; - my $ce = $r->ce; - my $db = $r->db; - my $courseName = $urlpath->arg("courseID"); + my $self = shift; + my $r = $self->r; + my $urlpath = $r->urlpath; + my $ce = $r->ce; + my $db = $r->db; + my $courseName = $urlpath->arg("courseID"); my $user = $r->param("user"); @@ -264,8 +263,8 @@ sub index { my @setList = map { $_->[0] } $db->listGlobalSetsWhere({}, 'set_id'); - my @setLinks = (); - my @studentLinks = (); + my @setLinks = (); + my @studentLinks = (); for my $set (@setList) { my $setStatisticsPage = $urlpath->newFromModule( $urlpath->module, $r, @@ -296,7 +295,7 @@ sub index { CGI::div( { class => 'col-lg-5 col-sm-6 border border-dark' }, CGI::h2({ class => 'text-center fs-3' }, $r->maketext('View student progress by set')), - CGI::ul({ dir => 'ltr' }, CGI::li([@setLinks])) + CGI::ul({ dir => 'ltr' }, CGI::li([@setLinks])) ), CGI::div( { class => 'col-lg-5 col-sm-6 border border-dark' }, @@ -319,7 +318,8 @@ sub displaySets { my $user = $r->param('user'); my $GlobalSet = $self->{setRecord}; my $root = $ce->{webworkURLs}->{root}; - my $setStatsPage = $urlpath->newFromModule($urlpath->module, $r, courseID => $courseName, statType => 'sets', setID => $setName); + my $setStatsPage = + $urlpath->newFromModule($urlpath->module, $r, courseID => $courseName, statType => 'sets', setID => $setName); my $primary_sort_method_name = $r->param('primary_sort'); my $secondary_sort_method_name = $r->param('secondary_sort'); my $ternary_sort_method_name = $r->param('ternary_sort'); @@ -516,7 +516,7 @@ sub displaySets { total => 'n/a', section => $studentRecord->section(), recitation => $studentRecord->recitation(), - problemsRow => [$r->maketext('no attempt recorded')], + problemsRow => [ $r->maketext('no attempt recorded') ], email_address => $studentRecord->email_address(), date => 'n/a', testtime => 'n/a', @@ -526,8 +526,8 @@ sub displaySets { push(@score_list, ($max_hash->{total} && $max_hash->{total} ne 'n/a') ? $max_hash->{score} / $max_hash->{total} : 0); push(@augmentedUserRecords, $max_hash); - # if there were no set versions and the set was assigned - # to the user, also keep the data + # if there were no set versions and the set was assigned + # to the user, also keep the data } elsif (!@allSetVersionNames && !$notAssignedSet) { my $dataH = { user_id => $studentRecord->user_id(), @@ -545,7 +545,7 @@ sub displaySets { push(@score_list, 0); push(@augmentedUserRecords, $dataH); } - } # this closes the loop through all student records + } # this closes the loop through all student records debug("end mainloop"); @augmentedUserRecords = sort { @@ -559,8 +559,8 @@ sub displaySets { # construct header my @list_problems = map { $_->[1] } $db->listGlobalProblemsWhere({ set_id => $setName }, 'problem_id'); - @list_problems = ($r->maketext('None')) unless (@list_problems); - my $maxProblem = scalar @list_problems; + @list_problems = ($r->maketext('None')) unless (@list_problems); + my $maxProblem = scalar @list_problems; # for a jitar set we only get the top level problems if ($GlobalSet->assignment_type eq 'jitar') { @@ -697,14 +697,14 @@ sub displaySets { print CGI::p( $r->maketext('Entries are sorted by [_1]', $display_sort_method_name{$primary_sort_method_name}) . ( - defined $secondary_sort_method_name - ? $r->maketext(', then by [_1]', $display_sort_method_name{$secondary_sort_method_name}) - : '' + defined $secondary_sort_method_name + ? $r->maketext(', then by [_1]', $display_sort_method_name{$secondary_sort_method_name}) + : '' ) . ( - defined $ternary_sort_method_name - ? $r->maketext(', then by [_1]', $display_sort_method_name{$ternary_sort_method_name}) - : '' + defined $ternary_sort_method_name + ? $r->maketext(', then by [_1]', $display_sort_method_name{$ternary_sort_method_name}) + : '' ) . '.' ); @@ -849,8 +849,8 @@ sub displaySets { # (the total number of columns is two more than this; we want the # number that missing record information should span) my $numCol = 1; - $numCol++ if $showColumns{'date'}; - $numCol++ if $showColumns{'testtime'}; + $numCol++ if $showColumns{'date'}; + $numCol++ if $showColumns{'testtime'}; $numCol += $maxProblem if $showColumns{'problems'}; # Loop that prints the table rows diff --git a/lib/WeBWorK/ContentGenerator/Instructor/UserDetail.pm b/lib/WeBWorK/ContentGenerator/Instructor/UserDetail.pm index e9598238c7..b98200254c 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/UserDetail.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/UserDetail.pm @@ -30,19 +30,21 @@ use WeBWorK::Utils qw(sortByName x getAssetURL format_set_name_display); use WeBWorK::Debug; # We use the x function to mark strings for localizaton -use constant DATE_FIELDS => { open_date => x("Open:"), - reduced_scoring_date => x("Reduced:"), - due_date => x("Closes:"), - answer_date => x("Answer:") +use constant DATE_FIELDS => { + open_date => x("Open:"), + reduced_scoring_date => x("Reduced:"), + due_date => x("Closes:"), + answer_date => x("Answer:") }; -use constant DATE_FIELDS_ORDER =>[qw(open_date reduced_scoring_date due_date answer_date )]; +use constant DATE_FIELDS_ORDER => [qw(open_date reduced_scoring_date due_date answer_date )]; + sub initialize { - my ($self) = @_; - my $r = $self->r; - my $urlpath = $r->urlpath; - my $db = $r->db; - my $authz = $r->authz; - my $userID = $r->param("user"); + my ($self) = @_; + my $r = $self->r; + my $urlpath = $r->urlpath; + my $db = $r->db; + my $authz = $r->authz; + my $userID = $r->param("user"); my $editForUserID = $urlpath->arg("userID"); return CGI::div({ class => 'alert alert-danger p-1 mb-0' }, @@ -53,19 +55,19 @@ sub initialize { $self->{setRecords} = [ $db->getGlobalSetsWhere({}, 'set_id') ]; # first check to see if a save form has been submitted - return '' unless ($r->param('save_button') || - $r->param('assignAll')); + return '' unless ($r->param('save_button') + || $r->param('assignAll')); # As it stands we need to check each set to see if it is still assigned # the forms are not currently set up to simply transmit changes my @assignedSets = (); foreach my $set (@{ $self->{setRecords} }) { - # add sets to the assigned list if the parameter is checked or the - # assign all button is pushed. (already assigned sets will be - # skipped later) + # add sets to the assigned list if the parameter is checked or the + # assign all button is pushed. (already assigned sets will be + # skipped later) my $setID = $set->set_id; - push @assignedSets, $setID if defined($r->param("set.$setID.assignment")); + push @assignedSets, $setID if defined($r->param("set.$setID.assignment")); } # note: assignedSets are those sets that are assigned in the submitted form @@ -74,10 +76,10 @@ sub initialize { my %selectedSets = map { $_ => 1 } @assignedSets; #debug ########################## - #print STDERR ("aSsigned sets", join(" ",@assignedSets)); - #my @params = $r->param(); - #print STDERR " parameters ", join(" ", @params); - ############### + #print STDERR ("aSsigned sets", join(" ",@assignedSets)); + #my @params = $r->param(); + #print STDERR " parameters ", join(" ", @params); + ############### #Get the user(s) whose records are to be modified # for now: $editForUserID @@ -89,7 +91,7 @@ sub initialize { my %userSets = map { $_ => 1 } $db->listUserSets($editForUserID); # Go through each possible set - debug(" parameters ", join(" ", $r->param()) ); + debug(" parameters ", join(" ", $r->param())); for my $setRecord (@{ $self->{setRecords} }) { my $setID = $setRecord->set_id; # Does the user want this set to be assigned to the selected user? @@ -120,7 +122,7 @@ sub initialize { my @setVer = $db->getSetVersionsWhere({ user_id => $editForUserID, set_id => { like => "$setID,v\%" } }); for my $setVersionRecord (@setVer) { - my $ver = $setVersionRecord->version_id; + my $ver = $setVersionRecord->version_id; my $action = $r->param("set.$setID,v$ver.assignment"); if (defined $action) { if ($action eq 'assigned') { @@ -170,12 +172,12 @@ sub body { return CGI::div({ class => 'alert alert-danger p-1' }, "You are not authorized to edit user specific information.") unless $authz->hasPermissions($userID, "access_instructor_tools"); - my $UserRecord = $db->getUser($editForUserID); + my $UserRecord = $db->getUser($editForUserID); my $userName = $UserRecord->first_name . " " . $UserRecord->last_name; # create a message about how many sets have been assigned to this user - my $setCount = $db->countUserSets($editForUserID); + my $setCount = $db->countUserSets($editForUserID); my $basicInfoPage = $urlpath->new( type => 'instructor_user_list', args => { @@ -327,24 +329,27 @@ sub outputSetRow { labelattributes => { class => 'form-check-label' } }), defined $mergedSet - ? CGI::b({ dir => 'ltr' }, CGI::a( - { - href => $self->systemLink( - $urlpath->new( - type => 'instructor_set_detail', - args => { - courseID => $courseID, - setID => $setID . ($version ? ",v$version" : '') + ? CGI::b( + { dir => 'ltr' }, + CGI::a( + { + href => $self->systemLink( + $urlpath->new( + type => 'instructor_set_detail', + args => { + courseID => $courseID, + setID => $setID . ($version ? ",v$version" : '') + } + ), + params => { + effectiveUser => $editForUserID, + editForUser => $editForUserID, } - ), - params => { - effectiveUser => $editForUserID, - editForUser => $editForUserID, - } - ) - }, - format_set_name_display($version ? "$setID (version $version)" : $setID) - )) + ) + }, + format_set_name_display($version ? "$setID (version $version)" : $setID) + ) + ) . ($version ? CGI::hidden({ name => "set.$setID,v$version.assignment", value => 'delete' }) : '') : CGI::b({ dir => 'ltr' }, format_set_name_display($setID)), join '', diff --git a/lib/WeBWorK/ContentGenerator/Instructor/UserList.pm b/lib/WeBWorK/ContentGenerator/Instructor/UserList.pm index aafa297adb..3abb1de98c 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/UserList.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/UserList.pm @@ -73,9 +73,9 @@ use WeBWorK::File::Classlist; use WeBWorK::DB qw(check_user_id); use WeBWorK::Utils qw(readFile readDirectory cryptPassword x getAssetURL); use constant HIDE_USERS_THRESHHOLD => 200; -use constant EDIT_FORMS => [qw(saveEdit cancelEdit)]; -use constant PASSWORD_FORMS => [qw(savePassword cancelPassword)]; -use constant VIEW_FORMS => [qw(filter sort edit password import export add delete)]; +use constant EDIT_FORMS => [qw(saveEdit cancelEdit)]; +use constant PASSWORD_FORMS => [qw(savePassword cancelPassword)]; +use constant VIEW_FORMS => [qw(filter sort edit password import export add delete)]; # Prepare the tab titles for translation by maketext use constant FORM_TITLES => { @@ -89,29 +89,31 @@ use constant FORM_TITLES => { export => x("Export"), add => x("Add"), delete => x("Delete"), - savePassword => x("Save Password"), - cancelPassword => x("Cancel Password") + savePassword => x("Save Password"), + cancelPassword => x("Cancel Password") }; # permissions needed to perform a given action use constant FORM_PERMS => { - saveEdit => "modify_student_data", - edit => "modify_student_data", - savePassword => "change_password", - password => "change_password", - import => "modify_student_data", - export => "modify_classlist_files", - add => "modify_student_data", - delete => "modify_student_data", + saveEdit => "modify_student_data", + edit => "modify_student_data", + savePassword => "change_password", + password => "change_password", + import => "modify_student_data", + export => "modify_classlist_files", + add => "modify_student_data", + delete => "modify_student_data", }; # permissions needed to view a given field use constant FIELD_PERMS => { - act_as => "become_student", - sets => "assign_problem_sets", + act_as => "become_student", + sets => "assign_problem_sets", }; -use constant STATE_PARAMS => [qw(user effectiveUser key visible_users no_visible_users prev_visible_users no_prev_visible_users editMode passwordMode primarySortField secondarySortField ternarySortField labelSortMethod)]; +use constant STATE_PARAMS => [ + qw(user effectiveUser key visible_users no_visible_users prev_visible_users no_prev_visible_users editMode passwordMode primarySortField secondarySortField ternarySortField labelSortMethod) +]; use constant SORT_SUBS => { user_id => \&byUserID, @@ -126,89 +128,90 @@ use constant SORT_SUBS => { permission => \&byPermission, }; -use constant FIELD_PROPERTIES => { +use constant FIELD_PROPERTIES => { user_id => { - type => "text", - size => 8, + type => "text", + size => 8, access => "readonly", }, first_name => { - type => "text", - size => 10, + type => "text", + size => 10, access => "readwrite", }, last_name => { - type => "text", - size => 10, + type => "text", + size => 10, access => "readwrite", }, email_address => { - type => "text", - size => 20, + type => "text", + size => 20, access => "readwrite", }, student_id => { - type => "text", - size => 11, + type => "text", + size => 11, access => "readwrite", }, status => { - type => "status", - size => 4, + type => "status", + size => 4, access => "readwrite", }, section => { - type => "text", - size => 3, + type => "text", + size => 3, access => "readwrite", }, recitation => { - type => "text", - size => 3, + type => "text", + size => 3, access => "readwrite", }, comment => { - type => "text", - size => 20, + type => "text", + size => 20, access => "readwrite", }, permission => { -# this really should be read from $r->ce, but that's not available here - type => "permission", + # this really should be read from $r->ce, but that's not available here + type => "permission", access => "readwrite", - size => 4, -# type => "number", -# size => 2, -# access => "readwrite", + size => 4, + # type => "number", + # size => 2, + # access => "readwrite", }, displayMode => { - access => 'hidden', + access => 'hidden', }, showOldAnswers => { - access => 'hidden', + access => 'hidden', }, useMathView => { - access => 'hidden', - }, - - useWirisEditor => { - access => 'hidden', - }, - useMathQuill => { - access => 'hidden', - }, - lis_source_did => { - access => 'hidden', + access => 'hidden', + }, + + useWirisEditor => { + access => 'hidden', + }, + useMathQuill => { + access => 'hidden', + }, + lis_source_did => { + access => 'hidden', }, }; + sub pre_header_initialize { - my $self = shift; - my $r = $self->r; - my $urlpath = $r->urlpath; - my $authz = $r->authz; - my $ce = $r->ce; - my $courseName = $urlpath->arg("courseID"); - my $user = $r->param('user'); + my $self = shift; + my $r = $self->r; + my $urlpath = $r->urlpath; + my $authz = $r->authz; + my $ce = $r->ce; + my $courseName = $urlpath->arg("courseID"); + my $user = $r->param('user'); # Handle redirects, if any. ############################## # Redirect to the addUser page @@ -219,15 +222,16 @@ sub pre_header_initialize { defined($r->param('action')) && $r->param('action') eq 'add' && do { # fix url and redirect - my $root = $ce->{webworkURLs}->{root}; + my $root = $ce->{webworkURLs}->{root}; - my $numberOfStudents = $r->param('number_of_students'); + my $numberOfStudents = $r->param('number_of_students'); warn $r->maketext("number of students not defined") unless defined $numberOfStudents; - my $uri=$self->systemLink( $urlpath->newFromModule('WeBWorK::ContentGenerator::Instructor::AddUsers', $r, courseID=>$courseName), - params=>{ - number_of_students=>$numberOfStudents, - } + my $uri = $self->systemLink( + $urlpath->newFromModule('WeBWorK::ContentGenerator::Instructor::AddUsers', $r, courseID => $courseName), + params => { + number_of_students => $numberOfStudents, + } ); #FIXME does the display mode need to be defined? #FIXME url_authen_args also includes an effective user, so the new one must come first. @@ -251,15 +255,15 @@ sub initialize { } sub body { - my ($self) = @_; - my $r = $self->r; - my $urlpath = $r->urlpath; - my $db = $r->db; - my $ce = $r->ce; - my $authz = $r->authz; - my $courseName = $urlpath->arg("courseID"); - my $setID = $urlpath->arg("setID"); - my $user = $r->param('user'); + my ($self) = @_; + my $r = $self->r; + my $urlpath = $r->urlpath; + my $db = $r->db; + my $ce = $r->ce; + my $authz = $r->authz; + my $courseName = $urlpath->arg("courseID"); + my $setID = $urlpath->arg("setID"); + my $user = $r->param('user'); my $root = $ce->{webworkURLs}->{root}; @@ -276,7 +280,7 @@ sub body { $userTemplate->FIELDS(), $permissionLevelTemplate->FIELDS(); - @prettyFieldNames{qw( + @prettyFieldNames{ qw( user_id first_name last_name @@ -287,17 +291,12 @@ sub body { recitation comment permission - )} = ( - $r->maketext("Login Name"), - $r->maketext("First Name"), - $r->maketext("Last Name"), - $r->maketext("Email Address"), - $r->maketext("Student ID"), - $r->maketext("Status"), - $r->maketext("Section"), - $r->maketext("Recitation"), - $r->maketext("Comment"), - $r->maketext("Permission Level") + ) } = ( + $r->maketext("Login Name"), $r->maketext("First Name"), + $r->maketext("Last Name"), $r->maketext("Email Address"), + $r->maketext("Student ID"), $r->maketext("Status"), + $r->maketext("Section"), $r->maketext("Recitation"), + $r->maketext("Comment"), $r->maketext("Permission Level") ); $self->{prettyFieldNames} = \%prettyFieldNames; @@ -338,7 +337,6 @@ sub body { $r->maketext("You are not authorized to modify student data")) if $self->{editMode} and not $authz->hasPermissions($user, "modify_student_data"); - $self->{passwordMode} = $r->param("passwordMode") || 0; return CGI::div({ class => 'alert alert-danger p-1' }, @@ -346,14 +344,13 @@ sub body { if $self->{passwordMode} and not $authz->hasPermissions($user, "modify_student_data"); if (defined $r->param("labelSortMethod")) { - $self->{primarySortField} = $r->param("labelSortMethod"); + $self->{primarySortField} = $r->param("labelSortMethod"); $self->{secondarySortField} = $r->param("primarySortField"); - $self->{ternarySortField} = $r->param("secondarySortField"); - } - else { - $self->{primarySortField} = $r->param("primarySortField") || "last_name"; + $self->{ternarySortField} = $r->param("secondarySortField"); + } else { + $self->{primarySortField} = $r->param("primarySortField") || "last_name"; $self->{secondarySortField} = $r->param("secondarySortField") || "first_name"; - $self->{ternarySortField} = $r->param("ternarySortField") || "student_id"; + $self->{ternarySortField} = $r->param("ternarySortField") || "student_id"; } my (%sections, %recitations); @@ -368,7 +365,7 @@ sub body { my $actionID = $r->param("action"); if ($actionID) { - unless (grep { $_ eq $actionID } @{ VIEW_FORMS() }, @{ EDIT_FORMS() }, @{ PASSWORD_FORMS() } ) { + unless (grep { $_ eq $actionID } @{ VIEW_FORMS() }, @{ EDIT_FORMS() }, @{ PASSWORD_FORMS() }) { die $r->maketext("Action [_1] not found", $actionID); } # Check permissions @@ -379,7 +376,7 @@ sub body { $genericParams{$param} = [ $r->param($param) ]; } my %actionParams = $self->getActionParams($actionID); - my %tableParams = $self->getTableParams(); + my %tableParams = $self->getTableParams(); print CGI::p( CGI::div( { class => 'alert alert-success p-1' }, @@ -397,49 +394,37 @@ sub body { } # Retrieve values for member fields - my $editMode = $self->{editMode}; - my $passwordMode = $self->{passwordMode}; - my $primarySortField = $self->{primarySortField}; + my $editMode = $self->{editMode}; + my $passwordMode = $self->{passwordMode}; + my $primarySortField = $self->{primarySortField}; my $secondarySortField = $self->{secondarySortField}; - my $ternarySortField = $self->{ternarySortField}; + my $ternarySortField = $self->{ternarySortField}; # Get requested users my @Users = @{ $self->{visibleUserIDs} } ? $db->getUsers(@{ $self->{visibleUserIDs} }) : (); - my %sortSubs = %{ SORT_SUBS() }; - my $primarySortSub = $sortSubs{$primarySortField}; + my %sortSubs = %{ SORT_SUBS() }; + my $primarySortSub = $sortSubs{$primarySortField}; my $secondarySortSub = $sortSubs{$secondarySortField}; - my $ternarySortSub = $sortSubs{$ternarySortField}; + my $ternarySortSub = $sortSubs{$ternarySortField}; # add permission level to user record hash so we can sort it if necessary if ($primarySortField eq 'permission' or $secondarySortField eq 'permission' or $ternarySortField eq 'permission') { foreach my $User (@Users) { next unless $User; my $permissionLevel = $db->getPermissionLevel($User->user_id); - $User->{permission} = $permissionLevel->permission; + $User->{permission} = $permissionLevel->permission; } } - # # don't forget to sort in opposite order of importance # @Users = sort $secondarySortSub @Users; # @Users = sort $primarySortSub @Users; # #@Users = sort byLnFnUid @Users; # Always have a definite sort order even if first three sorts don't determine things - @Users = sort { - &$primarySortSub - || - &$secondarySortSub - || - &$ternarySortSub - || - byLastName - || - byFirstName - || - byUserID - } + @Users = + sort { &$primarySortSub || &$secondarySortSub || &$ternarySortSub || byLastName || byFirstName || byUserID } @Users; my @PermissionLevels; @@ -448,7 +433,7 @@ sub body { my $User = $Users[$i]; # FIXME utf8, utf8mb4 debugging codes # warn "UserList: user name, ".$User->first_name." ".$User->last_name."\n"; - my $PermissionLevel = $db->getPermissionLevel($User->user_id); # checked + my $PermissionLevel = $db->getPermissionLevel($User->user_id); # checked # DBFIXME this should go in the DB layer unless ($PermissionLevel) { @@ -521,24 +506,24 @@ sub body { print CGI::hidden(-name => "no_prev_visible_users", -value => "1"); } - print CGI::hidden(-name=>"editMode", -value=>$editMode); + print CGI::hidden(-name => "editMode", -value => $editMode); - print CGI::hidden(-name=>"passwordMode", -value=>$passwordMode); + print CGI::hidden(-name => "passwordMode", -value => $passwordMode); - print CGI::hidden(-name=>"primarySortField", -value=>$primarySortField); - print CGI::hidden(-name=>"secondarySortField", -value=>$secondarySortField); - print CGI::hidden(-name=>"ternarySortField", -value=>$ternarySortField); + print CGI::hidden(-name => "primarySortField", -value => $primarySortField); + print CGI::hidden(-name => "secondarySortField", -value => $secondarySortField); + print CGI::hidden(-name => "ternarySortField", -value => $ternarySortField); print "\n\n"; ########## print action forms - print CGI::p($r->maketext("Select an action to perform").":"); + print CGI::p($r->maketext("Select an action to perform") . ":"); my @formsToShow; if ($editMode) { @formsToShow = @{ EDIT_FORMS() }; - }elsif ($passwordMode) { + } elsif ($passwordMode) { @formsToShow = @{ PASSWORD_FORMS() }; } else { @formsToShow = @{ VIEW_FORMS() }; @@ -582,9 +567,9 @@ sub body { @contentArr, CGI::div( { - class => 'tab-pane fade mb-2' . ($active ? " show$active" : ''), - id => $actionID, - role => 'tabpanel', + class => 'tab-pane fade mb-2' . ($active ? " show$active" : ''), + id => $actionID, + role => 'tabpanel', aria_labelledby => "$actionID-tab" }, $self->$actionForm($self->getActionParams($actionID)) @@ -609,23 +594,28 @@ sub body { print CGI::p($r->maketext("Showing [_1] out of [_2] users", scalar @Users, scalar @{ $self->{allUserIDs} })); - print CGI::p($r->maketext("If a password field is left blank, the student's current password will be maintained.")) if $passwordMode; + print CGI::p($r->maketext("If a password field is left blank, the student's current password will be maintained.")) + if $passwordMode; if ($editMode) { - print CGI::p($r->maketext('Click on the login name to edit individual problem set data, (e.g. due dates) for these students.')); + print CGI::p( + $r->maketext( + 'Click on the login name to edit individual problem set data, (e.g. due dates) for these students.') + ); } - $self->printTableHTML(\@Users, \@PermissionLevels, \%prettyFieldNames, - editMode => $editMode, - passwordMode => $passwordMode, - selectedUserIDs => $self->{selectedUserIDs}, - primarySortField => $primarySortField, + $self->printTableHTML( + \@Users, \@PermissionLevels, \%prettyFieldNames, + editMode => $editMode, + passwordMode => $passwordMode, + selectedUserIDs => $self->{selectedUserIDs}, + primarySortField => $primarySortField, secondarySortField => $secondarySortField, - visableUserIDs => $self->{visibleUserIDs}, + visableUserIDs => $self->{visibleUserIDs}, ); ########## print end of form - print CGI::end_form(); + print CGI::end_form(); return ""; } @@ -752,7 +742,7 @@ sub filter_form { sub filter_handler { my ($self, $genericParams, $actionParams, $tableParams) = @_; - my $r = $self->r; + my $r = $self->r; my $db = $r->db; my $ce = $r->ce; @@ -767,21 +757,21 @@ sub filter_handler { $self->{visibleUserIDs} = []; } elsif ($scope eq "selected") { $result = $r->maketext("showing selected users"); - $self->{visibleUserIDs} = $genericParams->{selected_users}; # an arrayref + $self->{visibleUserIDs} = $genericParams->{selected_users}; # an arrayref } elsif ($scope eq "match_regex") { $result = $r->maketext("showing matching users"); - my $regex = $actionParams->{"action.filter.user_ids"}->[0]; - my $field = $actionParams->{"action.filter.field"}->[0]; + my $regex = $actionParams->{"action.filter.user_ids"}->[0]; + my $field = $actionParams->{"action.filter.field"}->[0]; my @userRecords = $db->getUsersWhere({ user_id => { not_like => 'set_id:%' } }); my @userIDs; - my %permissionLabels = reverse %{$ce->{userRoles}}; + my %permissionLabels = reverse %{ $ce->{userRoles} }; for my $record (@userRecords) { # add permission level to user record hash so we can match it if necessary # also change permission level and status to their text # labels if ($field eq "permission") { my $permissionLevel = $db->getPermissionLevel($record->user_id); - $record->{permission} = $permissionLabels{$permissionLevel->permission}; + $record->{permission} = $permissionLabels{ $permissionLevel->permission }; } elsif ($field eq 'status') { $record->{status} = $ce->status_abbrev_to_name($record->{status}); } @@ -793,10 +783,10 @@ sub filter_handler { $self->{visibleUserIDs} = \@userIDs; } elsif ($scope eq "match_section") { my $section = $actionParams->{"action.filter.section"}->[0]; - $self->{visibleUserIDs} = $self->{sections}->{$section}; # an arrayref + $self->{visibleUserIDs} = $self->{sections}->{$section}; # an arrayref } elsif ($scope eq "match_recitation") { my $recitation = $actionParams->{"action.filter.recitation"}->[0]; - $self->{visibleUserIDs} = $self->{recitations}->{$recitation}; # an arrayref + $self->{visibleUserIDs} = $self->{recitations}->{$recitation}; # an arrayref } return $result; @@ -901,27 +891,28 @@ sub sort_handler { my ($self, $genericParams, $actionParams, $tableParams) = @_; my $r = $self->r; - my $primary = $actionParams->{"action.sort.primary"}->[0]; + my $primary = $actionParams->{"action.sort.primary"}->[0]; my $secondary = $actionParams->{"action.sort.secondary"}->[0]; - my $ternary = $actionParams->{"action.sort.ternary"}->[0]; + my $ternary = $actionParams->{"action.sort.ternary"}->[0]; - $self->{primarySortField} = $primary; + $self->{primarySortField} = $primary; $self->{secondarySortField} = $secondary; - $self->{ternarySortField} = $ternary; + $self->{ternarySortField} = $ternary; my %names = ( - user_id => $r->maketext("Login Name"), - first_name => $r->maketext("First Name"), - last_name => $r->maketext("Last Name"), - student_id => $r->maketext("Student ID"), - status => $r->maketext("Enrollment Status"), - section => $r->maketext("Section"), - recitation => $r->maketext("Recitation"), - comment => $r->maketext("Comment"), - permission => $r->maketext("Permission Level") + user_id => $r->maketext("Login Name"), + first_name => $r->maketext("First Name"), + last_name => $r->maketext("Last Name"), + student_id => $r->maketext("Student ID"), + status => $r->maketext("Enrollment Status"), + section => $r->maketext("Section"), + recitation => $r->maketext("Recitation"), + comment => $r->maketext("Comment"), + permission => $r->maketext("Permission Level") ); - return $r->maketext("Users sorted by [_1], then by [_2], then by [_3]", $names{$primary}, $names{$secondary}, $names{$ternary}); + return $r->maketext("Users sorted by [_1], then by [_2], then by [_3]", + $names{$primary}, $names{$secondary}, $names{$ternary}); } sub edit_form { @@ -967,14 +958,13 @@ sub edit_handler { # leave visibleUserIDs alone } elsif ($scope eq "selected") { $result = $r->maketext("editing selected users"); - $self->{visibleUserIDs} = $genericParams->{selected_users}; # an arrayref + $self->{visibleUserIDs} = $genericParams->{selected_users}; # an arrayref } $self->{editMode} = 1; return $result; } - sub password_form { my ($self, %actionParams) = @_; my $r = $self->r; @@ -988,7 +978,7 @@ sub password_form { CGI::div( { class => 'col-auto' }, CGI::popup_menu({ - id => 'password_select', + id => 'password_select', name => 'action.password.scope', values => [qw(all visible selected)], default => $actionParams{'action.password.scope'}[0] || 'selected', @@ -1018,7 +1008,7 @@ sub password_handler { # leave visibleUserIDs alone } elsif ($scope eq "selected") { $result = $r->maketext("giving new passwords to selected users"); - $self->{visibleUserIDs} = $genericParams->{selected_users}; # an arrayref + $self->{visibleUserIDs} = $genericParams->{selected_users}; # an arrayref } $self->{passwordMode} = 1; @@ -1060,9 +1050,9 @@ sub delete_form { sub delete_handler { my ($self, $genericParams, $actionParams, $tableParams) = @_; - my $r = $self->r; - my $db = $r->db; - my $user = $r->param('user'); + my $r = $self->r; + my $db = $r->db; + my $user = $r->param('user'); my $scope = $actionParams->{"action.delete.scope"}->[0]; my @userIDsToDelete = (); @@ -1070,14 +1060,14 @@ sub delete_handler { @userIDsToDelete = @{ $self->{selectedUserIDs} }; } - my %allUserIDs = map { $_ => 1 } @{ $self->{allUserIDs} }; - my %visibleUserIDs = map { $_ => 1 } @{ $self->{visibleUserIDs} }; + my %allUserIDs = map { $_ => 1 } @{ $self->{allUserIDs} }; + my %visibleUserIDs = map { $_ => 1 } @{ $self->{visibleUserIDs} }; my %selectedUserIDs = map { $_ => 1 } @{ $self->{selectedUserIDs} }; my $error = ""; - my $num = 0; + my $num = 0; foreach my $userID (@userIDsToDelete) { - if ($user eq $userID) { # don't delete yourself!! + if ($user eq $userID) { # don't delete yourself!! $error = $r->maketext("You cannot delete yourself!"); next; } @@ -1088,8 +1078,8 @@ sub delete_handler { $num++; } - $self->{allUserIDs} = [ keys %allUserIDs ]; - $self->{visibleUserIDs} = [ keys %visibleUserIDs ]; + $self->{allUserIDs} = [ keys %allUserIDs ]; + $self->{visibleUserIDs} = [ keys %visibleUserIDs ]; $self->{selectedUserIDs} = [ keys %selectedUserIDs ]; return $r->maketext("Deleted [_1] users.", $num) . ($error ? " $error" : ''); @@ -1199,11 +1189,11 @@ sub import_handler { my ($self, $genericParams, $actionParams, $tableParams) = @_; my $r = $self->r; - my $source = $actionParams->{"action.import.source"}->[0]; - my $add = $actionParams->{"action.import.add"}->[0]; + my $source = $actionParams->{"action.import.source"}->[0]; + my $add = $actionParams->{"action.import.add"}->[0]; my $replace = $actionParams->{"action.import.replace"}->[0]; - my $fileName = $source; + my $fileName = $source; my $createNew = $add eq "any"; my $replaceExisting; my @replaceList; @@ -1213,24 +1203,24 @@ sub import_handler { $replaceExisting = "none"; } elsif ($replace eq "visible") { $replaceExisting = "listed"; - @replaceList = @{ $self->{visibleUserIDs} }; + @replaceList = @{ $self->{visibleUserIDs} }; } elsif ($replace eq "selected") { $replaceExisting = "listed"; - @replaceList = @{ $self->{selectedUserIDs} }; + @replaceList = @{ $self->{selectedUserIDs} }; } - my ($replaced, $added, $skipped) - = $self->importUsersFromCSV($fileName, $createNew, $replaceExisting, @replaceList); + my ($replaced, $added, $skipped) = $self->importUsersFromCSV($fileName, $createNew, $replaceExisting, @replaceList); # make new users visible... do we really want to do this? probably. push @{ $self->{visibleUserIDs} }, @$added; - push @{ $self->{allUserIDs} }, @$added; + push @{ $self->{allUserIDs} }, @$added; my $numReplaced = @$replaced; - my $numAdded = @$added; - my $numSkipped = @$skipped; + my $numAdded = @$added; + my $numSkipped = @$skipped; - return $r->maketext("[_1] users replaced, [_2] users added, [_3] users skipped. Skipped users: ([_4])", $numReplaced, $numAdded, $numSkipped, join (", ", @$skipped)); + return $r->maketext("[_1] users replaced, [_2] users added, [_3] users skipped. Skipped users: ([_4])", + $numReplaced, $numAdded, $numSkipped, join(", ", @$skipped)); } sub export_form { @@ -1304,13 +1294,13 @@ sub export_form { sub export_handler { my ($self, $genericParams, $actionParams, $tableParams) = @_; - my $r = $self->r; - my $ce = $r->ce; - my $dir = $ce->{courseDirs}->{templates}; + my $r = $self->r; + my $ce = $r->ce; + my $dir = $ce->{courseDirs}->{templates}; - my $scope = $actionParams->{"action.export.scope"}->[0]; + my $scope = $actionParams->{"action.export.scope"}->[0]; my $target = $actionParams->{"action.export.target"}->[0]; - my $new = $actionParams->{"action.export.new"}->[0]; + my $new = $actionParams->{"action.export.new"}->[0]; #get name of templates directory as it appears in file manager $dir =~ s|.*/||; @@ -1346,10 +1336,10 @@ sub cancelEdit_form { sub cancelEdit_handler { my ($self, $genericParams, $actionParams, $tableParams) = @_; - my $r = $self->r; + my $r = $self->r; #$self->{selectedUserIDs} = $self->{visibleUserIDs}; - # only do the above if we arrived here via "edit selected users" + # only do the above if we arrived here via "edit selected users" if (defined $r->param("prev_visible_users")) { $self->{visibleUserIDs} = [ $r->param("prev_visible_users") ]; } elsif (defined $r->param("no_prev_visible_users")) { @@ -1370,16 +1360,16 @@ sub saveEdit_form { sub saveEdit_handler { my ($self, $genericParams, $actionParams, $tableParams) = @_; - my $r = $self->r; - my $db = $r->db; - my $editorUser = $r->param('user'); + my $r = $self->r; + my $db = $r->db; + my $editorUser = $r->param('user'); my $editorUserPermission = $db->getPermissionLevel($editorUser)->permission; my @visibleUserIDs = @{ $self->{visibleUserIDs} }; foreach my $userID (@visibleUserIDs) { - my $User = $db->getUser($userID); # checked + my $User = $db->getUser($userID); # checked die $r->maketext("record for visible user [_1] not found", $userID) unless $User; - my $PermissionLevel = $db->getPermissionLevel($userID); # checked + my $PermissionLevel = $db->getPermissionLevel($userID); # checked die $r->maketext("permissions for [_1] not defined", $userID) unless defined $PermissionLevel; foreach my $field ($User->NONKEYFIELDS()) { my $param = "user.${userID}.${field}"; @@ -1390,8 +1380,9 @@ sub saveEdit_handler { foreach my $field ($PermissionLevel->NONKEYFIELDS()) { my $param = "permission.${userID}.${field}"; - if (defined $tableParams->{$param}->[0] && - $tableParams->{$param}->[0] <= $editorUserPermission) { + if (defined $tableParams->{$param}->[0] + && $tableParams->{$param}->[0] <= $editorUserPermission) + { $PermissionLevel->$field($tableParams->{$param}->[0]); } } @@ -1421,10 +1412,10 @@ sub cancelPassword_form { sub cancelPassword_handler { my ($self, $genericParams, $actionParams, $tableParams) = @_; - my $r = $self->r; + my $r = $self->r; #$self->{selectedUserIDs} = $self->{visibleUserIDs}; - # only do the above if we arrived here via "edit selected users" + # only do the above if we arrived here via "edit selected users" if (defined $r->param("prev_visible_users")) { $self->{visibleUserIDs} = [ $r->param("prev_visible_users") ]; } elsif (defined $r->param("no_prev_visible_users")) { @@ -1445,17 +1436,17 @@ sub savePassword_form { sub savePassword_handler { my ($self, $genericParams, $actionParams, $tableParams) = @_; - my $r = $self->r; - my $db = $r->db; + my $r = $self->r; + my $db = $r->db; my @visibleUserIDs = @{ $self->{visibleUserIDs} }; foreach my $userID (@visibleUserIDs) { - my $User = $db->getUser($userID); # checked + my $User = $db->getUser($userID); # checked die $r->maketext("record for visible user [_1] not found", $userID) unless $User; my $param = "user.${userID}.new_password"; if ((defined $tableParams->{$param}->[0]) and ($tableParams->{$param}->[0])) { - my $newP = $tableParams->{$param}->[0]; - my $Password = eval {$db->getPassword($User->user_id)}; # checked + my $newP = $tableParams->{$param}->[0]; + my $Password = eval { $db->getPassword($User->user_id) }; # checked my $cryptPassword = cryptPassword($newP); if (!defined($Password)) { $Password = $db->newPassword(); @@ -1482,21 +1473,23 @@ sub savePassword_handler { return $r->maketext("New passwords saved"); } - ################################################################################ # sorts ################################################################################ -sub byUserID { lc $a->user_id cmp lc $b->user_id } -sub byFirstName { (defined $a->first_name && defined $b->first_name) ? lc $a->first_name cmp lc $b->first_name : 0; } -sub byLastName { (defined $a->last_name && defined $b->last_name ) ? lc $a->last_name cmp lc $b->last_name : 0; } +sub byUserID { lc $a->user_id cmp lc $b->user_id } +sub byFirstName { (defined $a->first_name && defined $b->first_name) ? lc $a->first_name cmp lc $b->first_name : 0; } +sub byLastName { (defined $a->last_name && defined $b->last_name) ? lc $a->last_name cmp lc $b->last_name : 0; } sub byEmailAddress { lc $a->email_address cmp lc $b->email_address } -sub byStudentID { lc $a->student_id cmp lc $b->student_id } -sub byStatus { lc $a->status cmp lc $b->status } -sub bySection { lc $a->section cmp lc $b->section } -sub byRecitation { lc $a->recitation cmp lc $b->recitation } -sub byComment { lc $a->comment cmp lc $b->comment } -sub byPermission { $a->{permission} <=> $b->{permission} } ## permission level is added to user record hash so we can sort it if necessary +sub byStudentID { lc $a->student_id cmp lc $b->student_id } +sub byStatus { lc $a->status cmp lc $b->status } +sub bySection { lc $a->section cmp lc $b->section } +sub byRecitation { lc $a->recitation cmp lc $b->recitation } +sub byComment { lc $a->comment cmp lc $b->comment } + +sub byPermission { + $a->{permission} <=> $b->{permission}; +} ## permission level is added to user record hash so we can sort it if necessary # sub byLnFnUid { &byLastName || &byFirstName || &byUserID } @@ -1511,7 +1504,7 @@ sub menuLabels { my %result; foreach my $key (keys %hash) { - my $count = @{ $hash{$key} }; + my $count = @{ $hash{$key} }; my $displayKey = $key || ""; $result{$key} = "$displayKey ($count users)"; } @@ -1522,11 +1515,11 @@ sub menuLabels { # (we need a whole suite of higher-level import/export functions somewhere) sub importUsersFromCSV { my ($self, $fileName, $createNew, $replaceExisting, @replaceList) = @_; - my $r = $self->r; - my $ce = $r->ce; - my $db = $r->db; - my $dir = $ce->{courseDirs}->{templates}; - my $user = $r->param('user'); + my $r = $self->r; + my $ce = $r->ce; + my $db = $r->db; + my $dir = $ce->{courseDirs}->{templates}; + my $user = $r->param('user'); die $r->maketext("illegal character in input: '/'") if $fileName =~ m|/|; die $r->maketext("won't be able to read from file [_1]/[_2]: does it exist? is it readable?", $dir, $fileName) @@ -1553,14 +1546,14 @@ sub importUsersFromCSV { my $default_status_abbrev = $ce->{statuses}->{Enrolled}->{abbrevs}->[0]; foreach my $record (@classlist) { - my %record = %$record; + my %record = %$record; my $user_id = $record{user_id}; - unless (WeBWorK::DB::check_user_id($user_id) ) { # try to catch lines with bad characters + unless (WeBWorK::DB::check_user_id($user_id)) { # try to catch lines with bad characters push @skipped, $user_id; next; } - if ($user_id eq $user) { # don't replace yourself!! + if ($user_id eq $user) { # don't replace yourself!! push @skipped, $user_id; next; } @@ -1594,9 +1587,9 @@ sub importUsersFromCSV { $record{permission} = $default_permission_level unless defined $record{permission} and $record{permission} ne ""; - my $User = $db->newUser(%record); + my $User = $db->newUser(%record); my $PermissionLevel = $db->newPermissionLevel(user_id => $user_id, permission => $record{permission}); - my $Password = $db->newPassword(user_id => $user_id, password => $record{password}); + my $Password = $db->newPassword(user_id => $user_id, password => $record{password}); # DBFIXME use REPLACE if (exists $allUserIDs{$user_id}) { @@ -1618,26 +1611,26 @@ sub importUsersFromCSV { sub exportUsersToCSV { my ($self, $fileName, @userIDsToExport) = @_; - my $r = $self->r; - my $ce = $r->ce; - my $db = $r->db; - my $dir = $ce->{courseDirs}->{templates}; + my $r = $self->r; + my $ce = $r->ce; + my $db = $r->db; + my $dir = $ce->{courseDirs}->{templates}; die $r->maketext("illegal character in input: '/'") if $fileName =~ m|/|; my @records; - my @Users = $db->getUsers(@userIDsToExport); - my @Passwords = $db->getPasswords(@userIDsToExport); + my @Users = $db->getUsers(@userIDsToExport); + my @Passwords = $db->getPasswords(@userIDsToExport); my @PermissionLevels = $db->getPermissionLevels(@userIDsToExport); foreach my $i (0 .. $#userIDsToExport) { - my $User = $Users[$i]; - my $Password = $Passwords[$i]; + my $User = $Users[$i]; + my $Password = $Passwords[$i]; my $PermissionLevel = $PermissionLevels[$i]; next unless defined $User; my %record = ( defined $PermissionLevel ? $PermissionLevel->toHash : (), - defined $Password ? $Password->toHash : (), + defined $Password ? $Password->toHash : (), $User->toHash, ); push @records, \%record; @@ -1745,42 +1738,57 @@ sub fieldEditHTML { sub recordEditHTML { my ($self, $User, $PermissionLevel, %options) = @_; - my $r = $self->r; - my $urlpath = $r->urlpath; - my $db = $r->db; - my $ce = $r->ce; - my $authz = $r->authz; - my $user = $r->param('user'); - my $root = $ce->{webworkURLs}->{root}; - my $courseName = $urlpath->arg("courseID"); - - my $editMode = $options{editMode}; + my $r = $self->r; + my $urlpath = $r->urlpath; + my $db = $r->db; + my $ce = $r->ce; + my $authz = $r->authz; + my $user = $r->param('user'); + my $root = $ce->{webworkURLs}->{root}; + my $courseName = $urlpath->arg("courseID"); + + my $editMode = $options{editMode}; my $passwordMode = $options{passwordMode}; my $userSelected = $options{userSelected}; my $statusClass = $ce->status_abbrev_to_name($User->status); - my $sets = $db->countUserSets($User->user_id); + my $sets = $db->countUserSets($User->user_id); my $totalSets = $self->{totalSets}; - my $changeEUserURL = $self->systemLink($urlpath->new(type=>'set_list',args=>{courseID=>$courseName}), - params => {effectiveUser => $User->user_id} - ); + my $changeEUserURL = $self->systemLink($urlpath->new(type => 'set_list', args => { courseID => $courseName }), + params => { effectiveUser => $User->user_id }); - my $setsAssignedToUserURL = $self->systemLink($urlpath->new(type=>'instructor_user_detail', - args=>{courseID => $courseName, - userID => $User->user_id - }), - params => {effectiveUser => $User->user_id} + my $setsAssignedToUserURL = $self->systemLink( + $urlpath->new( + type => 'instructor_user_detail', + args => { + courseID => $courseName, + userID => $User->user_id + } + ), + params => { effectiveUser => $User->user_id } ); - my $userListURL = $self->systemLink($urlpath->new(type=>'instructor_user_list', args=>{courseID => $courseName} )) . "&editMode=1&visible_users=" . $User->user_id; + my $userListURL = + $self->systemLink($urlpath->new(type => 'instructor_user_list', args => { courseID => $courseName })) + . "&editMode=1&visible_users=" + . $User->user_id; my $imageLink = ''; if ($authz->hasPermissions($user, "modify_student_data")) { - $imageLink = CGI::a({href => $userListURL}, CGI::i({ class => 'icon fas fa-pencil-alt', - data_alt => "Link to Edit Page for " . $User->user_id, aria_hidden => "true" }, "")); + $imageLink = CGI::a( + { href => $userListURL }, + CGI::i( + { + class => 'icon fas fa-pencil-alt', + data_alt => "Link to Edit Page for " . $User->user_id, + aria_hidden => "true" + }, + "" + ) + ); } my @tableCells; @@ -1792,11 +1800,11 @@ sub recordEditHTML { # selection checkbox push @tableCells, CGI::input({ - type => 'checkbox', - id => $User->user_id . '_checkbox', - name => "selected_users", - value => $User->user_id, - class => "form-check-input", + type => 'checkbox', + id => $User->user_id . '_checkbox', + name => "selected_users", + value => $User->user_id, + class => "form-check-input", $userSelected ? (checked => undef) : (), }); @@ -1844,59 +1852,61 @@ sub recordEditHTML { } } # User ID (edit mode) or Assigned Sets (otherwise) - if ( $passwordMode) { + if ($passwordMode) { # straight user ID - push @tableCells, CGI::div({class=>$statusClass}, $User->user_id); + push @tableCells, CGI::div({ class => $statusClass }, $User->user_id); } elsif ($editMode) { # straight user ID - my $userDetailPage = $urlpath->new(type =>'instructor_user_detail', - args =>{ - courseID => $courseName, - userID => $User->user_id, #FIXME eventually this should be a list?? - } - ); - my $userDetailUrl = $self->systemLink($userDetailPage,params =>{}); - push @tableCells, CGI::a({href=>$userDetailUrl}, $User->user_id); + my $userDetailPage = $urlpath->new( + type => 'instructor_user_detail', + args => { + courseID => $courseName, + userID => $User->user_id, #FIXME eventually this should be a list?? + } + ); + my $userDetailUrl = $self->systemLink($userDetailPage, params => {}); + push @tableCells, CGI::a({ href => $userDetailUrl }, $User->user_id); } else { # "edit sets assigned to user" link #push @tableCells, CGI::a({href=>$setsAssignedToUserURL}, "Edit sets"); - if ( FIELD_PERMS()->{sets} and not $authz->hasPermissions($user, FIELD_PERMS()->{sets}) ) { + if (FIELD_PERMS()->{sets} and not $authz->hasPermissions($user, FIELD_PERMS()->{sets})) { push @tableCells, "$sets/$totalSets"; } else { - push @tableCells, CGI::a({href=>$setsAssignedToUserURL}, "$sets/$totalSets"); + push @tableCells, CGI::a({ href => $setsAssignedToUserURL }, "$sets/$totalSets"); } } # User Fields foreach my $field ($User->NONKEYFIELDS) { - my $fieldName = 'user.' . $User->user_id . '.' . $field, - my $fieldValue = $User->$field; + my $fieldName = 'user.' . $User->user_id . '.' . $field, my $fieldValue = $User->$field; # FIXME utf8, utf8mb4 debugging codes # warn "user values ".join(" ", $User->user_id,$User->first_name, $User->last_name)."\n"; # warn "variants". join(" ",$User->user_id, Encode::decode("UTF-8",$User->first_name), Encode::decode("UTF-8",$User->last_name))."\n"; # warn "is_utf8 flag, first_name, last_name ".join(" ", utf8::is_utf8($User->first_name)?1:0, utf8::is_utf8($User->last_name)?1:0 )."\n"; my %properties = %{ FIELD_PROPERTIES()->{$field} }; - next if $properties{access} eq 'hidden'; + next if $properties{access} eq 'hidden'; $properties{access} = 'readonly' unless $editMode; - $properties{type} = 'email' if ($field eq 'email_address' and !$editMode and !$passwordMode); - $fieldValue = $self->nbsp($fieldValue) unless $editMode; - push @tableCells, CGI::div({class=>$statusClass}, $self->fieldEditHTML($fieldName, $fieldValue, \%properties)); + $properties{type} = 'email' if ($field eq 'email_address' and !$editMode and !$passwordMode); + $fieldValue = $self->nbsp($fieldValue) unless $editMode; + push @tableCells, + CGI::div({ class => $statusClass }, $self->fieldEditHTML($fieldName, $fieldValue, \%properties)); } # PermissionLevel Fields foreach my $field ($PermissionLevel->NONKEYFIELDS) { my $fieldName = 'permission.' . $PermissionLevel->user_id . '.' . $field, - my $fieldValue = $PermissionLevel->$field; + my $fieldValue = $PermissionLevel->$field; # get name out of permission level - if ( $field eq 'permission' ) { - ($fieldValue) = grep { $ce->{userRoles}->{$_} eq $fieldValue } ( keys ( %{$ce->{userRoles}} ) ); - $fieldValue = $r->maketext($fieldValue) + if ($field eq 'permission') { + ($fieldValue) = grep { $ce->{userRoles}->{$_} eq $fieldValue } (keys(%{ $ce->{userRoles} })); + $fieldValue = $r->maketext($fieldValue); } my %properties = %{ FIELD_PROPERTIES()->{$field} }; - $properties{access} = 'readonly' unless $editMode; - $fieldValue = $self->nbsp($fieldValue) unless $editMode; - push @tableCells, CGI::div({class=>$statusClass}, $self->fieldEditHTML($fieldName, $fieldValue, \%properties)); + $properties{access} = 'readonly' unless $editMode; + $fieldValue = $self->nbsp($fieldValue) unless $editMode; + push @tableCells, + CGI::div({ class => $statusClass }, $self->fieldEditHTML($fieldName, $fieldValue, \%properties)); } return CGI::Tr(CGI::td(\@tableCells)); @@ -1905,27 +1915,24 @@ sub recordEditHTML { sub printTableHTML { my ($self, $UsersRef, $PermissionLevelsRef, $fieldNamesRef, %options) = @_; my $r = $self->r; - my $urlpath = $r->urlpath; - my $courseName = $urlpath->arg("courseID"); + my $urlpath = $r->urlpath; + my $courseName = $urlpath->arg("courseID"); my $userTemplate = $self->{userTemplate}; my $permissionLevelTemplate = $self->{permissionLevelTemplate}; my @Users = @$UsersRef; my @PermissionLevels = @$PermissionLevelsRef; my %fieldNames = %$fieldNamesRef; - my $editMode = $options{editMode}; - my $passwordMode = $options{passwordMode}; - my %selectedUserIDs = map { $_ => 1 } @{ $options{selectedUserIDs} }; - my $primarySortField = $options{primarySortField}; - my $secondarySortField = $options{secondarySortField}; - my @visableUserIDs = @{ $options{visableUserIDs} }; + my $editMode = $options{editMode}; + my $passwordMode = $options{passwordMode}; + my %selectedUserIDs = map { $_ => 1 } @{ $options{selectedUserIDs} }; + my $primarySortField = $options{primarySortField}; + my $secondarySortField = $options{secondarySortField}; + my @visableUserIDs = @{ $options{visableUserIDs} }; # names of headings: - my @realFieldNames = ( - $userTemplate->KEYFIELDS, - $userTemplate->NONKEYFIELDS, - $permissionLevelTemplate->NONKEYFIELDS, - ); + my @realFieldNames = + ($userTemplate->KEYFIELDS, $userTemplate->NONKEYFIELDS, $permissionLevelTemplate->NONKEYFIELDS,); my @tableHeadings; @@ -1940,22 +1947,22 @@ sub printTableHTML { my $visableUserIDsString = join ':', @visableUserIDs; if (length($visableUserIDsString) < 1830) { %current_state = ( - primarySortField => "$primarySortField", - secondarySortField => "$secondarySortField", + primarySortField => "$primarySortField", + secondarySortField => "$secondarySortField", visable_user_string => "$visableUserIDsString" ); } else { %current_state = ( - primarySortField => "$primarySortField", + primarySortField => "$primarySortField", secondarySortField => "$secondarySortField", - show_all_users => "1" + show_all_users => "1" ); } } else { %current_state = ( - primarySortField => "$primarySortField", + primarySortField => "$primarySortField", secondarySortField => "$secondarySortField", - no_visible_users => "1" + no_visible_users => "1" ); } @@ -2060,11 +2067,11 @@ sub printTableHTML { for my $field (@realFieldNames) { my %properties = %{ FIELD_PROPERTIES()->{$field} }; next if $properties{access} eq 'hidden'; - push @tableHeadings, CGI::th({ id => "${field}_header"}, $fieldNames{$field}); + push @tableHeadings, CGI::th({ id => "${field}_header" }, $fieldNames{$field}); } } - unshift(@tableHeadings, CGI::th({ id => "new_password_header"}, $r->maketext("New Password"))) if ($passwordMode); + unshift(@tableHeadings, CGI::th({ id => "new_password_header" }, $r->maketext("New Password"))) if ($passwordMode); # Print the table. print CGI::start_div({ class => 'table-responsive' }); @@ -2081,13 +2088,14 @@ sub printTableHTML { print CGI::start_tbody(); for (my $i = 0; $i < @Users; $i++) { - my $User = $Users[$i]; + my $User = $Users[$i]; my $PermissionLevel = $PermissionLevels[$i]; - print $self->recordEditHTML($User, $PermissionLevel, - editMode => $editMode, + print $self->recordEditHTML( + $User, $PermissionLevel, + editMode => $editMode, passwordMode => $passwordMode, - userSelected => exists $selectedUserIDs{$User->user_id} + userSelected => exists $selectedUserIDs{ $User->user_id } ); } print CGI::end_tbody(); @@ -2095,9 +2103,10 @@ sub printTableHTML { print CGI::end_table(), CGI::end_div(); # if there are no users shown print message - print CGI::p( - CGI::i($r->maketext("No students shown. Choose one of the options above to list the students in the course.")) - ) unless @Users; + print CGI::p(CGI::i( + $r->maketext("No students shown. Choose one of the options above to list the students in the course.") + )) + unless @Users; } # output_JS subroutine diff --git a/lib/WeBWorK/ContentGenerator/Instructor/UsersAssignedToSet.pm b/lib/WeBWorK/ContentGenerator/Instructor/UsersAssignedToSet.pm index 2457de320b..1a46bb93ca 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/UsersAssignedToSet.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/UsersAssignedToSet.pm @@ -227,8 +227,8 @@ sub body { { class => 'alert alert-danger p-1 mb-3' }, $r->maketext( 'There is NO undo for this function. Do not use it unless you know what you are doing! ' - . 'When you unassign a student using this button, or by unchecking their name, you destroy all ' - . "of the data for homework set [_1] for this student.", + . 'When you unassign a student using this button, or by unchecking their name, you destroy all ' + . "of the data for homework set [_1] for this student.", CGI::span({ dir => 'ltr' }, format_set_name_display($setID)) ) ), diff --git a/lib/WeBWorK/ContentGenerator/Login.pm b/lib/WeBWorK/ContentGenerator/Login.pm index c1e772c50b..89f1c50fa2 100644 --- a/lib/WeBWorK/ContentGenerator/Login.pm +++ b/lib/WeBWorK/ContentGenerator/Login.pm @@ -34,7 +34,7 @@ use Encode; # BUT one must return a 1 so that error messages can be displayed. sub if_loggedin { my ($self, $arg) = @_; -# return !$arg; + # return !$arg; return 1; } @@ -64,11 +64,11 @@ sub title { sub info { ######### NOTES ON TRANSLATION - # -translation of the content found in the info panel. Since most of this content is in fact read from files, a simple use of maketext would be too limited to translate these types of content efficiently. +# -translation of the content found in the info panel. Since most of this content is in fact read from files, a simple use of maketext would be too limited to translate these types of content efficiently. my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; + my $r = $self->r; + my $ce = $r->ce; my $result; # This section should be kept in sync with the Home.pm version @@ -108,7 +108,7 @@ sub info { } if (defined $result and $result ne "") { - return $result; + return $result; } else { return ""; } @@ -124,24 +124,24 @@ sub pre_header_initialize { my ($self) = @_; my $authen = $self->r->authen; - if ( defined($authen->{redirect}) && $authen->{redirect} ) { + if (defined($authen->{redirect}) && $authen->{redirect}) { $self->reply_with_redirect($authen->{redirect}); } } sub head { - my ($self) = @_; - my $ce = $self->r->ce; + my ($self) = @_; + my $ce = $self->r->ce; my $contents = $ce->{options}{metaRobotsContent} // 'none'; - print ''; - return ""; + print ''; + return ""; } sub body { - my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; - my $db = $r->db; + my ($self) = @_; + my $r = $self->r; + my $ce = $r->ce; + my $db = $r->db; my $urlpath = $r->urlpath; # get the authen object to make sure that we should print @@ -149,20 +149,22 @@ sub body { my $auth = $r->authen; # The following line may not work when a sequence of authentication modules - # are used, because the preferred module might be external, e.g., LTIBasic, - # but a non-external one, e.g., Basic_TheLastChance or - # even just WeBWorK::Authen, might handle the ongoing session management. - # So this should be set in the course environment when a sequence of + # are used, because the preferred module might be external, e.g., LTIBasic, + # but a non-external one, e.g., Basic_TheLastChance or + # even just WeBWorK::Authen, might handle the ongoing session management. + # So this should be set in the course environment when a sequence of # authentication modules is used.. #my $externalAuth = (defined($auth->{external_auth}) && $auth->{external_auth} ) ? 1 : 0; - my $externalAuth = ((defined($ce->{external_auth}) && $ce->{external_auth}) - or (defined($auth->{external_auth}) && $auth->{external_auth}) ) ? 1 : 0; + my $externalAuth = ( + (defined($ce->{external_auth}) && $ce->{external_auth}) + or (defined($auth->{external_auth}) && $auth->{external_auth}) + ) ? 1 : 0; # get some stuff together - my $user = $r->param("user") || ""; - my $key = $r->param("key"); - my $passwd = $r->param("passwd") || ""; - my $course = $urlpath->arg("courseID") =~ s/_/ /gr; + my $user = $r->param("user") || ""; + my $key = $r->param("key"); + my $passwd = $r->param("passwd") || ""; + my $course = $urlpath->arg("courseID") =~ s/_/ /gr; my $practiceUserPrefix = $ce->{practiceUserPrefix}; # don't fill in the user ID for practice users @@ -174,17 +176,21 @@ sub body { # us to yell at the user for doing that, since Authen isn't a content- # generating module. my $authen_error = $r->notes->get("authen_error"); - $authen_error = Encode::decode("UTF-8",$authen_error); + $authen_error = Encode::decode("UTF-8", $authen_error); if ($authen_error) { print CGI::div({ class => 'alert alert-danger', tabindex => '0' }, $authen_error); } - if ($externalAuth ) { - my $LMS = ($ce->{LMS_url}) ? CGI::a({ href => $ce->{LMS_url} },$ce->{LMS_name}) : $ce->{LMS_name}; + if ($externalAuth) { + my $LMS = ($ce->{LMS_url}) ? CGI::a({ href => $ce->{LMS_url} }, $ce->{LMS_name}) : $ce->{LMS_name}; if (!$authen_error || $r->authen() eq "WeBWorK::Authen::LTIBasic") { - print CGI::p($r->maketext('The course [_1] uses an external authentication system ([_2]). ' . - 'Please return to that system to access this course.', CGI::strong($course), $LMS)); + print CGI::p($r->maketext( + 'The course [_1] uses an external authentication system ([_2]). ' + . 'Please return to that system to access this course.', + CGI::strong($course), + $LMS + )); } else { print CGI::p($r->maketext( 'The course [_1] uses an external authentication system ([_2]). You\'ve authenticated through that ' @@ -267,7 +273,7 @@ sub body { next unless defined $GuestUser->status; next unless $GuestUser->status ne ""; push @allowedGuestUsers, $GuestUser - if $ce->status_abbrev_has_behavior($GuestUser->status, "allow_course_access"); + if $ce->status_abbrev_has_behavior($GuestUser->status, "allow_course_access"); } # Guest login @@ -275,12 +281,10 @@ sub body { # preserve the form data posted to the requested URI my @fields_to_print = grep { not m/^(user|passwd|key|force_passwd_authen)$/ } $r->param; print CGI::start_div({ class => 'my-3' }); - print CGI::p( - $r->maketext( - 'This course supports guest logins. Click [_1] to log into this course as a guest.', - CGI::b($r->maketext("Guest Login")) - ) - ); + print CGI::p($r->maketext( + 'This course supports guest logins. Click [_1] to log into this course as a guest.', + CGI::b($r->maketext("Guest Login")) + )); print CGI::input({ type => "submit", name => "login_practice_user", diff --git a/lib/WeBWorK/ContentGenerator/LoginProctor.pm b/lib/WeBWorK/ContentGenerator/LoginProctor.pm index 883b02ed4c..701aeba5ae 100644 --- a/lib/WeBWorK/ContentGenerator/LoginProctor.pm +++ b/lib/WeBWorK/ContentGenerator/LoginProctor.pm @@ -25,10 +25,10 @@ GatewayQuiz proctored tests. use strict; use warnings; -use CGI qw(-nosticky ); -use WeBWorK::Utils qw(readFile dequote); -use WeBWorK::Utils::Rendering qw(constructPGOptions); -use WeBWorK::DB::Utils qw(grok_vsetID); +use CGI qw(-nosticky ); +use WeBWorK::Utils qw(readFile dequote); +use WeBWorK::Utils::Rendering qw(constructPGOptions); +use WeBWorK::DB::Utils qw(grok_vsetID); use WeBWorK::ContentGenerator::GatewayQuiz qw(can_recordAnswers); # This content generator is NOT logged in. diff --git a/lib/WeBWorK/ContentGenerator/Logout.pm b/lib/WeBWorK/ContentGenerator/Logout.pm index c136e143a6..a37249ce5b 100644 --- a/lib/WeBWorK/ContentGenerator/Logout.pm +++ b/lib/WeBWorK/ContentGenerator/Logout.pm @@ -31,38 +31,35 @@ use WeBWorK::Authen qw(write_log_entry); sub pre_header_initialize { my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; - my $db = $r->db; + my $r = $self->r; + my $ce = $r->ce; + my $db = $r->db; my $authen = $r->authen; - my $userID = $r->param("user_id"); + my $userID = $r->param("user_id"); my $keyError = ''; -# eval { $db->deleteKey($userID) }; -# if ($@) { -# $keyError .= "Something went wrong while logging out of " . -# "WeBWorK: $@"; -# } + # eval { $db->deleteKey($userID) }; + # if ($@) { + # $keyError .= "Something went wrong while logging out of " . + # "WeBWorK: $@"; + # } - $authen -> killSession; + $authen->killSession; $authen->WeBWorK::Authen::write_log_entry("LOGGED OUT"); # also check to see if there is a proctor key associated with this # login. if there is a proctor user, then we must have a # proctored test, so we try and delete the key - my $proctorID = defined($r->param("proctor_user")) ? - $r->param("proctor_user") : ''; - if ( $proctorID ) { - eval { $db->deleteKey( "$userID,$proctorID" ); }; - if ( $@ ) { - $keyError .= CGI::p( - "Error when clearing proctor key: $@"); + my $proctorID = defined($r->param("proctor_user")) ? $r->param("proctor_user") : ''; + if ($proctorID) { + eval { $db->deleteKey("$userID,$proctorID"); }; + if ($@) { + $keyError .= CGI::p("Error when clearing proctor key: $@"); } - # we may also have a proctor key from grading the test - eval { $db->deleteKey( "$userID,$proctorID,g" ); }; - if ( $@ ) { - $keyError .= CGI::p( - "Error when clearing proctor grading key: $@"); + # we may also have a proctor key from grading the test + eval { $db->deleteKey("$userID,$proctorID,g"); }; + if ($@) { + $keyError .= CGI::p("Error when clearing proctor grading key: $@"); } } $self->{keyError} = $keyError; @@ -72,8 +69,8 @@ sub pre_header_initialize { # if we have an authen redirect, all of those errors may be # moot, but I think that's unavoidable (-glarose) - if ( defined($authen->{redirect}) && $authen->{redirect} ) { - $self->reply_with_redirect( $authen->{redirect} ); + if (defined($authen->{redirect}) && $authen->{redirect}) { + $self->reply_with_redirect($authen->{redirect}); } } @@ -81,7 +78,7 @@ sub pre_header_initialize { ## but must return a 1 to get messages. sub if_loggedin { my ($self, $arg) = @_; -# return !$arg; + # return !$arg; return 1; } @@ -93,64 +90,65 @@ sub if_can { sub path { my ($self, $args) = @_; - my $r = $self->r; + my $r = $self->r; my $urlpath = $r->urlpath; - my $ce = $r->{ce}; - my $authen = $r -> {authen}; + my $ce = $r->{ce}; + my $authen = $r->{authen}; - if ((defined($ce -> {external_auth}) and $ce -> {external_auth}) - or (defined($authen -> {external_auth}) and $authen -> {external_auth}) ) { - my $courseID = $urlpath -> arg("courseID"); + if ((defined($ce->{external_auth}) and $ce->{external_auth}) + or (defined($authen->{external_auth}) and $authen->{external_auth})) + { + my $courseID = $urlpath->arg("courseID"); if (defined($courseID)) { print $courseID; } else { - $self -> SUPER::path($args); + $self->SUPER::path($args); } } else { - $self-> SUPER::path($args); + $self->SUPER::path($args); } return ""; } sub body { - my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; - my $db = $r->db; + my ($self) = @_; + my $r = $self->r; + my $ce = $r->ce; + my $db = $r->db; my $urlpath = $r->urlpath; - my $auth = $r->authen; + my $auth = $r->authen; # The following line may not work when a sequence of authentication modules - # are used, because the preferred module might be external, e.g., LTIBasic, - # but a non-external one, e.g., Basic_TheLastChance or - # even just WeBWorK::Authen, might handle the ongoing session management. - # So this should be set in the course environment when a sequence of + # are used, because the preferred module might be external, e.g., LTIBasic, + # but a non-external one, e.g., Basic_TheLastChance or + # even just WeBWorK::Authen, might handle the ongoing session management. + # So this should be set in the course environment when a sequence of # authentication modules is used.. #my $externalAuth = (defined($auth->{external_auth}) && $auth->{external_auth} ) ? 1 : 0; - my $externalAuth = ((defined($ce->{external_auth}) && $ce->{external_auth}) - or (defined($auth->{external_auth}) && $auth->{external_auth}) ) ? 1 : 0; + my $externalAuth = ( + (defined($ce->{external_auth}) && $ce->{external_auth}) + or (defined($auth->{external_auth}) && $auth->{external_auth}) + ) ? 1 : 0; my $courseID = $urlpath->arg("courseID"); - my $userID = $r->param("user"); + my $userID = $r->param("user"); if ($self->{keyError}) { print CGI::div({ class => 'alert alert-danger' }, $self->{keyError}); } my $problemSets = $urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets", $r, courseID => $courseID); - my $loginURL = $r->location . $problemSets->path; + my $loginURL = $r->location . $problemSets->path; print CGI::p($r->maketext("You have been logged out of WeBWorK.")); if ($externalAuth) { my $LMS = ($ce->{LMS_url}) ? CGI::a({ href => $ce->{LMS_url} }, $ce->{LMS_name}) : $ce->{LMS_name}; - print CGI::p( - $r->maketext( - 'The course [_1] uses an external authentication system ([_2]). Please go there to log in again.', - CGI::b($courseID), $LMS - ) - ); + print CGI::p($r->maketext( + 'The course [_1] uses an external authentication system ([_2]). Please go there to log in again.', + CGI::b($courseID), $LMS + )); } else { print CGI::start_form({ method => 'POST', action => $loginURL }); print CGI::hidden('force_passwd_authen', 1); diff --git a/lib/WeBWorK/ContentGenerator/Options.pm b/lib/WeBWorK/ContentGenerator/Options.pm index a8a869d495..5b0d461127 100644 --- a/lib/WeBWorK/ContentGenerator/Options.pm +++ b/lib/WeBWorK/ContentGenerator/Options.pm @@ -142,7 +142,7 @@ sub body { id => 'currPassword', (defined $Password) ? () : (disabled => 1), class => 'form-control', - dir => 'ltr' + dir => 'ltr' }) ), ), @@ -154,7 +154,9 @@ sub body { ), CGI::div( { class => 'col-sm-6' }, - CGI::password_field({ name => 'newPassword', id => 'newPassword', class => 'form-control', dir => 'ltr' }) + CGI::password_field( + { name => 'newPassword', id => 'newPassword', class => 'form-control', dir => 'ltr' } + ) ) ), CGI::div( @@ -226,7 +228,9 @@ sub body { ), CGI::div( { class => 'col-sm-6' }, - CGI::textfield({ name => 'newAddress', id => 'newAddress', class => 'form-control', dir => 'ltr' }) + CGI::textfield( + { name => 'newAddress', id => 'newAddress', class => 'form-control', dir => 'ltr' } + ) ) ) ) diff --git a/lib/WeBWorK/ContentGenerator/PGtoTexRenderer.pm b/lib/WeBWorK/ContentGenerator/PGtoTexRenderer.pm index bef032fcd7..4d55e012e8 100644 --- a/lib/WeBWorK/ContentGenerator/PGtoTexRenderer.pm +++ b/lib/WeBWorK/ContentGenerator/PGtoTexRenderer.pm @@ -13,9 +13,6 @@ # Artistic License for more details. ################################################################################ - - - use strict; use warnings; @@ -28,13 +25,12 @@ use Parser; use AlgParser; use HTML::Entities; - #use encodeURI to send code sub pre_header_initialize { my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; + my $r = $self->r; + my $ce = $r->ce; my $PGcode = ""; $self->{result} = ""; @@ -44,18 +40,18 @@ sub pre_header_initialize { } sub content { - ####################################################################### - # Return content of rendered problem to the browser that requested it # - ####################################################################### + ####################################################################### + # Return content of rendered problem to the browser that requested it # + ####################################################################### my $self = shift; print $self->{result}; } sub translate { - my $self = shift; - my $PGcode = shift; + my $self = shift; + my $PGcode = shift; my $mathObject = "*" . $PGcode; - eval{$mathObject = AlgParser->new->parse($PGcode)->tolatex}; + eval { $mathObject = AlgParser->new->parse($PGcode)->tolatex }; $self->{result} = $mathObject; } diff --git a/lib/WeBWorK/ContentGenerator/Problem.pm b/lib/WeBWorK/ContentGenerator/Problem.pm index 56b094e8e5..96dc75b517 100644 --- a/lib/WeBWorK/ContentGenerator/Problem.pm +++ b/lib/WeBWorK/ContentGenerator/Problem.pm @@ -119,9 +119,10 @@ sub can_showProblemGrader { my ($self, $User, $EffectiveUser, $Set, $Problem) = @_; my $authz = $self->r->authz; - return ($authz->hasPermissions($User->user_id, "access_instructor_tools") && - $authz->hasPermissions($User->user_id, "score_sets") && - $Set->set_id ne 'Undefined_Set' && !$self->{invalidSet}); + return ($authz->hasPermissions($User->user_id, "access_instructor_tools") + && $authz->hasPermissions($User->user_id, "score_sets") + && $Set->set_id ne 'Undefined_Set' + && !$self->{invalidSet}); } sub can_showAnsGroupInfo { @@ -178,10 +179,9 @@ sub can_showSolutions { || $authz->hasPermissions($User->user_id, "show_solutions_before_answer_date"); } - sub can_recordAnswers { my ($self, $User, $EffectiveUser, $Set, $Problem, $submitAnswers) = @_; - my $authz = $self->r->authz; + my $authz = $self->r->authz; my $thisAttempt = $submitAnswers ? 1 : 0; if ($User->user_id ne $EffectiveUser->user_id) { return $authz->hasPermissions($User->user_id, "record_answers_when_acting_as_student"); @@ -189,7 +189,7 @@ sub can_recordAnswers { if (before($Set->open_date)) { return $authz->hasPermissions($User->user_id, "record_answers_before_open_date"); } elsif (between($Set->open_date, $Set->due_date)) { - my $max_attempts = $Problem->max_attempts; + my $max_attempts = $Problem->max_attempts; my $attempts_used = $Problem->num_correct + $Problem->num_incorrect + $thisAttempt; if ($max_attempts == -1 or $attempts_used < $max_attempts) { return $authz->hasPermissions($User->user_id, "record_answers_after_open_date_with_attempts"); @@ -205,20 +205,21 @@ sub can_recordAnswers { sub can_checkAnswers { my ($self, $User, $EffectiveUser, $Set, $Problem, $submitAnswers) = @_; - my $authz = $self->r->authz; + my $authz = $self->r->authz; my $thisAttempt = $submitAnswers ? 1 : 0; # if we can record answers then we dont need to be able to check them # unless we have that specific permission. - if ($self->can_recordAnswers($User,$EffectiveUser,$Set,$Problem,$submitAnswers) - && !$authz->hasPermissions($User->user_id, "can_check_and_submit_answers")) { - return 0; + if ($self->can_recordAnswers($User, $EffectiveUser, $Set, $Problem, $submitAnswers) + && !$authz->hasPermissions($User->user_id, "can_check_and_submit_answers")) + { + return 0; } if (before($Set->open_date)) { return $authz->hasPermissions($User->user_id, "check_answers_before_open_date"); } elsif (between($Set->open_date, $Set->due_date)) { - my $max_attempts = $Problem->max_attempts; + my $max_attempts = $Problem->max_attempts; my $attempts_used = $Problem->num_correct + $Problem->num_incorrect + $thisAttempt; if ($max_attempts == -1 or $attempts_used < $max_attempts) { return $authz->hasPermissions($User->user_id, "check_answers_after_open_date_with_attempts"); @@ -233,27 +234,26 @@ sub can_checkAnswers { } sub can_useMathView { - my ($self, $User, $EffectiveUser, $Set, $Problem, $submitAnswers) = @_; - my $ce= $self->r->ce; + my ($self, $User, $EffectiveUser, $Set, $Problem, $submitAnswers) = @_; + my $ce = $self->r->ce; - return $ce->{pg}->{specialPGEnvironmentVars}->{entryAssist} eq 'MathView'; + return $ce->{pg}->{specialPGEnvironmentVars}->{entryAssist} eq 'MathView'; } sub can_useWirisEditor { - my ($self, $User, $EffectiveUser, $Set, $Problem, $submitAnswers) = @_; - my $ce= $self->r->ce; + my ($self, $User, $EffectiveUser, $Set, $Problem, $submitAnswers) = @_; + my $ce = $self->r->ce; - return $ce->{pg}->{specialPGEnvironmentVars}->{entryAssist} eq 'WIRIS'; + return $ce->{pg}->{specialPGEnvironmentVars}->{entryAssist} eq 'WIRIS'; } sub can_useMathQuill { - my ($self, $User, $EffectiveUser, $Set, $Problem, $submitAnswers) = @_; - my $ce= $self->r->ce; + my ($self, $User, $EffectiveUser, $Set, $Problem, $submitAnswers) = @_; + my $ce = $self->r->ce; - return $ce->{pg}->{specialPGEnvironmentVars}->{entryAssist} eq 'MathQuill'; + return $ce->{pg}->{specialPGEnvironmentVars}->{entryAssist} eq 'MathQuill'; } - sub can_showMeAnother { # PURPOSE: subroutine to check if showMeAnother # button should be allowed; note that this is done @@ -264,19 +264,22 @@ sub can_showMeAnother { # if the showMeAnother button isn't enabled in the course configuration, # don't show it under any circumstances (not even for the instructor) - return 0 unless($ce->{pg}->{options}->{enableShowMeAnother}); + return 0 unless ($ce->{pg}->{options}->{enableShowMeAnother}); # get the hash of information about showMeAnother my %showMeAnother = %{ $self->{showMeAnother} }; - if (after($Set->open_date) or $self->r->authz->hasPermissions($self->r->param('user'), "can_use_show_me_another_early")) { + if (after($Set->open_date) + or $self->r->authz->hasPermissions($self->r->param('user'), "can_use_show_me_another_early")) + { # if $showMeAnother{TriesNeeded} is somehow not an integer or if its -2, use the default value - $showMeAnother{TriesNeeded} = $ce->{pg}->{options}->{showMeAnotherDefault} if ($showMeAnother{TriesNeeded} !~ /^[+-]?\d+$/ || $showMeAnother{TriesNeeded} == -2); + $showMeAnother{TriesNeeded} = $ce->{pg}->{options}->{showMeAnotherDefault} + if ($showMeAnother{TriesNeeded} !~ /^[+-]?\d+$/ || $showMeAnother{TriesNeeded} == -2); # if SMA is just not permitted for the problem, don't show it return 0 unless ($showMeAnother{TriesNeeded} > -1); - my $thisAttempt = $submitAnswers ? 1 : 0; + my $thisAttempt = $submitAnswers ? 1 : 0; my $attempts_used = $Problem->num_correct + $Problem->num_incorrect + $thisAttempt; # if $showMeAnother{Count} is somehow not an integer, it probably means that the database was never @@ -285,11 +288,15 @@ sub can_showMeAnother { # if the student is *preview*ing or *check*ing their answer to SMA then showMeAnother{Count} IS ALLOWED # to be equal to showMeAnother{MaxReps} - $showMeAnother{Count}-- if(defined($showMeAnother{CheckAnswers} && $showMeAnother{CheckAnswers}) or (defined($showMeAnother{Preview}) && $showMeAnother{Preview})); + $showMeAnother{Count}-- + if (defined($showMeAnother{CheckAnswers} && $showMeAnother{CheckAnswers}) + or (defined($showMeAnother{Preview}) && $showMeAnother{Preview})); # if we've gotten this far, the button is enabled globally and for the problem; check if the student has either # not submitted enough answers yet or has used the SMA button too many times - if ($attempts_used < $showMeAnother{TriesNeeded} or ($showMeAnother{Count}>=$showMeAnother{MaxReps} and $showMeAnother{MaxReps}>-1)) { + if ($attempts_used < $showMeAnother{TriesNeeded} + or ($showMeAnother{Count} >= $showMeAnother{MaxReps} and $showMeAnother{MaxReps} > -1)) + { return 0; } else { return 1; @@ -305,22 +312,22 @@ sub can_showMeAnother { ################################################################################ sub attemptResults { - my $self = shift; - my $r = $self->r; - my $pg = shift; - my $showAttemptAnswers = shift//0; + my $self = shift; + my $r = $self->r; + my $pg = shift; + my $showAttemptAnswers = shift // 0; my $showCorrectAnswers = shift; my $showAttemptResults = $showAttemptAnswers && shift; - my $showSummary = shift; + my $showSummary = shift; my $showAttemptPreview = shift // 1; - my $ce = $self->r->ce; + my $ce = $self->r->ce; # to make grabbing these options easier, we'll pull them out now... - my %imagesModeOptions = %{$ce->{pg}->{displayModeOptions}->{images}}; + my %imagesModeOptions = %{ $ce->{pg}->{displayModeOptions}->{images} }; my $imgGen = WeBWorK::PG::ImageGenerator->new( tempDir => $ce->{webworkDirs}->{tmp}, - latex => $ce->{externalPrograms}->{latex}, + latex => $ce->{externalPrograms}->{latex}, dvipng => $ce->{externalPrograms}->{dvipng}, useCache => 1, cacheDir => $ce->{webworkDirs}->{equationCache}, @@ -331,32 +338,32 @@ sub attemptResults { dvipng_depth_db => $imagesModeOptions{dvipng_depth_db}, ); - my $answers = $pg->{answers}; - my $showEvaluatedAnswers = $ce->{pg}->{options}->{showEvaluatedAnswers}//''; + my $answers = $pg->{answers}; + my $showEvaluatedAnswers = $ce->{pg}->{options}->{showEvaluatedAnswers} // ''; -# Create AttemptsTable object + # Create AttemptsTable object my $tbl = WeBWorK::Utils::AttemptsTable->new( $answers, - answersSubmitted => 1, - answerOrder => $pg->{flags}->{ANSWER_ENTRY_ORDER}, - displayMode => $self->{displayMode}, - showAnswerNumbers => 0, - showAttemptAnswers => $showAttemptAnswers && $showEvaluatedAnswers, - showAttemptPreviews => $showAttemptPreview, - showAttemptResults => $showAttemptResults, - showCorrectAnswers => $showCorrectAnswers, - showMessages => $showAttemptAnswers, # internally checks for messages - showSummary => $showSummary, - imgGen => $imgGen, # not needed if ce is present , - ce => '', # not needed if $imgGen is present - maketext => WeBWorK::Localize::getLoc($ce->{language}), + answersSubmitted => 1, + answerOrder => $pg->{flags}->{ANSWER_ENTRY_ORDER}, + displayMode => $self->{displayMode}, + showAnswerNumbers => 0, + showAttemptAnswers => $showAttemptAnswers && $showEvaluatedAnswers, + showAttemptPreviews => $showAttemptPreview, + showAttemptResults => $showAttemptResults, + showCorrectAnswers => $showCorrectAnswers, + showMessages => $showAttemptAnswers, # internally checks for messages + showSummary => $showSummary, + imgGen => $imgGen, # not needed if ce is present , + ce => '', # not needed if $imgGen is present + maketext => WeBWorK::Localize::getLoc($ce->{language}), ); # render equation images my $answerTemplate = $tbl->answerTemplate; - # answerTemplate collects all the formulas to be displayed in the attempts table + # answerTemplate collects all the formulas to be displayed in the attempts table $tbl->imgGen->render(body_text => \$answerTemplate) if $tbl->displayMode eq 'images'; - # after all of the formulas have been collected the render command creates png's for them - # refresh=>1 insures that we never reuse old images -- since the answers change frequently + # after all of the formulas have been collected the render command creates png's for them + # refresh=>1 insures that we never reuse old images -- since the answers change frequently return $answerTemplate; } @@ -365,39 +372,40 @@ sub attemptResults { # Template escape implementations ################################################################################ sub templateName { - my $self = shift; - my $r = $self->r; - my $templateName = $r->param('templateName')//'system'; - $self->{templateName}= $templateName; + my $self = shift; + my $r = $self->r; + my $templateName = $r->param('templateName') // 'system'; + $self->{templateName} = $templateName; $templateName; } + sub content { - my $self = shift; - my $result = $self->SUPER::content(@_); - $self->{pg}->free if $self->{pg}; # be sure to clean up PG environment when the page is done - return $result; + my $self = shift; + my $result = $self->SUPER::content(@_); + $self->{pg}->free if $self->{pg}; # be sure to clean up PG environment when the page is done + return $result; } sub pre_header_initialize { - my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; - my $db = $r->db; - my $authz = $r->authz; + my ($self) = @_; + my $r = $self->r; + my $ce = $r->ce; + my $db = $r->db; + my $authz = $r->authz; my $urlpath = $r->urlpath; - my $setName = $urlpath->arg("setID"); - my $problemNumber = $r->urlpath->arg("problemID"); - my $userName = $r->param('user'); + my $setName = $urlpath->arg("setID"); + my $problemNumber = $r->urlpath->arg("problemID"); + my $userName = $r->param('user'); my $effectiveUserName = $r->param('effectiveUser'); - my $key = $r->param('key'); - my $editMode = $r->param("editMode"); + my $key = $r->param('key'); + my $editMode = $r->param("editMode"); - my $user = $db->getUser($userName); # checked + my $user = $db->getUser($userName); # checked die "record for user $userName (real user) does not exist." unless defined $user; - my $effectiveUser = $db->getUser($effectiveUserName); # checked + my $effectiveUser = $db->getUser($effectiveUserName); # checked die "record for user $effectiveUserName (effective user) does not exist." unless defined $effectiveUser; @@ -420,13 +428,15 @@ sub pre_header_initialize { my $isClosed = 0; # now we check the reasons why it might be closed unless ($self->{isOpen}) { - # its closed if the set is restricted - $isClosed = $ce->{options}{enableConditionalRelease} && is_restricted($db, $set, $effectiveUserName); - # or if its a jitar set and the problem is hidden or closed - $isClosed = $isClosed || ($set->assignment_type() eq 'jitar' && - is_jitar_problem_hidden($db,$effectiveUserName,$set->set_id,$problemNumber)); - $isClosed = $isClosed || ($set->assignment_type() eq 'jitar' && - is_jitar_problem_closed($db,$ce,$effectiveUserName,$set->set_id,$problemNumber)); + # its closed if the set is restricted + $isClosed = $ce->{options}{enableConditionalRelease} && is_restricted($db, $set, $effectiveUserName); + # or if its a jitar set and the problem is hidden or closed + $isClosed = $isClosed + || ($set->assignment_type() eq 'jitar' + && is_jitar_problem_hidden($db, $effectiveUserName, $set->set_id, $problemNumber)); + $isClosed = $isClosed + || ($set->assignment_type() eq 'jitar' + && is_jitar_problem_closed($db, $ce, $effectiveUserName, $set->set_id, $problemNumber)); } # isOpen overrides $isClosed. @@ -435,19 +445,19 @@ sub pre_header_initialize { die("You do not have permission to view unopened sets") unless $self->{isOpen}; # When a set is created enable_reduced_scoring is null, so we have to set it - if ( $set and $set->enable_reduced_scoring ne "0" and $set->enable_reduced_scoring ne "1") { + if ($set and $set->enable_reduced_scoring ne "0" and $set->enable_reduced_scoring ne "1") { my $globalSet = $db->getGlobalSet($set->set_id); - $globalSet->enable_reduced_scoring("0"); # defaults to disabled + $globalSet->enable_reduced_scoring("0"); # defaults to disabled $db->putGlobalSet($globalSet); $set = $db->getMergedSet($effectiveUserName, $setName); } # obtain the merged problem for $effectiveUser - my $problem = $db->getMergedProblem($effectiveUserName, $setName, $problemNumber); # checked + my $problem = $db->getMergedProblem($effectiveUserName, $setName, $problemNumber); # checked # A very hacky and temporary solution to the max_attempts problem # if($problem->max_attempts == ""){ - # $problem->max_attempts = -1; + # $problem->max_attempts = -1; # } if ($authz->hasPermissions($userName, "modify_problem_sets")) { @@ -461,7 +471,7 @@ sub pre_header_initialize { # if it does, we add fake user data unless (defined $set) { my $userSetClass = $db->{set_user}->{record}; - my $globalSet = $db->getGlobalSet($setName); # checked + my $globalSet = $db->getGlobalSet($setName); # checked if (not defined $globalSet) { $set = fake_set($db); @@ -475,14 +485,16 @@ sub pre_header_initialize { # convert it to a user problem, and add fake user data unless (defined $problem) { my $userProblemClass = $db->{problem_user}->{record}; - my $globalProblem = $db->getGlobalProblem($setName, $problemNumber); # checked - # if the global problem doesn't exist either, bail! - if(not defined $globalProblem) { + my $globalProblem = $db->getGlobalProblem($setName, $problemNumber); # checked + # if the global problem doesn't exist either, bail! + if (not defined $globalProblem) { my $sourceFilePath = $r->param("sourceFilePath"); - die "sourceFilePath is unsafe!" unless path_is_subdir($sourceFilePath, $ce->{courseDirs}->{templates}, 1); # 1==path can be relative to dir - # These are problems from setmaker. If declared invalid, they won't come up + die "sourceFilePath is unsafe!" + unless path_is_subdir($sourceFilePath, $ce->{courseDirs}->{templates}, 1) + ; # 1==path can be relative to dir + # These are problems from setmaker. If declared invalid, they won't come up $self->{invalidProblem} = $self->{invalidSet} = 1 unless defined $sourceFilePath; -# die "Problem $problemNumber in set $setName does not exist" unless defined $sourceFilePath; + # die "Problem $problemNumber in set $setName does not exist" unless defined $sourceFilePath; $problem = fake_problem($db); $problem->problem_id(1); $problem->source_file($sourceFilePath); @@ -508,29 +520,37 @@ sub pre_header_initialize { # editMode calls for a temporary file, do so my $sourceFilePath = $r->param("sourceFilePath"); if (defined $editMode and $editMode eq "temporaryFile" and defined $sourceFilePath) { - die "sourceFilePath is unsafe!" unless path_is_subdir($sourceFilePath, $ce->{courseDirs}->{templates}, 1); # 1==path can be relative to dir + die "sourceFilePath is unsafe!" + unless path_is_subdir($sourceFilePath, $ce->{courseDirs}->{templates}, 1) + ; # 1==path can be relative to dir $problem->source_file($sourceFilePath); } # if the problem does not have a source file or no source file has been passed in # then this is really an invalid problem (probably from a bad URL) - $self->{invalidProblem} = not (defined $sourceFilePath or $problem->source_file); + $self->{invalidProblem} = not(defined $sourceFilePath or $problem->source_file); - # if the caller is asking to override the problem seed, do so + # if the caller is asking to override the problem seed, do so my $problemSeed = $r->param("problemSeed"); if (defined $problemSeed && $problemSeed =~ /^[+-]?\d+$/) { $problem->problem_seed($problemSeed); - } + } my $visiblityStateClass = ($set->visible) ? "font-visible" : "font-hidden"; - my $visiblityStateText = ($set->visible) ? $r->maketext("visible to students")."." : $r->maketext("hidden from students")."."; - $self->addmessage(CGI::span($r->maketext("This set is [_1]", CGI::span({class=>$visiblityStateClass}, $visiblityStateText)))); + my $visiblityStateText = + ($set->visible) ? $r->maketext("visible to students") . "." : $r->maketext("hidden from students") . "."; + $self->addmessage(CGI::span($r->maketext( + "This set is [_1]", CGI::span({ class => $visiblityStateClass }, $visiblityStateText)))); - # test for additional problem validity if it's not already invalid - } else { - $self->{invalidProblem} = !(defined $problem and ($set->visible || $authz->hasPermissions($userName, "view_hidden_sets"))); + # test for additional problem validity if it's not already invalid + } else { + $self->{invalidProblem} = + !(defined $problem and ($set->visible || $authz->hasPermissions($userName, "view_hidden_sets"))); - $self->addbadmessage(CGI::p($r->maketext("This problem will not count towards your grade."))) if $problem and not $problem->value and not $self->{invalidProblem}; + $self->addbadmessage(CGI::p($r->maketext("This problem will not count towards your grade."))) + if $problem + and not $problem->value + and not $self->{invalidProblem}; } $self->{userName} = $userName; @@ -544,21 +564,28 @@ sub pre_header_initialize { ##### form processing ##### # set options from form fields (see comment at top of file for names) - my $displayMode = $r->param("displayMode") || $user->displayMode || $ce->{pg}->{options}->{displayMode}; - my $redisplay = $r->param("redisplay"); - my $submitAnswers = $r->param("submitAnswers"); - my $checkAnswers = $r->param("checkAnswers"); - my $previewAnswers = $r->param("previewAnswers"); - my $requestNewSeed = $r->param("requestNewSeed") // 0; + my $displayMode = $r->param("displayMode") || $user->displayMode || $ce->{pg}->{options}->{displayMode}; + my $redisplay = $r->param("redisplay"); + my $submitAnswers = $r->param("submitAnswers"); + my $checkAnswers = $r->param("checkAnswers"); + my $previewAnswers = $r->param("previewAnswers"); + my $requestNewSeed = $r->param("requestNewSeed") // 0; my $formFields = { WeBWorK::Form->new_from_paramable($r)->Vars }; # Check for a page refresh which causes a cached form resubmission. In that case this is # not a valid submission of answers. - $submitAnswers = 0, $self->{resubmitDetected} = 1 - if ($set->set_id ne 'Undefined_Set' && $submitAnswers && (!defined($formFields->{num_attempts}) || - (defined($formFields->{num_attempts}) && - $formFields->{num_attempts} != $problem->num_correct + $problem->num_incorrect))); + $submitAnswers = 0, + $self->{resubmitDetected} = 1 + if ( + $set->set_id ne 'Undefined_Set' + && $submitAnswers + && ( + !defined($formFields->{num_attempts}) + || (defined($formFields->{num_attempts}) + && $formFields->{num_attempts} != $problem->num_correct + $problem->num_incorrect) + ) + ); $self->{displayMode} = $displayMode; $self->{redisplay} = $redisplay; @@ -574,33 +601,33 @@ sub pre_header_initialize { # now that we've set all the necessary variables quit out if the set or problem is invalid return if $self->{invalidSet} || $self->{invalidProblem}; - # a hash containing information for showMeAnother - # TriesNeeded: the number of times the student needs to attempt the problem before the button is available - # MaxReps: the Maximum Number of times that showMeAnother can be clicked (specified in course configuration - # Count: the number of times the student has clicked SMA (or clicked refresh on the page) - my %SMAoptions = map {$_ => 1} @{$ce->{pg}->{options}->{showMeAnother}}; - my %showMeAnother = ( - TriesNeeded => $problem->{showMeAnother}, - MaxReps => $ce->{pg}->{options}->{showMeAnotherMaxReps}, - Count => $problem->{showMeAnotherCount}, - ); - - # if $showMeAnother{Count} is somehow not an integer, make it one - $showMeAnother{Count} = 0 unless ($showMeAnother{Count} =~ /^[+-]?\d+$/); - - # store the showMeAnother hash for the check to see if the button can be used - # (this hash is updated and re-stored after the can, must, will hashes) + # a hash containing information for showMeAnother + # TriesNeeded: the number of times the student needs to attempt the problem before the button is available + # MaxReps: the Maximum Number of times that showMeAnother can be clicked (specified in course configuration + # Count: the number of times the student has clicked SMA (or clicked refresh on the page) + my %SMAoptions = map { $_ => 1 } @{ $ce->{pg}->{options}->{showMeAnother} }; + my %showMeAnother = ( + TriesNeeded => $problem->{showMeAnother}, + MaxReps => $ce->{pg}->{options}->{showMeAnotherMaxReps}, + Count => $problem->{showMeAnotherCount}, + ); + + # if $showMeAnother{Count} is somehow not an integer, make it one + $showMeAnother{Count} = 0 unless ($showMeAnother{Count} =~ /^[+-]?\d+$/); + + # store the showMeAnother hash for the check to see if the button can be used + # (this hash is updated and re-stored after the can, must, will hashes) $self->{showMeAnother} = \%showMeAnother; ##### permissions ##### - # what does the user want to do? - #FIXME There is a problem with checkboxes -- if they are not checked they are invisible. Hence if the default mode in $ce is 1 - # there is no way to override this. Probably this is ok for the last three options, but it was definitely not ok for showing - # saved answers which is normally on, but you want to be able to turn it off! This section should be moved to ContentGenerator - # so that you can set these options anywhere. We also need mechanisms for making them sticky. - # Note: ProblemSet and ProblemSets might set showOldAnswers to '', which - # needs to be treated as if it is not set. +# what does the user want to do? +#FIXME There is a problem with checkboxes -- if they are not checked they are invisible. Hence if the default mode in $ce is 1 +# there is no way to override this. Probably this is ok for the last three options, but it was definitely not ok for showing +# saved answers which is normally on, but you want to be able to turn it off! This section should be moved to ContentGenerator +# so that you can set these options anywhere. We also need mechanisms for making them sticky. +# Note: ProblemSet and ProblemSets might set showOldAnswers to '', which +# needs to be treated as if it is not set. my %want = ( showOldAnswers => $user->showOldAnswers ne '' ? $user->showOldAnswers : $ce->{pg}{options}{showOldAnswers}, # showProblemGrader implies showCorrectAnswers. This is a convenience for grading. @@ -631,7 +658,7 @@ sub pre_header_initialize { showResourceInfo => 0, showHints => 0, showSolutions => 0, - recordAnswers => ! $authz->hasPermissions($userName, "avoid_recording_answers"), + recordAnswers => !$authz->hasPermissions($userName, "avoid_recording_answers"), checkAnswers => 0, showMeAnother => 0, getSubmitButton => 0, @@ -663,28 +690,29 @@ sub pre_header_initialize { ); # re-randomization based on the number of attempts and specified period - my $prEnabled = $ce->{pg}{options}{enablePeriodicRandomization} // 0; + my $prEnabled = $ce->{pg}{options}{enablePeriodicRandomization} // 0; my $rerandomizePeriod = $ce->{pg}{options}{periodicRandomizationPeriod} // 0; $problem->{prPeriod} = $ce->{problemDefaults}{prPeriod} - if (defined($problem->{prPeriod}) && $problem->{prPeriod} =~ /^\s*$/); + if (defined($problem->{prPeriod}) && $problem->{prPeriod} =~ /^\s*$/); $rerandomizePeriod = $problem->{prPeriod} - if (defined($problem->{prPeriod}) && $problem->{prPeriod} > -1); + if (defined($problem->{prPeriod}) && $problem->{prPeriod} > -1); $prEnabled = 0 if ($rerandomizePeriod < 1 || $self->{editMode}); if ($prEnabled) { $problem->{prCount} = 0 - if !defined($problem->{prCount}) || $problem->{prCount} =~ /^\s*$/; + if !defined($problem->{prCount}) || $problem->{prCount} =~ /^\s*$/; $problem->{prCount} += $submitAnswers ? 1 : 0; $requestNewSeed = 0 - if ($problem->{prCount} < $rerandomizePeriod || after($set->due_date)); + if ($problem->{prCount} < $rerandomizePeriod || after($set->due_date)); if ($requestNewSeed) { # obtain new random seed to hopefully change the problem - $problem->{problem_seed} = ($problem->{problem_seed} + $problem->num_correct + $problem->num_incorrect) % 10000; + $problem->{problem_seed} = + ($problem->{problem_seed} + $problem->num_correct + $problem->num_incorrect) % 10000; $problem->{prCount} = 0; } if ($problem->{prCount} > -1) { @@ -744,24 +772,27 @@ sub pre_header_initialize { debug("end pg processing"); - $pg->{body_text} .= CGI::hidden({ -name => 'num_attempts', -id => 'num_attempts', - -value => $problem->num_correct + $problem->num_incorrect + ($submitAnswers ? 1 : 0) }); + $pg->{body_text} .= CGI::hidden({ + -name => 'num_attempts', + -id => 'num_attempts', + -value => $problem->num_correct + $problem->num_incorrect + ($submitAnswers ? 1 : 0) + }); if ($prEnabled && $problem->{prCount} >= $rerandomizePeriod && !after($set->due_date)) { - $showMeAnother{active} = 0; - $must{requestNewSeed} = 1; - $can{requestNewSeed} = 1; - $want{requestNewSeed} = 1; - $will{requestNewSeed} = 1; + $showMeAnother{active} = 0; + $must{requestNewSeed} = 1; + $can{requestNewSeed} = 1; + $want{requestNewSeed} = 1; + $will{requestNewSeed} = 1; $self->{showCorrectOnRandomize} = $ce->{pg}{options}{showCorrectOnRandomize}; # If this happens, it means that the page was refreshed. So prevent the answers from # being recorded and the number of attempts from being increased. if ($problem->{prCount} > $rerandomizePeriod) { $self->{resubmitDetected} = 1; - $must{recordAnswers} = 0; - $can{recordAnswers} = 0; - $want{recordAnswers} = 0; - $will{recordAnswers} = 0; + $must{recordAnswers} = 0; + $can{recordAnswers} = 0; + $want{recordAnswers} = 0; + $will{recordAnswers} = 0; } } @@ -770,14 +801,15 @@ sub pre_header_initialize { $can{showSolutions} &&= $pg->{flags}{solutionExists}; ##### record errors ######### - if (ref ($pg->{pgcore}) ) { - my @debug_messages = @{$pg->{pgcore}->get_debug_messages}; - my @warning_messages = @{$pg->{pgcore}->get_warning_messages}; - my @internal_errors = @{$pg->{pgcore}->get_internal_debug_messages}; - $self->{pgerrors} = @debug_messages||@warning_messages||@internal_errors; # is 1 if any of these are non-empty - $self->{pgdebug} = \@debug_messages; - $self->{pgwarning} = \@warning_messages; - $self->{pginternalerrors} = \@internal_errors ; + if (ref($pg->{pgcore})) { + my @debug_messages = @{ $pg->{pgcore}->get_debug_messages }; + my @warning_messages = @{ $pg->{pgcore}->get_warning_messages }; + my @internal_errors = @{ $pg->{pgcore}->get_internal_debug_messages }; + $self->{pgerrors} = + @debug_messages || @warning_messages || @internal_errors; # is 1 if any of these are non-empty + $self->{pgdebug} = \@debug_messages; + $self->{pgwarning} = \@warning_messages; + $self->{pginternalerrors} = \@internal_errors; } else { warn "Processing of this PG problem was not completed. Probably because of a syntax error. The translator died prematurely and no PG warning messages were transmitted."; @@ -789,7 +821,7 @@ sub pre_header_initialize { $self->{must} = \%must; $self->{can} = \%can; $self->{will} = \%will; - $self->{pg} = $pg; + $self->{pg} = $pg; #### process and log answers #### $self->{scoreRecordedMessage} = process_and_log_answer($self) || ""; @@ -799,31 +831,32 @@ sub pre_header_initialize { sub warnings { my $self = shift; # print "entering warnings() subroutine internal messages = ", $self->{pgerrors},CGI::br(); - my $r = $self->r; -# my $pg = $self->{pg}; -# warn "type of pg is ",ref($pg); -# my $pgerrordiv = $pgdebug||$pgwarning||$pginternalerrors; # is 1 if any of these are non-empty - # print warning messages - if (not defined $self->{pgerrors} ) { - print CGI::start_div(); - print CGI::h3({style=>"color:red;"}, $r->maketext("PG question failed to render")); - print CGI::p($r->maketext("Unable to obtain error messages from within the PG question." )); + my $r = $self->r; + # my $pg = $self->{pg}; + # warn "type of pg is ",ref($pg); + # my $pgerrordiv = $pgdebug||$pgwarning||$pginternalerrors; # is 1 if any of these are non-empty + # print warning messages + if (not defined $self->{pgerrors}) { + print CGI::start_div(); + print CGI::h3({ style => "color:red;" }, $r->maketext("PG question failed to render")); + print CGI::p($r->maketext("Unable to obtain error messages from within the PG question.")); print CGI::end_div(); - } elsif ( $self->{pgerrors} > 0 ) { - my @pgdebug = (defined $self->{pgdebug}) ? @{ $self->{pgdebug}} : () ; - my @pgwarning = (defined $self->{pgwarning}) ? @{ $self->{pgwarning}} : (); - my @pginternalerrors = (defined $self->{pginternalerrors}) ? @{ $self->{pginternalerrors}} : (); + } elsif ($self->{pgerrors} > 0) { + my @pgdebug = (defined $self->{pgdebug}) ? @{ $self->{pgdebug} } : (); + my @pgwarning = (defined $self->{pgwarning}) ? @{ $self->{pgwarning} } : (); + my @pginternalerrors = (defined $self->{pginternalerrors}) ? @{ $self->{pginternalerrors} } : (); print CGI::start_div(); - print CGI::h3({style=>"color:red;"}, $r->maketext("PG question processing error messages")); - print CGI::p(CGI::h3($r->maketext("PG debug messages" ) ), join(CGI::br(), @pgdebug ) ) if @pgdebug ; - print CGI::p(CGI::h3($r->maketext("PG warning messages" ) ),join(CGI::br(), @pgwarning) ) if @pgwarning ; - print CGI::p(CGI::h3($r->maketext("PG internal errors" ) ), join(CGI::br(), @pginternalerrors )) if @pginternalerrors; + print CGI::h3({ style => "color:red;" }, $r->maketext("PG question processing error messages")); + print CGI::p(CGI::h3($r->maketext("PG debug messages")), join(CGI::br(), @pgdebug)) if @pgdebug; + print CGI::p(CGI::h3($r->maketext("PG warning messages")), join(CGI::br(), @pgwarning)) if @pgwarning; + print CGI::p(CGI::h3($r->maketext("PG internal errors")), join(CGI::br(), @pginternalerrors)) + if @pginternalerrors; print CGI::end_div(); } # print "proceeding to SUPER::warnings"; $self->SUPER::warnings(); # print $self->{pgerrors}; - ""; #FIXME -- let's see if this is the appropriate output. + ""; #FIXME -- let's see if this is the appropriate output. } sub if_errors($$) { @@ -837,10 +870,10 @@ sub if_errors($$) { } sub head { - my ($self) = @_; - my $ce = $self->r->ce; + my ($self) = @_; + my $ce = $self->r->ce; my $webwork_htdocs_url = $ce->{webwork_htdocs_url}; - return "" if ( $self->{invalidSet} ); + return "" if ($self->{invalidSet}); return $self->{pg}->{head_text} if $self->{pg}->{head_text}; @@ -848,24 +881,24 @@ sub head { sub post_header_text { my ($self) = @_; - return "" if ( $self->{invalidSet} ); - return $self->{pg}->{post_header_text} if $self->{pg}->{post_header_text}; + return "" if ($self->{invalidSet}); + return $self->{pg}->{post_header_text} if $self->{pg}->{post_header_text}; } sub siblings { - my ($self) = @_; - my $r = $self->r; - my $db = $r->db; - my $ce = $r->ce; - my $authz = $r->authz; + my ($self) = @_; + my $r = $self->r; + my $db = $r->db; + my $ce = $r->ce; + my $authz = $r->authz; my $urlpath = $r->urlpath; # can't show sibling problems if the set is invalid return "" if $self->{invalidSet}; my $courseID = $urlpath->arg("courseID"); - my $setID = $self->{set}->set_id; - my $eUserID = $r->param("effectiveUser"); + my $setID = $self->{set}->set_id; + my $eUserID = $r->param("effectiveUser"); my @problemRecords = $db->getMergedProblemsWhere({ user_id => $eUserID, set_id => $setID }, 'problem_id'); my @problemIDs = map { $_->problem_id } @problemRecords; @@ -873,16 +906,15 @@ sub siblings { my $isJitarSet = $setID ne 'Undefined_Set' && $self->{set}->assignment_type eq 'jitar' ? 1 : 0; # variables for the progress bar - my $num_of_problems = 0; + my $num_of_problems = 0; my $problemList; - my $total_correct=0; - my $total_incorrect=0; - my $total_inprogress=0; + my $total_correct = 0; + my $total_incorrect = 0; + my $total_inprogress = 0; my $currentProblemID = $self->{problem}->problem_id if !($self->{invalidProblem}); my $progressBarEnabled = $r->ce->{pg}->{options}->{enableProgressBar}; - print CGI::start_div({ class => 'info-box', id => 'fisheye' }); print CGI::h2($r->maketext('Problems')); @@ -892,40 +924,48 @@ sub siblings { my %problemGraderLink = $self->{will}{showProblemGrader} ? (params => { showProblemGrader => 1 }) : (); foreach my $problemID (@problemIDs) { - if ($isJitarSet && !$authz->hasPermissions($eUserID, "view_unopened_sets") && is_jitar_problem_hidden($db,$eUserID, $setID, $problemID)) { + if ($isJitarSet + && !$authz->hasPermissions($eUserID, "view_unopened_sets") + && is_jitar_problem_hidden($db, $eUserID, $setID, $problemID)) + { shift(@problemRecords) if $progressBarEnabled; next; } - my $problemPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Problem", $r, courseID => $courseID, setID => $setID, problemID => $problemID); + my $problemPage = $urlpath->newFromModule( + "WeBWorK::ContentGenerator::Problem", $r, + courseID => $courseID, + setID => $setID, + problemID => $problemID + ); my $link; my $status_symbol = ''; - if($progressBarEnabled){ + if ($progressBarEnabled) { my $problemRecord = shift(@problemRecords); $num_of_problems++; - my $total_attempts = $problemRecord->num_correct+$problemRecord->num_incorrect; + my $total_attempts = $problemRecord->num_correct + $problemRecord->num_incorrect; my $status = $problemRecord->status; if ($isJitarSet) { - $status = jitar_problem_adjusted_status($problemRecord,$db); + $status = jitar_problem_adjusted_status($problemRecord, $db); } # variables for the widths of the bars in the Progress Bar - if( $status ==1 ){ + if ($status == 1) { # correct $total_correct++; - $status_symbol = " ✓"; # checkmark + $status_symbol = " ✓"; # checkmark } else { # incorrect - if($total_attempts >= $problemRecord->max_attempts and $problemRecord->max_attempts!=-1){ + if ($total_attempts >= $problemRecord->max_attempts and $problemRecord->max_attempts != -1) { $total_incorrect++; - $status_symbol = " ✗"; # cross + $status_symbol = " ✗"; # cross } else { # in progress - if($problemRecord->attempted>0){ + if ($problemRecord->attempted > 0) { $total_inprogress++; - $status_symbol = " …"; # horizontal ellipsis + $status_symbol = " …"; # horizontal ellipsis } } } @@ -935,7 +975,7 @@ sub siblings { if ($isJitarSet) { # If it is a jitar set, we need to hide and disable links to hidden or restricted problems. - my @seq = jitar_id_to_seq($problemID); + my @seq = jitar_id_to_seq($problemID); my $level = $#seq; my $class = 'nav-link' . ($active ? ' active' : ''); if ($level != 0) { @@ -952,7 +992,8 @@ sub siblings { } else { $link = CGI::a( { - $active ? (class => $class) + $active + ? (class => $class) : (href => $self->systemLink($problemPage, %problemGraderLink), class => $class) }, $r->maketext('Problem [_1]', join('.', @seq)) . ($progressBarEnabled ? $status_symbol : '') @@ -961,7 +1002,8 @@ sub siblings { } else { $link = CGI::a( { - $active ? (class => 'nav-link active') + $active + ? (class => 'nav-link active') : (href => $self->systemLink($problemPage, %problemGraderLink), class => 'nav-link') }, $r->maketext('Problem [_1]', $problemID) . ($progressBarEnabled ? $status_symbol : '') @@ -1128,7 +1170,8 @@ sub nav { # Mark the current user. $userRecords[$currentUserIndex]{currentUser} = 1; - my $problemPage = $urlpath->newFromModule(__PACKAGE__, $r, + my $problemPage = $urlpath->newFromModule( + __PACKAGE__, $r, courseID => $courseID, setID => $setID, problemID => $problemID @@ -1324,7 +1367,8 @@ sub nav { my @links; if ($prevID) { - my $prevPage = $urlpath->newFromModule(__PACKAGE__, $r, + my $prevPage = $urlpath->newFromModule( + __PACKAGE__, $r, courseID => $courseID, setID => $setID, problemID => $prevID @@ -1341,7 +1385,8 @@ sub nav { } if ($nextID) { - my $nextPage = $urlpath->newFromModule(__PACKAGE__, $r, + my $nextPage = $urlpath->newFromModule( + __PACKAGE__, $r, courseID => $courseID, setID => $setID, problemID => $nextID @@ -1402,24 +1447,24 @@ sub path { sub title { my ($self) = @_; - my $r = $self->r; - my $db = $r->db; + my $r = $self->r; + my $db = $r->db; # Using the url arguments won't break if the set/problem are invalid - my $setID = $self->r->urlpath->arg("setID"); + my $setID = $self->r->urlpath->arg("setID"); my $problemID = $self->r->urlpath->arg("problemID"); my $set = $db->getGlobalSet($setID); $setID = CGI::span({ dir => 'ltr' }, format_set_name_display($setID)); if ($set && $set->assignment_type eq 'jitar') { - $problemID = join('.',jitar_id_to_seq($problemID)); + $problemID = join('.', jitar_id_to_seq($problemID)); } my $out = $r->maketext('[_1]: Problem [_2]', $setID, $problemID); # Return here if we don't have the requisite information. return $out if ($self->{invalidSet} || $self->{invalidProblem}); - my $ce = $r->ce; + my $ce = $r->ce; my $problem = $self->{problem}; $out .= CGI::start_span({ class => "problem-sub-header d-block" }); @@ -1432,9 +1477,10 @@ sub title { # This uses the permission level and user id of the user assigned to the problem. my $problemUser = $problem->user_id; - my $inList = grep($_ eq $problemUser, @{$ce->{pg}{specialPGEnvironmentVars}{PRINT_FILE_NAMES_FOR}}); + my $inList = grep($_ eq $problemUser, @{ $ce->{pg}{specialPGEnvironmentVars}{PRINT_FILE_NAMES_FOR} }); if ($db->getPermissionLevel($problemUser)->permission >= - $ce->{pg}{specialPGEnvironmentVars}{PRINT_FILE_NAMES_PERMISSION_LEVEL} || $inList) { + $ce->{pg}{specialPGEnvironmentVars}{PRINT_FILE_NAMES_PERMISSION_LEVEL} || $inList) + { $out .= " " . $problem->source_file; } @@ -1444,36 +1490,38 @@ sub title { } sub body { - my $self = shift; - my $set = $self->{set}; + my $self = shift; + my $set = $self->{set}; my $problem = $self->{problem}; - my $pg = $self->{pg}; + my $pg = $self->{pg}; - print CGI::p("Entering Problem::body subroutine. + print CGI::p( + "Entering Problem::body subroutine. This indicates an old style system.template file -- consider upgrading. ", - caller(1), ); + caller(1), + ); my $valid = check_invalid($self); - unless($valid eq "valid"){ + unless ($valid eq "valid") { return $valid; } # output for templates that only use body instead of calling the body parts individually - $self ->output_JS; - $self ->output_tag_info; - $self ->output_custom_edit_message; - $self ->output_summary; - $self ->output_grader; - $self ->output_hidden_info; - $self ->output_form_start(); - $self ->output_problem_body; - $self ->output_message; - $self ->output_editorLink; - $self ->output_checkboxes; - $self ->output_submit_buttons; - $self ->output_score_summary; - $self ->output_comments; - $self ->output_misc; + $self->output_JS; + $self->output_tag_info; + $self->output_custom_edit_message; + $self->output_summary; + $self->output_grader; + $self->output_hidden_info; + $self->output_form_start(); + $self->output_problem_body; + $self->output_message; + $self->output_editorLink; + $self->output_checkboxes; + $self->output_submit_buttons; + $self->output_score_summary; + $self->output_comments; + $self->output_misc; print ""; # debugging stuff if (0) { @@ -1489,7 +1537,7 @@ sub body { CGI::h3("problem object"), ref2string($problem), CGI::h3("PG object"), - ref2string($pg, {'WeBWorK::PG::Translator' => 1}); + ref2string($pg, { 'WeBWorK::PG::Translator' => 1 }); } debug("leaving body of Problem.pm"); return ""; @@ -1499,9 +1547,9 @@ sub body { # prints out the beginning of the main form, and the necessary hidden authentication fields -sub output_form_start{ - my $self = shift; - my $r = $self->r; +sub output_form_start { + my $self = shift; + my $r = $self->r; my $startTime = $r->param('startTime') || time(); print CGI::start_form({ @@ -1512,7 +1560,7 @@ sub output_form_start{ class => 'problem-main-form' }); print $self->hidden_authen_fields; - print CGI::hidden({-name=>'startTime', -value=>$startTime}); + print CGI::hidden({ -name => 'startTime', -value => $startTime }); return ""; } @@ -1523,7 +1571,12 @@ sub output_form_start{ sub output_problem_lang_and_dir { my $self = shift; - print " " . get_problem_lang_and_dir($self->{pg}{flags}, $self->r->ce->{perProblemLangAndDirSettingMode}, $self->r->ce->{language}); + print " " + . get_problem_lang_and_dir( + $self->{pg}{flags}, + $self->r->ce->{perProblemLangAndDirSettingMode}, + $self->r->ce->{language} + ); return ""; } @@ -1531,14 +1584,14 @@ sub output_problem_lang_and_dir { # prints out the body of the current problem -sub output_problem_body{ +sub output_problem_body { my $self = shift; - my $pg = $self->{pg}; + my $pg = $self->{pg}; my %will = %{ $self->{will} }; print "\n"; - print CGI::div({id=>'output_problem_body'},$pg->{body_text}); + print CGI::div({ id => 'output_problem_body' }, $pg->{body_text}); return ""; } @@ -1605,8 +1658,8 @@ sub output_grader { my $self = shift; if ($self->{will}{showProblemGrader}) { - my $grader = new WeBWorK::ContentGenerator::Instructor::SingleProblemGrader( - $self->r, $self->{pg}, $self->{problem}); + my $grader = + new WeBWorK::ContentGenerator::Instructor::SingleProblemGrader($self->r, $self->{pg}, $self->{problem}); $grader->insertGrader; } @@ -1617,19 +1670,19 @@ sub output_grader { # processes and prints out the correct link to the editor of the current problem -sub output_editorLink{ +sub output_editorLink { my $self = shift; - my $set = $self->{set}; - my $problem = $self->{problem}; - my $pg = $self->{pg}; + my $set = $self->{set}; + my $problem = $self->{problem}; + my $pg = $self->{pg}; - my $r = $self->r; - my $ce = $r->ce; - my $authz = $r->authz; + my $r = $self->r; + my $ce = $r->ce; + my $authz = $r->authz; my $urlpath = $r->urlpath; - my $user = $r->param('user'); + my $user = $r->param('user'); my $courseName = $urlpath->arg("courseID"); @@ -1663,11 +1716,11 @@ sub output_editorLink{ print $editorLink; } else { - print $self->errorOutput($pg->{errors}, $r->maketext("You do not have permission to view the details of this error.")); + print $self->errorOutput($pg->{errors}, + $r->maketext("You do not have permission to view the details of this error.")); } print ""; - } - else{ + } else { print $editorLink; } return ""; @@ -1676,11 +1729,11 @@ sub output_editorLink{ # output_checkboxes subroutine # prints out the checkbox input elements that are available for the current problem sub output_checkboxes { - my $self = shift; - my $r = $self->r; - my %can = %{ $self->{can} }; - my %will = %{ $self->{will} }; - my $ce = $r->ce; + my $self = shift; + my $r = $self->r; + my %can = %{ $self->{can} }; + my %will = %{ $self->{will} }; + my $ce = $r->ce; if ($can{showCorrectAnswers} || $can{showProblemGrader} @@ -1790,19 +1843,19 @@ sub output_checkboxes { # prints out the submit button input elements that are available for the current problem sub output_submit_buttons { - my $self = shift; - my $r = $self->r; - my $ce = $self->r->ce; - my %can = %{ $self->{can} }; - my %will = %{ $self->{will} }; - my $urlpath = $r->urlpath; - my $problem = $self->{problem}; - my $courseID = $urlpath->arg("courseID"); - my $user = $r->param('user'); + my $self = shift; + my $r = $self->r; + my $ce = $self->r->ce; + my %can = %{ $self->{can} }; + my %will = %{ $self->{will} }; + my $urlpath = $r->urlpath; + my $problem = $self->{problem}; + my $courseID = $urlpath->arg("courseID"); + my $user = $r->param('user'); my $effectiveUser = $r->param('effectiveUser'); my %showMeAnother = %{ $self->{showMeAnother} }; - if ($will{requestNewSeed}){ + if ($will{requestNewSeed}) { print CGI::submit({ id => 'submitAnswers_id', name => 'requestNewSeed', @@ -1872,8 +1925,8 @@ sub output_submit_buttons { data_bs_title => $r->maketext( 'You can use this feature [quant,_1,more time,more times,as many times as you want] on this problem', $showMeAnother{MaxReps} >= $showMeAnother{Count} - ? ($showMeAnother{MaxReps} - $showMeAnother{Count}) - : '' + ? ($showMeAnother{MaxReps} - $showMeAnother{Count}) + : '' ) }, $r->maketext('Show me another') @@ -1894,13 +1947,12 @@ sub output_submit_buttons { data_bs_toggle => 'tooltip', data_bs_placement => 'right', data_bs_title => before($r->db->getGlobalSet($self->{set}->set_id)->open_date) - ? $r->maketext('The problem set is not yet open') - : $exhausted eq 'exhausted' - ? $r->maketext('Feature exhausted for this problem') - : $r->maketext( - 'You must attempt this problem [quant,_1,time,times] before this feature is available', - $showMeAnother{TriesNeeded} - ) + ? $r->maketext('The problem set is not yet open') + : $exhausted eq 'exhausted' ? $r->maketext('Feature exhausted for this problem') + : $r->maketext( + 'You must attempt this problem [quant,_1,time,times] before this feature is available', + $showMeAnother{TriesNeeded} + ) }, qq{'; + + toastContainer.append(toast); + + const bsToast = new bootstrap.Toast(toast, { delay: success ? 2000 : 6000 }); + toast.addEventListener('hidden.bs.toast', () => { bsToast.dispose(); toast.remove(); }) + bsToast.show(); }; - const frame = document.getElementById('pg_editor_frame_id'); - frame?.addEventListener('load', () => { - removeBusyIndicator(); - if (frame.contentDocument.URL == 'about:blank') return; - const style = frame.contentDocument.createElement('style'); - style.type = 'text/css'; - style.textContent = '#site-navigation,#toggle-sidebar,#masthead,#breadcrumb-row,' + - '#footer,.sticky-nav{display:none !important;}'; - frame.contentDocument.head.appendChild(style); - frame.contentDocument.getElementById('content').classList.remove('col-md-10'); - frame.contentWindow.addEventListener('resize', - () => frame.contentDocument.getElementById('content').classList.remove('col-md-10') - ); - }); + const webserviceURL = `${webworkConfig?.webwork_url ?? '/webwork2'}/instructor_rpc`; + + // Send a request to the server to save the temporary file for the currently edited file. + // This temporary file could be used for recovery, and is displayed if the page is reloaded. + const saveTempFile = () => { + const request_object = { + user: document.getElementById('hidden_user')?.value, + courseID: document.getElementsByName('courseID')[0]?.value, + key: document.getElementById('hidden_key')?.value + }; + + if (!(request_object.user && request_object.courseID && request_object.key)) return; + + request_object.rpc_command = 'saveFile'; + request_object.outputFilePath = document.getElementsByName('temp_file_path')[0]?.value ?? ''; + request_object.fileContents = webworkConfig?.pgCodeMirror?.getValue() ?? ''; + + if (!request_object.outputFilePath || !request_object.fileContents) return; - document.getElementById('submit_button_id')?.addEventListener('click', () => { + fetch(webserviceURL, { method: 'post', mode: 'same-origin', body: new URLSearchParams(request_object) }) + .then((response) => response.json()) + .then((data) => showMessage(data.server_response, data.result_data)) + .catch((err) => showMessage(`Error saving temporary file: ${err?.message ?? err}`)); + }; + + const viewSeedInput = document.getElementById('action_view_seed_id'); + if (viewSeedInput) { + document.getElementById('randomize_view_seed_id')?.addEventListener('click', async () => { + viewSeedInput.value = Math.ceil(Math.random() * 9999); + await render(); + + saveTempFile(); + }); + } + + const hardcopySeedInput = document.getElementById('action_hardcopy_seed_id'); + if (hardcopySeedInput) { + document.getElementById('randomize_hardcopy_seed_id')?.addEventListener('click', async () => { + hardcopySeedInput.value = Math.ceil(Math.random() * 9999); + await generateHardcopy(); + + saveTempFile(); + }); + } + + document.getElementById('submit_button_id')?.addEventListener('click', async (e) => { const actionView = document.getElementById('view'); + const editorForm = document.getElementById('editor'); + + // Make sure this is reset on each click so that a new window isn't always opened once that has been done once. + if (editorForm) editorForm.target = '_self'; + + if (actionView && actionView.classList.contains('active')) { + if (document.getElementById('newWindowView')?.checked) { + if (editorForm) editorForm.target = 'WW_View'; + } else { + e.preventDefault(); + await render(); + + saveTempFile(); + } + } + const actionSave = document.getElementById('save'); + if (actionSave + && actionSave.classList.contains('active') + && document.getElementById('newWindowSave')?.checked + && editorForm) + editorForm.target = 'WW_View'; + + + const actionHardcopy = document.getElementById('hardcopy'); + if (actionHardcopy && actionHardcopy.classList.contains('active')) { + e.preventDefault(); + await generateHardcopy(); + + saveTempFile(); + } + }); - let target = "_self"; - if (actionView && actionView.classList.contains('active')) - target = document.getElementById("newWindowView").checked ? "WW_View" : "pg_editor_frame"; - else if (actionSave && actionSave.classList.contains('active')) - target = document.getElementById("newWindowSave").checked ? "WW_View" : "pg_editor_frame"; - - document.getElementById('editor').target = target; - - if (target == "pg_editor_frame") { - bsModal.show(); - busyIndicator = document.createElement('div'); - busyIndicator.classList.add('page-loading-busy-indicator'); - busyIndicator.innerHTML = '

      Loading...

      ' + - '
      ' + - '
      Press escape to cancel
      '; - busyIndicator.tabIndex = -1; - bsModal._element.querySelector('.modal-body')?.appendChild(busyIndicator); - busyIndicator.focus(); - - // Allow the user to cancel loading of the iframe by pressing escape. - busyIndicator.addEventListener('keydown', (e) => { - if (e.key === 'Escape') { - removeBusyIndicator(); - window.stop(); + const renderURL = `${webworkConfig?.webwork_url ?? '/webwork2'}/render_rpc`; + const renderArea = document.getElementById('pgedit-render-area'); + const fileType = document.getElementsByName('file_type')[0]?.value; + + // This is either the div created by the CodeMirror editor or the problemContents textarea in the case that + // CodeMirror is disabled in localOverrides.conf. + const editorArea = document.querySelector('.CodeMirror') ?? document.getElementById('problemContents'); + + // Synchronize the heights of the render area and the editor area for wide windows. + if (editorArea && renderArea) { + const codeMirrorResizeObserver = new ResizeObserver((entries) => { + if (document.body.clientWidth < 992) return; + + for (const entry of entries) { + if (entry.borderBoxSize) { + // Note that the blockSize is the height (since width is not resizable). + const height = Array.isArray(entry.borderBoxSize) + ? entry.borderBoxSize[0].blockSize + : entry.borderBoxSize.blockSize; + if (window.getComputedStyle(renderArea).getPropertyValue('height') !== `${height}px`) + renderArea.style.height = `${height}px`; + if (window.getComputedStyle(editorArea).getPropertyValue('height') !== `${height}px`) { + if (webworkConfig?.pgCodeMirror) webworkConfig.pgCodeMirror.setSize('100%', `${height}px`); + else editorArea.style.height = `${height}px`; + } } + } + }); + codeMirrorResizeObserver.observe(editorArea); + codeMirrorResizeObserver.observe(renderArea); + } + + // Save the initial placeholder content of the render area so that it can be put back when a problem is reloaded. + const placeholder = renderArea.querySelector('.placeholder'); + const iframe = document.createElement('iframe'); + iframe.title = 'Rendered content'; + iframe.id = 'pgedit-render-iframe'; + + // When one of the problem form submit buttons is clicked, set the source for the problem in the + // hidden problemSource input to the current contents of the CodeMirror editor so that changes + // are immediate. + iframe.addEventListener('load', () => { + const problemForm = iframe.contentWindow.document.getElementById('problemMainForm'); + if (!problemForm) return; + + for (const button of problemForm.querySelectorAll('input[type="submit"]')) { + button.addEventListener('click', (e) => { + e.preventDefault(); + + // FormData does not support the characters in raw problem source. URLSearchParams does. + // So extract the problem form data using the FormData object and construct the URLSearchParams object + // with that. + const requestData = new URLSearchParams(new FormData(problemForm)); + requestData.set('rawProblemSource', webworkConfig?.pgCodeMirror?.getValue() + ?? document.getElementById('problemContents')?.value ?? ''); + requestData.set('send_pg_flags', 1); + requestData.set(button.name, button.value); + + renderProblem(requestData); + + saveTempFile(); }); } }); - document.getElementById('randomize_view_seed_id')?.addEventListener('click', () => { - document.getElementById('action_view_seed_id').value = Math.ceil(Math.random()*9999); + const render = () => new Promise((resolve) => { + if (fileType === 'hardcopy_header') { + renderArea.innerHTML = '
      ' + + 'Hardcopy header contents can only be viewed in a new window.
      '; + resolve(); + return; + } + + if (fileType === 'course_info') { + const contents = webworkConfig?.pgCodeMirror?.getValue(); + if (contents) renderArea.innerHTML = contents; + + // Typeset any math content that may be in the course info file. + if (window.MathJax) { + MathJax.startup.promise = + MathJax.startup.promise.then(() => MathJax.typesetPromise(['#pgedit-render-area'])); + } + + resolve(); + return; + } + + renderProblem(new URLSearchParams({ + user: document.getElementById('hidden_user')?.value, + courseID: document.getElementsByName('courseID')[0]?.value, + key: document.getElementById('hidden_key')?.value, + problemSeed: document.getElementById('action_view_seed_id')?.value ?? 1, + sourceFilePath: document.getElementsByName('edit_file_path')[0]?.value, + rawProblemSource: webworkConfig?.pgCodeMirror?.getValue() + ?? document.getElementById('problemContents')?.value ?? '', + outputformat: 'simple', + showAnswerNumbers: 0, + // The set id is really only needed by set headers to get the correct dates for the set. + set_id: document.getElementsByName('hidden_set_id')[0]?.value ?? 'Unknown Set', + // This should not be an actual problem number in the set. If so the current user's seed for that problem + // will be used instead of the seed from the editor form. + probNum: 0, + showHints: 1, + showSolutions: 1, + isInstructor: 1, + noprepostambles: 1, + processAnswers: 0, + showPreviewButton: fileType && fileType === 'problem' ? 1 : 0, + showCheckAnswersButton: fileType && fileType === 'problem' ? 1 : 0, + showCorrectAnswersButton: fileType && fileType === 'problem' ? 1 : 0, + showFooter: 0, + displayMode: document.getElementById('action_view_displayMode_id')?.value ?? 'MathJax', + language: document.querySelector('input[name="hidden_language"]')?.value ?? 'en', + send_pg_flags: 1 + })).then(() => resolve()); + }); + + // This is used to protect against rapid successive clicks on the "Randomize Seed" or "Take Action" buttons. + let rendering = false; + + const renderProblem = (body) => new Promise((resolve) => { + if (rendering) { resolve(); return; } + rendering = true; + + // Put the placeholder back until the problem finishes rendering. + renderArea.replaceChildren(placeholder); + + const controller = new AbortController(); + const timeoutId = setTimeout(() => controller.abort(), 20000); + + fetch(renderURL, { method: 'post', mode: 'same-origin', signal: controller.signal, body }) + .then((response) => { + clearTimeout(timeoutId); + return response.json(); + }) + .then((data) => { + // If the error is set, show that. + if (data.error) throw data.error; + // This generally shouldn't happen. + if (!data.html) throw 'A server error occured. The response had no content'; + // Give a nicer file not found error. + if (/this problem file was empty/i.test(data.html)) throw 'No Such File or Directory!'; + + renderArea.replaceChildren(iframe); + iframe.srcdoc = data.html; + + if (data.pg_flags && data.pg_flags.comment) { + // The problem has a comment, so show it. + const container = document.createElement('div'); + container.classList.add('px-2', 'mb-2'); + container.innerHTML = data.pg_flags.comment; + iframe.after(container); + } + + iframe.addEventListener('load', () => { rendering = false; resolve(); }, { once: true }); + }) + .catch((err) => { + renderArea.innerHTML = `
      Rendering error: ${ + err?.message ?? err}
      `; + rendering = false; + resolve(); + }); }); + + // Render the content when the page loads. + render(); + + const generateHardcopy = async () => { + if (rendering) return; + rendering = true; + + const controller = new AbortController(); + const timeoutId = setTimeout(() => controller.abort(), 30000); + + try { + const response = await fetch(renderURL, { + method: 'post', + mode: 'same-origin', + signal: controller.signal, + body: new URLSearchParams({ + user: document.getElementById('hidden_user')?.value, + courseID: document.getElementsByName('courseID')[0]?.value, + key: document.getElementById('hidden_key')?.value, + problemSeed: document.getElementById('action_hardcopy_seed_id')?.value ?? 1, + sourceFilePath: document.getElementsByName('edit_file_path')[0]?.value, + rawProblemSource: webworkConfig?.pgCodeMirror?.getValue() + ?? document.getElementById('problemContents')?.value ?? '', + outputformat: document.getElementById('action_hardcopy_format_id')?.value ?? 'pdf', + hardcopy_theme: document.getElementById('action_hardcopy_theme_id')?.value ?? 'oneColumn', + // The set id is really only needed by set headers to get the correct dates for the set. + set_id: document.getElementsByName('hidden_set_id')[0]?.value ?? 'Unknown Set', + // This should not be an actual problem number in the set. If so the current user's seed for that + // problem will be used instead of the seed from the editor form. + probNum: 0, + showHints: 1, + showSolutions: 1, + WWcorrectAns: 1, + isInstructor: 1, + noprepostambles: 1, + processAnswers: 1, + displayMode: 'tex', + view_problem_debugging_info: 1 + }) + }); + + clearTimeout(timeoutId); + + if (!response.ok || + !response.headers.get('content-type') || + /text\/html/.test(response.headers.get('content-type'))) + { + throw await response.text(); + return; + } + + const data = await response.blob(); + + const element = document.createElement('a'); + element.href = window.URL.createObjectURL(data); + element.download = response.headers.get('content-disposition').split('=')[1]; + element.style.display = 'none'; + document.body.appendChild(element); + element.click(); + document.body.removeChild(element); + + rendering = false; + } catch (err) { + if (typeof err === 'string') { + renderArea.innerHTML = '
      ' + + '
      Hardcopy generation errors:
      ' + + err.split('\n').reduce((acc, line) => acc += `
      ${line}
      `, ''); + } else { + renderArea.innerHTML = `
      Hardcopy generation error: ${ + err?.message ?? err}
      `; + } + rendering = false; + }; + }; })(); diff --git a/htdocs/js/apps/ProblemSetDetail/problemsetdetail.js b/htdocs/js/apps/ProblemSetDetail/problemsetdetail.js index 848aa1f041..2882d4748f 100644 --- a/htdocs/js/apps/ProblemSetDetail/problemsetdetail.js +++ b/htdocs/js/apps/ProblemSetDetail/problemsetdetail.js @@ -384,8 +384,6 @@ if (data.pg_flags && data.pg_flags.comment) iframe.insertAdjacentHTML('afterend', data.pg_flags.comment); - if (data.warnings) - iframe.insertAdjacentHTML('afterend', data.warnings); iFrameResize({ checkOrigin: false, warningTimeout: 20000, scrolling: 'omit' }, iframe); iframe.addEventListener('load', () => resolve()); diff --git a/htdocs/js/apps/SetMaker/setmaker.js b/htdocs/js/apps/SetMaker/setmaker.js index 9deff0e7b6..0cf62f5bf3 100644 --- a/htdocs/js/apps/SetMaker/setmaker.js +++ b/htdocs/js/apps/SetMaker/setmaker.js @@ -495,11 +495,6 @@ container.innerHTML = data.pg_flags.comment; iframe.after(container); } - if (data.warnings) { - const container = document.createElement('div'); - container.innerHTML = data.warnings; - iframe.after(container); - } iFrameResize({ checkOrigin: false, warningTimeout: 20000, scrolling: 'omit' }, iframe); iframe.addEventListener('load', () => resolve()); } diff --git a/htdocs/themes/math4/math4.scss b/htdocs/themes/math4/math4.scss index fa9d18ce95..fb3157d4d4 100644 --- a/htdocs/themes/math4/math4.scss +++ b/htdocs/themes/math4/math4.scss @@ -720,30 +720,26 @@ input.changed[type=text] { /* orange */ } } -#render-modal { - .modal-dialog { - width: 90vw; - max-width: unset; - height: 86vh; - } +#pgedit-render-area { + border: 1px solid #ddd; + min-height: 400px; + height: 550px; + resize: vertical; + display: flex; + flex-direction: column; - .modal-content { - height: 100%; + @media only screen and (max-width: 992px) { + min-height: 200px; + height: 300px; } - .modal-body { - overflow: hidden; - padding: 0; + #pgedit-render-iframe { + flex-grow: 1; + border: none; + width: 100%; } } -#pg_editor_frame_id { - overflow: auto; - border: none; - width: 100%; - height: 100%; -} - // Fix the style of the save file path input group. // It is forced to be ltr, but the bootstrap rtl style makes that look wrong. /* rtl:raw: @@ -763,32 +759,6 @@ input.changed[type=text] { /* orange */ } */ -/* Page loading busy indicator */ -/* Currently only used on the problem editor page. */ -.page-loading-busy-indicator { - position: absolute; - width: 100%; - height: 100%; - left: 0; - top: 0; - display: flex; - flex-direction: column; - justify-content: center; - align-items: center; - gap: 1rem; - background: rgba(0, 0, 0, .5); - z-index: 105; - - .busy-text { - color: white; - font-size: 1.4em; - } - - i { - color: white; - } -} - /* Problem Set Detail */ #problem_set_form { input[name=add_n_problems] { diff --git a/lib/FormatRenderedProblem.pm b/lib/FormatRenderedProblem.pm index 6743b66349..c5a5f01489 100644 --- a/lib/FormatRenderedProblem.pm +++ b/lib/FormatRenderedProblem.pm @@ -24,28 +24,22 @@ package FormatRenderedProblem; use strict; use warnings; -use XML::Simple qw(XMLout); use JSON; use Digest::SHA qw(sha1_base64); +use Mojo::Util qw(xml_escape); +use Mojo::DOM; use WeBWorK::Utils::AttemptsTable; -use WeBWorK::Utils qw(wwRound getAssetURL); -use WeBWorK::CGI; +use WeBWorK::Utils qw(getAssetURL); use WeBWorK::Utils::LanguageAndDirection; sub formatRenderedProblem { my $ws = shift; # $ws is a WebworkWebservice object. my $ce = $ws->ce; - my $problemText = ''; - my $rh_result = $ws->return_object || {}; # wrap problem in formats - $problemText = 'No output from rendered Problem' unless $rh_result; - - my $courseID = $ws->{inputs_ref}{courseID} // ''; - - my $mt = WeBWorK::Localize::getLangHandle($ws->{inputs_ref}{language} // 'en'); + my $rh_result = $ws->return_object; - my $forbidGradePassback = 1; # Default is to forbid, due to the security issue + my $forbidGradePassback = 1; # Default is to forbid, due to the security issue if (defined($ce->{renderRPCAllowGradePassback}) && $ce->{renderRPCAllowGradePassback} eq @@ -58,7 +52,8 @@ sub formatRenderedProblem { my $renderErrorOccurred = 0; - if (ref($rh_result) && $rh_result->{text}) { + my $problemText = ''; + if ($rh_result->{text}) { $problemText = $rh_result->{text}; } else { $problemText .= "Unable to decode problem text:
      $ws->{error_string}
      " . format_hash_ref($rh_result); @@ -67,45 +62,22 @@ sub formatRenderedProblem { $forbidGradePassback = 1; # due to render error } - my $SITE_URL = $ws->r->server_root_url; - my $FORM_ACTION_URL = $SITE_URL . $ws->r->webwork_url . '/render_rpc'; - - my $user = $ws->{inputs_ref}{user} // ''; - my $passwd = $ws->{inputs_ref}{passwd} // ''; - my $problemSeed = $rh_result->{problem_seed} // $ws->{inputs_ref}{problemSeed} // 6666; - my $psvn = $rh_result->{psvn} // $ws->{inputs_ref}{psvn} // 54321; - my $key = $ws->authen->{session_key}; - my $displayMode = $ws->{inputs_ref}{displayMode} // 'MathJax'; - my $hideWasNotRecordedMessage = $ce->{hideWasNotRecordedMessage} // 0; + my $SITE_URL = $ws->r->server_root_url; - # HTML document language settings - my $formLanguage = $ws->{inputs_ref}{language} // 'en'; - my $COURSE_LANG_AND_DIR = get_lang_and_dir($formLanguage); + my $displayMode = $ws->{inputs_ref}{displayMode} // 'MathJax'; - # Problem source - my $sourceFilePath = $ws->{inputs_ref}{sourceFilePath} // ''; - my $fileName = $ws->{inputs_ref}{fileName} // ''; - my $encoded_source = $ws->{inputs_ref}{problemSource} // ''; + # HTML document language setting + my $formLanguage = $ws->{inputs_ref}{language} // 'en'; - # Select the theme. - my $theme = $ws->{inputs_ref}{theme} || $ce->{defaultTheme}; - - # Add the favicon. - my $favicon = CGI::Link({ href => "$ce->{webworkURLs}{htdocs}/images/favicon.ico", rel => 'shortcut icon' }); - - # Set up the header text - my $problemHeadText = ''; - - # CSS Loads + # Third party CSS # The second element of each array in the following is whether or not the file is a theme file. - my @CSSLoads = map { getAssetURL($ce, $_->[0], $_->[1]) } ( + my @third_party_css = map { getAssetURL($ce, $_->[0], $_->[1]) } ( [ 'bootstrap.css', 1 ], [ 'node_modules/jquery-ui-dist/jquery-ui.min.css', 0 ], [ 'node_modules/@fortawesome/fontawesome-free/css/all.min.css', 0 ], [ 'math4.css', 1 ], [ 'math4-overrides.css', 1 ], ); - $problemHeadText .= CGI::Link({ href => $_, rel => 'stylesheet' }) for (@CSSLoads); # Add CSS files requested by problems via ADD_CSS_FILE() in the PG file # or via a setting of $ce->{pg}{specialPGEnvironmentVars}{extra_css_files} @@ -124,18 +96,15 @@ sub formatRenderedProblem { $cssFilesAdded{ $_->{file} } = 1; if ($_->{external}) { push(@extra_css_files, $_); - $problemHeadText .= CGI::Link({ href => $_->{file}, rel => 'stylesheet' }); } else { - my $url = getAssetURL($ce, $_->{file}); - push(@extra_css_files, { file => $url, external => 0 }); - $problemHeadText .= CGI::Link({ href => $url, rel => 'stylesheet' }); + push(@extra_css_files, { file => getAssetURL($ce, $_->{file}), external => 0 }); } } - # JS Loads + # Third party JavaScript # The second element of each array in the following is whether or not the file is a theme file. # The third element is a hash containing the necessary attributes for the script tag. - my @JSLoads = map { [ getAssetURL($ce, $_->[0], $_->[1]), $_->[2] ] } ( + my @third_party_js = map { [ getAssetURL($ce, $_->[0], $_->[1]), $_->[2] ] } ( [ 'node_modules/jquery/dist/jquery.min.js', 0, {} ], [ 'node_modules/jquery-ui-dist/jquery-ui.min.js', 0, {} ], [ 'node_modules/iframe-resizer/js/iframeResizer.contentWindow.min.js', 0, {} ], @@ -146,16 +115,10 @@ sub formatRenderedProblem { [ 'math4.js', 1, { defer => undef } ], [ 'math4-overrides.js', 1, { defer => undef } ] ); - $problemHeadText .= CGI::script({ src => $_->[0], %{ $_->[1] // {} } }, '') for (@JSLoads); # Get the requested format. my $formatName = $ws->{inputs_ref}{outputformat} // 'simple'; - # Add the local storage javascript for the sticky format. - $problemHeadText .= - CGI::script({ src => getAssetURL($ce, 'js/apps/LocalStorage/localstorage.js'), defer => undef }, '') - if $formatName eq 'sticky'; - # Add JS files requested by problems via ADD_JS_FILE() in the PG file. my @extra_js_files; if (ref($rh_result->{flags}{extra_js_files}) eq 'ARRAY') { @@ -166,30 +129,21 @@ sub formatRenderedProblem { my %attributes = ref($_->{attributes}) eq 'HASH' ? %{ $_->{attributes} } : (); if ($_->{external}) { push(@extra_js_files, $_); - $problemHeadText .= CGI::script({ src => $_->{file}, %attributes }, ''); } else { - my $url = getAssetURL($ce, $_->{file}); - push(@extra_js_files, { file => $url, external => 0, attributes => $_->{attributes} }); - $problemHeadText .= CGI::script({ src => $url, %attributes }, ''); + push(@extra_js_files, + { file => getAssetURL($ce, $_->{file}), external => 0, attributes => $_->{attributes} }); } } } - $problemHeadText .= $rh_result->{header_text} // ''; - $problemHeadText .= $rh_result->{post_header_text} // ''; - my $extra_header_text = $ws->{inputs_ref}{extra_header_text} // ''; - $problemHeadText .= $extra_header_text; - # Set up the problem language and direction - # PG files can request their language and text direction be set. If we do - # not have access to a default course language, fall back to the - # $formLanguage instead. + # PG files can request their language and text direction be set. If we do not have access to a default course + # language, fall back to the $formLanguage instead. my %PROBLEM_LANG_AND_DIR = get_problem_lang_and_dir($rh_result->{flags}, $ce->{perProblemLangAndDirSettingMode}, $formLanguage); my $PROBLEM_LANG_AND_DIR = join(' ', map {qq{$_="$PROBLEM_LANG_AND_DIR{$_}"}} keys %PROBLEM_LANG_AND_DIR); my $previewMode = defined($ws->{inputs_ref}{preview}) || 0; - my $checkMode = defined($ws->{inputs_ref}{WWcheck}) || 0; my $submitMode = defined($ws->{inputs_ref}{WWsubmit}) || 0; my $showCorrectMode = defined($ws->{inputs_ref}{WWcorrectAns}) || 0; # A problemUUID should be added to the request as a parameter. It is used by PG to create a proper UUID for use in @@ -199,15 +153,11 @@ sub formatRenderedProblem { my $showSummary = $ws->{inputs_ref}{showSummary} // 1; my $showAnswerNumbers = $ws->{inputs_ref}{showAnswerNumbers} // 1; - my $color_input_blanks_script = ''; - # Attempts table my $answerTemplate = ''; - if ($renderErrorOccurred) { - # Do not produce an AttemptsTable when we had a rendering error. - $answerTemplate = ' '; - } else { + # Do not produce an AttemptsTable when we had a rendering error. + if (!$renderErrorOccurred) { my $tbl = WeBWorK::Utils::AttemptsTable->new( $rh_result->{answers} // {}, answersSubmitted => $ws->{inputs_ref}{answersSubmitted} // 0, @@ -226,135 +176,31 @@ sub formatRenderedProblem { $answerTemplate = $tbl->answerTemplate; $tbl->imgGen->render(refresh => 1) if $tbl->displayMode eq 'images'; } - # Score summary - my $scoreSummary = ''; - - if ($submitMode) { - if ($renderErrorOccurred) { - $scoreSummary = ''; - } elsif ($problemResult) { - $scoreSummary = CGI::p($mt->maketext( - 'You received a score of [_1] for this attempt.', - wwRound(0, $problemResult->{score} * 100) . '%' - )); - $scoreSummary .= CGI::p($problemResult->{msg}) if ($problemResult->{msg}); - - $scoreSummary .= CGI::p($mt->maketext('Your score was not recorded.')) unless $hideWasNotRecordedMessage; - $scoreSummary .= CGI::hidden( - { id => 'problem-result-score', name => 'problem-result-score', value => $problemResult->{score} }); - } - } - if (!$forbidGradePassback && !$submitMode) { - $forbidGradePassback = 1; - } # Answer hash in XML format used by the PTX format. - my $answerhashXML = $formatName eq 'ptx' ? XMLout($rh_result->{answers} // {}, RootName => 'answerhashes') : ''; - - # Sticky format local storage messages - my $localStorageMessages = CGI::div({ id => 'local-storage-messages' }, - CGI::p('Your overall score for this problem is ' . CGI::span({ id => 'problem-overall-score' }, ''))); - - # Submit buttons (all are shown by default) - my $showPreviewButton = $ws->{inputs_ref}{showPreviewButton} // ''; - my $previewButton = $showPreviewButton eq '0' ? '' : CGI::submit({ - name => 'preview', - id => 'previewAnswers_id', - class => 'btn btn-primary mb-1', - value => $mt->maketext('Preview My Answers') - }); - my $showCheckAnswersButton = $ws->{inputs_ref}{showCheckAnswersButton} // ''; - my $checkAnswersButton = - $showCheckAnswersButton eq '0' - ? '' - : CGI::submit({ name => 'WWsubmit', class => 'btn btn-primary mb-1', value => $mt->maketext('Check Answers') }); - my $showCorrectAnswersButton = $ws->{inputs_ref}{showCorrectAnswersButton} // ''; - my $correctAnswersButton = - $showCorrectAnswersButton eq '0' - ? '' - : CGI::submit( - { name => 'WWcorrectAns', class => 'btn btn-primary mb-1', value => $mt->maketext('Show Correct Answers') } - ); - - my $showSolutions = $ws->{inputs_ref}{showSolutions} // ''; - my $showHints = $ws->{inputs_ref}{showHints} // ''; - - # PG warning messages (this includes translator warnings). - my $warnings = ''; - if ($rh_result->{pg_warnings}) { - $warnings .= CGI::div({ class => 'alert alert-danger mb-2 p-1' }, - CGI::h3('Warning Messages') . join('
      ', split("\n", $rh_result->{pg_warnings}))); + my $answerhashXML = ''; + if ($formatName eq 'ptx') { + my $dom = Mojo::DOM->new->xml(1); + for my $answer (sort keys %{ $rh_result->{answers} }) { + $dom->append_content($dom->new_tag( + $answer, + map { $_ => ($rh_result->{answers}{$answer}{$_} // '') } keys %{ $rh_result->{answers}{$answer} } + )); + } + $dom->wrap_content(''); + $answerhashXML = $dom->to_string; } - # PG debug messages generated with DEBUG_message(); - $rh_result->{debug_messages} = join('
      ', @{ $rh_result->{debug_messages} || [] }); - - # PG warning messages generated with WARN_message(); - my $PG_warning_messages = join('
      ', @{ $rh_result->{warning_messages} || [] }); + # Make sure this is defined and is an array reference as saveGradeToLTI might add to it. + $rh_result->{debug_messages} = [] unless defined $rh_result && ref $rh_result eq 'ARRAY'; - # Internal debug messages generated within PG_core. - # These are sometimes needed if the PG_core warning message system isn't properly set - # up before the bug occurs. In general don't use these unless necessary. - my $internal_debug_messages = join('
      ', @{ $rh_result->{internal_debug_messages} || [] }); + $forbidGradePassback = 1 if !$forbidGradePassback && !$submitMode; # Try to save the grade to an LTI if one provided us data (depending on $forbidGradePassback) my $LTIGradeMessage = saveGradeToLTI($ws, $ce, $rh_result, $forbidGradePassback); - my $debug_messages = $rh_result->{debug_messages}; - - # For debugging purposes (only used in the debug format) - my $clientDebug = $ws->{inputs_ref}{clientDebug} // ''; - my $client_debug_data = $clientDebug ? CGI::h3('Webwork client data') . pretty_print($ws) : ''; - - # Show the footer unless it is explicity disabled. - my $showFooter = $ws->{inputs_ref}{showFooter} // ''; - my $footer = $showFooter eq '0' ? '' : CGI::div({ id => 'footer' }, - "WeBWorK © 2000-2022 | host: $SITE_URL | course: $courseID | format: $formatName | theme: $theme"); - # Execute and return the interpolated problem template - # The json format - if ($formatName eq 'json') { - my $json_output = do('WebworkClient/json_format.pl'); - for my $key (keys %{ $json_output->{hidden_input_field} }) { - $json_output->{hidden_input_field}{$key} =~ s/(\$\w+)/$1/gee; - } - - for my $key (keys %$json_output) { - if (($key =~ /^real_webwork/) - || ($key =~ /^internal/) - || ($key =~ /_A?VI$/)) - { - # Interpolate values - if ($key =~ /_AVI$/) { - map { $json_output->{$key}{$_} =~ s/(\$\w+)/$1/gee } @{ $json_output->{$key} }; - } else { - $json_output->{$key} =~ s/(\$\w+)/$1/gee; - } - if (($key =~ /_A?VI$/)) { - my $new_key = $key =~ s/_A?VI$//r; - $json_output->{$new_key} = $json_output->{$key}; - delete $json_output->{$key}; - } - } - } - - # CSS Loads - $json_output->{head_part100} = \@CSSLoads; - - # JS Loads - $json_output->{head_part200} = \@JSLoads; - - # Add the current score to the %json_output - my $json_score = 0; - if ($submitMode && $problemResult) { - $json_score = wwRound(0, $problemResult->{score} * 100); - } - $json_output->{score} = $json_score; - - return JSON->new->utf8(0)->encode($json_output); - } - # Raw format # This format returns javascript object notation corresponding to the perl hash # with everything that a client-side application could use to work with the problem. @@ -377,8 +223,8 @@ sub formatRenderedProblem { # Include third party css and javascript files. Only jquery, jquery-ui, mathjax, and bootstrap are needed for # PG. See the comments before the subroutine definitions for load_css and load_js in pg/macros/PG.pl. # The other files included are only needed to make themes work in the webwork2 formats. - $output->{third_party_css} = \@CSSLoads; - $output->{third_party_js} = \@JSLoads; + $output->{third_party_css} = \@third_party_css; + $output->{third_party_js} = \@third_party_js; # Say what version of WeBWorK this is $output->{ww_version} = $ce->{WW_VERSION}; @@ -388,15 +234,58 @@ sub formatRenderedProblem { return JSON->new->utf8(0)->encode($output); } - # Find and execute the appropriate template in the WebworkClient folder. - my $template = do("$WeBWorK::Constants::WEBWORK_DIRECTORY/lib/WebworkClient/${formatName}_format.pl"); - return "Unknown format name $formatName
      " unless $template; - - # Interpolate values into the template - $template =~ s/(\$\w+)/$1/gee; - - return $template unless $ws->{inputs_ref}{send_pg_flags}; - return JSON->new->utf8(0)->encode({ html => $template, pg_flags => $rh_result->{flags}, warnings => $warnings }); + # Render the appropriate template in the templates/RPCRenderFormats folder depending on the outputformat. + # "ptx" has a special template. "json" uses the default json template. All others use the default html template. + # Note that render_to_string returns a Mojo::ByteStream object which must be stringified with to_string. + my $template = $ws->r->render_to_string( + template => $formatName eq 'ptx' ? 'RPCRenderFormats/ptx' : 'RPCRenderFormats/default', + $formatName eq 'json' ? (format => 'json') : (), + formatName => $formatName, + ws => $ws, + ce => $ce, + lh => WeBWorK::Localize::getLangHandle($ws->{inputs_ref}{language} // 'en'), + rh_result => $rh_result, + SITE_URL => $SITE_URL, + FORM_ACTION_URL => $SITE_URL . $ws->r->webwork_url . '/render_rpc', + COURSE_LANG_AND_DIR => get_lang_and_dir($formLanguage), + theme => $ws->{inputs_ref}{theme} || $ce->{defaultTheme}, + courseID => $ws->{inputs_ref}{courseID} // '', + user => $ws->{inputs_ref}{user} // '', + passwd => $ws->{inputs_ref}{passwd} // '', + key => $ws->authen->{session_key}, + PROBLEM_LANG_AND_DIR => $PROBLEM_LANG_AND_DIR, + problemSeed => $rh_result->{problem_seed} // $ws->{inputs_ref}{problemSeed} // 6666, + psvn => $rh_result->{psvn} // $ws->{inputs_ref}{psvn} // 54321, + problemUUID => $problemUUID, + displayMode => $displayMode, + third_party_css => \@third_party_css, + extra_css_files => \@extra_css_files, + third_party_js => \@third_party_js, + extra_js_files => \@extra_js_files, + problemText => $problemText, + extra_header_text => $ws->{inputs_ref}{extra_header_text} // '', + answerTemplate => $answerTemplate, + showScoreSummary => $submitMode && !$renderErrorOccurred && $problemResult, + answerhashXML => $answerhashXML, + LTIGradeMessage => $LTIGradeMessage, + sourceFilePath => $ws->{inputs_ref}{sourceFilePath} // '', + problemSource => $ws->{inputs_ref}{problemSource} // '', + uriEncodedProblemSource => $ws->{inputs_ref}{uriEncodedProblemSource} // '', + fileName => $ws->{inputs_ref}{fileName} // '', + formLanguage => $formLanguage, + showSummary => $showSummary, + showHints => $ws->{inputs_ref}{showHints} // '', + showSolutions => $ws->{inputs_ref}{showSolutions} // '', + showAnswerNumbers => $showAnswerNumbers, + showPreviewButton => $ws->{inputs_ref}{showPreviewButton} // '', + showCheckAnswersButton => $ws->{inputs_ref}{showCheckAnswersButton} // '', + showCorrectAnswersButton => $ws->{inputs_ref}{showCorrectAnswersButton} // '', + showFooter => $ws->{inputs_ref}{showFooter} // '', + pretty_print => \&pretty_print + )->to_string; + + return $template if $formatName eq 'json' || !$ws->{inputs_ref}{send_pg_flags}; + return JSON->new->utf8(0)->encode({ html => $template, pg_flags => $rh_result->{flags} }); } sub saveGradeToLTI { @@ -489,22 +378,22 @@ EOS $response->content =~ /\s*(\w+)\s*<\/imsx_codeMajor>/; my $message = $1; if ($message ne 'success') { - $LTIGradeMessage = CGI::p("Unable to update LMS grade. Error: $message"); - $rh_result->{debug_messages} .= CGI::escapeHTML($response->content); + $LTIGradeMessage = $ws->r->tag('p', "Unable to update LMS grade. Error: $message")->to_string; + push(@{ $rh_result->{debug_messages} }, xml_escape($response->content)); } else { - $LTIGradeMessage = CGI::p('Grade sucessfully saved.'); + $LTIGradeMessage = $ws->r->tag('p', 'Grade sucessfully saved.')->to_string; } } else { - $LTIGradeMessage = CGI::p('Unable to update LMS grade. Error: ' . $response->message); - $rh_result->{debug_messages} .= CGI::escapeHTML($response->content); + $LTIGradeMessage = $ws->r->tag('p', 'Unable to update LMS grade. Error: ' . $response->message)->to_string; + push(@{ $rh_result->{debug_messages} }, xml_escape($response->content)); } } # save parameters for next time - $LTIGradeMessage .= CGI::input({ type => 'hidden', name => 'lis_outcome_service_url', value => $request_url }); - $LTIGradeMessage .= CGI::input({ type => 'hidden', name => 'oauth_consumer_key', value => $consumer_key }); - $LTIGradeMessage .= CGI::input({ type => 'hidden', name => 'oauth_signature_method', value => $signature_method }); - $LTIGradeMessage .= CGI::input({ type => 'hidden', name => 'lis_result_sourcedid', value => $sourcedid }); + $LTIGradeMessage .= $ws->r->hidden_field(lis_outcome_service_url => $request_url)->to_string; + $LTIGradeMessage .= $ws->r->hidden_field(oauth_consumer_key => $consumer_key)->to_string; + $LTIGradeMessage .= $ws->r->hidden_field(oauth_signature_method => $signature_method)->to_string; + $LTIGradeMessage .= $ws->r->hidden_field(lis_result_sourcedid => $sourcedid)->to_string; return $LTIGradeMessage; } @@ -526,8 +415,10 @@ sub pretty_print { if (!ref $r_input) { $out = $r_input if defined $r_input; $out =~ s/}; @@ -543,7 +434,7 @@ sub pretty_print { || ($key eq "externalPrograms") || ($key eq "permissionLevels") || ($key eq "seed_ce")); - $out .= "$key=> " . pretty_print($r_input->{$key}) . ""; + $out .= "$key=> " . pretty_print($r_input->{$key}, $level) . ""; } $out .= ''; } elsif (ref $r_input eq 'ARRAY') { diff --git a/lib/HardcopyRenderedProblem.pm b/lib/HardcopyRenderedProblem.pm new file mode 100644 index 0000000000..918cd390ff --- /dev/null +++ b/lib/HardcopyRenderedProblem.pm @@ -0,0 +1,275 @@ +################################################################################ +# WeBWorK Online Homework Delivery System +# Copyright © 2000-2022 The WeBWorK Project, https://github.com/openwebwork +# +# This program is free software; you can redistribute it and/or modify it under +# the terms of either: (a) the GNU General Public License as published by the +# Free Software Foundation; either version 2, or (at your option) any later +# version, or (b) the "Artistic License" which comes with this package. +# +# This program is distributed in the hope that it will be useful, but WITHOUT +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +# FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the +# Artistic License for more details. +################################################################################ + +=head1 NAME + +HardcopyRenderedProblem.pm -- Generate a pdf file or zip file containing a tex +file and the neccessary files to generate the pdf file from the result of the +renderProblem method. + +=cut + +package HardcopyRenderedProblem; + +use strict; +use warnings; + +use File::Path; +use String::ShellQuote; +use Archive::Zip qw(:ERROR_CODES); +use Mojo::File qw(path tempdir); + +sub hardcopyRenderedProblem { + my $ws = shift; # $ws is a WebworkWebservice object. + my $r = $ws->r; + my $ce = $ws->ce; + + my $rh_result = $ws->return_object; + + # Deal with PG errors + return $rh_result->{errors} if $rh_result->{flags}{error_flag}; + + return 'Unable to decode problem text.' unless $rh_result->{text}; + + my @errors; + + my $courseID = $ws->{inputs_ref}{courseID}; + my $userID = $ws->{inputs_ref}{user}; + + # Create the parent directory for the temporary working directory. + my $temp_dir_parent_path = path("$ce->{webworkDirs}{tmp}/$courseID/hardcopy/$userID"); + eval { $temp_dir_parent_path->make_path }; + if ($@) { + push(@errors, "Couldn't create hardcopy directory $temp_dir_parent_path: $@"); + return join("\n", @errors); + } + + # Create a randomly named directory in the hardcopy directory. + my $temp_dir_path = eval { tempdir('work.XXXXXXXX', DIR => $temp_dir_parent_path) }; + if ($@) { + push(@errors, "Couldn't create temporary directory: $@"); + return join("\n", @errors); + } + + # Use the basename of the source file path without the extension prefixed with the course id and user id for the + # working directory namd and download filename. + my $returnFileName = + "$courseID.$userID." . ((($ws->{inputs_ref}{sourceFilePath} =~ s/^.*\///r) =~ s/\.[^.]*$//r) || 'hardcopy'); + + # Create a subdirectory of that to do all of the work in. This directory will be zipped + # if the tex outputformat is specified or if pdf generation fails or has errors. + my $working_dir = $temp_dir_path->child($returnFileName); + eval { $working_dir->make_path }; + if ($@) { + push(@errors, "Couldn't create working directory $working_dir: $@"); + return join("\n", @errors); + } + + # Create TeX file. + my $tex_file = $working_dir->child('hardcopy.tex'); + my $fh = $tex_file->open('>:encoding(UTF-8)'); + unless ($fh) { + push(@errors, qq{Failed to open file "$tex_file" for writing: $!}); + return join("\n", @errors); + } + write_tex($ws, $fh, \@errors); + $fh->close; + + # Call the pdf generation subroutine if the pdf outputformat was specified or if no outputformat was specified. + if (!$ws->{inputs_ref}{outputformat} || $ws->{inputs_ref}{outputformat} eq 'pdf') { + generate_hardcopy_pdf($ws, $working_dir, \@errors); + + # Send the pdf file if it was successfully generated with no errors. + my $pdf_file = $working_dir->child('hardcopy.pdf'); + if (-e $pdf_file && !@errors) { + $r->res->headers->content_type('application/pdf'); + $r->res->headers->add('Content-Disposition' => qq{attachment; filename=$returnFileName.pdf}); + $r->reply->file($pdf_file); + return; + } + } + + # Call the tex generation subroutine if the tex outputformat was specified, + # or if there were errors in generating the pdf file. + generate_hardcopy_tex($ws, $working_dir, \@errors); + + # Send the zip file if it exists. + my $zip_file = $temp_dir_path->child('hardcopy.zip'); + if (-e $zip_file) { + $r->res->headers->content_type('application/zip'); + $r->res->headers->add('Content-Disposition' => qq{attachment; filename=$returnFileName.zip}); + $r->reply->file($zip_file); + return; + } + + # Something has really gone wrong. A tex file was written, but hardcopy generation failed or had errors, and a zip + # file could not be created. Just return the errors that have accumulated. Probably a lengthy list. + return join("\n", @errors); +} + +# This subroutine assumes that the TeX source file is located at $working_dir/hardcopy.tex. +sub generate_hardcopy_tex { + my ($ws, $working_dir, $errors) = @_; + + my $src_file = $working_dir->child('hardcopy.tex'); + + # Copy the common tex files into the working directory + my $ce = $ws->r->ce; + my $common_dir = path($ce->{webworkDirs}{texinputs_common}); + for (qw{packages.tex CAPA.tex PGML.tex}) { + eval { $common_dir->child($_)->copy_to($working_dir) }; + push(@$errors, qq{Failed to copy "$ce->{webworkDirs}{texinputs_common}/$_" into directory "$working_dir": $@}) + if $@; + } + + # Attempt to copy image files used into the working directory. + my $resource_list = $ws->return_object->{resource_list}; + if ($resource_list && keys %$resource_list) { + my $data = eval { $src_file->slurp }; + unless ($@) { + for my $resource (keys %$resource_list) { + my $file_path = path($resource_list->{$resource}); + $data =~ s{$file_path}{$file_path->basename}ge; + + eval { $file_path->copy_to($working_dir) }; + push(@$errors, qq{Failed to copy image "$file_path" into directory "$working_dir": $@}) + if $@; + } + + # Rewrite the tex file with the image paths stripped. + eval { $src_file->spurt($data) }; + push(@$errors, "Error rewriting $src_file: $@") if $@; + } else { + push(@$errors, qq{Failed to open "$$src_file" for reading: $@}); + } + } + + # Write any errors to a file to include in the zip file. + eval { $working_dir->child('hardcopy-generation-errors.log')->spurt(join("\n", @$errors)) } if @$errors; + push(@$errors, "Failed to generate error log file: $@") if $@; + + # Create a zip archive of the bundle directory + my $zip = Archive::Zip->new; + $zip->addTree($working_dir->dirname->to_string); + + push(@$errors, qq{Failed to create zip archive of directory "$working_dir"}) + unless ($zip->writeToFileNamed($working_dir->dirname->child('hardcopy.zip')->to_string) == AZ_OK); + + return; +} + +# This subroutine assumes that the TeX source file is located at $working_dir/hardcopy.tex. +sub generate_hardcopy_pdf { + my ($ws, $working_dir, $errors) = @_; + + # Save the current working directory and change to the temporary directory. + my $cwd = path->to_abs; + chdir($working_dir); + + # Call pdflatex + my $pdflatex_cmd = + 'TEXINPUTS=.:' + . shell_quote($ws->r->ce->{webworkDirs}{texinputs_common}) . ': ' + . $ws->r->ce->{externalPrograms}{pdflatex} + . ' > pdflatex.stdout 2> pdflatex.stderr hardcopy'; + + if (my $rawexit = system $pdflatex_cmd) { + my $exit = $rawexit >> 8; + my $signal = $rawexit & 127; + my $core = $rawexit & 128; + push(@$errors, + qq{Failed to convert TeX to PDF with command "$pdflatex_cmd" (exit=$exit signal=$signal core=$core).}, + q{See the "hardcopy.log" file for details.}); + } + + # Restore the current working directory to what it was before. + chdir($cwd); + + return; +} + +sub write_tex { + my ($ws, $FH, $errors) = @_; + my $r = $ws->r; + my $ce = $r->ce; + + # Determine snippets theme directory. + my $themeDir = "$ce->{webworkDirs}{conf}/snippets/hardcopyThemes/" + . ($ws->{inputs_ref}{hardcopy_theme} // $ce->{hardcopyTheme}); + + write_tex_file($FH, $ce->{webworkFiles}{hardcopySnippets}{preamble} // "$themeDir/hardcopyPreamble.tex", $errors); + write_problem_tex($ws, $FH); + write_tex_file($FH, $ce->{webworkFiles}{hardcopySnippets}{postamble} // "$themeDir/hardcopyPostamble.tex", $errors); + + return; +} + +sub write_problem_tex { + my ($ws, $FH) = @_; + my $r = $ws->r; + + my $rh_result = $ws->return_object; + + print $FH " {\\footnotesize\\path|$ws->{inputs_ref}{sourceFilePath}|}\n\n\\vspace{\\baselineskip}" + if ($ws->{inputs_ref}{showSourceFile}); + + print $FH $rh_result->{text}; + + # Write the correct answers if requested and there are answers to write. + if ($ws->{inputs_ref}{WWcorrectAns}) { + my @ans_entry_order = @{ $rh_result->{flags}{ANSWER_ENTRY_ORDER} // [] }; + if (@ans_entry_order) { + my $correctTeX = + "\n\n\\vspace{\\baselineskip}\\par{\\small{\\it " + . $r->maketext("Correct Answers:") + . "}\n\\begin{itemize}\n"; + + for (@ans_entry_order) { + $correctTeX .= + "\\item\n\$\\displaystyle " + . ($rh_result->{answers}{$_}{correct_ans_latex_string} + || "\\text{$rh_result->{answers}{$_}{correct_ans}}") + . "\$\n"; + } + + $correctTeX .= "\\end{itemize}}\\par\n"; + + print $FH $correctTeX; + } + } + + # If there are any PG warnings and the view_problem_debugging_info parameter was set, + # then append the warnings to end of the tex file. + if ($ws->{inputs_ref}{view_problem_debugging_info} && $rh_result->{pg_warnings}) { + print $FH "\n\n\\vspace{\\baselineskip}\\par\n" . $r->maketext('Warning messages:') . "\n\\begin{itemize}\n"; + for (split("\n", $rh_result->{pg_warnings})) { + print $FH "\\item \\verb|$_|\n"; + } + print $FH "\\end{itemize}\n"; + } + + return; +} + +sub write_tex_file { + my ($FH, $file, $errors) = @_; + + eval { print $FH path($file)->slurp }; + push(@$errors, qq{Failed to include TeX file "$file": $@}) if $@; + + return; +} + +1; diff --git a/lib/WeBWorK/ContentGenerator/Hardcopy.pm b/lib/WeBWorK/ContentGenerator/Hardcopy.pm index bdc8a26726..bf81981373 100644 --- a/lib/WeBWorK/ContentGenerator/Hardcopy.pm +++ b/lib/WeBWorK/ContentGenerator/Hardcopy.pm @@ -968,51 +968,40 @@ sub generate_hardcopy_tex { } } - # Attempt to copy image files used into the bundle directory - # For security reasons only files in the $ce->{courseDirs}{html_temp}/images are included. - # The file names of the images are only allowed to contain alphanumeric characters, underscores, dashes, and - # periods. No spaces or slashes, etc. This will usually be all of the included images. - if (open(my $in_fh, "<", "$bundle_path/$src_name")) { - local $/; - my $data = <$in_fh>; - close($in_fh); - - # Extract the included image file names and strip the absolute path in the tex file. - my @image_files; - my $image_tmp_dir = $ce->{courseDirs}{html_temp} . "/images/"; - $data =~ s{\\includegraphics\[([^]]*)\]\{$image_tmp_dir([^\}]*)\}} - {push @image_files, $2; "\\includegraphics[$1]{$2}"}ge; - - # Rewrite the tex file with the image paths stripped. - open(my $out_fh, ">", "$bundle_path/$src_name") - or warn "Can't open $bundle_path/$src_name for writing."; - print $out_fh $data; - close $out_fh; - - for (@image_files) { - # This is a little protection in case a student enters an answer like - # \includegraphics[]{$ce->{courseDirs}{html_temp}/images/malicious code or absolute system file name} - $self->add_errors("Unable to safely copy image '" - . CGI::code(CGI::escapeHTML("$image_tmp_dir$_")) - . "' into directory '" - . CGI::code(CGI::escapeHTML($bundle_path)) - . "'."), warn "Invalid image file name '$_' detected. Possible malicious activity?", next - unless $_ =~ /^[\w._-]*$/ && -f "$image_tmp_dir$_"; - - # Copy the image file into the bundle directory. - my $cp_cmd = "2>&1 $ce->{externalPrograms}{cp} " . shell_quote("$image_tmp_dir$_", $bundle_path); - my $cp_out = readpipe $cp_cmd; - if ($?) { - $self->add_errors("Failed to copy image '" - . CGI::code(CGI::escapeHTML("$image_tmp_dir$_")) - . "' into directory '" - . CGI::code(CGI::escapeHTML($bundle_path)) . "':" - . CGI::br() - . CGI::pre(CGI::escapeHTML($cp_out))); + # Attempt to copy image files used into the working directory. + my $resource_list = $self->{resource_list}; + if (ref $resource_list eq 'ARRAY' && @$resource_list) { + if (open(my $in_fh, "<", "$bundle_path/$src_name")) { + local $/; + my $data = <$in_fh>; + close($in_fh); + + for my $resource (@$resource_list) { + my $basename = $resource =~ s/.*\///r; + $data =~ s{$resource}{$basename}g; + + # Copy the image file into the bundle directory. + my $cp_cmd = "2>&1 $ce->{externalPrograms}{cp} " . shell_quote($resource, $bundle_path); + my $cp_out = readpipe $cp_cmd; + if ($?) { + $self->add_errors("Failed to copy image '" + . CGI::code(CGI::escapeHTML($resource)) + . "' into directory '" + . CGI::code(CGI::escapeHTML($bundle_path)) . "':" + . CGI::br() + . CGI::pre(CGI::escapeHTML($cp_out))); + } } + + # Rewrite the tex file with the image paths stripped. + open(my $out_fh, ">", "$bundle_path/$src_name") + or warn "Can't open $bundle_path/$src_name for writing."; + print $out_fh $data; + close $out_fh; + } else { + $self->add_errors( + "Failed to open '" . CGI::code(CGI::escapeHTML("$bundle_path/$src_name")) . "' for reading."); } - } else { - $self->add_errors("Failed to open '" . CGI::code(CGI::escapeHTML("$bundle_path/$src_name")) . "' for reading."); } # Create a zip archive of the bundle directory @@ -1389,6 +1378,9 @@ async sub write_problem_tex { } ); + push(@{ $self->{resource_list} }, map { $pg->{resource_list}{$_} } keys %{ $pg->{resource_list} }) + if ref $pg->{resource_list} eq 'HASH'; + # only bother to generate this info if there were warnings or errors my $edit_url; my $problem_name; diff --git a/lib/WeBWorK/ContentGenerator/Instructor/AchievementEditor.pm b/lib/WeBWorK/ContentGenerator/Instructor/AchievementEditor.pm index dfb215e16c..7515c58c6a 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/AchievementEditor.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/AchievementEditor.pm @@ -30,10 +30,11 @@ use WeBWorK::CGI; use WeBWorK::Utils qw(readFile surePathToFile path_is_subdir x getAssetURL); use HTML::Entities; use URI::Escape; -use WeBWorK::Utils qw(has_aux_files not_blank); +use WeBWorK::Utils qw(not_blank); use File::Copy; use WeBWorK::Utils::Tasks qw(fake_user fake_set); -use WeBWorK::ContentGenerator::Instructor::CodeMirrorEditor; +use WeBWorK::ContentGenerator::Instructor::CodeMirrorEditor + qw(generate_codemirror_html generate_codemirror_controls_html output_codemirror_static_files); use Fcntl; use constant ACTION_FORMS => [qw(save save_as)]; @@ -218,8 +219,8 @@ sub body { ? CGI::hidden({ name => 'sourceFilePath', value => $self->{sourceFilePath} }) : ''; - WeBWorK::ContentGenerator::Instructor::CodeMirrorEditor::output_codemirror_html($r, 'achievementContents', - $achievementContents); + print CGI::div({ class => 'mb-2' }, generate_codemirror_html($r, 'achievementContents', $achievementContents)); + print generate_codemirror_controls_html($r); ######### print action forms my @formsToShow = @{ ACTION_FORMS() }; @@ -720,7 +721,7 @@ sub output_JS { my $self = shift; my $ce = $self->r->ce; - WeBWorK::ContentGenerator::Instructor::CodeMirrorEditor::output_codemirror_static_files($ce); + output_codemirror_static_files($ce); print CGI::script({ src => getAssetURL($ce, 'js/apps/ActionTabs/actiontabs.js'), defer => undef }, ''); diff --git a/lib/WeBWorK/ContentGenerator/Instructor/CodeMirrorEditor.pm b/lib/WeBWorK/ContentGenerator/Instructor/CodeMirrorEditor.pm index 47103c7855..e2670bd4f5 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/CodeMirrorEditor.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/CodeMirrorEditor.pm @@ -14,6 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::Instructor::CodeMirrorEditor; +use parent qw(Exporter); =head1 NAME @@ -23,11 +24,13 @@ AchievementEditor.pm and PGProblemEditor.pm modules. =cut +use strict; +use warnings; + use CGI; use WeBWorK::Utils qw(getAssetURL); -use strict; -use warnings; +our @EXPORT_OK = qw(generate_codemirror_html generate_codemirror_controls_html output_codemirror_static_files); # Available CodeMirror themes use constant CODEMIRROR_THEMES => [ @@ -64,115 +67,109 @@ use constant CODEMIRROR_ADDONS_JS => [ 'scroll/annotatescrollbar.js', 'edit/matchbrackets.js' ]; -sub output_codemirror_html { +sub generate_codemirror_html { my ($r, $name, $contents) = @_; + + # Output the textarea that will be used by CodeMirror. + # If CodeMirror is disabled, then this is directly the editing area. + return CGI::textarea({ + id => $name, + name => $name, + default => $contents, + class => 'codeMirrorEditor', + override => 1, + }); +} + +sub generate_codemirror_controls_html { + my $r = shift; my $ce = $r->ce; - if ($ce->{options}{PGCodeMirror}) { - # Output the textarea that will be used by CodeMirror. - print CGI::div( - { class => 'mb-2' }, - CGI::textarea({ - id => $name, - name => $name, - default => $contents, - class => 'codeMirrorEditor', - override => 1, - }), - ); - - # Construct the labels and values for the theme menu. - my ($themeLabels, $themeValues) = ({ default => 'default' }, ['default']); - for (@{ CODEMIRROR_THEMES() }) { - my $value = getAssetURL($ce, "node_modules/codemirror/theme/$_.css"); - push @$themeValues, $value; - $themeLabels->{$value} = $_; - } + return '' unless $ce->{options}{PGCodeMirror}; - # Construct the labels and values for the keymap menu. - my ($keymapLabels, $keymapValues) = ({ default => 'default' }, ['default']); - for (@{ CODEMIRROR_KEYMAPS() }) { - my $value = getAssetURL($ce, "node_modules/codemirror/keymap/$_.js"); - push @$keymapValues, $value; - $keymapLabels->{$value} = $_; - } + # Construct the labels and values for the theme menu. + my ($themeLabels, $themeValues) = ({ default => 'default' }, ['default']); + for (@{ CODEMIRROR_THEMES() }) { + my $value = getAssetURL($ce, "node_modules/codemirror/theme/$_.css"); + push @$themeValues, $value; + $themeLabels->{$value} = $_; + } - # Output the html elements for setting the CodeMirror options. - print CGI::div( - { class => 'row align-items-center' }, + # Construct the labels and values for the keymap menu. + my ($keymapLabels, $keymapValues) = ({ default => 'default' }, ['default']); + for (@{ CODEMIRROR_KEYMAPS() }) { + my $value = getAssetURL($ce, "node_modules/codemirror/keymap/$_.js"); + push @$keymapValues, $value; + $keymapLabels->{$value} = $_; + } + + # Output the html elements for setting the CodeMirror options. + return CGI::div( + { class => 'row align-items-center' }, + CGI::div( + { class => 'col-sm-auto mb-2' }, CGI::div( - { class => 'col-sm-auto mb-2' }, + { class => 'row align-items-center' }, + CGI::label({ for => 'selectTheme', class => 'col-form-label col-auto' }, $r->maketext('Theme:')), CGI::div( - { class => 'row align-items-center' }, - CGI::label( - { for => 'selectTheme', class => 'col-form-label col-auto' }, $r->maketext('Theme:') - ), - CGI::div( - { class => 'col-auto' }, - CGI::popup_menu({ - name => 'selectTheme', - id => 'selectTheme', - values => $themeValues, - labels => $themeLabels, - default => 'default', - class => 'form-select form-select-sm d-inline w-auto' - }) - ) + { class => 'col-auto' }, + CGI::popup_menu({ + name => 'selectTheme', + id => 'selectTheme', + values => $themeValues, + labels => $themeLabels, + default => 'default', + class => 'form-select form-select-sm d-inline w-auto' + }) ) - ), + ) + ), + CGI::div( + { class => 'col-sm-auto mb-2' }, CGI::div( - { class => 'col-sm-auto mb-2' }, + { class => 'row align-items-center' }, + CGI::label({ for => 'selectKeymap', class => 'col-form-label col-auto' }, $r->maketext('Key Map:')), CGI::div( - { class => 'row align-items-center' }, - CGI::label( - { for => 'selectKeymap', class => 'col-form-label col-auto' }, - $r->maketext('Key Map:') - ), - CGI::div( - { class => 'col-auto' }, - CGI::popup_menu({ - name => 'selectKeymap', - id => 'selectKeymap', - values => $keymapValues, - labels => $keymapLabels, - default => 'default', - class => 'form-select form-select-sm d-inline w-auto' - }) - ) + { class => 'col-auto' }, + CGI::popup_menu({ + name => 'selectKeymap', + id => 'selectKeymap', + values => $keymapValues, + labels => $keymapLabels, + default => 'default', + class => 'form-select form-select-sm d-inline w-auto' + }) ) - ), + ) + ), + CGI::div( + { class => 'col-sm-auto mb-2' }, CGI::div( - { class => 'col-sm-auto mb-2' }, - CGI::div( - { class => 'form-check mb-0' }, - CGI::input({ - type => 'checkbox', - id => 'enableSpell', - class => 'form-check-input' - }), - CGI::label( - { for => 'enableSpell', class => 'form-check-label' }, - $r->maketext('Enable Spell Checking') - ) + { class => 'form-check mb-0' }, + CGI::input({ + type => 'checkbox', + id => 'enableSpell', + class => 'form-check-input' + }), + CGI::label( + { for => 'enableSpell', class => 'form-check-label' }, + $r->maketext('Enable Spell Checking') ) - ), + ) + ), + CGI::div( + { class => 'col-sm-auto mb-2' }, CGI::div( - { class => 'col-sm-auto mb-2' }, - CGI::div( - { class => 'form-check mb-0' }, - CGI::input({ - type => 'checkbox', - id => 'forceRTL', - class => 'form-check-input' - }), - CGI::label( - { for => 'forceRTL', class => 'form-check-label' }, - 'Force editor to RTL' # FIXME should have $r->maketext() - ) - ) + { class => 'form-check mb-0' }, + CGI::input({ + type => 'checkbox', + id => 'forceRTL', + class => 'form-check-input' + }), + CGI::label({ for => 'forceRTL', class => 'form-check-label' }, $r->maketext('Force editor to RTL')) ) - ); - } + ) + ); } sub output_codemirror_static_files { @@ -195,7 +192,12 @@ sub output_codemirror_static_files { print CGI::script({ src => getAssetURL($ce, 'js/apps/PGCodeMirror/PG.js'), defer => undef }, ''); print CGI::script({ src => getAssetURL($ce, 'js/apps/PGCodeMirror/pgeditor.js'), defer => undef }, ''); + } else { + # The textarea styles in this file are still needed if CodeMirror is disabled. + print CGI::Link({ href => getAssetURL($ce, 'js/apps/PGCodeMirror/pgeditor.css'), rel => 'stylesheet' }); } + + return; } 1; diff --git a/lib/WeBWorK/ContentGenerator/Instructor/PGProblemEditor.pm b/lib/WeBWorK/ContentGenerator/Instructor/PGProblemEditor.pm index 8910c476c3..6800ba41c4 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/PGProblemEditor.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/PGProblemEditor.pm @@ -14,427 +14,305 @@ ################################################################################ package WeBWorK::ContentGenerator::Instructor::PGProblemEditor; -use base qw(WeBWorK); -use base qw(WeBWorK::ContentGenerator::Instructor); - -use constant DEFAULT_SEED => 123456; +use parent qw(WeBWorK::ContentGenerator::Instructor); =head1 NAME WeBWorK::ContentGenerator::Instructor::PGProblemEditor - Edit a pg file +This editor will edit problem files, set header files, or files such as +course_info whose name is defined in the defaults.config file. + +Only files under the template directory (or linked to this location) can be +edited. + +The course information and problems are located in the course templates +directory. Course information has the name defined by +$ce->{courseFiles}{course_info} + +editMode = temporaryFile | savedFile + +This flag is read by Problem.pm and ProblemSet.pm (perhaps others). + +The value of temporaryFile means view the temp file defined by +fname.user_name.tmp instead of the file fname. + +The value of savedFile means to use fname directly. + +The suffix for a temporary file is "user_name.tmp" by default. + +=head2 File types (file_type) which can be edited. + +=over + +=item problem + +This is the most common type. This editor can be called by an instructor when +viewing any problem. the information for retrieving the source file is found +using the problemID in order to look look up the source file path. + +=item source_path_for_problem_file + +This is the same as the 'problem' file type except that the source for the +problem is found in the parameter $r->param('sourceFilePath'). This path is +relative to the templates directory + +=item set_header + +This is a special case of editing the problem. The set header is often listed +as problem 0 in the set's list of problems. + +=item hardcopy_header + +This is a special case of editing the problem. The hardcopy_header is often +listed as problem 0 in the set's list of problems. But it is used instead of +set_header when producing a hardcopy of the problem set in the TeX format, +instead of producing HTML formatted version for use on the computer screen. + +=item course_info + +This allows editing of the course_info.txt file which gives general information +about the course. It is called from the ProblemSets.pm module. + +=item blank_problem + +This is a special case which allows one to create and edit a new PG problem. +The "stationary" source for this problem is stored in the conf/snippets +directory and defined in defaults.config as +$webworkFiles{screenSnippets}{blankProblem} + +=back + +=head2 Action + +The behavior on submit is defined by the value of $file_type and the value of +the submit button pressed (the action). + + Requested actions and aliases + Save: action = save + Save as: action = save_as + View Problem: action = view + Add this problem to: action = add_problem + Make this set header for: action = add_problem + Revert: action = revert + Generate Hardcopy: actoin = hardcopy + +An undefined or invalid action is interpreted as an initial edit of the file. + +=head2 Notes + +The editFilePath and tempFilePath should always be set. The tempFilePath may +not exist. The path to the actual file being edited is stored in inputFilePath. + =cut use strict; use warnings; -use WeBWorK::CGI; -use WeBWorK::Utils qw(readFile surePathToFile path_is_subdir jitar_id_to_seq seq_to_jitar_id x getAssetURL - format_set_name_display); + use HTML::Entities; use URI::Escape; -use WeBWorK::Utils qw(has_aux_files not_blank); use File::Copy; use File::Basename qw(dirname); -use WeBWorK::Utils::Tasks qw(fake_user fake_set renderProblems); -use WeBWorK::ContentGenerator::Instructor::CodeMirrorEditor; -use Fcntl; -########################################################### -# This editor will edit problem files or set header files or files, such as course_info -# whose name is defined in the defaults.config file -# -# Only files under the template directory ( or linked to this location) can be edited. -# -# The course information and problems are located in the course templates directory. -# Course information has the name defined by courseFiles->{course_info} -# -# Only files under the template directory ( or linked to this location) can be edited. -# -# editMode = temporaryFile (view the temp file defined by course_info.txt.user_name.tmp -# instead of the file course_info.txt) -# this flag is read by Problem.pm and ProblemSet.pm, perhaps others -# The TEMPFILESUFFIX is "user_name.tmp" by default. It's definition should be moved to Instructor.pm #FIXME -########################################################### - -########################################################### -# The behavior of this module is essentially defined -# by the values of $file_type and the submit button which is placed in $action -############################################################# -# File types which can be edited -# -# file_type eq 'problem' -# this is the most common type -- this editor can be called by an instructor when viewing any problem. -# the information for retrieving the source file is found using the problemID in order to look -# look up the source file path. -# -# file_type eq 'source_path_for_problem_file' -# This is the same as the 'problem' file type except that the source for the problem is found in -# the parameter $r->param('sourceFilePath'). This path is relative to the templates directory -# -# file_type eq 'set_header' -# This is a special case of editing the problem. The set header is often listed as problem 0 in the set's list of problems. -# -# file_type eq 'hardcopy_header' -# This is a special case of editing the problem. The hardcopy_header is often listed as problem 0 in the set's list of problems. -# But it is used instead of set_header when producing a hardcopy of the problem set in the TeX format, instead of producing HTML -# formatted version for use on the computer screen. -# -# file_type eq 'course_info' -# This allows editing of the course_info.txt file which gives general information about the course. It is called from the -# ProblemSets.pm module. -# -# file_type eq 'options_info' -# This allows editing of the options_info.txt file which gives general information about the course. It is called from the -# Options.pm module. -# -# file_type eq 'blank_problem' -# This is a special call which allows one to create and edit a new PG problem. The "stationery" source for this problem is -# stored in the conf/snippets directory and defined in defaults.config by $webworkFiles{screenSnippets}{blankProblem} -############################################################# -# Requested actions -- these and the file_type determine the state of the module -# Save ---- action = save -# Save as ---- action = save_as -# View Problem ---- action = view -# Add this problem to: ---- action = add_problem -# Make this set header for: ---- action = add_problem -# Revert ---- action = revert -# no submit button defined ---- action = fresh_edit -################################################### -# -# Determining which is the correct path to the file is a mess!!! FIXME -# The path to the file to be edited is eventually put in tempFilePath -# -# (tempFilePath)(editFilePath)(forcedSourceFile) -#input parameter is: sourceFilePath -################################################################# -# params read -# user -# effectiveUser -# submit -# file_type -# problemSeed -# displayMode -# edit_level -# make_local_copy -# sourceFilePath -# problemContents -# save_to_new_file -# +use WeBWorK::Utils qw(getAssetURL jitar_id_to_seq not_blank path_is_subdir seq_to_jitar_id x format_set_name_display + surePathToFile readDirectory readFile max); +use WeBWorK::ContentGenerator::Instructor::CodeMirrorEditor + qw(generate_codemirror_html generate_codemirror_controls_html output_codemirror_static_files); -#hiding add_problem option to see if its needed -use constant ACTION_FORMS => [qw(view save save_as add_problem revert)]; -use constant ACTION_FORM_TITLES => { # editor tabs - view => x("View"), - add_problem => x("Append"), - save => x("Update"), - save_as => x("New Version"), - revert => x("Revert"), -}; +use constant DEFAULT_SEED => 123456; -# permissions needed to perform a given action -use constant FORM_PERMS => { - view => "modify_student_data", - add_problem => "modify_student_data", - make_local_copy => "modify_student_data", - save => "modify_student_data", - save_as => "modify_student_data", - revert => "modify_student_data", +# Editor tabs +use constant ACTION_FORMS => [qw(view hardcopy save save_as add_problem revert)]; +use constant ACTION_FORM_TITLES => { + view => x('View/Reload'), + hardcopy => x('Generate Hardcopy'), + add_problem => x('Append'), + save => x('Update'), + save_as => x('New Version'), + revert => x('Revert'), }; -our $BLANKPROBLEM = 'blankProblem.pg'; +my $BLANKPROBLEM = 'blankProblem.pg'; async sub pre_header_initialize { - my ($self) = @_; + my $self = shift; my $r = $self->r; my $ce = $r->ce; my $urlpath = $r->urlpath; my $authz = $r->authz; my $user = $r->param('user'); - $self->{courseID} = $urlpath->arg("courseID"); - $self->{setID} = $r->urlpath->arg("setID"); # using $r->urlpath->arg("setID") ||'' causes trouble with set 0!!! - $self->{problemID} = $r->urlpath->arg("problemID"); - - # parse setID, which may come in with version data - my $fullSetID = $self->{setID}; - if (defined($fullSetID)) { - if ($fullSetID =~ /,v(\d+)$/) { - $self->{versionID} = $1; - $self->{setID} =~ s/,v\d+$//; - } - $self->{fullSetID} = $fullSetID; - } - - my $submit_button = $r->param('submit'); # obtain submit command from form - my $actionID = $r->param('action'); - my $file_type = $r->param("file_type") || ''; - my $setName = $self->{setID}; - my $versionedSetName = $self->{fullSetID}; - my $problemNumber = $self->{problemID}; # Check permissions - return unless ($authz->hasPermissions($user, "access_instructor_tools")); - return unless ($authz->hasPermissions($user, "modify_problem_sets")); - - ############################################################################## - # displayMode and problemSeed - # - # Determine the display mode - # If $self->{problemSeed} was obtained within saveFileChanges from the problem_record - # then it can be overridden by the value obtained from the form. - # Insure that $self->{problemSeed} has some non-empty value - # displayMode and problemSeed - # will be needed for viewing the problem via redirect. - # They are also two of the parameters which can be set by the editor - ############################################################################## - - if (defined $r->param('displayMode')) { - $self->{displayMode} = $r->param('displayMode'); - } else { - $self->{displayMode} = $ce->{pg}->{options}->{displayMode}; + return + unless $authz->hasPermissions($user, 'access_instructor_tools') + && $authz->hasPermissions($user, 'modify_problem_sets'); + + $self->{courseID} = $urlpath->arg('courseID'); + $self->{setID} = $urlpath->arg('setID'); + $self->{problemID} = $urlpath->arg('problemID'); + + # Parse setID which may come in with version data + $self->{fullSetID} = $self->{setID}; + if (defined $self->{fullSetID} && $self->{fullSetID} =~ /^([^,]*),v(\d+)$/) { + $self->{setID} = $1; + $self->{versionID} = $2; } - # form version of problemSeed overrides version obtained from the the problem_record - # inside saveFileChanges - $self->{problemSeed} = $r->param('problemSeed') if (defined $r->param('problemSeed')); - # Make sure that the problem seed has some value - $self->{problemSeed} = DEFAULT_SEED() unless not_blank($self->{problemSeed}); - - ############################################################################## - ############################################################################# - # Save file to permanent or temporary file, then redirect for viewing - ############################################################################# - # - # Any file "saved as" should be assigned to "Undefined_Set" and redirected to be viewed again in the editor - # - # Problems "saved" or 'refreshed' are to be redirected to the Problem.pm module - # Set headers which are "saved" are to be redirected to the ProblemSet.pm page - # Hardcopy headers which are "saved" are also to be redirected to the ProblemSet.pm page - # Course_info files are redirected to the ProblemSets.pm page - # Options_info files are redirected to the Options.pm page - ############################################################################## - - ###################################### + # Determine displayMode and problemSeed that are needed for viewing the problem. + # They are also two of the parameters which can be set by the editor. + # Note that the problem seed may be overridden by the value obtained from the problem record later. + $self->{displayMode} = $r->param('displayMode') // $ce->{pg}{options}{displayMode}; + $self->{problemSeed} = (($r->param('problemSeed') // '') =~ s/^\s*|\s*$//gr) || DEFAULT_SEED(); + + # Save file to permanent or temporary file, then redirect for viewing if it was requested to view in a new window. + # Any file "saved as" should be assigned to "Undefined_Set" and redirected to be viewed again in the editor. + # Problems "saved" or 'refreshed' are to be redirected to the Problem.pm module + # Set headers which are "saved" are to be redirected to the ProblemSet.pm page + # Hardcopy headers which are "saved" are also to be redirected to the ProblemSet.pm page + # Course info files are redirected to the ProblemSets.pm page + # Insure that file_type is defined - ###################################### - # We have already read in the file_type parameter from the form - - # If this has not been defined we are dealing with a set header - # or regular problem - if (not_blank($file_type)) { #file_type is defined and is not blank - # file type is already defined -- do nothing - #warn "file type already defined as $file_type" #FIXME debug - } else { - # if "sourceFilePath" is defined in the form, then we are getting the path directly. - # if the problem number is defined and is 0 - # then we are dealing with some kind of - # header file. The default is 'set_header' which prints properly - # to the screen. - # If the problem number is not zero, we are dealing with a real problem - ###################################### + $self->{file_type} = ($r->param('file_type') // '') =~ s/^\s*|\s*$//gr; + + # If file_type has not been defined we are dealing with a set header or regular problem. + if (!$self->{file_type}) { + # If sourceFilePath is defined in the form, then the path will be obtained from that. + # If the problem number is defined and is 0 then a header file is being edited. + # If the problem number is not zero, a problem is being edited. if (not_blank($r->param('sourceFilePath'))) { - $file_type = 'source_path_for_problem_file'; - $file_type = 'set_header' - if $r->param('sourceFilePath') =~ m!/headers/|Header\.pg$!; #FIXME this need to be cleaned up - } elsif (defined($problemNumber)) { - if ($problemNumber =~ /^\d+$/ and $problemNumber == 0) { # if problem number is numeric and zero - $file_type = 'set_header' - unless $file_type eq 'set_header' - or $file_type eq 'hardcopy_header'; + $self->{file_type} = + $r->param('sourceFilePath') =~ m!/headers/|Header\.pg$! ? 'set_header' : 'source_path_for_problem_file'; + } elsif (defined $self->{problemID}) { + if ($self->{problemID} =~ /^\d+$/ && $self->{problemID} == 0) { + $self->{file_type} = 'set_header' unless $self->{file_type} eq 'hardcopy_header'; } else { - $file_type = 'problem'; - #warn "setting file type to 'problem'\n"; #FIXME debug + $self->{file_type} = 'problem'; } + } else { + $self->{file_type} = 'blank_problem'; } } - die "The file_type variable |$file_type| has not been defined or is blank." unless not_blank($file_type); - # clean up sourceFilePath, just in case - # double check that sourceFilePath is relative to the templates file - if ($file_type eq 'source_path_for_problem_file') { - my $templatesDirectory = $ce->{courseDirs}->{templates}; - my $sourceFilePath = $r->param('sourceFilePath'); - $sourceFilePath =~ s/$templatesDirectory//; - $sourceFilePath =~ s|^/||; # remove intial / + # Clean up sourceFilePath and check that sourceFilePath is relative to the templates file + if ($self->{file_type} eq 'source_path_for_problem_file') { + my $sourceFilePath = $r->param('sourceFilePath'); + $sourceFilePath =~ s/$ce->{courseDirs}{templates}//; + $sourceFilePath =~ s|^/||; $self->{sourceFilePath} = $sourceFilePath; } - $self->{file_type} = $file_type; - # $self->addgoodmessage("file type is $file_type"); #FIXME debug - - ########################################## -# File type is one of: blank_problem course_info options_info problem set_header hardcopy_header source_path_for_problem_file - ########################################## - # - # Determine the path to the file - # - ########################################### - $self->getFilePaths($versionedSetName, $problemNumber, $file_type); - #defines $self->{editFilePath} # path to the permanent file to be edited - # $self->{tempFilePath} # path to the permanent file to be edited has .tmp suffix - # $self->{inputFilePath} # path to the file for input, (might be a .tmp file) - - ########################################## + + # Initialize these values in case of failure in the getFilePaths method. + $self->{editFilePath} = ''; + $self->{tempFilePath} = ''; + $self->{inputFilePath} = ''; + + # Determine the paths for the file. + # getFilePath defines: + # $self->{editFilePath}: path to the permanent file to be edited + # $self->{tempFilePath}: path to the temporary file to be edited with .tmp suffix + # $self->{inputFilePath}: path to the file for input, (this is either the editFilePath or the tempFilePath) + $self->getFilePaths; + # Default problem contents - ########################################## - $self->{r_problemContents} = undef; - - ########################################## - # - # Determine action - # - ########################################### - - if ($actionID) { - unless (grep { $_ eq $actionID } @{ ACTION_FORMS() }) { - die "Action $actionID not found"; - } - # Check permissions - if (not FORM_PERMS()->{$actionID} or $authz->hasPermissions($user, FORM_PERMS()->{$actionID})) { - my $actionHandler = "${actionID}_handler"; - my %genericParams = (); - my %actionParams = $self->getActionParams($actionID); - my %tableParams = (); # $self->getTableParams(); - $self->{action} = $actionID; - $self->$actionHandler(\%genericParams, \%actionParams, \%tableParams); - } else { - $self->addbadmessage("You are not authorized to perform this action."); - } - } else { - $self->{action} = 'fresh_edit'; - my $actionHandler = "fresh_edit_handler"; - my %genericParams; - my %actionParams = (); #$self->getActionParams($actionID); - my %tableParams = (); # $self->getTableParams(); - my $problemContents = ''; - $self->{r_problemContents} = \$problemContents; - $self->$actionHandler(\%genericParams, \%actionParams, \%tableParams); - } + $self->{r_problemContents} = \''; - ############################################################################## - # displayMode and problemSeed - # - # Determine the display mode - # If $self->{problemSeed} was obtained within saveFileChanges from the problem_record - # then it can be overridden by the value obtained from the form. - # Insure that $self->{problemSeed} has some non-empty value - # displayMode and problemSeed - # will be needed for viewing the problem via redirect. - # They are also two of the parameters which can be set by the editor - ############################################################################## - - if (defined $r->param('displayMode')) { - $self->{displayMode} = $r->param('displayMode'); - } else { - $self->{displayMode} = $ce->{pg}->{options}->{displayMode}; + # Determine action. If an invalid action is sent in, assume this is an initial edit. + $self->{action} = $r->param('action') // ''; + if ($self->{action} && grep { $_ eq $self->{action} } @{ ACTION_FORMS() }) { + my $actionHandler = "$self->{action}_handler"; + $self->$actionHandler($self->getActionParams); } - # form version of problemSeed overrides version obtained from the the problem_record - # inside saveFileChanges - $self->{problemSeed} = $r->param('problemSeed') if (defined $r->param('problemSeed')); - # Make sure that the problem seed has some value - $self->{problemSeed} = DEFAULT_SEED() unless not_blank($self->{problemSeed}); - - ############################################################################## - # Return - # If file saving fails or - # if no redirects are required. No further processing takes place in this subroutine. - # Redirects are required only for the following submit values - # 'Save' - # 'Save as' - # 'Refresh' - # add problem to set - # add set header to set - # - ######################################### - - return if $self->{failure}; - # FIXME: even with an error we still open a new page because of the target specified in the form - - # Some cases do not need a redirect: save, refresh, save_as, add_problem_to_set, add_header_to_set,make_local_copy - my $action = $self->{action}; return; } sub initialize { - my ($self) = @_; - my $r = $self->r; - my $authz = $r->authz; - my $user = $r->param('user'); + my $self = shift; + my $r = $self->r; + my $authz = $r->authz; + my $user = $r->param('user'); # Check permissions - return unless ($authz->hasPermissions($user, "access_instructor_tools")); - return unless ($authz->hasPermissions($user, "modify_problem_sets")); - - my $file_type = $r->param('file_type') || ""; - my $tempFilePath = $self->{tempFilePath}; # path to the file currently being worked with (might be a .tmp file) - my $inputFilePath = $self->{inputFilePath}; # path to the file for input, (might be a .tmp file) - - $self->addmessage($r->param('status_message') || ''); # record status messages carried over if this is a redirect - $self->addbadmessage($r->maketext("Changes in this file have not yet been permanently saved.")) if -r $tempFilePath; - if (not(-e $inputFilePath)) { - $self->addbadmessage($r->maketext("The file '[_1]' cannot be found.", $self->shortPath($inputFilePath))); - } elsif ((not -w $inputFilePath) && $file_type ne 'blank_problem') { + return + unless $authz->hasPermissions($user, 'access_instructor_tools') + && $authz->hasPermissions($user, 'modify_problem_sets'); + + my $file_type = $r->param('file_type') || ''; + + # Record status messages carried over if this is a redirect + $self->addmessage($r->param('status_message') || ''); + + $self->addbadmessage($r->maketext('Changes in this file have not yet been permanently saved.')) + if $self->{inputFilePath} eq $self->{tempFilePath} && -r $self->{tempFilePath}; + + if (!-e $self->{inputFilePath}) { $self->addbadmessage( - $r->maketext("The file '[_1]' is protected!", $self->shortPath($inputFilePath)) - . CGI::br() - . $r->maketext( - "To edit this text you must first make a copy of this file using the 'NewVersion' action below.") - ); + $r->maketext('The file "[_1]" cannot be found.', $self->shortPath($self->{inputFilePath}))); + } elsif (!-w $self->{inputFilePath} && $file_type ne 'blank_problem') { + $self->addbadmessage(CGI::div( + { class => 'd-flex flex-column gap-1' }, + CGI::div($r->maketext('The file "[_1]" is protected!', $self->shortPath($self->{inputFilePath}))), + CGI::div( + $r->maketext( + 'To edit this text you must first make a copy of this file using the "New Version" action below.') + ) + )); } - if ($inputFilePath =~ /$BLANKPROBLEM$/ && $file_type ne 'blank_problem') { - $self->addbadmessage( - $r->maketext("The file '[_1]' is a blank problem!", $self->shortPath($inputFilePath)) - . CGI::br() - . $r->maketext( - "To edit this text you must use the 'NewVersion' action below to save it to another file.") - ); + + if ($self->{inputFilePath} =~ /$BLANKPROBLEM$/ && $file_type ne 'blank_problem') { + $self->addbadmessage(CGI::div( + { class => 'd-flex flex-column gap-1' }, + CGI::div($r->maketext('The file "[_1]" is a blank problem!', $self->shortPath($self->{inputFilePath}))), + CGI::div( + $r->maketext( + 'To edit this text you must use the "New Version" action below to save it to another file.') + ) + )); } + + return; } sub path { my ($self, $args) = @_; my $r = $self->r; my $urlpath = $r->urlpath; - my $courseName = $urlpath->arg("courseID"); - my $setName = $urlpath->arg("setID") || ''; - my $problemNumber = $urlpath->arg("problemID") || ''; + my $courseName = $urlpath->arg('courseID'); + my $setName = $urlpath->arg('setID') // ''; + my $problemNumber = $urlpath->arg('problemID') || ''; my $prettyProblemNumber = $problemNumber; - my $isGateway = 0; if ($setName) { my $set = $r->db->getGlobalSet($setName); - $prettyProblemNumber = join('.', jitar_id_to_seq($problemNumber)) - if ($set && $set->assignment_type eq 'jitar' && $problemNumber); - $isGateway = 1 if $set && $set->assignment_type =~ /gateway/; + if ($set && $set->assignment_type eq 'jitar' && $problemNumber) { + $prettyProblemNumber = join('.', jitar_id_to_seq($problemNumber)); + } } - # We need to build a path to the problem being edited by hand, since it is not the same as the urlpath. - # The breadcrumb path for the problem number leads back to the problem being edited for a regular set, - # and is not a link for a problem in a gateway quiz. - my @path = ( + # We need to build a path to the problem being edited by hand, since it is not the same as the urlpath for this + # page. The bread crumb path leads back to the problem being edited, not to the Instructor tool. + print $self->pathMacro( + $args, 'WeBWorK' => $r->location, $courseName => $r->location . "/$courseName", $setName => $r->location . "/$courseName/$setName", - $prettyProblemNumber => $isGateway ? '' : $r->location . "/$courseName/$setName/$problemNumber", - $r->maketext("Editor") => '' + $prettyProblemNumber => $r->location . "/$courseName/$setName/$problemNumber", + $r->maketext('Editor') => '' ); - print $self->pathMacro($args, @path); - return ''; } sub title { my $self = shift; my $r = $self->r; - my $courseName = $r->urlpath->arg("courseID"); - my $setID = $r->urlpath->arg("setID"); - my $problemNumber = $r->urlpath->arg("problemID"); - my $file_type = $self->{'file_type'} || ''; + my $courseName = $r->urlpath->arg('courseID'); + my $setID = $r->urlpath->arg('setID'); + my $problemNumber = $r->urlpath->arg('problemID'); - return "Set Header for set $setID" if ($file_type eq 'set_header'); - return "Hardcopy Header for set $setID" if ($file_type eq 'hardcopy_header'); - return "Course Information for course $courseName" if ($file_type eq 'course_info'); - return "Options Information" if ($file_type eq 'options_info'); + return $r->maketext('Set Header for set [_1]', $setID) if $self->{file_type} eq 'set_header'; + return $r->maketext('Hardcopy Header for set [_1]', $setID) if $self->{file_type} eq 'hardcopy_header'; + return $r->maketext('Course Information for course [_1]', $courseName) if $self->{file_type} eq 'course_info'; if ($setID) { my $set = $r->db->getGlobalSet($setID); @@ -447,113 +325,92 @@ sub title { } sub body { - my ($self) = @_; - my $r = $self->r; - my $db = $r->db; - my $ce = $r->ce; - my $authz = $r->authz; - my $user = $r->param('user'); - my $make_local_copy = $r->param('make_local_copy'); + my $self = shift; + my $r = $self->r; + my $db = $r->db; + my $ce = $r->ce; + my $authz = $r->authz; + my $user = $r->param('user'); # Check permissions return CGI::div({ class => 'alert alert-danger p-1 mb-0' }, - "You are not authorized to access the Instructor tools.") - unless $authz->hasPermissions($user, "access_instructor_tools"); - - return CGI::div({ class => 'alert alert-danger p-1 mb-0' }, "You are not authorized to modify problems.") - unless $authz->hasPermissions($user, "modify_student_data"); + $r->maketext('You are not authorized to access the Instructor tools.')) + unless $authz->hasPermissions($user, 'access_instructor_tools'); - # Gathering info - my $editFilePath = $self->{editFilePath}; # path to the permanent file to be edited - my $tempFilePath = $self->{tempFilePath}; # path to the file currently being worked with (might be a .tmp file) - my $inputFilePath = $self->{inputFilePath}; # path to the file for input, (might be a .tmp file) - my $setName = $self->{setID} // ''; # Allow the numeric set name 0. + return CGI::div({ class => 'alert alert-danger p-1 mb-0' }, + $r->maketext('You are not authorized to modify problems.')) + unless $authz->hasPermissions($user, 'modify_student_data'); + + # Gather info + my $editFilePath = $self->{editFilePath}; # Path to the permanent file being edited. + my $tempFilePath = $self->{tempFilePath}; # Path to the file currently being worked with (might be a .tmp file). + my $inputFilePath = $self->{inputFilePath}; # Path to the file for input, (might be a .tmp file). + my $setName = $self->{setID} // ''; # Allow the numeric set name 0. my $problemNumber = $self->{problemID}; - my $fullSetName = defined($self->{fullSetID}) ? $self->{fullSetID} : $setName; - $problemNumber = defined($problemNumber) ? $problemNumber : ''; - - ######################################################################### - # Construct url for reporting bugs: - ######################################################################### - - my $libraryName = ''; - if ($editFilePath =~ m|([^/]*)Library|) { #find the path to the file - # find the library, if any exists in the path name (first library is picked) - my $tempLibraryName = $1; - $libraryName = (not_blank($tempLibraryName)) ? $tempLibraryName : "Library"; - # things that start /Library/setFoo/probBar are labeled as component "Library" - # which refers to the SQL based problem library. (is nationalLibrary a better name?) - } else { - $libraryName = 'Library'; # make sure there is some default component defined. - } - - my $BUGZILLA = - "$ce->{webworkURLs}{bugReporter}?product=Problem%20libraries" - . "&component=$libraryName&bug_file_loc=${editFilePath}_with_problemSeed=" - . $self->{problemSeed}; - #FIXME # The construction of this URL is somewhat fragile. A separate module could be devoted to - # intelligent bug reporting. + my $fullSetName = $self->{fullSetID} // $setName; + $problemNumber = defined $problemNumber ? $problemNumber : ''; - ######################################################################### # Construct reference row for PGproblemEditor. - ######################################################################### - - my @PG_Editor_Reference_Links = ( + my @PG_Editor_References; + for my $link ( { - #'http://webwork.maa.org/wiki/Category:Problem_Techniques', + # http://webwork.maa.org/wiki/Category:Problem_Techniques label => $r->maketext('Problem Techniques'), url => $ce->{webworkURLs}{problemTechniquesHelpURL}, target => 'techniques_window', - tooltip => 'Snippets of PG code illustrating specific techniques', + tooltip => $r->maketext('Snippets of PG code illustrating specific techniques'), }, { - #'http://webwork.maa.org/wiki/Category:MathObjects', + # http://webwork.maa.org/wiki/Category:MathObjects label => $r->maketext('Math Objects'), url => $ce->{webworkURLs}{MathObjectsHelpURL}, target => 'math_objects', - tooltip => 'Wiki summary page for MathObjects', + tooltip => $r->maketext('Wiki summary page for MathObjects'), }, { - #'http://webwork.maa.org/pod/pg_TRUNK/', + # http://webwork.maa.org/pod/pg_TRUNK/ label => $r->maketext('POD'), url => $ce->{webworkURLs}{PODHelpURL}, target => 'pod_docs', - tooltip => - 'Documentation from source code for PG modules and macro files. Often the most up-to-date information.', + tooltip => $r->maketext( + 'Documentation from source code for PG modules and macro files. ' + . 'Often the most up-to-date information.' + ), }, { - #'http://demo.webwork.rochester.edu/webwork2/wikiExamples/MathObjectsLabs2/2/?login_practice_user=true', - # label => $r->maketext('PGLab'), - # url => $ce->{webworkURLs}{PGLabHelpURL}, - # target => 'PGLab', - # tooltip => 'Test snippets of PG code in interactive lab. This is a good way to learn the PG language.', - # }, { - #'https://courses1.webwork.maa.org/webwork2/cervone_course/PGML/1/?login_practice_user=true', + # https://courses1.webwork.maa.org/webwork2/cervone_course/PGML/1/?login_practice_user=true label => $r->maketext('PGML'), url => $ce->{webworkURLs}{PGMLHelpURL}, target => 'PGML', - tooltip => - 'PG mark down syntax used to format WeBWorK questions. This interactive lab can help you to learn the techniques.', + tooltip => $r->maketext( + 'PG mark down syntax used to format WeBWorK questions. ' + . 'This interactive lab can help you to learn the techniques.' + ), }, { - #'http://webwork.maa.org/wiki/Category:Authors', + # http://webwork.maa.org/wiki/Category:Authors label => $r->maketext('Author Info'), url => $ce->{webworkURLs}{AuthorHelpURL}, target => 'author_info', - tooltip => 'Top level of author information on the wiki.', + tooltip => $r->maketext('Top level of author information on the wiki.'), }, - { - label => $r->maketext('Report Bugs in this Problem'), - url => $BUGZILLA, + # Only show the report bugs in problem button if editing an OPL or Contrib problem. + $editFilePath =~ m|^$ce->{courseDirs}{templates}/([^/]*)/| && ($1 eq 'Library' || $1 eq 'Contrib') + ? { + label => $r->maketext('Report Bugs in this Problem'), + url => "$ce->{webworkURLs}{bugReporter}?product=Problem%20libraries" + . "&component=$1&bug_file_loc=${editFilePath}_with_problemSeed=$self->{problemSeed}", target => 'bug_report', - tooltip => 'Report bugs in a WeBWorK question/problem using this link. ' - . 'The very first time you do this you will need to register with an email address so that ' - . 'information on the bug fix can be reported back to you.', - }, - ); - - my @PG_Editor_References; - foreach my $link (@PG_Editor_Reference_Links) { + tooltip => $r->maketext( + 'Report bugs in a WeBWorK question/problem using this link. ' + . 'The very first time you do this you will need to register with an email address so that ' + . 'information on the bug fix can be reported back to you.' + ), + } + : {} + ) + { + next unless $link->{url}; push( @PG_Editor_References, CGI::a( @@ -570,59 +427,55 @@ sub body { ); } - ######################################################################### - # Find the text for the problem, either in the tmp file, if it exists - # or in the original file in the template directory - # or in the problem contents gathered in the initialization phase. - ######################################################################### + # Find the text for the problem, either in the temporary file if it exists, in the original file in the template + # directory, or in the problem contents gathered in the initialization phase. my $problemContents = ${ $self->{r_problemContents} }; unless ($problemContents =~ /\S/) { # non-empty contents - if (-r $tempFilePath and not -d $tempFilePath) { - die "tempFilePath is unsafe!" - unless path_is_subdir($tempFilePath, $ce->{courseDirs}->{templates}, 1) - ; # 1==path can be relative to dir - eval { $problemContents = WeBWorK::Utils::readFile($tempFilePath) }; + if (-r $tempFilePath && !-d $tempFilePath) { + return CGI::div({ class => 'alert alert-danger p-1 mb-0' }, + $r->maketext('Unable to open a temporary file at the given location.')) + unless path_is_subdir($tempFilePath, $ce->{courseDirs}{templates}, 1); + + eval { $problemContents = readFile($tempFilePath) }; $problemContents = $@ if $@; $inputFilePath = $tempFilePath; - } elsif (-r $editFilePath and not -d $editFilePath) { - die "editFilePath is unsafe!" - unless path_is_subdir($editFilePath, $ce->{courseDirs}->{templates}, 1) # 1==path can be relative to dir + } elsif (-r $editFilePath && !-d $editFilePath) { + return CGI::div({ class => 'alert alert-danger p-1 mb-0' }, + $r->maketext('The given file path is not a valid location.')) + unless path_is_subdir($editFilePath, $ce->{courseDirs}{templates}, 1) || $editFilePath eq $ce->{webworkFiles}{screenSnippets}{setHeader} || $editFilePath eq $ce->{webworkFiles}{hardcopySnippets}{setHeader} || $editFilePath eq $ce->{webworkFiles}{screenSnippets}{blankProblem}; - eval { $problemContents = WeBWorK::Utils::readFile($editFilePath) }; + + eval { $problemContents = readFile($editFilePath) }; $problemContents = $@ if $@; $inputFilePath = $editFilePath; - } else { # file not existing is not an error - #warn "No file exists"; + } else { + # File not existing is not an error $problemContents = ''; } - } else { - #warn "obtaining input from r_problemContents"; } - my $protected_file = not -w $inputFilePath; + my $protected_file = !-w $inputFilePath; my $prettyProblemNumber = $problemNumber; my $set = $self->r->db->getGlobalSet($setName); - $prettyProblemNumber = join('.', jitar_id_to_seq($problemNumber)) - if ($set && $set->assignment_type eq 'jitar'); + $prettyProblemNumber = join('.', jitar_id_to_seq($problemNumber)) if $set && $set->assignment_type eq 'jitar'; my %titles = ( - blank_problem => x('Editing blank problem in file "[_1]"'), - set_header => x('Editing set header file "[_1]"'), - hardcopy_header => x('Editing hardcopy header file "[_1]"'), - course_info => x('Editing course information file "[_1]"'), - options_info => x('Editing options information file "[_1]"'), - '' => x('Editing unknown file type in file "[_1]"'), - source_path_for_problem_file => x('Editing unassigned problem file "[_1]"') + blank_problem => x('Editing blank problem in file "[_1]".'), + set_header => x('Editing set header file "[_1]".'), + hardcopy_header => x('Editing hardcopy header file "[_1]".'), + course_info => x('Editing course information file "[_1]".'), + '' => x('Editing unknown file type in file "[_1]".'), + source_path_for_problem_file => x('Editing unassigned problem file "[_1]".') ); my $header = CGI::i( $self->{file_type} eq 'problem' ? $r->maketext( - 'Editing problem [_1] of set [_2] in file "[_3]"', + 'Editing problem [_1] of set [_2] in file "[_3]".', $prettyProblemNumber, CGI::span({ dir => 'ltr' }, format_set_name_display($fullSetName)), CGI::span({ dir => 'ltr' }, $self->shortPath($inputFilePath)) @@ -630,33 +483,59 @@ sub body { : $r->maketext($titles{ $self->{file_type} }, $self->shortPath($inputFilePath)) ); $header = $self->isTempEditFilePath($inputFilePath) - ? CGI::div({ class => 'temporaryFile' }, $header) # use colors if temporary file + ? CGI::div({ class => 'temporaryFile' }, $header) # Use colors if this is a temporary file. : $header; - ######################################################################### - # Format the page - ######################################################################### - - print CGI::div({ class => 'mb-2' }, $header), - CGI::start_form({ - method => 'POST', - id => 'editor', - name => 'editor', - action => $r->uri, - enctype => 'application/x-www-form-urlencoded', - class => 'col-12' - }), - $self->hidden_authen_fields, - not_blank($self->{sourceFilePath}) - ? CGI::hidden({ name => 'sourceFilePath', value => $self->{sourceFilePath} }) - : '', - CGI::hidden({ name => 'file_type', value => $self->{file_type} }), - CGI::div(@PG_Editor_References); - - WeBWorK::ContentGenerator::Instructor::CodeMirrorEditor::output_codemirror_html($r, 'problemContents', - $problemContents); - - ######### print action forms + # Output page contents + + print CGI::div({ class => 'mb-2' }, $header); + print CGI::start_form({ + method => 'POST', + id => 'editor', + name => 'editor', + action => $r->uri, + enctype => 'application/x-www-form-urlencoded', + class => 'col-12' + }); + + print $self->hidden_authen_fields; + print CGI::hidden({ name => 'file_type', value => $self->{file_type} }); + print CGI::hidden({ name => 'courseID', value => $self->{courseID} }); + print CGI::hidden({ name => 'hidden_set_id', value => $setName }) if defined $setName; + print CGI::hidden({ name => 'sourceFilePath', value => $self->{sourceFilePath} }) + if not_blank($self->{sourceFilePath}); + print CGI::hidden({ name => 'edit_file_path', value => $self->getRelativeSourceFilePath($self->{editFilePath}) }) + if ($self->{file_type} eq 'problem' || $self->{file_type} eq 'source_path_for_problem_file') + && not_blank($self->{editFilePath}); + print CGI::hidden({ name => 'temp_file_path', value => $self->{tempFilePath} }) if not_blank($self->{tempFilePath}); + + print CGI::div({ class => 'mb-2' }, @PG_Editor_References); + + print CGI::div( + { class => 'row mb-2' }, + CGI::div( + { class => 'col-lg-6 col-md-12 order-last order-lg-first' }, + generate_codemirror_html($r, 'problemContents', $problemContents) + ), + CGI::div( + { class => 'col-lg-6 col-md-12 mb-lg-0 mb-2 order-first order-lg-last' }, + CGI::div( + { class => 'p-0', id => 'pgedit-render-area', }, + CGI::div( + { + class => 'placeholder d-flex flex-column justify-content-center align-items-center ' + . 'bg-secondary h-100' + }, + CGI::div({ class => 'fs-1' }, $r->maketext('Loading...')), + CGI::i({ class => 'fa-solid fa-spinner fa-spin fa-2x' }, '') + ) + ) + ) + ); + + print generate_codemirror_controls_html($r); + + # Print action forms my @formsToShow = @{ ACTION_FORMS() }; my %actionFormTitles = %{ ACTION_FORM_TITLES() }; @@ -667,11 +546,11 @@ sub body { for my $actionID (@formsToShow) { my $actionForm = "${actionID}_form"; - my $line_contents = $self->$actionForm($self->getActionParams($actionID)); - my $active = ""; + my $line_contents = $self->$actionForm; + my $active = ''; if ($line_contents) { - $active = " active", $default_choice = $actionID unless $default_choice; + unless ($default_choice) { $active = ' active'; $default_choice = $actionID; } push( @tabArr, CGI::li( @@ -682,7 +561,7 @@ sub body { class => "nav-link action-link$active", id => "$actionID-tab", data_action => $actionID, - data_bs_toggle => "tab", + data_bs_toggle => 'tab', data_bs_target => "#$actionID", role => 'tab', aria_controls => $actionID, @@ -696,7 +575,7 @@ sub body { @contentArr, CGI::div( { - class => "tab-pane fade" . ($active ? " show$active" : ''), + class => 'tab-pane fade' . ($active ? " show$active" : ''), id => $actionID, role => 'tabpanel', aria_labelledby => "$actionID-tab" @@ -707,782 +586,681 @@ sub body { } } - print CGI::hidden(-name => 'action', -id => 'current_action', -value => $default_choice); + print CGI::hidden({ name => 'action', id => 'current_action', value => $default_choice }); print CGI::div(CGI::ul({ class => 'nav nav-tabs mb-2', role => 'tablist' }, @tabArr), - CGI::div({ class => "tab-content" }, @contentArr)); + CGI::div({ class => 'tab-content' }, @contentArr)); print CGI::div(CGI::submit({ - id => "submit_button_id", + id => 'submit_button_id', name => 'submit', - value => $r->maketext("Take Action!"), + value => $r->maketext('Take Action!'), class => 'btn btn-primary' })); print CGI::end_form(); - print CGI::start_div({ id => 'render-modal', class => 'modal hide fade', tabindex => '-1' }); - print CGI::start_div({ class => 'modal-dialog modal-dialog-centered' }); - print CGI::start_div({ class => 'modal-content' }); - print CGI::start_div({ class => 'modal-header' }); - print CGI::h5({ class => 'modal-title' }, $r->maketext('Problem Viewer')); - print ''; - print CGI::end_div(); - print CGI::start_div({ class => 'modal-body' }); - print CGI::iframe({ id => 'pg_editor_frame_id', name => 'pg_editor_frame' }, ''); - print CGI::end_div(); - print CGI::start_div({ class => 'modal-footer' }); - print CGI::button({ - value => $r->maketext('Close'), - data_bs_dismiss => 'modal', - class => 'btn btn-primary' - }); - print CGI::end_div(); - print CGI::end_div(); - print CGI::end_div(); - print CGI::end_div(); - - return ""; + return ''; } -# Convert long paths to [TMPL], etc. +# Convert initial path component to [TMPL], [COURSE], or [WW]. sub shortPath { - my $self = shift; - my $file = shift; + my ($self, $file) = @_; + my $tmpl = $self->r->ce->{courseDirs}{templates}; my $root = $self->r->ce->{courseDirs}{root}; my $ww = $self->r->ce->{webworkDirs}{root}; $file =~ s|^$tmpl|[TMPL]|; $file =~ s|^$root|[COURSE]|; $file =~ s|^$ww|[WW]|; + return $file; } -################################################################################ # Utilities -################################################################################ sub getRelativeSourceFilePath { my ($self, $sourceFilePath) = @_; - my $templatesDir = $self->r->ce->{courseDirs}->{templates}; + my $templatesDir = $self->r->ce->{courseDirs}{templates}; $sourceFilePath =~ s|^$templatesDir/*||; # remove templates path and any slashes that follow return $sourceFilePath; } -# determineLocalFilePath constructs a local file path parallel to a library file path - +# determineLocalFilePath constructs a local file path parallel to a library file path sub determineLocalFilePath { - my $self = shift; - die "determineLocalFilePath is a method" unless ref($self); - my $path = shift; - my $default_screen_header_path = $self->r->ce->{webworkFiles}->{hardcopySnippets}->{setHeader}; - my $default_hardcopy_header_path = $self->r->ce->{webworkFiles}->{screenSnippets}->{setHeader}; - my $setID = $self->{setID}; - $setID = int(rand(1000)) unless $setID =~ /\S/; # setID can be 0 + my ($self, $path) = @_; + + my $default_screen_header_path = $self->r->ce->{webworkFiles}{hardcopySnippets}{setHeader}; + my $default_hardcopy_header_path = $self->r->ce->{webworkFiles}{screenSnippets}{setHeader}; + my $setID = $self->{setID} // int(rand(1000)); + if ($path =~ /Library/) { - #$path =~ s|^.*?Library/||; # truncate the url up to a segment such as ...rochesterLibrary/....... - $path =~ s|^.*?Library/|local/| - ; # truncate the url up to a segment such as ...rochesterLibrary/....... and prepend local + # Truncate the url up to a segment such as ...rochesterLibrary/ and prepend local. + $path =~ s|^.*?Library/|local/|; } elsif ($path eq $default_screen_header_path) { $path = "set$setID/setHeader.pg"; } elsif ($path eq $default_hardcopy_header_path) { $path = "set$setID/hardcopyHeader.tex"; - } else { # if its not in a library we'll just save it locally - $path = "new_problem_" . int(rand(1000)) . ".pg"; #l hope there aren't any collisions. + } else { + # If its not in a library we'll just save it locally. + # FIXME: This should check to see if a file with the randomly generated name exists. + $path = 'new_problem_' . int(rand(1000)) . '.pg'; } - $path; + return $path; } -# this does not create the directories in the path to the file -# it returns an absolute path to the file +# Determine the location of the temporary file. +# This does not create the directories in the path to the file. +# It returns an absolute path to the file. +# $path should be an absolute path to the original file. sub determineTempEditFilePath { - my $self = shift; - die "determineTempEditFilePath is a method" unless ref($self); - my $r = $self->r; - my $path = shift; # this should be an absolute path to the file - my $user = $self->r->param("user"); - $user = int(rand(1000)) unless defined $user; - my $setID = $self->{setID} || int(rand(1000)); - my $courseDirectory = $self->r->ce->{courseDirs}; - ############### - # Calculate the location of the temporary file - ############### - my $templatesDirectory = $courseDirectory->{templates}; - my $blank_file_path = $self->r->ce->{webworkFiles}->{screenSnippets}->{blankProblem}; - my $default_screen_header_path = $self->r->ce->{webworkFiles}->{hardcopySnippets}->{setHeader}; - my $default_hardcopy_header_path = $self->r->ce->{webworkFiles}->{screenSnippets}->{setHeader}; - my $tmpEditFileDirectory = $self->getTempEditFileDirectory(); - $self->addbadmessage($r->maketext("The path to the original file should be absolute")) - unless $path =~ m|^/|; # debug + my ($self, $path) = @_; + my $r = $self->r; + my $user = $r->param('user'); + my $setID = $self->{setID}; + + my $templatesDirectory = $r->ce->{courseDirs}{templates}; + my $tmpEditFileDirectory = $self->getTempEditFileDirectory(); + + $self->addbadmessage($r->maketext('The path to the original file should be absolute.')) + unless $path =~ m|^/|; + if ($path =~ /^$tmpEditFileDirectory/) { - $self->addbadmessage( - "Error: This path is already in the temporary edit directory -- no new temporary file is created. path = $path" - ); + $self->addbadmessage($r->maketext('The path can not be the temporary edit directory.')); } else { if ($path =~ /^$templatesDirectory/) { $path =~ s|^$templatesDirectory||; $path =~ s|^/||; # remove the initial slash if any $path = "$tmpEditFileDirectory/$path.$user.tmp"; - } elsif ($path eq $blank_file_path) { - $path = "$tmpEditFileDirectory/blank.$setID.$user.tmp"; # handle the case of the blank problem - } elsif ($path eq $default_screen_header_path) { - $path = "$tmpEditFileDirectory/screenHeader.$setID.$user.tmp" - ; # handle the case of the screen header in snippets - } elsif ($path eq $default_hardcopy_header_path) { - $path = "$tmpEditFileDirectory/hardcopyHeader.$setID.$user.tmp" - ; # handle the case of the hardcopy header in snippets + } elsif ($path eq $self->r->ce->{webworkFiles}{screenSnippets}{blankProblem}) { + # Handle the case of the blank problem in snippets. + $path = "$tmpEditFileDirectory/blank.$setID.$user.tmp"; + } elsif ($path eq $self->r->ce->{webworkFiles}{hardcopySnippets}{setHeader}) { + # Handle the case of the screen header in snippets. + $path = "$tmpEditFileDirectory/screenHeader.$setID.$user.tmp"; + } elsif ($path eq $self->r->ce->{webworkFiles}{screenSnippets}{setHeader}) { + # Handle the case of the hardcopy header in snippets. + $path = "$tmpEditFileDirectory/hardcopyHeader.$setID.$user.tmp"; } else { - die "determineTempEditFilePath should only be used on paths within the templates directory, not on $path"; + # If all else fails, just use a failsafe filename. This is reused in all of these cases. + # This shouldn't be possible in any case. + $path = "$tmpEditFileDirectory/failsafe.$setID.$user.tmp"; + $self->addbadmessage( + $r->maketext('The original path is not in a valid location. Using failsafe [_1]', $path)); } } - $path; + + return $path; } -# determine the original path to a file corresponding to a temporary edit file -# returns path relative to the template directory +# Determine the original path to a file corresponding to a temporary edit file. +# Returns a path that is relative to the template directory. sub determineOriginalEditFilePath { - my $self = shift; - my $path = shift; - my $user = $self->r->param("user"); - $self->addbadmessage("Can't determine user of temporary edit file $path.") unless defined($user); - my $templatesDirectory = $self->r->ce->{courseDirs}->{templates}; - my $tmpEditFileDirectory = $self->getTempEditFileDirectory(); - # unless path is absolute assume that it is relative to the template directory - my $newpath = $path; - unless ($path =~ m|^/|) { - $newpath = "$templatesDirectory/$path"; - } + my ($self, $path) = @_; + my $r = $self->r; + my $ce = $r->ce; + + # Unless path is absolute, assume that it is relative to the template directory. + my $newpath = $path =~ m|^/| ? $path : "$ce->{courseDirs}{templates}/$path"; + if ($self->isTempEditFilePath($newpath)) { - $newpath =~ s|^$tmpEditFileDirectory/||; # delete temp edit directory - if ($newpath =~ m|blank\.[^/]*$|) { # handle the case of the blank problem - $newpath = $self->r->ce->{webworkFiles}->{screenSnippets}->{blankProblem}; - } elsif (($newpath =~ m|hardcopyHeader\.[^/]*$|)) { # handle the case of the hardcopy header in snippets - $newpath = $self->r->ce->{webworkFiles}->{hardcopySnippets}->{setHeader}; - } elsif (($newpath =~ m|screenHeader\.[^/]*$|)) { # handle the case of the screen header in snippets - $newpath = $self->r->ce->{webworkFiles}->{screenSnippets}->{setHeader}; + my $tmpEditFileDirectory = $self->getTempEditFileDirectory(); + $newpath =~ s|^$tmpEditFileDirectory/||; + + if ($newpath =~ m|blank\.[^/]*$|) { + $newpath = $ce->{webworkFiles}{screenSnippets}{blankProblem}; + } elsif (($newpath =~ m|hardcopyHeader\.[^/]*$|)) { + $newpath = $ce->{webworkFiles}{hardcopySnippets}{setHeader}; + } elsif (($newpath =~ m|screenHeader\.[^/]*$|)) { + $newpath = $ce->{webworkFiles}{screenSnippets}{setHeader}; } else { - $newpath =~ s|\.$user\.tmp$||; # delete suffix + my $user = $r->param('user'); + $newpath =~ s|\.$user\.tmp$||; } - #$self->addgoodmessage("Original file path is $newpath"); #FIXME debug } else { $self->addbadmessage("This path |$newpath| is not the path to a temporary edit file."); - # returns original path + # Returns the original path. } - $newpath; + + return $newpath; } sub getTempEditFileDirectory { - my $self = shift; - my $courseDirectory = $self->r->ce->{courseDirs}; - my $templatesDirectory = $courseDirectory->{templates}; - my $tmpEditFileDirectory = - (defined($courseDirectory->{tmpEditFileDir})) - ? $courseDirectory->{tmpEditFileDir} - : "$templatesDirectory/tmpEdit"; - $tmpEditFileDirectory; + my $self = shift; + my $courseDirectories = $self->r->ce->{courseDirs}; + return $courseDirectories->{tmpEditFileDir} // "$courseDirectories->{templates}/tmpEdit"; } sub isTempEditFilePath { - my $self = shift; - my $path = shift; - my $templatesDirectory = $self->r->ce->{courseDirs}->{templates}; - # unless path is absolute assume that it is relative to the template directory - unless ($path =~ m|^/|) { - $path = "$templatesDirectory/$path"; - } + my ($self, $path) = @_; + + # Unless path is absolute, assume that it is relative to the template directory. + $path = $self->r->ce->{courseDirs}{templates} . "/$path" unless $path =~ m|^/|; + my $tmpEditFileDirectory = $self->getTempEditFileDirectory(); - ($path =~ /^$tmpEditFileDirectory/) ? 1 : 0; + return $path =~ /^$tmpEditFileDirectory/ ? 1 : 0; } +# Determine file paths. This defines the following variables: +# $self->{editFilePath} -- path to permanent file +# $self->{tempFilePath} -- temporary file name to use (may not exist) +# $self->{inputFilePath} -- actual file to read and edit (will be one of the above) sub getFilePaths { - my ($self, $setName, $problemNumber, $file_type) = @_; - my $r = $self->r; - my $ce = $r->ce; - my $db = $r->db; - my $urlpath = $r->urlpath; - my $courseName = $urlpath->arg("courseID"); - my $user = $r->param('user'); - my $effectiveUserName = $r->param('effectiveUser'); - - $setName = '' unless defined $setName; - $problemNumber = '' unless defined $problemNumber; - - # parse possibly versioned set names - my $fullSetName = $setName; - my $editSetVersion = 0; - if ($setName =~ /,v(\d)+$/) { - $editSetVersion = $1; - $setName =~ s/,v\d+$//; - } - - die 'Internal error to PGProblemEditor -- file type is not defined' unless defined $file_type; - #$self->addgoodmessage("file type is $file_type"); #FIXME remove - ########################################################## - # Determine path to the input file to be edited. - # The permanent path of the input file == $editFilePath - # A temporary path to the input file == $tempFilePath - ########################################################## - # Relevant parameters - # $r->param("displayMode") - # $r->param('problemSeed') - # $r->param('submit') - # $r->param('make_local_copy') - # $r->param('sourceFilePath') - # $r->param('problemContents') - # $r->param('save_to_new_file') - ########################################################################## - # Define the following variables - # path to regular file -- $editFilePath; - # path to file being read (temporary or permanent) - # contents of the file being read --- $problemContents - # $self->{r_problemContents} = \$problemContents; - ########################################################################### - - my $editFilePath = $ce->{courseDirs}->{templates}; - - ########################################################################## - # Determine path to regular file, place it in $editFilePath - # problemSeed is defined for the file_type = 'problem' and 'source_path_to_problem' - ########################################################################## -CASE: - { - ($file_type eq 'course_info') and do { - # we are editing the course_info file - # value of courseFiles::course_info is relative to templates directory - $editFilePath .= '/' . $ce->{courseFiles}->{course_info}; - last CASE; - }; - - ($file_type eq 'options_info') and do { - # we are editing the options_info file - # value of courseFiles::options_info is relative to templates directory - $editFilePath .= '/' . $ce->{courseFiles}->{options_info}; - last CASE; - }; - - ($file_type eq 'blank_problem') and do { - $editFilePath = $ce->{webworkFiles}->{screenSnippets}->{blankProblem}; - $self->addbadmessage( - $r->maketext( - "This is a blank problem template file and can not be edited directly. Use the 'NewVersion' action below to create a local copy of the file and add it to the current problem set." - ) - ); - last CASE; - }; - - ($file_type eq 'set_header' or $file_type eq 'hardcopy_header') and do { - # first try getting the merged set for the effective user - # FIXME merged set is overwritten immediately with global value... WTF? --sam - my $set_record = $db->getMergedSet($effectiveUserName, $setName); - # if that doesn't work (the set is not yet assigned), get the global record - $set_record = $db->getGlobalSet($setName); - # bail if no set is found - die "Cannot find a set record for set $setName" unless defined($set_record); - - my $header_file = ""; - $header_file = $set_record->{$file_type}; - if ($header_file && $header_file ne "" && $header_file ne "defaultHeader") { - if ($header_file =~ m|^/|) { # if absolute address + my $self = shift; + my $r = $self->r; + my $ce = $r->ce; + my $db = $r->db; + + my $editFilePath; + + if ($self->{file_type} eq 'course_info') { + $editFilePath = "$ce->{courseDirs}{templates}/$ce->{courseFiles}{course_info}"; + } elsif ($self->{file_type} eq 'blank_problem') { + $editFilePath = $ce->{webworkFiles}{screenSnippets}{blankProblem}; + $self->addbadmessage($r->maketext( + 'This is a blank problem template file and can not be edited directly. Use the "New Version" ' + . 'action below to create a local copy of the file and add it to the current problem set.' + )); + } elsif ($self->{file_type} eq 'set_header' || $self->{file_type} eq 'hardcopy_header') { + my $set_record = $db->getGlobalSet($self->{setID}); + + if (defined $set_record) { + my $header_file = $set_record->{ $self->{file_type} }; + if ($header_file && $header_file ne 'defaultHeader') { + if ($header_file =~ m|^/|) { + # Absolute address $editFilePath = $header_file; } else { - $editFilePath .= '/' . $header_file; + $editFilePath = "$ce->{courseDirs}{templates}/$header_file"; } } else { - # if the set record doesn't specify the filename for a header - # then the set uses the default from snippets - $editFilePath = $ce->{webworkFiles}->{screenSnippets}->{setHeader} if $file_type eq 'set_header'; - $editFilePath = $ce->{webworkFiles}->{hardcopySnippets}->{setHeader} - if $file_type eq 'hardcopy_header'; - } - last CASE; - }; #end 'set_header, hardcopy_header' case - - ($file_type eq 'problem') and do { - # first try getting the merged problem for the effective user - my $problem_record; - if ($editSetVersion) { - $problem_record = - $db->getMergedProblemVersion($effectiveUserName, $setName, $editSetVersion, $problemNumber); - } else { - $problem_record = $db->getMergedProblem($effectiveUserName, $setName, $problemNumber); + # If the set record doesn't specify the filename for a header or it specifies the defaultHeader, + # then the set uses the default from snippets. + $editFilePath = $ce->{webworkFiles}{screenSnippets}{setHeader} + if $self->{file_type} eq 'set_header'; + $editFilePath = $ce->{webworkFiles}{hardcopySnippets}{setHeader} + if $self->{file_type} eq 'hardcopy_header'; } - - # if that doesn't work (the problem is not yet assigned), get the global record - $problem_record = $db->getGlobalProblem($setName, $problemNumber) unless defined($problem_record); - # bail if no source path for the problem is found ; - die "Cannot find a problem record for set $setName / problem $problemNumber" - unless defined($problem_record); - $editFilePath .= '/' . $problem_record->source_file; - # define the problem seed for later use - $self->{problemSeed} = $problem_record->problem_seed - if defined($problem_record) - and $problem_record->can('problem_seed'); - last CASE; - }; # end 'problem' case - - ($file_type eq 'source_path_for_problem_file') and do { - my $forcedSourceFile = $self->{sourceFilePath}; - # if the source file is in the temporary edit directory find the original source file - # the source file is relative to the templates directory. - if ($self->isTempEditFilePath($forcedSourceFile)) { - $forcedSourceFile = $self->determineOriginalEditFilePath($forcedSourceFile); # original file path - $self->addgoodmessage($r->maketext("the original path to the file is [_1]", $forcedSourceFile)) - ; #FIXME debug - } - # bail if no source path for the problem is found ; - die "Cannot find a file path to save to" unless (not_blank($forcedSourceFile)); + } else { + $self->addbadmessage("Cannot find a set record for set $self->{setID}"); + return; + } + } elsif ($self->{file_type} eq 'problem') { + # First try getting the merged problem for the effective user. + my $effectiveUserName = $r->param('effectiveUser'); + my $problem_record = + $self->{versionID} + ? $db->getMergedProblemVersion($effectiveUserName, $self->{setID}, $self->{versionID}, $self->{problemID}) + : $db->getMergedProblem($effectiveUserName, $self->{setID}, $self->{problemID}); + + # If that doesn't work, then the problem is not yet assigned. So get the global record. + $problem_record = $db->getGlobalProblem($self->{setID}, $self->{problemID}) unless defined $problem_record; + + if (defined $problem_record) { + $editFilePath = "$ce->{courseDirs}{templates}/" . $problem_record->source_file; + # Define the problem seed for later use. + $self->{problemSeed} = $problem_record->problem_seed if $problem_record->can('problem_seed'); + } else { + $self->addbadmessage( + $r->maketext("Cannot find a problem record for set $self->{setID} / problem $self->{problemID}")); + return; + } + } elsif ($self->{file_type} eq 'source_path_for_problem_file') { + my $forcedSourceFile = $self->{sourceFilePath}; + # If the source file is in the temporary edit directory find the original source file. + # The source file is relative to the templates directory. + if ($self->isTempEditFilePath($forcedSourceFile)) { + $forcedSourceFile = $self->determineOriginalEditFilePath($forcedSourceFile); # Original file path + $self->addgoodmessage($r->maketext('The original path to the file is [_1].', $forcedSourceFile)); + } + if (not_blank($forcedSourceFile)) { $self->{problemSeed} = DEFAULT_SEED(); - $editFilePath .= '/' . $forcedSourceFile; - last CASE; - }; # end 'source_path_for_problem_file' case - } # end CASE: statement + $editFilePath = "$ce->{courseDirs}{templates}/$forcedSourceFile"; + } else { + $self->addbadmessage($r->maketext('Cannot find a file path to save to.')); + return; + } + } if (-d $editFilePath) { - my $msg = $r->maketext("The file '[_1]' is a directory!", $self->shortPath($editFilePath)); - $self->{failure} = 1; - $self->addbadmessage($msg); + $self->addbadmessage($r->maketext('The file "[_1]" is a directory!', $self->shortPath($editFilePath))); } - if (-e $editFilePath and not -r $editFilePath) { - #it's ok if the file doesn't exist, perhaps we're going to create it with save as - my $msg = $r->maketext("The file '[_1]' cannot be read!", $self->shortPath($editFilePath)); - $self->{failure} = 1; - $self->addbadmessage($msg); + if (-e $editFilePath && !-r $editFilePath) { + # It's ok if the file doesn't exist. Perhaps we're going to create it with save as. + $self->addbadmessage($r->maketext('The file "[_1]" cannot be read!', $self->shortPath($editFilePath))); } - ################################################# # The path to the permanent file is now verified and stored in $editFilePath - # Whew!!! - ################################################# - - my $tempFilePath = $self->determineTempEditFilePath($editFilePath); #"$editFilePath.$TEMPFILESUFFIX"; - $self->{editFilePath} = $editFilePath; - $self->{tempFilePath} = $tempFilePath; - $self->{inputFilePath} = (-r $tempFilePath) ? $tempFilePath : $editFilePath; - #warn "editfile path is $editFilePath and tempFile is $tempFilePath and inputFilePath is ". $self->{inputFilePath}; + $self->{editFilePath} = $editFilePath; + $self->{tempFilePath} = $self->determineTempEditFilePath($editFilePath); + + # $self->{inputFilePath} is $self->{tempFilePath} if it is exists and is readable. + # Otherwise it is the original $self->{editFilePath}. + $self->{inputFilePath} = -r $self->{tempFilePath} ? $self->{tempFilePath} : $self->{editFilePath}; + + return; } -################################################################################ -# saveFileChanges does most of the work. it is a separate method so that it can -# be called from either pre_header_initialize() or initilize(), depending on -# whether a redirect is needed or not. -# -# it actually does a lot more than save changes to the file being edited, and -# sometimes less. -################################################################################ sub saveFileChanges { my ($self, $outputFilePath, $problemContents) = @_; my $r = $self->r; my $ce = $r->ce; - my $action = $self->{action} || 'no action'; - # my $editFilePath = $self->{editFilePath}; # not used?? - my $sourceFilePath = $self->{sourceFilePath}; - my $tempFilePath = $self->{tempFilePath}; + $problemContents = $$problemContents if defined $problemContents && ref $problemContents; + $problemContents = ${ $self->{r_problemContents} } unless not_blank($problemContents); - if (defined($problemContents) and ref($problemContents)) { - $problemContents = ${$problemContents}; - } elsif (!not_blank($problemContents)) { # if the problemContents is undefined or empty - $problemContents = ${ $self->{r_problemContents} }; - } - ############################################################################## - # read and update the targetFile and targetFile.tmp files in the directory - # if a .tmp file already exists use that, unless the revert button has been pressed. + # Read and update the targetFile and targetFile.tmp files in the directory. + # If a .tmp file already exists use that, unless the revert button has been pressed. # The .tmp files are removed when the file is or when the revert occurs. - ############################################################################## unless (not_blank($outputFilePath)) { - $self->addbadmessage($r->maketext("You must specify an file name in order to save a new file.")); - return ""; + $self->addbadmessage($r->maketext('You must specify a file name in order to save a new file.')); + return; } - my $do_not_save = 0; # flag to prevent saving of file - my $editErrors = ''; - - ############################################################################## - # write changes to the approriate files - # FIXME make sure that the permissions are set correctly!!! - # Make sure that the warning is being transmitted properly. - ############################################################################## - - my $writeFileErrors; - if (not_blank($outputFilePath)) { # save file - # Handle the problem of line endings. - # Make sure that all of the line endings are of unix type. - # Convert \r\n to \n - #$problemContents =~ s/\r\n/\n/g; - #$problemContents =~ s/\r/\n/g; - - # make sure any missing directories are created - WeBWorK::Utils::surePathToFile($ce->{courseDirs}->{templates}, $outputFilePath); - die "outputFilePath is unsafe!" - unless path_is_subdir($outputFilePath, $ce->{courseDirs}->{templates}, 1); # 1==path can be relative to dir - - eval { - local *OUTPUTFILE; - open OUTPUTFILE, ">:encoding(UTF-8)", $outputFilePath - or die "Failed to open $outputFilePath"; - print OUTPUTFILE $problemContents; - close OUTPUTFILE; - # any errors are caught in the next block - }; - - $writeFileErrors = $@ if $@; + + unless (path_is_subdir($outputFilePath, $ce->{courseDirs}{templates}, 1)) { + $self->addbadmessage($r->maktext( + 'The file [_1] is not contained in the course templates directory and can not be modified.', + $outputFilePath + )); + return; } - ########################################################### - # Catch errors in saving files, clean up temp files - ########################################################### + # Make sure any missing directories are created. + surePathToFile($ce->{courseDirs}{templates}, $outputFilePath); - # don't do redirects if the file was not saved. - # don't unlink files or send success messages - $self->{saveError} = $do_not_save; + # Actually save the file. + if (open my $outfile, '>:encoding(UTF-8)', $outputFilePath) { + print $outfile $problemContents; + close $outfile; + } else { + # Catch file save errors. + my $writeFileErrors = $!; - if ($writeFileErrors) { - # get the current directory from the outputFilePath + # Get the current directory from the outputFilePath. $outputFilePath =~ m|^(/.*?/)[^/]+$|; my $currentDirectory = $1; my $errorMessage; - # check why we failed to give better error messages - if (not -w $ce->{courseDirs}->{templates}) { - $errorMessage = - "Write permissions have not been enabled in the templates directory. No changes can be made."; - } elsif (not -w $currentDirectory) { - $errorMessage = - "Write permissions have not been enabled in '" - . $self->shortPath($currentDirectory) - . "'. Changes must be saved to a different directory for viewing."; - } elsif (-e $outputFilePath and not -w $outputFilePath) { - $errorMessage = - "Write permissions have not been enabled for '" - . $self->shortPath($outputFilePath) - . "'. Changes must be saved to another file for viewing."; + + if (!-w $ce->{courseDirs}{templates}) { + $errorMessage = $r->maketext( + 'Write permissions have not been enabled in the templates directory. No changes can be made.'); + } elsif (!-w $currentDirectory) { + $errorMessage = $r->maketext( + 'Write permissions have not been enabled in "[_1]".' + . 'Changes must be saved to a different directory for viewing.', + $self->shortPath($currentDirectory) + ); + } elsif (-e $outputFilePath && !-w $outputFilePath) { + $errorMessage = $r->maketext( + 'Write permissions have not been enabled for "[_1]". ' + . 'Changes must be saved to another file for viewing.', + $self->shortPath($outputFilePath) + ); } else { - $errorMessage = "Unable to write to '" . $self->shortPath($outputFilePath) . "': $writeFileErrors"; + $errorMessage = $r->maketext( + 'Unable to write to "[_1]": [_2]', + $self->shortPath($outputFilePath), + CGI::pre($writeFileErrors) + ); } - $self->{failure} = 1; - $self->addbadmessage(CGI::p($errorMessage)); + $self->addbadmessage($errorMessage); + return; } - ########################################################### - # FIXME if the file is accompanied by auxiliary files transfer them as well - # if the filepath ends in foobar/foobar.pg then we assume there are auxiliary files - # copy the contents of the original foobar directory to the new one - # - ########################################################### - # If things have worked so far determine if the file might be accompanied by auxiliary files - # a path ending in foo/foo.pg is assumed to contain auxilliary files - # - my $auxiliaryFilesExist = has_aux_files($outputFilePath); - - if ($auxiliaryFilesExist and not $do_not_save) { - my $sourceDirectory = $sourceFilePath || ''; - my $outputDirectory = $outputFilePath || ''; + # If the file is being saved as a new file in a new location, and the file is accompanied by auxiliary files + # transfer them as well. If the file is a pg file, then assume there are auxiliary files. Copy all files not + # ending in .pg from the original directory to the new one. + if ($self->{action} eq 'save_as' && $outputFilePath =~ /\.pg/) { + my $sourceDirectory = $self->{sourceFilePath} || ''; + my $outputDirectory = $outputFilePath; $sourceDirectory =~ s|/[^/]+\.pg$||; $outputDirectory =~ s|/[^/]+\.pg$||; - ############## - # Transfer this to Utils::copyAuxiliaryFiles($sourceDirectory, $destinationDirectory) - ############## - my @filesToCopy; - @filesToCopy = WeBWorK::Utils::readDirectory($sourceDirectory) if -d $sourceDirectory; - foreach my $file (@filesToCopy) { - next if $file =~ /\.pg$/; # .pg file should already be transferred - my $fromPath = "$sourceDirectory/$file"; - my $toPath = "$outputDirectory/$file"; - if (-f $fromPath and -r $fromPath and not -e $toPath) - { # don't copy directories, don't copy files that have already been copied - copy($fromPath, $toPath) or $writeFileErrors .= "
      Error copying $fromPath to $toPath"; - # need to use binary transfer for gif files. File::Copy does this. - #warn "copied from $fromPath to $toPath"; - #warn "files are different ",system("diff $fromPath $toPath"); + + # Only perform the copy if the output directory is an actual new location. + if ($sourceDirectory ne $outputDirectory) { + for my $file (-d $sourceDirectory ? readDirectory($sourceDirectory) : ()) { + # The .pg file being edited has already been transferred. Ignore any others in the directory. + next if $file =~ /\.pg$/; + my $fromPath = "$sourceDirectory/$file"; + my $toPath = "$outputDirectory/$file"; + # Don't copy directories and don't copy files that have already been copied. + if (-f $fromPath && -r $fromPath && !-e $toPath) { + # Need to use binary transfer for image files. File::Copy does this. + $self->addbadmessage(CGI::div($r->maketext('Error copying [_1] to [_2].', $fromPath, $toPath))) + unless copy($fromPath, $toPath); + } } - $self->addbadmessage($writeFileErrors) if not_blank($writeFileErrors); + $self->addgoodmessage($r->maketext( + 'Copied auxiliary files from [_1] to new location at [_2].', + $sourceDirectory, $outputDirectory + )); } - $self->addgoodmessage($r->maketext( - "Copied auxiliary files from [_1] to new location at [_2]", - $sourceDirectory, $outputDirectory - )); } - ########################################################### - # clean up temp files on revert, save and save_as - ########################################################### - unless ($writeFileErrors or $do_not_save) { # everything worked! unlink and announce success! - # unlink the temporary file if there are no errors and the save button has been pushed - if (($action eq 'save' or $action eq 'save_as') and (-w $self->{tempFilePath})) { - $self->addgoodmessage($r->maketext("Deleting temp file at [_1]", $self->shortPath($self->{tempFilePath}))); - die "tempFilePath is unsafe!" - unless path_is_subdir($self->{tempFilePath}, $ce->{courseDirs}->{templates}, 1) - ; # 1==path can be relative to dir + # Clean up temp files on save or save_as. + # Unlink the temporary file if there are no errors and the save or save_as button has been pushed. + if (($self->{action} eq 'save' || $self->{action} eq 'save_as') && -w $self->{tempFilePath}) { + if (path_is_subdir($self->{tempFilePath}, $ce->{courseDirs}{templates}, 1)) { + $self->addgoodmessage($r->maketext('Deleted temp file at [_1]', $self->shortPath($self->{tempFilePath}))); unlink($self->{tempFilePath}); - } - if (defined($outputFilePath) and !$self->{failure} and not $self->isTempEditFilePath($outputFilePath)) { - # don't announce saving of temporary editing files - my $msg = $r->maketext("Saved to file '[_1]'", $self->shortPath($outputFilePath)); - $self->addgoodmessage($msg); - #$self->{inputFilePath} = $outputFilePath; ## DPVC -- avoid file-not-found message + # Update the file paths. + $self->{tempFilePath} = $self->determineTempEditFilePath($self->{editFilePath}); + $self->{inputFilePath} = $self->{editFilePath}; + } else { + $self->addbadmessage($r->maketext( + 'The temporary file [_1] is not in the course templates directory and can not be deleted!', + $self->{tempFilePath} + )); } } -} # end saveFileChanges + + # Announce that the file was saved unless it was a temporary file. + unless ($self->isTempEditFilePath($outputFilePath)) { + my $msg = $r->maketext('Saved to file "[_1]"', $self->shortPath($outputFilePath)); + $self->addgoodmessage($msg); + } + + return; +} sub getActionParams { - my ($self, $actionID) = @_; - my $r = $self->{r}; + my ($self) = @_; + my $r = $self->r; - my %actionParams = (); - foreach my $param ($r->param) { - next unless $param =~ m/^action\.$actionID\./; - $actionParams{$param} = [ $r->param($param) ]; + my %actionParams; + for ($r->param) { + next unless $_ =~ m/^action\.$self->{action}\./; + $actionParams{$_} = [ $r->param($_) ]; } return %actionParams; } +# Fix line endings in the problem contents. +# Make sure that all of the line endings are of unix type and convert \r\n to \n. sub fixProblemContents { - #NOT a method my $problemContents = shift; - # Handle the problem of line endings. - # Make sure that all of the line endings are of unix type. - # Convert \r\n to \n - $problemContents =~ s/\r\n/\n/g; - $problemContents =~ s/\r/\n/g; - $problemContents; -} - -sub fresh_edit_handler { - my ($self, $genericParams, $actionParams, $tableParams) = @_; - #$self->addgoodmessage("fresh_edit_handler called"); + return $problemContents =~ s/(\r\n)|(\r)/\n/gr; } sub view_form { - my ($self, %actionParams) = @_; - my $r = $self->r; - my $file_type = $self->{file_type}; + my $self = shift; + my $r = $self->r; - # FIXME: These can't yet be edited from temporary files - return '' if $file_type eq 'hardcopy_header'; + # Hardcopy headers are previewed from the hardcopy generation tab. + return '' if $self->{file_type} eq 'hardcopy_header'; - unless ($file_type eq 'course_info' || $file_type eq 'options_info') { - return CGI::div( + return CGI::div( + CGI::div( + { class => 'row align-items-center' }, + CGI::label( + { for => 'action_view_seed_id', class => 'col-form-label col-auto mb-2' }, + $r->maketext('Using what seed?') + ), CGI::div( - { class => 'row align-items-center' }, - CGI::label( - { for => 'action_view_seed_id', class => 'col-form-label col-auto mb-2' }, - $r->maketext('Using what seed?') - ), - CGI::div( - { class => 'col-auto mb-2' }, - CGI::textfield({ - id => 'action_view_seed_id', - name => 'action.view.seed', - value => $self->{problemSeed}, - class => 'form-control form-control-sm' - }) - ), - CGI::div( - { class => 'col-auto mb-2' }, - CGI::button({ - id => 'randomize_view_seed_id', - name => 'action.randomize.view.seed', - value => $r->maketext('Randomize Seed'), - class => 'btn btn-info btn-sm' - }) - ) + { class => 'col-auto mb-2' }, + CGI::textfield({ + id => 'action_view_seed_id', + name => 'action.view.seed', + value => $self->{problemSeed}, + class => 'form-control form-control-sm' + }) ), CGI::div( - { class => 'row align-items-center mb-2' }, - CGI::label( - { for => 'action_view_displayMode_id', class => 'col-form-label col-auto' }, - $r->maketext('Using what display mode?') - ), - CGI::div( - { class => 'col-auto' }, - CGI::popup_menu({ - id => 'action_view_displayMode_id', - name => 'action.view.displayMode', - values => $self->r->ce->{pg}{displayModes}, - class => 'form-select form-select-sm d-inline w-auto', - default => $self->{displayMode} - }) - ) + { class => 'col-auto mb-2' }, + CGI::button({ + id => 'randomize_view_seed_id', + name => 'action.randomize.view.seed', + value => $r->maketext('Randomize Seed'), + class => 'btn btn-info btn-sm' + }) + ) + ), + CGI::div( + { class => 'row align-items-center mb-2' }, + CGI::label( + { for => 'action_view_displayMode_id', class => 'col-form-label col-auto' }, + $r->maketext('Using what display mode?') ), CGI::div( - { class => 'row g-0 mb-2' }, - CGI::div( - { class => 'form-check mb-2' }, - CGI::input({ - type => 'checkbox', - id => 'newWindowView', - class => 'form-check-input' - }), - CGI::label( - { for => 'newWindowView', class => 'form-check-label' }, - $r->maketext('Open in new window') - ) + { class => 'col-auto' }, + CGI::popup_menu({ + id => 'action_view_displayMode_id', + name => 'action.view.displayMode', + values => $self->r->ce->{pg}{displayModes}, + class => 'form-select form-select-sm d-inline w-auto', + default => $self->{displayMode} + }) + ) + ), + CGI::div( + { class => 'row g-0 mb-2' }, + CGI::div( + { class => 'form-check mb-2' }, + CGI::input({ + type => 'checkbox', + id => 'newWindowView', + class => 'form-check-input' + }), + CGI::label( + { for => 'newWindowView', class => 'form-check-label' }, + $r->maketext('Open in new window') ) ) - ); - } - - return ''; + ) + ); } sub view_handler { - my ($self, $genericParams, $actionParams, $tableParams) = @_; - my $r = $self->r; - my $courseName = $self->{courseID}; - my $setName = $self->{setID}; - my $fullSetName = $self->{fullSetID}; - my $problemNumber = $self->{problemID}; - my $problemSeed = ($actionParams->{'action.view.seed'}) ? $actionParams->{'action.view.seed'}->[0] : DEFAULT_SEED(); + my ($self, %actionParams) = @_; + my $r = $self->r; + + my $problemSeed = $actionParams{'action.view.seed'} ? $actionParams{'action.view.seed'}[0] : DEFAULT_SEED(); my $displayMode = - ($actionParams->{'action.view.displayMode'}) - ? $actionParams->{'action.view.displayMode'}->[0] - : $self->r->ce->{pg}->{options}->{displayMode}; - - my $editFilePath = $self->{editFilePath}; - my $tempFilePath = $self->{tempFilePath}; - ######################################################## - # grab the problemContents from the form in order to save it to the tmp file - ######################################################## - my $problemContents = fixProblemContents($self->r->param('problemContents')); - $self->{r_problemContents} = \$problemContents; + $actionParams{'action.view.displayMode'} + ? $actionParams{'action.view.displayMode'}[0] + : $self->r->ce->{pg}{options}{displayMode}; - my $do_not_save = 0; - my $file_type = $self->{file_type}; - $self->saveFileChanges($tempFilePath,); - - ######################################################## - # construct redirect URL and redirect - ######################################################## - my $edit_level = $self->r->param("edit_level") || 0; - $edit_level++; - my $viewURL; - - my $relativeTempFilePath = $self->getRelativeSourceFilePath($tempFilePath); - - # redirect to Problem.pm or GatewayQuiz.pm - if ($file_type eq 'problem' or $file_type eq 'source_path_for_problem_file') { - # we need to know if the set is a gateway set to determine the redirect - my $globalSet = $r->db->getGlobalSet($setName); - - my $problemPage; - if (defined $globalSet && $globalSet->assignment_type =~ /gateway/) { - $problemPage = $r->urlpath->newFromModule( + # Grab the problemContents from the form in order to save it to the tmp file. + $self->{r_problemContents} = \(fixProblemContents($self->r->param('problemContents'))); + + $self->saveFileChanges($self->{tempFilePath}); + + my $relativeTempFilePath = $self->getRelativeSourceFilePath($self->{tempFilePath}); + + # Construct redirect URL and redirect to it. + if ($self->{file_type} eq 'problem' || $self->{file_type} eq 'source_path_for_problem_file') { + # Redirect to Problem.pm or GatewayQuiz.pm. + # We need to know if the set is a gateway set to determine the redirect. + my $globalSet = $self->r->db->getGlobalSet($self->{setID}); + + $self->reply_with_redirect($self->systemLink( + defined $globalSet && $globalSet->assignment_type =~ /gateway/ + ? $self->r->urlpath->newFromModule( 'WeBWorK::ContentGenerator::GatewayQuiz', $r, - courseID => $courseName, + courseID => $self->{courseID}, setID => 'Undefined_Set' - ); - } else { - $problemPage = $r->urlpath->newFromModule( + ) + : $self->r->urlpath->newFromModule( 'WeBWorK::ContentGenerator::Problem', $r, - courseID => $courseName, - setID => $r->db->existsUserSet($r->param('user'), $setName) ? $setName : 'Undefined_Set', - problemID => $problemNumber - ); - } - - $viewURL = $self->systemLink( - $problemPage, + courseID => $self->{courseID}, + setID => $self->{setID}, + problemID => $self->{problemID} + ), params => { displayMode => $displayMode, problemSeed => $problemSeed, - editMode => "temporaryFile", - edit_level => $edit_level, + editMode => 'temporaryFile', sourceFilePath => $relativeTempFilePath, status_message => uri_escape_utf8($self->{status_message}) } - ); - } elsif ($file_type eq 'set_header') { # redirect to ProblemSet - my $problemPage = $self->r->urlpath->newFromModule( - "WeBWorK::ContentGenerator::ProblemSet", $r, - courseID => $courseName, - setID => $setName, - ); - - $viewURL = $self->systemLink( - $problemPage, + )); + } elsif ($self->{file_type} eq 'set_header') { + # Redirect to ProblemSet + $self->reply_with_redirect($self->systemLink( + $self->r->urlpath->newFromModule( + 'WeBWorK::ContentGenerator::ProblemSet', $r, + courseID => $self->{courseID}, + setID => $self->{setID}, + ), params => { - set_header => $tempFilePath, + set_header => $self->{tempFilePath}, displayMode => $displayMode, problemSeed => $problemSeed, - editMode => "temporaryFile", - edit_level => $edit_level, + editMode => 'temporaryFile', sourceFilePath => $relativeTempFilePath, status_message => uri_escape_utf8($self->{status_message}) } - ); - } elsif ($file_type eq 'hardcopy_header') - { # redirect to ProblemSet?? # it's difficult to view temporary changes for hardcopy headers - my $problemPage = $self->r->urlpath->newFromModule( - "WeBWorK::ContentGenerator::ProblemSet", $r, - courseID => $courseName, - setID => $setName, - ); - - $viewURL = $self->systemLink( - $problemPage, + )); + } elsif ($self->{file_type} eq 'hardcopy_header') { + # Redirect to ProblemSet?? It's difficult to view temporary changes for hardcopy headers. + $self->reply_with_redirect($self->systemLink( + $self->r->urlpath->newFromModule( + 'WeBWorK::ContentGenerator::ProblemSet', $r, + courseID => $self->{courseID}, + setID => $self->{setID}, + ), params => { - set_header => $tempFilePath, + set_header => $self->{tempFilePath}, displayMode => $displayMode, problemSeed => $problemSeed, - editMode => "temporaryFile", - edit_level => $edit_level, + editMode => 'temporaryFile', sourceFilePath => $relativeTempFilePath, status_message => uri_escape_utf8($self->{status_message}) } - ); - } elsif ($file_type eq 'course_info') { # redirec to ProblemSets.pm - my $problemSetsPage = - $self->r->urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets", $r, courseID => $courseName); - $viewURL = $self->systemLink( - $problemSetsPage, - params => { - course_info => $tempFilePath, - editMode => "temporaryFile", - edit_level => $edit_level, - sourceFilePath => $relativeTempFilePath, - status_message => uri_escape_utf8($self->{status_message}) - } - ); - } elsif ($file_type eq 'options_info') { # redirec to Options.pm - my $optionsPage = - $self->r->urlpath->newFromModule("WeBWorK::ContentGenerator::Options", $r, courseID => $courseName); - $viewURL = $self->systemLink( - $optionsPage, + )); + } elsif ($self->{file_type} eq 'course_info') { + # Redirect to ProblemSets.pm. + $self->reply_with_redirect($self->systemLink( + $self->r->urlpath->newFromModule( + 'WeBWorK::ContentGenerator::ProblemSets', + $r, courseID => $self->{courseID} + ), params => { - options_info => $tempFilePath, - editMode => "temporaryFile", - edit_level => $edit_level, + course_info => $self->{tempFilePath}, + editMode => 'temporaryFile', sourceFilePath => $relativeTempFilePath, status_message => uri_escape_utf8($self->{status_message}) } - ); + )); } else { - die "I don't know how to redirect this file type $file_type "; + die "I don't know how to redirect this file type $self->{file_type}."; } - $self->reply_with_redirect($viewURL); + return; } +sub hardcopy_form { + my $self = shift; + my $r = $self->r; + my $ce = $r->ce; + + return '' if $self->{file_type} eq 'course_info'; + + return CGI::div( + CGI::div( + { class => 'row align-items-center' }, + CGI::label( + { for => 'action_hardcopy_seed_id', class => 'col-form-label col-auto mb-2' }, + $r->maketext('Using what seed?') + ), + CGI::div( + { class => 'col-auto mb-2' }, + CGI::textfield({ + id => 'action_hardcopy_seed_id', + name => 'action.hardcopy.seed', + value => $self->{problemSeed}, + class => 'form-control form-control-sm' + }) + ), + CGI::div( + { class => 'col-auto mb-2' }, + CGI::button({ + id => 'randomize_hardcopy_seed_id', + name => 'action.randomize.hardcopy.seed', + value => $r->maketext('Randomize Seed'), + class => 'btn btn-info btn-sm' + }) + ) + ), + CGI::div( + { class => 'row align-items-center mb-2' }, + CGI::label( + { for => 'action_hardcopy_format_id', class => 'col-form-label col-auto' }, + $r->maketext('Using which hardcopy format?'), + CGI::a( + { + class => 'help-popup', + data_bs_content => $r->maketext( + 'If "PDF" is selected, then a PDF file will be generated for download, unless there are ' + . 'errors. If errors occur generating a PDF file or "TeX Source" is selected then a ' + . 'zip file will be generated for download that contains the TeX source file and ' + . 'resources needed for generating the PDF file using pdflatex.' + ), + data_bs_placement => 'top', + data_bs_toggle => 'popover', + role => 'button', + tabindex => 0 + }, + CGI::i( + { + class => 'icon fas fa-question-circle', + data_alt => $r->maketext('Help Icon'), + aria_hidden => 'true' + }, + '' + ) + ) + ), + CGI::div( + { class => 'col-auto' }, + CGI::popup_menu({ + id => 'action_hardcopy_format_id', + name => 'action.hardcopy.format', + values => [ 'pdf', 'tex' ], + labels => { pdf => $r->maketext('PDF'), tex => $r->maketext('TeX Source') }, + default => $r->param('action.hardcopy.format') // 'pdf', + class => 'form-select form-select-sm d-inline w-auto', + }) + ) + ), + CGI::div( + { class => 'row align-items-center mb-2' }, + CGI::label( + { for => 'action_hardcopy_theme_id', class => 'col-form-label col-auto' }, + $r->maketext('Using which hardcopy theme?') + ), + CGI::div( + { class => 'col-auto' }, + CGI::popup_menu({ + id => 'action_hardcopy_theme_id', + name => 'action.hardcopy.theme', + values => $ce->{hardcopyThemes}, + default => $r->param('action.hardcopy.theme') // $ce->{hardcopyTheme}, + labels => { map { $_ => $ce->{hardcopyThemeNames}{$_} } @{ $ce->{hardcopyThemes} } }, + class => 'form-select form-select-sm d-inline w-auto' + }) + ) + ) + ); +} + +# The hardcopy action is handled by javascript. This is provided just in case +# something goes wrong and the action gets called. +sub hardcopy_action { } + sub add_problem_form { - my $self = shift; - my %actionParams = @_; - my $r = $self->r; - my $setName = $self->{setID} // ''; # Allow numeric 0 for $setName - my $problemNumber = $self->{problemID}; + my $self = shift; + my $r = $self->r; - return '' if $self->{file_type} eq 'course_info' || $self->{file_type} eq 'options_info'; + return '' if $self->{file_type} eq 'course_info'; - my $filePath = $self->{inputFilePath}; - $setName =~ s|^set||; - my @allSetNames = sort $r->db->listGlobalSets; - for (my $j = 0; $j < scalar(@allSetNames); $j++) { - $allSetNames[$j] =~ s|^set||; - $allSetNames[$j] =~ s|\.def||; - } + my $allSetNames = [ map { $_->[0] =~ s/^set|\.def$//gr } $r->db->listGlobalSetsWhere({}, 'set_id') ]; return CGI::div( CGI::div( @@ -1496,11 +1274,11 @@ sub add_problem_form { CGI::popup_menu({ id => 'action_add_problem_target_set_id', name => 'action.add_problem.target_set', - values => \@allSetNames, - labels => { map { $_ => format_set_name_display($_) } @allSetNames }, + values => $allSetNames, + labels => { map { $_ => format_set_name_display($_) } @$allSetNames }, class => 'form-select form-select-sm d-inline w-auto', dir => 'ltr', - default => $setName + default => $self->{setID} // '' }) ) ), @@ -1527,58 +1305,44 @@ sub add_problem_form { ) ) ); - - return ''; } sub add_problem_handler { - my ($self, $genericParams, $actionParams, $tableParams) = @_; + my ($self, %actionParams) = @_; my $r = $self->r; my $db = $r->db; - #$self->addgoodmessage("add_problem_handler called"); - my $courseName = $self->{courseID}; - my $setName = $self->{setID}; - my $problemNumber = $self->{problemID}; - my $sourceFilePath = $self->{editFilePath}; - my $displayMode = $self->{displayMode}; - my $problemSeed = $self->{problemSeed}; - - my $targetSetName = $actionParams->{'action.add_problem.target_set'}->[0]; - my $targetFileType = $actionParams->{'action.add_problem.file_type'}->[0]; - my $templatesPath = $self->r->ce->{courseDirs}->{templates}; - $sourceFilePath =~ s|^$templatesPath/||; - - my $edit_level = $self->r->param("edit_level") || 0; - $edit_level++; - - my $viewURL = ''; + + my $templatesPath = $self->r->ce->{courseDirs}{templates}; + my $sourceFilePath = $self->{editFilePath} =~ s|^$templatesPath/||r; + + my $targetSetName = $actionParams{'action.add_problem.target_set'}[0]; + my $targetFileType = $actionParams{'action.add_problem.file_type'}[0]; + if ($targetFileType eq 'problem') { my $targetProblemNumber; my $set = $db->getGlobalSet($targetSetName); - # for jitar sets new problems are put as top level - # problems at the end if ($set->assignment_type eq 'jitar') { - my @problemIDs = $db->listGlobalProblems($targetSetName); - @problemIDs = sort { $a <=> $b } @problemIDs; - my @seq = jitar_id_to_seq($problemIDs[$#problemIDs]); + # For jitar sets new problems are put as top level problems at the end. + my @problemIDs = map { $_->[1] } $db->listGlobalProblemsWhere({ set_id => $targetSetName }, 'problem_id'); + my @seq = jitar_id_to_seq($problemIDs[-1]); $targetProblemNumber = seq_to_jitar_id($seq[0] + 1); } else { - $targetProblemNumber = 1 + WeBWorK::Utils::max($db->listGlobalProblems($targetSetName)); + $targetProblemNumber = 1 + max($db->listGlobalProblems($targetSetName)); } - ################################################# # Update problem record - ################################################# my $problemRecord = $self->addProblemToSet( setName => $targetSetName, sourceFile => $sourceFilePath, - problemID => $targetProblemNumber, #added to end of set + problemID => $targetProblemNumber, ); + $self->assignProblemToAllSetUsers($problemRecord); + $self->addgoodmessage($r->maketext( - "Added [_1] to [_2] as problem [_3]", + 'Added [_1] to [_2] as problem [_3]', $sourceFilePath, $targetSetName, ( @@ -1587,109 +1351,100 @@ sub add_problem_handler { : $targetProblemNumber ) )); - $self->{file_type} = 'problem'; # change file type to problem -- if it's not already that - - ################################################# - # Set up redirect to problem editor page. - ################################################# - my $problemPage = $self->r->urlpath->newFromModule( - "WeBWorK::ContentGenerator::Instructor::PGProblemEditor", $r, - courseID => $courseName, - setID => $targetSetName, - problemID => $targetProblemNumber, - ); - my $relativeSourceFilePath = $self->getRelativeSourceFilePath($sourceFilePath); - $viewURL = $self->systemLink( - $problemPage, + $self->{file_type} = 'problem'; # Change file type to problem if it is not already that. + + # Redirect to problem editor page. + $self->reply_with_redirect($self->systemLink( + $self->r->urlpath->newFromModule( + 'WeBWorK::ContentGenerator::Instructor::PGProblemEditor', $r, + courseID => $self->{courseID}, + setID => $targetSetName, + problemID => $targetProblemNumber, + ), params => { - displayMode => $displayMode, - problemSeed => $problemSeed, - editMode => "savedFile", - edit_level => $edit_level, - sourceFilePath => $relativeSourceFilePath, + displayMode => $self->{displayMode}, + problemSeed => $self->{problemSeed}, + editMode => 'savedFile', + sourceFilePath => $self->getRelativeSourceFilePath($sourceFilePath), status_message => uri_escape_utf8($self->{status_message}), file_type => 'problem', } - ); + )); } elsif ($targetFileType eq 'set_header') { - ################################################# # Update set record - ################################################# my $setRecord = $self->r->db->getGlobalSet($targetSetName); $setRecord->set_header($sourceFilePath); if ($self->r->db->putGlobalSet($setRecord)) { $self->addgoodmessage($r->maketext( - "Added '[_1]' to [_2] as new set header", + 'Added "[_1]" to [_2] as new set header', $self->shortPath($sourceFilePath), $targetSetName )); } else { - $self->addbadmessage( - "Unable to make '" . $self->shortPath($sourceFilePath) . "' the set header for $targetSetName"); + $self->addbadmessage($r->maketext( + 'Unable to make "[_1]" the set header for [_2].', $self->shortPath($sourceFilePath), + $targetSetName + )); } - $self->{file_type} = 'set_header'; # change file type to set_header if it not already so - ################################################# - # Set up redirect - ################################################# - my $problemPage = $self->r->urlpath->newFromModule( - "WeBWorK::ContentGenerator::ProblemSet", $r, - courseID => $courseName, - setID => $targetSetName - ); - $viewURL = $self->systemLink( - $problemPage, + + $self->{file_type} = 'set_header'; # Change file type to set_header if not already so. + + # Redirect + $self->reply_with_redirect($self->systemLink( + $self->r->urlpath->newFromModule( + 'WeBWorK::ContentGenerator::ProblemSet', $r, + courseID => $self->{courseID}, + setID => $targetSetName + ), params => { - displayMode => $displayMode, - editMode => "savedFile", - edit_level => $edit_level, + displayMode => $self->{displayMode}, + editMode => 'savedFile', status_message => uri_escape_utf8($self->{status_message}), } - ); + )); } elsif ($targetFileType eq 'hardcopy_header') { - ################################################# # Update set record - ################################################# my $setRecord = $self->r->db->getGlobalSet($targetSetName); $setRecord->hardcopy_header($sourceFilePath); if ($self->r->db->putGlobalSet($setRecord)) { $self->addgoodmessage($r->maketext( - "Added '[_1]' to [_2] as new hardcopy header", + 'Added "[_1]" to [_2] as new hardcopy header', $self->shortPath($sourceFilePath), $targetSetName )); } else { - $self->addbadmessage("Unable to make '" - . $self->shortPath($sourceFilePath) - . "' the hardcopy header for $targetSetName"); + $self->addbadmessage( + $r->maketext('Unable to make "[_1]" the hardcopy header for [_2].'), + $self->shortPath($sourceFilePath), + $targetSetName + ); } - $self->{file_type} = 'hardcopy_header'; # change file type to set_header if it not already so - ################################################# - # Set up redirect - ################################################# - my $problemPage = $self->r->urlpath->newFromModule( - "WeBWorK::ContentGenerator::Hardcopy", $r, - courseID => $courseName, - setID => $targetSetName - ); - $viewURL = $self->systemLink( - $problemPage, + + $self->{file_type} = 'hardcopy_header'; # Change file type to set_header if not already so. + + # Redirect + $self->reply_with_redirect($self->systemLink( + $self->r->urlpath->newFromModule( + 'WeBWorK::ContentGenerator::Hardcopy', $r, + courseID => $self->{courseID}, + setID => $targetSetName + ), params => { - displayMode => $displayMode, - editMode => "savedFile", - edit_level => $edit_level, + displayMode => $self->{displayMode}, + editMode => 'savedFile', status_message => uri_escape_utf8($self->{status_message}), } - ); + )); } else { - die "Don't know what to do with target file type $targetFileType"; + die "Unsupported target file type $targetFileType"; } - $self->reply_with_redirect($viewURL); + return; } sub save_form { - my ($self, %actionParams) = @_; - my $r = $self->r; + my $self = shift; + my $r = $self->r; if ($self->{editFilePath} =~ /$BLANKPROBLEM$/) { # Can't save blank problems without changing names. @@ -1707,200 +1462,163 @@ sub save_form { { class => 'form-check mb-2' }, CGI::input({ type => 'checkbox', + name => 'newWindowSave', id => 'newWindowSave', - class => 'form-check-input' + class => 'form-check-input', + $self->{file_type} eq 'hardcopy_header' ? (checked => undef) : () }), CGI::label( { for => 'newWindowSave', class => 'form-check-label' }, $r->maketext('Open in new window') ) - ) + ), + CGI::hidden({ name => 'action.save.source_file', value => $self->{editFilePath} }), ); } else { - # Can't save -- No write permission; + # Can't save. No write permission. return ''; } } sub save_handler { - my ($self, $genericParams, $actionParams, $tableParams) = @_; - my $r = $self->r; - #$self->addgoodmessage("save_handler called"); - my $courseName = $self->{courseID}; - my $setName = $self->{setID}; - my $fullSetName = $self->{fullSetID}; - my $problemNumber = $self->{problemID}; - my $displayMode = $self->{displayMode}; - my $problemSeed = $self->{problemSeed}; + my $self = shift; + my $r = $self->r; - ################################################# - # grab the problemContents from the form in order to save it to a new permanent file - # later we will unlink (delete) the current temporary file - ################################################# - my $problemContents = fixProblemContents($self->r->param('problemContents')); - $self->{r_problemContents} = \$problemContents; + # Grab the problemContents from the form in order to save it to a new permanent file. + # Later we will unlink (delete) the current temporary file. + $self->{r_problemContents} = \(fixProblemContents($self->r->param('problemContents'))); - ################################################# - # Construct the output file path - ################################################# - my $editFilePath = $self->{editFilePath}; - my $outputFilePath = $editFilePath; + # Sanity check in case the user has edited the problem set while editing a problem. + # This can cause the current editor contents to overwrite the new file that is saved for the problem. + if ($self->{editFilePath} ne $r->param('action.save.source_file')) { + $self->addbadmessage($r->maketext( + 'File not saved. The file name for this problem does not match the file name the editor was opened with. ' + . 'The problem set may have changed. Please reopen this file from the homework sets editor.' + )); + } else { + $self->saveFileChanges($self->{editFilePath}); + } - my $do_not_save = 0; - my $file_type = $self->{file_type}; - $self->saveFileChanges($outputFilePath); - ################################################# - # Set up redirect to Problem.pm - ################################################# - my $viewURL; - ######################################################## - # construct redirect URL and redirect - ######################################################## - if ($file_type eq 'problem' || $file_type eq 'source_path_for_problem_file') { # redirect to Problem.pm - # we need to know if the set is a gateway set to determine the redirect - my $globalSet = $self->r->db->getGlobalSet($setName); - my $problemPage; - if (defined($globalSet) && $globalSet->assignment_type =~ /gateway/) { - $problemPage = $self->r->urlpath->newFromModule( - "WeBWorK::ContentGenerator::GatewayQuiz", $r, - courseID => $courseName, - setID => "Undefined_Set" - ); - # courseID => $courseName, setID => $fullSetName); - } else { - $problemPage = $self->r->urlpath->newFromModule( - "WeBWorK::ContentGenerator::Problem", $r, - courseID => $courseName, - setID => $setName, - problemID => $problemNumber - ); - } + # Don't redirect unless it was requested to open in a new window. + return unless $r->param('newWindowSave'); - my $relativeEditFilePath = $self->getRelativeSourceFilePath($editFilePath); + if ($self->{file_type} eq 'problem' || $self->{file_type} eq 'source_path_for_problem_file') { + # Redirect to Problem.pm or GatewayQuiz.pm. + # We need to know if the set is a gateway set to determine the redirect. + my $globalSet = $self->r->db->getGlobalSet($self->{setID}); - $viewURL = $self->systemLink( - $problemPage, + $self->reply_with_redirect($self->systemLink( + defined $globalSet && $globalSet->assignment_type =~ /gateway/ + ? $self->r->urlpath->newFromModule( + 'WeBWorK::ContentGenerator::GatewayQuiz', $r, + courseID => $self->{courseID}, + setID => 'Undefined_Set' + ) + : $self->r->urlpath->newFromModule( + 'WeBWorK::ContentGenerator::Problem', $r, + courseID => $self->{courseID}, + setID => $self->{setID}, + problemID => $self->{problemID} + ), params => { - displayMode => $displayMode, - problemSeed => $problemSeed, - editMode => "savedFile", - edit_level => 0, - sourceFilePath => $relativeEditFilePath, + displayMode => $self->{displayMode}, + problemSeed => $self->{problemSeed}, + editMode => 'savedFile', + sourceFilePath => $self->getRelativeSourceFilePath($self->{editFilePath}), status_message => uri_escape_utf8($self->{status_message}) } - ); - } elsif ($file_type eq 'set_header') { # redirect to ProblemSet - my $problemPage = $self->r->urlpath->newFromModule( - "WeBWorK::ContentGenerator::ProblemSet", $r, - courseID => $courseName, - setID => $setName, - ); - - $viewURL = $self->systemLink( - $problemPage, + )); + } elsif ($self->{file_type} eq 'set_header') { + # Redirect to ProblemSet + $self->reply_with_redirect($self->systemLink( + $self->r->urlpath->newFromModule( + 'WeBWorK::ContentGenerator::ProblemSet', $r, + courseID => $self->{courseID}, + setID => $self->{setID}, + ), params => { - displayMode => $displayMode, - problemSeed => $problemSeed, - editMode => "savedFile", - edit_level => 0, + displayMode => $self->{displayMode}, + problemSeed => $self->{problemSeed}, + editMode => 'savedFile', status_message => uri_escape_utf8($self->{status_message}) } - ); - } elsif ($file_type eq 'hardcopy_header') { # redirect to ProblemSet - my $problemPage = $self->r->urlpath->newFromModule( - 'WeBWorK::ContentGenerator::Hardcopy', $r, - courseID => $courseName, - setID => $setName, - ); - - $viewURL = $self->systemLink( - $problemPage, - params => { - displayMode => $displayMode, - problemSeed => $problemSeed, - editMode => "savedFile", - edit_level => 0, - status_message => uri_escape_utf8($self->{status_message}) - } - ); - } elsif ($file_type eq 'course_info') { # redirect to ProblemSets.pm - my $problemSetsPage = - $self->r->urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets", $r, courseID => $courseName); - $viewURL = $self->systemLink( - $problemSetsPage, + )); + } elsif ($self->{file_type} eq 'hardcopy_header') { + # Redirect to ProblemSet + $self->reply_with_redirect($self->systemLink( + $self->r->urlpath->newFromModule( + 'WeBWorK::ContentGenerator::Hardcopy', $r, + courseID => $self->{courseID}, + setID => $self->{setID}, + ), params => { - editMode => ("savedFile"), - edit_level => 0, + displayMode => $self->{displayMode}, + problemSeed => $self->{problemSeed}, + editMode => 'savedFile', status_message => uri_escape_utf8($self->{status_message}) } - ); - } elsif ($file_type eq 'options_info') { # redirect to Options.pm - my $optionsPage = - $self->r->urlpath->newFromModule("WeBWorK::ContentGenerator::Options", $r, courseID => $courseName); - $viewURL = $self->systemLink( - $optionsPage, + )); + } elsif ($self->{file_type} eq 'course_info') { + # Redirect to ProblemSets.pm + $self->reply_with_redirect($self->systemLink( + $self->r->urlpath->newFromModule( + 'WeBWorK::ContentGenerator::ProblemSets', + $r, courseID => $self->{courseID} + ), params => { - editMode => ("savedFile"), - edit_level => 0, + editMode => 'savedFile', status_message => uri_escape_utf8($self->{status_message}) } - ); - } elsif ($file_type eq 'source_path_for_problem_file') { # redirect to ProblemSets.pm - my $problemPage = $self->r->urlpath->newFromModule( - "WeBWorK::ContentGenerator::Instructor::PGProblemEditor", $r, - courseID => $courseName, - setID => $setName, - problemID => $problemNumber - ); - my $viewURL = $self->systemLink( - $problemPage, + )); + } elsif ($self->{file_type} eq 'source_path_for_problem_file') { + # Redirect to ProblemSets.pm + $self->reply_with_redirect($self->systemLink( + $self->r->urlpath->newFromModule( + 'WeBWorK::ContentGenerator::Instructor::PGProblemEditor', $r, + courseID => $self->{courseID}, + setID => $self->{setID}, + problemID => $self->{problemID} + ), params => { - displayMode => $displayMode, - problemSeed => $problemSeed, - editMode => "savedFile", - edit_level => 0, - sourceFilePath => $outputFilePath, #The path relative to the templates directory is required. + displayMode => $self->{displayMode}, + problemSeed => $self->{problemSeed}, + editMode => 'savedFile', + # The path relative to the templates directory is required. + sourceFilePath => $self->{editFilePath}, file_type => 'source_path_for_problem_file', status_message => uri_escape_utf8($self->{status_message}) } - ); + )); } else { - die "I don't know how to redirect this file type $file_type "; + die "Unsupported save file type $self->{file_type}."; } - $self->reply_with_redirect($viewURL); + + return; } -# Calls the save_as_handler sub save_as_form { - my ($self, %actionParams) = @_; - my $r = $self->r; - my $editFilePath = $self->{editFilePath}; - - my $templatesDir = $self->r->ce->{courseDirs}->{templates}; - my $setID = $self->{setID}; - my $fullSetID = $self->{fullSetID}; + my $self = shift; + my $r = $self->r; - my $fileDir = dirname($editFilePath); - my $shortFilePath = $editFilePath; - $shortFilePath =~ s|^$templatesDir/||; + my $templatesDir = $self->r->ce->{courseDirs}{templates}; + my $shortFilePath = $self->{editFilePath} =~ s|^$templatesDir/||r; # Suggest that modifications be saved to the "local" subdirectory if its not in a writeable directory $shortFilePath = 'local/' . $shortFilePath - if (!-w $fileDir); + if (!-w dirname($self->{editFilePath})); - # If it is still an absolute path don't suggest a file path to save to. - $shortFilePath =~ s|^.*/|| - if $shortFilePath =~ m|^/|; + # If it is an absolute path make it relative. + $shortFilePath =~ s|^/*|| if $shortFilePath =~ m|^/|; - my $probNum = ($self->{file_type} eq 'problem') ? $self->{problemID} : 'header'; + my $probNum = $self->{file_type} eq 'problem' ? $self->{problemID} : 'header'; # Don't add or replace problems to sets if the set is the Undefined_Set or if the problem is the blank_problem. my $can_add_problem_to_set = - not_blank($setID) && $setID ne 'Undefined_Set' && $self->{file_type} ne 'blank_problem'; + not_blank($self->{setID}) && $self->{setID} ne 'Undefined_Set' && $self->{file_type} ne 'blank_problem'; my $prettyProbNum = $probNum; - if ($setID) { - my $set = $self->r->db->getGlobalSet($setID); + if ($self->{setID}) { + my $set = $self->r->db->getGlobalSet($self->{setID}); $prettyProbNum = join('.', jitar_id_to_seq($probNum)) if ($self->{file_type} eq 'problem' && $set && $set->assignment_type eq 'jitar'); } @@ -1927,7 +1645,7 @@ sub save_as_form { }) ) ), - CGI::hidden({ name => 'action.save_as.source_file', value => $editFilePath }), + CGI::hidden({ name => 'action.save_as.source_file', value => $self->{editFilePath} }), CGI::hidden({ name => 'action.save_as.file_type', value => $self->{file_type} }) ), ( @@ -1946,7 +1664,8 @@ sub save_as_form { $r->maketext( 'Replace current problem: [_1]', CGI::strong( - CGI::span({ dir => 'ltr' }, format_set_name_display($fullSetID)) . "/$prettyProbNum" + CGI::span({ dir => 'ltr' }, format_set_name_display($self->{fullSetID})) + . "/$prettyProbNum" ) ) ) @@ -1966,7 +1685,7 @@ sub save_as_form { { for => 'action_save_as_saveMode_new_problem_id', class => 'form-check-label' }, $r->maketext( 'Append to end of [_1] set', - CGI::strong({ dir => 'ltr' }, format_set_name_display($fullSetID)) + CGI::strong({ dir => 'ltr' }, format_set_name_display($self->{fullSetID})) ) ) ) : '' @@ -1988,165 +1707,145 @@ sub save_as_form { ) ); } -# suggestions for improvement -# save as ...... -# * replacing foobar (rename) * and add to set (add_new_problem) * as an independent file (new_independent_problem) sub save_as_handler { - my ($self, $genericParams, $actionParams, $tableParams) = @_; + my ($self, %actionParams) = @_; my $r = $self->r; - #$self->addgoodmessage("save_as_handler called"); - $self->{status_message} = ''; ## DPVC -- remove bogus old messages - my $courseName = $self->{courseID}; - my $setName = $self->{setID}; - my $fullSetName = $self->{fullSetID}; - my $problemNumber = $self->{problemID}; - my $displayMode = $self->{displayMode}; - my $problemSeed = $self->{problemSeed}; - my $effectiveUserName = $self->r->param('effectiveUser'); - - my $do_not_save = 0; - my $saveMode = $actionParams->{'action.save_as.saveMode'}->[0] || 'no_save_mode_selected'; - my $new_file_name = $actionParams->{'action.save_as.target_file'}->[0] || ''; - my $sourceFilePath = $actionParams->{'action.save_as.source_file'}->[0] || ''; - my $file_type = $actionParams->{'action.save_as.file_type'}->[0] || ''; - $self->{sourceFilePath} = $sourceFilePath; # store for use in saveFileChanges - $new_file_name =~ s/^\s*//; #remove initial and final white space - $new_file_name =~ s/\s*$//; - - if ($new_file_name !~ /\S/) { # need a non-blank file name - # setting $self->{failure} stops saving and any redirects + + $self->{status_message} = ''; + + my $do_not_save = 0; + + my $saveMode = $actionParams{'action.save_as.saveMode'}[0] || 'no_save_mode_selected'; + my $new_file_name = ($actionParams{'action.save_as.target_file'}[0] || '') =~ s/^\s*|\s*$//gr; + $self->{sourceFilePath} = $actionParams{'action.save_as.source_file'}[0] || ''; # Store for use in saveFileChanges. + my $file_type = $actionParams{'action.save_as.file_type'}[0] || ''; + + # Need a non-blank file name. + if (!$new_file_name) { $do_not_save = 1; - $self->addbadmessage(CGI::p($r->maketext("Please specify a file to save to."))); + $self->addbadmessage(CGI::div($r->maketext('Please specify a file to save to.'))); } - ################################################# - # grab the problemContents from the form in order to save it to a new permanent file - # later we will unlink (delete) the current temporary file - ################################################# - my $problemContents = fixProblemContents($self->r->param('problemContents')); - $self->{r_problemContents} = \$problemContents; - warn "problem contents is empty" unless $problemContents; - ################################################# - # Rescue the user in case they forgot to end the file name with .pg - ################################################# - - if ($file_type eq 'problem' - or $file_type eq 'blank_problem' - or $file_type eq 'set_header') + # Rescue the user in case they forgot to end the file name with the pg extension. + if (($file_type eq 'problem' || $file_type eq 'blank_problem' || $file_type eq 'set_header') + && $new_file_name !~ /\.pg$/) { - $new_file_name =~ s/\.pg$//; # remove it if it is there - $new_file_name .= '.pg'; # put it there + $new_file_name .= '.pg'; } - ################################################# + + # Grab the problemContents from the form in order to save it to a new permanent file. + # Later we will unlink (delete) the current temporary file. + $self->{r_problemContents} = \(fixProblemContents($self->r->param('problemContents'))); + # Construct the output file path - ################################################# - my $outputFilePath = $self->r->ce->{courseDirs}->{templates} . '/' . $new_file_name; - if (defined $outputFilePath and -e $outputFilePath) { - # setting $do_not_save stops saving and any redirects + my $outputFilePath = $self->r->ce->{courseDirs}{templates} . "/$new_file_name"; + if (defined $outputFilePath && -e $outputFilePath) { $do_not_save = 1; - $self->addbadmessage(CGI::p($r->maketext( - "File '[_1]' exists. File not saved. No changes have been made. You can change the file path for this problem manually from the 'Hmwk Sets Editor' page", + $self->addbadmessage(CGI::div($r->maketext( + 'File "[_1]" exists. File not saved. No changes have been made. ' + . 'You can change the file path for this problem manually from the "Hmwk Sets Editor" page', $self->shortPath($outputFilePath) ))); - $self->addgoodmessage(CGI::p( - $r->maketext( - "The text box now contains the source of the original problem. You can recover lost edits by using the Back button on your browser." - ) - )); + $self->addgoodmessage(CGI::div($r->maketext( + 'The text box now contains the source of the original problem. ' + . 'You can recover lost edits by using the Back button on your browser.' + ))); } else { - $self->{editFilePath} = $outputFilePath; - $self->{tempFilePath} = ''; # nothing needs to be unlinked. - $self->{inputFilePath} = ''; + $self->{editFilePath} = $outputFilePath; + # saveFileChanges will update the tempFilePath and inputFilePath as needed. Don't do that here. } unless ($do_not_save) { $self->saveFileChanges($outputFilePath); my $targetProblemNumber; - if ($saveMode eq 'rename' and -r $outputFilePath) { - ################################################# - # Modify source file path in problem - ################################################# + if ($saveMode eq 'rename' && -r $outputFilePath) { + # Modify source file path in problem. if ($file_type eq 'set_header') { - my $setRecord = $self->r->db->getGlobalSet($setName); + my $setRecord = $self->r->db->getGlobalSet($self->{setID}); $setRecord->set_header($new_file_name); if ($self->r->db->putGlobalSet($setRecord)) { $self->addgoodmessage($r->maketext( - "The set header for set [_1] has been renamed to '[_2]'.", $setName, + 'The set header for set [_1] has been renamed to "[_2]".', $self->{setID}, $self->shortPath($outputFilePath) )); } else { - $self->addbadmessage("Unable to change the set header for set $setName. Unknown error."); + $self->addbadmessage($r->maketext( + 'Unable to change the set header for set [_1]. Unknown error.', + $self->{setID} + )); } } elsif ($file_type eq 'hardcopy_header') { - my $setRecord = $self->r->db->getGlobalSet($setName); + my $setRecord = $self->r->db->getGlobalSet($self->{setID}); $setRecord->hardcopy_header($new_file_name); if ($self->r->db->putGlobalSet($setRecord)) { $self->addgoodmessage($r->maketext( - "The hardcopy header for set [_1] has been renamed to '[_2]'.", $setName, + 'The hardcopy header for set [_1] has been renamed to "[_2]".', $self->{setID}, $self->shortPath($outputFilePath) )); } else { - $self->addbadmessage("Unable to change the hardcopy header for set $setName. Unknown error."); + $self->addbadmessage($r->maketext( + 'Unable to change the hardcopy header for set [_1]. Unknown error.', + $self->{setID} + )); } } else { my $problemRecord; - if ($fullSetName =~ /,v(\d+)$/) { - $problemRecord = - $self->r->db->getMergedProblemVersion($effectiveUserName, $setName, $1, $problemNumber); + if ($self->{versionID}) { + $problemRecord = $self->r->db->getMergedProblemVersion($r->param('effectiveUser'), + $self->{setID}, $1, $self->{problemID}); } else { - $problemRecord = $self->r->db->getGlobalProblem($setName, $problemNumber); + $problemRecord = $self->r->db->getGlobalProblem($self->{setID}, $self->{problemID}); } $problemRecord->source_file($new_file_name); my $result = - ($fullSetName =~ /,v(\d+)$/) + $self->{versionID} ? $self->r->db->putProblemVersion($problemRecord) : $self->r->db->putGlobalProblem($problemRecord); - my $prettyProblemNumber = $problemNumber; - my $set = $self->r->db->getGlobalSet($setName); - $prettyProblemNumber = join('.', jitar_id_to_seq($problemNumber)) + my $prettyProblemNumber = $self->{problemID}; + my $set = $self->r->db->getGlobalSet($self->{setID}); + $prettyProblemNumber = join('.', jitar_id_to_seq($self->{problemID})) if ($set && $set->assignment_type eq 'jitar'); if ($result) { $self->addgoodmessage($r->maketext( - "The source file for 'set [_1] / problem [_2] has been changed from '[_3]' to '[_4]'", - $fullSetName, + 'The source file for "set [_1] / problem [_2] has been changed from "[_3]" to "[_4]".', + $self->{fullSetID}, $prettyProblemNumber, - $self->shortPath($sourceFilePath), + $self->shortPath($self->{sourceFilePath}), $self->shortPath($outputFilePath) )); } else { - $self->addbadmessage( - "Unable to change the source file path for set $fullSetName, problem $prettyProblemNumber. Unknown error." - ); + $self->addbadmessage($r->maketext( + 'Unable to change the source file path for set [_1], problem [_2]. Unknown error.', + $self->{fullSetID}, $prettyProblemNumber + )); } } } elsif ($saveMode eq 'add_to_set_as_new_problem') { + my $set = $self->r->db->getGlobalSet($self->{setID}); - my $set = $self->r->db->getGlobalSet($setName); - - # for jitar sets new problems are put as top level - # problems at the end + # For jitar sets new problems are put as top level problems at the end. if ($set->assignment_type eq 'jitar') { - my @problemIDs = $self->r->db->listGlobalProblems($setName); + my @problemIDs = $self->r->db->listGlobalProblems($self->{setID}); @problemIDs = sort { $a <=> $b } @problemIDs; - my @seq = jitar_id_to_seq($problemIDs[$#problemIDs]); + my @seq = jitar_id_to_seq($problemIDs[-1]); $targetProblemNumber = seq_to_jitar_id($seq[0] + 1); } else { - $targetProblemNumber = 1 + WeBWorK::Utils::max($self->r->db->listGlobalProblems($setName)); + $targetProblemNumber = 1 + max($self->r->db->listGlobalProblems($self->{setID})); } my $problemRecord = $self->addProblemToSet( - setName => $setName, + setName => $self->{setID}, sourceFile => $new_file_name, - problemID => $targetProblemNumber, #added to end of set + problemID => $targetProblemNumber, # Added to end of set ); $self->assignProblemToAllSetUsers($problemRecord); $self->addgoodmessage($r->maketext( - "Added [_1] to [_2] as problem [_3]", + 'Added [_1] to [_2] as problem [_3].', $new_file_name, - $setName, + $self->{setID}, ( $set->assignment_type eq 'jitar' ? join('.', jitar_id_to_seq($targetProblemNumber)) @@ -2154,112 +1853,106 @@ sub save_as_handler { ) )); } elsif ($saveMode eq 'new_independent_problem') { - ################################################# - # Don't modify source file path in problem -- just report - ################################################# $self->addgoodmessage($r->maketext( - "A new file has been created at '[_1]' with the contents below. No changes have been made to set [_2]", - $self->shortPath($outputFilePath), - $setName + 'A new file has been created at "[_1]" with the contents below.', + $self->shortPath($outputFilePath) )); + $self->addgoodmessage($r->maketext(' No changes have been made to set [_1]', $self->{setID})) + if ($self->{setID} ne 'Undefined_Set'); } else { - $self->addbadmessage("Don't recognize saveMode: |$saveMode|. Unknown error."); + $self->addbadmessage($r->maketext('Unkown saveMode: [_1].', $saveMode)); + return; } } - my $edit_level = $self->r->param("edit_level") || 0; - $edit_level++; - ################################################# - # Set up redirect - # The redirect gives the server time to detect that the new file exists. - ################################################# + # Set up redirect. my $problemPage; my $new_file_type; if ($saveMode eq 'new_independent_problem') { $problemPage = $self->r->urlpath->newFromModule( - "WeBWorK::ContentGenerator::Instructor::PGProblemEditor", $r, - courseID => $courseName, + 'WeBWorK::ContentGenerator::Instructor::PGProblemEditor', $r, + courseID => $self->{courseID}, setID => 'Undefined_Set', problemID => 1 ); $new_file_type = 'source_path_for_problem_file'; } elsif ($saveMode eq 'rename') { $problemPage = $self->r->urlpath->newFromModule( - "WeBWorK::ContentGenerator::Instructor::PGProblemEditor", $r, - courseID => $courseName, - setID => $setName, - problemID => $problemNumber + 'WeBWorK::ContentGenerator::Instructor::PGProblemEditor', $r, + courseID => $self->{courseID}, + setID => $self->{setID}, + problemID => $self->{problemID} ); $new_file_type = $file_type; } elsif ($saveMode eq 'add_to_set_as_new_problem') { $problemPage = $self->r->urlpath->newFromModule( 'WeBWorK::ContentGenerator::Instructor::PGProblemEditor', $r, - courseID => $courseName, - setID => $setName, - problemID => $do_not_save - ? $problemNumber - : WeBWorK::Utils::max($self->r->db->listGlobalProblems($setName)) + courseID => $self->{courseID}, + setID => $self->{setID}, + problemID => $do_not_save ? $self->{problemID} : max($self->r->db->listGlobalProblems($self->{setID})) ); $new_file_type = $file_type; } else { - $self->addbadmessage( - " Please use radio buttons to choose the method for saving this file. Can't recognize saveMode: |$saveMode|." - ); - # can't continue since paths have not been properly defined. - return ""; + $self->addbadmessage($r->maketext( + 'Please use radio buttons to choose the method for saving this file. Uknown saveMode: [_1].', $saveMode + )); + return; } - my $relativeOutputFilePath = $self->getRelativeSourceFilePath($outputFilePath); - - my $viewURL = $self->systemLink( + $self->reply_with_redirect($self->systemLink( $problemPage, params => { - sourceFilePath => $relativeOutputFilePath, #The path relative to the templates directory is required. - problemSeed => $problemSeed, - edit_level => $edit_level, + # The path relative to the templates directory is required. + sourceFilePath => $self->getRelativeSourceFilePath($outputFilePath), + problemSeed => $self->{problemSeed}, file_type => $new_file_type, status_message => uri_escape_utf8($self->{status_message}) } - ); - - $self->reply_with_redirect($viewURL); - return ""; # no redirect needed + )); + return; } sub revert_form { - my ($self, %actionParams) = @_; - my $r = $self->r; - my $editFilePath = $self->{editFilePath}; - return $r->maketext("Error: The original file [_1] cannot be read.", $editFilePath) unless -r $editFilePath; - return "" unless defined($self->{tempFilePath}) and -e $self->{tempFilePath}; - return $r->maketext("Revert to [_1]", CGI::span({ dir => 'ltr' }, $self->shortPath($editFilePath))); + my $self = shift; + my $r = $self->r; + return $r->maketext('Error: The original file [_1] cannot be read.', $self->{editFilePath}) + unless -r $self->{editFilePath}; + return '' unless defined $self->{tempFilePath} && -e $self->{tempFilePath}; + return $r->maketext('Revert to [_1]', CGI::span({ dir => 'ltr' }, $self->shortPath($self->{editFilePath}))); } sub revert_handler { - my ($self, $genericParams, $actionParams, $tableParams) = @_; - my $ce = $self->r->ce; - #$self->addgoodmessage("revert_handler called"); - my $editFilePath = $self->{editFilePath}; - $self->{inputFilePath} = $editFilePath; - # unlink the temp files; - die "tempFilePath is unsafe!" - unless path_is_subdir($self->{tempFilePath}, $ce->{courseDirs}->{templates}, 1) - ; # 1==path can be relative to dir + my $self = shift; + my $r = $self->r; + my $ce = $r->ce; + + $self->{inputFilePath} = $self->{editFilePath}; + + unless (path_is_subdir($self->{tempFilePath}, $ce->{courseDirs}{templates}, 1)) { + $self->addbadmessage($r->maketext( + 'The temporary file [_1] is not contained in the course templates directory and can not be deleted.', + $self->{tempFilePath} + )); + return; + } + + # Unlink the temp files; unlink($self->{tempFilePath}); - $self->addgoodmessage("Deleting temp file at " . $self->shortPath($self->{tempFilePath})); - $self->{tempFilePath} = ''; - my $problemContents = ''; - $self->{r_problemContents} = \$problemContents; - $self->addgoodmessage("Reverting to original file '" . $self->shortPath($editFilePath) . "'"); - # no redirect is needed + $self->addgoodmessage($r->maketext('Deleted temporary file [_1].', $self->shortPath($self->{tempFilePath}))); + + $self->{r_problemContents} = \''; + + $self->addgoodmessage($r->maketext('Reverted to original file "[_1]".', $self->shortPath($self->{editFilePath}))); + + return; } sub output_JS { my $self = shift; my $ce = $self->r->ce; - WeBWorK::ContentGenerator::Instructor::CodeMirrorEditor::output_codemirror_static_files($ce); + output_codemirror_static_files($ce); print CGI::script({ src => getAssetURL($ce, 'js/apps/ActionTabs/actiontabs.js'), defer => undef }, ''); print CGI::script({ src => getAssetURL($ce, 'js/apps/PGProblemEditor/pgproblemeditor.js'), defer => undef }, ''); diff --git a/lib/WeBWorK/ContentGenerator/Instructor/ProblemSetDetail.pm b/lib/WeBWorK/ContentGenerator/Instructor/ProblemSetDetail.pm index 4c05ba8ab6..2e332fc957 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/ProblemSetDetail.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/ProblemSetDetail.pm @@ -2528,8 +2528,7 @@ sub body { type => 'instructor_problem_editor_withset_withproblem', args => { courseID => $courseID, setID => $setID, problemID => 0 } ); - my $editHeaderLink = - $self->systemLink($editHeaderPage, params => { file_type => $headerType, make_local_copy => 1 }); + my $editHeaderLink = $self->systemLink($editHeaderPage, params => { file_type => $headerType }); my $viewHeaderPage = $urlpath->new(type => $headerModules{$headerType}, args => { courseID => $courseID, setID => $setID }); @@ -2725,7 +2724,7 @@ sub body { type => 'instructor_problem_editor_withset_withproblem', args => { courseID => $courseID, setID => $fullSetID, problemID => $problemID } ); - $editProblemLink = $self->systemLink($editProblemPage, params => { make_local_copy => 0 }); + $editProblemLink = $self->systemLink($editProblemPage); $viewProblemPage = $urlpath->new( type => 'gateway_quiz', args => { @@ -2751,7 +2750,7 @@ sub body { type => 'instructor_problem_editor_withset_withproblem', args => { courseID => $courseID, setID => $fullSetID, problemID => $problemID } ); - $editProblemLink = $self->systemLink($editProblemPage, params => { make_local_copy => 0 }); + $editProblemLink = $self->systemLink($editProblemPage); # FIXME: should we have an "act as" type link here when editing for multiple users? $viewProblemPage = $urlpath->new( type => 'problem_detail', diff --git a/lib/WeBWorK/ContentGenerator/ProblemSets.pm b/lib/WeBWorK/ContentGenerator/ProblemSets.pm index 710bd69e80..09bf9dd392 100644 --- a/lib/WeBWorK/ContentGenerator/ProblemSets.pm +++ b/lib/WeBWorK/ContentGenerator/ProblemSets.pm @@ -14,8 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::ProblemSets; -use base qw(WeBWorK); -use base qw(WeBWorK::ContentGenerator); +use parent qw(WeBWorK::ContentGenerator); =head1 NAME @@ -25,14 +24,16 @@ WeBWorK::ContentGenerator::ProblemSets - Display a list of built problem sets. use strict; use warnings; -#use CGI qw(-nosticky ); + use WeBWorK::CGI; use WeBWorK::Debug; -use WeBWorK::Utils qw(after readFile sortByName path_is_subdir is_restricted wwRound format_set_name_display); +use WeBWorK::Utils qw(after readFile sortByName path_is_subdir is_restricted format_set_name_display); use WeBWorK::Localize; -# what do we consider a "recent" problem set? + +# What do we consider a "recent" problem set? use constant RECENT => 2 * 7 * 24 * 60 * 60; # Two-Weeks in seconds -# the "default" data in the course_info.txt file + +# The "default" data in the course_info.txt file use constant DEFAULT_COURSE_INFO_TXT => "Put information about your course here. Click the edit button above to add your own message.\n"; @@ -42,22 +43,18 @@ sub if_can { if ($arg ne 'info') { return $self->can($arg) ? 1 : 0; } else { - my $r = $self->r; - my $ce = $r->ce; - my $urlpath = $r->urlpath; - my $authz = $r->authz; - my $user = $r->param("user"); + my $r = $self->r; + my $ce = $r->ce; - # we only print the info box if the viewer has permission - # to edit it or if its not the standard template box. + # Only print the info box if the viewer has permission + # to edit it or if it is not the standard template box. - my $course_info_path = $ce->{courseDirs}->{templates} . "/" . $ce->{courseFiles}->{course_info}; - my $text = DEFAULT_COURSE_INFO_TXT; + my $course_info_path = "$ce->{courseDirs}{templates}/$ce->{courseFiles}{course_info}"; - if (-f $course_info_path) { #check that it's a plain file - $text = eval { readFile($course_info_path) }; - } - return $authz->hasPermissions($user, "access_instructor_tools") + my $text = DEFAULT_COURSE_INFO_TXT; + $text = eval { readFile($course_info_path) } if (-f $course_info_path); + + return $r->authz->hasPermissions($r->param('user'), 'access_instructor_tools') || $text ne DEFAULT_COURSE_INFO_TXT; } @@ -67,63 +64,67 @@ sub info { my ($self) = @_; my $r = $self->r; my $ce = $r->ce; - my $db = $r->db; my $urlpath = $r->urlpath; my $authz = $r->authz; - my $courseID = $urlpath->arg("courseID"); - my $user = $r->param("user"); - - my $course_info = $ce->{courseFiles}->{course_info}; - - if (defined $course_info and $course_info) { - my $course_info_path = $ce->{courseDirs}->{templates} . "/$course_info"; - - # deal with instructor crap - my $editorURL; - if ($authz->hasPermissions($user, "access_instructor_tools")) { - if (defined $r->param("editMode") and $r->param("editMode") eq "temporaryFile") { - $course_info_path = $r->param("sourceFilePath"); - $course_info_path = $ce->{courseDirs}{templates} . '/' . $course_info_path - unless $course_info_path =~ m!^/!; - die "sourceFilePath is unsafe!" - unless path_is_subdir($course_info_path, $ce->{courseDirs}->{templates}); - $self->addmessage(CGI::div( - { class => 'temporaryFile' }, - $r->maketext("Viewing temporary file:") . ' ', - $course_info_path - )); + my $courseID = $urlpath->arg('courseID'); + my $user = $r->param('user'); + + my $course_info = $ce->{courseFiles}{course_info}; + + return '' unless $course_info; + + my $course_info_path = "$ce->{courseDirs}{templates}/$course_info"; + + if ($authz->hasPermissions($user, 'access_instructor_tools')) { + if (defined $r->param('editMode') && $r->param('editMode') eq 'temporaryFile') { + $course_info_path = $r->param('sourceFilePath'); + $course_info_path = "$ce->{courseDirs}{templates}/$course_info_path" unless $course_info_path =~ m!^/!; + + unless (path_is_subdir($course_info_path, $ce->{courseDirs}{templates})) { + $self->addbadmessage('sourceFilePath is unsafe!'); + return ''; } - my $editorPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Instructor::PGProblemEditor", - $r, courseID => $courseID); - $editorURL = $self->systemLink($editorPage, params => { file_type => "course_info" }); + $self->addmessage(CGI::div( + { class => 'temporaryFile' }, + $r->maketext('Viewing temporary file:') . ' ', + $course_info_path + )); } - if ($editorURL) { - print CGI::h2( - { class => 'd-flex align-items-center justify-content-center' }, - $r->maketext("Course Info"), - CGI::a( - { href => $editorURL, target => "WW_Editor", class => 'btn btn-sm btn-info m-1' }, - $r->maketext("Edit") - ) - ); + print CGI::h2( + { class => 'd-flex align-items-center justify-content-center' }, + $r->maketext('Course Info'), + CGI::a( + { + href => $self->systemLink( + $urlpath->newFromModule( + 'WeBWorK::ContentGenerator::Instructor::PGProblemEditor', + $r, courseID => $courseID + ), + params => { file_type => 'course_info' } + ), + target => 'WW_Editor', + class => 'btn btn-sm btn-info m-1' + }, + $r->maketext('Edit') + ) + ); + } else { + print CGI::h2($r->maketext('Course Info')); + } + + if (-f $course_info_path) { + my $text = eval { readFile($course_info_path) }; + if ($@) { + print CGI::div({ class => 'alert alert-danger p-1 mb-0' }, $@); } else { - print CGI::h2($r->maketext("Course Info")); - } - die "course info path is unsafe!" unless path_is_subdir($course_info_path, $ce->{courseDirs}->{templates}, 1); - if (-f $course_info_path) { #check that it's a plain file - my $text = eval { readFile($course_info_path) }; - if ($@) { - print CGI::div({ class => 'alert alert-danger p-1 mb-0' }, $@); - } else { - print $text; - } + print $text; } - - return ""; } + + return ''; } sub templateName { diff --git a/lib/WeBWorK/ContentGenerator/RenderViaRPC.pm b/lib/WeBWorK/ContentGenerator/RenderViaRPC.pm index 9b6b3b62a6..57e33cdaa9 100644 --- a/lib/WeBWorK/ContentGenerator/RenderViaRPC.pm +++ b/lib/WeBWorK/ContentGenerator/RenderViaRPC.pm @@ -54,6 +54,8 @@ async sub pre_header_initialize { return; } + $r->param('displayMode', 'tex') if ($r->param('outputformat') eq 'pdf' || $r->param('outputformat') eq 'tex'); + # Call the WebworkWebservice to render the problem and store the result in $self->return_object. my $rpc_service = WebworkWebservice->new($r); await $rpc_service->rpc_execute('renderProblem'); @@ -70,8 +72,19 @@ async sub pre_header_initialize { return; } +# Override the default ContentGenerator header method. It always returns 0 and sets the content type to text/html. +# When hardcopy generation occurs, the result may have already been rendered. Return the response code in that case. +sub header { + my $self = shift; + return $self->r->res->code || 0; +} + async sub content { my $self = shift; + + # Hardcopy generation may have already rendered a response. Stop here in that case. + return if $self->r->res->code; + $self->r->res->headers->content_type(($self->{wantsjson} ? 'application/json;' : 'text/html;') . ' charset=utf-8'); print $self->{output}; return 0; diff --git a/lib/WeBWorK/Utils.pm b/lib/WeBWorK/Utils.pm index 942e69f8bb..fcce77f594 100644 --- a/lib/WeBWorK/Utils.pm +++ b/lib/WeBWorK/Utils.pm @@ -76,7 +76,6 @@ our @EXPORT_OK = qw( encode_utf8_base64 fisher_yates_shuffle formatDateTime - has_aux_files intDateTime list2hash listFilesRecursive @@ -1221,23 +1220,6 @@ sub not_blank ($) { # check that a string exists and is not blank return (defined($str) and $str =~ /\S/); } -########################################################### -# If things have worked so far determine if the file might be accompanied by auxiliary files - -# -sub has_aux_files ($) { # determine whether a question has auxiliary files - # a path ending in foo/foo.pg is assumed to contain auxilliary files - my $path = shift; - if (not_blank($path)) { - my ($dir, $prob) = $path =~ m|([^/]+)/([^/]+)\.pg$|; # must be a problem file ending in .pg - return 1 if (defined($dir) and defined($prob) and $dir eq $prob); - } else { - warn "This subroutine cannot handle empty paths: |$path|", caller(); - } - return 0; # no aux files with this .pg file - -} - sub is_restricted { my ($db, $set, $studentName) = @_; diff --git a/lib/WebworkClient/body_text_format.pl b/lib/WebworkClient/body_text_format.pl deleted file mode 100644 index e248738ead..0000000000 --- a/lib/WebworkClient/body_text_format.pl +++ /dev/null @@ -1,7 +0,0 @@ -$body_text_format = q{ - - -$problemText -}; - -$body_text_format; diff --git a/lib/WebworkClient/debug_format.pl b/lib/WebworkClient/debug_format.pl deleted file mode 100644 index a990823cd5..0000000000 --- a/lib/WebworkClient/debug_format.pl +++ /dev/null @@ -1,74 +0,0 @@ -$debug_format = <<'ENDPROBLEMTEMPLATE'; - - - - - -$favicon - -$problemHeadText - -WeBWorK using host: $SITE_URL, format: debug, seed: $problemSeed, course: $courseID - - -
      -

      WeBWorK using host: $SITE_URL, course: $courseID, format: debug

      -
      -
      -
      -$answerTemplate -$color_input_blanks_script -
      -
      -$problemText -
      -$scoreSummary -$LTIGradeMessage - - - - - - - - - - - - - - - - - - - - - - - - - - - -
      $previewButton$checkAnswersButton$correctAnswersButton
      -
      -
      -
      - -$warnings -

      PG Warning section

      -$PG_warning_messages -

      Debug message section

      -$debug_messages -

      internal errors

      -$internal_debug_messages -$client_debug_data -
      -$footer - - -ENDPROBLEMTEMPLATE - -$debug_format; diff --git a/lib/WebworkClient/json_format.pl b/lib/WebworkClient/json_format.pl deleted file mode 100644 index e9603b60a9..0000000000 --- a/lib/WebworkClient/json_format.pl +++ /dev/null @@ -1,101 +0,0 @@ -# The json output format needs to collect the data differently than the other -# formats. It will return a hash, and each relevant value will later undergo -# variable interpolation. - -# Most parts which need variable interpolation end in "_VI". -# Parts ending in "_AVI" are references to anonymous arrays whose entries need variable interpolation. -# Other parts which need variable interpolation are: -# hidden_input_field}{* -# real_webwork_* - -# NOTE: When a variable needs to be interpolated later, the string should be in single quotes not in double quotes. - -$json_output = { head_part001_VI => '' }; - -$json_output->{head_part010_VI} = <<'ENDPROBLEMTEMPLATE'; - - - -$favicon -ENDPROBLEMTEMPLATE - -# CSS loads - as an array of href values -# This is added in formatRenderedProblem -# $json_output->{head_part100} - -# JS loads - as an array of arrays. The first element of each subarray is the href value, and the second (if present) -# is a hash containing any needed attributes for the script tag. -# This is added in formatRenderedProblem -# $json_output->{head_part200} - -$json_output->{head_part300_VI} = '$problemHeadText'; - -$json_output->{head_part400} = 'WeBWorK problem'; - -$json_output->{head_part999} = ""; -$json_output->{body_part001} = ""; - -$json_output->{body_part100} = <<'ENDPROBLEMTEMPLATE'; -
      -
      -
      -ENDPROBLEMTEMPLATE - -$json_output->{body_part300_VI} = '$answerTemplate'; - -$json_output->{body_part500} = - '
      '; - -$json_output->{body_part530_VI} = '
      '; - -$json_output->{body_part550_VI} = '$problemText'; - -$json_output->{body_part590} = "
      "; - -$json_output->{body_part650_VI} = '$scoreSummary'; - -$json_output->{body_part700_VI} = '

      $previewButton $checkAnswersButton $correctAnswersButton

      '; - -$json_output->{body_part999_VI} = <<'ENDPROBLEMTEMPLATE'; -
      -$footer - -ENDPROBLEMTEMPLATE - -$json_output->{hidden_input_field} = {}; - -$json_output->{hidden_input_field}{answersSubmitted} = '1'; -$json_output->{hidden_input_field}{sourceFilePath} = '$sourceFilePath'; -$json_output->{hidden_input_field}{problemSource} = '$encoded_source'; -$json_output->{hidden_input_field}{problemSeed} = '$problemSeed'; -$json_output->{hidden_input_field}{problemUUID} = '$problemUUID'; -$json_output->{hidden_input_field}{psvn} = '$psvn'; -$json_output->{hidden_input_field}{pathToProblemFile} = '$fileName'; -$json_output->{hidden_input_field}{courseID} = '$courseID'; -$json_output->{hidden_input_field}{user} = '$user'; -$json_output->{hidden_input_field}{passwd} = '$passwd'; -$json_output->{hidden_input_field}{displayMode} = '$displayMode'; -$json_output->{hidden_input_field}{key} = '$key'; -$json_output->{hidden_input_field}{outputformat} = 'json'; -$json_output->{hidden_input_field}{theme} = '$theme'; -$json_output->{hidden_input_field}{language} = '$formLanguage'; -$json_output->{hidden_input_field}{showSummary} = '$showSummary'; -$json_output->{hidden_input_field}{showHints} = '$showHints'; -$json_output->{hidden_input_field}{showSolution} = '$showSolution'; -$json_output->{hidden_input_field}{showAnswerNumbers} = '$showAnswerNumbers'; -$json_output->{hidden_input_field}{showPreviewButton} = '$showPreviewButton'; -$json_output->{hidden_input_field}{showCheckAnswersButton} = '$showCheckAnswersButton'; -$json_output->{hidden_input_field}{showCorrectAnswersButton} = '$showCorrectAnswersButton'; -$json_output->{hidden_input_field}{showFooter} = '$showFooter'; -$json_output->{hidden_input_field}{extraHeaderText} = '$extra_header_text'; - -# These are the real WeBWorK server URLs which the intermediate needs to use -# to communicate with WW, while the distant client must use URLs of the -# intermediate server (the man in the middle). - -$json_output->{real_webwork_SITE_URL} = '$SITE_URL'; -$json_output->{real_webwork_FORM_ACTION_URL} = '$FORM_ACTION_URL'; -$json_output->{internal_problem_lang_and_dir} = '$PROBLEM_LANG_AND_DIR'; - -# Output back to WebworkClient.pm is the reference to the hash: -$json_output; diff --git a/lib/WebworkClient/ptx_format.pl b/lib/WebworkClient/ptx_format.pl deleted file mode 100644 index 359f1d6179..0000000000 --- a/lib/WebworkClient/ptx_format.pl +++ /dev/null @@ -1,11 +0,0 @@ -$ptx_static_format = <<'ENDPROBLEMTEMPLATE'; - - - -$problemText -$answerhashXML - - -ENDPROBLEMTEMPLATE - -$ptx_static_format; diff --git a/lib/WebworkClient/simple_format.pl b/lib/WebworkClient/simple_format.pl deleted file mode 100644 index 0ba720a704..0000000000 --- a/lib/WebworkClient/simple_format.pl +++ /dev/null @@ -1,60 +0,0 @@ -$simple_format = <<'ENDPROBLEMTEMPLATE'; - - - - - -$favicon - -$problemHeadText - -WeBWorK using host: $SITE_URL, format: simple seed: $problemSeed - - -
      -
      -
      -$answerTemplate -$color_input_blanks_script -
      -
      -$problemText -
      -$scoreSummary -$LTIGradeMessage - - - - - - - - - - - - - - - - - - - - - - - - - -
      $previewButton$checkAnswersButton$correctAnswersButton
      -
      -
      -
      -$footer - - -ENDPROBLEMTEMPLATE - -$simple_format; diff --git a/lib/WebworkClient/sticky_format.pl b/lib/WebworkClient/sticky_format.pl deleted file mode 100644 index a2b9867a64..0000000000 --- a/lib/WebworkClient/sticky_format.pl +++ /dev/null @@ -1,72 +0,0 @@ -$sticky_format = <<'ENDPROBLEMTEMPLATE'; - - - - - - -$favicon - -$problemHeadText - -WeBWorK using host: $SITE_URL, format: sticky seed: $problemSeed - - -
      -
      -
      -
      -$answerTemplate -$color_input_blanks_script -
      -
      -
      -$problemText -
      -

      -$scoreSummary -

      - -

      -$localStorageMessages -

      - -$LTIGradeMessage - - - - - - - - - - - - - - - - - - - - - - - - - -
      $previewButton$checkAnswersButton$correctAnswersButton
      -
      -
      -
      -
      -$footer - - - -ENDPROBLEMTEMPLATE - -$sticky_format; diff --git a/lib/WebworkClient/tex_format.pl b/lib/WebworkClient/tex_format.pl deleted file mode 100644 index e897c01c1b..0000000000 --- a/lib/WebworkClient/tex_format.pl +++ /dev/null @@ -1,32 +0,0 @@ -$tex_format = q{ - -\documentclass[11pt]{amsart} -\usepackage{geometry} % See geometry.pdf to learn the layout options. There are lots. -\geometry{letterpaper} % ... or a4paper or a5paper or ... -%\geometry{landscape} % Activate for for rotated page geometry -%\usepackage[parfill]{parskip} % Activate to begin paragraphs with an empty line rather than an indent -\usepackage{graphicx} -\usepackage{amssymb} -\usepackage{epstopdf} -\usepackage{path} -\usepackage{eulervm} %knuth concrete math style fonts -%\usepackage{concmath} % knuth concrete math tex font - -\DeclareGraphicsRule{.tif}{png}{.png}{`convert #1 `dirname #1`/`basename #1 .tif`.png} - -\title{PG problem} -%\author{The Author} -%\date{} % Activate to display a given date or no date - -\begin{document} -\maketitle -%\section{} -%\subsection{} - -$problemText - -\end{document} - -}; - -$tex_format; diff --git a/lib/WebworkWebservice.pm b/lib/WebworkWebservice.pm index 726aea765e..6a29e2b57b 100644 --- a/lib/WebworkWebservice.pm +++ b/lib/WebworkWebservice.pm @@ -64,6 +64,7 @@ use WebworkWebservice::SetActions; use WebworkWebservice::CourseActions; use WebworkWebservice::ProblemActions; use FormatRenderedProblem; +use HardcopyRenderedProblem; =head2 new (constructor) @@ -100,8 +101,6 @@ sub error_string { return $self->{error_string}; } -=over - =head2 rpc_execute This method executes a WebworkWebservice command, and makes sure that @@ -159,11 +158,15 @@ async sub rpc_execute { return $self->return_object($result); } +=over + =item formatRenderedProblem This is called by WeBWorK::ContentGenerator::RenderViaRPC::pre_header_initialize to format the return result of the WebworkWebservice::renderProblem method. -This method just calls FormatRenderedProblem::formatRenderedProblem. +This method calls HardcopyRenderedProblem::hardcopyRenderedProblem if the +outputformat is tex or pdf, and calls FormatRenderedProblem::formatRenderedProblem +otherwise. =back @@ -171,6 +174,8 @@ This method just calls FormatRenderedProblem::formatRenderedProblem. sub formatRenderedProblem { my $self = shift; + return HardcopyRenderedProblem::hardcopyRenderedProblem($self) + if $self->{inputs_ref}{outputformat} eq 'tex' || $self->{inputs_ref}{outputformat} eq 'pdf'; return FormatRenderedProblem::formatRenderedProblem($self); } @@ -247,6 +252,7 @@ sub command_permission { changeUserPassword => 'modify_student_data', getCourseSettings => 'access_instructor_tools', updateSetting => 'manage_course_files', + saveFile => 'modify_problem_sets', # WebworkWebservice::LibraryActions listLibraries => 'access_instructor_tools', diff --git a/lib/WebworkWebservice/CourseActions.pm b/lib/WebworkWebservice/CourseActions.pm index 276dfa99eb..5c7f66a28a 100644 --- a/lib/WebworkWebservice/CourseActions.pm +++ b/lib/WebworkWebservice/CourseActions.pm @@ -25,7 +25,7 @@ use Data::Structure::Util qw(unbless); use WeBWorK::DB; use WeBWorK::DB::Utils qw(initializeUserProblem); -use WeBWorK::Utils qw(cryptPassword); +use WeBWorK::Utils qw(cryptPassword path_is_subdir surePathToFile); use WeBWorK::Utils::CourseManagement qw(addCourse); use WeBWorK::Debug; @@ -512,4 +512,45 @@ sub updateSetting { return { text => 'Successfully updated course setting' }; } +# This saves a file to the course's templates directory. +sub saveFile { + my ($invocant, $self, $params) = @_; + + my $r = $self->r; + my $ce = $self->ce; + + my $outputFilePath = $params->{outputFilePath}; + + my $writeFileErrors; + if ($outputFilePath && $outputFilePath =~ /\S/) { + return { + ra_out => 0, + text => $r->maketext( + 'File not saved. The file "[_1]" is not contained in the templates directory!', + $outputFilePath + ) + } + unless path_is_subdir($outputFilePath, $ce->{courseDirs}{templates}, 1); + + $outputFilePath = "$ce->{courseDirs}{templates}/$outputFilePath" unless $outputFilePath =~ m|^/|; + + # Make sure any missing directories are created. + surePathToFile($ce->{courseDirs}{templates}, $outputFilePath); + + # Save the file. + open(my $outfile, '>:encoding(UTF-8)', $outputFilePath) + or return { + ra_out => 0, + text => $r->maketext('File not saved. Failed to open "[_1]" for writing.', $outputFilePath) + }; + print $outfile $params->{fileContents}; + close $outfile; + } + + return { + ra_out => 1, + text => $r->maketext('Saved to file "[_1]"', $outputFilePath =~ s/$ce->{courseDirs}{templates}/[TMPL]/r) + }; +} + 1; diff --git a/lib/WebworkWebservice/RenderProblem.pm b/lib/WebworkWebservice/RenderProblem.pm index 3f6c5c57c3..13c8f7d4f9 100644 --- a/lib/WebworkWebservice/RenderProblem.pm +++ b/lib/WebworkWebservice/RenderProblem.pm @@ -20,6 +20,7 @@ use warnings; use Future::AsyncAwait; use Benchmark; +use Mojo::Util qw(url_unescape); use WeBWorK::Debug; use WeBWorK::CourseEnvironment; @@ -37,7 +38,10 @@ async sub renderProblem { my ($invocant, $ws) = @_; my $rh = $ws->{inputs_ref}; - debug(pretty_print_rh($rh)); + + # $WeBWorK::Debug::Enabled needs to be checked, otherwise pretty_print_rh($rh) is called regardless of if debgging + # is enabled. That is an expensive method to always call here. + debug(pretty_print_rh($rh)) if $WeBWorK::Debug::Enabled; my $problemSeed = $rh->{problemSeed} // '1234'; @@ -137,7 +141,7 @@ async sub renderProblem { $setRecord->open_date(time - 60 * 60 * 24 * 7); # one week ago $setRecord->due_date(time + 60 * 60 * 24 * 7 * 2); # in two weeks $setRecord->answer_date(time + 60 * 60 * 24 * 7 * 3); # in three weeks - $setRecord->psvn($rh->{psvn} || 0); + $setRecord->psvn($rh->{psvn} // 1234); } # obtain the merged problem for $effectiveUser @@ -183,23 +187,24 @@ async sub renderProblem { if defined($rh->{problemSource}) && $rh->{problemSource}; } - # initialize problem source + # Initialize problem source my $r_problem_source; if ($rh->{problemSource}) { - my $problem_source = decode_utf8_base64($rh->{problemSource}) =~ tr/\r/\n/r; - $r_problem_source = \$problem_source; - if (defined $rh->{fileName}) { - $problemRecord->source_file($rh->{fileName}); - } else { - $problemRecord->source_file($rh->{sourceFilePath}); - } + $r_problem_source = \(decode_utf8_base64($rh->{problemSource}) =~ tr/\r/\n/r); + $problemRecord->source_file(defined $rh->{fileName} ? $rh->{fileName} : $rh->{sourceFilePath}); + } elsif ($rh->{rawProblemSource}) { + $r_problem_source = \$rh->{rawProblemSource}; + $problemRecord->source_file(defined $rh->{fileName} ? $rh->{fileName} : $rh->{sourceFilePath}); + } elsif ($rh->{uriEncodedProblemSource}) { + $r_problem_source = \(url_unescape($rh->{uriEncodedProblemSource})); + $problemRecord->source_file(defined $rh->{fileName} ? $rh->{fileName} : $rh->{sourceFilePath}); } elsif (defined $rh->{sourceFilePath} && $rh->{sourceFilePath} =~ /\S/) { $problemRecord->source_file($rh->{sourceFilePath}); - warn 'reading source from ', $rh->{sourceFilePath} if $UNIT_TESTS_ON; $r_problem_source = \(WeBWorK::PG::IO::read_whole_file($ce->{courseDirs}{templates} . '/' . $rh->{sourceFilePath})); $problemRecord->source_file('RenderProblemFooBar') unless defined($problemRecord->source_file); } + if ($UNIT_TESTS_ON) { print STDERR 'template directory path ', $ce->{courseDirs}{templates}, "\n"; print STDERR 'RenderProblem.pm: source file is ', $problemRecord->source_file, "\n"; @@ -224,7 +229,13 @@ async sub renderProblem { useWiris => $ce->{pg}{specialPGEnvironmentVars}{entryAssist} eq 'WIRIS', isInstructor => $rh->{isInstructor} // 0, forceScaffoldsOpen => $rh->{forceScaffoldsOpen} // 0, - debuggingOptions => $rh->{debuggingOptions} // {} + debuggingOptions => { + show_resource_info => $rh->{show_resource_info} // 0, + view_problem_debugging_info => $rh->{view_problem_debugging_info} // 0, + show_pg_info => $rh->{show_pg_info} // 0, + show_answer_hash_info => $rh->{show_answer_hash_info} // 0, + show_answer_group_info => $rh->{show_answer_group_info} // 0 + } }; $ce->{pg}{specialPGEnvironmentVars}{problemPreamble} = { TeX => '', HTML => '' } if $rh->{noprepostambles}; @@ -247,6 +258,7 @@ async sub renderProblem { flags => $pg->{flags}, psvn => $psvn, problem_seed => $problemSeed, + resource_list => $pg->{resource_list}, warning_messages => ref $pg->{warning_messages} eq 'ARRAY' ? $pg->{warning_messages} : [], debug_messages => ref $pg->{debug_messages} eq 'ARRAY' ? $pg->{debug_messages} : [], internal_debug_messages => ref $pg->{internal_debug_messages} eq 'ARRAY' @@ -276,7 +288,7 @@ sub pretty_print_rh { } elsif (not defined($rh)) { $out .= ' type = scalar; '; } - if (ref($rh) =~ /HASH/ || "$rh" =~ /HASH/) { + if (ref $rh eq 'HASH' || eval { %$rh && 1 }) { $out .= "{\n"; $indent++; foreach my $key (sort keys %{$rh}) { diff --git a/templates/RPCRenderFormats/default.html.ep b/templates/RPCRenderFormats/default.html.ep new file mode 100644 index 0000000000..2c6717243a --- /dev/null +++ b/templates/RPCRenderFormats/default.html.ep @@ -0,0 +1,182 @@ +% use WeBWorK::Utils qw(getAssetURL wwRound); +% + +> + + + + + WeBWorK using host: <%= $SITE_URL %>, + format: <%= $formatName %>, + seed: <%= $problemSeed %>, + course: <%= $courseID %> + + {webworkURLs}{htdocs}/images/favicon.ico" %>" rel="shortcut icon"> + % # Add third party css and javascript as well as css and javascript requested by the problem. + % for (@$third_party_css) { + %= stylesheet $_ + % } + % for (@$extra_css_files) { + %= stylesheet $_->{file} + % } + % for (@$third_party_js) { + %= javascript $_->[0], %{ $_->[1] // {} } + % } + % # Add the local storage javascript for the sticky format. + % if ($formatName eq 'sticky') { + %= javascript getAssetURL($ce, 'js/apps/LocalStorage/localstorage.js'), defer => undef + % } + % for (@$extra_js_files) { + %= javascript $_->{file}, %{ $_->{attributes} } + % } + %== $rh_result->{header_text} // '' + %== $rh_result->{post_header_text} // '' + %== $extra_header_text + + +
      +
      +
      + %== $answerTemplate + <%= form_for $FORM_ACTION_URL, id => 'problemMainForm', class => 'problem-main-form', + name => 'problemMainForm', method => 'POST', begin %> +
      > + %== $problemText +
      + % if ($showScoreSummary) { +

      <%= $lh->maketext('You received a score of [_1] for this attempt.', + wwRound(0, $rh_result->{problem_result}{score} * 100) . '%') %>

      + % if ($rh_result->{problem_result}{msg}) { +

      <%= $rh_result->{problem_result}{msg} %>

      + % } + % unless ($ce->{hideWasNotRecordedMessage}) { +

      <%= $lh->maketext('Your score was not recorded.') %>

      + % } + <%= hidden_field 'problem-result-score' => $rh_result->{problem_result}{score}, + id => 'problem-result-score' %> + % } + % if ($formatName eq 'sticky') { +
      +

      Your overall score for this problem is .

      +
      + % } + %== $LTIGradeMessage + + %= hidden_field answersSubmitted => 1 + %= hidden_field sourceFilePath => $sourceFilePath + %= hidden_field problemSource => $problemSource + %= hidden_field uriEncodedProblemSource => $uriEncodedProblemSource + %= hidden_field problemSeed => $problemSeed + %= hidden_field problemUUID => $problemUUID + %= hidden_field psvn => $psvn + %= hidden_field pathToProblemFile => $fileName + %= hidden_field courseID => $courseID + %= hidden_field user => $user + %= hidden_field passwd => $passwd + %= hidden_field displayMode => $displayMode + %= hidden_field key => $key + %= hidden_field outputformat => $formatName + %= hidden_field theme => $theme + %= hidden_field language => $formLanguage + %= hidden_field showSummary => $showSummary + %= hidden_field showHints => $showHints + %= hidden_field showSolutions => $showSolutions + %= hidden_field showAnswerNumbers => $showAnswerNumbers + %= hidden_field showPreviewButton => $showPreviewButton + %= hidden_field showCheckAnswersButton => $showCheckAnswersButton + %= hidden_field showCorrectAnswersButton => $showCorrectAnswersButton + %= hidden_field showFooter => $showFooter + %= hidden_field extra_header_text => $extra_header_text + % if ($formatName eq 'debug' && $ws->{inputs_ref}{clientDebug}) { + %= hidden_field clientDebug => $ws->{inputs_ref}{clientDebug} + % } + +
      + % # Submit buttons (all are shown by default) + % if ($showPreviewButton ne '0') { + <%= submit_button $lh->maketext('Preview My Answers'), + name => 'preview', id => 'previewAnswers_id', class => 'btn btn-primary mb-1' %> + % } + % if ($showCheckAnswersButton ne '0') { + <%= submit_button $lh->maketext('Check Answers'), + name => 'WWsubmit', class => 'btn btn-primary mb-1' %> + % } + % if ($showCorrectAnswersButton ne '0') { + <%= submit_button $lh->maketext('Show Correct Answers'), + name => 'WWcorrectAns', class => 'btn btn-primary mb-1' %> + % } +
      + % end +
      +
      + % # PG warning messages (this includes translator warnings but not translator errors). + % if ($rh_result->{pg_warnings}) { +
      +

      <%= $lh->maketext('Warning messages') %>

      +
        + % for (split("\n", $rh_result->{pg_warnings})) { +
      • <%== $_ %>
        • + % } +
      +
      + % } + % # PG warning messages generated with WARN_message. + % if (ref $rh_result->{warning_messages} eq 'ARRAY' && @{ $rh_result->{warning_messages} }) { +
      +

      <%= $lh->maketext('PG warning messages') %>

      +
        + % for (@{ $rh_result->{warning_messages} }) { +
      • <%== $_ %>
        • + % } +
      +
      + % } + % # Translator errors. + % if ($rh_result->{flags}{error_flag}) { +
      +

      Translator errors

      + <%== $rh_result->{errors} %> +
      + % } + % # Additional information output only for the debug format. + % if ($formatName eq 'debug') { + % # PG debug messages generated with DEBUG_message. + % if (@{ $rh_result->{debug_messages} }) { +
      +

      PG debug messages

      +
        + % for (@{ $rh_result->{debug_messages} }) { +
      • <%== $_ %>
        • + % } +
      +
      + % } + % # Internal debug messages generated within PGcore. + % if (ref $rh_result->{internal_debug_messages} eq 'ARRAY' && @{ $rh_result->{internal_debug_messages} }) { +
      +

      Internal errors

      +
        + % for (@{ $rh_result->{internal_debug_messages} }) { +
      • <%== $_ %>
        • + % } +
      +
      + % } + % if ($ws->{inputs_ref}{clientDebug}) { +

      Webwork client data

      + %== $pretty_print->($ws) + % } + % } +
      + % # Show the footer unless it is explicity disabled. + % if ($showFooter ne '0') { + + % } + + diff --git a/templates/RPCRenderFormats/default.json.ep b/templates/RPCRenderFormats/default.json.ep new file mode 100644 index 0000000000..1c10ff170f --- /dev/null +++ b/templates/RPCRenderFormats/default.json.ep @@ -0,0 +1,88 @@ +% use Mojo::JSON qw(to_json); +% use WeBWorK::Utils qw(wwRound); +% +% my $json_output = { + % head_part001 => "", + % head_part010 => q{} + % . qq{}, + % head_part300 => join('', + % (map { stylesheet($_) } @$third_party_css), + % (map { stylesheet($_->{file}) } @$extra_css_files), + % (map { javascript($_->[0], %{ $_->[1] // {} }) } @$third_party_js), + % (map { javascript($_->{file}, %{ $_->{attributes} }) } @$extra_js_files), + % $rh_result->{header_text} // '', + % $rh_result->{post_header_text} // '', + % $extra_header_text + % ), + % head_part400 => 'WeBWorK problem', + % head_part999 => '', + % + % body_part001 => '', + % body_part100 => '
      ', + % body_part300 => $answerTemplate, + % body_part500 => '
      ', + % body_part530 => qq{
      }, + % body_part550 => $problemText, + % body_part590 => '
      ', + % body_part650 => '

      ' . $lh->maketext('You received a score of [_1] for this attempt.', + % wwRound(0, $rh_result->{problem_result}{score} * 100) . '%') . '

      ' + % . ($rh_result->{problem_result}{msg} ? ('

      ' . $rh_result->{problem_result}{msg} . '

      ') : '') + % . ($ce->{hideWasNotRecordedMessage} ? '' : '

      ' . $lh->maketext('Your score was not recorded.') . '

      ') + % . hidden_field('problem-result-score' => $rh_result->{problem_result}{score}, + % id => 'problem-result-score'), + % body_part700 => join('', '

      ', + % $showPreviewButton eq '0' ? '' : submit_button($lh->maketext('Preview My Answers'), + % name => 'preview', id => 'previewAnswers_id', class => 'btn btn-primary mb-1'), + % $showCheckAnswersButton eq '0' ? '' : submit_button($lh->maketext('Check Answers'), + % name => 'WWsubmit', class => 'btn btn-primary mb-1'), + % $showCorrectAnswersButton eq '0' ? '' : submit_button($lh->maketext('Show Correct Answers'), + % name => 'WWcorrectAns', class => 'btn btn-primary mb-1'), + % '

      '), + % body_part999 => '
      ' + % . ($showFooter eq '0' ? '' + % : qq{") + % . '}', + % + % hidden_input_field => { + % answersSubmitted => '1', + % sourceFilePath => $sourceFilePath, + % problemSource => $problemSource, + % problemSeed => $problemSeed, + % problemUUID => $problemUUID, + % psvn => $psvn, + % pathToProblemFile => $fileName, + % courseID => $courseID, + % user => $user, + % passwd => $passwd, + % displayMode => $displayMode, + % key => $key, + % outputformat => 'json', + % theme => $theme, + % language => $formLanguage, + % showSummary => $showSummary, + % showHints => $showHints, + % showSolutions => $showSolutions, + % showAnswerNumbers => $showAnswerNumbers, + % showPreviewButton => $showPreviewButton, + % showCheckAnswersButton => $showCheckAnswersButton, + % showCorrectAnswersButton => $showCorrectAnswersButton, + % showFooter => $showFooter, + % extraHeaderText => $extra_header_text + % }, + % + % # Add the current score to the json output + % score => $ws->{inputs_ref}{WWsubmit} && $rh_result->{problem_result} + % ? wwRound(0, $rh_result->{problem_result}{score} * 100) + % : 0, + % + % # These are the real WeBWorK server URLs which the intermediate needs to use + % # to communicate with WW, while the distant client must use URLs of the + % # intermediate server (the man in the middle). + % real_webwork_SITE_URL => $SITE_URL, + % real_webwork_FORM_ACTION_URL => $FORM_ACTION_URL, + % internal_problem_lang_and_dir => $PROBLEM_LANG_AND_DIR +% }; +% +%== to_json($json_output) diff --git a/templates/RPCRenderFormats/ptx.html.ep b/templates/RPCRenderFormats/ptx.html.ep new file mode 100644 index 0000000000..d3c4cbc9b1 --- /dev/null +++ b/templates/RPCRenderFormats/ptx.html.ep @@ -0,0 +1,7 @@ + + + +%== $problemText +%== $answerhashXML + + From d8881593db1d785eb7451453653f364f96e58ddd Mon Sep 17 00:00:00 2001 From: Glenn Rice Date: Wed, 23 Nov 2022 11:35:36 -0600 Subject: [PATCH 081/490] Improvements for course info files. The save_as_handler is updated to handle course info files correctly. I don't think this ever worked right. If a course information file does not exist the "New Version" tab is shown but the file name input is readonly. The course info file name needs to be what is set in the course environment for that. In addition the "Update" tab is not shown. If a course information file does exist the "New Version" tab is not shown but the "Update" tab is. Also, if the course info file does not exist then don't show the 'Revert' tab in any case. There is nothing to revert to. The javascript is updated to handle things for course info files better also. --- .../apps/PGProblemEditor/pgproblemeditor.js | 6 +- .../Instructor/PGProblemEditor.pm | 98 ++++++++++--------- 2 files changed, 57 insertions(+), 47 deletions(-) diff --git a/htdocs/js/apps/PGProblemEditor/pgproblemeditor.js b/htdocs/js/apps/PGProblemEditor/pgproblemeditor.js index c06507c0f0..ca2d4fdc79 100644 --- a/htdocs/js/apps/PGProblemEditor/pgproblemeditor.js +++ b/htdocs/js/apps/PGProblemEditor/pgproblemeditor.js @@ -37,13 +37,11 @@ key: document.getElementById('hidden_key')?.value }; - if (!(request_object.user && request_object.courseID && request_object.key)) return; - request_object.rpc_command = 'saveFile'; request_object.outputFilePath = document.getElementsByName('temp_file_path')[0]?.value ?? ''; request_object.fileContents = webworkConfig?.pgCodeMirror?.getValue() ?? ''; - if (!request_object.outputFilePath || !request_object.fileContents) return; + if (!request_object.outputFilePath) return; fetch(webserviceURL, { method: 'post', mode: 'same-origin', body: new URLSearchParams(request_object) }) .then((response) => response.json()) @@ -182,6 +180,8 @@ if (fileType === 'course_info') { const contents = webworkConfig?.pgCodeMirror?.getValue(); if (contents) renderArea.innerHTML = contents; + else + renderArea.innerHTML = '
      The file has no content.
      '; // Typeset any math content that may be in the course info file. if (window.MathJax) { diff --git a/lib/WeBWorK/ContentGenerator/Instructor/PGProblemEditor.pm b/lib/WeBWorK/ContentGenerator/Instructor/PGProblemEditor.pm index 6800ba41c4..1603378bf0 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/PGProblemEditor.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/PGProblemEditor.pm @@ -1600,6 +1600,9 @@ sub save_as_form { my $self = shift; my $r = $self->r; + # Don't show the save as form when editing an existing course info file. + return '' if $self->{file_type} eq 'course_info' && -e $self->{editFilePath}; + my $templatesDir = $self->r->ce->{courseDirs}{templates}; my $shortFilePath = $self->{editFilePath} =~ s|^$templatesDir/||r; @@ -1641,56 +1644,55 @@ sub save_as_form { size => 60, value => $shortFilePath, class => 'form-control form-control-sm', - dir => 'ltr' + dir => 'ltr', + # Don't allow changing the file name for course info files. + # The filename needs to be what is set in the course environment. + $self->{file_type} eq 'course_info' ? (readonly => undef) : () }) ) ), CGI::hidden({ name => 'action.save_as.source_file', value => $self->{editFilePath} }), CGI::hidden({ name => 'action.save_as.file_type', value => $self->{file_type} }) ), - ( - $can_add_problem_to_set ? CGI::div( - { class => 'form-check' }, - CGI::input({ - type => 'radio', - id => 'action_save_as_saveMode_rename_id', - name => 'action.save_as.saveMode', - value => 'rename', - checked => undef, - class => 'form-check-input', - }), - CGI::label( - { for => 'action_save_as_saveMode_rename_id', class => 'form-check-label' }, - $r->maketext( - 'Replace current problem: [_1]', - CGI::strong( - CGI::span({ dir => 'ltr' }, format_set_name_display($self->{fullSetID})) - . "/$prettyProbNum" - ) + $can_add_problem_to_set ? CGI::div( + { class => 'form-check' }, + CGI::input({ + type => 'radio', + id => 'action_save_as_saveMode_rename_id', + name => 'action.save_as.saveMode', + value => 'rename', + checked => undef, + class => 'form-check-input', + }), + CGI::label( + { for => 'action_save_as_saveMode_rename_id', class => 'form-check-label' }, + $r->maketext( + 'Replace current problem: [_1]', + CGI::strong( + CGI::span({ dir => 'ltr' }, format_set_name_display($self->{fullSetID})) + . "/$prettyProbNum" ) ) - ) : '' - ), - ( - $can_add_problem_to_set ? CGI::div( - { class => 'form-check' }, - CGI::input({ - type => 'radio', - id => 'action_save_as_saveMode_new_problem_id', - name => 'action.save_as.saveMode', - value => 'add_to_set_as_new_problem', - class => 'form-check-input', - }), - CGI::label( - { for => 'action_save_as_saveMode_new_problem_id', class => 'form-check-label' }, - $r->maketext( - 'Append to end of [_1] set', - CGI::strong({ dir => 'ltr' }, format_set_name_display($self->{fullSetID})) - ) + ) + ) : '', + $can_add_problem_to_set ? CGI::div( + { class => 'form-check' }, + CGI::input({ + type => 'radio', + id => 'action_save_as_saveMode_new_problem_id', + name => 'action.save_as.saveMode', + value => 'add_to_set_as_new_problem', + class => 'form-check-input', + }), + CGI::label( + { for => 'action_save_as_saveMode_new_problem_id', class => 'form-check-label' }, + $r->maketext( + 'Append to end of [_1] set', + CGI::strong({ dir => 'ltr' }, format_set_name_display($self->{fullSetID})) ) - ) : '' - ), - CGI::div( + ) + ) : '', + $self->{file_type} eq 'course_info' ? '' : CGI::div( { class => 'form-check' }, CGI::input({ type => 'radio', @@ -1760,7 +1762,11 @@ sub save_as_handler { $self->saveFileChanges($outputFilePath); my $targetProblemNumber; - if ($saveMode eq 'rename' && -r $outputFilePath) { + if ($file_type eq 'course_info') { + # The saveMode is not set for course_info files as there are no such options presented in the form. + # So set that here so that the correct redirect is chosen below. + $saveMode = 'new_course_info'; + } elsif ($saveMode eq 'rename' && -r $outputFilePath) { # Modify source file path in problem. if ($file_type eq 'set_header') { my $setRecord = $self->r->db->getGlobalSet($self->{setID}); @@ -1869,7 +1875,11 @@ sub save_as_handler { my $problemPage; my $new_file_type; - if ($saveMode eq 'new_independent_problem') { + if ($saveMode eq 'new_course_info') { + $problemPage = $self->r->urlpath->newFromModule('WeBWorK::ContentGenerator::Instructor::PGProblemEditor', + $r, courseID => $self->{courseID}); + $new_file_type = 'course_info'; + } elsif ($saveMode eq 'new_independent_problem') { $problemPage = $self->r->urlpath->newFromModule( 'WeBWorK::ContentGenerator::Instructor::PGProblemEditor', $r, courseID => $self->{courseID}, @@ -1917,7 +1927,7 @@ sub revert_form { my $self = shift; my $r = $self->r; return $r->maketext('Error: The original file [_1] cannot be read.', $self->{editFilePath}) - unless -r $self->{editFilePath}; + unless $self->{file_type} eq 'course_info' || -r $self->{editFilePath}; return '' unless defined $self->{tempFilePath} && -e $self->{tempFilePath}; return $r->maketext('Revert to [_1]', CGI::span({ dir => 'ltr' }, $self->shortPath($self->{editFilePath}))); } From 4ef136c69624e8ab5582b301727655251c16f046 Mon Sep 17 00:00:00 2001 From: "dependabot[bot]" <49699333+dependabot[bot]@users.noreply.github.com> Date: Mon, 9 Jan 2023 15:11:08 +0000 Subject: [PATCH 082/490] Bump luxon from 2.5.0 to 2.5.2 in /htdocs Bumps [luxon](https://github.com/moment/luxon) from 2.5.0 to 2.5.2. - [Release notes](https://github.com/moment/luxon/releases) - [Changelog](https://github.com/moment/luxon/blob/master/CHANGELOG.md) - [Commits](https://github.com/moment/luxon/compare/2.5.0...2.5.2) --- updated-dependencies: - dependency-name: luxon dependency-type: direct:production ... Signed-off-by: dependabot[bot] --- htdocs/package-lock.json | 14 +++++++------- htdocs/package.json | 2 +- 2 files changed, 8 insertions(+), 8 deletions(-) diff --git a/htdocs/package-lock.json b/htdocs/package-lock.json index 1f817efa1f..76bb45aa33 100644 --- a/htdocs/package-lock.json +++ b/htdocs/package-lock.json @@ -14,7 +14,7 @@ "iframe-resizer": "^4.3.2", "jquery": "^3.6.0", "jquery-ui-dist": "^1.13.1", - "luxon": "^2.3.1", + "luxon": "^2.5.2", "mathjax": "^3.2.0", "sortablejs": "^1.14.0" }, @@ -812,9 +812,9 @@ "dev": true }, "node_modules/luxon": { - "version": "2.5.0", - "resolved": "https://registry.npmjs.org/luxon/-/luxon-2.5.0.tgz", - "integrity": "sha512-IDkEPB80Rb6gCAU+FEib0t4FeJ4uVOuX1CQ9GsvU3O+JAGIgu0J7sf1OarXKaKDygTZIoJyU6YdZzTFRu+YR0A==", + "version": "2.5.2", + "resolved": "https://registry.npmjs.org/luxon/-/luxon-2.5.2.tgz", + "integrity": "sha512-Yg7/RDp4nedqmLgyH0LwgGRvMEKVzKbUdkBYyCosbHgJ+kaOUx0qzSiSatVc3DFygnirTPYnMM2P5dg2uH1WvA==", "engines": { "node": ">=12" } @@ -2247,9 +2247,9 @@ "dev": true }, "luxon": { - "version": "2.5.0", - "resolved": "https://registry.npmjs.org/luxon/-/luxon-2.5.0.tgz", - "integrity": "sha512-IDkEPB80Rb6gCAU+FEib0t4FeJ4uVOuX1CQ9GsvU3O+JAGIgu0J7sf1OarXKaKDygTZIoJyU6YdZzTFRu+YR0A==" + "version": "2.5.2", + "resolved": "https://registry.npmjs.org/luxon/-/luxon-2.5.2.tgz", + "integrity": "sha512-Yg7/RDp4nedqmLgyH0LwgGRvMEKVzKbUdkBYyCosbHgJ+kaOUx0qzSiSatVc3DFygnirTPYnMM2P5dg2uH1WvA==" }, "mathjax": { "version": "3.2.2", diff --git a/htdocs/package.json b/htdocs/package.json index 3593a5c195..64cf5d3bfb 100644 --- a/htdocs/package.json +++ b/htdocs/package.json @@ -18,7 +18,7 @@ "iframe-resizer": "^4.3.2", "jquery": "^3.6.0", "jquery-ui-dist": "^1.13.1", - "luxon": "^2.3.1", + "luxon": "^2.5.2", "mathjax": "^3.2.0", "sortablejs": "^1.14.0" }, From a0ed06ea24e8fafd7a6dde3e3341eb86be5e7453 Mon Sep 17 00:00:00 2001 From: Glenn Rice Date: Sat, 19 Nov 2022 16:10:47 -0600 Subject: [PATCH 083/490] Convert templates to Mojolicious templates and remove all CGI usage. To make this work all template escape handlers need to be non-async. Thus all of the set headers that were generated in the template methods need to be generated instead in the initialize method which can be async. The previous theme template file system.template is now system.html.ep, and is a layout. The gateway.template file is no more. All content generator modules use the system.html.ep template. The special case for Problem.pm and ShowMeAnother.pm in system.template is also removed. Those modules have their own template file that is the default content just like all the other content generator modules. The output_JS and output_CSS files are removed, and added in each content generator modules template. Note that the git upgrade notifier has been removed. --- .gitignore | 1 + README.md.bak | 43 - bin/check_modules.pl | 2 - bin/dev_scripts/update-localization-files | 3 +- bin/upgrade_admin_db.pl | 19 +- conf/LTIConfigValues.config | 4 +- conf/defaults.config | 41 +- conf/localOverrides.conf.dist | 23 - htdocs/generate-assets.js | 2 +- htdocs/js/apps/FileManager/filemanager.js | 53 + htdocs/js/apps/GatewayQuiz/gateway.js | 2 + .../apps/InstructorTools/instructortools.js | 4 +- .../apps/ProblemSetDetail/problemsetdetail.js | 23 +- htdocs/js/apps/SetMaker/setmaker.js | 93 +- htdocs/js/apps/Stats/stats.js | 29 +- htdocs/js/apps/UserList/userlist.js | 26 + htdocs/themes/layouts | 1 + htdocs/themes/math4-green/gateway.template | 1 - htdocs/themes/math4-green/system.html.ep | 1 + htdocs/themes/math4-green/system.template | 1 - htdocs/themes/math4-red/gateway.template | 1 - htdocs/themes/math4-red/system.html.ep | 1 + htdocs/themes/math4-red/system.template | 1 - htdocs/themes/math4-yellow/gateway.template | 1 - htdocs/themes/math4-yellow/system.html.ep | 1 + htdocs/themes/math4-yellow/system.template | 1 - htdocs/themes/math4/gateway.scss | 4 - htdocs/themes/math4/gateway.template | 127 - htdocs/themes/math4/math4.js | 25 - htdocs/themes/math4/math4.scss | 28 +- htdocs/themes/math4/system.html.ep | 166 + htdocs/themes/math4/system.template | 322 -- lib/FormatRenderedProblem.pm | 22 +- lib/Mojolicious/WeBWorK.pm | 18 +- lib/Mojolicious/WeBWorK/Controller/Handler.pm | 341 +- lib/WeBWorK.pm | 95 +- lib/WeBWorK/AchievementEvaluator.pm | 107 +- lib/WeBWorK/AchievementItems.pm | 1749 +----- lib/WeBWorK/AchievementItems/AddNewTestGW.pm | 97 + lib/WeBWorK/AchievementItems/DoubleProb.pm | 121 + lib/WeBWorK/AchievementItems/DoubleSet.pm | 95 + lib/WeBWorK/AchievementItems/DuplicateProb.pm | 145 + lib/WeBWorK/AchievementItems/ExtendDueDate.pm | 91 + .../AchievementItems/ExtendDueDateGW.pm | 111 + .../AchievementItems/FullCreditProb.pm | 120 + lib/WeBWorK/AchievementItems/FullCreditSet.pm | 91 + .../AchievementItems/HalfCreditProb.pm | 126 + lib/WeBWorK/AchievementItems/HalfCreditSet.pm | 95 + lib/WeBWorK/AchievementItems/ReducedCred.pm | 101 + .../ResetIncorrectAttempts.pm | 122 + lib/WeBWorK/AchievementItems/ResurrectGW.pm | 97 + lib/WeBWorK/AchievementItems/ResurrectHW.pm | 103 + .../AchievementItems/SuperExtendDueDate.pm | 91 + lib/WeBWorK/AchievementItems/Surprise.pm | 55 + lib/WeBWorK/Authen/LTIAdvanced.pm | 2 - lib/WeBWorK/Authen/LTIAdvanced/SubmitGrade.pm | 22 +- lib/WeBWorK/Authen/LTIBasic.pm | 6 +- lib/WeBWorK/Authen/Shibboleth.pm | 7 +- lib/WeBWorK/Authz.pm | 2 +- lib/WeBWorK/ConfigObject.pm | 113 + lib/WeBWorK/ConfigObject/boolean.pm | 51 + lib/WeBWorK/ConfigObject/checkboxlist.pm | 80 + lib/WeBWorK/ConfigObject/list.pm | 63 + .../{CGI.pm => ConfigObject/number.pm} | 28 +- lib/WeBWorK/ConfigObject/permission.pm | 59 + lib/WeBWorK/ConfigObject/popuplist.pm | 50 + .../{HTML/InfoBox.pm => ConfigObject/text.pm} | 25 +- lib/WeBWorK/ConfigObject/time.pm | 39 + lib/WeBWorK/ConfigObject/timezone.pm | 42 + lib/WeBWorK/ContentGenerator.pm | 1406 +---- lib/WeBWorK/ContentGenerator/Achievements.pm | 307 +- lib/WeBWorK/ContentGenerator/CourseAdmin.pm | 4857 +++++------------ .../ContentGenerator/EquationDisplay.pm | 112 +- lib/WeBWorK/ContentGenerator/Feedback.pm | 293 +- lib/WeBWorK/ContentGenerator/GatewayQuiz.pm | 2688 +++------ lib/WeBWorK/ContentGenerator/Grades.pm | 294 +- lib/WeBWorK/ContentGenerator/Hardcopy.pm | 717 +-- lib/WeBWorK/ContentGenerator/Home.pm | 90 +- lib/WeBWorK/ContentGenerator/Instructor.pm | 90 +- .../Instructor/AchievementEditor.pm | 567 +- .../Instructor/AchievementList.pm | 1327 +---- .../Instructor/AchievementUserEditor.pm | 200 +- .../ContentGenerator/Instructor/AddUsers.pm | 272 +- .../ContentGenerator/Instructor/Assigner.pm | 186 +- .../ContentGenerator/Instructor/Config.pm | 720 +-- .../Instructor/FileManager.pm | 1217 +---- .../ContentGenerator/Instructor/Index.pm | 438 +- .../ContentGenerator/Instructor/LTIUpdate.pm | 170 +- .../Instructor/PGProblemEditor.pm | 881 +-- .../Instructor/ProblemGrader.pm | 384 +- .../Instructor/ProblemSetDetail.pm | 2240 ++------ .../Instructor/ProblemSetList.pm | 1764 +----- .../ContentGenerator/Instructor/Scoring.pm | 199 +- .../Instructor/ScoringDownload.pm | 48 +- .../ContentGenerator/Instructor/SendMail.pm | 684 +-- .../ContentGenerator/Instructor/SetMaker.pm | 1754 +----- .../Instructor/SetsAssignedToUser.pm | 240 - .../Instructor/ShowAnswers.pm | 481 +- .../Instructor/SingleProblemGrader.pm | 251 - .../ContentGenerator/Instructor/Stats.pm | 1117 +--- .../Instructor/StudentProgress.pm | 1019 +--- .../ContentGenerator/Instructor/UserDetail.pm | 534 +- .../ContentGenerator/Instructor/UserList.pm | 1895 +------ .../Instructor/UsersAssignedToSet.pm | 169 +- .../ContentGenerator/InstructorRPCHandler.pm | 23 +- lib/WeBWorK/ContentGenerator/Login.pm | 299 +- lib/WeBWorK/ContentGenerator/LoginProctor.pm | 286 +- lib/WeBWorK/ContentGenerator/Logout.pm | 126 +- lib/WeBWorK/ContentGenerator/Options.pm | 438 +- .../ContentGenerator/PGtoTexRenderer.pm | 66 - lib/WeBWorK/ContentGenerator/Problem.pm | 2416 +++----- .../ContentGenerator/ProblemRenderer.pm | 90 - lib/WeBWorK/ContentGenerator/ProblemSet.pm | 1083 +--- lib/WeBWorK/ContentGenerator/ProblemSets.pm | 565 +- .../ContentGenerator/ProctoredGatewayQuiz.pm | 7 +- lib/WeBWorK/ContentGenerator/RenderViaRPC.pm | 30 +- lib/WeBWorK/ContentGenerator/ShowMeAnother.pm | 383 +- lib/WeBWorK/ContentGenerator/Skeleton.pm | 76 +- lib/WeBWorK/ContentGenerator/Test.pm | 115 - lib/WeBWorK/FakeRequest.pm | 2 + lib/WeBWorK/Form.pm | 7 +- lib/WeBWorK/HTML/AttemptsTable.pm | 483 ++ .../Instructor => HTML}/CodeMirrorEditor.pm | 122 +- lib/WeBWorK/HTML/ComboBox.pm | 69 - lib/WeBWorK/HTML/DropdownList.pm | 191 - lib/WeBWorK/HTML/OptionList.pm | 106 - lib/WeBWorK/HTML/ScrollingRecordList.pm | 154 +- lib/WeBWorK/HTML/SingleProblemGrader.pm | 77 + lib/WeBWorK/NPL.pm | 626 --- lib/WeBWorK/Request.pm | 130 +- lib/WeBWorK/Template.pm | 230 - lib/WeBWorK/URLPath.pm | 32 +- lib/WeBWorK/Utils.pm | 3 +- lib/WeBWorK/Utils/AttemptsTable.pm | 452 -- lib/WeBWorK/Utils/CourseIntegrityCheck.pm | 242 +- lib/WeBWorK/Utils/CourseManagement.pm | 15 +- lib/WeBWorK/Utils/FilterRecords.pm | 191 +- lib/WeBWorK/Utils/FormatRecords.pm | 296 +- lib/WeBWorK/Utils/Grades.pm | 48 +- lib/WeBWorK/Utils/ProblemProcessing.pm | 42 +- lib/WeBWorK/Utils/Rendering.pm | 2 +- lib/WeBWorK/Utils/SortRecords.pm | 184 +- lib/WeBWorK/Utils/Tasks.pm | 186 +- lib/WebworkWebservice/LibraryActions.pm | 2 + lib/WebworkWebservice/ProblemActions.pm | 2 +- lib/WebworkWebservice/SetActions.pm | 4 - .../cheevoMessage.html.ep | 24 + .../ContentGenerator/Achievements.html.ep | 19 + .../Achievements/achievement_badges.html.ep | 40 + .../Achievements/achievement_items.html.ep | 55 + .../Achievements/cheevobigbox.html.ep | 22 + .../Base/error_output.html.ep | 45 + .../Base/feedback_macro_email.html.ep | 18 + .../Base/feedback_macro_form.html.ep | 27 + .../ContentGenerator/Base/footer.html.ep | 11 + templates/ContentGenerator/Base/links.html.ep | 303 + .../Base/login_status.html.ep | 43 + .../Base/warning_output.html.ep | 24 + .../ContentGenerator/CourseAdmin.html.ep | 104 + .../CourseAdmin/add_course_form.html.ep | 131 + .../archive_course_confirm.html.ep | 111 + .../CourseAdmin/archive_course_form.html.ep | 76 + .../CourseAdmin/delete_course_confirm.html.ep | 18 + .../CourseAdmin/delete_course_form.html.ep | 54 + .../CourseAdmin/edit_location_form.html.ep | 61 + .../hide_inactive_course_form.html.ep | 60 + .../CourseAdmin/manage_location_form.html.ep | 152 + .../CourseAdmin/registration_form.html.ep | 76 + .../CourseAdmin/rename_course_confirm.html.ep | 90 + .../rename_course_confirm_short.html.ep | 30 + .../CourseAdmin/rename_course_form.html.ep | 77 + .../unarchive_course_confirm.html.ep | 14 + .../CourseAdmin/unarchive_course_form.html.ep | 58 + .../upgrade_course_confirm.html.ep | 48 + .../CourseAdmin/upgrade_course_form.html.ep | 63 + .../ContentGenerator/EquationDisplay.html.ep | 9 + templates/ContentGenerator/Feedback.html.ep | 62 + .../ContentGenerator/GatewayQuiz.html.ep | 706 +++ .../ContentGenerator/GatewayQuiz/nav.html.ep | 134 + templates/ContentGenerator/Grades.html.ep | 2 + .../Grades/student_stats.html.ep | 39 + templates/ContentGenerator/Hardcopy.html.ep | 56 + .../ContentGenerator/Hardcopy/form.html.ep | 175 + templates/ContentGenerator/Home.html.ep | 28 + .../Instructor/AchievementEditor.html.ep | 65 + .../AchievementEditor/save_as_form.html.ep | 36 + .../AchievementEditor/save_form.html.ep | 3 + .../Instructor/AchievementList.html.ep | 71 + .../AchievementList/assign_form.html.ep | 26 + .../AchievementList/cancel_edit_form.html.ep | 1 + .../cancel_export_form.html.ep | 1 + .../AchievementList/create_form.html.ep | 23 + .../AchievementList/default_table.html.ep | 83 + .../AchievementList/delete_form.html.ep | 17 + .../AchievementList/edit_form.html.ep | 12 + .../AchievementList/edit_table.html.ep | 78 + .../AchievementList/edit_table_row.html.ep | 25 + .../AchievementList/export_form.html.ep | 12 + .../AchievementList/export_table.html.ep | 37 + .../AchievementList/import_form.html.ep | 26 + .../AchievementList/save_edit_form.html.ep | 1 + .../AchievementList/save_export_form.html.ep | 1 + .../AchievementList/score_form.html.ep | 13 + .../Instructor/AchievementUserEditor.html.ep | 105 + .../Instructor/AddUsers.html.ep | 90 + .../AddUsers/student_entry_report.html.ep | 33 + .../Instructor/Assigner.html.ep | 82 + .../Instructor/Config.html.ep | 69 + .../Instructor/FileManager.html.ep | 62 + .../Instructor/FileManager/confirm.html.ep | 15 + .../Instructor/FileManager/delete.html.ep | 78 + .../Instructor/FileManager/refresh.html.ep | 121 + .../FileManager/refresh_edit.html.ep | 27 + .../Instructor/FileManager/view.html.ep | 23 + .../ContentGenerator/Instructor/Index.html.ep | 254 + .../Instructor/LTIUpdate.html.ep | 86 + .../Instructor/PGProblemEditor.html.ep | 181 + .../PGProblemEditor/add_problem_form.html.ep | 30 + .../PGProblemEditor/hardcopy_form.html.ep | 62 + .../PGProblemEditor/revert_form.html.ep | 5 + .../PGProblemEditor/save_as_form.html.ep | 84 + .../PGProblemEditor/save_form.html.ep | 14 + .../PGProblemEditor/view_form.html.ep | 32 + .../Instructor/ProblemGrader.html.ep | 154 + .../Instructor/ProblemSetDetail.html.ep | 710 +++ .../ProblemSetDetail/attempts_row.html.ep | 12 + .../ProblemSetDetail/ip_locations_row.html.ep | 30 + ...tricted_login_proctor_password_row.html.ep | 28 + .../Instructor/ProblemSetList.html.ep | 137 + .../ProblemSetList/cancel_edit_form.html.ep | 1 + .../ProblemSetList/cancel_export_form.html.ep | 1 + .../ProblemSetList/create_form.html.ep | 22 + .../ProblemSetList/delete_form.html.ep | 16 + .../ProblemSetList/edit_form.html.ep | 11 + .../ProblemSetList/export_form.html.ep | 13 + .../ProblemSetList/filter_form.html.ep | 30 + .../ProblemSetList/import_form.html.ep | 69 + .../ProblemSetList/publish_form.html.ep | 26 + .../ProblemSetList/save_edit_form.html.ep | 1 + .../ProblemSetList/save_export_form.html.ep | 1 + .../ProblemSetList/score_form.html.ep | 12 + .../ProblemSetList/set_list_field.html.ep | 51 + .../ProblemSetList/set_list_row.html.ep | 60 + .../ProblemSetList/set_list_table.html.ep | 47 + .../ProblemSetList/sort_form.html.ep | 30 + .../Instructor/Scoring.html.ep | 99 + .../Instructor/SendMail.html.ep | 31 + .../Instructor/SendMail/main_form.html.ep | 204 + .../Instructor/SendMail/preview.html.ep | 10 + .../Instructor/SetMaker.html.ep | 89 + .../SetMaker/browse_course_sets_panel.html.ep | 19 + .../SetMaker/browse_library_panel.html.ep | 32 + .../browse_library_panel_advanced.html.ep | 119 + .../browse_library_panel_simple.html.ep | 55 + .../SetMaker/browse_local_panel.html.ep | 27 + .../SetMaker/browse_setdef_panel.html.ep | 22 + .../Instructor/SetMaker/problem_row.html.ep | 275 + .../Instructor/SetMaker/top_row.html.ep | 100 + .../SetMaker/view_problems_line.html.ep | 59 + .../Instructor/ShowAnswers.html.ep | 19 + .../ShowAnswers/instructor-selectors.html.ep | 71 + .../ShowAnswers/past-answers-table.html.ep | 65 + .../ContentGenerator/Instructor/Stats.html.ep | 29 + .../Instructor/Stats/index.html.ep | 46 + .../Instructor/Stats/problem_menu.html.ep | 39 + .../Instructor/Stats/problem_stats.html.ep | 102 + .../Instructor/Stats/set_stats.html.ep | 219 + .../Instructor/Stats/siblings.html.ep | 58 + .../Instructor/Stats/stats_table.html.ep | 12 + .../Stats/student_filter_menu.html.ep | 29 + .../Instructor/Stats/student_stats.html.ep | 31 + .../Instructor/StudentProgress.html.ep | 16 + .../StudentProgress/set_progress.html.ep | 332 ++ .../Instructor/UserDetail.html.ep | 136 + .../UserDetail/set_date_table.html.ep | 64 + .../Instructor/UserDetail/set_row.html.ep | 41 + .../Instructor/UserList.html.ep | 118 + .../Instructor/UserList/add_form.html.ep | 9 + .../UserList/cancel_edit_form.html.ep | 1 + .../UserList/cancel_password_form.html.ep | 1 + .../Instructor/UserList/delete_form.html.ep | 16 + .../Instructor/UserList/edit_form.html.ep | 11 + .../Instructor/UserList/export_form.html.ep | 37 + .../Instructor/UserList/filter_form.html.ep | 39 + .../Instructor/UserList/import_form.html.ep | 34 + .../Instructor/UserList/password_form.html.ep | 12 + .../UserList/save_edit_form.html.ep | 1 + .../UserList/save_password_form.html.ep | 1 + .../Instructor/UserList/sort_form.html.ep | 42 + .../Instructor/UserList/user_list.html.ep | 90 + .../UserList/user_list_field.html.ep | 56 + .../Instructor/UserList/user_row.html.ep | 100 + .../Instructor/UsersAssignedToSet.html.ep | 113 + templates/ContentGenerator/Login.html.ep | 77 + .../ContentGenerator/LoginProctor.html.ep | 96 + templates/ContentGenerator/Logout.html.ep | 26 + templates/ContentGenerator/Options.html.ep | 192 + templates/ContentGenerator/Problem.html.ep | 100 + .../Problem/checkboxes.html.ep | 72 + .../ContentGenerator/Problem/messages.html.ep | 50 + .../ContentGenerator/Problem/siblings.html.ep | 54 + .../Problem/student_nav.html.ep | 103 + .../Problem/submit_buttons.html.ep | 81 + templates/ContentGenerator/ProblemSet.html.ep | 64 + .../ContentGenerator/ProblemSet/info.html.ep | 25 + .../ProblemSet/problem_list.html.ep | 60 + .../ProblemSet/problem_list_row.html.ep | 89 + .../ProblemSet/siblings.html.ep | 24 + .../ProblemSet/version_list.html.ep | 261 + .../ContentGenerator/ProblemSets.html.ep | 98 + .../ContentGenerator/ProblemSets/info.html.ep | 27 + .../ProctoredGatewayQuiz.html.ep | 1 + .../ContentGenerator/ShowMeAnother.html.ep | 1 + .../ShowMeAnother/messages.html.ep | 38 + .../HTML/CodeMirrorEditor/controls.html.ep | 33 + templates/HTML/CodeMirrorEditor/js.html.ep | 28 + .../scrollingRecordList.html.ep | 30 + .../HTML/SingleProblemGrader/grader.html.ep | 142 + templates/RPCRenderFormats/default.html.ep | 4 +- templates/exception.html.ep | 19 + templates/exception_default.html.ep | 120 + templates/exception_min.html.ep | 31 + 322 files changed, 23164 insertions(+), 33568 deletions(-) delete mode 100644 README.md.bak create mode 100644 htdocs/js/apps/FileManager/filemanager.js create mode 120000 htdocs/themes/layouts delete mode 120000 htdocs/themes/math4-green/gateway.template create mode 120000 htdocs/themes/math4-green/system.html.ep delete mode 120000 htdocs/themes/math4-green/system.template delete mode 120000 htdocs/themes/math4-red/gateway.template create mode 120000 htdocs/themes/math4-red/system.html.ep delete mode 120000 htdocs/themes/math4-red/system.template delete mode 120000 htdocs/themes/math4-yellow/gateway.template create mode 120000 htdocs/themes/math4-yellow/system.html.ep delete mode 120000 htdocs/themes/math4-yellow/system.template delete mode 100644 htdocs/themes/math4/gateway.template create mode 100644 htdocs/themes/math4/system.html.ep delete mode 100644 htdocs/themes/math4/system.template create mode 100644 lib/WeBWorK/AchievementItems/AddNewTestGW.pm create mode 100644 lib/WeBWorK/AchievementItems/DoubleProb.pm create mode 100644 lib/WeBWorK/AchievementItems/DoubleSet.pm create mode 100644 lib/WeBWorK/AchievementItems/DuplicateProb.pm create mode 100644 lib/WeBWorK/AchievementItems/ExtendDueDate.pm create mode 100644 lib/WeBWorK/AchievementItems/ExtendDueDateGW.pm create mode 100644 lib/WeBWorK/AchievementItems/FullCreditProb.pm create mode 100644 lib/WeBWorK/AchievementItems/FullCreditSet.pm create mode 100644 lib/WeBWorK/AchievementItems/HalfCreditProb.pm create mode 100644 lib/WeBWorK/AchievementItems/HalfCreditSet.pm create mode 100644 lib/WeBWorK/AchievementItems/ReducedCred.pm create mode 100644 lib/WeBWorK/AchievementItems/ResetIncorrectAttempts.pm create mode 100644 lib/WeBWorK/AchievementItems/ResurrectGW.pm create mode 100644 lib/WeBWorK/AchievementItems/ResurrectHW.pm create mode 100644 lib/WeBWorK/AchievementItems/SuperExtendDueDate.pm create mode 100644 lib/WeBWorK/AchievementItems/Surprise.pm create mode 100644 lib/WeBWorK/ConfigObject.pm create mode 100644 lib/WeBWorK/ConfigObject/boolean.pm create mode 100644 lib/WeBWorK/ConfigObject/checkboxlist.pm create mode 100644 lib/WeBWorK/ConfigObject/list.pm rename lib/WeBWorK/{CGI.pm => ConfigObject/number.pm} (54%) create mode 100644 lib/WeBWorK/ConfigObject/permission.pm create mode 100644 lib/WeBWorK/ConfigObject/popuplist.pm rename lib/WeBWorK/{HTML/InfoBox.pm => ConfigObject/text.pm} (64%) create mode 100644 lib/WeBWorK/ConfigObject/time.pm create mode 100644 lib/WeBWorK/ConfigObject/timezone.pm delete mode 100644 lib/WeBWorK/ContentGenerator/Instructor/SetsAssignedToUser.pm delete mode 100644 lib/WeBWorK/ContentGenerator/Instructor/SingleProblemGrader.pm delete mode 100644 lib/WeBWorK/ContentGenerator/PGtoTexRenderer.pm delete mode 100644 lib/WeBWorK/ContentGenerator/ProblemRenderer.pm delete mode 100644 lib/WeBWorK/ContentGenerator/Test.pm create mode 100644 lib/WeBWorK/HTML/AttemptsTable.pm rename lib/WeBWorK/{ContentGenerator/Instructor => HTML}/CodeMirrorEditor.pm (51%) delete mode 100644 lib/WeBWorK/HTML/ComboBox.pm delete mode 100644 lib/WeBWorK/HTML/DropdownList.pm delete mode 100644 lib/WeBWorK/HTML/OptionList.pm create mode 100644 lib/WeBWorK/HTML/SingleProblemGrader.pm delete mode 100644 lib/WeBWorK/NPL.pm delete mode 100644 lib/WeBWorK/Template.pm delete mode 100644 lib/WeBWorK/Utils/AttemptsTable.pm create mode 100644 templates/AchievementEvaluator/cheevoMessage.html.ep create mode 100644 templates/ContentGenerator/Achievements.html.ep create mode 100644 templates/ContentGenerator/Achievements/achievement_badges.html.ep create mode 100644 templates/ContentGenerator/Achievements/achievement_items.html.ep create mode 100644 templates/ContentGenerator/Achievements/cheevobigbox.html.ep create mode 100644 templates/ContentGenerator/Base/error_output.html.ep create mode 100644 templates/ContentGenerator/Base/feedback_macro_email.html.ep create mode 100644 templates/ContentGenerator/Base/feedback_macro_form.html.ep create mode 100644 templates/ContentGenerator/Base/footer.html.ep create mode 100644 templates/ContentGenerator/Base/links.html.ep create mode 100644 templates/ContentGenerator/Base/login_status.html.ep create mode 100644 templates/ContentGenerator/Base/warning_output.html.ep create mode 100644 templates/ContentGenerator/CourseAdmin.html.ep create mode 100644 templates/ContentGenerator/CourseAdmin/add_course_form.html.ep create mode 100644 templates/ContentGenerator/CourseAdmin/archive_course_confirm.html.ep create mode 100644 templates/ContentGenerator/CourseAdmin/archive_course_form.html.ep create mode 100644 templates/ContentGenerator/CourseAdmin/delete_course_confirm.html.ep create mode 100644 templates/ContentGenerator/CourseAdmin/delete_course_form.html.ep create mode 100644 templates/ContentGenerator/CourseAdmin/edit_location_form.html.ep create mode 100644 templates/ContentGenerator/CourseAdmin/hide_inactive_course_form.html.ep create mode 100644 templates/ContentGenerator/CourseAdmin/manage_location_form.html.ep create mode 100644 templates/ContentGenerator/CourseAdmin/registration_form.html.ep create mode 100644 templates/ContentGenerator/CourseAdmin/rename_course_confirm.html.ep create mode 100644 templates/ContentGenerator/CourseAdmin/rename_course_confirm_short.html.ep create mode 100644 templates/ContentGenerator/CourseAdmin/rename_course_form.html.ep create mode 100644 templates/ContentGenerator/CourseAdmin/unarchive_course_confirm.html.ep create mode 100644 templates/ContentGenerator/CourseAdmin/unarchive_course_form.html.ep create mode 100644 templates/ContentGenerator/CourseAdmin/upgrade_course_confirm.html.ep create mode 100644 templates/ContentGenerator/CourseAdmin/upgrade_course_form.html.ep create mode 100644 templates/ContentGenerator/EquationDisplay.html.ep create mode 100644 templates/ContentGenerator/Feedback.html.ep create mode 100644 templates/ContentGenerator/GatewayQuiz.html.ep create mode 100644 templates/ContentGenerator/GatewayQuiz/nav.html.ep create mode 100644 templates/ContentGenerator/Grades.html.ep create mode 100644 templates/ContentGenerator/Grades/student_stats.html.ep create mode 100644 templates/ContentGenerator/Hardcopy.html.ep create mode 100644 templates/ContentGenerator/Hardcopy/form.html.ep create mode 100644 templates/ContentGenerator/Home.html.ep create mode 100644 templates/ContentGenerator/Instructor/AchievementEditor.html.ep create mode 100644 templates/ContentGenerator/Instructor/AchievementEditor/save_as_form.html.ep create mode 100644 templates/ContentGenerator/Instructor/AchievementEditor/save_form.html.ep create mode 100644 templates/ContentGenerator/Instructor/AchievementList.html.ep create mode 100644 templates/ContentGenerator/Instructor/AchievementList/assign_form.html.ep create mode 100644 templates/ContentGenerator/Instructor/AchievementList/cancel_edit_form.html.ep create mode 100644 templates/ContentGenerator/Instructor/AchievementList/cancel_export_form.html.ep create mode 100644 templates/ContentGenerator/Instructor/AchievementList/create_form.html.ep create mode 100644 templates/ContentGenerator/Instructor/AchievementList/default_table.html.ep create mode 100644 templates/ContentGenerator/Instructor/AchievementList/delete_form.html.ep create mode 100644 templates/ContentGenerator/Instructor/AchievementList/edit_form.html.ep create mode 100644 templates/ContentGenerator/Instructor/AchievementList/edit_table.html.ep create mode 100644 templates/ContentGenerator/Instructor/AchievementList/edit_table_row.html.ep create mode 100644 templates/ContentGenerator/Instructor/AchievementList/export_form.html.ep create mode 100644 templates/ContentGenerator/Instructor/AchievementList/export_table.html.ep create mode 100644 templates/ContentGenerator/Instructor/AchievementList/import_form.html.ep create mode 100644 templates/ContentGenerator/Instructor/AchievementList/save_edit_form.html.ep create mode 100644 templates/ContentGenerator/Instructor/AchievementList/save_export_form.html.ep create mode 100644 templates/ContentGenerator/Instructor/AchievementList/score_form.html.ep create mode 100644 templates/ContentGenerator/Instructor/AchievementUserEditor.html.ep create mode 100644 templates/ContentGenerator/Instructor/AddUsers.html.ep create mode 100644 templates/ContentGenerator/Instructor/AddUsers/student_entry_report.html.ep create mode 100644 templates/ContentGenerator/Instructor/Assigner.html.ep create mode 100644 templates/ContentGenerator/Instructor/Config.html.ep create mode 100644 templates/ContentGenerator/Instructor/FileManager.html.ep create mode 100644 templates/ContentGenerator/Instructor/FileManager/confirm.html.ep create mode 100644 templates/ContentGenerator/Instructor/FileManager/delete.html.ep create mode 100644 templates/ContentGenerator/Instructor/FileManager/refresh.html.ep create mode 100644 templates/ContentGenerator/Instructor/FileManager/refresh_edit.html.ep create mode 100644 templates/ContentGenerator/Instructor/FileManager/view.html.ep create mode 100644 templates/ContentGenerator/Instructor/Index.html.ep create mode 100644 templates/ContentGenerator/Instructor/LTIUpdate.html.ep create mode 100644 templates/ContentGenerator/Instructor/PGProblemEditor.html.ep create mode 100644 templates/ContentGenerator/Instructor/PGProblemEditor/add_problem_form.html.ep create mode 100644 templates/ContentGenerator/Instructor/PGProblemEditor/hardcopy_form.html.ep create mode 100644 templates/ContentGenerator/Instructor/PGProblemEditor/revert_form.html.ep create mode 100644 templates/ContentGenerator/Instructor/PGProblemEditor/save_as_form.html.ep create mode 100644 templates/ContentGenerator/Instructor/PGProblemEditor/save_form.html.ep create mode 100644 templates/ContentGenerator/Instructor/PGProblemEditor/view_form.html.ep create mode 100644 templates/ContentGenerator/Instructor/ProblemGrader.html.ep create mode 100644 templates/ContentGenerator/Instructor/ProblemSetDetail.html.ep create mode 100644 templates/ContentGenerator/Instructor/ProblemSetDetail/attempts_row.html.ep create mode 100644 templates/ContentGenerator/Instructor/ProblemSetDetail/ip_locations_row.html.ep create mode 100644 templates/ContentGenerator/Instructor/ProblemSetDetail/restricted_login_proctor_password_row.html.ep create mode 100644 templates/ContentGenerator/Instructor/ProblemSetList.html.ep create mode 100644 templates/ContentGenerator/Instructor/ProblemSetList/cancel_edit_form.html.ep create mode 100644 templates/ContentGenerator/Instructor/ProblemSetList/cancel_export_form.html.ep create mode 100644 templates/ContentGenerator/Instructor/ProblemSetList/create_form.html.ep create mode 100644 templates/ContentGenerator/Instructor/ProblemSetList/delete_form.html.ep create mode 100644 templates/ContentGenerator/Instructor/ProblemSetList/edit_form.html.ep create mode 100644 templates/ContentGenerator/Instructor/ProblemSetList/export_form.html.ep create mode 100644 templates/ContentGenerator/Instructor/ProblemSetList/filter_form.html.ep create mode 100644 templates/ContentGenerator/Instructor/ProblemSetList/import_form.html.ep create mode 100644 templates/ContentGenerator/Instructor/ProblemSetList/publish_form.html.ep create mode 100644 templates/ContentGenerator/Instructor/ProblemSetList/save_edit_form.html.ep create mode 100644 templates/ContentGenerator/Instructor/ProblemSetList/save_export_form.html.ep create mode 100644 templates/ContentGenerator/Instructor/ProblemSetList/score_form.html.ep create mode 100644 templates/ContentGenerator/Instructor/ProblemSetList/set_list_field.html.ep create mode 100644 templates/ContentGenerator/Instructor/ProblemSetList/set_list_row.html.ep create mode 100644 templates/ContentGenerator/Instructor/ProblemSetList/set_list_table.html.ep create mode 100644 templates/ContentGenerator/Instructor/ProblemSetList/sort_form.html.ep create mode 100644 templates/ContentGenerator/Instructor/Scoring.html.ep create mode 100644 templates/ContentGenerator/Instructor/SendMail.html.ep create mode 100644 templates/ContentGenerator/Instructor/SendMail/main_form.html.ep create mode 100644 templates/ContentGenerator/Instructor/SendMail/preview.html.ep create mode 100644 templates/ContentGenerator/Instructor/SetMaker.html.ep create mode 100644 templates/ContentGenerator/Instructor/SetMaker/browse_course_sets_panel.html.ep create mode 100644 templates/ContentGenerator/Instructor/SetMaker/browse_library_panel.html.ep create mode 100644 templates/ContentGenerator/Instructor/SetMaker/browse_library_panel_advanced.html.ep create mode 100644 templates/ContentGenerator/Instructor/SetMaker/browse_library_panel_simple.html.ep create mode 100644 templates/ContentGenerator/Instructor/SetMaker/browse_local_panel.html.ep create mode 100644 templates/ContentGenerator/Instructor/SetMaker/browse_setdef_panel.html.ep create mode 100644 templates/ContentGenerator/Instructor/SetMaker/problem_row.html.ep create mode 100644 templates/ContentGenerator/Instructor/SetMaker/top_row.html.ep create mode 100644 templates/ContentGenerator/Instructor/SetMaker/view_problems_line.html.ep create mode 100644 templates/ContentGenerator/Instructor/ShowAnswers.html.ep create mode 100644 templates/ContentGenerator/Instructor/ShowAnswers/instructor-selectors.html.ep create mode 100644 templates/ContentGenerator/Instructor/ShowAnswers/past-answers-table.html.ep create mode 100644 templates/ContentGenerator/Instructor/Stats.html.ep create mode 100644 templates/ContentGenerator/Instructor/Stats/index.html.ep create mode 100644 templates/ContentGenerator/Instructor/Stats/problem_menu.html.ep create mode 100644 templates/ContentGenerator/Instructor/Stats/problem_stats.html.ep create mode 100644 templates/ContentGenerator/Instructor/Stats/set_stats.html.ep create mode 100644 templates/ContentGenerator/Instructor/Stats/siblings.html.ep create mode 100644 templates/ContentGenerator/Instructor/Stats/stats_table.html.ep create mode 100644 templates/ContentGenerator/Instructor/Stats/student_filter_menu.html.ep create mode 100644 templates/ContentGenerator/Instructor/Stats/student_stats.html.ep create mode 100644 templates/ContentGenerator/Instructor/StudentProgress.html.ep create mode 100644 templates/ContentGenerator/Instructor/StudentProgress/set_progress.html.ep create mode 100644 templates/ContentGenerator/Instructor/UserDetail.html.ep create mode 100644 templates/ContentGenerator/Instructor/UserDetail/set_date_table.html.ep create mode 100644 templates/ContentGenerator/Instructor/UserDetail/set_row.html.ep create mode 100644 templates/ContentGenerator/Instructor/UserList.html.ep create mode 100644 templates/ContentGenerator/Instructor/UserList/add_form.html.ep create mode 100644 templates/ContentGenerator/Instructor/UserList/cancel_edit_form.html.ep create mode 100644 templates/ContentGenerator/Instructor/UserList/cancel_password_form.html.ep create mode 100644 templates/ContentGenerator/Instructor/UserList/delete_form.html.ep create mode 100644 templates/ContentGenerator/Instructor/UserList/edit_form.html.ep create mode 100644 templates/ContentGenerator/Instructor/UserList/export_form.html.ep create mode 100644 templates/ContentGenerator/Instructor/UserList/filter_form.html.ep create mode 100644 templates/ContentGenerator/Instructor/UserList/import_form.html.ep create mode 100644 templates/ContentGenerator/Instructor/UserList/password_form.html.ep create mode 100644 templates/ContentGenerator/Instructor/UserList/save_edit_form.html.ep create mode 100644 templates/ContentGenerator/Instructor/UserList/save_password_form.html.ep create mode 100644 templates/ContentGenerator/Instructor/UserList/sort_form.html.ep create mode 100644 templates/ContentGenerator/Instructor/UserList/user_list.html.ep create mode 100644 templates/ContentGenerator/Instructor/UserList/user_list_field.html.ep create mode 100644 templates/ContentGenerator/Instructor/UserList/user_row.html.ep create mode 100644 templates/ContentGenerator/Instructor/UsersAssignedToSet.html.ep create mode 100644 templates/ContentGenerator/Login.html.ep create mode 100644 templates/ContentGenerator/LoginProctor.html.ep create mode 100644 templates/ContentGenerator/Logout.html.ep create mode 100644 templates/ContentGenerator/Options.html.ep create mode 100644 templates/ContentGenerator/Problem.html.ep create mode 100644 templates/ContentGenerator/Problem/checkboxes.html.ep create mode 100644 templates/ContentGenerator/Problem/messages.html.ep create mode 100644 templates/ContentGenerator/Problem/siblings.html.ep create mode 100644 templates/ContentGenerator/Problem/student_nav.html.ep create mode 100644 templates/ContentGenerator/Problem/submit_buttons.html.ep create mode 100644 templates/ContentGenerator/ProblemSet.html.ep create mode 100644 templates/ContentGenerator/ProblemSet/info.html.ep create mode 100644 templates/ContentGenerator/ProblemSet/problem_list.html.ep create mode 100644 templates/ContentGenerator/ProblemSet/problem_list_row.html.ep create mode 100644 templates/ContentGenerator/ProblemSet/siblings.html.ep create mode 100644 templates/ContentGenerator/ProblemSet/version_list.html.ep create mode 100644 templates/ContentGenerator/ProblemSets.html.ep create mode 100644 templates/ContentGenerator/ProblemSets/info.html.ep create mode 100644 templates/ContentGenerator/ProctoredGatewayQuiz.html.ep create mode 100644 templates/ContentGenerator/ShowMeAnother.html.ep create mode 100644 templates/ContentGenerator/ShowMeAnother/messages.html.ep create mode 100644 templates/HTML/CodeMirrorEditor/controls.html.ep create mode 100644 templates/HTML/CodeMirrorEditor/js.html.ep create mode 100644 templates/HTML/ScrollingRecordList/scrollingRecordList.html.ep create mode 100644 templates/HTML/SingleProblemGrader/grader.html.ep create mode 100644 templates/exception.html.ep create mode 100644 templates/exception_default.html.ep create mode 100644 templates/exception_min.html.ep diff --git a/.gitignore b/.gitignore index 984b7e7468..df02a25e7a 100644 --- a/.gitignore +++ b/.gitignore @@ -31,6 +31,7 @@ htdocs/themes/* !htdocs/themes/math4-red !htdocs/themes/math4-green !htdocs/themes/math4-yellow +!htdocs/themes/layouts DATA/* docker-compose.yml docker-config/ssl/* diff --git a/README.md.bak b/README.md.bak deleted file mode 100644 index d5acabaf93..0000000000 --- a/README.md.bak +++ /dev/null @@ -1,43 +0,0 @@ -This is a rough draft of our developer instructions, so parts of it are likely missing or wrong. Any corrections/additions are welcome - -We're trying to follow [git flow](http://nvie.com/posts/a-successful-git-branching-model/) so it would be a good idea for developers to read up on it -and [install](https://github.com/nvie/gitflow/wiki/Installation) the commandline tools. -We're working on getting our own, more specific, documentation up about our desired development flow. - -Here are the basics to get you set up developing. - -First create an account/login to github. Head to the https://github.com/openwebwork/webwork2 and click **fork**. - -Once that's done, clone your newly forked repo to your local computer and add openwebwork as an upstream. - -``` -git remote add upstream git://github.com/openwebwork/webwork2.git -``` - -I'd also recomend making sure the develop branch is pulled down from openwebwork and ready to push up to your github repo. - -``` -git checkout -b develop upstream/develop -git branch --set-upstream develop origin/develop -``` - -This will let you keep your version up to date with the official one. - -The rest of these instructions will assume your using the [git flow commandline](https://github.com/nvie/gitflow/wiki/Command-Line-Arguments).. if you're not, there are equivilant commands in pure git. - -First get your local repo ready for git flow - -``` -git flow init -``` - -Here are the basics for working on a new feature - -``` -git flow feature start -``` - -then make your changes, and when ready push everything up to your github for people to see `git push origin`. - -When your feature is stable (or close) you can issue a pull requst on github from your feature branch to the openwebwork/webwork2 develop branch. -Including a comment stating what the feature is and any more information would be great. diff --git a/bin/check_modules.pl b/bin/check_modules.pl index edd5ec8696..ad3b242b0d 100755 --- a/bin/check_modules.pl +++ b/bin/check_modules.pl @@ -68,7 +68,6 @@ =head1 DESCRIPTION Array::Utils Benchmark Carp - CGI Class::Accessor Data::Dump Data::Dumper @@ -100,7 +99,6 @@ =head1 DESCRIPTION Getopt::Long Getopt::Std HTML::Entities - HTML::Scrubber HTML::Tagset HTML::Template HTTP::Async diff --git a/bin/dev_scripts/update-localization-files b/bin/dev_scripts/update-localization-files index c9507346fe..37c62152ee 100755 --- a/bin/dev_scripts/update-localization-files +++ b/bin/dev_scripts/update-localization-files @@ -55,7 +55,8 @@ cd $LOCDIR echo "Updating $WEBWORK_ROOT/webwork2.pot" -xgettext.pl -o webwork2.pot -D $WEBWORK_ROOT/lib -D $PG_ROOT/lib -D $PG_ROOT/macros $WEBWORK_ROOT/conf/defaults.config $WEBWORK_ROOT/conf/LTIConfigValues.config +xgettext.pl -o webwork2.pot -D $WEBWORK_ROOT/lib -D $PG_ROOT/lib -D $PG_ROOT/macros -D $WEBWORK_ROOT/templates \ + $WEBWORK_ROOT/conf/defaults.config $WEBWORK_ROOT/conf/LTIConfigValues.config if $UPDATE_PO; then find $LOCDIR -name '*.po' -exec bash -c "echo \"Updating {}\"; msgmerge -qUN {} webwork2.pot" \; diff --git a/bin/upgrade_admin_db.pl b/bin/upgrade_admin_db.pl index 4b0792566b..fdef76c078 100755 --- a/bin/upgrade_admin_db.pl +++ b/bin/upgrade_admin_db.pl @@ -44,8 +44,8 @@ BEGIN # Create integrity checker ############################################################################# -my $update_error_msg = ''; -my $CIchecker = new WeBWorK::Utils::CourseIntegrityCheck(ce => $ce); +my @update_report; +my $CIchecker = new WeBWorK::Utils::CourseIntegrityCheck(ce => $ce); ############################################################################# # Add missing tables and missing fields to existing tables @@ -57,15 +57,20 @@ BEGIN grep { $dbStatus->{$_}->[0] == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_A() } @schema_table_names; my @tables_to_alter = grep { $dbStatus->{$_}->[0] == WeBWorK::Utils::CourseIntegrityCheck::DIFFER_IN_A_AND_B() } @schema_table_names; -$update_error_msg = $CIchecker->updateCourseTables($upgrade_courseID, [@tables_to_create]); +push(@update_report, $CIchecker->updateCourseTables($upgrade_courseID, [@tables_to_create])); foreach my $table_name (@tables_to_alter) { #warn "do_upgrade_course: adding new fields to table $table_name in course $upgrade_courseID"; - $update_error_msg .= $CIchecker->updateTableFields($upgrade_courseID, $table_name); + push(@update_report, $CIchecker->updateTableFields($upgrade_courseID, $table_name)); } -if ($update_error_msg) { - $update_error_msg =~ s/
      /\n/g; - print $update_error_msg. "\n"; +if (@update_report) { + for (@update_report) { + if ($_->[1]) { + print "$_->[0]\n"; + } else { + print STDERR "$_->[0]\n"; + } + } } else { print "Admin Course Up to Date\n"; } diff --git a/conf/LTIConfigValues.config b/conf/LTIConfigValues.config index c5c6326b9e..0d44f6f0fa 100644 --- a/conf/LTIConfigValues.config +++ b/conf/LTIConfigValues.config @@ -60,9 +60,7 @@ $LTIConfigValues = { . 'future due dates as zero.
      homework
      Sends back a score for each problem set ' . '(including for each quiz). To use this, the external links from the LMS must be problem set ' . 'specific. For example, webwork.myschool.edu/webwork2/course-name/problem_set_name. ' - . 'If the problem set name has space characters, they should be underscores in these addresses. If ' - . 'the problem set is a quiz, it must have this format: ' - . 'webwork.myschool.edu/webwork2/course-name/quiz_mode/problem_set_name. ' + . 'If the problem set name has space characters, they should be underscores in these addresses. ' . 'Also, to initialize the communication between WeBWorK and the LMS, the user must follow each of ' . 'these external learning tools at least one time. Since there must be a separate external tool link ' . 'for each problem set, this option requires more maintenance of the LMS course.
      ' diff --git a/conf/defaults.config b/conf/defaults.config index 3832a18041..a4c10ff4e8 100644 --- a/conf/defaults.config +++ b/conf/defaults.config @@ -136,25 +136,6 @@ $courseURLs{feedbackURL} = ""; #$courseURLs{feedbackFormURL} = "http://www.mathnerds.com/MathNerds/mmn/SDS/askQuestion.aspx"; #"http://www.tipjar.com/cgi-bin/test"; $courseURLs{feedbackFormURL} = ""; -################################################################################ -# Repository Information -################################################################################ -# This is where you put your remote and branch for your WeBWorK, PG and OPL -# github repositories. - -# Note: This process uses git ls-remote which can be very slow on some -# systems. If your course list page in the admin course is very slow -# consider disabling this option. - -$enableGitUpgradeNotifier = 0; - -$gitWeBWorKRemoteName = "origin"; -$gitWeBWorKBranchName = "main"; -$gitPGRemoteName = "origin"; -$gitPGBranchName = "main"; -$gitLibraryRemoteName = "origin"; -$gitLibraryBranchName = "main"; - ################################################################################ # Theme ################################################################################ @@ -1006,14 +987,6 @@ $options{setDefSearchDepth} = 4; $options{useOPLdefFiles} = 1; $options{useContribDefFiles} = 1; - -########################################################################################## -#### Default settings for the problem grader page -########################################################################################## - -# gap betweens cores in score dropdown - e.g. 5 gives 5, 10, 15, 20 -$options{problemGraderScoreDelta} = 5; - ########################################################################################## #### Default settings for the problem editor pages ########################################################################################## @@ -1413,13 +1386,15 @@ $pg{options}{enableProgressBar} = 1; # Configuration data # It is organized by section. The allowable types are -# 'text' for a text string (no quote marks allowed), +# 'text' for a text string (no quotes allowed), # 'number' for a number, # 'list' for a list of text strings, # 'permission' for a permission value, -# 'boolean' for variables which really hold 0/1 values as flags. -# 'checkboxlist' for variables which really hold a list of values which -# can be independently picked yes/no as checkboxes +# 'boolean' for variables which really hold 0/1 values as flags, +# 'timezone' for a time zone, +# 'time' for a time, +# 'checkboxlist' for variables that hold a list of values which can be independently picked yes/no as checkboxes, +# 'popuplist' for variables that hold a list of values to be selected from. # Localization Info: The doc strings in this portion are reproduced in # lib/WeBWorK/Localize.pm solely so that xgettext.pl will @@ -1447,8 +1422,8 @@ $ConfigValues = [ var => 'defaultTheme', doc => x('Theme (refresh page after saving changes to reveal new theme.)'), doc2 => x( - 'There is one main theme to choose from: math4. It has two variants, math4-green and math4-red. ' - . 'The theme specifies a unified look and feel for the WeBWorK course web pages.' + 'There is one main theme to choose from: math4. It has three variants: math4-green, math4-red, and' + . 'math4-yellow. The theme specifies a unified look and feel for the WeBWorK course web pages.' ), values => [qw(math4 math4-green math4-red)], type => 'popuplist', diff --git a/conf/localOverrides.conf.dist b/conf/localOverrides.conf.dist index c9f6346b66..3243a05eb4 100644 --- a/conf/localOverrides.conf.dist +++ b/conf/localOverrides.conf.dist @@ -60,29 +60,6 @@ $mail{feedbackRecipients} = [ # Use this to customize the text of the feedback button. #$feedback_button_name = "Email Instructor"; - - -################################################################################ -# Repository Information -############################################################################### -# This is where you put your custom remote and branch for your WeBWorK, PG and OPL -# github repositories. -# To disable checking for a particular repository, set the remote and branch -# variables to be empty strings. - -# Note: This process uses git ls-remote which can be very slow on some -# systems, so it is disabled by default. Enabling this may make the course -# list page in the admin course very slow. - -#$enableGitUpgradeNotifier = 1; - -#$gitWeBWorKRemoteName = "origin"; -#$gitWeBWorKBranchName = "main"; -#$gitPGRemoteName = "origin"; -#$gitPGBranchName = "main"; -#$gitLibraryRemoteName = "origin"; -#$gitLibraryBranchName = "main"; - ################################################################################ # Theme ################################################################################ diff --git a/htdocs/generate-assets.js b/htdocs/generate-assets.js index 634850aeb5..98c1db1119 100755 --- a/htdocs/generate-assets.js +++ b/htdocs/generate-assets.js @@ -229,7 +229,7 @@ if (argv.useCDN || process.env.USE_CDN) { // Set up the watcher. if (argv.watchFiles) console.log('\x1b[32mEstablishing watches and performing initial build.\x1b[0m'); chokidar.watch(['js/apps', 'themes'], { - ignored: /\.min\.(js|css)$/, + ignored: /layouts|\.min\.(js|css)$/, cwd: __dirname, // Make sure all paths are given relative to the htdocs directory. usePolling: true, // Needed to get changes to symlinks. interval: 500, diff --git a/htdocs/js/apps/FileManager/filemanager.js b/htdocs/js/apps/FileManager/filemanager.js new file mode 100644 index 0000000000..8f579d6bf8 --- /dev/null +++ b/htdocs/js/apps/FileManager/filemanager.js @@ -0,0 +1,53 @@ +'use strict'; +(() => { + const form = window.document.getElementById('FileManager'); + + const files = document.getElementById('files'); + + if (form) { + const doAction = (action) => { + form.formAction.value = action; + form.submit(); + }; + + document.getElementsByName('directory')[0]?.addEventListener('change', () => doAction('Go')); + document.getElementsByName('dates')[0]?.addEventListener('click', () => doAction('Refresh')); + files?.addEventListener('dblclick', () => doAction('View')); + + // If on the confirmation page, then focus the "name" input. + form.querySelector('input[name="name"]')?.focus(); + } + + const fileActionButtons = ['View', 'Edit', 'Download', 'Rename', 'Copy', 'Delete', 'MakeArchive'].map((buttonId) => + document.getElementById(buttonId) + ); + const archiveButton = document.getElementById('MakeArchive'); + + const checkFiles = () => { + const state = files.selectedIndex < 0; + + for (const button of fileActionButtons) { + if (button) button.disabled = state; + } + + if (archiveButton && !state) { + const numSelected = files.querySelectorAll('option:checked').length; + if ( + numSelected === 0 || + numSelected > 1 || + !/\.(tar|tar\.gz|tgz)$/.test(files.children[files.selectedIndex].value) + ) + archiveButton.value = archiveButton.dataset.archiveText; + else archiveButton.value = archiveButton.dataset.unarchiveText; + } + }; + + files?.addEventListener('change', checkFiles); + if (files) checkFiles(); + + const file = document.getElementById('file'); + const uploadButton = document.getElementById('Upload'); + const checkFile = () => (uploadButton.disabled = file.value === ''); + if (uploadButton) file?.addEventListener('change', checkFile); + if (file) checkFile(); +})(); diff --git a/htdocs/js/apps/GatewayQuiz/gateway.js b/htdocs/js/apps/GatewayQuiz/gateway.js index baa4ab0a2a..63494c0015 100644 --- a/htdocs/js/apps/GatewayQuiz/gateway.js +++ b/htdocs/js/apps/GatewayQuiz/gateway.js @@ -6,6 +6,8 @@ // The timer code relies on the existence of data attributes for the gwTimer div created by GatewayQuiz.pm. (() => { + if (!document.gwquiz) return; + // Gateway timer const timerDiv = document.getElementById('gwTimer'); // The timer div element let actuallySubmit = false; // This needs to be set to true to allow an actual submission. diff --git a/htdocs/js/apps/InstructorTools/instructortools.js b/htdocs/js/apps/InstructorTools/instructortools.js index efb41b456a..6b41ded95c 100644 --- a/htdocs/js/apps/InstructorTools/instructortools.js +++ b/htdocs/js/apps/InstructorTools/instructortools.js @@ -1,7 +1,7 @@ (() => { const form = document.forms['instructor-tools-form']; - form.addEventListener('submit', (e) => { + form?.addEventListener('submit', (e) => { const selectedUsers = Array.from(document.querySelector('select[name=selected_users]')?.options ?? []) .filter((option) => option.selected); const selectedSets = Array.from(document.querySelector('select[name=selected_sets]')?.options ?? []) @@ -25,7 +25,7 @@ } if (messages.length) { - const msgBoxes = document.querySelectorAll('.Message'); + const msgBoxes = document.querySelectorAll('.message'); msgBoxes.forEach((msgBox) => { while (msgBox.firstChild) msgBox.firstChild.remove(); const container = document.createElement('div'); diff --git a/htdocs/js/apps/ProblemSetDetail/problemsetdetail.js b/htdocs/js/apps/ProblemSetDetail/problemsetdetail.js index 2882d4748f..c2a0c1c2ac 100644 --- a/htdocs/js/apps/ProblemSetDetail/problemsetdetail.js +++ b/htdocs/js/apps/ProblemSetDetail/problemsetdetail.js @@ -402,7 +402,7 @@ if (iframe && iframe.iFrameResizer) { iframe.iFrameResizer.close(); renderArea.innerHTML = ''; - } else if (renderArea.innerHTML != '') { + } else if (/\S/.test(renderArea.innerHTML)) { renderArea.innerHTML = ''; } else { collapsibles[id]?.show(); @@ -461,4 +461,25 @@ if (!overrideCheck) return; select.addEventListener('change', () => overrideCheck.checked = select.value != ''); }); + + // This changes the set header textbox text to the currently selected option in the select menu. + document.querySelectorAll('.combo-box').forEach((comboBox) => { + const comboBoxText = comboBox.querySelector('.combo-box-text'); + const comboBoxSelect = comboBox.querySelector('.combo-box-select'); + + if (!comboBoxText || !comboBoxSelect) return; + + // Try to select best option in select menu as user types in the textbox. + comboBoxText.addEventListener('keyup', () => { + let i = 0; + for (; + i < comboBoxSelect.options.length && comboBoxSelect.options[i].value.indexOf(comboBoxText.value) != 0; + ++i) {} + comboBoxSelect.selectedIndex = i; + }); + + // Set the textbox text to be same as that of select menu + comboBoxSelect.addEventListener('change', + () => comboBoxText.value = comboBoxSelect.options[comboBoxSelect.selectedIndex].value); + }); })(); diff --git a/htdocs/js/apps/SetMaker/setmaker.js b/htdocs/js/apps/SetMaker/setmaker.js index 0cf62f5bf3..20ba9512ea 100644 --- a/htdocs/js/apps/SetMaker/setmaker.js +++ b/htdocs/js/apps/SetMaker/setmaker.js @@ -39,21 +39,15 @@ }; const init_webservice = (command) => { - const myUser = document.getElementById('hidden_user')?.value; - const myCourseID = document.getElementById('hidden_courseID')?.value; - const mySessionKey = document.getElementById('hidden_key')?.value; - const requestObject = { rpc_command: 'listLib', library_name: 'Library', command: 'buildtree' }; - if (myUser && mySessionKey && myCourseID) { - requestObject.user = myUser; - requestObject.key = mySessionKey; - requestObject.courseID = myCourseID; - } else { - alertToast('Missing hidden credentials', `user: ${myUser ?? 'uknown'}, session_key: ${ - mySessionKey ?? 'unknown'}, courseID: ${myCourseID ?? 'unknown'}`); - return null; - } - requestObject.rpc_command = command; - return requestObject; + return { + rpc_command: 'listLib', + library_name: 'Library', + command: 'buildtree', + user: document.getElementById('hidden_user')?.value, + key: document.getElementById('hidden_key')?.value, + courseID: document.getElementById('hidden_courseID')?.value, + rpc_command: command + }; }; // Content request handling @@ -61,29 +55,25 @@ const libSubjects = document.querySelector('select[name="library_subjects"]'); const libChapters = document.querySelector('select[name="library_chapters"]'); const libSections = document.querySelector('select[name="library_sections"]'); + const libraryTextbook = document.querySelector('select[name="library_textbook"]'); + const libraryChapter = document.querySelector('select[name="library_textchapter"]'); + const librarySection = document.querySelector('select[name="library_textsection"]'); + const includeOPL = document.querySelector('[name="includeOPL"]'); + const includeContrib = document.querySelector('[name="includeContrib"]'); const lib_update = async (who, what) => { const child = { subjects: 'chapters', chapters: 'sections', sections: 'count' }; - const all = `All ${who.charAt(0).toUpperCase()}${who.slice(1)}`; - const requestObject = init_webservice('searchLib'); - if (!requestObject) return; // Missing credentials - - const subj = libSubjects?.value ?? ''; - const chap = libChapters?.value ?? ''; - const sect = libSections?.value ?? ''; - - const lib_text = document.querySelector('[name="library_textbook"]')?.value ?? ''; - const lib_textchap = document.querySelector('[name="library_textchapter"]')?.value ?? ''; - const lib_textsect = document.querySelector('[name="library_textsection"]')?.value ?? ''; - - requestObject.library_subjects = subj === 'All Subjects' ? '' : subj; - requestObject.library_chapters = chap === 'All Chapters' ? '' : chap; - requestObject.library_sections = sect === 'All Sections' ? '' : sect; - requestObject.library_textbooks = lib_text === 'All Textbooks' ? '' : lib_text; - requestObject.library_textchapter = lib_textchap === 'All Chapters' ? '' : lib_textchap; - requestObject.library_textsection = lib_textsect === 'All Sections' ? '' : lib_textsect; + requestObject.library_subjects = libSubjects?.value ?? ''; + requestObject.library_chapters = libChapters?.value ?? ''; + requestObject.library_sections = libSections?.value ?? ''; + requestObject.library_textbook = libraryTextbook?.value ?? ''; + requestObject.library_textchapter = libraryChapter?.value ?? ''; + requestObject.library_textsection = librarySection?.value ?? ''; + requestObject.includeOPL = (includeOPL.type === 'checkbox' && includeOPL?.checked) || + (includeOPL.type === 'hidden' && includeOPL.value) ? 1 : 0; + requestObject.includeContrib = includeContrib?.checked ? 1 : 0; if (who == 'count') { requestObject.command = 'countDBListings'; @@ -109,7 +99,7 @@ throw data.error; } else { const num = data.result_data[0]; - document.getElementById('library_count_line').innerHTML = num === '1' + document.getElementById('library_count_line').firstElementChild.innerHTML = num === '1' ? 'There is 1 matching WeBWorK problem' : `There are ${num} matching WeBWorK problems.`; } @@ -121,13 +111,13 @@ } if (what == 'clear') { - setselect(`library_${who}`, [all]); + setselect(`library_${who}`, []); lib_update(child[who], 'clear'); return; } - if (who == 'chapters' && subj == '') { lib_update(who, 'clear'); return; } - if (who == 'sections' && chap == '') { lib_update(who, 'clear'); return; } + if (who == 'chapters' && requestObject.library_subjects == '') { lib_update(who, 'clear'); return; } + if (who == 'sections' && requestObject.library_chapters == '') { lib_update(who, 'clear'); return; } requestObject.command = who == 'sections' ? 'getSectionListings' : 'getAllDBchapters'; @@ -151,9 +141,7 @@ if (data.error) { throw data.error; } else { - const arr = data.result_data; - arr.unshift(all); - setselect(`library_${who}`, arr); + setselect(`library_${who}`, data.result_data); lib_update(child[who], 'clear'); } } @@ -164,7 +152,10 @@ const setselect = (selname, newarray) => { const sel = document.querySelector(`[name="${selname}"]`); + // Save the 'all' option, remove all options, and then restore the 'all' option. + const select_all_option = sel.firstChild; while (sel.firstChild) sel.lastChild.remove(); + sel.append(select_all_option); newarray.forEach((val) => { const option = document.createElement('option'); option.value = val; @@ -176,9 +167,19 @@ libChapters?.addEventListener('change', () => lib_update('sections', 'get')); libSubjects?.addEventListener('change', () => lib_update('chapters', 'get')); libSections?.addEventListener('change', () => lib_update('count', 'clear')); + includeOPL?.addEventListener('change', () => lib_update('count', 'clear')); + includeContrib?.addEventListener('change', () => lib_update('count', 'clear')); document.querySelectorAll('input[name="level"]').forEach( (level) => level.addEventListener('change', () => lib_update('count', 'clear'))); + // Set up the advanced view selects to submit the form when changed. + const libraryBrowserForm = document.forms['library_browser_form']; + if (libraryBrowserForm) { + libraryTextbook?.addEventListener('change', () => libraryBrowserForm.submit()); + libraryChapter?.addEventListener('change', () => libraryBrowserForm.submit()); + librarySection?.addEventListener('change', () => libraryBrowserForm.submit()); + } + // Add problems to target set const addme = async (path, who) => { const localSets = document.getElementById('local_sets'); @@ -190,7 +191,6 @@ } const request = init_webservice('addProblem'); - if (!request) return; request.set_id = target; const pathlist = []; @@ -241,7 +241,7 @@ }; document.querySelector('input[name="select_all"]')?.addEventListener('click', () => addme('', 'all')); - document.querySelectorAll('input[name="add_me"]') + document.querySelectorAll('button.add_me') .forEach((btn) => btn.addEventListener('click', () => addme(btn.dataset.sourceFile, 'one'))); // Update the messages about which problems are in the current set. @@ -381,7 +381,7 @@ const mltIcon = document.getElementById(`mlt${cnt}`); if(mltIcon.textContent == 'M') { - unshownAreas.forEach((area) => area.style.display = 'block'); + unshownAreas.forEach((area) => area.classList.remove('d-none')); // Render any problems that were hidden that have not yet been rendered. for (const area of unshownAreas) { const iframe = area.querySelector('iframe[id^=psr_render_iframe_]'); @@ -394,7 +394,7 @@ new bootstrap.Tooltip(mltIcon, { fallbackPlacements: [] }) count = -count; } else { - unshownAreas.forEach((area) => area.style.display = 'none'); + unshownAreas.forEach((area) => area.classList.add('d-none')); mltIcon.textContent = 'M'; mltIcon.dataset.bsTitle = mltIcon.dataset.moreText; bootstrap.Tooltip.getInstance(mltIcon)?.dispose(); @@ -516,8 +516,9 @@ // Render all visible problems on the page (async () => { for (const renderArea of renderAreas) { - if (renderArea.style.display === 'none') continue; - await render(renderArea.id.match(/^psr_render_area_(\d+)/)[1]); + const id = renderArea.id.match(/^psr_render_area_(\d+)/)[1]; + if (document.getElementById(`pgrow${id}`)?.classList.contains('d-none')) continue; + await render(id); } })(); diff --git a/htdocs/js/apps/Stats/stats.js b/htdocs/js/apps/Stats/stats.js index bb8ec1e047..b4ff8a531d 100644 --- a/htdocs/js/apps/Stats/stats.js +++ b/htdocs/js/apps/Stats/stats.js @@ -5,9 +5,9 @@ // Send a request to the webwork webservice and render a problem. const basicWebserviceURL = `${webworkConfig?.webwork_url ?? '/webwork2'}/render_rpc`; - const render = () => new Promise((resolve) => { - const renderArea = document.getElementById(`problem_render_area`); + const renderArea = document.getElementById(`problem_render_area`); + const render = () => new Promise((resolve) => { const ro = { user: document.getElementById('hidden_user')?.value, courseID: document.getElementById('hidden_course_id')?.value, @@ -88,20 +88,21 @@ }); }); - const hide = () => { - const iframe = document.getElementById('problem_render_iframe'); - if (iframe && iframe.iFrameResizer) iframe.iFrameResizer.close(); - }; - // Set up the render button. - document.getElementById('problem_render_btn')?.addEventListener('click', () => { - const btn = document.getElementById('problem_render_btn'); - if (btn.innerHTML == 'Render Problem') { - btn.innerHTML = 'Hide Problem'; - render(); + const btn = document.getElementById('problem_render_btn'); + btn?.addEventListener('click', () => { + const iframe = document.getElementById('problem_render_iframe'); + if (iframe && iframe.iFrameResizer) { + iframe.iFrameResizer.close(); + renderArea.innerHTML = ''; + btn.textContent = btn.dataset.renderText; + } else if (/\S/.test(renderArea.innerHTML)) { + renderArea.innerHTML = ''; + btn.textContent = btn.dataset.renderText; } else { - btn.innerHTML = 'Render Problem'; - hide(); + btn.textContent = btn.dataset.hideText; + renderArea.innerHTML = '
      Loading Please Wait...
      '; + render(); } }); diff --git a/htdocs/js/apps/UserList/userlist.js b/htdocs/js/apps/UserList/userlist.js index 89cd65cc41..7df3990cb3 100644 --- a/htdocs/js/apps/UserList/userlist.js +++ b/htdocs/js/apps/UserList/userlist.js @@ -25,4 +25,30 @@ export_select_target.addEventListener('change', classlist_add_export_elements); classlist_add_export_elements(); } + + // Submit the user list form when a sort header is clicked or enter or space is pressed when it has focus. + const userListForm = document.forms['userlist']; + const currentAction = document.getElementById('current_action'); + + if (userListForm && currentAction) { + for (const header of document.querySelectorAll('.sort-header')) { + const submitSortMethod = (e) => { + e.preventDefault(); + + currentAction.value = ''; + + const sortInput = document.createElement('input'); + sortInput.name = 'labelSortMethod'; + sortInput.value = header.dataset.sortField; + userListForm.append(sortInput); + + userListForm.submit(); + }; + + header.addEventListener('click', submitSortMethod); + header.addEventListener('keydown', (e) => { + if (e.key === ' ' || e.key === 'Enter') submitSortMethod(e); + }); + } + } })(); diff --git a/htdocs/themes/layouts b/htdocs/themes/layouts new file mode 120000 index 0000000000..945c9b46d6 --- /dev/null +++ b/htdocs/themes/layouts @@ -0,0 +1 @@ +. \ No newline at end of file diff --git a/htdocs/themes/math4-green/gateway.template b/htdocs/themes/math4-green/gateway.template deleted file mode 120000 index be20bd0efd..0000000000 --- a/htdocs/themes/math4-green/gateway.template +++ /dev/null @@ -1 +0,0 @@ -../math4/gateway.template \ No newline at end of file diff --git a/htdocs/themes/math4-green/system.html.ep b/htdocs/themes/math4-green/system.html.ep new file mode 120000 index 0000000000..f7a74c7169 --- /dev/null +++ b/htdocs/themes/math4-green/system.html.ep @@ -0,0 +1 @@ +../math4/system.html.ep \ No newline at end of file diff --git a/htdocs/themes/math4-green/system.template b/htdocs/themes/math4-green/system.template deleted file mode 120000 index 27c5fd2222..0000000000 --- a/htdocs/themes/math4-green/system.template +++ /dev/null @@ -1 +0,0 @@ -../math4/system.template \ No newline at end of file diff --git a/htdocs/themes/math4-red/gateway.template b/htdocs/themes/math4-red/gateway.template deleted file mode 120000 index be20bd0efd..0000000000 --- a/htdocs/themes/math4-red/gateway.template +++ /dev/null @@ -1 +0,0 @@ -../math4/gateway.template \ No newline at end of file diff --git a/htdocs/themes/math4-red/system.html.ep b/htdocs/themes/math4-red/system.html.ep new file mode 120000 index 0000000000..f7a74c7169 --- /dev/null +++ b/htdocs/themes/math4-red/system.html.ep @@ -0,0 +1 @@ +../math4/system.html.ep \ No newline at end of file diff --git a/htdocs/themes/math4-red/system.template b/htdocs/themes/math4-red/system.template deleted file mode 120000 index 27c5fd2222..0000000000 --- a/htdocs/themes/math4-red/system.template +++ /dev/null @@ -1 +0,0 @@ -../math4/system.template \ No newline at end of file diff --git a/htdocs/themes/math4-yellow/gateway.template b/htdocs/themes/math4-yellow/gateway.template deleted file mode 120000 index be20bd0efd..0000000000 --- a/htdocs/themes/math4-yellow/gateway.template +++ /dev/null @@ -1 +0,0 @@ -../math4/gateway.template \ No newline at end of file diff --git a/htdocs/themes/math4-yellow/system.html.ep b/htdocs/themes/math4-yellow/system.html.ep new file mode 120000 index 0000000000..f7a74c7169 --- /dev/null +++ b/htdocs/themes/math4-yellow/system.html.ep @@ -0,0 +1 @@ +../math4/system.html.ep \ No newline at end of file diff --git a/htdocs/themes/math4-yellow/system.template b/htdocs/themes/math4-yellow/system.template deleted file mode 120000 index 27c5fd2222..0000000000 --- a/htdocs/themes/math4-yellow/system.template +++ /dev/null @@ -1 +0,0 @@ -../math4/system.template \ No newline at end of file diff --git a/htdocs/themes/math4/gateway.scss b/htdocs/themes/math4/gateway.scss index 470f841682..da527bc6ce 100644 --- a/htdocs/themes/math4/gateway.scss +++ b/htdocs/themes/math4/gateway.scss @@ -22,10 +22,6 @@ div.gwMessage { border-radius: 3px; } -.Message { - display: block; -} - #gwTimer { position: sticky; width: 15em; diff --git a/htdocs/themes/math4/gateway.template b/htdocs/themes/math4/gateway.template deleted file mode 100644 index 642f98a28c..0000000000 --- a/htdocs/themes/math4/gateway.template +++ /dev/null @@ -1,127 +0,0 @@ - -> - - - - - - - -"/> -"/> -"/> -"/> -"/> - -"/> - -"/> - -"/> - - - - - - - - - - - - - - - - -<!--#path style="text" text=" : " textonly="1"--> - - - - -Skip to main content - -
      - -
      - - -
      - -
      -
      - - - - -
      -
      - - - - - - - - - -

      - - - -
      - - - -
      > - -
      - - - -
      - -
      - -
      -
      -
      - - - - - - - - diff --git a/htdocs/themes/math4/math4.js b/htdocs/themes/math4/math4.js index 4084d87d9e..46ba494183 100644 --- a/htdocs/themes/math4/math4.js +++ b/htdocs/themes/math4/math4.js @@ -65,31 +65,6 @@ () => window.open(helpLink.href, helpLink.target, 'width=550,height=350,scrollbars=yes,resizable=yes')) ); - // Focus on an alert-danger element if one is around and focusable. - Array.from(document.querySelectorAll('.alert-danger')).shift()?.focus(); - - // ComboBox (see lib/WeBWorK/HTML/ComboBox.pm) - // This changes the textbox text to the currently selected option in the select menu. - document.querySelectorAll('.combo-box').forEach((comboBox) => { - const comboBoxText = comboBox.querySelector('.combo-box-text'); - const comboBoxSelect = comboBox.querySelector('.combo-box-select'); - - if (!comboBoxText || !comboBoxSelect) return; - - // Try to select best option in select menu as user types in the textbox. - comboBoxText.addEventListener('keyup', () => { - let i = 0; - for (; - i < comboBoxSelect.options.length && comboBoxSelect.options[i].value.indexOf(comboBoxText.value) != 0; - ++i) {} - comboBoxSelect.selectedIndex = i; - }); - - // Set the textbox text to be same as that of select menu - comboBoxSelect.addEventListener('change', - () => comboBoxText.value = comboBoxSelect.options[comboBoxSelect.selectedIndex].value); - }); - // Turn help boxes into popovers document.querySelectorAll('.help-popup').forEach((popover) => { new bootstrap.Popover(popover, {trigger: 'hover focus'}); diff --git a/htdocs/themes/math4/math4.scss b/htdocs/themes/math4/math4.scss index fb3157d4d4..bfa922b413 100644 --- a/htdocs/themes/math4/math4.scss +++ b/htdocs/themes/math4/math4.scss @@ -121,7 +121,7 @@ table caption { } } -#loginstatus { +#login-status { padding: 5px 5px 5px 0; color: var(--ww-primary-foreground-color, white); text-align: right; @@ -375,6 +375,7 @@ h2.page-title { } .problem-sub-header { + margin-top: 0.25rem; font-weight: bold; font-size: 14px; line-height: 1.4; @@ -387,6 +388,15 @@ h2.page-title { } } +.error-output { + word-wrap: break-word; + color: #d63384; + font-size: 0.875rem; + direction: ltr; + font-family: monospace; + font-size: 9pt; +} + /* Question nav section */ .sticky-nav { display: flex; @@ -420,7 +430,7 @@ h2.page-title { } /* Message section */ -.Message:not(:empty) { +.message:not(:empty) { display: inline-block; margin-bottom: 0.5rem; } @@ -609,6 +619,15 @@ ul.courses-list { #library_sets { max-width: 50% } + + .browse-lib-btn, + .library-action-btn { + width: 9.3rem; + } + + .library-panel-btn { + max-width: 9rem; + } } .lb-problem-row div.card { @@ -937,6 +956,11 @@ span { border-radius: 3px; } } + + .problem-score, + .answer-part-score { + width: 5.5rem; + } } /* Equation editor bugfixes */ diff --git a/htdocs/themes/math4/system.html.ep b/htdocs/themes/math4/system.html.ep new file mode 100644 index 0000000000..c7e546326b --- /dev/null +++ b/htdocs/themes/math4/system.html.ep @@ -0,0 +1,166 @@ + +output_course_lang_and_dir %>> + + + +% +% ################################################################################ +% # WeBWorK Online Homework Delivery System +% # Copyright © 2000-2022 The WeBWorK Project, https://github.com/openwebwork +% # +% # This program is free software; you can redistribute it and/or modify it under +% # the terms of either: (a) the GNU General Public License as published by the +% # Free Software Foundation; either version 2, or (at your option) any later +% # version, or (b) the "Artistic License" which comes with this package. +% # +% # This program is distributed in the hope that it will be useful, but WITHOUT +% # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +% # FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the +% # Artistic License for more details. +% ################################################################################ +% + +% +% # CSS Loads +<%= stylesheet $cg->url({ type => 'webwork', name => 'theme', file => 'bootstrap.css' }) =%> +<%= stylesheet $cg->url({ + type => 'webwork', name => 'htdocs', + file => 'node_modules/@fortawesome/fontawesome-free/css/all.min.css' +}) =%> +<%= stylesheet $cg->url({ type => 'webwork', name => 'theme', file => 'math4.css' }) =%> +<%= content 'css' =%> +% if ($cg->exists_theme_file('math4-overrides.css')) { + <%= stylesheet $cg->url({ type => 'webwork', name => 'theme', file => 'math4-overrides.css' }) =%> +% } +% +% # Webwork configuration for javascript + +% +% # JS Loads +<%= javascript $cg->url({ type => 'webwork', name => 'htdocs', file => 'js/apps/MathJaxConfig/mathjax-config.js' }), + defer => undef =%> +<%= javascript $cg->url({ type => 'webwork', name => 'htdocs', file => 'node_modules/mathjax/es5/tex-svg.js' }), + id => 'MathJax-script', defer => undef =%> +<%= javascript $cg->url({ type => 'webwork', name => 'htdocs', file => 'node_modules/jquery/dist/jquery.min.js' }) %> +<%= javascript $cg->url({ + type => 'webwork', name => 'htdocs', + file => 'node_modules/bootstrap/dist/js/bootstrap.bundle.min.js' + }), defer => undef =%> +<%= javascript $cg->url({ type => 'webwork', name => 'theme', file => 'math4.js' }), defer => undef =%> +<%= content 'js' =%> +% if ($cg->exists_theme_file('math4-overrides.js')) { + <%= javascript $cg->url({ type => 'webwork', name => 'theme', file => 'math4-overrides.js' }), defer => undef =%> +% } +% +% if ($cg->can('head')) { + <%== $cg->head =%> +% } +% +<%= $cg->path({ style => 'text', text => ' : ', textonly => '1' }) %> + +% + +<%= link_to 'Skip to main content' => '#page-title', id => 'stmc-link', class => 'sr-only sr-only-focusable' =%> +% +
      + % # Header + + % # Breadcrumb + +
      + % # Navigation + % if ($cg->can('links') || $cg->can('siblings') || $cg->can('options')) { + + % } + % + % # Main Content Area +
      + % + % # Navigation, e.g.: Prev, Up, Next for homeworks + % if ($cg->can('nav')) { + <%= $cg->nav({ style => 'buttons', separator => '' }) =%> + % } + % + % # Page Title + % if ($cg->can('title')) { +
      +
      +

      <%== $cg->title %>

      +
      +
      + % } + % + % # Message for the user + % if ($cg->can('message')) { +
      <%= $cg->message %>
      + % } + % + % # Indicate presence of perl warnings + % if ($cg->have_warnings) { +
      +
      <%== $cg->warningMessage %>
      +
      + % } + % + % # Display the page body. +
      +
      + <%= content =%> +
      + % if ($cg->can('info')) { +
      +
      + <%= $cg->info =%> +
      +
      + % } +
      + % + % if ($cg->have_warnings) { +
      <%= $cg->warnings %>
      + % } + % if ($cg->can('message')) { +
      <%= $cg->message %>
      + % } +
      +
      +
      +% +% # Footer + +% + + diff --git a/htdocs/themes/math4/system.template b/htdocs/themes/math4/system.template deleted file mode 100644 index e8acd2e28d..0000000000 --- a/htdocs/themes/math4/system.template +++ /dev/null @@ -1,322 +0,0 @@ - -> - - - - - - - -"/> - - -"/> -"/> -"/> - -"/> - - - - - -"/> - - - - - - - - - - - - - - - - - - -<!--#path style="text" text=" : " textonly="1"--> - - - - - -Skip to main content - - -
      - - - - - - -
      - - - - - - - - -
      - -
      - - - - - - - - -
      -

      -
      - - - - -
      - - - - - - - - - - - -
      -
      - -
      -
      - - - -
      -
      - -
      -
      - - - -
      -
      - - -
      - -
      - - -
      - -
      - - - -
      - -
      - - - -
      - -
      - - - -
      - -
      - - - -
      -
      - - - - - - -
      - -
      > - -
      - - - - - - - -
      - - - -
      - - - -
      -
      - - - -
      - - -
      - -
      - - - - - - - - - - - -

      Form2

      - -
      - -
      - - -
      -
      - - - - -
      - -
      - -
      - - -
      - - -
      -
      - - -
      -
      - -
      - - - - -
      - - - - - - -
      - - - -
      - -
      - - -
      - -
      - - -
      - - -
      -
      - - - - - - diff --git a/lib/FormatRenderedProblem.pm b/lib/FormatRenderedProblem.pm index c5a5f01489..011150fd83 100644 --- a/lib/FormatRenderedProblem.pm +++ b/lib/FormatRenderedProblem.pm @@ -29,7 +29,7 @@ use Digest::SHA qw(sha1_base64); use Mojo::Util qw(xml_escape); use Mojo::DOM; -use WeBWorK::Utils::AttemptsTable; +use WeBWorK::HTML::AttemptsTable; use WeBWorK::Utils qw(getAssetURL); use WeBWorK::Utils::LanguageAndDirection; @@ -158,8 +158,8 @@ sub formatRenderedProblem { # Do not produce an AttemptsTable when we had a rendering error. if (!$renderErrorOccurred) { - my $tbl = WeBWorK::Utils::AttemptsTable->new( - $rh_result->{answers} // {}, + my $tbl = WeBWorK::HTML::AttemptsTable->new( + $rh_result->{answers} // {}, $ws->r, answersSubmitted => $ws->{inputs_ref}{answersSubmitted} // 0, answerOrder => $rh_result->{flags}{ANSWER_ENTRY_ORDER} // [], displayMode => $displayMode, @@ -230,14 +230,13 @@ sub formatRenderedProblem { $output->{ww_version} = $ce->{WW_VERSION}; $output->{pg_version} = $ce->{PG_VERSION}; - # Convert to JSON - return JSON->new->utf8(0)->encode($output); + # Convert to JSON and render. + $ws->r->render(data => JSON->new->utf8(0)->encode($output)); } - # Render the appropriate template in the templates/RPCRenderFormats folder depending on the outputformat. + # Setup arnd render the appropriate template in the templates/RPCRenderFormats folder depending on the outputformat. # "ptx" has a special template. "json" uses the default json template. All others use the default html template. - # Note that render_to_string returns a Mojo::ByteStream object which must be stringified with to_string. - my $template = $ws->r->render_to_string( + my %template_params = ( template => $formatName eq 'ptx' ? 'RPCRenderFormats/ptx' : 'RPCRenderFormats/default', $formatName eq 'json' ? (format => 'json') : (), formatName => $formatName, @@ -282,10 +281,11 @@ sub formatRenderedProblem { showCorrectAnswersButton => $ws->{inputs_ref}{showCorrectAnswersButton} // '', showFooter => $ws->{inputs_ref}{showFooter} // '', pretty_print => \&pretty_print - )->to_string; + ); - return $template if $formatName eq 'json' || !$ws->{inputs_ref}{send_pg_flags}; - return JSON->new->utf8(0)->encode({ html => $template, pg_flags => $rh_result->{flags} }); + return $ws->r->render(%template_params) if $formatName eq 'json' || !$ws->{inputs_ref}{send_pg_flags}; + return $ws->r->render( + json => { html => $ws->r->render_to_string(%template_params), pg_flags => $rh_result->{flags} }); } sub saveGradeToLTI { diff --git a/lib/Mojolicious/WeBWorK.pm b/lib/Mojolicious/WeBWorK.pm index 35b7f4f46a..45ad8f3817 100644 --- a/lib/Mojolicious/WeBWorK.pm +++ b/lib/Mojolicious/WeBWorK.pm @@ -21,7 +21,7 @@ Mojolicious::WeBWorK - Mojolicious app for WeBWorK 2. =cut -use Mojo::Base 'Mojolicious', -signatures, -async_await; +use Mojo::Base 'Mojolicious', -signatures; use Env qw(WEBWORK_SERVER_ADMIN); use WeBWorK; @@ -61,6 +61,14 @@ sub startup ($app) { "webwork_server_admin_email for reporting bugs has been set to $WEBWORK_SERVER_ADMIN in site.conf"); } + # Make the htdocs directory the first place to search for static files. At this point this is only used by the + # exception templates, but it could be used to improve the getAssetURL method together with the Mojolicious + # url_for_asset controller method. + unshift(@{ $app->static->paths }, $webwork_htdocs_dir); + + # Add the themes directory to the template search paths. + push(@{ $app->renderer->paths }, $ce->{webworkDirs}{themes}); + # Helpers # This replaces the previous Apache2::RequestUtil method that was overriden in the WeBWorK::Request module to return @@ -70,6 +78,14 @@ sub startup ($app) { $app->helper(server_root_url => sub ($) { return $server_root_url; }); $app->helper(webwork_url => sub ($) { return $webwork_url; }); + $app->helper( + maketext => sub ($c, @args) { + return $c->language_handle->(@args); + # Comment out the above line and uncomment below to check that your strings are run through maketext. + #return 'xXx' . $c->language_handle->(@args) . 'xXx'; + } + ); + # Add a hook to add extra headers if set in the config file. if (ref $config->{extra_headers} eq 'HASH') { $app->hook( diff --git a/lib/Mojolicious/WeBWorK/Controller/Handler.pm b/lib/Mojolicious/WeBWorK/Controller/Handler.pm index 8031cccc9d..0767b77293 100644 --- a/lib/Mojolicious/WeBWorK/Controller/Handler.pm +++ b/lib/Mojolicious/WeBWorK/Controller/Handler.pm @@ -22,275 +22,52 @@ requests to the main WeBWorK dispatcher. =cut -use Mojo::Base 'Mojolicious::Controller', -signatures, -async_await; -use HTML::Entities; -use HTML::Scrubber; -use Date::Format; +use Mojo::Base 'WeBWorK::Request', -signatures, -async_await; use JSON::MaybeXS; -use UUID::Tiny ':std'; async sub handler ($c) { my $uri = $c->req->url->path->to_string; - my $output = ''; $c->stash->{warnings} = ''; - my @backtrace; - - my $log = $c->log; my $tx = $c->render_later->tx; - my $result = 0; - - # These can not be defined "local" below or Future::AsyncAwait will panic. - # Instead save them and restore them later. + # This can not be defined "local" below or Future::AsyncAwait will panic. + # Instead save the warning handler and restore it later. my $origWarn = $SIG{__WARN__}; - my $origDie = $SIG{__DIE__}; - - eval { - $SIG{__WARN__} = sub { - my ($warning) = @_; - chomp $warning; - $c->stash->{warnings} .= "$warning\n"; - $log->warn("[$uri] $warning"); - }; - - $SIG{__DIE__} = sub { - @backtrace = backtrace(); - die @_; - }; - - # Redirect standard output to $output. - open my $output_handle, '>>:encoding(UTF-8)', \$output or die 'Unable to open output handle'; - my $orig_output_handle = select $output_handle; - - $result = await WeBWorK::dispatch($c); - close $output_handle; - select $orig_output_handle; + $SIG{__WARN__} = sub { + my ($warning) = @_; + chomp $warning; + $c->stash->{warnings} .= "$warning\n"; + $c->log->warn("[$uri] $warning"); }; - $SIG{__WARN__} = $origWarn; - $SIG{__DIE__} = $origDie; - - if ($@) { - my $exception = $@; - - my $htmlMessage; - my $uuid = create_uuid_as_string(UUID_SHA1, UUID_NS_URL, $uri) . "::" . create_uuid_as_string(UUID_TIME); - my $time = time2str('%a %b %d %H:%M:%S %Y', time); - - if ($c->config('MIN_HTML_ERRORS')) { - $htmlMessage = htmlMinMessage($c, $exception, $uuid, $time); - } else { - $htmlMessage = htmlMessage($c, $c->stash->{warnings}, $exception, $uuid, $time, @backtrace); - } - - # Log the error to the Mojolicious error log - my $logMessage = ''; - if ($c->config('JSON_ERROR_LOG')) { - $logMessage = jsonMessage($c, $c->stash->{warnings}, $exception, $uuid, $time, @backtrace); - } else { - $logMessage = textMessage($c, $c->stash->{warnings}, $exception, $uuid, $time, @backtrace); - } - $c->log->error($logMessage); - - $c->res->headers->content_type('text/html; charset=utf-8') unless $c->res->headers->content_type; - $output = '' - . qq{WeBWorK error$htmlMessage}; - $result = 403; - } - - return if $c->res->code && $c->res->code == 200; - $c->res->body($output) unless $c->res->code; - return $c->rendered($c->res->is_redirect ? 302 : ($result || 200)); -} - -=head1 ERROR HANDLING ROUTINES - -=over - -=item backtrace() - -Produce a stack-frame traceback for the calls up through the ones in -Mojolicious::WeBWorK. - -=cut - -sub backtrace { - my $frame = 2; - my @trace; + await WeBWorK::dispatch($c); - while (my ($pkg, $file, $line, $subname) = caller($frame++)) { - last if $pkg eq 'Mojolicious::WeBWorK::Controller::Handler'; - push @trace, "in $subname called at line $line of $file"; - } + $SIG{__WARN__} = $origWarn; - return @trace; + return; } -=back - =head1 ERROR OUTPUT FUNCTIONS =over -=item htmlMessage($c, $warnings, $exception, $uuid, $time, @backtrace) +=item textMessage($c, $exception, $uuid, $time) -Format a message for HTML output reporting an exception, backtrace, and any +Format a message for HTML output reporting an exception and any associated warnings. =cut -sub htmlMessage ($c, $warnings, $exception, $uuid, $time, @backtrace) { - # Warnings and exceptions have html and look better scrubbed. - my $scrubber = HTML::Scrubber->new(default => 1, script => 0, comment => 0); - $scrubber->default(undef, { '*' => 1 }); - - $warnings = $scrubber->scrub($warnings); - $exception = $scrubber->scrub($exception); - - my @warnings = defined $warnings ? split m|
      |, $warnings : (); # fragile - $warnings = htmlWarningsList(@warnings); - my $backtrace = htmlBacktrace(@backtrace); - - # $ENV{WEBWORK_SERVER_ADMIN} is set from $webwork_server_admin_email in site.conf. - $ENV{WEBWORK_SERVER_ADMIN} = $ENV{WEBWORK_SERVER_ADMIN} // ''; - - my $admin = - $ENV{WEBWORK_SERVER_ADMIN} - ? qq{($ENV{WEBWORK_SERVER_ADMIN})} - : ''; - my $method = htmlEscape($c->req->method); - my $uri = htmlEscape($c->req->url->to_abs->to_string); - my $headers = do { - my %headers = %{ $c->req->headers->to_hash }; - if (defined($headers{'sec-ch-ua'})) { - # Was getting warnings about the value of 'sec-ch-ua' in my testing... - $headers{'sec-ch-ua'} = join('', $headers{'sec-ch-ua'}); - $headers{'sec-ch-ua'} =~ s/\"//g; - } - - join( - '', - qq{KeyValue}, - map { - qq{} - . htmlEscape($_) - . qq{} - . htmlEscape($headers{$_}) - . '' - } keys %headers - ); - }; - - return < -
      -

      WeBWorK error

      -

      An error occured while processing your request.

      -

      - For help, please send mail to this site's webmaster $admin, including all of the following - information as well as what what you were doing when the error occured. -

      -

      Error record identifier

      -

      $uuid

      -

      Warning messages

      -
        $warnings
      -

      Error messages

      -

      $exception

      -

      Call stack

      -

      The following information can help locate the source of the problem.

      -
        $backtrace
      -

      Request information

      -
      -

      The HTTP request information is included in the following table.

      -
      - - - - - - - - - -
      HTTP request information
      ItemData
      Method$method
      URI$uri
      HTTP Headers - - - $headers -
      HTTP request headers
      -
      -
      -
      -

      Time generated:

      -

      $time

      -
      - -EOF -} - -=item htmlMinMessage($c, $exception, $uuid, $time) - -Format a minimal message for HTML output reporting an error ID number, and NOT providing much -additional data, which will instead be in the log files. - -=cut - -sub htmlMinMessage ($c, $exception, $uuid, $time) { - # Exceptions have html and look better scrubbed. - my $scrubber = HTML::Scrubber->new(default => 1, script => 0, comment => 0); - $scrubber->default(undef, { '*' => 1 }); - - $exception = $scrubber->scrub($exception); - - # Drop any code reference from the error message - $exception =~ s/ at \/.*//; +sub textMessage ($c, $uuid, $time) { + my $uri = $c->req->url->to_abs->to_string; - # $ENV{WEBWORK_SERVER_ADMIN} is set from $webwork_server_admin_email in site.conf. - $ENV{WEBWORK_SERVER_ADMIN} = $ENV{WEBWORK_SERVER_ADMIN} // ''; - - my $admin = - $ENV{WEBWORK_SERVER_ADMIN} - ? qq{($ENV{WEBWORK_SERVER_ADMIN})} - : ''; - - return < -
      -

      WeBWorK error

      -

      An error occured while processing your request.

      -

      - For help, please send mail to this site's webmaster $admin, including all of the following - information as well as what what you were doing when the error occured. -

      -

      Error record identifier

      -

      $uuid

      -

      Error messages

      -

      $exception

      -

      Time generated:

      -

      $time

      -
      - -EOF -} - -=item textMessage($c, $warnings, $exception, $uuid, $time, @backtrace) - -Format a message for HTML output reporting an exception, backtrace, and any -associated warnings. - -=cut - -sub textMessage ($c, $warnings, $exception, $uuid, $time, @backtrace) { - chomp $exception; - my $backtrace = textBacktrace(@backtrace); - my $uri = $c->req->url->to_abs->to_string; - - my @warnings = defined $warnings ? split m/\n+/, $warnings : (); + my $exception = $c->stash->{exception} // ''; my %headers = %{ $c->req->headers->to_hash }; - # Was getting JSON errors for the value of 'sec-ch-ua' in my testing, so remove it + # Avoid JSON errors for the value of 'sec-ch-ua'. if (defined($headers{'sec-ch-ua'})) { $headers{'sec-ch-ua'} = join('', $headers{'sec-ch-ua'}); $headers{'sec-ch-ua'} =~ s/\"//g; @@ -302,25 +79,22 @@ sub textMessage ($c, $warnings, $exception, $uuid, $time, @backtrace) { Method => $c->req->method, URI => $uri, 'HTTP Headers' => {%headers}, - Warnings => [@warnings], + Warnings => [ defined $c->stash->{warnings} ? split m/\n+/, $c->stash->{warnings} : () ], }); - return "[$uuid] [$uri] $additional_json $exception\n$backtrace"; + return "[$uuid] [$uri] $additional_json $exception"; } -=item jsonMessage($c, $warnings, $exception, $uuid, $time, @backtrace) +=item jsonMessage($c, $uuid, $time) -Format a JSON message for log output reporting an exception, backtrace, and any +Format a JSON message for log output reporting an exception and any associated warnings. =cut -sub jsonMessage ($c, $warnings, $exception, $uuid, $time, @backtrace) { - chomp $exception; - my @warnings = defined $warnings ? split m/\n+/, $warnings : (); - +sub jsonMessage ($c, $uuid, $time) { my %headers = %{ $c->req->headers->to_hash }; - # Was getting JSON errors for the value of 'sec-ch-ua' in my testing, so remove it + # Avoid JSON errors for the value of 'sec-ch-ua'. if (defined($headers{'sec-ch-ua'})) { $headers{'sec-ch-ua'} = join('', $headers{'sec-ch-ua'}); $headers{'sec-ch-ua'} =~ s/\"//g; @@ -332,76 +106,11 @@ sub jsonMessage ($c, $warnings, $exception, $uuid, $time, @backtrace) { Method => $c->req->method, URI => $c->req->url->to_abs->to_string, 'HTTP Headers' => {%headers}, - Warnings => [@warnings], - Exception => $exception, - Backtrace => [@backtrace], + Warnings => [ defined $c->stash->{warnings} ? split m/\n+/, $c->stash->{warnings} : () ], + Exception => $c->stash->{exception} ? $c->stash->{exception}->to_string : '' }); } -=item htmlBacktrace(@frames) - -Formats a list of stack frames in a backtrace as list items for HTML output. - -=cut - -sub htmlBacktrace (@frames) { - for my $frame (@frames) { - $frame = htmlEscape($frame); - $frame = "
    • $frame
      • "; - } - return join '', @frames; -} - -=item textBacktrace(@frames) - -Formats a list of stack frames in a backtrace as list items for text output. - -=cut - -sub textBacktrace (@frames) { - for my $frame (@frames) { - $frame = " * $frame"; - } - return join "\n", @frames; -} - -=item htmlWarningsList(@warnings) - -Formats a list of warning strings as list items for HTML output. - -=cut - -sub htmlWarningsList (@warnings) { - for my $warning (@warnings) { - $warning = "
    • $warning
      • "; - } - return join '', @warnings; -} - -=item textWarningsList(@warnings) - -Formats a list of warning strings as list items for text output. - -=cut - -sub textWarningsList (@warnings) { - for my $warning (@warnings) { - $warning = " * $warning"; - } - return join "\n", @warnings; -} - -=item htmlEscape($string) - -Protect characters that would be interpreted as HTML entities. Then, replace -line breaks with HTML "
      " tags. - -=cut - -sub htmlEscape ($string) { - return encode_entities($string // '') =~ s|\n|
      |gr; -} - =back =cut diff --git a/lib/WeBWorK.pm b/lib/WeBWorK.pm index f32be3ddd8..77f7ce4f84 100644 --- a/lib/WeBWorK.pm +++ b/lib/WeBWorK.pm @@ -37,7 +37,6 @@ use warnings; use Time::HiRes qw/time/; use HTML::Entities qw/encode_entities/; - use Future::AsyncAwait; use WeBWorK::Localize; @@ -53,7 +52,6 @@ use WeBWorK::Debug; use WeBWorK::Request; use WeBWorK::Upload; use WeBWorK::URLPath; -use WeBWorK::CGI; use WeBWorK::Utils qw(runtime_use writeTimingLogEntry); use constant LOGIN_MODULE => "WeBWorK::ContentGenerator::Login"; @@ -76,8 +74,8 @@ BEGIN { our %SeedCE; async sub dispatch { - my $controller = shift; - my $r = WeBWorK::Request->new($controller); + my $r = shift; + $r->submitTime(time); # this is Time::HiRes's time, which gives floating point values my $method = $r->req->method; @@ -258,55 +256,58 @@ async sub dispatch { debug("(here's the DB handle: $db)\n"); $r->db($db); - my $authenOK = $authen->verify; - if ($authenOK) { - my $userID = $r->param("user"); - debug("Hi, $userID, glad you made it.\n"); - - # tell authorizer to cache this user's permission level - $authz->setCachedUser($userID); - - debug("Now we deal with the effective user:\n"); - my $eUserID = $r->param("effectiveUser") || $userID; - debug("userID=$userID eUserID=$eUserID\n"); - if ($userID ne $eUserID) { - debug("userID and eUserID differ... seeing if userID has 'become_student' permission.\n"); - my $su_authorized = $authz->hasPermissions($userID, "become_student"); - if ($su_authorized) { - debug("Ok, looks like you're allowed to become $eUserID. Whoopie!\n"); - } else { - debug("Uh oh, you're not allowed to become $eUserID. Nice try!\n"); - die "You do not have permission to act as another user. + # Don't check authentication if the user is logging out. + if ($displayModule ne 'WeBWorK::ContentGenerator::Logout') { + my $authenOK = $authen->verify; + if ($authenOK) { + my $userID = $r->param("user"); + debug("Hi, $userID, glad you made it.\n"); + + # tell authorizer to cache this user's permission level + $authz->setCachedUser($userID); + + debug("Now we deal with the effective user:\n"); + my $eUserID = $r->param("effectiveUser") || $userID; + debug("userID=$userID eUserID=$eUserID\n"); + if ($userID ne $eUserID) { + debug("userID and eUserID differ... seeing if userID has 'become_student' permission.\n"); + my $su_authorized = $authz->hasPermissions($userID, "become_student"); + if ($su_authorized) { + debug("Ok, looks like you're allowed to become $eUserID. Whoopie!\n"); + } else { + debug("Uh oh, you're not allowed to become $eUserID. Nice try!\n"); + die "You do not have permission to act as another user. Close down your browser (this clears temporary cookies), restart and try again.\n"; + } } - } - # set effectiveUser in case it was changed or not set to begin with - $r->param("effectiveUser" => $eUserID); - - # if we're doing a proctored test, after the user has been authenticated - # we need to also check on the proctor. note that in the gateway quiz - # module we double check this, to be sure that someone isn't taking a - # proctored quiz but calling the unproctored ContentGenerator - my $urlProducedPath = $urlPath->path(); - if ($urlProducedPath =~ /proctored_test_mode/i) { - my $proctor_authen_module = WeBWorK::Authen::class($ce, "proctor_module"); - runtime_use $proctor_authen_module; - my $authenProctor = $proctor_authen_module->new($r); - debug("Using proctor_authen_module $proctor_authen_module: $authenProctor\n"); - my $procAuthOK = $authenProctor->verify(); - - if (not $procAuthOK) { - $displayModule = PROCTOR_LOGIN_MODULE; + # set effectiveUser in case it was changed or not set to begin with + $r->param("effectiveUser" => $eUserID); + + # if we're doing a proctored test, after the user has been authenticated + # we need to also check on the proctor. note that in the gateway quiz + # module we double check this, to be sure that someone isn't taking a + # proctored quiz but calling the unproctored ContentGenerator + my $urlProducedPath = $urlPath->path(); + if ($urlProducedPath =~ /proctored_test_mode/i) { + my $proctor_authen_module = WeBWorK::Authen::class($ce, "proctor_module"); + runtime_use $proctor_authen_module; + my $authenProctor = $proctor_authen_module->new($r); + debug("Using proctor_authen_module $proctor_authen_module: $authenProctor\n"); + my $procAuthOK = $authenProctor->verify(); + + if (not $procAuthOK) { + $displayModule = PROCTOR_LOGIN_MODULE; + } } + } else { + debug("Bad news: authentication failed!\n"); + # For a remote procedure call continue on to the original display module. + # It will give the authentication failure response. + $displayModule = LOGIN_MODULE if !$r->{rpc}; + debug("set displayModule to $displayModule\n"); } - } else { - debug("Bad news: authentication failed!\n"); - # For a remote procedure call continue on to the original display module. - # It will give the authentication failure response. - $displayModule = LOGIN_MODULE if !$r->{rpc}; - debug("set displayModule to $displayModule\n"); } } diff --git a/lib/WeBWorK/AchievementEvaluator.pm b/lib/WeBWorK/AchievementEvaluator.pm index 8929e163e6..c26fb831d3 100644 --- a/lib/WeBWorK/AchievementEvaluator.pm +++ b/lib/WeBWorK/AchievementEvaluator.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::AchievementEvaluator; -use base qw(WeBWorK); +use parent qw(Exporter); =head1 NAME @@ -24,33 +24,28 @@ use base qw(WeBWorK); use strict; use warnings; -use WeBWorK::CGI; -use WeBWorK::Utils qw(before after readFile sortAchievements nfreeze_base64 thaw_base64); -use WeBWorK::Utils::Tags; + use DateTime; +use WeBWorK::Utils qw(sortAchievements nfreeze_base64 thaw_base64); +use WeBWorK::Utils::Tags; use WWSafe; -sub checkForAchievements { +our @EXPORT_OK = qw(checkForAchievements); - our $problem = shift; - my $pg = shift; - my $r = shift; - my %options = @_; - my $db = $r->db; - my $ce = $r->ce; - - my $course_display_tz = $ce->{siteDefaults}{timezone}; - # the following line from Utils.pm - $course_display_tz ||= "local"; # do our best to provide default vaules +sub checkForAchievements { + my ($problem_in, $pg, $r, %options) = @_; + our $problem = $problem_in; + my $db = $r->db; + my $ce = $r->ce; # Date and time for course timezone (may differ from the server timezone) # Saved into separate array # https://metacpan.org/pod/DateTime - my $dtCourseTime = DateTime->from_epoch(epoch => time(), time_zone => $course_display_tz); + my $dtCourseTime = DateTime->from_epoch(epoch => time(), time_zone => $ce->{siteDefaults}{timezone} || 'local'); - #set up variables and get achievements - my $cheevoMessage = ''; + # Set up variables and get achievements + my $cheevoMessage = $r->c; my $user_id = $problem->user_id; my $set_id = $problem->set_id; @@ -98,7 +93,7 @@ sub checkForAchievements { $dtCourseTime->month, $dtCourseTime->year, $dtCourseTime->day_of_week ); - my $compartment = new WWSafe; + my $compartment = WWSafe->new; #initialize things that are "" if (not $achievementPoints) { @@ -170,7 +165,7 @@ sub checkForAchievements { if ($isGatewaySet) { $problem = undef; } else { - my $templateDir = $ce->{courseDirs}->{templates}; + my $templateDir = $ce->{courseDirs}{templates}; $tags = WeBWorK::Utils::Tags->new($templateDir . '/' . $problem->source_file()); } @@ -193,14 +188,13 @@ sub checkForAchievements { $globalData $counter $nextLevelPoints $set $achievementPoints $tags @courseDateTime)); #load any preamble code - # this line causes the whole file to be read into one string - local $/; my $preamble = ''; my $source; - if (-e "$ce->{courseDirs}->{achievements}/$ce->{achievementPreambleFile}") { - open(PREAMB, '<', "$ce->{courseDirs}->{achievements}/$ce->{achievementPreambleFile}"); - $preamble = ; - close(PREAMB); + if (-e "$ce->{courseDirs}{achievements}/$ce->{achievementPreambleFile}") { + local $/; + open(my $PREAMB, '<', "$ce->{courseDirs}{achievements}/$ce->{achievementPreambleFile}"); + $preamble = <$PREAMB>; + close($PREAMB); } #loop through the various achievements, see if they have been obtained, foreach my $achievement (@achievements) { @@ -223,11 +217,12 @@ sub checkForAchievements { $maxCounter = $achievement->max_counter; #check the achievement using Safe - my $sourceFilePath = $ce->{courseDirs}->{achievements} . '/' . $achievement->test; + my $sourceFilePath = $ce->{courseDirs}{achievements} . '/' . $achievement->test; if (-e $sourceFilePath) { - open(SOURCE, '<', $sourceFilePath); - $source = ; - close(SOURCE); + local $/ = undef; + open(my $SOURCE, '<', $sourceFilePath); + $source = <$SOURCE>; + close($SOURCE); } else { warn('Couldnt find achievement evaluator $sourceFilePath'); next; @@ -250,41 +245,8 @@ sub checkForAchievements { $globalUserAchievement->next_level_points($nextLevelPoints); } - #build the cheevo message. New level messages are slightly different - my $imgSrc = $ce->{server_root_url}; - if ($achievement->{icon}) { - $imgSrc .= $ce->{courseURLs}->{achievements} . "/" . $achievement->{icon}; - } else { - $imgSrc .= $ce->{webworkURLs}->{htdocs} . "/images/defaulticon.png"; - } - - $cheevoMessage .= CGI::start_div({ - class => 'cheevo-toast toast hide', - role => 'alert', - aria_live => 'polite', - aria_atomic => 'true' - }); - $cheevoMessage .= CGI::start_div({ class => 'toast-body d-flex align-items-center' }); - - $cheevoMessage .= CGI::img({ src => $imgSrc, alt => 'Achievement Icon' }); - - $cheevoMessage .= CGI::start_div({ class => 'cheevopopuptext' }); - if ($achievement->category eq 'level') { - $cheevoMessage = $cheevoMessage . CGI::h2("$achievement->{name}"); - # Print the description as part of the message if we are using items. - $cheevoMessage .= - CGI::div($ce->{achievementItemsEnabled} - ? $achievement->{description} - : $r->maketext("Congratulations, you earned a new level!")); - } else { - $cheevoMessage .= CGI::h2("$achievement->{name}"); - $cheevoMessage .= CGI::div("$achievement->{points} Points: $achievement->{description}"); - } - $cheevoMessage .= CGI::end_div(); - - $cheevoMessage .= q{}; - $cheevoMessage .= CGI::end_div() . CGI::end_div(); + # Construct the cheevo message using the cheevoMessage template. + push(@$cheevoMessage, $r->include('AchievementEvaluator/cheevoMessage', achievement => $achievement)); my $points = $achievement->points; #just in case points is an ininitialzied variable @@ -306,17 +268,16 @@ sub checkForAchievements { $globalUserAchievement->frozen_hash(nfreeze_base64($globalData)); $db->putGlobalUserAchievement($globalUserAchievement); - if ($cheevoMessage) { - $cheevoMessage = CGI::div( - { - class => "cheevo-toast-container toast-container " - . "position-absolute top-0 start-50 translate-middle-x p-3" - }, - $cheevoMessage + if (@$cheevoMessage) { + return $r->tag( + 'div', + class => + 'cheevo-toast-container toast-container position-absolute top-0 start-50 translate-middle-x p-3', + $cheevoMessage->join('') ); } - return $cheevoMessage; + return ''; } 1; diff --git a/lib/WeBWorK/AchievementItems.pm b/lib/WeBWorK/AchievementItems.pm index b0202ed018..ec3f64ceac 100644 --- a/lib/WeBWorK/AchievementItems.pm +++ b/lib/WeBWorK/AchievementItems.pm @@ -14,16 +14,14 @@ ################################################################################ package WeBWorK::AchievementItems; -use base qw(WeBWorK); -use WeBWorK::Utils qw(nfreeze_base64 thaw_base64); +use WeBWorK::Utils qw(thaw_base64); use strict; use warnings; -# have to add any new items to this list, furthermore -# the elements of this list have to match the class name/id of the -# item classes defined below. +# List of available achievement items. Make sure to add any new items to this list. Furthermore, the elements in this +# list have to match the class name of the achievement item classes loaded below. use constant ITEMS => [ qw( ResetIncorrectAttempts DuplicateProb @@ -45,24 +43,21 @@ use constant ITEMS => [ qw( =head2 NAME -Item - this is the base class for achievement times. This defines an -interface for all of the achievement items. Each achievement item will have -a name, a description, a method for creating an html form to get its inputs -called print_form and a method for applying those inputs called use_item. +This is the base class for achievement times. This defines an interface for all of the achievement items. Each +achievement item will have a name, a description, a method for creating an html form to get its inputs called print_form +and a method for applying those inputs called use_item. Note: the ID has to match the name of the class. =cut -sub id { shift->{id} } -sub name { shift->{name} } -sub description { shift->{description} } +sub id { return shift->{id}; } +sub name { return shift->{name}; } +sub description { return shift->{description}; } # This is a global method that returns all of the provided users items. sub UserItems { - my $userName = shift; - my $db = shift; - my $ce = shift; + my ($userName, $db, $ce) = @_; # return unless the user has global achievement data my $globalUserAchievement = $db->getGlobalUserAchievement($userName); @@ -72,9 +67,9 @@ sub UserItems { my $globalData = thaw_base64($globalUserAchievement->frozen_hash); my @items; - # ugly eval to get a new item object for each type of item. - foreach my $item (@{ +ITEMS }) { - push(@items, [ eval("WeBWorK::AchievementItems::${item}->new"), $globalData->{$item} ]) + # Get a new item object for each type of item. + for my $item (@{ +ITEMS }) { + push(@items, [ "WeBWorK::AchievementItems::$item"->new, $globalData->{$item} ]) if ($globalData->{$item}); } @@ -84,1701 +79,53 @@ sub UserItems { # Utility method for outputing a form row with a label and popup menu. # The id, label_text, and values are required parameters. sub form_popup_menu_row { + my ($r, %options) = @_; + my %params = ( id => '', label_text => '', label_attr => {}, values => [], - labels => {}, menu_attr => {}, menu_container_attr => {}, add_container => 1, - @_ - ); - - $params{label_attr}{for} = $params{id}; - $params{label_attr}{class} = 'col-4 col-form-label' unless defined $params{label_attr}{class}; - $params{menu_attr}{values} = $params{values}; - $params{menu_attr}{labels} = $params{labels}; - $params{menu_attr}{id} = $params{id}; - $params{menu_attr}{name} = $params{id}; - $params{menu_attr}{class} = 'form-select' unless defined $params{menu_attr}{class}; - $params{menu_container_attr}{class} = 'col-8' unless defined $params{menu_container_attr}{class}; - - return join('', - $params{add_container} ? CGI::start_div({ class => 'row mb-3' }) : '', - CGI::label($params{label_attr}, $params{label_text}), - CGI::div($params{menu_container_attr}, CGI::popup_menu($params{menu_attr})), - $params{add_container} ? CGI::end_div() : ''); -} - -#Item to resurrect a homework for 24 hours - -package WeBWorK::AchievementItems::ResurrectHW; -our @ISA = qw(WeBWorK::AchievementItems); - -use WeBWorK::Utils qw(sortByName before after between x nfreeze_base64 thaw_base64 format_set_name_display); - -sub new { - my $class = shift; - my %options = @_; - - my $self = { - id => "ResurrectHW", - name => x("Scroll of Resurrection"), - description => x("Opens any homework set for 24 hours."), - %options, - }; - - bless($self, $class); - return $self; -} - -sub print_form { - my $self = shift; - my $sets = shift; - my $setProblemCount = shift; - my $r = shift; - - my @openSets; - my @openSetCount; - my $maxProblems = 0; - - #Find all of the closed sets or sets that are past their reduced scoring date and put them in form - - for (my $i = 0; $i <= $#$sets; $i++) { - if (after($$sets[$i]->due_date) && $$sets[$i]->assignment_type eq 'default') { - push(@openSets, $$sets[$i]->set_id); - } elsif (defined $$sets[$i]->reduced_scoring_date && $$sets[$i]->reduced_scoring_date ne '') { - if (after($$sets[$i]->reduced_scoring_date) && $$sets[$i]->assignment_type eq 'default') { - push(@openSets, $$sets[$i]->set_id); - } - } - } - - return join( - '', - CGI::p($r->maketext('Choose the set which you would like to resurrect.')), - WeBWorK::AchievementItems::form_popup_menu_row( - id => 'res_set_id', - label_text => $r->maketext('Set Name'), - values => \@openSets, - labels => { map { $_ => format_set_name_display($_) } @openSets }, - menu_attr => { dir => 'ltr' } - ) - ); -} - -sub use_item { - my $self = shift; - my $userName = shift; - my $r = shift; - my $db = $r->db; - my $ce = $r->ce; - - #check and see if student really has the item and if the data is valid - my $globalUserAchievement = $db->getGlobalUserAchievement($userName); - return "No achievement data?!?!?!" - unless ($globalUserAchievement->frozen_hash); - my $globalData = thaw_base64($globalUserAchievement->frozen_hash); - - return "You are $self->{id} trying to use an item you don't have" - unless ($globalData->{ $self->{id} }); - - my $setID = $r->param('res_set_id'); - return "You need to input a Set Name" - unless (defined $setID); - - my $set = $db->getUserSet($userName, $setID); - return "Couldn't find that set!" - unless ($set); - - # Set a new reduced scoring date, close date, and answer date for the student; remove the item - $set->reduced_scoring_date(time() + 86400); - $set->due_date(time() + 86400); - $set->answer_date(time() + 86400); - - $db->putUserSet($set); - - my @probIDs = $db->listUserProblems($userName, $setID); - - foreach my $probID (@probIDs) { - my $problem = $db->getUserProblem($userName, $setID, $probID); - $problem->problem_seed($problem->problem_seed + 100); - $db->putUserProblem($problem); - } - - $globalData->{ $self->{id} }--; - $globalUserAchievement->frozen_hash(nfreeze_base64($globalData)); - $db->putGlobalUserAchievement($globalUserAchievement); - - return; -} - -#Item to extend a close date by 24 hours. - -package WeBWorK::AchievementItems::ExtendDueDate; -our @ISA = qw(WeBWorK::AchievementItems); - -use WeBWorK::Utils qw(sortByName before after between x nfreeze_base64 thaw_base64 format_set_name_display); - -sub new { - my $class = shift; - my %options = @_; - - my $self = { - id => "ExtendDueDate", - name => x("Tunic of Extension"), - description => x("Adds 24 hours to the close date of a homework."), - %options, - }; - - bless($self, $class); - return $self; -} - -sub print_form { - my $self = shift; - my $sets = shift; - my $setProblemCount = shift; - my $r = shift; - - my @openSets; - my @openSetCount; - my $maxProblems = 0; - - #find all currently open sets and print to a form - for (my $i = 0; $i <= $#$sets; $i++) { - if (between($$sets[$i]->open_date, $$sets[$i]->answer_date) && $$sets[$i]->assignment_type eq "default") { - push(@openSets, $$sets[$i]->set_id); - } - } - - return join( - '', - CGI::p($r->maketext('Choose the set whose close date you would like to extend.')), - WeBWorK::AchievementItems::form_popup_menu_row( - id => 'ext_set_id', - label_text => $r->maketext('Set Name'), - values => \@openSets, - labels => { map { $_ => format_set_name_display($_) } @openSets }, - menu_attr => { dir => 'ltr' } - ) - ); -} - -sub use_item { - my $self = shift; - my $userName = shift; - my $r = shift; - my $db = $r->db; - my $ce = $r->ce; - - #check and see if the student has the achievement and if the data is valid - my $globalUserAchievement = $db->getGlobalUserAchievement($userName); - return "No achievement data?!?!?!" - unless ($globalUserAchievement->frozen_hash); - my $globalData = thaw_base64($globalUserAchievement->frozen_hash); - - return "You are $self->{id} trying to use an item you don't have" - unless ($globalData->{ $self->{id} }); - - my $setID = $r->param('ext_set_id'); - return "You need to input a Set Name" - unless (defined $setID); - - my $set = $db->getMergedSet($userName, $setID); - return "Couldn't find that set!" - unless ($set); - my $userSet = $db->getUserSet($userName, $setID); - - #add time to the reduced scoring date, due date, and answer date; remove item from inventory - $userSet->reduced_scoring_date($set->reduced_scoring_date() + 86400) - if defined($set->reduced_scoring_date()) && $set->reduced_scoring_date(); - $userSet->due_date($set->due_date() + 86400); - $userSet->answer_date($set->answer_date() + 86400); - - $db->putUserSet($userSet); - - $globalData->{ $self->{id} }--; - $globalUserAchievement->frozen_hash(nfreeze_base64($globalData)); - $db->putGlobalUserAchievement($globalUserAchievement); - - return; -} - -#Item to extend a close date by 48 hours. - -package WeBWorK::AchievementItems::SuperExtendDueDate; -our @ISA = qw(WeBWorK::AchievementItems); - -use WeBWorK::Utils qw(sortByName before after between x nfreeze_base64 thaw_base64 format_set_name_display); - -sub new { - my $class = shift; - my %options = @_; - - my $self = { - id => "SuperExtendDueDate", - name => x("Robe of Longevity"), - description => x("Adds 48 hours to the close date of a homework."), - %options, - }; - - bless($self, $class); - return $self; -} - -sub print_form { - my $self = shift; - my $sets = shift; - my $setProblemCount = shift; - my $r = shift; - - my @openSets; - my @openSetCount; - my $maxProblems = 0; - - #find all currently open sets and print to a form - for (my $i = 0; $i <= $#$sets; $i++) { - if (between($$sets[$i]->open_date, $$sets[$i]->answer_date) && $$sets[$i]->assignment_type eq "default") { - push(@openSets, $$sets[$i]->set_id); - } - } - - return join( - '', - CGI::p($r->maketext('Choose the set whose close date you would like to extend.')), - WeBWorK::AchievementItems::form_popup_menu_row( - id => 'ext_set_id', - label_text => $r->maketext('Set Name'), - values => \@openSets, - labels => { map { $_ => format_set_name_display($_) } @openSets }, - menu_attr => { dir => 'ltr' } - ) - ); -} - -sub use_item { - my $self = shift; - my $userName = shift; - my $r = shift; - my $db = $r->db; - my $ce = $r->ce; - - #check and see if the student has the achievement and if the data is valid - my $globalUserAchievement = $db->getGlobalUserAchievement($userName); - return "No achievement data?!?!?!" - unless ($globalUserAchievement->frozen_hash); - my $globalData = thaw_base64($globalUserAchievement->frozen_hash); - - return "You are $self->{id} trying to use an item you don't have" - unless ($globalData->{ $self->{id} }); - - my $setID = $r->param('ext_set_id'); - return "You need to input a Set Name" - unless (defined $setID); - - my $set = $db->getMergedSet($userName, $setID); - return "Couldn't find that set!" - unless ($set); - my $userSet = $db->getUserSet($userName, $setID); - - #add time to the reduced scoring date, due date, and answer date; remove item from inventory - $userSet->reduced_scoring_date($set->reduced_scoring_date() + 172800) - if defined($set->reduced_scoring_date()) && $set->reduced_scoring_date(); - $userSet->due_date($set->due_date() + 172800); - $userSet->answer_date($set->answer_date() + 172800); - - $db->putUserSet($userSet); - - $globalData->{ $self->{id} }--; - $globalUserAchievement->frozen_hash(nfreeze_base64($globalData)); - $db->putGlobalUserAchievement($globalUserAchievement); - - return; -} - -#Item to extend a close date by 24 hours for reduced credit - -package WeBWorK::AchievementItems::ReducedCred; -our @ISA = qw(WeBWorK::AchievementItems); - -use WeBWorK::Utils qw(sortByName before after between x nfreeze_base64 thaw_base64 format_set_name_display); - -sub new { - my $class = shift; - my %options = @_; - - my $self = { - id => "ReducedCred", - name => x("Ring of Reduction"), - #Reduced credit needs to be set up in course configuration for this - # item to work, - description => x( - "Enable reduced scoring for a homework set. This will allow you to submit answers for partial credit for 24 hours after the close date." - ), - %options, - }; - - bless($self, $class); - return $self; -} - -sub print_form { - my $self = shift; - my $sets = shift; - my $setProblemCount = shift; - my $r = shift; - my $ce = $r->{ce}; - - my @openSets; - my @openSetCount; - my $maxProblems = 0; - - #print names of open sets - for (my $i = 0; $i <= $#$sets; $i++) { - if (between($$sets[$i]->open_date, $$sets[$i]->answer_date) && $$sets[$i]->assignment_type eq "default") { - push(@openSets, $$sets[$i]->set_id); - } - } - - return join( - '', - CGI::p($r->maketext('Choose the set which you would like to enable partial credit for.')), - WeBWorK::AchievementItems::form_popup_menu_row( - id => 'red_set_id', - label_text => $r->maketext('Set Name'), - values => \@openSets, - labels => { map { $_ => format_set_name_display($_) } @openSets }, - menu_attr => { dir => 'ltr' } - ) - ); -} - -sub use_item { - my $self = shift; - my $userName = shift; - my $r = shift; - my $db = $r->db; - my $ce = $r->ce; - - #check variables - my $globalUserAchievement = $db->getGlobalUserAchievement($userName); - return "No achievement data?!?!?!" - unless ($globalUserAchievement->frozen_hash); - my $globalData = thaw_base64($globalUserAchievement->frozen_hash); - - return - "This item won't work unless your instructor enables the reduced scoring feature. Let them know that you recieved this message." - unless $ce->{pg}{ansEvalDefaults}{reducedScoringPeriod}; - - return "You are $self->{id} trying to use an item you don't have" - unless ($globalData->{ $self->{id} }); - - my $setID = $r->param('red_set_id'); - return "You need to input a Set Name" - unless (defined $setID); - - my $set = $db->getMergedSet($userName, $setID); - return "Couldn't find that set!" - unless ($set); - my $userSet = $db->getUserSet($userName, $setID); - - # enable reduced scoring on the set and add the reduced scoring period - # to the due date. - my $additionalTime = 60 * $ce->{pg}{ansEvalDefaults}{reducedScoringPeriod}; - $userSet->enable_reduced_scoring(1); - $userSet->reduced_scoring_date($set->due_date()); - $userSet->due_date($set->due_date() + $additionalTime); - $userSet->answer_date($set->answer_date() + $additionalTime); - - $db->putUserSet($userSet); - - $globalData->{ $self->{id} }--; - $globalUserAchievement->frozen_hash(nfreeze_base64($globalData)); - $db->putGlobalUserAchievement($globalUserAchievement); - - return; -} - -#Item to make a homework set worth twice as much - -package WeBWorK::AchievementItems::DoubleSet; -our @ISA = qw(WeBWorK::AchievementItems); - -use WeBWorK::Utils qw(sortByName before after between x nfreeze_base64 thaw_base64 format_set_name_display); - -sub new { - my $class = shift; - my %options = @_; - - my $self = { - id => "DoubleSet", - name => x("Cake of Enlargement"), - description => x("Cause the selected homework set to count for twice as many points as it normally would."), - %options, - }; - - bless($self, $class); - return $self; -} - -sub print_form { - my $self = shift; - my $sets = shift; - my $setProblemCount = shift; - my $r = shift; - my $ce = $r->{ce}; - - my @openSets; - - #print open sets - - for (my $i = 0; $i <= $#$sets; $i++) { - if ($$sets[$i]->assignment_type eq "default") { - push(@openSets, $$sets[$i]->set_id); - } - } - - return join( - '', - CGI::p($r->maketext('Choose the set which you would like to be worth twice as much.')), - WeBWorK::AchievementItems::form_popup_menu_row( - id => 'dub_set_id', - label_text => $r->maketext('Set Name'), - values => \@openSets, - labels => { map { $_ => format_set_name_display($_) } @openSets }, - menu_attr => { dir => 'ltr' } - ) - ); -} - -sub use_item { - my $self = shift; - my $userName = shift; - my $r = shift; - my $db = $r->db; - my $ce = $r->ce; - - #validate input data - - my $globalUserAchievement = $db->getGlobalUserAchievement($userName); - return "No achievement data?!?!?!" - unless ($globalUserAchievement->frozen_hash); - my $globalData = thaw_base64($globalUserAchievement->frozen_hash); - - return "You are $self->{id} trying to use an item you don't have" - unless ($globalData->{ $self->{id} }); - - my $setID = $r->param('dub_set_id'); - return "You need to input a Set Name" - unless (defined $setID); - - my $set = $db->getMergedSet($userName, $setID); - return "Couldn't find that set!" - unless ($set); - - # got through the problems in the set and double the value/weight of each - - my @probIDs = $db->listUserProblems($userName, $setID); - - foreach my $probID (@probIDs) { - my $globalproblem = $db->getMergedProblem($userName, $setID, $probID); - my $problem = $db->getUserProblem($userName, $setID, $probID); - $problem->value($globalproblem->value * 2); - $db->putUserProblem($problem); - } - - $globalData->{ $self->{id} }--; - $globalUserAchievement->frozen_hash(nfreeze_base64($globalData)); - $db->putGlobalUserAchievement($globalUserAchievement); - - return; -} - -#Item to reset number of incorrect attempts. -package WeBWorK::AchievementItems::ResetIncorrectAttempts; -our @ISA = qw(WeBWorK::AchievementItems); - -use WeBWorK::Utils qw(sortByName before after between x nfreeze_base64 thaw_base64 format_set_name_display); - -sub new { - my $class = shift; - my %options = @_; - - my $self = { - id => "ResetIncorrectAttempts", - name => x("Potion of Forgetfulness"), - description => x("Resets the number of incorrect attempts on a single homework problem."), - %options, - }; - - bless($self, $class); - return $self; -} - -sub print_form { - my $self = shift; - my $sets = shift; - my $setProblemCount = shift; - my $r = shift; - - my @openSets; - my $set_attribs; - my @openSetCount; - my $maxProblems = 0; - - #print open sets in a drop down and some javascript which will cause the - #second drop down to have the correct number of problems for each set - - for (my $i = 0; $i <= $#$sets; $i++) { - if (between($$sets[$i]->open_date, $$sets[$i]->due_date) && $$sets[$i]->assignment_type eq "default") { - push(@openSets, $$sets[$i]->set_id); - $set_attribs->{ $$sets[$i]->set_id }{'data-max'} = $$setProblemCount[$i]; - push(@openSetCount, $$setProblemCount[$i]); - $maxProblems = $$setProblemCount[$i] if ($$setProblemCount[$i] > $maxProblems); - } - } - - my @problemIDs; - my $problem_attribs; - - for (my $i = 1; $i <= $maxProblems; $i++) { - push(@problemIDs, $i); - if ($i > $openSetCount[0]) { - $problem_attribs->{$i}{style} = 'display:none;'; - } - } - - return join( - '', - CGI::p($r->maketext( - 'Please choose the set name and problem number of the question which ' - . 'should have its incorrect attempt count reset.' - )), - WeBWorK::AchievementItems::form_popup_menu_row( - id => 'ria_set_id', - label_text => $r->maketext('Set Name'), - values => \@openSets, - labels => { map { $_ => format_set_name_display($_) } @openSets }, - menu_attr => { attributes => $set_attribs, dir => 'ltr', data_problems => 'ria_problem_id' } - ), - WeBWorK::AchievementItems::form_popup_menu_row( - id => 'ria_problem_id', - label_text => $r->maketext('Problem Number'), - values => \@problemIDs, - menu_attr => { attributes => $problem_attribs }, - menu_container_attr => { class => 'col-3' } - ) - ); -} - -sub use_item { - my $self = shift; - my $userName = shift; - my $r = shift; - my $db = $r->db; - my $ce = $r->ce; - - #validate data - my $globalUserAchievement = $db->getGlobalUserAchievement($userName); - return "No achievement data?!?!?!" - unless ($globalUserAchievement->frozen_hash); - my $globalData = thaw_base64($globalUserAchievement->frozen_hash); - - return "You are $self->{id} trying to use an item you don't have" - unless ($globalData->{ $self->{id} }); - - my $setID = $r->param('ria_set_id'); - return "You need to input a Set Name" - unless (defined $setID); - my $problemID = $r->param('ria_problem_id'); - return "You need to input a Problem Number" - unless ($problemID); - - my $problem = $db->getUserProblem($userName, $setID, $problemID); - - return "There was an error accessing that problem." unless $problem; - - #set number of incorrect attempts to zero - - $problem->num_incorrect(0); - - $db->putUserProblem($problem); - - $globalData->{ $self->{id} }--; - $globalUserAchievement->frozen_hash(nfreeze_base64($globalData)); - $db->putGlobalUserAchievement($globalUserAchievement); - - return; -} - -#Item to make a problem worth double. -package WeBWorK::AchievementItems::DoubleProb; -our @ISA = qw(WeBWorK::AchievementItems); - -use WeBWorK::Utils qw(sortByName before after between x nfreeze_base64 thaw_base64 format_set_name_display); - -sub new { - my $class = shift; - my %options = @_; - - my $self = { - id => "DoubleProb", - name => x("Cupcake of Enlargement"), - description => x("Causes a single homework problem to be worth twice as much."), - %options, - }; - - bless($self, $class); - return $self; -} - -sub print_form { - my $self = shift; - my $sets = shift; - my $setProblemCount = shift; - my $r = shift; - - my @openSets; - my $set_attribs; - my @openSetCount; - my $maxProblems = 0; - - #print open sets and javascript to mach second dropdown to number of - #problems in each set - - for (my $i = 0; $i <= $#$sets; $i++) { - if (between($$sets[$i]->open_date, $$sets[$i]->due_date) && $$sets[$i]->assignment_type eq "default") { - push(@openSets, $$sets[$i]->set_id); - $set_attribs->{ $$sets[$i]->set_id }{'data-max'} = $$setProblemCount[$i]; - push(@openSetCount, $$setProblemCount[$i]); - $maxProblems = $$setProblemCount[$i] if ($$setProblemCount[$i] > $maxProblems); - } - } - - my @problemIDs; - my $problem_attribs; - - for (my $i = 1; $i <= $maxProblems; $i++) { - push(@problemIDs, $i); - if ($i > $openSetCount[0]) { - $problem_attribs->{$i}{style} = 'display:none;'; - } - } - - return join( - '', - CGI::p( - $r->maketext( - 'Please choose the set name and problem number of the question which should have its weight doubled.') - ), - WeBWorK::AchievementItems::form_popup_menu_row( - id => 'dbp_set_id', - label_text => $r->maketext('Set Name'), - values => \@openSets, - labels => { map { $_ => format_set_name_display($_) } @openSets }, - menu_attr => { attributes => $set_attribs, dir => 'ltr', data_problems => 'dbp_problem_id' } - ), - WeBWorK::AchievementItems::form_popup_menu_row( - id => 'dbp_problem_id', - label_text => $r->maketext('Problem Number'), - values => \@problemIDs, - menu_attr => { attributes => $problem_attribs }, - menu_container_attr => { class => 'col-3' } - ) + %options ); -} - -sub use_item { - my $self = shift; - my $userName = shift; - my $r = shift; - my $db = $r->db; - my $ce = $r->ce; - - #validate data - - my $globalUserAchievement = $db->getGlobalUserAchievement($userName); - return "No achievement data?!?!?!" - unless ($globalUserAchievement->frozen_hash); - my $globalData = thaw_base64($globalUserAchievement->frozen_hash); - - return "You are $self->{id} trying to use an item you don't have" - unless ($globalData->{ $self->{id} }); - - my $setID = $r->param('dbp_set_id'); - return "You need to input a Set Name" - unless (defined $setID); - my $problemID = $r->param('dbp_problem_id'); - return "You need to input a Problem Number" - unless ($problemID); - - my $globalproblem = $db->getMergedProblem($userName, $setID, $problemID); - my $problem = $db->getUserProblem($userName, $setID, $problemID); - - return "There was an error accessing that problem." unless $problem; - - #double value of problem - - $problem->value($globalproblem->value * 2); - $db->putUserProblem($problem); - - $globalData->{ $self->{id} }--; - $globalUserAchievement->frozen_hash(nfreeze_base64($globalData)); - $db->putGlobalUserAchievement($globalUserAchievement); - return; -} - -#Item to give half credit on a single problem. -package WeBWorK::AchievementItems::HalfCreditProb; -our @ISA = qw(WeBWorK::AchievementItems); - -use WeBWorK::Utils qw(sortByName before after between x nfreeze_base64 thaw_base64 format_set_name_display); - -sub new { - my $class = shift; - my %options = @_; - - my $self = { - id => "HalfCreditProb", - name => x("Lesser Rod of Revelation"), - description => x("Gives half credit on a single homework problem."), - %options, - }; - - bless($self, $class); - return $self; -} - -sub print_form { - my $self = shift; - my $sets = shift; - my $setProblemCount = shift; - my $r = shift; - - my @openSets; - my $set_attribs; - my @openSetCount; - my $maxProblems = 0; - - #print form with open sets and javasscript to have appropriate number - # of items in second drop down - - for (my $i = 0; $i <= $#$sets; $i++) { - if (between($$sets[$i]->open_date, $$sets[$i]->due_date) && $$sets[$i]->assignment_type eq "default") { - push(@openSets, $$sets[$i]->set_id); - $set_attribs->{ $$sets[$i]->set_id }{'data-max'} = $$setProblemCount[$i]; - push(@openSetCount, $$setProblemCount[$i]); - $maxProblems = $$setProblemCount[$i] if ($$setProblemCount[$i] > $maxProblems); - } - } - - my @problemIDs; - my $problem_attribs; - - for (my $i = 1; $i <= $maxProblems; $i++) { - push(@problemIDs, $i); - $problem_attribs->{$i}{style} = 'display:none;' if ($i > $openSetCount[0]); - } + $params{label_attr}{class} //= 'col-4 col-form-label'; + $params{menu_attr}{class} //= 'form-select'; + $params{menu_container_attr}{class} //= 'col-8'; - return join( - '', - CGI::p( - $r->maketext( - 'Please choose the set name and problem number of the question which should be given half credit.') - ), - WeBWorK::AchievementItems::form_popup_menu_row( - id => 'hcp_set_id', - values => \@openSets, - labels => { map { $_ => format_set_name_display($_) } @openSets }, - label_text => $r->maketext('Set Name'), - menu_attr => { attributes => $set_attribs, dir => 'ltr', data_problems => 'hcp_problem_id' } - ), - WeBWorK::AchievementItems::form_popup_menu_row( - id => 'hcp_problem_id', - values => \@problemIDs, - label_text => $r->maketext('Problem Number'), - menu_attr => { attributes => $problem_attribs }, - menu_container_attr => { class => 'col-3' } + my $row_contents = $r->c( + $r->label_for($params{id} => $params{label_text}, %{ $params{label_attr} }), + $r->tag( + 'div', + %{ $params{menu_container_attr} }, + $r->select_field($params{id} => $params{values}, id => $params{id}, %{ $params{menu_attr} }) ) - ); -} - -sub use_item { - my $self = shift; - my $userName = shift; - my $r = shift; - my $db = $r->db; - my $ce = $r->ce; - - #validate data - - my $globalUserAchievement = $db->getGlobalUserAchievement($userName); - return "No achievement data?!?!?!" - unless ($globalUserAchievement->frozen_hash); - my $globalData = thaw_base64($globalUserAchievement->frozen_hash); - - return "You are $self->{id} trying to use an item you don't have" - unless ($globalData->{ $self->{id} }); - - my $setID = $r->param('hcp_set_id'); - return "You need to input a Set Name" - unless (defined $setID); - my $problemID = $r->param('hcp_problem_id'); - return "You need to input a Problem Number" - unless ($problemID); - - my $problem = $db->getUserProblem($userName, $setID, $problemID); - - return "There was an error accessing that problem." unless $problem; - - #Add .5 to grade with max of 1 - - if ($problem->status < .5) { - $problem->status($problem->status + .5); - } else { - $problem->status(1); - } - - $db->putUserProblem($problem); - - $globalData->{ $self->{id} }--; - $globalUserAchievement->frozen_hash(nfreeze_base64($globalData)); - $db->putGlobalUserAchievement($globalUserAchievement); - - return; -} - -#Item to give half credit on all problems in a homework set. -package WeBWorK::AchievementItems::HalfCreditSet; -our @ISA = qw(WeBWorK::AchievementItems); - -use WeBWorK::Utils qw(sortByName before after between x nfreeze_base64 thaw_base64 format_set_name_display); - -sub new { - my $class = shift; - my %options = @_; - - my $self = { - id => "HalfCreditSet", - name => x("Lesser Tome of Enlightenment"), - description => x("Gives half credit on every problem in a set."), - %options, - }; - - bless($self, $class); - return $self; -} - -sub print_form { - my $self = shift; - my $sets = shift; - my $setProblemCount = shift; - my $r = shift; - - my @openSets; - my @openSetCount; - my $maxProblems = 0; - - for (my $i = 0; $i <= $#$sets; $i++) { - push(@openSets, $$sets[$i]->set_id); - } - - # print form with sets - return join( - '', - CGI::p($r->maketext('Choose the set which you would like to resurrect.')), - WeBWorK::AchievementItems::form_popup_menu_row( - id => 'hcs_set_id', - label_text => $r->maketext('Set Name'), - values => \@openSets, - labels => { map { $_ => format_set_name_display($_) } @openSets }, - menu_attr => { dir => 'ltr' } - ) - ); -} - -sub use_item { - my $self = shift; - my $userName = shift; - my $r = shift; - my $db = $r->db; - my $ce = $r->ce; - - #validate data - - my $globalUserAchievement = $db->getGlobalUserAchievement($userName); - return "No achievement data?!?!?!" - unless ($globalUserAchievement->frozen_hash); - my $globalData = thaw_base64($globalUserAchievement->frozen_hash); - - return "You are $self->{id} trying to use an item you don't have" - unless ($globalData->{ $self->{id} }); - - my $setID = $r->param('hcs_set_id'); - return "You need to input a Set Name" - unless (defined $setID); - - # go through the problems in the set - my @probIDs = $db->listUserProblems($userName, $setID); - - foreach my $probID (@probIDs) { - my $problem = $db->getUserProblem($userName, $setID, $probID); - - return "There was an error accessing that problem." unless $problem; - - #Add .5 to grade with max of 1 - - if ($problem->status < .5) { - $problem->status($problem->status + .5); - } else { - $problem->status(1); - } - - $db->putUserProblem($problem); - } - - $globalData->{ $self->{id} }--; - $globalUserAchievement->frozen_hash(nfreeze_base64($globalData)); - $db->putGlobalUserAchievement($globalUserAchievement); - - return; -} - -#Item to give full credit on a single problem -package WeBWorK::AchievementItems::FullCreditProb; -our @ISA = qw(WeBWorK::AchievementItems); - -use WeBWorK::Utils qw(sortByName before after between x nfreeze_base64 thaw_base64 format_set_name_display); - -sub new { - my $class = shift; - my %options = @_; - - my $self = { - id => "FullCreditProb", - name => x("Greater Rod of Revelation"), - description => x("Gives full credit on a single homework problem."), - %options, - }; - - bless($self, $class); - return $self; -} - -sub print_form { - my $self = shift; - my $sets = shift; - my $setProblemCount = shift; - my $r = shift; - - my @openSets; - my $set_attribs; - my @openSetCount; - my $maxProblems = 0; - - #print form getting set and problem number - - for (my $i = 0; $i <= $#$sets; $i++) { - if (between($$sets[$i]->open_date, $$sets[$i]->due_date) && $$sets[$i]->assignment_type eq "default") { - push(@openSets, $$sets[$i]->set_id); - $set_attribs->{ $$sets[$i]->set_id }{'data-max'} = $$setProblemCount[$i]; - push(@openSetCount, $$setProblemCount[$i]); - $maxProblems = $$setProblemCount[$i] if ($$setProblemCount[$i] > $maxProblems); - } - } - - my @problemIDs; - my $problem_attribs; - - for (my $i = 1; $i <= $maxProblems; $i++) { - push(@problemIDs, $i); - if ($i > $openSetCount[0]) { - $problem_attribs->{$i}{style} = 'display:none;' if ($i > $openSetCount[0]); - } - } - - return join( - '', - CGI::p( - $r->maketext( - 'Please choose the set name and problem number of the question which should be given full credit.') - ), - WeBWorK::AchievementItems::form_popup_menu_row( - id => 'fcp_set_id', - label_text => $r->maketext('Set Name'), - values => \@openSets, - labels => { map { $_ => format_set_name_display($_) } @openSets }, - menu_attr => { attributes => $set_attribs, dir => 'ltr', data_problems => 'fcp_problem_id' } - ), - WeBWorK::AchievementItems::form_popup_menu_row( - id => 'fcp_problem_id', - values => \@problemIDs, - label_text => $r->maketext('Problem Number'), - menu_attr => { attributes => $problem_attribs }, - menu_container_attr => { class => 'col-3' } - ) - ); -} - -sub use_item { - my $self = shift; - my $userName = shift; - my $r = shift; - my $db = $r->db; - my $ce = $r->ce; - - #validate data - - my $globalUserAchievement = $db->getGlobalUserAchievement($userName); - return "No achievement data?!?!?!" - unless ($globalUserAchievement->frozen_hash); - my $globalData = thaw_base64($globalUserAchievement->frozen_hash); - - return "You are $self->{id} trying to use an item you don't have" - unless ($globalData->{ $self->{id} }); - - my $setID = $r->param('fcp_set_id'); - return "You need to input a Set Name" - unless (defined $setID); - my $problemID = $r->param('fcp_problem_id'); - return "You need to input a Problem Number" - unless ($problemID); - - my $problem = $db->getUserProblem($userName, $setID, $problemID); - - return "There was an error accessing that problem." unless $problem; - - #set status of the file to one. - - $problem->status(1); - - $db->putUserProblem($problem); - - $globalData->{ $self->{id} }--; - $globalUserAchievement->frozen_hash(nfreeze_base64($globalData)); - $db->putGlobalUserAchievement($globalUserAchievement); - - return; -} - -#Item to give half credit on all problems in a homework set. -package WeBWorK::AchievementItems::FullCreditSet; -our @ISA = qw(WeBWorK::AchievementItems); - -use WeBWorK::Utils qw(sortByName before after between x nfreeze_base64 thaw_base64 format_set_name_display); - -sub new { - my $class = shift; - my %options = @_; - - my $self = { - id => "FullCreditSet", - name => x("Greater Tome of Enlightenment"), - description => x("Gives full credit on every problem in a set."), - %options, - }; - - bless($self, $class); - return $self; -} - -sub print_form { - my $self = shift; - my $sets = shift; - my $setProblemCount = shift; - my $r = shift; - - my @openSets; - my @openSetCount; - my $maxProblems = 0; - - for (my $i = 0; $i <= $#$sets; $i++) { - push(@openSets, $$sets[$i]->set_id); - } - - # print form with sets - return join( - '', - CGI::p($r->maketext('Choose the set which you would like to resurrect.')), - WeBWorK::AchievementItems::form_popup_menu_row( - id => 'fcs_set_id', - label_text => $r->maketext('Set Name'), - values => \@openSets, - labels => { map { $_ => format_set_name_display($_) } @openSets }, - menu_attr => { dir => 'ltr' } - ) - ); -} - -sub use_item { - my $self = shift; - my $userName = shift; - my $r = shift; - my $db = $r->db; - my $ce = $r->ce; - - #validate data - - my $globalUserAchievement = $db->getGlobalUserAchievement($userName); - return "No achievement data?!?!?!" - unless ($globalUserAchievement->frozen_hash); - my $globalData = thaw_base64($globalUserAchievement->frozen_hash); - - return "You are $self->{id} trying to use an item you don't have" - unless ($globalData->{ $self->{id} }); - - my $setID = $r->param('fcs_set_id'); - return "You need to input a Set Name" - unless (defined $setID); - - # go through the problems in the set - my @probIDs = $db->listUserProblems($userName, $setID); - - foreach my $probID (@probIDs) { - my $problem = $db->getUserProblem($userName, $setID, $probID); - - return "There was an error accessing that problem." unless $problem; - - # set status to 1 - $problem->status(1); - - $db->putUserProblem($problem); - } - - $globalData->{ $self->{id} }--; - $globalUserAchievement->frozen_hash(nfreeze_base64($globalData)); - $db->putGlobalUserAchievement($globalUserAchievement); - - return; -} - -#Item to turn one problem into another problem -package WeBWorK::AchievementItems::DuplicateProb; -our @ISA = qw(WeBWorK::AchievementItems); - -use WeBWorK::Utils qw(sortByName before after between x nfreeze_base64 thaw_base64 format_set_name_display); - -sub new { - my $class = shift; - my %options = @_; - - my $self = { - id => "DuplicateProb", - name => x("Box of Transmogrification"), - description => x("Causes a homework problem to become a clone of another problem from the same set."), - %options, - }; - - bless($self, $class); - return $self; -} - -sub print_form { - my $self = shift; - my $sets = shift; - my $setProblemCount = shift; - my $r = shift; - - my @openSets; - my $set_attribs; - my @openSetCount; - my $maxProblems = 0; - - # print open sets and allow for a choice of two problems from the set - - for (my $i = 0; $i <= $#$sets; $i++) { - if (between($$sets[$i]->open_date, $$sets[$i]->due_date) && $$sets[$i]->assignment_type eq "default") { - push(@openSets, $$sets[$i]->set_id); - $set_attribs->{ $$sets[$i]->set_id }{'data-max'} = $$setProblemCount[$i]; - push(@openSetCount, $$setProblemCount[$i]); - $maxProblems = $$setProblemCount[$i] if ($$setProblemCount[$i] > $maxProblems); - } - } - - my @problemIDs; - my %attributes; - - for (my $i = 1; $i <= $maxProblems; $i++) { - push(@problemIDs, $i); - if ($i > $openSetCount[0]) { - $attributes{$i}{style} = 'display:none;'; - } - } - - return join( - '', - CGI::p($r->maketext( - 'Please choose the set, the problem you would like to copy, ' - . 'and the problem you would like to copy it to.' - )), - WeBWorK::AchievementItems::form_popup_menu_row( - id => 'tran_set_id', - label_text => $r->maketext('Set Name'), - values => \@openSets, - labels => { map { $_ => format_set_name_display($_) } @openSets }, - menu_attr => { - attributes => $set_attribs, - dir => 'ltr', - data_problems => 'tran_problem_id', - data_problems2 => 'tran_problem_id2' - } - ), - CGI::div( - { class => 'row mb-3' }, - WeBWorK::AchievementItems::form_popup_menu_row( - id => 'tran_problem_id', - values => \@problemIDs, - label_text => $r->maketext('Copy this Problem'), - menu_attr => { attributes => \%attributes }, - menu_container_attr => { class => 'col-2 ps-0' }, - add_container => 0 - ), - WeBWorK::AchievementItems::form_popup_menu_row( - id => 'tran_problem_id2', - values => \@problemIDs, - label_text => $r->maketext('To this Problem'), - menu_attr => { attributes => \%attributes }, - menu_container_attr => { class => 'col-2 ps-0' }, - add_container => 0 - ) - ) - ); -} - -sub use_item { - my $self = shift; - my $userName = shift; - my $r = shift; - my $db = $r->db; - my $ce = $r->ce; - - #validate data - - my $globalUserAchievement = $db->getGlobalUserAchievement($userName); - return "No achievement data?!?!?!" - unless ($globalUserAchievement->frozen_hash); - my $globalData = thaw_base64($globalUserAchievement->frozen_hash); - - return "You are $self->{id} trying to use an item you don't have" - unless ($globalData->{ $self->{id} }); - - my $setID = $r->param('tran_set_id'); - return "You need to input a Set Name" - unless (defined $setID); - my $problemID = $r->param('tran_problem_id'); - return "You need to input a Problem Number" - unless ($problemID); - my $problemID2 = $r->param('tran_problem_id2'); - return "You need to input a Problem Number" - unless ($problemID2); - - return "You need to pick 2 different problems!" - if ($problemID == $problemID2); - - my $problem = $db->getMergedProblem($userName, $setID, $problemID); - my $problem2 = $db->getUserProblem($userName, $setID, $problemID2); - - return "There was an error accessing that problem." unless $problem; - - #set the source of the second problem to that of the first problem. - - $problem2->source_file($problem->source_file); - - $db->putUserProblem($problem2); - - $globalData->{ $self->{id} }--; - $globalUserAchievement->frozen_hash(nfreeze_base64($globalData)); - $db->putGlobalUserAchievement($globalUserAchievement); - - return; -} - -#Item to print a suprise message -package WeBWorK::AchievementItems::Surprise; -our @ISA = qw(WeBWorK::AchievementItems); - -use WeBWorK::Utils qw(sortByName before after between x nfreeze_base64 thaw_base64); - -sub new { - my $class = shift; - my %options = @_; - - my $self = { - id => "Surprise", - name => x("Mysterious Package (with Ribbons)"), - description => x("What could be inside?"), - %options, - }; - - bless($self, $class); - return $self; -} - -sub print_form { - my $self = shift; - my $sets = shift; - my $setProblemCount = shift; - my $r = shift; - - # the form opens the file "suprise_message.txt" in the achievements - # folder and then prints the contetnts of the file. - - my $sourceFilePath = $r->{ce}->{courseDirs}->{achievements} . '/surprise_message.txt'; - - open MESSAGE, $sourceFilePath - or return CGI::p($r->maketext("I couldn't find the file [ACHEVDIR]/surprise_message.txt!")); - - my @message = ; - - return CGI::div(@message); - -} - -sub use_item { - my $self = shift; - my $userName = shift; - my $r = shift; - my $db = $r->db; - my $ce = $r->ce; - - #doesn't do anything - - return; -} - -#Item to allow students to take an addition test -package WeBWorK::AchievementItems::AddNewTestGW; -our @ISA = qw(WeBWorK::AchievementItems); - -use WeBWorK::Utils qw(sortByName before after between x nfreeze_base64 thaw_base64 format_set_name_display); - -sub new { - my $class = shift; - my %options = @_; - - my $self = { - id => "AddNewTestGW", - name => x("Oil of Cleansing"), - description => x( - "Unlock an additional version of a Gateway Test. If used before the close date of the Gateway Test this will allow you to generate a new version of the test." - ), - %options, - }; - - bless($self, $class); - return $self; -} - -sub print_form { - my $self = shift; - my $sets = shift; - my $setProblemCount = shift; - my $r = shift; - my $db = $r->db; - - my $userName = $r->param('user'); - my $effectiveUserName = defined($r->param('effectiveUser')) ? $r->param('effectiveUser') : $userName; - my @setIDs = $db->listUserSets($effectiveUserName); - my @userSetIDs = map { [ $effectiveUserName, $_ ] } @setIDs; - my @unfilteredsets = $db->getMergedSets(@userSetIDs); - my @sets; - - # we going to have to find the gateways for these achievements. - # we don't want the versioned gateways though. - foreach my $set (@unfilteredsets) { - if ($set->assignment_type() =~ /gateway/ - && $set->set_id !~ /,v\d+$/) - { - push @sets, $set; - } - } - - # now we need to find out which gateways are open - my @openGateways; - - foreach my $set (@sets) { - if (between($set->open_date, $set->due_date)) { - push @openGateways, $set->set_id; - } - } - - #print open gateways in a drop down. - - return join( - '', - CGI::p($r->maketext('Add a new test for which Gateway?')), - WeBWorK::AchievementItems::form_popup_menu_row( - id => 'adtgw_gw_id', - label_text => $r->maketext('Gateway Name'), - values => \@openGateways, - labels => { map { $_ => format_set_name_display($_) } @openGateways }, - menu_attr => { dir => 'ltr' } - ) - ); -} - -sub use_item { - my $self = shift; - my $userName = shift; - my $r = shift; - my $db = $r->db; - my $ce = $r->ce; - - #validate data - my $globalUserAchievement = $db->getGlobalUserAchievement($userName); - return "No achievement data?!?!?!" - unless ($globalUserAchievement->frozen_hash); - my $globalData = thaw_base64($globalUserAchievement->frozen_hash); - - return "You are $self->{id} trying to use an item you don't have" - unless ($globalData->{ $self->{id} }); - - my $setID = $r->param('adtgw_gw_id'); - return "You need to input a Gateway Name" - unless (defined $setID); - - my $set = $db->getMergedSet($userName, $setID); - return "Couldn't find that set!" - unless ($set); - - my $userSet = $db->getUserSet($userName, $setID); - - $userSet->versions_per_interval($set->versions_per_interval() + 1) - unless ($set->versions_per_interval() == 0); - - $db->putUserSet($userSet); - - $globalData->{ $self->{id} }--; - $globalUserAchievement->frozen_hash(nfreeze_base64($globalData)); - $db->putGlobalUserAchievement($globalUserAchievement); - - return; -} - -#Item to extend the due date on a gateway -package WeBWorK::AchievementItems::ExtendDueDateGW; -our @ISA = qw(WeBWorK::AchievementItems); - -use WeBWorK::Utils qw(sortByName before after between x nfreeze_base64 thaw_base64 format_set_name_display); - -sub new { - my $class = shift; - my %options = @_; - - my $self = { - id => "ExtendDueDateGW", - name => x("Amulet of Extension"), - description => x( - "Extends the close date of a gateway test by 24 hours. Note: The test must still be open for this to work." - ), - %options, - }; - - bless($self, $class); - return $self; -} - -sub print_form { - my $self = shift; - my $sets = shift; - my $setProblemCount = shift; - my $r = shift; - my $db = $r->db; - - my $userName = $r->param('user'); - my $effectiveUserName = defined($r->param('effectiveUser')) ? $r->param('effectiveUser') : $userName; - my @setIDs = $db->listUserSets($effectiveUserName); - my @userSetIDs = map { [ $effectiveUserName, $_ ] } @setIDs; - my @unfilteredsets = $db->getMergedSets(@userSetIDs); - my @sets; - - # we going to have to find the gateways for these achievements. - # we don't want the versioned gateways though. - foreach my $set (@unfilteredsets) { - if ($set->assignment_type() =~ /gateway/ - && $set->set_id !~ /,v\d+$/) - { - push @sets, $set; - } - } - - # now we need to find out which gateways are open - my @openGateways; - - foreach my $set (@sets) { - if (between($set->open_date, $set->due_date)) { - push @openGateways, $set->set_id; - } - } - - # Print open gateways in a drop down. - return join( - '', - CGI::p($r->maketext('Extend the close date for which Gateway?')), - WeBWorK::AchievementItems::form_popup_menu_row( - id => 'eddgw_gw_id', - label_text => $r->maketext('Gateway Name'), - values => \@openGateways, - labels => { map { $_ => format_set_name_display($_) } @openGateways }, - menu_attr => { dir => 'ltr' } - ) - ); -} - -sub use_item { - my $self = shift; - my $userName = shift; - my $r = shift; - my $db = $r->db; - my $ce = $r->ce; - - #validate data - my $globalUserAchievement = $db->getGlobalUserAchievement($userName); - return "No achievement data?!?!?!" - unless ($globalUserAchievement->frozen_hash); - my $globalData = thaw_base64($globalUserAchievement->frozen_hash); - - return "You are $self->{id} trying to use an item you don't have" - unless ($globalData->{ $self->{id} }); - - my $setID = $r->param('eddgw_gw_id'); - return "You need to input a Gateway Name" - unless (defined $setID); - - my $set = $db->getMergedSet($userName, $setID); - return "Couldn't find that set!" - unless ($set); - my $userSet = $db->getUserSet($userName, $setID); - - #add time to the reduced scoring date, due date, and answer date - $userSet->reduced_scoring_date($set->reduced_scoring_date() + 86400) - if defined($set->reduced_scoring_date()) && $set->reduced_scoring_date(); - $userSet->due_date($set->due_date() + 86400); - $userSet->answer_date($set->answer_date() + 86400); - - $db->putUserSet($userSet); - - #add time to the reduced scoring date, due date, and answer date of various versions - my @versions = $db->listSetVersions($userName, $setID); - - foreach my $version (@versions) { - - $set = $db->getSetVersion($userName, $setID, $version); - $set->reduced_scoring_date($set->reduced_scoring_date() + 86400) - if defined($set->reduced_scoring_date()) && $set->reduced_scoring_date(); - $set->due_date($set->due_date() + 86400); - $set->answer_date($set->answer_date() + 86400); - $db->putSetVersion($set); - - } - - $globalData->{ $self->{id} }--; - $globalUserAchievement->frozen_hash(nfreeze_base64($globalData)); - $db->putGlobalUserAchievement($globalUserAchievement); - - return; -} - -#Item to extend the due date on a gateway -package WeBWorK::AchievementItems::ResurrectGW; -our @ISA = qw(WeBWorK::AchievementItems); - -use WeBWorK::Utils qw(sortByName before after between x nfreeze_base64 thaw_base64 format_set_name_display); - -sub new { - my $class = shift; - my %options = @_; - - my $self = { - id => "ResurrectGW", - name => x("Necromancers Charm"), - description => x( - "Reopens any gateway test for an additional 24 hours. This allows you to take a test even if the close date has past. This item does not allow you to take additional versions of the test." - ), - %options, - }; - - bless($self, $class); - return $self; -} - -sub print_form { - my $self = shift; - my $sets = shift; - my $setProblemCount = shift; - my $r = shift; - my $db = $r->db; - - my $userName = $r->param('user'); - my $effectiveUserName = defined($r->param('effectiveUser')) ? $r->param('effectiveUser') : $userName; - my @setIDs = $db->listUserSets($effectiveUserName); - my @userSetIDs = map { [ $effectiveUserName, $_ ] } @setIDs; - my @unfilteredsets = $db->getMergedSets(@userSetIDs); - my @sets; - - # we going to have to find the gateways for these achievements. - foreach my $set (@unfilteredsets) { - if ($set->assignment_type() =~ /gateway/ - && $set->set_id !~ /,v\d+$/) - { - push @sets, $set->set_id; - } - } - - # Print gateways in a drop down. - return join( - '', - CGI::p($r->maketext('Resurrect which Gateway?')), - WeBWorK::AchievementItems::form_popup_menu_row( - id => 'resgw_gw_id', - label_text => $r->maketext('Gateway Name'), - values => \@sets, - labels => { map { $_ => format_set_name_display($_) } @sets }, - menu_attr => { dir => 'ltr' } - ) - ); -} - -sub use_item { - my $self = shift; - my $userName = shift; - my $r = shift; - my $db = $r->db; - my $ce = $r->ce; - - #validate data - my $globalUserAchievement = $db->getGlobalUserAchievement($userName); - return "No achievement data?!?!?!" - unless ($globalUserAchievement->frozen_hash); - my $globalData = thaw_base64($globalUserAchievement->frozen_hash); - - return "You are $self->{id} trying to use an item you don't have" - unless ($globalData->{ $self->{id} }); - - my $setID = $r->param('resgw_gw_id'); - return "You need to input a Gateway Name" - unless (defined $setID); - - my $set = $db->getUserSet($userName, $setID); - return "Couldn't find that set!" - unless ($set); - - #add time to the reduced scoring date, due date, and answer date; remove item from inventory - $set->reduced_scoring_date(time() + 86400) if defined($set->reduced_scoring_date()) && $set->reduced_scoring_date(); - $set->due_date(time() + 86400); - $set->answer_date(time() + 86400); - - $db->putUserSet($set); - - $globalData->{ $self->{id} }--; - $globalUserAchievement->frozen_hash(nfreeze_base64($globalData)); - $db->putGlobalUserAchievement($globalUserAchievement); - - return; + )->join(''); + + return $params{add_container} ? $r->tag('div', class => 'row mb-3', $row_contents) : $row_contents; +} + +END { + # Load the achievement item classes. + use WeBWorK::AchievementItems::AddNewTestGW; + use WeBWorK::AchievementItems::DoubleProb; + use WeBWorK::AchievementItems::DoubleSet; + use WeBWorK::AchievementItems::DuplicateProb; + use WeBWorK::AchievementItems::ExtendDueDateGW; + use WeBWorK::AchievementItems::ExtendDueDate; + use WeBWorK::AchievementItems::FullCreditProb; + use WeBWorK::AchievementItems::FullCreditSet; + use WeBWorK::AchievementItems::HalfCreditProb; + use WeBWorK::AchievementItems::HalfCreditSet; + use WeBWorK::AchievementItems::ReducedCred; + use WeBWorK::AchievementItems::ResetIncorrectAttempts; + use WeBWorK::AchievementItems::ResurrectGW; + use WeBWorK::AchievementItems::ResurrectHW; + use WeBWorK::AchievementItems::SuperExtendDueDate; + use WeBWorK::AchievementItems::Surprise; } 1; diff --git a/lib/WeBWorK/AchievementItems/AddNewTestGW.pm b/lib/WeBWorK/AchievementItems/AddNewTestGW.pm new file mode 100644 index 0000000000..e28cf4d23b --- /dev/null +++ b/lib/WeBWorK/AchievementItems/AddNewTestGW.pm @@ -0,0 +1,97 @@ +################################################################################ +# WeBWorK Online Homework Delivery System +# Copyright © 2000-2022 The WeBWorK Project, https://github.com/openwebwork +# +# This program is free software; you can redistribute it and/or modify it under +# the terms of either: (a) the GNU General Public License as published by the +# Free Software Foundation; either version 2, or (at your option) any later +# version, or (b) the "Artistic License" which comes with this package. +# +# This program is distributed in the hope that it will be useful, but WITHOUT +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +# FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the +# Artistic License for more details. +################################################################################ + +package WeBWorK::AchievementItems::AddNewTestGW; +use parent qw(WeBWorK::AchievementItems); + +# Item to allow students to take an addition test + +use strict; +use warnings; + +use WeBWorK::Utils qw(before between x nfreeze_base64 thaw_base64 format_set_name_display); + +sub new { + my ($class) = @_; + + return bless { + id => 'AddNewTestGW', + name => x('Oil of Cleansing'), + description => x( + 'Unlock an additional version of a Gateway Test. If used before the close date of ' + . 'the Gateway Test this will allow you to generate a new version of the test.' + ) + }, $class; +} + +sub print_form { + my ($self, $sets, $setProblemCount, $r) = @_; + my $db = $r->db; + + my $effectiveUserName = $r->param('effectiveUser') // $r->param('user'); + my @unfilteredsets = $db->getMergedSets(map { [ $effectiveUserName, $_ ] } $db->listUserSets($effectiveUserName)); + my @openGateways; + + # Find the template sets of open gateway quizzes. + for my $set (@unfilteredsets) { + push(@openGateways, [ format_set_name_display($set->set_id) => $set->set_id ]) + if $set->assignment_type =~ /gateway/ + && $set->set_id !~ /,v\d+$/ + && between($set->open_date, $set->due_date); + } + + return $r->c( + $r->tag('p', $r->maketext('Add a new test for which Gateway?')), + WeBWorK::AchievementItems::form_popup_menu_row( + $r, + id => 'adtgw_gw_id', + label_text => $r->maketext('Gateway Name'), + values => \@openGateways, + menu_attr => { dir => 'ltr' } + ) + )->join(''); +} + +sub use_item { + my ($self, $userName, $r) = @_; + my $db = $r->db; + my $ce = $r->ce; + + # Validate data + my $globalUserAchievement = $db->getGlobalUserAchievement($userName); + return 'No achievement data?!?!?!' unless $globalUserAchievement->frozen_hash; + + my $globalData = thaw_base64($globalUserAchievement->frozen_hash); + return "You are $self->{id} trying to use an item you don't have" unless $globalData->{ $self->{id} }; + + my $setID = $r->param('adtgw_gw_id'); + return 'You need to input a Gateway Name' unless defined $setID; + + my $set = $db->getMergedSet($userName, $setID); + my $userSet = $db->getUserSet($userName, $setID); + return q{Couldn't find that set!} unless $set && $userSet; + + # Add an additional version per interval to the set. + $userSet->versions_per_interval($set->versions_per_interval + 1) unless $set->versions_per_interval == 0; + $db->putUserSet($userSet); + + $globalData->{ $self->{id} }--; + $globalUserAchievement->frozen_hash(nfreeze_base64($globalData)); + $db->putGlobalUserAchievement($globalUserAchievement); + + return; +} + +1; diff --git a/lib/WeBWorK/AchievementItems/DoubleProb.pm b/lib/WeBWorK/AchievementItems/DoubleProb.pm new file mode 100644 index 0000000000..5410830095 --- /dev/null +++ b/lib/WeBWorK/AchievementItems/DoubleProb.pm @@ -0,0 +1,121 @@ +################################################################################ +# WeBWorK Online Homework Delivery System +# Copyright © 2000-2022 The WeBWorK Project, https://github.com/openwebwork +# +# This program is free software; you can redistribute it and/or modify it under +# the terms of either: (a) the GNU General Public License as published by the +# Free Software Foundation; either version 2, or (at your option) any later +# version, or (b) the "Artistic License" which comes with this package. +# +# This program is distributed in the hope that it will be useful, but WITHOUT +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +# FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the +# Artistic License for more details. +################################################################################ + +package WeBWorK::AchievementItems::DoubleProb; +use parent qw(WeBWorK::AchievementItems); + +# Item to make a problem worth double. + +use strict; +use warnings; + +use WeBWorK::Utils qw(between x nfreeze_base64 thaw_base64 format_set_name_display); + +sub new { + my ($class) = @_; + + return bless { + id => 'DoubleProb', + name => x('Cupcake of Enlargement'), + description => x('Causes a single homework problem to be worth twice as much.') + }, $class; +} + +sub print_form { + my ($self, $sets, $setProblemCount, $r) = @_; + + # Construct a dropdown with open sets and another with problems. + # Javascript ensures the appropriate number of problems are shown for the selected set. + + my @openSets; + my $maxProblems = 0; + + for my $i (0 .. $#$sets) { + if (between($sets->[$i]->open_date, $sets->[$i]->due_date) && $sets->[$i]->assignment_type eq 'default') { + push( + @openSets, + [ + format_set_name_display($sets->[$i]->set_id) => $sets->[$i]->set_id, + data => { max => $setProblemCount->[$i] } + ] + ); + $maxProblems = $setProblemCount->[$i] if $setProblemCount->[$i] > $maxProblems; + } + } + + my @problemIDs; + + for my $i (1 .. $maxProblems) { + push(@problemIDs, [ $i => $i, $i > $openSets[0][3]{max} ? (style => 'display:none') : () ]); + } + + return $r->c( + $r->tag( + 'p', + $r->maketext( + 'Please choose the set name and problem number of the question which should have its weight doubled.') + ), + WeBWorK::AchievementItems::form_popup_menu_row( + $r, + id => 'dbp_set_id', + label_text => $r->maketext('Set Name'), + values => \@openSets, + menu_attr => { dir => 'ltr', data => { problems => 'dbp_problem_id' } } + ), + WeBWorK::AchievementItems::form_popup_menu_row( + $r, + id => 'dbp_problem_id', + label_text => $r->maketext('Problem Number'), + values => \@problemIDs, + menu_container_attr => { class => 'col-3' } + ) + )->join(''); +} + +sub use_item { + my ($self, $userName, $r) = @_; + my $db = $r->db; + my $ce = $r->ce; + + # Validate data + + my $globalUserAchievement = $db->getGlobalUserAchievement($userName); + return 'No achievement data?!?!?!' unless $globalUserAchievement->frozen_hash; + + my $globalData = thaw_base64($globalUserAchievement->frozen_hash); + return "You are $self->{id} trying to use an item you don't have" unless $globalData->{ $self->{id} }; + + my $setID = $r->param('dbp_set_id'); + return 'You need to input a Set Name' unless defined $setID; + + my $problemID = $r->param('dbp_problem_id'); + return 'You need to input a Problem Number' unless $problemID; + + my $globalproblem = $db->getMergedProblem($userName, $setID, $problemID); + my $problem = $db->getUserProblem($userName, $setID, $problemID); + return 'There was an error accessing that problem.' unless $globalproblem && $problem; + + # Double the value of the problem. + $problem->value($globalproblem->value * 2); + $db->putUserProblem($problem); + + $globalData->{ $self->{id} }--; + $globalUserAchievement->frozen_hash(nfreeze_base64($globalData)); + $db->putGlobalUserAchievement($globalUserAchievement); + + return; +} + +1; diff --git a/lib/WeBWorK/AchievementItems/DoubleSet.pm b/lib/WeBWorK/AchievementItems/DoubleSet.pm new file mode 100644 index 0000000000..bc1d4dcdce --- /dev/null +++ b/lib/WeBWorK/AchievementItems/DoubleSet.pm @@ -0,0 +1,95 @@ +################################################################################ +# WeBWorK Online Homework Delivery System +# Copyright © 2000-2022 The WeBWorK Project, https://github.com/openwebwork +# +# This program is free software; you can redistribute it and/or modify it under +# the terms of either: (a) the GNU General Public License as published by the +# Free Software Foundation; either version 2, or (at your option) any later +# version, or (b) the "Artistic License" which comes with this package. +# +# This program is distributed in the hope that it will be useful, but WITHOUT +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +# FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the +# Artistic License for more details. +################################################################################ + +package WeBWorK::AchievementItems::DoubleSet; +use parent qw(WeBWorK::AchievementItems); + +# Item to make a homework set worth twice as much + +use strict; +use warnings; + +use WeBWorK::Utils qw(between x nfreeze_base64 thaw_base64 format_set_name_display); + +sub new { + my ($class) = @_; + + return bless { + id => 'DoubleSet', + name => x('Cake of Enlargement'), + description => x('Cause the selected homework set to count for twice as many points as it normally would.') + }, $class; +} + +sub print_form { + my ($self, $sets, $setProblemCount, $r) = @_; + + my @openSets; + + for my $i (0 .. $#$sets) { + push(@openSets, [ format_set_name_display($sets->[$i]->set_id) => $sets->[$i]->set_id ]) + if (between($sets->[$i]->open_date, $sets->[$i]->due_date) && $sets->[$i]->assignment_type eq 'default'); + } + + return $r->c( + $r->tag('p', $r->maketext('Choose the set which you would like to be worth twice as much.')), + WeBWorK::AchievementItems::form_popup_menu_row( + $r, + id => 'dub_set_id', + label_text => $r->maketext('Set Name'), + values => \@openSets, + menu_attr => { dir => 'ltr' } + ) + )->join(''); +} + +sub use_item { + my ($self, $userName, $r) = @_; + my $db = $r->db; + my $ce = $r->ce; + + # Validate data + + my $globalUserAchievement = $db->getGlobalUserAchievement($userName); + return 'No achievement data?!?!?!' unless $globalUserAchievement->frozen_hash; + + my $globalData = thaw_base64($globalUserAchievement->frozen_hash); + return "You are $self->{id} trying to use an item you don't have" unless $globalData->{ $self->{id} }; + + my $setID = $r->param('dub_set_id'); + return 'You need to input a Set Name' unless defined $setID; + + my $set = $db->getMergedSet($userName, $setID); + return q{Couldn't find that set!} unless $set; + + my @probIDs = $db->listUserProblems($userName, $setID); + + for my $probID (@probIDs) { + my $globalproblem = $db->getMergedProblem($userName, $setID, $probID); + my $problem = $db->getUserProblem($userName, $setID, $probID); + + # Double the problem value. + $problem->value($globalproblem->value * 2); + $db->putUserProblem($problem); + } + + $globalData->{ $self->{id} }--; + $globalUserAchievement->frozen_hash(nfreeze_base64($globalData)); + $db->putGlobalUserAchievement($globalUserAchievement); + + return; +} + +1; diff --git a/lib/WeBWorK/AchievementItems/DuplicateProb.pm b/lib/WeBWorK/AchievementItems/DuplicateProb.pm new file mode 100644 index 0000000000..4532e72bdf --- /dev/null +++ b/lib/WeBWorK/AchievementItems/DuplicateProb.pm @@ -0,0 +1,145 @@ +################################################################################ +# WeBWorK Online Homework Delivery System +# Copyright © 2000-2022 The WeBWorK Project, https://github.com/openwebwork +# +# This program is free software; you can redistribute it and/or modify it under +# the terms of either: (a) the GNU General Public License as published by the +# Free Software Foundation; either version 2, or (at your option) any later +# version, or (b) the "Artistic License" which comes with this package. +# +# This program is distributed in the hope that it will be useful, but WITHOUT +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +# FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the +# Artistic License for more details. +################################################################################ + +package WeBWorK::AchievementItems::DuplicateProb; +use parent qw(WeBWorK::AchievementItems); + +# Item to turn one problem into another problem + +use strict; +use warnings; + +use WeBWorK::Utils qw(between x nfreeze_base64 thaw_base64 format_set_name_display); + +sub new { + my ($class, $r) = @_; + + return bless { + id => 'DuplicateProb', + name => x('Box of Transmogrification'), + description => x('Causes a homework problem to become a clone of another problem from the same set.') + }, $class; +} + +sub print_form { + my ($self, $sets, $setProblemCount, $r) = @_; + + # Show open sets and allow for a choice of two problems from the set. + + my @openSets; + my $maxProblems = 0; + + for my $i (0 .. $#$sets) { + if (between($sets->[$i]->open_date, $sets->[$i]->due_date) && $sets->[$i]->assignment_type eq 'default') { + push( + @openSets, + [ + format_set_name_display($sets->[$i]->set_id) => $sets->[$i]->set_id, + data => { max => $setProblemCount->[$i] } + ] + ); + $maxProblems = $setProblemCount->[$i] if $setProblemCount->[$i] > $maxProblems; + } + } + + my @problemIDs; + + for my $i (1 .. $maxProblems) { + push(@problemIDs, [ $i => $i, $i > $openSets[0][3]{max} ? (style => 'display:none') : () ]); + } + + return $r->c( + $r->tag( + 'p', + $r->maketext( + 'Please choose the set, the problem you would like to copy, ' + . 'and the problem you would like to copy it to.' + ) + ), + WeBWorK::AchievementItems::form_popup_menu_row( + $r, + id => 'tran_set_id', + label_text => $r->maketext('Set Name'), + values => \@openSets, + menu_attr => { + dir => 'ltr', + data => { problems => 'tran_problem_id', problems2 => 'tran_problem_id2' } + } + ), + $r->tag( + 'div', + class => 'row mb-3', + $r->c( + WeBWorK::AchievementItems::form_popup_menu_row( + $r, + id => 'tran_problem_id', + values => \@problemIDs, + label_text => $r->maketext('Copy this Problem'), + menu_container_attr => { class => 'col-2 ps-0' }, + add_container => 0 + ), + WeBWorK::AchievementItems::form_popup_menu_row( + $r, + id => 'tran_problem_id2', + values => \@problemIDs, + label_text => $r->maketext('To this Problem'), + menu_container_attr => { class => 'col-2 ps-0' }, + add_container => 0 + ) + )->join('') + ) + )->join(''); +} + +sub use_item { + my ($self, $userName, $r) = @_; + my $db = $r->db; + my $ce = $r->ce; + + # Validate data + + my $globalUserAchievement = $db->getGlobalUserAchievement($userName); + return 'No achievement data?!?!?!' unless $globalUserAchievement->frozen_hash; + + my $globalData = thaw_base64($globalUserAchievement->frozen_hash); + return "You are $self->{id} trying to use an item you don't have" unless $globalData->{ $self->{id} }; + + my $setID = $r->param('tran_set_id'); + return 'You need to input a Set Name' unless defined $setID; + + my $problemID = $r->param('tran_problem_id'); + return 'You need to input a Problem Number' unless $problemID; + + my $problemID2 = $r->param('tran_problem_id2'); + return 'You need to input a Problem Number' unless $problemID2; + + return 'You need to pick 2 different problems!' if $problemID == $problemID2; + + my $problem = $db->getMergedProblem($userName, $setID, $problemID); + my $problem2 = $db->getUserProblem($userName, $setID, $problemID2); + return 'There was an error accessing those problems.' unless $problem && $problem2; + + # Set the source of the second problem to that of the first problem. + $problem2->source_file($problem->source_file); + $db->putUserProblem($problem2); + + $globalData->{ $self->{id} }--; + $globalUserAchievement->frozen_hash(nfreeze_base64($globalData)); + $db->putGlobalUserAchievement($globalUserAchievement); + + return; +} + +1; diff --git a/lib/WeBWorK/AchievementItems/ExtendDueDate.pm b/lib/WeBWorK/AchievementItems/ExtendDueDate.pm new file mode 100644 index 0000000000..fb44e24f6c --- /dev/null +++ b/lib/WeBWorK/AchievementItems/ExtendDueDate.pm @@ -0,0 +1,91 @@ +################################################################################ +# WeBWorK Online Homework Delivery System +# Copyright © 2000-2022 The WeBWorK Project, https://github.com/openwebwork +# +# This program is free software; you can redistribute it and/or modify it under +# the terms of either: (a) the GNU General Public License as published by the +# Free Software Foundation; either version 2, or (at your option) any later +# version, or (b) the "Artistic License" which comes with this package. +# +# This program is distributed in the hope that it will be useful, but WITHOUT +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +# FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the +# Artistic License for more details. +################################################################################ + +package WeBWorK::AchievementItems::ExtendDueDate; +use parent qw(WeBWorK::AchievementItems); + +# Item to extend a close date by 24 hours. + +use strict; +use warnings; + +use WeBWorK::Utils qw(between x nfreeze_base64 thaw_base64 format_set_name_display); + +sub new { + my ($class) = @_; + + return bless { + id => 'ExtendDueDate', + name => x('Tunic of Extension'), + description => x('Adds 24 hours to the close date of a homework.') + }, $class; +} + +sub print_form { + my ($self, $sets, $setProblemCount, $r) = @_; + + my @openSets; + + for my $i (0 .. $#$sets) { + push(@openSets, [ format_set_name_display($sets->[$i]->set_id) => $sets->[$i]->set_id ]) + if (between($sets->[$i]->open_date, $sets->[$i]->due_date) && $sets->[$i]->assignment_type eq 'default'); + } + + return $r->c( + $r->tag('p', $r->maketext('Choose the set whose close date you would like to extend.')), + WeBWorK::AchievementItems::form_popup_menu_row( + $r, + id => 'ext_set_id', + label_text => $r->maketext('Set Name'), + values => \@openSets, + menu_attr => { dir => 'ltr' } + ) + )->join(''); +} + +sub use_item { + my ($self, $userName, $r) = @_; + my $db = $r->db; + my $ce = $r->ce; + + # Validate data + + my $globalUserAchievement = $db->getGlobalUserAchievement($userName); + return 'No achievement data?!?!?!' unless $globalUserAchievement->frozen_hash; + + my $globalData = thaw_base64($globalUserAchievement->frozen_hash); + return "You are $self->{id} trying to use an item you don't have" unless $globalData->{ $self->{id} }; + + my $setID = $r->param('ext_set_id'); + return 'You need to input a Set Name' unless defined $setID; + + my $set = $db->getMergedSet($userName, $setID); + my $userSet = $db->getUserSet($userName, $setID); + return q{Couldn't find that set!} unless $set && $userSet; + + # Add time to the reduced scoring date, due date, and answer date. + $userSet->reduced_scoring_date($set->reduced_scoring_date() + 86400) if $set->reduced_scoring_date; + $userSet->due_date($set->due_date() + 86400); + $userSet->answer_date($set->answer_date() + 86400); + $db->putUserSet($userSet); + + $globalData->{ $self->{id} }--; + $globalUserAchievement->frozen_hash(nfreeze_base64($globalData)); + $db->putGlobalUserAchievement($globalUserAchievement); + + return; +} + +1; diff --git a/lib/WeBWorK/AchievementItems/ExtendDueDateGW.pm b/lib/WeBWorK/AchievementItems/ExtendDueDateGW.pm new file mode 100644 index 0000000000..db27bc216c --- /dev/null +++ b/lib/WeBWorK/AchievementItems/ExtendDueDateGW.pm @@ -0,0 +1,111 @@ +################################################################################ +# WeBWorK Online Homework Delivery System +# Copyright © 2000-2022 The WeBWorK Project, https://github.com/openwebwork +# +# This program is free software; you can redistribute it and/or modify it under +# the terms of either: (a) the GNU General Public License as published by the +# Free Software Foundation; either version 2, or (at your option) any later +# version, or (b) the "Artistic License" which comes with this package. +# +# This program is distributed in the hope that it will be useful, but WITHOUT +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +# FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the +# Artistic License for more details. +################################################################################ + +package WeBWorK::AchievementItems::ExtendDueDateGW; +use parent qw(WeBWorK::AchievementItems); + +# Item to extend the due date on a gateway + +use strict; +use warnings; + +use WeBWorK::Utils qw(between x nfreeze_base64 thaw_base64 format_set_name_display); + +sub new { + my ($class) = @_; + + return bless { + id => 'ExtendDueDateGW', + name => x('Amulet of Extension'), + description => x( + 'Extends the close date of a gateway test by 24 hours. Note: The test must still be open for this to work.') + }, $class; +} + +sub print_form { + my ($self, $sets, $setProblemCount, $r) = @_; + my $db = $r->db; + + my $effectiveUserName = $r->param('effectiveUser') // $r->param('user'); + my @unfilteredsets = $db->getMergedSets(map { [ $effectiveUserName, $_ ] } $db->listUserSets($effectiveUserName)); + my @openGateways; + + # Find the template sets of open gateway quizzes. + for my $set (@unfilteredsets) { + push(@openGateways, [ format_set_name_display($set->set_id) => $set->set_id ]) + if $set->assignment_type =~ /gateway/ + && $set->set_id !~ /,v\d+$/ + && between($set->open_date, $set->due_date); + } + + return $r->c( + $r->tag('p', $r->maketext('Extend the close date for which Gateway?')), + WeBWorK::AchievementItems::form_popup_menu_row( + $r, + id => 'eddgw_gw_id', + label_text => $r->maketext('Gateway Name'), + values => \@openGateways, + menu_attr => { dir => 'ltr' } + ) + )->join(''); +} + +sub use_item { + my ($self, $userName, $r) = @_; + my $db = $r->db; + my $ce = $r->ce; + + # Validate data + + my $globalUserAchievement = $db->getGlobalUserAchievement($userName); + return 'No achievement data?!?!?!' unless $globalUserAchievement->frozen_hash; + + my $globalData = thaw_base64($globalUserAchievement->frozen_hash); + return "You are $self->{id} trying to use an item you don't have" unless $globalData->{ $self->{id} }; + + my $setID = $r->param('eddgw_gw_id'); + return 'You need to input a Gateway Name' unless defined $setID; + + my $set = $db->getMergedSet($userName, $setID); + my $userSet = $db->getUserSet($userName, $setID); + return q{Couldn't find that set!} unless $set && $userSet; + + # Add time to the reduced scoring date, due date, and answer date. + $userSet->reduced_scoring_date($set->reduced_scoring_date() + 86400) + if defined($set->reduced_scoring_date()) && $set->reduced_scoring_date(); + $userSet->due_date($set->due_date() + 86400); + $userSet->answer_date($set->answer_date() + 86400); + $db->putUserSet($userSet); + + # Add time to the reduced scoring date, due date, and answer date for all versions. + my @versions = $db->listSetVersions($userName, $setID); + + for my $version (@versions) { + $set = $db->getSetVersion($userName, $setID, $version); + $set->reduced_scoring_date($set->reduced_scoring_date() + 86400) + if defined($set->reduced_scoring_date()) && $set->reduced_scoring_date(); + $set->due_date($set->due_date() + 86400); + $set->answer_date($set->answer_date() + 86400); + $db->putSetVersion($set); + } + + $globalData->{ $self->{id} }--; + $globalUserAchievement->frozen_hash(nfreeze_base64($globalData)); + $db->putGlobalUserAchievement($globalUserAchievement); + + return; +} + +1; diff --git a/lib/WeBWorK/AchievementItems/FullCreditProb.pm b/lib/WeBWorK/AchievementItems/FullCreditProb.pm new file mode 100644 index 0000000000..14422746a2 --- /dev/null +++ b/lib/WeBWorK/AchievementItems/FullCreditProb.pm @@ -0,0 +1,120 @@ +################################################################################ +# WeBWorK Online Homework Delivery System +# Copyright © 2000-2022 The WeBWorK Project, https://github.com/openwebwork +# +# This program is free software; you can redistribute it and/or modify it under +# the terms of either: (a) the GNU General Public License as published by the +# Free Software Foundation; either version 2, or (at your option) any later +# version, or (b) the "Artistic License" which comes with this package. +# +# This program is distributed in the hope that it will be useful, but WITHOUT +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +# FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the +# Artistic License for more details. +################################################################################ + +package WeBWorK::AchievementItems::FullCreditProb; +use parent qw(WeBWorK::AchievementItems); + +# Item to give full credit on a single problem + +use strict; +use warnings; + +use WeBWorK::Utils qw(between x nfreeze_base64 thaw_base64 format_set_name_display); + +sub new { + my ($class) = @_; + + return bless { + id => 'FullCreditProb', + name => x('Greater Rod of Revelation'), + description => x('Gives full credit on a single homework problem.') + }, $class; +} + +sub print_form { + my ($self, $sets, $setProblemCount, $r) = @_; + + # Construct a dropdown with open sets and another with problems. + # Javascript ensures the appropriate number of problems are shown for the selected set. + + my @openSets; + my $maxProblems = 0; + + for my $i (0 .. $#$sets) { + if (between($sets->[$i]->open_date, $sets->[$i]->due_date) && $sets->[$i]->assignment_type eq 'default') { + push( + @openSets, + [ + format_set_name_display($sets->[$i]->set_id) => $sets->[$i]->set_id, + data => { max => $setProblemCount->[$i] } + ] + ); + $maxProblems = $setProblemCount->[$i] if $setProblemCount->[$i] > $maxProblems; + } + } + + my @problemIDs; + + for my $i (1 .. $maxProblems) { + push(@problemIDs, [ $i => $i, $i > $openSets[0][3]{max} ? (style => 'display:none') : () ]); + } + + return $r->c( + $r->tag( + 'p', + $r->maketext( + 'Please choose the set name and problem number of the question which should be given full credit.') + ), + WeBWorK::AchievementItems::form_popup_menu_row( + $r, + id => 'fcp_set_id', + label_text => $r->maketext('Set Name'), + values => \@openSets, + menu_attr => { dir => 'ltr', data => { problems => 'fcp_problem_id' } } + ), + WeBWorK::AchievementItems::form_popup_menu_row( + $r, + id => 'fcp_problem_id', + label_text => $r->maketext('Problem Number'), + values => \@problemIDs, + menu_container_attr => { class => 'col-3' } + ) + )->join(''); +} + +sub use_item { + my ($self, $userName, $r) = @_; + my $db = $r->db; + my $ce = $r->ce; + + # Validate data + + my $globalUserAchievement = $db->getGlobalUserAchievement($userName); + return 'No achievement data?!?!?!' unless $globalUserAchievement->frozen_hash; + + my $globalData = thaw_base64($globalUserAchievement->frozen_hash); + return "You are $self->{id} trying to use an item you don't have" unless $globalData->{ $self->{id} }; + + my $setID = $r->param('fcp_set_id'); + return 'You need to input a Set Name' unless defined $setID; + + my $problemID = $r->param('fcp_problem_id'); + return 'You need to input a Problem Number' unless $problemID; + + my $problem = $db->getUserProblem($userName, $setID, $problemID); + return 'There was an error accessing that problem.' unless $problem; + + # Set the status of the problem to one. + $problem->status(1); + $db->putUserProblem($problem); + + $globalData->{ $self->{id} }--; + $globalUserAchievement->frozen_hash(nfreeze_base64($globalData)); + $db->putGlobalUserAchievement($globalUserAchievement); + + return; +} + +1; diff --git a/lib/WeBWorK/AchievementItems/FullCreditSet.pm b/lib/WeBWorK/AchievementItems/FullCreditSet.pm new file mode 100644 index 0000000000..b6b4a475cb --- /dev/null +++ b/lib/WeBWorK/AchievementItems/FullCreditSet.pm @@ -0,0 +1,91 @@ +################################################################################ +# WeBWorK Online Homework Delivery System +# Copyright © 2000-2022 The WeBWorK Project, https://github.com/openwebwork +# +# This program is free software; you can redistribute it and/or modify it under +# the terms of either: (a) the GNU General Public License as published by the +# Free Software Foundation; either version 2, or (at your option) any later +# version, or (b) the "Artistic License" which comes with this package. +# +# This program is distributed in the hope that it will be useful, but WITHOUT +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +# FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the +# Artistic License for more details. +################################################################################ + +package WeBWorK::AchievementItems::FullCreditSet; +use parent qw(WeBWorK::AchievementItems); + +# Item to give half credit on all problems in a homework set. + +use strict; +use warnings; + +use WeBWorK::Utils qw(between x nfreeze_base64 thaw_base64 format_set_name_display); + +sub new { + my ($class) = @_; + + return bless { + id => 'FullCreditSet', + name => x('Greater Tome of Enlightenment'), + description => x('Gives full credit on every problem in a set.') + }, $class; +} + +sub print_form { + my ($self, $sets, $setProblemCount, $r) = @_; + + my @openSets; + + for my $i (0 .. $#$sets) { + push(@openSets, [ format_set_name_display($sets->[$i]->set_id) => $sets->[$i]->set_id ]) + if (between($sets->[$i]->open_date, $sets->[$i]->due_date) && $sets->[$i]->assignment_type eq 'default'); + } + + return $r->c( + $r->tag('p', $r->maketext('Please choose the set for which all problems should be given full credit.')), + WeBWorK::AchievementItems::form_popup_menu_row( + $r, + id => 'fcs_set_id', + label_text => $r->maketext('Set Name'), + values => \@openSets, + menu_attr => { dir => 'ltr' } + ) + )->join(''); +} + +sub use_item { + my ($self, $userName, $r) = @_; + my $db = $r->db; + my $ce = $r->ce; + + # Validate data + + my $globalUserAchievement = $db->getGlobalUserAchievement($userName); + return 'No achievement data?!?!?!' unless $globalUserAchievement->frozen_hash; + + my $globalData = thaw_base64($globalUserAchievement->frozen_hash); + return "You are $self->{id} trying to use an item you don't have" unless $globalData->{ $self->{id} }; + + my $setID = $r->param('fcs_set_id'); + return 'You need to input a Set Name' unless defined $setID; + + my @probIDs = $db->listUserProblems($userName, $setID); + + for my $probID (@probIDs) { + my $problem = $db->getUserProblem($userName, $setID, $probID); + + # Set status to 1. + $problem->status(1); + $db->putUserProblem($problem); + } + + $globalData->{ $self->{id} }--; + $globalUserAchievement->frozen_hash(nfreeze_base64($globalData)); + $db->putGlobalUserAchievement($globalUserAchievement); + + return; +} + +1; diff --git a/lib/WeBWorK/AchievementItems/HalfCreditProb.pm b/lib/WeBWorK/AchievementItems/HalfCreditProb.pm new file mode 100644 index 0000000000..2370c903c4 --- /dev/null +++ b/lib/WeBWorK/AchievementItems/HalfCreditProb.pm @@ -0,0 +1,126 @@ +################################################################################ +# WeBWorK Online Homework Delivery System +# Copyright © 2000-2022 The WeBWorK Project, https://github.com/openwebwork +# +# This program is free software; you can redistribute it and/or modify it under +# the terms of either: (a) the GNU General Public License as published by the +# Free Software Foundation; either version 2, or (at your option) any later +# version, or (b) the "Artistic License" which comes with this package. +# +# This program is distributed in the hope that it will be useful, but WITHOUT +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +# FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the +# Artistic License for more details. +################################################################################ + +package WeBWorK::AchievementItems::HalfCreditProb; +use parent qw(WeBWorK::AchievementItems); + +# Item to give half credit on a single problem. + +use strict; +use warnings; + +use WeBWorK::Utils qw(between x nfreeze_base64 thaw_base64 format_set_name_display); + +sub new { + my ($class) = @_; + + return bless { + id => 'HalfCreditProb', + name => x('Lesser Rod of Revelation'), + description => x('Gives half credit on a single homework problem.') + }, $class; +} + +sub print_form { + my ($self, $sets, $setProblemCount, $r) = @_; + + # Construct a dropdown with open sets and another with problems. + # Javascript ensures the appropriate number of problems are shown for the selected set. + + my @openSets; + my $maxProblems = 0; + + for my $i (0 .. $#$sets) { + if (between($sets->[$i]->open_date, $sets->[$i]->due_date) && $sets->[$i]->assignment_type eq 'default') { + push( + @openSets, + [ + format_set_name_display($sets->[$i]->set_id) => $sets->[$i]->set_id, + data => { max => $setProblemCount->[$i] } + ] + ); + $maxProblems = $setProblemCount->[$i] if $setProblemCount->[$i] > $maxProblems; + } + } + + my @problemIDs; + + for my $i (1 .. $maxProblems) { + push(@problemIDs, [ $i => $i, $i > $openSets[0][3]{max} ? (style => 'display:none') : () ]); + } + + return $r->c( + $r->tag( + 'p', + $r->maketext( + 'Please choose the set name and problem number of the question which should be given half credit.') + ), + WeBWorK::AchievementItems::form_popup_menu_row( + $r, + id => 'hcp_set_id', + label_text => $r->maketext('Set Name'), + values => \@openSets, + menu_attr => { dir => 'ltr', data => { problems => 'hcp_problem_id' } } + ), + WeBWorK::AchievementItems::form_popup_menu_row( + $r, + id => 'hcp_problem_id', + values => \@problemIDs, + label_text => $r->maketext('Problem Number'), + menu_container_attr => { class => 'col-3' } + ) + )->join(''); +} + +sub use_item { + my ($self, $userName, $r) = @_; + my $db = $r->db; + my $ce = $r->ce; + + # Validate data + + my $globalUserAchievement = $db->getGlobalUserAchievement($userName); + return 'No achievement data?!?!?!' unless $globalUserAchievement->frozen_hash; + + my $globalData = thaw_base64($globalUserAchievement->frozen_hash); + return "You are $self->{id} trying to use an item you don't have" unless $globalData->{ $self->{id} }; + + my $setID = $r->param('hcp_set_id'); + return 'You need to input a Set Name' unless defined $setID; + + my $problemID = $r->param('hcp_problem_id'); + return 'You need to input a Problem Number' unless $problemID; + + my $problem = $db->getUserProblem($userName, $setID, $problemID); + return 'There was an error accessing that problem.' unless $problem; + + # Add .5 to grade with max of 1 + + if ($problem->status < .5) { + $problem->status($problem->status + .5); + } else { + $problem->status(1); + } + + $db->putUserProblem($problem); + + $globalData->{ $self->{id} }--; + $globalUserAchievement->frozen_hash(nfreeze_base64($globalData)); + $db->putGlobalUserAchievement($globalUserAchievement); + + return; +} + +1; diff --git a/lib/WeBWorK/AchievementItems/HalfCreditSet.pm b/lib/WeBWorK/AchievementItems/HalfCreditSet.pm new file mode 100644 index 0000000000..fc27a6698c --- /dev/null +++ b/lib/WeBWorK/AchievementItems/HalfCreditSet.pm @@ -0,0 +1,95 @@ +################################################################################ +# WeBWorK Online Homework Delivery System +# Copyright © 2000-2022 The WeBWorK Project, https://github.com/openwebwork +# +# This program is free software; you can redistribute it and/or modify it under +# the terms of either: (a) the GNU General Public License as published by the +# Free Software Foundation; either version 2, or (at your option) any later +# version, or (b) the "Artistic License" which comes with this package. +# +# This program is distributed in the hope that it will be useful, but WITHOUT +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +# FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the +# Artistic License for more details. +################################################################################ + +package WeBWorK::AchievementItems::HalfCreditSet; +use parent qw(WeBWorK::AchievementItems); + +# Item to give half credit on all problems in a homework set. + +use strict; +use warnings; + +use WeBWorK::Utils qw(between x nfreeze_base64 thaw_base64 format_set_name_display); + +sub new { + my ($class) = @_; + + return bless { + id => 'HalfCreditSet', + name => x('Lesser Tome of Enlightenment'), + description => x('Gives half credit on every problem in a set.') + }, $class; +} + +sub print_form { + my ($self, $sets, $setProblemCount, $r) = @_; + + my @openSets; + + for my $i (0 .. $#$sets) { + push(@openSets, [ format_set_name_display($sets->[$i]->set_id) => $sets->[$i]->set_id ]) + if (between($sets->[$i]->open_date, $sets->[$i]->due_date) && $sets->[$i]->assignment_type eq 'default'); + } + + return $r->c( + $r->tag('p', $r->maketext('Please choose the set for which all problems should have half credit added.')), + WeBWorK::AchievementItems::form_popup_menu_row( + $r, + id => 'hcs_set_id', + label_text => $r->maketext('Set Name'), + values => \@openSets, + menu_attr => { dir => 'ltr' } + ) + )->join(''); +} + +sub use_item { + my ($self, $userName, $r) = @_; + my $db = $r->db; + my $ce = $r->ce; + + # Validate data + + my $globalUserAchievement = $db->getGlobalUserAchievement($userName); + return 'No achievement data?!?!?!' unless $globalUserAchievement->frozen_hash; + + my $globalData = thaw_base64($globalUserAchievement->frozen_hash); + return "You are $self->{id} trying to use an item you don't have" unless $globalData->{ $self->{id} }; + + my $setID = $r->param('hcs_set_id'); + return 'You need to input a Set Name' unless defined $setID; + + my @probIDs = $db->listUserProblems($userName, $setID); + + for my $probID (@probIDs) { + my $problem = $db->getUserProblem($userName, $setID, $probID); + + # Add .5 to grade with max of 1. + if ($problem->status < .5) { + $problem->status($problem->status + .5); + } else { + $problem->status(1); + } + $db->putUserProblem($problem); + } + + $globalData->{ $self->{id} }--; + $globalUserAchievement->frozen_hash(nfreeze_base64($globalData)); + $db->putGlobalUserAchievement($globalUserAchievement); + + return; +} + +1; diff --git a/lib/WeBWorK/AchievementItems/ReducedCred.pm b/lib/WeBWorK/AchievementItems/ReducedCred.pm new file mode 100644 index 0000000000..54c9ca15ce --- /dev/null +++ b/lib/WeBWorK/AchievementItems/ReducedCred.pm @@ -0,0 +1,101 @@ +################################################################################ +# WeBWorK Online Homework Delivery System +# Copyright © 2000-2022 The WeBWorK Project, https://github.com/openwebwork +# +# This program is free software; you can redistribute it and/or modify it under +# the terms of either: (a) the GNU General Public License as published by the +# Free Software Foundation; either version 2, or (at your option) any later +# version, or (b) the "Artistic License" which comes with this package. +# +# This program is distributed in the hope that it will be useful, but WITHOUT +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +# FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the +# Artistic License for more details. +################################################################################ + +package WeBWorK::AchievementItems::ReducedCred; +use parent qw(WeBWorK::AchievementItems); + +# Item to extend a close date by 24 hours for reduced credit +# Reduced scoring needs to be enabled for this item to work. + +use strict; +use warnings; + +use WeBWorK::Utils qw(after between x nfreeze_base64 thaw_base64 format_set_name_display); + +sub new { + my ($class) = @_; + + return bless { + id => 'ReducedCred', + name => x('Ring of Reduction'), + description => x( + 'Enable reduced scoring for a homework set. This will allow you to submit answers ' + . 'for partial credit for 24 hours after the close date.' + ) + }, $class; +} + +sub print_form { + my ($self, $sets, $setProblemCount, $r) = @_; + + my @openSets; + + for my $i (0 .. $#$sets) { + push(@openSets, [ format_set_name_display($sets->[$i]->set_id) => $sets->[$i]->set_id ]) + if (between($sets->[$i]->open_date, $sets->[$i]->due_date) && $sets->[$i]->assignment_type eq 'default'); + } + + return $r->c( + $r->tag('p', $r->maketext('Choose the set which you would like to enable partial credit for.')), + WeBWorK::AchievementItems::form_popup_menu_row( + $r, + id => 'red_set_id', + label_text => $r->maketext('Set Name'), + values => \@openSets, + menu_attr => { dir => 'ltr' } + ) + )->join(''); +} + +sub use_item { + my ($self, $userName, $r) = @_; + my $db = $r->db; + my $ce = $r->ce; + + # Validate data + + return q{This item won't work unless your instructor enables the reduced scoring feature. } + . 'Let your instructor know that you recieved this message.' + unless $ce->{pg}{ansEvalDefaults}{reducedScoringPeriod}; + + my $globalUserAchievement = $db->getGlobalUserAchievement($userName); + return "No achievement data?!?!?!" unless $globalUserAchievement->frozen_hash; + + my $globalData = thaw_base64($globalUserAchievement->frozen_hash); + return "You are $self->{id} trying to use an item you don't have" unless $globalData->{ $self->{id} }; + + my $setID = $r->param('red_set_id'); + return "You need to input a Set Name" unless defined $setID; + + my $set = $db->getMergedSet($userName, $setID); + my $userSet = $db->getUserSet($userName, $setID); + return "Couldn't find that set!" unless $set && $userSet; + + # Enable reduced scoring on the set and add the reduced scoring period to the due date. + my $additionalTime = 60 * $ce->{pg}{ansEvalDefaults}{reducedScoringPeriod}; + $userSet->enable_reduced_scoring(1); + $userSet->reduced_scoring_date($set->due_date()); + $userSet->due_date($set->due_date() + $additionalTime); + $userSet->answer_date($set->answer_date() + $additionalTime); + $db->putUserSet($userSet); + + $globalData->{ $self->{id} }--; + $globalUserAchievement->frozen_hash(nfreeze_base64($globalData)); + $db->putGlobalUserAchievement($globalUserAchievement); + + return; +} + +1; diff --git a/lib/WeBWorK/AchievementItems/ResetIncorrectAttempts.pm b/lib/WeBWorK/AchievementItems/ResetIncorrectAttempts.pm new file mode 100644 index 0000000000..230d421df7 --- /dev/null +++ b/lib/WeBWorK/AchievementItems/ResetIncorrectAttempts.pm @@ -0,0 +1,122 @@ +################################################################################ +# WeBWorK Online Homework Delivery System +# Copyright © 2000-2022 The WeBWorK Project, https://github.com/openwebwork +# +# This program is free software; you can redistribute it and/or modify it under +# the terms of either: (a) the GNU General Public License as published by the +# Free Software Foundation; either version 2, or (at your option) any later +# version, or (b) the "Artistic License" which comes with this package. +# +# This program is distributed in the hope that it will be useful, but WITHOUT +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +# FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the +# Artistic License for more details. +################################################################################ + +package WeBWorK::AchievementItems::ResetIncorrectAttempts; +use parent qw(WeBWorK::AchievementItems); + +# Item to reset number of incorrect attempts. + +use strict; +use warnings; + +use WeBWorK::Utils qw(between x nfreeze_base64 thaw_base64 format_set_name_display); + +sub new { + my ($class) = @_; + + return bless { + id => 'ResetIncorrectAttempts', + name => x('Potion of Forgetfulness'), + description => x('Resets the number of incorrect attempts on a single homework problem.') + }, $class; +} + +sub print_form { + my ($self, $sets, $setProblemCount, $r) = @_; + + # Construct a dropdown with open sets and another with problems. + # Javascript ensures the appropriate number of problems are shown for the selected set. + + my @openSets; + my $maxProblems = 0; + + for my $i (0 .. $#$sets) { + if (between($sets->[$i]->open_date, $sets->[$i]->due_date) && $sets->[$i]->assignment_type eq 'default') { + push( + @openSets, + [ + format_set_name_display($sets->[$i]->set_id) => $sets->[$i]->set_id, + data => { max => $setProblemCount->[$i] } + ] + ); + $maxProblems = $setProblemCount->[$i] if $setProblemCount->[$i] > $maxProblems; + } + } + + my @problemIDs; + + for my $i (1 .. $maxProblems) { + push(@problemIDs, [ $i => $i, $i > $openSets[0][3]{max} ? (style => 'display:none') : () ]); + } + + return $r->c( + $r->tag( + 'p', + $r->maketext( + 'Please choose the set name and problem number of the question which ' + . 'should have its incorrect attempt count reset.' + ) + ), + WeBWorK::AchievementItems::form_popup_menu_row( + $r, + id => 'ria_set_id', + label_text => $r->maketext('Set Name'), + values => \@openSets, + menu_attr => { dir => 'ltr', data => { problems => 'ria_problem_id' } } + ), + WeBWorK::AchievementItems::form_popup_menu_row( + $r, + id => 'ria_problem_id', + label_text => $r->maketext('Problem Number'), + values => \@problemIDs, + menu_container_attr => { class => 'col-3' } + ) + )->join(''); +} + +sub use_item { + my ($self, $userName, $r) = @_; + my $db = $r->db; + my $ce = $r->ce; + + # Validate data + + my $globalUserAchievement = $db->getGlobalUserAchievement($userName); + return 'No achievement data?!?!?!' unless $globalUserAchievement->frozen_hash; + + my $globalData = thaw_base64($globalUserAchievement->frozen_hash); + return "You are $self->{id} trying to use an item you don't have" unless $globalData->{ $self->{id} }; + + my $setID = $r->param('ria_set_id'); + return 'You need to input a Set Name' unless defined $setID; + + my $problemID = $r->param('ria_problem_id'); + return 'You need to input a Problem Number' unless $problemID; + + my $problem = $db->getUserProblem($userName, $setID, $problemID); + return 'There was an error accessing that problem.' unless $problem; + + # Set the number of incorrect attempts to zero. + $problem->num_incorrect(0); + $db->putUserProblem($problem); + + $globalData->{ $self->{id} }--; + $globalUserAchievement->frozen_hash(nfreeze_base64($globalData)); + $db->putGlobalUserAchievement($globalUserAchievement); + + return; +} + +1; diff --git a/lib/WeBWorK/AchievementItems/ResurrectGW.pm b/lib/WeBWorK/AchievementItems/ResurrectGW.pm new file mode 100644 index 0000000000..7cae8cd287 --- /dev/null +++ b/lib/WeBWorK/AchievementItems/ResurrectGW.pm @@ -0,0 +1,97 @@ +################################################################################ +# WeBWorK Online Homework Delivery System +# Copyright © 2000-2022 The WeBWorK Project, https://github.com/openwebwork +# +# This program is free software; you can redistribute it and/or modify it under +# the terms of either: (a) the GNU General Public License as published by the +# Free Software Foundation; either version 2, or (at your option) any later +# version, or (b) the "Artistic License" which comes with this package. +# +# This program is distributed in the hope that it will be useful, but WITHOUT +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +# FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the +# Artistic License for more details. +################################################################################ + +package WeBWorK::AchievementItems::ResurrectGW; +use parent qw(WeBWorK::AchievementItems); + +# Item to extend the due date on a gateway + +use strict; +use warnings; + +use WeBWorK::Utils qw(x nfreeze_base64 thaw_base64 format_set_name_display); + +sub new { + my ($class) = @_; + + return bless { + id => 'ResurrectGW', + name => x('Necromancers Charm'), + description => x( + 'Reopens any gateway test for an additional 24 hours. This allows you to take a test even if the ' + . 'close date has past. This item does not allow you to take additional versions of the test.' + ) + }, $class; +} + +sub print_form { + my ($self, $sets, $setProblemCount, $r) = @_; + my $db = $r->db; + + my $effectiveUserName = $r->param('effectiveUser') // $r->param('user'); + my @unfilteredsets = $db->getMergedSets(map { [ $effectiveUserName, $_ ] } $db->listUserSets($effectiveUserName)); + my @sets; + + # Find the template sets of gateway quizzes. + for my $set (@unfilteredsets) { + push(@sets, [ format_set_name_display($set->set_id) => $set->set_id ]) + if ($set->assignment_type =~ /gateway/ && $set->set_id !~ /,v\d+$/); + } + + return $r->c( + $r->tag('p', $r->maketext('Resurrect which Gateway?')), + WeBWorK::AchievementItems::form_popup_menu_row( + $r, + id => 'resgw_gw_id', + label_text => $r->maketext('Gateway Name'), + values => \@sets, + menu_attr => { dir => 'ltr' } + ) + )->join(''); +} + +sub use_item { + my ($self, $userName, $r) = @_; + my $db = $r->db; + my $ce = $r->ce; + + # Validate data + + my $globalUserAchievement = $db->getGlobalUserAchievement($userName); + return 'No achievement data?!?!?!' unless $globalUserAchievement->frozen_hash; + + my $globalData = thaw_base64($globalUserAchievement->frozen_hash); + return "You are $self->{id} trying to use an item you don't have" unless $globalData->{ $self->{id} }; + + my $setID = $r->param('resgw_gw_id'); + return 'You need to input a Gateway Name' unless defined $setID; + + my $set = $db->getUserSet($userName, $setID); + return q{Couldn't find that set!} unless $set; + + # Add time to the reduced scoring date, due date, and answer date. + $set->reduced_scoring_date(time + 86400) if defined($set->reduced_scoring_date()) && $set->reduced_scoring_date(); + $set->due_date(time + 86400); + $set->answer_date(time + 86400); + $db->putUserSet($set); + + $globalData->{ $self->{id} }--; + $globalUserAchievement->frozen_hash(nfreeze_base64($globalData)); + $db->putGlobalUserAchievement($globalUserAchievement); + + return; +} + +1; diff --git a/lib/WeBWorK/AchievementItems/ResurrectHW.pm b/lib/WeBWorK/AchievementItems/ResurrectHW.pm new file mode 100644 index 0000000000..877671f437 --- /dev/null +++ b/lib/WeBWorK/AchievementItems/ResurrectHW.pm @@ -0,0 +1,103 @@ +################################################################################ +# WeBWorK Online Homework Delivery System +# Copyright © 2000-2022 The WeBWorK Project, https://github.com/openwebwork +# +# This program is free software; you can redistribute it and/or modify it under +# the terms of either: (a) the GNU General Public License as published by the +# Free Software Foundation; either version 2, or (at your option) any later +# version, or (b) the "Artistic License" which comes with this package. +# +# This program is distributed in the hope that it will be useful, but WITHOUT +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +# FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the +# Artistic License for more details. +################################################################################ + +package WeBWorK::AchievementItems::ResurrectHW; +use parent qw(WeBWorK::AchievementItems); + +# Item to resurrect a homework for 24 hours + +use strict; +use warnings; + +use WeBWorK::Utils qw(after x nfreeze_base64 thaw_base64 format_set_name_display); + +sub new { + my ($class) = @_; + + return bless { + id => 'ResurrectHW', + name => x('Scroll of Resurrection'), + description => x('Opens any homework set for 24 hours.') + }, $class; +} + +sub print_form { + my ($self, $sets, $setProblemCount, $r) = @_; + + # List all of the sets that are closed or past their reduced scoring date. + + my @closedSets; + + for my $i (0 .. $#$sets) { + push(@closedSets, [ format_set_name_display($sets->[$i]->set_id) => $sets->[$i]->set_id ]) + if $sets->[$i]->assignment_type eq 'default' + && (after($sets->[$i]->due_date) + || ($sets->[$i]->reduced_scoring_date && after($$sets[$i]->reduced_scoring_date))); + } + + return $r->c( + $r->tag('p', $r->maketext('Choose the set which you would like to resurrect.')), + WeBWorK::AchievementItems::form_popup_menu_row( + $r, + id => 'res_set_id', + label_text => $r->maketext('Set Name'), + values => \@closedSets, + menu_attr => { dir => 'ltr' } + ) + )->join(''); +} + +sub use_item { + my ($self, $userName, $r) = @_; + my $db = $r->db; + my $ce = $r->ce; + + # Validate data + + my $globalUserAchievement = $db->getGlobalUserAchievement($userName); + return 'No achievement data?!?!?!' unless $globalUserAchievement->frozen_hash; + + my $globalData = thaw_base64($globalUserAchievement->frozen_hash); + return "You are $self->{id} trying to use an item you don't have" unless $globalData->{ $self->{id} }; + + my $setID = $r->param('res_set_id'); + return 'You need to input a Set Name' unless defined $setID; + + my $set = $db->getUserSet($userName, $setID); + return q{Couldn't find that set!} unless $set; + + # Set a new reduced scoring date, close date, and answer date for the student. + $set->reduced_scoring_date(time + 86400); + $set->due_date(time + 86400); + $set->answer_date(time + 86400); + $db->putUserSet($set); + + my @probIDs = $db->listUserProblems($userName, $setID); + + # Change the seed for all of the problems in the set. + for my $probID (@probIDs) { + my $problem = $db->getUserProblem($userName, $setID, $probID); + $problem->problem_seed($problem->problem_seed + 100); + $db->putUserProblem($problem); + } + + $globalData->{ $self->{id} }--; + $globalUserAchievement->frozen_hash(nfreeze_base64($globalData)); + $db->putGlobalUserAchievement($globalUserAchievement); + + return; +} + +1; diff --git a/lib/WeBWorK/AchievementItems/SuperExtendDueDate.pm b/lib/WeBWorK/AchievementItems/SuperExtendDueDate.pm new file mode 100644 index 0000000000..8e5586f119 --- /dev/null +++ b/lib/WeBWorK/AchievementItems/SuperExtendDueDate.pm @@ -0,0 +1,91 @@ +################################################################################ +# WeBWorK Online Homework Delivery System +# Copyright © 2000-2022 The WeBWorK Project, https://github.com/openwebwork +# +# This program is free software; you can redistribute it and/or modify it under +# the terms of either: (a) the GNU General Public License as published by the +# Free Software Foundation; either version 2, or (at your option) any later +# version, or (b) the "Artistic License" which comes with this package. +# +# This program is distributed in the hope that it will be useful, but WITHOUT +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +# FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the +# Artistic License for more details. +################################################################################ + +package WeBWorK::AchievementItems::SuperExtendDueDate; +use parent qw(WeBWorK::AchievementItems); + +# Item to extend a close date by 48 hours. + +use strict; +use warnings; + +use WeBWorK::Utils qw(between x nfreeze_base64 thaw_base64 format_set_name_display); + +sub new { + my ($class) = @_; + + return bless { + id => 'SuperExtendDueDate', + name => x('Robe of Longevity'), + description => x('Adds 48 hours to the close date of a homework.') + }, $class; +} + +sub print_form { + my ($self, $sets, $setProblemCount, $r) = @_; + + my @openSets; + + for my $i (0 .. $#$sets) { + push(@openSets, [ format_set_name_display($sets->[$i]->set_id) => $sets->[$i]->set_id ]) + if (between($sets->[$i]->open_date, $sets->[$i]->due_date) && $sets->[$i]->assignment_type eq 'default'); + } + + return $r->c( + $r->tag('p', $r->maketext('Choose the set whose close date you would like to extend.')), + WeBWorK::AchievementItems::form_popup_menu_row( + $r, + id => 'ext_set_id', + label_text => $r->maketext('Set Name'), + values => \@openSets, + menu_attr => { dir => 'ltr' } + ) + )->join(''); +} + +sub use_item { + my ($self, $userName, $r) = @_; + my $db = $r->db; + my $ce = $r->ce; + + # Validate data + + my $globalUserAchievement = $db->getGlobalUserAchievement($userName); + return 'No achievement data?!?!?!' unless $globalUserAchievement->frozen_hash; + + my $globalData = thaw_base64($globalUserAchievement->frozen_hash); + return "You are $self->{id} trying to use an item you don't have" unless $globalData->{ $self->{id} }; + + my $setID = $r->param('ext_set_id'); + return 'You need to input a Set Name' unless defined $setID; + + my $set = $db->getMergedSet($userName, $setID); + my $userSet = $db->getUserSet($userName, $setID); + return q{Couldn't find that set!} unless $set && $userSet; + + # Add time to the reduced scoring date, due date, and answer date. + $userSet->reduced_scoring_date($set->reduced_scoring_date() + 172800) if $set->reduced_scoring_date; + $userSet->due_date($set->due_date() + 172800); + $userSet->answer_date($set->answer_date() + 172800); + $db->putUserSet($userSet); + + $globalData->{ $self->{id} }--; + $globalUserAchievement->frozen_hash(nfreeze_base64($globalData)); + $db->putGlobalUserAchievement($globalUserAchievement); + + return; +} + +1; diff --git a/lib/WeBWorK/AchievementItems/Surprise.pm b/lib/WeBWorK/AchievementItems/Surprise.pm new file mode 100644 index 0000000000..aa68bd54bf --- /dev/null +++ b/lib/WeBWorK/AchievementItems/Surprise.pm @@ -0,0 +1,55 @@ +################################################################################ +# WeBWorK Online Homework Delivery System +# Copyright © 2000-2022 The WeBWorK Project, https://github.com/openwebwork +# +# This program is free software; you can redistribute it and/or modify it under +# the terms of either: (a) the GNU General Public License as published by the +# Free Software Foundation; either version 2, or (at your option) any later +# version, or (b) the "Artistic License" which comes with this package. +# +# This program is distributed in the hope that it will be useful, but WITHOUT +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +# FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the +# Artistic License for more details. +################################################################################ + +package WeBWorK::AchievementItems::Surprise; +use parent qw(WeBWorK::AchievementItems); + +# Item to print a suprise message + +use strict; +use warnings; + +use WeBWorK::Utils qw(x); + +sub new { + my ($class) = @_; + + return bless { + id => 'Surprise', + name => x('Mysterious Package (with Ribbons)'), + description => x('What could be inside?') + }, $class; +} + +sub print_form { + my ($self, $sets, $setProblemCount, $r) = @_; + + # The form opens the file "suprise_message.txt" in the achievements + # folder and prints the contents of the file. + + open my $MESSAGE, '<', "$r->{ce}{courseDirs}{achievements}/surprise_message.txt" + or return $r->tag('p', $r->maketext(q{I couldn't find the file [ACHIEVEMENT_DIR]/surprise_message.txt!})); + local $/ = undef; + my $message = <$MESSAGE>; + close $MESSAGE; + + return $r->tag('div', $r->b($message)); +} + +sub use_item { + # This doesn't do anything. +} + +1; diff --git a/lib/WeBWorK/Authen/LTIAdvanced.pm b/lib/WeBWorK/Authen/LTIAdvanced.pm index d46c53bba2..a1f5fce96e 100644 --- a/lib/WeBWorK/Authen/LTIAdvanced.pm +++ b/lib/WeBWorK/Authen/LTIAdvanced.pm @@ -28,7 +28,6 @@ use warnings; use Carp; use WeBWorK::Debug; use DBI; -use WeBWorK::CGI; use WeBWorK::Utils qw(formatDateTime); use WeBWorK::Localize; use WeBWorK::ContentGenerator::Instructor; @@ -867,4 +866,3 @@ sub maybe_purge_nonces { } 1; - diff --git a/lib/WeBWorK/Authen/LTIAdvanced/SubmitGrade.pm b/lib/WeBWorK/Authen/LTIAdvanced/SubmitGrade.pm index fed90f35a7..028f6bf9dd 100644 --- a/lib/WeBWorK/Authen/LTIAdvanced/SubmitGrade.pm +++ b/lib/WeBWorK/Authen/LTIAdvanced/SubmitGrade.pm @@ -25,10 +25,10 @@ WeBWorK::Authen::LTIAdvanced::SubmitGrade - pass back grades to an enabled LMS use strict; use warnings; use WeBWorK::Debug; -use WeBWorK::CGI; use Carp; use WeBWorK::Utils qw(grade_set grade_gateway grade_all_sets wwRound); use Net::OAuth; +use HTML::Entities; use HTTP::Request; use LWP::UserAgent; use UUID::Tiny ':std'; @@ -188,18 +188,15 @@ sub submit_set_grade { return $self->submit_grade($userSet->lis_source_did, $score); } -# error in reporting michael.gage@rochester.edu, Demo, Global $r object is not available. Set: -# PerlOptions +GlobalRequest -# in httpd.conf at /opt/rh/perl516/root/usr/local/share/perl5/CGI.pm line 346, line 76. -# so we don't use CGI::escapeHTML in post processing mode but use this local version instead. - -sub local_escape_html { # a local version of escapeHTML that works for post processing - my $self = shift; # a grading object - my @message = @_; +# Escape HTML in messages when post processing is not being done. When post processing is being done these messages are +# sent to a log file, and so escaping HTML makes the messages even less readable. Note that this should never be used +# with the "debug" method as those messages always go into a log file. +sub local_escape_html { + my ($self, @message) = @_; if ($self->{post_processing_mode}) { - return join('', @message); # this goes to log files in post processing to escapeHTML is not essential + return join('', @message); } else { - return CGI::escapeHTML(@message); #FIXME -- why won't this work in post_processing_mode (missing $r ??) + return HTML::Entities::encode_entities(join('', @message)); } } @@ -408,7 +405,7 @@ EOS debug( "Unable to retrieve prior grade from LMS. Note that if your server time is not correct, this may fail for reasons which are less than obvious from the error messages. Error: " . $response->message); - debug(CGI::escapeHTML($response->content)); + debug($response->content); return 0; } } @@ -620,4 +617,3 @@ sub mass_update { } 1; - diff --git a/lib/WeBWorK/Authen/LTIBasic.pm b/lib/WeBWorK/Authen/LTIBasic.pm index b6b7424d1c..933900ad32 100644 --- a/lib/WeBWorK/Authen/LTIBasic.pm +++ b/lib/WeBWorK/Authen/LTIBasic.pm @@ -28,7 +28,6 @@ use warnings; use Carp; use WeBWorK::Debug; use DBI; -use WeBWorK::CGI; use WeBWorK::Utils qw(formatDateTime); use WeBWorK::Localize; use URI::Escape; @@ -352,7 +351,7 @@ sub check_user { if (!defined($user_id) or (defined $user_id and $user_id eq "")) { $self->{log_error} .= "no user id specified"; - my $LMS = ($ce->{LMS_url}) ? CGI::a({ href => $ce->{LMS_url} }, $ce->{LMS_name}) : $ce->{LMS_name}; + my $LMS = $ce->{LMS_url} ? $r->link_to($ce->{LMS_name} => $ce->{LMS_url}) : $ce->{LMS_name}; $self->{error} = $r->maketext($GENERIC_MISSING_USER_ID_ERROR_MESSAGE, $LMS); return 0; } @@ -477,7 +476,7 @@ sub authenticate { #debug("Nonce = |" . $self-> {oauth_nonce} . "|"); my $nonce = WeBWorK::Authen::LTIBasic::Nonce->new($r, $self->{oauth_nonce}, $self->{oauth_timestamp}); if (!($nonce->ok)) { - my $LMS = ($ce->{LMS_url}) ? CGI::a({ href => $ce->{LMS_url} }, $ce->{LMS_name}) : $ce->{LMS_name}; + my $LMS = $ce->{LMS_url} ? $r->link_to($ce->{LMS_name} => $ce->{LMS_url}) : $ce->{LMS_name}; #debug( "eval failed: ", $@, "

      "; print_keys($r);); $self->{error} .= $r->maketext( $GENERIC_ERROR_MESSAGE @@ -890,4 +889,3 @@ sub print_keys { } 1; - diff --git a/lib/WeBWorK/Authen/Shibboleth.pm b/lib/WeBWorK/Authen/Shibboleth.pm index 744cf01997..4ab14c89a4 100644 --- a/lib/WeBWorK/Authen/Shibboleth.pm +++ b/lib/WeBWorK/Authen/Shibboleth.pm @@ -46,7 +46,7 @@ $shibboleth{mapping}{user_id} = "username"; use strict; use warnings; -use CGI qw/:standard/; + use WeBWorK::Debug; # this is similar to the method in the base class, except that Shibboleth @@ -104,10 +104,9 @@ sub get_credentials { } debug("Couldn't shib header or user_id"); - my $q = new CGI; - my $go_to = $ce->{shibboleth}{login_script} . "?target=" . $q->url(-path => 1); + my $go_to = $ce->{shibboleth}{login_script} . "?target=" . $r->uri; $self->{redirect} = $go_to; - print $q->redirect($go_to); + $r->redirect_to($go_to); return 0; } diff --git a/lib/WeBWorK/Authz.pm b/lib/WeBWorK/Authz.pm index 8a060d4b73..23032c9682 100644 --- a/lib/WeBWorK/Authz.pm +++ b/lib/WeBWorK/Authz.pm @@ -488,7 +488,7 @@ sub checkSet { my $LTIGradeMode = $ce->{LTIGradeMode} // ''; if ($LTIGradeMode eq 'homework' && !$self->hasPermissions($userName, "view_unopened_sets")) { - my $LMS = ($ce->{LMS_url}) ? CGI::a({ href => $ce->{LMS_url} }, $ce->{LMS_name}) : $ce->{LMS_name}; + my $LMS = $ce->{LMS_url} ? $r->link_to($ce->{LMS_name} => $ce->{LMS_url}) : $ce->{LMS_name}; return $r->maketext( 'You must use your Learning Management System ([_1]) to access this set. ' . 'Try logging in to the Learning Management System and visiting the set from there.', diff --git a/lib/WeBWorK/ConfigObject.pm b/lib/WeBWorK/ConfigObject.pm new file mode 100644 index 0000000000..b0de6118cf --- /dev/null +++ b/lib/WeBWorK/ConfigObject.pm @@ -0,0 +1,113 @@ +package WeBWorK::ConfigObject; + +# Base object class for all config objects + +use strict; +use warnings; + +use URI::Escape; + +sub new { + my ($class, $self, $module) = @_; + # The module should be a content generator module. + $self->{Module} = $module; + $self->{name} = ($self->{var} =~ s/[{]/_/gr) =~ s/[}]//gr; + return bless $self, $class; +} + +# Only input is a value to display, and should produce an html string. +sub display_value { + my ($self, $val) = @_; + return $val; +} + +# This should return the value to compare to the new value. This is *not* what is displayed. +sub comparison_value { + my ($self, $val) = @_; + return $val; +} + +# Get the value of the corresponding variable in the provided course environment. +sub get_value { + my ($self, $ce) = @_; + + my @keys = $self->{var} =~ m/([^{}]+)/g; + return '' unless @keys; + + my $value = $ce; + for (@keys) { + $value = $value->{$_}; + } + return $value; +} + +# If use_current is true then return the current course environment value for this setting. +# Otherwise use the value of the html form element. +sub convert_newval_source { + my ($self, $use_current) = @_; + if ($use_current) { + return $self->comparison_value($self->get_value($self->{Module}->r->ce)); + } else { + return $self->{Module}->r->param($self->{name}) // ''; + } +} + +# Bit of text to put in the configuration file. The result should be an assignment which is executable by perl. oldval +# will be the value of the perl variable, and newval will be whatever an entry widget produces. +sub save_string { + my ($self, $oldval, $use_current) = @_; + + my $newval = $self->convert_newval_source($use_current); + return '' if $self->comparison_value($oldval) eq $newval; + + $newval =~ s/['"`]//g; + return "\$$self->{var} = '$newval';\n"; +} + +# A widget to interact with the user +sub entry_widget { + my ($self, $default) = @_; + return $self->{Module}->r->text_field( + $self->{name} => $default, + id => $self->{name}, + size => $self->{width} || 15, + class => 'form-control form-control-sm' + ); +} + +# This produces the documentation string and image link to more documentation. It is the same for all config types. +sub what_string { + my ($self) = @_; + my $r = $self->{Module}->r; + + return $r->tag( + 'div', + class => 'd-flex justify-content-between align-items-center', + $r->c( + $r->tag( + 'div', + ref $self eq 'WeBWorK::ConfigObject::checkboxlist' + ? $r->b($r->maketext($self->{doc})) + : $r->label_for($self->{name} => $r->b($r->maketext($self->{doc}))) + ), + $r->link_to( + $r->tag( + 'i', + class => 'icon fas fa-question-circle', + 'aria-hidden' => 'true', + data => { alt => 'help' }, + '' + ) => $self->{Module}->systemLink( + $r->urlpath->new( + type => 'instructor_config', + args => { courseID => $r->urlpath->arg('courseID') } + ), + params => { show_long_doc => 1, var_name => uri_escape($self->{var}) } + ), + target => '_blank' + ) + )->join('') + ); +} + +1; diff --git a/lib/WeBWorK/ConfigObject/boolean.pm b/lib/WeBWorK/ConfigObject/boolean.pm new file mode 100644 index 0000000000..bb3ee67755 --- /dev/null +++ b/lib/WeBWorK/ConfigObject/boolean.pm @@ -0,0 +1,51 @@ +################################################################################ +# WeBWorK Online Homework Delivery System +# Copyright © 2000-2021 The WeBWorK Project, https://github.com/openwebwork +# +# This program is free software; you can redistribute it and/or modify it under +# the terms of either: (a) the GNU General Public License as published by the +# Free Software Foundation; either version 2, or (at your option) any later +# version, or (b) the "Artistic License" which comes with this package. +# +# This program is distributed in the hope that it will be useful, but WITHOUT +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +# FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the +# Artistic License for more details. +################################################################################ + +package WeBWorK::ConfigObject::boolean; +use parent qw(WeBWorK::ConfigObject); + +use strict; +use warnings; + +sub comparison_value { my ($self, $value) = @_; return $value ? 1 : 0; } + +sub display_value { + my ($self, $val) = @_; + my $r = $self->{Module}->r; + return $r->maketext('True') if $val; + return $r->maketext('False'); +} + +sub save_string { + my ($self, $oldval, $use_current) = @_; + my $newval = $self->convert_newval_source($use_current); + return '' if $self->comparison_value($oldval) eq $newval; + return "\$$self->{var} = $newval;\n"; +} + +sub entry_widget { + my ($self, $default) = @_; + my $r = $self->{Module}->r; + return $r->select_field( + $self->{name} => [ + [ $r->maketext('True') => 1, $default == 1 ? (selected => undef) : () ], + [ $r->maketext('False') => 0, $default == 0 ? (selected => undef) : () ] + ], + id => $self->{name}, + class => 'form-select form-select-sm' + ); +} + +1; diff --git a/lib/WeBWorK/ConfigObject/checkboxlist.pm b/lib/WeBWorK/ConfigObject/checkboxlist.pm new file mode 100644 index 0000000000..edd660b5ed --- /dev/null +++ b/lib/WeBWorK/ConfigObject/checkboxlist.pm @@ -0,0 +1,80 @@ +################################################################################ +# WeBWorK Online Homework Delivery System +# Copyright © 2000-2021 The WeBWorK Project, https://github.com/openwebwork +# +# This program is free software; you can redistribute it and/or modify it under +# the terms of either: (a) the GNU General Public License as published by the +# Free Software Foundation; either version 2, or (at your option) any later +# version, or (b) the "Artistic License" which comes with this package. +# +# This program is distributed in the hope that it will be useful, but WITHOUT +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +# FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the +# Artistic License for more details. +################################################################################ + +package WeBWorK::ConfigObject::checkboxlist; +use parent qw(WeBWorK::ConfigObject); + +use strict; +use warnings; + +sub display_value { + my ($self, $val) = @_; + my $r = $self->{Module}->r; + return $r->c(@{ $val // [] })->join($r->tag('br')); +} + +# r->param() returns an array, so a custom version of convert_newval_source is needed. +sub convert_newval_source { + my ($self, $use_current) = @_; + if ($use_current) { + return @{ $self->get_value($self->{Module}->r->ce) }; + } else { + return $self->{Module}->r->param($self->{name}); + } +} + +sub save_string { + my ($self, $oldval, $use_current) = @_; + my @newvals = $self->convert_newval_source($use_current); + if ($self->{min} && scalar(@newvals) < $self->{min}) { + $self->{Module}->addbadmessage("You need to select at least $self->{min} display mode."); + return '' if $use_current; + return $self->save_string($oldval, 1); + } + return '' if $self->comparison_value($oldval) eq $self->comparison_value(\@newvals); + return "\$$self->{var} = [" . join(',', map {"'$_'"} @newvals) . "];\n"; +} + +sub comparison_value { + my ($self, $val) = @_; + return join(',', @{ $val // [] }); +} + +sub entry_widget { + my ($self, $default) = @_; + my $r = $self->{Module}->r; + return $r->c( + map { + $r->tag( + 'div', + class => 'form-check', + $r->tag( + 'label', + class => 'form-check-label', + $r->c( + $r->check_box( + $self->{name} => $_, + { map { $_ => 1 } @$default }->{$_} ? (checked => undef) : (), + class => 'form-check-input', + ), + $_ + )->join('') + ) + ) + } @{ $self->{values} } + )->join(''); +} + +1; diff --git a/lib/WeBWorK/ConfigObject/list.pm b/lib/WeBWorK/ConfigObject/list.pm new file mode 100644 index 0000000000..bcea486d02 --- /dev/null +++ b/lib/WeBWorK/ConfigObject/list.pm @@ -0,0 +1,63 @@ +################################################################################ +# WeBWorK Online Homework Delivery System +# Copyright © 2000-2021 The WeBWorK Project, https://github.com/openwebwork +# +# This program is free software; you can redistribute it and/or modify it under +# the terms of either: (a) the GNU General Public License as published by the +# Free Software Foundation; either version 2, or (at your option) any later +# version, or (b) the "Artistic License" which comes with this package. +# +# This program is distributed in the hope that it will be useful, but WITHOUT +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +# FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the +# Artistic License for more details. +################################################################################ + +package WeBWorK::ConfigObject::list; +use parent qw(WeBWorK::ConfigObject); + +use strict; +use warnings; + +sub display_value { + my ($self, $val) = @_; + my $r = $self->{Module}->r; + return $r->b(' ') if ref $val ne 'ARRAY'; + my $str = $r->c(@$val)->join(',' . $r->tag('br')); + return $str =~ /\S/ ? $str : $r->b(' '); +} + +sub comparison_value { + my ($self, $val) = @_; + return join(',', @{ $val // [] }); +} + +sub save_string { + my ($self, $oldval, $use_current) = @_; + my $newval = $self->convert_newval_source($use_current); + $oldval = $self->comparison_value($oldval); + + return '' if $oldval eq $newval; + + $oldval =~ s/^\s*|\s*$//g; + $newval =~ s/^\s*|\s*$//g; + $oldval =~ s/[\s,]+/,/sg; + $newval =~ s/[\s,]+/,/sg; + return '' if $newval eq $oldval; + + # This is a new value. Turn it back into a string and return it. + return "\$$self->{var} = [" . join(',', map {"'$_'"} map { $_ =~ s/['"`]//gr } split(',', $newval)) . "];\n"; +} + +sub entry_widget { + my ($self, $default) = @_; + my $str = join(', ', @{ $default // [] }); + return $self->{Module}->r->text_area( + $self->{name} => $str =~ /\S/ ? $str : '', + id => $self->{name}, + rows => 4, + class => 'form-control form-control-sm' + ); +} + +1; diff --git a/lib/WeBWorK/CGI.pm b/lib/WeBWorK/ConfigObject/number.pm similarity index 54% rename from lib/WeBWorK/CGI.pm rename to lib/WeBWorK/ConfigObject/number.pm index 21da43cc0f..7070335586 100644 --- a/lib/WeBWorK/CGI.pm +++ b/lib/WeBWorK/ConfigObject/number.pm @@ -1,6 +1,6 @@ ################################################################################ # WeBWorK Online Homework Delivery System -# Copyright © 2000-2022 The WeBWorK Project, https://github.com/openwebwork +# Copyright © 2000-2021 The WeBWorK Project, https://github.com/openwebwork # # This program is free software; you can redistribute it and/or modify it under # the terms of either: (a) the GNU General Public License as published by the @@ -9,28 +9,28 @@ # # This program is distributed in the hope that it will be useful, but WITHOUT # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS -# FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the +# FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the # Artistic License for more details. ################################################################################ -package WeBWorK::CGI; +package WeBWorK::ConfigObject::number; +use parent qw(WeBWorK::ConfigObject); use strict; use warnings; -# from http://search.cpan.org/src/LDS/CGI.pm-3.20/cgi_docs.html#subclassing -use vars qw/@ISA $VERSION/; -require CGI; -@ISA = 'CGI'; -$VERSION = "0.1"; +sub save_string { + my ($self, $oldval, $use_current) = @_; -$CGI::DefaultClass = __PACKAGE__; -$WeBWorK::CGI::AutoloadClass = 'CGI'; + my $newval = $self->convert_newval_source($use_current) =~ s/['"`]//gr; + if ($newval !~ m/^[+-]?\d*(\.\d*)?$/) { + $self->{Module}->addbadmessage(qq{Invalid numeric value "$newval" for variable \$$self->{var}. } + . 'Reverting to the system default value.'); + return ''; + } -sub new { - my $self = shift->SUPER::new(@_); - $self->delete_all; - return $self; + return '' if $self->comparison_value($oldval) == +$newval; + return "\$$self->{var} = $newval;\n"; } 1; diff --git a/lib/WeBWorK/ConfigObject/permission.pm b/lib/WeBWorK/ConfigObject/permission.pm new file mode 100644 index 0000000000..2cf0f2cb6e --- /dev/null +++ b/lib/WeBWorK/ConfigObject/permission.pm @@ -0,0 +1,59 @@ +################################################################################ +# WeBWorK Online Homework Delivery System +# Copyright © 2000-2021 The WeBWorK Project, https://github.com/openwebwork +# +# This program is free software; you can redistribute it and/or modify it under +# the terms of either: (a) the GNU General Public License as published by the +# Free Software Foundation; either version 2, or (at your option) any later +# version, or (b) the "Artistic License" which comes with this package. +# +# This program is distributed in the hope that it will be useful, but WITHOUT +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +# FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the +# Artistic License for more details. +################################################################################ + +package WeBWorK::ConfigObject::permission; +use parent qw(WeBWorK::ConfigObject); + +use strict; +use warnings; + +sub comparison_value { + my ($self, $val) = @_; + return $val // 'nobody'; +} + +# This tries to produce a string from a permission number. If you feed it a string, that's what you get back. +sub display_value { + my ($self, $val) = @_; + my $r = $self->{Module}->r; + return $r->maketext('nobody') if !defined $val; + my %reverseUserRoles = reverse %{ $r->ce->{userRoles} }; + return defined $reverseUserRoles{$val} ? $r->maketext($reverseUserRoles{$val}) : $r->maketext($val); +} + +sub save_string { + my ($self, $oldval, $use_current) = @_; + my $newval = $self->convert_newval_source($use_current); + return '' if $self->comparison_value($oldval) eq $newval; + return "\$$self->{var} = '$newval';\n"; +} + +sub entry_widget { + my ($self, $default) = @_; + my $r = $self->{Module}->r; + + # The value of a permission can be undefined (for nobody), a standard permission number, or some other number + my %userRoles = %{ $r->ce->{userRoles} }; + my @values = sort { $userRoles{$a} <=> $userRoles{$b} } keys %userRoles; + + return $r->select_field( + $self->{name} => + [ map { [ $r->maketext($_) => $_, ($default // 'nobody') eq $_ ? (selected => undef) : () ] } @values ], + id => $self->{name}, + class => 'form-select form-select-sm', + ); +} + +1; diff --git a/lib/WeBWorK/ConfigObject/popuplist.pm b/lib/WeBWorK/ConfigObject/popuplist.pm new file mode 100644 index 0000000000..29324e1abe --- /dev/null +++ b/lib/WeBWorK/ConfigObject/popuplist.pm @@ -0,0 +1,50 @@ +################################################################################ +# WeBWorK Online Homework Delivery System +# Copyright © 2000-2021 The WeBWorK Project, https://github.com/openwebwork +# +# This program is free software; you can redistribute it and/or modify it under +# the terms of either: (a) the GNU General Public License as published by the +# Free Software Foundation; either version 2, or (at your option) any later +# version, or (b) the "Artistic License" which comes with this package. +# +# This program is distributed in the hope that it will be useful, but WITHOUT +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +# FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the +# Artistic License for more details. +################################################################################ + +package WeBWorK::ConfigObject::popuplist; +use parent qw(WeBWorK::ConfigObject); + +use strict; +use warnings; + +sub display_value { + my ($self, $val) = @_; + my $r = $self->{Module}->r; + $val //= 'ur'; + return $r->c($r->maketext($self->{labels}{$val}))->join($r->tag('br')) if ($self->{labels}{$val}); + return $r->c($val)->join($r->tag('br')); +} + +sub save_string { + my ($self, $oldval, $use_current) = @_; + my $newval = $self->convert_newval_source($use_current); + return '' if $self->comparison_value($oldval) eq $newval; + return ("\$$self->{var} = '$newval';\n"); +} + +sub entry_widget { + my ($self, $default) = @_; + my $r = $self->{Module}->r; + return $r->select_field( + $self->{name} => [ + map { [ $r->maketext($self->{labels}{$_} // $_) => $_, $default eq $_ ? (selected => undef) : () ] } + @{ $self->{values} } + ], + id => $self->{name}, + class => 'form-select form-select-sm', + ); +} + +1; diff --git a/lib/WeBWorK/HTML/InfoBox.pm b/lib/WeBWorK/ConfigObject/text.pm similarity index 64% rename from lib/WeBWorK/HTML/InfoBox.pm rename to lib/WeBWorK/ConfigObject/text.pm index 50f231725a..23714a2037 100644 --- a/lib/WeBWorK/HTML/InfoBox.pm +++ b/lib/WeBWorK/ConfigObject/text.pm @@ -1,6 +1,6 @@ ################################################################################ # WeBWorK Online Homework Delivery System -# Copyright © 2000-2022 The WeBWorK Project, https://github.com/openwebwork +# Copyright © 2000-2021 The WeBWorK Project, https://github.com/openwebwork # # This program is free software; you can redistribute it and/or modify it under # the terms of either: (a) the GNU General Public License as published by the @@ -9,31 +9,16 @@ # # This program is distributed in the hope that it will be useful, but WITHOUT # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS -# FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the +# FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the # Artistic License for more details. ################################################################################ -package WeBWorK::HTML::InfoBox; -use base qw(Exporter); - -=head1 NAME - -WeBWorK::HTML::InfoBox - HTML widget for a box to display information in. - -=cut +package WeBWorK::ConfigObject::text; +use parent qw(WeBWorK::ConfigObject); use strict; use warnings; -use Carp; - -our @EXPORT = (); -our @EXPORT_OK = qw( - infoBox -); -sub infoBox { - # FIXME: write this! - # see: Login, ProblemSets, ProblemSet for disasters -} +# The base ConfigObject handles everything for this package. This is just a namespace. 1; diff --git a/lib/WeBWorK/ConfigObject/time.pm b/lib/WeBWorK/ConfigObject/time.pm new file mode 100644 index 0000000000..c53ae865d2 --- /dev/null +++ b/lib/WeBWorK/ConfigObject/time.pm @@ -0,0 +1,39 @@ +################################################################################ +# WeBWorK Online Homework Delivery System +# Copyright © 2000-2021 The WeBWorK Project, https://github.com/openwebwork +# +# This program is free software; you can redistribute it and/or modify it under +# the terms of either: (a) the GNU General Public License as published by the +# Free Software Foundation; either version 2, or (at your option) any later +# version, or (b) the "Artistic License" which comes with this package. +# +# This program is distributed in the hope that it will be useful, but WITHOUT +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +# FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the +# Artistic License for more details. +################################################################################ + +package WeBWorK::ConfigObject::time; +use parent qw(WeBWorK::ConfigObject); + +# Just like WeBWorK::ConfigObject::text, but it validates the time before saving. + +use strict; +use warnings; + +sub save_string { + my ($self, $oldval, $use_current) = @_; + + my $newval = $self->convert_newval_source($use_current); + return '' if $self->comparison_value($oldval) eq $newval; + + if ($newval !~ /^(01|1|02|2|03|3|04|4|05|5|06|6|07|7|08|8|09|9|10|11|12):[0-5]\d(am|pm|AM|PM)$/) { + $self->{Module} + ->addbadmessage(qq{String "$newval" is not a valid time. Reverting to the system default value.}); + return ''; + } + + return "\$$self->{var} = '$newval';\n"; +} + +1; diff --git a/lib/WeBWorK/ConfigObject/timezone.pm b/lib/WeBWorK/ConfigObject/timezone.pm new file mode 100644 index 0000000000..9d369acbbf --- /dev/null +++ b/lib/WeBWorK/ConfigObject/timezone.pm @@ -0,0 +1,42 @@ +################################################################################ +# WeBWorK Online Homework Delivery System +# Copyright © 2000-2021 The WeBWorK Project, https://github.com/openwebwork +# +# This program is free software; you can redistribute it and/or modify it under +# the terms of either: (a) the GNU General Public License as published by the +# Free Software Foundation; either version 2, or (at your option) any later +# version, or (b) the "Artistic License" which comes with this package. +# +# This program is distributed in the hope that it will be useful, but WITHOUT +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +# FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the +# Artistic License for more details. +################################################################################ + +package WeBWorK::ConfigObject::timezone; +use parent qw(WeBWorK::ConfigObject); + +# Just like WeBWorK::ConfigObject::text, but it validates the timezone before saving. + +use strict; +use warnings; + +use DateTime::TimeZone; + +sub save_string { + my ($self, $oldval, $use_current) = @_; + + my $newval = $self->convert_newval_source($use_current); + return '' if $self->comparison_value($oldval) eq $newval; + + if (not DateTime::TimeZone->is_valid_name($newval)) { + $self->{Module} + ->addbadmessage("String '$newval' is not a valid time zone. Reverting to the system default value."); + return ''; + } + + $newval =~ s/['"`]//g; + return "\$$self->{var} = '$newval';\n"; +} + +1; diff --git a/lib/WeBWorK/ContentGenerator.pm b/lib/WeBWorK/ContentGenerator.pm index 7828bd985b..5b9f032482 100644 --- a/lib/WeBWorK/ContentGenerator.pm +++ b/lib/WeBWorK/ContentGenerator.pm @@ -49,23 +49,16 @@ use URI::Escape; use MIME::Base64; use Scalar::Util qw(weaken); use HTML::Entities; -use HTML::Scrubber; use Encode; use Email::Sender::Transport::SMTP; use Future::AsyncAwait; -use WeBWorK::CGI; -use WeBWorK::File::Scoring qw/parse_scoring_file/; -use WeBWorK::Debug; +use WeBWorK::File::Scoring qw(parse_scoring_file); use WeBWorK::PG; -use WeBWorK::Template qw(template); use WeBWorK::Localize; use WeBWorK::Utils qw(jitar_id_to_seq fetchEmailRecipients generateURLs getAssetURL format_set_name_display); use WeBWorK::Authen::LTIAdvanced::SubmitGrade; - -use Future::AsyncAwait; - -our $TRACE_WARNINGS = 0; # set to 1 to trace channel used by warning message +use WeBWorK::Utils::LanguageAndDirection qw(get_lang_and_dir); ############################################################################### @@ -153,55 +146,50 @@ async sub go { my $r = $self->r; my $ce = $r->ce; - # If grades are begin passed back to the lti then we peroidically - # update all of the grades because things can get out of sync if - # instructors add or modify sets. - if ($ce->{LTIGradeMode} and ref($r->{db} // '')) { + # If grades are begin passed back to the LTI then we peroidically update all of the grades because things can get + # out of sync if instructors add or modify sets. + if ($ce->{LTIGradeMode} && ref $r->db) { my $grader = WeBWorK::Authen::LTIAdvanced::SubmitGrade->new($r); $grader->mass_update('auto'); } - # check to verify if there are set-level problems with running - # this content generator (individual content generators must - # check $self->{invalidSet} and react correctly) - my $authz = $r->authz; - $self->{invalidSet} = $authz->checkSet(); - - my $returnValue = 0; + # Check to determine if this is a problem set response. Individual content generators must check + # $self->{invalidSet} and react appropriately. + $self->{invalidSet} = $r->authz->checkSet(); - # We only write to the activity log if it has been defined and if - # we are in a specific course. The latter check is to prevent attempts - # to write to a course log file when viewing the top-level list of - # courses page. + # We only write to the activity log if it has been defined and if we are in a specific course. The latter check is + # to prevent attempts to write to a course log file when viewing the top-level list of courses page. WeBWorK::Utils::writeCourseLog($ce, 'activity_log', $self->prepare_activity_entry) - if ($r->urlpath->arg('courseID') - and $r->ce->{courseFiles}{logs}{activity_log}); + if ($r->urlpath->arg('courseID') && $r->ce->{courseFiles}{logs}{activity_log}); - await $self->pre_header_initialize(@_) if $self->can('pre_header_initialize'); + if ($self->can('pre_header_initialize')) { + my $pre_header_initialize = $self->pre_header_initialize(@_); + await $pre_header_initialize + if ref $pre_header_initialize eq 'Future' || ref $pre_header_initialize eq 'Mojo::Promise'; + } - # send a file instead of a normal reply (reply_with_file() sets this field) - defined $self->{reply_with_file} and do { + # Reply with a file. + if (defined $self->{reply_with_file}) { return $self->do_reply_with_file($self->{reply_with_file}); - }; + } - # send a Location: header instead of a normal reply (reply_with_redirect() sets this field) - defined $self->{reply_with_redirect} and do { + # Reply with a redirect. + if (defined $self->{reply_with_redirect}) { return $self->do_reply_with_redirect($self->{reply_with_redirect}); - }; - - my $headerReturn = $self->header(@_); - $returnValue = $headerReturn if defined $headerReturn; - - return $returnValue if $r->req->method eq 'HEAD'; + } if ($self->can('initialize')) { my $initialize = $self->initialize; await $initialize if ref $initialize eq 'Future' || ref $initialize eq 'Mojo::Promise'; } - await $self->content(); + $self->content(); - return $returnValue; + # All content generator modules must have rendered at this point unless there was an error in which case an error + # response will be rendered. There is no special handing for HEAD requests. Mojolicious takes care of that in its + # render methods. This just returns the status code of the response (typically set by the Mojolicious render + # methods. Although this return value isn't actually used at this point. + return $self->header(@_); } =item r() @@ -232,11 +220,11 @@ sub do_reply_with_file { my $name = $fileHash->{name}; my $delete_after = $fileHash->{delete_after}; - # if there was a problem, we return here and let go() worry about sending the reply - return 404 unless -e $source; - return 403 unless -r $source; + # If there was a problem, render the appropriate error response. + return $r->render(text => 'File not found', status => 404) unless -e $source; + return $r->render(text => 'Insufficient permissions', status => 403) unless -r $source; - # send our custom HTTP header + # Send our custom HTTP header. $r->res->headers->content_type($type); $r->res->headers->add("Content-Disposition" => qq{attachment; filename="$name"}); @@ -247,7 +235,7 @@ sub do_reply_with_file { unlink $source or warn "failed to unlink $source after sending: $!"; } - return; + return $r->res->code; } =item do_reply_with_redirect($url) @@ -259,11 +247,8 @@ Handler for reply_with_redirect(), used by go(). DO NOT CALL THIS METHOD DIRECTL sub do_reply_with_redirect { my ($self, $url) = @_; my $r = $self->r; - - $r->res->code(302); - $r->res->headers->add(Location => $url); - - return; + $r->redirect_to($url); + return $r->res->code; } =back @@ -286,8 +271,7 @@ the client after calling pre_header_initialize(). The content type sent is $type, and the suggested client-side file name is $name. If $delete_after is true, $source is deleted after it is sent. -Must be called before the HTTP header is sent. Usually called from -pre_header_initialize(). +Must be called from pre_header_initialize(). =cut @@ -308,8 +292,7 @@ sub reply_with_file { Enables redirect mode, causing go() to redirect to the given URL after calling pre_header_initialize(). -Must be called before the HTTP header is sent. Usually called from -pre_header_initialize(). +Must be called from pre_header_initialize(). =cut @@ -321,7 +304,7 @@ sub reply_with_redirect { =item addmessage($message) -Adds a message to the list of messages to be printed by the message() template +Adds a message to the list of messages to be output by the message() template escape handler. Must be called before the message() template escape is invoked. @@ -329,51 +312,36 @@ Must be called before the message() template escape is invoked. =cut sub addmessage { - #addmessages takes html so we use htmlscrubber to get rid of - # any scripts or html comments. However, we leave everything else - # by default. - my ($self, $message) = @_; - return unless defined($message); - my $scrubber = HTML::Scrubber->new( - default => 1, - script => 0, - comment => 0 - ); - $scrubber->default( - undef, - { - '*' => 1, - } - ); + return '' unless defined $message; - $message = $scrubber->scrub($message); - $self->{status_message} .= $message; + $self->{status_message} //= $self->r->c; + push(@{ $self->{status_message} }, $message); } =item addgoodmessage($message) -Adds a success message to the list of messages to be printed by the +Adds a success message to the list of messages to be output by the message() template escape handler. =cut sub addgoodmessage { my ($self, $message) = @_; - $self->addmessage(CGI::div({ class => 'alert alert-success p-1 my-2' }, $message)); + $self->addmessage($self->r->tag('p', class => 'alert alert-success p-1 my-2', $self->r->b($message))); } =item addbadmessage($message) -Adds a failure message to the list of messages to be printed by the +Adds a failure message to the list of messages to be output by the message() template escape handler. =cut sub addbadmessage { my ($self, $message) = @_; - $self->addmessage(CGI::div({ class => 'alert alert-danger p-1 my-2' }, $message)); + $self->addmessage($self->r->tag('p', class => 'alert alert-danger p-1 my-2', $self->r->b($message))); } =item prepare_activity_entry() @@ -406,49 +374,50 @@ The following are the standard content generator methods. Some are defined here, but may be overridden in a subclass. Others are not defined unless they are defined in a subclass. +FIXME: The names of the first three methods don't really make sense anymore. +There really is no need for both of the pre_header_initialize and initialize +methods. The initialize method should be dropped and the pre_header_initialize +method renamed. + =over =item pre_header_initialize() Not defined in this package. -May be defined by a subclass to perform any processing that must occur before -the HTTP header is sent. +May be defined by a subclass to perform any early processing that is needed. +This method must be used if responding with a file or redirect. -=cut - -#sub pre_header_initialize { } +This method may be asynchronous. =item header() Defined in this package. -Generates and sends a default HTTP header, specifying the "text/html" content -type. +This method is not really useful anymore. For now it returns the response +status code and this return value is ignored. Headers are now set when +rendering a response (as it really should have been done before. =cut sub header { my $self = shift; - $self->r->res->headers->content_type('text/html; charset=utf-8'); - return 0; + return $self->r->res->code; } =item initialize() Not defined in this package. -May be defined by a subclass to perform any processing that must occur after the -HTTP header is sent but before any content is sent. - -=cut +May be defined by a subclass to perform any early processing that is needed. +This method can not be used if responding with a file or redirect. -#sub initialize { } +This method may be asynchronous. =item output_course_lang_and_dir() Output the LANG and DIR tags in the main HTML tag of a generated web page when -a template files calls this function. +a template file calls this function. This calls WeBWorK::Utils::LanguageAndDirection::get_lang_and_dir. @@ -456,8 +425,7 @@ This calls WeBWorK::Utils::LanguageAndDirection::get_lang_and_dir. sub output_course_lang_and_dir { my $self = shift; - print WeBWorK::Utils::LanguageAndDirection::get_lang_and_dir($self->r->ce->{language}); - return ""; + return get_lang_and_dir($self->r->ce->{language}); } =item webwork_logo() @@ -475,21 +443,12 @@ sub webwork_logo { if ($r->authen->was_verified && !$r->authz->hasPermissions($r->param('user'), 'navigation_allowed')) { # If navigation is restricted for this user, then the webwork logo is not a link to the courses page. - print CGI::span(CGI::img({ - src => "$htdocs/themes/$theme/images/webwork_logo.svg", - alt => 'WeBWorK' - })); + return $r->tag('span', $r->image("$htdocs/themes/$theme/images/webwork_logo.svg", alt => 'WeBWorK')); } else { - print CGI::a( - { href => $ce->{webwork_url} }, - CGI::img({ - src => "$htdocs/themes/$theme/images/webwork_logo.svg", - alt => $r->maketext('to courses page') - }) - ); + return $r->link_to( + $r->image("$htdocs/themes/$theme/images/webwork_logo.svg", alt => $r->maketext('to courses page')) => + $ce->{webwork_url}); } - - return ''; } =item institution_logo() @@ -504,14 +463,12 @@ sub institution_logo { my $ce = $r->ce; my $theme = $r->param("theme") || $ce->{defaultTheme}; my $htdocs = $ce->{webwork_htdocs_url}; - print CGI::a( - { href => $ce->{institutionURL} }, - CGI::img({ - src => "$htdocs/themes/$theme/images/" . $ce->{institutionLogo}, + return $r->link_to( + $r->image( + "$htdocs/themes/$theme/images/" . $ce->{institutionLogo}, alt => $r->maketext("to [_1] main web site", $ce->{institutionName}) - }) + ) => $ce->{institutionURL} ); - return ""; } =item content() @@ -520,46 +477,49 @@ Defined in this package. Print the content of the generated page. -The implementation in this package uses WeBWorK::Template to define the content -of the page. See WeBWorK::Template for details. +This renders a Mojo::Template. -If a method named templateName() exists, it it called to determine the name of -the template to use. If not, the default template, "system", is used. The -location of the template is looked up in the course environment. +The defaultThemeTemplate in the course environment is used for the page layout. +If that is not defined, the default "system" template, is used. The location of +the template is looked up in the course environment. =cut -async sub content { +sub content { my ($self) = @_; my $r = $self->r; my $ce = $r->ce; - my $themesDir = $ce->{webworkDirs}{themes}; - my $theme = $r->param("theme") || $ce->{defaultTheme}; + my $theme = $r->param('theme') || $ce->{defaultTheme}; $theme = $ce->{defaultTheme} if $theme =~ m!(?:^|/)\.\.(?:/|$)!; - #$ce->{webworkURLs}->{stylesheet} = ($ce->{webworkURLs}->{htdocs})."/css/$theme.css"; # reset the style sheet - # the line above is clever -- but I think it is better to link directly to the style sheet from the system.template - # then the link between template and css is made in .template file instead of hard coded as above - # this means that the {stylesheet} option in defaults.config is never used - my $template = $self->can("templateName") ? $self->templateName : $ce->{defaultThemeTemplate}; - my $templateFile = "$themesDir/$theme/$template.template"; - unless (-r $templateFile) { #hack to prevent disaster when missing theme directory - if (-r "$themesDir/math4/$template.template") { - $templateFile = "$themesDir/math4/$template.template"; - $theme = HTML::Entities::encode_entities($theme); + + my $layout = $ce->{defaultThemeTemplate} // 'system'; + + my $layoutName = "$theme/$layout"; + + # Attempt to prevent disaster when the theme layout file is missing. + unless (-r "$ce->{webworkDirs}{themes}/$theme/$layout.html.ep") { + if (-r "$ce->{webworkDirs}{themes}/math4/$layout.html.ep") { + $layoutName = "math4/$layout"; + $theme = HTML::Entities::encode_entities($theme); warn "Theme $theme is not one of the available themes. " - . "Please check the theme configuration " - . "in the files localOverrides.conf, course.conf and " + . 'Please check the theme configuration ' + . 'in the files localOverrides.conf, course.conf and ' . "simple.conf and on the course configuration page.\n"; } else { $theme = HTML::Entities::encode_entities($theme); die "Neither the theme $theme nor the defaultTheme math4 are available. " - . "Please notify your site administrator that the structure of the " - . "themes directory needs attention."; + . 'Please notify your site administrator that the structure of the ' + . 'themes directory needs attention.'; } } - await template($templateFile, $self); + + return $r->render( + template => ((ref($self) =~ s/^WeBWorK:://r) =~ s/::/\//gr), + layout => $layoutName, + cg => $self + ); } =back @@ -570,15 +530,11 @@ async sub content { =head2 Template escape handlers -Template escape handlers are invoked when the template processor encounters a -matching escape sequence in the template. The escapse sequence's arguments are -passed to the methods as a reference to a hash. +Template escape handlers are invoked in the templates. -For more information, refer to WeBWorK::Template. - -The following template escapes handlers are defined here or may be defined in -subclasses. For methods that are not defined in this package, the documentation -defines the interface and behavior that any subclass implementation must follow. +Some of the template escapes handlers are defined here but may be overridden +in a subclass. Others, like C and C are not defined here, but +may be defined in a subclass if needed. =over @@ -588,20 +544,12 @@ Not defined in this package. Any tags that should appear in the HEAD of the document. -=cut - -#sub head { } - =item info() Not defined in this package. Auxiliary information related to the content displayed in the C. -=cut - -#sub info { } - =item links() Defined in this package. @@ -619,13 +567,9 @@ sub links { my $authz = $r->authz; my $urlpath = $r->urlpath; - # we don't currently have any links to display if the user's not logged in. this may change, though. - #return "" unless $authen->was_verified; - - # grab some interesting data from the request + # Grab data from the request. my $courseID = $urlpath->arg('courseID'); my $userID = $r->param('user'); - my $urlUserID = $urlpath->arg('userID'); my $eUserID = $r->param('effectiveUser'); my $setID = $urlpath->arg('setID'); my $problemID = $urlpath->arg('problemID'); @@ -638,10 +582,6 @@ sub links { # then get the setID this user is restricted to view from the authen cookie. $setID = $authen->get_session_set_id if (!$setID && $restricted_navigation); - my $prettySetID = format_set_name_display($setID // ''); - my $prettyAchievementID = $achievementID; - $prettyAchievementID =~ s/_/ /g if defined $prettyAchievementID; - my $prettyProblemID = $problemID; # It's possible that the setID and the problemID are invalid, since they're just taken from the URL path info. @@ -654,32 +594,37 @@ sub links { } } - # experimental subroutine for generating links, to clean up the rest of the - # code. ignore for now. (this is a closure over $self.) + # System link parameters that are common to all links (except the Courses link). + my %systemlink_params = ( + $r->param('displayMode') ? (displayMode => $r->param('displayMode')) : (), + $r->param('showOldAnswers') ? (showOldAnswers => $r->param('showOldAnswers')) : () + ); + + # Subroutine for generating links. my $makelink = sub { my ($module, %options) = @_; - my $urlpath_args = $options{urlpath_args} || {}; - my $systemlink_args = $options{systemlink_args} || {}; - my $text = HTML::Entities::encode_entities($options{text}); - my $active = $options{active}; - my %target = ($options{target} ? (target => $options{target}) : ()); - - my $new_urlpath = $self->r->urlpath->newFromModule($module, $r, %$urlpath_args); - my $new_systemlink = $self->systemLink($new_urlpath, %$systemlink_args); + my $new_urlpath = $self->r->urlpath->newFromModule( + "WeBWorK::ContentGenerator::$module", + $r, + courseID => $courseID, + %{ $options{urlpath_args} || {} } + ); - defined $text or $text = $new_urlpath->name(1); + my $active = $options{active}; - # try to set $active automatically by comparing - if (not defined $active) { + # Try to set $active automatically by comparing the generated urlpath to the existing one. + if (!defined $active) { if ($urlpath->module eq $new_urlpath->module) { my @args = sort keys %{ { $urlpath->args } }; my @new_args = sort keys %{ { $new_urlpath->args } }; if (@args == @new_args) { - foreach my $i (0 .. $#args) { - $active = 0; - last if $args[$i] ne $new_args[$i]; - $active = 1; + $active = 1; + for my $i (0 .. $#args) { + if ($args[$i] ne $new_args[$i]) { + $active = 0; + last; + } } } else { $active = 0; @@ -689,513 +634,32 @@ sub links { } } - if ($active) { - # add active class for current location - return CGI::a( - { href => $new_systemlink, class => 'nav-link active', %target, %{ $options{link_attrs} // {} } }, - $text); - } else { - return CGI::a( - { href => $new_systemlink, class => 'nav-link', %target, %{ $options{link_attrs} // {} } }, $text); - } - }; - - # to make things more concise - my $pfx = "WeBWorK::ContentGenerator::"; - my %args = (courseID => $courseID); - - # we'd like to preserve displayMode and showOldAnswers between pages, and we - # don't have a general way of preserving non-authen params between requests, - # so here is the hack: - my %params; - $params{displayMode} = $r->param("displayMode") if defined $r->param("displayMode"); - $params{showOldAnswers} = $r->param("showOldAnswers") if defined $r->param("showOldAnswers"); - # in the past, we were checking $self->{displayMode} and $self->{will}->{showOldAnswers} - # to set these args, but I don't wanna do that anymore, since it relies on - # fields specific to Problem.pm (pretty sure). The only differences in this - # approach are: - # (a) displayMode will not be set if it wasn't set in the current request, - # but this is ok since the resulting page will just use the default value - # (b) showOldAnswers will get set to the value specified in the current - # request, regardless of whether it is allowed, but this is OK since we - # always this value before using it. - my %systemlink_args; - $systemlink_args{params} = \%params if %params; - - print CGI::h2({ class => 'navbar-brand mb-0' }, $r->maketext('Main Menu')); - print CGI::start_ul({ class => 'nav flex-column' }); - - print CGI::li({ class => 'nav-item' }, - &$makelink("${pfx}Home", text => $r->maketext("Courses"), systemlink_args => { authen => 0 })) - unless $restricted_navigation; - - if (defined $courseID) { - if ($authen->was_verified) { - # Homework Sets or Course Administration - print CGI::li( - { class => 'nav-item' }, - $restricted_navigation ? CGI::span({ class => 'nav-link disabled' }, $r->maketext('Homework Sets')) - : &$makelink( - "${pfx}ProblemSets", - text => $ce->{courseName} eq 'admin' ? $r->maketext('Course Administration') - : $r->maketext('Homework Sets'), - urlpath_args => {%args}, - systemlink_args => \%systemlink_args - ) - ); - - if (defined $setID) { - print CGI::start_li({ class => 'nav-item' }); - print CGI::start_ul({ class => 'nav flex-column' }); - print CGI::start_li({ class => 'nav-item' }); # $setID - - # Show a link which depends on if it is a versioned gateway - # assignment or not; to know if it's a gateway - # assignment, we have to get the set record. - my ($globalSetID) = ($setID =~ /(.+?)(,v\d+)?$/); - my $setRecord = $db->getGlobalSet($globalSetID); - - if ($setRecord->assignment_type eq 'jitar' && defined $problemID) { - $prettyProblemID = join('.', jitar_id_to_seq($problemID)); - } - if ($setRecord->assignment_type =~ /proctor/ && $setID =~ /,v(\d)+$/) { - print &$makelink( - "${pfx}ProctoredGatewayQuiz", - text => "$prettySetID", - urlpath_args => { %args, setID => $setID }, - systemlink_args => \%systemlink_args, - link_attrs => { dir => 'ltr' } - ); - } elsif ($setRecord->assignment_type =~ /gateway/ && $setID =~ /,v(\d)+$/) { - print &$makelink( - "${pfx}GatewayQuiz", - text => "$prettySetID", - urlpath_args => { %args, setID => $setID }, - systemlink_args => \%systemlink_args, - link_attrs => { dir => 'ltr' } - ); - } else { - print &$makelink( - "${pfx}ProblemSet", - text => "$prettySetID", - urlpath_args => { %args, setID => $setID }, - systemlink_args => \%systemlink_args, - link_attrs => { dir => 'ltr' } - ); - } - print CGI::end_li(); - - if (defined $problemID) { - print CGI::start_li({ class => 'nav-item' }); - print CGI::start_ul({ class => 'nav flex-column' }); - print CGI::start_li({ class => 'nav-item' }); # $problemID - print $setRecord->assignment_type =~ /gateway/ - ? CGI::a({ class => 'nav-link' }, $r->maketext('Problem [_1]', $prettyProblemID)) - : &$makelink( - "${pfx}Problem", - text => $r->maketext("Problem [_1]", $prettyProblemID), - urlpath_args => { %args, setID => $setID, problemID => $problemID }, - systemlink_args => \%systemlink_args - ); - print CGI::end_li(); # end $problemID - print CGI::end_ul(); - print CGI::end_li(); # end $setID - } - - print CGI::end_ul(); - print CGI::end_li(); # end Homework Sets - } - - print CGI::li({ class => 'nav-item' }, - &$makelink("${pfx}Options", urlpath_args => {%args}, systemlink_args => \%systemlink_args)) - if ($authz->hasPermissions($userID, 'change_password') - || $authz->hasPermissions($userID, 'change_email_address') - || $authz->hasPermissions($userID, 'change_pg_display_settings')); - - print CGI::li({ class => 'nav-item' }, - &$makelink("${pfx}Grades", urlpath_args => {%args}, systemlink_args => \%systemlink_args)) - unless $restricted_navigation; - - if ($ce->{achievementsEnabled}) { - print CGI::li( - { class => 'nav-item' }, - &$makelink("${pfx}Achievements", urlpath_args => {%args}, systemlink_args => \%systemlink_args) - ); - } - - if ($authz->hasPermissions($userID, "access_instructor_tools")) { - $pfx .= "Instructor::"; - - print CGI::start_li({ class => 'nav-item' }); # Instructor Tools - print &$makelink("${pfx}Index", urlpath_args => {%args}, systemlink_args => \%systemlink_args); - print CGI::end_li(); - print CGI::start_li({ class => 'nav-item' }); - print CGI::start_ul({ class => 'nav flex-column' }); - - #class list editor - print CGI::li({ class => 'nav-item' }, - &$makelink("${pfx}UserList", urlpath_args => {%args}, systemlink_args => \%systemlink_args)); - - # Homework Set Editor - print CGI::li( - { class => 'nav-item' }, - &$makelink( - "${pfx}ProblemSetList", - urlpath_args => {%args}, - systemlink_args => \%systemlink_args - ) - ); - - ## only show editor link for non-versioned sets - if (defined $setID && $setID !~ /,v\d+$/) { - print CGI::start_li({ class => 'nav-item' }); - print CGI::start_ul({ class => 'nav flex-column' }); - - print CGI::start_li({ class => 'nav-item' }); - print &$makelink( - "${pfx}ProblemSetDetail", - text => $prettySetID, - urlpath_args => { %args, setID => $setID }, - systemlink_args => \%systemlink_args, - link_attrs => { dir => 'ltr' } - ); - print CGI::end_li(); - - if (defined $problemID) { - print CGI::start_li({ class => 'nav-item' }); - print CGI::start_ul({ class => 'nav flex-column' }); - print CGI::li( - { class => 'nav-item' }, - &$makelink( - "${pfx}PGProblemEditor", - text => $r->maketext('Problem [_1]', $prettyProblemID), - urlpath_args => { %args, setID => $setID, problemID => $problemID }, - systemlink_args => \%systemlink_args, - target => "WW_Editor" - ) - ); - print CGI::end_ul(); - print CGI::end_li(); - } - - print CGI::end_ul(); - print CGI::end_li(); - } - - print CGI::li( - { class => 'nav-item' }, - &$makelink( - "${pfx}SetMaker", - text => $r->maketext("Library Browser"), - urlpath_args => {%args}, - systemlink_args => \%systemlink_args - ) - ); - - print CGI::start_li({ class => 'nav-item' }); # Stats - print &$makelink("${pfx}Stats", urlpath_args => {%args}, systemlink_args => \%systemlink_args); - if ($userID ne $eUserID or defined $setID or defined $urlUserID) { - print CGI::start_ul({ class => 'nav flex-column' }); - if (defined $urlUserID) { - print CGI::li( - { class => 'nav-item' }, - &$makelink( - "${pfx}Stats", - text => $urlUserID, - urlpath_args => { %args, statType => "student", userID => $urlUserID }, - systemlink_args => \%systemlink_args - ) - ); - } - if ($userID ne $eUserID && (!defined $urlUserID || $urlUserID ne $eUserID)) { - print CGI::li( - { class => 'nav-item' }, - &$makelink( - "${pfx}Stats", - text => $eUserID, - urlpath_args => { %args, statType => "student", userID => $eUserID }, - systemlink_args => \%systemlink_args, - active => $urlpath->type eq 'instructor_user_statistics' && !defined $urlUserID - ) - ); - } - if (defined $setID) { - # make sure we don't try to send a versioned - # set id in to the stats link - my ($nvSetID) = ($setID =~ /(.+?)(,v\d+)?$/); - my ($nvPretty) = ($prettySetID =~ /(.+?)(,v\d+)?$/); - print CGI::li( - { class => 'nav-item', dir => 'ltr' }, - &$makelink( - "${pfx}Stats", - text => "$nvPretty", - urlpath_args => { %args, statType => "set", setID => $nvSetID }, - systemlink_args => \%systemlink_args - ) - ); - if (defined $problemID) { - print CGI::li( - { class => 'nav-item' }, - CGI::ul( - { class => 'nav flex-column' }, - CGI::li( - { class => 'nav-item', dir => 'ltr' }, - &$makelink( - "${pfx}Stats", - text => $r->maketext('Problem [_1]', $prettyProblemID), - urlpath_args => { - %args, - statType => 'ste', - setID => $nvSetID, - problemID => $problemID - }, - systemlink_args => \%systemlink_args - ) - ) - ) - ); - } - } - print CGI::end_ul(); - } - print CGI::end_li(); # end Stats - - print CGI::start_li({ class => 'nav-item' }); # Student Progress - print &$makelink( - "${pfx}StudentProgress", - urlpath_args => {%args}, - systemlink_args => \%systemlink_args - ); - if ($userID ne $eUserID or defined $setID or defined $urlUserID) { - print CGI::start_ul({ class => 'nav flex-column' }); - if (defined $urlUserID) { - print CGI::li( - { class => 'nav-item' }, - &$makelink( - "${pfx}StudentProgress", - text => $urlUserID, - urlpath_args => { %args, statType => "student", userID => $urlUserID }, - systemlink_args => \%systemlink_args - ) - ); - } - if ($userID ne $eUserID && (!defined $urlUserID || $urlUserID ne $eUserID)) { - print CGI::li( - { class => 'nav-item' }, - &$makelink( - "${pfx}StudentProgress", - text => $eUserID, - urlpath_args => { %args, statType => "student", userID => $eUserID }, - systemlink_args => \%systemlink_args, - active => $urlpath->type eq 'instructor_user_progress' && !defined $urlUserID - ) - ); - } - if (defined $setID) { - # make sure we don't try to send a versioned - # set id in to the stats link - my ($nvSetID) = ($setID =~ /(.+?)(,v\d+)?$/); - my ($nvPretty) = ($prettySetID =~ /(.+?)(,v\d+)?$/); - print CGI::li( - { class => 'nav-item', dir => 'ltr' }, - &$makelink( - "${pfx}StudentProgress", - text => "$nvPretty", - urlpath_args => { %args, statType => "set", setID => $nvSetID }, - systemlink_args => \%systemlink_args - ) - ); - } - print CGI::end_ul(); - } - print CGI::end_li(); # end Student Progress - - if ($authz->hasPermissions($userID, "score_sets")) { - print CGI::li( - { class => 'nav-item' }, - &$makelink( - "${pfx}Scoring", - urlpath_args => {%args}, - systemlink_args => \%systemlink_args - ) - ); - } - - #Show achievement editor for instructors - if ($ce->{achievementsEnabled} && $authz->hasPermissions($userID, "edit_achievements")) { - print CGI::li( - { class => 'nav-item' }, - &$makelink( - "${pfx}AchievementList", - urlpath_args => {%args}, - systemlink_args => \%systemlink_args - ) - ); - if (defined $achievementID) { - print CGI::start_li({ class => 'nav-item' }); - print CGI::start_ul({ class => 'nav flex-column' }); - print CGI::start_li({ class => 'nav-item' }); # $achievementID - print &$makelink( - "${pfx}AchievementEditor", - text => "$prettyAchievementID", - urlpath_args => { %args, achievementID => $achievementID }, - systemlink_args => \%systemlink_args - ); - print CGI::end_ul(); - print CGI::end_li(); - } - - } - - if ($authz->hasPermissions($userID, "send_mail")) { - print CGI::li( - { class => 'nav-item' }, - &$makelink( - "${pfx}SendMail", - urlpath_args => {%args}, - systemlink_args => \%systemlink_args - ) - ); - } - - if ($authz->hasPermissions($userID, "manage_course_files")) { - print CGI::li( - { class => 'nav-item' }, - &$makelink( - "${pfx}FileManager", - urlpath_args => {%args}, - systemlink_args => \%systemlink_args - ) - ); - } - - if ($ce->{LTIGradeMode} && $authz->hasPermissions($userID, 'score_sets')) { - print CGI::li( - { class => 'nav-item' }, - &$makelink( - "${pfx}LTIUpdate", - text => $r->maketext('LTI Grade Update'), - urlpath_args => \%args, - systemlink_args => \%systemlink_args, - ) - ); - } - - if ($authz->hasPermissions($userID, "manage_course_files")) { - print CGI::li( - { class => 'nav-item' }, - &$makelink( - "${pfx}Config", - urlpath_args => {%args}, - systemlink_args => \%systemlink_args - ) - ); - } - print CGI::li({ class => 'nav-item' }, - $self->helpMacro('instructor_links', { label => $r->maketext('Help'), class => 'nav-link' })); - print CGI::li({ class => 'nav-item' }, $self->help({ class => 'nav-link' })); - if ( - $authz->hasPermissions($userID, "manage_course_files") # show this only on the FileManager page - && $r->urlpath->module eq "WeBWorK::ContentGenerator::Instructor::FileManager" - ) - { - my %augmentedSystemLinks = %systemlink_args; - $augmentedSystemLinks{params}->{archiveCourse} = 1; - print CGI::li( - { class => 'nav-item' }, - &$makelink( - "${pfx}FileManager", - text => $r->maketext("Archive this Course"), - urlpath_args => {%args}, - systemlink_args => \%augmentedSystemLinks, - active => 0 - ) - ); - } - print CGI::end_ul(); - print CGI::end_li(); # end Instructor Tools - } # /* access_instructor_tools */ - - if (exists $ce->{webworkURLs}{bugReporter} - && $ce->{webworkURLs}{bugReporter} ne '' - && $authz->hasPermissions($userID, 'report_bugs')) - { - print CGI::li( - { class => 'nav-item' }, - CGI::a( - { href => $ce->{webworkURLs}{bugReporter}, class => 'nav-link' }, - $r->maketext("Report bugs") - ) - ); - } - - } # /* authentication was_verified */ - - } # /* defined $courseID */ - - print CGI::end_ul(); - - return ""; -} - -=item loginstatus() - -Defined in this package. - -Print a notification message announcing the current real user and effective -user, a link to stop acting as the effective user, and a link to logout. - -=cut - -sub loginstatus { - my ($self) = @_; - my $r = $self->r; - my $authen = $r->authen; - my $urlpath = $r->urlpath; - #This will contain any extra parameters which are needed to make - # the page function properly. This will normally be empty. - my $extraStopActingParams = $r->{extraStopActingParams}; - - if ($authen and $authen->was_verified) { - my $courseID = $urlpath->arg("courseID"); - my $userID = $r->param("user"); - my $eUserID = $r->param("effectiveUser"); - - $extraStopActingParams->{effectiveUser} = $userID; - my $stopActingURL = $self->systemLink( - $urlpath, # current path - params => $extraStopActingParams + # Do not use HTML::Entities::encode_entities the link text. + # Mojolicious has already encoded html entities at this point. + return $r->link_to( + ($options{text} // $new_urlpath->name(1)) => $self->systemLink( + $new_urlpath, params => { %systemlink_params, %{ $options{systemlink_params} // {} } } + ), + class => 'nav-link' . ($active ? ' active' : ''), + $options{target} ? (target => $options{target}) : (), + %{ $options{link_attrs} // {} } ); - my $logoutURL = $self->systemLink($urlpath->newFromModule(__PACKAGE__ . "::Logout", $r, courseID => $courseID)); - - my $signOutIcon = - CGI::i({ class => "icon fas fa-sign-out-alt", aria_hidden => "true", data_alt => "signout" }, ""); - - my $user = $r->db->getUser($userID); - my $prettyUserName = $user->full_name || $user->user_id; - - if ($eUserID eq $userID) { - print $r->maketext("Logged in as [_1].", HTML::Entities::encode_entities($prettyUserName)) - . CGI::a({ href => $logoutURL, class => "btn btn-light btn-sm ms-2" }, - $r->maketext("Log Out") . " " . $signOutIcon); - } else { - my $eUser = $r->db->getUser($eUserID); - my $prettyEUserName = - $eUser->full_name ? join(' ', $eUser->full_name, '(' . $eUser->user_id . ')') : $eUser->user_id; - - print $r->maketext("Logged in as [_1].", HTML::Entities::encode_entities($prettyUserName)) - . CGI::a({ href => $logoutURL, class => "btn btn-light btn-sm ms-2" }, - $r->maketext("Log Out") . " " . $signOutIcon); - print CGI::br(); - print $r->maketext("Acting as [_1].", HTML::Entities::encode_entities($prettyEUserName)) - . CGI::a({ href => $stopActingURL, class => "btn btn-light btn-sm ms-2" }, - $r->maketext("Stop Acting") . " " . $signOutIcon); - } - } else { - print $r->maketext("Not logged in."); - } + }; - return ""; + return $r->include( + 'ContentGenerator/Base/links', + courseID => $courseID, + userID => $userID, + eUserID => $eUserID, + urlUserID => $urlpath->arg('userID'), + setID => $setID, + prettySetID => format_set_name_display($setID // ''), + problemID => $problemID, + prettyProblemID => $prettyProblemID, + achievementID => $achievementID, + restricted_navigation => $restricted_navigation, + makelink => $makelink, + ); } =item nav($args) @@ -1213,10 +677,6 @@ For example: -=cut - -#sub nav { } - =item options() Not defined in this package. @@ -1224,10 +684,6 @@ Not defined in this package. View options related to the content displayed in the body or info areas. See also optionsMacro(). -=cut - -#sub options { } - =item path($args) Defined in this package. @@ -1276,11 +732,9 @@ sub path { } while ($urlpath = $urlpath->parent); # We don't want the last path element to be a link. - $path[$#path] = ''; + $path[-1] = ''; - print $self->pathMacro($args, @path); - - return ''; + return $self->pathMacro($args, @path); } =item siblings() @@ -1289,38 +743,6 @@ Not defined in this package. Print links to siblings of the current object. -=cut - -#sub siblings { } - -=item footer() - - -by ghe3 - - combines timestamp() and other elements of the footer, including the copyright, into one output subroutine, -=cut - -sub footer { - my $self = shift; - my $r = $self->r; - my $ce = $r->ce; - my $ww_version = $ce->{WW_VERSION} || 'unknown -- set WW_VERSION in VERSION'; - my $pg_version = $ce->{PG_VERSION} || 'unknown -- set PG_VERSION in ../pg/VERSION'; - my $theme = $ce->{defaultTheme} || 'unknown -- set defaultTheme in localOverides.conf'; - my $copyright_years = $ce->{WW_COPYRIGHT_YEARS} || '1996-2022'; - print CGI::div({ id => 'last-modified' }, $r->maketext('Page generated at [_1]', timestamp($self))); - print CGI::div( - { id => 'copyright' }, - $r->maketext( - 'WeBWorK © [_1] | theme: [_2] | ww_version: [_3] | pg_version [_4] |', - $copyright_years, $theme, $ww_version, $pg_version - ), - CGI::a({ href => 'https://openwebwork.org/' }, $r->maketext('The WeBWorK Project')) - ); - - return ''; -} - =item timestamp() Defined in this package. @@ -1335,16 +757,10 @@ will give standard WeBWorK time format. Wording and other formatting can be done in the template itself. =cut -# sub timestamp { -# my ($self, $args) = @_; -# my $formatstring = "%l:%M%P on %b %e, %Y"; -# $formatstring = $args->{style} if(defined($args->{style})); -# return(Date::Format::time2str($formatstring, time())); -# } sub timestamp { my ($self, $args) = @_; - # need to use the formatDateTime in this file (some subclasses access Util's version. - return ($self->formatDateTime(time())); + # Need to use the formatDateTime in this file (some subclasses access Util's version). + return $self->formatDateTime(time); } =item message() @@ -1354,14 +770,17 @@ Defined in this package. Print any messages (error or non-error) resulting from the last form submission. This could be used to give Sucess and Failure messages after an action is performed by a module. -The implementation in this package prints the value of the field +The implementation in this package outputs the value of the field $self->{status_message}, if it is present. =cut sub message { my ($self) = @_; - print $self->{status_message} if $self->{status_message}; + + $self->{status_message} //= $self->r->c; + return $self->{status_message}->join('') if @{ $self->{status_message} }; + return ''; } @@ -1385,13 +804,11 @@ sub title { # If the urlpath type is 'set_list' and the course has a course title then display that. if (($urlpath->type // '') eq 'set_list' && $db->settingExists('courseTitle')) { - print $db->getSettingValue('courseTitle'); + return $db->getSettingValue('courseTitle'); } else { # Display the urlpath name - print $urlpath->name(1); + return $urlpath->name(1); } - - return ''; } =item webwork_url @@ -1408,8 +825,7 @@ that can be accessed in javascript files. sub webwork_url { my $self = shift; - print $self->r->location; - return ''; + return $self->r->location; } =item warnings() @@ -1425,8 +841,11 @@ The implementation in this package checks for a stash key named sub warnings { my ($self) = @_; - print CGI::p("Entering ContentGenerator::warnings") if $TRACE_WARNINGS; - print $self->warningOutput($self->r->stash->{warnings}) if $self->r->stash->{warnings}; + my $r = $self->r; + + return $self->r->include('ContentGenerator/Base/warning_output', + warnings => [ split m/\n+/, $r->stash('warnings') ]) + if $r->stash('warnings'); return ''; } @@ -1497,138 +916,65 @@ sub url { # ------------------------------------------------------------------------------ -=head2 Conditional predicates +=head2 Template conditions -Conditional predicate methods are invoked when the C<#if> escape sequence is -encountered in the template. If a method named C is defined in -here or in the instantiated subclass, it is invoked. +Template condition methods are called in the template. If a method is defined +here or overriden in the instantiated subclass, it is invoked. -The following predicates are currently defined: +The following conditions are currently defined: =over -=item if_can($function) +=item can($function) If a function named $function is present in the current content generator (or any superclass), a true value is returned. Otherwise, a false value is returned. -The implementation in this package uses the method UNIVERSAL->can(function) to -arrive at the result. +This package just uses the UNIVERSAL::can() function. A subclass could redefine this method to, for example, "hide" a method from the template: - sub if_can { - my ($self, $arg) = @_; - - if ($arg eq "floobar") { - return 0; - } else { - return $self->SUPER::if_can($arg); - } - } - -=cut - -sub if_can { - my ($self, $arg) = @_; - - return $self->can($arg) ? 1 : 0; -} - -=item if_loggedin($arg) + sub can { + my ($self, $arg) = @_; -If the user is currently logged in, $arg is returned. Otherwise, the inverse of -$arg is returned. - -#The implementation in this package always returns $arg, since most content -#generators are only reachable when the user is authenticated. It is up to -#classes that can be reached without logging in to override this method and -#provide the correct behavior. -# -#This is suboptimal, and may change in the future. - -The implementation in this package uses WeBWorK::Authen::was_verified() to -retrieve the result of the last call to WeBWorK::Authen::verify(). + if ($arg eq "floobar") { + return 0; + } else { + return $self->SUPER::can($arg); + } + } =cut -sub if_loggedin { - my ($self, $arg) = @_; - - #return $arg; - return 0 unless $self->r->authen; - return $self->r->authen->was_verified() ? $arg : !$arg; -} - -=item if_message($arg) - -If the last form submission generated a message, $arg is returned. Otherwise, the -inverse of $arg is returned. +=item have_warnings -The implementation in this package checks for the field $self->{status_message} to -determine if a message is present. +If warnings have been emitted while handling this request return true, otherwise +return false. -If a subclass uses some other method to classify submission results, this method could be -redefined to handle that variance: - - sub if_message { - my ($self, $arg) = @_; - - my $status = $self->{processReturnValue}; - if ($status != 0) { - return $arg; - } else { - return !$arg; - } - } +This implementation checks if a stash value named "warnings" has been set or if +there are pg errors. =cut -sub if_message { - my ($self, $arg) = @_; - - if (exists $self->{status_message}) { - return $arg; - } else { - return !$arg; - } -} - -=item if_warnings - -If warnings have been emitted while handling this request, $arg is returned. -Otherwise, the inverse of $arg is returned. - -The implementation in this package checks for a note in the request named -"warnings". This is set by the WARN handler in Apache::WeBWorK when a warning is -handled. - -=cut - -sub if_warnings { - my ($self, $arg) = @_; +sub have_warnings { + my ($self) = @_; my $r = $self->r; - if ($r->stash('warnings') || $self->{pgerrors}) { - return $arg; - } else { - return !$arg; - } + return $r->stash('warnings') || $self->{pgerrors}; } -=item if_exists +=item exists_theme_file Returns true if the specified file exists in the current theme directory and false otherwise =cut -sub if_exists { +sub exists_theme_file { my ($self, $arg) = @_; - my $r = $self->r; - my $ce = $r->ce; - return -e $ce->{webworkDirs}{themes} . '/' . $ce->{defaultTheme} . '/' . $arg; + my $ce = $self->r->ce; + return -e "$ce->{webworkDirs}{themes}/$ce->{defaultTheme}/$arg"; } =back @@ -1678,14 +1024,8 @@ sub pathMacro { $args{style} = 'text' if $args{textonly}; my $auth = $self->url_authen_args; - my $sep; - if ($args{style} eq 'image') { - $sep = CGI::img({ src => $args{image}, alt => $args{text} }); - } else { - $sep = $args{text}; - } - my @result; + my $result = $r->c; while (@path) { my $name = shift @path; my $url = shift @path; @@ -1695,22 +1035,22 @@ sub pathMacro { $name =~ s/_/ /g; - if ($url and not $args{textonly}) { + if ($url && !$args{textonly}) { if ($args{style} eq 'bootstrap') { - push @result, CGI::li({ class => 'breadcrumb-item' }, CGI::a({ href => "$url?$auth" }, $name)); + push @$result, $r->tag('li', class => 'breadcrumb-item', $r->link_to($name => "$url?$auth")); } else { - push @result, CGI::a({ href => "$url?$auth" }, $name); + push @$result, $r->link_to($name => "$url?$auth"); } } else { if ($args{style} eq 'bootstrap') { - push @result, CGI::li({ class => 'breadcrumb-item active' }, $name); + push @$result, $r->tag('li', class => 'breadcrumb-item active', $name); } else { - push @result, $name; + push @$result, $name; } } } - return join($sep, @result); + return $result->join($args{text}); } =item siblingsMacro(@siblings) @@ -1732,9 +1072,9 @@ we have systemLink(). sub siblingsMacro { my ($self, @siblings) = @_; + my $r = $self->r; my $auth = $self->url_authen_args; - my $sep = CGI::br(); my @result; while (@siblings) { @@ -1742,11 +1082,10 @@ sub siblingsMacro { my $url = shift @siblings; my $id = $name; $id =~ s/\W/\_/g; - push @result, - $url ? CGI::span({ id => $id }, CGI::a({ -href => "$url?$auth" }, $name)) : CGI::span({ id => $id }, $name); + push @result, $r->tag('span', id => $id, $url ? $r->link_to($name => "$url?$auth") : $name); } - return join($sep, @result) . "\n"; + return join($r->tag('br'), @result) . "\n"; } =item navMacro($args, $tail, @links) @@ -1770,22 +1109,21 @@ sub navMacro { my $ce = $r->ce; my %args = %$args; - my $auth = $self->url_authen_args; - my $prefix = $ce->{webworkURLs}->{htdocs} . "/images"; + my $auth = $self->url_authen_args; - my @result; + my $result = $r->c; while (@links) { my $name = shift @links; my $url = shift @links; my $direction = shift @links; my $html = ($direction && $args{style} eq "buttons") ? $direction : $name; - push @result, + push @$result, $url - ? CGI::a({ href => "$url?$auth$tail", class => "btn btn-primary" }, $html) - : CGI::span({ class => "btn btn-primary disabled" }, $html); + ? $r->link_to($html => "$url?$auth$tail", class => 'btn btn-primary') + : $r->tag('span', class => 'btn btn-primary disabled', $html); } - return join($args{separator}, @result) . "\n"; + return $result->join($args{separator}); } =item helpMacro($name) @@ -1802,9 +1140,10 @@ sub helpMacro { my $self = shift; my $name = shift; my $args = shift; + my $r = $self->r; my $label = $args->{label} - // CGI::i({ class => "icon fas fa-question-circle", aria_hidden => "true", data_alt => " ? " }, ''); + // $r->tag('i', class => 'icon fas fa-question-circle', 'aria-hidden' => 'true', data => { alt => ' ? ' }, ''); delete $args->{label}; $args->{class} = 'help-macro ' . ($args->{class} // ''); @@ -1812,14 +1151,7 @@ sub helpMacro { my $ce = $self->r->ce; $name = 'no_help' unless -e "$ce->{webworkDirs}{local_help}/$name.html"; - return CGI::a( - { - href => $ce->{webworkURLs}{local_help} . "/$name.html", - target => 'ww_help', - %$args - }, - $label - ); + return $r->link_to($label => "$ce->{webworkURLs}{local_help}/$name.html", target => 'ww_help', %$args); } =item sub optionsMacro @@ -1852,76 +1184,32 @@ sub feedbackMacro { my $feedbackURL = $r->ce->{courseURLs}{feedbackURL}; my $feedbackFormURL = $r->ce->{courseURLs}{feedbackFormURL}; if (defined $feedbackURL and $feedbackURL ne "") { - return $self->feedbackMacro_url($feedbackURL); + return $self->feedback_macro_url($feedbackURL); } elsif (defined $feedbackFormURL and $feedbackFormURL ne "") { - return $self->feedbackMacro_form($feedbackFormURL, %params); + return $self->feedback_macro_form($feedbackFormURL, %params); } else { - return $self->feedbackMacro_email(%params); + return $self->feedback_macro_email(%params); } } -sub feedbackMacro_email { +sub feedback_macro_email { my ($self, %params) = @_; - my $r = $self->r; - my $ce = $r->ce; - my $urlpath = $r->urlpath; - my $courseID = $urlpath->arg("courseID"); - - # feedback form url - my $feedbackPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Feedback", $r, courseID => $courseID); - my $feedbackURL = $self->systemLink($feedbackPage, authen => 0); # no authen info for form action - my $feedbackName = $r->maketext($ce->{feedback_button_name}) || $r->maketext("Email instructor"); - - my $result = CGI::start_form(-method => "POST", -action => $feedbackURL) . "\n"; - #This is being used on forms with hidden_authen_fields already included - # in many pages so we need to change the fields to be hidden - my $hiddenFields = $self->hidden_authen_fields; - $hiddenFields =~ s/\"hidden_/\"email-hidden_/g; - $result .= $hiddenFields . "\n"; - - while (my ($key, $value) = each %params) { - next if $key eq 'pg_object'; # not used in internal feedback mechanism - $result .= CGI::hidden($key, $value) . "\n"; - } - $result .= CGI::p(CGI::submit({ name => "feedbackForm", value => $feedbackName, class => 'btn btn-primary' })); - $result .= CGI::end_form() . "\n"; - - return $result; + return $self->r->include('ContentGenerator/Base/feedback_macro_email', params => \%params); } -sub feedbackMacro_form { +sub feedback_macro_form { my ($self, $feedbackFormURL, %params) = @_; - my $r = $self->r; - my $ce = $r->ce; - - # feedback form url - my $feedbackName = $r->maketext($ce->{feedback_button_name}) || $r->maketext("Email instructor"); - - my $result = CGI::start_form(-method => "POST", -action => $feedbackFormURL, -target => "WW_info") . "\n"; - - $result .= $self->hidden_authen_fields . "\n"; - - while (my ($key, $value) = each %params) { - if ($key eq 'pg_object') { - my $tmp = $value->{body_text}; - $tmp .= CGI::p(CGI::b("Note: ") . CGI::i($value->{result}->{msg})) if $value->{result}->{msg}; - $result .= CGI::hidden($key, encode_base64(Encode::encode('UTF-8', $tmp), "")); - } else { - $result .= CGI::hidden($key, $value) . "\n"; - } - } - $result .= CGI::p({ -align => "left" }, - CGI::submit({ name => "feedbackForm", value => $feedbackName, class => 'btn btn-primary' })); - $result .= CGI::end_form() . "\n"; - - return $result; + return $self->r->include( + 'ContentGenerator/Base/feedback_macro_form', + params => \%params, + feedbackFormURL => $feedbackFormURL + ); } -sub feedbackMacro_url { +sub feedback_macro_url { my ($self, $url) = @_; - my $r = $self->r; - my $feedbackName = $r->maketext($r->ce->{feedback_button_name}) || $r->maketext("Email instructor"); - return CGI::a({ -href => $url }, $feedbackName); + my $r = $self->r; + return $r->link_to(($r->maketext($r->ce->{feedback_button_name}) || $r->maketext('Email instructor')) => $url); } =back @@ -1942,24 +1230,31 @@ fragments. Return hidden tags for each field mentioned in @fields (or all fields if list is empty), taking data from the current request. +A hash of options may be passed for the first argument of this method. The only +supported option is an "id_prefix" to prepend to the id's of all of the hidden +inputs that are created. + =cut sub hidden_fields { my ($self, @fields) = @_; my $r = $self->r; + my %options = ref $fields[0] eq 'HASH' ? %{ shift @fields } : (); + my $id_prefix = $options{id_prefix} // ''; + @fields = $r->param unless @fields; - my $html = ''; - foreach my $param (@fields) { + my $html = $r->c; + for my $param (@fields) { my @values = $r->param($param); - foreach my $value (@values) { + for my $value (@values) { next unless defined($value); - $html .= CGI::hidden({ name => $param, default => $value, id => "hidden_" . $param }); + push(@$html, $r->hidden_field($param => $value, id => "${id_prefix}hidden_$param")); } } - return $html; + return $html->join(''); } =item hidden_authen_fields() @@ -1967,12 +1262,16 @@ sub hidden_fields { Use hidden_fields to return hidden tags for request fields used in authentication. +An optional $id_prefix may be passed as the first argument of this method. + =cut sub hidden_authen_fields { - my ($self) = @_; + my ($self, $id_prefix) = @_; - return $self->hidden_fields("user", "effectiveUser", "key", "theme"); + return $self->hidden_fields({ id_prefix => $id_prefix }, 'user', 'effectiveUser', 'key', 'theme') + if defined $id_prefix; + return $self->hidden_fields('user', 'effectiveUser', 'key', 'theme'); } =item hidden_proctor_authen_fields() @@ -1985,29 +1284,12 @@ proctor authentication. sub hidden_proctor_authen_fields { my $self = shift; if ($self->r->param('proctor_user')) { - return $self->hidden_fields("proctor_user", "proctor_key"); + return $self->hidden_fields('proctor_user', 'proctor_key'); } else { return ''; } } -=item hidden_state_fields() - -Use hidden_fields to return hidden tags for request fields used to -maintain state. Currently includes authentication fields and display option -fields. - -=cut - -sub hidden_state_fields { - my ($self) = @_; - - return $self->hidden_authen_fields(); - - # other things that may be state data: - #$self->hidden_fields("displayMode", "showOldAnswers", "showCorrectAnswers", "showHints", "showSolutions"); -} - =item url_args(@fields) Return a URL query string (without the leading `?') containing values for each @@ -2023,9 +1305,9 @@ sub url_args { @fields = $r->param unless @fields; my @pairs; - foreach my $param (@fields) { + for my $param (@fields) { my @values = $r->param($param); - foreach my $value (@values) { + for my $value (@values) { push @pairs, uri_escape_utf8($param) . "=" . uri_escape($value); } } @@ -2054,70 +1336,6 @@ sub url_authen_args { } } -=item url_state_args() - -Use url_args to return a URL query string for request fields used to maintain -state. Currently includes authentication fields and display option fields. - -=cut - -sub url_state_args { - my ($self) = @_; - - return $self->url_authen_args; - - # other things that may be state data: - #$self->url_args("displayMode", "showOldAnswers", "showCorrectAnswers", "showHints", "showSolutions"); -} - -# This method is not used anywhere! --sam(1-Aug-05) -# -#=item url_display_args() -# -#Use url_args to return a URL query string for request fields used in -#authentication. -# -#=cut -# -#sub url_display_args { -# my ($self) = @_; -# -# return $self->url_args("displayMode", "showOldAnswer"); -#} - -# This method is not used anywhere! --sam(1-Aug-05) -# -#=item print_form_data($begin, $middle, $end, $omit) -# -#Return a string containing every request field not matched by the quoted reguar -#expression $omit, placing $begin before each field name, $middle between each -#field name and its value, and $end after each value. Values are taken from the -#current request. -# -#=cut -# -#sub print_form_data { -# my ($self, $begin, $middle, $end, $qr_omit) = @_; -# my $r=$self->r; -# my @form_data = $r->param; -# -# my $return_string = ""; -# foreach my $name (@form_data) { -# next if ($qr_omit and $name =~ /$qr_omit/); -# my @values = $r->param($name); -# foreach my $variable (qw(begin name middle value end)) { -# # FIXME: can this loop be moved out of the enclosing loop? -# no strict 'refs'; -# ${$variable} = "" unless defined ${$variable}; -# } -# foreach my $value (@values) { -# $return_string .= "$begin$name$middle$value$end"; -# } -# } -# -# return $return_string; -#} - =back =cut @@ -2209,7 +1427,7 @@ sub systemLink { $url .= $r->location . $urlpath->path; my $first = 1; - foreach my $name (keys %params) { + for my $name (keys %params) { my $value = $params{$name}; my @values; @@ -2224,8 +1442,8 @@ sub systemLink { } #FIXME -- evntually we'd like to catch where this happens if ($name eq 'user' and @values > 1) { - warn - "internal error -- user has been multiply defined! You may need to logout and log back in to correct this."; + warn 'internal error -- user has been multiply defined! ' + . 'You may need to logout and log back in to correct this.'; my $user = $r->param("user"); $r->param(user => $user); @values = ($user); @@ -2257,7 +1475,7 @@ Otherwise $string is returned. sub nbsp { my ($self, $str) = @_; - return (defined $str && $str =~ /\S/) ? $str : " "; + return (defined $str && $str =~ /\S/) ? $str : ' '; } =item errorOutput($error, $details) @@ -2267,134 +1485,21 @@ problem rendering. =cut -sub errorOutput($$$) { +sub errorOutput { my ($self, $error, $details) = @_; - my $r = $self->{r}; - print "Entering ContentGenerator::errorOutput subroutine
      " if $TRACE_WARNINGS; - my $time = time2str("%a %b %d %H:%M:%S %Y", time); - my $method = $r->req->method; - my $uri = $r->uri; - my $headers = do { - my %headers = %{ $r->headers_in }; - join("", map { CGI::Tr({}, CGI::td(CGI::small($_)), CGI::td(CGI::small($headers{$_}))) } keys %headers); - }; - - # if it is a long report pass details by reference rather than by value - # for consistency we automatically convert all forms of $details into - # a reference to an array. - - if (ref($details) =~ /SCALAR/i) { - $details = [$$details]; - } elsif (ref($details) =~ /ARRAY/i) { - # no change needed - } else { - $details = [$details]; - } - return - CGI::h2($r->maketext("WeBWorK Error")), - CGI::p($r->maketext( - 'WeBWorK has encountered a software error while attempting to process this problem. It is likely that ' - . 'there is an error in the problem itself. If you are a student, report this error message to your ' - . 'professor to have it corrected. If you are a professor, please consult the error output below for ' - . 'more information.' - )), - - CGI::h3($r->maketext("Error messages")), - - CGI::p(CGI::code($error)), CGI::h3("Error details"), - - CGI::start_code(), CGI::start_p(), @{$details}, - #CGI::code(CGI::p(@expandedDetails)), - # not using inclusive CGI calls here saves about 30Meg of memory! - CGI::end_p(), CGI::end_code(), - - CGI::h3($r->maketext("Request information")), - CGI::table( - { border => "1" }, - CGI::Tr({}, CGI::td($r->maketext("Time")), CGI::td($time)), - CGI::Tr({}, CGI::td($r->maketext("Method")), CGI::td($method)), - CGI::Tr({}, CGI::td($r->maketext("URI")), CGI::td($uri)), - CGI::Tr({}, CGI::td($r->maketext("HTTP Headers")), CGI::td(CGI::table($headers),)), - ), - ; - + return $self->r->include('ContentGenerator/Base/error_output', error => $error, details => $details); } =item warningMessage -Used to print out a generic warning message at the top of the page +Used to display a generic warning message at the top of the page =cut sub warningMessage { my $self = shift; - my $r = $self->r; - - return CGI::b($r->maketext("Warning")), ' -- ', - $r->maketext( - "There may be something wrong with this question. Please inform your instructor including the warning messages below." - ); - -} - -=item warningOutput($warnings) - -Used by warnings() in this class to report warnings caught during dispatching -and content generation. - -=cut - -sub warningOutput($$) { - my ($self, $warnings) = @_; - my $r = $self->{r}; - print "Entering ContentGenerator::warningOutput subroutine
      " if $TRACE_WARNINGS; - my @warnings = split m/\n+/, $warnings; - - my $scrubber = HTML::Scrubber->new( - default => 1, - script => 0, - comment => 0 - ); - $scrubber->default( - undef, - { - '*' => 1, - } - ); - - foreach my $warning (@warnings) { - # Since these warnings have html they look better scrubbed - #$warning = HTML::Entities::encode_entities($warning); - $warning = $scrubber->scrub($warning); - $warning = CGI::li(CGI::code($warning)); - } - $warnings = join("", @warnings); - - my $time = time2str("%a %b %d %H:%M:%S %Y", time); - my $method = $r->req->method; - my $uri = $r->uri; - #my $headers = do { - # my %headers = $r->headers_in; - # join("", map { CGI::Tr(CGI::td(CGI::small($_)), CGI::td(CGI::small($headers{$_}))) } keys %headers); - #}; - - return - CGI::h2($r->maketext("WeBWorK Warnings")), - CGI::p( - $r->maketext( - 'WeBWorK has encountered warnings while processing your request. If this occured when viewing a problem, it was likely caused by an error or ambiguity in that problem. Otherwise, it may indicate a problem with the WeBWorK system itself. If you are a student, report these warnings to your professor to have them corrected. If you are a professor, please consult the warning output below for more information.' - ) - ), - CGI::h3($r->maketext("Warning messages")), - CGI::ul($warnings), CGI::h3($r->maketext("Request information")), CGI::table( - { class => 'table-bordered' }, - CGI::Tr({}, CGI::td($r->maketext("Time")), CGI::td($time)), - CGI::Tr({}, CGI::td($r->maketext("Method")), CGI::td($method)), - CGI::Tr({}, CGI::td($r->maketext("URI")), CGI::td($uri)), - #CGI::Tr(CGI::td("HTTP Headers"), CGI::td( - # CGI::table($headers), - #)), - ); + return $self->r->maketext('Warning: There may be something wrong with this question. ' + . 'Please inform your instructor including the warning messages below.'); } =item $dateTime = parseDateTime($string, $display_tz) @@ -2483,11 +1588,6 @@ sub createEmailSenderTransportSMTP { =back -=head1 AUTHOR - -Written by Dennis Lambe Jr., malsyned (at) math.rochester.edu and Sam Hathaway, -sh002i (at) math.rochester.edu. - =cut 1; diff --git a/lib/WeBWorK/ContentGenerator/Achievements.pm b/lib/WeBWorK/ContentGenerator/Achievements.pm index f12bb58f2e..f04e70df31 100644 --- a/lib/WeBWorK/ContentGenerator/Achievements.pm +++ b/lib/WeBWorK/ContentGenerator/Achievements.pm @@ -15,8 +15,7 @@ # This module prints out the list of achievements that a student has earned package WeBWorK::ContentGenerator::Achievements; -use base qw(WeBWorK::ContentGenerator); -use WeBWorK::AchievementItems; +use parent qw(WeBWorK::ContentGenerator); =head1 NAME @@ -28,19 +27,15 @@ This produces a list of earned achievements for each student. use strict; use warnings; -use CGI; -use WeBWorK::Utils qw(sortAchievements thaw_base64 getAssetURL); +use WeBWorK::Utils qw(sortAchievements thaw_base64); +use WeBWorK::AchievementItems; sub head { my ($self) = @_; my $r = $self->r; my $ce = $r->ce; - return ""; -} - -sub output_achievement_CSS { - return ""; + return ''; } sub initialize { @@ -56,7 +51,6 @@ sub initialize { # Check to see if user items are enabled and if the user has achievement data. if ($ce->{achievementItemsEnabled} && defined $self->{globalData}) { - my $itemsWithCounts = WeBWorK::AchievementItems::UserItems($self->{studentName}, $db, $ce); $self->{achievementItems} = $itemsWithCounts; @@ -69,184 +63,93 @@ sub initialize { if ($error) { $self->addbadmessage($error); } else { - if ($itemsWithCounts->[$usedItem]->[1] != 1) { --$itemsWithCounts->[$usedItem][1]; } - else { splice(@$itemsWithCounts, $usedItem, 1); } + if ($itemsWithCounts->[$usedItem][1] != 1) { --$itemsWithCounts->[$usedItem][1]; } + else { splice(@$itemsWithCounts, $usedItem, 1); } $self->addgoodmessage($r->maketext('Reward used successfully!')); } } } -} -sub body { - my ($self) = @_; - my $r = $self->r; - my $db = $r->db; - my $ce = $r->ce; - my $globalUserAchievements = $self->{globalData}; - my $userID = $self->{studentName}; - my $achievementURL = $ce->{courseURLs}->{achievements}; - - #If they dont have a globalUserAchievements record then they dont have achievements - if (not defined($globalUserAchievements)) { - print CGI::p($r->maketext("You don't have any Achievement data associated to you!")); - return ""; - } + return; +} - print CGI::br(); - print CGI::start_div({ class => 'cheevobigbox' }); +sub getAchievementLevelData { + my ($self) = @_; - #Print their "level achievement" if there is one and print the progress bar if there is one - my $achievement; + my ($achievement, $level_progress, $level_goal, $level_percentage); - if ($globalUserAchievements->level_achievement_id) { - $achievement = $db->getAchievement($globalUserAchievements->level_achievement_id); + if ($self->{globalData}->level_achievement_id) { + $achievement = $self->r->db->getAchievement($self->{globalData}->level_achievement_id); } if ($achievement) { - print CGI::start_div({ class => 'd-flex align-items-center gap-3' }); - my $imgSrc; - if ($achievement->{icon}) { - $imgSrc = $ce->{courseURLs}->{achievements} . "/" . $achievement->{icon}; - } else { - $imgSrc = $ce->{webworkURLs}->{htdocs} . "/images/defaulticon.png"; + if ($self->{globalData}->next_level_points) { + # Get prev_level_points from the globalData frozen_hash in the database. + my $globalData = $self->{globalData}->frozen_hash ? thaw_base64($self->{globalData}->frozen_hash) : {}; + my $prev_level = $globalData->{prev_level_points} || 0; + $level_goal = $self->{globalData}->next_level_points - $prev_level; + $level_progress = $self->{globalData}->achievement_points - $prev_level; + $level_progress = 0 if $level_progress < 0; + $level_progress = $level_goal if $level_progress > $level_goal; + $level_percentage = int(100 * $level_progress / $level_goal); } + } + + return ( + achievement => $achievement, + level_progress => $level_progress, + level_goal => $level_goal, + level_percentage => $level_percentage + ); +} - print CGI::img({ src => $imgSrc, alt => 'Level Icon' }); - print CGI::start_div(); - print CGI::h1($achievement->name); +sub getAchievementItemsData { + my ($self) = @_; + my $db = $self->r->db; - if ($globalUserAchievements->next_level_points) { + my $userID = $self->{studentName}; - # get prev_level_points from globalData frozen_hash in database - my $globalData = {}; - if ($globalUserAchievements->frozen_hash) { - $globalData = thaw_base64($globalUserAchievements->frozen_hash); - } - my $prev_level = ($globalData->{prev_level_points}) ? $globalData->{prev_level_points} : 0; - my $level_goal = $globalUserAchievements->next_level_points - $prev_level; - my $level_prog = $globalUserAchievements->achievement_points - $prev_level; - $level_prog = $level_prog >= 0 ? $level_prog : 0; - $level_prog = $level_prog <= $level_goal ? $level_prog : $level_goal; - my $levelpercentage = int(100 * $level_prog / $level_goal); - - print CGI::start_div({ - class => 'levelouterbar', - title => $r->maketext("[_1]% Complete", $levelpercentage), - aria_label => $r->maketext("[_1]% Complete", $levelpercentage), - role => 'figure' - }); - print CGI::div({ class => 'levelinnerbar', style => "width:$levelpercentage\%" }, ''); - print CGI::end_div(); - print CGI::div(CGI::strong($r->maketext('Level Progress:')) . " $level_prog/$level_goal"); - } - print CGI::div(CGI::strong($r->maketext('Total Points:')) . ' ' . $globalUserAchievements->achievement_points); - print CGI::end_div(); - print CGI::end_div(); - } - print CGI::end_div(); - - #print any items they have if they have items - if ($ce->{achievementItemsEnabled} && $self->{achievementItems}) { - my @itemsWithCounts = @{ $self->{achievementItems} }; - # remove count data so @items is structured as originally designed - my @items = (); - my %itemCounts = (); - for my $item (@itemsWithCounts) { + my (@items, %itemCounts, @sets, @setProblemCount); + + if ($self->r->ce->{achievementItemsEnabled} && $self->{achievementItems}) { + # Remove count data so @items is structured as originally designed. + for my $item (@{ $self->{achievementItems} }) { push(@items, $item->[0]); $itemCounts{ $item->[0]->id() } = $item->[1]; } - my $urlpath = $r->urlpath; - my @setIDs = $db->listUserSets($userID); - my @setProblemCount; - - my @userSetIDs = map { [ $userID, $_ ] } @setIDs; - my @unfilteredsets = $db->getMergedSets(@userSetIDs); - my @sets; - - # achievement items only make sense for regular homeworks - # so filter gateways out - foreach my $set (@unfilteredsets) { - if ($set->assignment_type() eq 'default') { - push @sets, $set; - } + + # Achievement items only make sense for regular homeworks. So filter gateways out. + for my $set ($db->getMergedSets(map { [ $userID, $_ ] } $db->listUserSets($userID))) { + push(@sets, $set) if ($set->assignment_type() eq 'default'); } - # Generate array of problem counts + # Generate an array of problem counts. for (my $i = 0; $i <= $#sets; $i++) { $setProblemCount[$i] = WeBWorK::Utils::max($db->listUserProblems($userID, $sets[$i]->set_id)); } - - print CGI::h2($r->maketext('Rewards')); - - if (@items) { - my $itemnumber = 0; - foreach my $item (@items) { - # Print each item's name, count, and description - print CGI::start_div({ class => 'achievement-item' }); - if ($itemCounts{ $item->id() } > 1) { - print CGI::h3($r->maketext($item->name()) . ' (' - . $r->maketext('[_1] remaining', $itemCounts{ $item->id() }) - . ')'); - } elsif ($itemCounts{ $item->id() } < 0) { - print CGI::h3($r->maketext($item->name()) . ' (' . $r->maketext('unlimited reusability') . ')'); - } else { - print CGI::h3($r->maketext($item->name())); - } - - print CGI::p($r->maketext($item->description())); - # Print a modal popup for each item which contains the form necessary to get the data to use the item. - # Print the form in the modal body. - print CGI::a( - { - href => '#modal_' . $item->id(), - role => 'button', - data_bs_toggle => 'modal', - class => 'btn btn-secondary', - id => 'popup_' . $item->id() - }, - $r->maketext('Use Reward') - ); - print CGI::start_div({ id => 'modal_' . $item->id(), class => 'modal hide fade', tabindex => '-1' }); - print CGI::start_div({ class => 'modal-dialog modal-dialog-centered' }); - print CGI::start_div({ class => 'modal-content' }); - print CGI::start_div({ class => 'modal-header' }); - print CGI::h4({ class => 'modal-title' }, $r->maketext($item->name())); - print qq{}; - print CGI::end_div(); - print CGI::start_form({ - method => 'post', - action => $self->systemLink($urlpath, authen => 0), - name => "itemform_$itemnumber", - class => 'achievementitemform' - }); - print CGI::start_div({ class => 'modal-body' }); - # Note: we provide the item with some information about the current sets to help set up the form fields. - print $item->print_form(\@sets, \@setProblemCount, $r); - print CGI::hidden({ name => "useditem", value => $itemnumber }); - print $self->hidden_authen_fields =~ s/id=\"hidden_/id=\"achievement_${itemnumber}_hidden_/gr; - print CGI::end_div(); - print CGI::start_div({ class => 'modal-footer' }); - print CGI::submit({ value => $r->maketext('Submit'), class => 'btn btn-primary' }); - print CGI::end_div(); - print CGI::end_form(); - print CGI::end_div(); - print CGI::end_div(); - print CGI::end_div(); - print CGI::end_div(); - - $itemnumber++; - } - } else { - print CGI::p($r->maketext('You don\'t have any rewards!')); - } - print CGI::br(); } - #Get all the achievements + return ( + items => \@items, + itemCounts => \%itemCounts, + sets => \@sets, + setProblemCount => \@setProblemCount + ); +} + +sub getAchievementsData { + my ($self) = @_; + my $r = $self->r; + my $db = $r->db; + my $ce = $r->ce; + + my $userID = $self->{studentName}; + my (@visibleAchievements, %userAchievements); + + # Get all the achievements my @allAchievementIDs = $db->listAchievements; - if (@allAchievementIDs) { # bail if there are no achievements + if (@allAchievementIDs) { my @achievements = $db->getAchievements(@allAchievementIDs); @achievements = sortAchievements(@achievements); @@ -256,21 +159,14 @@ sub body { my $chainCount = 0; my $chainStart = 0; - print CGI::h2($r->maketext('Badges')); - - #Loop through achievements and - foreach my $achievement (@achievements) { - #skip the level achievements and only show achievements assigned to user + # Loop through achievements + for my $achievement (@achievements) { + # Skip the level achievements and only show achievements assigned to user. last if ($achievement->category eq 'level'); next unless ($db->existsUserAchievement($userID, $achievement->achievement_id)); next unless $achievement->enabled; - #separate categories with whitespace - if ($previousCategory ne $achievement->category) { - print CGI::br(); - } - - #setup up chain achievements + # Setup up chain achievements. my $isChain = 1; if (!$achievement->max_counter || $achievement->max_counter == 0 @@ -282,76 +178,27 @@ sub body { $chainCount = 0; $chainName = $achievement->achievement_id =~ s/^([^_]*_).*$/$1/r; } - $previousNumber = $achievement->number; $previousCategory = $achievement->category; + $previousNumber = $achievement->number; my $userAchievement = $db->getUserAchievement($userID, $achievement->achievement_id); - #dont show unearned secret achievements - next if ($achievement->category eq 'secret' and not $userAchievement->earned); + # Don't show unearned secret achievements. + next if ($achievement->category eq 'secret' && !$userAchievement->earned); - #dont show chain achievements (beyond first) - $chainCount++ if ($isChain && !$userAchievement->earned); + # Don't show chain achievements beyond the first. + ++$chainCount if $isChain && !$userAchievement->earned; if ($chainCount == 0) { $chainStart = $userAchievement->earned ? 1 : 0; } - next if ($isChain && ($chainCount > 1 || ($chainCount == '1' && $chainStart == '0'))); - - #print achievement and associated progress bar (if there is one) - print CGI::start_div({ - class => 'cheevoouterbox d-flex justify-content-start align-items-center mb-3 ' - . ($userAchievement->earned ? 'unlocked' : 'locked') - }); - - my $imgSrc; - if ($achievement->{icon}) { - $imgSrc = $ce->{courseURLs}->{achievements} . "/" . $achievement->{icon}; - } else { - $imgSrc = $ce->{webworkURLs}->{htdocs} . "/images/defaulticon.png"; - } - - print CGI::div(CGI::img({ - src => $imgSrc, - alt => $userAchievement->earned ? 'Achievement Earned' : 'Achievement Unearned' - })); - print CGI::start_div({ class => 'ms-3' }); - print CGI::h3({ class => 'fs-5 mb-1 fw-bold' }, $achievement->name); - print CGI::div( - CGI::i($r->maketext("[_1] Points:", $achievement->{points})) . ' ' . $achievement->{description}); - - if ($achievement->max_counter and not $userAchievement->earned) { - my $userCounter = $userAchievement->counter; - $userCounter = 0 unless ($userAchievement->counter); - my $percentage = int(100 * $userCounter / $achievement->max_counter); - $percentage = $percentage <= 100 ? $percentage : 100; - print CGI::start_div({ - class => 'cheevoouterbar mt-1', - title => $r->maketext("[_1]% Complete", $percentage), - aria_label => $r->maketext("[_1]% Complete", $percentage), - role => 'figure' - }); - print CGI::div({ class => 'cheevoinnerbar', style => sprintf("width:%i%%;", $percentage) }, ''); - print CGI::end_div(); - } - print CGI::end_div(); - print CGI::end_div(); + next if $isChain && ($chainCount > 1 || ($chainCount == 1 && $chainStart == 0)); + push(@visibleAchievements, $achievement); + $userAchievements{ $achievement->achievement_id } = $userAchievement; } - } else { # no achievements - print CGI::p($r->maketext('No achievement badges have been assigned yet.')); } - return ""; - -} - -sub output_JS { - my $self = shift; - my $ce = $self->r->ce; - - print CGI::script({ src => getAssetURL($ce, 'js/apps/AchievementItems/achievementitems.js'), defer => undef }, ''); - - return ''; + return (achievements => \@visibleAchievements, userAchievements => \%userAchievements); } 1; diff --git a/lib/WeBWorK/ContentGenerator/CourseAdmin.pm b/lib/WeBWorK/ContentGenerator/CourseAdmin.pm index 0bc4e05044..905e8f74e1 100644 --- a/lib/WeBWorK/ContentGenerator/CourseAdmin.pm +++ b/lib/WeBWorK/ContentGenerator/CourseAdmin.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::CourseAdmin; -use base qw(WeBWorK::ContentGenerator); +use parent qw(WeBWorK::ContentGenerator); =head1 NAME @@ -24,25 +24,19 @@ WeBWorK::ContentGenerator::CourseAdmin - Add, rename, and delete courses. use strict; use warnings; -#use CGI qw(-nosticky ); -use WeBWorK::CGI; -use Data::Dumper; -use File::Temp qw/tempfile/; + +use Net::IP; # needed for location management +use File::Path 'remove_tree'; +use File::stat; +use Time::localtime; + use WeBWorK::CourseEnvironment; -use IO::File; -use URI::Escape; use WeBWorK::Debug; -use WeBWorK::Utils qw(cryptPassword writeLog listFilesRecursive trim_spaces getAssetURL); +use WeBWorK::Utils qw(cryptPassword writeLog trim_spaces); use WeBWorK::Utils::CourseManagement qw(addCourse renameCourse retitleCourse deleteCourse listCourses archiveCourse - listArchivedCourses unarchiveCourse initNonNativeTables); + unarchiveCourse initNonNativeTables); use WeBWorK::Utils::CourseIntegrityCheck; use WeBWorK::DB; -#use WeBWorK::Utils::DBImportExport qw(dbExport dbImport); -# needed for location management -use Net::IP; -use File::Path 'remove_tree'; -use File::stat; -use Time::localtime; async sub pre_header_initialize { my ($self) = @_; @@ -53,657 +47,244 @@ async sub pre_header_initialize { my $urlpath = $r->urlpath; my $user = $r->param('user'); - # check permissions - unless ($authz->hasPermissions($user, "create_and_delete_courses")) { - $self->addbadmessage("$user is not authorized to create or delete courses"); - return; - } - - # get result and send to message - my $status_message = $r->param("status_message"); - $self->addmessage(CGI::p("$status_message")) if $status_message; + return unless $authz->hasPermissions($user, 'create_and_delete_courses'); - # Check that the non-native tables are present in the database - # These are the tables which are not course specific + # Get result and send to message + my $status_message = $r->param('status_message'); + $self->addmessage($r->tag('p', class => 'my-2', $r->b($status_message))) if $status_message; - my $table_update_result = initNonNativeTables($ce, $ce->{dbLayoutName}); - - $self->addgoodmessage(CGI::p("$table_update_result")) if $table_update_result; + # Check that the non-native tables are present in the database. + # These are the tables which are not course specific. + my @table_update_messages = initNonNativeTables($ce, $ce->{dbLayoutName}); + $self->addgoodmessage($r->c(@table_update_messages)->join($r->tag('br'))) if @table_update_messages; my @errors; my $method_to_call; - my $subDisplay = $r->param("subDisplay"); + my $subDisplay = $r->param('subDisplay'); if (defined $subDisplay) { - - if ($subDisplay eq "add_course") { - if (defined $r->param("add_course")) { + if ($subDisplay eq 'add_course') { + if (defined $r->param('add_course')) { @errors = $self->add_course_validate; if (@errors) { - $method_to_call = "add_course_form"; + $method_to_call = 'add_course_form'; } else { - $method_to_call = "do_add_course"; + $method_to_call = 'do_add_course'; } } else { - $method_to_call = "add_course_form"; + $method_to_call = 'add_course_form'; } - - } elsif ($subDisplay eq "rename_course") { - if (defined $r->param("rename_course")) { + } elsif ($subDisplay eq 'rename_course') { + if (defined $r->param('rename_course')) { @errors = $self->rename_course_validate; if (@errors) { - $method_to_call = "rename_course_form"; + $method_to_call = 'rename_course_form'; } else { - $method_to_call = "rename_course_confirm"; + $method_to_call = 'rename_course_confirm'; } - } elsif (defined $r->param("confirm_rename_course")) { - # validate and rename + } elsif (defined $r->param('confirm_rename_course')) { @errors = $self->rename_course_validate; if (@errors) { - $method_to_call = "rename_course_form"; + $method_to_call = 'rename_course_form'; } else { - $method_to_call = "do_rename_course"; + $method_to_call = 'do_rename_course'; } - } elsif (defined $r->param("confirm_retitle_course")) { - $method_to_call = "do_retitle_course"; + } elsif (defined $r->param('confirm_retitle_course')) { + $method_to_call = 'do_retitle_course'; - } elsif (defined $r->param("upgrade_course_tables")) { - # upgrade and revalidate + } elsif (defined $r->param('upgrade_course_tables')) { @errors = $self->rename_course_validate; if (@errors) { - $method_to_call = "rename_course_form"; + $method_to_call = 'rename_course_form'; } else { - $method_to_call = "rename_course_confirm"; + $method_to_call = 'rename_course_confirm'; } - } else { - $method_to_call = "rename_course_form"; + $method_to_call = 'rename_course_form'; } - - } elsif ($subDisplay eq "delete_course") { - if (defined $r->param("delete_course")) { - # validate or confirm + } elsif ($subDisplay eq 'delete_course') { + if (defined $r->param('delete_course')) { @errors = $self->delete_course_validate; if (@errors) { - $method_to_call = "delete_course_form"; + $method_to_call = 'delete_course_form'; } else { - $method_to_call = "delete_course_confirm"; + $method_to_call = 'delete_course_confirm'; } - } elsif (defined $r->param("confirm_delete_course")) { - # validate and delete + } elsif (defined $r->param('confirm_delete_course')) { @errors = $self->delete_course_validate; if (@errors) { - $method_to_call = "delete_course_form"; - } else { - $method_to_call = "do_delete_course"; - } - } elsif (defined($r->param("delete_course_refresh"))) { - $method_to_call = "delete_course_form"; - } else { - # form only - $method_to_call = "delete_course_form"; - } - - } elsif ($subDisplay eq "export_database") { - if (defined $r->param("export_database")) { - @errors = $self->export_database_validate; - if (@errors) { - $method_to_call = "export_database_form"; - } else { - # we have to do something special here, since we're sending - # the database as we export it. $method_to_call still gets - # set here, but it gets caught by header() and content() - # below instead of by body(). - $method_to_call = "do_export_database"; - } - } else { - $method_to_call = "export_database_form"; - } - - } elsif ($subDisplay eq "import_database") { - if (defined $r->param("import_database")) { - @errors = $self->import_database_validate; - if (@errors) { - $method_to_call = "import_database_form"; + $method_to_call = 'delete_course_form'; } else { - $method_to_call = "do_import_database"; + $method_to_call = 'do_delete_course'; } + } elsif (defined($r->param('delete_course_refresh'))) { + $method_to_call = 'delete_course_form'; } else { - $method_to_call = "import_database_form"; + $method_to_call = 'delete_course_form'; } - - } elsif ($subDisplay eq "archive_course") { - if (defined $r->param("archive_course") - || defined $r->param("skip_archive_course")) - { - - # validate -- if invalid, start over. - # if form is valid a page indicating the status of - # database tables and directories is presented. - # If they are ok, then you can push archive button, otherwise - # you can quit or choose to upgrade the tables + } elsif ($subDisplay eq 'archive_course') { + if (defined $r->param('archive_course') || defined $r->param('skip_archive_course')) { @errors = $self->archive_course_validate; if (@errors) { - $method_to_call = "archive_course_form"; + $method_to_call = 'archive_course_form'; } else { - $method_to_call = "archive_course_confirm"; #check tables & directories + $method_to_call = 'archive_course_confirm'; } - } elsif (defined $r->param("confirm_archive_course")) { - # validate and archive - # the "archive it" button has been pushed and the - # course will be archived - # a report on success or failure will be generated + } elsif (defined $r->param('confirm_archive_course')) { @errors = $self->archive_course_validate; if (@errors) { - $method_to_call = "archive_course_form"; + $method_to_call = 'archive_course_form'; } else { - $method_to_call = "do_archive_course"; + $method_to_call = 'do_archive_course'; } - } elsif (defined $r->param("upgrade_course_tables")) { - # upgrade and revalidate - # the "upgrade course" button has been pushed - # after the course has been upgraded you are returned - # to the confirm page. + } elsif (defined $r->param('upgrade_course_tables')) { @errors = $self->archive_course_validate; if (@errors) { - $method_to_call = "archive_course_form"; + $method_to_call = 'archive_course_form'; } else { - $method_to_call = "archive_course_confirm"; # upgrade and recheck tables & directories. + $method_to_call = 'archive_course_confirm'; } - } elsif (defined($r->param("archive_course_refresh"))) { - $method_to_call = "archive_course_form"; + } elsif (defined($r->param('archive_course_refresh'))) { + $method_to_call = 'archive_course_form'; } else { - # form only - $method_to_call = "archive_course_form"; + $method_to_call = 'archive_course_form'; } - } elsif ($subDisplay eq "unarchive_course") { - if (defined $r->param("unarchive_course")) { - # validate or confirm + } elsif ($subDisplay eq 'unarchive_course') { + if (defined $r->param('unarchive_course')) { @errors = $self->unarchive_course_validate; if (@errors) { - $method_to_call = "unarchive_course_form"; + $method_to_call = 'unarchive_course_form'; } else { - $method_to_call = "unarchive_course_confirm"; + $method_to_call = 'unarchive_course_confirm'; } - } elsif (defined $r->param("confirm_unarchive_course")) { - # validate and archive + } elsif (defined $r->param('confirm_unarchive_course')) { @errors = $self->unarchive_course_validate; if (@errors) { - $method_to_call = "unarchive_course_form"; + $method_to_call = 'unarchive_course_form'; } else { - $method_to_call = "do_unarchive_course"; + $method_to_call = 'do_unarchive_course'; } } else { - # form only - # start at the beginning -- get drop down list of courses to unarchive - $method_to_call = "unarchive_course_form"; + $method_to_call = 'unarchive_course_form'; } - } elsif ($subDisplay eq "upgrade_course") { - if (defined $r->param("upgrade_course")) { - # validate or confirm - # if form is valid present details of analysis of the course structure + } elsif ($subDisplay eq 'upgrade_course') { + if (defined $r->param('upgrade_course')) { @errors = $self->upgrade_course_validate; if (@errors) { - $method_to_call = "upgrade_course_form"; + $method_to_call = 'upgrade_course_form'; } else { - $method_to_call = "upgrade_course_confirm"; + $method_to_call = 'upgrade_course_confirm'; } - } elsif (defined $r->param("confirm_upgrade_course")) { - # validate and upgrade - # if form is valid upgrade the courses and present results + } elsif (defined $r->param('confirm_upgrade_course')) { @errors = $self->upgrade_course_validate; if (@errors) { - $method_to_call = "upgrade_course_form"; + $method_to_call = 'upgrade_course_form'; } else { - $method_to_call = "do_upgrade_course"; + $method_to_call = 'do_upgrade_course'; } } else { - # form only - # start at the beginning -- get list of courses and their status - $method_to_call = "upgrade_course_form"; + $method_to_call = 'upgrade_course_form'; } - } elsif ($subDisplay eq "manage_locations") { - if (defined($r->param("manage_location_action"))) { - $method_to_call = $r->param("manage_location_action"); + } elsif ($subDisplay eq 'manage_locations') { + if (defined($r->param('manage_location_action'))) { + $method_to_call = $r->param('manage_location_action'); } else { - $method_to_call = "manage_location_form"; + $method_to_call = 'manage_location_form'; } - } elsif ($subDisplay eq "hide_inactive_course") { - # warn "subDisplay is $subDisplay"; - if (defined($r->param("hide_course"))) { + } elsif ($subDisplay eq 'hide_inactive_course') { + if (defined($r->param('hide_course'))) { @errors = $self->hide_course_validate; if (@errors) { - $method_to_call = "hide_inactive_course_form"; + $method_to_call = 'hide_inactive_course_form'; } else { - $method_to_call = "do_hide_inactive_course"; + $method_to_call = 'do_hide_inactive_course'; } - } elsif (defined($r->param("unhide_course"))) { + } elsif (defined($r->param('unhide_course'))) { @errors = $self->unhide_course_validate; if (@errors) { - $method_to_call = "hide_inactive_course_form"; + $method_to_call = 'hide_inactive_course_form'; } else { - $method_to_call = "do_unhide_inactive_course"; + $method_to_call = 'do_unhide_inactive_course'; } - } elsif (defined($r->param("hide_course_refresh"))) { - $method_to_call = "hide_inactive_course_form"; + } elsif (defined($r->param('hide_course_refresh'))) { + $method_to_call = 'hide_inactive_course_form'; } else { - $method_to_call = "hide_inactive_course_form"; + $method_to_call = 'hide_inactive_course_form'; } - } elsif ($subDisplay eq "registration") { - if (defined($r->param("register_site"))) { - $method_to_call = "do_registration"; - } else { - $method_to_call = "registration_form"; + } elsif ($subDisplay eq 'registration') { + if (defined($r->param('register_site'))) { + $method_to_call = 'do_registration'; } } else { - @errors = "Unrecognized sub-display @{[ CGI::b($subDisplay) ]}."; + @errors = "Unrecognized sub-display @{[ $r->tag('b', $subDisplay) ]}."; } } $self->{errors} = \@errors; $self->{method_to_call} = $method_to_call; -} - -sub body { - my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; - my $db = $r->db; - my $authz = $r->authz; - my $urlpath = $r->urlpath; - - my $user = $r->param('user'); - - # check permissions - unless ($authz->hasPermissions($user, "create_and_delete_courses")) { - return ""; - } - my $method_to_call = $self->{method_to_call}; - my $methodMessage = ""; - - (defined($method_to_call) and $method_to_call eq "do_export_database") && do { - my @export_courseID = $r->param("export_courseID"); - my $course_ids = join(", ", @export_courseID); - $methodMessage = CGI::p("Exporting database for course(s) $course_ids") . CGI::p( - ".... please wait.... - If your browser times out you will - still be able to download the exported database using the - file manager." - ) . CGI::hr(); - }; - - print CGI::ul( - { class => 'nav nav-pills justify-content-center my-2' }, - map { - CGI::li( - { class => 'nav-item' }, - CGI::a( - { - href => - $self->systemLink($urlpath, params => { subDisplay => $_->[0], %{ $_->[2] // {} } }), - class => 'nav-link' . (($r->param('subDisplay') // '') eq $_->[0] ? ' active' : '') - }, - $_->[1] - ) - ) - } ( - [ - 'add_course', - $r->maketext('Add Course'), - { - add_admin_users => 1, - add_config_file => 1, - add_dbLayout => 'sql_single', - add_templates_course => $ce->{siteDefaults}->{default_templates_course} || '' - } - ], - [ 'rename_course', $r->maketext('Rename Course') ], - [ 'delete_course', $r->maketext('Delete Course') ], - [ 'archive_course', $r->maketext('Archive Course') ], - [ 'unarchive_course', $r->maketext('Unarchive Course') ], - [ 'upgrade_course', $r->maketext('Upgrade Courses') ], - [ 'manage_locations', $r->maketext('Manage Locations') ], - [ 'hide_inactive_course', $r->maketext('Hide Courses') ], - ) - ); - - print CGI::hr({ class => 'mt-0' }); - print $methodMessage; - - print $self->display_registration_form; - - my @errors = @{ $self->{errors} }; - - if (@errors) { - print CGI::div( - { class => 'alert alert-danger p-1 mb-2' }, - CGI::div({ class => 'mb-1' }, $r->maketext("Please correct the following errors and try again:")), - CGI::ul({ class => 'mb-1' }, CGI::li(\@errors)), - ); - } - - if (defined $method_to_call and $method_to_call ne "") { - $self->$method_to_call; - } else { - my $msg = ""; - $msg .= CGI::li($r->maketext("unable to write to directory [_1]", $ce->{webworkDirs}{logs})) - unless -w $ce->{webworkDirs}{logs}; - $msg .= CGI::li($r->maketext("unable to write to directory [_1]", $ce->{webworkDirs}{tmp})) - unless -w $ce->{webworkDirs}{tmp}; - $msg .= CGI::li($r->maketext("unable to write to directory [_1]", $ce->{webworkDirs}{DATA})) - unless -w $ce->{webworkDirs}{DATA}; - if ($msg) { - print CGI::h2($r->maketext("Directory permission errors ")) - . CGI::ul($msg) - . CGI::p( - $r->maketext( - "The webwork server must be able to write to these directories. Please correct the permssion errors." - ) - ); - } - - print $self->upgrade_notification(); - - print CGI::h2($r->maketext("Courses")); - - print CGI::start_ol(); - - my @courseIDs = listCourses($ce); - foreach my $courseID (sort { lc($a) cmp lc($b) } @courseIDs) { - next if $courseID eq "admin"; # done already above - next - if $courseID eq - "modelCourse"; # modelCourse isn't a real course so don't create missing directories, etc - my $urlpath = - $r->urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets", $r, courseID => $courseID); - print CGI::li(CGI::a({ href => $self->systemLink($urlpath, authen => 0) }, $courseID)); - } - - print CGI::end_ol(); - - print CGI::h2($r->maketext("Archived Courses")); - print CGI::start_ol(); - - @courseIDs = listArchivedCourses($ce); - foreach my $courseID (sort { lc($a) cmp lc($b) } @courseIDs) { - print CGI::li($courseID),; - } - print CGI::end_ol(); - } - return ""; + return; } -################################################################################ - sub add_course_form { my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; - - my @existingCourses = sort { lc($a) cmp lc($b) } listCourses($ce); # make sort case insensitive - unshift(@existingCourses, @{ $ce->{modelCoursesForCopy} }); - - print CGI::h2($r->maketext('Add Course')); - - print CGI::start_form({ method => 'POST', action => $r->uri }); - print $self->hidden_authen_fields; - print $self->hidden_fields('subDisplay'); - - print CGI::p($r->maketext( - 'Specify an ID, title, and institution for the new course. The course ID may contain only letters, ' - . 'numbers, hyphens, and underscores, and may have at most [_1] characters.', - $ce->{maxCourseIdLength} - )); - - print CGI::div( - { class => 'row mb-2' }, - CGI::div( - { class => 'col-lg-8 col-md-10' }, - CGI::div( - { class => 'form-floating mb-1' }, - CGI::textfield({ - name => 'add_courseID', - id => 'add_courseID', - value => trim_spaces($r->param('add_courseID')) || '', - placeholder => '', - class => 'form-control' - }), - CGI::label({ for => 'add_courseID' }, $r->maketext('Course ID')) - ), - CGI::div( - { class => 'form-floating mb-1' }, - CGI::textfield({ - name => 'add_courseTitle', - id => 'add_courseTitle', - value => trim_spaces($r->param('add_courseTitle')) || '', - placeholder => '', - class => 'form-control' - }), - CGI::label({ for => 'add_courseTitle' }, $r->maketext('Course Title')) - ), - CGI::div( - { class => 'form-floating mb-1' }, - CGI::textfield({ - name => 'add_courseInstitution', - id => 'add_courseInstitution', - value => trim_spaces($r->param('add_courseInstitution')) || '', - placeholder => '', - class => 'form-control' - }), - CGI::label({ for => 'add_courseInstitution' }, $r->maketext('Institution')) - ) - ) - ); - - print CGI::div( - { class => 'mb-3' }, - CGI::div( - { class => 'mb-1' }, - $r->maketext( - 'To add the WeBWorK administrators to the new course (as administrators) check the box below.') - ), - CGI::div( - { class => 'form-check mb-2' }, - CGI::checkbox({ - name => 'add_admin_users', - label => $r->maketext('Add WeBWorK administrators to new course'), - checked => trim_spaces($r->param('add_admin_users')) || 0, - class => 'form-check-input', - labelattributes => { class => 'form-check-label' } - }) - ), - CGI::div( - { class => 'form-check' }, - CGI::checkbox({ - name => 'add_config_file', - label => $r->maketext('Copy simple configuration file to new course'), - checked => trim_spaces($r->param('add_config_file')) || 0, - class => 'form-check-input', - labelattributes => { class => 'form-check-label' } - }) - ) - ); - - print CGI::div( - { class => 'mb-2' }, - $r->maketext( - 'To add an additional instructor to the new course, specify user information below. ' - . 'The user ID may contain only numbers, letters, hyphens, periods (dots), commas,and underscores.' - ) - ); - - print CGI::div( - { class => 'row mb-2' }, - CGI::div( - { class => 'col-lg-4 col-md-5 col-sm-6' }, - CGI::div( - { class => 'form-floating mb-1' }, - CGI::textfield({ - name => 'add_initial_userID', - id => 'add_initial_userID', - value => trim_spaces($r->param('add_initial_userID')) || '', - placeholder => '', - class => 'form-control' - }), - CGI::label({ for => 'add_initial_userID' }, $r->maketext('User ID')) - ), - CGI::div( - { class => 'form-floating mb-1' }, - CGI::password_field({ - name => 'add_initial_password', - id => 'add_initial_password', - value => trim_spaces($r->param('add_initial_password')) || '', - placeholder => '', - class => 'form-control' - }), - CGI::label({ for => 'add_initial_password' }, $r->maketext('Password')) - ), - CGI::div( - { class => 'form-floating mb-1' }, - CGI::password_field({ - name => 'add_initial_confirmPassword', - id => 'add_initial_confirmPassword', - value => trim_spaces($r->param('add_initial_confirmPassword')) || '', - placeholder => '', - class => 'form-control' - }), - CGI::label({ for => 'add_initial_confirmPassword' }, $r->maketext('Confirm Password')) - ) - ), - CGI::div( - { class => 'col-lg-4 col-md-5 col-sm-6' }, - CGI::div( - { class => 'form-floating mb-1' }, - CGI::textfield({ - name => 'add_initial_firstName', - id => 'add_initial_firstName', - value => trim_spaces($r->param('add_initial_firstName')) || '', - placeholder => '', - class => 'form-control' - }), - CGI::label({ for => 'add_initial_firstName' }, $r->maketext('First Name')) - ), - CGI::div( - { class => 'form-floating mb-1' }, - CGI::textfield({ - name => 'add_initial_lastName', - id => 'add_initial_lastName', - value => trim_spaces($r->param('add_initial_lastName')) || '', - placeholder => '', - class => 'form-control' - }), - CGI::label({ for => 'add_initial_lastName' }, $r->maketext('Last Name')) - ), - CGI::div( - { class => 'form-floating mb-1' }, - CGI::textfield({ - name => 'add_initial_email', - id => 'add_initial_email', - value => trim_spaces($r->param('add_initial_email')) || '', - placeholder => '', - class => 'form-control' - }), - CGI::label({ for => 'add_initial_email' }, $r->maketext('Email Address')) - ) - ) - ); - - print CGI::div({ class => 'mb-1' }, - $r->maketext('To copy problem templates from an existing course, select the course below.')); - - print CGI::div( - { class => 'row mb-3' }, - CGI::label( - { for => 'add_templates_course', class => 'col-auto col-form-label fw-bold' }, - $r->maketext('Copy templates from:') - ), - CGI::div( - { class => 'col-auto' }, - CGI::popup_menu({ - name => 'add_templates_course', - id => 'add_templates_course', - values => [ '', @existingCourses ], - labels => { '' => $r->maketext('No Course'), map { $_ => $_ } @existingCourses }, - default => trim_spaces($r->param('add_templates_course')) || '', - class => 'form-select' - }) - ) - ); - - print CGI::input({ type => 'hidden', name => 'add_dbLayout', value => 'sql_single' }); - - print CGI::submit({ name => 'add_course', label => $r->maketext('Add Course'), class => 'btn btn-primary' }); - - print CGI::end_form(); + return $self->r->include('ContentGenerator/CourseAdmin/add_course_form'); } sub add_course_validate { my ($self) = @_; my $r = $self->r; my $ce = $r->ce; - #my $db = $r->db; - #my $authz = $r->authz; - #my $urlpath = $r->urlpath; - - my $add_courseID = trim_spaces($r->param("add_courseID")) || ""; - my $add_courseTitle = trim_spaces($r->param("add_courseTitle")) || ""; - my $add_courseInstitution = trim_spaces($r->param("add_courseInstitution")) || ""; - my $add_admin_users = trim_spaces($r->param("add_admin_users")) || ""; - - my $add_initial_userID = trim_spaces($r->param("add_initial_userID")) || ""; - my $add_initial_password = trim_spaces($r->param("add_initial_password")) || ""; - my $add_initial_confirmPassword = trim_spaces($r->param("add_initial_confirmPassword")) || ""; - my $add_initial_firstName = trim_spaces($r->param("add_initial_firstName")) || ""; - my $add_initial_lastName = trim_spaces($r->param("add_initial_lastName")) || ""; - my $add_initial_email = trim_spaces($r->param("add_initial_email")) || ""; - my $add_templates_course = trim_spaces($r->param("add_templates_course")) || ""; - my $add_config_file = trim_spaces($r->param("add_config_file")) || ""; - my $add_dbLayout = trim_spaces($r->param("add_dbLayout")) || ""; - - ###################### + my $add_courseID = trim_spaces($r->param('add_courseID')) || ''; + my $add_initial_userID = trim_spaces($r->param('add_initial_userID')) || ''; + my $add_initial_password = trim_spaces($r->param('add_initial_password')) || ''; + my $add_initial_confirmPassword = trim_spaces($r->param('add_initial_confirmPassword')) || ''; + my $add_initial_firstName = trim_spaces($r->param('add_initial_firstName')) || ''; + my $add_initial_lastName = trim_spaces($r->param('add_initial_lastName')) || ''; + my $add_initial_email = trim_spaces($r->param('add_initial_email')) || ''; + my $add_dbLayout = trim_spaces($r->param('add_dbLayout')) || ''; my @errors; - if ($add_courseID eq "") { - push @errors, $r->maketext("You must specify a course ID."); + if ($add_courseID eq '') { + push @errors, $r->maketext('You must specify a course ID.'); } unless ($add_courseID =~ /^[\w-]*$/) { # regex copied from CourseAdministration.pm - push @errors, $r->maketext("Course ID may only contain letters, numbers, hyphens, and underscores."); + push @errors, $r->maketext('Course ID may only contain letters, numbers, hyphens, and underscores.'); } if (grep { $add_courseID eq $_ } listCourses($ce)) { - push @errors, $r->maketext("A course with ID [_1] already exists.", $add_courseID); + push @errors, $r->maketext('A course with ID [_1] already exists.', $add_courseID); } if (length($add_courseID) > $ce->{maxCourseIdLength}) { - push @errors, $r->maketext("Course ID cannot exceed [_1] characters.", $ce->{maxCourseIdLength}); + push @errors, $r->maketext('Course ID cannot exceed [_1] characters.', $ce->{maxCourseIdLength}); } - if ($add_initial_userID ne "") { - if ($add_initial_password eq "") { - push @errors, $r->maketext("You must specify a password for the initial instructor."); + if ($add_initial_userID ne '') { + if ($add_initial_password eq '') { + push @errors, $r->maketext('You must specify a password for the initial instructor.'); } - if ($add_initial_confirmPassword eq "") { - push @errors, $r->maketext("You must confirm the password for the initial instructor."); + if ($add_initial_confirmPassword eq '') { + push @errors, $r->maketext('You must confirm the password for the initial instructor.'); } if ($add_initial_password ne $add_initial_confirmPassword) { - push @errors, $r->maketext("The password and password confirmation for the instructor must match."); + push @errors, $r->maketext('The password and password confirmation for the instructor must match.'); } - if ($add_initial_firstName eq "") { - push @errors, $r->maketext("You must specify a first name for the initial instructor."); + if ($add_initial_firstName eq '') { + push @errors, $r->maketext('You must specify a first name for the initial instructor.'); } - if ($add_initial_lastName eq "") { - push @errors, $r->maketext("You must specify a last name for the initial instructor."); + if ($add_initial_lastName eq '') { + push @errors, $r->maketext('You must specify a last name for the initial instructor.'); } - if ($add_initial_email eq "") { - push @errors, $r->maketext("You must specify an email address for the initial instructor."); + if ($add_initial_email eq '') { + push @errors, $r->maketext('You must specify an email address for the initial instructor.'); } } - if ($add_dbLayout eq "") { - push @errors, "You must select a database layout."; + if ($add_dbLayout eq '') { + push @errors, 'You must select a database layout.'; } else { - if (exists $ce->{dbLayouts}->{$add_dbLayout}) { + if (exists $ce->{dbLayouts}{$add_dbLayout}) { # we used to check for layout-specific fields here, but there aren't any layouts that require them # anymore. (in the future, we'll probably deal with this in layout-specific modules.) } else { @@ -722,63 +303,53 @@ sub do_add_course { my $authz = $r->authz; my $urlpath = $r->urlpath; - my $add_courseID = trim_spaces($r->param("add_courseID")) || ""; - my $add_courseTitle = trim_spaces($r->param("add_courseTitle")) || ""; - my $add_courseInstitution = trim_spaces($r->param("add_courseInstitution")) || ""; + my $add_courseID = trim_spaces($r->param('add_courseID')) || ''; + my $add_courseTitle = trim_spaces($r->param('add_courseTitle')) || ''; + my $add_courseInstitution = trim_spaces($r->param('add_courseInstitution')) || ''; - my $add_admin_users = trim_spaces($r->param("add_admin_users")) || ""; + my $add_admin_users = trim_spaces($r->param('add_admin_users')) || ''; - my $add_initial_userID = trim_spaces($r->param("add_initial_userID")) || ""; - my $add_initial_password = trim_spaces($r->param("add_initial_password")) || ""; - my $add_initial_confirmPassword = trim_spaces($r->param("add_initial_confirmPassword")) || ""; - my $add_initial_firstName = trim_spaces($r->param("add_initial_firstName")) || ""; - my $add_initial_lastName = trim_spaces($r->param("add_initial_lastName")) || ""; - my $add_initial_email = trim_spaces($r->param("add_initial_email")) || ""; + my $add_initial_userID = trim_spaces($r->param('add_initial_userID')) || ''; + my $add_initial_password = trim_spaces($r->param('add_initial_password')) || ''; + my $add_initial_confirmPassword = trim_spaces($r->param('add_initial_confirmPassword')) || ''; + my $add_initial_firstName = trim_spaces($r->param('add_initial_firstName')) || ''; + my $add_initial_lastName = trim_spaces($r->param('add_initial_lastName')) || ''; + my $add_initial_email = trim_spaces($r->param('add_initial_email')) || ''; - my $add_templates_course = trim_spaces($r->param("add_templates_course")) || ""; - my $add_config_file = trim_spaces($r->param("add_config_file")) || ""; + my $add_templates_course = trim_spaces($r->param('add_templates_course')) || ''; + my $add_config_file = trim_spaces($r->param('add_config_file')) || ''; - my $add_dbLayout = trim_spaces($r->param("add_dbLayout")) || ""; + my $add_dbLayout = trim_spaces($r->param('add_dbLayout')) || ''; - my $ce2 = new WeBWorK::CourseEnvironment({ + my $ce2 = WeBWorK::CourseEnvironment->new({ %WeBWorK::SeedCE, courseName => $add_courseID, }); my %courseOptions = (dbLayoutName => $add_dbLayout); - if ($add_initial_email ne "") { + if ($add_initial_email ne '') { $courseOptions{allowedRecipients} = [$add_initial_email]; - # don't set feedbackRecipients -- this just gets in the way of the more - # intelligent "receive_recipients" method. - #$courseOptions{feedbackRecipients} = [ $add_initial_email ]; } - # this is kinda left over from when we had 'gdbm' and 'sql' database layouts - # below this line, we would grab values from getopt and put them in this hash - # but for now the hash can remain empty - my %dbOptions; - my @users; # copy users from current (admin) course if desired - if ($add_admin_users ne "") { - - foreach my $userID ($db->listUsers) { + if ($add_admin_users ne '') { + for my $userID ($db->listUsers) { if ($userID eq $add_initial_userID) { $self->addbadmessage($r->maketext( - "User '[_1]' will not be copied from admin course as it is the initial instructor.", $userID + 'User "[_1]" will not be copied from admin course as it is the initial instructor.', $userID )); next; } my $PermissionLevel = $db->newPermissionLevel(); $PermissionLevel->user_id($userID); - $PermissionLevel->permission($ce->{userRoles}->{admin}); + $PermissionLevel->permission($ce->{userRoles}{admin}); my $User = $db->getUser($userID); my $Password = $db->getPassword($userID); push @users, [ $User, $Password, $PermissionLevel ] - if $authz->hasPermissions($userID, "create_and_delete_courses"); - #only transfer the "instructors" in the admin course classlist. + if $authz->hasPermissions($userID, 'create_and_delete_courses'); } } @@ -790,7 +361,7 @@ sub do_add_course { last_name => $add_initial_lastName, student_id => $add_initial_userID, email_address => $add_initial_email, - status => "C", + status => 'C', ); my $Password = $db->newPassword( user_id => $add_initial_userID, @@ -798,67 +369,72 @@ sub do_add_course { ); my $PermissionLevel = $db->newPermissionLevel( user_id => $add_initial_userID, - permission => "10", + permission => '10', ); push @users, [ $User, $Password, $PermissionLevel ]; } push @{ $courseOptions{PRINT_FILE_NAMES_FOR} }, map { $_->[0]->user_id } @users; - # include any optional arguments, including a template course and the - # course title and course institution. + # Include any optional arguments, including a template course and the course title and course institution. my %optional_arguments; - if ($add_templates_course ne "") { + if ($add_templates_course ne '') { $optional_arguments{templatesFrom} = $add_templates_course; } - if ($add_config_file ne "") { + if ($add_config_file ne '') { $optional_arguments{copySimpleConfig} = $add_config_file; } - if ($add_courseTitle ne "") { + if ($add_courseTitle ne '') { $optional_arguments{courseTitle} = $add_courseTitle; } - if ($add_courseInstitution ne "") { + if ($add_courseInstitution ne '') { $optional_arguments{courseInstitution} = $add_courseInstitution; } + my $output = $r->c; + eval { addCourse( courseID => $add_courseID, ce => $ce2, courseOptions => \%courseOptions, - dbOptions => \%dbOptions, + dbOptions => {}, users => \@users, %optional_arguments, ); }; if ($@) { my $error = $@; - print CGI::div( - { class => 'alert alert-danger p-1 mb-2' }, - CGI::p("An error occured while creating the course $add_courseID:"), - CGI::div({ class => 'font-monospace' }, CGI::escapeHTML($error)), + push( + @$output, + $r->tag( + 'div', + class => 'alert alert-danger p-1 mb-2', + $r->c($r->tag('p', "An error occured while creating the course $add_courseID:"), + $r->tag('div', class => 'font-monospace', $error))->join('') + ) ); - # get rid of any partially built courses - # FIXME -- this is too fragile + # Get rid of any partially built courses. + # FIXME: This is too fragile. unless ($error =~ /course exists/) { - eval { deleteCourse(courseID => $add_courseID, ce => $ce2, dbOptions => \%dbOptions,); } + eval { deleteCourse(courseID => $add_courseID, ce => $ce2, dbOptions => {}); } } } else { #log the action writeLog( $ce, - "hosted_courses", + 'hosted_courses', join("\t", "\tAdded", - (defined $add_courseInstitution ? $add_courseInstitution : "(no institution specified)"), - (defined $add_courseTitle ? $add_courseTitle : "(no title specified)"), + (defined $add_courseInstitution ? $add_courseInstitution : '(no institution specified)'), + (defined $add_courseTitle ? $add_courseTitle : '(no title specified)'), $add_courseID, $add_initial_firstName, $add_initial_lastName, $add_initial_email, ) ); - # add contact to admin course as student? + # Add contact to admin course as student? # FIXME -- should we do this? if ($add_initial_userID =~ /\S/) { my $composite_id = "${add_initial_userID}_${add_courseID}"; # student id includes school name and contact @@ -868,7 +444,7 @@ sub do_add_course { last_name => $add_initial_lastName, student_id => $add_initial_userID, email_address => $add_initial_email, - status => "C", + status => 'C', ); my $Password = $db->newPassword( user_id => $composite_id, @@ -876,13 +452,20 @@ sub do_add_course { ); my $PermissionLevel = $db->newPermissionLevel( user_id => $composite_id, - permission => "0", + permission => '0', ); # add contact to admin course as student # or if this contact and course already exist in a dropped status # change the student's status to enrolled if (my $oldUser = $db->getUser($composite_id)) { - warn "Replacing old data for $composite_id status: " . $oldUser->status; + push( + @$output, + $r->tag( + 'div', + class => 'alert alert-danger p-1 mb-2', + $r->maketext('Replacing old data for [_1]: status: [_2]', $composite_id, $oldUser->status) + ) + ); $db->deleteUser($composite_id); } eval { $db->addUser($User) }; @@ -892,464 +475,122 @@ sub do_add_course { eval { $db->addPermissionLevel($PermissionLevel) }; warn $@ if $@; } - print CGI::div( - { class => 'alert alert-success p-1 mb-2' }, - $r->maketext("Successfully created the course [_1]", $add_courseID), + push( + @$output, + $r->tag( + 'div', + class => 'alert alert-success p-1 mb-2', + $r->maketext('Successfully created the course [_1]', $add_courseID) + ) ); - my $newCoursePath = - $urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets", $r, courseID => $add_courseID); - my $newCourseURL = $self->systemLink($newCoursePath, authen => 0); - print CGI::div( - { class => 'text-center mb-2' }, - CGI::a({ href => $newCourseURL }, $r->maketext("Log into [_1]", $add_courseID)), + push( + @$output, + $r->tag( + 'div', + class => 'text-center mb-2', + $r->link_to( + $r->maketext('Log into [_1]', $add_courseID) => $self->systemLink( + $urlpath->newFromModule( + 'WeBWorK::ContentGenerator::ProblemSets', + $r, courseID => $add_courseID + ), + authen => 0 + ) + ) + ) ); } + return $output->join(''); } -################################################################################ - sub rename_course_form { my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; - - print CGI::h2($r->maketext('Rename Course')); - - my @courseIDs = sort { lc($a) cmp lc($b) } listCourses($ce); - - unless (@courseIDs) { - print CGI::p($r->maketext('No courses found')); - return; - } - - my %courseLabels; - for my $courseID (@courseIDs) { - $courseLabels{$courseID} = $courseID; - } - - print CGI::start_form(-method => 'POST', -action => $r->uri); - print $self->hidden_authen_fields; - print $self->hidden_fields('subDisplay'); - - print CGI::p($r->maketext( - 'Select a course to rename. The courseID is used in the url and can only contain alphanumeric characters ' - . 'and underscores. The course title appears on the course home page and can be any string.' - )); - - print CGI::div( - { class => 'col-lg-7 col-md-8' }, - CGI::div( - { class => 'row mb-2' }, - CGI::label( - { for => 'rename_oldCourseID', class => 'col-sm-6 col-form-label fw-bold' }, - $r->maketext('Course ID:') - ), - CGI::div( - { class => 'col-sm-6' }, - CGI::scrolling_list({ - name => 'rename_oldCourseID', - id => 'rename_oldCourseID', - values => \@courseIDs, - default => $r->param('rename_oldCourseID') || '', - size => 10, - multiple => 0, - labels => \%courseLabels, - class => 'form-select', - }) - ) - ), - CGI::div( - { class => 'row mb-2 align-items-center' }, - CGI::div( - { class => 'col-sm-6' }, - CGI::div( - { class => 'form-check' }, - CGI::checkbox({ - name => 'rename_newCourseID_checkbox', - label => $r->maketext('Change CourseID to:'), - checked => $r->param('rename_newCourseID_checkbox') || '', - value => 'on', - class => 'form-check-input', - labelattributes => { class => 'form-check-label', id => 'rename_newCourseID_label' } - }) - ) - ), - CGI::div( - { class => 'col-sm-6' }, - CGI::textfield({ - name => 'rename_newCourseID', - value => $r->param('rename_newCourseID') || '', - class => 'form-control', - aria_labelledby => 'rename_newCourseID_label' - }), - ) - ), - CGI::div( - { class => 'row mb-2 align-items-center' }, - CGI::div( - { class => 'col-sm-6' }, - CGI::div( - { class => 'form-check' }, - CGI::checkbox({ - name => 'rename_newCourseTitle_checkbox', - label => $r->maketext('Change Course Title to:'), - selected => $r->param('rename_newCourseTitle_checkbox') || '', - value => 'on', - class => 'form-check-input', - labelattributes => { class => 'form-check-label', id => 'rename_newCourseTitle_label' } - }) - ) - ), - CGI::div( - { class => 'col-sm-6' }, - CGI::textfield({ - name => 'rename_newCourseTitle', - value => $r->param('rename_newCourseTitle') || '', - class => 'form-control', - aria_labelledby => 'rename_newCourseTitle_label' - }) - ), - ), - CGI::div( - { class => 'row mb-2 align-items-center' }, - CGI::div( - { class => 'col-sm-6' }, - CGI::div( - { class => 'form-check' }, - CGI::checkbox({ - name => 'rename_newCourseInstitution_checkbox', - label => $r->maketext('Change Institution to:'), - checked => $r->param('rename_newCourseInstitution_checkbox') || '', - value => 'on', - class => 'form-check-input', - labelattributes => - { class => 'form-check-label', id => 'rename_newCourseInstitution_label' } - }) - ) - ), - CGI::div( - { class => 'col-sm-6' }, - CGI::textfield({ - name => 'rename_newCourseInstitution', - value => $r->param('rename_newCourseInstitution') || '', - class => 'form-control', - aria_labelledby => 'rename_newCourseInstitution_label' - }) - ) - ) - ); - - print CGI::submit({ name => 'rename_course', label => $r->maketext('Rename Course'), class => 'btn btn-primary' }); - - print CGI::end_form(); + return $self->r->include('ContentGenerator/CourseAdmin/rename_course_form'); } sub rename_course_confirm { - my ($self) = @_; my $r = $self->r; my $ce = $r->ce; - my $rename_oldCourseID = $r->param("rename_oldCourseID") || ""; - my $rename_newCourseID = $r->param("rename_newCourseID") || ""; - my $rename_newCourseID_checkbox = $r->param("rename_newCourseID_checkbox") || ""; + my $rename_oldCourseID = $r->param('rename_oldCourseID') || ''; + my $rename_newCourseID = $r->param('rename_newCourseID') || ''; + my $rename_newCourseTitle = $r->param('rename_newCourseTitle') || ''; + my $rename_newCourseInstitution = $r->param('rename_newCourseInstitution') || ''; - my $rename_newCourseTitle = $r->param("rename_newCourseTitle") || ""; - my $rename_newCourseTitle_checkbox = $r->param("rename_newCourseTitle_checkbox") || ""; - my $rename_newCourseInstitution = $r->param("rename_newCourseInstitution") || ""; - my $rename_newCourseInstitution_checkbox = $r->param("rename_newCourseInstitution_checkbox") || ""; + my $ce2 = WeBWorK::CourseEnvironment->new({ %WeBWorK::SeedCE, courseName => $rename_oldCourseID }); - my $ce2 = new WeBWorK::CourseEnvironment({ - %WeBWorK::SeedCE, courseName => $rename_oldCourseID, - }); -###################################################### -## Create strings confirming title and institution change -###################################################### - # connect to database to get old title and institution + # Create strings confirming title and institution change. + # Connect to the database to get old title and institution. my $dbLayoutName = $ce->{dbLayoutName}; - my $db = new WeBWorK::DB($ce->{dbLayouts}->{$dbLayoutName}); - my $oldDB = new WeBWorK::DB($ce2->{dbLayouts}->{$dbLayoutName}); - my $rename_oldCourseTitle = $oldDB->getSettingValue('courseTitle') // '""'; - my $rename_oldCourseInstitution = $oldDB->getSettingValue('courseInstitution') // '""'; + my $db = WeBWorK::DB->new($ce->{dbLayouts}{$dbLayoutName}); + my $oldDB = WeBWorK::DB->new($ce2->{dbLayouts}{$dbLayoutName}); + my $rename_oldCourseTitle = $oldDB->getSettingValue('courseTitle') // ''; + my $rename_oldCourseInstitution = $oldDB->getSettingValue('courseInstitution') // ''; - my ($change_course_title_str, $change_course_institution_str) = (""); - if ($rename_newCourseTitle_checkbox) { + my ($change_course_title_str, $change_course_institution_str) = ('', ''); + if ($r->param('rename_newCourseTitle_checkbox')) { $change_course_title_str = - $r->maketext("Change title from [_1] to [_2]", $rename_oldCourseTitle, $rename_newCourseTitle); + $r->maketext('Change title from [_1] to [_2]', $rename_oldCourseTitle, $rename_newCourseTitle); } - if ($rename_newCourseInstitution_checkbox) { - $change_course_institution_str = $r->maketext("Change course institution from [_1] to [_2]", + if ($r->param('rename_newCourseInstitution_checkbox')) { + $change_course_institution_str = $r->maketext('Change course institution from [_1] to [_2]', $rename_oldCourseInstitution, $rename_newCourseInstitution); } -############################################################################# - # If we are only changing the title or institution we can cut this short -############################################################################# - unless ($rename_newCourseID_checkbox) { # in this case do not change course ID - print CGI::start_form(-method => "POST", -action => $r->uri); - print $self->hidden_authen_fields; - print $self->hidden_fields("subDisplay"); - print $self->hidden_fields( - qw/rename_oldCourseID rename_newCourseID - rename_newCourseTitle rename_newCourseInstitution - rename_newCourseID_checkbox rename_newCourseInstitution_checkbox - rename_newCourseTitle_checkbox / - ); - print CGI::hidden( - -name => "rename_oldCourseTitle", - -default => $rename_oldCourseTitle, - -id => "hidden_rename_oldCourseTitle" - ); - print CGI::hidden( - -name => "rename_oldCourseInstitution", - -default => $rename_oldCourseInstitution, - -id => "hidden_rename_oldCourseInstitution" - ); + # If we are only changing the title or institution, and not the courseID, then we can cut this short. + return $r->include( + 'ContentGenerator/CourseAdmin/rename_course_confirm_short', + rename_oldCourseTitle => $rename_oldCourseTitle, + change_course_title_str => $change_course_title_str, + rename_oldCourseInstitution => $rename_oldCourseInstitution, + change_course_institution_str => $change_course_institution_str, + rename_oldCourseID => $rename_oldCourseID + ) unless $r->param('rename_newCourseID_checkbox'); - print CGI::div( - { style => "text-align: left" }, - CGI::hr(), - CGI::h4($r->maketext("Make these changes in course:") . " $rename_oldCourseID"), - CGI::p($change_course_title_str), - CGI::p($change_course_institution_str), - CGI::submit({ - name => "decline_retitle_course", - value => $r->maketext("Don't make changes"), - class => 'btn btn-primary' - }), - " ", - CGI::submit({ - name => "confirm_retitle_course", - value => $r->maketext("Make changes"), - class => 'btn btn-primary' - }), - CGI::hr(), - ); - print CGI::end_form(); - return; - } + if ($ce2->{dbLayoutName}) { + my $CIchecker = WeBWorK::Utils::CourseIntegrityCheck->new(ce => $ce2); -############################################################################# - # Check database -############################################################################# + # Check database + my ($tables_ok, $dbStatus) = $CIchecker->checkCourseTables($rename_oldCourseID); - my ($tables_ok, $dbStatus); - if ($ce2->{dbLayoutName}) { - my $CIchecker = new WeBWorK::Utils::CourseIntegrityCheck(ce => $ce2); - ($tables_ok, $dbStatus) = $CIchecker->checkCourseTables($rename_oldCourseID); - if ($r->param("upgrade_course_tables")) { - my @schema_table_names = keys %$dbStatus; # update tables missing from database; + # Upgrade the database if requested. + my @upgrade_report; + if ($r->param('upgrade_course_tables')) { + my @schema_table_names = keys %$dbStatus; my @tables_to_create = grep { $dbStatus->{$_}->[0] == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_A } @schema_table_names; my @tables_to_alter = grep { $dbStatus->{$_}->[0] == WeBWorK::Utils::CourseIntegrityCheck::DIFFER_IN_A_AND_B } @schema_table_names; - my $msg = $CIchecker->updateCourseTables($rename_oldCourseID, [@tables_to_create]); - foreach my $table_name (@tables_to_alter) { - $msg .= $CIchecker->updateTableFields($rename_oldCourseID, $table_name); + push(@upgrade_report, $CIchecker->updateCourseTables($rename_oldCourseID, [@tables_to_create])); + for my $table_name (@tables_to_alter) { + push(@upgrade_report, $CIchecker->updateTableFields($rename_oldCourseID, $table_name)); } - print CGI::p({ class => 'text-success fw-bold' }, $msg); - } - ($tables_ok, $dbStatus) = $CIchecker->checkCourseTables($rename_oldCourseID); - - # print db status - - my %msg = ( - WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_A => - CGI::span({ class => 'text-danger' }, $r->maketext("Table defined in schema but missing in database")), - WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_B => - CGI::span({ class => 'text-danger' }, $r->maketext("Table defined in database but missing in schema")), - WeBWorK::Utils::CourseIntegrityCheck::SAME_IN_A_AND_B => - CGI::span({ class => 'text-success' }, $r->maketext("Table is ok")), - WeBWorK::Utils::CourseIntegrityCheck::DIFFER_IN_A_AND_B => CGI::span( - { class => 'text-danger' }, - $r->maketext("Schema and database table definitions do not agree") - ), - ); - my %msg2 = ( - WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_A => - CGI::span({ class => 'text-danger' }, $r->maketext("Field missing in database")), - WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_B => - CGI::span({ class => 'text-danger' }, $r->maketext("Field missing in schema")), - WeBWorK::Utils::CourseIntegrityCheck::SAME_IN_A_AND_B => - CGI::span({ class => 'text-success' }, $r->maketext("Field is ok")), - WeBWorK::Utils::CourseIntegrityCheck::DIFFER_IN_A_AND_B => CGI::span( - { class => 'text-danger' }, - $r->maketext("Schema and database field definitions do not agree") - ), - ); - my $all_tables_ok = 1; - my $extra_database_tables = 0; - my $extra_database_fields = 0; - my $str = - CGI::h4($r->maketext("Report on database structure for course [_1]:", $rename_oldCourseID)) . CGI::br(); - foreach my $table (sort keys %$dbStatus) { - my $table_status = $dbStatus->{$table}->[0]; - $str .= CGI::b($table) . ': ' . $msg{$table_status} . CGI::br(); - - CASE: { - $table_status == WeBWorK::Utils::CourseIntegrityCheck::SAME_IN_A_AND_B - && do { - last CASE; - }; - $table_status == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_A - && do { - $all_tables_ok = 0; - last CASE; - }; - $table_status == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_B - && do { - $extra_database_tables = 1; - last CASE; - }; - $table_status == WeBWorK::Utils::CourseIntegrityCheck::DIFFER_IN_A_AND_B - && do { - my %fieldInfo = %{ $dbStatus->{$table}->[1] }; - foreach my $key (keys %fieldInfo) { - my $field_status = $fieldInfo{$key}->[0]; - CASE2: { - $field_status == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_B - && do { - $extra_database_fields = 1; - last CASE2; - }; - $field_status == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_A - && do { - $all_tables_ok = 0; - last CASE2; - }; - } - $str .= CGI::br() . "\n   $key => " . $msg2{$field_status}; - } - }; - } - $str .= CGI::br(); - - } -############################################################################# - # Report on databases -############################################################################# - - print CGI::p($str); - if ($extra_database_tables) { - print CGI::p( - { class => 'text-danger fw-bold' }, - $r->maketext( - 'There are extra database tables which are not defined in the schema. ' - . 'These can be deleted when upgrading the course.' - ) - ); - } - if ($extra_database_fields) { - print CGI::p( - { class => 'text-danger fw-bold' }, - $r->maketext( - 'There are extra database fields which are not defined in the schema for at least one table. ' - . 'They can only be removed when upgrading the course.' - ) - ); - } - if ($all_tables_ok) { - print CGI::p({ class => 'text-success fw-bold' }, - $r->maketext("Course [_1] database is in order", $rename_oldCourseID)); - } else { - print CGI::p( - { class => 'text-danger fw-bold' }, - $r->maketext( - "Course [_1] databases must be updated before renaming this course.", - $rename_oldCourseID - ) - ); + ($tables_ok, $dbStatus) = $CIchecker->checkCourseTables($rename_oldCourseID); } -############################################################################# # Check directories -############################################################################# - - my ($directories_ok, $str2) = $CIchecker->checkCourseDirectories($ce2); - print CGI::h2('Directory structure'), CGI::p($str2), - $directories_ok ? CGI::p({ class => 'text-success' }, $r->maketext('Directory structure is ok')) : CGI::p( - { class => 'text-danger' }, - $r->maketext( - 'Directory structure is missing directories or the webserver lacks sufficient privileges.') - ); - -############################################################################# - # Print form for choosing next action. -############################################################################# - - print CGI::start_form(-method => "POST", -action => $r->uri); - print $self->hidden_authen_fields; - print $self->hidden_fields("subDisplay"); - print $self->hidden_fields( - qw/rename_oldCourseID rename_newCourseID - rename_newCourseTitle rename_newCourseInstitution - rename_newCourseID_checkbox rename_newCourseInstitution_checkbox - rename_newCourseTitle_checkbox / + my ($directories_ok, $directory_report) = $CIchecker->checkCourseDirectories($ce2); + + return $r->include( + 'ContentGenerator/CourseAdmin/rename_course_confirm', + upgrade_report => \@upgrade_report, + tables_ok => $tables_ok, + dbStatus => $dbStatus, + directory_report => $directory_report, + directories_ok => $directories_ok, + rename_oldCourseTitle => $rename_oldCourseTitle, + change_course_title_str => $change_course_title_str, + rename_oldCourseInstitution => $rename_oldCourseInstitution, + change_course_institution_str => $change_course_institution_str, + rename_oldCourseID => $rename_oldCourseID, + rename_newCourseID => $rename_newCourseID ); - print CGI::hidden( - -name => "rename_oldCourseTitle", - -default => $rename_oldCourseTitle, - -id => "hidden_rename_oldCourseTitle" - ); - print CGI::hidden( - -name => "rename_oldCourseInstitution", - -default => $rename_oldCourseInstitution, - -id => "hidden_rename_oldCourseInstitution" - ); - - # grab some values we'll need - # fail if the source course does not exist - - if ($all_tables_ok && $directories_ok) { # no missing tables or missing fields or directories - print CGI::p( - { style => "text-align: center" }, - CGI::hr(), - CGI::h4($r->maketext("Rename [_1] to [_2]", $rename_oldCourseID, $rename_newCourseID)), - CGI::div($change_course_title_str), - CGI::div($change_course_institution_str), - CGI::submit({ - name => "decline_rename_course", - value => $r->maketext("Don't rename"), - class => 'btn btn-primary' - }), - " ", - CGI::submit({ - name => "confirm_rename_course", - value => $r->maketext("Rename"), - class => 'btn btn-primary' - }), - ); - } elsif ($directories_ok) { - print CGI::p( - { style => "text-align: center" }, - CGI::submit({ - name => "decline_rename_course", - -value => $r->maketext("Don't rename"), - class => 'btn btn-primary' - }), - " ", - CGI::submit({ - name => "upgrade_course_tables", - value => $r->maketext("Upgrade Course Tables"), - class => 'btn btn-primary' - }), - ); - } else { - print CGI::p( - { style => "text-align: center" }, - CGI::submit({ - name => "decline_rename_course", - -value => $r->maketext("Don't rename"), - class => 'btn btn-primary' - }), - CGI::br(), - $r->maketext("Directory structure needs to be repaired manually before renaming.") - ); - } - print CGI::end_form(); + } else { + return $r->tag('p', class => 'text-danger fw-bold', "Unable to find database layout for $rename_oldCourseID"); } } @@ -1358,40 +599,40 @@ sub rename_course_validate { my $r = $self->r; my $ce = $r->ce; - my $rename_oldCourseID = $r->param("rename_oldCourseID") || ""; - my $rename_newCourseID = $r->param("rename_newCourseID") || ""; - my $rename_newCourseID_checkbox = $r->param("rename_newCourseID_checkbox") || ""; + my $rename_oldCourseID = $r->param('rename_oldCourseID') || ''; + my $rename_newCourseID = $r->param('rename_newCourseID') || ''; + my $rename_newCourseID_checkbox = $r->param('rename_newCourseID_checkbox') || ''; - my $rename_newCourseTitle = $r->param("rename_newCourseTitle") || ""; - my $rename_newCourseTitle_checkbox = $r->param("rename_newCourseTitle_checkbox") || ""; - my $rename_newCourseInstitution = $r->param("rename_newCourseInstitution") || ""; - my $rename_newCourseInstitution_checkbox = $r->param("rename_newCourseInstitution_checkbox") || ""; + my $rename_newCourseTitle = $r->param('rename_newCourseTitle') || ''; + my $rename_newCourseTitle_checkbox = $r->param('rename_newCourseTitle_checkbox') || ''; + my $rename_newCourseInstitution = $r->param('rename_newCourseInstitution') || ''; + my $rename_newCourseInstitution_checkbox = $r->param('rename_newCourseInstitution_checkbox') || ''; my @errors; - if ($rename_oldCourseID eq "") { - push @errors, $r->maketext("You must select a course to rename."); + if ($rename_oldCourseID eq '') { + push @errors, $r->maketext('You must select a course to rename.'); } - if ($rename_newCourseID eq "" and $rename_newCourseID_checkbox eq 'on') { - push @errors, $r->maketext("You must specify a new name for the course."); + if ($rename_newCourseID eq '' and $rename_newCourseID_checkbox eq 'on') { + push @errors, $r->maketext('You must specify a new name for the course.'); } if ($rename_oldCourseID eq $rename_newCourseID and $rename_newCourseID_checkbox eq 'on') { - push @errors, $r->maketext("Can't rename to the same name."); + push @errors, $r->maketext(q{Can't rename to the same name.}); } if ($rename_newCourseID_checkbox eq 'on' && length($rename_newCourseID) > $ce->{maxCourseIdLength}) { - push @errors, $r->maketext("Course ID cannot exceed [_1] characters.", $ce->{maxCourseIdLength}); + push @errors, $r->maketext('Course ID cannot exceed [_1] characters.', $ce->{maxCourseIdLength}); } unless ($rename_newCourseID =~ /^[\w-]*$/) { # regex copied from CourseAdministration.pm - push @errors, $r->maketext("Course ID may only contain letters, numbers, hyphens, and underscores."); + push @errors, $r->maketext('Course ID may only contain letters, numbers, hyphens, and underscores.'); } if (grep { $rename_newCourseID eq $_ } listCourses($ce)) { - push @errors, $r->maketext("A course with ID [_1] already exists.", $rename_newCourseID); + push @errors, $r->maketext('A course with ID [_1] already exists.', $rename_newCourseID); } - if ($rename_newCourseTitle eq "" and $rename_newCourseTitle_checkbox eq 'on') { - push @errors, $r->maketext("You must specify a new title for the course."); + if ($rename_newCourseTitle eq '' and $rename_newCourseTitle_checkbox eq 'on') { + push @errors, $r->maketext('You must specify a new title for the course.'); } - if ($rename_newCourseInstitution eq "" and $rename_newCourseInstitution_checkbox eq 'on') { - push @errors, $r->maketext("You must specify a new institution for the course."); + if ($rename_newCourseInstitution eq '' and $rename_newCourseInstitution_checkbox eq 'on') { + push @errors, $r->maketext('You must specify a new institution for the course.'); } unless ($rename_newCourseID or $rename_newCourseID_checkbox @@ -1400,7 +641,7 @@ sub rename_course_validate { { push @errors, $r->maketext( - "No changes specified. You must mark the checkbox of the item(s) to be changed and enter the change data." + 'No changes specified. You must mark the checkbox of the item(s) to be changed and enter the change data.' ); } @@ -1408,22 +649,21 @@ sub rename_course_validate { } sub do_retitle_course { - my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; - my $db = $r->db; - #my $authz = $r->authz; + my ($self) = @_; + my $r = $self->r; + my $ce = $r->ce; + my $db = $r->db; my $urlpath = $r->urlpath; - my $rename_oldCourseID = $r->param("rename_oldCourseID") || ""; - # my $rename_newCourseID = $r->param("rename_newCourseID") || ""; + my $rename_oldCourseID = $r->param('rename_oldCourseID') || ''; + # There is no new course, but there are new titles and institutions - my $rename_newCourseTitle = $r->param("rename_newCourseTitle") || ""; - my $rename_newCourseInstitution = $r->param("rename_newCourseInstitution") || ""; - my $rename_oldCourseTitle = $r->param("rename_oldCourseTitle") || ""; - my $rename_oldCourseInstitution = $r->param("rename_oldCourseInstitution") || ""; - my $title_checkbox = $r->param("rename_newCourseTitle_checkbox") || ""; - my $institution_checkbox = $r->param("rename_newCourseInstitution_checkbox") || ""; + my $rename_newCourseTitle = $r->param('rename_newCourseTitle') || ''; + my $rename_newCourseInstitution = $r->param('rename_newCourseInstitution') || ''; + my $rename_oldCourseTitle = $r->param('rename_oldCourseTitle') || ''; + my $rename_oldCourseInstitution = $r->param('rename_oldCourseInstitution') || ''; + my $title_checkbox = $r->param('rename_newCourseTitle_checkbox') || ''; + my $institution_checkbox = $r->param('rename_newCourseInstitution_checkbox') || ''; # $rename_newCourseID = $rename_oldCourseID ; #since they are the same FIXME # define new courseTitle and new courseInstitution @@ -1432,356 +672,242 @@ sub do_retitle_course { $optional_arguments{courseInstitution} = $rename_newCourseInstitution if $institution_checkbox; my $ce2; - my %dbOptions = (); - eval { $ce2 = new WeBWorK::CourseEnvironment({ %WeBWorK::SeedCE, courseName => $rename_oldCourseID, }); }; + eval { $ce2 = WeBWorK::CourseEnvironment->new({ %WeBWorK::SeedCE, courseName => $rename_oldCourseID }); }; warn "failed to create environment in do_retitle_course $@" if $@; - eval { retitleCourse(courseID => $rename_oldCourseID, ce => $ce2, dbOptions => \%dbOptions, - %optional_arguments,); }; + eval { retitleCourse(courseID => $rename_oldCourseID, ce => $ce2, dbOptions => {}, %optional_arguments); }; if ($@) { my $error = $@; - print CGI::div( - { class => 'alert alert-danger p-1 mb-2' }, - CGI::p($r->maketext( - "An error occured while changing the title of the course [_1].", $rename_oldCourseID)), - CGI::div({ class => 'font-monospace' }, CGI::escapeHTML($error)), + return $r->tag( + 'div', + class => 'alert alert-danger p-1 mb-2', + $r->c( + $r->tag( + 'p', + $r->maketext( + 'An error occured while changing the title of the course [_1].', + $rename_oldCourseID + ) + ), + $r->tag('div', class => 'font-monospace', $error) + )->join('') ); } else { - print CGI::div( - { class => 'alert alert-success p-1 mb-2' }, - ($title_checkbox) ? CGI::div($r->maketext( - "The title of the course [_1] has been changed from [_2] to [_3]", - $rename_oldCourseID, $rename_oldCourseTitle, $rename_newCourseTitle - )) : '', - ($institution_checkbox) ? CGI::div($r->maketext( - "The institution associated with the course [_1] has been changed from [_2] to [_3]", - $rename_oldCourseID, $rename_oldCourseInstitution, $rename_newCourseInstitution - )) : '', - ); writeLog( $ce, - "hosted_courses", + 'hosted_courses', join( "\t", "\t", - $r->maketext("Retitled"), - "", "", + $r->maketext('Retitled'), + '', '', $r->maketext( - "[_1] title and institution changed from [_2] to [_3] and from [_4] to [_5]", + '[_1] title and institution changed from [_2] to [_3] and from [_4] to [_5]', $rename_oldCourseID, $rename_oldCourseTitle, $rename_newCourseTitle, $rename_oldCourseInstitution, $rename_newCourseInstitution ) ) ); - my $oldCoursePath = - $urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets", $r, courseID => $rename_oldCourseID); - my $oldCourseURL = $self->systemLink($oldCoursePath, authen => 0); - print CGI::div( - { style => "text-align: center" }, - CGI::a({ href => $oldCourseURL }, $r->maketext("Log into [_1]", $rename_oldCourseID)), - ); + + return $r->c( + $r->tag( + 'div', + class => 'alert alert-success p-1 my-2', + $r->c( + ($title_checkbox) ? $r->tag( + 'div', + $r->maketext( + 'The title of the course [_1] has been changed from [_2] to [_3]', + $rename_oldCourseID, $rename_oldCourseTitle, $rename_newCourseTitle + ) + ) : '', + ($institution_checkbox) ? $r->tag( + 'div', + $r->maketext( + 'The institution associated with the course [_1] has been changed from [_2] to [_3]', + $rename_oldCourseID, $rename_oldCourseInstitution, $rename_newCourseInstitution + ) + ) : '' + )->join('') + ), + $r->tag( + 'div', + class => 'text-center', + $r->link_to( + $r->maketext('Log into [_1]', $rename_oldCourseID) => $self->systemLink( + $urlpath->newFromModule( + 'WeBWorK::ContentGenerator::ProblemSets', + $r, courseID => $rename_oldCourseID + ), + authen => 0 + ) + ) + ) + )->join(''); } } sub do_rename_course { my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; - my $db = $r->db; - #my $authz = $r->authz; - my $urlpath = $r->urlpath; - - my $rename_oldCourseID = $r->param("rename_oldCourseID") || ""; - my $rename_newCourseID = $r->param("rename_newCourseID") || ""; - my $rename_newCourseTitle = $r->param("rename_newCourseTitle") || ""; - my $rename_newCourseInstitution = $r->param("rename_newCourseInstitution") || ""; - my $title_checkbox = $r->param("rename_newCourseTitle_checkbox") || ""; - my $institution_checkbox = $r->param("rename_newCourseInstitution_checkbox") || ""; - - my $ce2 = new WeBWorK::CourseEnvironment({ - %WeBWorK::SeedCE, courseName => $rename_oldCourseID, - }); + my $r = $self->r; - my $dbLayoutName = $ce->{dbLayoutName}; + my $rename_oldCourseID = $r->param('rename_oldCourseID') || ''; + my $rename_newCourseID = $r->param('rename_newCourseID') || ''; # define new courseTitle and new courseInstitution my %optional_arguments = (); my ($title_message, $institution_message); - if ($title_checkbox) { - $optional_arguments{courseTitle} = $rename_newCourseTitle; - $title_message = - $r->maketext("The title of the course [_1] is now [_2]", $rename_newCourseID, $rename_newCourseTitle),; - - } else { + if ($r->param('rename_newCourseTitle_checkbox')) { + $optional_arguments{courseTitle} = $r->param('rename_newCourseTitle') || ''; + $title_message = $r->maketext('The title of the course [_1] is now [_2]', + $rename_newCourseID, $optional_arguments{courseTitle}); } - if ($institution_checkbox) { - $optional_arguments{courseInstitution} = $rename_newCourseInstitution; - $institution_message = $r->maketext("The institution associated with the course [_1] is now [_2]", - $rename_newCourseID, $rename_newCourseInstitution), - ; + if ($r->param('rename_newCourseInstitution_checkbox')) { + $optional_arguments{courseInstitution} = $r->param('rename_newCourseInstitution') || ''; + $institution_message = $r->maketext('The institution associated with the course [_1] is now [_2]', + $rename_newCourseID, $optional_arguments{courseInstitution}); } - # this is kinda left over from when we had 'gdbm' and 'sql' database layouts - # below this line, we would grab values from getopt and put them in this hash - # but for now the hash can remain empty - my %dbOptions; - + # dbOptions is left over from when we had 'gdbm' and 'sql' database layouts. For now the hash can remain empty. eval { renameCourse( courseID => $rename_oldCourseID, - ce => $ce2, - dbOptions => \%dbOptions, + ce => WeBWorK::CourseEnvironment->new({ %WeBWorK::SeedCE, courseName => $rename_oldCourseID }), + dbOptions => {}, newCourseID => $rename_newCourseID, - %optional_arguments, + %optional_arguments ); }; if ($@) { my $error = $@; - print CGI::div( - { class => 'alert alert-danger p-1 mb-2' }, - CGI::p($r->maketext( - "An error occured while renaming the course [_1] to [_2]:", $rename_oldCourseID, - $rename_newCourseID - )), - CGI::div({ class => 'font-monospace' }, CGI::escapeHTML($error)), + return $r->tag( + 'div', + class => 'alert alert-danger p-1 mb-2', + $r->c( + $r->tag( + 'p', + $r->maketext( + 'An error occured while renaming the course [_1] to [_2]:', $rename_oldCourseID, + $rename_newCourseID + ) + ), + $r->tag('div', class => 'font-monospace', $error) + )->join('') ); } else { - print CGI::div( - { class => 'alert alert-success p-1 mb-2' }, - CGI::p($title_message), - CGI::p($institution_message), - CGI::p($r->maketext( - "Successfully renamed the course [_1] to [_2]", - $rename_oldCourseID, $rename_newCourseID - )), - ); - writeLog($ce, "hosted_courses", join("\t", "\tRenamed", "", "", "$rename_oldCourseID to $rename_newCourseID",)); - my $newCoursePath = - $urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets", $r, courseID => $rename_newCourseID); - my $newCourseURL = $self->systemLink($newCoursePath, authen => 0); - print CGI::div( - { style => "text-align: center" }, - CGI::a({ href => $newCourseURL }, $r->maketext("Log into [_1]", $rename_newCourseID)), - ); + writeLog($r->ce, 'hosted_courses', + join("\t", "\tRenamed", '', '', "$rename_oldCourseID to $rename_newCourseID")); + return $r->c( + $r->tag( + 'div', + class => 'alert alert-success p-1 mb-2', + $r->c( + $title_message ? $r->tag('p', $title_message) : '', + $institution_message ? $r->tag('p', $institution_message) : '', + $r->tag( + 'p', + class => 'mb-0', + $r->maketext( + 'Successfully renamed the course [_1] to [_2]', $rename_oldCourseID, + $rename_newCourseID + ) + ) + )->join('') + ), + $r->tag( + 'div', + style => 'text-align: center', + $r->link_to( + $r->maketext('Log into [_1]', $rename_newCourseID) => $self->systemLink( + $r->urlpath->newFromModule( + 'WeBWorK::ContentGenerator::ProblemSets', + $r, courseID => $rename_newCourseID + ), + authen => 0 + ) + ) + ) + )->join(''); } } -################################################################################ - -my %coursesData; -sub byLoginActivity { $coursesData{$a}{'epoch_modify_time'} <=> $coursesData{$b}{'epoch_modify_time'} } - sub delete_course_form { my ($self) = @_; my $r = $self->r; my $ce = $r->ce; - print CGI::h2($r->maketext('Delete Course')); + my @courseIDs = grep { $_ ne $r->urlpath->arg('courseID') } listCourses($ce); + my %courseLabels; - my @courseIDs = listCourses($ce); + if (@courseIDs) { + my $coursesDir = $ce->{webworkDirs}{courses}; + my $delete_listing_format = $r->param('delete_listing_format'); + unless (defined $delete_listing_format) { $delete_listing_format = 'alphabetically'; } # Use the default + + # Get and store last modify time for login.log for all courses. Also get visibility status. + my @noLoginLogIDs; + my @loginLogIDs; + + my %coursesData; + for my $courseID (@courseIDs) { + my $loginLogFile = "$coursesDir/$courseID/logs/login.log"; + if (-e $loginLogFile) { + # The login log file should always exist except for the model course. + my $epoch_modify_time = stat($loginLogFile)->mtime; + $coursesData{$courseID}{epoch_modify_time} = $epoch_modify_time; + $coursesData{$courseID}{local_modify_time} = ctime($epoch_modify_time); + push(@loginLogIDs, $courseID); + } else { + # This is for the model course. + $coursesData{$courseID}{local_modify_time} = 'no login.log'; + push(@noLoginLogIDs, $courseID); + } + if (-f "$coursesDir/$courseID/hide_directory") { + $coursesData{$courseID}{status} = $r->maketext('hidden'); + } else { + $coursesData{$courseID}{status} = $r->maketext('visible'); + } + $courseLabels{$courseID} = + "$courseID ($coursesData{$courseID}{status} :: $coursesData{$courseID}{local_modify_time}) "; + } - unless (@courseIDs) { - print CGI::p($r->maketext('No courses found')); - return; + if ($delete_listing_format eq 'last_login') { + # This should be an empty array except for the model course. + @noLoginLogIDs = sort { lc($a) cmp lc($b) } @noLoginLogIDs; + @loginLogIDs = sort { $coursesData{$a}{epoch_modify_time} <=> $coursesData{$b}{epoch_modify_time} } + @loginLogIDs; # oldest first + @courseIDs = (@noLoginLogIDs, @loginLogIDs); + } else { + # In this case we sort alphabetically + @courseIDs = sort { lc($a) cmp lc($b) } @courseIDs; + } } - my $coursesDir = $ce->{webworkDirs}{courses}; - my $delete_listing_format = $r->param('delete_listing_format'); - unless (defined $delete_listing_format) { $delete_listing_format = 'alphabetically'; } #use the default - - # Get and store last modify time for login.log for all courses. Also get visibility status. - my %courseLabels; - my @noLoginLogIDs = (); - my @loginLogIDs = (); - - my ($loginLogFile, $epoch_modify_time, $courseDir); - for my $courseID (@courseIDs) { - $loginLogFile = "$coursesDir/$courseID/logs/login.log"; - if (-e $loginLogFile) { - # The login log file should always exist except for the model course. - $epoch_modify_time = stat($loginLogFile)->mtime; - $coursesData{$courseID}{'epoch_modify_time'} = $epoch_modify_time; - $coursesData{$courseID}{'local_modify_time'} = ctime($epoch_modify_time); - push(@loginLogIDs, $courseID); - } else { - # This is for the model course. - $coursesData{$courseID}{'local_modify_time'} = 'no login.log'; - push(@noLoginLogIDs, $courseID); - } - if (-f "$coursesDir/$courseID/hide_directory") { - $coursesData{$courseID}{'status'} = $r->maketext('hidden'); - } else { - $coursesData{$courseID}{'status'} = $r->maketext('visible'); - } - $courseLabels{$courseID} = - "$courseID ($coursesData{$courseID}{'status'} :: $coursesData{$courseID}{'local_modify_time'}) "; - } - if ($delete_listing_format eq 'last_login') { - # This should be an empty array except for the model course. - @noLoginLogIDs = sort { lc($a) cmp lc($b) } @noLoginLogIDs; - @loginLogIDs = sort byLoginActivity @loginLogIDs; # oldest first - @courseIDs = (@noLoginLogIDs, @loginLogIDs); - } else { - # In this case we sort alphabetically - @courseIDs = sort { lc($a) cmp lc($b) } @courseIDs; - } - - print CGI::start_form(-method => 'POST', -action => $r->uri); - - print CGI::p($r->maketext( - 'Courses are listed either alphabetically or in order by the time of most recent login activity, ' - . 'oldest first. To change the listing order check the mode you want and click "Refresh Listing". ' - . 'The listing format is: Course_Name (status :: date/time of most recent login) where status is "hidden" ' - . 'or "visible".' - )); - - print CGI::div( - { class => 'mb-3' }, - CGI::div({ class => 'mb-2' }, $r->maketext('Select a listing format:')), - map { - CGI::div( - { class => 'form-check' }, - CGI::input({ - type => 'radio', - name => 'delete_listing_format', - id => "delete_listing_format_$_->[0]", - value => $_->[0], - class => 'form-check-input', - $_->[0] eq ($r->param('delete_listing_format') // 'alphabetically') ? (checked => undef) : () - }), - CGI::label( - { - for => "delete_listing_format_$_->[0]", - class => 'form-check-label' - }, - $_->[1] - ) - ) - } ( - [ alphabetically => $r->maketext('alphabetically') ], - [ last_login => $r->maketext('by last login date') ] - ), - ); - - print CGI::div( - { class => 'mb-2' }, - CGI::submit({ - name => 'delete_course_refresh', - value => $r->maketext('Refresh Listing'), - class => 'btn btn-primary' - }), - CGI::submit({ - name => 'delete_course', - value => $r->maketext('Delete Course'), - class => 'btn btn-primary' - }) - ); - - print $self->hidden_authen_fields; - print $self->hidden_fields('subDisplay'); - - print CGI::div({ class => 'mb-2' }, $r->maketext('Select a course to delete.')); - print CGI::div( - { class => 'row mb-2' }, - CGI::label( - { for => 'delete_courseID', class => 'col-auto col-form-label fw-bold' }, - $r->maketext('Course Name:') - ), - CGI::div( - { class => 'col-auto' }, - CGI::scrolling_list({ - name => 'delete_courseID', - id => 'delete_courseID', - values => \@courseIDs, - default => $r->param('delete_courseID') || '', - size => 15, - multiple => 0, - labels => \%courseLabels, - class => 'form-select' - }) - ) - ); - - print CGI::div( - CGI::submit({ - name => 'delete_course_refresh', - value => $r->maketext('Refresh Listing'), - class => 'btn btn-primary' - }), - CGI::submit({ - name => 'delete_course', - value => $r->maketext('Delete Course'), - class => 'btn btn-primary' - }) + return $r->include( + 'ContentGenerator/CourseAdmin/delete_course_form', + courseIDs => \@courseIDs, + courseLabels => \%courseLabels ); - - print CGI::end_form(); } sub delete_course_validate { my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; - #my $db = $r->db; - #my $authz = $r->authz; - my $urlpath = $r->urlpath; - - my $delete_courseID = $r->param("delete_courseID") || ""; + my $r = $self->r; my @errors; - - if ($delete_courseID eq "") { - push @errors, $r->maketext("You must specify a course name."); - } elsif ($delete_courseID eq $urlpath->arg("courseID")) { - push @errors, $r->maketext("You cannot delete the course you are currently using."); + if (!$r->param('delete_courseID')) { + push @errors, $r->maketext('You must specify a course name.'); + } elsif ($r->param('delete_courseID') eq $r->urlpath->arg('courseID')) { + push @errors, $r->maketext('You cannot delete the course you are currently using.'); } - my $ce2 = new WeBWorK::CourseEnvironment({ - %WeBWorK::SeedCE, courseName => $delete_courseID, - }); - return @errors; } sub delete_course_confirm { my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; - - print CGI::h2($r->maketext('Delete Course')); - - my $delete_courseID = $r->param('delete_courseID') || ''; - - my $ce2 = new WeBWorK::CourseEnvironment({ %WeBWorK::SeedCE, courseName => $delete_courseID }); - - print CGI::p($r->maketext( - 'Are you sure you want to delete the course [_1]? All course files and data will be destroyed. ' - . 'There is no undo available.', - CGI::b($delete_courseID) - )); - - print CGI::start_form({ method => 'POST', action => $r->uri }); - print $self->hidden_authen_fields; - print $self->hidden_fields('subDisplay'); - print $self->hidden_fields('delete_courseID'); - - print CGI::p( - { style => 'text-align: center' }, - CGI::submit({ - name => 'decline_delete_course', - label => $r->maketext("Don't delete"), - class => 'btn btn-primary' - }), - ' ', - CGI::submit({ - name => 'confirm_delete_course', - label => $r->maketext('Delete'), - class => 'btn btn-primary' - }), - ); - - print CGI::end_form(); + return $self->r->include('ContentGenerator/CourseAdmin/delete_course_confirm'); } sub do_delete_course { @@ -1789,66 +915,65 @@ sub do_delete_course { my $r = $self->r; my $ce = $r->ce; my $db = $r->db; - #my $authz = $r->authz; - #my $urlpath = $r->urlpath; - - my $delete_courseID = $r->param("delete_courseID") || ""; - - my $ce2 = new WeBWorK::CourseEnvironment({ - %WeBWorK::SeedCE, courseName => $delete_courseID, - }); - # this is kinda left over from when we had 'gdbm' and 'sql' database layouts - # below this line, we would grab values from getopt and put them in this hash - # but for now the hash can remain empty - my %dbOptions; + my $delete_courseID = $r->param('delete_courseID') || ''; - eval { deleteCourse(courseID => $delete_courseID, ce => $ce2, dbOptions => \%dbOptions,); }; + # dbOptions is left over from when we had 'gdbm' and 'sql' database layouts. For now the hash can remain empty. + eval { + deleteCourse( + courseID => $delete_courseID, + ce => WeBWorK::CourseEnvironment->new({ %WeBWorK::SeedCE, courseName => $delete_courseID }), + dbOptions => {} + ); + }; if ($@) { my $error = $@; - print CGI::div( - { class => 'alert alert-danger p-1 mb-2' }, - CGI::p($r->maketext("An error occured while deleting the course [_1]:", $delete_courseID)), - CGI::div({ class => 'font-monospace' }, CGI::escapeHTML($error)), + return $r->tag( + 'div', + class => 'alert alert-danger p-1 my-2', + $r->c($r->tag('p', $r->maketext('An error occured while deleting the course [_1]:', $delete_courseID)), + $r->tag('div', class => 'font-monospace', $error))->join('') ); } else { - # mark the contact person in the admin course as dropped. - # find the contact person for the course by searching the admin classlist. - my @contacts = grep /_$delete_courseID$/, $db->listUsers; + # Mark the contact person in the admin course as dropped. + # Find the contact person for the course by searching the admin classlist. + my @contacts = grep {/_$delete_courseID$/} $db->listUsers; if (@contacts) { - die "Incorrect number of contacts for the course $delete_courseID" . join(" ", @contacts) if @contacts != 1; - #warn "contacts", join(" ", @contacts); - #my $composite_id = "${add_initial_userID}_${add_courseID}"; - my $composite_id = $contacts[0]; - - # mark the contact person as dropped. - my $User = $db->getUser($composite_id); - my $status_name = 'Drop'; - my $status_value = ($ce->status_name_to_abbrevs($status_name))[0]; - $User->status($status_value); + die 'Incorrect number of contacts for the course $delete_courseID' . join(' ', @contacts) if @contacts != 1; + + # Mark the contact person as dropped. + my $User = $db->getUser($contacts[0]); + $User->status(($ce->status_name_to_abbrevs('Drop'))[0]); $db->putUser($User); } - print CGI::div( - { class => 'alert alert-success p-1 mb-2' }, - $r->maketext("Successfully deleted the course [_1].", $delete_courseID), - ); - writeLog($ce, "hosted_courses", join("\t", "\tDeleted", "", "", $delete_courseID,)); - print CGI::start_form(-method => "POST", -action => $r->uri); - print $self->hidden_authen_fields; - print $self->hidden_fields("subDisplay"); - - print CGI::p( - { style => "text-align: center" }, - CGI::submit({ - name => "decline_delete_course", - value => $r->maketext("OK"), - class => 'btn btn-primary' - }) - ); + writeLog($ce, 'hosted_courses', join("\t", "\tDeleted", '', '', $delete_courseID)); - print CGI::end_form(); + return $r->c( + $r->tag( + 'div', + class => 'alert alert-success p-1 my-2', + $r->maketext('Successfully deleted the course [_1].', $delete_courseID), + ), + $r->form_for( + $r->uri, + method => 'POST', + $r->c( + $self->hidden_authen_fields, + $self->hidden_fields('subDisplay'), + $r->tag( + 'div', + class => 'text-center', + $r->submit_button( + $r->maketext('OK'), + name => 'decline_delete_course', + class => 'btn btn-primary' + ) + ) + )->join('') + ) + )->join(''); } } @@ -1857,198 +982,69 @@ sub archive_course_form { my $r = $self->r; my $ce = $r->ce; - print CGI::h2($r->maketext('Archive Course')); - - print CGI::p($r->maketext( - 'Creates a gzipped tar archive (.tar.gz) of a course in the WeBWorK courses directory. ' - . 'Before archiving, the course database is dumped into a subdirectory of the course\'s DATA directory. ' - . 'Currently the archive facility is only available for mysql databases. It depends on the mysqldump ' - . 'application.' - )); - my @courseIDs = listCourses($ce); - - unless (@courseIDs) { - print CGI::p($r->maketext('No courses found')); - return; - } - - my $archive_listing_format = $r->param('archive_listing_format') // 'alphabetically'; - - my $coursesDir = $ce->{webworkDirs}{courses}; - - # Get and store last modify time for login.log for all courses. Also get visibility status. my %courseLabels; - my @noLoginLogIDs; - my @loginLogIDs; - my ($loginLogFile, $epoch_modify_time, $courseDir); - for my $courseID (@courseIDs) { - $loginLogFile = "$coursesDir/$courseID/logs/login.log"; - if (-e $loginLogFile) { - # The login log file should always exist except for the model course. - $epoch_modify_time = stat($loginLogFile)->mtime; - $coursesData{$courseID}{'epoch_modify_time'} = $epoch_modify_time; - $coursesData{$courseID}{'local_modify_time'} = ctime($epoch_modify_time); - push(@loginLogIDs, $courseID); - } else { - # This is for the model course. - $coursesData{$courseID}{'local_modify_time'} = 'no login.log'; - push(@noLoginLogIDs, $courseID); - } - if (-f "$coursesDir/$courseID/hide_directory") { - $coursesData{$courseID}{'status'} = $r->maketext('hidden'); + if (@courseIDs) { + # Get and store last modify time for login.log for all courses. Also get visibility status. + my @noLoginLogIDs; + my @loginLogIDs; + + my ($loginLogFile, $epoch_modify_time, $courseDir, %coursesData); + for my $courseID (@courseIDs) { + $loginLogFile = "$ce->{webworkDirs}{courses}/$courseID/logs/login.log"; + if (-e $loginLogFile) { + # The login log file should always exist except for the model course. + $epoch_modify_time = stat($loginLogFile)->mtime; + $coursesData{$courseID}{epoch_modify_time} = $epoch_modify_time; + $coursesData{$courseID}{local_modify_time} = ctime($epoch_modify_time); + push(@loginLogIDs, $courseID); + } else { + # This is for the model course. + $coursesData{$courseID}{local_modify_time} = 'no login.log'; + push(@noLoginLogIDs, $courseID); + } + if (-f "$ce->{webworkDirs}{courses}/$courseID/hide_directory") { + $coursesData{$courseID}{status} = $r->maketext('hidden'); + } else { + $coursesData{$courseID}{status} = $r->maketext('visible'); + } + $courseLabels{$courseID} = + "$courseID ($coursesData{$courseID}{status} :: $coursesData{$courseID}{local_modify_time}) "; + } + if (($r->param('archive_listing_format') // 'alphabetically') eq 'last_login') { + # This should be an empty array except for the model course + @noLoginLogIDs = sort { lc($a) cmp lc($b) } @noLoginLogIDs; + @loginLogIDs = sort { $coursesData{$a}{epoch_modify_time} <=> $coursesData{$b}{epoch_modify_time} } + @loginLogIDs; # Oldest first + @courseIDs = (@noLoginLogIDs, @loginLogIDs); } else { - $coursesData{$courseID}{'status'} = $r->maketext('visible'); + # in this case we sort alphabetically + @courseIDs = sort { lc($a) cmp lc($b) } @courseIDs; } - $courseLabels{$courseID} = - "$courseID ($coursesData{$courseID}{'status'} :: $coursesData{$courseID}{'local_modify_time'}) "; } - if ($archive_listing_format eq 'last_login') { - # This should be an empty array except for the model course - @noLoginLogIDs = sort { lc($a) cmp lc($b) } @noLoginLogIDs; - @loginLogIDs = sort byLoginActivity @loginLogIDs; # oldest first - @courseIDs = (@noLoginLogIDs, @loginLogIDs); - } else { - # in this case we sort alphabetically - @courseIDs = sort { lc($a) cmp lc($b) } @courseIDs; - } - - print CGI::p($r->maketext( - 'Courses are listed either alphabetically or in order by the time of most recent login activity, oldest first. ' - . 'To change the listing order check the mode you want and click "Refresh Listing". ' - . 'The listing format is: Course_Name (status :: date/time of most recent login) where status is "hidden" ' - . 'or "visible".' - )); - - print CGI::start_form(-method => 'POST', -action => $r->uri); - - print CGI::div( - { class => 'mb-3' }, - CGI::div({ class => 'mb-2' }, $r->maketext('Select a listing format:')), - map { - CGI::div( - { class => 'form-check' }, - CGI::input({ - type => 'radio', - name => 'archive_listing_format', - id => "archive_listing_format_$_->[0]", - value => $_->[0], - class => 'form-check-input', - $_->[0] eq ($r->param('archive_listing_format') // 'alphabetically') ? (checked => undef) : () - }), - CGI::label( - { - for => "archive_listing_format_$_->[0]", - class => 'form-check-label' - }, - $_->[1] - ) - ) - } ( - [ alphabetically => $r->maketext('alphabetically') ], - [ last_login => $r->maketext('by last login date') ] - ), - ); - - print CGI::div( - { class => 'mb-2' }, - CGI::submit({ - name => 'archive_course_refresh', - value => $r->maketext('Refresh Listing'), - class => 'btn btn-primary' - }), - CGI::submit({ - name => 'archive_course', - value => $r->maketext('Archive Courses'), - class => 'btn btn-primary' - }) - ); - print $self->hidden_authen_fields; - print $self->hidden_fields('subDisplay'); - - print CGI::div({ class => 'mb-2' }, $r->maketext('Select course(s) to archive.')); - print CGI::div( - { class => 'row mb-2' }, - CGI::label( - { for => 'archive_courseIDs', class => 'col-auto col-form-label fw-bold' }, - $r->maketext('Course Name:') - ), - CGI::div( - { class => 'col-auto' }, - CGI::scrolling_list({ - name => 'archive_courseIDs', - id => 'archive_courseIDs', - values => \@courseIDs, - default => $r->param('archive_courseID') || '', - size => 15, - multiple => 1, - labels => \%courseLabels, - class => 'form-select' - }) - ) - ); - - print CGI::div( - { class => 'row align-items-center mb-2' }, - CGI::div({ class => 'col-auto fw-bold' }, $r->maketext('Delete course:')), - CGI::div( - { class => 'col-auto' }, - CGI::div( - { class => 'form-check mb-0' }, - CGI::checkbox({ - name => 'delete_course', - checked => 0, - value => 1, - label => $r->maketext('Delete course after archiving. Caution there is no undo!'), - class => 'form-check-input', - labelattributes => { class => 'form-check-label alert alert-danger py-0 px-1 mb-0' } - }) - ) - ) + return $r->include( + 'ContentGenerator/CourseAdmin/archive_course_form', + courseIDs => \@courseIDs, + courseLabels => \%courseLabels ); - - print CGI::div( - CGI::submit({ - name => 'archive_course_refresh', - value => $r->maketext('Refresh Listing'), - class => 'btn btn-primary' - }), - CGI::submit({ - name => 'archive_course', - value => $r->maketext('Archive Courses'), - class => 'btn btn-primary' - }) - ); - - print CGI::end_form(); } sub archive_course_validate { my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; - #my $db = $r->db; - #my $authz = $r->authz; - my $urlpath = $r->urlpath; + my $r = $self->r; - my @archive_courseIDs = $r->param("archive_courseIDs"); - @archive_courseIDs = () unless @archive_courseIDs; + my @archive_courseIDs = $r->param('archive_courseIDs'); my @errors; - foreach my $archive_courseID (@archive_courseIDs) { - if ($archive_courseID eq "") { - push @errors, $r->maketext("You must specify a course name."); - } elsif ($archive_courseID eq $urlpath->arg("courseID")) { - push @errors, $r->maketext("You cannot archive the course you are currently using."); + for my $archive_courseID (@archive_courseIDs) { + if ($archive_courseID eq '') { + push @errors, $r->maketext('You must specify a course name.'); + } elsif ($archive_courseID eq $r->urlpath->arg('courseID')) { + push @errors, $r->maketext('You cannot archive the course you are currently using.'); } } - #my $ce2 = new WeBWorK::CourseEnvironment({ - # %WeBWorK::SeedCE, - # courseName => $archive_courseID, - #}); - return @errors; } @@ -2056,274 +1052,57 @@ sub archive_course_confirm { my ($self) = @_; my $r = $self->r; my $ce = $r->ce; - #my $db = $r->db; - #my $authz = $r->authz; - #my $urlpath = $r->urlpath; - - print CGI::h2($r->maketext("Archive Course")); - my $delete_course_flag = $r->param("delete_course") || ""; + my @archive_courseIDs = $r->param('archive_courseIDs'); - my @archive_courseIDs = $r->param("archive_courseIDs"); - @archive_courseIDs = () unless @archive_courseIDs; - # if we are skipping a course remove one from - # the list of courses - if (defined $r->param("skip_archive_course")) { - shift @archive_courseIDs; - } + # If we are skipping a course remove one from the list of courses + shift @archive_courseIDs if defined $r->param('skip_archive_course'); my $archive_courseID = $archive_courseIDs[0]; - my $ce2 = new WeBWorK::CourseEnvironment({ - %WeBWorK::SeedCE, courseName => $archive_courseID, - }); + my $ce2 = WeBWorK::CourseEnvironment->new({ %WeBWorK::SeedCE, courseName => $archive_courseID }); - my ($tables_ok, $dbStatus); -############################################################################# - # Check database -############################################################################# - my %missing_fields; if ($ce2->{dbLayoutName}) { - my $CIchecker = new WeBWorK::Utils::CourseIntegrityCheck(ce => $ce2); - ($tables_ok, $dbStatus) = $CIchecker->checkCourseTables($archive_courseID); - if ($r->param("upgrade_course_tables")) { - my @schema_table_names = keys %$dbStatus; # update tables missing from database; + my $CIchecker = WeBWorK::Utils::CourseIntegrityCheck->new(ce => $ce2); + + # Check database + my ($tables_ok, $dbStatus) = $CIchecker->checkCourseTables($archive_courseID); + + # Upgrade the database if requested. + my @upgrade_report; + if ($r->param('upgrade_course_tables')) { + my @schema_table_names = keys %$dbStatus; my @tables_to_create = grep { $dbStatus->{$_}->[0] == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_A } @schema_table_names; my @tables_to_alter = grep { $dbStatus->{$_}->[0] == WeBWorK::Utils::CourseIntegrityCheck::DIFFER_IN_A_AND_B } @schema_table_names; - my $msg = $CIchecker->updateCourseTables($archive_courseID, [@tables_to_create]); - foreach my $table_name (@tables_to_alter) { - $msg .= $CIchecker->updateTableFields($archive_courseID, $table_name); - } - print CGI::p({ class => 'text-success fw-bold' }, $msg); - } - if ($r->param("upgrade_course_tables")) { - - $CIchecker->updateCourseDirectories(); # needs more error messages - } - ($tables_ok, $dbStatus) = $CIchecker->checkCourseTables($archive_courseID); - - # print db status - - my %msg = ( - WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_A => - CGI::span({ class => 'text-danger' }, $r->maketext("Table defined in schema but missing in database")), - WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_B => - CGI::span({ class => 'text-danger' }, $r->maketext("Table defined in database but missing in schema")), - WeBWorK::Utils::CourseIntegrityCheck::SAME_IN_A_AND_B => - CGI::span({ class => 'text-success' }, $r->maketext("Table is ok")), - WeBWorK::Utils::CourseIntegrityCheck::DIFFER_IN_A_AND_B => CGI::span( - { class => 'text-danger' }, - $r->maketext("Schema and database table definitions do not agree") - ), - ); - my %msg2 = ( - WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_A => - CGI::span({ class => 'text-danger' }, $r->maketext("Field missing in database")), - WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_B => - CGI::span({ class => 'text-danger' }, $r->maketext("Field missing in schema")), - WeBWorK::Utils::CourseIntegrityCheck::SAME_IN_A_AND_B => - CGI::span({ class => 'text-success' }, $r->maketext("Field is ok")), - WeBWorK::Utils::CourseIntegrityCheck::DIFFER_IN_A_AND_B => CGI::span( - { class => 'text-danger' }, - $r->maketext("Schema and database field definitions do not agree") - ), - ); - my $all_tables_ok = 1; - my $extra_database_tables = 0; - my $extra_database_fields = 0; - my $str = CGI::h4($r->maketext("Report on database structure for course [_1]:", $archive_courseID)) . CGI::br(); - foreach my $table (sort keys %$dbStatus) { - my $table_status = $dbStatus->{$table}->[0]; - $str .= CGI::b($table) . ": " . $msg{$table_status} . CGI::br(); - - CASE: { - $table_status == WeBWorK::Utils::CourseIntegrityCheck::SAME_IN_A_AND_B - && do { - last CASE; - }; - $table_status == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_A - && do { - $all_tables_ok = 0; - last CASE; - }; - $table_status == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_B - && do { - $extra_database_tables = 1; - last CASE; - }; - $table_status == WeBWorK::Utils::CourseIntegrityCheck::DIFFER_IN_A_AND_B - && do { - my %fieldInfo = %{ $dbStatus->{$table}->[1] }; - foreach my $key (keys %fieldInfo) { - my $field_status = $fieldInfo{$key}->[0]; - CASE2: { - $field_status == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_B - && do { - $extra_database_fields = 1; - last CASE2; - }; - $field_status == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_A - && do { - $all_tables_ok = 0; - last CASE2; - }; - } - $str .= CGI::br() . "\n  $key => " . $msg2{$field_status}; - } - }; + push(@upgrade_report, $CIchecker->updateCourseTables($archive_courseID, [@tables_to_create])); + for my $table_name (@tables_to_alter) { + push(@upgrade_report, $CIchecker->updateTableFields($archive_courseID, $table_name)); } - $str .= CGI::br(); - - } -############################################################################# - # Report on databases -############################################################################# - - print CGI::p($str); - if ($extra_database_tables) { - print CGI::p( - { class => 'text-danger fw-bold' }, - $r->maketext( - 'There are extra database tables which are not defined in the schema. ' - . 'These can be deleted when upgrading the course.' - ) - ); - } - if ($extra_database_fields) { - print CGI::p( - { class => 'text-danger fw-bold' }, - $r->maketext( - 'There are extra database fields which are not defined in the schema for at least one table. ' - . 'They can only be removed when upgrading the course.' - ) - ); - } - if ($all_tables_ok) { - print CGI::p({ class => 'text-success fw-bold' }, - $r->maketext("Course [_1] database is in order", $archive_courseID)); - print(CGI::p( - { class => 'text-danger fw-bold' }, - $r->maketext( - "Are you sure that you want to delete the course [_1] after archiving? This cannot be undone!", - CGI::b($archive_courseID) - ) - )) - if $delete_course_flag; - } else { - print CGI::p( - { class => 'text-danger fw-bold' }, - $r->maketext( - 'There are tables or fields missing from the database. ' - . 'The database must be upgraded before archiving this course.' - ) - ); - } -############################################################################# - # Check directories and report -############################################################################# - - my ($directories_ok, $str2) = $CIchecker->checkCourseDirectories($ce2); - print CGI::h2('Directory structure'), CGI::p($str2), - $directories_ok ? CGI::p({ class => 'text-success' }, $r->maketext('Directory structure is ok')) : CGI::p( - { class => 'text-danger' }, - $r->maketext( - 'Directory structure is missing directories or the webserver lacks sufficient privileges.') - ); -############################################################################# - # Print form for choosing next action. -############################################################################# - - print CGI::start_form(-method => "POST", -action => $r->uri); - print $self->hidden_authen_fields; - print $self->hidden_fields("subDisplay"); - print $self->hidden_fields(qw/delete_course/); - print CGI::hidden('archive_courseID', $archive_courseID); - print CGI::hidden('archive_courseIDs', @archive_courseIDs); - # grab some values we'll need - my $course_dir = $ce2->{courseDirs}{root}; - my $archive_path = $ce2->{webworkDirs}{courses} . "/$archive_courseID.tar.gz"; - # fail if the source course does not exist - unless (-e $course_dir) { - print CGI::p($r->maketext("[_1]: The directory for the course not found.", $archive_courseID)); + ($tables_ok, $dbStatus) = $CIchecker->checkCourseTables($archive_courseID); } - if ($all_tables_ok && $directories_ok) { # no missing fields - # Warn about overwriting an existing archive - if (-e $archive_path and -w $archive_path) { - print CGI::p( - { class => 'text-danger fw-bold' }, - $r->maketext( - "The course '[_1]' has already been archived at '[_2]'. " - . "This earlier archive will be erased. This cannot be undone.", - $archive_courseID, - $archive_path - ) - ); - } - # archive execute button - print CGI::p( - { style => "text-align: center" }, - CGI::submit({ - name => "decline_archive_course", - value => $r->maketext("Stop Archiving"), - class => 'btn btn-primary' - }), - " ", - scalar(@archive_courseIDs) > 1 - ? CGI::submit({ - name => "skip_archive_course", - value => $r->maketext("Skip archiving this course"), - class => 'btn btn-primary' - }) - . " " - : '', - CGI::submit({ - name => "confirm_archive_course", - value => $r->maketext("Archive"), - class => 'btn btn-primary' - }), - ); - } elsif ($directories_ok) { - print CGI::p( - { style => "text-align: center" }, - CGI::submit({ - name => "decline_archive_course", - -value => $r->maketext("Don't Archive"), - class => 'btn btn-primary' - }), - " ", - CGI::submit({ - name => "upgrade_course_tables", - value => $r->maketext("Upgrade Course Tables"), - class => 'btn btn-primary' - }) - ); - } else { - print CGI::p( - { style => "text-align: center" }, - CGI::br(), - $r->maketext("Directory structure needs to be repaired manually before archiving."), - CGI::br(), - CGI::submit({ - name => "decline_archive_course", - value => $r->maketext("Don't Archive"), - class => 'btn btn-primary' - }), - CGI::submit({ - name => "upgrade_course_tables", - value => $r->maketext("Attempt to upgrade directories"), - class => 'btn btn-primary' - }), - ); + # Update and check directories. + my $dir_update_messages = $r->param('upgrade_course_tables') ? $CIchecker->updateCourseDirectories : []; + my ($directories_ok, $directory_report) = $CIchecker->checkCourseDirectories($ce2); - } - print CGI::end_form(); + return $r->include( + 'ContentGenerator/CourseAdmin/archive_course_confirm', + ce2 => $ce2, + upgrade_report => \@upgrade_report, + tables_ok => $tables_ok, + dbStatus => $dbStatus, + dir_update_messages => $dir_update_messages, + directory_report => $directory_report, + directories_ok => $directories_ok, + archive_courseID => $archive_courseID, + archive_courseIDs => \@archive_courseIDs + ); } else { - print CGI::p({ class => 'text-danger fw-bold' }, "Unable to find database layout for $archive_courseID"); + return $r->tag('p', class => 'text-danger fw-bold', "Unable to find database layout for $archive_courseID"); } } @@ -2332,68 +1111,75 @@ sub do_archive_course { my $r = $self->r; my $ce = $r->ce; my $db = $r->db; - #my $authz = $r->authz; - #my $urlpath = $r->urlpath; - my $delete_course_flag = $r->param("delete_course") || ""; - my @archive_courseIDs = $r->param("archive_courseIDs"); - @archive_courseIDs = () unless @archive_courseIDs; - my $archive_courseID = $archive_courseIDs[0]; + my @archive_courseIDs = $r->param('archive_courseIDs'); + my $archive_courseID = $archive_courseIDs[0]; - my $ce2 = new WeBWorK::CourseEnvironment({ - %WeBWorK::SeedCE, courseName => $archive_courseID, - }); + my $ce2 = WeBWorK::CourseEnvironment->new({ %WeBWorK::SeedCE, courseName => $archive_courseID }); + + # Remove course specific temp files before archiving, but don't delete the temp directory itself. + remove_tree($ce2->{courseDirs}{html_temp}, { keep_root => 1 }); - # Remove course specific temp files before archiving - my $courseTempDir = $ce2->{courseDirs}{html_temp}; - remove_tree("$courseTempDir"); # Remove the original default tmp directory if it exists my $orgDefaultCourseTempDir = "$ce2->{courseDirs}{html}/tmp"; - if (-d "$orgDefaultCourseTempDir") { - remove_tree("$orgDefaultCourseTempDir"); + if (-d $orgDefaultCourseTempDir) { + remove_tree($orgDefaultCourseTempDir); } - # this is kinda left over from when we had 'gdbm' and 'sql' database layouts - # below this line, we would grab values from getopt and put them in this hash - # but for now the hash can remain empty - my %dbOptions; - - eval { archiveCourse(courseID => $archive_courseID, ce => $ce2, dbOptions => \%dbOptions,); }; + # dbOptions is left over from when we had 'gdbm' and 'sql' database layouts. For now the hash can remain empty. + my $message = eval { archiveCourse(courseID => $archive_courseID, ce => $ce2, dbOptions => {}); }; if ($@) { my $error = $@; - print CGI::div( - { class => 'alert alert-danger p-1 mb-2' }, - CGI::p($r->maketext("An error occured while archiving the course [_1]:", $archive_courseID)), - CGI::div({ class => 'font-monospace' }, CGI::escapeHTML($error)), + return $r->tag( + 'div', + class => 'alert alert-danger p-1 mb-2', + $r->c( + $r->tag('p', $r->maketext('An error occured while archiving the course [_1]:', $archive_courseID)), + $r->tag('div', class => 'font-monospace', $error) + )->join('') ); } else { - print CGI::div({ class => 'alert alert-success p-1 mb-2' }, - $r->maketext("Successfully archived the course [_1].", $archive_courseID)); - writeLog($ce, "hosted_courses", join("\t", "\tarchived", "", "", $archive_courseID,)); + my $output = $r->c; + push(@$output, $r->tag('div', class => 'alert alert-danger p-1 mb-2', $message)) if $message; + push( + @$output, + $r->tag( + 'div', + class => 'alert alert-success p-1 mb-2', + $r->maketext('Successfully archived the course [_1].', $archive_courseID) + ) + ); + writeLog($ce, 'hosted_courses', join("\t", "\tarchived", '', '', $archive_courseID,)); - if ($delete_course_flag) { - eval { deleteCourse(courseID => $archive_courseID, ce => $ce2, dbOptions => \%dbOptions,); }; + if ($r->param('delete_course')) { + eval { deleteCourse(courseID => $archive_courseID, ce => $ce2, dbOptions => {}); }; if ($@) { my $error = $@; - print CGI::div( - { class => 'alert alert-danger p-1 mb-2' }, - CGI::p($r->maketext("An error occured while deleting the course [_1]:", $archive_courseID)), - CGI::div({ class => 'font-monospace' }, CGI::escapeHTML($error)), + push( + @$output, + $r->tag( + 'div', + class => 'alert alert-danger p-1 mb-2', + $r->c( + $r->tag( + 'p', + $r->maketext('An error occured while deleting the course [_1]:', $archive_courseID) + ), + $r->tag('div', class => 'font-monospace', $error) + )->join('') + ) ); } else { - # mark the contact person in the admin course as dropped. - # find the contact person for the course by searching the admin classlist. - my @contacts = grep /_$archive_courseID$/, $db->listUsers; + # Mark the contact person in the admin course as dropped. + # Find the contact person for the course by searching the admin classlist. + my @contacts = grep {/_$archive_courseID$/} $db->listUsers; if (@contacts) { - die "Incorrect number of contacts for the course $archive_courseID" . join(" ", @contacts) + die "Incorrect number of contacts for the course $archive_courseID" . join(' ', @contacts) if @contacts != 1; - #warn "contacts", join(" ", @contacts); - #my $composite_id = "${add_initial_userID}_${add_courseID}"; my $composite_id = $contacts[0]; - # mark the contact person as dropped. my $User = $db->getUser($composite_id); my $status_name = 'Drop'; my $status_value = ($ce->status_name_to_abbrevs($status_name))[0]; @@ -2401,176 +1187,108 @@ sub do_archive_course { $db->putUser($User); } - print CGI::div( - { class => 'alert alert-success p-1 mb-2' }, - $r->maketext("Successfully deleted the course [_1].", $archive_courseID), + push( + @$output, + $r->tag( + 'div', + class => 'alert alert-success p-1 mb-2', + $r->maketext('Successfully deleted the course [_1].', $archive_courseID), + ) ); } } - shift @archive_courseIDs; # remove the course which has just been archived. + shift @archive_courseIDs; # Remove the course which has just been archived. if (@archive_courseIDs) { - print CGI::start_form(-method => "POST", -action => $r->uri); - print $self->hidden_authen_fields; - print $self->hidden_fields("subDisplay"); - print $self->hidden_fields(qw/delete_course/); - - print CGI::hidden('archive_courseIDs', @archive_courseIDs); - print CGI::p( - { style => "text-align: center" }, - CGI::submit({ - name => "decline_archive_course", - value => $r->maketext("Stop archiving courses"), - class => 'btn btn-primary' - }), - CGI::submit({ - name => "archive_course", - value => $r->maketext("Archive next course"), - class => 'btn btn-primary' - }) + push( + @$output, + $r->form_for( + $r->uri, + method => 'POST', + $r->c( + $self->hidden_authen_fields, + $self->hidden_fields(qw(subDisplay delete_course)), + (map { $r->hidden_field(archive_courseIDs => $_) } @archive_courseIDs), + $r->tag( + 'div', + class => 'd-flex justify-content-center gap-2', + $r->c( + $r->submit_button( + $r->maketext('Stop archiving courses'), + name => 'decline_archive_course', + class => 'btn btn-primary' + ), + $r->submit_button( + $r->maketext('Archive next course'), + name => 'archive_course', + class => 'btn btn-primary' + ) + )->join('') + ) + )->join('') + ) ); - print CGI::end_form(); } else { - print CGI::start_form(-method => "POST", -action => $r->uri); - print $self->hidden_authen_fields; - print $self->hidden_fields("subDisplay"); - print CGI::hidden('archive_courseIDs', $archive_courseID); - print CGI::p(CGI::submit({ - name => "decline_archive_course", - value => $r->maketext("OK"), - class => 'btn btn-primary' - })); - print CGI::end_form(); + push( + @$output, + $r->form_for( + $r->uri, + method => 'POST', + $r->c( + $self->hidden_authen_fields, + $self->hidden_fields('subDisplay'), + $r->hidden_field(archive_courseIDs => $archive_courseID), + $r->tag( + 'div', + class => 'd-flex justify-content-center gap-2', + $r->submit_button( + $r->maketext('OK'), + name => 'decline_archive_course', + class => 'btn btn-primary' + ) + ) + )->join('') + ) + ); } + + return $output->join(''); } } -########################################################################## - sub unarchive_course_form { my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; - - print CGI::h2($r->maketext('Unarchive Course')); - - print CGI::p($r->maketext( - 'Restores a course from a gzipped tar archive (.tar.gz). After unarchiving, the course database is ' - . "restored from a subdirectory of the course's DATA directory. Currently the archive facility is only " - . 'available for mysql databases. It depends on the mysqldump application.' - )); - - # First find courses which have been archived. - my @courseIDs = sort { lc($a) cmp lc($b) } listArchivedCourses($ce); # Make sort case insensitive - - unless (@courseIDs) { - print CGI::p($r->maketext('No course archives found.')); - return; - } - - my %courseLabels; - for my $courseID (@courseIDs) { - $courseLabels{$courseID} = $courseID; - } - - print CGI::start_form({ method => 'POST', action => $r->uri }); - print $self->hidden_authen_fields; - print $self->hidden_fields('subDisplay'); - - print CGI::div({ class => 'mb-2' }, $r->maketext('Select a course to unarchive.')); - - print CGI::div( - { class => 'col-lg-7 col-md-8' }, - CGI::div( - { class => 'row mb-2' }, - CGI::label( - { for => 'unarchive_courseID', class => 'col-sm-4 col-form-label' }, - $r->maketext('Course Name:') - ), - CGI::div( - { class => 'col-sm-8' }, - CGI::scrolling_list({ - name => 'unarchive_courseID', - id => 'unarchive_courseID', - values => \@courseIDs, - default => $r->param('unarchive_courseID') || '', - size => 10, - multiple => 0, - labels => \%courseLabels, - class => 'form-select' - }) - ) - ), - CGI::div( - { class => 'row mb-2 align-items-center' }, - CGI::div( - { class => 'col-sm-4' }, - CGI::div( - { class => 'form-check' }, - CGI::checkbox({ - name => 'create_newCourseID', - value => 1, - label => $r->maketext('New Name:'), - class => 'form-check-input', - labelattributes => { class => 'form-check-label', id => 'create_newCourseID_label' } - }) - ) - ), - CGI::div( - { class => 'col-sm-8' }, - CGI::textfield({ - name => 'new_courseID', - value => '', - size => 25, - maxlength => $ce->{maxCourseIdLength}, - class => 'form-control', - aria_labelledby => 'create_newCourseID_label' - }) - ) - ) - ); - - print CGI::div(CGI::submit({ - name => 'unarchive_course', - value => $r->maketext('Unarchive Course'), - class => 'btn btn-primary' - })); - - print CGI::end_form(); + return $self->r->include('ContentGenerator/CourseAdmin/unarchive_course_form'); } sub unarchive_course_validate { - my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; - #my $db = $r->db; - #my $authz = $r->authz; + my ($self) = @_; + my $r = $self->r; + my $ce = $r->ce; my $urlpath = $r->urlpath; - my $unarchive_courseID = $r->param("unarchive_courseID") || ""; - my $create_newCourseID = $r->param("create_newCourseID") || ""; - my $new_courseID = $r->param("new_courseID") || ""; - my @errors; - #by default we use the archive name for the course - my $courseID = $unarchive_courseID; - $courseID =~ s/\.tar\.gz$//; + my $unarchive_courseID = $r->param('unarchive_courseID') || ''; + my $new_courseID = $r->param('new_courseID') || ''; + + # Use the archive name for the course unless a course id was provided. + my $courseID = ($r->param('create_newCourseID') ? $new_courseID : $unarchive_courseID) =~ s/\.tar\.gz$//r; - if ($create_newCourseID) { - $courseID = $new_courseID; - } debug(" unarchive_courseID $unarchive_courseID new_courseID $new_courseID "); - if ($courseID eq "") { - push @errors, $r->maketext("You must specify a course name."); - } elsif (-d $ce->{webworkDirs}->{courses} . "/$courseID") { - #Check that a directory for this course doesn't already exist + my @errors; + + if ($courseID eq '') { + push @errors, $r->maketext('You must specify a course name.'); + } elsif (-d "$ce->{webworkDirs}->{courses}/$courseID") { + # Check that a directory for this course doesn't already exist. push @errors, $r->maketext( - "A directory already exists with the name [_1]. You must first delete this existing course before you can unarchive.", + 'A directory already exists with the name [_1]. ' + . 'You must first delete this existing course before you can unarchive.', $courseID ); } elsif (length($courseID) > $ce->{maxCourseIdLength}) { - push @errors, $r->maketext("Course ID cannot exceed [_1] characters.", $ce->{maxCourseIdLength}); + push @errors, $r->maketext('Course ID cannot exceed [_1] characters.', $ce->{maxCourseIdLength}); } return @errors; @@ -2580,207 +1298,110 @@ sub unarchive_course_confirm { my ($self) = @_; my $r = $self->r; my $ce = $r->ce; - #my $db = $r->db; - #my $authz = $r->authz; - #my $urlpath = $r->urlpath; - - print CGI::h2($r->maketext("Unarchive Course")); - my $unarchive_courseID = $r->param("unarchive_courseID") || ""; - my $create_newCourseID = $r->param("create_newCourseID") || ""; - my $new_courseID = $r->param("new_courseID") || ""; + my $unarchive_courseID = $r->param('unarchive_courseID') || ''; + my $new_courseID = $r->param('new_courseID') || ''; - my $courseID = $unarchive_courseID; - $courseID =~ s/\.tar\.gz$//; - - if ($create_newCourseID) { - $courseID = $new_courseID; - } + my $courseID = ($r->param('create_newCourseID') ? $new_courseID : $unarchive_courseID) =~ s/\.tar\.gz//r; debug(" unarchive_courseID $unarchive_courseID new_courseID $new_courseID "); - print CGI::start_form(-method => "POST", -action => $r->uri); - print CGI::p( - $r->maketext("Unarchive [_1] to course:", $unarchive_courseID), - CGI::input({ -name => 'new_courseID', -value => $courseID }) + return $self->r->include( + 'ContentGenerator/CourseAdmin/unarchive_course_confirm', + unarchive_courseID => $unarchive_courseID, + courseID => $courseID ); - - print $self->hidden_authen_fields; - print $self->hidden_fields("subDisplay"); - print $self->hidden_fields(qw/unarchive_courseID create_newCourseID/); - - print CGI::p( - { style => "text-align: center" }, - CGI::submit({ - name => "decline_unarchive_course", - value => $r->maketext("Don't Unarchive"), - class => 'btn btn-primary' - }), - " ", - CGI::submit({ - name => "confirm_unarchive_course", - value => $r->maketext("Unarchive"), - class => 'btn btn-primary' - }), - ); - - print CGI::end_form(); } sub do_unarchive_course { my ($self) = @_; my $r = $self->r; my $ce = $r->ce; - #my $db = $r->db; - #my $authz = $r->authz; - my $urlpath = $r->urlpath; - my $new_courseID = $r->param("new_courseID") || ""; - my $unarchive_courseID = $r->param("unarchive_courseID") || ""; - my $old_courseID = $unarchive_courseID; - $old_courseID =~ s/.tar.gz//; + my $new_courseID = $r->param('new_courseID'); + + return $r->tag('div', class => 'alert alert-danger p-1 mb-2', $r->maketext('You must specify a course name.')) + unless $new_courseID; + + my $unarchive_courseID = $r->param('unarchive_courseID') || ''; - #eval { unarchiveCourse( newCourseID => $new_courseID, - oldCourseID => $old_courseID, - archivePath => $ce->{webworkDirs}->{courses} . "/$unarchive_courseID", + oldCourseID => $unarchive_courseID =~ s/\.tar\.gz$//r, + archivePath => "$ce->{webworkDirs}{courses}/$unarchive_courseID", ce => $ce, ); - #}; if ($@) { my $error = $@; - print CGI::div( - { class => 'alert alert-danger p-1 mb-2' }, - CGI::p($r->maketext("An error occured while archiving the course [_1]:", $unarchive_courseID)), - CGI::div({ class => 'font-monospace' }, CGI::escapeHTML($error)), + return $r->tag( + 'div', + class => 'alert alert-danger p-1 mb-2', + $r->c( + $r->tag( + 'p', $r->maketext('An error occured while archiving the course [_1]:', $unarchive_courseID) + ), + $r->tag('div', class => 'font-monospace', $error) + )->join('') ); } else { - print CGI::div( - { class => 'alert alert-success p-1 mb-2' }, - $r->maketext("Successfully unarchived [_1] to the course [_2]", $unarchive_courseID, $new_courseID), - ); - writeLog($ce, "hosted_courses", join("\t", "\tunarchived", "", "", "$unarchive_courseID to $new_courseID",)); - - my $newCoursePath = - $urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets", $r, courseID => $new_courseID); - my $newCourseURL = $self->systemLink($newCoursePath, authen => 0); - print CGI::div( - { style => "text-align: center" }, - CGI::a({ href => $newCourseURL }, $r->maketext("Log into [_1]", $new_courseID)), - ); + writeLog($ce, 'hosted_courses', join("\t", "\tunarchived", '', '', "$unarchive_courseID to $new_courseID",)); - print CGI::start_form(-method => "POST", -action => $r->uri); - print $self->hidden_authen_fields; - print $self->hidden_fields("subDisplay"); - print CGI::hidden("unarchive_courseID", $unarchive_courseID); - print CGI::p(CGI::submit({ - name => "decline_unarchive_course", - value => $r->maketext("Unarchive Next Course"), - class => 'btn btn-primary' - })); - print CGI::end_form(); + return $r->c( + $r->tag( + 'div', + class => 'alert alert-success p-1 mb-2', + $r->maketext('Successfully unarchived [_1] to the course [_2]', $unarchive_courseID, $new_courseID), + ), + $r->tag( + 'div', + class => 'text-center', + $r->link_to( + $r->maketext('Log into [_1]', $new_courseID) => $self->systemLink( + $r->urlpath->newFromModule( + 'WeBWorK::ContentGenerator::ProblemSets', + $r, courseID => $new_courseID + ), + authen => 0 + ) + ), + ), + $r->form_for( + $r->uri, + method => 'POST', + $r->c( + $self->hidden_authen_fields, + $self->hidden_fields('subDisplay'), + $r->hidden_field(unarchive_courseID => $unarchive_courseID), + $r->tag( + 'div', + class => 'd-flex justify-content-center mt-2', + $r->submit_button( + $r->maketext('Unarchive Next Course'), + name => 'decline_unarchive_course', + class => 'btn btn-primary' + ) + ) + )->join('') + ) + )->join(''); } } -########################################################################## # Course upgrade methods sub upgrade_course_form { my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; - - my @courseIDs = listCourses($ce); - @courseIDs = sort { lc($a) cmp lc($b) } @courseIDs; # make sort case insensitive - - print CGI::h2($r->maketext('Upgrade Courses')); - - print CGI::div({ class => 'mb-2' }, $r->maketext('Update the checked directories?')); - - print CGI::start_form({ method => 'POST', action => $r->uri, id => 'courselist', name => 'courselist' }); - - print CGI::div( - { class => 'mb-2' }, - CGI::input({ - type => 'button', - value => $r->maketext('Select all eligible courses'), - class => 'select-all btn btn-sm btn-secondary', - data_select_group => 'upgrade_courseIDs' - }), - CGI::input({ - type => 'button', - value => $r->maketext('Unselect all courses'), - class => 'select-none btn btn-sm btn-secondary', - data_select_group => 'upgrade_courseIDs' - }) - ); - - print $self->hidden_authen_fields; - print $self->hidden_fields('subDisplay'); - - print CGI::start_ul(); - foreach my $courseID (@courseIDs) { - next if $courseID eq 'modelCourse'; # modelCourse isn't a real course so don't create missing directories, etc - next unless $courseID =~ /\S/; # skip empty courseIDs (there shouldn't be any) - my $urlpath = $r->urlpath->newFromModule('WeBWorK::ContentGenerator::ProblemSets', $r, courseID => $courseID); - my $tempCE; - eval { $tempCE = new WeBWorK::CourseEnvironment({ %WeBWorK::SeedCE, courseName => $courseID, }) }; - print $r->maketext("Can't create course environment for [_1] because [_2]", $courseID, $@) if $@; - my $CIchecker = new WeBWorK::Utils::CourseIntegrityCheck(ce => $tempCE); - $CIchecker->updateCourseDirectories(); #creates missing html_temp, mailmerge tmpEditFileDir directories; - my ($tables_ok, $dbStatus) = $CIchecker->checkCourseTables($courseID); - my ($directories_ok, $str2) = $CIchecker->checkCourseDirectories(); - my $checked = ($tables_ok && $directories_ok) ? 0 : 1; # don't check if everything is ok - - print CGI::li( - { class => 'align-items-center' }, - # Only show the checkbox if the course is not up to date. - $checked ? CGI::div( - { class => 'form-check form-check-inline me-1' }, - CGI::checkbox({ - name => 'upgrade_courseIDs', - label => $r->maketext('Upgrade'), - selected => $checked, - value => $courseID, - class => 'form-check-input', - labelattributes => { class => 'form-check-label' } - }) - ) : '', - CGI::a({ href => $self->systemLink($urlpath, authen => 0) }, $courseID), - CGI::code($tempCE->{dbLayoutName},), - $directories_ok ? '' : CGI::span( - { class => 'alert alert-danger p-1 mb-0' }, - $r->maketext('Directory structure or permissions need to be repaired. ') - ), - $tables_ok - ? CGI::span({ class => 'text-success' }, $r->maketext('Database tables ok')) - : CGI::span({ class => 'text-danger' }, $r->maketext('Database tables need updating.')), - ); - } - print CGI::end_ul(); - - print CGI::div(CGI::submit({ - name => 'upgrade_course', - value => $r->maketext('Upgrade Courses'), - class => 'btn btn-primary' - })); - - print CGI::end_form(); + return $self->r->include('ContentGenerator/CourseAdmin/upgrade_course_form'); } sub upgrade_course_validate { my $self = shift; my $r = $self->r; - my @upgrade_courseIDs = ($r->param("upgrade_courseIDs")); - my @errors; - for my $upgrade_courseID (@upgrade_courseIDs) { - if ($upgrade_courseID eq '') { - push @errors, $r->maketext('You must specify a course name.'); - } + for ($r->param('upgrade_courseIDs')) { + push @errors, $r->maketext('You must specify a course name.') if ($_ eq ''); } return @errors; @@ -2792,159 +1413,139 @@ sub upgrade_course_confirm { my $ce = $r->ce; my $db = $r->db; - my @upgrade_courseIDs = ($r->param("upgrade_courseIDs")); + my @upgrade_courseIDs = $r->param('upgrade_courseIDs'); my ($extra_database_tables_exist, $extra_database_fields_exist) = (0, 0); - print CGI::start_form({ method => 'POST', action => $r->uri }); + my $status_output = $r->c; - my $output = ''; for my $upgrade_courseID (@upgrade_courseIDs) { next unless $upgrade_courseID =~ /\S/; # skip empty values # Analyze one course - my $ce2 = new WeBWorK::CourseEnvironment({ %WeBWorK::SeedCE, courseName => $upgrade_courseID }); + my $ce2 = WeBWorK::CourseEnvironment->new({ %WeBWorK::SeedCE, courseName => $upgrade_courseID }); # Create integrity checker - my $CIchecker = new WeBWorK::Utils::CourseIntegrityCheck(ce => $ce2); + my $CIchecker = WeBWorK::Utils::CourseIntegrityCheck->new(ce => $ce2); # Report on database status my ($tables_ok, $dbStatus) = $CIchecker->checkCourseTables($upgrade_courseID); - my ($all_tables_ok, $extra_database_tables, $extra_database_fields, $str) = + my ($all_tables_ok, $extra_database_tables, $extra_database_fields, $db_report) = $self->formatReportOnDatabaseTables($tables_ok, $dbStatus, $upgrade_courseID); - $output .= CGI::start_div({ class => 'border border-dark rounded p-2 mb-2' }); - - # Add the report on databases to the output. - $output .= CGI::div( - { class => 'form-check mb-2' }, - CGI::checkbox({ - name => 'upgrade_courseIDs', - label => $r->maketext('Upgrade [_1]', $upgrade_courseID), - selected => 1, - value => $upgrade_courseID, - class => 'form-check-input', - labelattributes => { class => 'form-check-label' } - }) + my $course_output = $r->c; + + # Add the report on course database to the output. + push( + @$course_output, + $r->tag( + 'div', + class => 'form-check mb-2', + $r->tag( + 'label', + class => 'form-check-label', + $r->c( + $r->check_box( + upgrade_courseIDs => $upgrade_courseID, + checked => undef, + class => 'form-check-input', + ), + $r->maketext('Upgrade [_1]', $upgrade_courseID) + )->join('') + ) + ) ); - $output .= CGI::h2($r->maketext('Report for course [_1]:', $upgrade_courseID)); - $output .= CGI::div({ class => 'mb-2' }, $r->maketext('Database:')); - $output .= $str; + push(@$course_output, $r->tag('h2', $r->maketext('Report for course [_1]:', $upgrade_courseID))); + push(@$course_output, $r->tag('div', class => 'mb-2', $r->maketext('Database:'))); + push(@$course_output, $db_report); if ($extra_database_tables) { $extra_database_tables_exist = 1; - $output .= CGI::p( - { class => 'text-danger fw-bold' }, - $r->maketext('There are extra database tables which are not defined in the schema. ') - . 'Check the checkbox by the table to delete it when upgrading the course. ' - . 'Warning: Deletion destroys all data contained in the table and is not undoable!' + push( + @$course_output, + $r->tag( + 'p', + class => 'text-danger fw-bold', + $r->maketext('There are extra database tables which are not defined in the schema. ') + . 'Check the checkbox by the table to delete it when upgrading the course. ' + . 'Warning: Deletion destroys all data contained in the table and is not undoable!' + ) ); } if ($extra_database_fields) { $extra_database_fields_exist = 1; - $output .= CGI::p( - { class => 'text-danger fw-bold' }, - $r->maketext( - 'There are extra database fields which are not defined in the schema for at least one table. ' - . 'Check the checkbox by the field to delete it when upgrading the course. ' - . 'Warning: Deletion destroys all data contained in the field and is not undoable!' + push( + @$course_output, + $r->tag( + 'p', + class => 'text-danger fw-bold', + $r->maketext( + 'There are extra database fields which are not defined in the schema for at least one table. ' + . 'Check the checkbox by the field to delete it when upgrading the course. ' + . 'Warning: Deletion destroys all data contained in the field and is not undoable!' + ) ) ); } # Report on directory status - my ($directories_ok, $str2) = $CIchecker->checkCourseDirectories(); - $output .= CGI::div({ class => 'mb-2' }, $r->maketext('Directory structure:')); - $output .= $str2; - $output .= + my ($directories_ok, $directory_report) = $CIchecker->checkCourseDirectories; + push(@$course_output, $r->tag('div', class => 'mb-2', $r->maketext('Directory structure:'))); + push( + @$course_output, + $r->tag( + 'ul', + $r->c( + map { + $r->tag( + 'li', + $r->c("$_->[0]: ", + $r->tag('span', class => $_->[2] ? 'text-success' : 'text-danger', $_->[1])) + ->join('') + ) + } @$directory_report + )->join('') + ) + ); + push( + @$course_output, $directories_ok - ? CGI::p({ class => 'text-success mb-0' }, $r->maketext('Directory structure is ok')) - : CGI::p( - { class => 'text-danger mb-0' }, + ? $r->tag('p', class => 'text-success mb-0', $r->maketext('Directory structure is ok')) + : $r->tag( + 'p', + class => 'text-danger mb-0', $r->maketext( 'Directory structure is missing directories or the webserver lacks sufficient privileges.') - ); - - $output .= CGI::end_div(); - } - - my $checkAlls = ''; - - if ($extra_database_tables_exist) { - $checkAlls .= CGI::div( - { class => 'form-check' }, - CGI::checkbox({ - label => $r->maketext('Select/unselect all tables missing in schema for deletion.'), - class => 'select-all form-check-input', - labelattributes => { class => 'form-check-label' }, - data_select_group => 'delete_tableIDs', - }) + ) ); - } - if ($extra_database_fields_exist) { - $checkAlls .= CGI::div( - { class => 'form-check' }, - CGI::checkbox({ - label => $r->maketext('Select/unselect all fields missing in schema for deletion.'), - class => 'select-all form-check-input', - labelattributes => { class => 'form-check-label' }, - data_select_group => 'delete_fieldIDs' - }) - ); + push(@$status_output, $r->tag('div', class => 'border border-dark rounded p-2 mb-2', $course_output->join(''))); } - print CGI::div({ class => 'mb-3' }, $checkAlls); - - print $output; - - # Print form for choosing next action. - print CGI::h3($r->maketext('No course id defined')) unless @upgrade_courseIDs; - - print $self->hidden_authen_fields; - print $self->hidden_fields('subDisplay'); - - print CGI::div({ class => 'mb-3' }, $checkAlls); - - # Submit buttons - # After presenting a detailed summary of status of selected courses the choice is made to upgrade the selected - # courses (confirm_upgrade_course is set or return to the beginning (decline_upgrade_course is set) - print CGI::div( - { class => 'submit-buttons-container' }, - CGI::submit({ - name => 'decline_upgrade_course', - value => $r->maketext("Don't Upgrade"), - class => 'btn btn-primary' - }), - CGI::submit({ - name => 'confirm_upgrade_course', - value => $r->maketext('Upgrade'), - class => 'btn btn-primary' - }) + return $r->include( + 'ContentGenerator/CourseAdmin/upgrade_course_confirm', + upgrade_courseIDs => \@upgrade_courseIDs, + extra_database_tables_exist => $extra_database_tables_exist, + extra_database_fields_exist => $extra_database_fields_exist, + status_output => $status_output->join('') ); - - print CGI::end_form(); } sub do_upgrade_course { my $self = shift; my $r = $self->r; - my $ce = $r->ce; - my $db = $r->db; - - my @upgrade_courseIDs = ($r->param("upgrade_courseIDs")); - my %update_error_msg; + my $output = $r->c; - for my $upgrade_courseID (@upgrade_courseIDs) { + for my $upgrade_courseID ($r->param('upgrade_courseIDs')) { next unless $upgrade_courseID =~ /\S/; # Omit blank course IDs # Update one course - my $ce2 = new WeBWorK::CourseEnvironment({ %WeBWorK::SeedCE, courseName => $upgrade_courseID }); + my $ce2 = WeBWorK::CourseEnvironment->new({ %WeBWorK::SeedCE, courseName => $upgrade_courseID }); # Create integrity checker - my $CIchecker = new WeBWorK::Utils::CourseIntegrityCheck(ce => $ce2); + my $CIchecker = WeBWorK::Utils::CourseIntegrityCheck->new(ce => $ce2); # Add missing tables and missing fields to existing tables my ($tables_ok, $dbStatus) = $CIchecker->checkCourseTables($upgrade_courseID); @@ -2953,299 +1554,154 @@ sub do_upgrade_course { grep { $dbStatus->{$_}[0] == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_A } @schema_table_names; my @tables_to_alter = grep { $dbStatus->{$_}[0] == WeBWorK::Utils::CourseIntegrityCheck::DIFFER_IN_A_AND_B } @schema_table_names; - $update_error_msg{$upgrade_courseID} = $CIchecker->updateCourseTables($upgrade_courseID, [@tables_to_create], - [ ($r->param("$upgrade_courseID.delete_tableIDs")) ]); + + my @upgrade_report; + push( + @upgrade_report, + $CIchecker->updateCourseTables( + $upgrade_courseID, [@tables_to_create], [ ($r->param("$upgrade_courseID.delete_tableIDs")) ] + ) + ); for my $table_name (@tables_to_alter) { - $update_error_msg{$upgrade_courseID} .= $CIchecker->updateTableFields($upgrade_courseID, $table_name, - [ ($r->param("$upgrade_courseID.$table_name.delete_fieldIDs")) ]); + push( + @upgrade_report, + $CIchecker->updateTableFields( + $upgrade_courseID, $table_name, + [ ($r->param("$upgrade_courseID.$table_name.delete_fieldIDs")) ] + ) + ); } - # Add missing directories when it can be done safely - $CIchecker->updateCourseDirectories(); # Needs more error messages - # Analyze database status and prepare status report ($tables_ok, $dbStatus) = $CIchecker->checkCourseTables($upgrade_courseID); - my ($all_tables_ok, $extra_database_tables, $extra_database_fields, $str) = + my ($all_tables_ok, $extra_database_tables, $extra_database_fields, $db_report) = $self->formatReportOnDatabaseTables($tables_ok, $dbStatus); # Prepend course name - $str = CGI::div({ class => 'mb-2' }, $r->maketext('Database:')) . $str; + $db_report = $r->c($r->tag('div', class => 'mb-2', $r->maketext('Database:')), $db_report); # Report on databases and report summary if ($extra_database_tables) { - $str .= CGI::p({ class => 'text-danger fw-bold' }, - $r->maketext('There are extra database tables which are not defined in the schema.')); + push( + @$db_report, + $r->tag( + 'p', + class => 'text-danger fw-bold', + $r->maketext('There are extra database tables which are not defined in the schema.') + ) + ); } if ($extra_database_fields) { - $str .= CGI::p( - { class => 'text-danger fw-bold' }, - $r->maketext( - 'There are extra database fields which are not defined in the schema for at least one table.') + push( + @$db_report, + $r->tag( + 'p', + class => 'text-danger fw-bold', + $r->maketext( + 'There are extra database fields which are not defined in the schema for at least one table.') + ) ); } - # Prepare report on directory status - my ($directories_ok, $str2) = $CIchecker->checkCourseDirectories(); - my $dir_msg = join( - '', - CGI::div({ class => 'mb-2' }, $r->maketext('Directory structure:')), - $str2, + # Add missing directories and prepare report on directory status + my $dir_update_messages = $CIchecker->updateCourseDirectories; # Needs more error messages + my ($directories_ok, $directory_report) = $CIchecker->checkCourseDirectories; + + # Show status + my $course_report = $r->c; + push(@$course_report, $r->tag('h2', $r->maketext('Report for course [_1]:', $upgrade_courseID))); + push(@$course_report, + map { $r->tag('p', class => ($_->[1] ? 'text-success' : 'text-danger my-0') . ' fw-bold', $_->[0]) } + @upgrade_report); + + push(@$course_report, @$db_report); + + # Show report on directory status + push( + @$course_report, + $r->tag('div', class => 'mb-2', $r->maketext('Directory structure:')), + $r->tag( + 'ul', + $r->c( + map { + $r->tag( + 'li', + $r->c("$_->[0]: ", + $r->tag('span', class => $_->[2] ? 'text-success' : 'text-danger', $_->[1])) + ->join('') + ) + } @$directory_report + )->join('') + ), + $r->tag( + 'ul', + $r->c( + map { + $r->tag( + 'li', + $r->tag( + 'span', + class => $_->[2] ? 'text-success' : 'text-danger', + $_->[1] + ) + ) + } @$dir_update_messages + )->join('') + ), $directories_ok - ? CGI::p({ class => 'text-success mb-0' }, $r->maketext('Directory structure is ok')) - : CGI::p( - { class => 'text-danger mb-0' }, + ? $r->tag('p', class => 'text-success mb-0', $r->maketext('Directory structure is ok')) + : $r->tag( + 'p', + class => 'text-danger mb-0', $r->maketext( 'Directory structure is missing directories or the webserver lacks sufficient privileges.') ) ); - - # Print status - print CGI::start_div({ class => 'border border-dark rounded p-2 mb-2' }); - print CGI::h2($r->maketext('Report for course [_1]:', $upgrade_courseID)); - print CGI::p({ class => 'text-success fw-bold' }, $update_error_msg{$upgrade_courseID}) - if $update_error_msg{$upgrade_courseID}; - - print $str; # Print message about tables - print $dir_msg; # Print message about directories - print CGI::end_div(); + push(@$output, $r->tag('div', class => 'border border-dark rounded p-2 mb-2', $course_report->join(''))); } # Submit buttons -- return to beginning - print CGI::h2($r->maketext('Upgrade process completed')); - print CGI::start_form({ method => 'POST', action => $r->uri }); # send back to this script - print $self->hidden_authen_fields; - print $self->hidden_fields('subDisplay'); - print CGI::p( - { class => 'text-center' }, - CGI::submit({ - name => 'decline_upgrade_course', - value => $r->maketext('Done'), - class => 'btn btn-primary' - }) - ); - print CGI::end_form(); -} - -################################################################################ -## location management routines; added by DG [Danny Ginn] 20070215 -## revised by glarose - -sub manage_location_form { - my ($self) = @_; - my $r = $self->r; - my $db = $r->db; - - # Get a list of all existing locations - my @locations = sort { lc($a->location_id) cmp lc($b->location_id) } $db->getAllLocations(); - my %locAddr = map { $_->location_id => [ $db->listLocationAddresses($_->location_id) ] } @locations; - - my @locationIDs = map { $_->location_id } @locations; - - print CGI::h2($r->maketext('Manage Locations')); - - print CGI::p(CGI::strong($r->maketext('Currently defined locations are listed below.'))); - - print CGI::start_form(-method => 'POST', -action => $r->uri); - print $self->hidden_authen_fields; - print $self->hidden_fields('subDisplay'); - - # Get a list of radio buttons to select an action - my @actionRadios = CGI::radio_group({ - name => 'manage_location_action', - values => [ 'edit_location_form', 'add_location_handler', 'delete_location_handler' ], - labels => { - edit_location_form => $r->maketext('Edit Location:'), - add_location_handler => $r->maketext('Create Location:'), - delete_location_handler => $r->maketext('Delete location:'), - }, - default => $r->param('manage_location_action') ? $r->param('manage_location_action') : 'none', - class => 'form-check-input', - labelattributes => { class => 'form-check-label' } - }); - - print CGI::start_div({ class => 'col-lg-8 col-md-9' }); - print CGI::div({ class => 'mb-2 fw-bold' }, $r->maketext('Select an action to perform:')); - - # Edit action - print CGI::div( - { class => 'row align-items-center mb-2' }, - CGI::div({ class => 'col-sm-4' }, CGI::div({ class => 'form-check' }, $actionRadios[0])), - CGI::div( - { class => 'col-sm-8' }, - CGI::popup_menu({ - name => 'edit_location', - values => [@locationIDs], - class => 'form-select' - }) - ) - ); - - # Create action - print CGI::div( - { class => 'row align-items-center mb-2' }, - CGI::div({ class => 'col-auto' }, CGI::div({ class => 'form-check' }, $actionRadios[1])), - ); - - print CGI::div( - { class => 'row ms-sm-3 mb-2' }, - CGI::label( - { for => 'new_location_name', class => 'col-sm-4 col-form-label' }, - $r->maketext('Location name:') - ), - CGI::div( - { class => 'col-sm-8' }, - CGI::textfield({ - name => 'new_location_name', - id => 'new_location_name', - value => $r->param('new_location_name') // '', - class => 'form-control' - }) - ) - ); - - print CGI::div( - { class => 'row ms-sm-3 mb-2' }, - CGI::label( - { for => 'new_location_description', class => 'col-sm-4 col-form-label' }, - $r->maketext('Location description:') - ), - CGI::div( - { class => 'col-sm-8' }, - CGI::textfield({ - name => 'new_location_description', - id => 'new_location_description', - value => $r->param('new_location_description') // '', - class => 'form-control' - }) - ) - ); - - print CGI::div( - { class => 'row ms-sm-3 mb-2' }, - CGI::div( - { class => 'col' }, - CGI::label( - { for => 'new_location_addresses' }, - $r->maketext( - 'Addresses for new location. Enter one per line, as single IP addresses (e.g., 192.168.1.101), ' - . 'address masks (e.g., 192.168.1.0/24), or IP ranges (e.g., 192.168.1.101-192.168.1.150):' - ) - ) - ) - ); - - print CGI::div( - { class => 'row ms-sm-3 mb-2' }, - CGI::div( - { class => 'col-auto' }, - CGI::textarea({ - name => 'new_location_addresses', - id => 'new_location_addresses', - columns => 28, - value => $r->param('new_location_addresses') ? $r->param('new_location_addresses') : '', - class => 'form-control' - }) - ) - ); - - # Delete action - print CGI::div( - { class => 'row mb-2' }, - CGI::div( - { class => 'text-danger' }, - CGI::em($r->maketext('Deletion deletes all location data and related addresses, and is not undoable!')) - ) - ); - - print CGI::div( - { class => 'row align-items-center mb-2' }, - CGI::div({ class => 'col-sm-4' }, CGI::div({ class => 'form-check' }, $actionRadios[2])), - CGI::div( - { class => 'col-sm-8' }, - CGI::div( - { class => 'row mb-1' }, - CGI::div( - { class => 'col-auto' }, - CGI::popup_menu({ - name => 'delete_location', - values => [ '', 'selected_locations', @locationIDs ], - labels => { - selected_locations => $r->maketext('locations selected below'), - '' => $r->maketext('no location') - }, - class => 'form-select' - }) - ) - ), - CGI::div( - { class => 'row' }, - CGI::div( - { class => 'col-auto' }, - CGI::div( - { class => 'form-check' }, - CGI::checkbox({ - name => 'delete_confirm', - value => 'true', - label => $r->maketext('Confirm'), - class => 'form-check-input', - labelattributes => { class => 'form-check-label' } - - }) + push(@$output, $r->tag('h2', $r->maketext('Upgrade process completed'))); + push( + @$output, + $r->form_for( + $r->uri, + method => 'POST', + $r->c( + $self->hidden_authen_fields, + $self->hidden_fields('subDisplay'), + $r->tag( + 'p', + class => 'text-center', + $r->submit_button( + $r->maketext('Done'), + name => 'decline_upgrade_course', + class => 'btn btn-primary' ) ) - ) + )->join('') ) ); - print CGI::end_div(); + return $output->join(''); +} - print CGI::p(CGI::submit({ - name => 'manage_locations', - value => $r->maketext('Take Action!'), - class => 'btn btn-primary' - })); +# Location management routines - unless (@locations) { - print CGI::div( - { class => 'row mt-3' }, - CGI::div({ class => 'col-lg-8 col-md-9 fw-bold' }, $r->maketext('No locations are currently defined.')) - ); - return; - } +sub manage_location_form { + my ($self) = @_; + my $r = $self->r; + my $db = $r->db; - # Existing location table - print CGI::start_div({ class => 'table-responsive mt-3' }), - CGI::start_table({ class => 'table table-sm font-sm table-bordered table-striped' }); - print CGI::thead(CGI::Tr(CGI::th([ $r->maketext('Select'), $r->maketext('Location'), $r->maketext('Description'), - $r->maketext('Addresses') ]))); - print CGI::start_tbody(); - for my $loc (@locations) { - my $editAddr = $self->systemLink( - $r->urlpath, - params => { - subDisplay => 'manage_locations', - manage_location_action => 'edit_location_form', - edit_location => $loc->location_id - } - ); - print CGI::Tr(CGI::td([ - CGI::checkbox({ - name => 'delete_selected', - id => $loc->location_id . '_id', - value => $loc->location_id, - label => '', - class => 'form-check-input' - }), - CGI::label({ for => $loc->location_id . '_id' }, CGI::a({ href => $editAddr }, $loc->location_id)), - $loc->description, - join(', ', @{ $locAddr{ $loc->location_id } }) - ])); - } - print CGI::end_tbody(); - print CGI::end_table(), CGI::end_div(); + # Get a list of all existing locations + my @locations = sort { lc($a->location_id) cmp lc($b->location_id) } $db->getAllLocations(); - print CGI::end_form(); + return $r->include( + 'ContentGenerator/CourseAdmin/manage_location_form', + locations => \@locations, + locAddr => { map { $_->location_id => [ $db->listLocationAddresses($_->location_id) ] } @locations } + ); } sub add_location_handler { @@ -3253,19 +1709,20 @@ sub add_location_handler { my $r = $self->r; my $db = $r->db; - # the location data we're to add - my $locationID = $r->param("new_location_name"); - my $locationDescr = $r->param("new_location_description"); - my $locationAddr = $r->param("new_location_addresses"); - # break the addresses up + # Get the new location data. + my $locationID = $r->param('new_location_name'); + my $locationDescr = $r->param('new_location_description'); + my $locationAddr = $r->param('new_location_addresses'); + + # Break the addresses up $locationAddr =~ s/\s*-\s*/-/g; $locationAddr =~ s/\s*\/\s*/\//g; my @addresses = split(/\s+/, $locationAddr); - # sanity checks + # Sanity checks my $badAddr = ''; - foreach my $addr (@addresses) { - unless (new Net::IP($addr)) { + for my $addr (@addresses) { + unless (Net::IP->new($addr)) { $badAddr .= "$addr, "; $locationAddr =~ s/$addr\n//s; } @@ -3278,7 +1735,7 @@ sub add_location_handler { if (!$badAddr && $locationID) { if ($db->countLocationAddresses($locationID)) { my @allLocAddr = $db->listLocationAddresses($locationID); - foreach my $addr (@addresses) { + for my $addr (@addresses) { $badLocAddr .= "$addr, " if (grep {/^$addr$/} @allLocAddr); } @@ -3286,36 +1743,57 @@ sub add_location_handler { } } + my $output = $r->c; + if (!@addresses || !$locationID || !$locationDescr) { - print CGI::div( - { class => 'alert alert-danger p-1 mb-2' }, - $r->maketext( - "Missing required input data. Please check that you have filled in all of the create location fields and resubmit." + push( + @$output, + $r->tag( + 'div', + class => 'alert alert-danger p-1 mb-2', + $r->maketext( + 'Missing required input data. Please check that you have ' + . 'filled in all of the create location fields and resubmit.' + ) ) ); } elsif ($badAddr) { - $r->param("new_location_addresses", $locationAddr); - print CGI::div( - { class => 'alert alert-danger p-1 mb-2' }, - $r->maketext( - "Address(es) [_1] is(are) not in a recognized form. Please check your data entry and resubmit.", - $badAddr + $r->param('new_location_addresses', $locationAddr); + push( + @$output, + $r->tag( + 'div', + class => 'alert alert-danger p-1 mb-2', + $r->maketext( + 'Address(es) [_1] is(are) not in a recognized form. Please check your data entry and resubmit.', + $badAddr + ) ) ); } elsif ($db->existsLocation($locationID)) { - print CGI::div( - { class => 'alert alert-danger p-1 mb-2' }, - $r->maketext( - "A location with the name [_1] already exists in the database. Did you mean to edit that location instead?", - $locationID + push( + @$output, + $r->tag( + 'div', + class => 'alert alert-danger p-1 mb-2', + $r->maketext( + 'A location with the name [_1] already exists in the database. ' + . 'Did you mean to edit that location instead?', + $locationID + ) ) ); } elsif ($badLocAddr) { - print CGI::div( - { class => 'alert alert-danger p-1 mb-2' }, - $r->maketext( - "Address(es) [_1] already exist in the database. THIS SHOULD NOT HAPPEN! Please double check the integrity of the WeBWorK database before continuing.", - $badLocAddr + push( + @$output, + $r->tag( + 'div', + { class => 'alert alert-danger p-1 mb-2' }, + $r->maketext( + 'Address(es) [_1] already exist in the database. THIS SHOULD NOT HAPPEN! ' + . 'Please double check the integrity of the WeBWorK database before continuing.', + $badLocAddr + ) ) ); } else { @@ -3326,7 +1804,7 @@ sub add_location_handler { $db->addLocation($locationObj); # and add the addresses - foreach my $addr (@addresses) { + for my $addr (@addresses) { my $locationAddress = $db->newLocationAddress; $locationAddress->location_id($locationID); $locationAddress->ip_mask($addr); @@ -3341,16 +1819,22 @@ sub add_location_handler { $r->param('new_location_description', ''); $r->param('new_location_addresses', ''); - print CGI::div( - { class => 'alert alert-success p-1 mb-2' }, - $r->maketext( - "Location [_1] has been created, with addresses [_2].", - $locationID, join(', ', @addresses) + push( + @$output, + $r->tag( + 'div', + class => 'alert alert-success p-1 mb-2', + $r->maketext( + 'Location [_1] has been created, with addresses [_2].', + $locationID, join(', ', @addresses) + ) ) ); } - $self->manage_location_form; + push(@$output, $self->manage_location_form); + + return $output->join(''); } sub delete_location_handler { @@ -3358,46 +1842,76 @@ sub delete_location_handler { my $r = $self->r; my $db = $r->db; - # what location are we deleting? - my $locationID = $r->param("delete_location"); - # check for selected deletions if appropriate + # Determine which location was requested to be deleted. + my $locationID = $r->param('delete_location'); + + # Check for selected deletions if appropriate. my @delLocations = ($locationID); if ($locationID eq 'selected_locations') { - @delLocations = $r->param("delete_selected"); + @delLocations = $r->param('delete_selected'); $locationID = @delLocations; } - # are we sure? - my $confirm = $r->param("delete_confirm"); + + # Has the confirmation been checked? + my $confirm = $r->param('delete_confirm'); + + my $output = $r->c; my $badID; if (!$locationID) { - print CGI::div({ class => 'alert alert-danger p-1 mb-2' }, - $r->maketext("Please provide a location name to delete.")); + push( + @$output, + $r->tag( + 'div', + class => 'alert alert-danger p-1 mb-2', + $r->maketext('Please provide a location name to delete.') + ) + ); } elsif ($badID = $self->existsLocations_helper(@delLocations)) { - print CGI::div({ class => 'alert alert-danger p-1 mb-2' }, - $r->maketext("No location with name [_1] exists in the database", $badID)); + push( + @$output, + $r->tag( + 'div', + class => 'alert alert-danger p-1 mb-2', + $r->maketext('No location with name [_1] exists in the database', $badID) + ) + ); } elsif (!$confirm || $confirm ne 'true') { - print CGI::div({ class => 'alert alert-danger p-1 mb-2' }, - $r->maketext("Location deletion requires confirmation.")); + push( + @$output, + $r->tag( + 'div', + class => 'alert alert-danger p-1 mb-2', + $r->maketext('Location deletion requires confirmation.') + ) + ); } else { - foreach (@delLocations) { + for (@delLocations) { $db->deleteLocation($_); } - print CGI::div({ class => 'alert alert-success p-1 mb-2' }, - $r->maketext("Deleted Location(s): [_1]", join(', ', @delLocations))); + push( + @$output, + $r->tag( + 'div', + class => 'alert alert-success p-1 mb-2', + $r->maketext('Deleted Location(s): [_1]', join(', ', @delLocations)) + ) + ); $r->param('manage_location_action', 'none'); $r->param('delete_location', ''); } - $self->manage_location_form; + push(@$output, $self->manage_location_form); + + return $output->join(''); } sub existsLocations_helper { my ($self, @locations) = @_; my $db = $self->r->db; - foreach (@locations) { - return $_ if (!$db->existsLocation($_)); + for (@locations) { + return $_ if !$db->existsLocation($_); } return 0; } @@ -3410,129 +1924,30 @@ sub edit_location_form { my $locationID = $r->param('edit_location'); if ($db->existsLocation($locationID)) { my $location = $db->getLocation($locationID); - # This doesn't give that nice a sort for IP addresses, - # b/c there's the problem with 192.168.1.168 sorting - # ahead of 192.168.1.2. we could do better if we - # either invoked Net::IP in the sort routine, or if - # we insisted on dealing only with IPv4. rather than - # deal with either of those, we'll leave this for now + # This doesn't give that nice a sort for IP addresses, because there is the problem with 192.168.1.168 sorting + # ahead of 192.168.1.2. we could do better if we either invoked Net::IP in the sort routine, or if we insisted + # on dealing only with IPv4. Rather than deal with either of those, we'll leave this for now. my @locAddresses = sort { $a cmp $b } $db->listLocationAddresses($locationID); - print CGI::h2($r->maketext('Editing location [_1]', $locationID)); - - print CGI::p($r->maketext( - 'Edit the current value of the location description, if desired, then add and select addresses to delete, ' - . q{and then click the "Take Action" button to make all of your changes. Or, click } - . q{"Manage Locations" above to make no changes and return to the Manage Locations page.} - )); - - print CGI::start_form({ method => 'POST', action => $r->uri }); - - print $self->hidden_authen_fields; - print $self->hidden_fields('subDisplay'); - print CGI::hidden({ name => 'edit_location', default => $locationID }); - print CGI::hidden({ name => 'manage_location_action', default => 'edit_location_handler' }); - - print CGI::div( - { class => 'row mb-2' }, - CGI::label( - { for => 'location_description', class => 'col-auto col-form-label' }, - $r->maketext('Location description:') - ), - CGI::div( - { class => 'col-auto' }, - CGI::textfield({ - name => 'location_description', - id => 'location_description', - size => '50', - default => $location->description, - class => 'form-control' - }) - ) + return $r->include( + 'ContentGenerator/CourseAdmin/edit_location_form', + location => $location, + locationID => $locationID, + locAddresses => \@locAddresses ); - - print CGI::div( - { class => 'row' }, - CGI::div( - { class => 'col-md-6' }, - CGI::div( - { class => 'mb-2' }, - CGI::label( - { for => 'new_location_addresses' }, - $r->maketext( - 'Addresses to add to the location. Enter one per line, as single IP addresses ' - . '(e.g., 192.168.1.101), address masks (e.g., 192.168.1.0/24), or IP ranges ' - . '(e.g., 192.168.1.101-192.168.1.150):' - ) - ) - ), - CGI::div( - { class => 'mb-2' }, - CGI::textarea({ - name => 'new_location_addresses', - id => 'new_location_addresses', - rows => 5, - columns => 28, - class => 'form-control' - }) + } else { + return $r->c( + $r->tag( + 'div', + class => 'alert alert-danger p-1 mb-2', + $r->maketext( + 'Location [_1] does not exist in the WeBWorK database. Please check your input ' + . '(perhaps you need to reload the location management page?).', + $locationID ) ), - CGI::div( - { class => 'col-md-6' }, - CGI::div( - { class => 'mb-2' }, - CGI::label( - { for => 'delete_location_addresses' }, - $r->maketext( - 'Existing addresses for the location are given in the scrolling list below. ' - . 'Select addresses from the list to delete them:' - ) - ) - ), - CGI::div( - { class => 'mb-2' }, - CGI::scrolling_list({ - name => 'delete_location_addresses', - id => 'delete_location_addresses', - values => [@locAddresses], - size => 8, - multiple => 'multiple', - class => 'form-select' - }) - ), - CGI::div({ class => 'mb-2' }, $r->maketext('or')), - CGI::div( - { class => 'mb-2' }, - CGI::div( - { class => 'form-check' }, - CGI::checkbox({ - name => 'delete_all_addresses', - value => 'true', - label => $r->maketext('Delete all existing addresses'), - class => 'form-check-input', - labelattributes => { class => 'form-check-label' } - }) - ) - ) - ) - ); - - print CGI::div(CGI::submit({ - value => $r->maketext('Take Action!'), - class => 'btn btn-primary' - })); - - print CGI::end_form(); - } else { - print CGI::div( - { class => 'alert alert-danger p-1 mb-2' }, - $r->maketext( - 'Location [_1] does not exist in the WeBWorK database. Please check your input ' - . '(perhaps you need to reload the location management page?).', - $locationID - ) - ); - $self->manage_location_form; + $self->manage_location_form + )->join(''); } } @@ -3541,33 +1956,41 @@ sub edit_location_handler { my $r = $self->r; my $db = $r->db; - my $locationID = $r->param("edit_location"); - my $locationDesc = $r->param("location_description"); - my $addAddresses = $r->param("new_location_addresses"); - my @delAddresses = $r->param("delete_location_addresses"); - my $deleteAll = $r->param("delete_all_addresses"); + my $locationID = $r->param('edit_location'); + my $locationDesc = $r->param('location_description'); + my $addAddresses = $r->param('new_location_addresses'); + my @delAddresses = $r->param('delete_location_addresses'); + my $deleteAll = $r->param('delete_all_addresses'); - # gut check + # Gut check if (!$locationID) { - print CGI::div({ class => 'alert alert-danger p-1 mb-2' }, - $r->maketext("No location specified to edit. Please check your input data.")); - $self->manage_location_form; + return $r->c( + $r->tag( + 'div', + class => 'alert alert-danger p-1 mb-2', + $r->maketext('No location specified to edit. Please check your input data.') + ), + $self->manage_location_form + )->join(''); } elsif (!$db->existsLocation($locationID)) { - print CGI::div( - { class => 'alert alert-danger p-1 mb-2' }, - $r->maketext( - "Location [_1] does not exist in the WeBWorK database. Please check your input (perhaps you need to reload the location management page?).", - $locationID - ) - ); - $self->manage_location_form; + return $r->c( + $r->tag( + 'div', + class => 'alert alert-danger p-1 mb-2', + $r->maketext( + 'Location [_1] does not exist in the WeBWorK database. ' + . 'Please check your input (perhaps you need to reload the location management page?).', + $locationID + ) + ), + $self->manage_location_form + )->join(''); } else { my $location = $db->getLocation($locationID); - # get the current location addresses. if we're deleting - # all of the existing addresses, we don't use this list - # to determine which addresses to add, however. + # Get the current location addresses. If we're deleting all of the existing addresses, we don't use this list + # to determine which addresses to add, however. my @currentAddr = $db->listLocationAddresses($locationID); my @compareAddr = (!$deleteAll || $deleteAll ne 'true') ? @currentAddr : (); @@ -3576,31 +1999,37 @@ sub edit_location_handler { if ($locationDesc && $location->description ne $locationDesc) { $location->description($locationDesc); $db->putLocation($location); - $doneMsg .= CGI::p({}, $r->maketext("Updated location description.")); + $doneMsg = $r->tag('p', class => 'my-0', $r->maketext('Updated location description.')); } - # get the actual addresses to add out of the text field + + # Get the addresses to add out of the text field. $addAddresses =~ s/\s*-\s*/-/g; $addAddresses =~ s/\s*\/\s*/\//g; my @addAddresses = split(/\s+/, $addAddresses); - # make sure that we're adding and deleting only those - # addresses that are not yet/currently in the location - # addresses - my @toAdd = (); - my @noAdd = (); - my @toDel = (); - my @noDel = (); - foreach my $addr (@addAddresses) { + # Make sure that we're adding and deleting only those addresses + # that are not yet/currently in the location addresses. + my (@toAdd, @noAdd, @toDel, @noDel); + + my $badAddr = ''; + for my $addr (@addAddresses) { if (grep {/^$addr$/} @compareAddr) { push(@noAdd, $addr); } else { - push(@toAdd, $addr); + # Make sure the address is in a sensible form. + if (Net::IP->new($addr)) { + push(@toAdd, $addr); + } else { + $badAddr .= "$addr, " unless Net::IP->new($addr); + } } } + $badAddr =~ s/, $//; + if ($deleteAll && $deleteAll eq 'true') { @toDel = @currentAddr; } else { - foreach my $addr (@delAddresses) { + for my $addr (@delAddresses) { if (grep {/^$addr$/} @currentAddr) { push(@toDel, $addr); } else { @@ -3609,62 +2038,96 @@ sub edit_location_handler { } } - # and make sure that all of the addresses we're adding are - # a sensible form - my $badAddr = ''; - foreach my $addr (@toAdd) { - unless (new Net::IP($addr)) { - $badAddr .= "$addr, "; - } - } - $badAddr =~ s/, $//; - - # delete addresses first, because we allow deletion of - # all existing addresses, then addition of addresses. - # note that we don't allow deletion and then addition - # of the same address normally, however; in that case - # we'll end up just deleting the address. - foreach (@toDel) { + # Delete addresses first, because we allow deletion of all existing addresses, then addition of addresses. note + # that we don't allow deletion and then addition of the same address normally, however; in that case we'll end + # up just deleting the address. + for (@toDel) { $db->deleteLocationAddress($locationID, $_); } - foreach (@toAdd) { + for (@toAdd) { my $locAddr = $db->newLocationAddress; $locAddr->location_id($locationID); $locAddr->ip_mask($_); - $db->addLocationAddress($locAddr); } - my $addrMsg = ''; - $addrMsg .= $r->maketext("Deleted addresses [_1] from location.", join(', ', @toDel)) . CGI::br() if (@toDel); - $addrMsg .= $r->maketext("Added addresses [_1] to location [_2].", join(', ', @toAdd), $locationID) if (@toAdd); - - my $badMsg = ''; - $badMsg .= - $r->maketext('Address(es) [_1] in the add list is(are) already in the location [_2], and so were skipped.', - join(', ', @noAdd), $locationID) - . CGI::br() - if (@noAdd); - $badMsg .= $r->maketext( - "Address(es) [_1] is(are) not in a recognized form. Please check your data entry and try again.", - $badAddr) - . CGI::br() - if ($badAddr); - $badMsg .= - $r->maketext('Address(es) [_1] in the delete list is(are) not in the location [_2], and so were skipped.', - join(', ', @noDel), $locationID) - if (@noDel); - - print CGI::div({ class => 'alert alert-danger p-1 mb-2' }, $badMsg) - if ($badMsg); - if ($doneMsg || $addrMsg) { - print CGI::div({ -class => 'alert alert-danger p-1 mb-2' }, CGI::p({}, $doneMsg, $addrMsg)); + my $addrMsg = $r->c; + push( + @$addrMsg, + $r->tag( + 'p', + class => 'my-0', + $r->maketext('Deleted addresses [_1] from location.', join(', ', @toDel)) + ) + ) if @toDel; + push( + @$addrMsg, + $r->tag( + 'p', + class => 'my-0', + $r->maketext('Added addresses [_1] to location [_2].', join(', ', @toAdd), $locationID) + ) + ) if @toAdd; + + my $badMsg = $r->c; + push( + @$badMsg, + $r->tag( + 'p', + class => 'my-0', + $r->maketext( + 'Address(es) [_1] in the add list is(are) already in the location [_2], and so were skipped.', + join(', ', @noAdd), $locationID + ) + ) + ) if @noAdd; + push( + @$badMsg, + $r->tag( + 'p', + class => 'my-0', + $r->maketext( + 'Address(es) [_1] is(are) not in a recognized form. Please check your data entry and try again.', + $badAddr + ) + ) + ) if $badAddr; + push( + @$badMsg, + $r->tag( + 'p', + class => 'my-0', + $r->maketext( + 'Address(es) [_1] in the delete list is(are) not in the location [_2], and so were skipped.', + join(', ', @noDel), $locationID + ) + ) + ) if @noDel; + + my $output = $r->c; + push(@$output, $r->tag('div', class => 'alert alert-danger p-1 mb-2', $badMsg->join(''))) + if @$badMsg; + if ($doneMsg || @$addrMsg) { + push( + @$output, + $r->tag( + 'div', + class => 'alert alert-success p-1 mb-2', + $r->c($doneMsg, @$addrMsg)->join('') + ) + ); } else { - print CGI::div({ -class => 'alert alert-danger p-1 mb-2' }, - $r->maketext("No valid changes submitted for location [_1].", $locationID)); + push( + @$output, + $r->tag( + 'div', + class => 'alert alert-danger p-1 mb-2', + $r->maketext('No valid changes submitted for location [_1].', $locationID) + ) + ); } - - $self->edit_location_form; + push(@$output, $self->edit_location_form); + return $output->join(''); } } @@ -3673,174 +2136,53 @@ sub hide_inactive_course_form { my $r = $self->r; my $ce = $r->ce; - my $coursesDir = $ce->{webworkDirs}->{courses}; - my @courseIDs = listCourses($ce); - my $hide_listing_format = $r->param('hide_listing_format') // 'last_login'; + my @courseIDs = listCourses($ce); # Get and store last modify time for login.log for all courses. Also get visibility status. - my %courseLabels; - my @noLoginLogIDs; - my @loginLogIDs; - my @hideCourseIDs; - my ($loginLogFile, $epoch_modify_time, $courseDir); + my ($epoch_modify_time, %coursesData, %courseLabels, @noLoginLogIDs, @loginLogIDs, @hideCourseIDs); for my $courseID (@courseIDs) { - $loginLogFile = "$coursesDir/$courseID/logs/login.log"; - if (-e $loginLogFile) { #this should always exist except for the model course - $epoch_modify_time = stat($loginLogFile)->mtime; - $coursesData{$courseID}{'epoch_modify_time'} = $epoch_modify_time; - $coursesData{$courseID}{'local_modify_time'} = ctime($epoch_modify_time); + my $loginLogFile = "$ce->{webworkDirs}{courses}/$courseID/logs/login.log"; + if (-e $loginLogFile) { # This should always exist except for the model course. + $epoch_modify_time = stat($loginLogFile)->mtime; + $coursesData{$courseID}{epoch_modify_time} = $epoch_modify_time; + $coursesData{$courseID}{local_modify_time} = ctime($epoch_modify_time); push(@loginLogIDs, $courseID); } else { - $coursesData{$courseID}{'local_modify_time'} = - 'no login.log'; #this should never be the case except for the model course + $coursesData{$courseID}{local_modify_time} = + 'no login.log'; # This should never be the case except for the model course push(@noLoginLogIDs, $courseID); } - if (-f "$coursesDir/$courseID/hide_directory") { - $coursesData{$courseID}{'status'} = $r->maketext('hidden'); + if (-f "$ce->{webworkDirs}{courses}/$courseID/hide_directory") { + $coursesData{$courseID}{status} = $r->maketext('hidden'); } else { - $coursesData{$courseID}{'status'} = $r->maketext('visible'); + $coursesData{$courseID}{status} = $r->maketext('visible'); } $courseLabels{$courseID} = - "$courseID ($coursesData{$courseID}{'status'} :: $coursesData{$courseID}{'local_modify_time'})"; + "$courseID ($coursesData{$courseID}{status} :: $coursesData{$courseID}{local_modify_time})"; } - if ($hide_listing_format eq 'last_login') { - # This should be an empty arrey except for the model course. + if (($r->param('hide_listing_format') // 'alphabetically') eq 'last_login') { + # This should be an empty array except for the model course. @noLoginLogIDs = sort { lc($a) cmp lc($b) } @noLoginLogIDs; - @loginLogIDs = sort byLoginActivity @loginLogIDs; # oldest first + @loginLogIDs = sort { $coursesData{$a}{epoch_modify_time} <=> $coursesData{$b}{epoch_modify_time} } + @loginLogIDs; # oldest first @hideCourseIDs = (@noLoginLogIDs, @loginLogIDs); } else { # In this case we sort alphabetically @hideCourseIDs = sort { lc($a) cmp lc($b) } @courseIDs; } - print CGI::h2($r->maketext('Hide Courses')); - - print CGI::p($r->maketext( - 'Select the course(s) you want to hide (or unhide) and then click "Hide Courses" (or "Unhide Courses"). ' - . 'Hiding a course that is already hidden does no harm (the action is skipped). Likewise unhiding a ' - . 'course that is already visible does no harm (the action is skipped). Hidden courses are still active ' - . 'but are not listed in the list of WeBWorK courses on the opening page. To access the course, an ' - . 'instructor or student must know the full URL address for the course.' - )); - - print CGI::p($r->maketext( - 'Courses are listed either alphabetically or in order by the time of most recent login activity, ' - . 'oldest first. To change the listing order check the mode you want and click "Refresh Listing". ' - . 'The listing format is: Course_Name (status :: date/time of most recent login) where status is "hidden" ' - . 'or "visible".' - )); - - print CGI::start_form(-method => 'POST', -action => $r->uri); - - print CGI::div( - { class => 'mb-3' }, - CGI::div({ class => 'mb-2' }, $r->maketext('Select a listing format:')), - map { - CGI::div( - { class => 'form-check' }, - CGI::input({ - type => 'radio', - name => 'hide_listing_format', - id => "hide_listing_format_$_->[0]", - value => $_->[0], - class => 'form-check-input', - $_->[0] eq ($r->param('hide_listing_format') // 'alphabetically') ? (checked => undef) : () - }), - CGI::label( - { - for => "hide_listing_format_$_->[0]", - class => 'form-check-label' - }, - $_->[1] - ) - ) - } ( - [ alphabetically => $r->maketext('alphabetically') ], - [ last_login => $r->maketext('by last login date') ] - ), - ); - - print CGI::div( - { class => 'mb-2' }, - CGI::submit({ - name => 'hide_course_refresh', - value => $r->maketext('Refresh Listing'), - class => 'btn btn-primary' - }), - CGI::submit({ - name => 'hide_course', - value => $r->maketext('Hide Courses'), - class => 'btn btn-primary' - }), - CGI::submit({ - name => 'unhide_course', - value => $r->maketext('Unhide Courses'), - class => 'btn btn-primary' - }) - ); - - print $self->hidden_authen_fields; - print $self->hidden_fields('subDisplay'); - - print CGI::div({ class => 'mb-2' }, $r->maketext('Select course(s) to hide or unhide.')); - print CGI::div( - { class => 'row mb-2' }, - CGI::label( - { for => 'hide_courseIDs', class => 'col-auto col-form-label fw-bold' }, - $r->maketext('Course Name:') - ), - CGI::div( - { class => 'col-auto' }, - CGI::scrolling_list({ - name => 'hide_courseIDs', - id => 'hide_courseIDs', - values => \@hideCourseIDs, - size => 15, - multiple => 1, - labels => \%courseLabels, - class => 'form-select' - }) - ) - ); - - print CGI::div( - CGI::submit({ - name => 'hide_course_refresh', - value => $r->maketext('Refresh Listing'), - class => 'btn btn-primary' - }), - CGI::submit({ - name => 'hide_course', - value => $r->maketext('Hide Courses'), - class => 'btn btn-primary' - }), - CGI::submit({ - name => 'unhide_course', - value => $r->maketext('Unhide Courses'), - class => 'btn btn-primary' - }) + return $r->include( + 'ContentGenerator/CourseAdmin/hide_inactive_course_form', + hideCourseIDs => \@hideCourseIDs, + courseLabels => \%courseLabels ); - - print CGI::end_form(); } sub hide_course_validate { my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; - #my $db = $r->db; - #my $authz = $r->authz; - my $urlpath = $r->urlpath; - - my @hide_courseIDs = $r->param("hide_courseIDs"); - @hide_courseIDs = () unless @hide_courseIDs; - - my @errors; - - unless (@hide_courseIDs) { - push @errors, $r->maketext("You must specify a course name."); - } - return @errors; + my $r = $self->r; + return $r->maketext('You must specify a course name.') unless $r->param('hide_courseIDs'); + return; } sub do_hide_inactive_course { @@ -3848,82 +2190,77 @@ sub do_hide_inactive_course { my $r = $self->r; my $ce = $r->ce; - my $coursesDir = $ce->{webworkDirs}->{courses}; - - my $hide_courseID; - my @hide_courseIDs = $r->param("hide_courseIDs"); - @hide_courseIDs = () unless @hide_courseIDs; - - my $hideDirFileContent = $r->maketext( - 'Place a file named "hide_directory" in a course or other directory and it will not show up in the courses list on the WeBWorK home page. It will still appear in the Course Administration listing.' - ); - - my @succeeded_courses = (); - my $succeeded_count = 0; - my @failed_courses = (); + my (@succeeded_courses, @failed_courses); my $already_hidden_count = 0; - foreach $hide_courseID (@hide_courseIDs) { - my $hideDirFile = "$coursesDir/$hide_courseID/hide_directory"; + for my $hide_courseID ($r->param('hide_courseIDs')) { + my $hideDirFile = "$ce->{webworkDirs}{courses}/$hide_courseID/hide_directory"; if (-f $hideDirFile) { - $already_hidden_count++; + ++$already_hidden_count; next; + } + if (open(my $HIDEFILE, '>', $hideDirFile)) { + print $HIDEFILE $r->maketext( + 'Place a file named "hide_directory" in a course or other directory and it will not show up ' + . 'in the courses list on the WeBWorK home page. It will still appear in the ' + . 'Course Administration listing.'); + close $HIDEFILE; + push @succeeded_courses, $hide_courseID; } else { - local *HIDEFILE; - if (open(HIDEFILE, ">", $hideDirFile)) { - print HIDEFILE "$hideDirFileContent"; - close HIDEFILE; - push @succeeded_courses, $hide_courseID; - $succeeded_count++; - } else { - push @failed_courses, $hide_courseID; - } + push @failed_courses, $hide_courseID; } } + my $output = $r->c; + if (@failed_courses) { - print CGI::div( - { class => 'alert alert-danger p-1 mb-2' }, - CGI::p($r->maketext( - "Errors occured while hiding the courses listed below when attempting to create the file hide_directory in the course's directory. Check the ownership and permissions of the course's directory, e.g [_1]", - "$coursesDir/$failed_courses[0]/" - )), - join(CGI::br(), @failed_courses) + push( + @$output, + $r->tag( + 'div', + class => 'alert alert-danger p-1 mb-2', + $r->c( + $r->tag( + 'p', + $r->maketext( + 'Errors occured while hiding the courses listed below when attempting to create the ' + . q{file hide_directory in the course's directory. Check the ownership and permissions } + . q{of the course's directory, e.g "[_1]".}, + "$ce->{webworkDirs}{courses}/$failed_courses[0]/" + ) + ), + $r->tag('ul', $r->c(map { $r->tag('li', $_) } @failed_courses)->join('')) + )->join('') + ) ); } + my $succeeded_message = ''; - if ($succeeded_count < 1 and $already_hidden_count > 0) { - $succeeded_message = - $r->maketext("Except for possible errors listed above, all selected courses are already hidden."); + if (!@succeeded_courses && $already_hidden_count) { + if (@failed_courses) { + $succeeded_message = + $r->maketext('Except for the errors listed above, all selected courses are already hidden.'); + } else { + $succeeded_message = $r->maketext('All selected courses are already hidden.'); + } + } elsif (@succeeded_courses) { + $succeeded_message = $r->c( + $r->tag('p', $r->maketext('The following courses were successfully hidden:')), + $r->tag('ul', $r->c(map { $r->tag('li', $_) } @succeeded_courses)->join('')) + )->join(''); } - if ($succeeded_count) { - $succeeded_message = CGI::p($r->maketext("The following courses were successfully hidden:")) - . join(CGI::br(), @succeeded_courses); - } - if ($succeeded_count or $already_hidden_count) { - print CGI::div({ class => 'alert alert-success p-1 mb-2' }, $succeeded_message); - } + push(@$output, $r->tag('div', class => 'alert alert-success p-1 mb-2', $succeeded_message)) if ($succeeded_message); + + return $output->join(''); } sub unhide_course_validate { my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; - #my $db = $r->db; - #my $authz = $r->authz; - my $urlpath = $r->urlpath; - - my @unhide_courseIDs = $r->param("hide_courseIDs"); - @unhide_courseIDs = () unless @unhide_courseIDs; - - my @errors; - - unless (@unhide_courseIDs) { - push @errors, $r->maketext("You must specify a course name."); - } - return @errors; + my $r = $self->r; + return $r->maketext('You must specify a course name.') unless $r->param('hide_courseIDs'); + return; } sub do_unhide_inactive_course { @@ -3931,427 +2268,100 @@ sub do_unhide_inactive_course { my $r = $self->r; my $ce = $r->ce; - my $coursesDir = $ce->{webworkDirs}->{courses}; - - my $unhide_courseID; - my @unhide_courseIDs = $r->param("hide_courseIDs"); - @unhide_courseIDs = () unless @unhide_courseIDs; - - my @succeeded_courses = (); - my $succeeded_count = 0; - my @failed_courses = (); + my (@succeeded_courses, @failed_courses); my $already_visible_count = 0; - foreach $unhide_courseID (@unhide_courseIDs) { - my $hideDirFile = "$coursesDir/$unhide_courseID/hide_directory"; + for my $unhide_courseID ($r->param('hide_courseIDs')) { + my $hideDirFile = "$ce->{webworkDirs}{courses}/$unhide_courseID/hide_directory"; unless (-f $hideDirFile) { - $already_visible_count++; + ++$already_visible_count; next; } - remove_tree("$hideDirFile", { error => \my $err }); - if (@$err) { - push @failed_courses, $unhide_courseID; - } else { + if (unlink $hideDirFile) { push @succeeded_courses, $unhide_courseID; - $succeeded_count++; + } else { + push @failed_courses, $unhide_courseID; } } - my $succeeded_message = ''; - if ($succeeded_count < 1 and $already_visible_count > 0) { - $succeeded_message = - $r->maketext("Except for possible errors listed above, all selected courses are already unhidden."); - } + my $output = $r->c; - if ($succeeded_count) { - $succeeded_message = CGI::p($r->maketext("The following courses were successfully unhidden:")) - . join(CGI::br(), @succeeded_courses); - } - if ($succeeded_count or $already_visible_count) { - print CGI::div({ class => 'alert alert-success p-1 mb-2' }, $succeeded_message); - } if (@failed_courses) { - print CGI::div( - { class => 'alert alert-danger p-1 mb-2' }, - CGI::p($r->maketext( - "Errors occured while unhiding the courses listed below when attempting delete the file hide_directory in the course's directory. Check the ownership and permissions of the course's directory, e.g [_1]", - "$coursesDir/$failed_courses[0]/" - )), - join(CGI::br(), @failed_courses) + push( + @$output, + $r->tag( + 'div', + class => 'alert alert-danger p-1 mb-2', + $r->c( + $r->tag( + 'p', + $r->maketext( + 'Errors occured while unhiding the courses listed below when attempting delete the file ' + . q{hide_directory in the course's directory. Check the ownership and permissions of } + . q{the course's directory, e.g "[_1]".}, + "$ce->{webworkDirs}{courses}/$failed_courses[0]/" + ) + ), + $r->tag('ul', $r->c(map { $r->tag('li', $_) } @failed_courses)->join('')) + )->join('') + ) ); } -} - -sub upgrade_notification { - my $self = shift; - my $r = $self->r; - my $ce = $r->ce; - my $db = $r->db; - - # exit if notifications are disabled - return unless $ce->{enableGitUpgradeNotifier}; - - my $git = $ce->{externalPrograms}->{git}; - my $WeBWorKRemote = $ce->{gitWeBWorKRemoteName}; - my $WeBWorKBranch = $ce->{gitWeBWorKBranchName}; - my $PGRemote = $ce->{gitPGRemoteName}; - my $PGBranch = $ce->{gitPGBranchName}; - my $LibraryRemote = $ce->{gitLibraryRemoteName}; - my $LibraryBranch = $ce->{gitLibraryBranchName}; - - # we can tproceed unless we have git; - if (!(defined($git) && -x $git)) { - warn('External Program "git" not found. Check your site.conf'); - return; - } - - my $upgradeMessage = ''; - my $upgradesAvailable = 0; - my $output; - my @lines; - my $commit; - - if ($WeBWorKRemote && $WeBWorKBranch) { - # Check if there is an updated version of webwork available - # this is done by using ls-remote to get the commit sha at the - # head of the remote branch and looking to see if that sha is in - # the currently selected local branch - chdir($ce->{webwork_dir}); - my $currentBranch = `$git symbolic-ref --short HEAD`; - $output = `$git ls-remote --heads $WeBWorKRemote`; - @lines = split /\n/, $output; - $commit = -1; - - foreach my $line (@lines) { - if ($line =~ /refs\/heads\/$WeBWorKBranch$/) { - $line =~ /^(\w+)/; - $commit = $1; - last; - } - } - - $output = `$git branch --contains $commit`; - - if ($commit ne '-1' && $output !~ /\s+$currentBranch(\s+|$)/) { - # There are upgrades, we need to figure out if its a - # new version or not - # This is done by using ls-remote to get the commit sha's - # at the heads of the remote tags. - # Tags of the form WeBWorK-x.y are release tags. If there is - # an sha there which isn't in the current branch then there must - # be a newer version. - - $output = `$git ls-remote --tags $WeBWorKRemote`; - @lines = split /\n/, $output; - my $newversion = 0; - - foreach my $line (@lines) { - next unless $line =~ /\/tags\/WeBWorK-/; - $line =~ /^(\w+)/; - $commit = $1; - $output = `$git branch --contains $commit`; - - if ($output !~ /\s+$currentBranch(\s+|$)/) { - # There is a version tag which contains a commit that - # isn't in the current branch so there must - # be a new version - $newversion = 1; - last; - } - } - - if ($newversion) { - $upgradesAvailable = 1; - $upgradeMessage .= CGI::Tr(CGI::td($r->maketext('There is a new version of WeBWorK available.'))); - } else { - $upgradesAvailable = 1; - $upgradeMessage .= CGI::Tr(CGI::td($r->maketext( - 'There are upgrades available for your current branch of WeBWorK from branch [_1] in remote [_2].', - $WeBWorKBranch, - $WeBWorKRemote - ))); - } - } elsif ($commit eq '-1') { - $upgradesAvailable = 1; - $upgradeMessage .= CGI::Tr(CGI::td($r->maketext( - "Couldn't find WeBWorK Branch [_1] in remote [_2]", $WeBWorKBranch, $WeBWorKRemote))); - } else { - $upgradeMessage .= CGI::Tr(CGI::td($r->maketext( - 'Your current branch of WeBWorK is up to date with branch [_1] in remote [_2].', $WeBWorKBranch, - $WeBWorKRemote - ))); - } - } - - if ($PGRemote && $PGBranch) { - # Check if there is an updated version of pg available - # this is done by using ls-remote to get the commit sha at the - # head of the remote branch and looking to see if that sha is in - # the currently selected local branch - chdir($ce->{pg_dir}); - my $currentBranch = `$git symbolic-ref --short HEAD`; - $output = `$git ls-remote --heads $PGRemote`; - @lines = split /\n/, $output; - $commit = '-1'; - - foreach my $line (@lines) { - if ($line =~ /refs\/heads\/$PGBranch$/) { - $line =~ /^(\w+)\s+/; - $commit = $1; - last; - } - } - - $output = `$git branch --contains $commit`; - - if ($commit ne '-1' && $output !~ /\s+$currentBranch(\s+|$)/) { - # There are upgrades, we need to figure out if its a - # new version or not - # This is done by using ls-remote to get the commit sha's - # at the heads of the remote tags. - # Tags of the form WeBWorK-x.y are release tags. If there is - # an sha there which isn't in the local branch then there must - # be a newer version. - $output = `$git ls-remote --tags $PGRemote`; - @lines = split /\n/, $output; - my $newversion = 0; - - foreach my $line (@lines) { - next unless $line =~ /\/tags\/PG-/; - $line =~ /^(\w+)/; - $commit = $1; - $output = `$git branch --contains $commit`; - if ($output !~ /\s+$currentBranch(\s+|$)/) { - # There is a version tag which contains a commit that - # isn't in the current branch so there must - # be a new version - $newversion = 1; - last; - } - } - - if ($newversion) { - $upgradesAvailable = 1; - $upgradeMessage .= CGI::Tr(CGI::td($r->maketext('There is a new version of PG available.'))); - } else { - $upgradesAvailable = 1; - $upgradeMessage .= CGI::Tr(CGI::td($r->maketext( - 'There are upgrades available for your current branch of PG from branch [_1] in remote [_2].', - $PGBranch, $PGRemote - ))); - } - } elsif ($commit eq '-1') { - $upgradesAvailable = 1; - $upgradeMessage .= - CGI::Tr(CGI::td($r->maketext("Couldn't find PG Branch [_1] in remote [_2]", $PGBranch, $PGRemote))); - } else { - $upgradeMessage .= CGI::Tr(CGI::td($r->maketext( - 'Your current branch of PG is up to date with branch [_1] in remote [_2].', - $PGBranch, $PGRemote - ))); - - } - } - die "Couldn't find " - . $ce->{problemLibrary}{root} - . '. Are you sure $problemLibrary{root} is set correctly in localOverrides.conf?' - unless chdir($ce->{problemLibrary}{root}); - - if ($LibraryRemote && $LibraryBranch) { - # Check if there is an updated version of the OPL available - # this is done by using ls-remote to get the commit sha at the - # head of the remote branch and looking to see if that sha is in - # the local current branch - my $currentBranch = `$git symbolic-ref --short HEAD`; - $output = `$git ls-remote --heads $LibraryRemote`; - @lines = split /\n/, $output; - $commit = '-1'; - - foreach my $line (@lines) { - if ($line =~ /refs\/heads\/$LibraryBranch$/) { - $line =~ /^(\w+)\s+/; - $commit = $1; - last; - } - } + my $succeeded_message = ''; - $output = `$git branch --contains $commit`; - - if ($commit ne '-1' && $output !~ /\s+$currentBranch(\s+|$)/) { - $upgradesAvailable = 1; - $upgradeMessage .= - CGI::Tr(CGI::td($r->maketext('There are upgrades available for the Open Problem Library.'))); - } elsif ($commit eq '-1') { - $upgradesAvailable = 1; - $upgradeMessage .= CGI::Tr( - CGI::td($r->maketext( - "Couldn't find OPL Branch [_1] in remote [_2]", $LibraryBranch, $LibraryRemote))); + if (!@succeeded_courses && $already_visible_count) { + if (@failed_courses) { + $succeeded_message = + $r->maketext('Except for the errors listed above, all selected courses are already unhidden.'); } else { - $upgradeMessage .= CGI::Tr(CGI::td($r->maketext( - 'Your current branch of the Open Problem Library is up to date.', - $LibraryBranch, $LibraryRemote - ))); + $succeeded_message = $r->maketext('All selected courses are already unhidden.'); } + } elsif (@succeeded_courses) { + $succeeded_message = $r->c( + $r->tag('p', $r->maketext('The following courses were successfully unhidden:')), + $r->tag('ul', $r->c(map { $r->tag('li', $_) } @succeeded_courses)->join('')) + )->join(''); } - chdir($ce->{webwork_dir}); - - if ($upgradesAvailable) { - $upgradeMessage = - CGI::Tr(CGI::th($r->maketext('The following upgrades are available for your WeBWorK system:'))) - . $upgradeMessage; - return CGI::center(CGI::table({ class => "admin-messagebox" }, $upgradeMessage)); - } else { - return CGI::center(CGI::div( - { class => 'alert alert-success p-1 mb-2' }, $r->maketext('Your systems are up to date!'))); + if ($succeeded_message) { + push(@$output, $r->tag('div', class => 'alert alert-success p-1 mb-2', $succeeded_message)); } + return $output->join(''); } -################################################################################ -# registration forms added by Mike Gage 5-5-2008 -################################################################################ - -our $registered_file_name = "registered_???"; - -sub display_registration_form { - my $self = shift; - my $ce = $self->r->ce; - my $ww_version = $ce->{WW_VERSION}; - $registered_file_name = "registered_$ww_version"; - my $registeredQ = (-e "$ce->{courseDirs}{root}/$registered_file_name") ? 1 : 0; - my $registration_subDisplay = - (defined($self->r->param('subDisplay')) && $self->r->param('subDisplay') eq 'registration') ? 1 : 0; - my $register_site = ($self->r->param('register_site')) ? 1 : 0; - - return CGI::div({ class => 'd-flex justify-content-center' }, "REGISTERED for WeBWorK $ww_version") - if $registeredQ || $register_site || $registration_subDisplay; - - # Otherwise return registration form. - return CGI::div( - { class => 'd-flex justify-content-center' }, - CGI::div( - { class => 'admin-messagebox' }, - - CGI::p( - CGI::strong('Please consider registering for the WW-security-announce Google group / mailing list'), - ' using the join group link on the ', - CGI::a({ href => $ce->{webworkURLs}{wwSecurityAnnounce}, target => '_blank' }, 'group page'), - ' which appears when you are logged in to a Google account ', - CGI::strong('or'), - ' by sending an email using ', - CGI::a( - { - href => join('', - "mailto:$ce->{webworkSecListManagers}?subject=", - uri_escape('Joining ww-security-announce'), - '&body=', - uri_escape("Server URL: $ce->{server_root_url}\n"), - uri_escape("WeBWorK version: $ce->{WW_VERSION}\n"), - uri_escape("Institution name: \n")) - }, - , - 'this mailto link' - ), - '. This list will help us keep you updated about security issues and patches, ' - . 'and important related announcements.' - ), - - CGI::hr(), - - CGI::p( - 'Please consider contributing to WeBWorK development either with a one time contribution or monthly ', - 'support. The WeBWorK Project is a registered 501(c)(3) organization and contributions are tax ', - 'deductible in the United States.' - ), - CGI::div( - { class => 'text-center' }, - CGI::a( - { - class => 'btn btn-secondary', - href => 'https://github.com/sponsors/openwebwork', - target => '_blank' - }, - CGI::i({ class => 'fa-regular fa-heart' }, '') . ' Sponsor', - ) - ), - - CGI::hr(), +sub do_registration { + my $self = shift; + my $r = $self->r; + my $ce = $r->ce; - CGI::p("This site is not registered for WeBWorK version $ww_version."), - CGI::p( - 'We are often asked how many institutions are using WeBWorK and how many students are using WeBWorK. ', - 'Since WeBWorK is open source and can be freely downloaded from ', - CGI::a({ href => $ce->{webworkURLs}{GitHub}, target => '_blank' }, $ce->{webworkURLs}{GitHub}), - ', it is frequently difficult for us to give a reasonable answer to this question.' - ), - CGI::p( - 'You can help by ', - CGI::a( - { href => $ce->{webworkURLs}{serverRegForm}, target => '_blank' }, - 'registering your current version of WeBWorK' - ), - '. Please complete the Google form as best you can and submit your answers ', - 'to the WeBWorK Project team. It takes just 2-3 minutes. Thank you! -- The WeBWorK Project' - ), - CGI::p( - 'Eventually your site will be listed along with all of the others on the ', - CGI::a({ href => $ce->{webworkURLs}{SiteMap}, target => '_blank' }, 'site map'), - ' on the main ', - CGI::a({ href => $ce->{webworkURLs}{WikiMain}, target => '_blank' }, 'WeBWorK Wiki'), - '.', - ), + `echo "info" > $ce->{courseDirs}{root}/registered_$ce->{WW_VERSION}`; - CGI::hr(), - - CGI::p('You can hide this "registration" banner for the future by clicking the button below.'), - CGI::start_form({ method => 'POST', id => 'return_to_main_page', action => $self->r->uri }), - $self->hidden_authen_fields, - CGI::hidden({ name => 'subDisplay', value => 'registration' }), - CGI::div( - { class => 'text-center' }, - CGI::submit({ - id => 'register_site', - name => 'register_site', - label => 'Hide the banner.', - class => 'btn btn-primary' - }) + return $r->tag( + 'div', + class => 'mt-2 mx-auto w-50 text-center', + $r->c( + $r->tag( + 'p', + 'Registration banner has been hidden. ' + . 'We appreciate your registering your server with the WeBWorK Project!' ), - CGI::end_form() - ) - ); -} - -sub registration_form { -} - -sub do_registration { - my $self = shift; - my $ce = $self->r->ce; - my $registered_file_path = $ce->{courseDirs}->{root} . "/$registered_file_name"; - # warn qq!`echo "info" >$registered_file_path`!; - `echo "info" >$registered_file_path`; - - print "\n
      ", - CGI::p( - { style => "text-align: left; width:60%" }, - q{Registration banner has been hidden. We appreciate your registering your server with the WeBWorK Project!"} - ); - - print CGI::start_form(-method => "POST", -action => $self->r->uri); - print $self->hidden_authen_fields; - print CGI::p( - { style => "text-align: center" }, - CGI::submit({ - name => "registration_completed", - label => "Continue", - class => 'btn btn-primary' - }) + $r->form_for( + $r->uri, + method => 'POST', + $r->c( + $self->hidden_authen_fields, + $r->submit_button( + $r->maketext('Continue'), + name => 'registration_completed', + label => 'Continue', + class => 'btn btn-primary' + ) + )->join('') + ) + )->join('') ); - print CGI::end_form(); - print "
      "; - } # Format a list of tables and fields in the database, and the status of each. @@ -4359,94 +2369,111 @@ sub formatReportOnDatabaseTables { my ($self, $tables_ok, $dbStatus, $courseID) = @_; my $r = $self->r; - my %msg = ( - WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_A => - CGI::span({ class => 'text-danger' }, $r->maketext('Table defined in schema but missing in database')), - WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_B => - CGI::span({ class => 'text-danger me-2' }, $r->maketext('Table defined in database but missing in schema')), + my %table_status_message = ( WeBWorK::Utils::CourseIntegrityCheck::SAME_IN_A_AND_B => - CGI::span({ class => 'text-success' }, $r->maketext('Table is ok')), - WeBWorK::Utils::CourseIntegrityCheck::DIFFER_IN_A_AND_B => - CGI::span({ class => 'text-danger' }, $r->maketext('Schema and database table definitions do not agree')), + $r->tag('span', class => 'text-success me-2', $r->maketext('Table is ok')), + WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_A => $r->tag( + 'span', + class => 'text-danger me-2', + $r->maketext('Table defined in schema but missing in database') + ), + WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_B => $r->tag( + 'span', + class => 'text-danger me-2', + $r->maketext('Table defined in database but missing in schema') + ), + WeBWorK::Utils::CourseIntegrityCheck::DIFFER_IN_A_AND_B => $r->tag( + 'span', + class => 'text-danger me-2', + $r->maketext('Schema and database table definitions do not agree') + ) ); - my %msg2 = ( + my %field_status_message = ( + WeBWorK::Utils::CourseIntegrityCheck::SAME_IN_A_AND_B => + $r->tag('span', class => 'text-success me-2', $r->maketext('Field is ok')), WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_A => - CGI::span({ class => 'text-danger' }, $r->maketext('Field missing in database')), + $r->tag('span', class => 'text-danger me-2', $r->maketext('Field missing in database')), WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_B => - CGI::span({ class => 'text-danger me-2' }, $r->maketext('Field missing in schema')), - WeBWorK::Utils::CourseIntegrityCheck::SAME_IN_A_AND_B => - CGI::span({ class => 'text-success' }, $r->maketext('Field is ok')), - WeBWorK::Utils::CourseIntegrityCheck::DIFFER_IN_A_AND_B => - CGI::span({ class => 'text-danger' }, $r->maketext('Schema and database field definitions do not agree')), + $r->tag('span', class => 'text-danger me-2', $r->maketext('Field missing in schema')), + WeBWorK::Utils::CourseIntegrityCheck::DIFFER_IN_A_AND_B => $r->tag( + 'span', + class => 'text-danger me-2', + $r->maketext('Schema and database field definitions do not agree') + ) ); + my $all_tables_ok = 1; my $extra_database_tables = 0; my $extra_database_fields = 0; - my $str = CGI::start_ul(); + my $db_report = $r->c; + for my $table (sort keys %$dbStatus) { + my $table_report = $r->c; + my $table_status = $dbStatus->{$table}[0]; - $str .= CGI::start_li(); - $str .= CGI::b($table) . ': ' . $msg{$table_status}; + push(@$table_report, $table . ': ', $table_status_message{$table_status}); if ($table_status == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_A) { $all_tables_ok = 0; } elsif ($table_status == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_B) { $extra_database_tables = 1; - $str .= CGI::span( - { class => 'form-check d-inline-block' }, - CGI::checkbox({ - name => "$courseID.delete_tableIDs", - value => $table, - label => $r->maketext('Delete table when upgrading'), - class => 'form-check-input', - labelattributes => { class => 'form-check-label' } - }) + push( + @$table_report, + $r->tag( + 'span', + class => 'form-check d-inline-block', + $r->tag( + 'label', + class => 'form-check-label', + $r->c($r->check_box("$courseID.delete_tableIDs" => $table, class => 'form-check-input'), + $r->maketext('Delete table when upgrading'))->join('') + ) + ) ) if defined $courseID; } elsif ($table_status == WeBWorK::Utils::CourseIntegrityCheck::DIFFER_IN_A_AND_B) { - my %fieldInfo = %{ $dbStatus->{$table}->[1] }; - $str .= CGI::start_ul(); + my %fieldInfo = %{ $dbStatus->{$table}[1] }; + my $fields_report = $r->c; for my $key (keys %fieldInfo) { - my $field_status = $fieldInfo{$key}->[0]; - $str .= CGI::start_li(); - $str .= "$key => $msg2{$field_status}"; + my $field_status = $fieldInfo{$key}[0]; + my $field_report = $r->c("$key: $field_status_message{$field_status}"); if ($field_status == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_B) { $extra_database_fields = 1; - $str .= CGI::span( - { class => 'form-check d-inline-block' }, - CGI::checkbox({ - name => "$courseID.$table.delete_fieldIDs", - value => $key, - label => $r->maketext('Delete field when upgrading'), - class => 'form-check-input', - labelattributes => { class => 'form-check-label' } - }) + push( + @$field_report, + $r->tag( + 'span', + class => 'form-check d-inline-block', + $r->tag( + 'label', + class => 'form-check-label', + $r->c( + $r->check_box( + "$courseID.$table.delete_fieldIDs" => $key, + class => 'form-check-input' + ), + $r->maketext('Delete field when upgrading') + )->join('') + ) + ) ) if defined $courseID; } elsif ($field_status == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_A) { $all_tables_ok = 0; } - $str .= CGI::end_li(); + push(@$fields_report, $r->tag('li', $field_report->join(''))); } - $str .= CGI::end_ul(); + push(@$table_report, $r->tag('ul', $fields_report->join(''))); } - $str .= CGI::end_li(); + push(@$db_report, $r->tag('li', $table_report->join(''))); } - $str .= CGI::end_ul(); - $str .= $all_tables_ok ? CGI::p({ class => 'text-success' }, $r->maketext('Database tables are ok')) : ''; - - return ($all_tables_ok, $extra_database_tables, $extra_database_fields, $str); -} - -sub output_JS { - my $self = shift; - my $ce = $self->r->ce; + $db_report = $r->c($r->tag('ul', $db_report->join(''))); - print CGI::script({ src => getAssetURL($ce, 'js/apps/SelectAll/selectall.js'), defer => undef }, ''); + push(@$db_report, $r->tag('p', class => 'text-success', $r->maketext('Database tables are ok'))) if $all_tables_ok; - return ''; + return ($all_tables_ok, $extra_database_tables, $extra_database_fields, $db_report->join('')); } 1; diff --git a/lib/WeBWorK/ContentGenerator/EquationDisplay.pm b/lib/WeBWorK/ContentGenerator/EquationDisplay.pm index e700da31d5..2fff98f81b 100644 --- a/lib/WeBWorK/ContentGenerator/EquationDisplay.pm +++ b/lib/WeBWorK/ContentGenerator/EquationDisplay.pm @@ -14,117 +14,57 @@ ################################################################################ package WeBWorK::ContentGenerator::EquationDisplay; -use base qw(WeBWorK::ContentGenerator); +use parent qw(WeBWorK::ContentGenerator); =head1 NAME - WeBWorK::ContentGenerator::EquationDisplay -- create .png version of TeX equations. =cut use strict; use warnings; -#use CGI qw(-nosticky ); -use WeBWorK::CGI; + use WeBWorK::PG::ImageGenerator; sub display_equation { my ($self, $str) = @_; + my $ce = $self->r->ce; + + my $image_gen = WeBWorK::PG::ImageGenerator->new( + tempDir => $ce->{webworkDirs}{tmp}, + latex => $ce->{externalPrograms}{latex}, + dvipng => $ce->{externalPrograms}{dvipng}, + useCache => 1, + cacheDir => $ce->{webworkDirs}{equationCache}, + cacheURL => $ce->{webworkURLs}{equationCache}, + cacheDB => $ce->{webworkFiles}{equationCacheDB}, + useMarkers => 1, + dvipng_align => 'baseline', + dvipng_depth_db => { dbsource => '' }, + ); - my $imageTag = $self->{image_gen}->add($str, 'inline'); - $self->{image_gen}->render(); + my $imageTag = $image_gen->add($str, 'inline'); + $image_gen->render; return $imageTag; } -################################################################################ -# template escape handlers -################################################################################ - sub initialize { - my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; - - $self->{image_gen} = WeBWorK::PG::ImageGenerator->new( - tempDir => $ce->{webworkDirs}->{tmp}, # global temp dir - latex => $ce->{externalPrograms}->{latex}, - dvipng => $ce->{externalPrograms}->{dvipng}, - useCache => 1, - cacheDir => $ce->{webworkDirs}->{equationCache}, - cacheURL => $ce->{webworkURLs}->{equationCache}, - cacheDB => $ce->{webworkFiles}->{equationCacheDB}, - ); - - my $equationStr = $r->param('eq'); - $self->{equationStr} = $equationStr if defined $equationStr; - $self->{typesetStr} = $self->display_equation($equationStr) if $equationStr; -} - -#sub path { -# my ($self, $args) = @_; -# -# my $ce = $self->{ce}; -# my $root = $ce->{webworkURLs}->{root}; -# my $courseName = $ce->{courseName}; -# return $self->pathMacro($args, -# "Home" => "$root", -# $courseName => "$root/$courseName", -# "Feedback" => "", -# ); -#} -# -#sub title { -# return "Equation"; -#} - -sub body { my ($self) = @_; my $r = $self->r; - ####################################### - # Initial data for the textarea field where the equation is entered - ####################################### - my $initial_str = "Enter equation here"; - $initial_str = $r->param('eq') if $self->{equationStr}; + my $equationStr = $r->param('eq') // ''; - ####################################### - # Prepare to display the typeset image and - # the HTML code that links to the source image. - # The HTML code is linked also to the image address - # This requires digging out the link from the string returned - # by display_equation and ImageGenerator. - # The server name and port are included in the new url. - ####################################### - my $typesetStr = (defined $self->{typesetStr}) ? $self->{typesetStr} : ''; + # Prepare to display the typeset image and the HTML code that links to the source image. The HTML code is linked + # also to the image address This requires digging out the link from the string returned by display_equation and + # ImageGenerator. The server name and port are included in the new url. + $r->stash->{typesetStr} = $equationStr ? $self->display_equation($equationStr) : ''; - #### add the host name to the string + # Add the host name to the string. my $hostName = $r->req->url->to_abs->host_port; - $typesetStr =~ s|src="|src="http://$hostName|; - - my $typeset2Str = $typesetStr; - $typeset2Str =~ s//>/g; + $r->stash->{typesetStr} =~ s|src="|src="http://$hostName|; - my $sourceHref = $typesetStr; - $sourceHref =~ /"([^"]*)"/; - $sourceHref = $1; - - ####################################### - # Print the page - ####################################### - return join("", - "Copy the location of this image (or drag and drop) into your editing area:", - CGI::br(), - $typeset2Str, - CGI::br(), - $typesetStr, - CGI::start_form(-method => 'POST', -action => $r->uri), - $self->hidden_authen_fields, - CGI::textarea("eq", $initial_str, 5, 40), - CGI::submit('typeset', 'typeset'), - CGI::end_form(), - ); + return; } 1; diff --git a/lib/WeBWorK/ContentGenerator/Feedback.pm b/lib/WeBWorK/ContentGenerator/Feedback.pm index fcb317d02d..f0bd6e4c6c 100644 --- a/lib/WeBWorK/ContentGenerator/Feedback.pm +++ b/lib/WeBWorK/ContentGenerator/Feedback.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::Feedback; -use base qw(WeBWorK::ContentGenerator); +use parent qw(WeBWorK::ContentGenerator); =head1 NAME @@ -22,23 +22,17 @@ WeBWorK::ContentGenerator::Feedback - Send mail to professors. =cut -# *** feedback should be exempt from authentication, so that people can send -# feedback from the login page! - use strict; use warnings; use utf8; + use Data::Dumper; -use Data::Dump qw/dump/; -use WeBWorK::Debug; -use WeBWorK::CGI; use Email::Stuffer; use Try::Tiny; -use WeBWorK::Upload; - -use Socket qw/unpack_sockaddr_in inet_ntoa/; # for remote host/port info use Text::Wrap qw(wrap); -use WeBWorK::Utils qw/ decodeAnswers/; + +use WeBWorK::Upload; +use WeBWorK::Utils qw/decodeAnswers/; # request paramaters used # @@ -63,7 +57,7 @@ use WeBWorK::Utils qw/ decodeAnswers/; # problem object for current problem (if from Problem) # display options (if from Problem) -sub body { +sub initialize { my ($self) = @_; my $r = $self->r; my $ce = $r->ce; @@ -71,59 +65,45 @@ sub body { my $authz = $r->authz; # get form fields - my $key = $r->param("key"); - my $userName = $r->param("user"); - my $module = $r->param("module"); - my $setName = $r->param("set"); - my $problemNumber = $r->param("problem"); - my $displayMode = $r->param("displayMode"); - my $showOldAnswers = $r->param("showOldAnswers"); - my $showCorrectAnswers = $r->param("showCorrectAnswers"); - my $showHints = $r->param("showHints"); - my $showSolutions = $r->param("showSolutions"); - my $from = $r->param("from"); - my $feedback = $r->param("feedback"); - my $courseID = $r->urlpath->arg("courseID"); + my $userID = $r->param('user'); + my $module = $r->param('module'); + my $setID = $r->param('set'); + my $problemID = $r->param('problem'); + my $from = $r->param('from'); + my $feedback = $r->param('feedback'); + my $courseID = $r->urlpath->arg('courseID'); my ($user, $set, $problem); - $user = $db->getUser($userName) # checked - if defined $userName and $userName ne ""; + + $user = $db->getUser($userID) if $userID; + $r->stash->{user_email_address} = $user ? $user->email_address : ''; + if (defined $user) { - $set = $db->getMergedSet($userName, $setName) # checked - if defined $setName and $setName ne ""; - $problem = $db->getMergedProblem($userName, $setName, $problemNumber) # checked - if defined $set and defined $problemNumber && $problemNumber ne ""; + $set = $db->getMergedSet($userID, $setID) if defined $setID && $setID ne ''; + $problem = $db->getMergedProblem($userID, $setID, $problemID) + if defined $set && defined $problemID && $problemID ne ''; } else { - $set = $db->getGlobalSet($setName) # checked - if defined $setName and $setName ne ""; - $problem = $db->getGlobalProblem($setName, $problemNumber) # checked - if defined $set and defined $problemNumber && $problemNumber ne ""; + $set = $db->getGlobalSet($setID) if defined $setID && $setID ne ''; + $problem = $db->getGlobalProblem($setID, $problemID) + if defined $set && defined $problemID && $problemID ne ''; } - # generate context URLs - my ($emailableURL, $returnURL) = $self->generateURLs(set_id => $setName, problem_id => $problemNumber); + # Generate context URLs. + (my $emailableURL, $r->stash->{returnURL}) = $self->generateURLs(set_id => $setID, problem_id => $problemID); - my $homeModulePath = $r->urlpath->newFromModule("WeBWorK::ContentGenerator::Home", $r); - my $systemURL = $self->systemLink($homeModulePath, authen => 0, use_abs_url => 1); + return unless $authz->hasPermissions($userID, 'submit_feedback'); - unless ($authz->hasPermissions($userName, "submit_feedback")) { - $self->feedbackNotAllowed($returnURL); - return ""; - } - - # determine the recipients of the email + # Determine the recipients of the email. my @recipients = $self->getFeedbackRecipients($user); + $r->stash->{numRecipients} = scalar @recipients; - unless (@recipients) { - $self->noRecipientsAvailable($returnURL); - return ""; - } + return unless $r->stash->{numRecipients}; - if (defined $r->param("sendFeedback")) { - # get verbosity level - my $verbosity = $ce->{mail}->{feedbackVerbosity}; + if (defined $r->param('sendFeedback')) { + # Get verbosity level. + my $verbosity = $ce->{mail}{feedbackVerbosity}; - # determine the sender of the email + # Determine the sender of the email. my $sender; if ($user) { if ($user->email_address) { @@ -139,14 +119,13 @@ sub body { $sender = $from; } - # sanity checks unless ($sender) { - $self->feedbackForm($user, $returnURL, "No Sender specified."); - return ""; + $r->stash->{send_error} = $r->maketext('No Sender specified.'); + return; } unless ($feedback) { - $self->feedbackForm($user, $returnURL, "Message was blank."); - return ""; + $r->stash->{send_error} = $r->maketext('Message was blank.'); + return; } my %subject_map = ( @@ -158,21 +137,19 @@ sub body { 'r' => $user ? $user->recitation : undef, '%' => '%', ); - my $chars = join("", keys %subject_map); - my $subject = $ce->{mail}{feedbackSubjectFormat} - || "WeBWorK question from %c: %u set %s/prob %p"; # default if not entered - $subject =~ s/%([$chars])/defined $subject_map{$1} ? $subject_map{$1} : ""/eg; - - # If in the future any fields in the subject can contain non-ASCII characters - # then we will also need: - # $subject = Encode::encode("MIME-Header", $subject); - # at present, this does not seem to be necessary. - - # get info about remote user (stolen from &WeBWorK::Authen::write_log_entry) - my ($remote_host, $remote_port); - - $remote_host = $r->useragent_ip || "UNKNOWN"; - $remote_port = $r->remote_port || "UNKNOWN"; + my $chars = join('', keys %subject_map); + my $subject = $ce->{mail}{feedbackSubjectFormat} || 'WeBWorK question from %c: %u set %s/prob %p'; + $subject =~ s/%([$chars])/defined $subject_map{$1} ? $subject_map{$1} : ''/eg; + + # Get info about remote user. + my $remote_host = $r->useragent_ip || 'UNKNOWN'; + my $remote_port = $r->remote_port || 'UNKNOWN'; + + my $systemURL = $self->systemLink( + $r->urlpath->newFromModule("WeBWorK::ContentGenerator::Home", $r), + authen => 0, + use_abs_url => 1 + ); my $msg = qq/This message was automatically generated by the WeBWorK system at $systemURL, in response to a request from $remote_host:$remote_port. @@ -188,34 +165,36 @@ $emailableURL if ($problem and $verbosity >= 1) { $msg .= qq/***** Data about the problem processor: ***** \n\n/ - . "Display Mode: $displayMode\n" - . "Show Old Answers: " - . ($showOldAnswers ? "yes" : "no") . "\n" - . " Show Correct Answers: " - . ($showCorrectAnswers ? "yes" : "no") . "\n" - . " Show Hints: " - . ($showHints ? "yes" : "no") . "\n" - . " Show Solutions: " - . ($showSolutions ? "yes" : "no") . "\n\n"; + . 'Display Mode: ' + . $r->param('displayMode') . "\n" + . 'Show Old Answers: ' + . ($r->param('showOldAnswers') ? 'yes' : 'no') . "\n" + . 'Show Correct Answers: ' + . ($r->param('showCorrectAnswers') ? 'yes' : 'no') . "\n" + . 'Show Hints: ' + . ($r->param('showHints') ? 'yes' : 'no') . "\n" + . 'Show Solutions: ' + . ($r->param('showSolutions') ? 'yes' : 'no') . "\n\n"; } - if ($user and $verbosity >= 1) { + if ($user && $verbosity >= 1) { $msg .= "***** Data about the user: *****\n\n"; $msg .= $self->format_user($user) . "\n"; } - if ($problem and $verbosity >= 1) { + if ($problem && $verbosity >= 1) { $msg .= "***** Data about the problem: *****\n\n"; $msg .= $self->format_userproblem($problem) . "\n"; } - if ($set and $verbosity >= 1) { + if ($set && $verbosity >= 1) { $msg .= "***** Data about the homework set: *****\n\n" . $self->format_userset($set) . "\n"; } - if ($ce and $verbosity >= 2) { - $msg .= "***** Data about the environment: *****\n\n", $msg .= Dumper($ce) . "\n\n"; + if ($ce && $verbosity >= 2) { + $msg .= "***** Data about the environment: *****\n\n" . Dumper($ce) . "\n\n"; } - my $email = Email::Stuffer->to(join(',', @recipients))->from($sender)->subject($subject)->text_body($msg) + my $email = + Email::Stuffer->to(join(',', @recipients))->from($sender)->subject($subject)->text_body($msg) ->header('X-Remote-Host' => $remote_host); # Extra headers @@ -248,148 +227,50 @@ $emailableURL # Check to see that this is an allowed filetype. unless (lc($filename =~ s/.*\.//r) =~ /^(jpe?g|gif|png|pdf|zip|txt|csv)$/) { - $self->feedbackForm($user, $returnURL, - $r->maketext('The filetype of the attached file "[_1]" is not allowed.', $filename)); - return ''; + $r->stash->{send_error} = + $r->maketext('The filetype of the attached file "[_1]" is not allowed.', $filename); + return; } # Check to see that the attached file does not exceed the allowed size. if (length($contents) > $ce->{mail}{maxAttachmentSize} * 1000000) { - $self->feedbackForm( - $user, - $returnURL, - $r->maketext( - 'The attached file "[_1]" exceeds the allowed attachment size of [quant,_2,megabyte].', - $filename, $ce->{mail}{maxAttachmentSize} - ) - ); - return ''; + + $r->stash->{send_error} = + $r->maketext('The attached file "[_1]" exceeds the allowed attachment size of [quant,_2,megabyte].', + $filename, $ce->{mail}{maxAttachmentSize}); + return; } # Attach the file. $email->attach($contents, filename => $filename); } - # $ce->{mail}{set_return_path} is the address used to report returned email if defined and non empty. - # It is an argument used in sendmail() (aka Email::Stuffer::send_or_die). - # For arcane historical reasons sendmail actually sets the field "MAIL FROM" and the smtp server then - # uses that to set "Return-Path". - # references: - # https://stackoverflow.com/questions/1235534/what-is-the-behavior-difference-between-return-path-reply-to-and-from - # https://metacpan.org/pod/Email::Sender::Manual::QuickStart#envelope-information + # $ce->{mail}{set_return_path} is the address used to report returned email if defined and non empty. + # It is an argument used in sendmail (via Email::Stuffer::send_or_die). + # For arcane historical reasons sendmail actually sets the field "MAIL FROM" and the smtp server then + # uses that to set "Return-Path". + # references: + # https://stackoverflow.com/questions/1235534/ + # what-is-the-behavior-difference-between-return-path-reply-to-and-from + # https://metacpan.org/pod/Email::Sender::Manual::QuickStart#envelope-information try { $email->send_or_die({ # createEmailSenderTransportSMTP is defined in ContentGenerator transport => $self->createEmailSenderTransportSMTP(), $ce->{mail}{set_return_path} ? (from => $ce->{mail}{set_return_path}) : () }); - print CGI::p($r->maketext('Your message was sent successfully.')); - print CGI::p(CGI::a({ -href => $returnURL }, $r->maketext('Return to your work'))); - print CGI::pre(wrap('', '', $feedback)); } catch { - $self->feedbackForm($user, $returnURL, "Failed to send message: $_"); + $r->stash->{send_error} = $r->maketext('Failed to send message: [_1]', $_); }; - } else { - # just print the feedback form, with no message - $self->feedbackForm($user, $returnURL, ''); } - return ''; -} - -sub feedbackNotAllowed { - my ($self, $returnURL) = @_; - - print CGI::p("You are not allowed to send e-mail."); - print CGI::p(CGI::a({ -href => $returnURL }, "Cancel E-Mail")) if $returnURL; -} - -sub noRecipientsAvailable { - my ($self, $returnURL) = @_; - - print CGI::p("No e-mail recipients are listed for this course."); - print CGI::p(CGI::a({ -href => $returnURL }, "Cancel E-Mail")) if $returnURL; + return; } sub title { - my ($self, $user, $returnURL, $message) = @_; - my $r = $self->r; - return $r->maketext("E-mail Instructor"); -} - -sub feedbackForm { - my ($self, $user, $returnURL, $message) = @_; + my ($self) = @_; my $r = $self->r; - - print CGI::start_form(-method => 'POST', -action => $r->uri); - print $self->hidden_authen_fields; - print $self->hidden_fields(qw( - module set problem displayMode showOldAnswers showCorrectAnswers - showHints showSolutions - )); - - print CGI::div( - { class => 'mb-3' }, - $r->maketext( - 'Use this form to ask your instructor a question, to report a problem with the WeBWorK system, or ' - . 'to report an error in a problem you are attempting. Along with your message, additional ' - . 'information about the state of the system will be included.' - ) - ); - - print CGI::div( - { class => 'row mb-3' }, - CGI::label({ for => 'from', class => 'col-form-label col-auto' }, CGI::b($r->maketext('From:'))), - CGI::div( - { class => 'col-auto' }, - CGI::textfield({ - class => 'form-control', - size => 40, - name => 'from', - id => 'from', - $user && $user->email_address - ? (disabled => undef, readonly => undef, value => $user->email_address) - : (required => undef, value => $r->param('from') // '') - }) - ) - ); - print CGI::div({ class => 'alert alert-danger mb-3' }, $message) if $message; - print CGI::div( - { class => 'mb-3' }, - CGI::label({ for => 'feedback', class => 'form-label' }, CGI::b($r->maketext('E-mail:'))), - CGI::textarea({ - name => 'feedback', - id => 'feedback', - rows => '20', - class => 'form-control', - placeholder => $r->maketext('Compose Email Message'), - value => $r->param('feedback') // '', - required => undef - }), - ); - - # Attachment - print CGI::div( - { class => 'row mb-3' }, - CGI::label( - { for => 'attachment', class => 'col-form-label col-auto' }, CGI::b($r->maketext('Attachment:')) - ), - CGI::div( - { class => 'col-auto' }, - CGI::filefield({ - name => 'attachment', - id => 'attachment', - class => 'form-control', - accept => 'image/*,application/pdf,application/zip,text/plain,text/csv' - }) - ) - ); - - print CGI::submit( - { name => 'sendFeedback', value => $r->maketext('Send E-mail'), class => 'btn btn-primary mb-1' }); - print CGI::end_form(); - print CGI::div(CGI::a({ href => $returnURL, class => 'btn btn-primary mt-2' }, $r->maketext('Cancel E-mail'))) - if $returnURL; + return $r->ce->{feedback_button_name} || $r->maketext('E-mail Instructor'); } sub getFeedbackRecipients { diff --git a/lib/WeBWorK/ContentGenerator/GatewayQuiz.pm b/lib/WeBWorK/ContentGenerator/GatewayQuiz.pm index 072b88ead8..bc8b826d1d 100644 --- a/lib/WeBWorK/ContentGenerator/GatewayQuiz.pm +++ b/lib/WeBWorK/ContentGenerator/GatewayQuiz.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::GatewayQuiz; -use base qw(WeBWorK::ContentGenerator); +use parent qw(WeBWorK::ContentGenerator); =head1 NAME @@ -27,392 +27,273 @@ use strict; use warnings; use Future::AsyncAwait; +use Mojo::Promise; use WeBWorK::Form; -use WeBWorK::PG; use WeBWorK::PG::ImageGenerator; -use WeBWorK::PG::IO; # Use the ContentGenerator formatDateTime, not the version in Utils. use WeBWorK::Utils qw(writeLog writeCourseLogGivenTime encodeAnswers decodeAnswers - path_is_subdir before after getAssetURL between wwRound is_restricted); + path_is_subdir before after between wwRound is_restricted); use WeBWorK::Utils::Rendering qw(getTranslatorDebuggingOptions renderPG); use WeBWorK::Utils::ProblemProcessing qw/create_ans_str_from_responses compute_reduced_score/; use WeBWorK::DB::Utils qw(global2user); use WeBWorK::Utils::Tasks qw(fake_set fake_set_version fake_problem); use WeBWorK::Debug; -use WeBWorK::ContentGenerator::Instructor qw(assignSetVersionToUser); use WeBWorK::Authen::LTIAdvanced::SubmitGrade; -use WeBWorK::Utils::AttemptsTable; -use WeBWorK::ContentGenerator::Instructor::SingleProblemGrader; +use WeBWorK::HTML::AttemptsTable; use PGrandom; - use Caliper::Sensor; use Caliper::Entity; -# template method -sub templateName { - return "gateway"; +# Disable links for gateway tests. +sub can { + my ($self, $arg) = @_; + return $arg eq 'links' ? 0 : $self->SUPER::can($arg); } -################################################################################ # "can" methods -################################################################################ - # Subroutines to determine if a user "can" perform an action. Each subroutine is # called with the following arguments: -# -# ($self, $User, $PermissionLevel, $EffectiveUser, $Set, $Problem) - -# *** The "can" routines are taken from Problem.pm, with small modifications -# *** to look at number of attempts per version, not per set, and to allow -# *** showing of correct answers after all attempts at a version are used +# ($self, $user, $effectiveUser, $set, $problem, $tmplSet) +# In addition can_recordAnswers and can_checkAnswers have the argument $submitAnswers +# that is used to distinguish between this submission and the next. sub can_showOldAnswers { - my ($self, $User, $PermissionLevel, $EffectiveUser, $Set, $Problem, $tmplSet) = @_; + my ($self, $user, $permissionLevel, $effectiveUser, $set, $problem, $tmplSet) = @_; my $authz = $self->r->authz; - # we'd like to use "! $Set->hide_work()", but that hides students' work - # as they're working on the set, which isn't quite right. so use instead: - return 0 unless $authz->hasPermissions($User->user_id, "can_show_old_answers"); + + return 0 unless $authz->hasPermissions($user->user_id, 'can_show_old_answers'); return ( - before($Set->due_date(), $self->r->{submitTime}) - || $authz->hasPermissions($User->user_id, "view_hidden_work") - || ($Set->hide_work() eq 'N' - || ($Set->hide_work() eq 'BeforeAnswerDate' && time > $tmplSet->answer_date)) + before($set->due_date, $self->r->submitTime) + || $authz->hasPermissions($user->user_id, 'view_hidden_work') + || ($set->hide_work eq 'N' + || ($set->hide_work eq 'BeforeAnswerDate' && after($tmplSet->answer_date, $self->r->submitTime))) ); } -# gateway change here: add $submitAnswers as an optional additional argument -# to be included if it's defined sub can_showCorrectAnswers { - my ($self, $User, $PermissionLevel, $EffectiveUser, $Set, $Problem, $tmplSet, $submitAnswers) = @_; + my ($self, $user, $permissionLevel, $effectiveUser, $set, $problem, $tmplSet) = @_; my $authz = $self->r->authz; - # gateway change here to allow correct answers to be viewed after all attempts - # at a version are exhausted as well as if it's after the answer date - # $addOne allows us to count the current submission - my $addOne = defined($submitAnswers) ? $submitAnswers : 0; - my $maxAttempts = $Set->attempts_per_version() || 0; - my $attemptsUsed = $Problem->num_correct + $Problem->num_incorrect + $addOne || 0; - - # this is complicated by trying to address hiding scores by problem---that - # is, if $set->hide_score_by_problem and $set->hide_score are both set, - # then we should allow scores to be shown, but not show the score on - # any individual problem. to deal with this, we make - # can_showCorrectAnswers give the least restrictive view of hiding, and - # then filter scores for the problems themselves later - - # showing correcrt answers but not showing scores doesn't make sense - # so we should hide the correct answers if we aren not showing - # scores GG. - - my $canShowScores = $Set->hide_score_by_problem eq 'N' - && ($Set->hide_score eq 'N' - || ($Set->hide_score eq 'BeforeAnswerDate' && after($tmplSet->answer_date, $self->r->{submitTime}))); + # Allow correct answers to be viewed after all attempts at a version + # are exhausted or if it is after the answer date. + my $attemptsPerVersion = $set->attempts_per_version || 0; + my $attemptsUsed = $problem->num_correct + $problem->num_incorrect + ($self->{submitAnswers} ? 1 : 0); + # This is complicated by trying to address hiding scores by problem. That is, if $set->hide_score_by_problem and + # $set->hide_score are both set, then we should allow scores to be shown, but not show the score on any individual + # problem. To deal with this, we make can_showCorrectAnswers give the least restrictive view of hiding, and then + # filter scores for the problems themselves later. return ( ( ( - after($Set->answer_date, $self->r->{submitTime}) || ($attemptsUsed >= $maxAttempts - && $maxAttempts != 0 - && $Set->due_date() == $Set->answer_date()) + after($set->answer_date, $self->r->submitTime) || ($attemptsUsed >= $attemptsPerVersion + && $attemptsPerVersion != 0 + && $set->due_date == $set->answer_date) ) - || $authz->hasPermissions($User->user_id, "show_correct_answers_before_answer_date") + || $authz->hasPermissions($user->user_id, 'show_correct_answers_before_answer_date') ) - && ($authz->hasPermissions($User->user_id, "view_hidden_work") || $canShowScores) + && ( + $authz->hasPermissions($user->user_id, 'view_hidden_work') + || $set->hide_score_by_problem eq 'N' && ($set->hide_score eq 'N' + || ($set->hide_score eq 'BeforeAnswerDate' && after($tmplSet->answer_date, $self->r->submitTime))) + ) ); } sub can_showProblemGrader { - my ($self, $User, $PermissionLevel, $EffectiveUser, $Set, $Problem) = @_; + my ($self, $user, $permissionLevel, $effectiveUser, $set) = @_; my $authz = $self->r->authz; - return ($authz->hasPermissions($User->user_id, "access_instructor_tools") - && $authz->hasPermissions($User->user_id, "score_sets") - && $Set->set_id ne "Undefined_Set" + return ($authz->hasPermissions($user->user_id, 'access_instructor_tools') + && $authz->hasPermissions($user->user_id, 'score_sets') + && $set->set_id ne 'Undefined_Set' && !$self->{invalidSet}); } -sub can_showHints { - #my ($self, $User, $PermissionLevel, $EffectiveUser, $Set, $Problem) = @_; - return 1; -} +sub can_showHints { return 1; } -# gateway change here: add $submitAnswers as an optional additional argument -# to be included if it's defined sub can_showSolutions { - my ($self, $User, $PermissionLevel, $EffectiveUser, $Set, $Problem, $tmplSet, $submitAnswers) = @_; + my ($self, $user, $permissionLevel, $effectiveUser, $set, $problem, $tmplSet) = @_; my $authz = $self->r->authz; - return 1 if $authz->hasPermissions($User->user_id, 'always_show_solution'); - - # this is the same as can_showCorrectAnswers - # gateway change here to allow correct answers to be viewed after all attempts - # at a version are exhausted as well as if it's after the answer date - # $addOne allows us to count the current submission - my $addOne = defined($submitAnswers) ? $submitAnswers : 0; - my $attempts_per_version = $Set->attempts_per_version() || 0; - my $attemptsUsed = $Problem->num_correct + $Problem->num_incorrect + $addOne || 0; - - # this is complicated by trying to address hiding scores by problem---that - # is, if $set->hide_score_by_problem and $set->hide_score are both set, - # then we should allow scores to be shown, but not show the score on - # any individual problem. to deal with this, we make can_showSolutions - # give the least restrictive view of hiding, and then filter scores for - # the problems themselves later - # showing correcrt answers but not showing scores doesn't make sense - # so we should hide the correct answers if we aren not showing - # scores GG. - - my $canShowScores = $Set->hide_score_by_problem eq 'N' - && ($Set->hide_score eq 'N' - || ($Set->hide_score eq 'BeforeAnswerDate' && after($tmplSet->answer_date, $self->r->{submitTime}))); + return 1 if $authz->hasPermissions($user->user_id, 'always_show_solution'); - return ( - ( - ( - after($Set->answer_date, $self->r->{submitTime}) || ($attemptsUsed >= $attempts_per_version - && $attempts_per_version != 0 - && $Set->due_date() == $Set->answer_date()) - ) - || $authz->hasPermissions($User->user_id, "show_correct_answers_before_answer_date") - ) - && ($authz->hasPermissions($User->user_id, "view_hidden_work") || $canShowScores) - ); + # This is the same as can_showCorrectAnswers. + return $self->can_showCorrectAnswers($user, $permissionLevel, $effectiveUser, $set, $problem, $tmplSet, + $self->{submitAnswers}); } -# gateway change here: add $submitAnswers as an optional additional argument -# to be included if it's defined -# we also allow for a version_last_attempt_time which is the time the set was -# submitted; if that's present we use that instead of the current time to -# decide if we can record the answers. this deals with the time between the -# submission time and the proctor authorization. +# Allow for a version_last_attempt_time which is the time the set was submitted. If that is present we use that instead +# of the current time to decide if answers can be recorded. This deals with the time between the submission time and +# the proctor authorization. sub can_recordAnswers { - my ($self, $User, $PermissionLevel, $EffectiveUser, $Set, $Problem, $tmplSet, $submitAnswers) = @_; + my ($self, $user, $permissionLevel, $effectiveUser, $set, $problem, $tmplSet, $submitAnswers) = @_; my $authz = $self->r->authz; - # easy first case: never record answers for undefined sets - return 0 if $Set->set_id eq "Undefined_Set"; + # Never record answers for undefined sets + return 0 if $set->set_id eq 'Undefined_Set'; - my $timeNow = defined($self->{timeNow}) ? $self->{timeNow} : $self->r->{submitTime}; - # get the sag time after the due date in which we'll still grade the test - my $grace = $self->{ce}->{gatewayGracePeriod}; + if ($user->user_id ne $effectiveUser->user_id) { + # If the user is not allowed to record answers as another user, return that permission. If the user is allowed + # to record only set version answers, then allow that between the open and close dates, and so drop out of this + # conditional to the usual one. + return 1 if $authz->hasPermissions($user->user_id, 'record_answers_when_acting_as_student'); + return 0 if !$authz->hasPermissions($user->user_id, 'record_set_version_answers_when_acting_as_student'); + } my $submitTime = - ($Set->assignment_type eq 'proctored_gateway' - && defined($Set->version_last_attempt_time()) - && $Set->version_last_attempt_time()) ? $Set->version_last_attempt_time() : $timeNow; - - if ($User->user_id ne $EffectiveUser->user_id) { - my $recordAsOther = $authz->hasPermissions($User->user_id, "record_answers_when_acting_as_student"); - my $recordVersionsAsOther = - $authz->hasPermissions($User->user_id, "record_set_version_answers_when_acting_as_student"); - - if ($recordAsOther) { - return $recordAsOther; - } elsif (!$recordVersionsAsOther) { - return $recordVersionsAsOther; - } - ## if we're not allowed to record answers as another user, - ## return that permission. if we're allowed to record - ## only set version answers, then we allow that between - ## the open and close dates, and so drop out of this - ## conditional to the usual one. - ## it isn't clear if this is the correct behavior, but I - ## think it's probably reasonable. - } + ($set->assignment_type eq 'proctored_gateway' && $set->version_last_attempt_time) + ? $set->version_last_attempt_time + : $self->r->submitTime; - if (before($Set->open_date, $submitTime)) { - return $authz->hasPermissions($User->user_id, "record_answers_before_open_date"); - } elsif (between($Set->open_date, $Set->due_date + $grace, $submitTime)) { - - # gateway change here; we look at maximum attempts per version, not for the set, - # to determine the number of attempts allowed - # $addOne allows us to count the current submission - my $addOne = (defined($submitAnswers) && $submitAnswers) ? 1 : 0; - my $attempts_per_version = $Set->attempts_per_version() || 0; - my $attempts_used = $Problem->num_correct + $Problem->num_incorrect + $addOne; - if ($attempts_per_version == 0 or $attempts_used < $attempts_per_version) { - return $authz->hasPermissions($User->user_id, "record_answers_after_open_date_with_attempts"); + return $authz->hasPermissions($user->user_id, 'record_answers_before_open_date') + if before($set->open_date, $submitTime); + + if (between($set->open_date, $set->due_date + $self->{ce}{gatewayGracePeriod}, $submitTime)) { + # Look at maximum attempts per version, not for the set, to determine the number of attempts allowed. + my $attemptsPerVersion = $set->attempts_per_version || 0; + my $attemptsUsed = $problem->num_correct + $problem->num_incorrect + ($submitAnswers ? 1 : 0); + + if ($attemptsPerVersion == 0 || $attemptsUsed < $attemptsPerVersion) { + return $authz->hasPermissions($user->user_id, 'record_answers_after_open_date_with_attempts'); } else { - return $authz->hasPermissions($User->user_id, "record_answers_after_open_date_without_attempts"); + return $authz->hasPermissions($user->user_id, 'record_answers_after_open_date_without_attempts'); } - } elsif (between(($Set->due_date + $grace), $Set->answer_date, $submitTime)) { - return $authz->hasPermissions($User->user_id, "record_answers_after_due_date"); - } elsif (after($Set->answer_date, $submitTime)) { - return $authz->hasPermissions($User->user_id, "record_answers_after_answer_date"); } + + return $authz->hasPermissions($user->user_id, 'record_answers_after_due_date') + if between(($set->due_date + $self->{ce}{gatewayGracePeriod}), $set->answer_date, $submitTime); + + return $authz->hasPermissions($user->user_id, 'record_answers_after_answer_date') + if after($set->answer_date, $submitTime); + + return 0; } -# gateway change here: add $submitAnswers as an optional additional argument -# to be included if it's defined -# we also allow for a version_last_attempt_time which is the time the set was -# submitted; if that's present we use that instead of the current time to -# decide if we can check the answers. this deals with the time between the -# submission time and the proctor authorization. +# Allow for a version_last_attempt_time which is the time the set was submitted. If that is present, then use that +# instead of the current time to decide if answers can be checked. This deals with the time between the submission time +# and the proctor authorization. sub can_checkAnswers { - my ($self, $User, $PermissionLevel, $EffectiveUser, $Set, $Problem, $tmplSet, $submitAnswers) = @_; + my ($self, $user, $permissionLevel, $effectiveUser, $set, $problem, $tmplSet, $submitAnswers) = @_; my $authz = $self->r->authz; - # if we can record answers then we dont need to be able to check them - # unless we have that specific permission. - if ($self->can_recordAnswers($User, $PermissionLevel, $EffectiveUser, $Set, $Problem, $tmplSet, $submitAnswers) - && !$authz->hasPermissions($User->user_id, "can_check_and_submit_answers")) - { - return 0; - } - - my $timeNow = defined($self->{timeNow}) ? $self->{timeNow} : $self->r->{submitTime}; - # get the sag time after the due date in which we'll still grade the test - my $grace = $self->{ce}->{gatewayGracePeriod}; + return 0 + if $self->can_recordAnswers($user, $permissionLevel, $effectiveUser, $set, $problem, $tmplSet, $submitAnswers) + && !$authz->hasPermissions($user->user_id, 'can_check_and_submit_answers'); my $submitTime = - ($Set->assignment_type eq 'proctored_gateway' - && defined($Set->version_last_attempt_time()) - && $Set->version_last_attempt_time()) ? $Set->version_last_attempt_time() : $timeNow; - - # this is further complicated by trying to address hiding scores by - # problem---that is, if $set->hide_score_by_problem and - # $set->hide_score are both set, then we should allow scores to - # be shown, but not show the score on any individual problem. - # to deal with this, we use the least restrictive view of hiding - # here, and then filter for the problems themselves later - # showing correcrt answers but not showing scores doesn't make sense - # so we should hide the correct answers if we aren not showing - # scores GG. - - my $canShowScores = $Set->hide_score_by_problem eq 'N' - && ($Set->hide_score eq 'N' - || ($Set->hide_score eq 'BeforeAnswerDate' && after($tmplSet->answer_date, $self->r->{submitTime}))); - - if (before($Set->open_date, $submitTime)) { - return $authz->hasPermissions($User->user_id, "check_answers_before_open_date"); - } elsif (between($Set->open_date, $Set->due_date + $grace, $submitTime)) { - - # gateway change here; we look at maximum attempts per version, not for the set, - # to determine the number of attempts allowed - # $addOne allows us to count the current submission - my $addOne = (defined($submitAnswers) && $submitAnswers) ? 1 : 0; - my $attempts_per_version = $Set->attempts_per_version() || 0; - my $attempts_used = $Problem->num_correct + $Problem->num_incorrect + $addOne; - - if ($attempts_per_version == -1 or $attempts_used < $attempts_per_version) { - return ( - $authz->hasPermissions($User->user_id, "check_answers_after_open_date_with_attempts") - && ($authz->hasPermissions($User->user_id, "view_hidden_work") - || $canShowScores) - ); + ($set->assignment_type eq 'proctored_gateway' && $set->version_last_attempt_time) + ? $set->version_last_attempt_time + : $self->r->submitTime; + + return $authz->hasPermissions($user->user_id, 'check_answers_before_open_date') + if before($set->open_date, $submitTime); + + # This is complicated by trying to address hiding scores by problem. If $set->hide_score_by_problem and + # $set->hide_score are both set, then allow scores to be shown, but don't show the score on any individual problem. + # To deal with this, use the least restrictive view of hiding, and then filter for the problems themselves later. + + my $canShowProblemScores = + $self->can_showProblemScores($user, $permissionLevel, $effectiveUser, $set, $problem, $tmplSet); + + if (between($set->open_date, $set->due_date + $self->{ce}{gatewayGracePeriod}, $submitTime)) { + # Look at maximum attempts per version, not for the set, to determine the number of attempts allowed. + my $attempts_per_version = $set->attempts_per_version || 0; + my $attempts_used = $problem->num_correct + $problem->num_incorrect + ($submitAnswers ? 1 : 0); + + if ($attempts_per_version == -1 || $attempts_used < $attempts_per_version) { + return $authz->hasPermissions($user->user_id, 'check_answers_after_open_date_with_attempts') + && $canShowProblemScores; } else { - return ( - $authz->hasPermissions($User->user_id, "check_answers_after_open_date_without_attempts") - && ($authz->hasPermissions($User->user_id, "view_hidden_work") - || $canShowScores) - ); + return $authz->hasPermissions($user->user_id, 'check_answers_after_open_date_without_attempts') + && $canShowProblemScores; } - } elsif (between(($Set->due_date + $grace), $Set->answer_date, $submitTime)) { - return ( - $authz->hasPermissions($User->user_id, "check_answers_after_due_date") - && ($authz->hasPermissions($User->user_id, "view_hidden_work") - || $canShowScores) - ); - } elsif (after($Set->answer_date, $submitTime)) { - return ( - $authz->hasPermissions($User->user_id, "check_answers_after_answer_date") - && ($authz->hasPermissions($User->user_id, "view_hidden_work") - || $canShowScores) - ); } + + return $authz->hasPermissions($user->user_id, 'check_answers_after_due_date') && $canShowProblemScores + if between(($set->due_date + $self->{ce}{gatewayGracePeriod}), $set->answer_date, $submitTime); + + return $authz->hasPermissions($user->user_id, 'check_answers_after_answer_date') && $canShowProblemScores + if after($set->answer_date, $submitTime); + + return 0; } sub can_showScore { - my ($self, $User, $PermissionLevel, $EffectiveUser, $Set, $Problem, $tmplSet, $submitAnswers) = @_; - my $authz = $self->r->authz; - - my $timeNow = defined($self->{timeNow}) ? $self->{timeNow} : $self->r->{submitTime}; + my ($self, $user, $permissionLevel, $effectiveUser, $set, $problem, $tmplSet) = @_; + return + $self->r->authz->hasPermissions($user->user_id, 'view_hidden_work') + || $set->hide_score eq 'N' + || ($set->hide_score eq 'BeforeAnswerDate' && after($tmplSet->answer_date, $self->r->submitTime)); +} - # address hiding scores by problem - my $canShowScores = ( - $Set->hide_score eq 'N' || ($Set->hide_score eq 'BeforeAnswerDate' - && after($tmplSet->answer_date, $self->r->{submitTime})) - ); +sub can_showProblemScores { + my ($self, $user, $permissionLevel, $effectiveUser, $set, $problem, $tmplSet) = @_; + return $self->can_showScore($user, $permissionLevel, $effectiveUser, $set, $problem, $tmplSet) + && ($set->hide_score_by_problem eq 'N' || $self->r->authz->hasPermissions($user->user_id, 'view_hidden_work')); +} - return ($authz->hasPermissions($User->user_id, "view_hidden_work") || $canShowScores); +sub can_showWork { + my ($self, $user, $permissionLevel, $effectiveUser, $set, $problem, $tmplSet) = @_; + return $self->r->authz->hasPermissions($user->user_id, 'view_hidden_work') + || ($set->hide_work eq 'N' + || ($set->hide_work eq 'BeforeAnswerDate' && $self->r->submitTime > $tmplSet->answer_date)); } sub can_useMathView { - my ($self, $User, $EffectiveUser, $Set, $Problem, $submitAnswers) = @_; - my $ce = $self->r->ce; - - return $ce->{pg}->{specialPGEnvironmentVars}->{entryAssist} eq 'MathView'; + my ($self) = @_; + return $self->r->ce->{pg}{specialPGEnvironmentVars}{entryAssist} eq 'MathView'; } sub can_useWirisEditor { - my ($self, $User, $EffectiveUser, $Set, $Problem, $submitAnswers) = @_; - my $ce = $self->r->ce; - - return $ce->{pg}->{specialPGEnvironmentVars}->{entryAssist} eq 'WIRIS'; + my ($self) = @_; + return $self->r->ce->{pg}{specialPGEnvironmentVars}{entryAssist} eq 'WIRIS'; } sub can_useMathQuill { - my ($self, $User, $EffectiveUser, $Set, $Problem, $submitAnswers) = @_; - my $ce = $self->r->ce; - - return $ce->{pg}->{specialPGEnvironmentVars}->{entryAssist} eq 'MathQuill'; + my ($self) = @_; + return $self->r->ce->{pg}{specialPGEnvironmentVars}{entryAssist} eq 'MathQuill'; } -################################################################################ -# output utilities -################################################################################ - +# Output utility sub attemptResults { - my $self = shift; - my $pg = shift; - my $showAttemptAnswers = shift; - my $showCorrectAnswers = shift; - my $showAttemptResults = $showAttemptAnswers && shift; - my $showSummary = shift; - my $showAttemptPreview = shift || 0; - my $ce = $self->{ce}; - - # to make grabbing these options easier, we'll pull them out now... - my %imagesModeOptions = %{ $ce->{pg}{displayModeOptions}{images} }; - - my $imgGen = WeBWorK::PG::ImageGenerator->new( - tempDir => $ce->{webworkDirs}{tmp}, - latex => $ce->{externalPrograms}{latex}, - dvipng => $ce->{externalPrograms}{dvipng}, - useCache => 1, - cacheDir => $ce->{webworkDirs}{equationCache}, - cacheURL => $ce->{webworkURLs}{equationCache}, - cacheDB => $ce->{webworkFiles}{equationCacheDB}, - useMarkers => 1, - dvipng_align => $imagesModeOptions{dvipng_align}, - dvipng_depth_db => $imagesModeOptions{dvipng_depth_db}, - ); - - my $showEvaluatedAnswers = $ce->{pg}{options}{showEvaluatedAnswers} // ''; + my ($self, $pg, $showCorrectAnswers, $showAttemptResults, $showSummary) = @_; + my $ce = $self->{ce}; # Create AttemptsTable object - my $tbl = WeBWorK::Utils::AttemptsTable->new( + my $tbl = WeBWorK::HTML::AttemptsTable->new( $pg->{answers}, + $self->r, answersSubmitted => 1, answerOrder => $pg->{flags}{ANSWER_ENTRY_ORDER}, displayMode => $self->{displayMode}, showHeadline => 0, showAnswerNumbers => 0, - showAttemptAnswers => $showAttemptAnswers && $showEvaluatedAnswers, - showAttemptPreviews => $showAttemptPreview, + showAttemptAnswers => $ce->{pg}{options}{showEvaluatedAnswers}, + showAttemptPreviews => 1, showAttemptResults => $showAttemptResults, showCorrectAnswers => $showCorrectAnswers, - showMessages => $showAttemptAnswers, # internally checks for messages + showMessages => 1, showSummary => $showSummary, - imgGen => $imgGen, # not needed if ce is present , - ce => '', # not needed if $imgGen is present - maketext => WeBWorK::Localize::getLoc($ce->{language}), + imgGen => WeBWorK::PG::ImageGenerator->new( + tempDir => $ce->{webworkDirs}{tmp}, + latex => $ce->{externalPrograms}{latex}, + dvipng => $ce->{externalPrograms}{dvipng}, + useCache => 1, + cacheDir => $ce->{webworkDirs}{equationCache}, + cacheURL => $ce->{webworkURLs}{equationCache}, + cacheDB => $ce->{webworkFiles}{equationCacheDB}, + useMarkers => 1, + dvipng_align => $ce->{pg}{displayModeOptions}{images}{dvipng_align}, + dvipng_depth_db => $ce->{pg}{displayModeOptions}{images}{dvipng_depth_db}, + ), ); my $answerTemplate = $tbl->answerTemplate; $tbl->imgGen->render(body_text => $answerTemplate) if $tbl->displayMode eq 'images'; + return $answerTemplate; } @@ -424,7 +305,7 @@ sub get_instructor_comment { my $db = $self->r->db; my $userPastAnswerID = $db->latestProblemPastAnswer( $self->{ce}{courseName}, - $problem->user_id, $problem->set_id . ",v" . $problem->version_id, + $problem->user_id, $problem->set_id . ',v' . $problem->version_id, $problem->problem_id ); @@ -433,107 +314,97 @@ sub get_instructor_comment { return $userPastAnswer->comment_string; } - return ""; + return ''; } -################################################################################ -# Template escape implementations -################################################################################ - -# FIXME need to make $Set and $set be used consistently +# Template methods async sub pre_header_initialize { my ($self) = @_; - - # if authz->checkSet has failed, this set is invalid, and no need to proceeded. + my $r = $self->r; + + # Make sure these are defined for the templates. + $r->stash->{problems} = []; + $r->stash->{pg_results} = []; + $r->stash->{startProb} = 0; + $r->stash->{endProb} = 0; + $r->stash->{numPages} = 0; + $r->stash->{pageNumber} = 0; + $r->stash->{problem_numbers} = []; + $r->stash->{probOrder} = []; + + # If authz->checkSet has failed, then this set is invalid. No need to proceeded. return if $self->{invalidSet}; - my $r = $self->r; my $ce = $r->ce; my $db = $r->db; my $authz = $r->authz; my $urlpath = $r->urlpath; - my $setName = $urlpath->arg("setID"); - my $userName = $r->param('user'); - my $effectiveUserName = $r->param('effectiveUser'); - my $key = $r->param('key'); - - # should we allow a new version to be created when acting as a user? - my $verCreateOK = defined($r->param('createnew_ok')) ? $r->param('createnew_ok') : 0; + my $setID = $urlpath->arg('setID'); + my $userID = $r->param('user'); + my $effectiveUserID = $r->param('effectiveUser'); - # user checks - my $User = $db->getUser($userName); - die "record for user $userName (real user) does not exist." unless defined $User; + # User checks + my $user = $db->getUser($userID); + die "record for user $userID (real user) does not exist." unless defined $user; - my $EffectiveUser = $db->getUser($effectiveUserName); - die "record for user $effectiveUserName (effective user) does not exist." unless defined $EffectiveUser; + my $effectiveUser = $db->getUser($effectiveUserID); + die "record for user $effectiveUserID (effective user) does not exist." unless defined $effectiveUser; - my $PermissionLevel = $db->getPermissionLevel($userName); - die "permission level record for $userName does not exist (but the user does? odd...)" - unless defined($PermissionLevel); + my $permissionLevel = $db->getPermissionLevel($userID); + die "permission level record for $userID does not exist (but the user does? odd...)" + unless defined $permissionLevel; - my $permissionLevel = $PermissionLevel->permission; + # The $setID could be the versioned or nonversioned set. Extract the version if it is provided. + my $requestedVersion = ($setID =~ /,v(\d+)$/) ? $1 : 0; + $setID =~ s/,v\d+$//; + # Note that if a version was provided the version needs to be checked. That is done after it has + # been validated that the user is assigned the set. - # we could be coming in with $setName = the versioned or nonversioned set - # deal with that first - my $requestedVersion = ($setName =~ /,v(\d+)$/) ? $1 : 0; - $setName =~ s/,v\d+$//; - # note that if we're already working with a version we want to be sure to stick - # with that version. we do this after we've validated that the user is - # assigned the set, below + # Gateway set and problem collection - ################################### - # gateway set and problem collection - ################################### + # We need the template (user) set, the merged set version, and a problem from the set to be able to test whether + # we're creating a new set version. + my ($tmplSet, $set, $problem) = (0, 0, 0); - # we need the template (user) set, the merged set-version, and a - # problem from the set to be able to test whether we're creating a - # new set version. assemble these - my ($tmplSet, $set, $Problem) = (0, 0, 0); - - # if the set comes in as "Undefined_Set", then we're trying/editing a - # single problem in a set, and so create a fake set with which to work - # if the user has the authorization to do that. - if ($setName eq "Undefined_Set") { - - # make sure these are defined + # If the set comes in as "Undefined_Set", then we're trying/editing a single problem in a set, and so create a fake + # set with which to work if the user has the authorization to do that. + if ($setID eq 'Undefined_Set') { + # Make sure these are defined $requestedVersion = 1; $self->{assignment_type} = 'gateway'; - if (!$authz->hasPermissions($userName, "modify_problem_sets")) { - $self->{invalidSet} = "You do not have the " . "authorization level required to view/edit undefined sets."; + if (!$authz->hasPermissions($userID, 'modify_problem_sets')) { + $self->{invalidSet} = 'You do not have the authorization level required to view/edit undefined sets.'; - # define these so that we can drop through - # to report the error in body() + # Define these so that we can drop through to report the error in body. $tmplSet = fake_set($db); $set = fake_set_version($db); - $Problem = fake_problem($db); + $problem = fake_problem($db); } else { - # in this case we're creating a fake set from the input, so - # the input must include a source file. - if (!$r->param("sourceFilePath")) { + # In this case we're creating a fake set from the input, so the input must include a source file. + if (!$r->param('sourceFilePath')) { $self->{invalidSet} = - "An Undefined_Set was requested, but no source " . "file for the contained problem was provided."; + 'An Undefined_Set was requested, but no source file for the contained problem was provided.'; - # define these so that we can drop through - # to report the error in body() + # Define these so that we can drop through to report the error in body. $tmplSet = fake_set($db); $set = fake_set_version($db); - $Problem = fake_problem($db); + $problem = fake_problem($db); } else { - my $sourceFPath = $r->param("sourceFilePath"); - die("sourceFilePath is unsafe!") - unless path_is_subdir($sourceFPath, $ce->{courseDirs}->{templates}, 1); + my $sourceFPath = $r->param('sourceFilePath'); + die('sourceFilePath is unsafe!') + unless path_is_subdir($sourceFPath, $ce->{courseDirs}{templates}, 1); $tmplSet = fake_set($db); $set = fake_set_version($db); - $Problem = fake_problem($db); + $problem = fake_problem($db); - my $creation_time = time(); + my $creation_time = time; - $tmplSet->assignment_type("gateway"); + $tmplSet->assignment_type('gateway'); $tmplSet->attempts_per_version(0); $tmplSet->time_interval(0); $tmplSet->versions_per_interval(1); @@ -547,82 +418,70 @@ async sub pre_header_initialize { $tmplSet->time_limit_cap('0'); $tmplSet->restrict_ip('No'); - $set->assignment_type("gateway"); + $set->assignment_type('gateway'); $set->time_interval(0); $set->versions_per_interval(1); $set->version_time_limit(0); $set->version_creation_time($creation_time); $set->time_limit_cap('0'); - $Problem->problem_id(1); - $Problem->source_file($sourceFPath); - $Problem->user_id($effectiveUserName); - $Problem->value(1); - $Problem->problem_seed($r->param("problemSeed")) if ($r->param("problemSeed")); + $problem->problem_id(1); + $problem->source_file($sourceFPath); + $problem->user_id($effectiveUserID); + $problem->value(1); + $problem->problem_seed($r->param('problemSeed')) if ($r->param('problemSeed')); } } } else { - # get template set: the non-versioned set that's assigned to the user - # if this fails/failed in authz->checkSet, then $self->{invalidSet} is set - $tmplSet = $db->getMergedSet($effectiveUserName, $setName); + # Get the template set, i.e., the non-versioned set that's assigned to the user. + # If this failed in authz->checkSet, then $self->{invalidSet} is set. + $tmplSet = $db->getMergedSet($effectiveUserID, $setID); - # now we know that we're in a gateway test, save the assignment test - # for the processing of proctor keys for graded proctored tests; - # if we failed to get the set from the database, we store a fake - # value here to be able to continue - $self->{'assignment_type'} = $tmplSet->assignment_type() || 'gateway'; + # Now that is has been validated that this is a gateway test, save the assignment test for the processing of + # proctor keys for graded proctored tests. If a set was not obtained from the database, store a fake value here + # to be able to continue. + $self->{assignment_type} = $tmplSet->assignment_type || 'gateway'; # next, get the latest (current) version of the set if we don't have a # requested version number - my @allVersionIds = $db->listSetVersions($effectiveUserName, $setName); + my @allVersionIds = $db->listSetVersions($effectiveUserID, $setID); my $latestVersion = (@allVersionIds ? $allVersionIds[-1] : 0); - # double check that any requested version makes sense + # Double check that the requested version makes sense. $requestedVersion = $latestVersion if ($requestedVersion !~ /^\d+$/ || $requestedVersion > $latestVersion || $requestedVersion < 0); - die("No requested version when returning to problem?!") + die('No requested version when returning to problem?!') if ( ( - $r->param("previewAnswers") - || $r->param("checkAnswers") - || $r->param("submitAnswers") - || $r->param("newPage") + $r->param('previewAnswers') + || $r->param('checkAnswers') + || $r->param('submitAnswers') + || $r->param('newPage') ) && !$requestedVersion ); - # to test for a proctored test, we need the set version, not the - # template, to allow a finished proctored test to be checked as an - # unproctored test. so we get the versioned set here + # To check for a proctored test, the set version is needed, not the template. So get that. if ($requestedVersion) { - # if a specific set version was requested, it was stored in the $authz - # object when we did the set check - $set = $db->getMergedSetVersion($effectiveUserName, $setName, $requestedVersion); + $set = $db->getMergedSetVersion($effectiveUserID, $setID, $requestedVersion); } elsif ($latestVersion) { - # otherwise, if there's a current version, which we take to be the - # latest version taken, we use that - $set = $db->getMergedSetVersion($effectiveUserName, $setName, $latestVersion); + $set = $db->getMergedSetVersion($effectiveUserID, $setID, $latestVersion); } else { - # and if neither of those work, get a dummy set so that we have - # something to work with - my $userSetClass = $ce->{dbLayout}->{set_version}->{record}; + # If there is not a requested version or a latest version, then create dummy set to proceed. # FIXME RETURN TO: should this be global2version? - $set = global2user($userSetClass, $db->getGlobalSet($setName)); - die "set $setName not found." unless $set; - $set->user_id($effectiveUserName); + $set = global2user($ce->{dbLayout}{set_version}{record}, $db->getGlobalSet($setID)); + $set->user_id($effectiveUserID); $set->psvn('000'); - $set->set_id("$setName"); # redundant? + $set->set_id($setID); # redundant? $set->version_id(0); } } - my $setVersionNumber = ($set) ? $set->version_id() : 0; + my $setVersionNumber = $set ? $set->version_id : 0; - ################################# - # assemble gateway parameters - ################################# + # Assemble gateway parameters # We get the open and close dates for the gateway from the template set, or from the merged set version if a set has # been requested. Note $isOpen and $isClosed give the open and close dates for the gateway as a whole (that is, the @@ -630,114 +489,74 @@ async sub pre_header_initialize { # date. If a specific version has not been requested and conditional release is enabled, then this also checks to # see if the conditions have been met for a conditional release. my $isOpen = ( - $requestedVersion ? ($set && $set->open_date && after($set->open_date, $self->r->{submitTime})) : ($tmplSet + $requestedVersion ? ($set && $set->open_date && after($set->open_date, $self->r->submitTime)) : ($tmplSet && $tmplSet->open_date - && after($tmplSet->open_date, $self->r->{submitTime}) - && !($ce->{options}{enableConditionalRelease} && is_restricted($db, $tmplSet, $effectiveUserName))) + && after($tmplSet->open_date, $self->r->submitTime) + && !($ce->{options}{enableConditionalRelease} && is_restricted($db, $tmplSet, $effectiveUserID))) ) - || $authz->hasPermissions($userName, "view_unopened_sets"); + || $authz->hasPermissions($userID, 'view_unopened_sets'); - # FIXME for $isClosed, "record_answers_after_due_date" isn't quite - # the right description, but it seems reasonable my $isClosed = $tmplSet && $tmplSet->due_date - && (after($tmplSet->due_date(), $self->r->{submitTime}) - && !$authz->hasPermissions($userName, "record_answers_after_due_date")); - - # to determine if we need a new version, we need to know whether this - # version exceeds the number of attempts per version. (among other - # things,) the number of attempts is a property of the problem, so - # get a problem to check that. note that for a gateway/quiz all - # problems will have the same number of attempts. This means that - # if the set doesn't have any problems we're up a creek, so check - # for that here and bail if it's the case - my @setPNum = $setName eq "Undefined_Set" ? (1) : $db->listUserProblems($EffectiveUser->user_id, $setName); - die("Set $setName contains no problems.") if (!@setPNum); - - # if we assigned a fake problem above, $Problem is already defined. - # otherwise, we get the Problem, or define it to be undefined if - # the set hasn't been versioned to the user yet--this gets fixed - # when we assign the setVersion - if (!$Problem) { - $Problem = + && after($tmplSet->due_date, $self->r->submitTime) + && !$authz->hasPermissions($userID, 'record_answers_after_due_date'); + + # To determine if we need a new version, we need to know whether this version exceeds the number of attempts per + # version. Among other things, the number of attempts is a property of the problem, so get a problem to check that. + # Note that for a gateway quiz all problems will have the same number of attempts. This means that if the set + # doesn't have any problems we're up a creek, so check for that here and bail if that is the case. + my @setPNum = $setID eq 'Undefined_Set' ? (1) : $db->listUserProblems($effectiveUser->user_id, $setID); + die("Set $setID contains no problems.") if (!@setPNum); + + # If we assigned a fake problem above, $problem is already defined. Otherwise, get the problem, or define it to be + # undefined if the set hasn't been versioned to the user yet. This is fixed when we assign the setVersion. + if (!$problem) { + $problem = $setVersionNumber - ? $db->getMergedProblemVersion($EffectiveUser->user_id, $setName, $setVersionNumber, $setPNum[0]) + ? $db->getMergedProblemVersion($effectiveUser->user_id, $setID, $setVersionNumber, $setPNum[0]) : undef; } - # note that having $maxAttemptsPerVersion set to an infinite/0 value is - # nonsensical; if we did that, why have versions? (might want to do it for one individual?) - # Its actually a good thing for "repeatable" practice sets - my $maxAttemptsPerVersion = $tmplSet->attempts_per_version() || 0; - my $timeInterval = $tmplSet->time_interval() || 0; - my $versionsPerInterval = $tmplSet->versions_per_interval() || 0; - my $timeLimit = $tmplSet->version_time_limit() || 0; - - # what happens if someone didn't set one of these? I think this can - # happen if we're handed a malformed set, where the values in the - # database are null. - $timeInterval = 0 if (!defined($timeInterval) || $timeInterval eq ''); - $versionsPerInterval = 0 if (!defined($versionsPerInterval) - || $versionsPerInterval eq ''); - - # every problem in the set must have the same submission characteristics + my $maxAttemptsPerVersion = $tmplSet->attempts_per_version || 0; + my $timeInterval = $tmplSet->time_interval || 0; + my $versionsPerInterval = $tmplSet->versions_per_interval || 0; + my $timeLimit = $tmplSet->version_time_limit || 0; + + # What happens if someone didn't set one of these? Perhaps this can happen if we're handed a malformed set, where + # the values in the database are null. + $timeInterval = 0 if !defined $timeInterval || $timeInterval eq ''; + $versionsPerInterval = 0 if !defined $versionsPerInterval || $versionsPerInterval eq ''; + + # Every problem in the set is assumed have the same submission characteristics. my $currentNumAttempts = - (defined($Problem) && $Problem->num_correct() ne '') ? $Problem->num_correct() + $Problem->num_incorrect() : 0; - - # $maxAttempts turns into the maximum number of versions we can create; - # if $Problem isn't defined, we can't have made any attempts, so it - # doesn't matter - my $maxAttempts = - (defined($Problem) && defined($Problem->max_attempts()) && $Problem->max_attempts()) - ? $Problem->max_attempts() - : -1; - - # finding the number of versions per time interval is a little harder. - # we interpret the time interval as a rolling interval: that is, - # if we allow two sets per day, that's two sets in any 24 hour - # period. this is probably not what we really want, but it's - # more extensible to a limitation like "one version per hour", - # and we can set it to two sets per 12 hours for most "2ce daily" - # type applications - my $timeNow = $r->{submitTime}; # Time::HiRes saved time set in dispatch() of lib/WeBWorK.pm - - # Convert the floating point value from Time::HiRes to an integer - # for use below. Truncate towards 0. - my $timeNowInt = int($timeNow); - - my $grace = $ce->{gatewayGracePeriod}; + defined $problem && $problem->num_correct ne '' ? $problem->num_correct + $problem->num_incorrect : 0; + + # $maxAttempts is the maximum number of versions that can be created. + # If the problem isn't defined it doesn't matter. + my $maxAttempts = defined $problem && $problem->max_attempts ? $problem->max_attempts : -1; + + # Find the number of versions per time interval. Interpret the time interval as a rolling interval. That is, if two + # sets are allowed per day, that is two sets in any 24 hour period. my $currentNumVersions = 0; # this is the number of versions in the time interval my $totalNumVersions = 0; - # we don't need to check this if $self->{invalidSet} is already set, - # or if we're working with an Undefined_Set - if ($setVersionNumber && !$self->{invalidSet} && $setName ne "Undefined_Set") { - my @setVersionIDs = $db->listSetVersions($effectiveUserName, $setName); - my @setVersions = $db->getSetVersions(map { [ $effectiveUserName, $setName,, $_ ] } @setVersionIDs); - foreach (@setVersions) { + if ($setVersionNumber && !$self->{invalidSet} && $setID ne 'Undefined_Set') { + my @setVersionIDs = $db->listSetVersions($effectiveUserID, $setID); + my @setVersions = $db->getSetVersions(map { [ $effectiveUserID, $setID,, $_ ] } @setVersionIDs); + for (@setVersions) { $totalNumVersions++; - $currentNumVersions++ - if (!$timeInterval - || $_->version_creation_time() > ($timeNow - $timeInterval)); + $currentNumVersions++ if (!$timeInterval || $_->version_creation_time() > ($r->submitTime - $timeInterval)); } } - #################################### - # new version creation conditional - #################################### + # New version creation conditional - my $versionIsOpen = 0; # can we do anything to this version? + my $versionIsOpen = 0; - # recall $isOpen = timeNow > openDate [for the merged userset] and - # $isClosed = timeNow > dueDate [for the merged userset] - # again, if $self->{invalidSet} is already set, we don't need to - # to check this if ($isOpen && !$isClosed && !$self->{invalidSet}) { - - # if no specific version is requested, we can create a new one if - # need be + # If specific version was not requested, then create a new one if needed. if (!$requestedVersion) { if ( ($maxAttempts == -1 || $totalNumVersions < $maxAttempts) @@ -747,47 +566,44 @@ async sub pre_header_initialize { ( ($maxAttemptsPerVersion == 0 && $currentNumAttempts > 0) || ($maxAttemptsPerVersion != 0 && $currentNumAttempts >= $maxAttemptsPerVersion) - || $timeNow >= $set->due_date + $grace + || $r->submitTime >= $set->due_date + $ce->{gatewayGracePeriod} ) && (!$versionsPerInterval || $currentNumVersions < $versionsPerInterval) ) ) && ( - $effectiveUserName eq $userName + $effectiveUserID eq $userID || ( - $authz->hasPermissions($userName, "record_answers_when_acting_as_student") - || ($authz->hasPermissions($userName, "create_new_set_version_when_acting_as_student") - && $verCreateOK) + $authz->hasPermissions($userID, 'record_answers_when_acting_as_student') + || ($authz->hasPermissions($userID, 'create_new_set_version_when_acting_as_student') + && $r->param('createnew_ok')) ) ) ) { - # assign set, get the right name, version - # number, etc., and redefine the $set - # and $Problem we're working with - my $setTmpl = $db->getUserSet($effectiveUserName, $setName); - WeBWorK::ContentGenerator::Instructor::assignSetVersionToUser($self, $effectiveUserName, $setTmpl); + # Assign the set, get the right name, version number, etc., and redefine the $set and $problem for the + # remainder of this method. + my $setTmpl = $db->getUserSet($effectiveUserID, $setID); + WeBWorK::ContentGenerator::Instructor::assignSetVersionToUser($self, $effectiveUserID, $setTmpl); $setVersionNumber++; - # get a clean version of the set to save, - # and the merged version to use in the - # rest of the routine - my $cleanSet = $db->getSetVersion($effectiveUserName, $setName, $setVersionNumber); - $set = $db->getMergedSetVersion($effectiveUserName, $setName, $setVersionNumber); + # Get a clean version of the set and merged version to use in the rest of the routine. + my $cleanSet = $db->getSetVersion($effectiveUserID, $setID, $setVersionNumber); + $set = $db->getMergedSetVersion($effectiveUserID, $setID, $setVersionNumber); + $set->visible(1); - $Problem = $db->getMergedProblemVersion($effectiveUserName, $setName, $setVersionNumber, $setPNum[0]); + $problem = $db->getMergedProblemVersion($effectiveUserID, $setID, $setVersionNumber, $setPNum[0]); - # because we're creating this on the fly, - # it should be visible - $set->visible(1); - # set up creation time, open and due dates - my $ansOffset = $set->answer_date() - $set->due_date(); + # Convert the floating point value from Time::HiRes to an integer for use below. Truncate towards 0. + my $timeNowInt = int($r->submitTime); + + # Set up creation time, and open and due dates. + my $ansOffset = $set->answer_date - $set->due_date; $set->version_creation_time($timeNowInt); $set->open_date($timeNowInt); - # figure out the due date, taking into account - # any time limit cap + # Figure out the due date, taking into account the time limit cap. my $dueTime = - ($timeLimit == 0 || ($set->time_limit_cap && $timeNow + $timeLimit > $set->due_date)) + $timeLimit == 0 || ($set->time_limit_cap && $r->submitTime + $timeLimit > $set->due_date) ? $set->due_date : $timeNowInt + $timeLimit; @@ -795,14 +611,9 @@ async sub pre_header_initialize { $set->answer_date($set->due_date + $ansOffset); $set->version_last_attempt_time(0); - # put this new info into the database. we - # put back that data which we need for the - # version, and leave blank any information - # that we'd like to inherit from the user - # set or global set. we set the data which - # determines if a set is open, because we - # don't want the set version to reopen after - # it's complete + # Put this new info into the database. Put back the data needed for the version, and leave blank any + # information that should be inherited from the user set or global set. Set the data which determines + # if a set is open, because a set version should not reopen after it's complete. $cleanSet->version_creation_time($set->version_creation_time); $cleanSet->open_date($set->open_date); $cleanSet->due_date($set->due_date); @@ -813,160 +624,132 @@ async sub pre_header_initialize { $cleanSet->assignment_type($set->assignment_type); $db->putSetVersion($cleanSet); - # we have a new set version, so it's open + # This is a new set version, so it's open. $versionIsOpen = 1; - # also reset the number of attempts for this - # set to zero + # Set the number of attempts for this set to zero. $currentNumAttempts = 0; } elsif ($maxAttempts != -1 && $totalNumVersions > $maxAttempts) { - $self->{invalidSet} = "No new versions of this assignment are available, " - . "because you have already taken the maximum number allowed."; + $self->{invalidSet} = 'No new versions of this assignment are available, ' + . 'because you have already taken the maximum number allowed.'; - } elsif ($effectiveUserName ne $userName - && $authz->hasPermissions($userName, "create_new_set_version_when_acting_as_student")) + } elsif ($effectiveUserID ne $userID + && $authz->hasPermissions($userID, 'create_new_set_version_when_acting_as_student')) { $self->{invalidSet} = - "User $effectiveUserName is being acted " - . "as. If you continue, you will create a new version of this set " - . "for that user, which will count against their allowed maximum " - . "number of versions for the current time interval. IN GENERAL, THIS " - . "IS NOT WHAT YOU WANT TO DO. Please be sure that you want to " - . "do this before clicking the \"Create new set version\" link " - . "below. Alternately, PRESS THE \"BACK\" BUTTON and continue."; + "User $effectiveUserID is being acted " + . 'as. If you continue, you will create a new version of this set ' + . 'for that user, which will count against their allowed maximum ' + . 'number of versions for the current time interval. IN GENERAL, THIS ' + . 'IS NOT WHAT YOU WANT TO DO. Please be sure that you want to ' + . 'do this before clicking the "Create new set version" link ' + . 'below. Alternately, PRESS THE "BACK" BUTTON and continue.'; $self->{invalidVersionCreation} = 1; - } elsif ($effectiveUserName ne $userName) { - $self->{invalidSet} = "User $effectiveUserName is being acted as. " - . "When acting as another user, new versions of the set cannot be created."; + } elsif ($effectiveUserID ne $userID) { + $self->{invalidSet} = "User $effectiveUserID is being acted as. " + . 'When acting as another user, new versions of the set cannot be created.'; $self->{invalidVersionCreation} = 2; } elsif (($maxAttemptsPerVersion == 0 || $currentNumAttempts < $maxAttemptsPerVersion) - && $timeNow < $set->due_date() + $grace) + && $r->submitTime < $set->due_date() + $ce->{gatewayGracePeriod}) { - if (between($set->open_date(), $set->due_date() + $grace, $timeNow)) { + if (between($set->open_date(), $set->due_date() + $ce->{gatewayGracePeriod}, $r->submitTime)) { $versionIsOpen = 1; } else { - $versionIsOpen = 0; # redundant $self->{invalidSet} = - "No new versions of this assignment" - . " are available,\nbecause the set is not open or its time" - . " limit has expired.\n"; + 'No new versions of this assignment are available, because the set is not open or its time' + . ' limit has expired.'; } } elsif ($versionsPerInterval && ($currentNumVersions >= $versionsPerInterval)) { $self->{invalidSet} = - "You have already taken all available versions of this " - . "test in the current time interval. You may take the test again after " - . "the time interval has expired."; + 'You have already taken all available versions of this test in the current time interval. ' + . 'You may take the test again after the time interval has expired.'; } } else { - # (we're still in the $isOpen && ! $isClosed conditional here) - # if a specific version is requested, then we only check to - # see if it's open + # If a specific version is requested, then check to see if it's open. if ( ($currentNumAttempts < $maxAttemptsPerVersion) - && ($effectiveUserName eq $userName - || $authz->hasPermissions($userName, "record_set_version_answers_when_acting_as_student")) + && ($effectiveUserID eq $userID + || $authz->hasPermissions($userID, 'record_set_version_answers_when_acting_as_student')) ) { - if (between($set->open_date(), $set->due_date() + $grace, $timeNow)) { + if (between($set->open_date(), $set->due_date() + $ce->{gatewayGracePeriod}, $r->submitTime)) { $versionIsOpen = 1; - } else { - $versionIsOpen = 0; # redundant } } } - # closed set, with attempt at a new one } elsif (!$self->{invalidSet} && !$requestedVersion) { - $self->{invalidSet} = "This set is closed. No new set versions may be taken."; + $self->{invalidSet} = 'This set is closed. No new set versions may be taken.'; + } + + # If the set or problem is invalid, then delete any proctor keys if any and return. + if ($self->{invalidSet} || $self->{invalidProblem}) { + if (defined $self->{assignment_type} && $self->{assignment_type} eq 'proctored_gateway') { + my $proctorID = $r->param('proctor_user'); + if ($proctorID) { + eval { $db->deleteKey("$effectiveUserID,$proctorID"); }; + eval { $db->deleteKey("$effectiveUserID,$proctorID,g"); }; + } + } + return; } - #################################### - # save problem and user data - #################################### + # Save problem and user data my $psvn = $set->psvn(); - $self->{tmplSet} = $tmplSet; - $self->{set} = $set; - $self->{problem} = $Problem; - $self->{requestedVersion} = $requestedVersion; + $self->{tmplSet} = $tmplSet; + $self->{set} = $set; + $self->{problem} = $problem; - $self->{userName} = $userName; - $self->{effectiveUserName} = $effectiveUserName; - $self->{user} = $User; - $self->{effectiveUser} = $EffectiveUser; - $self->{permissionLevel} = $permissionLevel; + $self->{userID} = $userID; + $self->{user} = $user; + $self->{effectiveUser} = $effectiveUser; $self->{isOpen} = $isOpen; $self->{isClosed} = $isClosed; $self->{versionIsOpen} = $versionIsOpen; - $self->{timeNow} = $timeNow; - - #################################### - # form processing - #################################### - - # this is the same as the following, but doesn't appear in Problem.pm - my $newPage = $r->param("newPage"); - $self->{newPage} = $newPage; + # Form processing - # also get the current page, if it's given - my $currentPage = $r->param("currentPage") || 1; + # Get the current page, if it's given. + my $currentPage = $r->param('currentPage') || 1; - # This is a hack to manage changing pages. We set previewAnswers to + # This is a hack to manage changing pages. Set previewAnswers to # false if the "pageChangeHack" input is set (a page change link was used). $r->param('previewAnswers', 0) if ($r->param('pageChangeHack')); - # [This section lifted from Problem.pm] ############################## + $self->{displayMode} = $user->displayMode || $ce->{pg}{options}{displayMode}; - # set options from form fields (see comment at top of file for names) - my $displayMode = $User->displayMode || $ce->{pg}->{options}->{displayMode}; - my $redisplay = $r->param("redisplay"); - my $submitAnswers = $r->param("submitAnswers") // 0; - my $checkAnswers = $r->param("checkAnswers") // 0; - my $previewAnswers = $r->param("previewAnswers") // 0; + # Set options from request parameters. + $self->{redisplay} = $r->param('redisplay'); + $self->{submitAnswers} = $r->param('submitAnswers') || 0; + $self->{checkAnswers} = $r->param('checkAnswers') // 0; + $self->{previewAnswers} = $r->param('previewAnswers') // 0; + $self->{formFields} = { WeBWorK::Form->new_from_paramable($r)->Vars }; - my $formFields = { WeBWorK::Form->new_from_paramable($r)->Vars }; + # Permissions - $self->{displayMode} = $displayMode; - $self->{redisplay} = $redisplay; - $self->{submitAnswers} = $submitAnswers; - $self->{checkAnswers} = $checkAnswers; - $self->{previewAnswers} = $previewAnswers; - $self->{formFields} = $formFields; - - # now that we've set all the necessary variables quit out if the set or - # problem is invalid - - return if $self->{invalidSet} || $self->{invalidProblem}; - - # [End lifted section] ############################################### - - #################################### - # permissions - #################################### - - # bail without doing anything if the set isn't yet open for this user - if (!($self->{isOpen} || $authz->hasPermissions($userName, "view_unopened_sets"))) { - $self->{invalidSet} = "This set is not yet open."; + # Bail without doing anything if the set isn't yet open for this user. + if (!($self->{isOpen} || $authz->hasPermissions($userID, 'view_unopened_sets'))) { + $self->{invalidSet} = 'This set is not yet open.'; return; } - # what does the user want to do? + # What does the user want to do? my %want = ( - showOldAnswers => $User->showOldAnswers ne '' ? $User->showOldAnswers : $ce->{pg}{options}{showOldAnswers}, + showOldAnswers => $user->showOldAnswers ne '' ? $user->showOldAnswers : $ce->{pg}{options}{showOldAnswers}, # showProblemGrader implies showCorrectAnswers. This is a convenience for grading. showCorrectAnswers => ($r->param('showProblemGrader') || 0) - || ($r->param("showCorrectAnswers") && ($submitAnswers || $checkAnswers)) + || ($r->param('showCorrectAnswers') && ($self->{submitAnswers} || $self->{checkAnswers})) || 0, showProblemGrader => $r->param('showProblemGrader') || 0, @@ -974,16 +757,16 @@ async sub pre_header_initialize { showHints => 0, # showProblemGrader implies showSolutions. Another convenience for grading. showSolutions => $r->param('showProblemGrader') - || ($r->param("showSolutions") && ($submitAnswers || $checkAnswers)), - recordAnswers => $submitAnswers && !$authz->hasPermissions($userName, "avoid_recording_answers"), + || ($r->param('showSolutions') && ($self->{submitAnswers} || $self->{checkAnswers})), + recordAnswers => $self->{submitAnswers} && !$authz->hasPermissions($userID, 'avoid_recording_answers'), # we also want to check answers if we were checking answers and are switching between pages - checkAnswers => $checkAnswers, - useMathView => $User->useMathView ne '' ? $User->useMathView : $ce->{pg}{options}{useMathView}, - useWirisEditor => $User->useWirisEditor ne '' ? $User->useWirisEditor : $ce->{pg}{options}{useWirisEditor}, - useMathQuill => $User->useMathQuill ne '' ? $User->useMathQuill : $ce->{pg}{options}{useMathQuill}, + checkAnswers => $self->{checkAnswers}, + useMathView => $user->useMathView ne '' ? $user->useMathView : $ce->{pg}{options}{useMathView}, + useWirisEditor => $user->useWirisEditor ne '' ? $user->useWirisEditor : $ce->{pg}{options}{useWirisEditor}, + useMathQuill => $user->useMathQuill ne '' ? $user->useMathQuill : $ce->{pg}{options}{useMathQuill}, ); - # are certain options enforced? + # Are certain options enforced? my %must = ( showOldAnswers => 0, showCorrectAnswers => 0, @@ -997,65 +780,52 @@ async sub pre_header_initialize { useMathQuill => 0, ); - # does the user have permission to use certain options? - my @args = ($User, $PermissionLevel, $EffectiveUser, $set, $Problem, $tmplSet); - my $sAns = $submitAnswers ? 1 : 0; + # Does the user have permission to use certain options? + my @args = ($user, $permissionLevel, $effectiveUser, $set, $problem, $tmplSet); my %can = ( showOldAnswers => $self->can_showOldAnswers(@args), - showCorrectAnswers => $self->can_showCorrectAnswers(@args, $sAns), + showCorrectAnswers => $self->can_showCorrectAnswers(@args), showProblemGrader => $self->can_showProblemGrader(@args), showHints => $self->can_showHints(@args), - showSolutions => $self->can_showSolutions(@args, $sAns), + showSolutions => $self->can_showSolutions(@args), recordAnswers => $self->can_recordAnswers(@args), checkAnswers => $self->can_checkAnswers(@args), - recordAnswersNextTime => $self->can_recordAnswers(@args, $sAns), - checkAnswersNextTime => $self->can_checkAnswers(@args, $sAns), + recordAnswersNextTime => $self->can_recordAnswers(@args, $self->{submitAnswers}), + checkAnswersNextTime => $self->can_checkAnswers(@args, $self->{submitAnswers}), showScore => $self->can_showScore(@args), - useMathView => $self->can_useMathView(@args), - useWirisEditor => $self->can_useWirisEditor(@args), - useMathQuill => $self->can_useMathQuill(@args) + showProblemScores => $self->can_showProblemScores(@args), + showWork => $self->can_showWork(@args), + useMathView => $self->can_useMathView, + useWirisEditor => $self->can_useWirisEditor, + useMathQuill => $self->can_useMathQuill ); - # final values for options - my %will; - foreach (keys %must) { - $will{$_} = $can{$_} && ($must{$_} || $want{$_}); - } - ##### store fields ##### - - # FIXME: the following is present in Problem.pm, but missing here. how do we - # deal with it in the context of multiple problems with possible hints? - # Update and fix hint/solution options after PG processing - # $can{showHints} &&= $pg->{flags}{hintExists}; - # $can{showSolutions} &&= $pg->{flags}{solutionExists}; + # Final values for options + my %will = map { $_ => $can{$_} && ($must{$_} || $want{$_}) } keys %must; $self->{want} = \%want; $self->{must} = \%must; $self->{can} = \%can; $self->{will} = \%will; - #################################### - # set up problem numbering and multipage variables - #################################### + # Set up problem numbering and multipage variables. my @problemNumbers; - if ($setName eq "Undefined_Set") { + if ($setID eq 'Undefined_Set') { @problemNumbers = (1); } else { - @problemNumbers = $db->listProblemVersions($effectiveUserName, $setName, $setVersionNumber); + @problemNumbers = $db->listProblemVersions($effectiveUserID, $setID, $setVersionNumber); } - # to speed up processing of long (multi-page) tests, we want to only - # translate those problems that are being submitted or are currently - # being displayed. so work out here which problems are on the - # current page. + # To speed up processing of long (multi-page) tests, we want to only translate those problems that are being + # submitted or are currently being displayed. So determine which problems are on the current page. my ($numPages, $pageNumber, $numProbPerPage) = (1, 0, 0); my ($startProb, $endProb) = (0, $#problemNumbers); - # update startProb and endProb for multipage tests - if (defined($set->problems_per_page) && $set->problems_per_page) { + # Update startProb and endProb for multipage tests + if ($set->problems_per_page) { $numProbPerPage = $set->problems_per_page; - $pageNumber = ($newPage) ? $newPage : $currentPage; + $pageNumber = $r->param('newPage') || $currentPage; $numPages = scalar(@problemNumbers) / $numProbPerPage; $numPages = int($numPages) + 1 if (int($numPages) != $numPages); @@ -1066,19 +836,15 @@ async sub pre_header_initialize { ($startProb + $numProbPerPage > $#problemNumbers) ? $#problemNumbers : $startProb + $numProbPerPage - 1; } - # set up problem list for randomly ordered tests + # Set up problem list for randomly ordered tests. my @probOrder = (0 .. $#problemNumbers); - # there's a routine to do this somewhere, I think... if ($set->problem_randorder) { - my @newOrder = (); - # we need to keep the random order the same each time the set is loaded! - # this requires either saving the order in the set definition, or - # being sure that the random seed that we use is the same each time - # the same set is called. we'll do the latter by setting the seed - # to the psvn of the problem set. we use a local PGrandom object - # to avoid mucking with the system seed. - my $pgrand = PGrandom->new(); + my @newOrder; + # Make sure to keep the random order the same each time the set is loaded! This is done by ensuring that the + # random seed used is the same each time the same set is called by setting the seed to the psvn of the problem + # set. Use a local PGrandom object to avoid mucking with the system seed. + my $pgrand = PGrandom->new; $pgrand->srand($set->psvn); while (@probOrder) { my $i = int($pgrand->rand(scalar(@probOrder))); @@ -1086,564 +852,136 @@ async sub pre_header_initialize { } @probOrder = @newOrder; } - # now $probOrder[i] = the problem number, numbered from zero, that's - # displayed in the ith position on the test + # Now $probOrder[i] is the problem number, numbered from zero, that is displayed in the ith position on the test. - # make a list of those problems we're displaying + # Make a list of those problems displayed on this page. my @probsToDisplay = (); for (my $i = 0; $i < @probOrder; $i++) { push(@probsToDisplay, $probOrder[$i]) if ($i >= $startProb && $i <= $endProb); } - #################################### - # process problems - #################################### + # Process problems + + my @problems; + my @pg_results; - my @problems = (); - my @pg_results = (); - # pg errors are stored here; initialize it to empty to start + # pg errors are stored here. $self->{errors} = []; - # process the problems as needed + # Process the problems as needed. my @mergedProblems; - if ($setName eq "Undefined_Set") { - @mergedProblems = ($Problem); + if ($setID eq 'Undefined_Set') { + @mergedProblems = ($problem); } else { - @mergedProblems = $db->getAllMergedProblemVersions($effectiveUserName, $setName, $setVersionNumber); + @mergedProblems = $db->getAllMergedProblemVersions($effectiveUserID, $setID, $setVersionNumber); } + my @renderPromises; + for my $pIndex (0 .. $#problemNumbers) { + my $problemN = $mergedProblems[$pIndex]; - if (!defined($mergedProblems[$pIndex])) { - $self->{invalidSet} = "One or more of the problems " . "in this set have not been assigned to you."; + if (!defined $problemN) { + $self->{invalidSet} = 'One or more of the problems in this set have not been assigned to you.'; return; } - my $ProblemN = $mergedProblems[$pIndex]; # sticky answers are set up here - if (not($submitAnswers or $previewAnswers or $checkAnswers or $newPage) and $will{showOldAnswers}) { - my %oldAnswers = decodeAnswers($ProblemN->last_answer); - $formFields->{$_} = $oldAnswers{$_} foreach (keys %oldAnswers); + if (!($self->{submitAnswers} || $self->{previewAnswers} || $self->{checkAnswers} || $r->param('newPage')) + && $will{showOldAnswers}) + { + my %oldAnswers = decodeAnswers($problemN->last_answer); + $self->{formFields}{$_} = $oldAnswers{$_} for (keys %oldAnswers); } - push(@problems, $ProblemN); + push(@problems, $problemN); - # if we don't have to translate this problem, just store a placeholder in the array. + # If this problem DOES NOT need to be translated, store a defined but false placeholder in the array. my $pg = 0; - # this is the actual translation of each problem. errors are - # stored in @{$self->{errors}} in each case - if ((grep /^$pIndex$/, @probsToDisplay) || $submitAnswers) { - $pg = await $self->getProblemHTML($self->{effectiveUser}, $set, $formFields, $ProblemN); + # This is the actual translation of each problem. + if ((grep {/^$pIndex$/} @probsToDisplay) || $self->{submitAnswers}) { + push @renderPromises, $self->getProblemHTML($self->{effectiveUser}, $set, $self->{formFields}, $problemN); + # If this problem DOES need to be translated, store an undefined placeholder in the array. + # This will be replaced with the rendered problem after all of the above promises are awaited. + $pg = undef; } push(@pg_results, $pg); } - $self->{ra_problems} = \@problems; - $self->{ra_pg_results} = \@pg_results; - - $self->{startProb} = $startProb; - $self->{endProb} = $endProb; - $self->{numPages} = $numPages; - $self->{pageNumber} = $pageNumber; - $self->{ra_problem_numbers} = \@problemNumbers; - $self->{ra_probOrder} = \@probOrder; -} - -sub head { - my ($self) = @_; - return "" if !defined($self->{ra_pg_results}); - my $head_text = ""; - for (@{ $self->{ra_pg_results} }) { - next if !ref($_); - $head_text .= $_->{head_text} if $_->{head_text}; - } - return $head_text; -} - -sub path { - my ($self, $args) = @_; - - my $r = $self->{r}; - my $ce = $self->{ce}; - my $setName = $r->urlpath->arg("setID"); - my $root = $ce->{webworkURLs}{root}; - my $courseName = $ce->{courseName}; - - my $navigation_allowed = $r->authz->hasPermissions($r->param('user'), 'navigation_allowed'); - - return $self->pathMacro( - $args, - 'WeBWorK' => $navigation_allowed ? $root : '', - $courseName => $navigation_allowed ? "$root/$courseName" : '', - $setName eq "Undefined_Set" || $self->{invalidSet} - ? ($setName => '') - : ( - $self->{set}->set_id => "$root/" - . $r->urlpath->newFromModule( - 'WeBWorK::ContentGenerator::ProblemSet', $r, - courseID => $courseName, - setID => $self->{set}->set_id - )->path, - 'v' . $self->{set}->version_id => '' - ), - ); -} - -sub nav { - my ($self, $args) = @_; - my $r = $self->{r}; - my $db = $r->db; - my $user = $r->param('user'); - my $effectiveUser = $r->param('effectiveUser'); - - # Set up and display a student navigation for those that have permission to act as a student. - if ($r->authz->hasPermissions($user, 'become_student') && $effectiveUser ne $user) { - my $setName = $self->{set}->set_id; - - return '' if $setName eq 'Undefined_Set' || $self->{invalidSet}; - - my $setVersion = $self->{set}->version_id; - my $courseName = $self->{ce}{courseName}; - - # Find all versions of this set that have been taken (excluding those taken by the current user). - my @users = - $db->listSetVersionsWhere({ user_id => { not_like => $user }, set_id => { like => "$setName,v\%" } }); - my @allUserRecords = $db->getUsers(map { $_->[0] } @users); - - my $filter = $r->param('studentNavFilter'); - - # Format the student names for display, and associate the users with the test versions. - my %filters; - my @userRecords; - for (0 .. $#allUserRecords) { - # Add to the sections and recitations if defined. Also store the first user found in that section or - # recitation. This user will be switched to when the filter is selected. - my $section = $allUserRecords[$_]->section; - $filters{"section:$section"} = - [ $r->maketext('Filter by section [_1]', $section), $allUserRecords[$_]->user_id, $users[$_][2] ] - if $section && !$filters{"section:$section"}; - my $recitation = $allUserRecords[$_]->recitation; - $filters{"recitation:$recitation"} = - [ $r->maketext('Filter by recitation [_1]', $recitation), $allUserRecords[$_]->user_id, $users[$_][2] ] - if $recitation && !$filters{"recitation:$recitation"}; - - # Only keep this user if it satisfies the selected filter if a filter was selected. - next - unless !$filter - || ($filter =~ /^section:(.*)$/ && $allUserRecords[$_]->section eq $1) - || ($filter =~ /^recitation:(.*)$/ && $allUserRecords[$_]->recitation eq $1); - - my $addRecord = $allUserRecords[$_]; - push @userRecords, $addRecord; - - $addRecord->{displayName} = - ($addRecord->last_name || $addRecord->first_name - ? $addRecord->last_name . ', ' . $addRecord->first_name - : $addRecord->user_id); - $addRecord->{setVersion} = $users[$_][2]; - } - # Sort by last name, then first name, then user_id, then set version. - @userRecords = sort { - lc($a->last_name) cmp lc($b->last_name) - || lc($a->first_name) cmp lc($b->first_name) - || lc($a->user_id) cmp lc($b->user_id) - || lc($a->{setVersion}) <=> lc($b->{setVersion}) - } @userRecords; - - # Find the previous, current, and next test. - my $currentTestIndex = 0; - for (0 .. $#userRecords) { - $currentTestIndex = $_, last - if $userRecords[$_]->user_id eq $effectiveUser && $userRecords[$_]->{setVersion} == $setVersion; - } - my $prevTest = $currentTestIndex > 0 ? $userRecords[ $currentTestIndex - 1 ] : 0; - my $nextTest = $currentTestIndex < $#userRecords ? $userRecords[ $currentTestIndex + 1 ] : 0; - - # Mark the current test. - $userRecords[$currentTestIndex]{currentTest} = 1; - - my $setPage = $r->urlpath->newFromModule( - __PACKAGE__, $r, - courseID => $courseName, - setID => "$setName,v%s" - ); - - # Cap the number of tests shown to at most 200. - my $numAfter = $#userRecords - $currentTestIndex; - my $numBefore = 200 - ($numAfter < 100 ? $numAfter : 100); - my $minTestIndex = $currentTestIndex < $numBefore ? 0 : $currentTestIndex - $numBefore; - my $maxTestIndex = $minTestIndex + 200 < $#userRecords ? $minTestIndex + 200 : $#userRecords; - - # Set up the student nav. - print CGI::div( - { class => 'row sticky-nav', role => 'navigation', aria_label => 'user navigation' }, - CGI::div( - { class => 'user-nav' }, - CGI::div( - { class => 'btn-group', role => 'group', aria_label => 'student selector' }, - $prevTest - ? CGI::a( - { - href => sprintf( - $self->systemLink( - $setPage, - params => { - effectiveUser => $prevTest->user_id, - currentPage => $self->{pageNumber}, - showProblemGrader => $self->{will}{showProblemGrader}, - $filter ? (studentNavFilter => $filter) : () - } - ), - $prevTest->{setVersion} - ), - data_bs_toggle => 'tooltip', - data_bs_placement => 'top', - title => "$prevTest->{displayName} (version $prevTest->{setVersion})", - class => 'btn btn-primary student-nav-button' - }, - CGI::i({ class => 'fas fa-chevron-left' }, '') - ) - : CGI::span( - { class => 'btn btn-primary disabled' }, - CGI::i({ class => 'fas fa-chevron-left' }, '') - ), - ' ', - CGI::div( - { class => 'btn-group student-nav-selector' }, - CGI::a( - { - href => '#', - id => 'studentSelector', - class => 'btn btn-primary dropdown-toggle', - role => 'button', - data_bs_toggle => 'dropdown', - aria_expanded => 'false' - }, - $userRecords[$currentTestIndex]{displayName} - . " (version $userRecords[$currentTestIndex]{setVersion})" - ), - CGI::ul( - { - class => 'dropdown-menu', - role => 'menu', - aria_labelledby => 'studentSelector' - }, - ( - map { - CGI::li(CGI::a( - { - tabindex => '-1', - style => $_->{currentTest} ? 'background-color: #8F8' : '', - class => 'dropdown-item', - href => sprintf( - $self->systemLink( - $setPage, - params => { - effectiveUser => $_->user_id, - currentPage => $self->{pageNumber}, - showProblemGrader => $self->{will}{showProblemGrader}, - $filter ? (studentNavFilter => $filter) : () - } - ), - $_->{setVersion} - ) - }, - "$_->{displayName} (version $_->{setVersion})" - )) - } @userRecords[ $minTestIndex .. $maxTestIndex ] - ), - ), - ), - ' ', - $nextTest - ? CGI::a( - { - href => sprintf( - $self->systemLink( - $setPage, - params => { - effectiveUser => $nextTest->user_id, - currentPage => $self->{pageNumber}, - showProblemGrader => $self->{will}{showProblemGrader}, - $filter ? (studentNavFilter => $filter) : () - } - ), - $nextTest->{setVersion} - ), - data_bs_toggle => 'tooltip', - data_bs_placement => 'top', - title => "$nextTest->{displayName} (version $nextTest->{setVersion})", - class => 'btn btn-primary student-nav-button' - }, - CGI::i({ class => 'fas fa-chevron-right' }, '') - ) - : CGI::span( - { class => 'btn btn-primary disabled' }, - CGI::i({ class => 'fas fa-chevron-right' }, '') - ), - ), - # Create a section/recitation filter by dropdown if there are sections or recitaitons. - scalar keys %filters - ? CGI::div( - { class => 'btn-group student-nav-filter-selector' }, - CGI::a( - { - href => '#', - id => 'testSelectorFilter', - class => 'btn btn-primary dropdown-toggle dropdown-toggle-split', - role => 'button', - data_bs_toggle => 'dropdown', - aria_expanded => 'false', - }, - $filter ? $filters{$filter}[0] : $r->maketext('Showing all tests') - ), - CGI::ul( - { - class => 'dropdown-menu', - role => 'menu', - aria_labelledby => 'testSelectorFilter' - }, - # If a filter is currently in use, then add an item that will remove that filter. - $filter - ? CGI::li(CGI::a( - { - class => 'dropdown-item', - href => sprintf( - $self->systemLink( - $setPage, - params => { - effectiveUser => $effectiveUser, - currentPage => $self->{pageNumber}, - showProblemGrader => $self->{will}{showProblemGrader} - } - ), - $setVersion - ) - }, - $r->maketext('Show all tests') - )) - : '', - map { - CGI::li(CGI::a( - { - class => 'dropdown-item', - style => ($filter || '') eq $_ ? 'background-color: #8F8' : '', - href => sprintf( - $self->systemLink( - $setPage, - params => { - effectiveUser => $filters{$_}[1], - currentPage => $self->{pageNumber}, - showProblemGrader => $self->{will}{showProblemGrader}, - studentNavFilter => $_ - } - ), - $filters{$_}[2] - ) - }, - $filters{$_}[0] - )) - } sort keys %filters - ), - ) - : '' - ) - ); + # Wait for all problems to be rendered and replace the undefined entries + # in the pg_results array with the rendered result. + my @renderedPG = await Mojo::Promise->all(@renderPromises); + for (@pg_results) { + $_ = (shift @renderedPG)->[0] if !defined $_; } - return ''; -} - -sub body { - my $self = shift(); - my $r = $self->r; - my $ce = $r->ce; - my $db = $r->db; - my $authz = $r->authz; - my $urlpath = $r->urlpath; - my $user = $r->param('user'); - my $effectiveUser = $r->param('effectiveUser'); - my $courseID = $urlpath->arg("courseID"); + $r->stash->{problems} = \@problems; + $r->stash->{pg_results} = \@pg_results; + $r->stash->{startProb} = $startProb; + $r->stash->{endProb} = $endProb; + $r->stash->{numPages} = $numPages; + $r->stash->{pageNumber} = $pageNumber; + $r->stash->{problem_numbers} = \@problemNumbers; + $r->stash->{probOrder} = \@probOrder; - # report everything with the same time that we started with - my $timeNow = $self->{timeNow}; - my $grace = $ce->{gatewayGracePeriod}; + my $versionID = $set->version_id; + my $setVName = "$setID,v$versionID"; - # Convert the floating point value from Time::HiRes to an integer - # for use below. Truncate towards 0. - my $timeNowInt = int($timeNow); + # Report everything with the request submit time. Convert the floating point + # value from Time::HiRes to an integer for use below. Truncate towards 0. + my $timeNowInt = int($r->submitTime); - ######################################### - # preliminary error checking and output - ######################################### + # Answer processing - # if $self->{invalidSet} is set, then we have an error and should - # just bail with the appropriate error message - - if ($self->{invalidSet} || $self->{invalidProblem}) { - # delete any proctor keys that are floating around - if (defined($self->{'assignment_type'}) && $self->{'assignment_type'} eq 'proctored_gateway') { - my $proctorID = $r->param('proctor_user'); - if ($proctorID) { - eval { $db->deleteKey("$effectiveUser,$proctorID"); }; - eval { $db->deleteKey("$effectiveUser,$proctorID,g"); }; - } - } - - my $newlink = ''; - my $usernote = ''; - if (defined($self->{invalidVersionCreation}) - && $self->{invalidVersionCreation} == 1) - { - my $gwpage = $urlpath->newFromModule( - $urlpath->module, $r, - courseID => $urlpath->arg("courseID"), - setID => $urlpath->arg("setID") - ); - my $link = $self->systemLink($gwpage, - params => { effectiveUser => $effectiveUser, user => $user, createnew_ok => 1 }); - $newlink = CGI::p(CGI::a({ href => $link }, "Create new set version.")); - $usernote = " (acted as by $user)"; - } elsif (defined($self->{invalidVersionCreation}) - && $self->{invalidVersionCreation} == 2) - { - $usernote = " (acted as by $user)"; - } - - return CGI::div( - { class => 'alert alert-danger mb-2' }, - CGI::div( - { class => 'mb-2' }, - $r->maketext( - "The selected problem set ([_1]) is not a valid set for [_2][_3]:", $urlpath->arg("setID"), - $effectiveUser, $usernote - ) - ), - CGI::div($self->{invalidSet}), - $newlink - ); - } - - my $tmplSet = $self->{tmplSet}; - my $set = $self->{set}; - my $Problem = $self->{problem}; - my $permissionLevel = $self->{permissionLevel}; - my $submitAnswers = $self->{submitAnswers}; - my $checkAnswers = $self->{checkAnswers}; - my $previewAnswers = $self->{previewAnswers}; - my $newPage = $self->{newPage}; - my %want = %{ $self->{want} }; - my %can = %{ $self->{can} }; - my %must = %{ $self->{must} }; - my %will = %{ $self->{will} }; - - my @problems = @{ $self->{ra_problems} }; - my @pg_results = @{ $self->{ra_pg_results} }; - my @pg_errors = @{ $self->{errors} }; - my $requestedVersion = $self->{requestedVersion}; - - my $startProb = $self->{startProb}; - my $endProb = $self->{endProb}; - my $numPages = $self->{numPages}; - my $pageNumber = $self->{pageNumber}; - my @problemNumbers = @{ $self->{ra_problem_numbers} }; - my @probOrder = @{ $self->{ra_probOrder} }; - - my $setName = $set->set_id; - my $versionNumber = $set->version_id; - my $setVName = "$setName,v$versionNumber"; - my $numProbPerPage = $set->problems_per_page; - - # translation errors -- we use the same output routine as Problem.pm, - # but play around to allow for errors on multiple translations - # because we have an array of problems to deal with. - if (@pg_errors) { - my $errorNum = 1; - my ($message, $context) = ('', ''); - foreach (@pg_errors) { - - $message .= "$errorNum. " if (@pg_errors > 1); - $message .= $_->{message} . CGI::br() . "\n"; - - $context .= CGI::p((@pg_errors > 1 ? "$errorNum." : '') . $_->{context}) . "\n\n" - . CGI::div({ class => 'gwDivider' }, "") . "\n\n"; - } - return $self->errorOutput($message, $context); - } - - #################################### - # answer processing - #################################### - - debug("begin answer processing"); + debug('begin answer processing'); my @scoreRecordedMessage = ('') x scalar(@problems); my $LTIGradeResult = -1; - #################################### - # save results to database as appropriate - #################################### - - if ($submitAnswers || (($previewAnswers || $newPage) && $can{recordAnswers})) { - # if we're submitting answers, we have to save the problems - # to the database. - # if we're previewing or switching pages and can still - # record answers, we save the last answer for future - # reference - - # first, if we're submitting answers for a proctored exam, - # we want to delete the proctor keys that authorized - # that grading, so that it isn't possible to just log - # in and take another proctored test without getting - # reauthorized - if ($submitAnswers && $self->{'assignment_type'} eq 'proctored_gateway') { + # Save results to database as appropriate + if ($self->{submitAnswers} || (($self->{previewAnswers} || $r->param('newPage')) && $can{recordAnswers})) { + # If answers are being submitted, then save the problems to the database. If this is a preview or pages change + # and answers can be recorded, then save the last answer for future reference. + + # First, deal with answers being submitted for a proctored exam. Delete the proctor keys that authorized the + # grading, so that it isn't possible to log in and take another proctored test without being reauthorized. + if ($self->{submitAnswers} && $self->{assignment_type} eq 'proctored_gateway') { my $proctorID = $r->param('proctor_user'); - # if we don't have attempts left, delete all - # proctor keys for this user - if ($set->attempts_per_version - 1 - $Problem->num_correct - $Problem->num_incorrect <= 0) { - eval { $db->deleteAllProctorKeys($effectiveUser); }; + # If there are no attempts left, delete all proctor keys for this user. + if ($set->attempts_per_version - 1 - $problem->num_correct - $problem->num_incorrect <= 0) { + eval { $db->deleteAllProctorKeys($effectiveUserID); }; } else { - # otherwise, delete only the grading key - eval { $db->deleteKey("$effectiveUser,$proctorID,g"); }; - # in this case we may have a past, login, - # proctor key that we can keep so that - # we don't have to get another login to - # continue working the test - if ($r->param("past_proctor_user") && $r->param("past_proctor_key")) { - $r->param("proctor_user", $r->param("past_proctor_user")); - $r->param("proctor_key", $r->param("past_proctor_key")); + # Otherwise, delete only the grading key. + eval { $db->deleteKey("$effectiveUserID,$proctorID,g"); }; + # In this case there may be a past login proctor key that can be kept so that another login to continue + # working the test is not needed. + if ($r->param('past_proctor_user') && $r->param('past_proctor_key')) { + $r->param('proctor_user', $r->param('past_proctor_user')); + $r->param('proctor_key', $r->param('past_proctor_key')); } } - # this is unsubtle, but we'd rather not have bogus - # keys sitting around + # This is unsubtle, but we'd rather not have bogus keys sitting around. if ($@) { - die("ERROR RESETTING PROCTOR GRADING KEY(S): $@\n"); + die "ERROR RESETTING PROCTOR GRADING KEY(S): $@\n"; } } - my @pureProblems = $db->getAllProblemVersions($effectiveUser, $setName, $versionNumber); - foreach my $i (0 .. $#problems) { # process each problem - # this code is essentially that from Problem.pm - # begin problem loop for sticky answers + my @pureProblems = $db->getAllProblemVersions($effectiveUserID, $setID, $versionID); + for my $i (0 .. $#problems) { + # Process each problem. my $pureProblem = $pureProblems[ $probOrder[$i] ]; my $problem = $problems[ $probOrder[$i] ]; my $pg_result = $pg_results[ $probOrder[$i] ]; - # store answers in problem for sticky answers later - # my %answersToStore; - - # we have to be a little careful about getting the - # answers that we're saving, because we don't have - # a pg_result object for all problems if we're not - # submitting - my %answerHash = (); - my @answer_order = (); + my %answerHash; + my @answer_order; my $encoded_last_answer_string; - if (ref($pg_result)) { - my ($past_answers_string, $scores, $isEssay); #not used here + + if (ref $pg_result) { + my ($past_answers_string, $scores, $isEssay); # Not used here ($past_answers_string, $encoded_last_answer_string, $scores, $isEssay) = create_ans_str_from_responses($self, $pg_result); } else { @@ -1653,20 +991,21 @@ sub body { my @answer_order = @fields; $encoded_last_answer_string = encodeAnswers(%answersToStore, @answer_order); } - # and get the last answer + + # Get the last answer $problem->last_answer($encoded_last_answer_string); $pureProblem->last_answer($encoded_last_answer_string); - # Next, store the state in the database if answers are being recorded. - if ($submitAnswers && $will{recordAnswers}) { + # Store the state in the database if answers are being recorded. + if ($self->{submitAnswers} && $will{recordAnswers}) { my $score = - compute_reduced_score($ce, $problem, $set, $pg_result->{state}{recorded_score}, $timeNow); + compute_reduced_score($ce, $problem, $set, $pg_result->{state}{recorded_score}, $r->submitTime); $problem->status($score) if $score > $problem->status; $problem->sub_status($problem->status) if (!$ce->{pg}{ansEvalDefaults}{enableReducedScoring} || !$set->enable_reduced_scoring - || before($set->reduced_scoring_date, $timeNow)); + || before($set->reduced_scoring_date, $r->submitTime)); $problem->attempted(1); $problem->num_correct($pg_result->{state}{num_of_correct_ans}); @@ -1679,13 +1018,16 @@ sub body { $pureProblem->num_incorrect($pg_result->{state}{num_of_incorrect_ans}); if ($db->putProblemVersion($pureProblem)) { - $scoreRecordedMessage[ $probOrder[$i] ] = $r->maketext('Your score on this problem was recorded.'); + # Use a simple untranslated value here. This message will never be shown, and will later be + # used in a string comparison. Don't compare translated strings! + $scoreRecordedMessage[ $probOrder[$i] ] = 'recorded'; } else { $scoreRecordedMessage[ $probOrder[$i] ] = $r->maketext('Your score was not recorded because ' . 'there was a failure in storing the problem record to the database.'); } - # write the transaction log - writeLog($self->{ce}, "transaction", + + # Write the transaction log + writeLog($self->{ce}, 'transaction', $problem->problem_id . "\t" . $problem->set_id . "\t" . $problem->user_id . "\t" @@ -1698,11 +1040,8 @@ sub body { . $problem->last_answer . "\t" . $problem->num_correct . "\t" . $problem->num_incorrect); - } elsif ($submitAnswers) { - # this is the case where we submitted answers - # but can't save them; report an error - # message - + } elsif ($self->{submitAnswers}) { + # This is the case answers were submitted but can not be saved. Report an error message. if ($self->{isClosed}) { $scoreRecordedMessage[ $probOrder[$i] ] = $r->maketext('Your score was not recorded because this problem set version is not open.'); @@ -1710,53 +1049,45 @@ sub body { $scoreRecordedMessage[ $probOrder[$i] ] = $r->maketext( 'Your score was not recorded because you have no attempts remaining on this set version.'); } elsif (!$self->{versionIsOpen}) { - my $endTime = ($set->version_last_attempt_time) ? $set->version_last_attempt_time : $timeNow; - if ($endTime > $set->due_date && $endTime < $set->due_date + $grace) { + my $endTime = ($set->version_last_attempt_time) ? $set->version_last_attempt_time : $r->submitTime; + if ($endTime > $set->due_date && $endTime < $set->due_date + $ce->{gatewayGracePeriod}) { $endTime = $set->due_date; } my $elapsed = int(($endTime - $set->open_date) / 0.6 + 0.5) / 100; - # we assume that allowed is an even - # number of minutes - my $allowed = ($set->due_date - $set->open_date) / 60; $scoreRecordedMessage[ $probOrder[$i] ] = $r->maketext( - 'Your score was not recorded because ' - . ' you have exceeded the time limit for this test. (Time taken: [_1] min; allowed: [_2] min.)', - $elapsed, $allowed + 'Your score was not recorded because you have exceeded the time limit for this test. ' + . '(Time taken: [_1] min; allowed: [_2] min.)', + $elapsed, + # Assume the allowed time is an even number of minutes. + ($set->due_date - $set->open_date) / 60 ); } else { $scoreRecordedMessage[ $probOrder[$i] ] = $r->maketext('Your score was not recorded.'); } } else { - # finally, we must be previewing or switching - # pages. save only the last answer for the - # problems + # The final case is that of a preview or page change. Save the last answers for the problems. $db->putProblemVersion($pureProblem); } - } # end loop through problems - # end loop through problems for sticky answer + } - #Try to update the student score on the LMS - # if that option is enabled. - my $LTIGradeMode = $self->{ce}->{LTIGradeMode} // ''; - if ($submitAnswers && $will{recordAnswers} && $LTIGradeMode && $self->{ce}->{LTIGradeOnSubmit}) { + # Try to update the student score on the LMS if that option is enabled. + my $LTIGradeMode = $self->{ce}{LTIGradeMode} // ''; + if ($self->{submitAnswers} && $will{recordAnswers} && $LTIGradeMode && $self->{ce}{LTIGradeOnSubmit}) { my $grader = WeBWorK::Authen::LTIAdvanced::SubmitGrade->new($r); if ($LTIGradeMode eq 'course') { - $LTIGradeResult = $grader->submit_course_grade($effectiveUser); + $LTIGradeResult = $grader->submit_course_grade($effectiveUserID); } elsif ($LTIGradeMode eq 'homework') { - $LTIGradeResult = $grader->submit_set_grade($effectiveUser, $setName); + $LTIGradeResult = $grader->submit_set_grade($effectiveUserID, $setID); } } - # Finally, log student answers if we're submitting answers, - # provided that we can record answers. Note that this will log an overtime submission - # (or any case where someone submits the test, or spoofs a request to submit a test). + # Finally, log student answers answers are being submitted, provided that answers can be recorded. Note that + # this will log an overtime submission (or any case where someone submits the test, or spoofs a request to + # submit a test). + my $answer_log = $self->{ce}{courseFiles}{logs}{answer_log}; - my $answer_log = $self->{ce}->{courseFiles}->{logs}->{'answer_log'}; - - # This is modified from process_and_log_answer in ProblemUtil.pm - if (defined($answer_log) && $submitAnswers) { - foreach my $i (0 .. $#problems) { - # Begin problem loop for passed answers. + if (defined $answer_log && $self->{submitAnswers}) { + for my $i (0 .. $#problems) { next unless ref($pg_results[ $probOrder[$i] ]); my $problem = $problems[ $probOrder[$i] ]; @@ -1772,16 +1103,16 @@ sub body { # Write to courseLog, use the recorded time of when the submission was received, but as an integer writeCourseLogGivenTime( $self->{ce}, - "answer_log", + 'answer_log', $timeNowInt, - join("", + join('', '|', $problem->user_id, '|', $setVName, '|', ($i + 1), '|', $scores, "\t$timeNowInt\t", "$past_answers_string") ); # Add to PastAnswer db my $pastAnswer = $db->newPastAnswer(); - $pastAnswer->course_id($courseID); + $pastAnswer->course_id($urlpath->arg('courseID')); $pastAnswer->user_id($problem->user_id); $pastAnswer->set_id($setVName); $pastAnswer->problem_id($problem->problem_id); @@ -1794,13 +1125,13 @@ sub body { } my $caliper_sensor = Caliper::Sensor->new($self->{ce}); - if ($caliper_sensor->caliperEnabled() && defined($answer_log)) { + if ($caliper_sensor->caliperEnabled() && defined $answer_log) { my $events = []; my $startTime = $r->param('startTime'); - my $endTime = time(); - if ($submitAnswers && $will{recordAnswers}) { - foreach my $i (0 .. $#problems) { + my $endTime = int($r->submitTime); + if ($self->{submitAnswers} && $will{recordAnswers}) { + for my $i (0 .. $#problems) { my $problem = $problems[ $probOrder[$i] ]; my $pg = $pg_results[ $probOrder[$i] ]; my $completed_question_event = { @@ -1809,7 +1140,7 @@ sub body { 'profile' => 'AssessmentProfile', 'object' => Caliper::Entity::problem_user( $self->{ce}, $db, - $problem->set_id(), $versionNumber, + $problem->set_id(), $versionID, $problem->problem_id(), $problem->user_id(), $pg ), @@ -1817,7 +1148,7 @@ sub body { $self->{ce}, $db, $problem->set_id(), - $versionNumber, + $versionID, $problem->problem_id(), $problem->user_id(), $pg, @@ -1831,9 +1162,9 @@ sub body { 'type' => 'AssessmentEvent', 'action' => 'Submitted', 'profile' => 'AssessmentProfile', - 'object' => Caliper::Entity::problem_set($self->{ce}, $db, $setName), + 'object' => Caliper::Entity::problem_set($self->{ce}, $db, $setID), 'generated' => Caliper::Entity::problem_set_attempt( - $self->{ce}, $db, $setName, $versionNumber, $effectiveUser, $startTime, $endTime + $self->{ce}, $db, $setID, $versionID, $effectiveUserID, $startTime, $endTime ), }; push @$events, $submitted_set_event; @@ -1842,9 +1173,9 @@ sub body { 'type' => 'AssessmentEvent', 'action' => 'Paused', 'profile' => 'AssessmentProfile', - 'object' => Caliper::Entity::problem_set($self->{ce}, $db, $setName), + 'object' => Caliper::Entity::problem_set($self->{ce}, $db, $setID), 'generated' => Caliper::Entity::problem_set_attempt( - $self->{ce}, $db, $setName, $versionNumber, $effectiveUser, $startTime, $endTime + $self->{ce}, $db, $setID, $versionID, $effectiveUserID, $startTime, $endTime ), }; push @$events, $paused_set_event; @@ -1858,30 +1189,35 @@ sub body { push @$events, $tool_use_event; $caliper_sensor->sendEvents($r, $events); - # reset start time + # Reset start time $r->param('startTime', ''); } } - debug("end answer processing"); - # end problem loop + debug('end answer processing'); + + $self->{scoreRecordedMessage} = \@scoreRecordedMessage; + $self->{LTIGradeResult} = $LTIGradeResult; # Additional set-level database manipulation: We want to save the time that a set was submitted, and for proctored # tests we want to reset the assignment type after a set is submitted for the last time so that it's possible to # look at it later without getting proctor authorization. if ( ( - $submitAnswers - && ($will{recordAnswers} || (!$set->version_last_attempt_time && $timeNow > $set->due_date + $grace)) + $self->{submitAnswers} + && ( + $will{recordAnswers} + || (!$set->version_last_attempt_time && $r->submitTime > $set->due_date + $ce->{gatewayGracePeriod}) + ) ) || ( $set->assignment_type eq 'proctored_gateway' && ( - ($user eq $effectiveUser && !$can{recordAnswersNextTime}) + ($userID eq $effectiveUserID && !$can{recordAnswersNextTime}) || ( - $user ne $effectiveUser - && $authz->hasPermissions($user, "record_answers_when_acting_as_student") + $userID ne $effectiveUserID + && $authz->hasPermissions($userID, 'record_answers_when_acting_as_student') && $set->attempts_per_version > 0 - && ($Problem->num_correct + $Problem->num_incorrect + ($submitAnswers ? 1 : 0) >= + && ($problem->num_correct + $problem->num_incorrect + ($self->{submitAnswers} ? 1 : 0) >= $set->attempts_per_version) ) ) @@ -1890,783 +1226,285 @@ sub body { { # Save the submission time if we're recording the answer, or if the first submission occurs after the due_date. $set->version_last_attempt_time($timeNowInt) - if ($submitAnswers - && ($will{recordAnswers} || (!$set->version_last_attempt_time && $timeNow > $set->due_date + $grace))); + if ( + $self->{submitAnswers} + && ( + $will{recordAnswers} + || (!$set->version_last_attempt_time && $r->submitTime > $set->due_date + $ce->{gatewayGracePeriod}) + ) + ); $set->assignment_type('gateway') if ( $set->assignment_type eq 'proctored_gateway' && ( - ($user eq $effectiveUser && !$can{recordAnswersNextTime}) + ($userID eq $effectiveUserID && !$can{recordAnswersNextTime}) || ( - $user ne $effectiveUser - && $authz->hasPermissions($user, "record_answers_when_acting_as_student") + $userID ne $effectiveUserID + && $authz->hasPermissions($userID, 'record_answers_when_acting_as_student') && $set->attempts_per_version > 0 - && ($Problem->num_correct + $Problem->num_incorrect + ($submitAnswers ? 1 : 0) >= + && ($problem->num_correct + $problem->num_incorrect + ($self->{submitAnswers} ? 1 : 0) >= $set->attempts_per_version) ) ) ); # Save only parameters that determine access to the set version. - my $cleanSet = $db->getSetVersion($effectiveUser, $set->set_id, $versionNumber); + my $cleanSet = $db->getSetVersion($effectiveUserID, $set->set_id, $versionID); $cleanSet->assignment_type($set->assignment_type); $cleanSet->version_last_attempt_time($set->version_last_attempt_time); $db->putSetVersion($cleanSet); } - #################################### - # output - #################################### - - # some convenient output variables - my $canShowProblemScores = $can{showScore} - && ($set->hide_score_by_problem eq 'N' - || $authz->hasPermissions($user, "view_hidden_work")); - - my $canShowWork = $authz->hasPermissions($user, "view_hidden_work") - || ($set->hide_work eq 'N' || ($set->hide_work eq 'BeforeAnswerDate' && $timeNow > $tmplSet->answer_date)); - - # For answer checking on multi-page tests, track changes that made on other pages, and scores for problems on those + # For answer checking on multi-page tests, track changes made on other pages, and scores for problems on those # pages. @probStatus is used for this. Initialize this to the saved score either from a hidden input or the # database, and then update this when calculating the score for checked or submitted tests. my @probStatus; # Figure out the recorded score for the set, and the score on this attempt. - my $recordedScore = 0; - my $totPossible = 0; + $self->{recordedScore} = 0; + $self->{totalPossible} = 0; for (@problems) { my $pv = $_->value // 1; - $totPossible += $pv; - $recordedScore += $_->status * $pv if defined $_->status; + $self->{totalPossible} += $pv; + $self->{recordedScore} += $_->status * $pv if defined $_->status; push(@probStatus, ($r->param('probstatus' . $_->problem_id) || $_->status || 0)); } # To get the attempt score, determine the score for each problem, and multiply the total for the problem by the # weight (value) of the problem. Avoid translating all of the problems when checking answers. # Note that it is okay to ignore problem order here as all arrays used are index the same. - my $attemptScore = 0; + $self->{attemptScore} = 0; if ($will{recordAnswers} || $will{checkAnswers}) { my $i = 0; for my $pg (@pg_results) { - my $pValue = $problems[$i]->value() ? $problems[$i]->value() : 1; + my $pValue = $problems[$i]->value ? $problems[$i]->value : 1; my $pScore = 0; if (ref $pg) { # If a pg object is available, then use the pg recorded score and save it in the @probStatus array. - $pScore = compute_reduced_score($ce, $problems[$i], $set, $pg->{state}{recorded_score}, $timeNow); + $pScore = compute_reduced_score($ce, $problems[$i], $set, $pg->{state}{recorded_score}, $r->submitTime); $probStatus[$i] = $pScore if $pScore > $probStatus[$i]; } else { # If a pg object is not available, then use the saved problem status. $pScore = $probStatus[$i]; } - $attemptScore += $pScore * $pValue; + $self->{attemptScore} += $pScore * $pValue; $i++; } + + $self->{attemptScore} = wwRound(2, $self->{attemptScore}); } + $self->{probStatus} = \@probStatus; - # we want to print elapsed and allowed times; allowed is easy - my $allowed = sprintf("%.0f", 10 * ($set->due_date - $set->open_date) / 6) / 100; - # elapsed is a little harder; we're counting to the last submission - # time, or to the current time if the test hasn't been submitted, - # and if the submission fell in the grace period round it to the - # due_date - my $exceededAllowedTime = 0; - my $endTime = ($set->version_last_attempt_time) ? $set->version_last_attempt_time : $timeNowInt; - if ($endTime > $set->due_date && $endTime < $set->due_date + $grace) { + # To compute the elapsed time, take into account the last submission time or the current time if the test hasn't + # been submitted. Also, if the submission is during the grace period, then round it to the due date. + $self->{exceededAllowedTime} = 0; + my $endTime = $set->version_last_attempt_time ? $set->version_last_attempt_time : $timeNowInt; + if ($endTime > $set->due_date && $endTime < $set->due_date + $ce->{gatewayGracePeriod}) { $endTime = $set->due_date; } elsif ($endTime > $set->due_date) { - $exceededAllowedTime = 1; - } - my $elapsedTime = int(($endTime - $set->open_date) / 0.6 + 0.5) / 100; - - # Get the number of remaining attempts. - my $numLeft = - ($set->attempts_per_version || 0) - - $Problem->num_correct - - $Problem->num_incorrect - - ($submitAnswers && $will{recordAnswers} ? 1 : 0); - my $attemptNumber = - $Problem->num_correct + $Problem->num_incorrect + ($submitAnswers && $will{recordAnswers} ? 1 : 0); - - # a handy noun for when referring to a test - my $testNoun = (($set->attempts_per_version || 0) > 1) ? $r->maketext("submission") : $r->maketext("test"); - my $testNounNum = - (($set->attempts_per_version || 0) > 1) - ? $r->maketext("submission (version [_1])", $versionNumber) - : $r->maketext("version ([_1])", $versionNumber); - - ##### start output of test headers: - ##### display information about recorded and checked scores - $attemptScore = wwRound(2, $attemptScore); - if ($will{recordAnswers}) { - # the distinction between $can{recordAnswers} and ! $can{} has - # been dealt with above and recorded in @scoreRecordedMessage - my $divClass = 'ResultsWithoutError'; - my $recdMsg = ''; - foreach (@scoreRecordedMessage) { - if ($_ !~ $r->maketext('Your score on this problem was recorded.')) { - $recdMsg = $_; - $divClass = 'ResultsWithError'; - last; - } - } - - print CGI::start_div({ class => $divClass . ' mb-3' }); - if ($recdMsg) { - # then there was an error when saving the results - print CGI::strong($r->maketext("Your score on this [_1] was NOT recorded.", $testNounNum), $recdMsg), - CGI::br(); - } else { - # no error; print recorded message - print CGI::strong($r->maketext("Your score on this [_1] WAS recorded.", $testNounNum)), CGI::br(); - - # and show the score if we're allowed to do that - if ($can{showScore}) { - print CGI::strong($r->maketext( - "Your score on this [_1] is [_2]/[_3].", $testNoun, $attemptScore, $totPossible)); - } else { - if ($set->hide_score eq 'BeforeAnswerDate') { - print $r->maketext("(Your score on this [_1] is not available until [_2].)", - $testNoun, $self->formatDateTime($set->answer_date)); - } else { - print $r->maketext("(Your score on this [_1] is not available.)", $testNoun); - } - } - - # Print a message if we are trying to send the score to - # an LMS - if ($LTIGradeResult != -1) { - print CGI::br(); - print $LTIGradeResult - ? $r->maketext("Your score was successfully sent to the LMS.") - : $r->maketext("Your score was not successfully sent to the LMS."); - } - } - print CGI::end_div(); - - # finally, if there is another, recorded message, print that - # too so that we know what's going on - if ($set->attempts_per_version > 1 - && $attemptNumber > 0 - && $recordedScore != $attemptScore - && $can{showScore}) - { - print CGI::start_div({ class => 'gwMessage' }); - my $recScore = wwRound(2, $recordedScore); - print $r->maketext("The recorded score for this version is [_1]/[_2].", $recScore, $totPossible); - print CGI::end_div(); - } - } elsif ($will{checkAnswers}) { - if ($can{showScore}) { - print CGI::start_div({ class => 'gwMessage' }); - print CGI::strong($r->maketext( - "Your score on this (checked, not recorded) submission is [_1]/[_2].", $attemptScore, - $totPossible - )), - CGI::br(); - my $recScore = wwRound(2, $recordedScore); - print $r->maketext("The recorded score for this version is [_1]/[_2].", $recScore, $totPossible); - print CGI::end_div(); - } + $self->{exceededAllowedTime} = 1; } + $self->{elapsedTime} = int(($endTime - $set->open_date) / 0.6 + 0.5) / 100; - # Display the reduced scoring message if reduced scoring is enabled and the set is in the reduced scoring period. - if ($ce->{pg}{ansEvalDefaults}{enableReducedScoring} - && $set->enable_reduced_scoring - && after($set->reduced_scoring_date, $self->r->{submitTime}) - && before($set->due_date, $self->r->{submitTime}) - && ($can{recordAnswersNextTime} || $submitAnswers)) - { - print CGI::div( - { class => 'gwMessage' }, - CGI::b($r->maketext( - 'Note: [_1]', - CGI::i($r->maketext( - 'You are in the Reduced Scoring Period. All work counts for [_1]% of the original.', - $ce->{pg}{ansEvalDefaults}{reducedScoringValue} * 100 - )) - )) - ); - } - - # Remaining output of test headers: - # Display timer or information about elapsed time, print link, and information about any recorded score if not - # submitAnswers or checkAnswers. - if ($can{recordAnswersNextTime}) { - my $timeLeft = $set->due_date() - $timeNowInt; # This is in seconds - - # Print the timer if there is less than 24 hours left. - if ($timeLeft < 86400) { - print CGI::div( - { - id => 'gwTimer', - class => 'alert alert-warning p-1', - data_server_time => $timeNowInt, - data_server_due_time => $set->due_date(), - data_grace_period => $ce->{gatewayGracePeriod}, - data_alert_title => $r->maketext('Test Time Notification'), - data_alert_three => $r->maketext( - 'You have less than 90 seconds left to complete this ' - . 'assignment. You should finish it soon!' - ), - data_alert_two => ('
      ' . $r->maketext('You have less than 45 seconds left!') . '
      ') - . ( - ($set->attempts_per_version > 1 && $attemptNumber > 0) ? '' - : '
      ' . $r->maketext('Press "Grade Test" soon!') . '
      ' - ), - data_alert_one => ('
      ' . $r->maketext('You are out of time!') . '
      ') - . ( - ($set->attempts_per_version > 1 && $attemptNumber > 0) ? '' - : '
      ' . $r->maketext('Press "Grade Test" now!') . '
      ' - ), - $user ne $effectiveUser ? (data_acting => 1) : () - }, - # '00:00:00' is a placeholder that is replaced by the actual time remaining via javascript. - $r->maketext('Remaining time: [_1]', '00:00:00') - ); - } - if ($timeLeft < 60 && $timeLeft > 0 && !$authz->hasPermissions($user, 'record_answers_when_acting_as_student')) - { - print CGI::div({ class => 'ResultsWithError d-inline-block mb-2' }, - CGI::b($r->maketext('You have less than 1 minute to complete this test.'))); - } elsif ($timeLeft <= 0 && !$authz->hasPermissions($user, 'record_answers_when_acting_as_student')) { - print CGI::div( - { class => 'ResultsWithError d-inline-block mb-2' }, - CGI::b( - $r->maketext('You are out of time!') . ' ' - . ( - $set->attempts_per_version > 1 - && $attemptNumber > 0 ? '' : $r->maketext('Press "Grade Test" now!') - ) - ) - ); - } - # If there are multiple attempts per version, indicate the number remaining, and if we've submitted a multiple - # attempt multi-page test, show the score on the previous submission - if ($set->attempts_per_version > 1) { - print CGI::div({ class => 'alert alert-info p-1' }, - CGI::em($r->maketext('You have [_1] attempt(s) remaining on this test.', $numLeft))); - if ($numLeft < $set->attempts_per_version && $numPages > 1 && $can{showScore}) { - print CGI::start_div({ id => 'gwScoreSummary' }), - CGI::strong($r->maketext('Score summary for last submit:')); - print CGI::start_table(); - print CGI::Tr( - CGI::th({ align => 'left' }, $r->maketext('Prob')), - CGI::td(''), CGI::th($r->maketext('Status')), - CGI::td(''), CGI::th($r->maketext('Result')) - ); - for (my $i = 0; $i < @probStatus; $i++) { - print CGI::Tr(CGI::td([ - ($i + 1), '', int(100 * $probStatus[ $probOrder[$i] ] + 0.5) . '%', - '', $probStatus[ $probOrder[$i] ] == 1 ? $r->maketext('Correct') : $r->maketext('Incorrect') - ])); - } - print CGI::end_table(), CGI::end_div(); - } - } - } else { - if (!$checkAnswers && !$submitAnswers) { - if ($can{showScore}) { - print CGI::start_div({ class => 'gwMessage' }); - - my $scMsg = $r->maketext("Your recorded score on this test (version [_1]) is [_2]/[_3].", - $versionNumber, wwRound(2, $recordedScore), $totPossible); - if ($exceededAllowedTime && $recordedScore == 0) { - $scMsg .= " " . $r->maketext("You exceeded the allowed time."); - } - print CGI::strong($scMsg), CGI::br(); - print CGI::end_div(); - } - } - - if ($set->version_last_attempt_time) { - print CGI::start_div({ class => 'gwMessage' }); - print $r->maketext("Time taken on test: [_1] min ([_2] min allowed).", $elapsedTime, $allowed); - print CGI::end_div(); - } elsif ($exceededAllowedTime && $recordedScore != 0) { - print CGI::start_div({ class => 'gwMessage' }); - print $r->maketext("(This test is overtime because it was not submitted in the allowed time.)"); - print CGI::end_div(); - } + # Get the number of attempts and number of remaining attempts. + $self->{attemptNumber} = + $problem->num_correct + $problem->num_incorrect + ($self->{submitAnswers} && $will{recordAnswers} ? 1 : 0); + $self->{numAttemptsLeft} = ($set->attempts_per_version || 0) - $self->{attemptNumber}; - if ($canShowWork && $set->set_id ne 'Undefined_Set') { - print CGI::start_div({ class => 'row' }); - print CGI::div( - { class => 'col-md-10 mb-1' }, - CGI::div( - { class => 'alert alert-info p-1 mb-0' }, - $r->maketext('The test (which is version [_1]) may no longer be submitted for a grade.', - $versionNumber) - . ($can{showScore} ? (' ' . $r->maketext('You may still check your answers.')) : '') - ) - ); + return; +} - # Display a print test link if the user is allowed to see work. - print CGI::div( - { class => 'col-md-2 text-end mb-1' }, - CGI::a( - { - href => "$ce->{webworkURLs}{root}/$ce->{courseName}/hardcopy/" - . $set->set_id . ',v' - . $set->version_id . '/?' - . $self->url_authen_args, - class => 'btn btn-info' - }, - $r->maketext('Print Test') - ) - ); - print CGI::end_div(); - } +sub head { + my ($self) = @_; + return '' unless ref $self->r->stash->{pg_results} eq 'ARRAY'; + my $head_text = ''; + for (@{ $self->r->stash->{pg_results} }) { + next unless ref $_; + $head_text .= $_->{head_text} if $_->{head_text}; } + return $head_text; +} - # this is a hack to get a URL that won't require a proctor login if - # we've submitted a proctored test for the last time. above we've - # reset the assignment_type in this case, so we'll use that to - # decide if we should give a path to an unproctored test. - my $action = $r->uri(); - $action =~ s/proctored_test_mode/test_mode/ if ($set->assignment_type() eq 'gateway'); - # we also want to be sure that if we're in a set, the 'action' in the - # form points us to the same set. - my $setname = $set->set_id; - my $setvnum = $set->version_id; - $action =~ s/(test_mode\/$setname)\/?$/$1,v$setvnum\//; #" - - if (!$can{recordAnswersNextTime} && !$canShowWork) { - # Problems can not be shown. - print CGI::div( - { class => 'gwProblem' }, - $set->hide_work eq 'BeforeAnswerDate' - ? CGI::strong($r->maketext( - 'Completed results for this assignment are not available until [_1].', - $self->formatDateTime($set->answer_date) - )) - : CGI::strong($r->maketext('Completed results for this assignment are not available.')) - ); - } else { - # Problems can be shown, so print out the main form and the problems. - my $startTime = $r->param('startTime') || time(); - - print CGI::start_form({ name => 'gwquiz', method => 'POST', action => $action, class => 'problem-main-form' }), - $self->hidden_authen_fields, - $self->hidden_proctor_authen_fields; - - # Hacks to use a javascript link to trigger previews and jump to subsequent pages of a multipage test. - print CGI::hidden({ name => 'pageChangeHack', value => '' }); - print CGI::hidden({ name => 'startTime', value => $startTime }); - if ($numProbPerPage && $numPages > 1) { - print CGI::hidden({ name => 'newPage', value => '' }); - print CGI::hidden({ name => 'currentPage', value => $pageNumber }); - } - - # Set up links between problems and, for multi-page tests, pages. - my $jumpLinks = ''; - my $probRow = []; - my @scoreRow; - for my $i (0 .. $#pg_results) { - my $pn = $i + 1; - if ($i >= $startProb && $i <= $endProb) { - push(@$probRow, CGI::a({ href => '#', class => 'problem-jump-link', data_problem_number => $pn }, $pn)); - } else { - push(@$probRow, $pn); - } - my $score = $probStatus[ $probOrder[$i] ]; - $score = $score == 1 ? "\x{1F4AF}" : wwRound(0, 100 * $score); - push(@scoreRow, - CGI::td({ class => 'score', data_problem_id => $problems[ $probOrder[$i] ]->problem_id }, $score)); - } - my @tableRows; - my @cols = (CGI::colgroup(CGI::col({ class => 'header' }))); - if ($numProbPerPage && $numPages > 1) { - push(@cols, - CGI::colgroup({ class => 'page' }, CGI::col({ class => 'problem' }) x $numProbPerPage) x $numPages); - my @pages; - for my $i (1 .. $numPages) { - my $pn = - $i == $pageNumber - ? $i - : CGI::a({ href => '#', class => 'page-change-link', data_page_number => $i }, $i); - my $class = $i == $pageNumber ? 'page active' : 'page'; - push(@pages, CGI::td({ colspan => $numProbPerPage, class => $class }, $pn)); - } - if ($numProbPerPage == 1) { - push(@tableRows, CGI::Tr(CGI::th({ scope => 'row' }, $r->maketext('Move to Problem:')), @pages)); - } else { - push( - @tableRows, - CGI::Tr( - CGI::th({ scope => 'row', class => 'text-nowrap' }, $r->maketext('Move to Page:')), @pages - ), - CGI::Tr( - CGI::th({ class => 'text-nowrap' }, $r->maketext('Jump to Problem:')), - CGI::td({ class => 'problem' }, $probRow) - ) - ); - } - } else { - push(@cols, CGI::colgroup({ class => 'page' }, CGI::col({ class => 'problem' }) x ($#pg_results + 1))); - push( - @tableRows, - CGI::Tr( - CGI::th({ class => 'text-nowrap' }, $r->maketext('Jump to Problem:')), - CGI::td({ class => 'problem' }, $probRow) - ) - ); - } - push(@tableRows, CGI::Tr(CGI::th($r->maketext('% Score:')), @scoreRow)) - if ($canShowProblemScores && $set->version_last_attempt_time); - $jumpLinks = CGI::div( - { class => 'table-responsive' }, - CGI::table( - { class => 'gwNavigation', role => 'navigation', 'aria-label' => 'problem navigation' }, - @cols, @tableRows - ) - ); - print $jumpLinks; - - # Print out problems and attempt results, as appropriate. - # Note: args to attemptResults are (self,) $pg, $showAttemptAnswers, $showCorrectAnswers, $showAttemptResults - # (and-ed with $showAttemptAnswers), $showSummary, $showAttemptPreview (or-ed with zero) - my $problemNumber = 0; - my $effectiveUserPermission = $db->getPermissionLevel($effectiveUser)->permission; - - for my $i (0 .. $#pg_results) { - my $pg = $pg_results[ $probOrder[$i] ]; - $problemNumber++; - - if ($i >= $startProb && $i <= $endProb) { - - my $recordMessage = ''; - my $resultsTable = ''; - - if ($pg->{flags}->{showPartialCorrectAnswers} >= 0 && $submitAnswers) { - if ($scoreRecordedMessage[ $probOrder[$i] ] !~ - $r->maketext('Your score on this problem was recorded.')) - { - $recordMessage = CGI::div( - { class => 'ResultsWithError d-inline-block mb-2' }, - $r->maketext('ANSWERS NOT RECORDED --'), - $scoreRecordedMessage[ $probOrder[$i] ] - ); - } - $resultsTable = $self->attemptResults( - $pg, 1, - $will{showCorrectAnswers}, - $pg->{flags}->{showPartialCorrectAnswers} && $canShowProblemScores, - $canShowProblemScores, 1 - ); - - } elsif ($will{checkAnswers} || $will{showProblemGrader}) { - $recordMessage = CGI::div( - { class => 'ResultsWithError d-inline-block mb-2' }, - $r->maketext('ANSWERS ONLY CHECKED -- '), - $r->maketext('ANSWERS NOT RECORDED') - ); - - $resultsTable = $self->attemptResults( - $pg, 1, - $will{showCorrectAnswers}, - $pg->{flags}->{showPartialCorrectAnswers} && $canShowProblemScores, - $canShowProblemScores, 1 - ); - - } elsif ($previewAnswers) { - $recordMessage = CGI::div( - { class => 'ResultsWithError d-inline-block mb-2' }, - $r->maketext('PREVIEW ONLY -- ANSWERS NOT RECORDED') - ); - $resultsTable = $self->attemptResults($pg, 1, 0, 0, 0, 1); - } - - print CGI::start_div({ class => 'gwProblem' }); - - # Output the jump to anchor. - print CGI::div({ id => "prob$i", tabindex => -1 }, $recordMessage); - - # Output the problem header. - print CGI::h2($r->maketext('Problem [_1].', $problemNumber)); +sub path { + my ($self, $args) = @_; - print CGI::start_span({ class => 'problem-sub-header' }); + my $r = $self->r; + my $ce = $self->{ce}; + my $setID = $r->urlpath->arg('setID'); + my $root = $ce->{webworkURLs}{root}; + my $courseName = $ce->{courseName}; - my $problemValue = $problems[ $probOrder[$i] ]->value; - if (defined($problemValue)) { - my $points = $problemValue == 1 ? $r->maketext('point') : $r->maketext('points'); - print "($problemValue $points)"; - } + my $navigation_allowed = $r->authz->hasPermissions($r->param('user'), 'navigation_allowed'); - my $inlist = grep($_ eq $effectiveUser, @{ $ce->{pg}{specialPGEnvironmentVars}{PRINT_FILE_NAMES_FOR} }); + return $self->pathMacro( + $args, + 'WeBWorK' => $navigation_allowed ? $root : '', + $courseName => $navigation_allowed ? "$root/$courseName" : '', + $setID eq 'Undefined_Set' || $self->{invalidSet} + ? ($setID => '') + : ( + $self->{set}->set_id => "$root/" + . $r->urlpath->newFromModule( + 'WeBWorK::ContentGenerator::ProblemSet', $r, + courseID => $courseName, + setID => $self->{set}->set_id + )->path, + 'v' . $self->{set}->version_id => '' + ), + ); +} - # This uses the permission level and user id of the user assigned to the set. - if ($effectiveUserPermission >= $ce->{pg}{specialPGEnvironmentVars}{PRINT_FILE_NAMES_PERMISSION_LEVEL} - || $inlist) - { - print ' ' . $problems[ $probOrder[$i] ]->source_file; - } +sub nav { + my ($self, $args) = @_; + my $r = $self->r; + my $db = $r->db; + my $userID = $r->param('user'); + my $effectiveUserID = $r->param('effectiveUser'); - print CGI::end_span(); + return '' if $self->{invalidSet}; - my $instructor_comment = $self->get_instructor_comment($problems[ $probOrder[$i] ]); - if ($instructor_comment) { - print CGI::start_div({ id => 'answerComment', class => 'answerComments' }); - print CGI::b($r->maketext('Instructor Comment:')), CGI::br(); - print CGI::escapeHTML($instructor_comment); - print CGI::end_div(); - } + # Set up and display a student navigation for those that have permission to act as a student. + if ($r->authz->hasPermissions($userID, 'become_student') && $effectiveUserID ne $userID) { + my $setID = $self->{set}->set_id; - print CGI::div({ class => 'problem-content col-lg-10' }, $pg->{body_text}); + return '' if $setID eq 'Undefined_Set'; - print CGI::div({ class => 'mb-2' }, CGI::b($r->maketext('Note: [_1]', CGI::i($pg->{result}{msg})))) - if $pg->{result}{msg}; + my $setVersion = $self->{set}->version_id; + my $courseName = $self->{ce}{courseName}; - print CGI::div( - { class => 'text-end mb-2' }, - CGI::a( - { - href => '#', - class => 'gateway-preview-btn btn btn-secondary', - ($numProbPerPage && $numPages > 1) ? (data_page_number => $pageNumber) : () - }, - $r->maketext('preview answers') - ) - ); + # Find all versions of this set that have been taken (excluding those taken by the current user). + my @users = + $db->listSetVersionsWhere({ user_id => { not_like => $userID }, set_id => { like => "$setID,v\%" } }); + my @allUserRecords = $db->getUsers(map { $_->[0] } @users); - print $resultsTable if $resultsTable; + my $filter = $r->param('studentNavFilter'); - # Initialize the problem graders for the problem. - if ($self->{will}{showProblemGrader}) { - my $problem_grader = WeBWorK::ContentGenerator::Instructor::SingleProblemGrader->new($self->r, $pg, - $problems[ $probOrder[$i] ]); - $problem_grader->insertGrader; - } + # Format the student names for display, and associate the users with the test versions. + my %filters; + my @userRecords; + for (0 .. $#allUserRecords) { + # Add to the sections and recitations if defined. Also store the first user found in that section or + # recitation. This user will be switched to when the filter is selected. + my $section = $allUserRecords[$_]->section; + $filters{"section:$section"} = + [ $r->maketext('Filter by section [_1]', $section), $allUserRecords[$_]->user_id, $users[$_][2] ] + if $section && !$filters{"section:$section"}; + my $recitation = $allUserRecords[$_]->recitation; + $filters{"recitation:$recitation"} = + [ $r->maketext('Filter by recitation [_1]', $recitation), $allUserRecords[$_]->user_id, $users[$_][2] ] + if $recitation && !$filters{"recitation:$recitation"}; - print CGI::end_div(); - # Store the problem status for continued attempts recording. - my $pNum = $probOrder[$i] + 1; - print CGI::hidden({ -name => "probstatus$pNum", -value => $probStatus[ $probOrder[$i] ] }); + # Only keep this user if it satisfies the selected filter if a filter was selected. + next + unless !$filter + || ($filter =~ /^section:(.*)$/ && $allUserRecords[$_]->section eq $1) + || ($filter =~ /^recitation:(.*)$/ && $allUserRecords[$_]->recitation eq $1); - print CGI::div({ class => 'gwDivider' }, ''); - } else { - # Print out hidden fields with the current last answers. - my $curr_prefix = 'Q' . sprintf('%04d', $problemNumbers[ $probOrder[$i] ]) . '_'; - my @curr_fields = grep {/^(?!previous).*$curr_prefix/} keys %{ $self->{formFields} }; - for my $curr_field (@curr_fields) { - for (split(/\0/, $self->{formFields}->{$curr_field} // '')) { - print CGI::hidden({ -name => $curr_field, -value => $_ }); - } - } - # Store the problem status for continued attempts recording. - my $pNum = $probOrder[$i] + 1; - print CGI::hidden({ -name => "probstatus$pNum", -value => $probStatus[ $probOrder[$i] ] }); - } - } + my $addRecord = $allUserRecords[$_]; + push @userRecords, $addRecord; - print $jumpLinks; - print CGI::div({ class => 'gwDivider' }, ''); - - print CGI::start_div({ class => 'checkboxes-container col-12 my-2' }); - if ($can{showCorrectAnswers}) { - print CGI::div( - { class => 'form-check' }, - CGI::checkbox({ - name => 'showCorrectAnswers', - checked => $want{showCorrectAnswers} || $want{showProblemGrader}, - label => $r->maketext('Show correct answers'), - class => 'form-check-input', - labelattributes => { class => 'form-check-label' } - }) - ); - } - if ($can{showSolutions}) { - print CGI::div( - { class => 'form-check' }, - CGI::checkbox({ - name => 'showSolutions', - checked => $will{showSolutions} || $want{showProblemGrader}, - label => $r->maketext('Show Solutions'), - class => 'form-check-input', - labelattributes => { class => 'form-check-label' } - }) - ); - } - if ($can{showProblemGrader}) { - print CGI::div( - { class => 'form-check' }, - CGI::checkbox({ - name => 'showProblemGrader', - checked => $want{showProblemGrader}, - label => $r->maketext('Show problem graders'), - class => 'form-check-input', - labelattributes => { class => 'form-check-label' } - }) - ); + $addRecord->{displayName} = + ($addRecord->last_name || $addRecord->first_name + ? $addRecord->last_name . ', ' . $addRecord->first_name + : $addRecord->user_id); + $addRecord->{setVersion} = $users[$_][2]; } - print CGI::end_div(); - - print CGI::div( - { class => 'submit-buttons-container col-12 mb-2' }, - CGI::submit({ - name => 'previewAnswers', - label => $r->maketext('Preview Test'), - class => 'btn btn-primary mb-1' - }), - $can{recordAnswersNextTime} - ? CGI::submit({ - name => 'submitAnswers', - label => $r->maketext('Grade Test'), - class => 'btn btn-primary mb-1', - $set->attempts_per_version - ? ( - data_confirm_dialog_title => $r->maketext('Do you want to grade this test?'), - data_confirm_btn_text => $r->maketext('Yes'), - data_cancel_btn_text => $r->maketext('No'), - data_confirm_dialog_message => $numLeft > 1 - ? $r->maketext( - 'You have [_1] submissions remaining for this test. If you say yes, then you will have ' - . '[quant,_2,submission] remaining. Once all submissions have been used, your answers ' - . 'will be final and you will not be able to continue to work this test version.', - $numLeft, - $numLeft - 1 - ) - : $set->attempts_per_version > 1 ? $r->maketext( - 'This is your last submission. If you say yes, then your answers will be final, ' - . 'and you will not be able to continue to work this test version.' - ) - : $r->maketext( - 'This is your only submission. If you say yes, then your answers will be final, ' - . 'and you will not be able to continue to work this test version.' - ) - ) - : () - }) - : '', - $can{checkAnswersNextTime} && !$can{recordAnswersNextTime} - ? CGI::submit({ - name => 'checkAnswers', - label => $r->maketext('Check Test'), - class => 'btn btn-primary mb-1' - }) - : '' - ); - - print CGI::p(CGI::em($r->maketext('Note: grading the test grades all problems, not just those on this page.'))) - if $numProbPerPage && $numPages > 1 && $can{recordAnswersNextTime}; - - print(CGI::hidden({ name => 'sourceFilePath', value => $r->param('sourceFilePath') })) - if defined($r->param('sourceFilePath')); - print(CGI::hidden({ name => 'problemSeed', value => $r->param('problemSeed') })) - if defined($r->param('problemSeed')); - - # Make sure the student nav filter setting is preserved when the problem form is submitted. - my $filter = $r->param('studentNavFilter'); - print CGI::hidden({ name => 'studentNavFilter', value => $filter }) if $filter; - print CGI::end_form(); - } + # Sort by last name, then first name, then user_id, then set version. + @userRecords = sort { + lc($a->last_name) cmp lc($b->last_name) + || lc($a->first_name) cmp lc($b->first_name) + || lc($a->user_id) cmp lc($b->user_id) + || lc($a->{setVersion}) <=> lc($b->{setVersion}) + } @userRecords; - # finally, put in a show answers option if appropriate - # print answer inspection button - if ($authz->hasPermissions($user, "view_answers")) { - my $hiddenFields = $self->hidden_authen_fields; - my $firstProb = $startProb + 1; - my $lastProb = $endProb + 1; - $hiddenFields =~ s/\"hidden_/\"pastans-hidden_/g; - my $pastAnswersPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Instructor::ShowAnswers", - $r, courseID => $ce->{courseName}); - my $showPastAnswersURL = $self->systemLink($pastAnswersPage, authen => 0); # no authen info for form action - print "\n", CGI::start_form(-method => "POST", -action => $showPastAnswersURL, -target => "WW_Info"), "\n", - $hiddenFields, "\n", - CGI::hidden(-name => 'courseID', -value => $ce->{courseName}), "\n", - CGI::hidden(-name => 'selected_sets', -value => $setVName), "\n", - CGI::hidden(-name => 'selected_users', -value => $effectiveUser), "\n"; - for (my $prob = $firstProb; $prob <= $lastProb; $prob++) { - print CGI::hidden(-name => 'selected_problems', -value => "$prob"), "\n"; + # Find the previous, current, and next test. + my $currentTestIndex = 0; + for (0 .. $#userRecords) { + if ($userRecords[$_]->user_id eq $effectiveUserID && $userRecords[$_]->{setVersion} == $setVersion) { + $currentTestIndex = $_; + last; + } } + my $prevTest = $currentTestIndex > 0 ? $userRecords[ $currentTestIndex - 1 ] : 0; + my $nextTest = $currentTestIndex < $#userRecords ? $userRecords[ $currentTestIndex + 1 ] : 0; - print CGI::p(CGI::submit({ - name => 'action', - value => $r->maketext('Show Past Answers'), - class => 'btn btn-primary' - })), - "\n"; - - print CGI::end_form(); - } - - # prints the achievement message if there is one - #If achievements enabled, and if we are not in a try it page, check to see if there are new ones.and print them. - #Gateways are special. We only provide the first problem just to seed the data, but all of the problems from the - #gateway will be provided to the achievement evaluator - if ($ce->{achievementsEnabled} && $will{recordAnswers} && $submitAnswers && $set->set_id ne 'Undefined_Set') { - print WeBWorK::AchievementEvaluator::checkForAchievements($problems[0], - $pg_results[0], $r, setVersion => $versionNumber); + # Mark the current test. + $userRecords[$currentTestIndex]{currentTest} = 1; + # Show the student nav. + return $r->include( + 'ContentGenerator/GatewayQuiz/nav', + userRecords => \@userRecords, + setVersion => $setVersion, + prevTest => $prevTest, + nextTest => $nextTest, + currentTestIndex => $currentTestIndex, + setPage => $r->urlpath->newFromModule(__PACKAGE__, $r, courseID => $courseName, setID => "$setID,v%s"), + filters => \%filters, + filter => $filter + ); } - - return ""; } -########################################################################### -# Evaluation utilities -############################################################################ +sub warningMessage { + my $self = shift; + return $self->r->maketext('Warning: There may be something wrong with a question in this test. ' + . 'Please inform your instructor including the warning messages below.'); +} +# Evaluation utility async sub getProblemHTML { - my ($self, $EffectiveUser, $set, $formFields, $mergedProblem, $pgFile) = @_; - # in: $EffectiveUser is the effective user we're working as, $set is the - # merged set version, %$formFields the form fields from the input form - # that we need to worry about putting into the HTML we're generating, - # and $mergedProblem and $pgFile are what we'd expect. - # $pgFile is optional - # out: the translated problem is returned + my ($self, $effectiveUser, $set, $formFields, $mergedProblem, $pgFile) = @_; + # $effectiveUser is the current effective user, $set is the merged set version, $formFields is a reference to the + # hash of parameters from the input form that need to be passed to the translator, and $mergedProblem and $pgFile + # are what we'd expect. $pgFile is optional. The translated problem is returned. my $r = $self->r; - my $ce = $r->ce; - my $db = $r->db; - my $key = $r->param('key'); - my $setName = $set->set_id; + my $setID = $set->set_id; my $setVersionNumber = $set->version_id; - my $permissionLevel = $self->{permissionLevel}; - my $psvn = $set->psvn(); - if (defined($mergedProblem) && $mergedProblem->problem_id) { - # nothing needs to be done - } elsif ($pgFile) { + if ((!defined $mergedProblem || !$mergedProblem->problem_id) && $pgFile) { $mergedProblem = WeBWorK::DB::Record::ProblemVersion->new( - set_id => $setName, + set_id => $setID, version_id => $setVersionNumber, problem_id => 0, - login_id => $EffectiveUser->user_id, + login_id => $effectiveUser->user_id, source_file => $pgFile, - # the rest of Problem's fields are not needed, i think + # The rest of problem fields are not needed. ); } - # figure out if we're allowed to get solutions and call renderPG accordingly. - my $showCorrectAnswers = $self->{will}->{showCorrectAnswers}; - my $showHints = $self->{will}->{showHints}; - my $showSolutions = $self->{will}->{showSolutions}; - my $processAnswers = $self->{will}->{checkAnswers}; - # FIXME I'm not sure that problem_id is what we want here FIXME + # Figure out solutions are allowed and call renderPG accordingly. + my $showCorrectAnswers = $self->{will}{showCorrectAnswers}; + my $showHints = $self->{will}{showHints}; + my $showSolutions = $self->{will}{showSolutions}; + my $processAnswers = $self->{will}{checkAnswers}; + + # FIXME: I'm not sure that problem_id is what we want here. my $problemNumber = $mergedProblem->problem_id; my $pg = await renderPG( $r, - $EffectiveUser, + $effectiveUser, $set, $mergedProblem, - $psvn, + $set->psvn, $formFields, - { # translation options + { displayMode => $self->{displayMode}, showHints => $showHints, showSolutions => $showSolutions, refreshMath2img => $showHints || $showSolutions, processAnswers => 1, - QUIZ_PREFIX => 'Q' . sprintf("%04d", $problemNumber) . '_', + QUIZ_PREFIX => 'Q' . sprintf('%04d', $problemNumber) . '_', useMathQuill => $self->{will}{useMathQuill}, useMathView => $self->{will}{useMathView}, useWirisEditor => $self->{will}{useWirisEditor}, forceScaffoldsOpen => 1, - isInstructor => $r->authz->hasPermissions($self->{userName}, 'view_answers'), - debuggingOptions => getTranslatorDebuggingOptions($r->authz, $self->{userName}) + isInstructor => $r->authz->hasPermissions($self->{userID}, 'view_answers'), + debuggingOptions => getTranslatorDebuggingOptions($r->authz, $self->{userID}) }, ); @@ -2674,88 +1512,18 @@ async sub getProblemHTML { # So rewarn them and let the global warning handler take care of it. warn $pg->{warnings} if $pg->{warnings}; - if ($pg->{flags}->{error_flag}) { + if ($pg->{flags}{error_flag}) { push @{ $self->{errors} }, { - set => "$setName,v$setVersionNumber", + set => "$setID,v$setVersionNumber", problem => $mergedProblem->problem_id, message => $pg->{errors}, context => $pg->{body_text}, }; - # if there was an error, body_text contains - # the error context, not TeX code $pg->{body_text} = undef; } return $pg; } -sub output_JS { - my $self = shift; - my $ce = $self->r->ce; - - # Add CSS files requested by problems via ADD_CSS_FILE() in the PG file - # or via a setting of $ce->{pg}{specialPGEnvironmentVars}{extra_css_files} - # which can be set in course.conf (the value should be an anonomous array). - my @cssFiles; - if (ref($ce->{pg}{specialPGEnvironmentVars}{extra_css_files}) eq 'ARRAY') { - push(@cssFiles, { file => $_, external => 0 }) for @{ $ce->{pg}{specialPGEnvironmentVars}{extra_css_files} }; - } - for my $pg (@{ $self->{ra_pg_results} }) { - next unless ref($pg); - if (ref($pg->{flags}{extra_css_files}) eq 'ARRAY') { - push @cssFiles, @{ $pg->{flags}{extra_css_files} }; - } - } - my %cssFilesAdded; # Used to avoid duplicates - for (@cssFiles) { - next if $cssFilesAdded{ $_->{file} }; - $cssFilesAdded{ $_->{file} } = 1; - if ($_->{external}) { - print CGI::Link({ rel => 'stylesheet', href => $_->{file} }); - } else { - print CGI::Link({ rel => 'stylesheet', href => getAssetURL($ce, $_->{file}) }); - } - } - - # This is for the problem grader - if ($self->{will}{showProblemGrader}) { - print CGI::script( - { - src => getAssetURL($ce, 'js/apps/ProblemGrader/problemgrader.js'), - defer => undef - }, - '' - ); - } - - #This is for page specfific js - print CGI::script({ src => getAssetURL($ce, 'js/apps/GatewayQuiz/gateway.js'), defer => undef }, ''); - - # Add JS files requested by problems via ADD_JS_FILE() in the PG file. - my %jsFiles; - for my $pg (@{ $self->{ra_pg_results} }) { - next unless ref($pg); - if (ref($pg->{flags}{extra_js_files}) eq 'ARRAY') { - for (@{ $pg->{flags}{extra_js_files} }) { - next if $jsFiles{ $_->{file} }; - $jsFiles{ $_->{file} } = 1; - - my %attributes = ref($_->{attributes}) eq 'HASH' ? %{ $_->{attributes} } : (); - if ($_->{external}) { - print CGI::script({ src => $_->{file}, %attributes }, ''); - } else { - print CGI::script({ src => getAssetURL($ce, $_->{file}), %attributes }, ''); - } - } - } - } - - return ''; -} - -sub output_achievement_CSS { - return ""; -} - 1; diff --git a/lib/WeBWorK/ContentGenerator/Grades.pm b/lib/WeBWorK/ContentGenerator/Grades.pm index 7fbb46e607..6b59ede810 100644 --- a/lib/WeBWorK/ContentGenerator/Grades.pm +++ b/lib/WeBWorK/ContentGenerator/Grades.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::Grades; -use base qw(WeBWorK::ContentGenerator); +use parent qw(WeBWorK::ContentGenerator); =head1 NAME @@ -26,8 +26,6 @@ problem set. use strict; use warnings; -use WeBWorK::CGI; -use WeBWorK::Debug; use WeBWorK::Utils qw(jitar_id_to_seq wwRound after grade_set format_set_name_display); use WeBWorK::Localize; @@ -35,40 +33,9 @@ sub initialize { my $self = shift; my $r = $self->r; - $self->{userName} = $r->param('user'); - $self->{studentName} = defined $r->param('effectiveUser') ? $r->param('effectiveUser') : $self->{userName}; -} - -sub body { - my $self = shift; - - $self->displayStudentStats($self->{studentName}); - - print $self->scoring_info; - - return ''; -} - -# Borrowed from SendMail.pm and Instructor.pm -sub getRecord { - my $self = shift; - my $line = shift; - my $delimiter = shift // ','; - - # Takes a delimited line as a parameter and returns an - # array. Note that all white space is removed. If the - # last field is empty, the last element of the returned - # array is also empty (unlike what the perl split command - # would return). E.G. @lineArray=&getRecord(\$delimitedLine). - - my (@lineArray); - - # Add $delimiter to end of line so that last field is never empty - $line .= $delimiter; + $self->{studentID} = $r->param('effectiveUser') // $r->param('user'); - @lineArray = split(/\s*${delimiter}\s*/, $line); - $lineArray[0] =~ s/^\s*// if defined($lineArray[0]); # Remove white space from first element - @lineArray; + return; } sub scoring_info { @@ -77,22 +44,16 @@ sub scoring_info { my $db = $r->db; my $ce = $r->ce; - my $userName = $r->param('effectiveUser') || $r->param('user'); - my $userID = $r->param('user'); + my $user = $db->getUser($self->{studentID}); + return '' unless $user; - my $ur = $db->getUser($userName); - return unless ($ur); - - my $emailDirectory = $ce->{courseDirs}->{email}; - my $message_file = 'report_grades.msg'; - my $filePath = "$emailDirectory/$message_file"; - my $merge_file = "report_grades_data.csv"; - my $delimiter = ','; - my $scoringDirectory = $ce->{courseDirs}->{scoring}; + my $message_file = 'report_grades.msg'; + my $filePath = "$ce->{courseDirs}{email}/$message_file"; + my $merge_file = "report_grades_data.csv"; # Return if the files don't exist. - if (!(-e "$scoringDirectory/$merge_file" && -e "$filePath")) { - if ($r->authz->hasPermissions($userID, 'access_instructor_tools')) { + if (!(-e "$ce->{courseDirs}{scoring}/$merge_file" && -e "$filePath")) { + if ($r->authz->hasPermissions($r->param('user'), 'access_instructor_tools')) { return $r->maketext( 'There is no additional grade information. A message about additional grades can go in ' . '~[TMPL~]/email/[_1]. It is merged with the file ~[Scoring~]/[_2]. These files can be ' @@ -104,37 +65,37 @@ sub scoring_info { } } - my $rh_merge_data = $self->read_scoring_file($merge_file, $delimiter); + my $rh_merge_data = $self->read_scoring_file($merge_file, ','); my $text; my $header = ''; - local (*FILE); if (-e $filePath and -r $filePath) { - open FILE, '<:encoding(UTF-8)', $filePath || return ("Can't open $filePath"); - while ($header !~ s/Message:\s*$//m and not eof(FILE)) { - $header .= ; + open my $FILE, '<:encoding(UTF-8)', $filePath or return "Can't open $filePath"; + while ($header !~ s/Message:\s*$//m && !eof($FILE)) { + $header .= <$FILE>; } + $text = join('', <$FILE>); + close($FILE); } else { - return ("There is no additional grade information.
      The message file $filePath cannot be found."); + return r->c('There is no additional grade information.', + $r->tag('br'), "The message file $filePath cannot be found.")->join(''); } - $text = join('', ); - close(FILE); - my $status_name = $ce->status_abbrev_to_name($ur->status); - $status_name = $ur->status unless defined $status_name; + my $status_name = $ce->status_abbrev_to_name($user->status); + $status_name = $user->status unless defined $status_name; - my $SID = $ur->student_id; - my $FN = $ur->first_name; - my $LN = $ur->last_name; - my $SECTION = $ur->section; - my $RECITATION = $ur->recitation; + my $SID = $user->student_id; + my $FN = $user->first_name; + my $LN = $user->last_name; + my $SECTION = $user->section; + my $RECITATION = $user->recitation; my $STATUS = $status_name; - my $EMAIL = $ur->email_address; - my $LOGIN = $ur->user_id; - my @COL = defined($rh_merge_data->{$SID}) ? @{ $rh_merge_data->{$SID} } : (); - unshift(@COL, ''); ## this makes COL[1] the first column + my $EMAIL = $user->email_address; + my $LOGIN = $user->user_id; + my @COL = ref $rh_merge_data->{$SID} eq 'ARRAY' ? @{ $rh_merge_data->{$SID} } : (); + unshift(@COL, ''); # This makes COL[1] the first column my $endCol = @COL; - # for safety, only evaluate special variables + # For safety, only evaluate special variables. my $msg = $text; $msg =~ s/(\$PAR)/

      /g; $msg =~ s/(\$BR)/
      /g; @@ -148,47 +109,57 @@ sub scoring_info { $msg =~ s/\$EMAIL/$EMAIL/g; $msg =~ s/\$LOGIN/$LOGIN/g; - if (defined($COL[1])) { # prevents extraneous error messages. + if (defined $COL[1]) { $msg =~ s/\$COL\[(\-?\d+)\]/$COL[$1]/g; - } else { # prevents extraneous $COL's in email message + } else { + # Prevents extraneous $COL's in email message $msg =~ s/\$COL\[(\-?\d+)\]//g; } $msg =~ s/\r//g; $msg =~ s/\n/
      /g; - $msg = CGI::div({ class => 'additional-scoring-msg card bg-light p-2' }, - CGI::h3($r->maketext('Scoring Message')), $msg); - - $msg .= CGI::div($r->maketext( - 'This scoring message is generated from ~[TMPL~]/email/[_1]. It is merged with the file ~[Scoring~]/[_2]. ' - . 'These files can be edited using the "Email" link and the "File Manager" link in the left margin.', - $message_file, - $merge_file - )) - if ($r->authz->hasPermissions($userID, 'access_instructor_tools')); + my $output = $r->c($r->tag( + 'div', + class => 'additional-scoring-msg card bg-light p-2', + $r->c($r->tag('h3', $r->maketext('Scoring Message')), $msg)->join('') + )); + + push( + @$output, + $r->tag( + 'div', + class => 'mt-2', + $r->maketext( + 'This scoring message is generated from ~[TMPL~]/email/[_1]. It is merged with the file ' + . '~[Scoring~]/[_2]. These files can be edited using the "Email" link and the "File Manager" ' + . 'link in the left margin.', + $message_file, + $merge_file + ) + ) + ) if $r->authz->hasPermissions($r->param('user'), 'access_instructor_tools'); - return $msg; + return $output->join(''); } sub displayStudentStats { - my ($self, $studentName) = @_; + my ($self, $studentID) = @_; my $r = $self->r; my $db = $r->db; my $ce = $r->ce; my $authz = $r->authz; - my $studentRecord = $db->getUser($studentName); + my $studentRecord = $db->getUser($studentID); unless ($studentRecord) { - $self->addbadmessage($r->maketext('Record for user [_1] not found.', $studentName)); - return; + $self->addbadmessage($r->maketext('Record for user [_1] not found.', $studentID)); + return ''; } my $courseName = $ce->{courseName}; - my $root = $ce->{webworkURLs}{root}; # First get all merged sets for this user ordered by set_id. - my @sets = $db->getMergedSetsWhere({ user_id => $studentName }, 'set_id'); + my @sets = $db->getMergedSetsWhere({ user_id => $studentID }, 'set_id'); # To be able to find the set objects later, make a handy hash of set ids to set objects. my %setsByID = (map { $_->set_id => $_ } @sets); @@ -205,7 +176,7 @@ sub displayStudentStats { # We have to have the merged set versions to know what each of their assignment types are # (because proctoring can change this). my @setVersions = - $db->getMergedSetVersionsWhere({ user_id => $studentName, set_id => { like => "$setID,v\%" } }); + $db->getMergedSetVersionsWhere({ user_id => $studentID, set_id => { like => "$setID,v\%" } }); # Add the set versions to our list of sets. $setsByID{ $_->set_id . ',v' . $_->version_id } = $_ for (@setVersions); @@ -224,12 +195,7 @@ sub displayStudentStats { my $fullName = join(' ', $studentRecord->first_name, $studentRecord->last_name); my $effectiveUser = $studentRecord->user_id(); - my $act_as_student_url = - "$root/$courseName/?user=" . $r->param('user') . "&effectiveUser=$effectiveUser&key=" . $r->param('key'); - - print CGI::h2($fullName); - my @rows; my $max_problems = 0; my $courseTotal = 0; my $courseTotalRight = 0; @@ -255,9 +221,10 @@ sub displayStudentStats { my $numGatewayVersions = 0; my $bestGatewayScore = 0; + my $rows = $r->c; for my $setID (@allSetIDs) { my $act_as_student_set_url = - "$root/$courseName/$setID/?user=" + "$ce->{webworkURLs}{root}/$courseName/$setID/?user=" . $r->param('user') . "&effectiveUser=$effectiveUser&key=" . $r->param('key'); @@ -267,13 +234,17 @@ sub displayStudentStats { # student hasn't attempted it. Otherwise, we skip it and let the versions speak for themselves. if (defined $setVersionsCount{$setID}) { next if $setVersionsCount{$setID}; - push @rows, - CGI::Tr( - CGI::td({ dir => 'ltr' }, format_set_name_display($setID)), - CGI::td( - { colspan => $max_problems + 3 }, - CGI::em($r->maketext('No versions of this assignment have been taken.')) - ) + push @$rows, + $r->tag( + 'tr', + $r->c( + $r->tag('td', dir => 'ltr', format_set_name_display($setID)), + $r->tag( + 'td', + colspan => $max_problems + 3, + $r->tag('em', $r->maketext('No versions of this assignment have been taken.')) + ) + )->join('') ); next; } @@ -290,16 +261,21 @@ sub displayStudentStats { ) { push( - @rows, - CGI::Tr( - CGI::td( - { dir => 'ltr' }, - format_set_name_display($setID) . ' (version ' . $set->version_id . ')' - ), - CGI::td( - { colspan => $max_problems + 3 }, - CGI::em($r->maketext('Display of scores for this set is not allowed.')) - ) + @$rows, + $r->tag( + 'tr', + $r->c( + $r->tag( + 'td', + dir => 'ltr', + format_set_name_display($setID) . ' (version ' . $set->version_id . ')' + ), + $r->tag( + 'td', + colspan => $max_problems + 3, + $r->tag('em', $r->maketext('Display of scores for this set is not allowed.')) + ) + )->join('') ) ); next; @@ -317,10 +293,10 @@ sub displayStudentStats { } my ($totalRight, $total, $problem_scores, $problem_incorrect_attempts) = - grade_set($db, $set, $studentName, $setIsVersioned, 1); + grade_set($db, $set, $studentID, $setIsVersioned, 1); $totalRight = wwRound(2, $totalRight); - my @cgi_prob_scores; + my @html_prob_scores; my $show_problem_scores = 1; @@ -333,16 +309,23 @@ sub displayStudentStats { for (my $i = 0; $i < $max_problems; ++$i) { my $score = defined $problem_scores->[$i] && $show_problem_scores ? $problem_scores->[$i] : ''; - $cgi_prob_scores[$i] = CGI::td( - { class => 'problem-data' }, - CGI::span({ class => $score eq '100' ? 'correct' : $score eq ' . ' ? 'unattempted' : '' }, - $score) - . CGI::br() - . ( + push( + @html_prob_scores, + $r->tag( + 'td', + class => 'problem-data', + $r->c( + $r->tag( + 'span', + class => $score eq '100' ? 'correct' : $score eq ' . ' ? 'unattempted' : '', + $r->b($score) + ), + $r->tag('br'), (defined $problem_incorrect_attempts->[$i] && $show_problem_scores) ? $problem_incorrect_attempts->[$i] - : ' ' - ) + : $r->b(' ') + )->join('') + ) ); } @@ -365,7 +348,7 @@ sub displayStudentStats { # If we are just starting a new gateway then set variables to look for the max. if ($currentVersion == 1) { - $numGatewayVersions = $db->countSetVersions($studentName, $gatewayName); + $numGatewayVersions = $db->countSetVersions($studentID, $gatewayName); } if ($totalRight > $bestGatewayScore) { @@ -387,54 +370,31 @@ sub displayStudentStats { } } - push @rows, CGI::Tr( - CGI::th( - { scope => 'row', dir => 'ltr' }, - CGI::a({ href => $act_as_student_set_url }, format_set_name_display($setID)) - ), - CGI::td(CGI::span({ class => $class }, $totalRightPercent . '%')), - CGI::td(sprintf('%0.2f', $totalRight)), # score - CGI::td($total), # out of - @cgi_prob_scores # problems + push @$rows, $r->tag( + 'tr', + $r->c( + $r->tag( + 'th', + scope => 'row', + dir => 'ltr', + $r->link_to(format_set_name_display($setID) => $act_as_student_set_url) + ), + $r->tag('td', $r->tag('span', class => $class, $totalRightPercent . '%')), + $r->tag('td', sprintf('%0.2f', $totalRight)), # score + $r->tag('td', $total), # out of + @html_prob_scores # problems + )->join('') ); } - # Print table - print CGI::start_div({ class => 'table-responsive' }); - print CGI::start_table({ class => 'grade-table table table-bordered table-sm font-xs', id => 'grades_table' }); - print CGI::Tr( - CGI::th({ rowspan => 2, scope => 'col' }, $r->maketext('Set')), - CGI::th({ rowspan => 2, scope => 'col' }, $r->maketext('Percent')), - CGI::th({ rowspan => 2, scope => 'col' }, $r->maketext('Score')), - CGI::th({ rowspan => 2, scope => 'col' }, $r->maketext('Out Of')), - CGI::th({ colspan => $max_problems, scope => 'col' }, $r->maketext('Problems')) + return $r->include( + 'ContentGenerator/Grades/student_stats', + fullName => $fullName, + max_problems => $max_problems, + rows => $rows->join(''), + courseTotal => $courseTotal, + courseTotalRight => $courseTotalRight ); - print CGI::Tr(map { CGI::th({ scope => 'col', class => 'problem-data' }, $_) } 1 .. $max_problems); - - print @rows; - - # Compute the percentage correct. - my $totalRightPercent = 100 * wwRound(2, $courseTotal ? $courseTotalRight / $courseTotal : 0); - - if ($ce->{showCourseHomeworkTotals}) { - print CGI::Tr( - { class => 'grades-course-total' }, - CGI::th({ scope => 'row' }, $r->maketext('Homework Totals')), - CGI::td(CGI::span( - { - class => $totalRightPercent == 0 ? 'unattempted' : $totalRightPercent == 100 ? 'correct' : '' - }, - $totalRightPercent . '%' - )), - CGI::td($courseTotalRight), - CGI::td($courseTotal), - CGI::td({ colspan => $max_problems }, ' ') - ); - } - - print CGI::end_table(), CGI::end_div(); - - return ''; } 1; diff --git a/lib/WeBWorK/ContentGenerator/Hardcopy.pm b/lib/WeBWorK/ContentGenerator/Hardcopy.pm index bf81981373..be86f9554a 100644 --- a/lib/WeBWorK/ContentGenerator/Hardcopy.pm +++ b/lib/WeBWorK/ContentGenerator/Hardcopy.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::Hardcopy; -use base qw(WeBWorK::ContentGenerator); +use parent qw(WeBWorK::ContentGenerator); =head1 NAME @@ -26,19 +26,14 @@ problem sets. use strict; use warnings; -#use Apache::Constants qw/:common REDIRECT/; -#use CGI qw(-nosticky ); -use WeBWorK::CGI; - use File::Path; use File::Temp qw/tempdir/; use Future::AsyncAwait; use String::ShellQuote; use Archive::Zip qw(:ERROR_CODES); + use WeBWorK::DB::Utils qw/user2global/; -use WeBWorK::Debug; use WeBWorK::Form; -use WeBWorK::HTML::ScrollingRecordList qw/scrollingRecordList/; use WeBWorK::PG; use WeBWorK::Utils qw/readFile decodeAnswers jitar_id_to_seq is_restricted after x format_set_name_display/; use WeBWorK::Utils::Rendering qw(renderPG); @@ -54,7 +49,7 @@ If true, don't delete temporary files. =cut -our $PreserveTempFiles = 0 unless defined $PreserveTempFiles; +our $PreserveTempFiles = $PreserveTempFiles // 0; =back @@ -87,8 +82,9 @@ our @HC_FORMAT_DISPLAY_ORDER = ('tex', 'pdf'); # Set by generate_hardcopy(), and used by pre_header_initialize(), used by body() # # hardcopy_errors -# reference to array containing HTML strings describing generation errors (and warnings) -# used by add_errors(), get_errors(), get_errors_ref() +# reference to an array of Mojo::ByteStream objects containing HTML strings +# describing generation errors (and warnings) +# used by add_error(), has_errors(), get_errors() # # at_least_one_problem_rendered_without_error # set to a true value by write_problem_tex if it is able to sucessfully render @@ -142,7 +138,7 @@ async sub pre_header_initialize { $self->{can_show_source_file} = ($db->getPermissionLevel($userID)->permission >= $ce->{pg}{specialPGEnvironmentVars}{PRINT_FILE_NAMES_PERMISSION_LEVEL}) - || grep($_ eq $userID, @{ $ce->{pg}{specialPGEnvironmentVars}{PRINT_FILE_NAMES_FOR} }); + || (grep { $_ eq $userID } @{ $ce->{pg}{specialPGEnvironmentVars}{PRINT_FILE_NAMES_FOR} }); if ($generate_hardcopy) { my $validation_failed = 0; @@ -152,7 +148,7 @@ async sub pre_header_initialize { # Make sure the format is valid. unless (grep { $_ eq $hardcopy_format } keys %HC_FORMATS) { - $self->addbadmessage("'$hardcopy_format' is not a valid hardcopy format."); + $self->addbadmessage(qq{"$hardcopy_format" is not a valid hardcopy format.}); $validation_failed = 1; } @@ -195,17 +191,17 @@ async sub pre_header_initialize { my $perm_viewunopened = $authz->hasPermissions($userID, 'view_unopened_sets'); - if (@setIDs > 1 and not $perm_multiset) { + if (@setIDs > 1 && !$perm_multiset) { $self->addbadmessage('You are not permitted to generate hardcopy for multiple sets. ' . 'Please select a single set and try again.'); $validation_failed = 1; } - if (@userIDs > 1 and not $perm_multiuser) { + if (@userIDs > 1 && !$perm_multiuser) { $self->addbadmessage('You are not permitted to generate hardcopy for multiple users. ' . 'Please select a single user and try again.'); $validation_failed = 1; } - if (@userIDs and $userIDs[0] ne $eUserID and not $perm_multiuser) { + if (@userIDs && $userIDs[0] ne $eUserID && !$perm_multiuser) { $self->addbadmessage('You are not permitted to generate hardcopy for other users.'); $validation_failed = 1; # FIXME: Download_hardcopy_multiuser controls both whether a user can generate hardcopy @@ -286,7 +282,7 @@ async sub pre_header_initialize { $self->{canShowScore} = \%canShowScore; $self->{mergedSets} = \%mergedSets; my $result = await $self->generate_hardcopy($hardcopy_format, \@userIDs, \@setIDs); - if ($self->get_errors) { + if ($self->has_errors) { # Store the result data in self hash so that body() can make a link to it. $self->{file_path} = $result->{file_path}; $self->{temp_file_map} = $result->{temp_file_map}; @@ -328,85 +324,6 @@ async sub pre_header_initialize { return; } -sub body { - my ($self) = @_; - my $r = $self->r; - my $userID = $self->r->param('user'); - my $perm_view_errors = $self->r->authz->hasPermissions($userID, 'download_hardcopy_view_errors'); - $perm_view_errors = defined $perm_view_errors ? $perm_view_errors : 0; - - if (my $num = $self->get_errors) { - my $file_path = $self->{file_path}; - my %temp_file_map = %{ $self->{temp_file_map} // {} }; - if ($perm_view_errors) { - print CGI::p($r->maketext('[quant,_1,error] occured while generating hardcopy:', $num)); - - print CGI::ul(CGI::li($self->get_errors_ref)); - } - - if ($file_path) { - print CGI::p( - $r->maketext( - 'A hardcopy file was generated, but it may not be complete or correct. Please check that no ' - . 'problems are missing and that they are all legible. If not, please inform your instructor.' - ), - '
      ', - CGI::a( - { - href => $self->systemLink( - $r->urlpath->newFromModule( - $r->urlpath->module, $r, courseID => $r->urlpath->arg('courseID') - ), - params => { tempFilePath => $file_path } - ) - }, - $r->maketext('Download Hardcopy') - ), - ); - } else { - print CGI::p( - $r->maketext( - 'WeBWorK was unable to generate a paper copy of this homework set. Please inform your instructor.') - ); - } - - if ($perm_view_errors) { - if (%temp_file_map) { - print CGI::start_p(); - print $r->maketext('You can also examine the following temporary files: '); - my $first = 1; - while (my ($temp_file_name, $temp_file_url) = each %temp_file_map) { - if ($first) { - $first = 0; - } else { - print ', '; - } - print CGI::a( - { - href => $self->systemLink( - $r->urlpath->newFromModule( - $r->urlpath->module, $r, courseID => $r->urlpath->arg('courseID') - ), - params => { tempFilePath => $temp_file_url } - ) - }, - $temp_file_name - ); - } - print CGI::end_p(); - } - } - - print CGI::hr(); - } - - # don't display the retry form if there are errors and the user doesn't have permission to view the errors. - unless ($self->get_errors and not $perm_view_errors) { - $self->display_form(); - } - ''; # return a blank -} - sub display_form { my ($self) = @_; my $r = $self->r; @@ -420,7 +337,7 @@ sub display_form { unless ($r->param("in_hc_form")) { # if a set was passed in via the path_info, add that to the list of sets. my $singleSet = $r->urlpath->arg("setID"); - if (defined $singleSet and $singleSet ne "") { + if (defined $singleSet && $singleSet ne '') { my @selected_sets = $r->param("selected_sets"); $r->param("selected_sets" => [ @selected_sets, $singleSet ]) unless grep { $_ eq $singleSet } @selected_sets; @@ -451,16 +368,14 @@ sub display_form { # get format names hash for radio buttons my %format_labels = map { $_ => $r->maketext($HC_FORMATS{$_}{name}) || $_ } @formats; - print CGI::start_form(-name => "hardcopy-form", -id => "hardcopy-form", -method => "POST", -action => $r->uri); - print $self->hidden_authen_fields(); - print CGI::hidden("in_hc_form", 1); - my $canShowCorrectAnswers = 0; - my $canShowSolutions = 0; - if ($perm_multiuser and $perm_multiset) { + my (@users, @wantedSets, @setVersions); + my ($user, $user_id, $selected_set_id); + + if ($perm_multiuser && $perm_multiset) { # Get all users for selection. - my @Users = $db->getUsersWhere({ user_id => { not_like => 'set_id:%' } }); + @users = $db->getUsersWhere({ user_id => { not_like => 'set_id:%' } }); # Get sets for selection. # Note that we are getting GlobalSets instead of using the list of UserSets assigned to the @@ -473,95 +388,34 @@ sub display_form { # FIXME: This is another place where we assume that there is a one-to-one correspondence between # assignment_type =~ gateway and versioned sets. I think we really should have a "is_versioned" flag on set # objects instead. - my @SetVersions = (); for my $v (grep { $_->assignment_type =~ /gateway/ } @GlobalSets) { # FIXME: The set_id change here is a hideous, horrible hack. The identifying key for a global set is the # set_id. Those for a set version are the set_id and version_id. But this means that we have trouble # displaying them both together in HTML::scrollingRecordList. So we brutally play tricks with the set_id # here, which probably is not very robust, and certainly is aesthetically displeasing. Yuck. - push(@SetVersions, + push(@setVersions, map { $_->set_id($_->set_id . ",v" . $_->version_id); $_ } $db->getSetVersionsWhere({ user_id => $eUserID, set_id => { like => $v->set_id . ',v%' } })); } # Filter out global gateway sets. Only the versioned sets may be printed. - my @WantedGlobalSets = grep { $_->assignment_type !~ /gateway/ } @GlobalSets; - - print CGI::p($r->maketext( - "Select the homework sets for which to generate hardcopy versions. You may" - . " also select multiple users from the users list. You will receive hardcopy" - . " for each (set, user) pair." - )); - - print CGI::div( - { class => 'row gx-3' }, - CGI::div( - { class => 'col-xl-5 col-md-6 mb-2' }, - CGI::div( - { class => 'fw-bold text-center' }, - CGI::label({ for => 'selected_users' }, $r->maketext('Users')) - ), - scrollingRecordList( - { - name => 'selected_users', - id => 'selected_users', - request => $r, - default_sort => 'lnfn', - default_format => 'lnfn_uid', - default_filters => ['all'], - attrs => { - size => 20, - multiple => $perm_multiuser - } - }, - @Users - ) - ), - CGI::div( - { class => 'col-xl-5 col-md-6 mb-2' }, - CGI::div( - { class => 'fw-bold text-center' }, - CGI::label({ for => 'selected_sets' }, $r->maketext('Sets')) - ), - scrollingRecordList( - { - name => 'selected_sets', - id => 'selected_sets', - request => $r, - default_sort => 'set_id', - default_format => 'sid', - default_filters => ['all'], - attrs => { - size => 20, - multiple => $perm_multiset, - dir => 'ltr' - } - }, - @WantedGlobalSets, - @SetVersions - ) - ) - ); + @wantedSets = grep { $_->assignment_type !~ /gateway/ } @GlobalSets; $canShowCorrectAnswers = 1; - $canShowSolutions = 1; - } else { # single user mode - my $user = $db->getUser($eUserID); + $user = $db->getUser($eUserID); - my $selected_set_id = $r->param("selected_sets"); - $selected_set_id = '' unless defined $selected_set_id; + $selected_set_id = $r->param("selected_sets") // ''; - my $selected_user_id = $user->user_id; - print CGI::hidden("selected_sets", $selected_set_id), CGI::hidden("selected_users", $selected_user_id); + $user_id = $user->user_id; my $mergedSet; if ($selected_set_id =~ /(.*),v(\d+)$/) { # Determining if answers can be shown is more complicated for gateway tests. my $the_set_id = $1; my $the_set_version = $2; - $mergedSet = $db->getMergedSetVersion($selected_user_id, $the_set_id, $the_set_version); - my $mergedProblem = $db->getMergedProblemVersion($selected_user_id, $the_set_id, $the_set_version, 1); + $mergedSet = $db->getMergedSetVersion($user_id, $the_set_id, $the_set_version); + my $mergedProblem = $db->getMergedProblemVersion($user_id, $the_set_id, $the_set_version, 1); # Get the parameters needed to determine if correct answers may be shown. my $maxAttempts = $mergedSet->attempts_per_version() || 0; @@ -585,175 +439,31 @@ sub display_form { ); } else { - $mergedSet = $db->getMergedSet($selected_user_id, $selected_set_id); + $mergedSet = $db->getMergedSet($user_id, $selected_set_id); $canShowCorrectAnswers = $perm_view_answers || (defined($mergedSet) && after($mergedSet->answer_date)); } # Make display for versioned sets a bit nicer $selected_set_id =~ s/,v(\d+)$/ (version $1)/; - - print CGI::p($r->maketext( - "Download hardcopy of set [_1] for [_2]?", - CGI::span({ dir => 'ltr' }, format_set_name_display($selected_set_id)), - $user->first_name . " " . $user->last_name - )); - - $canShowSolutions = $canShowCorrectAnswers; } - # Using maketext on the next line would trigger errors when a local hardcopyTheme is installed. - # my %hardcopyThemeNames = map {$_ => $r->maketext($ce->{hardcopyThemeNames}->{$_})} @{$ce->{hardcopyThemes}}; - my %hardcopyThemeNames = map { $_ => $ce->{hardcopyThemeNames}->{$_} } @{ $ce->{hardcopyThemes} }; - - print CGI::div( - { class => 'row' }, - CGI::div( - { class => 'col-md-8 font-sm mb-2' }, - $r->maketext( - 'You may choose to show any of the following data. Correct answers, hints, and solutions ' - . 'are only available [_1] after the answer date of the homework set.', - $perm_multiuser ? "to privileged users or" : "" - ) - ), - CGI::div( - { class => 'row' }, - CGI::div( - { class => 'col-md-8' }, - CGI::div( - { class => 'input-group input-group-sm mb-2' }, - CGI::span({ class => 'input-group-text' }, CGI::b($r->maketext("Show:"))), - CGI::div( - { class => 'input-group-text' }, - CGI::checkbox({ - name => "printStudentAnswers", - checked => $r->param("printStudentAnswers") // 1, # Checked by default - label => $r->maketext("Student answers"), - class => 'form-check-input me-2', - labelattributes => { class => 'form-check-label' } - }) - ), - CGI::div( - { class => 'input-group-text' }, - CGI::checkbox({ - name => "showComments", - checked => scalar($r->param("showComments")) || 0, - label => $r->maketext("Comments"), - class => 'form-check-input me-2', - labelattributes => { class => 'form-check-label' } - }) - ), - $canShowCorrectAnswers ? CGI::div( - { class => 'input-group-text' }, - CGI::checkbox({ - name => "showCorrectAnswers", - checked => scalar($r->param("showCorrectAnswers")) || 0, - label => $r->maketext("Correct answers"), - class => 'form-check-input me-2', - labelattributes => { class => 'form-check-label' } - }) - ) : '', - $canShowSolutions ? CGI::div( - { class => 'input-group-text' }, - CGI::checkbox({ - name => "showHints", - checked => scalar($r->param("showHints")) || 0, - label => $r->maketext("Hints"), - class => 'form-check-input me-2', - labelattributes => { class => 'form-check-label' } - }) - ) : '', - $canShowSolutions ? CGI::div( - { class => 'input-group-text' }, - CGI::checkbox({ - name => "showSolutions", - checked => scalar($r->param("showSolutions")) || 0, - label => $r->maketext("Solutions"), - class => 'form-check-input me-2', - labelattributes => { class => 'form-check-label' } - }) - ) : '' - ) - ) - ), - CGI::div( - { class => 'row' }, - CGI::div( - { class => 'col-md-8' }, - CGI::div( - { class => 'input-group input-group-sm mb-2' }, - CGI::span({ class => 'input-group-text' }, CGI::b($r->maketext("Hardcopy Format:"))), - CGI::div( - { class => 'input-group-text' }, - CGI::radio_group({ - name => "hardcopy_format", - values => \@formats, - default => scalar($r->param("hardcopy_format")) || $HC_DEFAULT_FORMAT, - labels => \%format_labels, - class => 'form-check-input me-2', - labelattributes => { class => 'form-check-label me-3' } - }) - ) - ) - ) - ), - $self->{can_show_source_file} ? CGI::div( - { class => 'row' }, - CGI::div( - { class => 'col-md-8' }, - CGI::div( - { class => 'input-group input-group-sm mb-2' }, - CGI::span({ class => 'input-group-text' }, CGI::b($r->maketext("Show Problem Source File:"))), - CGI::div( - { class => 'input-group-text' }, - CGI::radio_group({ - name => "show_source_file", - values => [ "Yes", "No" ], - default => "Yes", - labels => { Yes => $r->maketext("Yes"), No => $r->maketext("No") }, - class => 'form-check-input me-2', - labelattributes => { class => 'form-check-label me-3' } - }) - ) - ) - ) - ) : '', - $perm_change_theme ? CGI::div( - { class => 'row' }, - CGI::div( - { class => 'col-md-8' }, - CGI::div( - { class => 'input-group input-group-sm mb-2' }, - CGI::span({ class => 'input-group-text' }, CGI::b($r->maketext("Hardcopy Theme"))), - CGI::div( - { class => 'input-group-text' }, - CGI::radio_group({ - name => "hardcopy_theme", - values => $ce->{hardcopyThemes}, - default => scalar($r->param("hardcopyTheme")) || $ce->{hardcopyTheme}, - labels => \%hardcopyThemeNames, - class => 'form-check-input me-2', - labelattributes => { class => 'form-check-label me-3' } - }) - ) - ) - ) - ) : '', - CGI::div( - { class => '' }, - CGI::submit({ - name => "generate_hardcopy", - value => $perm_multiuser - ? $r->maketext("Generate hardcopy for selected sets and selected users") - : $r->maketext("Generate Hardcopy"), - class => 'btn btn-primary' - }) - ) + return $r->include( + 'ContentGenerator/Hardcopy/form', + canShowCorrectAnswers => $canShowCorrectAnswers, + multiuser => $perm_multiuser && $perm_multiset, + can_change_theme => $perm_change_theme, + users => \@users, + wantedSets => \@wantedSets, + setVersions => \@setVersions, + user => $user, + user_id => $user_id, + selected_set_id => $selected_set_id, + formats => \@formats, + default_format => $HC_DEFAULT_FORMAT, + format_labels => \%format_labels, + can_change_theme => $perm_change_theme ); - - print CGI::end_form(); - - return ""; } ################################################################################ @@ -774,27 +484,28 @@ async sub generate_hardcopy { my $temp_dir_parent_path = "$ce->{webworkDirs}{tmp}/$courseID/hardcopy/$userID"; eval { mkpath($temp_dir_parent_path) }; if ($@) { - $self->add_errors( - "Couldn't create hardcopy directory $temp_dir_parent_path: " . CGI::code(CGI::escapeHTML($@))); + $self->add_error("Couldn't create hardcopy directory $temp_dir_parent_path: ", $r->tag('code', $@)); return; } # Create a randomly named working directory in the hardcopy directory. my $temp_dir_path = eval { tempdir('work.XXXXXXXX', DIR => $temp_dir_parent_path) }; if ($@) { - $self->add_errors("Couldn't create temporary working directory: " . CGI::code(CGI::escapeHTML($@))); + $self->add_error(q{Couldn't create temporary working directory: }, $r->tag('code', $@)); return; } # Do some error checking. unless (-e $temp_dir_path) { - $self->add_errors("Temporary directory '" - . CGI::code(CGI::escapeHTML($temp_dir_path)) - . "' does not exist, but creation didn't fail. This shouldn't happen."); + $self->add_error( + 'Temporary directory "', + $r->tag('code', $temp_dir_path), + q{" does not exist, but creation didn't fail. This shouldn't happen.} + ); return; } unless (-w $temp_dir_path) { - $self->add_errors("Temporary directory '" . CGI::code(CGI::escapeHTML($temp_dir_path)) . "' is not writeable."); + $self->add_error('Temporary directory "', $r->tag('code', $temp_dir_path), '" is not writeable.'); $self->delete_temp_dir($temp_dir_path); return; } @@ -804,32 +515,37 @@ async sub generate_hardcopy { # Create TeX file. - my $open_result = open my $FH, '>:encoding(UTF-8)', $tex_file_path; - unless ($open_result) { - $self->add_errors("Failed to open file '" - . CGI::code(CGI::escapeHTML($tex_file_path)) - . "' for writing: " - . CGI::code(CGI::escapeHTML($!))); + if (open my $FH, '>:encoding(UTF-8)', $tex_file_path) { + await $self->write_multiuser_tex($FH, $userIDsRef, $setIDsRef); + close $FH; + } else { + $self->add_error( + 'Failed to open file "', + $r->tag('code', $tex_file_path), + '" for writing: ', + $r->tag('code', $!) + ); $self->delete_temp_dir($temp_dir_path); return; + } - await $self->write_multiuser_tex($FH, $userIDsRef, $setIDsRef); - close $FH; # If no problems were successfully rendered, we can't continue. unless ($self->{at_least_one_problem_rendered_without_error}) { - $self->add_errors("No problems rendered. Can't continue."); + $self->add_error(q{No problems rendered. Can't continue.}); $self->delete_temp_dir($temp_dir_path); return; } # If the hardcopy.tex file was not generated, fail now. unless (-e "$temp_dir_path/hardcopy.tex") { - $self->add_errors("'" - . CGI::code("hardcopy.tex") - . "' not written to temporary directory '" - . CGI::code(CGI::escapeHTML($temp_dir_path)) - . "'. Can't continue."); + $self->add_error( + '"', + $r->tag('code', 'hardcopy.tex'), + '" not written to temporary directory "', + $r->tag('code', $temp_dir_path), + q{". Can't continue.} + ); $self->delete_temp_dir($temp_dir_path); return; } @@ -856,11 +572,13 @@ async sub generate_hardcopy { # Make sure the final file exists. unless (-e $final_file_path) { - $self->add_errors("Final hardcopy file '" - . CGI::code(CGI::escapeHTML($final_file_path)) - . "' not found after calling '" - . CGI::code(CGI::escapeHTML($format_subr)) . "': " - . CGI::code(CGI::escapeHTML($!))); + $self->add_error( + 'Final hardcopy file "', + $r->tag('code', $final_file_path), + "' not found after calling '", + $r->tag('code', $format_subr), + "': ", $r->tag('code', $!) + ); return { temp_file_map => \%temp_file_map }; } @@ -869,24 +587,27 @@ async sub generate_hardcopy { my $mv_cmd = '2>&1 ' . $ce->{externalPrograms}{mv} . ' ' . shell_quote($final_file_path, $final_file_final_path); my $mv_out = readpipe $mv_cmd; if ($?) { - $self->add_errors("Failed to move hardcopy file '" - . CGI::code(CGI::escapeHTML($final_file_name)) - . "' from '" - . CGI::code(CGI::escapeHTML($temp_dir_path)) - . "' to '" - . CGI::code(CGI::escapeHTML($temp_dir_parent_path)) . "':" - . CGI::br() - . CGI::pre(CGI::escapeHTML($mv_out))); + $self->add_error( + 'Failed to move hardcopy file "', + $r->tag('code', $final_file_name), + '" from "', + $r->tag('code', $temp_dir_path), + '" to "', + $r->tag('code', $temp_dir_parent_path), + '":', + $r->tag('br'), + $r->tag('pre', $mv_out) + ); $final_file_final_path = "$temp_dir_rel_path/$final_file_name"; } # If there were any errors, then the final file will not be served directly, but will be served via reply_with_file # and the full file path will be built at that time. So the path needs to be relative to the temporary directory # parent path. - $final_file_final_path =~ s/^$temp_dir_parent_path\/// if ($self->get_errors); + $final_file_final_path =~ s/^$temp_dir_parent_path\/// if ($self->has_errors); # remove the temp directory if there are no errors - $self->delete_temp_dir($temp_dir_path) unless ($self->get_errors || $PreserveTempFiles); + $self->delete_temp_dir($temp_dir_path) unless ($self->has_errors || $PreserveTempFiles); warn "Preserved temporary files in directory '$temp_dir_path'.\n" if $PreserveTempFiles; @@ -901,14 +622,16 @@ async sub generate_hardcopy { # helper function to remove temp dirs sub delete_temp_dir { my ($self, $temp_dir_path) = @_; + my $r = $self->r; my $rm_cmd = '2>&1 ' . $self->r->ce->{externalPrograms}{rm} . ' -rf ' . shell_quote($temp_dir_path); my $rm_out = readpipe $rm_cmd; if ($?) { - $self->add_errors("Failed to remove temporary directory '" - . CGI::code(CGI::escapeHTML($temp_dir_path)) . "':" - . CGI::br() - . CGI::pre($rm_out)); + $self->add_error( + 'Failed to remove temporary directory "', + $r->tag('code', $temp_dir_path), + '":', $r->tag('br'), $r->tag('pre', $rm_out) + ); } return; @@ -924,16 +647,18 @@ sub delete_temp_dir { sub generate_hardcopy_tex { my ($self, $temp_dir_path, $final_file_basename) = @_; + my $r = $self->r; my $src_name = "hardcopy.tex"; my $bundle_path = "$temp_dir_path/$final_file_basename"; # Create directory for the tex bundle if (!mkdir $bundle_path) { - $self->add_errors("Failed to create directory '" - . CGI::code(CGI::escapeHTML($bundle_path)) . "': " - . CGI::br() - . CGI::pre(CGI::escapeHTML($!))); + $self->add_error( + 'Failed to create directory "', + $r->tag('code', $bundle_path), + '": ', $r->tag('br'), $r->tag('pre', $!) + ); return $src_name; } @@ -943,12 +668,13 @@ sub generate_hardcopy_tex { my $mv_out = readpipe $mv_cmd; if ($?) { - $self->add_errors("Failed to move '" - . CGI::code(CGI::escapeHTML($src_name)) - . "' into directory '" - . CGI::code(CGI::escapeHTML($bundle_path)) . "':" - . CGI::br() - . CGI::pre(CGI::escapeHTML($mv_out))); + $self->add_error( + 'Failed to move "', + $r->tag('code', $src_name), + '" into directory "', + $r->tag('code', $bundle_path), + '":', $r->tag('br'), $r->tag('pre', $mv_out) + ); return $src_name; } @@ -959,12 +685,13 @@ sub generate_hardcopy_tex { "2>&1 $ce->{externalPrograms}{cp} " . shell_quote("$ce->{webworkDirs}{texinputs_common}/$_", $bundle_path); my $cp_out = readpipe $cp_cmd; if ($?) { - $self->add_errors("Failed to copy '" - . CGI::code(CGI::escapeHTML("$ce->{webworkDirs}{texinputs_common}/$_")) - . "' into directory '" - . CGI::code(CGI::escapeHTML($bundle_path)) . "':" - . CGI::br() - . CGI::pre(CGI::escapeHTML($cp_out))); + $self->add_error( + 'Failed to copy "', + $r->tag('code', "$ce->{webworkDirs}{texinputs_common}/$_"), + '" into directory "', + $r->tag('code', $bundle_path), + '":', $r->tag('br'), $r->tag('pre', $cp_out) + ); } } @@ -984,12 +711,13 @@ sub generate_hardcopy_tex { my $cp_cmd = "2>&1 $ce->{externalPrograms}{cp} " . shell_quote($resource, $bundle_path); my $cp_out = readpipe $cp_cmd; if ($?) { - $self->add_errors("Failed to copy image '" - . CGI::code(CGI::escapeHTML($resource)) - . "' into directory '" - . CGI::code(CGI::escapeHTML($bundle_path)) . "':" - . CGI::br() - . CGI::pre(CGI::escapeHTML($cp_out))); + $self->add_error( + 'Failed to copy image "', + $r->tag('code', $resource), + '" into directory "', + $r->tag('code', $bundle_path), + '":', $r->tag('br'), $r->tag('pre', $cp_out) + ); } } @@ -999,8 +727,7 @@ sub generate_hardcopy_tex { print $out_fh $data; close $out_fh; } else { - $self->add_errors( - "Failed to open '" . CGI::code(CGI::escapeHTML("$bundle_path/$src_name")) . "' for reading."); + $self->add_error('Failed to open "', $r->tag('code', "$bundle_path/$src_name"), '" for reading.'); } } @@ -1010,16 +737,32 @@ sub generate_hardcopy_tex { my $zip_file = "$final_file_basename.zip"; unless ($zip->writeToFileNamed("$temp_dir_path/$zip_file") == AZ_OK) { - $self->add_errors( - "Failed to create zip archive of directory '" . CGI::code(CGI::escapeHTML($bundle_path)) . "'"); + $self->add_error('Failed to create zip archive of directory "', $r->tag('code', $bundle_path), '"'); return "$bundle_path/$src_name"; } return $zip_file; } +sub find_log_first_error { + my $log = shift; + + my ($line, $first_error); + while ($line = <$log>) { + if ($first_error) { + last if $line =~ /^!\s+/; + $first_error .= $line; + } elsif ($line =~ /^!\s+/) { + $first_error = $line; + } + } + + return $first_error; +} + sub generate_hardcopy_pdf { my ($self, $temp_dir_path, $final_file_basename) = @_; + my $r = $self->r; # call pdflatex - we don't want to chdir in the mod_perl process, as # that might step on the feet of other things (esp. in Apache 2.0) @@ -1033,35 +776,28 @@ sub generate_hardcopy_pdf { my $exit = $rawexit >> 8; my $signal = $rawexit & 127; my $core = $rawexit & 128; - $self->add_errors("Failed to convert TeX to PDF with command '" - . CGI::code(CGI::escapeHTML($pdflatex_cmd)) - . "' (exit=$exit signal=$signal core=$core)."); + $self->add_error( + 'Failed to convert TeX to PDF with command "', + $r->tag('code', $pdflatex_cmd), + qq{" (exit=$exit signal=$signal core=$core).} + ); # read hardcopy.log and report first error my $hardcopy_log = "$temp_dir_path/hardcopy.log"; if (-e $hardcopy_log) { if (open my $LOG, "<:encoding(UTF-8)", $hardcopy_log) { - my $line; - while ($line = <$LOG>) { - last if $line =~ /^!\s+/; - } - my $first_error = $line; - while ($line = <$LOG>) { - last if $line =~ /^!\s+/; - $first_error .= $line; - } + my $first_error = find_log_first_error($LOG); close $LOG; if (defined $first_error) { - $self->add_errors( - "First error in TeX log is:" . CGI::br() . CGI::pre(CGI::escapeHTML($first_error))); + $self->add_error('First error in TeX log is:', $r->tag('br'), $r->tag('pre', $first_error)); } else { - $self->add_errors("No errors encoundered in TeX log."); + $self->add_error('No errors encoundered in TeX log.'); } } else { - $self->add_errors("Could not read TeX log: " . CGI::code(CGI::escapeHTML($!))); + $self->add_error('Could not read TeX log: ', $r->tag('code', $!)); } } else { - $self->add_errors("No TeX log was found."); + $self->add_error('No TeX log was found.'); } } @@ -1075,14 +811,17 @@ sub generate_hardcopy_pdf { . shell_quote("$temp_dir_path/$src_name", "$temp_dir_path/$dest_name"); my $mv_out = readpipe $mv_cmd; if ($?) { - $self->add_errors("Failed to rename '" - . CGI::code(CGI::escapeHTML($src_name)) - . "' to '" - . CGI::code(CGI::escapeHTML($dest_name)) - . "' in directory '" - . CGI::code(CGI::escapeHTML($temp_dir_path)) . "':" - . CGI::br() - . CGI::pre(CGI::escapeHTML($mv_out))); + $self->add_error( + 'Failed to rename "', + $r->tag('code', $src_name), + '" to "', + $r->tag('code', $dest_name), + '" in directory "', + $r->tag('code', $temp_dir_path), + '":', + $r->tag('br'), + $r->tag('pre', $mv_out) + ); $final_file_name = $src_name; } else { $final_file_name = $dest_name; @@ -1121,6 +860,8 @@ async sub write_multiuser_tex { # write postamble $self->write_tex_file($FH, $postamble); + + return; } async sub write_multiset_tex { @@ -1132,9 +873,11 @@ async sub write_multiset_tex { # get user record my $TargetUser = $db->getUser($targetUserID); # checked unless ($TargetUser) { - $self->add_errors("Can't generate hardcopy for user '" - . CGI::code(CGI::escapeHTML($targetUserID)) - . "' -- no such user exists.\n"); + $self->add_error( + q{Can't generate hardcopy for user "}, + $r->tag('code', $targetUserID), + qq{" -- no such user exists.\n} + ); return; } @@ -1148,6 +891,8 @@ async sub write_multiset_tex { await $self->write_set_tex($FH, $TargetUser, $setID); $self->write_tex_file($FH, $divider) if @setIDs; # divide sets, but not after the last set } + + return; } async sub write_set_tex { @@ -1183,29 +928,32 @@ async sub write_set_tex { $self->{versioned} = $versioned; unless ($MergedSet) { - $self->add_errors("Can't generate hardcopy for set ''" - . CGI::code(CGI::escapeHTML($setID)) - . "' for user '" - . CGI::code(CGI::escapeHTML($TargetUser->user_id)) - . "' -- set is not assigned to that user."); + $self->add_error( + q{Can't generate hardcopy for set "}, + $r->tag('code', $setID), + '" for user "', + $r->tag('code', $TargetUser->user_id), + '" -- set is not assigned to that user.' + ); return; } # see if the *real* user is allowed to access this problem set - if ($MergedSet->open_date > time and not $authz->hasPermissions($userID, "view_unopened_sets")) { - $self->add_errors("Can't generate hardcopy for set '" - . CGI::code(CGI::escapeHTML($setID)) - . "' for user '" - . CGI::code(CGI::escapeHTML($TargetUser->user_id)) - . "' -- set is not yet open."); + if ($MergedSet->open_date > time && !$authz->hasPermissions($userID, "view_unopened_sets")) { + $self->add_error( + q{Can't generate hardcopy for set "}, + $r->tag('code', $setID), + '" for user "', + $r->tag('code', $TargetUser->user_id), + '" -- set is not yet open.' + ); return; } - if (not $MergedSet->visible and not $authz->hasPermissions($userID, "view_hidden_sets")) { - $self->addbadmessage("Can't generate hardcopy for set '" - . CGI::code(CGI::escapeHTML($setID)) - . "' for user '" - . CGI::code(CGI::escapeHTML($TargetUser->user_id)) - . "' -- set is not visible to students."); + if (!$MergedSet->visible && !$authz->hasPermissions($userID, "view_hidden_sets")) { + $self->addbadmessage($r->maketext( + q{Can't generate hardcopy for set "[_1]" for user "[_2]". The set is not visible to students.}, + $setID, $TargetUser->user_id, + )); return; } @@ -1262,6 +1010,8 @@ async sub write_set_tex { # write footer await $self->write_problem_tex($FH, $TargetUser, $MergedSet, 0, $footer); # 0 => pg file specified directly + + return; } async sub write_problem_tex { @@ -1292,13 +1042,15 @@ async sub write_problem_tex { # handle nonexistent problem unless ($MergedProblem) { - $self->add_errors("Can't generate hardcopy for problem '" - . CGI::code(CGI::escapeHTML($problemID)) - . "' in set '" - . CGI::code(CGI::escapeHTML($MergedSet->set_id)) - . "' for user '" - . CGI::code(CGI::escapeHTML($MergedSet->user_id)) - . "' -- problem does not exist in that set or is not assigned to that user."); + $self->add_error( + q{Can't generate hardcopy for problem "}, + $r->tag('code', $problemID), + '" in set "', + $r->tag('code', $MergedSet->set_id), + '" for user "', + $r->tag('code', $MergedSet->user_id), + '" -- problem does not exist in that set or is not assigned to that user.' + ); return; } } elsif ($pgFile) { @@ -1330,9 +1082,9 @@ async sub write_problem_tex { unless ( ( $authz->hasPermissions($userID, "show_correct_answers_before_answer_date") - or ( + || ( time > $MergedSet->answer_date - or ($versioned + || ($versioned && $MergedProblem->num_correct + $MergedProblem->num_incorrect >= $MergedSet->attempts_per_version && $MergedSet->due_date == $MergedSet->answer_date) @@ -1385,7 +1137,7 @@ async sub write_problem_tex { my $edit_url; my $problem_name; my $problem_desc; - if ($pg->{warnings} ne "" or $pg->{flags}->{error_flag}) { + if ($pg->{warnings} ne '' || $pg->{flags}->{error_flag}) { my $edit_urlpath = $r->urlpath->newFromModule( "WeBWorK::ContentGenerator::Instructor::PGProblemEditor", $r, courseID => $r->urlpath->arg("courseID"), @@ -1429,27 +1181,36 @@ async sub write_problem_tex { } # deal with PG warnings - if ($pg->{warnings} ne "") { - $self->add_errors( - CGI::a({ href => $edit_url, target => "WW_Editor" }, $r->maketext("~[Edit~]")) . ' ' - . $r->maketext( - "Warnings encountered while processing [_1]. Error text: [_2]", - $problem_desc, - CGI::br() . CGI::pre(CGI::escapeHTML($pg->{warnings})) - ) + if ($pg->{warnings}) { + $self->add_error( + $r->link_to( + $r->tag('button', type => 'button', class => 'btn btn-sm btn-secondary', $r->maketext('Edit')) => + $edit_url, + target => 'WW_Editor' + ), + ' ', + $r->b($r->maketext( + "Warnings encountered while processing [_1]. Error text: [_2]", + $problem_desc, + $r->tag('br') . $r->tag('pre', $pg->{warnings}) + )) ); } # deal with PG errors - if ($pg->{flags}->{error_flag}) { - $self->add_errors( - CGI::a({ href => $edit_url, target => "WW_Editor" }, $r->maketext("~[Edit~]")) . ' ' - . $r->maketext( - "Errors encountered while processing [_1]. This [_2] has been omitted from the hardcopy. Error text: [_3]", - $problem_desc, - $problem_name, - CGI::br() . CGI::pre(CGI::escapeHTML($pg->{errors})) - ) + if ($pg->{flags}{error_flag}) { + $self->add_error( + $r->link_to( + $r->tag('button', type => 'button', class => 'btn btn-sm btn-secondary', $r->maketext('Edit')) => + $edit_url, + target => 'WW_Editor' + ), + ' ', + $r->b($r->maketext( + 'Errors encountered while processing [_1]. This [_2] has been omitted from the hardcopy. ' + . 'Error text: [_3]', + $problem_desc, $problem_name, $r->tag('br') . $r->tag('pre', $pg->{errors}) + )) ); return; } @@ -1567,15 +1328,17 @@ async sub write_problem_tex { print $FH $correctTeX; } + + return; } sub write_tex_file { my ($self, $FH, $file) = @_; + my $r = $self->r; my $tex = eval { readFile($file) }; if ($@) { - $self->add_errors( - "Failed to include TeX file '" . CGI::code(CGI::escapeHTML($file)) . "': " . CGI::escapeHTML($@)); + $self->add_error('Failed to include TeX file "', $r->tag('code', $file), '": ', $r->tag('pre', $@)); } else { print $FH $tex; } @@ -1585,17 +1348,17 @@ sub write_tex_file { # utilities ################################################################################ -sub add_errors { - my ($self, @errors) = @_; - push @{ $self->{hardcopy_errors} }, @errors; +sub add_error { + my ($self, @error_parts) = @_; + push @{ $self->{hardcopy_errors} }, $self->r->c(@error_parts)->join(''); } -sub get_errors { +sub has_errors { my ($self) = @_; - return $self->{hardcopy_errors} ? @{ $self->{hardcopy_errors} } : (); + return scalar @{ $self->{hardcopy_errors} // [] }; } -sub get_errors_ref { +sub get_errors { my ($self) = @_; return $self->{hardcopy_errors}; } diff --git a/lib/WeBWorK/ContentGenerator/Home.pm b/lib/WeBWorK/ContentGenerator/Home.pm index 39090ec424..cede71a430 100644 --- a/lib/WeBWorK/ContentGenerator/Home.pm +++ b/lib/WeBWorK/ContentGenerator/Home.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::Home; -use base qw(WeBWorK::ContentGenerator); +use parent qw(WeBWorK::ContentGenerator); =head1 NAME @@ -24,93 +24,35 @@ WeBWorK::ContentGenerator::Home - display a list of courses. use strict; use warnings; -#use CGI qw(-nosticky ); -use WeBWorK::CGI; -use WeBWorK::Utils qw(readFile readDirectory); -use WeBWorK::Utils::CourseManagement qw/listCourses/; + +use WeBWorK::Utils qw(readFile); use WeBWorK::Localize; sub info { my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; + my $r = $self->r; my $result; # This section should be kept in sync with the Login.pm version - my $site_info = $ce->{webworkFiles}->{site_info}; - if (defined $site_info and $site_info) { - # deal with previewing a temporary file - # FIXME: DANGER: this code allows viewing of any file - # FIXME: this code is disabled because PGProblemEditor no longer uses editFileSuffix - #if (defined $r->param("editMode") and $r->param("editMode") eq "temporaryFile" - # and defined $r->param("editFileSuffix")) { - # $site_info .= $r->param("editFileSuffix"); - #} - - if (-f $site_info) { - my $text = eval { readFile($site_info) }; - if ($@) { - $result = CGI::div({ class => 'alert alert-danger p-1 mb-0' }, $@); - } elsif ($text =~ /\S/) { - $result = $text; - } + my $site_info = $r->ce->{webworkFiles}{site_info}; + if ($site_info && -f $site_info) { + # Show the site info file. + my $text = eval { readFile($site_info) }; + if ($@) { + $result = $r->tag('div', class => 'alert alert-danger p-1 mb-0', $@); + } elsif ($text =~ /\S/) { + $result = $text; } } - if (defined $result and $result ne "") { - return CGI::h2($r->maketext("Site Information")) . $result; - } else { - return ""; - } + return $result ? $r->c($r->tag('h2', $r->maketext('Site Information')), $result)->join('') : ''; } -# Override the if_can method to disable links for the home page. -sub if_can { +# Override the can method to disable links for the home page. +sub can { my ($self, $arg) = @_; - return $arg eq 'links' ? 0 : $self->SUPER::if_can($arg); -} - -sub body { - my ($self) = @_; - my $r = $self->r; - - my $coursesDir = $r->ce->{webworkDirs}->{courses}; - my $coursesURL = $r->ce->{webworkURLs}->{root}; - - my @courseIDs = listCourses($r->ce); - #filter underscores here! - - my $haveAdminCourse = 0; - foreach my $courseID (@courseIDs) { - if ($courseID eq "admin") { - $haveAdminCourse = 1; - last; - } - } - - print CGI::p($r->maketext("Welcome to WeBWorK!")); - - if ($haveAdminCourse and !(-f "$coursesDir/admin/hide_directory")) { - my $urlpath = $r->urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets", $r, courseID => "admin"); - print CGI::p( - CGI::a({ href => $self->systemLink($urlpath, authen => 0) }, $r->maketext("Course Administration"))); - } - - print CGI::h2($r->maketext("Courses")); - - print CGI::start_ul({ class => "courses-list" }); - - foreach my $courseID (sort { lc($a) cmp lc($b) } @courseIDs) { - next if $courseID eq "admin"; # done already above - next if -f "$coursesDir/$courseID/hide_directory"; - my $urlpath = $r->urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets", $r, courseID => $courseID); - print CGI::li(CGI::a({ href => $self->systemLink($urlpath, authen => 0) }, $courseID =~ s/_/ /gr)); - } ###place to use underscore sub - - print CGI::end_ul(); - - return ""; + return $arg eq 'links' ? 0 : $self->SUPER::can($arg); } 1; diff --git a/lib/WeBWorK/ContentGenerator/Instructor.pm b/lib/WeBWorK/ContentGenerator/Instructor.pm index ca6bafb89b..50d0ad269f 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::Instructor; -use base qw(WeBWorK::ContentGenerator); +use parent qw(WeBWorK::ContentGenerator); =head1 NAME @@ -25,9 +25,9 @@ tools, providing useful utility functions. use strict; use warnings; -#use CGI qw(-nosticky ); -use WeBWorK::CGI; + use File::Find; + use WeBWorK::DB::Utils qw(initializeUserProblem); use WeBWorK::Debug; use WeBWorK::Utils qw(jitar_id_to_seq seq_to_jitar_id); @@ -136,7 +136,7 @@ sub assignSetVersionToUser { # both Instructor and ContentGenerator objects have $self->{db} # FIXME it would be nice to have a better solution to this my @result = assignProblemToUserSetVersion($self, $userID, $userSet, $GlobalProblem, \%groupProblems); - push(@results, @result) if (@result && not $set_assigned); + push(@results, @result) if (@result && !$set_assigned); } return @results; @@ -153,6 +153,8 @@ sub unassignSetFromUser { my $db = $self->{db}; $db->deleteUserSet($userID, $setID); + + return; } =item assignProblemToUser($userID, $GlobalProblem, $seed) @@ -287,6 +289,8 @@ sub unassignProblemFromUser { my $db = $self->{db}; $db->deleteUserProblem($userID, $setID, $problemID); + + return; } =back @@ -363,6 +367,8 @@ sub unassignSetFromAllUsers { foreach my $userID (@userIDs) { $self->unassignSetFromUser($userID, $setID); } + + return; } =item assignAllSetsToUser($userID) @@ -404,6 +410,8 @@ sub unassignAllSetsFromUser { foreach my $setID (@setIDs) { $self->unassignSetFromUser($userID, $setID); } + + return; } =back @@ -461,6 +469,8 @@ sub unassignSetsFromUsers { $self->unassignSetFromUser($userID, $setID); } } + + return; } =item assignProblemToAllSetUsers($GlobalProblem) @@ -538,7 +548,7 @@ sub addProblemToSet { if ($set && $set->assignment_type eq 'jitar') { my @problemIDs = $db->listGlobalProblems($setName); if (@problemIDs) { - my @seq = jitar_id_to_seq($problemIDs[$#problemIDs]); + my @seq = jitar_id_to_seq($problemIDs[-1]); $problemID = seq_to_jitar_id($seq[0] + 1); } else { $problemID = seq_to_jitar_id(1); @@ -580,61 +590,12 @@ sub addProblemToSet { =cut -sub hiddenEditForUserFields { - my ($self, @editForUser) = @_; - my $return = ""; - foreach my $editUser (@editForUser) { - $return .= CGI::input({ type => "hidden", name => "editForUser", value => $editUser }); - } - - return $return; -} - -sub userCountMessage { - my ($self, $count, $numUsers) = @_; - - my $message; - if ($count == 0) { - $message = CGI::em($self->r->maketext("no students")); - } elsif ($count == $numUsers) { - $message = $self->r->maketext("all students"); - } elsif ($count == 1) { - $message = $self->r->maketext("1 student"); - } elsif ($count > $numUsers || $count < 0) { - $message = CGI::em($self->r->maketext("an impossible number of users: [_1] out of [_2]", $count, $numUsers)); - } else { - $message = $self->r->maketext("[_1] students out of [_2]", $count, $numUsers); - } - - return $message; -} - -sub setCountMessage { - my ($self, $count, $numSets) = @_; - my $r = $self->r; - - my $message; - if ($count == 0) { - $message = CGI::em($r->maketext("no sets")); - } elsif ($count == $numSets) { - $message = $r->maketext("all sets"); - } elsif ($count == 1) { - $message = "1 " . $r->maketext("set"); - } elsif ($count > $numSets || $count < 0) { - $message = CGI::em($self->r->maketext("an impossible number of sets: [_1] out of [_2]", $count, $numSets)); - } else { - $message = $count . " " . $r->maketext("sets"); - } - - return $message; -} - sub read_dir { # read a directory my $self = shift; my $directory = shift; my $pattern = shift; - my @files = grep /$pattern/, WeBWorK::Utils::readDirectory($directory); - return sort @files; + my @files = sort grep {/$pattern/} WeBWorK::Utils::readDirectory($directory); + return @files; } =back @@ -667,7 +628,9 @@ sub loadSetDefListFile { open(my $fh, "<:encoding(UTF-8)", $file) or die "FATAL: Unable to open '$file'!"; local $/; - <$fh>; + my $contents = <$fh>; + close $fh; + $contents; }; return @{ JSON->new->decode($data) }; @@ -688,9 +651,11 @@ sub getDefList { # get_set_defs_wanted is a closure over @found_set_defs my $get_set_defs_wanted = sub { - $File::Find::prune = 1, return - if $File::Find::dir =~ /^$topdir\/Library/ || $File::Find::dir =~ /^$topdir\/Contrib/; - $File::Find::prune = 1, return if @{ [ $File::Find::dir =~ /\//g ] } > $max_depth; + if ($File::Find::dir =~ /^$topdir\/Library/ || $File::Find::dir =~ /^$topdir\/Contrib/) { + $File::Find::prune = 1; + return; + } + if (@{ [ $File::Find::dir =~ /\//g ] } > $max_depth) { $File::Find::prune = 1; return; } push @found_set_defs, $_ =~ s|^$topdir/?||r if m|/set[^/]*\.def$|; }; @@ -735,7 +700,7 @@ sub getTemplateDirList { # find all .pg files under the template tree (time c my ($self) = @_; my $ce = $self->{ce}; my $dir = $ce->{courseDirs}->{templates}; - my @list = (); + my @list; my $wanted = sub { if (-d $_) { my $current = $_; @@ -748,7 +713,8 @@ sub getTemplateDirList { # find all .pg files under the template tree (time c } }; File::Find::find($wanted, $dir); - return sort @list; + @list = sort @list; + return @list; } =back diff --git a/lib/WeBWorK/ContentGenerator/Instructor/AchievementEditor.pm b/lib/WeBWorK/ContentGenerator/Instructor/AchievementEditor.pm index 7515c58c6a..cfccf2c604 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/AchievementEditor.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/AchievementEditor.pm @@ -14,8 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::Instructor::AchievementEditor; -use base qw(WeBWorK); -use base qw(WeBWorK::ContentGenerator::Instructor); +use parent qw(WeBWorK::ContentGenerator::Instructor); =head1 NAME @@ -25,25 +24,20 @@ WeBWorK::ContentGenerator::Instructor::AchievementEditor - edit an achevement ev use strict; use warnings; -#use CGI qw(-nosticky ); -use WeBWorK::CGI; -use WeBWorK::Utils qw(readFile surePathToFile path_is_subdir x getAssetURL); + use HTML::Entities; use URI::Escape; -use WeBWorK::Utils qw(not_blank); use File::Copy; -use WeBWorK::Utils::Tasks qw(fake_user fake_set); -use WeBWorK::ContentGenerator::Instructor::CodeMirrorEditor - qw(generate_codemirror_html generate_codemirror_controls_html output_codemirror_static_files); -use Fcntl; + +use WeBWorK::Utils qw(not_blank path_is_subdir x); use constant ACTION_FORMS => [qw(save save_as)]; use constant ACTION_FORM_TITLES => { - save => x("Save"), - save_as => x("Save As"), + save => x('Save'), + save_as => x('Save As'), }; -use constant DEFAULT_ICON => "defaulticon.png"; +use constant DEFAULT_ICON => 'defaulticon.png'; async sub pre_header_initialize { my ($self) = @_; @@ -52,67 +46,41 @@ async sub pre_header_initialize { my $urlpath = $r->urlpath; my $authz = $r->authz; my $user = $r->param('user'); - $self->{courseID} = $urlpath->arg("courseID"); - $self->{achievementID} = $r->urlpath->arg("achievementID"); + $self->{courseID} = $urlpath->arg('courseID'); + $self->{achievementID} = $r->urlpath->arg('achievementID'); - my $submit_button = $r->param('submit'); # obtain submit command from form - my $actionID = $r->param('action'); + # Make sure that are defined for the templates. + $r->stash->{formsToShow} = ACTION_FORMS(); + $r->stash->{actionFormTitles} = ACTION_FORM_TITLES(); + $r->stash->{achievementContents} = ''; # Check permissions - return unless ($authz->hasPermissions($user, "edit_achievements")); + return unless ($authz->hasPermissions($user, 'edit_achievements')); - #get the achievement + # Get the achievement my $Achievement = $r->db->getAchievement($self->{achievementID}); - if (not $Achievement) { + if (!$Achievement) { $self->addbadmessage("Achievement $self->{achievementID} not found!"); - die; + return; } - $self->{achievement} = $Achievement; - $self->{sourceFilePath} = $ce->{courseDirs}->{achievements} . "/" . $Achievement->test; - $self->{r_achievementContents} = undef; + $self->{achievement} = $Achievement; + $self->{sourceFilePath} = $ce->{courseDirs}{achievements} . '/' . $Achievement->test; + + my $actionID = $r->param('action'); - #perform a save or save_as action + # Perform a save or save_as action if ($actionID) { unless (grep { $_ eq $actionID } @{ ACTION_FORMS() }) { die "Action $actionID not found"; } my $actionHandler = "${actionID}_handler"; - my %genericParams = (); - my %actionParams = $self->getActionParams($actionID); - my %tableParams = (); - $self->{action} = $actionID; - $self->$actionHandler(\%genericParams, \%actionParams, \%tableParams); - - } else { - # we just opened up this file for the first time - $self->{action} = 'fresh_edit'; - my $actionHandler = "fresh_edit_handler"; - my %genericParams; - my %actionParams = (); - my %tableParams = (); - my $achievementContents = ''; - $self->{r_achievementContents} = \$achievementContents; - $self->$actionHandler(\%genericParams, \%actionParams, \%tableParams); + $self->$actionHandler; } - ############################################################################## - # Return - # If file saving fails or - # if no redirects are required. No further processing takes place in this subroutine. - # Redirects are required only for the following submit values - # 'Save' - # 'Save as' - # - ######################################### - - return if $self->{failure}; - # FIXME: even with an error we still open a new page because of the target specified in the form - my $action = $self->{action}; return; - } sub initialize { @@ -122,172 +90,55 @@ sub initialize { my $user = $r->param('user'); my $sourceFilePath = $self->{sourceFilePath}; - # Check permissions - return unless ($authz->hasPermissions($user, "edit_achievements")); + return unless ($authz->hasPermissions($user, 'edit_achievements')); - $self->addmessage($r->param('status_message') || ''); # record status messages carried over if this is a redirect + $self->addmessage($r->param('status_message') || ''); # Record status messages carried over from a redirect # Check source file path if (not(-e $sourceFilePath)) { - $self->addbadmessage("The file '" . $self->shortPath($sourceFilePath) . "' cannot be found."); + $self->addbadmessage('The file "' . $self->shortPath($sourceFilePath) . '" cannot be found.'); + return; + } + + # Find the text for the achievement. + unless ($r->stash->{achievementContents} =~ /\S/) { + unless (path_is_subdir($sourceFilePath, $r->ce->{courseDirs}{achievements}, 1)) { + $self->addbadmessage('Path is Unsafe!'); + return; + } + + eval { $r->stash->{achievementContents} = WeBWorK::Utils::readFile($sourceFilePath) }; + $r->stash->{achievementContents} = $@ if $@; } + + return; } sub path { my ($self, $args) = @_; - my $r = $self->r; - my $urlpath = $r->urlpath; - my $courseName = $urlpath->arg("courseID"); - my $achievementName = $r->urlpath->arg("achievementID") || ''; - - # we need to build a path to the achievement being edited by hand, since it is not the same as the urlpath - # For this page the bread crum path leads back to the problem being edited, not to the Instructor tool. - my @path = ( - 'WeBWork', $r->location, - "$courseName", $r->location . "/$courseName", - $r->maketext('Achievement'), $r->location . "/$courseName/instructor/achievement_list", - "$achievementName", $r->location . "/$courseName/instructor/achievement_list", + my $r = $self->r; + my $urlpath = $r->urlpath; + my $courseName = $urlpath->arg('courseID'); + + # Build a path to the achievement being edited by hand, since it is not the same as the urlpath. + # For this page the breadcrumb path shows the achievement being edited. + return $self->pathMacro( + $args, + 'WeBWork' => $r->location, + $courseName => $r->location . "/$courseName", + $r->maketext('Achievement') => $r->location . "/$courseName/instructor/achievement_list", + $r->urlpath->arg('achievementID') => undef ); - - #print "\n\n"; - print $self->pathMacro($args, @path); - #print "\n"; - - return ""; } sub title { - my $self = shift; - my $r = $self->r; - my $courseName = $r->urlpath->arg("courseID"); - my $achievementID = $r->urlpath->arg("achievementID"); - - return $r->maketext("Achievement Evaluator for achievement [_1]", $achievementID); - -} - -sub body { - my ($self) = @_; - my $r = $self->r; - my $db = $r->db; - my $ce = $r->ce; - my $authz = $r->authz; - my $user = $r->param('user'); - - # Check permissions - return CGI::div({ class => 'alert alert-danger p-1' }, "You are not authorized to edit achievements.") - unless $authz->hasPermissions($user, "edit_achievements"); - - # Gathering info - my $sourceFilePath = $self->{sourceFilePath}; # path to the permanent file to be edited - my $achievementID = $self->{achievementID}; - my $Achievement = $self->{achievement}; - - ######################################################################### - # Find the text for the achievement - ######################################################################### - - my $achievementContents = ${ $self->{r_achievementContents} }; - - unless ($achievementContents =~ /\S/) { # non-empty contents - die "Path is Unsafe!" unless path_is_subdir($sourceFilePath, $ce->{courseDirs}->{achievements}, 1); - - eval { $achievementContents = WeBWorK::Utils::readFile($sourceFilePath) }; - - $achievementContents = $@ if $@; - - } else { - #warn "obtaining input from r_problemContents"; - } - - my $header = CGI::i($r->maketext("Editing achievement in file '[_1]'", $self->shortPath($sourceFilePath))); - - ######################################################################### - # Format the page - ######################################################################### - - print CGI::div({ class => 'mb-2' }, $header), - CGI::start_form({ - method => 'POST', - id => 'editor', - name => 'editor', - action => $r->uri, - enctype => 'application/x-www-form-urlencoded' - }), - $self->hidden_authen_fields, - (not_blank($self->{sourceFilePath})) - ? CGI::hidden({ name => 'sourceFilePath', value => $self->{sourceFilePath} }) - : ''; - - print CGI::div({ class => 'mb-2' }, generate_codemirror_html($r, 'achievementContents', $achievementContents)); - print generate_codemirror_controls_html($r); - - ######### print action forms - my @formsToShow = @{ ACTION_FORMS() }; - my %actionFormTitles = %{ ACTION_FORM_TITLES() }; - my $default_choice; - - my @tabArr; - my @contentArr; - - for my $actionID (@formsToShow) { - my $actionForm = "${actionID}_form"; - my $line_contents = $self->$actionForm($self->getActionParams($actionID)); - my $active = ''; - - if ($line_contents) { - $active = ' active', $default_choice = $actionID unless $default_choice; - - push( - @tabArr, - CGI::li( - { class => 'nav-item', role => 'presentation' }, - CGI::a( - { - href => "#$actionID", - class => "nav-link action-link$active", - id => "$actionID-tab", - data_action => $actionID, - data_bs_toggle => 'tab', - data_bs_target => "#$actionID", - role => 'tab', - aria_controls => $actionID, - aria_selected => $active ? 'true' : 'false' - }, - $r->maketext($actionFormTitles{$actionID}) - ) - ) - ); - push( - @contentArr, - CGI::div( - { - class => 'tab-pane fade mb-2' . ($active ? " show$active" : ""), - id => $actionID, - role => 'tabpanel', - aria_labelledby => "$actionID-tab" - }, - $line_contents - ) - ); - } - } - - print CGI::hidden(-name => 'action', -id => 'current_action', -value => $default_choice); - print CGI::div(CGI::ul({ class => 'nav nav-tabs mb-2', role => 'tablist' }, @tabArr), - CGI::div({ class => 'tab-content' }, @contentArr)); - - print CGI::div( - CGI::submit({ name => 'submit', value => $r->maketext("Take Action!"), class => 'btn btn-primary' })); - - print CGI::end_form(); + my $self = shift; + my $r = $self->r; - return ""; + return $r->maketext('Achievement Evaluator for achievement [_1]', $r->urlpath->arg('achievementID')); } -# -# Convert long paths to [ACHEVDIR] -# +# Convert long paths to [ACHEVDIR] sub shortPath { my $self = shift; my $file = shift; @@ -296,10 +147,6 @@ sub shortPath { return $file; } -################################################################################ -# Utilities -################################################################################ - sub getRelativeSourceFilePath { my ($self, $sourceFilePath) = @_; @@ -309,270 +156,128 @@ sub getRelativeSourceFilePath { return $sourceFilePath; } +# saveFileChanges does most of the work. It is a separate method so that it can +# be called from either pre_header_initialize or initilize, depending on +# whether a redirect is needed or not. sub saveFileChanges { - -################################################################################ - # saveFileChanges does most of the work. it is a separate method so that it can - # be called from either pre_header_initialize() or initilize(), depending on - # whether a redirect is needed or not. - # - # it actually does a lot more than save changes to the file being edited, and - # sometimes less. -################################################################################ - my ($self, $outputFilePath, $achievementContents) = @_; + my $r = $self->r; my $ce = $r->ce; - my $action = $self->{action} || 'no action'; - if (defined($achievementContents) and ref($achievementContents)) { $achievementContents = ${$achievementContents}; } elsif (!not_blank($achievementContents)) { # if the AchievementContents is undefined or empty - $achievementContents = ${ $self->{r_achievementContents} }; + $achievementContents = $self->r->stash->{achievementContents}; } unless (not_blank($outputFilePath)) { - $self->addbadmessage($r->maketext("You must specify an file name in order to save a new file.")); - return ""; + $self->addbadmessage($r->maketext('You must specify an file name in order to save a new file.')); + return ''; } my $do_not_save = 0; # flag to prevent saving of file my $editErrors = ''; - ############################################################################## # write changes to the approriate files # FIXME make sure that the permissions are set correctly!!! # Make sure that the warning is being transmitted properly. - ############################################################################## my $writeFileErrors; if (not_blank($outputFilePath)) { # save file # make sure any missing directories are created WeBWorK::Utils::surePathToFile($ce->{courseDirs}->{achievements}, $outputFilePath); - die "outputFilePath is unsafe!" - unless path_is_subdir($outputFilePath, $ce->{courseDirs}->{achievements}, 1) - ; # 1==path can be relative to dir + die 'outputFilePath is unsafe!' + unless path_is_subdir($outputFilePath, $ce->{courseDirs}->{achievements}, 1); eval { - local *OUTPUTFILE; - open OUTPUTFILE, ">$outputFilePath" - or die "Failed to open $outputFilePath"; - print OUTPUTFILE $achievementContents; - close OUTPUTFILE; - # any errors are caught in the next block + open my $OUTPUTFILE, '>', $outputFilePath or die "Failed to open $outputFilePath"; + print $OUTPUTFILE $achievementContents; + close $OUTPUTFILE; }; $writeFileErrors = $@ if $@; } - ########################################################### # Catch errors in saving files, - ########################################################### - - $self->{saveError} = $do_not_save; # don't do redirects if the file was not saved. - # don't unlink files or send success messages + $self->{saveError} = $do_not_save; # Don't do redirects if the file was not saved. + # Don't unlink files or send success messages if ($writeFileErrors) { - # get the current directory from the outputFilePath + # Get the current directory from the outputFilePath $outputFilePath =~ m|^(/.*?/)[^/]+$|; my $currentDirectory = $1; my $errorMessage; - # check why we failed to give better error messages + # Check why we failed to give better error messages if (not -w $ce->{courseDirs}->{achievements}) { $errorMessage = $r->maketext( - "Write permissions have not been enabled in the templates directory. No changes can be made."); + 'Write permissions have not been enabled in the templates directory. No changes can be made.'); } elsif (not -w $currentDirectory) { $errorMessage = $r->maketext( - "Write permissions have not been enabled in '[_1]'. Changes must be saved to a different directory for viewing.", + 'Write permissions have not been enabled in "[_1]". ' + . 'Changes must be saved to a different directory for viewing.', $self->shortPath($currentDirectory) ); } elsif (-e $outputFilePath and not -w $outputFilePath) { $errorMessage = $r->maketext( - "Write permissions have not been enabled for '[_1]'. Changes must be saved to another file for viewing.", + 'Write permissions have not been enabled for "[_1]". ' + . 'Changes must be saved to another file for viewing.', $self->shortPath($outputFilePath) ); } else { $errorMessage = - $r->maketext("Unable to write to '[_1]': [_2]", $self->shortPath($outputFilePath), $writeFileErrors); + $r->maketext('Unable to write to "[_1]": [_2]', $self->shortPath($outputFilePath), $writeFileErrors); } $self->{failure} = 1; - $self->addbadmessage(CGI::p($errorMessage)); - - } - - unless ($writeFileErrors or $do_not_save) { # everything worked! unlink and announce success! - - if (defined($outputFilePath) and !$self->{failure}) { - # don't announce saving of temporary editing files - my $msg = $r->maketext("Saved to file '[_1]'", $self->shortPath($outputFilePath)); - - $self->addgoodmessage($msg); - } - + $self->addbadmessage($errorMessage); } -} # end saveFileChanges - -sub getActionParams { - my ($self, $actionID) = @_; - my $r = $self->{r}; - - my %actionParams = (); - foreach my $param ($r->param) { - next unless $param =~ m/^action\.$actionID\./; - $actionParams{$param} = [ $r->param($param) ]; + if (!$writeFileErrors && !$do_not_save && defined $outputFilePath && !$self->{failure}) { + $self->addgoodmessage($r->maketext('Saved to file "[_1]"', $self->shortPath($outputFilePath))); } - return %actionParams; } sub fixAchievementContents { - #NOT a method my $AchievementContents = shift; # Handle the problem of line endings. # Make sure that all of the line endings are of unix type. # Convert \r\n to \n $AchievementContents =~ s/\r\n/\n/g; $AchievementContents =~ s/\r/\n/g; - $AchievementContents; -} - -sub save_form { - my ($self, %actionParams) = @_; - my $r = $self->r; - - if (-w $self->{sourceFilePath}) { - return $r->maketext("Save [_1]", CGI::b($self->shortPath($self->{sourceFilePath}))); - } else { - return ""; #"Can't save -- No write permission"; - } + return $AchievementContents; } sub save_handler { - my ($self, $genericParams, $actionParams, $tableParams) = @_; + my ($self) = @_; my $r = $self->r; my $courseName = $self->{courseID}; my $achievementName = $self->{achievementID}; - ################################################# - # grab the achievementContents from the form in order to save it to the source path - ################################################# - my $achievementContents = fixAchievementContents($self->r->param('achievementContents')); - $self->{r_achievementContents} = \$achievementContents; + # Grab the achievementContents from the form in order to save it to the source path + $self->r->stash->{achievementContents} = fixAchievementContents($self->r->param('achievementContents')); - ################################################# # Construct the output file path - ################################################# $self->saveFileChanges($self->{sourceFilePath}); return; - -} - -# calls the save_as_handler -sub save_as_form { - my ($self, %actionParams) = @_; - my $r = $self->r; - my $sourceFilePath = $self->{sourceFilePath}; - my $achievementsDir = $self->r->ce->{courseDirs}->{achievements}; - my $achievementID = $self->{achievementID}; - my $sourceFileName = getRelativeSourceFilePath($self, $sourceFilePath); - - # There are three things you can do with a new achievement editor. - # You can replace the current achievement, use it in a new achievement, or not use it at all. - return CGI::div( - CGI::div( - { class => 'row align-items-center mb-2' }, - CGI::label( - { for => 'action.save_as.target_file_id', class => 'col-form-label col-auto' }, - $r->maketext('Save as:') - ), - CGI::div( - { class => 'col-auto' }, - CGI::textfield({ - name => 'action.save_as.target_file', - id => 'action.save_as.target_file_id', - size => 40, - value => $sourceFileName, - class => 'form-control form-control-sm' - }) - ), - CGI::hidden(-name => 'action.save_as.source_file', -value => $sourceFilePath) - ), - CGI::div( - { class => 'form-check mb-2' }, - CGI::input({ - type => 'radio', - id => 'action.save_as.saveMode.use_in_current', - name => 'action.save_as.saveMode', - value => 'use_in_current', - class => 'form-check-input' - }), - CGI::label( - { for => 'action.save_as.saveMode.use_in_current', class => 'form-check-label' }, - $r->maketext('Use in achievement [_1]', CGI::b($achievementID)) - ) - ), - CGI::div( - { class => 'mb-2' }, - CGI::div( - { class => 'form-check d-inline-block' }, - CGI::input({ - type => 'radio', - id => 'action.save_as.saveMode.use_in_new', - name => 'action.save_as.saveMode', - value => 'use_in_new', - class => 'form-check-input' - }), - CGI::label( - { - for => 'action.save_as.saveMode.use_in_new', - class => 'form-check-label me-1', - id => 'action.save_as.saveMode.use_in_new.label' - }, - $r->maketext('Use in new achievement:'), - ) - ), - CGI::textfield({ - name => 'action.save_as.id', - aria_labelledby => 'action.save_as.saveMode.use_in_new.label', - value => '', - class => 'form-control form-control-sm d-inline w-auto' - }) - ), - CGI::div( - { class => 'form-check' }, - CGI::input({ - type => 'radio', - id => 'action.save_as.saveMode.dont_use', - name => 'action.save_as.saveMode', - value => 'dont_use', - class => 'form-check-input' - }), - CGI::label( - { for => 'action.save_as.saveMode.dont_use', class => 'form-check-label' }, - $r->maketext("Don't use in an achievement") - ) - ) - ); } sub save_as_handler { - my ($self, $genericParams, $actionParams, $tableParams) = @_; - my $r = $self->r; - my $db = $r->db; - $self->{status_message} = ''; ## DPVC -- remove bogus old messages + my ($self) = @_; + my $r = $self->r; + my $db = $r->db; + $self->{status_message} = $r->c; ## DPVC -- remove bogus old messages my $courseName = $self->{courseID}; my $achievementName = $self->{achievementID}; my $effectiveUserName = $self->r->param('effectiveUser'); my $do_not_save = 0; - my $saveMode = $actionParams->{'action.save_as.saveMode'}->[0] || 'no_save_mode_selected'; - my $new_file_name = $actionParams->{'action.save_as.target_file'}->[0] || ''; - my $sourceFilePath = $actionParams->{'action.save_as.source_file'}->[0] || ''; - my $targetAchievementID = $actionParams->{'action.save_as.id'}->[0] || ''; + my $saveMode = $r->param('action.save_as.saveMode') || 'no_save_mode_selected'; + my $new_file_name = $r->param('action.save_as.target_file') || ''; + my $sourceFilePath = $r->param('action.save_as.source_file') || ''; + my $targetAchievementID = $r->param('action.save_as.id') || ''; $self->{sourceFilePath} = $sourceFilePath; # store for use in saveFileChanges $new_file_name =~ s/^\s*//; #remove initial and final white space @@ -580,69 +285,60 @@ sub save_as_handler { if ($new_file_name !~ /\S/) { # need a non-blank file name # setting $self->{failure} stops saving and any redirects $do_not_save = 1; - $self->addbadmessage(CGI::p($r->maketext("Please specify a file to save to."))); + $self->addbadmessage($r->maketext('Please specify a file to save to.')); } - ################################################# - # grab the achievementContents from the form in order to save it to a new permanent file - ################################################# - my $achievementContents = fixAchievementContents($self->r->param('achievementContents')); - $self->{r_achievementContents} = \$achievementContents; - warn "achievement contents is empty" unless $achievementContents; - ################################################# - # Rescue the user in case they forgot to end the file name with .at - ################################################# + # Grab the achievementContents from the form in order to save it to a new permanent file + $self->r->stash->{achievementContents} = fixAchievementContents($self->r->param('achievementContents')); + warn 'achievement contents is empty' unless $self->r->stash->{achievementContents}; + # Rescue the user in case they forgot to end the file name with .at $new_file_name =~ s/\.at$//; # remove it if it is there $new_file_name .= '.at'; # put it there - ################################################# # Construct the output file path - ################################################# my $outputFilePath = $self->r->ce->{courseDirs}->{achievements} . '/' . $new_file_name; if (defined $outputFilePath and -e $outputFilePath) { # setting $do_not_save stops saving and any redirects $do_not_save = 1; - $self->addbadmessage(CGI::p($r->maketext( - "File '[_1]' exists. File not saved. No changes have been made.", + $self->addbadmessage($r->maketext( + 'File "[_1]" exists. File not saved. No changes have been made.', $self->shortPath($outputFilePath) - ))); - } elsif ($saveMode eq 'use_in_new' && not $targetAchievementID) { + )); + } elsif ($saveMode eq 'use_in_new' && !$targetAchievementID) { $self->addbadmessage( - $r->maketext("No new Achievement ID specified. No new achievement created. File not saved.")); + $r->maketext('No new Achievement ID specified. No new achievement created. File not saved.')); $do_not_save = 1; } elsif ($saveMode eq 'use_in_new' && $db->existsAchievement($targetAchievementID)) { - $self->addbadmessage($r->maketext("Achievement ID exists! No new achievement created. File not saved.")); + $self->addbadmessage($r->maketext('Achievement ID exists! No new achievement created. File not saved.')); $do_not_save = 1; } else { $self->{editFilePath} = $outputFilePath; $self->{inputFilePath} = ''; } - return "" if $do_not_save; + return '' if $do_not_save; #Save changes $self->saveFileChanges($outputFilePath); if ($saveMode eq 'use_in_current' and -r $outputFilePath) { - ################################################# # Modify evaluator path in current achievement - ################################################# my $achievement = $self->r->db->getAchievement($achievementName); $achievement->test($new_file_name); if ($self->r->db->putAchievement($achievement)) { $self->addgoodmessage($r->maketext( - "The evaluator for [_1] has been renamed to '[_2]'.", $achievementName, + 'The evaluator for [_1] has been renamed to "[_2]".', $achievementName, $self->shortPath($outputFilePath) )); } else { $self->addbadmessage( - $r->maketext("Unable to change the evaluator for set [_1]. Unknown error.", $achievementName)); + $r->maketext('Unable to change the evaluator for set [_1]. Unknown error.', $achievementName)); } } elsif ($saveMode eq 'use_in_new') { - #Create a new achievement to use the evaluator in + # Create a new achievement to use the evaluator in my $achievement = $self->r->db->newAchievement(); $achievement->achievement_id($targetAchievementID); $achievement->test($new_file_name); @@ -650,82 +346,59 @@ sub save_as_handler { $self->r->db->addAchievement($achievement); $self->addgoodmessage($r->maketext( - "Achievement [_1] created with evaluator '[_2]'.", $targetAchievementID, + 'Achievement [_1] created with evaluator "[_2]".', $targetAchievementID, $self->shortPath($outputFilePath) )); } elsif ($saveMode eq 'dont_use') { - ################################################# # Don't change any achievements - just report - ################################################# - $self->addgoodmessage($r->maketext("A new file has been created at '[_1]'", $self->shortPath($outputFilePath))); + $self->addgoodmessage($r->maketext('A new file has been created at "[_1]"', $self->shortPath($outputFilePath))); } else { - $self->addbadmessage($r->maketext("Don't recognize saveMode: |[_1]|. Unknown error.", $saveMode)); + $self->addbadmessage($r->maketext(q{Don't recognize saveMode: |[_1]|. Unknown error.}, $saveMode)); } - ################################################# # Set up redirect # The redirect gives the server time to detect that the new file exists. - ################################################# my $problemPage; if ($saveMode eq 'dont_use') { $problemPage = $self->r->urlpath->newFromModule( - "WeBWorK::ContentGenerator::Instructor::AchievementEditor", $r, + 'WeBWorK::ContentGenerator::Instructor::AchievementEditor', $r, courseID => $courseName, achievementID => $achievementName ); } elsif ($saveMode eq 'use_in_current') { $problemPage = $self->r->urlpath->newFromModule( - "WeBWorK::ContentGenerator::Instructor::AchievementEditor", $r, + 'WeBWorK::ContentGenerator::Instructor::AchievementEditor', $r, courseID => $courseName, achievementID => $achievementName ); } elsif ($saveMode eq 'use_in_new') { $problemPage = $self->r->urlpath->newFromModule( - "WeBWorK::ContentGenerator::Instructor::AchievementEditor", $r, + 'WeBWorK::ContentGenerator::Instructor::AchievementEditor', $r, courseID => $courseName, achievementID => $targetAchievementID ); } else { - $self->addbadmessage( - " Please use radio buttons to choose the method for saving this file. Can't recognize saveMode: |$saveMode|." - ); - # can't continue since paths have not been properly defined. - return ""; + $self->addbadmessage('Please use radio buttons to choose the method for saving this file. ' + . "Can't recognize saveMode: |$saveMode|."); + # Can't continue since paths have not been properly defined. + return ''; } - #warn "save mode is $saveMode"; - my $relativeOutputFilePath = $self->getRelativeSourceFilePath($outputFilePath); my $viewURL = $self->systemLink( $problemPage, params => { sourceFilePath => $relativeOutputFilePath, - status_message => uri_escape_utf8($self->{status_message}) + status_message => uri_escape_utf8($self->{status_message}->join('')) } ); $self->reply_with_redirect($viewURL); - return ""; # no redirect needed -} - -sub fresh_edit_handler { - my ($self, $genericParams, $actionParams, $tableParams) = @_; - #$self->addgoodmessage("fresh_edit_handler called"); -} - -sub output_JS { - my $self = shift; - my $ce = $self->r->ce; - - output_codemirror_static_files($ce); - - print CGI::script({ src => getAssetURL($ce, 'js/apps/ActionTabs/actiontabs.js'), defer => undef }, ''); - - return ''; + return; } 1; diff --git a/lib/WeBWorK/ContentGenerator/Instructor/AchievementList.pm b/lib/WeBWorK/ContentGenerator/Instructor/AchievementList.pm index 95853bd230..51d86b76e5 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/AchievementList.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/AchievementList.pm @@ -14,8 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::Instructor::AchievementList; -use base qw(WeBWorK); -use base qw(WeBWorK::ContentGenerator::Instructor); +use parent qw(WeBWorK::ContentGenerator::Instructor); =head1 NAME @@ -47,136 +46,52 @@ links to edit the evaluator and the individual user data. use strict; use warnings; -#use CGI qw(-nosticky ); -use WeBWorK::CGI; -use WeBWorK::Debug; -use WeBWorK::Utils qw(timeToSec readFile listFilesRecursive sortAchievements x getAssetURL); -use DateTime; + +use Mojo::File; use Text::CSV; -use Encode; -use open IO => ':encoding(UTF-8)'; -#constants for forms and the various handlers -use constant BLANK_ACHIEVEMENT => "blankachievement.at"; -use constant DEFAULT_ENABLED_STATE => 0; +use WeBWorK::Utils qw(sortAchievements x); -use constant EDIT_FORMS => [qw(saveEdit cancelEdit)]; +# Forms +use constant EDIT_FORMS => [qw(save_edit cancel_edit)]; use constant VIEW_FORMS => [qw(edit assign import export score create delete)]; -use constant EXPORT_FORMS => [qw(saveExport cancelExport)]; +use constant EXPORT_FORMS => [qw(save_export cancel_export)]; # Prepare the tab titles for translation by maketext use constant FORM_TITLES => { - saveEdit => x("Save Edit"), - cancelEdit => x("Cancel Edit"), - edit => x("Edit"), - assign => x("Assign"), - import => x("Import"), - export => x("Export"), - score => x("Score"), - create => x("Create"), - delete => x("Delete"), - saveExport => x("Save Export"), - cancelExport => x("Cancel Export") -}; - -use constant VIEW_FIELD_ORDER => [qw( achievement_id enabled name number category )]; -use constant EDIT_FIELD_ORDER => [ - qw( icon achievement_id name number assignment_type category enabled points max_counter description icon_file test_file) -]; -use constant EXPORT_FIELD_ORDER => [qw( select achievement_id name)]; - -use constant STATE_PARAMS => [qw(user effectiveUser key editMode exportMode)]; - -use constant ASSIGNMENT_TYPES => [qw(default gateway jitar)]; - -use constant ASSIGNMENT_NAMES => { - default => 'homework', - gateway => 'gateways', - jitar => 'just-in-time', -}; - -#properites for the fields shown in the tables -use constant FIELD_PROPERTIES => { - achievement_id => { - type => "text", - size => 8, - access => "readonly", - }, - name => { - type => "text", - size => 30, - access => "readwrite", - }, - assignment_type => { - type => "assignment_type", - size => 30, - access => "readwrite", - }, - category => { - type => "text", - size => 30, - access => "readwrite", - }, - number => { - type => "text", - size => 8, - access => "readwrite", - }, - icon => { - type => "text", - size => 85, - access => "readwrite", - }, - test => { - type => "text", - size => 85, - access => "readwrite", - }, - - description => { - type => "text", - size => 85, - access => "readwrite", - }, - - enabled => { - type => "checked", - size => 8, - access => "readwrite", - }, - - points => { - type => "text", - size => 8, - access => "readwrite", - }, - - max_counter => { - type => "text", - size => 8, - access => "readwrite", - }, + save_edit => x('Save Edit'), + cancel_edit => x('Cancel Edit'), + edit => x('Edit'), + assign => x('Assign'), + import => x('Import'), + export => x('Export'), + score => x('Score'), + create => x('Create'), + delete => x('Delete'), + save_export => x('Save Export'), + cancel_export => x('Cancel Export') }; sub initialize { - my ($self) = @_; my $r = $self->r; my $urlpath = $r->urlpath; my $db = $r->db; my $ce = $r->ce; my $authz = $r->authz; - my $courseName = $urlpath->arg("courseID"); - my $achievementID = $urlpath->arg("achievementID"); + my $courseName = $urlpath->arg('courseID'); + my $achievementID = $urlpath->arg('achievementID'); my $user = $r->param('user'); - my $root = $ce->{webworkURLs}->{root}; + # Make sure these are available in the templates. + $r->stash->{formsToShow} = VIEW_FORMS(); + $r->stash->{formTitles} = FORM_TITLES(); + $r->stash->{achievements} = []; - #check permissions - return CGI::div({ class => 'alert alert-danger p-1' }, "You are not authorized to edit achievements.") - unless $authz->hasPermissions($user, "edit_achievements"); + # Check permissions + return unless $authz->hasPermissions($user, 'edit_achievements'); - ########## set initial values for state fields + # Set initial values for state fields my @allAchievementIDs = $db->listAchievements; #### Temporary Transition Code #### @@ -186,7 +101,7 @@ sub initialize { # This whole block of code can be removed once people have had time # to transition over. (I.E. around 2017) - foreach my $achievementID (@allAchievementIDs) { + for my $achievementID (@allAchievementIDs) { my $achievement = $db->getAchievement($achievementID); unless ($achievement->assignment_type || $achievement->number) { $achievement->assignment_type('default'); @@ -199,19 +114,12 @@ sub initialize { $self->{allAchievementIDs} = \@allAchievementIDs; $self->{totalUsers} = scalar @users; - if (defined $r->param("selected_achievements")) { - $self->{selectedAchievementIDs} = [ $r->param("selected_achievements") ]; - } else { - $self->{selectedAchievementIDs} = []; - } + $self->{selectedAchievementIDs} = [ $r->param('selected_achievements') ]; - $self->{editMode} = $r->param("editMode") || 0; + $self->{editMode} = $r->param('editMode') || 0; - ######################################### - # call action handler - ######################################### - - my $actionID = $r->param("action"); + # Call action handler + my $actionID = $r->param('action'); $self->{actionID} = $actionID; if ($actionID) { unless (grep { $_ eq $actionID } @{ VIEW_FORMS() }, @{ EDIT_FORMS() }, @{ EXPORT_FORMS() }) { @@ -219,249 +127,33 @@ sub initialize { } my $actionHandler = "${actionID}_handler"; - my %genericParams; - foreach my $param (qw(selected_achievements)) { - $genericParams{$param} = [ $r->param($param) ]; - } - my %actionParams = $self->getActionParams($actionID); - my %tableParams = $self->getTableParams(); - $self->addmessage(CGI::div({ class => 'mb-1' }, $r->maketext("Results of last action performed: "))); - $self->addmessage($self->$actionHandler(\%genericParams, \%actionParams, \%tableParams)); + $self->addmessage($r->tag('p', class => 'mb-1', $r->maketext('Results of last action performed: '))); + $self->addmessage($self->$actionHandler); } else { - $self->addgoodmessage($r->maketext("Please select action to be performed.")); - } -} - -sub body { - my ($self) = @_; - my $r = $self->r; - my $urlpath = $r->urlpath; - my $db = $r->db; - my $ce = $r->ce; - my $authz = $r->authz; - my $courseName = $urlpath->arg("courseID"); - my $achievementID = $urlpath->arg("achievementID"); - my $user = $r->param('user'); - - my $root = $ce->{webworkURLs}->{root}; - - return CGI::div({ class => 'alert alert-danger p-1 mb-0' }, "You are not authorized to edit achievements.") - unless $authz->hasPermissions($user, "edit_achievements"); - - my $actionID = $self->{actionID}; - - ########## retrieve possibly changed values for member fields - - my @allAchievementIDs = @{ $self->{allAchievementIDs} } - ; # do we need this one? YES, deleting or importing a achievement will change this. - my @selectedAchievementIDs = @{ $self->{selectedAchievementIDs} }; - my $editMode = $self->{editMode}; - my $exportMode = $self->{exportMode}; - - ########## get achievements - - my @Achievements = $db->getAchievements(@allAchievementIDs); - - # sort Achievments. Achievements are always sorted by in the order they are evaluated - if (@Achievements) { - @Achievements = sortAchievements(@Achievements); - } - - ########## print site identifying information - - print CGI::input({ - type => "button", - id => "show_hide", - value => $r->maketext("Show/Hide Site Description"), - class => "btn btn-info mb-2" - }); - print CGI::p( - { - id => "site_description", - style => "display:none" - }, - CGI::em($r->maketext( - 'This is the Achievement Editor. It is used to edit the achievements available to students. Please keep ' - . 'in mind the following facts: Achievments are displayed, and evaluated, in the order they are ' - . 'listed. The "secret" category creates achievements which are not visible to students until they are ' - . 'earned. The "level" category is used for the achievements associated to a users level.' - )) - ); - - ########## print beginning of form - - print CGI::start_form({ - method => 'post', - action => $self->systemLink($urlpath, authen => 0), - id => 'achievement-list', - name => 'achievementlist', - class => 'font-sm' - }); - print $self->hidden_authen_fields(); - - ########## print state data - - print "\n\n"; - - print CGI::hidden(-name => "editMode", -value => $editMode); - print CGI::hidden(-name => "exportMode", -value => $exportMode); - - print "\n\n"; - - ########## print action forms - - print CGI::p(CGI::b($r->maketext("Any changes made below will be reflected in the achievement for ALL students."))) - if $editMode; - - print CGI::p($r->maketext("Select an action to perform") . ":"); - - my @formsToShow; - if ($editMode) { - @formsToShow = @{ EDIT_FORMS() }; - } elsif ($exportMode) { - @formsToShow = @{ EXPORT_FORMS() }; - } else { - @formsToShow = @{ VIEW_FORMS() }; - } - my %formTitles = %{ FORM_TITLES() }; - - my @tabArr; - my @contentArr; - - for my $actionID (@formsToShow) { - my $actionForm = "${actionID}_form"; - - push( - @tabArr, - CGI::li( - { class => 'nav-item', role => 'presentation' }, - CGI::a( - { - href => "#$actionID", - class => 'nav-link action-link' . ($actionID eq $formsToShow[0] ? ' active' : ''), - id => "$actionID-tab", - data_action => $actionID, - data_bs_toggle => 'tab', - data_bs_target => "#$actionID", - role => 'tab', - aria_controls => $actionID, - aria_selected => $actionID eq $formsToShow[0] ? 'true' : 'false' - }, - $r->maketext($formTitles{$actionID}) - ) - ) - ); - push( - @contentArr, - CGI::div( - { - class => 'tab-pane fade mb-2' . ($actionID eq $formsToShow[0] ? ' show active' : ''), - id => $actionID, - role => 'tabpanel', - aria_labelledby => "$actionID-tab" - }, - $self->$actionForm($self->getActionParams($actionID)) - ) - ); + $self->addgoodmessage($r->maketext('Please select action to be performed.')); } - print CGI::hidden(-name => 'action', -id => 'current_action', -value => $formsToShow[0]); - print CGI::div(CGI::ul({ class => 'nav nav-tabs mb-2', role => 'tablist' }, @tabArr), - CGI::div({ class => 'tab-content' }, @contentArr)); + $r->stash->{formsToShow} = $self->{editMode} ? EDIT_FORMS() : $self->{exportMode} ? EXPORT_FORMS() : VIEW_FORMS(); - print CGI::submit({ - id => "take_action", - value => $r->maketext("Take Action!"), - class => 'btn btn-primary mb-3' - }); + # Get and sort achievements. Achievements are sorted by in the order they are evaluated. + $r->stash->{achievements} = [ sortAchievements($r->db->getAchievements(@{ $self->{allAchievementIDs} })) ]; - ########## print table - - $self->printTableHTML( - \@Achievements, - editMode => $editMode, - exportMode => $exportMode, - selectedAchievementIDs => \@selectedAchievementIDs, - ); - - ########## print end of form - - print CGI::end_form(); - - return ""; -} - -################################################################################ -# extract particular params and put them in a hash (values are ARRAYREFs!) -################################################################################ - -sub getActionParams { - my ($self, $actionID) = @_; - my $r = $self->{r}; - - my %actionParams; - foreach my $param ($r->param) { - next unless $param =~ m/^action\.$actionID\./; - $actionParams{$param} = [ $r->param($param) ]; - } - return %actionParams; + return; } -sub getTableParams { - my ($self) = @_; - my $r = $self->{r}; - - my %tableParams; - foreach my $param ($r->param) { - next unless $param =~ m/^(?:achievement)\./; - $tableParams{$param} = [ $r->param($param) ]; - } - return %tableParams; -} - -################################################################################ -# actions and action triggers -################################################################################ - -# edit, cancelEdit, and saveEdit should stay with the display module and +# Actions handlers. +# The forms for all of the actions are templates. +# edit, cancel_edit, and save_edit should stay with the display module and # not be real "actions". that way, all actions are shown in view mode and no # actions are shown in edit mode. -# Form for editing achievements. -sub edit_form { - my ($self, %actionParams) = @_; - my $r = $self->r; - - return CGI::div( - { class => 'row mb-2' }, - CGI::label( - { for => 'edit_select', class => 'col-form-label col-form-label-sm col-auto' }, - $r->maketext('Edit which achievements?') - ), - CGI::div( - { class => 'col-auto' }, - CGI::popup_menu({ - name => 'action.edit.scope', - id => 'edit_select', - values => [qw(all selected)], - default => $actionParams{'action.edit.scope'}[0] || 'selected', - class => 'form-select form-select-sm', - labels => { - all => $r->maketext('all achievements'), - selected => $r->maketext('selected achievements'), - }, - }) - ) - ); -} - -#handler for editing achievements. Just changes the view mode +# Handler for editing achievements. Just changes the view mode. sub edit_handler { - my ($self, $genericParams, $actionParams, $tableParams) = @_; + my ($self) = @_; my $r = $self->r; my $result; - my $scope = $actionParams->{"action.edit.scope"}->[0]; + my $scope = $r->param('action.edit.scope'); if ($scope eq "all") { $self->{selectedAchievementIDs} = $self->{allAchievementIDs}; $result = $r->maketext("editing all achievements"); @@ -470,70 +162,19 @@ sub edit_handler { } $self->{editMode} = 1; - return CGI::div({ class => 'alert alert-success p-1 mb-0' }, $result); + return $r->tag('div', class => 'alert alert-success p-1 mb-0', $result); } -# Form for assigning achievements to users. -sub assign_form { - my ($self, %actionParams) = @_; - my $r = $self->r; - - return CGI::div( - CGI::div( - { class => 'row mb-2' }, - CGI::label( - { for => 'assign_select', class => 'col-form-label col-form-label-sm col-sm-auto' }, - $r->maketext('Assign which achievements?',) - ), - CGI::div( - { class => 'col-auto' }, - CGI::popup_menu({ - name => 'action.assign.scope', - id => 'assign_select', - values => [qw(all selected)], - default => $actionParams{'action.assign.scope'}[0] || 'selected', - class => 'form-select form-select-sm', - labels => { - all => $r->maketext('all achievements'), - selected => $r->maketext('selected achievements'), - }, - }) - ) - ), - CGI::div( - { class => 'row mb-2' }, - CGI::label( - { for => 'assign_data_select', class => 'col-form-label col-form-label-sm col-sm-auto' }, - $r->maketext('Choose what to do with existing data:') - ), - CGI::div( - { class => 'col-auto' }, - CGI::popup_menu({ - name => 'action.assign.overwrite', - id => 'assign_data_select', - values => [qw(everything new_only)], - default => $actionParams{'action.assign.overwrite'}[0] || 'new_only', - class => 'form-select form-select-sm', - labels => { - everything => $r->maketext('overwrite'), - new_only => $r->maketext('preserve'), - }, - }) - ) - ) - ); -} - -#handler for assigning achievements to users +# Handler for assigning achievements to users sub assign_handler { - my ($self, $genericParams, $actionParams, $tableParams) = @_; + my ($self) = @_; my $r = $self->r; my $db = $r->db; my $ce = $r->ce; - my $scope = $actionParams->{"action.assign.scope"}->[0]; - my $overwrite = (($actionParams->{"action.assign.overwrite"}->[0] eq 'everything') ? 1 : 0); + my $scope = $r->param('action.assign.scope'); + my $overwrite = $r->param('action.assign.overwrite') eq 'everything'; my @achievementIDs; my @users = $db->listUsers; @@ -544,17 +185,17 @@ sub assign_handler { @achievementIDs = @{ $self->{selectedAchievementIDs} }; } - #Enable all achievements + # Enable all achievements my @achievements = $db->getAchievements(@achievementIDs); - foreach my $achievement (@achievements) { + for my $achievement (@achievements) { $achievement->enabled(1); $db->putAchievement($achievement); } - #Assign globalUserAchievement data, overwriting if necc + # Assign globalUserAchievement data, overwriting if necc - foreach my $user (@users) { + for my $user (@users) { if (not $db->existsGlobalUserAchievement($user)) { my $globalUserAchievement = $db->newGlobalUserAchievement(); $globalUserAchievement->user_id($user); @@ -566,10 +207,10 @@ sub assign_handler { } } - #Assign userAchievement data, overwriting if necc + # Assign userAchievement data, overwriting if necc - foreach my $achievementID (@achievementIDs) { - foreach my $user (@users) { + for my $achievementID (@achievementIDs) { + for my $user (@users) { if (not $db->existsUserAchievement($user, $achievementID)) { my $userAchievement = $db->newUserAchievement(); $userAchievement->user_id($user); @@ -584,41 +225,12 @@ sub assign_handler { } } - return CGI::div({ class => 'alert alert-success p-1 mb-0' }, $r->maketext('Assigned achievements to users')); + return $r->tag('div', class => 'alert alert-success p-1 mb-0', $r->maketext('Assigned achievements to users')); } -# Form for scoring achievements. -sub score_form { - my ($self, %actionParams) = @_; - my $r = $self->r; - - return CGI::div( - { class => 'row mb-2' }, - CGI::label( - { for => 'score_select', class => 'col-form-label col-form-label-sm col-auto' }, - $r->maketext('Score which achievements?') - ), - CGI::div( - { class => 'col-auto' }, - CGI::popup_menu({ - name => 'action.score.scope', - id => 'score_select', - values => [qw(none all selected)], - default => $actionParams{'action.score.scope'}[0] || 'none', - class => 'form-select form-select-sm d-inline w-auto', - labels => { - none => $r->maketext('no achievements'), - all => $r->maketext('all achievements'), - selected => $r->maketext('selected achievements'), - }, - }) - ), - ); -} - -#handler for scoring +# Handler for scoring sub score_handler { - my ($self, $genericParams, $actionParams, $tableParams) = @_; + my ($self) = @_; my $r = $self->r; my $ce = $r->ce; @@ -626,7 +238,7 @@ sub score_handler { my $urlpath = $r->urlpath; my $courseName = $urlpath->arg("courseID"); - my $scope = $actionParams->{"action.score.scope"}->[0]; + my $scope = $r->param('action.score.scope'); my @achievementsToScore; if ($scope eq "none") { @@ -634,44 +246,46 @@ sub score_handler { } elsif ($scope eq "all") { @achievementsToScore = @{ $self->{allAchievementIDs} }; } elsif ($scope eq "selected") { - @achievementsToScore = @{ $genericParams->{selected_achievements} }; + @achievementsToScore = $r->param('selected_achievements'); } - #define file name + # Define file name my $scoreFileName = $courseName . "_achievement_scores.csv"; my $scoreFilePath = $ce->{courseDirs}->{scoring} . '/' . $scoreFileName; - # back up existing file + # Back up existing file if (-e $scoreFilePath) { rename($scoreFilePath, "$scoreFilePath.bak") or warn "Existing file $scoreFilePath could not be backed up and was lost."; } - # check path and open the file + # Check path and open the file $scoreFilePath = WeBWorK::Utils::surePathToFile($ce->{courseDirs}->{scoring}, $scoreFilePath); - local *SCORE; - open SCORE, ">$scoreFilePath" - or return CGI::div({ class => 'alert alert-danger p-1 mb-0' }, - $r->maketext("Failed to open [_1]", $scoreFilePath)); + my $SCORE = Mojo::File->new($scoreFilePath)->open('>:encoding(UTF-8)') + or return $r->tag( + 'div', + class => 'alert alert-danger p-1 mb-0', + $r->maketext("Failed to open [_1]", $scoreFilePath) + ); - #print out header info - print SCORE $r->maketext("username, last name, first name, section, achievement level, achievement score,"); + # Print out header info + print $SCORE $r->maketext("username, last name, first name, section, achievement level, achievement score,"); my @achievements = $db->getAchievements(@achievementsToScore); @achievements = sortAchievements(@achievements); - foreach my $achievement (@achievements) { - print SCORE $achievement->achievement_id . ", "; + for my $achievement (@achievements) { + print $SCORE $achievement->achievement_id . ", "; } - print SCORE "\n"; + print $SCORE "\n"; my @users = $db->listUsers; - # get user records + # Get user records my @userRecords = (); - foreach my $currentUser (@users) { - my $userObj = $db->getUser($currentUser); #checked + for my $currentUser (@users) { + my $userObj = $db->getUser($currentUser); die "Unable to find user object for $currentUser. " unless $userObj; push(@userRecords, $userObj); } @@ -679,87 +293,62 @@ sub score_handler { @userRecords = sort { (lc($a->section) cmp lc($b->section)) || (lc($a->last_name) cmp lc($b->last_name)) } @userRecords; - #print out achievement information for each user - foreach my $userRecord (@userRecords) { + # Print out achievement information for each user + for my $userRecord (@userRecords) { my $user_id = $userRecord->user_id; next unless $db->existsGlobalUserAchievement($user_id); next if ($userRecord->{status} eq 'D' || $userRecord->{status} eq 'A'); - print SCORE "$user_id, $userRecord->{last_name}, $userRecord->{first_name}, $userRecord->{section}, "; + print $SCORE "$user_id, $userRecord->{last_name}, $userRecord->{first_name}, $userRecord->{section}, "; my $globalUserAchievement = $db->getGlobalUserAchievement($user_id); my $level_id = $globalUserAchievement->level_achievement_id; $level_id = ' ' unless $level_id; my $points = $globalUserAchievement->achievement_points; $points = 0 unless $points; - print SCORE "$level_id, $points, "; + print $SCORE "$level_id, $points, "; - foreach my $achievement (@achievements) { + for my $achievement (@achievements) { my $achievement_id = $achievement->achievement_id; if ($db->existsUserAchievement($user_id, $achievement_id)) { my $userAchievement = $db->getUserAchievement($user_id, $achievement_id); - print SCORE $userAchievement->earned ? "1, " : "0, "; + print $SCORE $userAchievement->earned ? "1, " : "0, "; } else { - print SCORE ", "; + print $SCORE ", "; } } - print SCORE "\n"; + print $SCORE "\n"; } - close SCORE; + $SCORE->close; # Include a download link - # - my $fileManagerPage = - $urlpath->newFromModule("WeBWorK::ContentGenerator::Instructor::FileManager", $r, courseID => $courseName); - my $fileManagerURL = $self->systemLink($fileManagerPage, - params => { action => "View", files => "${courseName}_achievement_scores.csv", pwd => "scoring" }); - - return CGI::div({ class => 'alert alert-success p-1 mb-0' }, - $r->maketext('Achievement scores saved to [_1]', CGI::a({ href => $fileManagerURL }, $scoreFileName))); -} - -# Form for deleting achievements. -sub delete_form { - my ($self, %actionParams) = @_; - my $r = $self->r; - - return CGI::div( - CGI::div( - { class => 'd-inline-block alert alert-danger p-1 mb-2' }, - CGI::em($r->maketext('Deletion destroys all achievement-related data and is not undoable!')) - ), - CGI::div( - { class => 'row mb-2' }, - CGI::label( - { for => 'delete_select', class => 'col-form-label col-form-label-sm col-auto' }, - $r->maketext('Delete which achievements?') - ), - CGI::div( - { class => 'col-auto' }, - CGI::popup_menu({ - name => 'action.delete.scope', - id => 'delete_select', - values => [qw(none selected)], - default => $actionParams{'action.delete.scope'}[0] || 'none', - class => 'form-select form-select-sm d-inline w-auto me-3', - labels => { - none => $r->maketext('no achievements.'), - selected => $r->maketext('selected achievements.'), - }, - }) + return $r->tag( + 'div', + class => 'alert alert-success p-1 mb-0', + $r->b($r->maketext( + 'Achievement scores saved to [_1]', + $r->link_to( + $scoreFileName => $self->systemLink( + $urlpath->newFromModule( + "WeBWorK::ContentGenerator::Instructor::FileManager", + $r, courseID => $courseName + ), + params => + { action => "View", files => "${courseName}_achievement_scores.csv", pwd => "scoring" } + ) ) - ) + )) ); } -#handler for delete action +# Handler for delete action sub delete_handler { - my ($self, $genericParams, $actionParams, $tableParams) = @_; + my ($self) = @_; my $r = $self->r; my $db = $r->db; - my $scope = $actionParams->{"action.delete.scope"}->[0]; + my $scope = $r->param('action.delete.scope'); my @achievementIDsToDelete = (); @@ -770,213 +359,128 @@ sub delete_handler { my %allAchievementIDs = map { $_ => 1 } @{ $self->{allAchievementIDs} }; my %selectedAchievementIDs = map { $_ => 1 } @{ $self->{selectedAchievementIDs} }; - #run through selected achievements and delete - foreach my $achievementID (@achievementIDsToDelete) { + # Iterate over selected achievements and delete. + for my $achievementID (@achievementIDsToDelete) { delete $allAchievementIDs{$achievementID}; delete $selectedAchievementIDs{$achievementID}; $db->deleteAchievement($achievementID); } - #update local fields + # Update local fields $self->{allAchievementIDs} = [ keys %allAchievementIDs ]; $self->{selectedAchievementIDs} = [ keys %selectedAchievementIDs ]; my $num = @achievementIDsToDelete; - return CGI::div({ class => 'alert alert-success p-1 mb-0' }, $r->maketext('Deleted [quant,_1,achievement]', $num)); -} - -# Form for creating achievements. -sub create_form { - my ($self, %actionParams) = @_; - - my $r = $self->r; - - return CGI::div( - CGI::div( - { class => 'row mb-2' }, - CGI::label( - { for => 'create_text', class => 'col-form-label col-form-label-sm col-auto' }, - $r->maketext('Create a new achievement with ID') - . CGI::span({ class => 'required-field' }, '*') . ': ' - ), - CGI::div( - { class => 'col-auto' }, - CGI::textfield({ - name => 'action.create.id', - id => 'create_text', - value => $actionParams{'action.create.name'}[0] || '', - class => 'form-control form-control-sm d-inline w-auto' - }) - ) - ), - CGI::div( - { class => 'row mb-2' }, - CGI::label( - { for => 'create_select', class => 'col-form-label col-form-label-sm col-auto' }, - $r->maketext("Create as what type of achievement?") - ), - CGI::div( - { class => 'col-auto' }, - CGI::popup_menu({ - name => 'action.create.type', - id => 'create_select', - values => [qw(empty copy)], - default => $actionParams{'action.create.type'}[0] || 'empty', - class => 'form-select form-select-sm d-inline w-auto', - labels => { - empty => $r->maketext('a new empty achievement.'), - copy => $r->maketext('a duplicate of the first selected achievement.'), - }, - }) - ) - ) + return $r->tag( + 'div', + class => 'alert alert-success p-1 mb-0', + $r->maketext('Deleted [quant,_1,achievement]', $num) ); } -#handler for creating an ahcievement +# Handler for creating an ahcievement sub create_handler { - my ($self, $genericParams, $actionParams, $tableParams) = @_; + my ($self) = @_; my $r = $self->r; my $db = $r->db; my $ce = $r->ce; my $user = $r->param('user'); - #create achievement - my $newAchievementID = $actionParams->{"action.create.id"}->[0]; - return CGI::div({ class => 'alert alert-danger p-1 mb-0' }, - $r->maketext("Failed to create new achievement: no achievement ID specified!")) - unless $newAchievementID =~ /\S/; - return CGI::div({ class => 'alert alert-danger p-1 mb-0' }, - $r->maketext("Achievement [_1] exists. No achievement created", $newAchievementID)) - if $db->existsAchievement($newAchievementID); + # Create achievement + my $newAchievementID = $r->param('action.create.id'); + return $r->tag( + 'div', + class => 'alert alert-danger p-1 mb-0', + $r->maketext("Failed to create new achievement: no achievement ID specified!") + ) unless $newAchievementID =~ /\S/; + return $r->tag( + 'div', + class => 'alert alert-danger p-1 mb-0', + $r->maketext("Achievement [_1] exists. No achievement created", $newAchievementID) + ) if $db->existsAchievement($newAchievementID); my $newAchievementRecord = $db->newAchievement; my $oldAchievementID = $self->{selectedAchievementIDs}->[0]; - my $type = $actionParams->{"action.create.type"}->[0]; + my $type = $r->param('action.create.type'); - #either assign empty data or copy over existing data + # Either assign empty data or copy over existing data if ($type eq "empty") { $newAchievementRecord->achievement_id($newAchievementID); $newAchievementRecord->enabled(0); $newAchievementRecord->assignment_type('default'); - $newAchievementRecord->test(BLANK_ACHIEVEMENT()); + $newAchievementRecord->test('blankachievement.at'); $db->addAchievement($newAchievementRecord); } elsif ($type eq "copy") { - return CGI::div({ class => 'alert alert-danger p-1 mb-0' }, - $r->maketext("Failed to duplicate achievement: no achievement selected for duplication!")) - unless $oldAchievementID =~ /\S/; + return $r->tag( + 'div', + class => 'alert alert-danger p-1 mb-0', + $r->maketext("Failed to duplicate achievement: no achievement selected for duplication!") + ) unless $oldAchievementID =~ /\S/; $newAchievementRecord = $db->getAchievement($oldAchievementID); $newAchievementRecord->achievement_id($newAchievementID); $db->addAchievement($newAchievementRecord); } - # assign achievement to current user + # Assign achievement to current user my $userAchievement = $db->newUserAchievement(); $userAchievement->user_id($user); $userAchievement->achievement_id($newAchievementID); $db->addUserAchievement($userAchievement); - #add to local list of achievements + # Add to local list of achievements push @{ $self->{allAchievementIDs} }, $newAchievementID; - return CGI::div({ class => 'alert alert-danger p-1 mb-0' }, - $r->maketext("Failed to create new achievement: [_1]", $@)) - if $@; + return $r->tag( + 'div', + class => 'alert alert-danger p-1 mb-0', + $r->maketext("Failed to create new achievement: [_1]", $@) + ) if $@; - return CGI::div({ class => 'alert alert-success p-1 mb-0' }, - $r->maketext('Successfully created new achievement [_1]', $newAchievementID)); -} - -# Form for importing achievements. -sub import_form { - my ($self, %actionParams) = @_; - - my $r = $self->r; - my $authz = $r->authz; - my $user = $r->param('user'); - - return CGI::div( - CGI::div( - { class => 'row mb-2' }, - CGI::label( - { for => 'import_file_select', class => 'col-form-label col-form-label-sm col-sm-auto' }, - $r->maketext('Import from where?') - ), - CGI::div( - { class => 'col-auto' }, - CGI::popup_menu({ - name => 'action.import.source', - id => 'import_file_select', - values => [ '', $self->getAxpList() ], - labels => { '' => $r->maketext('Select import file') }, - default => $actionParams{'action.import.source'}[0] || '', - class => 'form-select form-select-sm d-inline w-auto' - }) - ) - ), - CGI::div( - { class => 'row mb-2' }, - CGI::label( - { for => 'import_users_select', class => 'col-form-label col-form-label-sm col-sm-auto' }, - $r->maketext('Assign this achievement to which users?') - ), - CGI::div( - { class => 'col-auto' }, - CGI::popup_menu({ - name => 'action.import.assign', - id => 'import_users_select', - value => [qw(none all)], - default => $actionParams{'action.import.assign'}[0] || 'none', - class => 'form-select form-select-sm d-inline w-auto', - labels => { - all => $r->maketext('all current users'), - none => $r->maketext('no users'), - }, - }) - ) - ) + return $r->tag( + 'div', + class => 'alert alert-success p-1 mb-0', + $r->maketext('Successfully created new achievement [_1]', $newAchievementID) ); } -# handler for importing achievements +# Handler for importing achievements sub import_handler { - my ($self, $genericParams, $actionParams, $tableParams) = @_; - my $r = $self->r; - my $ce = $r->ce; - my $db = $r->db; + my ($self) = @_; + my $r = $self->r; + my $ce = $r->ce; + my $db = $r->db; - my $fileName = $actionParams->{"action.import.source"}->[0]; - my $assign = $actionParams->{"action.import.assign"}->[0]; + my $fileName = $r->param('action.import.source'); + my $assign = $r->param('action.import.assign'); my @users = $db->listUsers; my %allAchievementIDs = map { $_ => 1 } @{ $self->{allAchievementIDs} }; my $filePath = $ce->{courseDirs}->{achievements} . '/' . $fileName; - #open file name - my $fh; - open $fh, "$filePath" - or return CGI::div({ class => 'alert alert-danger p-1 mb-0' }, $r->maketext("Failed to open [_1]", $filePath)); + # Open file name + my $fh = Mojo::File->new($filePath)->open('<:encoding(UTF-8)') + or + return $r->tag('div', class => 'alert alert-danger p-1 mb-0', $r->maketext("Failed to open [_1]", $filePath)); - #read in lines from file + # Read in lines from file my $count = 0; my $csv = Text::CSV->new(); while (my $data = $csv->getline($fh)) { my $achievement_id = $$data[0]; - #skip achievements that already exist + # Skip achievements that already exist next if $db->existsAchievement($achievement_id); - #write achievement data. The "format" for this isn't written down anywhere (!) + # Write achievement data. The "format" for this isn't written down anywhere (!) my $achievement = $db->newAchievement(); $achievement->achievement_id($achievement_id); - # fall back for importing an old list without the number - # or assignment_type fields + # Fall back for importing an old list without the number or assignment_type fields if (scalar(@$data) == 9) { - # old lists tend to have an extraneous space at the front. + # Old lists tend to have an extraneous space at the front. for (my $i = 1; $i <= 7; $i++) { $$data[$i] =~ s/^\s+//; } @@ -1006,14 +510,14 @@ sub import_handler { $achievement->enabled($assign eq "all" ? 1 : 0); - #add achievement + # Add achievement $db->addAchievement($achievement); $count++; $allAchievementIDs{$achievement_id} = 1; - #assign to usesrs if necc + # Assign to usesrs if neccessary if ($assign eq "all") { - foreach my $user (@users) { + for my $user (@users) { if (not $db->existsGlobalUserAchievement($user)) { my $globalUserAchievement = $db->newGlobalUserAchievement(); $globalUserAchievement->user_id($user); @@ -1027,111 +531,78 @@ sub import_handler { } } - $self->{allAchievementIDs} = [ keys %allAchievementIDs ]; - - return CGI::div({ class => 'alert alert-success p-1 mb-0' }, - $r->maketext('Imported [quant,_1,achievement]', $count)); -} + $fh->close; -# Form for exporting achievements. -sub export_form { - my ($self, %actionParams) = @_; - my $r = $self->r; + $self->{allAchievementIDs} = [ keys %allAchievementIDs ]; - return CGI::div( - { class => 'row mb-2' }, - CGI::label( - { for => 'export_select', class => 'col-form-label col-form-label-sm col-auto' }, - $r->maketext('Export which achievements?') - ), - CGI::div( - { class => 'col-auto' }, - CGI::popup_menu({ - name => 'action.export.scope', - id => 'export_select', - values => [qw(all selected)], - default => $actionParams{'action.export.scope'}[0] || 'selected', - class => 'form-select form-select-sm d-inline w-auto', - labels => { - all => $r->maketext('all achievements'), - selected => $r->maketext('selected achievements'), - }, - }) - ), + return $r->tag( + 'div', + class => 'alert alert-success p-1 mb-0', + $r->maketext('Imported [quant,_1,achievement]', $count) ); } -# export handler -# this does not actually export any files, rather it sends us to a new page in order to export the files +# Export handler +# This does not actually export any files, rather it sends us to a new page in order to export the files. sub export_handler { - my ($self, $genericParams, $actionParams, $tableParams) = @_; + my ($self) = @_; my $r = $self->r; my $result; - my $scope = $actionParams->{"action.export.scope"}->[0]; + my $scope = $r->param('action.export.scope'); if ($scope eq "all") { $result = $r->maketext("exporting all achievements"); $self->{selectedAchievementIDs} = $self->{allAchievementIDs}; } elsif ($scope eq "selected") { $result = $r->maketext("exporting selected achievements"); - $self->{selectedAchievementIDs} = $genericParams->{selected_achievements}; # an arrayref + $self->{selectedAchievementIDs} = [ $r->param('selected_achievements') ]; } $self->{exportMode} = 1; - return CGI::div({ class => 'alert alert-success p-1 mb-0' }, $result); + return $r->tag('div', class => 'alert alert-success p-1 mb-0', $result); } -# Form and handler for leaving the export page. -sub cancelExport_form { - my ($self, %actionParams) = @_; - return CGI::span($self->r->maketext('Abandon export')); -} - -sub cancelExport_handler { - my ($self, $genericParams, $actionParams, $tableParams) = @_; +# Handler for leaving the export page. +sub cancel_export_handler { + my ($self) = @_; my $r = $self->r; $self->{exportMode} = 0; - return CGI::div({ class => 'alert alert-danger p-1 mb-0' }, $r->maketext('export abandoned')); + return $r->tag('div', class => 'alert alert-danger p-1 mb-0', $r->maketext('export abandoned')); } -# Handler and form for actually exporting achievements. -sub saveExport_form { - my ($self, %actionParams) = @_; - return CGI::span($self->r->maketext('Export selected achievements.')); -} - -sub saveExport_handler { - my ($self, $genericParams, $actionParams, $tableParams) = @_; +# Handler actually exporting achievements. +sub save_export_handler { + my ($self) = @_; my $r = $self->r; my $ce = $r->ce; my $db = $r->db; my $urlpath = $r->urlpath; - my $courseName = $urlpath->arg("courseID"); + my $courseName = $urlpath->arg('courseID'); - my @achievementIDsToExport = $r->param("selected_export"); + my @achievementIDsToExport = @{ $self->{selectedAchievementIDs} }; - #get file path - my $FileName = $courseName . "_achievements.axp"; - my $FilePath = $ce->{courseDirs}->{achievements} . '/' . $FileName; + # Get file path + my $FileName = "${courseName}_achievements.axp"; + my $FilePath = "$ce->{courseDirs}{achievements}/$FileName"; - # back up existing file + # Back up existing file if (-e $FilePath) { rename($FilePath, "$FilePath.bak") or warn "Existing file $FilePath could not be backed up and was lost."; } - $FilePath = WeBWorK::Utils::surePathToFile($ce->{courseDirs}->{achievements}, $FilePath); - #open file - my $fh; - open $fh, ">$FilePath" - or return CGI::div({ class => 'alert alert-danger p-1 mb-0' }, $r->maketext("Failed to open [_1]", $FilePath)); + $FilePath = WeBWorK::Utils::surePathToFile($ce->{courseDirs}{achievements}, $FilePath); + + my $fh = Mojo::File->new($FilePath)->open('>:encoding(UTF-8)') + or + return $r->tag('div', class => 'alert alert-danger p-1 mb-0', $r->maketext('Failed to open [_1]', $FilePath)); - my $csv = Text::CSV->new({ eol => "\n" }); - my @achievements = $db->getAchievements(@achievementIDsToExport); - #run through achievements outputing data as csv list. This format is not documented anywhere - foreach my $achievement (@achievements) { + my $csv = Text::CSV->new({ eol => "\n" }); + + # Iterate over achievements outputing data as csv list. This format is not documented anywhere. + for my $achievement ($db->getAchievements(@achievementIDsToExport)) { my $line = [ $achievement->achievement_id, $achievement->name, $achievement->number, $achievement->category, $achievement->assignment_type, $achievement->description, @@ -1139,71 +610,56 @@ sub saveExport_handler { $achievement->icon, ]; - warn("Error Exporting Achievement " . $achievement->achievement_id) + warn('Error Exporting Achievement ' . $achievement->achievement_id) unless $csv->print($fh, $line); } - close EXPORT; + $fh->close; $self->{exportMode} = 0; - return CGI::div({ class => 'alert alert-success p-1 mb-0' }, - $r->maketext('Exported achievements to [_1]', $FileName)); -} - -# Form and handler for cancelling edits. -sub cancelEdit_form { - my ($self, %actionParams) = @_; - return CGI::span($self->r->maketext('Abandon changes')); + return $r->tag( + 'div', + class => 'alert alert-success p-1 mb-0', + $r->maketext('Exported achievements to [_1]', $FileName) + ); } -sub cancelEdit_handler { - my ($self, $genericParams, $actionParams, $tableParams) = @_; +# Handler for cancelling edits. +sub cancel_edit_handler { + my ($self) = @_; my $r = $self->r; $self->{editMode} = 0; - return CGI::div({ class => 'alert alert-danger p-1 mb-0' }, $r->maketext('changes abandoned')); -} - -# Form and handler for saving edits. -sub saveEdit_form { - my ($self, %actionParams) = @_; - return CGI::span($self->r->maketext('Save changes')); + return $r->tag('div', class => 'alert alert-danger p-1 mb-0', $r->maketext('changes abandoned')); } -sub saveEdit_handler { - my ($self, $genericParams, $actionParams, $tableParams) = @_; - my $r = $self->r; - my $db = $r->db; +# Handler for saving edits. +sub save_edit_handler { + my ($self) = @_; + my $r = $self->r; + my $db = $r->db; my @selectedAchievementIDs = @{ $self->{selectedAchievementIDs} }; - #run through selected achievements - foreach my $achievementID (@selectedAchievementIDs) { - my $Achievement = $db->getAchievement($achievementID); # checked - # FIXME: we may not want to die on bad sets, they're not as bad as bad users + for my $achievementID (@selectedAchievementIDs) { + my $Achievement = $db->getAchievement($achievementID); + + # FIXME: we may not want to die on bad achievements, they're not as bad as bad users die "record for achievement $achievementID not found" unless $Achievement; - #update fields - foreach my $field ($Achievement->NONKEYFIELDS()) { + # Update fields + for my $field ($Achievement->NONKEYFIELDS()) { my $param = "achievement.${achievementID}.${field}"; if ($field eq 'assignment_type') { - my @types = (); - my $i = 0; - - while (defined($tableParams->{$param}->[$i])) { - push @types, $tableParams->{$param}->[$i]; - $i++; - } - + my @types = $r->param($param); $Achievement->assignment_type(join(',', @types)); - } else { - if (defined $tableParams->{$param}->[0]) { - $Achievement->$field($tableParams->{$param}->[0]); + if (defined $r->param($param)) { + $Achievement->$field($r->param($param)); } } } @@ -1213,324 +669,10 @@ sub saveEdit_handler { $self->{editMode} = 0; - return CGI::div({ class => 'alert alert-success p-1 mb-0' }, $r->maketext('changes saved')); -} - -################################################################################ -# "display" methods -################################################################################ - -#write out a particular field -sub fieldEditHTML { - my ($self, $fieldName, $value, $properties) = @_; - my $size = $properties->{size}; - my $type = $properties->{type}; - my $access = $properties->{access}; - my $items = $properties->{items}; - my $synonyms = $properties->{synonyms}; - my $headerFiles = $self->{headerFiles}; - - return $value if ($access eq 'readonly'); - - if ($type eq 'number' || $type eq 'text') { - return CGI::input({ - type => 'text', - name => $fieldName, - aria_labelledby => ($fieldName =~ s/^.*\.([^.]*)$/$1/r) . '_header', - value => $value, - size => $size, - class => 'form-control form-control-sm' - }); - } - - if ($type eq 'checked') { - # If the checkbox is checked it returns a 1, if it is unchecked it returns nothing - # in which case the hidden field overrides the parameter with a 0. - return CGI::input({ - type => 'checkbox', - name => $fieldName, - aria_labelledby => ($fieldName =~ s/^.*\.([^.]*)$/$1/r) . '_header', - value => 1, - class => 'form-check-input', - $value ? (checked => undef) : (), - }) - . CGI::hidden({ - name => $fieldName, - value => 0 - }); - } - - if ($type eq 'assignment_type') { - my @allowedTypes = split(',', $value); - - return CGI::checkbox_group({ - name => $fieldName, - aria_labelledby => ($fieldName =~ s/^.*\.([^.]*)$/$1/r) . '_header', - values => ASSIGNMENT_TYPES, - labels => ASSIGNMENT_NAMES, - default => \@allowedTypes, - class => 'form-check-input me-1', - labelattributes => { class => 'form-check-label me-1' } - }); - } + return $r->tag('div', class => 'alert alert-success p-1 mb-0', $r->maketext('changes saved')); } -#write out a row of the table -sub recordEditHTML { - my ($self, $Achievement, %options) = @_; - my $r = $self->r; - my $urlpath = $r->urlpath; - my $ce = $r->ce; - my $db = $r->db; - my $authz = $r->authz; - my $user = $r->param('user'); - my $root = $ce->{webworkURLs}->{root}; - my $courseName = $urlpath->arg("courseID"); - - my $editMode = $options{editMode}; - my $exportMode = $options{exportMode}; - my $achievementSelected = $options{achievementSelected}; - - my $users = $db->countAchievementUsers($Achievement->achievement_id); - my $totalUsers = $self->{totalUsers}; - - my @tableCells; - my $achievement_id = $Achievement->achievement_id; - my $editorPage = $urlpath->newFromModule( - "WeBWorK::ContentGenerator::Instructor::AchievementEditor", $r, - courseID => $courseName, - achievementID => $achievement_id - ); - my $editorURL = $self->systemLink( - $editorPage, - params => { - sourceFilePath => $ce->{courseDirs}->{achievements} . "/" . $Achievement->test - } - ); - - my $userEditorPage = $urlpath->newFromModule( - "WeBWorK::ContentGenerator::Instructor::AchievementUserEditor", $r, - courseID => $courseName, - achievementID => $achievement_id - ); - my $userEditorURL = $self->systemLink($userEditorPage, params => {}); - - # The formats are "hard coded" below. Making them more modular would be good. - if ($exportMode) { - # Format for export row - # Select all checkbox - push @tableCells, - CGI::input({ - type => 'checkbox', - name => 'selected_export', - value => $achievement_id, - id => "${achievement_id}_id", - class => 'form-check-input', - $achievementSelected ? (checked => undef) : (), - }); - - my @fields = ('achievement_id', 'name'); - - for my $field (@fields) { - my $fieldName = 'achievement.' . $achievement_id . '.' . $field; - my $fieldValue = $Achievement->$field; - my %properties = %{ FIELD_PROPERTIES()->{$field} }; - $properties{access} = 'readonly'; - push @tableCells, - $field eq 'achievement_id' - ? CGI::label({ for => "${achievement_id}_id" }, - $self->fieldEditHTML($fieldName, $fieldValue, \%properties)) - : $self->fieldEditHTML($fieldName, $fieldValue, \%properties); - } - } elsif ($editMode) { - # Format for edit mode - return unless $achievementSelected; - - push @tableCells, - CGI::hidden({ name => 'selected_achievements', value => $achievement_id }) - . CGI::img({ - src => "$ce->{courseURLs}{achievements}/" . ($Achievement->{icon} // 'defaulticon.png'), - alt => 'Achievement Icon', - height => 60, - class => 'm-1' - }); - - for ( - [ 'achievement_id', 'name', 'category' ], - [ 'number', 'enabled', 'points', 'max_counter' ], - [ 'description', 'test', 'icon', 'assignment_type' ] - ) - { - my $tableCell = ''; - - for my $field (@$_) { - $tableCell .= CGI::span( - { class => 'text-nowrap', style => 'height:28px' }, - $self->fieldEditHTML( - "achievement.$achievement_id.$field", $Achievement->$field, - \%{ FIELD_PROPERTIES()->{$field} } - ) - ); - } - - push @tableCells, CGI::div({ class => 'd-flex flex-column gap-1' }, $tableCell); - } - } else { - # Format for regular viewing mode - # Select all checkbox - push @tableCells, - CGI::input({ - type => 'checkbox', - name => "selected_achievements", - value => $achievement_id, - id => "${achievement_id}_id", - class => 'form-check-input', - $achievementSelected ? (checked => undef) : (), - }); - - for my $field (@{ VIEW_FIELD_ORDER() }) { - my $fieldName = "achievement." . $achievement_id . "." . $field; - my $fieldValue = $Achievement->$field; - my %properties = %{ FIELD_PROPERTIES()->{$field} }; - $properties{access} = "readonly"; - $fieldValue =~ s/ / /g; - $fieldValue = ($fieldValue) ? $r->maketext("Yes") : $r->maketext("No") if $field =~ /enabled/; - if ($field =~ /achievement_id/) { - $fieldValue .= " " - . CGI::a( - { - href => $self->systemLink($urlpath->new( - type => 'instructor_achievement_list', - args => { courseID => $courseName } - )) - . "&editMode=1&selected_achievements=" - . $achievement_id - }, - CGI::i({ class => 'icon fas fa-pencil-alt', data_alt => 'edit', aria_hidden => "true" }, '') - ); - $fieldValue = CGI::div({ class => 'label-with-edit-icon' }, - CGI::label({ for => "${achievement_id}_id" }, $fieldValue)); - } - push @tableCells, $self->fieldEditHTML($fieldName, $fieldValue, \%properties); - } - - push @tableCells, CGI::a({ href => $userEditorURL }, "$users/$totalUsers"); - - push @tableCells, CGI::a({ href => $editorURL }, $r->maketext("Edit Evaluator")); - } - - return CGI::Tr(CGI::td(\@tableCells)); -} - -#this prints out the whole table -sub printTableHTML { - my ($self, $AchievementsRef, %options) = @_; - my $r = $self->r; - my $authz = $r->authz; - my $user = $r->param('user'); - my @Achievements = @$AchievementsRef; - - my $editMode = $options{editMode}; - my $exportMode = $options{exportMode}; - my %selectedAchievementIDs = map { $_ => 1 } @{ $options{selectedAchievementIDs} }; - - # names of headings: - - if ($editMode and not %selectedAchievementIDs) { - print CGI::p(CGI::i("No achievements shown. Select an achievement to edit!")); - return; - } - - my @tableHeadings; - - # Hardcoded headings. Making this more modular would be good. - if ($exportMode) { - @tableHeadings = ( - CGI::input({ - type => 'checkbox', - id => 'select-all', - aria_label => $r->maketext('Select all achievements'), - data_select_group => 'selected_export', - class => 'select-all form-check-input' - }), - CGI::label({ for => 'select-all' }, $r->maketext('Achievement ID')), - $r->maketext('Name') - ); - } elsif ($editMode) { - @tableHeadings = ( - $r->maketext('Icon'), - CGI::div( - { class => 'd-flex flex-column' }, - $r->maketext('Achievement ID'), - CGI::span({ id => 'name_header' }, $r->maketext('Name')), - CGI::span({ id => 'category_header' }, $r->maketext('Category')) - ), - CGI::div( - { class => 'd-flex flex-column' }, - CGI::span({ id => 'number_header' }, $r->maketext('Number')), - CGI::span({ id => 'enabled_header' }, $r->maketext('Enabled')), - CGI::span({ id => 'points_header' }, $r->maketext('Points')), - CGI::span({ id => 'max_counter_header' }, $r->maketext('Counter')) - ), - CGI::div( - { class => 'd-flex flex-column' }, - CGI::span({ id => 'description_header' }, $r->maketext('Description')), - CGI::span({ id => 'test_header' }, $r->maketext('Evaluator File')), - CGI::span({ id => 'icon_header' }, $r->maketext('Icon File')), - $r->maketext('Type') - ) - ); - } else { - @tableHeadings = ( - CGI::input({ - type => 'checkbox', - id => 'select-all', - aria_label => $r->maketext('Select all achievements'), - data_select_group => 'selected_achievements', - class => 'select-all form-check-input' - }), - CGI::label({ for => 'select-all' }, $r->maketext('Achievement ID')), - $r->maketext('Enabled'), - $r->maketext('Name'), - $r->maketext('Number'), - $r->maketext('Category'), - $r->maketext('Edit Users'), - $r->maketext('Edit Evaluator') - ); - } - - # print the table - print CGI::start_div({ class => 'table-responsive' }); - print CGI::start_table({ - class => "table table-sm table-bordered font-sm", - id => "achievement-table" - }); - - print CGI::thead(CGI::Tr(CGI::th({ class => 'align-top' }, \@tableHeadings))); - - print CGI::start_tbody(); - for (my $i = 0; $i < @Achievements; $i++) { - my $Achievement = $Achievements[$i]; - - print $self->recordEditHTML( - $Achievement, - editMode => $editMode, - exportMode => $exportMode, - achievementSelected => exists $selectedAchievementIDs{ $Achievement->achievement_id } - ); - } - print CGI::end_tbody(); - - print CGI::end_table(), CGI::end_div(); - ######################################### - # if there are no users shown print message - # - ########################################## - - print CGI::p(CGI::i($r->maketext("No achievements shown. Create an achievement!"))) unless @Achievements; -} - -#get list of files that can be imported. +# Get list of files that can be imported. sub getAxpList { my ($self) = @_; my $ce = $self->{ce}; @@ -1538,21 +680,4 @@ sub getAxpList { return $self->read_dir($dir, qr/.*\.axp/); } -sub output_JS { - my $self = shift; - my $ce = $self->r->ce; - - print CGI::script({ src => getAssetURL($ce, 'js/apps/ShowHide/show_hide.js'), defer => undef }, ''); - print CGI::script({ src => getAssetURL($ce, 'js/apps/ActionTabs/actiontabs.js'), defer => undef }, ''); - print CGI::script({ src => getAssetURL($ce, 'js/apps/SelectAll/selectall.js'), defer => undef }, ''); - - return ''; -} - 1; - -=head1 AUTHOR - -Written by Robert Van Dam, toenail (at) cif.rochester.edu - -=cut diff --git a/lib/WeBWorK/ContentGenerator/Instructor/AchievementUserEditor.pm b/lib/WeBWorK/ContentGenerator/Instructor/AchievementUserEditor.pm index f39bf0a8b8..de47581f4c 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/AchievementUserEditor.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/AchievementUserEditor.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::Instructor::AchievementUserEditor; -use base qw(WeBWorK::ContentGenerator::Instructor); +use parent qw(WeBWorK::ContentGenerator::Instructor); =head1 NAME @@ -25,8 +25,6 @@ users assigned to an achievement. use strict; use warnings; -use CGI qw(-nosticky ); -use WeBWorK::Debug; sub initialize { my ($self) = @_; @@ -34,51 +32,57 @@ sub initialize { my $urlpath = $r->urlpath; my $authz = $r->authz; my $db = $r->db; - my $achievementID = $urlpath->arg("achievementID"); + my $achievementID = $urlpath->arg('achievementID'); my $user = $r->param('user'); + # Make sure this is defined for the template. + $r->stash->{userRecords} = []; + # Check permissions - return unless $authz->hasPermissions($user, "edit_achievements"); + return unless $authz->hasPermissions($user, 'edit_achievements'); - $self->{all_users} = [ $db->listUsers ]; + my @all_users = $db->listUsers; my %selectedUsers = map { $_ => 1 } $r->param('selected'); my $doAssignToSelected = 0; #Check and see if we need to assign or unassign things if (defined $r->param('assignToAll')) { - $self->addmessage(CGI::div( - { class => 'alert alert-success p-1 mb-0' }, - $r->maketext("Achievement has been assigned to all users.") + $self->addmessage($r->tag( + 'p', + class => 'alert alert-success p-1 mb-0', + $r->maketext('Achievement has been assigned to all users.') )); - %selectedUsers = map { $_ => 1 } @{ $self->{all_users} }; + %selectedUsers = map { $_ => 1 } @all_users; $doAssignToSelected = 1; } elsif (defined $r->param('unassignFromAll') && defined($r->param('unassignFromAllSafety')) && $r->param('unassignFromAllSafety') == 1) { %selectedUsers = (); - $self->addmessage(CGI::div( - { class => 'alert alert-danger p-1 mb-0' }, - $r->maketext("Achievement has been unassigned to all students.") + $self->addmessage($r->tag( + 'p', + class => 'alert alert-danger p-1 mb-0', + $r->maketext('Achievement has been unassigned to all students.') )); $doAssignToSelected = 1; } elsif (defined $r->param('assignToSelected')) { - $self->addmessage(CGI::div( - { class => 'alert alert-success p-1 mb-0' }, - $r->maketext("Achievement has been assigned to selected users.") + $self->addmessage($r->tag( + 'p', + class => 'alert alert-success p-1 mb-0', + $r->maketext('Achievement has been assigned to selected users.') )); $doAssignToSelected = 1; - } elsif (defined $r->param("unassignFromAll")) { + } elsif (defined $r->param('unassignFromAll')) { # no action taken - $self->addmessage(CGI::div({ class => 'alert alert-danger p-1 mb-0' }, $r->maketext("No action taken"))); + $self->addmessage($r->tag('p', class => 'alert alert-danger p-1 mb-0', $r->maketext('No action taken'))); } #do actual assignment and unassignment if ($doAssignToSelected) { my %achievementUsers = map { $_ => 1 } $db->listAchievementUsers($achievementID); - foreach my $selectedUser (@{ $self->{all_users} }) { + foreach my $selectedUser (@all_users) { if (exists $selectedUsers{$selectedUser} && $achievementUsers{$selectedUser}) { # update existing user data (in case fields were changed) my $userAchievement = $db->getUserAchievement($selectedUser, $achievementID); @@ -131,167 +135,19 @@ sub initialize { } } } -} - -sub body { - my ($self) = @_; - my $r = $self->r; - my $urlpath = $r->urlpath; - my $db = $r->db; - my $ce = $r->ce; - my $authz = $r->authz; - my $webworkRoot = $ce->{webworkURLs}->{root}; - my $courseName = $urlpath->arg("courseID"); - my $achievementID = $urlpath->arg("achievementID"); - my $user = $r->param('user'); - - return CGI::div({ class => 'alert alert-danger p-1' }, "You are not authorized to edit achievements.") - unless $authz->hasPermissions($user, "edit_achievements"); - print CGI::start_form({ - name => "user-achievement-form", - id => "user-achievement-form", - method => "post", - action => $self->systemLink($urlpath, authen => 0) - }); - - # Assign to everyone message - print CGI::div( - { class => 'my-2' }, - CGI::submit({ - name => "assignToAll", - value => $r->maketext("Assign to All Current Users"), - class => 'btn btn-primary' - }), - CGI::i($r->maketext("This action will not overwrite existing users.")) - ); - - print CGI::div( - { class => 'alert alert-danger p-1 mb-2' }, - CGI::div({ class => 'mb-1' }, $r->maketext('Do not uncheck students, unless you know what you are doing.')), - CGI::div($r->maketext('There is NO undo for unassigning students.')) - ); - print CGI::p($r->maketext( - "When you unassign by unchecking a student's name, you destroy all of the data for achievement [_1] " - . 'for this student. Make sure this is what you want to do.', - CGI::b($achievementID) - )); - - # Print table - print CGI::start_div({ class => 'table-responsive' }), - CGI::start_table({ class => 'table table-sm table-bordered font-sm align-middle w-auto' }); - print CGI::Tr( - CGI::th({ class => 'text-center' }, $r->maketext('Assigned')), - CGI::th($r->maketext('Login Name')), - CGI::th($r->maketext('Student Name')), - CGI::th({ class => 'text-center' }, $r->maketext('Section')), - CGI::th({ class => 'text-center', id => 'earned_header' }, $r->maketext('Earned')), - CGI::th({ class => 'text-center', id => 'counter_header' }, $r->maketext('Counter')) - ); - - # get user records - my @userRecords = (); - for my $currentUser (@{ $self->{all_users} }) { - my $userObj = $db->getUser($currentUser); #checked + my @userRecords; + for my $currentUser (@all_users) { + my $userObj = $r->db->getUser($currentUser); die "Unable to find user object for $currentUser. " unless $userObj; push(@userRecords, $userObj); } @userRecords = sort { (lc($a->section) cmp lc($b->section)) || (lc($a->last_name) cmp lc($b->last_name)) } @userRecords; - #print row for user - for my $userRecord (@userRecords) { - - my $statusClass = $ce->status_abbrev_to_name($userRecord->status) || ''; - - my $user = $userRecord->user_id; - my $userAchievement = $db->getUserAchievement($user, $achievementID); - my $prettyName = $userRecord->last_name . ', ' . $userRecord->first_name; - my $earned = $userAchievement->earned if ref $userAchievement; - my $counter = $userAchievement->counter if ref $userAchievement; - - print CGI::Tr( - CGI::td( - { class => 'text-center' }, - CGI::input({ - type => 'checkbox', - name => 'selected', - id => "$user.assigned", - value => $user, - class => 'form-check-input', - defined $userAchievement ? (checked => undef) : (), - }) - ), - CGI::td(CGI::label({ for => "$user.assigned" }, $user)), - CGI::td($prettyName), - CGI::td({ class => 'text-center' }, $userRecord->section), - ( - defined $userAchievement - ? ( - CGI::td( - { class => 'text-center' }, - CGI::input({ - type => 'checkbox', - name => "$user.earned", - aria_labelledby => 'earned_header', - value => '1', - class => 'form-check-input', - $earned ? (checked => undef) : (), - }) - ), - CGI::td( - { class => 'text-center' }, - CGI::input({ - type => 'text', - name => "$user.counter", - aria_labelledby => 'counter_header', - value => $counter, - size => 6, - class => 'form-control form-control-sm' - }) - ), - ) - : (CGI::td(), CGI::td()) - ) - ); - } - - print CGI::end_table(), CGI::end_div(); - print $self->hidden_authen_fields; - print CGI::submit({ name => "assignToSelected", value => $r->maketext("Save"), class => 'btn btn-primary' }); - - #Print unassign from everyone stuff - print CGI::hr() - . CGI::div( - CGI::div( - { class => 'alert alert-danger p-1 mb-3' }, - $r->maketext( - "There is NO undo for this function. Do not use it unless you know what you are doing! " - . "When you unassign a student using this button, or by unchecking their name, you destroy all " - . "of the data for achievement [_1] for this student.", - $achievementID - ) - ), - CGI::div( - { class => 'd-flex align-items-center' }, - CGI::submit({ - name => "unassignFromAll", - value => $r->maketext("Unassign from All Users"), - class => 'btn btn-primary' - }), - CGI::radio_group({ - name => "unassignFromAllSafety", - values => [ 0, 1 ], - default => 0, - labels => { 0 => $r->maketext('Read only'), 1 => $r->maketext('Allow unassign') }, - class => 'form-check-input mx-1', - labelattributes => { class => 'form-check-label' }, - }), - ) - ) . CGI::hr(); - print CGI::end_form(); + $r->stash->{userRecords} = \@userRecords; - return ""; + return; } 1; diff --git a/lib/WeBWorK/ContentGenerator/Instructor/AddUsers.pm b/lib/WeBWorK/ContentGenerator/Instructor/AddUsers.pm index bd89e0ca38..85a0ec44f8 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/AddUsers.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/AddUsers.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::Instructor::AddUsers; -use base qw(WeBWorK::ContentGenerator::Instructor); +use parent qw(WeBWorK::ContentGenerator::Instructor); =head1 NAME @@ -24,7 +24,7 @@ WeBWorK::ContentGenerator::Instructor::AddUsers - Menu interface for adding user use strict; use warnings; -use WeBWorK::CGI; + use WeBWorK::Utils qw/cryptPassword trim_spaces/; sub initialize { @@ -37,27 +37,24 @@ sub initialize { my $user = $r->param('user'); # Check permissions - return unless ($authz->hasPermissions($user, "access_instructor_tools")); - return unless ($authz->hasPermissions($user, "modify_student_data")); + return unless $authz->hasPermissions($user, 'access_instructor_tools'); + return unless $authz->hasPermissions($user, 'modify_student_data'); + + if (defined $r->param('addStudents')) { + $self->{studentEntryReport} = $r->c; - if (defined($r->param('addStudents'))) { my @userIDs; - my $numberOfStudents = $r->param('number_of_students'); - warn "Internal error -- the number of students to be added has not been included" - unless defined $numberOfStudents; - foreach my $i (1 .. $numberOfStudents) { + my $numberOfStudents = $r->param('number_of_students') // 0; + + # FIXME: Handle errors if user already exists as well as all other errors that could occur (including errors + # when adding the permission, adding the password, and assigning sets to the users). + for my $i (1 .. $numberOfStudents) { my $new_user_id = trim_spaces($r->param("new_user_id_$i")); my $new_password = cryptPassword($r->param("student_id_$i")); - next unless defined($new_user_id) and $new_user_id; - push @userIDs, $new_user_id; + next unless $new_user_id; - my $newUser = $db->newUser; - my $newPermissionLevel = $db->newPermissionLevel; - my $newPassword = $db->newPassword; + my $newUser = $db->newUser; $newUser->user_id($new_user_id); - $newPermissionLevel->user_id($new_user_id); - $newPassword->user_id($new_user_id); - $newPassword->password($new_password); $newUser->last_name(trim_spaces($r->param("last_name_$i"))); $newUser->first_name(trim_spaces($r->param("first_name_$i"))); $newUser->student_id(trim_spaces($r->param("student_id_$i"))); @@ -66,232 +63,47 @@ sub initialize { $newUser->recitation(trim_spaces($r->param("recitation_$i"))); $newUser->comment(trim_spaces($r->param("comment_$i"))); $newUser->status($ce->status_name_to_abbrevs($ce->{default_status})); - $newPermissionLevel->permission(0); - #FIXME handle errors if user exists already + eval { $db->addUser($newUser) }; if ($@) { - my $addError = $@; - $self->{studentEntryReport} .= join("", - CGI::b($r->maketext("Failed to enter student:")), - ' ', - $newUser->last_name, - ", ", - $newUser->first_name, - CGI::b(", " . $r->maketext("login/studentID:")), - ' ', - $newUser->user_id, - "/", - $newUser->student_id, - CGI::b(", " . $r->maketext("email:")), - ' ', - $newUser->email_address, - CGI::b(", " . $r->maketext("section:")), - ' ', - $newUser->section, - CGI::br(), - CGI::b($r->maketext("Error message:")), - ' ', - $addError, - CGI::hr(), - CGI::br(), + push( + @{ $self->{studentEntryReport} }, + $r->include( + 'ContentGenerator/Instructor/AddUsers/student_entry_report', + newUser => $newUser, + addError => $@ + ) ); } else { + push @userIDs, $new_user_id; + + my $newPermissionLevel = $db->newPermissionLevel; + $newPermissionLevel->user_id($new_user_id); + $newPermissionLevel->permission(0); $db->addPermissionLevel($newPermissionLevel); + + my $newPassword = $db->newPassword; + $newPassword->user_id($new_user_id); + $newPassword->password($new_password); $db->addPassword($newPassword); - $self->{studentEntryReport} .= join( - "", - CGI::b($r->maketext("Entered student:")), ' ', $newUser->last_name, ", ", $newUser->first_name, - CGI::b(", ", $r->maketext("login/studentID:")), ' ', $newUser->user_id, "/", - $newUser->student_id, - CGI::b(", ", $r->maketext("email:")), ' ', $newUser->email_address, - CGI::b(", ", $r->maketext("section:")), ' ', $newUser->section, CGI::hr(), CGI::br(), + push( + @{ $self->{studentEntryReport} }, + $r->include( + 'ContentGenerator/Instructor/AddUsers/student_entry_report', + newUser => $newUser, + addError => '' + ) ); } } - if (defined $r->param("assignSets")) { - my @setIDs = $r->param("assignSets"); - if (@setIDs) { - $self->assignSetsToUsers(\@setIDs, \@userIDs); - } + if (defined $r->param('assignSets')) { + my @setIDs = $r->param('assignSets'); + $self->assignSetsToUsers(\@setIDs, \@userIDs); } } -} - -sub body { - my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; - my $db = $r->db; - my $authz = $r->authz; - - my $courseName = $r->urlpath->arg("courseID"); - my $authen_args = $self->url_authen_args(); - my $user = $r->param('user'); - - # Check permissions - return CGI::div({ class => 'alert alert-danger p-1 mb-0' }, - "You are not authorized to access the Instructor tools.") - unless $authz->hasPermissions($user, "access_instructor_tools"); - return CGI::div({ class => 'alert alert-danger p-1 mb-0' }, "You are not authorized to modify student data.") - unless $authz->hasPermissions($user, "modify_student_data"); - - return join( - "", - - CGI::hr(), - CGI::p(defined($self->{studentEntryReport}) ? $self->{studentEntryReport} : ''), - CGI::p( - $r->maketext( - "Enter information below for students you wish to add. Each student's password will initially be set to their student ID." - ) - ), - $self->addStudentForm, - ); -} - -sub addStudentForm { - my $self = shift; - my $r = $self->r; - my $db = $r->db; - my $ce = $r->ce; - my $numberOfStudents = $r->param("number_of_students") || 5; - - # Add a student form - - my @entryLines = (); - foreach my $i (1 .. $numberOfStudents) { - push( - @entryLines, - CGI::Tr(CGI::td([ - CGI::input({ - type => 'text', - class => "last-name-input", - name => "last_name_$i", - size => '10', - class => 'form-control form-control-sm w-auto' - }), - CGI::input({ - type => 'text', - class => "first-name-input", - name => "first_name_$i", - size => '10', - class => 'form-control form-control-sm w-auto' - }), - CGI::input({ - type => 'text', - class => "student-id-input", - name => "student_id_$i", - size => "16", - class => 'form-control form-control-sm w-auto' - }), - CGI::input({ - type => 'text', - class => "user-id-input", - name => "new_user_id_$i", - size => "10", - aria_required => 'true', - class => 'form-control form-control-sm w-auto', - }), - CGI::input({ - type => 'text', - class => "email-input", - name => "email_address_$i", - class => 'form-control form-control-sm w-auto' - }), - CGI::input({ - type => 'text', - class => "section-input", - name => "section_$i", - size => "4", - class => 'form-control form-control-sm w-auto' - }), - CGI::input({ - type => 'text', - class => "recitation-input", - name => "recitation_$i", - size => "4", - class => 'form-control form-control-sm w-auto' - }), - CGI::input({ - type => 'text', - class => "comment-input", - name => "comment_$i", - class => 'form-control form-control-sm w-auto' - }), - ])) - ); - } - - return join( - "", - CGI::start_form({ method => "post", action => $r->uri(), name => "add_users" }), - $self->hidden_authen_fields(), - CGI::div( - { class => 'input-group d-inline-flex w-auto' }, - CGI::submit({ name => "Create", value => $r->maketext("Create"), class => 'btn btn-primary' }), - CGI::textfield({ - name => 'number_of_students', - value => $numberOfStudents, - size => 3, - class => 'form-control' - }), - CGI::span({ class => 'input-group-text' }, $r->maketext("entry rows.")), - ), - CGI::end_form(), - CGI::hr(), - - CGI::start_form({ - method => "post", - action => $r->uri(), - name => "new-users-form", - id => "new-users-form" - }), - $self->hidden_authen_fields(), - CGI::input({ type => 'hidden', name => "number_of_students", value => $numberOfStudents }), - CGI::start_div({ class => 'table-responsive' }), - CGI::start_table({ class => 'table table-sm table-bordered' }), - CGI::Tr(CGI::th([ - $r->maketext('Last Name'), - $r->maketext('First Name'), - $r->maketext('Student ID'), - $r->maketext('Login Name') . CGI::span({ class => "required-field" }, '*'), - $r->maketext('Email Address'), - $r->maketext('Section'), - $r->maketext('Recitation'), - $r->maketext('Comment') - ])), - @entryLines, - CGI::end_table(), - CGI::end_div(), - - CGI::p($r->maketext("Select sets below to assign them to the newly-created users.")), - CGI::scrolling_list({ - name => "assignSets", - values => [ $db->listGlobalSets ], - size => 10, - multiple => "1", - class => 'form-select w-auto mb-2' - }), - CGI::p( - CGI::submit({ - name => "addStudents", - value => $r->maketext("Add Students"), - class => 'btn btn-primary' - }), - ), - CGI::end_form(), - - ); + return; } 1; - -__END__ - -=head1 AUTHOR - -Written by Dennis Lambe Jr., malsyned (at) math.rochester.edu - -=cut diff --git a/lib/WeBWorK/ContentGenerator/Instructor/Assigner.pm b/lib/WeBWorK/ContentGenerator/Instructor/Assigner.pm index 6f2789ec28..8df877a61c 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/Assigner.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/Assigner.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::Instructor::Assigner; -use base qw(WeBWorK::ContentGenerator::Instructor); +use parent qw(WeBWorK::ContentGenerator::Instructor); =head1 NAME @@ -24,9 +24,6 @@ WeBWorK::ContentGenerator::Instructor::Assigner - Assign homework sets to users. use strict; use warnings; -#use CGI qw(-nosticky ); -use WeBWorK::CGI; -use WeBWorK::HTML::ScrollingRecordList qw/scrollingRecordList/; async sub pre_header_initialize { my ($self) = @_; @@ -36,178 +33,69 @@ async sub pre_header_initialize { my $ce = $r->ce; my $user = $r->param('user'); + # Make sure these are defined for the template. + $r->stash->{users} = []; + $r->stash->{globalSets} = []; + # Permissions dealt with in the body - return "" unless $authz->hasPermissions($user, "access_instructor_tools"); - return "" unless $authz->hasPermissions($user, "assign_problem_sets"); + return '' unless $authz->hasPermissions($user, 'access_instructor_tools'); + return '' unless $authz->hasPermissions($user, 'assign_problem_sets'); - my @selected_users = $r->param("selected_users"); - my @selected_sets = $r->param("selected_sets"); + my @selected_users = $r->param('selected_users'); + my @selected_sets = $r->param('selected_sets'); - if (defined $r->param("assign") || defined $r->param("unassign")) { + if (defined $r->param('assign') || defined $r->param('unassign')) { if (@selected_users && @selected_sets) { my @results; # This is not used? - if (defined $r->param("assign")) { + if (defined $r->param('assign')) { $self->assignSetsToUsers(\@selected_sets, \@selected_users); $self->addgoodmessage($r->maketext('All assignments were made successfully.')); } - if (defined $r->param("unassign")) { + if (defined $r->param('unassign')) { if (defined $r->param('unassignFromAllSafety') and $r->param('unassignFromAllSafety') == 1) { - $self->unassignSetsFromUsers(\@selected_sets, \@selected_users) if (defined $r->param("unassign")); + $self->unassignSetsFromUsers(\@selected_sets, \@selected_users) if (defined $r->param('unassign')); $self->addgoodmessage($r->maketext('All unassignments were made successfully.')); } else { # asked for unassign, but no safety radio toggle - $self->addbadmessage( - $r->maketext( - 'Unassignments were not done. You need to both click to "Allow unassign" and click on the Unassign button.' - ) - ); + $self->addbadmessage($r->maketext( + 'Unassignments were not done. ' + . 'You need to select "Allow unassign" and then click on the Unassign button.' + )); } } if (@results) { # Can't get here? - $self->addbadmessage("The following error(s) occured while assigning:" . CGI::ul(CGI::li(\@results))); + $self->addbadmessage( + $r->c('The following error(s) occured while assigning:', + $r->tag('ul', $r->c(map { $r->tag('li', $_) } @results)->join('')))->join('') + ); } } else { - $self->addbadmessage("You must select one or more users below.") + $self->addbadmessage('You must select one or more users below.') unless @selected_users; - $self->addbadmessage("You must select one or more sets below.") + $self->addbadmessage('You must select one or more sets below.') unless @selected_sets; } } -} - -sub body { - my ($self) = @_; - my $r = $self->r; - my $db = $r->db; - my $authz = $r->authz; - my $ce = $r->ce; - - my $user = $r->param('user'); - - # Check permissions - return CGI::div({ class => 'alert alert-danger p-1 mb-0' }, - "You are not authorized to access the Instructor tools.") - unless $authz->hasPermissions($user, "access_instructor_tools"); - - return CGI::div({ class => 'alert alert-danger p-1 mb-0' }, "You are not authorized to assign homework sets.") - unless $authz->hasPermissions($user, "assign_problem_sets"); - - print CGI::p( - $r->maketext( - "Select one or more sets and one or more users below to assign/unassign each selected set to/from all selected users." - ) - ); # Get all users except the set level proctors, and restrict to the sections or recitations that are allowed for the # user if such restrictions are defined. - my @Users = $db->getUsersWhere({ - user_id => { not_like => 'set_id:%' }, - $ce->{viewable_sections}{$user} || $ce->{viewable_recitations}{$user} - ? ( - -or => [ - $ce->{viewable_sections}{$user} ? (section => $ce->{viewable_sections}{$user}) : (), - $ce->{viewable_recitations}{$user} ? (recitation => $ce->{viewable_recitations}{$user}) : () - ] - ) - : () - }); - - my @GlobalSets = $db->getGlobalSetsWhere(); - - print CGI::start_form({ method => 'post', action => $r->uri() }); - print $self->hidden_authen_fields(); - - print CGI::div( - CGI::div( - { class => 'row gx-3' }, - CGI::div( - { class => 'col-xl-5 col-md-6 mb-2' }, - CGI::div( - { class => 'fw-bold text-center' }, - CGI::label({ for => 'selected_users' }, $r->maketext('Users')) - ), - scrollingRecordList( - { - name => 'selected_users', - id => 'selected_users', - request => $r, - default_sort => 'lnfn', - default_format => 'lnfn_uid', - default_filters => ['all'], - attrs => { - size => 20, - multiple => 1 - } - }, - @Users - ) - ), - CGI::div( - { class => 'col-xl-5 col-md-6 mb-2' }, - CGI::div( - { class => 'fw-bold text-center' }, - CGI::label({ for => 'selected_sets' }, $r->maketext('Sets')) - ), - scrollingRecordList( - { - name => 'selected_sets', - id => 'selected_sets', - request => $r, - default_sort => 'set_id', - default_format => 'set_id', - default_filters => ['all'], - attrs => { - size => 20, - multiple => 1, - dir => 'ltr' - } - }, - @GlobalSets + $r->stash->{users} = [ + $db->getUsersWhere({ + user_id => { not_like => 'set_id:%' }, + $ce->{viewable_sections}{$user} || $ce->{viewable_recitations}{$user} + ? ( + -or => [ + $ce->{viewable_sections}{$user} ? (section => $ce->{viewable_sections}{$user}) : (), + $ce->{viewable_recitations}{$user} ? (recitation => $ce->{viewable_recitations}{$user}) : () + ] ) - ) - ), - CGI::div( - CGI::submit({ - name => 'assign', - value => $r->maketext('Assign selected sets to selected users'), - class => 'btn btn-primary mb-2' - }), - CGI::div( - { class => 'alert alert-danger p-1 mb-2' }, - CGI::div( - { class => 'mb-1' }, - $r->maketext('Do not unassign students unless you know what you are doing.') - ), - CGI::div($r->maketext('There is NO undo for unassigning students.')) - ), - CGI::div( - { class => 'd-flex align-items-center' }, - CGI::submit({ - name => "unassign", - value => $r->maketext("Unassign selected sets from selected users"), - class => 'btn btn-primary me-2' - }), - CGI::radio_group({ - name => "unassignFromAllSafety", - values => [ 0, 1 ], - default => 0, - labels => { 0 => $r->maketext('Assignments only'), 1 => $r->maketext('Allow unassign') }, - class => 'form-check-input mx-1', - labelattributes => { class => 'form-check-label' }, - }) - ), - CGI::div( - { class => 'mt-2' }, - "When you unassign a student's name, you destroy all of the data for that homework set for that " - . "student. You will then need to reassign the set(s) to these students and they will receive new " - . "versions of the problems. Make sure this is what you want to do before unassigning students." - ) - ) - ); + : () + }) + ]; - print CGI::end_form(); + $r->stash->{globalSets} = [ $db->getGlobalSetsWhere ]; - return ''; + return; } 1; diff --git a/lib/WeBWorK/ContentGenerator/Instructor/Config.pm b/lib/WeBWorK/ContentGenerator/Instructor/Config.pm index 64464f7cdc..f42e0af2d5 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/Config.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/Config.pm @@ -13,463 +13,8 @@ # Artistic License for more details. ################################################################################ -# TODO -# convert more html to CGI:: calls -# put some formatting in css and in ur.css -# add type to deal with boxes around problem text -# maybe add a type to deal with files like ur.css and templates (where -# a copy of the old file gets created for the course and then the -# user can modify it). - -# The main package starts lower down. First we define different -# types of config objects. - -# Each config object might want to override the methods display_value, -# entry_widget, and save_string - -########################### config object defaults -package configobject; - -use strict; -use warnings; - -use URI::Escape; - -sub new { - my $class = shift; - my $self = shift; - $self->{Module} = shift; - bless $self, $class; - return $self; -} - -# Only input is a value to display, and should produce an html string -sub display_value { - my ($self, $val) = @_; - return $val; -} - -# This should return the value to compare to the new value. This is *not* what is displayed. -sub comparison_value { - my ($self, $val) = @_; - return $val; -} - -sub convert_newval_source { - my ($self, $newvalsource) = @_; - my $inlinevarname = WeBWorK::ContentGenerator::Instructor::Config::inline_var($self->{var}); - my $newval; - if ($newvalsource =~ /widget/) { - $newval = $self->{Module}->{r}->param($newvalsource); - } else { - $newval = $self->comparison_value(eval('$self->{Module}->{r}->ce->' . $inlinevarname)); - } - return ($newval); -} - -# Bit of text to put in the configuration file. The result should -# be an assignment which is executable by perl. oldval will be the -# value of the perl variable, and newval will be whatever an entry -# widget produces -sub save_string { - my ($self, $oldval, $newvalsource) = @_; - my $varname = $self->{var}; - my $newval = $self->convert_newval_source($newvalsource); - my $cmpoldval = $self->comparison_value($oldval); - return '' if ($cmpoldval eq $newval); - return ('$' . $varname . " = '$newval';\n"); -} - -# A widget to interact with the user -sub entry_widget { - my ($self, $name, $default) = @_; - my $width = $self->{width} || 15; - return CGI::textfield({ - name => $name, - id => $name, - value => $default, - size => $width, - class => 'form-control form-control-sm' - }); -} - -# This produces the documentation string and image link to more -# documentation. It is the same for all config types. -sub what_string { - my ($self, $id) = @_; - my $r = $self->{Module}->r; - - return (CGI::td(CGI::div( - { class => 'd-flex justify-content-between align-items-center' }, - CGI::div( - ref $self eq 'configcheckboxlist' - ? $r->maketext($self->{doc}) - : CGI::label({ for => $id }, $r->maketext($self->{doc})) - ), - CGI::a( - { - href => $self->{Module}->systemLink( - $r->urlpath->new( - type => 'instructor_config', - args => { courseID => $r->urlpath->arg("courseID") } - ), - params => { show_long_doc => 1, var_name => uri_escape($self->{var}) } - ), - target => "_blank" - }, - CGI::i({ class => "icon fas fa-question-circle", aria_hidden => "true", data_alt => "help" }, '') - ) - ))); -} - -########################### configtext -package configtext; -@configtext::ISA = qw(configobject); - -sub save_string { - my ($self, $oldval, $newvalsource) = @_; - my $varname = $self->{var}; - my $newval = $self->convert_newval_source($newvalsource); - my $cmpoldval = $self->comparison_value($oldval); - return '' if ($cmpoldval eq $newval); - # Remove quotes from the string, we will have a new type for text with quotes - $newval =~ s/['"`]//g; - return ('$' . $varname . " = '$newval';\n"); -} - -########################### configtimezone -########################### just like text, but it validates the timezone before saving -package configtimezone; -@configtimezone::ISA = qw(configobject); - -#use DateTime; -use DateTime::TimeZone; - -sub save_string { - my ($self, $oldval, $newvalsource) = @_; - my $varname = $self->{var}; - my $newval = $self->convert_newval_source($newvalsource); - my $cmpoldval = $self->comparison_value($oldval); - return '' if ($cmpoldval eq $newval); - if (not DateTime::TimeZone->is_valid_name($newval)) { - $self->{Module} - ->addbadmessage("String '$newval' is not a valid time zone. Reverting to the system default value."); - return ''; - } - # Remove quotes from the string, we will have a new type for text with quotes - $newval =~ s/['"`]//g; #`"'geditsucks - return ('$' . $varname . " = '$newval';\n"); -} - -########################### configtime -########################### just like text, but it validates the time before saving -package configtime; -@configtime::ISA = qw(configobject); - -sub save_string { - my ($self, $oldval, $newvalsource) = @_; - my $varname = $self->{var}; - my $newval = $self->convert_newval_source($newvalsource); - my $cmpoldval = $self->comparison_value($oldval); - return '' if ($cmpoldval eq $newval); - - if ($newval !~ /^(01|1|02|2|03|3|04|4|05|5|06|6|07|7|08|8|09|9|10|11|12):[0-5]\d(am|pm|AM|PM)$/) { - $self->{Module}->addbadmessage("String '$newval' is not a valid time. Reverting to the system default value."); - return ''; - } - - return ('$' . $varname . " = '$newval';\n"); -} - -########################### confignumber -package confignumber; -@confignumber::ISA = qw(configobject); - -sub save_string { - my ($self, $oldval, $newvalsource) = @_; - my $varname = $self->{var}; - my $newval = $self->convert_newval_source($newvalsource); - my $cmpoldval = $self->comparison_value($oldval); - # Remove quotes from the string, we will have a new type for text with quotes - $newval =~ s/['"`]//g; #`"'geditsucks - my $newval2 = eval($newval); - if ($@) { - $self->{Module}->addbadmessage( - "Syntax error in numeric value '$newval' for variable \$$self->{var}. Reverting to the system default value." - ); - return ''; - } - return '' if ($cmpoldval == $newval2); - return ('$' . $varname . " = $newval;\n"); -} - -########################### configboolean -package configboolean; -@configboolean::ISA = qw(configobject); - -sub comparison_value { return $_[1] ? 1 : 0; } - -sub display_value { - my ($self, $val) = @_; - my $r = $self->{Module}->r; - return $r->maketext('True') if $val; - return $r->maketext('False'); -} - -sub save_string { - my ($self, $oldval, $newvalsource) = @_; - my $r = $self->{Module}->r; - my $newval = $self->convert_newval_source($newvalsource); - my $cmpoldval = $self->comparison_value($oldval); - return '' if $cmpoldval eq $newval; - return "\$$self->{var} = $newval;\n"; -} - -sub entry_widget { - my ($self, $name, $default) = @_; - my $r = $self->{Module}->r; - return CGI::popup_menu({ - name => $name, - id => $name, - default => $default, - values => [ 1, 0 ], - labels => { 1 => $r->maketext('True'), 0 => $r->maketext('False') }, - class => 'form-select form-select-sm' - }); -} - -########################### configpermission -package configpermission; -@configpermission::ISA = qw(configobject); - -sub comparison_value { - my ($self, $val) = @_; - return $val // "nobody"; -} - -# This tries to produce a string from a permission number. If you feed it -# a string, that's what you get back. -sub display_value { - my ($self, $val) = @_; - my $r = $self->{Module}->r; - return $r->maketext('nobody') if not defined($val); - my %userRoles = %{ $self->{Module}->{r}->{ce}->{userRoles} }; - my %reverseUserRoles = reverse %userRoles; - return $r->maketext($reverseUserRoles{$val}) if defined($reverseUserRoles{$val}); - return $r->maketext($val); -} - -sub save_string { - my ($self, $oldval, $newvalsource) = @_; - my $newval = $self->convert_newval_source($newvalsource); - my $cmpoldval = $self->comparison_value($oldval); - my $r = $self->{Module}->r; - return '' if ($cmpoldval eq $newval); - return "\$$self->{var} = $newval;\n"; -} - -sub entry_widget { - my ($self, $name, $default) = @_; - my $ce = $self->{Module}->{r}->{ce}; - my $r = $self->{Module}->r; - my $permHash = {}; - my %userRoles = %{ $ce->{userRoles} }; - my %reverseUserRoles = reverse %userRoles; - - # the value of a permission can be undefined (for nobody), - # a standard permission number, or some other number - $default = 'nobody' unless defined($default); - - my @values = sort { $userRoles{$a} <=> $userRoles{$b} } keys %userRoles; - - my %labels = map { $_ => $r->maketext($_) } @values; - return CGI::popup_menu({ - name => $name, - id => $name, - values => \@values, - default => $default, - labels => \%labels, - class => 'form-select form-select-sm' - }); -} - -########################### configlist -package configlist; -@configlist::ISA = qw(configobject); - -sub display_value { - my ($self, $val) = @_; - return ' ' if not defined($val); - my $str = join(',' . CGI::br(), @{$val}); - $str = ' ' if $str !~ /\S/; - return $str; -} - -sub comparison_value { - my ($self, $val) = @_; - $val = [] if not defined($val); - my $str = join(',', @{$val}); - return ($str); -} - -sub save_string { - my ($self, $oldval, $newvalsource) = @_; - my $newval = $self->convert_newval_source($newvalsource); - my $varname = $self->{var}; - $oldval = $self->comparison_value($oldval); - return '' if ($oldval eq $newval); - my $str = ''; - - $oldval =~ s/^\s*(.*)\s*$/$1/; - $newval =~ s/^\s*(.*)\s*$/$1/; - $oldval =~ s/[\s,]+/,/sg; - $newval =~ s/[\s,]+/,/sg; - return '' if ($newval eq $oldval); - # ok we really have a new value, now turn it back into a string - my @parts = split ',', $newval; - map { $_ =~ s/['"`]//g } @parts; #`"'geditsucks - @parts = map { "'" . $_ . "'" } @parts; - $str = join(',', @parts); - $str = '$' . $varname . " = [$str];\n"; - return ($str); -} - -sub entry_widget { - my ($self, $name, $default) = @_; - - $default = [] if not defined($default); - my $str = join(', ', @{$default}); - $str = '' if $str !~ /\S/; - return CGI::textarea({ - name => $name, - id => $name, - rows => 4, - value => $str, - class => 'form-control form-control-sm' - }); -} - -########################### configcheckboxlist -package configcheckboxlist; -@configcheckboxlist::ISA = qw(configobject); - -sub display_value { - my ($self, $val) = @_; - $val = [] if not defined($val); - my @vals = @$val; - return join(CGI::br(), @vals); -} - -# here r->param() returns an array, so we need a custom -# version of convert_newval_source - -sub convert_newval_source { - my ($self, $newvalsource) = @_; - my $inlinevarname = WeBWorK::ContentGenerator::Instructor::Config::inline_var($self->{var}); - my @newvals; - if ($newvalsource =~ /widget/) { - @newvals = $self->{Module}->{r}->param($newvalsource); - } else { - my $newval = eval('$self->{Module}->{r}->{ce}->' . $inlinevarname); - @newvals = @$newval; - } - return (@newvals); -} - -# Bit of text to put in the configuration file. The result should -sub save_string { - my ($self, $oldval, $newvalsource) = @_; - my $varname = $self->{var}; - my @newvals = $self->convert_newval_source($newvalsource); - if ($self->{min} and (scalar(@newvals) < $self->{min})) { - $self->{Module}->addbadmessage("You need to select at least $self->{min} display mode."); - if ($newvalsource =~ /widget/) { - return $self->save_string($oldval, 'current'); # try to return the old saved value - } else { - return ''; # the previous saved value was empty, reset to system default - } - } - $oldval = $self->comparison_value($oldval); - my $newval = $self->comparison_value(\@newvals); - return '' if ($oldval eq $newval); - @newvals = map { "'" . $_ . "'" } @newvals; - my $str = join(',', @newvals); - $str = '$' . $varname . " = [$str];\n"; - return ($str); -} - -sub comparison_value { - my ($self, $val) = @_; - $val = [] if not defined($val); - my $str = join(',', @{$val}); - return ($str); -} - -sub entry_widget { - my ($self, $name, $default) = @_; - my %checked = map { $_ => 1 } @$default; - return join( - "", - map { - CGI::div( - { class => 'form-check' }, - CGI::checkbox({ - name => $name, - value => $_, - label => $_, - checked => $checked{$_}, - class => 'form-check-input', - labelattributes => { class => 'form-check-label' } - }) - ) - } @{ $self->{values} } - ); -} - -########################### configpopuplist -package configpopuplist; -@configpopuplist::ISA = qw(configobject); - -sub display_value { - my ($self, $val) = @_; - my $r = $self->{Module}->r; - $val = 'ur' if not defined($val); - - if ($self->{labels}->{$val}) { - return join(CGI::br(), $r->maketext($self->{labels}->{$val})); - } - - return join(CGI::br(), $val); -} - -sub save_string { - my ($self, $oldval, $newvalsource) = @_; - my $varname = $self->{var}; - my $newval = $self->convert_newval_source($newvalsource); - my $cmpoldval = $self->comparison_value($oldval); - return '' if $cmpoldval eq $newval; - return ('$' . $varname . " = " . "'$newval';\n"); -} - -sub entry_widget { - my ($self, $name, $default) = @_; - my $r = $self->{Module}->r; - my %labels = map { $_ => $r->maketext($self->{labels}->{$_} // $_) } @{ $self->{values} }; - - return CGI::popup_menu({ - name => $name, - id => $name, - values => $self->{values}, - default => $default, - labels => \%labels, - class => 'form-select form-select-sm' - }); -} - -########### Main Config Package starts here - package WeBWorK::ContentGenerator::Instructor::Config; -use base qw(WeBWorK::ContentGenerator::Instructor); +use parent qw(WeBWorK::ContentGenerator::Instructor); =head1 NAME @@ -480,99 +25,94 @@ WeBWorK::ContentGenerator::Instructor::Config - Config use strict; use warnings; -use CGI qw(-nosticky ); use WeBWorK::CourseEnvironment; - -# Load the configuration parts defined in Constants.pm - -#our $ConfigValues = [] unless defined $ConfigValues; +use WeBWorK::ConfigObject::text; +use WeBWorK::ConfigObject::timezone; +use WeBWorK::ConfigObject::time; +use WeBWorK::ConfigObject::number; +use WeBWorK::ConfigObject::boolean; +use WeBWorK::ConfigObject::permission; +use WeBWorK::ConfigObject::list; +use WeBWorK::ConfigObject::checkboxlist; +use WeBWorK::ConfigObject::popuplist; # Configuation data # It is organized by section. The allowable types are -# 'text' for a text string, -# 'list' for a list of text strings, -# 'permission' for a permission value, -# 'boolean' for variables which really hold 0/1 values as flags. - -# write contents to outputFilePath and return error messages if any +# 'Text' for a text string, +# 'Number' for a number, +# 'List' for a list of text strings, +# 'Permission' for a permission value, +# 'Boolean' for variables which really hold 0/1 values as flags, +# 'TimeZone' for a time zone, +# 'Time' for a time, +# 'CheckboxList' for variables that hold a list of values which can be independently picked yes/no as checkboxes, +# 'PopupList' for variables that hold a list of values to be selected from. + +# Write contents to outputFilePath and return error messages if any. sub writeFile { - my $outputFilePath = shift; - my $contents = shift; - my $writeFileErrors; - eval { - local *OUTPUTFILE; - if (open OUTPUTFILE, ">utf8:", $outputFilePath) { - print OUTPUTFILE $contents; - close OUTPUTFILE; - } else { - $writeFileErrors = - "I could not open $outputFilePath" - . CGI::br() - . CGI::br() - . "We will not be able to make configuration changes unless the permissions are set so that the web server can write to this file."; - } - }; # any errors are caught in the next block + my ($outputFilePath, $contents) = @_; + if (open my $OUTPUTFILE, '>:encoding(UTF-8)', $outputFilePath) { + print $OUTPUTFILE $contents; + close $OUTPUTFILE; + } else { + return ( + "I could not open $outputFilePath", + 'We will not be able to make configuration changes unless the permissions ' + . 'are set so that the web server can write to this file.' + ); + } - $writeFileErrors = $@ if $@; - return ($writeFileErrors); + return; } # Make a new config object from data - sub objectify { my ($self, $data) = @_; - return "config$data->{type}"->new($data, $self); -} - -# Take var string from ConfigValues and prepare it for $ce->... -sub inline_var { - my $varstring = shift; - return '{' . $varstring . '}' if $varstring =~ /^\w+$/; - $varstring =~ s/^(\w+)/{$1}->/; - return ($varstring); + return "WeBWorK::ConfigObject::$data->{type}"->new($data, $self); } -sub print_navigation_tabs { +sub generate_navigation_tabs { my ($self, $current_tab, @tab_names) = @_; - my $r = $self->r; - my $str = ''; + my $r = $self->r; + my $tabs = $r->c; for my $tab (0 .. (scalar(@tab_names) - 1)) { if ($current_tab eq "tab$tab") { - $tab_names[$tab] = CGI::span({ class => 'nav-link active' }, $r->maketext($tab_names[$tab])); + push(@$tabs, $r->tag('span', class => 'nav-link active', $r->maketext($tab_names[$tab]))); } else { - $tab_names[$tab] = CGI::a( - { - href => $self->systemLink($r->urlpath, params => { section_tab => "tab$tab" }), + push( + @$tabs, + $r->link_to( + $r->maketext($tab_names[$tab]) => + $self->systemLink($r->urlpath, params => { section_tab => "tab$tab" }), class => 'nav-link' - }, - $r->maketext($tab_names[$tab]) + ) ); } } - print qq{

      }; + return $r->tag('nav', class => 'config-tabs nav nav-pills justify-content-center my-4', $tabs->join('')); } sub getConfigValues { - my $ce = shift; - my $ConfigValues = $ce->{ConfigValues}; + my ($self, $ce) = @_; + my $configValues = $ce->{ConfigValues}; - # get the list of theme folders in the theme directory and remove . and .. + # Get the list of theme folders in the theme directory and remove . and .. and 'layouts'. my $themeDir = $ce->{webworkDirs}{themes}; opendir(my $dh, $themeDir) || die "can't opendir $themeDir: $!"; - my $themes = [ grep { !/^\.{1,2}$/ } sort readdir($dh) ]; + my $themes = [ grep { !/^\.{1,2}$/ && $_ ne 'layouts' } sort readdir($dh) ]; # get list of localization dictionaries my $localizeDir = $ce->{webworkDirs}{localize}; opendir(my $dh2, $localizeDir) || die "can't opendir $localizeDir: $!"; my %seen = (); # find the languages in the localize direction my $languages = [ - grep { !$seen{$_}++ } # remove duplicate items - map { $_ =~ s/\...$//; $_ } # get rid of suffix - grep { /\.mo$|\.po$/; } sort readdir($dh2) #look at only .mo and .po files + grep { !$seen{$_}++ } # remove duplicate items + map { $_ =~ s/\.[pm]o$//r } # get rid of suffix + grep {/\.mo$|\.po$/} sort readdir($dh2) #look at only .mo and .po files ]; - # insert the anonymous array of theme folder names into ConfigValues + # insert the anonymous array of theme folder names into configValues # FIXME? Is there a reason this is an array? Couldn't we replace this # with a hash and conceptually simplify this routine? MEG my $modifyThemes = sub { @@ -587,37 +127,34 @@ sub getConfigValues { $item->{values} = $languages; } }; - foreach my $oneConfig (@$ConfigValues) { + foreach my $oneConfig (@$configValues) { foreach my $hash (@$oneConfig) { &$modifyThemes($hash); &$modifyLanguages($hash); } } - $ConfigValues; + return $configValues; } async sub pre_header_initialize { my ($self) = @_; my $r = $self->r; my $ce = $r->ce; - my $ConfigValues = getConfigValues($ce); + my $configValues = $self->getConfigValues($ce); # Get a course environment without course.conf $self->{default_ce} = WeBWorK::CourseEnvironment->new({ %WeBWorK::SeedCE, }); - $self->{ce_file_dir} = $ce->{courseDirs}->{root}; + $self->{ce_file_dir} = $ce->{courseDirs}{root}; # Get a copy of the course environment which does not have simple.conf loaded - my $ce3 = eval { - new WeBWorK::CourseEnvironment({ - %WeBWorK::SeedCE, - courseName => $ce->{courseName}, - web_config_filename => 'noSuchFilePlease', - }); - }; - if ($r->param("make_changes")) { - my $widget_count = 0; - my $fileoutput = "#!perl + my $ce3 = WeBWorK::CourseEnvironment->new({ + %WeBWorK::SeedCE, + courseName => $ce->{courseName}, + web_config_filename => 'noSuchFilePlease' + }); + if ($r->param('make_changes')) { + my $fileoutput = "#!perl # This file is automatically generated by WeBWorK's web-based # configuration module. Do not make changes directly to this # file. It will be overwritten the next time configuration @@ -626,134 +163,31 @@ async sub pre_header_initialize { # Get the number of the current tab my $tab = $r->param('section_tab') || 'tab0'; $tab =~ s/tab//; - # We completely rewrite the simple configuration file - # so we need to go through all sections - for my $configSection (@{$ConfigValues}) { + # We completely rewrite the simple configuration file, so we need to go through all sections. + for my $configSection (@{$configValues}) { my @configSectionArray = @{$configSection}; shift @configSectionArray; for my $con (@configSectionArray) { my $conobject = $self->objectify($con); - if ($tab) { # This tab is not being shown - my $oldval = eval('$ce3->' . inline_var($con->{var})); - $fileoutput .= $conobject->save_string($oldval, 'current'); - } else { # We reached the tab with entry objects - $fileoutput .= - $conobject->save_string(eval('$ce3->' . inline_var($con->{var})), "widget$widget_count"); - $widget_count++; + if ($tab) { + # This tab is hidden so use the current course environment value. + $fileoutput .= $conobject->save_string($con->get_value($ce3), 1); + } else { + # We reached the tab with entry objects + $fileoutput .= $conobject->save_string($con->get_value($ce3)); } } $tab--; } - my $write_result = writeFile($self->{ce_file_dir} . "/simple.conf", $fileoutput); - if ($write_result) { - $self->addbadmessage($write_result); + my @write_result = writeFile("$self->{ce_file_dir}/simple.conf", $fileoutput); + if (@write_result) { + $self->addbadmessage($r->c(@write_result)->join($r->tag('br'))); } else { - $self->addgoodmessage($r->maketext("Changes saved")); + $self->addgoodmessage($r->maketext('Changes saved')); } } -} - -sub body { - my ($self) = @_; - - my $r = $self->r; - my $ce = $r->ce; # course environment - my $db = $r->db; # database - my $ConfigValues = getConfigValues($ce); - my $userName = $r->param('user'); - - my $user = $db->getUser($userName); # checked - die "record for user $userName (real user) does not exist." - unless defined $user; - ### Check that this is a professor - my $authz = $r->authz; - unless ($authz->hasPermissions($userName, "modify_problem_sets")) { - print "User $userName returned " . $authz->hasPermissions($user, "modify_problem_sets") . " for permission"; - return (CGI::div( - { class => 'alert alert-danger p-1 mb-0' }, - CGI::em($r->maketext("You are not authorized to access the Instructor tools.")) - )); - } - - if ($r->param('show_long_doc')) { - my $docstring; - for my $consec (@$ConfigValues) { - my @configSectionArray = @$consec; - shift @configSectionArray; - for my $con (@configSectionArray) { - $docstring = $con->{doc2} || $con->{doc} - if ($con->{var} eq $r->param('var_name')); - } - } - print CGI::h2($r->maketext("Variable Documentation:") . ' ' . CGI::code('$' . $r->param('var_name'))), - CGI::p(), - CGI::blockquote($r->maketext($docstring)); - return ""; - } - - my $default_ce = $self->{default_ce}; - # Get the current course environment again in case we just saved changes - my $ce4 = eval { new WeBWorK::CourseEnvironment({ %WeBWorK::SeedCE, courseName => $ce->{courseName}, }) }; - - my $widget_count = 0; - if (scalar(@$ConfigValues) == 0) { - print CGI::p( - $r->maketext( - "The configuration module did not find the data it needs to function. Have your site administrator check that Constants.pm is up to date." - ) - ); - return ""; - } - - # Start tabs at the top - my $current_tab = $r->param('section_tab') || 'tab0'; - my @tab_names = map { $_->[0] } @{$ConfigValues}; - $self->print_navigation_tabs($current_tab, @tab_names); - - print CGI::start_form({ method => "post", action => $r->uri, id => "config-form", name => "config-form" }); - print $self->hidden_authen_fields(); - print CGI::hidden(-name => 'section_tab', -value => $current_tab); - - my $tabnumber = $current_tab; - $tabnumber =~ s/tab//; - my @configSectionArray = @{ $ConfigValues->[$tabnumber] }; - my $configTitle = shift @configSectionArray; - print CGI::h2(CGI::b($r->maketext($configTitle))); - - print CGI::start_div({ class => 'table-responsive' }); - print CGI::start_table({ class => 'table table-bordered align-middle' }); - print '' - . CGI::th($r->maketext('Setting')) - . CGI::th({ class => 'text-center' }, $r->maketext('Default')) - . CGI::th({ class => 'text-center' }, $r->maketext('Current')); - for my $con (@configSectionArray) { - my $conobject = $self->objectify($con); - print ''; - print $conobject->what_string("widget$widget_count"); - print CGI::td({ class => 'text-center' }, - $conobject->display_value(eval('$default_ce->' . inline_var($con->{var})))); - print CGI::td($conobject->entry_widget("widget$widget_count", eval('$ce4->' . inline_var($con->{var})))); - print ''; - $widget_count++; - } - print CGI::end_table(); - print CGI::end_div(); - - print CGI::p(CGI::submit({ - name => 'make_changes', - value => $r->maketext('Save Changes'), - class => 'btn btn-primary' - })); - print CGI::end_form(); - - return ""; + return; } -=head1 AUTHOR - -Written by John Jones, jj (at) asu.edu. - -=cut - 1; diff --git a/lib/WeBWorK/ContentGenerator/Instructor/FileManager.pm b/lib/WeBWorK/ContentGenerator/Instructor/FileManager.pm index 31382d03d6..fc21d888be 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/FileManager.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/FileManager.pm @@ -14,16 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::Instructor::FileManager; -use base qw(WeBWorK::ContentGenerator::Instructor); - -use utf8; -use WeBWorK::Utils qw(readDirectory readFile sortByName listFilesRecursive); -use WeBWorK::Upload; -use File::Path; -use File::Copy; -use File::Spec; - -use String::ShellQuote; +use parent qw(WeBWorK::ContentGenerator::Instructor); =head1 NAME @@ -33,16 +24,20 @@ WeBWorK::ContentGenerator::Instructor::FileManager.pm -- simple directory manage use strict; use warnings; -#use CGI; -use WeBWorK::CGI; +use utf8; + +use File::Path; +use File::Copy; +use File::Spec; +use String::ShellQuote; +use WeBWorK::Utils qw(readDirectory readFile sortByName listFilesRecursive); +use WeBWorK::Upload; use WeBWorK::Utils::CourseManagement qw(archiveCourse); use constant HOME => 'templates'; -# -# The list of file extensions and the directories they usually go in. -# +# The list of file extensions and the directories they usually go in. my %uploadDir = ( csv => 'scoring', lst => 'templates', @@ -52,38 +47,45 @@ my %uploadDir = ( html => 'html/.*', ); -################################################## -# -# Check that the user is authorized, and then -# see if there is a download to perform. -# +# Check that the user is authorized, and see if there is a download to perform. async sub pre_header_initialize { - my $self = shift; - my $r = $self->r; - my $authz = $r->authz; - my $user = $r->param('user'); + my $self = shift; + my $r = $self->r; - # we don't need to return an error here, because body() will print an error for us :) - return unless $authz->hasPermissions($user, "manage_course_files"); + return unless $r->authz->hasPermissions($r->param('user'), 'manage_course_files'); my $action = $r->param('action'); - $self->Download if ($action && ($action eq 'Download' || $action eq $r->maketext("Download"))); - my $file = $r->param('download'); - $self->downloadFile($file) if (defined $file); - my $ce = $r->ce; - my $urlpath = $r->urlpath; - my $courseID = $r->urlpath->arg("courseID"); -# removed archived_course_ prefix -- it is important that path matches the $courseID for consitency with the database dump - my $archive_path = $ce->{webworkDirs}{courses} . "/$courseID/templates/$courseID.tar.gz"; - my %options = (courseID => $courseID, archive_path => $archive_path, ce => $ce); - $self->{archive_options} = \%options; + $self->Download if $action && ($action eq 'Download' || $action eq $r->maketext('Download')); + $self->downloadFile($r->param('download')) if defined $r->param('download'); + + if ($r->param('archiveCourse')) { + my $ce = $r->ce; + my $courseID = $r->urlpath->arg('courseID'); + + my $message = eval { + WeBWorK::Utils::CourseManagement::archiveCourse( + courseID => $courseID, + archive_path => "$ce->{webworkDirs}{courses}/$courseID/templates/$courseID.tar.gz", + ce => $ce + ); + }; + if ($@) { + $self->addbadmessage($r->maketext('Failed to generate course archive: [_1]', $@)); + } else { + $self->addgoodmessage($r->maketext('Archived course as [_1].tar.gz.', $courseID)); + } + $self->addbadmessage($message) if ($message); + } + + $self->{pwd} = $self->checkPWD($r->param('pwd') || HOME); + $self->{courseRoot} = $r->ce->{courseDirs}{root}; + $self->{courseName} = $r->urlpath->arg('courseID'); + + return; } -################################################## -# # Download a given file -# sub downloadFile { my $self = shift; my $r = $self->r; @@ -92,130 +94,22 @@ sub downloadFile { return unless $pwd; $pwd = $self->{ce}{courseDirs}{root} . '/' . $pwd; unless (-e "$pwd/$file") { - $self->addbadmessage($r->maketext("The file you are trying to download doesn't exist")); + $self->addbadmessage($r->maketext(q{The file you are trying to download doesn't exist})); return; } unless (-f "$pwd/$file") { - $self->addbadmessage($r->maketext("You can only download regular files.")); + $self->addbadmessage($r->maketext('You can only download regular files.')); return; } - my $type = "application/octet-stream"; - $type = "text/plain" if $file =~ m/\.(pg|pl|pm|txt|def|csv|lst)/; - $type = "image/gif" if $file =~ m/\.gif/; - $type = "image/jpeg" if $file =~ m/\.(jpg|jpeg)/; - $type = "image/png" if $file =~ m/\.png/; + my $type = 'application/octet-stream'; + $type = 'text/plain' if $file =~ m/\.(pg|pl|pm|txt|def|csv|lst)/; + $type = 'image/gif' if $file =~ m/\.gif/; + $type = 'image/jpeg' if $file =~ m/\.(jpg|jpeg)/; + $type = 'image/png' if $file =~ m/\.png/; $self->reply_with_file($type, "$pwd/$file", $file, 0); } -################################################## -# -# The main body of the page -# -sub body { - my $self = shift; - my $r = $self->r; - my $urlpath = $r->urlpath; - my $db = $r->db; - my $ce = $r->ce; - my $authz = $r->authz; - my $courseRoot = $ce->{courseDirs}{root}; - my $courseName = $urlpath->arg('courseID'); - my $user = $r->param('user'); - my $key = $r->param('key'); - - return CGI::em("You are not authorized to manage course files") - unless $authz->hasPermissions($user, "manage_course_files"); - - $self->{pwd} = $self->checkPWD($r->param('pwd') || HOME); - return CGI::em("You have specified an illegal working directory!") unless defined $self->{pwd}; - - my $fileManagerPage = $urlpath->newFromModule($urlpath->module, $r, courseID => $courseName); - my $fileManagerURL = $self->systemLink($fileManagerPage, authen => 0); - - print CGI::start_form( - -method => "POST", - -action => $fileManagerURL, - -id => "FileManager", - -enctype => 'multipart/form-data', - -name => "FileManager", - -style => "margin:0", - ); - print $self->hidden_authen_fields; - - $self->{courseRoot} = $courseRoot; - $self->{courseName} = $courseName; - - # - #replaced by a list of if/elsif because the translation didn't recognize the translated actions. - # - my $action = $r->param('action') || $r->param('formAction') || $r->param("confirmed") || 'Init'; - #$self->addgoodmessage("|$action|"); - if ($action eq "Refresh" || $action eq $r->maketext("Refresh")) { $self->Refresh; } - elsif ($action eq "Cancel" || $action eq $r->maketext("Cancel")) { $self->Refresh; } - elsif ($action eq "Directory" || $action eq $r->maketext("Directory")) { $self->Go; } - elsif ($action eq "Go" || $action eq $r->maketext("Go")) { $self->Go; } - elsif ($action eq "View" || $action eq $r->maketext("View")) { $self->View; } - elsif ($action eq "Edit" || $action eq $r->maketext("Edit")) { $self->Edit; } - elsif ($action eq "Download" || $action eq $r->maketext("Download")) { $self->Refresh; } - elsif ($action eq "Copy" || $action eq $r->maketext("Copy")) { $self->Copy; } - elsif ($action eq "Rename" || $action eq $r->maketext("Rename")) { $self->Rename; } - elsif ($action eq "Delete" || $action eq $r->maketext("Delete")) { $self->Delete; } - elsif ($action eq "Make Archive" || $action eq $r->maketext("Make Archive")) { $self->MakeArchive; } - elsif ($action eq "Unpack" || $action eq $r->maketext("Unpack")) { $self->UnpackArchive; } - elsif ($action eq "New Folder" || $action eq $r->maketext("New Folder")) { $self->NewFolder; } - elsif ($action eq "New File" || $action eq $r->maketext("New File")) { $self->NewFile; } - elsif ($action eq "Upload" || $action eq $r->maketext("Upload")) { $self->Upload; } - elsif ($action eq "Revert" || $action eq $r->maketext("Revert")) { $self->Edit; } - elsif ($action eq "Save As" || $action eq $r->maketext("Save As")) { $self->SaveAs; } - elsif ($action eq "Save" || $action eq $r->maketext("Save")) { $self->Save; } - elsif ($action eq "Init" || $action eq $r->maketext("Init")) { $self->Init; } - elsif ($action eq "^" || $action eq "\\") { $self->ParentDir; } - else { - $self->addbadmessage("Unknown action"); - $self->Refresh; - } - #for ($action) { - # /^Refresh/i and do {$self->Refresh; last}; - # /^Cancel/i and do {$self->Refresh; last}; - # /^\^/i and do {$self->ParentDir; last}; - # /^Directory/i and do {$self->Go; last}; - # /^Go/i and do {$self->Go; last}; - # /^View/i and do {$self->View; last}; - # /^Edit/i and do {$self->Edit; last}; - # /^Download/i and do {$self->Refresh; last}; - # /^Copy/i and do {$self->Copy; last}; - # /^Rename/i and do {$self->Rename; last}; - # /^Delete/i and do {$self->Delete; last}; - # /^Make/i and do {$self->MakeArchive; last}; - # /^Unpack/i and do {$self->UnpackArchive; last}; - # /^New Folder/i and do {$self->NewFolder; last}; - # /^New File/i and do {$self->NewFile; last}; - # /^Upload/i and do {$self->Upload; last}; - # /^Revert/i and do {$self->Edit; last}; - # /^Save As/i and do {$self->SaveAs; last}; - # /^Save/i and do {$self->Save; last}; - # /^Init/i and do {$self->Init; last}; - #} - if ($r->param('archiveCourse')) { - my %options = %{ $self->{archive_options} }; - my $courseID = $options{courseID}; - $self->addgoodmessage( - $r->maketext("Archiving course as [_1].tar.gz. Reload FileManager to see it.", $courseID)); - WeBWorK::Utils::CourseManagement::archiveCourse(%options); - $self->addgoodmessage($r->maketext("Course archived.")); - - } - print CGI::hidden({ name => 'pwd', value => $self->{pwd} }); - print CGI::hidden({ name => 'formAction', value => "" }); - print CGI::end_form(); - - return ""; -} - -################################################## -# -# First time through -# +# First time through sub Init { my $self = shift; $self->r->param('unpack', 1); @@ -226,738 +120,299 @@ sub Init { sub HiddenFlags { my $self = shift; - print CGI::hidden({ name => "dates", value => $self->getFlag('dates') }); - print CGI::hidden({ name => "overwrite", value => $self->getFlag('overwrite') }); - print CGI::hidden({ name => "unpack", value => $self->getFlag('unpack') }); - print CGI::hidden({ name => "autodelete", value => $self->getFlag('autodelete') }); - print CGI::hidden({ name => "format", value => $self->getFlag('format', 'Automatic') }); + my $r = $self->r; + return $r->c( + $r->hidden_field(dates => ''), + $r->hidden_field(overwrite => ''), + $r->hidden_field(unpack => ''), + $r->hidden_field(autodelete => ''), + $r->hidden_field(autodelete => 'Automatic'), + )->join(''); } -################################################## -# -# Display the directory listing and associated buttons -# - +# Display the directory listing and associated buttons. sub Refresh { - my $self = shift; - my $r = $self->r; - my $pwd = shift || $self->{pwd}; - my $isTop = $pwd eq '.' || $pwd eq ''; - - my ($dirs, $dirlabels) = directoryMenu($self->{courseName}, $pwd); - my ($files, $filelabels) = directoryListing($self->{courseRoot}, $pwd, $self->getFlag('dates')); - - unless ($files) { - $self->addbadmessage($r->maketext("The directory you specified doesn't exist")); - $files = []; - $filelabels = {}; - } - - # Some JavaScript to make things easier for the user - print CGI::script(< 'row' }, - CGI::div( - { class => 'col-md-8 mb-2' }, - CGI::div( - { class => 'input-group input-group-sm' }, - CGI::submit({ - name => "action", - value => "^", - ($isTop ? (disabled => 1) : ()), - class => 'btn btn-sm btn-secondary' - }), - CGI::popup_menu({ - name => "directory", - values => $dirs, - labels => $dirlabels, - class => 'form-select', - dir => 'ltr', - onChange => "doForm('Go')" - }) - ) - ), - CGI::div( - { class => 'col-md-4 mb-2' }, - CGI::div( - { class => 'form-check font-sm' }, - CGI::checkbox({ - name => 'dates', - checked => $self->getFlag('dates'), - value => 1, - class => 'form-check-input', - label => $r->maketext('Show Date & Size'), - labelattributes => { class => 'form-check-label' }, - onClick => 'doForm("Refresh")' - }) - ) - ) - ); - - # Directory Listing and column of buttons - my %button = (name => "action", style => "width:10em", class => 'file-manager-btn btn btn btn-sm btn-secondary'); - my $width = ($self->getFlag('dates') && scalar(@{$files}) > 0) ? "" : " width:30em"; - print CGI::div( - { class => 'row' }, - CGI::div( - { class => 'col-md-8 mb-2' }, - fixSpaces(CGI::scrolling_list({ - name => "files", - id => "files", - class => 'form-select font-monospace h-100', - dir => 'ltr', - size => 17, - multiple => 1, - values => $files, - labels => $filelabels, - onDblClick => "doForm('View')", - onChange => "checkFiles()" - })) - ), - CGI::div( - { class => 'col-md-4 mb-2' }, - CGI::div( - { class => 'd-md-flex flex-column justify-content-evenly' }, - CGI::submit({ %button, value => $r->maketext("View"), id => "View" }), - CGI::submit({ %button, value => $r->maketext("Edit"), id => "Edit" }), - CGI::submit({ %button, value => $r->maketext("Download"), id => "Download" }), - CGI::submit({ %button, value => $r->maketext("Rename"), id => "Rename" }), - CGI::submit({ %button, value => $r->maketext("Copy"), id => "Copy" }), - CGI::submit({ %button, value => $r->maketext("Delete"), id => "Delete" }), - CGI::submit({ %button, value => $r->maketext("Make Archive"), id => "MakeArchive" }), - CGI::div({ style => 'height: 10px' }, ''), - CGI::submit({ %button, value => $r->maketext("New File") }), - CGI::submit({ %button, value => $r->maketext("New Folder") }), - CGI::submit({ %button, value => $r->maketext("Refresh") }), - ) - ) - ); - - # Upload button and checkboxes - print CGI::div( - { class => 'row' }, - CGI::div( - { class => 'col-md-8' }, - CGI::div( - { class => 'input-group input-group-sm mb-2' }, - CGI::submit({ - name => "action", - style => "width:7em", - value => $r->maketext("Upload"), - id => "Upload", - class => 'btn btn-sm btn-primary' - }), - CGI::input({ - type => "file", - name => "file", - id => "file", - onChange => "checkFile()", - class => 'form-control form-control-sm' - }) - ) - ) - ); - - print CGI::div( - { class => 'row' }, - CGI::div( - { class => 'col-md-8' }, - CGI::div( - { class => 'input-group input-group-sm mb-2' }, - CGI::span({ class => 'input-group-text' }, $r->maketext('Format') . ':'), - CGI::div( - { class => 'input-group-text flex-grow-1' }, - CGI::radio_group({ - name => 'format', - values => [ $r->maketext('Text'), $r->maketext('Binary'), $r->maketext('Automatic') ], - default => $self->getFlag('format', 'Automatic'), - class => 'form-check-input me-2', - labelattributes => { class => 'form-check-label me-4' } - }) - ) - ) - ) - ); - - print CGI::div( - { class => 'row' }, - CGI::div( - { class => 'col-md-8' }, - CGI::div( - { class => 'input-group input-group-sm mb-2' }, - CGI::div( - { class => 'input-group-text flex-grow-1' }, - CGI::checkbox({ - name => 'overwrite', - checked => $self->getFlag('overwrite'), - value => 1, - class => 'form-check-input me-2', - label => $r->maketext('Overwrite existing files silently'), - labelattributes => { class => 'form-check-label' } - }) - ) - ) - ), - ); - - print CGI::div( - { class => 'row' }, - CGI::div( - { class => 'col-md-8' }, - CGI::div( - { class => 'input-group input-group-sm' }, - CGI::div( - { class => 'input-group-text' }, - CGI::checkbox({ - name => 'unpack', - checked => $self->getFlag('unpack'), - value => 1, - class => 'form-check-input me-2', - label => $r->maketext('Unpack archives automatically'), - labelattributes => { class => 'form-check-label' } - }) - ), - CGI::div( - { class => 'input-group-text flex-grow-1' }, - CGI::checkbox({ - name => 'autodelete', - checked => $self->getFlag('autodelete'), - value => 1, - class => 'form-check-input me-2', - label => $r->maketext('then delete them'), - labelattributes => { class => 'form-check-label' } - }) - ) - ) - ) - ); - - print CGI::script("checkFiles(); checkFile();"); + my ($self) = @_; + return $self->r->include('ContentGenerator/Instructor/FileManager/refresh'); } -################################################## -# # Move to the parent directory -# sub ParentDir { my $self = shift; $self->{pwd} = '.' unless ($self->{pwd} =~ s!/[^/]*$!!); $self->Refresh; } -################################################## -# # Move to the parent directory -# sub Go { my $self = shift; $self->{pwd} = $self->r->param('directory'); $self->Refresh; } -################################################## -# # Open a directory or view a file -# sub View { - my $self = shift; - my $pwd = $self->{pwd}; - my $r = $self->r; - my $filename = $self->getFile("view"); - return unless $filename; - my $name = "$pwd/$filename"; - $name =~ s!^\./?!!; - my $file = "$self->{courseRoot}/$pwd/$filename"; + my $self = shift; + my $r = $self->r; + + my $filename = $self->getFile('view'); + return '' unless $filename; + + my $name = "$self->{pwd}/$filename" =~ s!^\./?!!r; + my $file = "$self->{courseRoot}/$self->{pwd}/$filename"; - # # Don't follow symbolic links - # if ($self->isSymLink($file)) { - $self->addbadmessage($r->maketext("You may not follow symbolic links")); - $self->Refresh; - return; + $self->addbadmessage($r->maketext('You may not follow symbolic links')); + return $self->Refresh; } - # # Handle directories by making them the working directory - # if (-d $file) { $self->{pwd} .= '/' . $filename; - $self->Refresh; - return; + return $self->Refresh; } unless (-f $file) { - $self->addbadmessage($r->maketext("You can't view files of that type")); - $self->Refresh; - return; + $self->addbadmessage($r->maketext(q{You can't view files of that type})); + return $self->Refresh; } - # - # Include a download link - # - my $urlpath = $self->r->urlpath; - my $fileManagerPage = $urlpath->newFromModule($urlpath->module, $r, courseID => $self->{courseName}); - my $fileManagerURL = $self->systemLink($fileManagerPage, params => { download => $filename, pwd => $pwd }); - print CGI::div({ style => "float:right" }, CGI::a({ href => $fileManagerURL }, "Download")); - print CGI::p(), CGI::b($name), CGI::p(); - print CGI::hr(); - - # - # For files, display the file, if possible. - # If the file is an image, display it as an image. - # - if (-T $file) { #check that it is a text file - my $data = readFile($file); - print CGI::div({ dir => "auto" }, CGI::pre(showHTML($data))); - } elsif ($file =~ m/\.(gif|jpg|png)/i) { - print CGI::img({ src => $fileManagerURL, border => 0 }); - } else { - print CGI::div({ class => 'alert alert-danger p-1 mb-0' }, - "The file $file does not appear to be a text or image file."); - } + return $r->include( + 'ContentGenerator/Instructor/FileManager/view', + filename => $filename, + name => $name, + file => $file + ); } -################################################## -# # Edit a file -# sub Edit { my $self = shift; my $filename = $self->getFile('edit'); - return unless $filename; + return '' unless $filename; my $file = "$self->{courseRoot}/$self->{pwd}/$filename"; my $r = $self->r; my $userID = $r->param('user'); my $ce = $r->ce; my $authz = $r->authz; - # if its a restricted file, dont allow the web editor to edit it unless - # that option has been set for the course. - foreach my $restrictedFile (@{ $ce->{uneditableCourseFiles} }) { + # If its a restricted file, dont allow the web editor to edit it unless that option has been set for the course. + for my $restrictedFile (@{ $ce->{uneditableCourseFiles} }) { if (File::Spec->canonpath($file) eq File::Spec->canonpath("$self->{courseRoot}/$restrictedFile") - && !$authz->hasPermissions($userID, "edit_restricted_files")) + && !$authz->hasPermissions($userID, 'edit_restricted_files')) { - $self->addbadmessage($r->maketext("You do not have permission to edit this file.")); - $self->Refresh; - return; + $self->addbadmessage($r->maketext('You do not have permission to edit this file.')); + return $self->Refresh; } } if (-d $file) { - $self->addbadmessage($r->maketext("You can't edit a directory")); - $self->Refresh; - return; + $self->addbadmessage($r->maketext(q{You can't edit a directory})); + return $self->Refresh; } unless (-f $file) { - $self->addbadmessage($r->maketext("You can only edit text files")); - $self->Refresh; - return; + $self->addbadmessage($r->maketext('You can only edit text files')); + return $self->Refresh; } if (-T $file) { - my $data = readFile($file); - $self->RefreshEdit($data, $filename); + return $self->RefreshEdit(readFile($file), $filename); } else { - $self->addbadmessage($r->maketext("The file does not appear to be a text file")); - $self->Refresh; + $self->addbadmessage($r->maketext('The file does not appear to be a text file')); + return $self->Refresh; } - return; + return ''; } -################################################## -# # Save the edited file -# sub Save { my $self = shift; my $filename = shift; my $r = $self->r; my $pwd = $self->{pwd}; if ($filename) { - $pwd = substr($filename, length($self->{courseRoot}) + 1); - $pwd =~ s!(/|^)([^/]*)$!!; + $pwd = substr($filename, length($self->{courseRoot}) + 1) =~ s!(/|^)([^/]*)$!!r; $filename = $2; $pwd = '.' if $pwd eq ''; } else { - $filename = $self->getFile("save"); + $filename = $self->getFile('save'); return unless $filename; } my $file = "$self->{courseRoot}/$pwd/$filename"; - my $data = $self->r->param("data"); + my $data = $self->r->param('data'); if (defined($data)) { $data =~ s/\r\n?/\n/g; # convert DOS and Mac line ends to unix - local (*OUTFILE); - if (open(OUTFILE, ">:encoding(UTF-8)", $file)) { - eval { print OUTFILE $data; close(OUTFILE) }; - if ($@) { $self->addbadmessage($r->maketext("Failed to save: [_1]", $@)) } - else { $self->addgoodmessage($r->maketext("File saved")) } + if (open(my $OUTFILE, '>:encoding(UTF-8)', $file)) { + print $OUTFILE $data; + close($OUTFILE); + if ($@) { $self->addbadmessage($r->maketext('Failed to save: [_1]', $@)) } + else { $self->addgoodmessage($r->maketext('File saved')) } } else { - $self->addbadmessage($r->maketext("Can't write to file [_1]", $!)); + $self->addbadmessage($r->maketext(q{Can't write to file [_1]}, $!)); } } else { - $data = ""; - $self->addbadmessage($r->maketext("Error: no file data was submitted!")); + $data = ''; + $self->addbadmessage($r->maketext('Error: no file data was submitted!')); } $self->{pwd} = $pwd; $self->RefreshEdit($data, $filename); } -################################################## -# # Save the edited file under a new name -# sub SaveAs { my $self = shift; my $newfile = $self->r->param('name'); my $original = $self->r->param('files'); $newfile = $self->verifyPath($newfile, $original); - if ($newfile) { $self->Save($newfile); return } + return $self->Save($newfile) if $newfile; $self->RefreshEdit($self->r->param('data'), $original); } -################################################## -# # Display the Edit page -# sub RefreshEdit { - my $self = shift; - my $data = shift; - my $file = shift; - my $r = $self->r; - my $pwd = shift || $self->{pwd}; - my $name = "$pwd/$file"; - $name =~ s!^\./?!!; - - my %button = (name => "action", class => 'btn btn-sm btn-secondary w-100'); - - print join( - '', - CGI::div( - { class => 'd-flex' }, - CGI::div({ align => "center", class => 'col-12 bg-dark text-white' }, CGI::b($name)) - ), - CGI::div( - { class => 'd-flex' }, - CGI::div( - { class => 'col-12' }, - CGI::textarea({ - name => "data", - default => $data, - override => 1, - rows => 30, - columns => 80, - dir => "auto", - class => "file-manager-editor form-control", - }) - ) - ), - CGI::div( - { class => 'row' }, - CGI::div({ class => 'col-md-2 col-4 my-2' }, CGI::submit({ %button, value => $r->maketext("Cancel") })), - CGI::div({ class => 'col-md-2 col-4 my-2' }, CGI::submit({ %button, value => $r->maketext("Revert") })), - CGI::div({ class => 'col-md-2 col-4 my-2' }, CGI::submit({ %button, value => $r->maketext("Save") })), - CGI::div( - { class => 'col-md-6 col-12 my-2' }, - CGI::div( - { class => 'input-group' }, - CGI::submit({ - name => "action", - class => 'btn btn-sm btn-secondary', - value => $r->maketext("Save As") - }), - CGI::input({ - type => "text", - name => "name", - size => 20, - class => 'form-control form-control-sm' - }) - ) - ) - ) - ); - print CGI::hidden({ name => "files", value => $file }); - $self->HiddenFlags; + my ($self, $data, $file) = @_; + return $self->r->include('ContentGenerator/Instructor/FileManager/refresh_edit', contents => $data, file => $file); } -################################################## -# # Copy a file -# sub Copy { my $self = shift; my $r = $self->r; my $dir = "$self->{courseRoot}/$self->{pwd}"; my $original = $self->getFile('copy'); - return unless $original; + return '' unless $original; my $oldfile = "$dir/$original"; if (-d $oldfile) { # FIXME: need to do recursive directory copy - $self->addbadmessage("Directory copies are not yet implemented"); - $self->Refresh; - return; + $self->addbadmessage('Directory copies are not yet implemented'); + return $self->Refresh; } if ($self->r->param('confirmed')) { my $newfile = $self->r->param('name'); if ($newfile = $self->verifyPath($newfile, $original)) { if (copy($oldfile, $newfile)) { - $self->addgoodmessage($r->maketext("File successfully copied")); - $self->Refresh; - return; + $self->addgoodmessage($r->maketext('File successfully copied')); + return $self->Refresh; } else { - $self->addbadmessage($r->maketext("Can't copy file: [_1]", $!)); + $self->addbadmessage($r->maketext(q{Can't copy file: [_1]}, $!)); } } } - $self->Confirm($r->maketext("Copy file as:"), uniqueName($dir, $original), $r->maketext("Copy")); - print CGI::hidden({ name => "files", value => $original }); + return $r->c($self->Confirm($r->maketext('Copy file as:'), uniqueName($dir, $original), $r->maketext('Copy')), + $r->hidden_field(files => $original))->join(''); } -################################################## -# # Rename a file -# sub Rename { my $self = shift; my $r = $self->r; my $dir = "$self->{courseRoot}/$self->{pwd}"; my $original = $self->getFile('rename'); - return unless $original; + return '' unless $original; my $oldfile = "$dir/$original"; if ($self->r->param('confirmed')) { my $newfile = $self->r->param('name'); if ($newfile = $self->verifyPath($newfile, $original)) { if (rename $oldfile, $newfile) { - $self->addgoodmessage($r->maketext("File successfully renamed")); - $self->Refresh; - return; + $self->addgoodmessage($r->maketext('File successfully renamed')); + return $self->Refresh; } else { - $self->addbadmessage($r->maketext("Can't rename file: [_1]", $!)); + $self->addbadmessage($r->maketext(q{Can't rename file: [_1]}, $!)); } } } - $self->Confirm($r->maketext("Rename file as:"), $original, $r->maketext("Rename")); - print CGI::hidden({ name => "files", value => $original }); + return $r->c($self->Confirm($r->maketext('Rename file as:'), $original, $r->maketext('Rename')), + $r->hidden_field(files => $original))->join(''); } -################################################## -# # Delete a file -# sub Delete { my $self = shift; my $r = $self->r; my @files = $self->r->param('files'); - if (scalar(@files) == 0) { - $self->addbadmessage($r->maketext("You must select at least one file to delete")); - $self->Refresh; - return; + + if (!@files) { + $self->addbadmessage($r->maketext('You must select at least one file to delete')); + return $self->Refresh; } - my $pwd = $self->{pwd}; - my $dir = $self->{courseRoot} . '/' . $pwd; + my $dir = "$self->{courseRoot}/$self->{pwd}"; if ($self->r->param('confirmed')) { - - # # If confirmed, go ahead and delete the files - # - foreach my $file (@files) { - if (defined $self->checkPWD("$pwd/$file", 1)) { + for my $file (@files) { + if (defined $self->checkPWD("$self->{pwd}/$file", 1)) { if (-d "$dir/$file" && !-l "$dir/$file") { my $removed = eval { rmtree("$dir/$file", 0, 1) }; if ($removed) { $self->addgoodmessage( - $r->maketext("Directory '[_1]' removed (items deleted: [_2])", $file, $removed)); + $r->maketext('Directory "[_1]" removed (items deleted: [_2])', $file, $removed)); } else { - $self->addbadmessage($r->maketext("Directory '[_1]' not removed: [_2]", $file, $!)); + $self->addbadmessage($r->maketext('Directory "[_1]" not removed: [_2]', $file, $!)); } } else { if (unlink("$dir/$file")) { - $self->addgoodmessage($r->maketext("File '[_1]' successfully removed", $file)); + $self->addgoodmessage($r->maketext('File "[_1]" successfully removed', $file)); } else { - $self->addbadmessage($r->maketext("File '[_1]' not removed: [_2]", $file, $!)); + $self->addbadmessage($r->maketext('File "[_1]" not removed: [_2]', $file, $!)); } } } else { - $self->addbadmessage($r->maketext("Illegal file '[_1]' specified", $file)); + $self->addbadmessage($r->maketext('Illegal file "[_1]" specified', $file)); last; } } - $self->Refresh; - + return $self->Refresh; } else { - - # - # Look up the files to be deleted, and for directories, add / and the contents of the directory - # - my @filelist = (); - foreach my $file (@files) { - if (defined $self->checkPWD("$pwd/$file", 1)) { - if (-l "$dir/$file") { - push(@filelist, "$file@"); - } elsif (-d "$dir/$file") { - my @contents = (); - my $dcount = 0; - foreach my $item (readDirectory("$dir/$file")) { - next if $item eq "." || $item eq ".."; - if (-l "$dir/$file/$item") { - push(@contents, "$item@"); - } elsif (-d "$dir/$file/$item") { - my $count = scalar(listFilesRecursive("$dir/$file/$item", ".*")); - my $s = ($count == 1 ? "" : "s"); - $dcount += $count; - push(@contents, - "$item/" - . CGI::small({ style => "float:right;margin-right:3em" }, CGI::i("($count item$s)")) - ); - } else { - push(@contents, $item); - } - $dcount += 1; - } - my $s = ($dcount == 1 ? "" : "s"); - @contents = (@contents[ 0 .. 10 ], "  .", "  .", "  .") if scalar(@contents) > 15; - push(@filelist, - $file . "/" - . CGI::small({ style => "float:right;margin-right:4em" }, CGI::i("($dcount item$s total)")) - . CGI::div({ style => "margin-left:1ex" }, join(CGI::br(), @contents))); - } else { - push(@filelist, $file); - } - } - } - - # - # Put up the confirmation dialog box - # - print CGI::start_div({ class => 'card w-75 mx-auto' }); - print CGI::div( - { class => 'card-body' }, - CGI::b($r->maketext("Warning") . ': '), - $r->maketext("You have requested that the following items be deleted"), - CGI::ul(CGI::li(\@filelist)), - ( - (grep { -d "$dir/$_" } @files) - ? CGI::p($r->maketext( - "Some of these files are directories. Only delete directories if you really know what you are " - . "doing. You can seriously damage your course if you delete the wrong thing." - )) - : "" - ), - CGI::p( - { class => 'alert alert-danger p-1 mb-3' }, - $r->maketext("There is no undo for deleting files or directories!") - ), - CGI::p($r->maketext("Really delete the items listed above?")), - CGI::div( - { class => 'd-flex justify-content-evenly' }, - CGI::submit({ name => "action", value => "Cancel", class => 'btn btn-sm btn-secondary' }), - CGI::submit({ name => "action", value => "Delete", class => 'btn btn-sm btn-secondary' }) - ) - ); - print CGI::end_div(); - - print CGI::hidden({ name => "confirmed", value => "Delete" }); - foreach my $file (@files) { print CGI::hidden({ name => "files", value => $file }); } - $self->HiddenFlags; + return $r->include('ContentGenerator/Instructor/FileManager/delete', dir => $dir, files => \@files); } } -################################################## -# # Make a gzipped tar archive -# sub MakeArchive { my $self = shift; my $r = $self->r; my @files = $self->r->param('files'); if (scalar(@files) == 0) { - $self->addbadmessage($r->maketext("You must select at least one file for the archive")); - $self->Refresh; - return; + $self->addbadmessage($r->maketext('You must select at least one file for the archive')); + return $self->Refresh; } my $dir = $self->{courseRoot} . '/' . $self->{pwd}; - my $archive = uniqueName($dir, (scalar(@files) == 1) ? $files[0] . ".tgz" : $self->{courseName} . ".tgz"); + my $archive = uniqueName($dir, (scalar(@files) == 1) ? $files[0] . '.tgz' : $self->{courseName} . '.tgz'); my $tar = - "cd " . shell_quote($dir) . " && $self->{ce}{externalPrograms}{tar} -cvzf " . shell_quote($archive, @files); - @files = readpipe $tar . " 2>&1"; + 'cd ' . shell_quote($dir) . " && $self->{ce}{externalPrograms}{tar} -cvzf " . shell_quote($archive, @files); + @files = readpipe $tar . ' 2>&1'; if ($? == 0) { my $n = scalar(@files); - $self->addgoodmessage($r->maketext("Archive '[_1]' created successfully ([quant, _2, file])", $archive, $n)); + $self->addgoodmessage($r->maketext('Archive "[_1]" created successfully ([quant, _2, file])', $archive, $n)); } else { $self->addbadmessage( - $r->maketext("Can't create archive '[_1]': command returned [_2]", $archive, systemError($?))); + $r->maketext(q{Can't create archive "[_1]": command returned [_2]}, $archive, systemError($?))); } - $self->Refresh; + return $self->Refresh; } -################################################## -# # Unpack a gzipped tar archive -# sub UnpackArchive { my $self = shift; my $r = $self->r; - my $archive = $self->getFile("unpack"); - return unless $archive; + my $archive = $self->getFile('unpack'); + return '' unless $archive; if ($archive !~ m/\.(tar|tar\.gz|tgz)$/) { - $self->addbadmessage($r->maketext("You can only unpack files ending in '.tgz', '.tar' or '.tar.gz'")); + $self->addbadmessage($r->maketext('You can only unpack files ending in ".tgz", ".tar" or ".tar.gz"')); } else { $self->unpack($archive); } - $self->Refresh; + return $self->Refresh; } sub unpack { @@ -967,129 +422,116 @@ sub unpack { my $z = 'z'; $z = '' if $archive =~ m/\.tar$/; my $dir = $self->{courseRoot} . '/' . $self->{pwd}; - my $tar = "cd " . shell_quote($dir) . " && $self->{ce}{externalPrograms}{tar} -vx${z}f " . shell_quote($archive); - my @files = readpipe $tar . " 2>&1"; + my $tar = 'cd ' . shell_quote($dir) . " && $self->{ce}{externalPrograms}{tar} -vx${z}f " . shell_quote($archive); + my @files = readpipe $tar . ' 2>&1'; if ($? == 0) { my $n = scalar(@files); - $self->addgoodmessage($r->maketext("[quant,_1,file] unpacked successfully", $n)); + $self->addgoodmessage($r->maketext('[quant,_1,file] unpacked successfully', $n)); return 1; } else { - $self->addbadmessage($r->maketext("Can't unpack '[_1]': command returned [_2]", $archive, systemError($?))); + $self->addbadmessage($r->maketext(q{Can't unpack "[_1]": command returned [_2]}, $archive, systemError($?))); return 0; } } -################################################## -# # Make a new file and edit it -# sub NewFile { my $self = shift; my $r = $self->r; if ($self->r->param('confirmed')) { my $name = $self->r->param('name'); - if (my $file = $self->verifyName($name, "file")) { - local (*NEWFILE); - if (open(NEWFILE, ">:encoding(UTF-8)", $file)) { - close(NEWFILE); - $self->RefreshEdit("", $name); - return; + if (my $file = $self->verifyName($name, 'file')) { + if (open(my $NEWFILE, '>:encoding(UTF-8)', $file)) { + close $NEWFILE; + return $self->RefreshEdit('', $name); } else { - $self->addbadmessage($r->maketext("Can't create file: [_1]", $!)); + $self->addbadmessage($r->maketext(q{Can't create file: [_1]}, $!)); } } } - $self->Confirm($r->maketext("New file name:"), "", $r->maketext("New File")); + return $self->Confirm($r->maketext('New file name:'), '', $r->maketext('New File')); } -################################################## -# # Make a new directory -# sub NewFolder { my $self = shift; my $r = $self->r; if ($self->r->param('confirmed')) { my $name = $self->r->param('name'); - if (my $dir = $self->verifyName($name, "directory")) { + if (my $dir = $self->verifyName($name, 'directory')) { if (mkdir $dir, 0750) { $self->{pwd} .= '/' . $name; - $self->Refresh; - return; + return $self->Refresh; } else { - $self->addbadmessage($r->maketext("Can't create directory: [_1]", $!)); + $self->addbadmessage($r->maketext(q{Can't create directory: [_1]}, $!)); } } } - $self->Confirm($r->maketext("New folder name:"), "", $r->maketext("New Folder")); + return $self->Confirm($r->maketext('New folder name:'), '', $r->maketext('New Folder')); } -################################################## -# # Download a file -# sub Download { my $self = shift; my $r = $self->r; my $pwd = $self->checkPWD($self->r->param('pwd') || HOME); return unless $pwd; - my $filename = $self->getFile("download"); + my $filename = $self->getFile('download'); return unless $filename; my $file = $self->{ce}{courseDirs}{root} . '/' . $pwd . '/' . $filename; - if (-d $file) { $self->addbadmessage($r->maketext("You can't download directories")); return } - unless (-f $file) { $self->addbadmessage($r->maketext("You can't download files of that type")); return } + if (-d $file) { $self->addbadmessage($r->maketext(q{You can't download directories})); return } + unless (-f $file) { $self->addbadmessage($r->maketext(q{You can't download files of that type})); return } $self->r->param('download', $filename); } -################################################## -# # Upload a file to the server -# sub Upload { my $self = shift; my $r = $self->r; my $dir = "$self->{courseRoot}/$self->{pwd}"; my $fileIDhash = $self->r->param('file'); unless ($fileIDhash) { - $self->addbadmessage($r->maketext("You have not chosen a file to upload.")); - $self->Refresh; - return; + $self->addbadmessage($r->maketext('You have not chosen a file to upload.')); + return $self->Refresh; } my ($id, $hash) = split(/\s+/, $fileIDhash); my $upload = WeBWorK::Upload->retrieve($id, $hash, dir => $self->{ce}{webworkDirs}{uploadCache}); my $name = checkName($upload->filename); - my $action = $self->r->param("formAction") || "Cancel"; - if ($self->r->param("confirmed")) { - if ($action eq "Cancel" || $action eq $r->maketext("Cancel")) { + my $action = $self->r->param('formAction') || 'Cancel'; + if ($self->r->param('confirmed')) { + if ($action eq 'Cancel' || $action eq $r->maketext('Cancel')) { $upload->dispose; - $self->Refresh; - return; + return $self->Refresh; } - $name = checkName($self->r->param('name')) if ($action eq "Rename" || $action eq $r->maketext("Rename")); + $name = checkName($self->r->param('name')) if ($action eq 'Rename' || $action eq $r->maketext('Rename')); } if (-e "$dir/$name") { - unless ($self->r->param('overwrite') || $action eq "Overwrite" || $action eq $r->maketext("Overwrite")) { - - $self->Confirm( - $r->maketext("File [_1] already exists. Overwrite it, or rename it as:", $name) . CGI::p(), - uniqueName($dir, $name), - $r->maketext("Rename"), - $r->maketext("Overwrite") - ); -#$self->Confirm("File ".CGI::b($name)." already exists. Overwrite it, or rename it as:".CGI::p(),uniqueName($dir,$name),"Rename","Overwrite"); - print CGI::hidden({ name => "action", value => "Upload" }); - print CGI::hidden({ name => "file", value => $fileIDhash }); - return; + unless ($self->r->param('overwrite') || $action eq 'Overwrite' || $action eq $r->maketext('Overwrite')) { + return $r->c( + $self->Confirm( + $r->tag( + 'p', + $r->b( + $r->maketext('File [_1] already exists. Overwrite it, or rename it as:', $name) + ) + ), + uniqueName($dir, $name), + $r->maketext('Rename'), + $r->maketext('Overwrite') + ), + $r->hidden_field(action => 'Upload'), + $r->hidden_field(file => $fileIDhash) + )->join(''); } } $self->checkFileLocation($name, $self->{pwd}); @@ -1098,9 +540,7 @@ sub Upload { my $type = $self->getFlag('format', 'Automatic'); my $data; - # # Check if we need to convert linebreaks - # if ($type ne 'Binary') { my $fh = $upload->fileHandle; my @lines = <$fh>; @@ -1110,7 +550,7 @@ sub Upload { if ($type eq 'Text') { $upload->dispose; $data =~ s/\r\n?/\n/g; - if (open(UPLOAD, ">:encoding(UTF-8)", $file)) { + if (open(my $UPLOAD, '>:encoding(UTF-8)', $file)) { my $backup_data = $data; my $success = utf8::decode($data); # try to decode as utf8 unless ($success) { @@ -1118,180 +558,137 @@ sub Upload { utf8::upgrade($backup_data); # try to convert data from latin1 to utf8. $data = $backup_data; } - print UPLOAD $data; # print massaged data to file. - close(UPLOAD); + print $UPLOAD $data; # print massaged data to file. + close $UPLOAD; } else { - $self->addbadmessage($r->maketext("Can't create file '[_1]': [_2]", $name, $!)); + $self->addbadmessage($r->maketext(q{Can't create file "[_1]": [_2]}, $name, $!)); } } else { $upload->disposeTo($file); } if (-e $file) { - $self->addgoodmessage($r->maketext("File '[_1]' uploaded successfully", $name)); + $self->addgoodmessage($r->maketext('File "[_1]" uploaded successfully', $name)); if ($name =~ m/\.(tar|tar\.gz|tgz)$/ && $self->getFlag('unpack')) { if ($self->unpack($name) && $self->getFlag('autodelete')) { - if (unlink($file)) { $self->addgoodmessage($r->maketext("Archive '[_1]' deleted", $name)) } - else { $self->addbadmessage($r->maketext("Can't delete archive '[_1]': [_2]", $name, $!)) } + if (unlink($file)) { $self->addgoodmessage($r->maketext('Archive "[_1]" deleted', $name)) } + else { $self->addbadmessage($r->maketext(q{Can't delete archive "[_1]": [_2]}, $name, $!)) } } } } - $self->Refresh; + return $self->Refresh; } -################################################## -################################################## -# # Print a confirmation dialog box -# sub Confirm { - my $self = shift; - my $r = $self->r; - my $message = shift; - my $value = shift; - my $button = shift; - my $button2 = shift; - - print CGI::start_div({ class => 'card w-75 mx-auto' }); - print CGI::div( - { class => 'card-body' }, - $message, - CGI::input({ type => "text", name => "name", size => 50, value => $value }), - CGI::div( - { class => 'd-flex justify-content-evenly mt-3' }, - CGI::submit({ - name => "formAction", - value => $r->maketext("Cancel"), - class => 'btn btn-sm btn-secondary' - }), - CGI::submit({ name => "formAction", value => $button, class => 'btn btn-sm btn-secondary' }), - ( - $button2 - ? CGI::submit({ name => "formAction", value => $button2, class => 'btn btn-sm btn-secondary' }) - : () - ) - ) + my ($self, $message, $value, $button, $button2) = @_; + return $self->r->include( + 'ContentGenerator/Instructor/FileManager/confirm', + message => $message, + value => $value, + button => $button, + button2 => $button2 ); - print CGI::end_div(); - print CGI::hidden({ name => "confirmed", value => $button }); - $self->HiddenFlags; - print CGI::script("window.document.FileManager.name.focus()"); } -################################################## -################################################## -# # Check that there is exactly one valid file -# sub getFile { my $self = shift; my $action = shift; my $r = $self->r; - my @files = $self->r->param("files"); + my @files = $self->r->param('files'); if (scalar(@files) > 1) { - $self->addbadmessage($r->maketext("You can only [_1] one file at a time.", $action)); + $self->addbadmessage($r->maketext('You can only [_1] one file at a time.', $action)); $self->Refresh unless $action eq 'download'; return; } - if (scalar(@files) == 0 || $files[0] eq "") { - $self->addbadmessage($r->maketext("You need to select a file to [_1].", $action)); + if (scalar(@files) == 0 || $files[0] eq '') { + $self->addbadmessage($r->maketext('You need to select a file to [_1].', $action)); $self->Refresh unless $action eq 'download'; return; } my $pwd = $self->checkPWD($self->{pwd} || $self->r->param('pwd') || HOME) || '.'; if ($self->isSymLink($pwd . '/' . $files[0])) { - $self->addbadmessage($r->maketext("You may not follow symbolic links")); + $self->addbadmessage($r->maketext('You may not follow symbolic links')); $self->Refresh unless $action eq 'download'; return; } unless ($self->checkPWD($pwd . '/' . $files[0], 1)) { - $self->addbadmessage($r->maketext("You have specified an illegal file")); + $self->addbadmessage($r->maketext('You have specified an illegal file')); $self->Refresh unless $action eq 'download'; return; } return $files[0]; } -################################################## -# # Get the entries for the directory menu -# sub directoryMenu { - my $course = shift; - my $dir = shift; + my ($self, $dir) = @_; + $dir =~ s!^\.(/|$)!!; my @dirs = split('/', $dir); - my $menu = ""; - my $pwd; - my (@values, %labels); - while (scalar(@dirs)) { - $pwd = join('/', (@dirs)[ 0 .. $#dirs ]); + my @values; + while (@dirs) { + my $pwd = join('/', (@dirs)[ 0 .. $#dirs ]); $dir = pop(@dirs); - push(@values, $pwd); - $labels{$pwd} = $dir; + push(@values, [ $dir => $pwd ]); } - push(@values, '.'); - $labels{'.'} = $course; - return (\@values, \%labels); + push(@values, [ $self->{courseName} => '.' ]); + return \@values; } -################################################## -# # Get the directory listing -# sub directoryListing { - my $root = shift; - my $pwd = shift; - my $showdates = shift; - my $dir = $root . '/' . $pwd; - my (@values, %labels, $size, $data); + my ($self, $pwd) = @_; + my $dir = "$self->{courseRoot}/$pwd"; return unless -d $dir; + + my (@values, $size, $data); + my $len = 24; - my @names = sortByName(undef, grep(/^[^.]/, readDirectory($dir))); - foreach my $name (@names) { + my @names = sortByName(undef, grep {/^[^.]/} readDirectory($dir)); + for my $name (@names) { unless ($name eq 'DATA') { #FIXME don't view the DATA directory - my $file = "$dir/$name"; - push(@values, $name); - $labels{$name} = $name; - $labels{$name} .= '@' if (-l $file); - $labels{$name} .= '/' if (-d $file && !-l $file); - $len = length($labels{$name}) if length($labels{$name}) > $len; + my $file = "$dir/$name"; + my $label = $name; + $label .= '@' if (-l $file); + $label .= '/' if (-d $file && !-l $file); + $len = length($label) if length($label) > $len; + push(@values, [ $label => $name ]); } } - if ($showdates) { + if ($self->getFlag('dates')) { $len += 3; - foreach my $name (@values) { - my $file = "$dir/$name"; + for my $name (@values) { + my $file = "$dir/$name->[1]"; my ($size, $date) = (lstat($file))[ 7, 9 ]; - $labels{$name} = sprintf("%-${len}s%-16s%10s", - $labels{$name}, ((-d $file) ? ("", "") : (getDate($date), getSize($size)))); + $name->[0] = + $self->r->b( + sprintf("%-${len}s%-16s%10s", $name->[0], -d $file ? ('', '') : (getDate($date), getSize($size))) + =~ s/\s/ /gr); } } - return (\@values, \%labels); + return \@values; } sub getDate { my ($sec, $min, $hour, $day, $month, $year) = localtime(shift); - sprintf("%02d-%02d-%04d %02d:%02d", $month + 1, $day, $year + 1900, $hour, $min); + return sprintf('%02d-%02d-%04d %02d:%02d', $month + 1, $day, $year + 1900, $hour, $min); } sub getSize { my $size = shift; - return $size . " B " if $size < 1024; - return sprintf("%.1f KB", $size / 1024) if $size < 1024 * 100; - return sprintf("%d KB", int($size / 1024)) if $size < 1024 * 1024; - return sprintf("%.1f MB", $size / 1024 / 1024) if $size < 1024 * 1024 * 100; - return sprintf("%d MB", $size / 1024 / 1024); + return $size . ' B ' if $size < 1024; + return sprintf('%.1f KB', $size / 1024) if $size < 1024 * 100; + return sprintf('%d KB', int($size / 1024)) if $size < 1024 * 1024; + return sprintf('%.1f MB', $size / 1024 / 1024) if $size < 1024 * 1024 * 100; + return sprintf('%d MB', $size / 1024 / 1024); } -################################################## -# -# Check if a file is a symbolic link that we -# are not allowed to follow. -# +# Check if a file is a symbolic link that we are not allowed to follow. sub isSymLink { my $self = shift; my $file = shift; @@ -1301,18 +698,15 @@ sub isSymLink { $courseRoot = readlink($courseRoot) if -l $courseRoot; my $pwd = $self->{pwd} || $self->r->param('pwd') || HOME; my $link = File::Spec->rel2abs(readlink($file), "$courseRoot/$pwd"); - # + # Remove /./ and dir/../ constructs - # $link =~ s!(^|/)(\.(/|$))+!$1!g; while ($link =~ s!((\.[^./]+|\.\.[^/]+|[^./][^/]*)/\.\.(/|$))!!) { } - # # Look through the list of valid paths to see if this link is OK - # my $valid = $self->{ce}{webworkDirs}{valid_symlinks}; if (defined $valid && $valid) { - foreach my $path (@{$valid}) { + for my $path (@{$valid}) { return 0 if substr($link, 0, length($path)) eq $path; } } @@ -1320,10 +714,7 @@ sub isSymLink { return 1; } -################################################## -# # Normalize the working directory and check if it is OK. -# sub checkPWD { my $self = shift; my $pwd = shift; @@ -1343,7 +734,7 @@ sub checkPWD { my @dirs = split('/', $pwd); pop(@dirs) if $renameError; # don't check file iteself in this case my @path = ($self->{ce}{courseDirs}{root}); - foreach my $dir (@dirs) { + for my $dir (@dirs) { push @path, $dir; return if ($self->isSymLink(join('/', @path))); } @@ -1358,10 +749,7 @@ sub checkPWD { return $pwd; } -################################################## -# # Check that a file is uploaded to the correct directory -# sub checkFileLocation { my $self = shift; my $r = $self->r; @@ -1374,37 +762,33 @@ sub checkFileLocation { $location =~ s!/\.\*!!; return if $dir =~ m/^$location$/; $self->addbadmessage( - $r->maketext("Files with extension '.[_1]' usually belong in '[_2]'", $extension, $location) + $r->maketext('Files with extension ".[_1]" usually belong in "[_2]"', $extension, $location) . ( ($extension eq 'csv') - ? $r->maketext(". If this is a class roster, rename it to have extension '.lst'") + ? $r->maketext('. If this is a class roster, rename it to have extension ".lst"') : '' ) ); + + return; } -################################################## -# # Check a name for bad characters, etc. -# sub checkName { my $file = shift; $file =~ s!.*[/\\]!!; # remove directory $file =~ s/[^-_.a-zA-Z0-9 ]/_/g; # no illegal characters $file =~ s/^\./_/; # no initial dot - $file = "newfile.txt" unless $file; # no blank names + $file = 'newfile.txt' unless $file; # no blank names return $file; } -################################################## -# # Get a unique name (in case it already exists) -# sub uniqueName { my $dir = shift; my $name = shift; return $name unless (-e "$dir/$name"); - my $type = ""; + my $type = ''; my $n = 1; $type = $1 if ($name =~ s/(\.[^.]*)$//); $n = $1 if ($name =~ s/_(\d+)$/_/); @@ -1412,11 +796,7 @@ sub uniqueName { return "${name}_$n$type"; } -################################################## -# -# Verify that a name can be added to the current -# directory. -# +# Verify that a name can be added to the current directory. sub verifyName { my $self = shift; my $name = shift; @@ -1428,26 +808,23 @@ sub verifyName { unless ($name =~ m![^-_.a-zA-Z0-9 ]!) { my $file = "$self->{courseRoot}/$self->{pwd}/$name"; return $file unless (-e $file); - $self->addbadmessage($r->maketext("A file with that name already exists")); + $self->addbadmessage($r->maketext('A file with that name already exists')); } else { - $self->addbadmessage($r->maketext("Your [_1] name contains illegal characters", $object)); + $self->addbadmessage($r->maketext('Your [_1] name contains illegal characters', $object)); } } else { - $self->addbadmessage($r->maketext("Your [_1] name may not begin with a dot", $object)); + $self->addbadmessage($r->maketext('Your [_1] name may not begin with a dot', $object)); } } else { - $self->addbadmessage($r->maketext("Your [_1] name may not contain a path component", $object)); + $self->addbadmessage($r->maketext('Your [_1] name may not contain a path component', $object)); } } else { - $self->addbadmessage($r->maketext("You must specify a [_1] name", $object)); + $self->addbadmessage($r->maketext('You must specify a [_1] name', $object)); } return; } -################################################## -# # Verify that a file path is valid -# sub verifyPath { my $self = shift; my $path = shift; @@ -1462,95 +839,41 @@ sub verifyPath { $path = $self->{courseRoot} . '/' . $path; $path .= '/' . $name if -d $path && $name; return $path unless (-e $path); - $self->addbadmessage($r->maketext("A file with that name already exists")); + $self->addbadmessage($r->maketext('A file with that name already exists')); } else { - $self->addbadmessage($r->maketext("You have specified an illegal path")); + $self->addbadmessage($r->maketext('You have specified an illegal path')); } } else { - $self->addbadmessage($r->maketext("You can not specify an absolute path")); + $self->addbadmessage($r->maketext('You can not specify an absolute path')); } } else { - $self->addbadmessage($r->maketext("Your file name contains illegal characters")); + $self->addbadmessage($r->maketext('Your file name contains illegal characters')); } } else { - $self->addbadmessage($r->maketext("You must specify a file name")); + $self->addbadmessage($r->maketext('You must specify a file name')); } return; } -################################################## -# # Get the value of a parameter flag -# sub getFlag { - my $self = shift; - my $flag = shift; - my $default = shift; - $default = 0 unless defined $default; - my $value = $self->r->param($flag); - $value = $default unless defined $value; - return $value; -} - -################################################## -# -# Make HTML symbols printable -# -sub showHTML { - my $string = shift; - return '' unless defined $string; - $string =~ s/&/\&/g; - $string =~ s//\>/g; - $string; + my ($self, $flag, $default) = @_; + $default //= 0; + return $self->r->param($flag) // $default; } -################################################## -# # Check if a string is plain text -# sub isText { my $string = shift; return utf8::is_utf8($string); } -################################################## -# -# Convert spaces to  , but only REAL spaces -# -sub sp2nbsp { - my $s = shift; - $s =~ s/ /\ /g; - return $s; -} - -################################################## -# -# Hack to convert multiple spaces in the file -# selection box into   so that the columns -# will allign properly in fixed-width fonts. -# We have to do it agter the fact, since CGI:: -# is being "helpful" by turning & in the labels -# into & for us. So we have to convert -# after the +
      +
      +
      +
      + <%= label_for delete_location_addresses => maketext( + 'Existing addresses for the location are given in the scrolling list below. ' + . 'Select addresses from the list to delete them:' + ) =%> +
      +
      + <%= select_field delete_location_addresses => $locAddresses, + id => 'delete_location_addresses', size => 8, multiple => undef, class => 'form-select' =%> +
      +
      <%= maketext('or') %>
      +
      +
      + +
      +
      +
      +
      +
      + <%= submit_button maketext('Take Action!'), class => 'btn btn-primary' =%> +
      +% end diff --git a/templates/ContentGenerator/CourseAdmin/hide_inactive_course_form.html.ep b/templates/ContentGenerator/CourseAdmin/hide_inactive_course_form.html.ep new file mode 100644 index 0000000000..478d792048 --- /dev/null +++ b/templates/ContentGenerator/CourseAdmin/hide_inactive_course_form.html.ep @@ -0,0 +1,60 @@ +

      <%= maketext('Hide Courses') %>

      +

      + <%= maketext( + 'Select the course(s) you want to hide (or unhide) and then click "Hide Courses" (or "Unhide Courses"). ' + . 'Hiding a course that is already hidden does no harm (the action is skipped). Likewise unhiding a ' + . 'course that is already visible does no harm (the action is skipped). Hidden courses are still active ' + . 'but are not listed in the list of WeBWorK courses on the opening page. To access the course, an ' + . 'instructor or student must know the full URL address for the course.' + ) =%> +

      +

      + <%= maketext( + 'Courses are listed either alphabetically or in order by the time of most recent login activity, ' + . 'oldest first. To change the listing order check the mode you want and click "Refresh Listing". ' + . 'The listing format is: Course_Name (status :: date/time of most recent login) where status is "hidden" ' + . 'or "visible".' + ) =%> +

      +%= form_for $c->uri, method => 'POST', begin +
      +
      <%= maketext('Select a listing format:') =%>
      + % for ( + % [ alphabetically => maketext('alphabetically') ], + % [ last_login => maketext('by last login date') ] + % ) + % { +
      + <%= radio_button hide_listing_format => $_->[0], + id => "hide_listing_format_$_->[0]", + class => 'form-check-input', + $_->[0] eq 'alphabetically' ? (checked => undef) : () =%> + <%= label_for "hide_listing_format_$_->[0]" => $_->[1], class => 'form-check-label' =%> +
      + % } +
      +
      + <%= submit_button maketext('Refresh Listing'), name => 'hide_course_refresh', class => 'btn btn-primary' =%> + <%= submit_button maketext('Hide Courses'), name => 'hide_course', class => 'btn btn-primary' =%> + <%= submit_button maketext('Unhide Courses'), name => 'unhide_course', class => 'btn btn-primary' =%> +
      + <%= $cg->hidden_authen_fields =%> + <%= $cg->hidden_fields('subDisplay') =%> + % +
      <%= maketext('Select course(s) to hide or unhide.') %>
      +
      + <%= label_for hide_courseIDs => maketext('Course Name:'), class => 'col-auto col-form-label fw-bold' =%> +
      + <%= select_field hide_courseIDs => [ map { [ $courseLabels->{$_} => $_ ] } @$hideCourseIDs ], + id => 'hide_courseIDs', + class => 'form-select', + multiple => undef, + size => 15 =%> +
      +
      +
      + <%= submit_button maketext('Refresh Listing'), name => 'hide_course_refresh', class => 'btn btn-primary' =%> + <%= submit_button maketext('Hide Courses'), name => 'hide_course', class => 'btn btn-primary' =%> + <%= submit_button maketext('Unhide Courses'), name => 'unhide_course', class => 'btn btn-primary' =%> +
      +% end diff --git a/templates/ContentGenerator/CourseAdmin/manage_location_form.html.ep b/templates/ContentGenerator/CourseAdmin/manage_location_form.html.ep new file mode 100644 index 0000000000..8c662e6ca3 --- /dev/null +++ b/templates/ContentGenerator/CourseAdmin/manage_location_form.html.ep @@ -0,0 +1,152 @@ +

      <%= maketext('Manage Locations') %>

      +

      <%= maketext('Currently defined locations are listed below.') %>

      +%= form_for $c->uri, method => 'POST', begin + % my @locationIDs = map { $_->location_id } @$locations; + % + <%= $cg->hidden_authen_fields =%> + <%= $cg->hidden_fields('subDisplay') =%> + % +
      +
      <%= maketext('Select an action to perform:') =%>
      + % # Edit action +
      +
      +
      + +
      +
      +
      <%= select_field edit_location => [@locationIDs], class => 'form-select' =%>
      +
      + % # Create action +
      +
      +
      + +
      +
      +
      +
      + <%= label_for new_location_name => maketext('Location name:'), class => 'col-sm-4 col-form-label' =%> +
      + <%= text_field new_location_name => '', id => 'new_location_name', class => 'form-control' =%> +
      +
      +
      + <%= label_for new_location_description => maketext('Location description:'), + class => 'col-sm-4 col-form-label' =%> +
      + <%= text_field new_location_description => '', + id => 'new_location_description', class => 'form-control' =%> +
      +
      +
      +
      + <%= label_for new_location_addresses => maketext( + 'Addresses for new location. Enter one per line, as single IP addresses (e.g., 192.168.1.101), ' + . 'address masks (e.g., 192.168.1.0/24), or IP ranges (e.g., 192.168.1.101-192.168.1.150):' + ) =%> +
      +
      +
      +
      + <%= text_area new_location_addresses => '', id => 'new_location_addresses', + columns => 40, class => 'form-control' =%> +
      +
      + % # Delete action +
      +
      + + <%= maketext('Deletion deletes all location data and related addresses, and is not undoable!') %> + +
      +
      +
      +
      +
      + +
      +
      +
      +
      +
      + <%= select_field delete_location => [ + [ maketext('no location') => '' ], + [ maketext('locations selected below') => 'selected_locations' ], + @locationIDs + ], class => 'form-select' =%> +
      +
      +
      +
      +
      + +
      +
      +
      +
      +
      +
      + % +
      <%= submit_button maketext('Take Action!'), name => 'manage_locations', class => 'btn btn-primary' =%>
      + % + % # Existing location table + % if (@$locations) { +
      + + + + + + + + + + + % for (@$locations) { + + + + + + + % } + +
      <%= maketext('Select') %><%= maketext('Location') %><%= maketext('Description') %><%= maketext('Addresses') %>
      + <%= check_box delete_selected => $_->location_id, + name => 'delete_selected', + id => $_->location_id . '_id', + class => 'form-check-input' =%> + + <%= label_for $_->location_id . '_id' => + link_to $_->location_id => $cg->systemLink( + $urlpath, + params => { + subDisplay => 'manage_locations', + manage_location_action => 'edit_location_form', + edit_location => $_->location_id + } + ) =%> + <%= $_->description %><%= join(', ', @{ $locAddr->{ $_->location_id } }) %>
      +
      + % } else { +
      +
      <%= maketext('No locations are currently defined.') %>
      +
      + % } +% end diff --git a/templates/ContentGenerator/CourseAdmin/registration_form.html.ep b/templates/ContentGenerator/CourseAdmin/registration_form.html.ep new file mode 100644 index 0000000000..bd47a8b7bf --- /dev/null +++ b/templates/ContentGenerator/CourseAdmin/registration_form.html.ep @@ -0,0 +1,76 @@ +% if ( + % -e "$ce->{courseDirs}{root}/registered_$ce->{WW_VERSION}" + % || param('register_site') + % || (defined param('subDisplay') && param('subDisplay') eq 'registration') +% ) +% { + % # Show registered note. +
      REGISTERED for WeBWorK <%= $ce->{WW_VERSION} %>
      +% } else { + % # Otherwise show the registration form. +
      +
      +

      + Please consider registering for the WW-security-announce Google group / mailing list + using the join group link on the + <%= link_to 'group page' => $ce->{webworkURLs}{wwSecurityAnnounce}, target => '_blank' %> + which appears when you are logged in to a Google account or by sending an email using + <%= link_to 'this mailto link' => + join('', + "mailto:$ce->{webworkSecListManagers}?subject=", + 'Joining ww-security-announce', + '&body=', + "Server URL: $ce->{server_root_url}\n", + "WeBWorK version: $ce->{WW_VERSION}\n", + "Institution name: \n") %> + This list will help us keep you updated about security issues and patches, and important related + announcements. +

      +
      +

      + Please consider contributing to WeBWorK development either with a one time contribution or monthly + support. The WeBWorK Project is a registered 501(c)(3) organization and contributions are tax deductible + in the United States. +

      +
      + <%= link_to 'https://github.com/sponsors/openwebwork', + class => 'btn btn-secondary', target => '_blank', begin =%> + Sponsor + <%= end =%> +
      +
      +

      This site is not registered for WeBWorK version <%= $ce->{WW_VERSION} %>.

      +

      + We are often asked how many institutions are using WeBWorK and how many students are using WeBWorK. + Since WeBWorK is open source and can be freely downloaded from + <%= link_to $ce->{webworkURLs}{GitHub} => $ce->{webworkURLs}{GitHub}, target => '_blank' %>, + it is frequently difficult for us to give a reasonable answer to this question. +

      +

      + You can help by + <%= link_to 'registering your current version of WeBWorK' => $ce->{webworkURLs}{serverRegForm}, + target => '_blank' %>. + Please complete the Google form as best you can and submit your answers to the WeBWorK Project team. It + takes just 2-3 minutes. Thank you! The WeBWorK Project +

      +

      + Eventually your site will be listed along with all of the others on the + <%= link_to 'site map' => $ce->{webworkURLs}{SiteMap}, target => '_blank' %> + on the main + <%= link_to 'WeBWorK Wiki' => $ce->{webworkURLs}{WikiMain}, target => '_blank' %>. +

      +
      +

      You can hide this "registration" banner for the future by clicking the button below.

      + <%= form_for $c->uri, method => 'POST', id => 'return_to_main_page', begin =%> + <%= $cg->hidden_authen_fields =%> + <%= hidden_field subDisplay => 'registration' =%> +
      + <%= submit_button 'Hide the banner.', + id => 'register_site', + name => 'register_site', + class => 'btn btn-primary' =%> +
      + <%= end =%> +
      +
      +% } diff --git a/templates/ContentGenerator/CourseAdmin/rename_course_confirm.html.ep b/templates/ContentGenerator/CourseAdmin/rename_course_confirm.html.ep new file mode 100644 index 0000000000..cd8357ed4b --- /dev/null +++ b/templates/ContentGenerator/CourseAdmin/rename_course_confirm.html.ep @@ -0,0 +1,90 @@ +

      <%= maketext('Rename Course') =%>

      +% # Report on databases +

      <%= maketext('Report on database structure for course [_1]:', $rename_oldCourseID) %>

      +% if (@$upgrade_report) { + % for (@$upgrade_report) { +

      <%= $_->[0] %>

      + % } +% } +% my ($all_tables_ok, $extra_database_tables, $extra_database_fields, $db_report) = + % $cg->formatReportOnDatabaseTables($tables_ok, $dbStatus); +<%= $db_report %> +% if ($extra_database_tables) { +

      + <%= maketext( + 'There are extra database tables which are not defined in the schema. ' + . 'These can be deleted when upgrading the course.' + ) =%> +

      +% } +% if ($extra_database_fields) { +

      + <%= maketext( + 'There are extra database fields which are not defined in the schema for at least one table. ' + . 'They can be removed when upgrading the course.' + ) =%> +

      +% } +% if (!$all_tables_ok) { +

      + <%= maketext('The course database must be upgraded before renaming this course.') =%> +

      +% } +% # Report on directories +

      Directory structure

      +
        + % for (@$directory_report) { +
      • <%= $_->[0] %>: <%= $_->[1] %>
        • + % } +
      +% if ($directories_ok) { +

      <%= maketext('Directory structure is ok') %>

      +% } else { +

      + <%= maketext('Directory structure is missing directories or the webserver lacks sufficient privileges.') =%> +

      +% } +
      +% # Print form for choosing next action. +%= form_for $c->uri, method => 'POST', begin + <%= $cg->hidden_authen_fields =%> + <%= $cg->hidden_fields( + qw(subDisplay rename_oldCourseID rename_newCourseID rename_newCourseTitle rename_newCourseInstitution + rename_newCourseID_checkbox rename_newCourseInstitution_checkbox rename_newCourseTitle_checkbox) + ) =%> + <%= hidden_field rename_oldCourseTitle => $rename_oldCourseTitle, id => 'hidden_rename_oldCourseTitle' =%> + <%= hidden_field rename_oldCourseInstitution => $rename_oldCourseInstitution, + id => 'hidden_rename_oldCourseInstitution' =%> + % + % if ($all_tables_ok && $directories_ok) { + % # No missing tables, missing fields, or directories +
      +

      <%= maketext('Rename [_1] to [_2]', $rename_oldCourseID, $rename_newCourseID) %>

      + % if ($change_course_title_str) { +
      <%= $change_course_title_str %>
      + % } + % if ($change_course_institution_str) { +
      <%= $change_course_institution_str %>
      + % } +
      + <%= submit_button maketext(q{Don't rename}), + name => 'decline_rename_course', class => 'btn btn-primary' =%> + <%= submit_button maketext('Rename'), + name => 'confirm_rename_course', class => 'btn btn-primary' =%> +
      +
      + % } elsif ($directories_ok) { +
      + <%= submit_button maketext(q{Don't rename}), name => 'decline_rename_course', class => 'btn btn-primary' =%> + <%= submit_button maketext('Upgrade Course Tables'), + name => 'upgrade_course_tables', class => 'btn btn-primary' =%> +
      + % } else { +
      + <%= maketext('Directory structure needs to be repaired manually before renaming.') =%> +
      +
      + <%= submit_button maketext(q{Don't rename}), name => 'decline_rename_course', class => 'btn btn-primary' =%> +
      + % } +% end diff --git a/templates/ContentGenerator/CourseAdmin/rename_course_confirm_short.html.ep b/templates/ContentGenerator/CourseAdmin/rename_course_confirm_short.html.ep new file mode 100644 index 0000000000..77cfa1e0a7 --- /dev/null +++ b/templates/ContentGenerator/CourseAdmin/rename_course_confirm_short.html.ep @@ -0,0 +1,30 @@ +

      <%= maketext('Rename Course') =%>

      +%= form_for $c->uri, method => 'POST', begin + <%= $cg->hidden_authen_fields =%> + <%= $cg->hidden_fields('subDisplay') =%> + <%= $cg->hidden_fields( + qw/rename_oldCourseID rename_newCourseID rename_newCourseTitle rename_newCourseInstitution + rename_newCourseID_checkbox rename_newCourseInstitution_checkbox rename_newCourseTitle_checkbox/ + ) =%> + <%= hidden_field rename_oldCourseTitle => $rename_oldCourseTitle, id => 'hidden_rename_oldCourseTitle' =%> + <%= hidden_field rename_oldCourseInstitution => $rename_oldCourseInstitution, + id => 'hidden_rename_oldCourseInstitution' =%> + % +
      +
      +

      <%= maketext('Make these changes in course: [_1]', $rename_oldCourseID) %>

      + % if ($change_course_title_str) { +

      <%= $change_course_title_str %>

      + % } + % if ($change_course_institution_str) { +

      <%= $change_course_institution_str %>

      + % } +
      +
      + <%= submit_button maketext(q{Don't make changes}), + name => 'decline_retitle_course', + class => 'btn btn-primary' =%> + <%= submit_button maketext('Make changes'), name => 'confirm_retitle_course', class => 'btn btn-primary' =%> +
      +
      +% end diff --git a/templates/ContentGenerator/CourseAdmin/rename_course_form.html.ep b/templates/ContentGenerator/CourseAdmin/rename_course_form.html.ep new file mode 100644 index 0000000000..b68be7c072 --- /dev/null +++ b/templates/ContentGenerator/CourseAdmin/rename_course_form.html.ep @@ -0,0 +1,77 @@ +% use WeBWorK::Utils::CourseManagement qw(listCourses); +% +

      <%= maketext('Rename Course') %>

      +% +% my @courseIDs = sort { lc($a) cmp lc($b) } listCourses($ce); +% +% if (@courseIDs) { + <%= form_for $c->uri, method => 'POST', begin =%> + <%= $cg->hidden_authen_fields =%> + <%= $cg->hidden_fields('subDisplay') =%> + % +

      + <%= maketext( + 'Select a course to rename. The courseID is used in the url and can only contain alphanumeric ' + . 'characters and underscores. The course title appears on the course home page and can be any ' + . 'string.' + ) =%> +

      +
      +
      + <%= label_for rename_oldCourseID => maketext('Course ID:'), + class => 'col-sm-6 col-form-label fw-bold' =%> +
      + <%= select_field rename_oldCourseID => [ map { [ $_ => $_ ] } @courseIDs ], + class => 'form-select', + size => 10, + id => 'rename_oldCourseID' =%> +
      +
      +
      +
      +
      + +
      +
      +
      + <%= text_field rename_newCourseID => '', + class => 'form-control', 'aria-labelledby' => 'rename_newCourseID_label' =%> +
      +
      +
      +
      +
      + +
      +
      +
      + <%= text_field rename_newCourseTitle => '', + class => 'form-control', 'aria-labelledby' => 'rename_newCourseTitle_label' =%> +
      +
      +
      +
      +
      + +
      +
      +
      + <%= text_field rename_newCourseInstitution => '', + class => 'form-control', 'aria-labelledby' => 'rename_newCourseInstitution_label' =%> +
      +
      +
      + <%= submit_button maketext('Rename Course'), name => 'rename_course', class => 'btn btn-primary' =%> + <% end =%> +% } else { +

      <%= maketext('No courses found') %>

      +% } diff --git a/templates/ContentGenerator/CourseAdmin/unarchive_course_confirm.html.ep b/templates/ContentGenerator/CourseAdmin/unarchive_course_confirm.html.ep new file mode 100644 index 0000000000..4003ed448a --- /dev/null +++ b/templates/ContentGenerator/CourseAdmin/unarchive_course_confirm.html.ep @@ -0,0 +1,14 @@ +

      <%= maketext('Unarchive Course') %>

      +%= form_for $c->uri, method => 'POST', begin +

      + <%= maketext('Unarchive [_1] to course:', $unarchive_courseID) %> + +

      + <%= $cg->hidden_authen_fields =%> + <%= $cg->hidden_fields(qw(subDisplay unarchive_courseID create_newCourseID)) =%> +
      + <%= submit_button maketext(q{Don't Unarchive}), + name => 'decline_unarchive_course', class => 'btn btn-primary' =%> + <%= submit_button maketext('Unarchive'), name => 'confirm_unarchive_course', class => 'btn btn-primary' =%> +
      +% end diff --git a/templates/ContentGenerator/CourseAdmin/unarchive_course_form.html.ep b/templates/ContentGenerator/CourseAdmin/unarchive_course_form.html.ep new file mode 100644 index 0000000000..1b86ace136 --- /dev/null +++ b/templates/ContentGenerator/CourseAdmin/unarchive_course_form.html.ep @@ -0,0 +1,58 @@ +% use WeBWorK::Utils::CourseManagement qw(listArchivedCourses); +% +

      <%= maketext('Unarchive Course') %>

      +

      + <%= maketext( + 'Restores a course from a gzipped tar archive (.tar.gz). After unarchiving, the course database is ' + . "restored from a subdirectory of the course's DATA directory. Currently the archive facility is only " + . 'available for mysql databases. It depends on the mysqldump application.' + ) =%> +

      +% +% # Find courses which have been archived. +% my @courseIDs = sort { lc($a) cmp lc($b) } listArchivedCourses($ce); +% +% if (@courseIDs) { + <%= form_for $c->uri, method => 'POST', begin =%> + <%= $cg->hidden_authen_fields =%> + <%= $cg->hidden_fields('subDisplay') =%> + % +
      <%= maketext('Select a course to unarchive.') =%>
      + % +
      +
      + <%= label_for 'unarchive_courseID' => maketext('Course Name:'), class => 'col-sm-4 col-form-label' =%> +
      + <%= select_field unarchive_courseID => \@courseIDs, + id => 'unarchive_courseID', + class => 'form-select', + size => 10 + =%> +
      +
      +
      +
      +
      + +
      +
      +
      + <%= text_field new_courseID => '', + size => 25, + maxlength => $ce->{maxCourseIdLength}, + class => 'form-control', + 'aria-labelledby' => 'create_newCourseID_label' + =%> +
      +
      +
      +
      + <%= submit_button maketext('Unarchive Course'), name => 'unarchive_course', class => 'btn btn-primary' =%> +
      + <% end =%> +% } else { +

      <%= maketext('No course archives found.') %>

      +% } diff --git a/templates/ContentGenerator/CourseAdmin/upgrade_course_confirm.html.ep b/templates/ContentGenerator/CourseAdmin/upgrade_course_confirm.html.ep new file mode 100644 index 0000000000..37a3f254c1 --- /dev/null +++ b/templates/ContentGenerator/CourseAdmin/upgrade_course_confirm.html.ep @@ -0,0 +1,48 @@ +%= form_for $c->uri, method => 'POST', begin + <% my $checkALLs = begin =%> + % if ($extra_database_tables_exist) { +
      + +
      + % } + % if ($extra_database_fields_exist) { +
      + +
      + % } + <% end =%> + % +
      + <%= $checkALLs->() %> +
      + % + <%= $status_output %> + % + % # Print form for choosing next action. + % unless (@$upgrade_courseIDs) { +

      <%= maketext('No course id defined') %>

      + % } + % + <%= $cg->hidden_authen_fields =%> + <%= $cg->hidden_fields('subDisplay') =%> + % +
      + <%= $checkALLs->() %> +
      + % + % # Submit buttons. + % # After presenting a detailed summary of status of selected courses the choice is made to upgrade the selected + % # courses (confirm_upgrade_course is set or return to the beginning (decline_upgrade_course is set) +
      + <%= submit_button maketext(q{Don't Upgrade}), name => 'decline_upgrade_course', class => 'btn btn-primary' =%> + <%= submit_button maketext('Upgrade'), name => 'confirm_upgrade_course', class => 'btn btn-primary' =%> +
      +% end diff --git a/templates/ContentGenerator/CourseAdmin/upgrade_course_form.html.ep b/templates/ContentGenerator/CourseAdmin/upgrade_course_form.html.ep new file mode 100644 index 0000000000..8f51521fbf --- /dev/null +++ b/templates/ContentGenerator/CourseAdmin/upgrade_course_form.html.ep @@ -0,0 +1,63 @@ +% use WeBWorK::Utils::CourseManagement qw(listCourses); +% use WeBWorK::Utils::CourseIntegrityCheck; +% use WeBWorK::CourseEnvironment; +% +% my @courseIDs = sort { lc($a) cmp lc($b) } listCourses($ce); +% +

      <%= maketext('Upgrade Courses') %>

      +
      <%= maketext('Update the checked directories?') %>
      +%= form_for $c->uri, method => 'POST', id => 'courselist', name => 'courselist', begin +
      + + +
      + <%= $cg->hidden_authen_fields =%> + <%= $cg->hidden_fields('subDisplay') =%> + % +
        + % for my $courseID (@courseIDs) { + % next if $courseID eq 'modelCourse'; # modelCourse isn't a real course so it can't be upgraded. + % next unless $courseID =~ /\S/; # Skip empty courseIDs (there shouldn't be any) + % + % my $tempCE = eval { WeBWorK::CourseEnvironment->new({ %WeBWorK::SeedCE, courseName => $courseID }) }; + % if ($@) { + <%= maketext(q{Can't create course environment for [_1] because [_2]}, $courseID, $@) =%> + % } + % my $CIchecker = WeBWorK::Utils::CourseIntegrityCheck->new(ce => $tempCE); + % my ($tables_ok) = $CIchecker->checkCourseTables($courseID); + % my ($directories_ok) = $CIchecker->checkCourseDirectories(); + % +
      • + % if (!$tables_ok || !$directories_ok) { +
        + +
        + % } + <%= link_to $courseID => $cg->systemLink( + $urlpath->newFromModule('WeBWorK::ContentGenerator::ProblemSets', $c, courseID => $courseID), + authen => 0 + ) =%> + <%= $tempCE->{dbLayoutName} %> + % if (!$directories_ok) { + + <%= maketext('Directory structure or permissions need to be repaired.') =%> + + % } + % if ($tables_ok) { + <%= maketext('Database tables ok') %> + % } else { + <%= maketext('Database tables need updating.') %> + % } +
        • + % } +
      + <%= submit_button maketext('Upgrade Courses'), name => 'upgrade_course', class => 'btn btn-primary' =%> +% end diff --git a/templates/ContentGenerator/EquationDisplay.html.ep b/templates/ContentGenerator/EquationDisplay.html.ep new file mode 100644 index 0000000000..f7d9ee103c --- /dev/null +++ b/templates/ContentGenerator/EquationDisplay.html.ep @@ -0,0 +1,9 @@ +
      Copy the location of this image (or drag and drop) into your editing area:
      +

      <%= $typesetStr %>

      +

      <%== $typesetStr %>

      +<%= form_for $c->uri, method => 'POST', begin =%> + <%= $cg->hidden_authen_fields =%> + <%= text_area eq => '', class => 'form-control mb-3', placeholder => 'Enter equation here', + cols => 40, rows => 5 =%> + <%= submit_button 'typeset', class => 'btn btn-primary' =%> +<% end =%> diff --git a/templates/ContentGenerator/Feedback.html.ep b/templates/ContentGenerator/Feedback.html.ep new file mode 100644 index 0000000000..141423bc4e --- /dev/null +++ b/templates/ContentGenerator/Feedback.html.ep @@ -0,0 +1,62 @@ +% use Text::Wrap qw(wrap); +% +% unless ($authz->hasPermissions(param('user'), 'submit_feedback')) { +

      <%= maketext('You are not allowed to send e-mail.') %>

      +

      <%= link_to maketext('Cancel E-Mail') => $returnURL %>

      + % last; +% } +% +% unless ($numRecipients) { +

      <%= maketext('No e-mail recipients are listed for this course.') %>

      +

      <%= link_to maketext('Cancel E-Mail') => $returnURL %>

      + % last; +% } +% +% if (defined param('sendFeedback') && !stash('send_error')) { +

      <%= maketext('Your message was sent successfully.') %>

      +

      <%= link_to maketext('Return to your work') => $returnURL =%>

      + 
      <%= wrap('', '', param('feedback')) =%>
      +% } else { + <%= form_for $c->uri, method => 'POST', enctype => 'multipart/form-data', begin =%> + <%= $cg->hidden_authen_fields =%> + <%= $cg->hidden_fields(qw(module set problem displayMode showOldAnswers + showCorrectAnswers showHints showSolutions)) =%> + % +
      + <%= maketext( + 'Use this form to ask your instructor a question, to report a problem with the WeBWorK system, or ' + . 'to report an error in a problem you are attempting. Along with your message, additional ' + . 'information about the state of the system will be included.' + ) =%> +
      +
      + <%= label_for 'from', class => 'col-form-label col-auto', begin =%><%= maketext('From:') %><% end =%> +
      + <%= text_field from => $user_email_address, class => 'form-control', size => 40, id => 'from', + $user_email_address ? (disabled => undef, readonly => undef) : (required => undef) =%> +
      +
      + % if (stash 'send_error') { +
      <%= stash 'send_error' %>
      + % } +
      + <%= label_for 'feedback', class => 'form-label', begin =%><%= maketext('E-mail:') %><% end =%> + <%= text_area feedback => '', id => 'feedback', rows => '20', class => 'form-control', + placeholder => maketext('Compose Email Message'), required => undef =%> +
      + % # Attachment +
      + <%= label_for 'attachment', class => 'col-form-label col-auto', begin =%> + <%= maketext('Attachment:') %> + <%= end %> +
      + <%= file_field 'attachment', id => 'attachment', class => 'form-control', + accept => 'image/*,application/pdf,application/zip,text/plain,text/csv' =%> +
      +
      + <%= submit_button maketext('Send E-mail'), name => 'sendFeedback', class => 'btn btn-primary mb-1' =%> + <% end =%> + % if ($returnURL) { +
      <%= link_to maketext('Cancel E-mail') => $returnURL, class => 'btn btn-primary mt-2' =%>
      + % } +% } diff --git a/templates/ContentGenerator/GatewayQuiz.html.ep b/templates/ContentGenerator/GatewayQuiz.html.ep new file mode 100644 index 0000000000..1d9aa08c55 --- /dev/null +++ b/templates/ContentGenerator/GatewayQuiz.html.ep @@ -0,0 +1,706 @@ +% use WeBWorK::Utils qw(before after wwRound getAssetURL); +% use WeBWorK::Utils::LanguageAndDirection qw(get_problem_lang_and_dir); +% use WeBWorK::HTML::SingleProblemGrader; +% use WeBWorK::AchievementEvaluator qw(checkForAchievements); +% +% content_for css => begin + <%= stylesheet $cg->url({ type => 'webwork', name => 'theme', file => 'achievements.css' }) =%> + <%= stylesheet $cg->url({ type => 'webwork', name => 'theme', file => 'gateway.css' }) =%> + % # Output css for jquery-ui for problems to use. + <%= stylesheet getAssetURL($ce, 'node_modules/jquery-ui-dist/jquery-ui.min.css') =%> + % + % # Add CSS files requested by problems via ADD_CSS_FILE() in the PG file + % # or via a setting of $ce->{pg}{specialPGEnvironmentVars}{extra_css_files} + % # which can be set in course.conf (the value should be an anonomous array). + % my @cssFiles; + % if (ref($ce->{pg}{specialPGEnvironmentVars}{extra_css_files}) eq 'ARRAY') { + % push(@cssFiles, { file => $_, external => 0 }) for @{ $ce->{pg}{specialPGEnvironmentVars}{extra_css_files} }; + % } + % for my $pg (@{ stash->{pg_results} }) { + % next unless ref($pg); + % if (ref($pg->{flags}{extra_css_files}) eq 'ARRAY') { + % push @cssFiles, @{ $pg->{flags}{extra_css_files} }; + % } + % } + % my %cssFilesAdded; # Used to avoid duplicates + % for (@cssFiles) { + % next if $cssFilesAdded{ $_->{file} }; + % $cssFilesAdded{ $_->{file} } = 1; + % if ($_->{external}) { + <%= stylesheet $_->{file} =%> + % } else { + <%= stylesheet getAssetURL($ce, $_->{file}) =%> + % } + % } +% end +% +% content_for js => begin + % if ($cg->{will}{showProblemGrader}) { + <%= javascript getAssetURL($ce, 'js/apps/ProblemGrader/problemgrader.js'), defer => undef =%> + % } + % + % # Page specfific javascript + <%= javascript getAssetURL($ce, 'js/apps/GatewayQuiz/gateway.js'), defer => undef =%> + % + % # Output javascript for jquery-ui for problems to use. + <%= javascript getAssetURL($ce, 'node_modules/jquery-ui-dist/jquery-ui.min.js') =%> + % + % # Add JS files requested by problems via ADD_JS_FILE() in the PG file. + % my %jsFiles; + % for my $pg (@{ stash->{pg_results} }) { + % next unless ref($pg); + % if (ref($pg->{flags}{extra_js_files}) eq 'ARRAY') { + % for (@{ $pg->{flags}{extra_js_files} }) { + % next if $jsFiles{ $_->{file} }; + % $jsFiles{ $_->{file} } = 1; + % + % my %attributes = ref($_->{attributes}) eq 'HASH' ? %{ $_->{attributes} } : (); + % if ($_->{external}) { + <%= javascript $_->{file}, %attributes =%> + % } else { + <%= javascript getAssetURL($ce, $_->{file}), %attributes =%> + % } + % } + % } + % } +% end +% +% my $userID = param('user'); +% my $effectiveUserID = param('effectiveUser'); +% +% # If the set or problem is invalid, then show that information and exit. +% if ($cg->{invalidSet} || $cg->{invalidProblem}) { +
      +
      + <%= maketext( + 'The selected problem set ([_1]) is not a valid set for [_2]: [_3]', + $urlpath->arg('setID'), $effectiveUserID, $cg->{invalidVersionCreation} ? " (acted as by $userID)" : '' + ) =%> +
      +
      <%== $cg->{invalidSet} %>
      + % if ($cg->{invalidVersionCreation} && $cg->{invalidVersionCreation} == 1) { +

      + <%= link_to 'Create new set version.' => $cg->systemLink( + $urlpath->newFromModule($urlpath->module, $c, + courseID => $urlpath->arg('courseID'), setID => $urlpath->arg('setID') + ), + params => { effectiveUser => $effectiveUserID, user => $userID, createnew_ok => 1 }) =%> +

      + % } +
      + % + % last; +% } +% +% # If there were translation errors, then show those and exit. +% if (@{ $cg->{errors} }) { + % my $errorNum = 1; + % my ($message, $context) = (c, c); + % for (@{ $cg->{errors} }) { + % push(@$message, "$errorNum. ") if (@{ $cg->{errors} } > 1); + % push(@$message, $_->{message}, tag('br')); + % + % my $line = begin +

      <%= (@{ $cg->{errors} } > 1 ? "$errorNum." : '') %><%== $_->{context} %>

      +
      + % end + % push @$context, $line->(); + % } + <%= include 'ContentGenerator/Base/error_output', error => $message->join(''), details => $context->join('') =%> + % + % last; +% } +% +% my $setID = $cg->{set}->set_id; +% my $setVersionID = $cg->{set}->version_id; +% my $numProbPerPage = $cg->{set}->problems_per_page; +% +% if ($cg->{will}{recordAnswers}) { + % my $divClass = 'ResultsWithoutError'; + % my $recdMsg = ''; + % for (@{ $cg->{scoreRecordedMessage} }) { + % if ($_ ne 'recorded') { + % $recdMsg = $_; + % $divClass = 'ResultsWithError'; + % last; + % } + % } + % +
      + % # A handy noun for when referring to a test. + % my $testNoun = ($cg->{set}->attempts_per_version || 0) > 1 ? maketext('submission') : maketext('test'); + % my $testNounNum = + % (($cg->{set}->attempts_per_version || 0) > 1) + % ? maketext('submission (version [_1])', $setVersionID) + % : maketext('version ([_1])', $setVersionID); + % + % if ($recdMsg) { + % # There was an error when saving the results + <%= maketext('Your score on this [_1] was NOT recorded.', $testNounNum) %> <%= $recdMsg %> +
      + % } else { + % # No error. Output recorded message. + <%= maketext('Your score on this [_1] WAS recorded.', $testNounNum) %> +
      + % # Show the score if that is allowed. + % if ($cg->{can}{showScore}) { + + <%= maketext('Your score on this [_1] is [_2]/[_3].', + $testNoun, $cg->{attemptScore}, $cg->{totalPossible}) =%> + + % } else { + % if ($cg->{set}->hide_score eq 'BeforeAnswerDate') { + <%= maketext('(Your score on this [_1] is not available until [_2].)', + $testNoun, $cg->formatDateTime($cg->{set}->answer_date)) =%> + % } else { + <%= maketext('(Your score on this [_1] is not available.)', $testNoun) =%> + % } + % } + % # Print a message when submitting the score to an LMS. + % if ($cg->{LTIGradeResult} != -1) { +
      + <%= $cg->{LTIGradeResult} + ? maketext('Your score was successfully sent to the LMS.') + : maketext('Your score was not successfully sent to the LMS.') =%> + % } + % } +
      + % + % # Finally, if there is another recorded message, output that too. + % if ( + % $cg->{set}->attempts_per_version > 1 + % && $cg->{attemptNumber} > 0 + % && $cg->{recordedScore} != $cg->{attemptScore} + % && $cg->{can}{showScore} + % ) + % { +
      + <%= maketext('The recorded score for this version is [_1]/[_2].', + wwRound(2, $cg->{recordedScore}), $cg->{totalPossible}) =%> +
      + % } +% } elsif ($cg->{will}{checkAnswers}) { + % if ($cg->{can}{showScore}) { +
      + + <%= maketext('Your score on this (checked, not recorded) submission is [_1]/[_2].', + $cg->{attemptScore}, $cg->{totalPossible}) =%> + +
      + <%= maketext('The recorded score for this version is [_1]/[_2].', + wwRound(2, $cg->{recordedScore}), $cg->{totalPossible}) =%> +
      + % } +% } +% +% # Display the reduced scoring message if reduced scoring is enabled and the set is in the reduced scoring period. +% if ($ce->{pg}{ansEvalDefaults}{enableReducedScoring} + % && $cg->{set}->enable_reduced_scoring + % && after($cg->{set}->reduced_scoring_date, $submitTime) + % && before($cg->{set}->due_date, $submitTime) + % && ($cg->{can}{recordAnswersNextTime} || $cg->{submitAnswers})) +% { +
      + + <%== maketext('Note: [_1]', + tag('i', maketext('You are in the Reduced Scoring Period. All work counts for [_1]% of the original.', + $ce->{pg}{ansEvalDefaults}{reducedScoringValue} * 100))) =%> + +
      +% } +% +% # Remaining output of test headers. +% # Display timer or information about elapsed time, output link, and information about any recorded score if not +% # submitAnswers or checkAnswers. +% if ($cg->{can}{recordAnswersNextTime}) { + % my $timeLeft = $cg->{set}->due_date - int($submitTime); # This is in seconds + % + % # Print the timer if there is less than 24 hours left. + % if ($timeLeft < 86400) { + <%= tag('div', + id => 'gwTimer', + class => 'alert alert-warning p-1', + data => { + server_time => int($submitTime), + server_due_time => $cg->{set}->due_date, + grace_period => $ce->{gatewayGracePeriod}, + alert_title => maketext('Test Time Notification'), + alert_three => maketext( + 'You have less than 90 seconds left to complete this assignment. You should finish it soon!'), + alert_two => ('
      ' . maketext('You have less than 45 seconds left!') . '
      ') + . ( + ($cg->{set}->attempts_per_version > 1 && $cg->{attemptNumber} > 0) ? '' + : '
      ' . maketext('Press "Grade Test" soon!') . '
      ' + ), + alert_one => ('
      ' . maketext('You are out of time!') . '
      ') + . ( + ($cg->{set}->attempts_per_version > 1 && $cg->{attemptNumber} > 0) ? '' + : '
      ' . maketext('Press "Grade Test" now!') . '
      ' + ), + $userID ne $effectiveUserID ? (acting => 1) : () + }, + # '00:00:00' is a placeholder that is replaced by the actual time remaining via javascript. + maketext('Remaining time: [_1]', '00:00:00') + ) =%> + % } + % + % if ($timeLeft < 60 && $timeLeft > 0 && !$authz->hasPermissions($userID, 'record_answers_when_acting_as_student')) { +
      + <%= maketext('You have less than 1 minute to complete this test.') %> +
      + % } elsif ($timeLeft <= 0 && !$authz->hasPermissions($userID, 'record_answers_when_acting_as_student')) { +
      + + <%= maketext('You are out of time!') + . ( + $cg->{set}->attempts_per_version > 1 + && $cg->{attemptNumber} > 0 ? '' : ' ' . maketext('Press "Grade Test" now!') + ) =%> + +
      + % } + % # If there are multiple attempts per version, then indicate the number remaining. If a multiple attempt + % # multi-page test has been submitted, then show the score on the previous submission. + % if ($cg->{set}->attempts_per_version > 1) { +
      + <%= maketext('You have [_1] attempt(s) remaining on this test.', $cg->{numAttemptsLeft}) %> +
      + % if ($cg->{numAttemptsLeft} < $cg->{set}->attempts_per_version + % && $numPages > 1 + % && $cg->{can}{showScore}) + % { +
      + <%= maketext('Score summary for last submission:') %> + + + + + + + + + % for (0 .. $#{ $cg->{probStatus} }) { + + + + + + + + % } +
      <%= maketext('Prob') %><%= maketext('Status') %><%= maketext('Result') %>
      <%= $_ + 1 %><%= int(100 * $cg->{probStatus}[ $probOrder->[$_] ] + 0.5) . '%' %> + <%= $cg->{probStatus}[ $probOrder->[$_] ] == 1 + ? maketext('Correct') + : maketext('Incorrect') %> +
      +
      + % } + % } +% } else { + % if (!$cg->{checkAnswers} && !$cg->{submitAnswers} && $cg->{can}{showScore}) { +
      + + <%= maketext('Your recorded score on this test (version [_1]) is [_2]/[_3].', + $setVersionID, wwRound(2, $cg->{recordedScore}), $cg->{totalPossible}) + . ( + $cg->{exceededAllowedTime} && $cg->{recordedScore} == 0 + ? ' ' . maketext('You exceeded the allowed time.') + : '' + ) =%> + +
      +
      + % } + % + % if ($cg->{set}->version_last_attempt_time) { +
      + <%= maketext('Time taken on test: [_1] min ([_2] min allowed).', + $cg->{elapsedTime}, sprintf('%.0f', 10 * ($cg->{set}->due_date - $cg->{set}->open_date) / 6) / 100) %> +
      + % } elsif ($cg->{exceededAllowedTime} && $cg->{recordedScore} != 0) { +
      + <%= maketext('(This test is overtime because it was not submitted in the allowed time.)') %> +
      + % } + % + % if ($cg->{can}{showWork} && $setID ne 'Undefined_Set') { +
      +
      +
      + <%= maketext('The test (which is version [_1]) may no longer be submitted for a grade.', + $setVersionID) + . ($cg->{can}{showScore} ? (' ' . maketext('You may still check your answers.')) : '') %> +
      +
      + % # Display a print test link if the user is allowed to see work. +
      + <%= link_to maketext('Print Test') => + "$ce->{webworkURLs}{root}/$ce->{courseName}/hardcopy/" + . $setID . ',v' + . $setVersionID . '/?' + . $cg->url_authen_args, + class => 'btn btn-info' =%> +
      +
      + % } +% } +% +% my $action = $c->uri; +% +% # This is a hack to get a URL that will not require a proctor login if a proctored test has been submitted for the +% # last time. The assignment type has already been reset in this case, so use that to decide if we should give a path +% # to an unproctored test. +% $action =~ s/proctored_test_mode/test_mode/ if $cg->{set}->assignment_type eq 'gateway'; +% +% # Make sure that if this is a set, then the 'action' in the form points to the same set. +% $action =~ s/(test_mode\/$setID)\/?$/$1,v$setVersionID\//; +% +% if (!$cg->{can}{recordAnswersNextTime} && !$cg->{can}{showWork}) { + % # Problems can not be shown. +
      + % if ($cg->{set}->hide_work eq 'BeforeAnswerDate') { + + <%= maketext('Completed results for this assignment are not available until [_1].', + $cg->formatDateTime($cg->{set}->answer_date)) %> + + % } else { + <%= maketext('Completed results for this assignment are not available.') %> + % } +
      +% } else { + % # Problems can be shown, so output the main form and the problems. + % my $startTime = param('startTime') || time; + % + <%= form_for $action, name => 'gwquiz', method => 'POST', class => 'problem-main-form', begin =%> + <%= $cg->hidden_authen_fields =%> + <%= $cg->hidden_proctor_authen_fields =%> + % + % # Hacks to use a javascript link to trigger previews and jump to subsequent pages of a multipage test. + <%= hidden_field pageChangeHack => '' =%> + <%= hidden_field startTime => $startTime =%> + % if ($numProbPerPage && $numPages > 1) { + <%= hidden_field newPage => '' =%> + <%= hidden_field currentPage => $pageNumber =%> + % } + % + % # Set up links between problems and, for multi-page tests, pages. + % for my $i (0 .. $#$pg_results) { + % my $pn = $i + 1; + % content_for 'gw-navigation-problem-row' => begin + + % if ($i >= $startProb && $i <= $endProb) { + <%= link_to $pn => '#', class => 'problem-jump-link', data => { problem_number => $pn } =%> + % } else { + <%= $pn =%> + % } + + % end + % content_for 'gw-navigation-score-row' => begin + + % if ($cg->{probStatus}[ $probOrder->[$i] ] == 1) { + 💯 + % } else { + <%= wwRound(0, 100 * $cg->{probStatus}[ $probOrder->[$i] ]) =%> + % } + + % end + % } + % content_for 'gw-navigation-cols' => begin + + % end + % if ($numProbPerPage && $numPages > 1) { + % content_for 'gw-navigation-cols' => begin + % for (1 .. $numPages) { + + % for (1 .. $numProbPerPage) { + + % } + + % } + % end + % for my $i (1 .. $numPages) { + % content_for 'gw-navigation-pages' => begin + + % if ($i == $pageNumber) { + <%= $i =%> + % } else { + <%= link_to $i => '#', class => 'page-change-link', data => { page_number => $i } =%> + % } + + % end + % } + % content_for 'gw-navigation-table-rows' => begin + % if ($numProbPerPage == 1) { + + <%= maketext('Move to Problem:') %> + <%= content 'gw-navigation-pages' =%> + + % } else { + + <%= maketext('Move to Page:') %> + <%= content 'gw-navigation-pages' =%> + + + <%= maketext('Jump to Problem:') %> + <%= content 'gw-navigation-problem-row' =%> + + % } + % end + % } else { + % content_for 'gw-navigation-cols' => begin + <% for (0 .. $#$pg_results) { =%><% } =%> + % end + % content_for 'gw-navigation-table-rows' => begin + + <%= maketext('Jump to Problem:') %> + <%= content 'gw-navigation-problem-row' =%> + + % end + % } + % if ($cg->{can}{showProblemScores} && $cg->{set}->version_last_attempt_time) { + % content_for 'gw-navigation-table-rows' => begin + <%= maketext('% Score:') %><%= content 'gw-navigation-score-row' =%> + % end + % } + % my $jumpLinks = begin +
      + + <%= content 'gw-navigation-cols' =%> + <%= content 'gw-navigation-table-rows' =%> + +
      + % end + <%= $jumpLinks->() =%> + % + % # Print out problems and attempt results, as appropriate. + % # Note: Usage is $cg->attemptResults($pg, $showCorrectAnswers, $showAttemptResults, $showSummary) + % for my $i (0 .. $#$pg_results) { + % my $pg = $pg_results->[ $probOrder->[$i] ]; + % + % if ($i >= $startProb && $i <= $endProb) { + % my $recordMessage = ''; + % my $resultsTable = ''; + % + % if ($pg->{flags}{showPartialCorrectAnswers} >= 0 && $cg->{submitAnswers}) { + % if ($cg->{scoreRecordedMessage}[ $probOrder->[$i] ] ne 'recorded') { + % $recordMessage = tag('div', class => 'ResultsWithError d-inline-block mb-2', + % maketext('ANSWERS NOT RECORDED -- [_1]', $cg->{scoreRecordedMessage}[ $probOrder->[$i] ]) + % ); + % } + % $resultsTable = $cg->attemptResults( + % $pg, + % $cg->{will}{showCorrectAnswers}, + % $pg->{flags}{showPartialCorrectAnswers} && $cg->{can}{showProblemScores}, + % $cg->{can}{showProblemScores} + % ); + % } elsif ($cg->{will}{checkAnswers} || $cg->{will}{showProblemGrader}) { + % $recordMessage = tag('div', class => 'ResultsWithError d-inline-block mb-2', + % maketext('ANSWERS ONLY CHECKED -- ANSWERS NOT RECORDED') + % ); + % + % $resultsTable = $cg->attemptResults( + % $pg, + % $cg->{will}{showCorrectAnswers}, + % $pg->{flags}{showPartialCorrectAnswers} && $cg->{can}{showProblemScores}, + % $cg->{can}{showProblemScores} + % ); + % } elsif ($cg->{previewAnswers}) { + % $recordMessage = tag('div', class => 'ResultsWithError d-inline-block mb-2', + % maketext('PREVIEW ONLY -- ANSWERS NOT RECORDED') + % ); + % $resultsTable = $cg->attemptResults($pg, 0, 0, 0); + % } + % +
      + % # Show the jump to anchor. +
      " tabindex="-1"><%= $recordMessage %>
      + % # Output the problem header. +

      <%= maketext('Problem [_1].', $i + 1) %>

      + + % my $problemValue = $problems->[ $probOrder->[$i] ]->value; + % if (defined $problemValue) { + % my $points = $problemValue == 1 ? maketext('point') : maketext('points'); + <%= "($problemValue $points)" %> + % } + % + % # This uses the permission level and user id of the user assigned to the set. + % if ( + % $db->getPermissionLevel($effectiveUserID)->permission >= + % $ce->{pg}{specialPGEnvironmentVars}{PRINT_FILE_NAMES_PERMISSION_LEVEL} + % || ( + % grep { $_ eq $effectiveUserID } + % @{ $ce->{pg}{specialPGEnvironmentVars}{PRINT_FILE_NAMES_FOR} } + % ) + % ) + % { + <%= $problems->[ $probOrder->[$i] ]->source_file %> + % } + + % + % my $instructor_comment = $cg->get_instructor_comment($problems->[ $probOrder->[$i] ]); + % if ($instructor_comment) { +
      + <%= maketext('Instructor Comment:') %> +
      + <%= $instructor_comment %> +
      + % } + % +
      {flags}, $ce->{perProblemLangAndDirSettingMode}, $ce->{language} + ) %>> + <%== $pg->{body_text} =%> +
      + % if ($pg->{result}{msg}) { +
      <%== maketext('Note: [_1]', tag('i', $pg->{result}{msg})) %>
      + % } + % +
      + <%= link_to maketext('preview answers') => '#', + class => 'gateway-preview-btn btn btn-secondary', + ($numProbPerPage && $numPages > 1) ? (data_page_number => $pageNumber) : () =%> +
      + % + % if ($resultsTable) { + <%= $resultsTable =%> + % } + % + % # Initialize the problem graders for the problem. + % if ($cg->{will}{showProblemGrader}) { + <%= WeBWorK::HTML::SingleProblemGrader->new($c, $pg, $problems->[ $probOrder->[$i] ]) + ->insertGrader =%> + % } +
      + % # Store the problem status for continued attempts recording. + <%= hidden_field 'probstatus' . ($probOrder->[$i] + 1) => $cg->{probStatus}[ $probOrder->[$i] ] =%> + % +
      + % } else { + % # Print out hidden fields with the current last answers. + % my $curr_prefix = 'Q' . sprintf('%04d', $problem_numbers->[ $probOrder->[$i] ]) . '_'; + % for my $curr_field (grep {/^(?!previous).*$curr_prefix/} keys %{ $cg->{formFields} }) { + % for (split(/\0/, $cg->{formFields}{$curr_field} // '')) { + <%= hidden_field $curr_field => $_ =%> + % } + % } + % # Store the problem status for continued attempts recording. + <%= hidden_field 'probstatus' . ($probOrder->[$i] + 1) => $cg->{probStatus}[ $probOrder->[$i] ] %> + % } + % } + % + <%= $jumpLinks->() =%> +
      + % +
      + % if ($cg->{can}{showCorrectAnswers}) { +
      + +
      + % } + % if ($cg->{can}{showSolutions}) { +
      + +
      + % } + % if ($cg->{can}{showProblemGrader}) { +
      + +
      + % } +
      + % +
      + <%= submit_button maketext('Preview Test'), name => 'previewAnswers', class => 'btn btn-primary mb-1' =%> + % if ($cg->{can}{recordAnswersNextTime}) { + <%= tag('input', + type => 'submit', + name => 'submitAnswers', + value => maketext('Grade Test'), + class => 'btn btn-primary mb-1', + $cg->{set}->attempts_per_version + ? ( + data => { + confirm_dialog_title => maketext('Do you want to grade this test?'), + confirm_btn_text => maketext('Yes'), + cancel_btn_text => maketext('No'), + confirm_dialog_message => $cg->{numAttemptsLeft} > 1 + ? maketext( + 'You have [_1] submissions remaining for this test. If you say yes, then you will ' + . 'have [quant,_2,submission] remaining. Once all submissions have been used, your ' + . 'answers will be final and you will not be able to continue to work this test ' + . 'version.', + $cg->{numAttemptsLeft}, + $cg->{numAttemptsLeft} - 1 + ) + : $cg->{set}->attempts_per_version > 1 ? maketext( + 'This is your last submission. If you say yes, then your answers will be final, ' + . 'and you will not be able to continue to work this test version.' + ) + : maketext( + 'This is your only submission. If you say yes, then your answers will be final, ' + . 'and you will not be able to continue to work this test version.' + ) + } + ) + : () + ) =%> + % } + % if ($cg->{can}{checkAnswersNextTime} && !$cg->{can}{recordAnswersNextTime}) { + <%= submit_button maketext('Check Test'), name => 'checkAnswers', class => 'btn btn-primary mb-1' =%> + % } +
      + % if ($numProbPerPage && $numPages > 1 && $cg->{can}{recordAnswersNextTime}) { +

      <%= maketext('Note: grading the test grades all problems, not just those on this page.') %>

      + % } + % if (defined param('sourceFilePath')) { + <%= hidden_field sourceFilePath => param('sourceFilePath') =%> + % } + % if (defined param('problemSeed')) { + <%= hidden_field problemSeed => param('problemSeed') =%> + % } + % # Make sure the student nav filter setting is preserved when the problem form is submitted. + % if (param('studentNavFilter')) { + <%= hidden_field studentNavFilter => param('studentNavFilter') =%> + % } + <% end =%> +% } +% +% # Add a show answers option if appropriate. +% if ($authz->hasPermissions($userID, 'view_answers')) { + <%= form_for $cg->systemLink( + $urlpath->newFromModule('WeBWorK::ContentGenerator::Instructor::ShowAnswers', + $c, courseID => $ce->{courseName}), + authen => 0 + ), + method => 'POST', + target => 'WW_Info', + begin =%> + <%= $cg->hidden_authen_fields('pastans-') =%> + <%= hidden_field courseID => $ce->{courseName} =%> + <%= hidden_field selected_sets => "$setID,v$setVersionID" =%> + <%= hidden_field selected_users => $effectiveUserID =%> + % for ($startProb + 1 .. $endProb + 1) { + <%= hidden_field selected_problems => $_ =%> + % } + <%= submit_button maketext('Show Past Answers'), name => 'action', class => 'btn btn-primary' =%> + <% end =%> +% } +% +% # If achievements enabled, check to see if there are new ones and output them. Use the first +% # problem to seed the data. However, all of the problems will be provided to the achievement evaluator. +% if ($ce->{achievementsEnabled} && $cg->{will}{recordAnswers} && $cg->{submitAnswers} && $setID ne 'Undefined_Set') { + <%= checkForAchievements($problems->[0], $pg_results->[0], $c, setVersion => $setVersionID) =%> +% } diff --git a/templates/ContentGenerator/GatewayQuiz/nav.html.ep b/templates/ContentGenerator/GatewayQuiz/nav.html.ep new file mode 100644 index 0000000000..8bc0aea8a7 --- /dev/null +++ b/templates/ContentGenerator/GatewayQuiz/nav.html.ep @@ -0,0 +1,134 @@ +% # Cap the number of tests shown to at most 200. +% my $numAfter = $#$userRecords - $currentTestIndex; +% my $numBefore = 200 - ($numAfter < 100 ? $numAfter : 100); +% my $minTestIndex = $currentTestIndex < $numBefore ? 0 : $currentTestIndex - $numBefore; +% my $maxTestIndex = $minTestIndex + 200 < $#$userRecords ? $minTestIndex + 200 : $#$userRecords; +% + diff --git a/templates/ContentGenerator/Grades.html.ep b/templates/ContentGenerator/Grades.html.ep new file mode 100644 index 0000000000..02c214f389 --- /dev/null +++ b/templates/ContentGenerator/Grades.html.ep @@ -0,0 +1,2 @@ +<%= $cg->displayStudentStats($cg->{studentID}) =%> +<%= $cg->scoring_info =%> diff --git a/templates/ContentGenerator/Grades/student_stats.html.ep b/templates/ContentGenerator/Grades/student_stats.html.ep new file mode 100644 index 0000000000..03a81ac797 --- /dev/null +++ b/templates/ContentGenerator/Grades/student_stats.html.ep @@ -0,0 +1,39 @@ +% use WeBWorK::Utils qw(wwRound); +% +

      <%= $fullName %>

      +
      + + + + + + + + + + % for (1 .. $max_problems) { + + % } + + % + <%= $rows =%> + % + % # Compute the percentage correct. + % my $totalRightPercent = 100 * wwRound(2, $courseTotal ? $courseTotalRight / $courseTotal : 0); + % + % if ($ce->{showCourseHomeworkTotals}) { + + + + + + + + % } +
      <%= maketext('Set') %><%= maketext('Percent') %><%= maketext('Score') %><%= maketext('Out Of') %><%= maketext('Problems') %>
      <%= $_ %>
      <%= maketext('Homework Totals') %> + + <%= $totalRightPercent . '%' %> + + <%= $courseTotalRight %><%= $courseTotal %> 
      +
      diff --git a/templates/ContentGenerator/Hardcopy.html.ep b/templates/ContentGenerator/Hardcopy.html.ep new file mode 100644 index 0000000000..c7aefc80f2 --- /dev/null +++ b/templates/ContentGenerator/Hardcopy.html.ep @@ -0,0 +1,56 @@ +% my $perm_view_errors = $authz->hasPermissions(param('user'), 'download_hardcopy_view_errors'); +% +% if ($cg->has_errors) { + % my $file_path = $cg->{file_path}; + % my %temp_file_map = %{ $cg->{temp_file_map} // {} }; + % + % if ($perm_view_errors) { +

      <%= maketext('Errors occured while generating hardcopy:') %>

      +
        + % for (@{ $cg->get_errors }) { +
      • <%= $_ %>
        • + % } +
      + % } + % + % if ($file_path) { +

      + <%= maketext( + 'A hardcopy file was generated, but it may not be complete or correct. Please check that no problems ' + . 'are missing and that they are all legible. If not, please inform your instructor.') =%> +
      + <%= link_to( + maketext('Download Hardcopy') => $cg->systemLink( + $urlpath->newFromModule($urlpath->module, $c, courseID => $urlpath->arg('courseID')), + params => { tempFilePath => $file_path } + ) + ) =%> +

      + % } else { +

      + <%= maketext( + 'WeBWorK was unable to generate a paper copy of this homework set. Please inform your instructor.' + ) =%> +

      + % } + % + % if ($perm_view_errors && keys %temp_file_map) { +

      + <%= maketext('You can also examine the following temporary files: ') =%> + <%= c( + map { + link_to $_ => $cg->systemLink( + $urlpath->newFromModule($urlpath->module, $c, courseID => $urlpath->arg('courseID')), + params => { tempFilePath => $temp_file_map{$_} } + ) + } keys %temp_file_map + )->join(', ') =%> +

      + % } +
      +% } +% +% # don't display the retry form if there are errors and the user doesn't have permission to view the errors. +% unless ($cg->has_errors && !$perm_view_errors) { + <%= $cg->display_form =%> +% } diff --git a/templates/ContentGenerator/Hardcopy/form.html.ep b/templates/ContentGenerator/Hardcopy/form.html.ep new file mode 100644 index 0000000000..05de9bd4c9 --- /dev/null +++ b/templates/ContentGenerator/Hardcopy/form.html.ep @@ -0,0 +1,175 @@ +% use WeBWorK::Utils qw(format_set_name_display); +% use WeBWorK::HTML::ScrollingRecordList qw/scrollingRecordList/; +% +%= form_for $c->uri, name => 'hardcopy-form', id => 'hardcopy-form', method => 'POST', begin + <%= $cg->hidden_authen_fields =%> + <%= hidden_field in_hc_form => 1 =%> + % + % if ($multiuser) { +

      + <%= maketext( + 'Select the homework sets for which to generate hardcopy versions. You may' + . ' also select multiple users from the users list. You will receive hardcopy' + . ' for each (set, user) pair.') =%> +

      +
      +
      +
      + <%= label_for selected_users => maketext('Users') =%> +
      + <%= scrollingRecordList( + { + name => 'selected_users', + id => 'selected_users', + request => $c, + default_sort => 'lnfn', + default_format => 'lnfn_uid', + default_filters => ['all'], + attrs => { size => 20, multiple => undef } + }, + @$users + ) =%> +
      +
      +
      + <%= label_for selected_sets => maketext('Sets') =%> +
      + <%= scrollingRecordList( + { + name => 'selected_sets', + id => 'selected_sets', + request => $c, + default_sort => 'set_id', + default_format => 'sid', + default_filters => ['all'], + attrs => { size => 20, multiple => undef, dir => 'ltr' } + }, + @$wantedSets, + @$setVersions + ) =%> +
      +
      + % } else { + <%= hidden_field selected_sets => $selected_set_id =%> + <%= hidden_field selected_users => $user_id =%> +

      + <%== maketext( + 'Download hardcopy of set [_1] for [_2]?', + tag('span', dir => 'ltr', format_set_name_display($selected_set_id)), + join(' ', $user->first_name, $user->last_name) + ) =%> +

      + % } + % +
      +
      + <%= maketext( + 'You may choose to show any of the following data. Correct answers, hints, and solutions ' + . 'are only available [_1] after the answer date of the homework set.', + $multiuser ? 'to privileged users or' : '' + ) =%> +
      +
      +
      +
      + <%= maketext('Show:') %> +
      + +
      +
      + +
      + % if ($canShowCorrectAnswers) { +
      + +
      +
      + +
      +
      + +
      + % } +
      +
      +
      +
      +
      +
      + <%= maketext('Hardcopy Format:') %> +
      + % for (@$formats) { + + % } +
      +
      +
      +
      + % if ($cg->{can_show_source_file}) { +
      +
      +
      + <%= maketext('Show Problem Source File:') %> +
      + + +
      +
      +
      +
      + % } + % if ($can_change_theme) { +
      +
      +
      + <%= maketext('Hardcopy Theme') %> +
      + % for (@{ $ce->{hardcopyThemes} }) { + + % } +
      +
      +
      +
      + % } +
      + <%= submit_button + $multiuser + ? maketext('Generate hardcopy for selected sets and selected users') + : maketext('Generate Hardcopy'), + name => 'generate_hardcopy', class => 'btn btn-primary' =%> +
      +
      +% end diff --git a/templates/ContentGenerator/Home.html.ep b/templates/ContentGenerator/Home.html.ep new file mode 100644 index 0000000000..4fd5354b36 --- /dev/null +++ b/templates/ContentGenerator/Home.html.ep @@ -0,0 +1,28 @@ +% use WeBWorK::Utils::CourseManagement qw(listCourses); +% +% my $coursesDir = $ce->{webworkDirs}{courses}; +% my @courseIDs = listCourses($ce); +% +

      <%= maketext('Welcome to WeBWorK!') %>

      +% +% if ((grep { $_ eq 'admin' } @courseIDs) && !-f "$coursesDir/admin/hide_directory") { +

      + <%= link_to maketext('Course Administration') => $cg->systemLink( + $urlpath->newFromModule('WeBWorK::ContentGenerator::ProblemSets', $c, courseID => 'admin'), + authen => 0) =%> +

      +% } +% +

      <%= maketext('Courses') %>

      +% +
        + % for my $courseID (sort { lc($a) cmp lc($b) } @courseIDs) { + % next if $courseID eq 'admin'; # Already shown above. + % next if -f "$coursesDir/$courseID/hide_directory"; +
      • + <%= link_to $courseID =~ s/_/ /gr => $cg->systemLink( + $urlpath->newFromModule('WeBWorK::ContentGenerator::ProblemSets', $c, courseID => $courseID), + authen => 0) =%> +
        • + % } +
      diff --git a/templates/ContentGenerator/Instructor/AchievementEditor.html.ep b/templates/ContentGenerator/Instructor/AchievementEditor.html.ep new file mode 100644 index 0000000000..fb7ce86ff9 --- /dev/null +++ b/templates/ContentGenerator/Instructor/AchievementEditor.html.ep @@ -0,0 +1,65 @@ +% use WeBWorK::Utils qw(not_blank getAssetURL); +% use WeBWorK::HTML::CodeMirrorEditor + % qw(generate_codemirror_html generate_codemirror_controls_html output_codemirror_static_files); +% +% content_for js => begin + <%= output_codemirror_static_files($c) =%> + <%= javascript getAssetURL($ce, 'js/apps/ActionTabs/actiontabs.js'), defer => undef =%> +% end +% +% unless ($authz->hasPermissions(param('user'), 'edit_achievements')) { +
      <%= maketext('You are not authorized to edit achievements.') %>
      + % last; +% } +% +
      + <%= maketext('Editing achievement in file "[_1]"', $cg->shortPath($cg->{sourceFilePath})) =%> +
      +<%= form_for $c->uri, method => 'POST', id => 'editor', name => 'editor', + enctype => 'application/x-www-form-urlencoded', + begin =%> + <%= $cg->hidden_authen_fields =%> + % if (not_blank($cg->{sourceFilePath})) { + <%= hidden_field sourceFilePath => $cg->{sourceFilePath} =%> + % } + % +
      <%= generate_codemirror_html($c, 'achievementContents', $achievementContents) =%>
      + <%= generate_codemirror_controls_html($c) =%> + % + % # Output action forms + % my $default_choice; + % + % for my $actionID (@$formsToShow) { + % my $line_contents = include("ContentGenerator/Instructor/AchievementEditor/${actionID}_form"); + % my $active = ''; + % + % if ($line_contents ne '') { + % unless ($default_choice) { $active = ' active'; $default_choice = $actionID; } + % + % content_for 'tab-list' => begin + + % end + % content_for 'tab-content' => begin +
      " id="<%= $actionID %>" + role="tabpanel" aria-labelledby="<%= $actionID %>-tab"> + <%= $line_contents =%> +
      + % end + % } + % } + % + <%= hidden_field action => $default_choice, id => 'current_action' =%> +
      +
        <%= content 'tab-list' =%>
      +
      <%= content 'tab-content' %>
      +
      +
      <%= submit_button maketext('Take Action!'), name => 'submit', class => 'btn btn-primary' %>
      +<% end =%> diff --git a/templates/ContentGenerator/Instructor/AchievementEditor/save_as_form.html.ep b/templates/ContentGenerator/Instructor/AchievementEditor/save_as_form.html.ep new file mode 100644 index 0000000000..d427a902ba --- /dev/null +++ b/templates/ContentGenerator/Instructor/AchievementEditor/save_as_form.html.ep @@ -0,0 +1,36 @@ +% # There are three things you can do with a new achievement editor. +% # You can replace the current achievement, use it in a new achievement, or not use it at all. +
      +
      + <%= label_for 'action.save_as.target_file_id' => maketext('Save as:'), class => 'col-form-label col-auto' =%> +
      + <%= text_field 'action.save_as.target_file' => $cg->getRelativeSourceFilePath($cg->{sourceFilePath}), + id => 'action.save_as.target_file_id', size => 40, class => 'form-control form-control-sm' =%> +
      + <%= hidden_field 'action.save_as.source_file' => $cg->{sourceFilePath} =%> +
      +
      + <%= radio_button 'action.save_as.saveMode' => 'use_in_current', + id => 'action.save_as.saveMode.use_in_current', class => 'form-check-input' =%> + <%= label_for 'action.save_as.saveMode.use_in_current', class => 'form-check-label', begin =%> + <%== maketext('Use in achievement [_1]', tag('b', $cg->{achievementID})) =%> + <% end =%> +
      +
      +
      + <%= radio_button 'action.save_as.saveMode' => 'use_in_new', + id => 'action.save_as.saveMode.use_in_new', class => 'form-check-input' =%> + <%= label_for 'action.save_as.saveMode.use_in_new' => maketext('Use in new achievement:'), + class => 'form-check-label me-1', id => 'action.save_as.saveMode.use_in_new.label' =%> +
      + <%= text_field 'action.save_as.id' => '', + 'aria-labelledby' => 'action.save_as.saveMode.use_in_new.label', + class => 'form-control form-control-sm d-inline w-auto' =%> +
      +
      + <%= radio_button 'action.save_as.saveMode' => 'dont_use', + id => 'action.save_as.saveMode.dont_use', class => 'form-check-input' =%> + <%= label_for 'action.save_as.saveMode.dont_use' => maketext(q{Don't use in an achievement}), + class => 'form-check-label' =%> +
      +
      diff --git a/templates/ContentGenerator/Instructor/AchievementEditor/save_form.html.ep b/templates/ContentGenerator/Instructor/AchievementEditor/save_form.html.ep new file mode 100644 index 0000000000..4aa31196b7 --- /dev/null +++ b/templates/ContentGenerator/Instructor/AchievementEditor/save_form.html.ep @@ -0,0 +1,3 @@ +% if (-w $cg->{sourceFilePath}) { + <%== maketext('Save [_1]', tag('b', $cg->shortPath($cg->{sourceFilePath}))) %> +% } diff --git a/templates/ContentGenerator/Instructor/AchievementList.html.ep b/templates/ContentGenerator/Instructor/AchievementList.html.ep new file mode 100644 index 0000000000..abc9a937a1 --- /dev/null +++ b/templates/ContentGenerator/Instructor/AchievementList.html.ep @@ -0,0 +1,71 @@ +% use WeBWorK::Utils qw(getAssetURL); +% +% content_for js => begin + <%= javascript getAssetURL($ce, 'js/apps/ShowHide/show_hide.js'), defer => undef =%> + <%= javascript getAssetURL($ce, 'js/apps/ActionTabs/actiontabs.js'), defer => undef =%> + <%= javascript getAssetURL($ce, 'js/apps/SelectAll/selectall.js'), defer => undef =%> +% end +% +% unless ($authz->hasPermissions(param('user'), 'edit_achievements')) { +
      <%= maketext('You are not authorized to edit achievements.') %>
      + % last; +% } +% + + +% +<%= form_for $cg->systemLink($urlpath, authen => 0), + method => 'post', id => 'achievement-list', name => 'achievementlist', class => 'font-sm', + begin =%> + <%= $cg->hidden_authen_fields =%> + <%= hidden_field editMode => $cg->{editMode} =%> + <%= hidden_field exportMode => $cg->{exportMode} =%> + % + % if ($cg->{editMode}) { +

      <%= maketext('Any changes made below will be reflected in the achievement for ALL students.') %>

      + % } + % + <%= hidden_field action => $formsToShow->[0], id => 'current_action' =%> +
      +
        + % for my $actionID (@$formsToShow) { + + % } +
      +
      + % for my $actionID (@$formsToShow) { +
      + <%= include "ContentGenerator/Instructor/AchievementList/${actionID}_form" =%> +
      + % } +
      +
      + <%= submit_button maketext('Take Action!'), id => 'take_action', class => 'btn btn-primary mb-3' =%> + % if ($cg->{exportMode}) { + <%= include 'ContentGenerator/Instructor/AchievementList/export_table' =%> + % } elsif ($cg->{editMode}) { + <%= include 'ContentGenerator/Instructor/AchievementList/edit_table' =%> + % } else { + <%= include 'ContentGenerator/Instructor/AchievementList/default_table' =%> + % } +<% end =%> diff --git a/templates/ContentGenerator/Instructor/AchievementList/assign_form.html.ep b/templates/ContentGenerator/Instructor/AchievementList/assign_form.html.ep new file mode 100644 index 0000000000..8182c2369b --- /dev/null +++ b/templates/ContentGenerator/Instructor/AchievementList/assign_form.html.ep @@ -0,0 +1,26 @@ +
      +
      + <%= label_for assign_select => maketext('Assign which achievements?'), + class => 'col-form-label col-form-label-sm col-sm-auto' =%> +
      + <%= select_field 'action.assign.scope' => [ + [ maketext('all achievements') => 'all' ], + [ maketext('selected achievements') => 'selected', selected => undef ] + ], + id => 'assign_select', + class => 'form-select form-select-sm' =%> +
      +
      +
      + <%= label_for 'assign_data_select' => maketext('Choose what to do with existing data:'), + class => 'col-form-label col-form-label-sm col-sm-auto' =%> +
      + <%= select_field 'action.assign.overwrite' => [ + [ maketext('overwrite') => 'everything' ], + [ maketext('preserve') => 'new_only', selected => undef ] + ], + id => 'assign_data_select', + class => 'form-select form-select-sm' =%> +
      +
      +
      diff --git a/templates/ContentGenerator/Instructor/AchievementList/cancel_edit_form.html.ep b/templates/ContentGenerator/Instructor/AchievementList/cancel_edit_form.html.ep new file mode 100644 index 0000000000..04d9646c9c --- /dev/null +++ b/templates/ContentGenerator/Instructor/AchievementList/cancel_edit_form.html.ep @@ -0,0 +1 @@ +<%= maketext('Abandon changes') =%> diff --git a/templates/ContentGenerator/Instructor/AchievementList/cancel_export_form.html.ep b/templates/ContentGenerator/Instructor/AchievementList/cancel_export_form.html.ep new file mode 100644 index 0000000000..4f3b5f4847 --- /dev/null +++ b/templates/ContentGenerator/Instructor/AchievementList/cancel_export_form.html.ep @@ -0,0 +1 @@ +<%= maketext('Abandon export') =%> diff --git a/templates/ContentGenerator/Instructor/AchievementList/create_form.html.ep b/templates/ContentGenerator/Instructor/AchievementList/create_form.html.ep new file mode 100644 index 0000000000..9ecec6f6aa --- /dev/null +++ b/templates/ContentGenerator/Instructor/AchievementList/create_form.html.ep @@ -0,0 +1,23 @@ +
      +
      + <%= label_for 'create_text', class => 'col-form-label col-form-label-sm col-auto', begin =%> + <%= maketext('Create a new achievement with ID') =%>*: + <% end =%> +
      + <%= text_field 'action.create.id' => '', id => 'create_text', + class => 'form-control form-control-sm d-inline w-auto' =%> +
      +
      +
      + <%= label_for create_select => maketext("Create as what type of achievement?"), + class => 'col-form-label col-form-label-sm col-auto' =%> +
      + <%= select_field 'action.create.type' => [ + [ maketext('a new empty achievement') => 'empty', selected => undef ], + [ maketext('a duplicate of the first selected achievement') => 'copy' ], + ], + id => 'create_select', + class => 'form-select form-select-sm d-inline w-auto' =%> +
      +
      +
      diff --git a/templates/ContentGenerator/Instructor/AchievementList/default_table.html.ep b/templates/ContentGenerator/Instructor/AchievementList/default_table.html.ep new file mode 100644 index 0000000000..be146a62b1 --- /dev/null +++ b/templates/ContentGenerator/Instructor/AchievementList/default_table.html.ep @@ -0,0 +1,83 @@ +% my $courseName = $urlpath->arg('courseID'); +% +
      + + + + + + + + + + + + + + + % my %selectedAchievementIDs = map { $_ => 1 } @{ $cg->{selectedAchievementIDs} }; + % for (@$achievements) { + % my $achievement_id = $_->achievement_id; + + + + + + + + + + + % } + +
      + <%= check_box select_all => '', + id => 'select-all', + class => 'select-all form-check-input', + 'aria-label' => maketext('Select all achievements'), + data => { select_group => 'selected_achievements' } =%> + <%= label_for 'select-all' => maketext('Achievement ID') %><%= maketext('Enabled') %><%= maketext('Name') %><%= maketext('Number') %><%= maketext('Category') %><%= maketext('Edit Users') %><%= maketext('Edit Evaluator') %>
      + <%= check_box selected_achievements => $achievement_id, + id => "${achievement_id}_id", + class => 'form-check-input', + $selectedAchievementIDs{ $_->achievement_id } ? (checked => undef) : () =%> + +
      + <%= label_for "${achievement_id}_id", begin =%> + <%= $_->achievement_id %> + <%= link_to $cg->systemLink( + $urlpath->new( + type => 'instructor_achievement_list', + args => { courseID => $courseName } + ), + params => { editMode => 1, selected_achievements => $achievement_id } + ), + begin %> + + <% end %> + <% end =%> +
      +       		<%= $_->enabled ? maketext('Yes') : maketext('No') %><%= $_->name %><%= $_->number %><%= $_->category %> + % my $num_users = $db->countAchievementUsers($_->achievement_id); + <%= link_to "$num_users/$cg->{totalUsers}" => $cg->systemLink( + $urlpath->newFromModule( + "WeBWorK::ContentGenerator::Instructor::AchievementUserEditor", $c, + courseID => $courseName, + achievementID => $achievement_id + ) + ) =%> + + <%= link_to maketext('Edit Evaluator') => $cg->systemLink( + $urlpath->newFromModule( + "WeBWorK::ContentGenerator::Instructor::AchievementEditor", $c, + courseID => $courseName, + achievementID => $achievement_id + ), + params => { sourceFilePath => $ce->{courseDirs}{achievements}. '/' . $_->test } + ) =%> +
      +
      +% +% unless (@$achievements) { +

      <%= maketext('No achievements shown. Create an achievement!') %>

      +% } diff --git a/templates/ContentGenerator/Instructor/AchievementList/delete_form.html.ep b/templates/ContentGenerator/Instructor/AchievementList/delete_form.html.ep new file mode 100644 index 0000000000..1ad96e4bf4 --- /dev/null +++ b/templates/ContentGenerator/Instructor/AchievementList/delete_form.html.ep @@ -0,0 +1,17 @@ +
      +
      + <%= maketext('Deletion destroys all achievement-related data and is not undoable!') =%> +
      +
      + <%= label_for delete_select => maketext('Delete which achievements?'), + class => 'col-form-label col-form-label-sm col-auto' =%> +
      + <%= select_field 'action.delete.scope' => [ + [ maketext('no achievements') => 'none', selected => undef ], + [ maketext('selected achievements') => 'selected' ], + ], + id => 'delete_select', + class => 'form-select form-select-sm d-inline w-auto me-3' =%> +
      +
      +
      diff --git a/templates/ContentGenerator/Instructor/AchievementList/edit_form.html.ep b/templates/ContentGenerator/Instructor/AchievementList/edit_form.html.ep new file mode 100644 index 0000000000..517373543a --- /dev/null +++ b/templates/ContentGenerator/Instructor/AchievementList/edit_form.html.ep @@ -0,0 +1,12 @@ +
      + <%= label_for edit_select => maketext('Edit which achievements?'), + class => 'col-form-label col-form-label-sm col-auto' =%> +
      + <%= select_field 'action.edit.scope' => [ + [ maketext('all achievements') => 'all' ], + [ maketext('selected achievements') => 'selected', selected => undef ], + ], + id => 'edit_select', + class => 'form-select form-select-sm' =%> +
      +
      diff --git a/templates/ContentGenerator/Instructor/AchievementList/edit_table.html.ep b/templates/ContentGenerator/Instructor/AchievementList/edit_table.html.ep new file mode 100644 index 0000000000..53c0dffa99 --- /dev/null +++ b/templates/ContentGenerator/Instructor/AchievementList/edit_table.html.ep @@ -0,0 +1,78 @@ +% if (!@{ $cg->{selectedAchievementIDs} }) { +

      <%= maketext('No achievements shown. Select an achievement to edit!') =%>

      +% } else { +
      + + + + + + + + + + + % my %selectedAchievementIDs = map { $_ => 1 } @{ $cg->{selectedAchievementIDs} }; + % for my $achievement (@$achievements) { + % my $achievement_id = $achievement->achievement_id; + % if ($selectedAchievementIDs{$achievement_id}) { + + + % for ( + % { size => 30, fields => [ 'achievement_id', 'name', 'category' ] }, + % { size => 8, fields => [ 'number', 'enabled', 'points', 'max_counter' ] }, + % { size => 85, fields => [ 'description', 'test', 'icon', 'assignment_type' ] } + % ) + % { + + % } + + % } + % } + +
      <%= maketext('Icon') %> +
      + <%= maketext('Achievement ID') =%> + <%= maketext('Name') %> + <%= maketext('Category') %> +
      +       		+
      + <%= maketext('Number') %> + <%= maketext('Enabled') %> + <%= maketext('Points') %> + <%= maketext('Counter') %> +
      +       		+
      + <%= maketext('Description') %> + <%= maketext('Evaluator File') %> + <%= maketext('Icon File') %> + <%= maketext('Type') =%> +
      +
      + <%= hidden_field selected_achievements => $achievement_id =%> + <%= image + $ce->{courseURLs}{achievements} + . '/' + . ($achievement->icon // 'defaulticon.png'), + alt => 'Achievement Icon', height => 60, class => 'm-1' =%> + +
      + % for my $field (@{ $_->{fields} }) { + + <%= include + 'ContentGenerator/Instructor/AchievementList/edit_table_row', + fieldName => "achievement.$achievement_id.$field", + value => $achievement->$field, + size => $_->{size} =%> + + % } +
      +
      +
      + % + % unless (@$achievements) { +

      <%= maketext('No achievements shown. Create an achievement!') %>

      + % } +% } diff --git a/templates/ContentGenerator/Instructor/AchievementList/edit_table_row.html.ep b/templates/ContentGenerator/Instructor/AchievementList/edit_table_row.html.ep new file mode 100644 index 0000000000..e015204a42 --- /dev/null +++ b/templates/ContentGenerator/Instructor/AchievementList/edit_table_row.html.ep @@ -0,0 +1,25 @@ +% if ($fieldName =~ /\.enabled$/) { + % # If the "enabled" checkbox is checked it returns a 1, if it is unchecked it returns nothing + % # in which case the hidden field overrides the parameter with a 0. + <%= check_box $fieldName => 1, + 'aria-labelledby' => ($fieldName =~ s/^.*\.([^.]*)$/$1/r) . '_header', + class => 'form-check-input', + $value ? (checked => undef) : () =%> + <%= hidden_field $fieldName => 0 =%> +% } elsif ($fieldName =~ /\.assignment_type$/) { + % my @allowedTypes = split(',', $value); + % for my $type ([ default => 'homework' ], [ gateway => 'gateways' ], [ jitar => 'just-in-time' ]) { + + % } +% } elsif ($fieldName =~ /\.achievement_id$/) { + <%= $value =%> +% } else { + <%= text_field $fieldName => $value, + 'aria-labelledby' => ($fieldName =~ s/^.*\.([^.]*)$/$1/r) . '_header', + size => $size, + class => 'form-control form-control-sm' =%> +% } diff --git a/templates/ContentGenerator/Instructor/AchievementList/export_form.html.ep b/templates/ContentGenerator/Instructor/AchievementList/export_form.html.ep new file mode 100644 index 0000000000..071f35df14 --- /dev/null +++ b/templates/ContentGenerator/Instructor/AchievementList/export_form.html.ep @@ -0,0 +1,12 @@ +
      + <%= label_for export_select => maketext('Export which achievements?'), + class => 'col-form-label col-form-label-sm col-auto' =%> +
      + <%= select_field 'action.export.scope' => [ + [ maketext('all achievements') => 'all' ], + [ maketext('selected achievements') => 'selected', selected => undef ], + ], + id => 'export_select', + class => 'form-select form-select-sm d-inline w-auto' =%> +
      +
      diff --git a/templates/ContentGenerator/Instructor/AchievementList/export_table.html.ep b/templates/ContentGenerator/Instructor/AchievementList/export_table.html.ep new file mode 100644 index 0000000000..3455b9f396 --- /dev/null +++ b/templates/ContentGenerator/Instructor/AchievementList/export_table.html.ep @@ -0,0 +1,37 @@ +
      + + + + + + + + + + % my %selectedAchievementIDs = map { $_ => 1 } @{ $cg->{selectedAchievementIDs} }; + % for (@$achievements) { + % my $achievement_id = $_->achievement_id; + + + + + + % } + +
      + <%= check_box select_all => '', + id => 'select-all', + class => 'select-all form-check-input', + 'aria-label' => maketext('Select all achievements'), + data => { select_group => 'selected_achievements' } =%> + <%= label_for 'select-all' => maketext('Achievement ID') %><%= maketext('Name') %>
      + <%= check_box selected_achievements => $_->achievement_id, + id => "${achievement_id}_id", + class => 'form-check-input', + $selectedAchievementIDs{ $_->achievement_id } ? (checked => undef) : () =%> + <%= label_for "${achievement_id}_id" => $_->achievement_id %><%= $_->name %>
      +
      +% +% unless (@$achievements) { +

      <%= maketext('No achievements shown. Create an achievement!') %>

      +% } diff --git a/templates/ContentGenerator/Instructor/AchievementList/import_form.html.ep b/templates/ContentGenerator/Instructor/AchievementList/import_form.html.ep new file mode 100644 index 0000000000..8e489385eb --- /dev/null +++ b/templates/ContentGenerator/Instructor/AchievementList/import_form.html.ep @@ -0,0 +1,26 @@ +
      +
      + <%= label_for import_file_select => maketext('Import from where?'), + class => 'col-form-label col-form-label-sm col-sm-auto' =%> +
      + <%= select_field 'action.import.source' => [ + [ maketext('Select import file') => '', selected => undef ], + $cg->getAxpList + ], + id => 'import_file_select', + class => 'form-select form-select-sm d-inline w-auto' =%> +
      +
      +
      + <%= label_for import_users_select => maketext('Assign this achievement to which users?'), + class => 'col-form-label col-form-label-sm col-sm-auto' =%> +
      + <%= select_field 'action.import.assign' => [ + [ maketext('all current users') => 'all' ], + [ maketext('no users') => 'none', selected => undef ], + ], + id => 'import_users_select', + class => 'form-select form-select-sm d-inline w-auto' =%> +
      +
      +
      diff --git a/templates/ContentGenerator/Instructor/AchievementList/save_edit_form.html.ep b/templates/ContentGenerator/Instructor/AchievementList/save_edit_form.html.ep new file mode 100644 index 0000000000..82fb7b3d08 --- /dev/null +++ b/templates/ContentGenerator/Instructor/AchievementList/save_edit_form.html.ep @@ -0,0 +1 @@ +<%= maketext('Save changes') =%> diff --git a/templates/ContentGenerator/Instructor/AchievementList/save_export_form.html.ep b/templates/ContentGenerator/Instructor/AchievementList/save_export_form.html.ep new file mode 100644 index 0000000000..5f96a8f6c3 --- /dev/null +++ b/templates/ContentGenerator/Instructor/AchievementList/save_export_form.html.ep @@ -0,0 +1 @@ +<%= maketext('Export selected achievements') =%> diff --git a/templates/ContentGenerator/Instructor/AchievementList/score_form.html.ep b/templates/ContentGenerator/Instructor/AchievementList/score_form.html.ep new file mode 100644 index 0000000000..e2ae010274 --- /dev/null +++ b/templates/ContentGenerator/Instructor/AchievementList/score_form.html.ep @@ -0,0 +1,13 @@ +
      + <%= label_for score_select => maketext('Score which achievements?'), + class => 'col-form-label col-form-label-sm col-auto' =%> +
      + <%= select_field 'action.score.scope' => [ + [ maketext('no achievements') => 'none', selected => undef ], + [ maketext('all achievements') => 'all' ], + [ maketext('selected achievements') => 'selected' ], + ], + id => 'score_select', + class => 'form-select form-select-sm d-inline w-auto' =%> +
      +
      diff --git a/templates/ContentGenerator/Instructor/AchievementUserEditor.html.ep b/templates/ContentGenerator/Instructor/AchievementUserEditor.html.ep new file mode 100644 index 0000000000..25a109fe39 --- /dev/null +++ b/templates/ContentGenerator/Instructor/AchievementUserEditor.html.ep @@ -0,0 +1,105 @@ +% unless ($authz->hasPermissions(param('user'), 'edit_achievements')) { +
      <%= maketext('You are not authorized to edit achievements.') %>
      + % last; +% } +% +% my $achievementID = $urlpath->arg('achievementID'); +% +<%= form_for $cg->systemLink($urlpath, authen => 0), method => 'post', + name => 'user-achievement-form', id => 'user-achievement-form', + begin =%> + % + % # Assign to everyone message +
      + <%= submit_button maketext('Assign to All Current Users'), name => 'assignToAll', class => 'btn btn-primary' =%> + <%= maketext('This action will not overwrite existing users.') %> +
      +
      +
      <%= maketext('Do not uncheck students, unless you know what you are doing.') =%>
      +
      <%= maketext('There is NO undo for unassigning students.') %>
      +
      +

      + <%== maketext( + q{When you unassign by unchecking a student's name, you destroy all of the data for achievement [_1] } + . 'for this student. Make sure this is what you want to do.', + tag('b', $achievementID) + ) =%> +

      + % + % # Output table +
      + + + + + + + + + + % + % # Output row for user + % for my $userRecord (@$userRecords) { + % my $statusClass = $ce->status_abbrev_to_name($userRecord->status) || ''; + % my $user = $userRecord->user_id; + % my $userAchievement = $db->getUserAchievement($user, $achievementID); + % my $prettyName = $userRecord->last_name . ', ' . $userRecord->first_name; + % + + + + + + % if (defined $userAchievement) { + + + % } else { + + % } + + % } +
      <%= maketext('Assigned') %><%= maketext('Login Name') %><%= maketext('Student Name') %><%= maketext('Section') %><%= maketext('Earned') %><%= maketext('Counter') %>
      + > + <%= label_for "$user.assigned" => $user %><%= $prettyName %><%= $userRecord->section %> + <%= check_box "$user.earned" => '1', + 'aria-labelledby' => 'earned_header', + class => 'form-check-input', + (ref $userAchievement ? $userAchievement->earned : 0) ? (checked => undef) : () =%> + + <%= text_field "$user.counter" => ref $userAchievement ? $userAchievement->counter : 0, + 'aria-labelledby' => 'counter_header', + size => 6, + class => 'form-control form-control-sm' =%> +
      +
      + % + <%= $cg->hidden_authen_fields =%> + <%= submit_button maketext('Save'), name => 'assignToSelected', class => 'btn btn-primary' =%> + % + % # Output unassign from all button. +
      +
      +
      + <%= maketext( + 'There is NO undo for this function. Do not use it unless you know what you are doing! ' + . 'When you unassign a student using this button, or by unchecking their name, you destroy all ' + . 'of the data for achievement [_1] for this student.', + $achievementID + ) =%> +
      +
      + <%= submit_button maketext('Unassign from All Users'), + name => 'unassignFromAll', class => 'btn btn-primary' =%> + + +
      +
      +
      +<% end =%> diff --git a/templates/ContentGenerator/Instructor/AddUsers.html.ep b/templates/ContentGenerator/Instructor/AddUsers.html.ep new file mode 100644 index 0000000000..9fea1a9135 --- /dev/null +++ b/templates/ContentGenerator/Instructor/AddUsers.html.ep @@ -0,0 +1,90 @@ +% use WeBWorK::Utils qw(format_set_name_display); +% +% unless ($authz->hasPermissions(param('user'), 'access_instructor_tools')) { +
      + <%= maketext('You are not authorized to access instructor tools.') =%> +
      + % last; +% } +% +% unless ($authz->hasPermissions(param('user'), 'modify_student_data')) { +
      <%= maketext('You are not authorized to modify student data.') =%>
      + % last; +% } +% +
      +

      <%= defined $cg->{studentEntryReport} ? $cg->{studentEntryReport}->join('') : '' %>

      +

      + <%= maketext( + 'Enter information below for students you wish to add. ' + . q{Each student's password will initially be set to their student ID.} + ) =%> +

      +% +% my $numberOfStudents = param('number_of_students') // 5; +% +%= form_for $c->uri, method => 'POST', begin + <%= $cg->hidden_authen_fields('create_') =%> +
      + <%= submit_button maketext('Create'), class => 'btn btn-primary' =%> + <%= text_field number_of_students => $numberOfStudents, size => 3, class => 'form-control' =%> + <%= maketext('entry rows.') %> +
      +% end +
      +%= form_for $c->uri, method => 'POST', begin + <%= $cg->hidden_authen_fields =%> + <%= hidden_field number_of_students => $numberOfStudents =%> +
      + + + + + + + + + + + + % for (1 .. $numberOfStudents) { + + + + + + + + + + + % } +
      <%= maketext('Last Name') %><%= maketext('First Name') %><%= maketext('Student ID') %><%= maketext('Login Name') %>*<%= maketext('Email Address') %><%= maketext('Section') %><%= maketext('Recitation') %><%= maketext('Comment') %>
      + <%= text_field "last_name_$_" => '', size => '10', + class => 'form-control form-control-sm w-auto' =%> + + <%= text_field "first_name_$_" => '', size => '10', + class => 'form-control form-control-sm w-auto' =%> + + <%= text_field "student_id_$_" => '', size => '16', + class => 'form-control form-control-sm w-auto' =%> + + <%= text_field "new_user_id_$_" => '', size => '10', + class => 'form-control form-control-sm w-auto' =%> + + <%= text_field "email_address_$_" => '', class => 'form-control form-control-sm w-auto' =%> + + <%= text_field "section_$_" => '', size => '4', + class => 'form-control form-control-sm w-auto' =%> + + <%= text_field "recitation_$_" => '', size => '4', + class => 'form-control form-control-sm w-auto' =%> + + <%= text_field "comment_$_" => '', class => 'form-control form-control-sm w-auto' =%> +
      +
      +

      <%= maketext('Select sets below to assign them to the newly-created users.') %>

      + <%= select_field assignSets => [ map { [ format_set_name_display($_) => $_ ] } $db->listGlobalSets ], + size => 10, multiple => undef, class => 'form-select w-auto mb-2' =%> +

      <%= submit_button maketext('Add Students'), name => 'addStudents', class => 'btn btn-primary' =%>

      +% end diff --git a/templates/ContentGenerator/Instructor/AddUsers/student_entry_report.html.ep b/templates/ContentGenerator/Instructor/AddUsers/student_entry_report.html.ep new file mode 100644 index 0000000000..e70ffdc8e0 --- /dev/null +++ b/templates/ContentGenerator/Instructor/AddUsers/student_entry_report.html.ep @@ -0,0 +1,33 @@ +
      + + <%= $addError ? maketext('Failed to add user:') : maketext('Added user:') %> + + <%= $newUser->last_name %>, <%= $newUser->first_name %> + <%= maketext('Login:') %> + <%= $newUser->user_id %> + % if ($newUser->student_id) { + <%= maketext('Student ID:') %> + <%= $newUser->student_id %> + % } + % if ($newUser->email_address) { + <%= maketext('Email:') %> + <%= $newUser->email_address %> + % } + % if ($newUser->section ne '') { + <%= maketext('Section:') %> + <%= $newUser->section %> + % } + % if ($newUser->recitation ne '') { + <%= maketext('Recitation:') %> + <%= $newUser->recitation %> + % } + % if ($newUser->comment) { + <%= maketext('Comment:') %> + <%= $newUser->comment %> + % } +
      +% if ($addError) { + +% } diff --git a/templates/ContentGenerator/Instructor/Assigner.html.ep b/templates/ContentGenerator/Instructor/Assigner.html.ep new file mode 100644 index 0000000000..66fb320b45 --- /dev/null +++ b/templates/ContentGenerator/Instructor/Assigner.html.ep @@ -0,0 +1,82 @@ +% use WeBWorK::HTML::ScrollingRecordList qw/scrollingRecordList/; +% +% unless ($authz->hasPermissions(param('user'), 'access_instructor_tools')) { +
      <%= maketext('You are not authorized to access instructor tools.') %>
      + % last; +% } +% +% unless ($authz->hasPermissions(param('user'), 'assign_problem_sets')) { +
      <%= maketext('You are not authorized to assign homework sets.') %>
      + % last; +% } +% +

      + <%= maketext('Select one or more sets and one or more users below to assign/unassign ' + . 'each selected set to/from all selected users.') =%> +

      +<%= form_for $c->uri, method => 'post', begin =%> + <%= $cg->hidden_authen_fields =%> + % +
      +
      +
      +
      <%= label_for selected_users => maketext('Users') =%>
      + <%= scrollingRecordList( + { + name => 'selected_users', + id => 'selected_users', + request => $c, + default_sort => 'lnfn', + default_format => 'lnfn_uid', + default_filters => ['all'], + attrs => { size => 20, multiple => undef } + }, + @$users + ) =%> +
      +
      +
      <%= label_for selected_sets => maketext('Sets') =%>
      + <%= scrollingRecordList( + { + name => 'selected_sets', + id => 'selected_sets', + request => $c, + default_sort => 'set_id', + default_format => 'sid', + default_filters => ['all'], + attrs => { size => 20, multiple => undef, dir => 'ltr' } + }, + @$globalSets + ) =%> +
      +
      +
      + <%= submit_button maketext('Assign selected sets to selected users'), + name => 'assign', class => 'btn btn-primary mb-2' =%> +
      +
      <%= maketext('Do not unassign students unless you know what you are doing.') =%>
      +
      <%= maketext('There is NO undo for unassigning students.') =%>
      +
      +
      + <%= submit_button maketext('Unassign selected sets from selected users'), + name => 'unassign', class => 'btn btn-primary me-2' =%> + + +
      +
      + <%= maketext( + 'When you unassign a set from students, you destroy all of the data for the set for those ' + . 'students. If the set is re-assigned to these students, then they will receive new versions ' + . 'of problems in the set. Make sure this is what you want to do before unassigning sets ' + . 'from students.' + ) =%> +
      +
      +
      +<% end =%> diff --git a/templates/ContentGenerator/Instructor/Config.html.ep b/templates/ContentGenerator/Instructor/Config.html.ep new file mode 100644 index 0000000000..8738ca246d --- /dev/null +++ b/templates/ContentGenerator/Instructor/Config.html.ep @@ -0,0 +1,69 @@ +% unless ($authz->hasPermissions(param('user'), 'modify_problem_sets')) { +
      + <%= maketext('You are not authorized to modify the course configuration.') %> +
      + % last; +% } +% +% my $configValues = $cg->getConfigValues($ce); +% +% if (param('show_long_doc')) { + % my $docstring; + % for my $consec (@$configValues) { + % my @configSectionArray = @$consec; + % shift @configSectionArray; + % for my $con (@configSectionArray) { + % $docstring = $con->{doc2} || $con->{doc} if ($con->{var} eq param('var_name')); + % } + % } + % +

      <%= maketext('Variable Documentation:') %> $<%= param('var_name') %>

      +

      <%== maketext($docstring) %>

      +% } else { + % # Get the current course environment again in case changes were just saved. + % my $ce4 = WeBWorK::CourseEnvironment->new({ %WeBWorK::SeedCE, courseName => $ce->{courseName}, }); + % + % if (@$configValues == 0) { +

      + <%= maketext( + 'The configuration module did not find the data it needs to function. ' + . 'Have your site administrator check that site configuration files are up to date.' + ) =%> +

      + % } else { + % my $current_tab = param('section_tab') || 'tab0'; + <%= $cg->generate_navigation_tabs($current_tab, map { $_->[0] } @$configValues) =%> + % + <%= form_for $c->uri, method => 'POST', id => 'config-form', name => 'config-form', begin =%> + <%= $cg->hidden_authen_fields =%> + <%= hidden_field section_tab => $current_tab =%> + % + % my $tabnumber = $current_tab =~ s/tab//r; + % my @configSectionArray = @{ $configValues->[$tabnumber] }; + % +

      <%= maketext(shift @configSectionArray) %>

      + % +
      + + + + + + + % for my $con (@configSectionArray) { + % my $conobject = $cg->objectify($con); + % my $name = ($conobject->{var} =~ s/[{]/-/gr) =~ s/[}]//gr; + + + + + + % } +
      <%= maketext('Setting') %><%= maketext('Default') %><%= maketext('Current') %>
      <%= $conobject->what_string %> + <%= $conobject->display_value($con->get_value($cg->{default_ce})) %> + <%= $conobject->entry_widget($con->get_value($ce4)) =%>
      +
      +

      <%= submit_button maketext('Save Changes'), name => 'make_changes', class => 'btn btn-primary' =%>

      + <% end =%> + % } +% } diff --git a/templates/ContentGenerator/Instructor/FileManager.html.ep b/templates/ContentGenerator/Instructor/FileManager.html.ep new file mode 100644 index 0000000000..907ad05bf7 --- /dev/null +++ b/templates/ContentGenerator/Instructor/FileManager.html.ep @@ -0,0 +1,62 @@ +% use WeBWorK::Utils qw(x getAssetURL); +% +% content_for js => begin + <%= javascript getAssetURL($ce, 'js/apps/FileManager/filemanager.js'), defer => undef =%> +% end +% +% unless ($authz->hasPermissions(param('user'), 'manage_course_files')) { + <%= maketext('You are not authorized to manage course files') %> + % last; +% } +% +% unless (defined $cg->{pwd}) { + <%= maktext('You have specified an illegal working directory!') %> + % last; +% } +% +<%= form_for $cg->systemLink($urlpath->newFromModule($urlpath->module, $c, courseID => $cg->{courseName}), authen => 0), + method => 'POST', id => 'FileManager', enctype => 'multipart/form-data', name => 'FileManager', begin =%> + <%= $cg->hidden_authen_fields =%> + % + % my $action = param('action') || param('formAction') || param('confirmed') || 'Init'; + % + % # Map of actions to methods. + % my %methods = ( + % x('Refresh') => 'Refresh', + % x('Cancel') => 'Refresh', + % x('Directory') => 'Go', + % x('Go') => 'Go', + % x('View') => 'View', + % x('Edit') => 'Edit', + % x('Download') => 'Refresh', + % x('Copy') => 'Copy', + % x('Rename') => 'Rename', + % x('Delete') => 'Delete', + % x('New Folder') => 'NewFolder', + % x('New File') => 'NewFile', + % x('Upload') => 'Upload', + % x('Revert') => 'Edit', + % x('Save As') => 'SaveAs', + % x('Save') => 'Save', + % x('Init') => 'Init', + % '^' => 'ParentDir', + % "\\" => 'ParentDir', + % x('Make Archive') => 'MakeArchive', + % x('Unpack Archive') => 'UnpackArchive', + % ); + % + % # Add translated action names to the method map. + % $methods{ maketext($_) } = $methods{$_} for keys %methods; + % + % # Look up the current action and perform it. + % my $method = $methods{$action}; + % if ($method) { + <%= $cg->$method =%> + % } else { + % $cg->addbadmessage('Unknown action'); + <%= $cg->Refresh =%> + % } + % + <%= hidden_field pwd => $cg->{pwd} =%> + <%= hidden_field formAction => '' =%> +<% end =%> diff --git a/templates/ContentGenerator/Instructor/FileManager/confirm.html.ep b/templates/ContentGenerator/Instructor/FileManager/confirm.html.ep new file mode 100644 index 0000000000..812f73dfc2 --- /dev/null +++ b/templates/ContentGenerator/Instructor/FileManager/confirm.html.ep @@ -0,0 +1,15 @@ +
      +
      + <%= $message =%> + <%= text_field name => $value, size => 50, class => 'form-control mt-3' =%> +
      + <%= submit_button maketext('Cancel'), name => 'formAction', class => 'btn btn-sm btn-secondary' =%> + <%= submit_button $button, name => 'formAction', class => 'btn btn-sm btn-secondary' =%> + % if ($button2) { + <%= submit_button $button2, name => 'formAction', class => 'btn btn-sm btn-secondary' =%> + % } +
      +
      +
      +<%= hidden_field confirmed => $button =%> +<%= $cg->HiddenFlags =%> diff --git a/templates/ContentGenerator/Instructor/FileManager/delete.html.ep b/templates/ContentGenerator/Instructor/FileManager/delete.html.ep new file mode 100644 index 0000000000..f2a5d48cb3 --- /dev/null +++ b/templates/ContentGenerator/Instructor/FileManager/delete.html.ep @@ -0,0 +1,78 @@ +% use WeBWorK::Utils qw(readDirectory listFilesRecursive); +% +% # Show the confirmation dialog box +
      +
      +
      + <%= maketext('Warning') %>: <%= maketext('You have requested that the following items be deleted') %> +
      + % # Look up the files to be deleted, and for directories add a trailing slash and the contents of the directory. +
        + % for my $file (@$files) { + % if (defined $cg->checkPWD("$cg->{pwd}/$file", 1)) { +
      • + % if (-l "$dir/$file") { + <%= $file %>@ + % } elsif (-d "$dir/$file") { + % my @contents; + % my $dcount = 0; + % for my $item (readDirectory("$dir/$file")) { + % next if $item eq '.' || $item eq '..'; + % push @contents, begin + % if (-l "$dir/$file/$item") { +
        <%= $item %>@
        + % } elsif (-d "$dir/$file/$item") { + % my $count = scalar(listFilesRecursive("$dir/$file/$item", '.*')); + % $dcount += $count; +
        + <%= $item %>/ + <%= maketext('([quant,_1,item])', $count) %> +
        + % } else { +
        <%= $item %>
        + % } + % end + % $dcount += 1; + % } + % +
        + <%= $file %>/ + <%= maketext('([quant,_1,item] total)', $dcount) %> +
        + % if (@contents > 15) { + <%= c(map { $_->() } @contents[ 0 .. 10 ])->join('') =%> +
          .
        +
          .
        +
          .
        + % } else { + <%= c(map { $_->() } @contents)->join('') =%> + % } + % } else { + <%= $file %> + % } +
        • + % } + % } +
      + % if (grep { -d "$dir/$_" } @$files) { +

      + <%= maketext( + 'Some of these files are directories. Only delete directories if you really know what you are ' + . 'doing. You can seriously damage your course if you delete the wrong thing.') =%> +

      + % } +

      + <%= maketext('There is no undo for deleting files or directories!') =%> +

      +

      <%= maketext('Really delete the items listed above?') %>

      +
      + <%= submit_button maketext('Cancel'), name => 'action', class => 'btn btn-sm btn-secondary' =%> + <%= submit_button maketext('Delete'), name => 'action', class => 'btn btn-sm btn-secondary' =%> +
      +
      +
      +<%= hidden_field confirmed => 'Delete' =%> +% for (@$files) { + <%= hidden_field files => $_ =%> +% } +<%= $cg->HiddenFlags =%> diff --git a/templates/ContentGenerator/Instructor/FileManager/refresh.html.ep b/templates/ContentGenerator/Instructor/FileManager/refresh.html.ep new file mode 100644 index 0000000000..8a71cbaf03 --- /dev/null +++ b/templates/ContentGenerator/Instructor/FileManager/refresh.html.ep @@ -0,0 +1,121 @@ +% my $pwd = $cg->{pwd}; +% my $files = $cg->directoryListing($pwd); +% +% unless ($files) { + % $cg->addbadmessage(maketext(q{The directory you specified doesn't exist})); + % $files = []; +% } +% +% # Directory menu and date/size checkbox +
      +
      +
      + <%= submit_button '^', name => 'action', $pwd eq '.' || $pwd eq '' ? (disabled => undef) : (), + class => 'btn btn-sm btn-secondary' =%> + <%= select_field directory => $cg->directoryMenu($pwd), class => 'form-select', dir => 'ltr' =%> +
      +
      +
      +
      + +
      +
      +
      +% +% # Directory Listing and column of buttons +% my %button = (name => 'action', style => 'width:10em', class => 'file-manager-btn btn btn btn-sm btn-secondary'); +% my $width = ($cg->getFlag('dates') && scalar(@{$files}) > 0) ? '' : ' width:30em'; +
      +
      + <%= select_field files => $files, id => 'files', class => 'form-select font-monospace h-100', + dir => 'ltr', size => 17, multiple => undef =%> +
      +
      +
      + <%= submit_button maketext('View'), id => 'View', %button =%> + <%= submit_button maketext('Edit'), id => 'Edit', %button =%> + <%= submit_button maketext('Download'), id => 'Download', %button =%> + <%= submit_button maketext('Rename'), id => 'Rename', %button =%> + <%= submit_button maketext('Copy'), id => 'Copy', %button =%> + <%= submit_button maketext('Delete'), id => 'Delete', %button =%> + <%= submit_button maketext('Make Archive'), id => 'MakeArchive', + data => { + archive_text => maketext('Make Archive'), + unarchive_text => maketext('Unpack Archive') + }, + %button =%> +
      + <%= submit_button maketext('New File'), id => 'NewFile', %button =%> + <%= submit_button maketext('New Folder'), id => 'NewFolder', %button =%> + <%= submit_button maketext('Refresh'), id => 'Refresh', %button =%> +
      +
      +
      +% +% # Upload button and checkboxes +
      +
      +
      + <%= submit_button maketext('Upload'), name => 'action', style => 'width:7em', id => 'Upload', + class => 'btn btn-sm btn-primary' =%> + <%= file_field 'file', id => 'file', class => 'form-control form-control-sm' =%> +
      +
      +
      +% +
      +
      +
      + <%= maketext('Format') %>: +
      + + + +
      +
      +
      +
      +% +
      +
      +
      +
      + +
      +
      +
      +
      +% +
      +
      +
      +
      + +
      +
      + +
      +
      +
      +
      diff --git a/templates/ContentGenerator/Instructor/FileManager/refresh_edit.html.ep b/templates/ContentGenerator/Instructor/FileManager/refresh_edit.html.ep new file mode 100644 index 0000000000..a7c9ba4a44 --- /dev/null +++ b/templates/ContentGenerator/Instructor/FileManager/refresh_edit.html.ep @@ -0,0 +1,27 @@ +% my $name = "$cg->{pwd}/$file" =~ s!^\./?!!r; +% my %button = (name => 'action', class => 'btn btn-sm btn-secondary w-100'); +% +
      +
      <%= $name %>
      +
      +
      +
      + % param('data', $contents); + <%= text_area data => '', rows => 30, columns => 80, dir => 'auto', + class => 'file-manager-editor form-control' =%> +
      +
      +
      +
      <%= submit_button maketext('Cancel'), %button %>
      +
      <%= submit_button maketext('Revert'), %button %>
      +
      <%= submit_button maketext('Save'), %button %>
      +
      +
      + <%= submit_button maketext('Save As'), name => 'action', class => 'btn btn-sm btn-secondary' =%> + <%= text_field name => '', size => 20, class => 'form-control form-control-sm' =%> +
      +
      +
      +% +<%= hidden_field files => $file =%> +<%= $cg->HiddenFlags =%> diff --git a/templates/ContentGenerator/Instructor/FileManager/view.html.ep b/templates/ContentGenerator/Instructor/FileManager/view.html.ep new file mode 100644 index 0000000000..e5a498ec85 --- /dev/null +++ b/templates/ContentGenerator/Instructor/FileManager/view.html.ep @@ -0,0 +1,23 @@ +% use WeBWorK::Utils qw(readFile); +% +% my $fileManagerURL = + % $cg->systemLink($urlpath->newFromModule($urlpath->module, $c, courseID => $cg->{courseName}), + % params => { download => $filename, pwd => $cg->{pwd} }); +% +% # Include a download link +
      + <%= $name %> + <%= link_to maketext('Download') => $fileManagerURL =%> +
      +
      +% +% # For files display the file, if possible. If the file is an image, display it as an image. +% if (-T $file) { # Check that it is a text file + 
      <%= readFile($file) =%>
      +% } elsif ($file =~ m/\.(gif|jpg|png)$/i) { + <%= image $fileManagerURL, style => 'border:0;', alt => $name =%> +% } else { +
      + <%= maketext('The file $file does not appear to be a text or image file.') =%> +
      +% } diff --git a/templates/ContentGenerator/Instructor/Index.html.ep b/templates/ContentGenerator/Instructor/Index.html.ep new file mode 100644 index 0000000000..33aabbff2a --- /dev/null +++ b/templates/ContentGenerator/Instructor/Index.html.ep @@ -0,0 +1,254 @@ +% use WeBWorK::Utils qw(getAssetURL); +% use WeBWorK::HTML::ScrollingRecordList qw(scrollingRecordList); +% +% content_for js => begin + <%= javascript getAssetURL($ce, 'js/apps/InstructorTools/instructortools.js'), defer => undef =%> +% end +% +% unless ($authz->hasPermissions(param('user'), 'access_instructor_tools')) { +
      <%= maketext('You are not authorized to access instructor tools.') %>
      + % last; +% } +% +

      + <%= maketext( + 'Use the interface below to quickly access commonly-used instructor tools, ' + . 'or select a tool from the list to the left.' + ) =%> +
      + <%= maketext('Select user(s) and/or set(s) below and click the action button of your choice.') =%> +

      +% +%= form_for $c->uri, method => 'POST', id => 'instructor-tools-form', begin + <%= $cg->hidden_authen_fields =%> + % +
      +
      +
      <%= label_for selected_users => maketext('Users') %>
      + <%= scrollingRecordList( + { + name => 'selected_users', + request => $c, + default_sort => 'lnfn', + default_format => 'lnfn_uid', + default_filters => ['all'], + attrs => { + size => 10, + multiple => undef + } + }, + @$users + ) =%> +
      +
      +
      <%= label_for selected_sets => maketext('Sets') %>
      + <%= scrollingRecordList( + { + name => 'selected_sets', + request => $c, + default_sort => 'set_id', + default_format => 'sid', + default_filters => ['all'], + attrs => { + size => 10, + multiple => undef, + dir => 'ltr' + } + }, + @$globalSets + ) =%> +
      +
      +
      +
      +
      + <%= submit_button maketext('View/Edit'), + name => 'sets_assigned_to_user', + class => 'btn btn-sm btn-secondary', + data => { users_needed => 'exactly one', error_users => maketext($E_ONE_USER) } =%> + \ + <%== maketext('all set dates for one user') =%>\ + +
      +
      + <%= submit_button maketext('Edit'), + name => 'edit_users', + class => 'btn btn-sm btn-secondary', + formaction => $cg->systemLink($urlpath->newFromModule( + 'WeBWorK::ContentGenerator::Instructor::UserList', $c, + courseID => $courseID + )), + data => { users_needed => 'at least one', error_users => maketext($E_MIN_ONE_USER) } =%> + \ + <%== maketext('class list data for selected users') =%>\ + +
      +
      + <%= submit_button maketext('Statistics'), + name => 'user_stats', + class => 'btn btn-sm btn-secondary', + data => { users_needed => 'exactly one', error_users => maketext($E_ONE_USER) } =%> + <%= maketext('or') %> + <%= submit_button maketext('progress'), + name => 'user_progress', + class => 'btn btn-sm btn-secondary', + data => { users_needed => 'exactly one', error_users => maketext($E_ONE_USER) } =%> + \ + <%== maketext('for one user') =%>\ + +
      +
      + <%= submit_button maketext('Change Password'), + name => 'user_options', + class => 'btn btn-sm btn-secondary', + data => { users_needed => 'exactly one', error_users => maketext($E_ONE_USER) } =%> + \ + <%== maketext('for one user') =%>\ + +
      +
      + <%= submit_button maketext('Add'), name => 'add_users', class => 'btn btn-sm btn-secondary' =%> + \ + <%= maketext('new users') =%>\ + +
      +
      +
      +
      + <%= submit_button maketext('View/Edit'), + name => 'users_assigned_to_set', + class => 'btn btn-sm btn-secondary', + data => { sets_needed => 'exactly one', error_sets => maketext($E_ONE_SET) } =%> + \ + <%== maketext('all users for one set') =%> + +
      +
      + <%= submit_button maketext('Edit'), + name => 'edit_sets', + class => 'btn btn-sm btn-secondary', + data => { sets_needed => 'exactly one', error_sets => maketext($E_ONE_SET) } =%> + <%== maketext('one set') =%> + <%= maketext('or') %> + <%= submit_button maketext('add problems'), + name => 'prob_lib', + class => 'btn btn-sm btn-secondary', + data => { sets_needed => 'exactly one', error_sets => maketext($E_ONE_SET) } =%> + \ + <%== maketext('to one set') =%>\ + +
      +
      + <%= submit_button maketext('Statistics'), + name => 'set_stats', + class => 'btn btn-sm btn-secondary', + data => { sets_needed => 'exactly one', error_sets => maketext($E_ONE_SET) } =%> + <%= maketext('or') %> + <%= submit_button maketext('progress'), + name => 'set_progress', + class => 'btn btn-sm btn-secondary', + data => { sets_needed => 'exactly one', error_sets => maketext($E_ONE_SET) } =%> + \ + <%== maketext('for one set') =%>\ + +
      +
      + <%= submit_button maketext('Score'), + name => 'score_sets', + class => 'btn btn-sm btn-secondary', + formaction => $cg->systemLink($urlpath->newFromModule( + 'WeBWorK::ContentGenerator::Instructor::Scoring', $c, + courseID => $courseID + )), + data => { sets_needed => 'at least one', error_sets => maketext($E_MIN_ONE_SET) } =%> + \ + <%== maketext('selected sets') =%>\ + +
      +
      + <%= submit_button maketext('Create'), + name => 'create_set', + class => 'btn btn-sm btn-secondary', + data => { + set_name_needed => 'true', + error_set_name => maketext($E_SET_NAME), + error_invalid_set_name => maketext($E_BAD_NAME) + } =%> + <%= label_for new_set_name => maketext('new set:'), class => 'input-group-text' =%> + <%= text_field new_set_name => '', + id => 'new_set_name', + placeholder => maketext('Name for new set here'), + size => 20, + class => 'form-control form-control-sm', + dir => 'ltr' =%> +
      +
      +
      +
      +
      +
      + <%= submit_button maketext('Assign'), + # This name is the same as the name of the submit button in Assigner.pm and the form is + # directly submitted to that module without modification. + name => 'assign', + class => 'btn btn-sm btn-secondary', + formaction => $cg->systemLink($urlpath->newFromModule( + 'WeBWorK::ContentGenerator::Instructor::Assigner', $c, + courseID => $courseID + )), + data => { + users_needed => 'at least one', + error_users => maketext($E_MIN_ONE_USER), + sets_needed => 'at least one', + error_sets => maketext($E_MIN_ONE_SET) + } =%> + \ + <%== maketext('selected users to selected sets') =%>\ + +
      +
      + <%= submit_button maketext('Act as'), + name => 'act_as_user', + class => 'btn btn-sm btn-secondary', + data => { + users_needed => 'exactly one', + error_users => maketext($E_ONE_USER), + sets_needed => 'at most one', + error_sets => maketext($E_MAX_ONE_SET) + } =%> + \ + <%== maketext('one user (on one set)') =%>\ + +
      +
      + <%= submit_button maketext('Edit'), + name => 'edit_set_for_users', + class => 'btn btn-sm btn-secondary', + data => { + users_needed => 'at least one', + error_users => maketext($E_MIN_ONE_USER), + sets_needed => 'exactly one', + error_sets => maketext($E_ONE_SET) + } =%> + \ + <%== maketext('one set for users') =%>\ + +
      +
      + <%= submit_button maketext('Email'), name => 'email_users', class => 'btn btn-sm btn-secondary' =%> + \ + <%= maketext('your students') =%>\ + +
      + % if ($authz->hasPermissions(param('user'), 'manage_course_files')) { +
      + <%= submit_button maketext('Transfer'), name => 'transfer_files', + class => 'btn btn-sm btn-secondary' =%> + \ + <%= maketext('course files') =%>\ + +
      + % } +
      +
      +% end diff --git a/templates/ContentGenerator/Instructor/LTIUpdate.html.ep b/templates/ContentGenerator/Instructor/LTIUpdate.html.ep new file mode 100644 index 0000000000..8a8ffebb36 --- /dev/null +++ b/templates/ContentGenerator/Instructor/LTIUpdate.html.ep @@ -0,0 +1,86 @@ +% use WeBWorK::Utils(qw(format_set_name_display getAssetURL)); +% +% # Only use javascript to update menus if using homework grade mode. +% if ($ce->{LTIGradeMode} eq 'homework') { + % content_for js => begin + <%= javascript getAssetURL($ce, 'js/apps/LTIUpdate/ltiupdate.js'), defer => undef =%> + % end +% } +% +% unless ($authz->hasPermissions(param('user'), 'score_sets')) { +
      <%= maketext('You are not authorized to update lti scores') %>
      + % last; +% } +% +% unless ($ce->{LTIGradeMode}) { +
      <%= maketext('LTI grade passback is not enabled for this course') %>
      + % last; +% } +% +% my $updateInterval = $ce->{LTIMassUpdateInterval} // -1; +% +% # Status table +
      + + + + + + + + + + + % if ($updateInterval > -1) { + + + + + % } +
      <%= maketext('LTI Grade Mode') %><%= $ce->{LTIGradeMode} %>
      <%= maketext('Update Interval') %><%= $updateInterval > -1 ? $cg->format_interval($updateInterval) : maketext('Never') %>
      <%= maketext('Last Full Update') %> + <%= $lastUpdate + ? $cg->formatDateTime($lastUpdate, 0, $ce->{studentDateDisplayFormat}) + : maketext('Never') =%> +
      <%= maketext('Next Update') %><%= $cg->formatDateTime($lastUpdate + $updateInterval, 0, $ce->{studentDateDisplayFormat}) =%>
      +
      +% +

      <%= maketext('Start LTI Grade Update') %>

      +<%= form_for $c->uri, method => 'POST', id => 'updateLTIForm', name => 'updateLTIForm', begin =%> +
      + <%= label_for updateUserID => maketext('Update user:'), class => 'col-auto col-form-label fw-bold' =%> +
      + <%= select_field updateUserID => [ + [ + maketext('All Users') => 'All Users', + selected => undef, + $ce->{LTIGradeMode} eq 'homework' ? (data => { sets => join(':', @$sets) }) : (), + ], + $ce->{LTIGradeMode} eq 'homework' + ? (map { [ $_ => $_, data => { sets => join(':', sort $db->listUserSets($_)) } ] } @$users) + : (@$users) + ], + id => 'updateUserID', class => 'form-select' =%> +
      +
      + % if ($ce->{LTIGradeMode} eq 'homework') { +
      + <%= label_for updateSetID => maketext('Update set:'), class => 'col-auto col-form-label fw-bold' =%> +
      + <%= select_field updateSetID => [ + [ + maketext('All Sets') => 'All Sets', + selected => undef, + data => { users => join(':', @$users) } + ], + map { [ + format_set_name_display($_) => $_, + data => { users => join(':', sort $db->listSetUsers($_)) } + ] } @$sets + ], + id => 'updateSetID', class => 'form-select' =%> +
      +
      + % } + <%= submit_button maketext('Update Grades'), id => 'updateLTI', name => 'updateLTI', + class => 'btn btn-primary mb-3' =%> +<% end =%> diff --git a/templates/ContentGenerator/Instructor/PGProblemEditor.html.ep b/templates/ContentGenerator/Instructor/PGProblemEditor.html.ep new file mode 100644 index 0000000000..c27d899722 --- /dev/null +++ b/templates/ContentGenerator/Instructor/PGProblemEditor.html.ep @@ -0,0 +1,181 @@ +% use WeBWorK::Utils qw(not_blank x format_set_name_display getAssetURL); +% use WeBWorK::HTML::CodeMirrorEditor + % qw(generate_codemirror_html generate_codemirror_controls_html output_codemirror_static_files); +% +% content_for js => begin + <%= output_codemirror_static_files($c) =%> + <%= javascript getAssetURL($ce, 'js/apps/ActionTabs/actiontabs.js'), defer => undef =%> + <%= javascript getAssetURL($ce, 'js/apps/PGProblemEditor/pgproblemeditor.js'), defer => undef =%> +% end +% +% unless ($authz->hasPermissions(param('user'), 'access_instructor_tools')) { +
      <%= maketext('You are not authorized to access instructor tools.') %>
      + % last; +% } +% +% unless ($authz->hasPermissions(param('user'), 'modify_student_data')) { +
      <%= maketext('You are not authorized to modify problems.') %>
      + % last; +% } +% +% if (stash('file_error')) { +
      <%= stash('file_error') %>
      + % last; +% } +% +% my %titles = ( + % blank_problem => x('Editing blank problem in file "[_1]".'), + % set_header => x('Editing set header file "[_1]".'), + % hardcopy_header => x('Editing hardcopy header file "[_1]".'), + % course_info => x('Editing course information file "[_1]".'), + % '' => x('Editing unknown file type in file "[_1]".'), + % source_path_for_problem_file => x('Editing unassigned problem file "[_1]".') +% ); +% +% my $setName = $urlpath->arg('setID') // ''; +% my $fullSetName = $cg->{fullSetID} // $setName; +% +% my $header = begin + + <%== $cg->{file_type} eq 'problem' + ? maketext( + 'Editing problem [_1] of set [_2] in file "[_3]".', + $cg->{prettyProblemNumber}, + tag('span', dir => 'ltr', format_set_name_display($fullSetName)), + tag('span', dir => 'ltr', $cg->shortPath($cg->{inputFilePath})) + ) + : maketext($titles{ $cg->{file_type} }, $cg->shortPath($cg->{inputFilePath})) =%> + +% end +% $header = $cg->isTempEditFilePath($cg->{inputFilePath}) + % ? tag('div', class => 'temporaryFile', $header) # Use colors if this is a temporary file. + % : $header->(); +% +
      <%= $header %>
      +<%= form_for $c->uri, method => 'POST', id => 'editor', name => 'editor', + enctype => 'application/x-www-form-urlencoded', class => 'col-12', begin =%> + <%= $cg->hidden_authen_fields =%> + <%= hidden_field file_type => $cg->{file_type} =%> + <%= hidden_field courseID => $cg->{courseID} =%> + % if (defined $setName) { + <%= hidden_field hidden_set_id => $setName =%> + % } + % if (not_blank($cg->{sourceFilePath})) { + <%= hidden_field sourceFilePath => $cg->{sourceFilePath} =%> + % } + % if (($cg->{file_type} eq 'problem' || $cg->{file_type} eq 'source_path_for_problem_file') + % && not_blank($cg->{editFilePath})) + % { + <%= hidden_field edit_file_path => $cg->getRelativeSourceFilePath($cg->{editFilePath}) =%> + % } + % if (not_blank($cg->{tempFilePath})) { + <%= hidden_field temp_file_path => $cg->{tempFilePath} =%> + % } + % + % # PG problem authoring resource links +
      + % # http://webwork.maa.org/wiki/Category:Problem_Techniques + <%= link_to maketext('Problem Techniques') => $ce->{webworkURLs}{problemTechniquesHelpURL}, + target => 'techniques_window', + title => maketext('Snippets of PG code illustrating specific techniques'), + class => 'reference-link btn btn-sm btn-info', + data => { bs_toggle => 'tooltip', bs_placement => 'top' } =%> + % # http://webwork.maa.org/wiki/Category:MathObjects + <%= link_to maketext('Math Objects') => $ce->{webworkURLs}{MathObjectsHelpURL}, + target => 'math_objects', + title => maketext('Wiki summary page for MathObjects'), + class => 'reference-link btn btn-sm btn-info', + data => { bs_toggle => 'tooltip', bs_placement => 'top' } =%> + % # http://webwork.maa.org/pod/pg_TRUNK/ + <%= link_to maketext('POD') => $ce->{webworkURLs}{PODHelpURL}, + target => 'pod_docs', + title => maketext( + 'Documentation from source code for PG modules and macro files. Often the most up-to-date information.' + ), + class => 'reference-link btn btn-sm btn-info', + data => { bs_toggle => 'tooltip', bs_placement => 'top' } =%> + % # https://courses1.webwork.maa.org/webwork2/cervone_course/PGML/1/?login_practice_user=true + <%= link_to maketext('PGML') => $ce->{webworkURLs}{PGMLHelpURL}, + target => 'PGML', + title => maketext( + 'PG mark down syntax used to format WeBWorK questions. ' + . 'This interactive lab can help you to learn the techniques.' + ), + class => 'reference-link btn btn-sm btn-info', + data => { bs_toggle => 'tooltip', bs_placement => 'top' } =%> + % # http://webwork.maa.org/wiki/Category:Authors + <%= link_to maketext('Author Info') => $ce->{webworkURLs}{AuthorHelpURL}, + target => 'author_info', + title => maketext('Top level of author information on the wiki.'), + class => 'reference-link btn btn-sm btn-info', + data => { bs_toggle => 'tooltip', bs_placement => 'top' } =%> + % # Only show the report bugs in problem button if editing an OPL or Contrib problem. + % if ($cg->{editFilePath} =~ m|^$ce->{courseDirs}{templates}/([^/]*)/| && ($1 eq 'Library' || $1 eq 'Contrib')) { + <%= link_to maketext('Report Bugs in this Problem') => + "$ce->{webworkURLs}{bugReporter}?product=Problem%20libraries" + . "&component=$1&bug_file_loc=$cg->{editFilePath}_with_problemSeed=$cg->{problemSeed}", + target => 'bug_report', + title => maketext( + 'Report bugs in a WeBWorK question/problem using this link. ' + . 'The very first time you do this you will need to register with an email address so that ' + . 'information on the bug fix can be reported back to you.' + ), + class => 'reference-link btn btn-sm btn-info', + data => { bs_toggle => 'tooltip', bs_placement => 'top' } =%> + % } +
      +
      +
      + <%= generate_codemirror_html($c, 'problemContents', $problemContents) =%> +
      +
      +
      +
      +
      <%= maketext('Loading...') %>
      + +
      +
      +
      +
      + <%= generate_codemirror_controls_html($c) =%> + % + % # Output action forms + % my $default_choice; + % + % for my $actionID (@$formsToShow) { + % my $line_contents = include("ContentGenerator/Instructor/PGProblemEditor/${actionID}_form"); + % my $active = ''; + % + % if ($line_contents && $line_contents ne '') { + % unless ($default_choice) { $active = ' active'; $default_choice = $actionID; } + % content_for 'tab-list' => begin + + % end + % content_for 'tab-content' => begin +
      " + id="<%= $actionID %>" role="tabpanel" aria-labelledby="<%= $actionID %>-tab"> + <%= $line_contents %> +
      + % end + % } + % } + % + <%= hidden_field action => $default_choice, id => 'current_action' =%> +
      +
        <%= content 'tab-list' =%>
      +
      <%= content 'tab-content' %>
      +
      +
      + <%= submit_button maketext('Take Action!'), name => 'submit', id => 'submit_button_id', + class => 'btn btn-primary' =%> +
      +<% end =%> diff --git a/templates/ContentGenerator/Instructor/PGProblemEditor/add_problem_form.html.ep b/templates/ContentGenerator/Instructor/PGProblemEditor/add_problem_form.html.ep new file mode 100644 index 0000000000..f995c723b9 --- /dev/null +++ b/templates/ContentGenerator/Instructor/PGProblemEditor/add_problem_form.html.ep @@ -0,0 +1,30 @@ +% last if $cg->{file_type} eq 'course_info'; +% +% my $allSetNames = [ map { $_->[0] =~ s/^set|\.def$//gr } $db->listGlobalSetsWhere({}, 'set_id') ]; +% +
      +
      + <%= label_for action_add_problem_target_set_id => maketext('Add to what set?'), + class => 'col-form-label col-auto' =%> +
      + <%= select_field 'action.add_problem.target_set' => [ + map { [ + format_set_name_display($_) => $_, $_ eq $cg->{setID} ? (selected => undef) : () + ] } @$allSetNames + ], + id => 'action_add_problem_target_set_id', class => 'form-select form-select-sm d-inline w-auto', + dir => 'ltr' =%> +
      +
      +
      + <%= label_for action_add_problem_file_type_id => maketext('Add as what filetype?'), + class => 'col-form-label col-auto' =%> +
      + <%= select_field 'action.add_problem.file_type' => [ + map { [ $_ =~ s/_/ /gr => $_, $cg->{file_type} eq $_ ? (selected => undef) : () ] } + ('problem', 'set_header', 'hardcopy_header') + ], + id => 'action_add_problem_file_type_id', class => 'form-select form-select-sm d-inline w-auto' =%> +
      +
      +
      diff --git a/templates/ContentGenerator/Instructor/PGProblemEditor/hardcopy_form.html.ep b/templates/ContentGenerator/Instructor/PGProblemEditor/hardcopy_form.html.ep new file mode 100644 index 0000000000..3125f7e3b4 --- /dev/null +++ b/templates/ContentGenerator/Instructor/PGProblemEditor/hardcopy_form.html.ep @@ -0,0 +1,62 @@ +% last if $cg->{file_type} eq 'course_info'; +% +
      +
      + <%= label_for action_hardcopy_seed_id => maketext('Using what seed?'), + class => 'col-form-label col-auto mb-2' =%> +
      + <%= text_field 'action.hardcopy.seed' => value => $cg->{problemSeed}, + id => 'action_hardcopy_seed_id', class => 'form-control form-control-sm' =%> +
      +
      + +
      +
      +
      + <%= label_for 'action_hardcopy_format_id' , class => 'col-form-label col-auto', begin =%> + <%= maketext('Using which hardcopy format?') =%> + <%= link_to '#', + class => 'help-popup', + data => { + bs_content => maketext( + 'If "PDF" is selected, then a PDF file will be generated for download, unless there are ' + . 'errors. If errors occur generating a PDF file or "TeX Source" is selected then a ' + . 'zip file will be generated for download that contains the TeX source file and ' + . 'resources needed for generating the PDF file using pdflatex.' + ), + bs_placement => 'top', + bs_toggle => 'popover' + }, + role => 'button', + tabindex => 0, + begin =%> + + <% end =%> + <% end =%> +
      + <%= select_field 'action.hardcopy.format' => [ + [ maketext('PDF') => 'pdf', selected => undef ], + [ maketext('TeX Source') => 'tex' ] + ], + id => 'action_hardcopy_format_id', + class => 'form-select form-select-sm d-inline w-auto' =%> +
      +
      +
      + <%= label_for action_hardcopy_theme_id => maketext('Using which hardcopy theme?'), + class => 'col-form-label col-auto' =%> +
      + <%= select_field 'action.hardcopy.theme' => [ + map { [ + $ce->{hardcopyThemeNames}{$_} => $_, + $_ eq $ce->{hardcopyTheme} ? (selected => undef) : () + ] } @{ $ce->{hardcopyThemes} } + ], + id => 'action_hardcopy_theme_id', + class => 'form-select form-select-sm d-inline w-auto' =%> +
      +
      +
      diff --git a/templates/ContentGenerator/Instructor/PGProblemEditor/revert_form.html.ep b/templates/ContentGenerator/Instructor/PGProblemEditor/revert_form.html.ep new file mode 100644 index 0000000000..1d1ed4c131 --- /dev/null +++ b/templates/ContentGenerator/Instructor/PGProblemEditor/revert_form.html.ep @@ -0,0 +1,5 @@ +% if ($cg->{file_type} ne 'course_info' && !-r $cg->{editFilePath}) { + <%= maketext('Error: The original file [_1] cannot be read.', $cg->{editFilePath}) =%> +% } elsif (defined $cg->{tempFilePath} && -e $cg->{tempFilePath}) { + <%== maketext('Revert to [_1]', tag('span', dir => 'ltr', $cg->shortPath($cg->{editFilePath}))) =%> +%} diff --git a/templates/ContentGenerator/Instructor/PGProblemEditor/save_as_form.html.ep b/templates/ContentGenerator/Instructor/PGProblemEditor/save_as_form.html.ep new file mode 100644 index 0000000000..bf7b58d895 --- /dev/null +++ b/templates/ContentGenerator/Instructor/PGProblemEditor/save_as_form.html.ep @@ -0,0 +1,84 @@ +% use File::Basename qw(dirname); +% +% use WeBWorK::Utils qw(jitar_id_to_seq not_blank format_set_name_display); +% +% # Don't show the save as form when editing an existing course info file. +% last if $cg->{file_type} eq 'course_info' && -e $cg->{editFilePath}; +% +% my $templatesDir = $ce->{courseDirs}{templates}; +% my $shortFilePath = $cg->{editFilePath} =~ s|^$templatesDir/||r; +% +% # Suggest that modifications be saved to the "local" subdirectory if its not in a writeable directory +% $shortFilePath = "local/$shortFilePath" if !-w dirname($cg->{editFilePath}); +% +% # If it is an absolute path make it relative. +% $shortFilePath =~ s|^/*|| if $shortFilePath =~ m|^/|; +% +% my $probNum = $cg->{file_type} eq 'problem' ? $cg->{problemID} : 'header'; +% +% # Don't add or replace problems to sets if the set is the Undefined_Set or if the problem is the blank_problem. +% my $can_add_problem_to_set = + % not_blank($cg->{setID}) && $cg->{setID} ne 'Undefined_Set' && $cg->{file_type} ne 'blank_problem'; +% +% my $prettyProbNum = $probNum; +% if ($cg->{setID}) { + % my $set = $db->getGlobalSet($cg->{setID}); + % $prettyProbNum = join('.', jitar_id_to_seq($probNum)) + % if ($cg->{file_type} eq 'problem' && $set && $set->assignment_type eq 'jitar'); +% } +% +
      +
      + <%= label_for action_save_as_target_file_id => maketext('Save file to:'), + class => 'col-form-label col-auto' =%> +
      +
      + <%= label_for action_save_as_target_file_id => '[TMPL]/', class => 'input-group-text' =%> + <%= text_field 'action.save_as.target_file' => $shortFilePath, + id => 'action_save_as_target_file_id', class => 'form-control form-control-sm', + size => 60, dir => 'ltr', + # Don't allow changing the file name for course info files. + # The filename needs to be what is set in the course environment. + $cg->{file_type} eq 'course_info' ? (readonly => undef) : () =%> +
      +
      + <%= hidden_field 'action.save_as.source_file' => $cg->{editFilePath} =%> + <%= hidden_field 'action.save_as.file_type' => $cg->{file_type} =%> +
      + % if ($can_add_problem_to_set) { +
      + <%= radio_button 'action.save_as.saveMode' => 'rename', id => 'action_save_as_saveMode_rename_id', + checked => undef, class => 'form-check-input' =%> + <%= label_for 'action_save_as_saveMode_rename_id', class => 'form-check-label', begin =%> + <%== maketext('Replace current problem: [_1]', + tag( + 'strong', + c( + tag('span', dir => 'ltr', format_set_name_display($cg->{fullSetID})), + "/$prettyProbNum" + )->join('') + ) + ) =%> + <% end =%> +
      +
      + <%= radio_button 'action.save_as.saveMode' => 'add_to_set_as_new_problem', + id => 'action_save_as_saveMode_new_problem_id', class => 'form-check-input' =%> + <%= label_for 'action_save_as_saveMode_new_problem_id', class => 'form-check-label', begin =%> + <%== maketext( + 'Append to end of [_1] set', + tag('strong', dir => 'ltr', format_set_name_display($cg->{fullSetID})) + ) =%> + <% end =%> +
      + % } + % if ($cg->{file_type} ne 'course_info') { +
      + <%= radio_button 'action.save_as.saveMode' => 'new_independent_problem', + id => 'action_save_as_saveMode_independent_problem_id', class => 'form-check-input', + $can_add_problem_to_set ? () : (checked => undef) =%> + <%= label_for action_save_as_saveMode_independent_problem_id => maketext('Create unattached problem'), + class => 'form-check-label' =%> +
      + % } +
      diff --git a/templates/ContentGenerator/Instructor/PGProblemEditor/save_form.html.ep b/templates/ContentGenerator/Instructor/PGProblemEditor/save_form.html.ep new file mode 100644 index 0000000000..15e1fb2b4e --- /dev/null +++ b/templates/ContentGenerator/Instructor/PGProblemEditor/save_form.html.ep @@ -0,0 +1,14 @@ +% # Can't save blank problems without changing names, and can't save if lacking write permissions. +% last unless $cg->{editFilePath} !~ /blankProblem\.pg$/ && -w $cg->{editFilePath}; +% +
      +
      + <%== maketext('Save to [_1] and View', tag('b', dir => 'ltr', $cg->shortPath($cg->{editFilePath}))) =%> +
      +
      + <%= check_box newWindowSave => 1, id => 'newWindowSave', class => 'form-check-input', + $cg->{file_type} eq 'hardcopy_header' ? (checked => undef) : () =%> + <%= label_for newWindowSave => maketext('Open in new window'), class => 'form-check-label' =%> +
      + <%= hidden_field 'action.save.source_file' => $cg->{editFilePath} =%> +
      diff --git a/templates/ContentGenerator/Instructor/PGProblemEditor/view_form.html.ep b/templates/ContentGenerator/Instructor/PGProblemEditor/view_form.html.ep new file mode 100644 index 0000000000..80039d79cb --- /dev/null +++ b/templates/ContentGenerator/Instructor/PGProblemEditor/view_form.html.ep @@ -0,0 +1,32 @@ +% # Hardcopy headers are previewed from the hardcopy generation tab. +% last if $cg->{file_type} eq 'hardcopy_header'; +% +
      +
      + <%= label_for action_view_seed_id => maketext('Using what seed?'), class => 'col-form-label col-auto mb-2' =%> +
      + <%= text_field 'action.view.seed' => $cg->{problemSeed}, + id => 'action_view_seed_id', class => 'form-control form-control-sm' =%> +
      +
      + +
      +
      +
      + <%= label_for action_view_displayMode_id => maketext('Using what display mode?'), + class => 'col-form-label col-auto' =%> +
      + <%= select_field 'action.view.displayMode' => [ + map { [ $_ => $_, $_ eq $cg->{displayMode} ? (selected => undef) : () ] } @{ $ce->{pg}{displayModes}} + ], id => 'action_view_displayMode_id', class => 'form-select form-select-sm d-inline w-auto' =%> +
      +
      +
      +
      + <%= check_box 'newWindowView' => 1, id => 'newWindowView', class => 'form-check-input' =%> + <%= label_for newWindowView => maketext('Open in new window'), class => 'form-check-label' =%> +
      +
      +
      diff --git a/templates/ContentGenerator/Instructor/ProblemGrader.html.ep b/templates/ContentGenerator/Instructor/ProblemGrader.html.ep new file mode 100644 index 0000000000..e71e4e9af0 --- /dev/null +++ b/templates/ContentGenerator/Instructor/ProblemGrader.html.ep @@ -0,0 +1,154 @@ +% use WeBWorK::Utils qw(sortByName wwRound getAssetURL); +% +% content_for js => begin + <%= javascript getAssetURL($ce, 'js/apps/ProblemGrader/problemgrader.js'), defer => undef =%> +% end +% +% content_for css => begin + <%= stylesheet getAssetURL($ce, 'js/apps/Problem/problem.css') =%> +% end +% +% unless ($authz->hasPermissions(param('user'), 'access_instructor_tools')) { +
      + <%= maketext('You are not authorized to access instructor tools.') =%> +
      + % last; +% } +% +% unless ($authz->hasPermissions(param('user'), 'score_sets')) { +
      <%= maktext('You are not authorized to grade homework sets.') %>
      + % last; +% } +% +% unless ($cg->{set} && $cg->{problem}) { +
      + <%= maketext('This set needs to be assigned to you before you can grade it.') =%> +
      + % last; +% } +% +% my $courseName = $urlpath->arg('courseID'); +% my $setID = $urlpath->arg('setID'); +% my $problemID = $urlpath->arg('problemID'); +% +% # Check to see what type the answers are. +% my @answerTypes; +% for (sortByName(undef, keys %{ $cg->{pg}{answers} })) { + % push(@answerTypes, $cg->{pg}{answers}{$_}{type}); +% } +% +
      <%== $cg->{pg}{body_text} %>
      +% +<%= form_for $cg->systemLink($urlpath, authen => 0), method => 'POST', id => 'problem-grader-form', + name => 'problem-grader-form', begin =%> + % +
      + + + + + + + + + + + + + % for my $user (@{ $cg->{users} }) { + % next unless $user->{data}{problem}; + % # Skip this user if the pg file for the user's past answer doesn't match the current pg file. + % next + % if (defined $user->{data}{past_answer} + % && defined $user->{data}{past_answer}->source_file + % && $user->{data}{past_answer}->source_file ne $cg->{problem}->source_file); + % + % my $userID = $user->user_id; + % + + + + + + + + + % } + +
      <%= maketext('Section') %><%= maketext('Name') %><%= maketext('Latest Answers') %> + <%= maketext('Mark Correct') %> +
      + +       		<%= maketext('Score (%)') %><%= maketext('Comment') %>
      <%= $user->section %> +
      + <%= link_to $user->last_name . ', ' . $user->first_name => $cg->systemLink( + $urlpath->new( + type => 'problem_detail', + args => { + courseID => $courseName, + setID => $setID, + problemID => $problemID + } + ), + params => { effectiveUser => $userID } + ), + target => 'WW_View' =%> +
      +       		+ % if ($user->{data}{past_answer} ) { + % my @scores = split(//, $user->{data}{past_answer}->scores); + % my @answers = split(/\t/, $user->{data}{past_answer}->answer_string); + % + % for (my $i = 0; $i <= $#answers; $i++) { + % if (!defined $answerTypes[$i]) { + % # If the answer type is undefined then just display the result. +

      <%= $answers[$i] %>

      + % } elsif ($answerTypes[$i] eq 'essay') { + % # If the answer is an essay answer then display it line by line. +
      + % for (split /\n/, $answers[$i]) { + <%= $_ =%> +
      + % } +
      + % } elsif ($answerTypes[$i] eq 'Value (Formula)') { + % # If its a formula then mark it as tex for MathJax and color it. +
      + `<%= $answers[$i] %>` +
      + % } else { + % # If it isn't an essay or a formula then show it as text and color it. +
      + <%= $answers[$i] %> +
      + % } + % } + % } else { + <%= 'There are no answers for this student.' =%> + % } +       		+ <%= check_box "$userID.mark_correct" => '1', class => 'mark_correct form-check-input', + 'aria-labelledby' => 'mark-all-correct-header' =%> + + <%= number_field "$userID.score" => wwRound(0, $user->{data}{problem}->status * 100), + class => 'score-selector form-select form-select-sm', style => 'width:6.5rem;', + min => 0, max => 100, autocomplete => 'off', 'aria-labelledby' => 'score-header' =%> + + % if ($user->{data}{past_answer}) { + <%= text_area "$userID.comment" => $user->{data}{past_answer}->comment_string, + rows => 3, class => 'form-control', 'aria-labelledby' => 'comment-header' =%> +
      + + % } +
      +
      + <%= $cg->hidden_authen_fields =%> + <%= submit_button maketext('Save'), name => 'assignGrades', class => 'btn btn-primary mb-2' =%> +<% end =%> diff --git a/templates/ContentGenerator/Instructor/ProblemSetDetail.html.ep b/templates/ContentGenerator/Instructor/ProblemSetDetail.html.ep new file mode 100644 index 0000000000..2caf2b9793 --- /dev/null +++ b/templates/ContentGenerator/Instructor/ProblemSetDetail.html.ep @@ -0,0 +1,710 @@ +% use WeBWorK::Utils + % qw(sortByName listFilesRecursive jitar_id_to_seq seq_to_jitar_id format_set_name_display getAssetURL); +% +% content_for css => begin + % log->info('hello'); + <%= stylesheet getAssetURL($ce, 'node_modules/flatpickr/dist/flatpickr.min.css') =%> + <%= stylesheet getAssetURL($ce, 'node_modules/flatpickr/dist/plugins/confirmDate/confirmDate.css') =%> +% end +% +% content_for js => begin + <%= javascript getAssetURL($ce, 'node_modules/luxon/build/global/luxon.min.js'), defer => undef =%> + <%= javascript getAssetURL($ce, 'node_modules/flatpickr/dist/flatpickr.min.js'), defer => undef =%> + % if ($ce->{language} !~ /^en/) { + <%= javascript + getAssetURL($ce, 'node_modules/flatpickr/dist/l10n/' . ($ce->{language} =~ s/^(..).*/$1/gr) . '.js'), + defer => undef =%> + % } + <%= javascript getAssetURL($ce, 'node_modules/flatpickr/dist/plugins/confirmDate/confirmDate.js'), + defer => undef =%> + <%= javascript getAssetURL($ce, 'js/apps/DatePicker/datepicker.js'), defer => undef =%> + <%= javascript getAssetURL($ce, 'node_modules/sortablejs/Sortable.min.js'), defer => undef =%> + <%= javascript getAssetURL($ce, 'node_modules/iframe-resizer/js/iframeResizer.min.js') =%> + <%= javascript getAssetURL($ce, 'js/apps/ProblemSetDetail/problemsetdetail.js'), defer => undef =%> +% end +% +% unless ($authz->hasPermissions(param('user'), 'access_instructor_tools')) { +
      <%= maketext('You are not authorized to access instructor tools.') %>
      + % last; +% } +% +% unless ($authz->hasPermissions(param('user'), 'modify_problem_sets')) { +
      <%= maketext('You are not authorized to modify problems.') %>
      + % last; +% } +% +% my @editForUser = param('editForUser'); +% +% if ($editingSetVersion && @editForUser != 1) { +
      + <%= maketext('Versions of a set can only be edited for one user at a time.') =%> +
      + % last; +% } +% +% unless ($setRecord) { +
      <%= maketext('No record for global set [_1].', $setID) =%>
      + % last; +% } +% +% # Creates two separate tables, first of the headers, and then of the problems in a given set. +% # If one or more users are specified in the "editForUser" param, only the data for those users +% # becomes editable, not all the data. +% +% my $courseID = $urlpath->arg('courseID'); +% my $isGatewaySet = $setRecord->assignment_type =~ /gateway/; +% my $isJitarSet = $setRecord->assignment_type eq 'jitar'; +% my $userToShow = @editForUser ? $editForUser[0] : param('user'); +% +% if (stash('forUsers')) { + % if (@editForUser && @$unassignedUsers) { +
      + <%== maketext( + 'The following users are NOT assigned to this set and will be ignored: [_1]', + tag('b', join(', ', @$unassignedUsers)) + ) =%> +
      + % } elsif (!@editForUser) { +
      + <%== maketext( + 'None of the selected users are assigned to this set: [_1]', + tag('b', join(', ', @$unassignedUsers)) + ) =%> +
      +
      + <%= maketext('Global set data will be shown instead of user specific data') =%> +
      + % } + % + % my $setDetailPage = $urlpath->newFromModule($urlpath->module, $c, courseID => $courseID, setID => $setID); + % + % # Calculate links for the users being edited. + % my $userLinks = c; + % for my $userID (@editForUser) { + % my $user = $db->getUser($userID); + % my $line = begin + + <%= $user->last_name %>, <%= $user->first_name %> + (<%= link_to $user->user_id => 'mailto:' . $user->email_address %>). + + % if (!$editingSetVersion) { + <%== maketext( + 'Assigned to [_1].', + link_to( + $cg->setCountMessage($db->countUserSets($user->user_id), $db->countGlobalSets) => + $cg->systemLink($urlpath->newFromModule( + 'WeBWorK::ContentGenerator::Instructor::UserDetail', $c, + courseID => $courseID, + userID => $user->user_id + )) + ) + ) =%> + % } else { + <%== maketext( + 'Edit set [_1] for this user.', + link_to( + $setID => $cg->systemLink( + $setDetailPage, params => { effectiveUser => $user->user_id, editForUser => $user->user_id } + ) + ) + ) =%> + % } + % end + % push @$userLinks, $line->(); + % } + % @$userLinks = sort @$userLinks; + % +
      +
      +
      + <%== maketext( + 'Editing problem set [_1] for these students: [_2]', + tag( + 'strong', + dir => 'ltr', + format_set_name_display($setID . ($editingSetVersion ? ",v$editingSetVersion" : '')) + ), + c( + tag('br'), + tag('strong', $userLinks->join(tag('br'))) + )->join('') + ) =%> +
      +
      + <%= link_to $cg->systemLink($setDetailPage), begin =%> + <%== maketext( + 'Edit set [_1] for ALL students assigned to this set.', + tag('strong', dir => 'ltr', format_set_name_display($setID)) + ) => $cg->systemLink($setDetailPage) =%> + <% end =%> + % # Handy messages when editing gateway sets. + % if ($isGatewaySet && !$editingSetVersion) { +
      + + <%= maketext( + 'To edit a specific student version of this set, edit (all of) her/his assigned sets.') =%> + + % } +
      +
      +
      +% } else { +
      +
      +
      + <%== maketext( + 'This set [_1] is assigned to [_2].', + tag('strong', dir => 'ltr', format_set_name_display($setID)), + $cg->userCountMessage($db->countSetUsers($setID), $db->countUsers) + ) =%> +
      +
      + <%== maketext( + 'Edit [_1] of set [_2].', + link_to(maketext('individual versions') => $cg->systemLink( + $urlpath->newFromModule( + "WeBWorK::ContentGenerator::Instructor::UsersAssignedToSet", $c, + courseID => $courseID, + setID => $setID + ), + params => { pageVersion => "instructor_set_detail" } + )), + tag('span', dir => 'ltr', format_set_name_display($setID)) + ) =%> +
      +
      +
      +% } +% +
      + % if (@editForUser) { + <%= maketext('Any changes made below will be reflected in the set for ONLY the student(s) listed above.') =%> + % } else { + <%= maketext('Any changes made below will be reflected in the set for ALL students.') =%> + % } +
      +% +<%= form_for $cg->systemLink( + $urlpath->newFromModule($urlpath->module, $c, courseID => $courseID, setID => $fullSetID), + authen => 0 + ), id => 'problem_set_form', name => 'problem_set_form', method => 'POST', begin =%> + % + % for (@editForUser) { + <%= hidden_field editForUser => $_ =%> + % } + <%= $cg->hidden_authen_fields =%> + <%= hidden_field courseID => $courseID, id => 'hidden_course_id' =%> + <%= hidden_field setID => $setID, id => 'hidden_set_id' =%> + % if ($editingSetVersion) { + <%= hidden_field versionID => $editingSetVersion, id => 'hidden_version_id' =%> + % } + % # Add the course language in a hidden input so that the javascript can get this information. + <%= hidden_field hidden_language => $ce->{language} =%> + % +
      + <%= submit_button maketext('Save Changes'), name => 'submit_changes', class => 'btn btn-primary' =%> + <%= submit_button maketext('Reset Form'), name => 'undo_changes', class => 'btn btn-primary' =%> +
      + % + % # General set information +
      +
      +
      <%= maketext('General Information') %>
      +
      + <%= $cg->fieldTable($userToShow, $setID, undef, $setRecord, + $editingSetVersion + ? $db->getSetVersion($userToShow, $setID, $editingSetVersion) + : $db->getUserSet($userToShow, $setID)) =%> +
      +
      +
      + % + % # Set description +
      + % if (@editForUser == 1) { +

      <%= maketext('Set Description') %>

      + <%= hidden_field "set.$setID.description" => $setRecord->description, id => "set.$setID.description" =%> + <%= $setRecord->description || maketext('No Description') =%> + % } else { + <%= label_for "set.$setID.description" => maketext('Set Description'), + class => 'form-label fw-bold fs-4' =%> + <%= text_area "set.$setID.description" => $setRecord->description, + id => "set.$setID.description", rows => 5, cols => 62, class => 'form-control' =%> + % } +
      + % + % # Display header information + % if (!@editForUser) { +
      +
      +
      <%= maketext("Headers") %>
      + % for my $headerType (@$headers) { +
      +
      +
      + + + + + + + +
      + <%= label_for "set.$setID.$headerType" => + maketext($field_properties->{$headerType}{name}), + class => 'form-label' =%> +
      + <%= link_to $cg->systemLink( + $urlpath->new( + type => 'instructor_problem_editor_withset_withproblem', + args => { + courseID => $courseID, + setID => $setID, + problemID => 0 + } + ), + params => { file_type => $headerType } + ), + class => 'psd_edit btn btn-secondary btn-sm', + target => 'WW_Editor', + data => { + bs_toggle => 'tooltip', + bs_title => maketext('Edit Header'), + bs_placement => 'top' + }, + begin =%> + + + <% end =%> + <%= link_to $cg->systemLink($urlpath->new( + type => { + set_header => 'problem_list', + hardcopy_header => 'hardcopy_preselect_set' + }->{$headerType}, + args => { courseID => $courseID, setID => $setID } + )), + class => 'psd_view btn btn-secondary btn-sm', + target => 'WW_View', + data => { + bs_toggle => 'tooltip', + bs_placement => 'top', + bs_title => maketext('Open in New Window') + }, + begin =%> + + <% end =%> +
      +
      +
      +
      + % # Browse available header/problem files +
      + % my $skip = join("|", keys %{ $ce->{courseFiles}{problibs} }); + <%= text_field "set.$setID.$headerType" => + $setRecord->{$headerType} || 'defaultHeader', + id => "set.$setID.$headerType", + class => 'combo-box-text form-control mb-1' =%> + <%= select_field "set.$setID.$headerType" => [ + [ + maketext('Use Default Header File') => 'defaultHeader', + ($setRecord->{$headerType} || 'defaultHeader') eq 'defaultHeader' + ? (selected => undef) + : () + ], + map { [ + $_ => $_, + $setRecord->{$headerType} && $setRecord->{$headerType} eq $_ + ? (selected => undef) + : () + ] } sortByName( + undef, + listFilesRecursive( + $ce->{courseDirs}{templates}, + qr/header.*\.pg$/i, + qr/^(?:$skip)$/, + 0, + 1 + ) + ) + ], + class => 'combo-box-select form-select', + 'aria-labelledby' => "set.$setID.$headerType" =%> +
      +
      +
      +
      +
      + % } +
      +
      + % } else { +

      + + <%= maketext( + 'Screen and Hardcopy set header information can not be overridden for individual students.') =%> + +

      + % } + % + % # Display problem information + % + % if (%$globalProblems) { + % # Create rows for problems. +

      <%= maketext('Problems') %>

      +
      + % if (@editForUser != 1) { +
      + + + +
      + % } + % if (!@editForUser) { +
      + + +
      + % } + % if ($isJitarSet) { +
      + + +
      + % } +
      + <%= label_for problem_displaymode => maketext('Display Mode:'), class => 'input-group-text' =%> + <%= select_field 'problem.displaymode' => [ + grep { exists $display_modes->{$_} } @{ $ce->{pg}{displayModes} } + ], + id => 'problem_displaymode', class => 'form-select w-auto flex-grow-0' =%> +
      +
      + % +
      + % my %shownYet; + % my $repeatFile; + % my @problemRows; + % + % for my $problemID (@$problemIDList) { + % my $problemRecord = + % @editForUser == 1 + % ? $mergedProblems->{$problemID} + % : $globalProblems->{$problemID}; + % + % my $problemFile = + % ((param("problem.$problemID.source_file") || $problemRecord->source_file) =~ s|^/||r) =~ + % s|\.\.||gr; + % + % # Warn of repeat problems + % if (defined $shownYet{$problemFile}) { + % my $prettyID = $shownYet{$problemFile}; + % $prettyID = join('.', jitar_id_to_seq($prettyID)) if $isJitarSet; + % $repeatFile = maketext('This problem uses the same source file as number [_1].', $prettyID); + % } else { + % $shownYet{$problemFile} = $problemID; + % $repeatFile = ''; + % } + % + % my $error = $cg->checkFile($problemFile, undef); + % + % # Show the "Try It" and "Edit It" links if there's a well defined problem to view. This is when editing a + % # homework set, or editing a gateway set version, or editing a gateway set and the problem is not a group + % # problem. Also add "grade problem" links for problems which have essay questions. + % my $showLinks = !$isGatewaySet || $editingSetVersion || $problemFile !~ /^group/; + % + % my $problemNumber = $problemID; + % my $lastProblemNumber = $problemID; + % my $parentID = ''; + % my $collapseButton = ''; + % if ($isJitarSet) { + % my @seq = jitar_id_to_seq($problemNumber); + % $problemNumber = join('.', @seq); + % $lastProblemNumber = pop @seq; + % $parentID = seq_to_jitar_id(@seq) if @seq; + % my $button = begin + + % end + % $collapseButton = $button->(); + % } + % + % # When editing a set version, make sure to use the merged problem in the edit, as problem groups could + % # be in use for which the problem is generated and then stored in the problem version. + % my $problemToShow = $editingSetVersion ? $mergedProblems->{$problemID} : $userProblems->{$problemID}; + % + % my @source_file_parts = $cg->fieldHTML($userToShow, $setID, $problemID, $globalProblems->{$problemID}, + % $problemToShow, 'source_file'); + % + % my $problemRow = begin +
      +
      +
      +
      + <%= $problemNumber %> + % if (!@editForUser) { + + + % } +
      + <%= $collapseButton =%> + <%= hidden_field "prob_num_$problemID" => $lastProblemNumber, + id => "prob_num_$problemID" =%> + <%= hidden_field "prob_parent_id_$problemID" => $parentID, + id => "prob_parent_id_$problemID" =%> + + % if ($showLinks) { + <%= link_to $cg->systemLink($urlpath->new( + type => 'instructor_problem_editor_withset_withproblem', + args => { + courseID => $courseID, + setID => $fullSetID, + problemID => $problemID + } + )), + class => 'psd_edit btn btn-secondary btn-sm', + target => 'WW_Editor', + data => { + bs_toggle => 'tooltip', + bs_placement => 'top', + bs_title => maketext('Edit Problem') + }, + begin =%> + + <% end =%> + % } + % if ($showLinks) { + <%= link_to $isGatewaySet + ? $cg->systemLink( + $urlpath->new( + type => 'gateway_quiz', + args => { + courseID => $courseID, + setID => 'Undefined_Set', + problemID => '1' + } + ), + params => { + effectiveUser => + @editForUser == 1 ? $editForUser[0] : param('user'), + problemSeed => $problemToShow ? $problemToShow->problem_seed : '', + sourceFilePath => $problemToShow + ? $problemToShow->source_file + : $globalProblems->{$problemID}->source_file + } + ) + : $cg->systemLink( + $urlpath->new( + type => 'problem_detail', + args => + { courseID => $courseID, setID => $setID, problemID => $problemID } + ), + params => { + effectiveUser => @editForUser == 1 ? $editForUser[0] : param('user') + } + ), + class => 'psd_view btn btn-secondary btn-sm', + target => 'WW_View', + data => { + bs_toggle => 'tooltip', + bs_placement => 'top', + bs_title => maketext('Open in New Window') + }, + begin =%> + + <% end =%> + % } + % if ($showLinks && $problemRecord->flags =~ /essay/) { + <%= link_to $cg->systemLink($urlpath->new( + type => 'instructor_problem_grader', + args => { courseID => $courseID, setID => $fullSetID, problemID => $problemID } + )), + class => "pdr_grader btn btn-secondary btn-sm", + data => { + bs_toggle => "tooltip", + bs_placement => "top", + bs_title => maketext("Grade Problem") + }, + begin =%> + "> + <% end =%> + % } +
      +
      + % if (@editForUser) { +
      + <%= $source_file_parts[0] =%> + <%= $source_file_parts[1] =%> +
      + % } else { +
      + <%= $source_file_parts[0] =%> +
      + % } +
      +
      + <%= $source_file_parts[ @editForUser ? 3 : 2 ] =%> + <%= hidden_field "problem_${problemID}_default_source_file" => + $globalProblems->{$problemID}->source_file, + id => "problem_${problemID}_default_source_file" =%> +
      + % if (!@editForUser) { +
      + +
      + % } +
      +
      +
      +
      + % if (!@editForUser) { +
      + +
      + % } + % if (@editForUser != 1) { +
      + +
      + % } +
      + % if (@editForUser) { +
      + <%= $source_file_parts[4] =%> +
      + % } +
      +
      +
      + <%= $cg->fieldTable( + $userToShow, $setID, $problemID, + $globalProblems->{$problemID}, $problemToShow, $setRecord->assignment_type + ) =%> +
      +
      + % if ($repeatFile) { +
      <%= $repeatFile %>
      + % } +
      \ + <% if ($error) { =%>\ +
      <%= $error %>
      + <% } =%>\ +
      +
      +
      +
      +
      + % end + % push @problemRows, $problemRow->(); + % } + % +
        + % if ($isJitarSet) { + % # If this is a jitar set then print nested lists. + % my $nestedIDHash = {}; + % + % for (my $i = 0; $i <= $#$problemIDList; $i++) { + % my @id_seq = jitar_id_to_seq($problemIDList->[$i]); + % my $hashref = $nestedIDHash; + % for my $num (@id_seq) { + % $hashref->{$num} = {} unless defined $hashref->{$num}; + % $hashref = $hashref->{$num}; + % } + % $hashref->{'row'} = $problemRows[$i]; + % $hashref->{'id'} = $problemIDList->[$i]; + % } + % + % # Use recursion to print the nested lists. + % for (sort { $a <=> $b } keys %$nestedIDHash) { + <%= $cg->print_nested_list($nestedIDHash->{$_}) =%> + % } + % } else { + % for (0 .. $#$problemIDList) { +
      1. + <%= $problemRows[$_] %> +
        2. + % } + % } +
      +
      + % +
      +
      + <%= check_box auto_render => 1, id => 'auto_render', class => 'form-check-input mt-0' =%> +
      + <%= label_for auto_render => maketext('Automatically render problems on page load'), + class => 'input-group-text' =%> +
      +
      +
      + <%= check_box force_renumber => '1', id => 'force_renumber', class => 'form-check-input mt-0' =%> +
      + <%= label_for force_renumber => maketext('Force problems to be numbered consecutively from one'), + class => 'input-group-text' =%> +
      + % } else { +

      <%= maketext("This set doesn't contain any problems yet.") %>

      + % } + % + % # Always allow one to add a new problem, unless a set version is being edited. + % if (!$editingSetVersion) { +
      +
      + <%= check_box add_blank_problem => '1', id => 'add_blank_problem', class => 'form-check-input mt-0' =%> +
      + <%= label_for add_blank_problem => maketext('Add'), class => 'input-group-text' =%> + <%= text_field add_n_problems => 1, id => 'add_n_problems', class => 'form-control flex-grow-0' =%> + <%= label_for add_n_problems => maketext('blank problem template(s) to end of homework set'), + class => 'input-group-text' =%> +
      + % } + % +
      + <%= submit_button maketext('Save Changes'), name => 'submit_changes', class => 'btn btn-primary' =%> + <%= submit_button maketext('Reset Form'), name => 'undo_changes', class => 'btn btn-primary' =%> + <%= maketext('(Any unsaved changes will be lost.)') =%> +
      +<% end =%> diff --git a/templates/ContentGenerator/Instructor/ProblemSetDetail/attempts_row.html.ep b/templates/ContentGenerator/Instructor/ProblemSetDetail/attempts_row.html.ep new file mode 100644 index 0000000000..a21a2f3a17 --- /dev/null +++ b/templates/ContentGenerator/Instructor/ProblemSetDetail/attempts_row.html.ep @@ -0,0 +1,12 @@ + + + <%= label_for "problem.$problemID.attempts.id" => maketext('Attempts') =%> + + + <%= text_field "problem.$problemID.attempts", + ($problemRecord->num_correct || 0) + ($problemRecord->num_incorrect || 0), + id => "problem.$problemID.attempts.id", class => 'form-control form-control-sm', + readonly => undef, size => 5 =%> + + + diff --git a/templates/ContentGenerator/Instructor/ProblemSetDetail/ip_locations_row.html.ep b/templates/ContentGenerator/Instructor/ProblemSetDetail/ip_locations_row.html.ep new file mode 100644 index 0000000000..09fe95291e --- /dev/null +++ b/templates/ContentGenerator/Instructor/ProblemSetDetail/ip_locations_row.html.ep @@ -0,0 +1,30 @@ + + % if ($forUsers) { + + <%= check_box "set.$setID.selected_ip_locations.override", + id => "set.$setID.selected_ip_locations.override_id", class => 'form-check-input', + $ipOverride ? (checked => undef) : () =%> + + % } + + <%= label_for $forUsers ? "set.$setID.selected_ip_locations.override_id" + : "set.$setID.selected_ip_locations_id" => maketext('Restrict Locations'), + $forUsers ? (id => "set.$setID.selected_ip_locations.label", class => 'form-check-label') + : (class => 'form-label') =%> + + + + <%= select_field "set.$setID.selected_ip_locations" => + [ map { [ $_ => $_, $defaultLocations->{$_} ? (selected => undef) : () ] } @$locations ], + id => "set.$setID.selected_ip_locations_id", size => 5, multiple => undef, + class => 'form-select form-select-sm', + $forUsers ? ('aria-labelledby' => "set.$setID.selected_ip_locations.label") : () =%> + + % if ($forUsers) { + + <%= text_area "set.$setID.selected_ip_locations.class_value" => join("\n", @$globalLocations), + readonly => undef, rows => 5, class => 'form-control form-control-sm', + 'aria-labelledby' => "set.$setID.selected_ip_locations.label" =%> + + % } + diff --git a/templates/ContentGenerator/Instructor/ProblemSetDetail/restricted_login_proctor_password_row.html.ep b/templates/ContentGenerator/Instructor/ProblemSetDetail/restricted_login_proctor_password_row.html.ep new file mode 100644 index 0000000000..57582d7835 --- /dev/null +++ b/templates/ContentGenerator/Instructor/ProblemSetDetail/restricted_login_proctor_password_row.html.ep @@ -0,0 +1,28 @@ +% # This assumes that the login proctor password is something that can only be changed for the global set. +% +% # If the set doesn't require a login proctor, then we can assume that one doesn't exist. +% # Otherwise, we need to check the database to find if there's an already defined password. +% # In that case set the form parameter so it is picked up by the tag helper below. +% if ($globalRecord->restricted_login_proctor eq 'Yes' && $db->existsPassword("set_id:$setID")) { + % param("set.$setID.restricted_login_proctor_password", '********'); +% } +% + + + <%= label_for "set.$setID.restricted_login_proctor_password" => + maketext('Password (Leave blank for regular proctoring)') =%> + + + + + + + + <%= text_field "set.$setID.restricted_login_proctor_password" => '', + id => "set.$setID.restricted_login_proctor_password", size => 10, + class => 'form-control form-control-sm' =%> + + diff --git a/templates/ContentGenerator/Instructor/ProblemSetList.html.ep b/templates/ContentGenerator/Instructor/ProblemSetList.html.ep new file mode 100644 index 0000000000..c22a94b3dd --- /dev/null +++ b/templates/ContentGenerator/Instructor/ProblemSetList.html.ep @@ -0,0 +1,137 @@ +% use WeBWorK::Utils qw(getAssetURL); +% +% content_for css => begin + <%= stylesheet getAssetURL($ce, 'node_modules/flatpickr/dist/flatpickr.min.css') =%> + <%= stylesheet getAssetURL($ce, 'node_modules/flatpickr/dist/plugins/confirmDate/confirmDate.css') =%> +% end +% +% content_for js => begin + <%= javascript getAssetURL($ce, 'node_modules/luxon/build/global/luxon.min.js'), defer => undef =%> + <%= javascript getAssetURL($ce, 'node_modules/flatpickr/dist/flatpickr.min.js'), defer => undef =%> + % if ($ce->{language} !~ /^en/) { + <%= javascript + getAssetURL($ce, 'node_modules/flatpickr/dist/l10n/' . ($ce->{language} =~ s/^(..).*/$1/gr) . '.js'), + defer => undef =%> + % } + <%= javascript getAssetURL($ce, 'node_modules/flatpickr/dist/plugins/confirmDate/confirmDate.js'), + defer => undef =%> + <%= javascript getAssetURL($ce, 'js/apps/DatePicker/datepicker.js'), defer => undef =%> + <%= javascript getAssetURL($ce, 'js/apps/ActionTabs/actiontabs.js'), defer => undef =%> + <%= javascript getAssetURL($ce, 'js/apps/ProblemSetList/problemsetlist.js'), defer => undef =%> + <%= javascript getAssetURL($ce, 'js/apps/ShowHide/show_hide.js'), defer => undef =%> + <%= javascript getAssetURL($ce, 'js/apps/SelectAll/selectall.js'), defer => undef =%> +% end +% +% unless ($authz->hasPermissions(param('user'), 'access_instructor_tools')) { +
      <%= maketext('You are not authorized to access instructor tools.') %>
      + % last; +% } +% +% if ($cg->{editMode} && !$authz->hasPermissions(param('user'), 'modify_problem_sets')) { +
      <%= maketext('You are not authorized to modify homework sets.') %>
      + % last; +% } +% +% if ($cg->{exportMode} && !$authz->hasPermissions(param('user'), 'modify_set_def_files')) { +
      + <%= maketext('You are not authorized to modify set definition files.') =%> +
      + % last; +% } +% + + +% +<%= form_for $cg->systemLink($urlpath, authen => 0), method => 'post', + id => 'problemsetlist', name => 'problemsetlist', class => 'font-sm', begin =%> + <%= $cg->hidden_authen_fields =%> + % + % # Show state data + % if (@{ $cg->{visibleSetIDs} }) { + % for (@{ $cg->{visibleSetIDs} }) { + <%= hidden_field visible_sets => $_ =%> + % } + % } else { + <%= hidden_field no_visible_sets => '1' =%> + % } + % if (@{ $cg->{prevVisibleSetIDs} }) { + % for (@{ $cg->{prevVisibleSetIDs} }) { + <%= hidden_field prev_visible_sets => $_ =%> + % } + % } else { + <%= hidden_field no_prev_visible_sets => '1' =%> + % } + <%= hidden_field editMode => $cg->{editMode} =%> + <%= hidden_field exportMode => $cg->{exportMode} =%> + <%= hidden_field primarySortField => $cg->{primarySortField} =%> + <%= hidden_field secondarySortField => $cg->{secondarySortField} =%> + % + % if ($cg->{editMode}) { +

      <%= maketext('Any changes made below will be reflected in the set for ALL students.') =%>

      + % } + % + % # Output action forms + % my $default_choice; + % + % for my $actionID (@$formsToShow) { + % # Check permissions + % next if $formPerms->{$actionID} && !$authz->hasPermissions(param('user'), $formPerms->{$actionID}); + % + % my $active = ''; + % unless ($default_choice) { $active = ' active'; $default_choice = $actionID; } + % + % content_for 'tab-list' => begin + + % end + % content_for 'tab-content' => begin +
      " id="<%= $actionID %>" + role="tabpanel" aria-labelledby="<%= $actionID %>-tab"> + <%= include "ContentGenerator/Instructor/ProblemSetList/${actionID}_form" =%> +
      + % end + % } + % + <%= hidden_field action => $default_choice, id => 'current_action' =%> +
      +
        <%= content 'tab-list' =%>
      +
      <%= content 'tab-content' %>
      +
      +
      + <%= submit_button maketext('Take Action!'), id => 'take_action', class => 'btn btn-primary mb-3' =%> +
      + % +

      + <%= maketext('Showing [_1] out of [_2] sets.', + scalar @{ $cg->{visibleSetIDs} }, + scalar @{ $cg->{allSetIDs} } + ) =%> +

      + % + <%= include 'ContentGenerator/Instructor/ProblemSetList/set_list_table' =%> +<% end =%> diff --git a/templates/ContentGenerator/Instructor/ProblemSetList/cancel_edit_form.html.ep b/templates/ContentGenerator/Instructor/ProblemSetList/cancel_edit_form.html.ep new file mode 100644 index 0000000000..3c1965a19c --- /dev/null +++ b/templates/ContentGenerator/Instructor/ProblemSetList/cancel_edit_form.html.ep @@ -0,0 +1 @@ +<%= maketext('Abandon changes') %> diff --git a/templates/ContentGenerator/Instructor/ProblemSetList/cancel_export_form.html.ep b/templates/ContentGenerator/Instructor/ProblemSetList/cancel_export_form.html.ep new file mode 100644 index 0000000000..1c548a24d3 --- /dev/null +++ b/templates/ContentGenerator/Instructor/ProblemSetList/cancel_export_form.html.ep @@ -0,0 +1 @@ +<%= maketext('Abandon export') %> diff --git a/templates/ContentGenerator/Instructor/ProblemSetList/create_form.html.ep b/templates/ContentGenerator/Instructor/ProblemSetList/create_form.html.ep new file mode 100644 index 0000000000..a48aa3609d --- /dev/null +++ b/templates/ContentGenerator/Instructor/ProblemSetList/create_form.html.ep @@ -0,0 +1,22 @@ +
      +
      + <%= label_for 'create_text', class => 'col-form-label col-form-label-sm col-auto', begin =%> + <%= maketext('Name the new set') =%>*: + <% end =%> +
      + <%= text_field 'action.create.name' => '', id => 'create_text', maxlength => '100', + 'aria-required' => 'true', class => 'form-control form-control-sm', dir => 'ltr' =%> +
      +
      +
      + <%= label_for create_select => maketext("Create as what type of set?"), + class => 'col-form-label col-form-label-sm col-auto' =%> +
      + <%= select_field 'action.create.type' => [ + [ maketext('a new empty set') => 'empty', selected => undef ], + [ maketext('a duplicate of the first selected set') => 'copy' ] + ], + id => 'create_select', class => 'form-select form-select-sm' =%> +
      +
      +
      diff --git a/templates/ContentGenerator/Instructor/ProblemSetList/delete_form.html.ep b/templates/ContentGenerator/Instructor/ProblemSetList/delete_form.html.ep new file mode 100644 index 0000000000..4963026c2b --- /dev/null +++ b/templates/ContentGenerator/Instructor/ProblemSetList/delete_form.html.ep @@ -0,0 +1,16 @@ +
      +
      + <%= maketext('Warning: Deletion destroys all set-related data and is not undoable!') =%> +
      +
      + <%= label_for delete_select => maketext('Delete which sets?'), + class => 'col-form-label col-form-label-sm col-auto' =%> +
      + <%= select_field 'action.delete.scope' => [ + [ maketext('no sets') => 'none', selected => undef ], + [ maketext('selected sets') => 'selected' ] + ], + id => 'delete_select', class => 'form-select form-select-sm' =%> +
      +
      +
      diff --git a/templates/ContentGenerator/Instructor/ProblemSetList/edit_form.html.ep b/templates/ContentGenerator/Instructor/ProblemSetList/edit_form.html.ep new file mode 100644 index 0000000000..56a2c066f1 --- /dev/null +++ b/templates/ContentGenerator/Instructor/ProblemSetList/edit_form.html.ep @@ -0,0 +1,11 @@ +
      + <%= label_for edit_select => maketext('Edit which sets?'), class => 'col-form-label col-form-label-sm col-auto' =%> +
      + <%= select_field 'action.edit.scope' => [ + [ maketext('all sets') => 'all' ], + [ maketext('listed sets') => 'visible' ], + [ maketext('selected sets') => 'selected', selected => undef ] + ], + id => 'edit_select', class => 'form-select form-select-sm' =%> +
      +
      diff --git a/templates/ContentGenerator/Instructor/ProblemSetList/export_form.html.ep b/templates/ContentGenerator/Instructor/ProblemSetList/export_form.html.ep new file mode 100644 index 0000000000..80571efd21 --- /dev/null +++ b/templates/ContentGenerator/Instructor/ProblemSetList/export_form.html.ep @@ -0,0 +1,13 @@ +
      + <%= label_for export_select => maketext('Prepare which sets for export?'), + class => 'col-form-label col-form-label-sm col-auto' =%> +
      + <%= select_field 'action.export.scope' => [ + [ maketext('all sets') => 'all' ], + [ maketext('listed sets') => 'visible', selected => undef ], + [ maketext('selected sets') => 'selected' ], + + ], + id => 'export_select', class => 'form-select form-select-sm' =%> +
      +
      diff --git a/templates/ContentGenerator/Instructor/ProblemSetList/filter_form.html.ep b/templates/ContentGenerator/Instructor/ProblemSetList/filter_form.html.ep new file mode 100644 index 0000000000..41770834c2 --- /dev/null +++ b/templates/ContentGenerator/Instructor/ProblemSetList/filter_form.html.ep @@ -0,0 +1,30 @@ +
      +
      + <%= label_for filter_select => maketext('Show which sets?'), + class => 'col-form-label col-form-label-sm col-sm-auto' =%> +
      + <%= select_field 'action.filter.scope' => [ + [ maketext('all sets') => 'all' ], + [ maketext('no sets') => 'none' ], + [ maketext('selected sets') => 'selected' ], + [ maketext('enter matching set IDs below') => 'match_ids', selected => undef ], + [ maketext('sets visible to students') => 'visible' ], + [ maketext('sets hidden from students') => 'unvisible' ] + ], + id => 'filter_select', class => 'form-select form-select-sm' =%> +
      +
      +
      + <%= label_for 'filter_text', class => 'col-form-label col-form-label-sm col-sm-auto', begin =%> + <%= maketext('Match on what? (separate multiple IDs with commas)') =%> + * + <% end =%> +
      + <%= text_field 'action.filter.set_ids' => '', id => 'filter_text', 'aria-required' => 'true', + class => 'form-control form-control-sm', dir => 'ltr' =%> +
      +
      +
      + <%= maketext('Please enter in a value to match in the filter field.') =%> +
      +
      diff --git a/templates/ContentGenerator/Instructor/ProblemSetList/import_form.html.ep b/templates/ContentGenerator/Instructor/ProblemSetList/import_form.html.ep new file mode 100644 index 0000000000..91ac47a178 --- /dev/null +++ b/templates/ContentGenerator/Instructor/ProblemSetList/import_form.html.ep @@ -0,0 +1,69 @@ +
      +
      + <%= label_for import_amt_select => maketext('Import how many sets?'), + class => 'col-form-label col-form-label-sm col-md-auto' =%> +
      + <%= select_field 'action.import.number' => [ + [ maketext('a single set') => 1, selected => undef ], + [maketext('multiple sets') => 8 ] + ], + id => 'import_amt_select', class => 'form-select form-select-sm' =%> +
      +
      +
      + <%= label_for import_source_select => maketext('Import from where?'), + class => 'col-form-label col-form-label-sm col-md-auto' =%> +
      + <%= select_field 'action.import.source' => [ + [ maketext('Enter filenames below') => '', selected => undef ], + $cg->getDefList + ], + id => 'import_source_select', class => 'form-select form-select-sm', dir => 'ltr', + size => param('action.import.number') || 1, + defined param('action.import.number') && param('action.import.number') ne '1' + ? (multiple => undef) + : () =%> +
      +
      +
      + <%= label_for import_text => maketext('Import sets with names') . ':', + class => 'col-form-label col-form-label-sm col-md-auto' =%> +
      + <%= text_field 'action.import.name' => '', id => 'import_text', class => 'form-control form-control-sm', + dir => 'ltr' =%> +
      +
      +
      + <%= label_for import_date_shift => maketext('Shift dates so that the earliest is') . ':', + class => 'col-form-label col-form-label-sm col-md-auto' =%> +
      +
      + <%= text_field 'action.import.start.date' => '', + id => 'import_date_shift', size => '27', class => 'form-control', + data => { + input => undef, + done_text => maketext('Done'), + locale => $ce->{language}, + timezone => $ce->{siteDefaults}{timezone} + } =%> + + + +
      +
      +
      + % if ($authz->hasPermissions(param('user'), 'assign_problem_sets')) { +
      + <%= label_for import_users_select => maketext('Assign this set to which users?'), + class => 'col-form-label col-form-label-sm col-md-auto' =%> +
      + <%= select_field 'action.import.assign' => [ + [ maketext('all current users') => 'all' ], + [ maketext('only') . ' ' . param('user') => 'user', selected => undef ] + ], + id => 'import_users_select', class => 'form-select form-select-sm' =%> +
      +
      + % } +
      diff --git a/templates/ContentGenerator/Instructor/ProblemSetList/publish_form.html.ep b/templates/ContentGenerator/Instructor/ProblemSetList/publish_form.html.ep new file mode 100644 index 0000000000..b2c02139b1 --- /dev/null +++ b/templates/ContentGenerator/Instructor/ProblemSetList/publish_form.html.ep @@ -0,0 +1,26 @@ +
      +
      + <%= label_for publish_filter_select => maketext('Choose which sets to be affected') . ':', + class => 'col-form-label col-form-label-sm col-sm-auto' =%> +
      + <%= select_field 'action.publish.scope' => [ + [ maketext('no sets') => 'none' ], + [ maketext('all sets') => 'all' ], + [ maketext('listed sets') => 'visible' ], + [ maketext('selected sets') => 'selected', selected => undef ] + ], + id => 'publish_filter_select', class => 'form-select form-select-sm' =%> +
      +
      +
      + <%= label_for publish_visibility_select => maketext('Choose visibility of the sets to be affected') . ':', + class => 'col-form-label col-form-label-sm col-sm-auto' =%> +
      + <%= select_field 'action.publish.value' => [ + [ maketext('Hidden') => 0 ], + [ maketext('Visible') => 1, selected => undef ] + ], + id => 'publish_visibility_select', class => 'form-select form-select-sm d-inline w-auto' =%> +
      +
      +
      diff --git a/templates/ContentGenerator/Instructor/ProblemSetList/save_edit_form.html.ep b/templates/ContentGenerator/Instructor/ProblemSetList/save_edit_form.html.ep new file mode 100644 index 0000000000..6a8054a030 --- /dev/null +++ b/templates/ContentGenerator/Instructor/ProblemSetList/save_edit_form.html.ep @@ -0,0 +1 @@ +<%= maketext('Save changes') %> diff --git a/templates/ContentGenerator/Instructor/ProblemSetList/save_export_form.html.ep b/templates/ContentGenerator/Instructor/ProblemSetList/save_export_form.html.ep new file mode 100644 index 0000000000..6338c0daed --- /dev/null +++ b/templates/ContentGenerator/Instructor/ProblemSetList/save_export_form.html.ep @@ -0,0 +1 @@ +<%= maketext('Confirm which sets to export.') %> diff --git a/templates/ContentGenerator/Instructor/ProblemSetList/score_form.html.ep b/templates/ContentGenerator/Instructor/ProblemSetList/score_form.html.ep new file mode 100644 index 0000000000..e2161b502b --- /dev/null +++ b/templates/ContentGenerator/Instructor/ProblemSetList/score_form.html.ep @@ -0,0 +1,12 @@ +
      + <%= label_for score_select => maketext('Score which sets?'), + class => 'col-form-label col-form-label-sm col-auto' =%> +
      + <%= select_field 'action.score.scope' => [ + [ maketext('no sets') => 'none', selected => undef ], + [ maketext('all sets') => 'all' ], + [ maketext('selected sets') => 'selected' ] + ], + id => 'score_select', class => 'form-select form-select-sm' =%> +
      +
      diff --git a/templates/ContentGenerator/Instructor/ProblemSetList/set_list_field.html.ep b/templates/ContentGenerator/Instructor/ProblemSetList/set_list_field.html.ep new file mode 100644 index 0000000000..54323ffe6f --- /dev/null +++ b/templates/ContentGenerator/Instructor/ProblemSetList/set_list_field.html.ep @@ -0,0 +1,51 @@ +% if ($type eq 'date') { + % if ($cg->{editMode}) { +
      + <%= text_field $name => $value, + id => "${name}_id", + class => 'form-control w-auto ' . ($name =~ /\.open_date/ ? ' datepicker-group' : ''), + size => 22, + placeholder => maketext('None Specified'), + role => 'button', + tabindex => 0, + data => { + input => undef, + done_text => maketext('Done'), + locale => $ce->{language}, + timezone => $ce->{siteDefaults}{timezone} + }, + 'aria-labelledby' => ($name =~ s/^.*\.([^.]*)$/$1/r) . '_header' =%> + + + +
      + % } else { + + <%= $cg->formatDateTime($value, '', 'datetime_format_short', $ce->{language}) =%> + + % } +% } elsif ($type eq 'check') { + % if ($cg->{editMode}) { + % # If the checkbox is checked it returns a 1, if it is unchecked it returns nothing + % # in which case the hidden field overrides the parameter with a 0. + <%= check_box $name => 1, id => "${name}_id", class => 'form-check-input', + 'aria-labelledby' => ($name =~ s/^.*\.([^.]*)$/$1/r) . '_header', + $value ? (checked => undef) : () =%> + <%= hidden_field $name => 0 =%> + % } else { + <%= $value ? maketext('Yes') : maketext('No') =%> + % } +% } else { + % # This case is not actually needed as only the "date" and "check" types occur. + % # This is a fallback in case someone tries add a type without learning this system. + % if ($cg->{editMode}) { +
      + <%= text_field $name => $value, id => "${name}_id", class => 'form-control w-auto', + 'aria-labelledby' => ($name =~ s/^.*\.([^.]*)$/$1/r) . '_header', + size => 10 =%> +
      + % } else { + <%= $value =%> + % } +% } diff --git a/templates/ContentGenerator/Instructor/ProblemSetList/set_list_row.html.ep b/templates/ContentGenerator/Instructor/ProblemSetList/set_list_row.html.ep new file mode 100644 index 0000000000..abe41f8b78 --- /dev/null +++ b/templates/ContentGenerator/Instructor/ProblemSetList/set_list_row.html.ep @@ -0,0 +1,60 @@ +% use WeBWorK::Utils qw(format_set_name_display); +% +% my $courseName = $urlpath->arg('courseID'); +% +% my $visibleClass = $set->visible ? 'font-visible' : 'font-hidden'; +% my $set_id = $set->set_id; +% my $prettySetID = format_set_name_display($set_id); +% my $problemListURL = $cg->systemLink( + % $urlpath->new(type => 'instructor_set_detail', args => { courseID => $courseName, setID => $set_id })); +% + +% +% if ($cg->{editMode}) { + <%= link_to $prettySetID => $problemListURL %> +% } else { + + % param(selected_sets => [ param('selected_sets'), $set_id ]) if $setSelected; + <%= check_box selected_sets => $set_id, id => "${set_id}_id", class => 'form-check-input' =%> + + +
      + <%= label_for "${set_id}_id", begin =%> + + <%= $prettySetID =%> + + % if ($authz->hasPermissions(param('user'), 'modify_problem_sets')) { + <%= link_to $cg->systemLink($urlpath->new( + type => 'instructor_set_list', + args => { courseID => $courseName, setID => $set_id } + ), + params => { editMode => 1, visible_sets => $set_id } + ), + begin =%> + + <% end =%> + % } + <% end =%> +
      + + %# Problems link + <%= link_to $db->countGlobalProblems($set_id) => $problemListURL %> + % # Users link + + <%= link_to $db->countSetUsers($set_id) . "/$cg->{totalUsers}" => $cg->systemLink($urlpath->new( + type => 'instructor_users_assigned_to_set', + args => { courseID => $courseName, setID => $set_id } + )) =%> + +% } +% +% for my $field (@$fieldNames) { + % next unless defined $fieldTypes->{$field}; + + + <%= include 'ContentGenerator/Instructor/ProblemSetList/set_list_field', + name => "set.$set_id.$field", value => $set->$field, type => $fieldTypes->{$field} =%> + + +% } diff --git a/templates/ContentGenerator/Instructor/ProblemSetList/set_list_table.html.ep b/templates/ContentGenerator/Instructor/ProblemSetList/set_list_table.html.ep new file mode 100644 index 0000000000..d0535d2061 --- /dev/null +++ b/templates/ContentGenerator/Instructor/ProblemSetList/set_list_table.html.ep @@ -0,0 +1,47 @@ +% my %fieldHeaders = ( + % set_id => $cg->{editMode} + % ? maketext('Edit Set') + % : label_for('select-all' => maketext('Edit Set Data')), + % problems => maketext('Edit Problems'), + % users => maketext('Edit Assigned Users'), + % visible => maketext('Visible'), + % enable_reduced_scoring => $cg->{editMode} ? maketext('Enable Reduced Scoring') : maketext('Reduced Scoring'), + % open_date => maketext('Open Date'), + % reduced_scoring_date => maketext('Reduced Scoring Date'), + % due_date => maketext('Close Date'), + % answer_date => maketext('Answer Date') +% ); +% +
      + + % + + % + + + % if (!$cg->{editMode}) { + + % } + % for (@$fieldNames) { + + % } + + + % + + % my %selectedSetIDs = (map { $_ => 1 } @{ $cg->{selectedSetIDs} }); + % for (@$sets) { + <%= include 'ContentGenerator/Instructor/ProblemSetList/set_list_row', + set => $_, setSelected => $selectedSetIDs{ $_->set_id } =%> + % } + +
      <%= maketext('Set List') %>
      + <%= check_box 'select-all' => '', id => 'select-all', class => 'select-all form-check-input', + 'aria-label' => maketext('Select all sets'), data => { select_group => 'selected_sets' } =%> + <%= $fieldHeaders{$_} =%>
      +
      +% # If there are no sets shown, print message. +% unless (@$sets) { +

      <%= maketext('No sets shown. Choose one of the options above to list the sets in the course.') %>

      +% } diff --git a/templates/ContentGenerator/Instructor/ProblemSetList/sort_form.html.ep b/templates/ContentGenerator/Instructor/ProblemSetList/sort_form.html.ep new file mode 100644 index 0000000000..2a96703db9 --- /dev/null +++ b/templates/ContentGenerator/Instructor/ProblemSetList/sort_form.html.ep @@ -0,0 +1,30 @@ +
      +
      + <%= label_for sort_select_1 => maketext('Sort by') . ':', class => 'col-form-label col-form-label-sm', + style => 'width:4.5rem' =%> +
      + <%= select_field 'action.sort.primary' => [ + [ maketext('Set Name') => 'set_id' ], + [ maketext('Open Date') => 'open_date' ], + [ maketext('Close Date') => 'due_date', selected => undef ], + [ maketext('Answer Date') => 'answer_date' ], + [ maketext('Visibility') => 'visible' ] + ], + id => 'sort_select_1', class => 'form-select form-select-sm' =%> +
      +
      +
      + <%= label_for sort_select_2 => maketext('Then by') . ':', class => 'col-form-label col-form-label-sm', + style => 'width:4.5rem' =%> +
      + <%= select_field 'action.sort.secondary' => [ + [ maketext('Set Name') => 'set_id' ], + [ maketext('Open Date') => 'open_date', selected => undef], + [ maketext('Close Date') => 'due_date' ], + [ maketext('Answer Date') => 'answer_date' ], + [ maketext('Visibility') => 'visible' ] + ], + id => 'sort_select_2', class => 'form-select form-select-sm' =%> +
      +
      +
      diff --git a/templates/ContentGenerator/Instructor/Scoring.html.ep b/templates/ContentGenerator/Instructor/Scoring.html.ep new file mode 100644 index 0000000000..a727012efa --- /dev/null +++ b/templates/ContentGenerator/Instructor/Scoring.html.ep @@ -0,0 +1,99 @@ +% use WeBWorK::Utils qw(readFile format_set_name_display); +% +% unless ($authz->hasPermissions(param('user'), 'access_instructor_tools')) { +
      + <%= maketext('You are not authorized to access instructor tools.') =%> +
      + % last; +% } +% +% unless ($authz->hasPermissions(param('user'), 'score_sets')) { +
      <%= maketext('You are not authorized to score sets.') %>
      + % last; +% } +% +% my $urlpath = $urlpath; +% my $courseName = $urlpath->arg('courseID'); +% my $scoringDir = $ce->{courseDirs}{scoring}; +% my $scoringDownloadPage = + % $urlpath->newFromModule('WeBWorK::ContentGenerator::Instructor::ScoringDownload', $c, courseID => $courseName); +% +
      + <%= form_for $cg->systemLink($urlpath->newFromModule($urlpath->module, $c, courseID => $courseName), authen => 0), + name => 'scoring-form', id => 'scoring-form', method => 'POST', begin =%> + <%= $cg->hidden_authen_fields =%> + <%= hidden_field returning => 1 =%> +
      +
      + <%= label_for selectedSet => maketext('Selected sets:'), class => 'form-label' =%> + <%= select_field selectedSet => + [ map { [ format_set_name_display($_) => $_ ] } @{ $cg->{ra_set_ids} } ], + id => 'selectedSet', class => 'form-select', size => 10, multiple => undef, dir => 'ltr' =%> +
      +
      +
      + +
      +
      + +
      +
      + +
      +
      + +
      +
      +
      +
      + <%= submit_button maketext('Score selected set(s) and save to:'), name => 'score-sets', + id => 'score-sets', class => 'btn btn-primary btn-sm me-2 mb-sm-0 mb-2' =%> + <%= text_field scoringFileName => $cg->{scoringFileName}, class => 'form-control form-control-sm', + size => '40', 'aria-labelledby' => 'score-sets' =%> +
      + <% end =%> +
      +% +% my @selected = param('selectedSet'); +% if (@selected) { +

      <%= maketext('All of these files will also be made available for mail merge.') %>

      +% } +% +% for my $setID (@selected) { + % my @validFiles; + % for my $type ('scr', 'ful') { + % my $filename = "s$setID$type.csv"; + % my $path = "$scoringDir/$filename"; + % push @validFiles, $filename if -f $path; + % } + % if (@validFiles) { +

      <%= $setID %>

      + % for my $filename (@validFiles) { +
      + <%= link_to $filename => $cg->systemLink($scoringDownloadPage, params => { getFile => $filename }) =%> +
      + % } +
      + % } +% } +% if (-f "$scoringDir/$cg->{scoringFileName}") { +

      <%= maketext('Totals') %>

      + <%= link_to $cg->{scoringFileName} => + $cg->systemLink($scoringDownloadPage, params => { getFile => $cg->{scoringFileName} }) =%> +
      + 
      <%== WeBWorK::Utils::readFile("$scoringDir/$cg->{scoringFileName}") =%>
      +% } diff --git a/templates/ContentGenerator/Instructor/SendMail.html.ep b/templates/ContentGenerator/Instructor/SendMail.html.ep new file mode 100644 index 0000000000..ea80405b0d --- /dev/null +++ b/templates/ContentGenerator/Instructor/SendMail.html.ep @@ -0,0 +1,31 @@ +% unless ($authz->hasPermissions(param('user'), 'access_instructor_tools')) { +
      <%= maketext('You are not authorized to access instructor tools') %>
      + % last; +% } +% +% unless ($authz->hasPermissions(param('user'), 'send_mail')) { +
      <%= maketext('You are not authorized to send mail to students') %>
      + % last; +% } +% +% my $response = $cg->{response} // ''; +% +% if ($response eq 'preview') { + <%= $cg->print_preview($urlpath->arg('setID')) =%> +% } else { + % if ($response eq 'send_email' && $cg->{ra_send_to} && @{ $cg->{ra_send_to} }) { + % my $message = begin + + <%= maketext( + 'Email is being sent to [quant,_1,recipient]. You will be notified by email ' + . 'when the task is completed. This may take several minutes if the class is large.', + scalar(@{ $cg->{ra_send_to} }) + ) =%> + + % end + % $cg->addgoodmessage($message->()); + % $cg->{message} = $message->(); + % } + % + <%= include('ContentGenerator/Instructor/SendMail/main_form') =%> +% } diff --git a/templates/ContentGenerator/Instructor/SendMail/main_form.html.ep b/templates/ContentGenerator/Instructor/SendMail/main_form.html.ep new file mode 100644 index 0000000000..ef90510369 --- /dev/null +++ b/templates/ContentGenerator/Instructor/SendMail/main_form.html.ep @@ -0,0 +1,204 @@ +% use WeBWorK::HTML::ScrollingRecordList qw/scrollingRecordList/; +% +% my $merge_file = $cg->{merge_file} // 'None'; +% +<%= form_for $cg->systemLink( + $urlpath->newFromModule($urlpath->module, $c, courseID => $urlpath->arg('courseID')), + authen => 0 + ), + method => 'post', begin =%> + <%= $cg->hidden_authen_fields =%> + % + % # Email settings +
      +
      +
      +
      +
      + <%= label_for 'openfilename', class => 'input-group-text', begin =%> + <%= maketext('Message file:') %> + <% end =%> + <%= $cg->{input_file} %> +
      +
      + <%= submit_button maketext('Open'), name => 'openMessage', class => 'btn btn-secondary' =%> + <%= select_field openfilename => [ + map { [ $_ => $_, $_ eq $cg->{input_file} ? (selected => undef) : () ] } + $cg->get_message_file_names + ], + id => 'openfilename', class => 'form-select form-select-sm' =%> +
      +
      + <%= maketext('Save file to:') %> + <%= $cg->{output_file} %> +
      +
      + <%= label_for 'merge_file', class => 'input-group-text', begin =%> + <%= maketext('Merge file:') %> + <% end =%> + <%= $merge_file %> +
      + <%= select_field merge_file => [ + map { [ $_ => $_, $_ eq $merge_file ? (selected => undef) : () ] } $cg->get_merge_file_names + ], + id => 'merge_file', class => 'form-select form-select-sm mb-2' =%> +
      + <%= label_for from => maketext('From:'), + class => 'col-sm-3 col-form-label col-form-label-sm' =%> +
      + <%= text_field from => $cg->{from}, id => 'from', + class => 'form-control form-control-sm' =%> +
      +
      +
      + <%= label_for replyTo => maketext('Reply-To:'), + class => 'col-sm-3 col-form-label col-form-label-sm' =%> +
      + <%= text_field replyTo => $cg->{replyTo}, id => 'replyTo', + class => 'form-control form-control-sm' =%> +
      +
      +
      + <%= label_for subject => maketext('Subject:'), + class => 'col-sm-3 col-form-label col-form-label-sm' =%> +
      + <%= text_field subject => $cg->{subject}, id => 'subject', + class => 'form-control form-control-sm' =%> +
      +
      +
      + <%= label_for rows => maketext('Editor rows:'), + class => 'col-3 col-form-label col-form-label-sm' =%> +
      + <%= text_field rows => $cg->{rows}, id => 'rows', size => 3, + class => 'form-control form-control-sm d-inline w-auto' =%> +
      +
      + <%= submit_button maketext('Update settings and refresh page'), + name => 'updateSettings', class => 'btn btn-secondary btn-sm' =%> +
      +
      +
      + <%= radio_button send_to => 'all_students', id => 'send_to_all', class => 'form-check-input' =%> + <%= label_for send_to_all => maketext('Send to all students'), class => 'form-check-label' =%> +
      +
      + <%= radio_button send_to => 'studentID', id => 'send_to_selected', class => 'form-check-input', + checked => undef =%> + <%= label_for send_to_selected => maketext('Send to the students selected below'), + class => 'form-check-label' =%> +
      +
      + <%= scrollingRecordList( + { + name => 'classList', + request => $c, + default_sort => 'lnfn', + default_format => 'lnfn_uid', + default_filters => ['all'], + refresh_button_name => maketext('Update settings and refresh page'), + attrs => { size => 5, multiple => undef } + }, + @{ $cg->{ra_user_records} } + ) =%> +
      + % my $preview_record = $db->getUser($cg->{preview_user}); + % if ($preview_record) { +
      + <%= submit_button maketext('Preview Message'), + name => 'previewMessage', class => 'btn btn-secondary btn-sm' =%> + + <%= maketext('for') %> +  <%= $preview_record->last_name %>, <%= $preview_record->first_name %> + (<%= $preview_record->user_id %>) + +
      + % } +
      +
      + % # Insert a toast containing a list of available macros. +
      + +
      +
      + +
      +
      +
      + % + % # Merge file fragment and message text area field + % my $rh_merge_data = $cg->read_scoring_file($merge_file, '.'); + % my @merge_data = eval { @{ $rh_merge_data->{ $db->getUser($cg->{preview_user})->student_id } } }; + % if ($@ && $merge_file ne 'None') { +
      <%= "No merge data for $cg->{preview_user} in merge file: $merge_file" =%>
      + % } elsif (@merge_data) { + 
      <%== join('', ' ', $cg->data_format(1 .. ($#merge_data + 1))) =%>\
+			
      <% =%>\
+			<%== join('', ' ', $cg->data_format2(@merge_data)) =%>\
+
      + % } + % + % # Create a textbox with the subject and a textarea with the message. + % # Print the actual body of message. + % if (defined $cg->{message}) { +
      <%= $cg->{message} %>
      + % } +
      + <%= label_for 'email-body', class => 'form-label', begin =%> + <%= maketext("Email Body:") %>* + <% end =%> + <%= text_area body => + defined $cg->{r_text} ? ${ $cg->{r_text} } : 'FIXME no text was produced by initialization!', + id => 'email-body', rows => $cg->{rows}, class => 'form-control' %> +
      + % + % # Action buttons +
      +
      +
      + <%= submit_button maketext('Send Email'), name => 'sendEmail', + class => 'btn btn-secondary btn-sm d-inline w-auto' =%> +
      +
      + <%= submit_button maketext('Save'), name => 'saveMessage', class => 'btn btn-secondary btn-sm' =%> + <%= maketext('to') . ' ' . $cg->{output_file} %> +
      +
      + <%= submit_button maketext('Save as') . ':', name => 'saveAs', id => 'saveAs', + class => 'btn btn-secondary btn-sm' =%> + <%= text_field savefilename => $cg->{output_file}, size => 20, + class => 'form-control form-control-sm', 'aria-labelledby' => 'saveAs' =%> +
      +
      + <%= submit_button maketext('Save as Default'), name => 'saveDefault', + class => 'btn btn-secondary btn-sm' =%> +
      +
      +
      +<% end =%> diff --git a/templates/ContentGenerator/Instructor/SendMail/preview.html.ep b/templates/ContentGenerator/Instructor/SendMail/preview.html.ep new file mode 100644 index 0000000000..d571efb7b5 --- /dev/null +++ b/templates/ContentGenerator/Instructor/SendMail/preview.html.ep @@ -0,0 +1,10 @@ +
      <%= $preview_header %>
      +

      <%= maketext('This sample mail would be sent to [_1]', $ur->email_address) %>

      +
      <%= $msg %>
      +% if ($recipients) { +

      <%= maketext('Emails to be sent to the following:') %>

      +
      <%= $recipients || maketext('No recipients selected.') %>
      +% } else { +

      <%= maketext('No recipients selected.') %>

      +% } +

      <%= maketext('Use browser back button to return from preview mode.') %>

      diff --git a/templates/ContentGenerator/Instructor/SetMaker.html.ep b/templates/ContentGenerator/Instructor/SetMaker.html.ep new file mode 100644 index 0000000000..92c8b7d0ae --- /dev/null +++ b/templates/ContentGenerator/Instructor/SetMaker.html.ep @@ -0,0 +1,89 @@ +% use WeBWorK::Utils qw(getAssetURL); +% +% content_for js => begin + <%= javascript getAssetURL($ce, 'node_modules/iframe-resizer/js/iframeResizer.min.js') =%> + <%= javascript getAssetURL($ce, 'js/apps/SetMaker/setmaker.js'), defer => undef =%> + % + % if ($authz->hasPermissions(scalar(param('user')), 'modify_tags')) { + <%= javascript "$ce->{webworkURLs}{htdocs}/js/apps/TagWidget/tagwidget.js", id => 'tag-widget-script', + defer => undef, data => { taxo => "$ce->{webworkURLs}{htdocs}/DATA/tagging-taxonomy.json" } =%> + % } +% end +% +% unless ($authz->hasPermissions(param('user'), 'modify_problem_sets')) { +
      <%= maketext('You are not authorized to access instructor tools.') %>
      + % last; +% } +% +<%= form_for $c->uri, method => 'POST', name => 'library_browser_form', begin =%> + <%= $cg->hidden_authen_fields =%> + <%= hidden_field courseID => $urlpath->arg('courseID'), id => 'hidden_courseID' =%> + <%= hidden_field hidden_language => $ce->{language} =%> + <%= hidden_field browse_which => $cg->{browse_which} =%> + <%= hidden_field problem_seed => $cg->{problem_seed} =%> + % for (my $i = 0; $i < @$pg_files; ++$i) { + <%= hidden_field "all_past_list$i" => $pg_files->[$i]{filepath} =%> + <%= hidden_field "all_past_mlt$i", => $pg_files->[$i]{morelt} || 0 =%> + % } + <%= hidden_field first_shown => $cg->{first_shown} =%> + <%= hidden_field last_shown => $cg->{last_shown} =%> + <%= hidden_field first_index => $cg->{first_index} =%> + <%= hidden_field last_index => $cg->{last_index} =%> + <%= hidden_field total_probs => $cg->{total_probs} =%> + % +
      + <%= include('ContentGenerator/Instructor/SetMaker/top_row', + local_sets => $cg->{all_db_sets}, browse_which => $cg->{browse_which}) =%> +
      + % + % # Show problems + % for (my $i = 0; $i < @$plist; ++$i) { + % $pg_files->[ $i + $cg->{first_index} ]{filepath} =~ s|^$ce->{courseDirs}{templates}/?||; + % my $sourceFileData = $pg_files->[ $i + $cg->{first_index} ]; + % if ($sourceFileData->{children}) { + % # If this problem has children, then show the problem and all children. +
      + <%= include 'ContentGenerator/Instructor/SetMaker/problem_row', + sourceFileData => $sourceFileData, pg_file => $plist->[$i], cnt => $i + 1 =%> + % for (@{ $sourceFileData->{children} }) { + % ++$i; + % last if $i == @$plist; # Protection in case of malformed data. + % $pg_files->[ $i + $cg->{first_index} ]{filepath} =~ s|^$ce->{courseDirs}{templates}/?||; + <%= include 'ContentGenerator/Instructor/SetMaker/problem_row', + sourceFileData => $pg_files->[ $i + $cg->{first_index} ], + pg_file => $plist->[$i], cnt => $i + 1 =%> + % } +
      + % } else { + <%= include 'ContentGenerator/Instructor/SetMaker/problem_row', + sourceFileData => $sourceFileData, pg_file => $plist->[$i], cnt => $i + 1 =%> + % } + % } + % + % if (@$pg_files) { +
      + + <%= $cg->{first_shown} + 1 %>-<%= + $cg->{last_shown} + 1 %> + + <%= maketext('of') %> + <%= $cg->{total_probs} %> + <%= maketext('shown') %> + % if ($cg->{first_index} > 0) { + <%= submit_button maketext('Previous page'), name => 'prev_page', + class => 'btn btn-secondary btn-sm' =%> + % } + % if (1 + $cg->{last_index} < @$pg_files) { + <%= submit_button maketext('Next page'), name => 'next_page', class => 'btn btn-secondary btn-sm' =%> + % } +
      +

      + <%= maketext( + 'Some problems shown above represent multiple similar problems from the database. If the (top) ' + . 'information line for a problem has a letter M for "More", hover your mouse over the M to ' + . 'see how many similar problems are hidden, or click on the M to see the problems. If you click ' + . 'to view these problems, the M becomes an L, which can be clicked on to hide the problems again.' + ) =%> +

      + % } +<% end =%> diff --git a/templates/ContentGenerator/Instructor/SetMaker/browse_course_sets_panel.html.ep b/templates/ContentGenerator/Instructor/SetMaker/browse_course_sets_panel.html.ep new file mode 100644 index 0000000000..71a89cf3bf --- /dev/null +++ b/templates/ContentGenerator/Instructor/SetMaker/browse_course_sets_panel.html.ep @@ -0,0 +1,19 @@ +% use WeBWorK::Utils qw(format_set_name_display); +% +% $selected_library //= ''; +% +
      +
      + <%= label_for library_sets => maketext('Browse from:'), class => 'col-form-label-sm' =%> + <%= select_field library_sets => [ + @$local_sets == 0 ? [ maketext('No sets in this course yet') => '' ] + : ( + $selected_library eq '' ? [ maketext('Select a Homework Set') => '', selected => undef ] : (), + map { [ format_set_name_display($_) => $_, $_ eq $selected_library ? (selected => undef) : () ] } + @$local_sets + ) + ], + id => 'library_sets', class => 'form-select form-select-sm d-inline w-auto', dir => 'ltr' =%> +
      + <%= include 'ContentGenerator/Instructor/SetMaker/view_problems_line', internal_name => 'view_course_set' =%> +
      diff --git a/templates/ContentGenerator/Instructor/SetMaker/browse_library_panel.html.ep b/templates/ContentGenerator/Instructor/SetMaker/browse_library_panel.html.ep new file mode 100644 index 0000000000..4acb37c754 --- /dev/null +++ b/templates/ContentGenerator/Instructor/SetMaker/browse_library_panel.html.ep @@ -0,0 +1,32 @@ +% # See if the problem library is installed. +% my $libraryRoot = $ce->{problemLibrary}{root}; +% unless ($libraryRoot) { +
      The problem library has not been installed.
      + % last; +% } +% # Test if the Library directory link exists. If not, try to make it. +% unless (-d "$ce->{courseDirs}{templates}/Library" + % || symlink($libraryRoot, "$ce->{courseDirs}{templates}/Library")) +% { + % my $msg = begin + You are missing the directory templates/Library, which is needed for the Problem Library to function. + It should be a link pointing to <%= $libraryRoot %>, which you set in conf/site.conf. An + attempt was made to create the link, but that failed. Check the permissions in your templates + directory. + % end + % $cg->addbadmessage($msg->()); +% } +% +% # Now check which version to use. +% my $libraryVersion = $ce->{problemLibrary}{version} || 2; +% if ($libraryVersion == 1) { +
      Problem library version 1 is no longer supported.
      +% } elsif ($libraryVersion >= 2) { + % if ($cg->{library_basic} == 1) { + <%= include 'ContentGenerator/Instructor/SetMaker/browse_library_panel_simple' =%> + % } else { + <%= include 'ContentGenerator/Instructor/SetMaker/browse_library_panel_advanced' =%> + % } +% } else { +
      The problem library version is set to an illegal value.
      +% } diff --git a/templates/ContentGenerator/Instructor/SetMaker/browse_library_panel_advanced.html.ep b/templates/ContentGenerator/Instructor/SetMaker/browse_library_panel_advanced.html.ep new file mode 100644 index 0000000000..d417e416ca --- /dev/null +++ b/templates/ContentGenerator/Instructor/SetMaker/browse_library_panel_advanced.html.ep @@ -0,0 +1,119 @@ +% use WeBWorK::Utils::ListingDB qw(getAllDBsubjects getAllDBchapters getAllDBsections getDBTextbooks countDBListings); +% +
      + <%= hidden_field library_is_basic => 2 =%> +
      + +
      +
      +
      +
      + <%= label_for library_subjects => maketext('Subject:'), + class => 'col-3 col-form-label col-form-label-sm' =%> +
      + <%= select_field library_subjects => [ + [ maketext('All Subjects') => '', selected => undef ], + getAllDBsubjects($c) + ], + id => 'library_subjects', class => 'form-select form-select-sm' =%> +
      +
      +
      + <%= label_for library_chapters => maketext('Chapter:'), + class => 'col-3 col-form-label col-form-label-sm' =%> +
      + <%= select_field library_chapters => [ + [ maketext('All Chapters') => '', selected => undef ], + getAllDBchapters($c) + ], + id => 'library_chapters', class => 'form-select form-select-sm' =%> +
      +
      +
      + <%= label_for library_sections => maketext('Section:'), + class => 'col-3 col-form-label col-form-label-sm' =%> +
      + <%= select_field library_sections => [ + [ maketext('All Sections') => '', selected => undef ], + getAllDBsections($c) + ], + id => 'library_sections', class => 'form-select form-select-sm' =%> +
      +
      +
      + <%= label_for library_textbook => maketext('Textbook:'), + class => 'col-3 col-form-label col-form-label-sm' =%> +
      + <%= select_field library_textbook => [ + [ maketext('All Textbooks') => '', selected => undef ], + map { [ "$_->[1] by $_->[2] (edition $_->[3])" => $_->[0] ] } @{ getDBTextbooks($c) } + ], + id => 'library_textbook', class => 'form-select form-select-sm' =%> +
      +
      +
      + <%= label_for library_textchapter => maketext('Text chapter:'), + class => 'col-3 col-form-label col-form-label-sm text-nowrap' =%> +
      + <%= select_field library_textchapter => [ + [ maketext('All Chapters') => '', selected => undef ], + map { $_->[0] } @{ getDBTextbooks($c, 'textchapter') } + ], + id => 'library_textchapter', class => 'form-select form-select-sm' =%> +
      +
      +
      + <%= label_for library_textsection => maketext('Text section:'), + class => 'col-3 col-form-label col-form-label-sm text-nowrap' =%> +
      + <%= select_field library_textsection => [ + [ maketext('All Sections') => '', selected => undef ], + map { $_->[0] } @{ getDBTextbooks($c, 'textsection') } + ], + id => 'library_textsection', class => 'form-select form-select-sm' =%> +
      +
      +
      + +
      +
      + % for (1 .. 6) { +
      + +
      + % } + <%= $cg->helpMacro('Levels') =%> +
      +
      +
      +
      + <%= label_for library_keywords => maketext('Keywords:'), + class => 'col-3 col-form-label col-form-label-sm' =%> +
      + <%= text_field library_keywords => '', + id => 'library_keywords', class => 'form-control form-control-sm' =%> +
      +
      +
      +
      + <%= submit_button maketext('Update Menus'), name => 'lib_select_subject', + class => 'btn btn-secondary btn-sm mb-1 library-panel-btn' =%> + <%= submit_button maketext('Reset'), name => 'library_reset', + class => 'btn btn-secondary btn-sm mb-1 ms-sm-0 ms-2 library-panel-btn' =%> + <%= submit_button maketext('Basic Search'), name => 'library_basic', + class => 'btn btn-secondary btn-sm mb-1 ms-sm-0 ms-2 library-panel-btn' =%> +
      +
      + <%= include 'ContentGenerator/Instructor/SetMaker/view_problems_line', internal_name => 'lib_view' =%> +
      + +
      +
      diff --git a/templates/ContentGenerator/Instructor/SetMaker/browse_library_panel_simple.html.ep b/templates/ContentGenerator/Instructor/SetMaker/browse_library_panel_simple.html.ep new file mode 100644 index 0000000000..7da61a3303 --- /dev/null +++ b/templates/ContentGenerator/Instructor/SetMaker/browse_library_panel_simple.html.ep @@ -0,0 +1,55 @@ +% use WeBWorK::Utils::ListingDB qw(getAllDBsubjects getAllDBchapters getAllDBsections countDBListings); +% +
      + <%= hidden_field library_is_basic => 1 =%> +
      +
      +
      + <%= label_for library_subjects => maketext('Subject:'), + class => 'col-2 col-form-label col-form-label-sm' =%> +
      + <%= select_field library_subjects => [ + [ maketext('All Subjects') => '', selected => undef ], + getAllDBsubjects($c) + ], + id => 'library_subjects', class => 'form-select form-select-sm' =%> +
      +
      +
      + <%= label_for library_chapters => maketext('Chapter:'), + class => 'col-2 col-form-label col-form-label-sm' =%> +
      + <%= select_field library_chapters => [ + [ maketext('All Chapters') => '', selected => undef ], + getAllDBchapters($c) + ], + id => 'library_chapters', class => 'form-select form-select-sm' =%> +
      +
      +
      + <%= label_for library_sections => maketext('Section:'), + class => 'col-2 col-form-label col-form-label-sm' =%> +
      + <%= select_field library_sections => [ + [ maketext('All Sections') => '', selected => undef ], + getAllDBsections($c) + ], + id => 'library_sections', class => 'form-select form-select-sm' =%> +
      +
      +
      +
      + <%= submit_button maketext('Advanced Search'), name => 'library_advanced', + class => 'btn btn-secondary btn-sm library-panel-btn' =%> +
      +
      + <%= include 'ContentGenerator/Instructor/SetMaker/view_problems_line', internal_name => 'lib_view' =%> +
      + +
      +
      diff --git a/templates/ContentGenerator/Instructor/SetMaker/browse_local_panel.html.ep b/templates/ContentGenerator/Instructor/SetMaker/browse_local_panel.html.ep new file mode 100644 index 0000000000..81f69255d2 --- /dev/null +++ b/templates/ContentGenerator/Instructor/SetMaker/browse_local_panel.html.ep @@ -0,0 +1,27 @@ +% $selected_library //= ''; +% my $lib = (stash('lib') || '') =~ s/^browse_//r; +% +% my $prob_dirs = $cg->get_problem_directories($lib); +% +
      +
      + <%= label_for library_sets => + maketext('[_1] Problems:', $lib eq '' ? maketext('Local') : $cg->{problibs}{$lib}), + class => 'col-form-label-sm' =%> + <%= select_field library_sets => [ + @$prob_dirs == 0 ? [ maketext('Found no directories containing problems') => '' ] + : ( + $selected_library eq '' ? [ maketext('Select a Problem Collection') => '', selected => undef ] : (), + $lib ? ( + map { [ $_ =~ s/^$lib\/(.*)$/$1/r => $_, $_ eq $selected_library ? (selected => undef) : () ] } + @$prob_dirs + ) : ( + map { [ $_ => $_, $_ eq $selected_library ? (selected => undef) : () ] } + @$prob_dirs + ) + ) + ], + id => 'library_sets', class => 'form-select form-select-sm d-inline w-auto' =%> +
      + <%= include 'ContentGenerator/Instructor/SetMaker/view_problems_line', internal_name => 'view_local_set' =%> +
      diff --git a/templates/ContentGenerator/Instructor/SetMaker/browse_setdef_panel.html.ep b/templates/ContentGenerator/Instructor/SetMaker/browse_setdef_panel.html.ep new file mode 100644 index 0000000000..60f03094be --- /dev/null +++ b/templates/ContentGenerator/Instructor/SetMaker/browse_setdef_panel.html.ep @@ -0,0 +1,22 @@ +% my @list_of_set_defs = $cg->getDefList; +% +% if (!@list_of_set_defs) { +
      + +
      + % last; +% } +% +
      +
      + + <%= select_field library_sets => [ + $selected_library eq '' ? [ maketext('Select a Set Definition File') => '', selected => undef ] : (), + @list_of_set_defs + ], + class => 'form-select form-select-sm d-inline w-auto' =%> +
      + <%= include 'ContentGenerator/Instructor/SetMaker/view_problems_line', internal_name => 'view_setdef_set' =%> +
      diff --git a/templates/ContentGenerator/Instructor/SetMaker/problem_row.html.ep b/templates/ContentGenerator/Instructor/SetMaker/problem_row.html.ep new file mode 100644 index 0000000000..e16d188a27 --- /dev/null +++ b/templates/ContentGenerator/Instructor/SetMaker/problem_row.html.ep @@ -0,0 +1,275 @@ +% use WeBWorK::Utils qw(wwRound); +% +% my $sourceFileName = $sourceFileData->{filepath} =~ s|^\./||r; +% my $isstatic = $sourceFileData->{static}; +% my $isMO = $sourceFileData->{MO}; +% +% if (!defined $isMO) { + % ($isMO, $isstatic) = $cg->getDBextras($sourceFileName); +% } +% +% # Determine if the target set is a gateway assignment. +% my $setRecord = + % (defined param('local_sets') && param('local_sets') ne '') + % ? $db->getGlobalSet(param('local_sets')) + % : undef; +% my $isGatewaySet = defined $setRecord && $setRecord->assignment_type =~ /gateway/; +% +% my $noshowclass = $sourceFileData->{morelt} ? "MLT$sourceFileData->{morelt}" : "NS$cnt"; +% if ($sourceFileData->{children}) { + % my $numchild = @{ $sourceFileData->{children} }; + % content_for "mlt-$cnt" => begin + <%= tag('span', + class => 'lb-mlt-parent btn btn-sm btn-secondary', + id => "mlt$cnt", + tabindex => 0, + role => 'button', + data => { + mlt_cnt => $cnt, + mlt_noshow_class => $noshowclass, + less_text => maketext('Show less like this'), + more_text => maketext('Show [_1] more like this', $numchild), + bs_title => maketext('Show [_1] more like this', $numchild), + bs_toggle => 'tooltip', + bs_placement => 'top' + }, + 'M' + ) =%> + % end + % $noshowclass = "NS$cnt"; +% } +% +% # Get statistics to display +% +% if ($ce->{problemLibrary}{showLibraryGlobalStats}) { + % my $stats = $cg->{library_stats_handler}->getGlobalStats($sourceFileName); + % if ($stats->{students_attempted}) { + % content_for "global-problem-stats-$cnt" => begin +
      + + <%= maketext('GLOBAL Usage') . ': ' =%> + + <%= $stats->{students_attempted} . ', ' =%> + + <%= maketext('Attempts') . ': ' =%> + + <%= wwRound(2, $stats->{average_attempts}) . ', ' =%> + + <%= maketext('Status') . ': ' =%> + + <%= wwRound(0, 100 * $stats->{average_status}) =%> +
      + % end + % } +% } +% +% my $local_problem_stats = ''; +% if ($ce->{problemLibrary}{showLibraryLocalStats}) { + % my $stats = $cg->{library_stats_handler}->getLocalStats($sourceFileName); + % if ($stats->{students_attempted}) { + % content_for "local-problem-stats-$cnt" => begin +
      + + <%= maketext('LOCAL Usage') . ': ' =%> + + <%= $stats->{students_attempted} . ', ' =%> + + <%= maketext('Attempts') . ': ' =%> + + <%= wwRound(2, $stats->{average_attempts}) . ', ' =%> + + <%= maketext('Status') . ': ' =%> + + <%= wwRound(0, 100 * $stats->{average_status}) =%> +
      + % end + % } +% } +% +
      +
      +
      +
      + +
      +
      + <%= content "global-problem-stats-$cnt" =%> + <%= content "local-problem-stats-$cnt" =%> +
      +
      + <%= content "mlt-$cnt" =%> + + % if ($isMO) { + + <%= image "$ce->{webworkURLs}{htdocs}/images/pi.svg", + alt => maketext('Uses Math Objects') =%> + + % } + + % if (!$isstatic) { + + + + % } + <%= link_to $cg->systemLink( + $urlpath->newFromModule( + 'WeBWorK::ContentGenerator::Instructor::PGProblemEditor', $c, + courseID => $urlpath->arg('courseID'), + setID => 'Undefined_Set', + problemID => '1' + ), + params => { + sourceFilePath => $sourceFileName, + problemSeed => $cg->{problem_seed} + } + ), + id => "editit$cnt", + class => 'btn btn-sm btn-secondary', + target => 'WW_Editor', + data => { + bs_title => maketext('Edit it'), + bs_toggle => 'tooltip', + bs_placement => 'top' + }, + begin =%> + + <% end =%> + <%= link_to $cg->systemLink( + $urlpath->newFromModule( + 'WeBWorK::ContentGenerator::' . ($isGatewaySet ? 'GatewayQuiz' : 'Problem'), + $c, + courseID => $urlpath->arg('courseID'), + setID => 'Undefined_Set', + $isGatewaySet ? () : (problemID => '1') + ), + params => { + effectiveUser => scalar(param('user')), + editMode => 'SetMaker', + problemSeed => $cg->{problem_seed}, + sourceFilePath => $sourceFileName, + displayMode => ( + !defined param('mydisplayMode') || param('mydisplayMode') eq 'None' + ) ? $ce->{pg}{options}{displayMode} : param('mydisplayMode'), + } + ), + id => "tryit$cnt", + class => 'text-decoration-none btn btn-sm btn-secondary', + target => 'WW_View', + data => { + bs_title => maketext('Try it'), + bs_toggle => 'tooltip', + bs_placement => 'top' + }, + begin =%> + + <% end =%> + + + +
      +
      +
      +
      <%= $sourceFileName %>
      +
      + <%= maketext('(in target set)') %> +
      +
      + <%= hidden_field "filetrial$cnt" => $sourceFileName =%> + % if ($authz->hasPermissions(param('user'), 'modify_tags')) { +
      {courseDirs}{templates}/$sourceFileName" %>"> +
      + % } +
      +
      +
      +
      +
      diff --git a/templates/ContentGenerator/Instructor/SetMaker/top_row.html.ep b/templates/ContentGenerator/Instructor/SetMaker/top_row.html.ep new file mode 100644 index 0000000000..44745553d5 --- /dev/null +++ b/templates/ContentGenerator/Instructor/SetMaker/top_row.html.ep @@ -0,0 +1,100 @@ +% use WeBWorK::Utils qw(format_set_name_display); +% +% my $selected_set = param('local_sets') // ''; +% +
      +
      +
      + <%= label_for 'local_sets', class => 'col-form-label-sm', begin =%> + <%= maketext('Add problems to') %> <%= maketext('Target Set:') %> + <% end =%> + <%= select_field local_sets => [ + @$local_sets == 0 ? [ maketext('No sets in this course yet') => '' ] + : ( + $selected_set eq '' ? [ maketext('Select a Set from this Course') => '', selected => undef ] : (), + map { [ format_set_name_display($_) => $_, $_ eq $selected_set ? (selected => undef) : () ] } + @$local_sets + ) + ], + id => 'local_sets', + class => 'form-select form-select-sm d-inline w-auto mx-2', + dir => 'ltr', + data => { + no_set_selected => maketext('No Target Set Selected'), + pick_target_set => maketext('Pick a target set above to add this problem to.'), + problems_added => maketext('Problems Added'), + added_to_single => maketext('Added one problem to set [_1].', '{set}'), + added_to_plural => maketext('Added [_1] problems to set [_2].', '{number}', '{set}') + } =%> +
      + <%= submit_button maketext('Edit Target Set'), name => 'edit_local', class => 'btn btn-primary btn-sm mb-2' =%> +
      +
      + <%= submit_button maketext('Create a New Set in This Course:'), name => 'new_local_set', id => 'new_local_set', + class => 'btn btn-primary btn-sm mb-2 mx-2' =%> + <%= text_field new_set_name => '', class => 'form-control form-control-sm d-inline w-auto mb-2', + 'aria-labelledby' => 'new_local_set', placeholder => maketext('New set name'), size => 30, dir => 'ltr' =%> +
      +
      +
      + +
      + <%= submit_button maketext('Open Problem Library'), name => 'browse_npl_library', + class => 'browse-lib-btn btn btn-secondary btn-sm mb-2 mx-1', + $browse_which eq 'browse_npl_library' ? (disabled => undef) : () =%> + <%= submit_button maketext('Local Problems'), name => 'browse_local', + class => 'browse-lib-btn btn btn-secondary btn-sm mb-2 mx-1', + $browse_which eq 'browse_local' ? (disabled => undef) : () =%> + <%= submit_button maketext('From This Course'), name => 'browse_course_sets', + class => 'browse-lib-btn btn btn-secondary btn-sm mb-2 mx-1', + $browse_which eq 'browse_course_sets' ? (disabled => undef) : () =%> + <%= submit_button maketext('Set Definition Files'), name => 'browse_setdefs', + class => 'browse-lib-btn btn btn-secondary btn-sm mb-2 mx-1', + $browse_which eq 'browse_setdefs' ? (disabled => undef) : () =%> +
      +
      +% # Add buttons for additional problem libraries +% if (%{ $cg->{problibs} }) { +
      + +
      + % for (sort grep { -d "$ce->{courseDirs}{templates}/$_" } keys %{ $cg->{problibs} }) { + <%= submit_button $cg->{problibs}{$_}, + name => "browse_$_", class => 'btn btn-secondary btn-sm ms-2 mb-2', + ($browse_which eq "browse_$_") ? (disabled => undef) : () =%> + % } +
      +
      +% } +
      +% if ($browse_which eq 'browse_local') { + <%= include 'ContentGenerator/Instructor/SetMaker/browse_local_panel', + selected_library => $cg->{current_library_set} =%> +% } elsif ($browse_which eq 'browse_course_sets') { + <%= include 'ContentGenerator/Instructor/SetMaker/browse_course_sets_panel', + selected_library => $cg->{current_library_set} =%> +% } elsif ($browse_which eq 'browse_npl_library') { + <%= include 'ContentGenerator/Instructor/SetMaker/browse_library_panel' =%> +% } elsif ($browse_which eq 'browse_setdefs') { + <%= include 'ContentGenerator/Instructor/SetMaker/browse_setdef_panel', + selected_library => $cg->{current_library_set} =%> +% } else { + % # Other problem libraries + <%= include 'ContentGenerator/Instructor/SetMaker/browse_local_panel', + selected_library => $cg->{current_library_set}, lib => $browse_which =%> +% } +
      +
      + <%= submit_button maketext('Add All'), name => 'select_all', + class => 'library-action-btn btn btn-primary btn-sm mx-1 mb-2' =%> + <%= submit_button maketext('Clear Problem Display'), name => 'cleardisplay', + class => 'library-action-btn btn btn-secondary btn-sm mx-1 mb-2' =%> + % if ($cg->{first_index} > 0) { + <%= submit_button maketext('Previous page'), name => 'prev_page', + class => 'library-action-btn btn btn-secondary btn-sm mx-1 mb-2' =%> + % } + % if (1 + $cg->{last_index} < @$pg_files) { + <%= submit_button maketext('Next page'), name => 'next_page', + class => 'library-action-btn btn btn-secondary btn-sm mx-1 mb-2' =%> + % } +
      diff --git a/templates/ContentGenerator/Instructor/SetMaker/view_problems_line.html.ep b/templates/ContentGenerator/Instructor/SetMaker/view_problems_line.html.ep new file mode 100644 index 0000000000..f0570c6909 --- /dev/null +++ b/templates/ContentGenerator/Instructor/SetMaker/view_problems_line.html.ep @@ -0,0 +1,59 @@ +% use WeBWorK::PG; +% +% my $contrib_exists = -r $ce->{courseDirs}{templates} . '/Contrib'; +% +
      + <%= submit_button maketext('View Problems'), name => $internal_name, class => 'btn btn-secondary btn-sm mb-2' =%> + % +
      + <%= label_for mydisplayMode => maketext('Display Mode:'), class => 'col-form-label col-form-label-sm' =%> + <%= select_field mydisplayMode => [ + ( + map { [ $_ => $_, $_ eq $ce->{pg}{options}{displayMode} ? (selected => undef) : () ] } + grep { exists WeBWorK::PG::DISPLAY_MODES()->{$_} } @{ $ce->{pg}{displayModes} } + ), + # Special display mode "None". This is illegal in other modules, + # but means don't render the problem in this module. + [ maketext('None') => 'None' ] + ], + id => 'mydisplayMode', class => 'form-select form-select-sm d-inline w-auto' =%> + <%= hidden_field original_displayMode => param('mydisplayMode') || $ce->{pg}{options}{displayMode} =%> +
      + % # Give a choice of the number of problems to show. +
      + <%= label_for max_shown => maketext('Max. Shown:'), class => 'col-form-label col-form-label-sm' =%> + <%= select_field max_shown => [ 5, 10, 15, [ 20 => 20, selected => undef ], 25, 30, 50, 'All' ], + id => 'max_shown', class => 'form-select form-select-sm d-inline w-auto' =%> +
      + % # Option of whether to show hints and solutions +
      + % if ($contrib_exists) { +
      + +
      +
      + +
      + % } else { + <%= hidden_field includeOPL => 1 =%> + % } +
      + +
      +
      + +
      +
      +
      diff --git a/templates/ContentGenerator/Instructor/ShowAnswers.html.ep b/templates/ContentGenerator/Instructor/ShowAnswers.html.ep new file mode 100644 index 0000000000..2790941fc1 --- /dev/null +++ b/templates/ContentGenerator/Instructor/ShowAnswers.html.ep @@ -0,0 +1,19 @@ +% use WeBWorK::Utils qw(getAssetURL); +% +% content_for js => begin + <%= javascript getAssetURL($ce, 'js/apps/ShowHide/show_hide.js'), defer => undef =%> +% end +% +% unless ($authz->hasPermissions(param('user'), 'view_answers')) { +
      <%= maketext('You are not authorized to view past answers') %>
      + % last; +% } +% +% # Only instructors should be able to veiw other people's answers. +% my $isInstructor = $authz->hasPermissions(param('user'), 'access_instructor_tools'); +% +% if ($isInstructor) { + <%= include 'ContentGenerator/Instructor/ShowAnswers/instructor-selectors', $cg->getInstructorData =%> +% } +% +<%= include 'ContentGenerator/Instructor/ShowAnswers/past-answers-table', isInstructor => $isInstructor =%> diff --git a/templates/ContentGenerator/Instructor/ShowAnswers/instructor-selectors.html.ep b/templates/ContentGenerator/Instructor/ShowAnswers/instructor-selectors.html.ep new file mode 100644 index 0000000000..da7ef716da --- /dev/null +++ b/templates/ContentGenerator/Instructor/ShowAnswers/instructor-selectors.html.ep @@ -0,0 +1,71 @@ +% use WeBWorK::HTML::ScrollingRecordList qw(scrollingRecordList); +% use WeBWorK::Utils qw(format_set_name_display); +% +% my $courseID = $urlpath->arg('courseID'); +% + + +
      +<%= form_for $cg->systemLink($urlpath->newFromModule($urlpath->module, $c, courseID => $courseID), authen => 0), + target => 'WW_Info', id => 'past-answer-form', method => 'POST', begin =%> + <%= $cg->hidden_authen_fields =%> + % +
      +
      +
      <%= label_for selected_users => maketext('Users') %>
      + <%= scrollingRecordList( + { + name => 'selected_users', + id => 'selected_users', + request => $c, + default_sort => 'lnfn', + default_format => 'lnfn_uid', + default_filters => ['all'], + attrs => { size => 10, multiple => undef } + }, + @$users + ) =%> +
      +
      +
      <%= label_for selected_sets => maketext('Sets') %>
      + <%= select_field selected_sets => [ map { [ format_set_name_display($_) => $_ ] } @$expandedGlobalSetIDs ], + id => 'selected_sets', size => 23, multiple => undef, class => 'form-select form-select-sm', + dir => 'ltr' =%> +
      +
      +
      <%= label_for selected_problems => maketext('Problems') %>
      + <%= select_field selected_problems => $globalProblemIDs, id => 'selected_problems', size => 23, + multiple => undef, class => 'form-select form-select-sm' =%> +
      +
      + % +
      + <%= submit_button maketext('Display Past Answers'), name => 'action', class => 'btn btn-primary mb-2' =%> +
      + +
      + % if (param('createCSV') && -e "$ce->{courseDirs}{scoring}/$filename") { + + <%= maketext('Download:') =%> + <%= link_to $filename => $cg->systemLink( + $urlpath->newFromModule( + 'WeBWorK::ContentGenerator::Instructor::ScoringDownload', $c, + courseID => $courseID + ), + params => { getFile => $filename } + ) =%> + + % } +
      +<% end =%> diff --git a/templates/ContentGenerator/Instructor/ShowAnswers/past-answers-table.html.ep b/templates/ContentGenerator/Instructor/ShowAnswers/past-answers-table.html.ep new file mode 100644 index 0000000000..7bc6bece3c --- /dev/null +++ b/templates/ContentGenerator/Instructor/ShowAnswers/past-answers-table.html.ep @@ -0,0 +1,65 @@ +% use WeBWorK::Utils qw(format_set_name_display); +% +% my $records = $cg->{records}; +% my $foundMatches = 0; +% +% for my $studentUser (sort keys %$records) { + % for my $setName (sort keys %{ $records->{$studentUser} }) { + % for my $problemNumber (sort { $a <=> $b } keys %{ $records->{$studentUser}{$setName} }) { + % my @pastAnswerIDs = sort { $a <=> $b } keys %{ $records->{$studentUser}{$setName}{$problemNumber} }; + % my $prettyProblemNumber = $cg->{prettyProblemNumbers}{$setName}{$problemNumber}; +

      + <%== maketext('Past Answers for [_1], set [_2], problem [_3]', + $studentUser, tag('span', dir => 'ltr', format_set_name_display($setName)), $prettyProblemNumber + ) =%> +

      +
      + + % my $previousTime = -1; + % for my $answerID (@pastAnswerIDs) { + % $foundMatches = 1; + % + % my %record = %{ $records->{$studentUser}{$setName}{$problemNumber}{$answerID} }; + % my @answers = @{ $record{answers} }; + % my @scores = @{ $record{scores} }; + % $previousTime = $record{time} if $previousTime < 0; + % my $upper_limit = $#scores > $#answers ? $#scores : $#answers; + % + $ce->{sessionKeyTimeout} + ? 'class="table-rule"' : '' %>> + + + % for (my $i = 0; $i <= $upper_limit; $i++) { + % my $answer = $answers[$i] // ''; + % my $answerType = $record{answerTypes}[$i] // ''; + % my $score = shift(@scores); + % + + % # Color the answer if the user is an instructor, there is an answer, + % # there is a score, and it is not an essay question. + + % } + % if ($record{comment}) { + + + % } + + % $previousTime = $record{time}; + % } +
      <%= $cg->formatDateTime($record{time}) %> <%== $answerType eq 'essay' ? 'class="essay"' : '' %>> + % if ($answer eq '') { + <%= maketext('empty') %> + % } else { + <%= $answer =%> + % } + <%= maketext('Comment') . ': ' . $record{comment} %>
      +
      + % } + % } +% } +% +% unless ($foundMatches) { +

      <%= maketext('No problems matched the given parameters.') %>

      +% } diff --git a/templates/ContentGenerator/Instructor/Stats.html.ep b/templates/ContentGenerator/Instructor/Stats.html.ep new file mode 100644 index 0000000000..5a0a1ddee0 --- /dev/null +++ b/templates/ContentGenerator/Instructor/Stats.html.ep @@ -0,0 +1,29 @@ +% use WeBWorK::Utils qw(getAssetURL); +% +% content_for js => begin + % if ($cg->{type} eq 'set' || $cg->{type} eq 'problem') { + <%= javascript getAssetURL($ce, 'js/apps/Stats/stats.js'), defer => undef =%> + % } + % if ($cg->{type} eq 'problem') { + <%= javascript getAssetURL($ce, 'node_modules/iframe-resizer/js/iframeResizer.min.js') =%> + % } +% end +% +% unless ($authz->hasPermissions(param('user'), 'access_instructor_tools')) { +
      <%= maketext('You are not authorized to access instructor tools') %>
      + % last; +% } +% +% if ($cg->{type} eq 'student') { + % # Stats and StudentProgress share this template. + <%= include 'ContentGenerator/Instructor/Stats/student_stats' =%> +% } elsif ($cg->{type} eq 'set') { + <%= $cg->set_stats =%> +% } elsif ($cg->{type} eq 'problem') { + <%= $cg->problem_stats =%> +% } else { + % # Stats and StudentProgress share this template also. + <%= include 'ContentGenerator/Instructor/Stats/index', + set_header => maketext('View statistics by set'), + student_header => maketext('View statistics by student') =%> +% } diff --git a/templates/ContentGenerator/Instructor/Stats/index.html.ep b/templates/ContentGenerator/Instructor/Stats/index.html.ep new file mode 100644 index 0000000000..7421eea822 --- /dev/null +++ b/templates/ContentGenerator/Instructor/Stats/index.html.ep @@ -0,0 +1,46 @@ +% # Note that this template is used by both WeBWorK::ContentGenerator::Instructor::Stats and +% # WeBWorK::ContentGenerator::Instructor::StudentProgress. +% +% use WeBWorK::Utils qw(format_set_name_display); +% +% my $courseID = $urlpath->arg('courseID'); +% +
      +
      +
      +
      +

      <%= $set_header %>

      +
        + % for ($db->listGlobalSetsWhere({}, 'set_id')) { +
      • + <%= link_to format_set_name_display($_->[0]) => + $cg->systemLink($urlpath->newFromModule( + $urlpath->module, $c, courseID => $courseID, statType => 'set', setID => $_->[0] + )) =%> +
        • + % } +
      +
      +
      +
      +
      +
      +
      +

      <%= $student_header %>

      +
        + % for (@{ $cg->{student_records} }) { +
      • + <%= link_to $_->last_name . ', ' . $_->first_name . ' (' . $_->user_id . ')' => + $cg->systemLink($urlpath->newFromModule( + $urlpath->module, $c, + courseID => $courseID, + statType => 'student', + userID => $_->user_id + )) =%> +
        • + % } +
      +
      +
      +
      +
      diff --git a/templates/ContentGenerator/Instructor/Stats/problem_menu.html.ep b/templates/ContentGenerator/Instructor/Stats/problem_menu.html.ep new file mode 100644 index 0000000000..84da589ae9 --- /dev/null +++ b/templates/ContentGenerator/Instructor/Stats/problem_menu.html.ep @@ -0,0 +1,39 @@ +
      + <%= link_to $cg->{prettyID} ? maketext('Problem [_1]', $cg->{prettyID}) : maketext('All problems') => '#', + id => 'problemMenu', class => 'btn btn-primary dropdown-toggle', role => 'button', 'aria-expanded' => 'false', + data => { bs_toggle => 'dropdown' } =%> + +
      \ diff --git a/templates/ContentGenerator/Instructor/Stats/problem_stats.html.ep b/templates/ContentGenerator/Instructor/Stats/problem_stats.html.ep new file mode 100644 index 0000000000..cc96753b67 --- /dev/null +++ b/templates/ContentGenerator/Instructor/Stats/problem_stats.html.ep @@ -0,0 +1,102 @@ +% my $courseID = $urlpath->arg('courseID'); +% +
      + <%= maketext('Showing statistics for:') =%> + <%= include 'ContentGenerator/Instructor/Stats/student_filter_menu', filters => $filters =%> + <%= include 'ContentGenerator/Instructor/Stats/problem_menu', problems => $problems =%> +
      +% +% # Histogram of total scores. +<%= $cg->build_bar_chart( + [ @$buckets ], + xAxisLabels => [ '90-100', '80-89', '70-79', '60-69', '50-59', '40-49', '30-39', '20-29', '10-19', '0-9' ], + yMax => 5 * $maxCount, + yAxisLabels => [ map { $_ * $maxCount } 0 .. 5 ], + mainTitle => maketext('Active Students Problem [_1] Grades', $cg->{prettyID}), + xTitle => maketext('Percent Ranges'), + yTitle => maketext('Number of Students'), + barWidth => 35, + barSep => 5, + isPercent => 0, + leftMargin => 40 + 5 * length(5 * $maxCount), + isJitarSet => ($isJitarSet && $topLevelJitar), + jitarBars => [ reverse(@$jitarBars) ], +) =%> +% +% # Display overall statistics +
      + + + + + + + + + + + +
      <%= maketext('Point Value') %><%= $cg->{problemRecord}->value =%>
      <%= maketext('Average Percent') %><%= sprintf('%0.1f', 100 * $mean) %>
      <%= maketext('Standard Deviation') %><%= sprintf('%0.1f', 100 * $stddev) %>
      <%= maketext('Average Attempts') %><%= sprintf('%0.1f', $mean2) %>
      + <%= maketext('Success Index') =%> + + + + <%= sprintf('%0.1f', 100 * $successIndex) %>
      <%= maketext('Active Students') %><%= $activeStudents %>
      <%= maketext('Inactive Students') %><%= $inactiveStudents %>
      +
      +% +% # Table showing percentile statistics for scores. +

      + <%= maketext( + 'Percentile cutoffs for student\'s score and success index. ' + . 'The 50% column shows the median number of attempts.' + ) =%> +

      +% +% my @tableHeaders = (maketext('Percent Score')); +% my @tableData = ($problemScores); +% if ($isJitarSet && $topLevelJitar) { + % push(@tableHeaders, maketext('% Score with Review')); + % push(@tableData, [ map { sprintf('%0.0f', 100 * $_) } @$adjustedScores ]); +% } +% my $successIndexHeader = begin + <%= maketext('Success Index') =%> + + + +% end +% push @tableHeaders, $successIndexHeader->(); +% push(@tableData, [ map { sprintf('%0.0f', 100 * $_) } @$successList ]); +<%= $cg->bracket_table([ 90, 80, 70, 60, 50, 40, 30, 20, 10 ], \@tableData, \@tableHeaders, showMax => 1) =%> +% +% # Table showing attempts percentiles +

      + <%= maketext('Percentile cutoffs for number of attempts. The 50% column shows the median number of attempts.') =%> +

      +<%= $cg->bracket_table([ 95, 75, 50, 25, 5, 1 ], [ $problemAttempts ], [ maketext('# of attempts') ], reverse => 1) =%> +% +% # Render Problem +
      + <%= $cg->hidden_authen_fields =%> + <%= hidden_field courseID => $courseID, id => 'hidden_course_id' =%> + <%= hidden_field setID => $cg->{setID}, id => 'hidden_set_id' =%> + <%= hidden_field problemID => $problemID, id => 'hidden_problem_id' =%> + <%= hidden_field sourceFilePath => $cg->{problemRecord}->source_file, id => 'hidden_source_file' =%> +
      + + <%= link_to maketext('Edit Problem') => $cg->systemLink($urlpath->new( + type => 'instructor_problem_editor_withset_withproblem', + args => { courseID => $courseID, setID => $cg->{setID}, problemID => $problemID } + )), + class => 'btn btn-primary', target => 'WW_Editor' =%> +
      +
      +
      diff --git a/templates/ContentGenerator/Instructor/Stats/set_stats.html.ep b/templates/ContentGenerator/Instructor/Stats/set_stats.html.ep new file mode 100644 index 0000000000..3217cc864e --- /dev/null +++ b/templates/ContentGenerator/Instructor/Stats/set_stats.html.ep @@ -0,0 +1,219 @@ +% # Filter and problem selectors. +
      + <%= maketext('Showing statistics for:') =%> + <%= include 'ContentGenerator/Instructor/Stats/student_filter_menu', filters => $filters =%> + <%= include 'ContentGenerator/Instructor/Stats/problem_menu', problems => $problems =%> +
      +% # Set information +
      + + + + + + + + + + + + + % if ($cg->{setRecord}->enable_reduced_scoring) { + + + + + % } + + + + + + + + +
      + <%= maketext('Status') =%> + + + + + % if (time < $cg->{setRecord}->open_date) { + <%= maketext('Before Open Date') =%> + % } elsif ($cg->{setRecord}->enable_reduced_scoring + % && time > $cg->{setRecord}->reduced_scoring_date + % && time < $cg->{setRecord}->due_date) + % { + <%= maketext('Reduced Scoring Period') =%> + % } elsif (time > $cg->{setRecord}->due_date && time < $cg->{setRecord}->answer_date) { + <%= maketext('Closed') =%> + % } elsif (time > $cg->{setRecord}->answer_date) { + <%= maketext('Answers Available') =%> + % } else { + <%= maketext('Open') =%> + % } + % if (!$cg->{setRecord}->visible) { + (<%= maketext('Hidden') =%>) + % } + % if ($cg->{setRecord}->assignment_type =~ /gateway/ && time > $cg->{setRecord}->answer_date) { + + + + % } +
      <%= maketext('Number of Students') %><%= scalar(@$score_list) %>
      <%= maketext('Open Date') %><%= $cg->formatDateTime($cg->{setRecord}->open_date, undef, $ce->{studentDateDisplayFormat}) %>
      <%= maketext('Reduced Scoring Date') %> + <%= $cg->formatDateTime($cg->{setRecord}->reduced_scoring_date, + undef, $ce->{studentDateDisplayFormat}) %> +
      <%= maketext('Close Date') %><%= $cg->formatDateTime($cg->{setRecord}->due_date, undef, $ce->{studentDateDisplayFormat}) %>
      <%= maketext('Answer Date') %><%= $cg->formatDateTime($cg->{setRecord}->answer_date, undef, $ce->{studentDateDisplayFormat}) %>
      +
      +% +

      <%= maketext('Overall Results') %>

      +% +% # Histogram of total scores. +<%= $cg->build_bar_chart( + $buckets, + xAxisLabels => [ '90-100', '80-89', '70-79', '60-69', '50-59', '40-49', '30-39', '20-29', '10-19', '0-9' ], + yMax => 5 * $maxCount, + yAxisLabels => [ map { $_ * $maxCount } 0 .. 5 ], + mainTitle => maketext('Overall Set Grades'), + xTitle => maketext('Percent Ranges'), + yTitle => maketext('Number of Students'), + barWidth => 35, + barSep => 5, + isPercent => 0, + leftMargin => 40 + 5 * length(5 * $maxCount), +) =%> +% +% # Success index help icon. +% my $successHelp = begin + + + +% end +% +% # Display the overall average +
      + + + + + + + + + + + + +
      <%= maketext('Total Points') %><%= $totalValue %>
      <%= maketext('Average Percent') %><%= sprintf('%0.1f', 100 * $mean) %>
      <%= maketext('Standard Deviation') %><%= sprintf('%0.1f', 100 * $stddev) %>
      <%= maketext('Average Attempts Per Problem') %><%= sprintf('%0.1f', $overallAvgAttempts) %>
      <%= maketext('Overall Success Index') =%><%= $successHelp->() %><%= sprintf('%0.1f', 100 * $overallSuccess) %>
      +
      +% +% # Table showing percentile statistics for scores and success indices. +

      + <%= maketext( + 'The percentage of students receiving at least these scores. The median score is in the 50% column.') =%> +

      +<%= $cg->bracket_table( + [ 90, 80, 70, 60, 50, 40, 30, 20, 10 ], + [ $score_list, $index_list ], + [ maketext('Percent Score'), b(maketext('Success Index') . $successHelp->()) ], + showMax => 1, +) =%> +% +% # Individual problem stats. +

      <%= maketext('Individual Problem Results') %>

      +% +% # SVG bar graph showing the percentage of students with correct answers for each problem. +<%= $cg->build_bar_chart( + $svgProblemData, + yAxisLabels => [ '0%', '20%', '40%', '60%', '80%', '100%' ], + xAxisLabels => $svgProblemLabels, + mainTitle => maketext('Grade of Active Students'), + xTitle => maketext('Problem Number'), + isJitarSet => $isJitarSet, + jitarBars => $isJitarSet ? $jitarBars : [], + barLinks => [ map { $_->{statsLink} } @$problems ], +) =%> +% +% # Table showing indvidual problem stats. +
      + + + + % for (@$problems) { + + % } + + + + <% for (@$problems) { %><% } =%> + + + + <% for (@$avgScore) { %><% } =%> + + % if ($isJitarSet) { + + + <% for (@$adjScore) { %><% } =%> + + % } + + + <% for (@$avgAttempts) { %><% } =%> + + + + <% for (@$successList) { %><% } =%> + + + + <% for (@$numActive) { %><% } =%> + + % if ($showGraderRow) { + + + % for (@$problems) { + + % } + + % } +
      <%= maketext('Problem Number') %><%= link_to $_->{prettyID} => $_->{statsLink} =%>
      <%= maketext('Point Value') %><%= $_->value %>
      <%= maketext('Point Value') %><%= $_ %>
      <%= maketext('% Average with Review') %><%= $_ %>
      <%= maketext('Average Attempts') %><%= $_ %>
      <%= maketext('Success Index') %><%= $successHelp->() %><%= $_ %>
      <%= maketext('# of Active Students') %><%= $_ %>
      <%= maketext('Manual Grader') %> + % if ($_->flags =~ /essay/) { + <%= link_to maketext('Grade Problem [_1]', $_->{prettyID}) => + $cg->systemLink($urlpath->new( + type => 'instructor_problem_grader', + args => { + courseID => $urlpath->arg('courseID'), + setID => $cg->{setID}, + problemID => $_->problem_id + } + )) %> + % } +
      +
      +% +% # Table showing percentile statistics for scores and success indices. +

      + <%= maketext('Percentile cutoffs for number of attempts. The 50% column shows the median number of attempts.') =%> +

      +<%= $cg->bracket_table( + [ 95, 75, 50, 25, 5, 1 ], + $attemptsList, + [ map { link_to maketext('Problem [_1]', $_->{prettyID}) => $_->{statsLink} } @$problems ], + reverse => 1 +) =%> diff --git a/templates/ContentGenerator/Instructor/Stats/siblings.html.ep b/templates/ContentGenerator/Instructor/Stats/siblings.html.ep new file mode 100644 index 0000000000..c2b1648e6c --- /dev/null +++ b/templates/ContentGenerator/Instructor/Stats/siblings.html.ep @@ -0,0 +1,58 @@ +% # Note that this template is used by both WeBWorK::ContentGenerator::Instructor::Stats and +% # WeBWorK::ContentGenerator::Instructor::StudentProgress. +% +% use WeBWorK::Utils qw(format_set_name_display); +% +% unless ($authz->hasPermissions(param('user'), 'access_instructor_tools')) { + % last; +% } +% +% my $courseID = $urlpath->arg('courseID'); +% +
      +

      <%= $header %>

      + % if ($cg->{type} eq 'student') { +
        + % for (@{ $cg->{student_records} }) { +
      • + <%= tag 'a', + $_->user_id eq $cg->{studentID} + ? (class => 'nav-link active') + : ( + href => $cg->systemLink($urlpath->newFromModule( + $urlpath->module, $c, + courseID => $courseID, + statType => 'student', + userID => $_->user_id + )), + class => 'nav-link' + ), begin =%> + <%= $_->last_name =%>, <%= $_->first_name %> (<%= $_->user_id %>) + <% end =%> +
        • + % } +
      + % } else { +
        + % for (sort $db->listGlobalSets) { +
      • + <%= tag 'a', + defined $cg->{setID} && $_ eq $cg->{setID} ? (class => 'nav-link active') + : ( + href => $cg->systemLink( + $urlpath->newFromModule( + $urlpath->module, $c, + courseID => $courseID, + setID => $_, + statType => 'set', + ), + params => param('filter') ? { filter => param('filter') } : {} + ), + class => 'nav-link' + ), + format_set_name_display($_) =%> +
        • + % } +
      + % } +
      diff --git a/templates/ContentGenerator/Instructor/Stats/stats_table.html.ep b/templates/ContentGenerator/Instructor/Stats/stats_table.html.ep new file mode 100644 index 0000000000..d7ef2d5c73 --- /dev/null +++ b/templates/ContentGenerator/Instructor/Stats/stats_table.html.ep @@ -0,0 +1,12 @@ +
      + + % while (@$tableHeaders && @$tableData) { + + + % for (@{ shift @$tableData }) { + + % } + + % } +
      <%= shift @$tableHeaders %><%= $_ %>
      +
      diff --git a/templates/ContentGenerator/Instructor/Stats/student_filter_menu.html.ep b/templates/ContentGenerator/Instructor/Stats/student_filter_menu.html.ep new file mode 100644 index 0000000000..cd17f5340e --- /dev/null +++ b/templates/ContentGenerator/Instructor/Stats/student_filter_menu.html.ep @@ -0,0 +1,29 @@ +% last unless %$filters; +% +% my $statsPage = $urlpath->newFromModule( + % $urlpath->module, $c, + % courseID => $urlpath->arg('courseID'), + % statType => $cg->{type}, + % setID => $cg->{setID}, + % problemID => $urlpath->arg('problemID') || '' +% ); +% +% # Create a section/recitation "filter by" dropdown if there are sections or recitations. +
      + <%= link_to param('filter') ? $filters->{param('filter')} : maketext('All sections') => '#', + id => 'filter', class => 'btn btn-primary dropdown-toggle', role => 'button', 'aria-expanded' => 'false', + data => { bs_toggle => 'dropdown' } =%> + +
      \ diff --git a/templates/ContentGenerator/Instructor/Stats/student_stats.html.ep b/templates/ContentGenerator/Instructor/Stats/student_stats.html.ep new file mode 100644 index 0000000000..3d0c8f3a14 --- /dev/null +++ b/templates/ContentGenerator/Instructor/Stats/student_stats.html.ep @@ -0,0 +1,31 @@ +% # Note that this template is used by both WeBWorK::ContentGenerator::Instructor::Stats and +% # WeBWorK::ContentGenerator::Instructor::StudentProgress. +% +% use WeBWorK::ContentGenerator::Grades; +% +% my $studentRecord = $db->getUser($cg->{studentID}); +% unless ($studentRecord) { +
      <%= maketext('Record for user [_1] not found.', $cg->{studentID}) %>
      + % last; +% } +% +% my $email = $studentRecord->email_address; +% if ($email) { + <%= link_to $email => "mailto:$email" =%> +
      +% } +% if ($studentRecord->section ne '') { + <%= maketext('Section') =%>: <%= $studentRecord->section %> +
      +% } +% if ($studentRecord->recitation ne '') { + <%= maketext('Recitation') =%>: <%= $studentRecord->recitation %> +
      +% } +% if ($authz->hasPermissions(param('user'), 'become_student')) { + <%= maketext('Act as:') =%> + <%= link_to $studentRecord->user_id => $cg->systemLink( + $urlpath->new(type => 'set_list', args => { courseID => $urlpath->arg('courseID') }), + params => { effectiveUser => $cg->{studentID} }) =%> +% } +<%= WeBWorK::ContentGenerator::Grades::displayStudentStats($cg, $cg->{studentID}) =%> diff --git a/templates/ContentGenerator/Instructor/StudentProgress.html.ep b/templates/ContentGenerator/Instructor/StudentProgress.html.ep new file mode 100644 index 0000000000..f088e51e31 --- /dev/null +++ b/templates/ContentGenerator/Instructor/StudentProgress.html.ep @@ -0,0 +1,16 @@ +% unless ($authz->hasPermissions(param('user'), 'access_instructor_tools')) { +
      <%= maketext('You are not authorized to access instructor tools') %>
      + % last; +% } +% +% if ($cg->{type} eq 'student') { + % # Stats and StudentProgress share this template. + <%= include 'ContentGenerator/Instructor/Stats/student_stats' =%> +% } elsif ($cg->{type} eq 'set') { + <%= $cg->displaySets($cg->{setID}) =%> +% } else { + % # Stats and StudentProgress share this template also. + <%= include 'ContentGenerator/Instructor/Stats/index', + set_header => maketext('View student progress by set'), + student_header => maketext('View student progress by student') =%> +% } diff --git a/templates/ContentGenerator/Instructor/StudentProgress/set_progress.html.ep b/templates/ContentGenerator/Instructor/StudentProgress/set_progress.html.ep new file mode 100644 index 0000000000..c77f421fde --- /dev/null +++ b/templates/ContentGenerator/Instructor/StudentProgress/set_progress.html.ep @@ -0,0 +1,332 @@ +% # In the case of gateway tests, add a form with checkboxes that allow customization of what is included in the +% # display. +% if ($setIsVersioned) { +
      + <%= form_for $cg->systemLink($urlpath, authen => 0), method => 'post', + id => 'sp-gateway-form', name => 'StudentProgress', begin =%> + <%= $cg->hidden_authen_fields =%> + <%= hidden_field returning => 1 =%> +
      +
      <%= maketext("Display options: Show") %>
      +
      +
      + +
      +
      + +
      +
      + +
      +
      + +
      +
      + +
      +
      + +
      +
      + +
      +
      + <%= submit_button maketext('Update Display'), class => 'btn btn-primary' =%> +
      + <% end =%> +
      +% } +% +% # Table description. Only show the problem description if the problems column is shown. +
      + % if (!$setIsVersioned || $showColumns->{problems}) { +

      + <%= maketext( + 'A period (.) indicates a problem has not been attempted, and a number from 0 to 100 indicates ' + . 'the grade earned. The number on the second line gives the number of incorrect attempts.' + ) =%> +

      + % } + % if ($setIsVersioned) { +

      + <%= maketext( + q{Click a student's name to see the student\'s test summary page. } + . q{Click a test's version number to see the corresponding test version. } + . 'Click a heading to sort the table.' + ) =%> +

      + % } else { +

      + <%= maketext( + q{Click a student's name to see the student's homework set. Click a heading to sort the table.} + ) =%> +

      + % } + % + % my %display_sort_method_name = ( + % last_name => maketext('last name'), + % first_name => maketext('first name'), + % email_address => maketext('email address'), + % score => maketext('score'), + % section => maketext('section'), + % recitation => maketext('recitation'), + % user_id => maketext('login name'), + % ); + % if (defined $primary_sort_method) { +

      + <%= maketext('Entries are sorted by [_1]', $display_sort_method_name{$primary_sort_method}) =%> + % if (defined $secondary_sort_method) { + <%= maketext(', then by [_1]', $display_sort_method_name{$secondary_sort_method}) =%> + % } + % if (defined $ternary_sort_method) { + <%= maketext(', then by [_1]', $display_sort_method_name{$ternary_sort_method}) =%> + % } +

      + % } +
      +% +% my %params = ( + % # Shift past sort methods down in priority. + % defined $primary_sort_method ? (secondary_sort => $primary_sort_method) : (), + % defined $secondary_sort_method ? (ternary_sort => $secondary_sort_method) : (), + % # Preserve display options when the sort headers are clicked for gateway quizzes. + % $setIsVersioned + % ? ( + % show_best_only => $showBestOnly, + % show_date => $showColumns->{date}, + % show_testtime => $showColumns->{testtime}, + % show_problems => $showColumns->{problems}, + % show_section => $showColumns->{section}, + % show_recitation => $showColumns->{recit}, + % show_login => $showColumns->{login}, + % ) + % : () +% ); +% +% my $courseID = $urlpath->arg('courseID'); +% +% my $setStatsPage = $urlpath->newFromModule( + % $urlpath->module, $c, + % courseID => $courseID, + % statType => 'sets', + % setID => $cg->{setID} +% ); +% +% # Start table output +
      + + + % my $rowspan = $showColumns->{problems} ? 'rowspan="2"' : ''; + + + + + % # Additional columns that may be shown depending on if showing a gateway quiz and user selection. + % if ($showColumns->{date}) { + + % } + % if ($showColumns->{testtime}) { + + % } + % if ($showColumns->{problems}) { + + % } + % if ($showColumns->{section}) { + + % } + % if ($showColumns->{recit}) { + + % } + % if ($showColumns->{login}) { + + % } + + % if ($showColumns->{problems}) { + + % for (@$problems) { + + % } + + % } + + + % # This is used to determine when all gateway versions for one user have been displayed and the next user + % # is being switched to. + % my $prevUserID = ''; + % + % for my $rec (@$user_set_list) { + % my $fullName = join('', $rec->{record}{first_name}, " ", $rec->{record}{last_name}); + % my $email = $rec->{record}{email_address}; + % + % if ($setIsVersioned) { + % my $interactiveURL = $cg->systemLink( + % $urlpath->newFromModule( + % 'WeBWorK::ContentGenerator::ProblemSet', $c, + % courseID => $courseID, + % setID => $cg->{setID} + % ), + % params => { effectiveUser => $rec->{record}{user_id} } + % ); + % + + % # If total is -1, then this is a user that hasn't taken any tests. + % if ($rec->{total} != -1) { + % # Make a versioned set name format nicer and link to the test version. + % my $versionLink = link_to "version $rec->{version}" => $cg->systemLink( + % $urlpath->newFromModule( + % 'WeBWorK::ContentGenerator::GatewayQuiz', $c, + % courseID => $courseID, + % setID => "$cg->{setID},v$rec->{version}" + % ), + % params => { effectiveUser => $rec->{record}{user_id} } + % ); + % + + + + % if ($showColumns->{date}) { + + % } + % if ($showColumns->{testtime}) { + + % } + % if ($showColumns->{problems}) { + % if (@{ $rec->{problem_scores} }) { + % for (0 .. $#{ $rec->{problem_scores} }) { + + % } + % } else { + + % } + % } + % } else { + + + + % } + % if ($showColumns->{section}) { + + % } + % if ($showColumns->{recit}) { + + % } + % if ($showColumns->{login}) { + + % } + + % } else { + + + + + % if (@{ $rec->{problem_scores} }) { + % for (0 .. $#{ $rec->{problem_scores} }) { + + % } + % } else { + + % } + + + + + % } + % } + +
      > + <%= maketext('Name') %> +
      + <%= link_to maketext('First') => + $cg->systemLink($setStatsPage, params => { primary_sort => 'first_name', %params }) =%> +     + <%= link_to maketext('Last') => + $cg->systemLink($setStatsPage, params => { primary_sort => 'last_name', %params }) =%> +
      + <%= link_to maketext('Email') => + $cg->systemLink($setStatsPage, params => { primary_sort => 'email_address', %params }) =%> +       		> + <%= link_to maketext('Score') => + $cg->systemLink($setStatsPage, params => { primary_sort => 'score', %params }) =%> + ><%= maketext('Out Of') %>><%= maketext('Date') %>><%= maketext('Test Time') %><%= maketext('Problems') %>> + <%= link_to maketext('Section') => + $cg->systemLink($setStatsPage, params => { primary_sort => 'section', %params }) =%> + > + <%= link_to maketext('Recitation') => + $cg->systemLink($setStatsPage, params => { primary_sort => 'recitation', %params }) =%> + > + <%= link_to maketext('Login Name') => + $cg->systemLink($setStatsPage, params => { primary_sort => 'user_id', %params }) =%> +
      <%= $_ %>
      + % if ($rec->{record}{user_id} eq $prevUserID) { +
      (<%= $versionLink %>)
      + % } else { +
      + <%= link_to $fullName => $interactiveURL =%> + % if ($setIsVersioned && !$showBestOnly) { + (<%= $versionLink %>) + % } +
      + % if ($email) { +
      <%= link_to $email => "mailto:$email" =%>
      + % } + % $prevUserID = $rec->{record}{user_id}; + % } +       		<%= $rec->{score} %><%= $rec->{total} %><%= $rec->{date} =%><%= $rec->{testtime} %> + + <%== $rec->{problem_scores}[$_] =%> + +
      + <%== $rec->{problem_incorrect_attempts}[$_] // ' ' =%> +       		  +
      <%= link_to $fullName => $interactiveURL =%>
      +
      <%= link_to $email => "mailto:$email" =%>
      +       		<%= $rec->{score} %><%= maketext('No tests taken.') %><%= $rec->{record}{section} %><%= $rec->{record}{recitation} %><%= $rec->{record}{user_id} %>
      +
      + <%= link_to $fullName => + $cg->systemLink( + $urlpath->newFromModule( + 'WeBWorK::ContentGenerator::ProblemSet', $c, + courseID => $courseID, + setID => $cg->{setID} + ), + params => { effectiveUser => $rec->{record}{user_id} } + ) =%> +
      + % if ($email) { +
      <%= link_to $email => "mailto:$email" %>
      + % } +       		<%= $rec->{score} %><%= $rec->{total} %> + + <%== $rec->{problem_scores}[$_] =%> + +
      + <%== $rec->{problem_incorrect_attempts}[$_] // ' ' =%> +       		 <%= $rec->{record}{section} %><%= $rec->{record}{recitation} %><%= $rec->{record}{user_id} %>
      +
      diff --git a/templates/ContentGenerator/Instructor/UserDetail.html.ep b/templates/ContentGenerator/Instructor/UserDetail.html.ep new file mode 100644 index 0000000000..660eb4d5f2 --- /dev/null +++ b/templates/ContentGenerator/Instructor/UserDetail.html.ep @@ -0,0 +1,136 @@ +% use WeBWorK::Utils qw(getAssetURL); +% +% content_for css => begin + <%= stylesheet getAssetURL($ce, 'node_modules/flatpickr/dist/flatpickr.min.css') =%> + <%= stylesheet getAssetURL($ce, 'node_modules/flatpickr/dist/plugins/confirmDate/confirmDate.css') =%> +% end +% +% content_for js => begin + <%= javascript getAssetURL($ce, 'node_modules/luxon/build/global/luxon.min.js'), defer => undef =%> + <%= javascript getAssetURL($ce, 'node_modules/flatpickr/dist/flatpickr.min.js'), defer => undef =%> + % if ($ce->{language} !~ /^en/) { + <%= javascript + getAssetURL($ce, 'node_modules/flatpickr/dist/l10n/' . ($ce->{language} =~ s/^(..).*/$1/gr) . '.js'), + defer => undef =%> + % } + <%= javascript getAssetURL($ce, 'node_modules/flatpickr/dist/plugins/confirmDate/confirmDate.js'), + defer => undef =%> + <%= javascript getAssetURL($ce, 'js/apps/DatePicker/datepicker.js'), defer => undef =%> + % + % # Add javascript specifically for this module. + <%= javascript getAssetURL($ce, 'js/apps/UserDetail/userdetail.js'), defer => undef =%> +% end +% +% unless ($authz->hasPermissions(param('user'), 'access_instructor_tools')) { +
      + <%= maketext('You are not authorized to edit user specific information.') =%> +
      + % last; +% } +% +% my $editForUserID = $urlpath->arg('userID'); +% unless ($cg->{userRecord}) { +
      <%= maketext('User [_1] not found.', $editForUserID) %>
      + % last; +% } +% +% my $courseID = $urlpath->arg('courseID'); +% my @editForSets = param('editForSets'); +% +% my $userName = $cg->{userRecord}->first_name . ' ' . $cg->{userRecord}->last_name; +% +% # Display a message about how many sets have been assigned to this user. +
      +

      + <%== maketext( + 'Edit [_1] for [_2] ([_3]) who has been assigned [_4] sets.', + link_to(maketext('class list data') => $cg->systemLink( + $urlpath->new(type => 'instructor_user_list', args => { courseID => $courseID }), + params => { visible_users => $editForUserID, editMode => 1 } + )), + $userName, + $editForUserID, + scalar(keys %{ $cg->{userSetRecords} }) + ) =%> +

      +
      +% +<%= form_for $cg->systemLink( + $urlpath->new( + type => 'instructor_user_detail', + args => { courseID => $courseID, userID => $editForUserID } + ), + authen => 0 + ), + method => 'post', name => 'UserDetail', id => 'UserDetail', begin =%> + <%= $cg->hidden_authen_fields =%> + % +
      + <%= submit_button maketext('Assign All Sets to Current User'), + name => 'assignAll', class => 'btn btn-primary' =%> +
      + % # Print warning +
      +
      <%= maketext('Do not uncheck a set unless you know what you are doing.') %>
      +
      <%= maketext('There is NO undo for unassigning a set.') %>
      +
      +
      + <%= maketext( + 'When you uncheck a homework set (and save the changes), you destroy all of the data for that set for ' + . 'this student. If you reassign the set, the student will receive a new version of each problem. ' + . 'Make sure this is what you want to do before unchecking sets.' + ) =%> +
      +
      + <%= maketext( + 'To change status (scores or grades) for this student for one set, click on the individual set link.') =%> +
      + % +
      + <%= submit_button maketext('Save changes'), name => 'save_button', class => 'btn btn-primary' =%> +
      + % +
      + + + + + + + + + + % for my $set (@{ $cg->{setRecords} }) { + % my $setID = $set->set_id; + % + <%= include 'ContentGenerator/Instructor/UserDetail/set_row', + set => $set, + userSet => $cg->{userSetRecords}{$setID}, + mergedSet => $cg->{mergedSetRecords}{$setID} =%> + % + % if ($set->assignment_type =~ /gateway/) { + % for (0 .. $#{ $cg->{setVersions}{$setID} }) { + <%= include 'ContentGenerator/Instructor/UserDetail/set_row', + set => $set, + userSet => $cg->{setVersions}{$setID}[$_], + mergedSet => $cg->{mergedVersions}{$setID}[$_], + version => $cg->{setVersions}{$setID}[$_]->version_id =%> + % } + % } + % } +
      + <%= maketext("Sets assigned to [_1] ([_2])", $userName, $editForUserID) =%> +
      <%= maketext('Assigned') %><%= maketext("Edit set for [_1]", $editForUserID) %><%= maketext('Dates') %>
      +
      + % + <%= submit_button maketext('Save changes'), name => 'save_button', class => 'btn btn-primary' =%> +<% end =%> +% +% # Print warning +
      + <%= maketext( + 'There is NO undo for unassigning sets. Do not do so unless you know what you are doing! When you unassign ' + . 'sets by unchecking set names and clicking save, you destroy all of the data for those sets for ' + . 'this student.' + ) =%> +
      diff --git a/templates/ContentGenerator/Instructor/UserDetail/set_date_table.html.ep b/templates/ContentGenerator/Instructor/UserDetail/set_date_table.html.ep new file mode 100644 index 0000000000..082d01426a --- /dev/null +++ b/templates/ContentGenerator/Instructor/UserDetail/set_date_table.html.ep @@ -0,0 +1,64 @@ +% my $setID = $globalRecord->set_id; +% +% # Modify set id to include the version if this is a versioned set. +% my $isVersioned = 0; +% if (defined $mergedRecord && $mergedRecord->assignment_type =~ /gateway/ && $mergedRecord->can('version_id')) { + % $setID .= ',v' . $mergedRecord->version_id; + % $isVersioned = 1; +% } +% + + % for my $field (@$fields) { + % # Skip reduced credit dates for sets which don't have them. + % next + % if $field eq 'reduced_scoring_date' + % && (!$ce->{pg}{ansEvalDefaults}{enableReducedScoring} || !$globalRecord->enable_reduced_scoring); + % + + % my $globalValue = $globalRecord->$field; + % + + + + + + % } +
      + % if (defined $userRecord) { + <%= label_for "set.$setID.$field.override_id" => maketext($fieldLabels->{$field}), + class => 'form-check-label' =%> + % } else { + <%= maketext($fieldLabels->{$field}) =%> + % } + + % if (defined $userRecord) { + <%= check_box "set.$setID.$field.override" => $field, + id => "set.$setID.$field.override_id", class => 'form-check-input', + (defined $mergedRecord ? $mergedRecord->$field : $globalValue) ne $globalValue + || ($isVersioned && $field ne 'reduced_scoring_date') + ? (checked => undef) + : () =%> + % } + + % if (defined $userRecord) { +
      + <%= text_field "set.$setID.$field" => + defined $userRecord ? $userRecord->$field : $globalValue, + id => "set.$setID.${field}_id", + placeholder => maketext('None Specified'), + class => 'form-control w-auto' . ($field eq 'open_date' ? ' datepicker-group' : ''), + data => { + override => "set.$setID.$field.override_id", + input => undef, + done_text => maketext('Done'), + locale => $ce->{language}, + timezone => $ce->{siteDefaults}{timezone} + } =%> + +
      + % } +       		+ + <%= $cg->formatDateTime($globalValue, '', 'datetime_format_short', $ce->{language}) =%> + +
      diff --git a/templates/ContentGenerator/Instructor/UserDetail/set_row.html.ep b/templates/ContentGenerator/Instructor/UserDetail/set_row.html.ep new file mode 100644 index 0000000000..65cf2ab695 --- /dev/null +++ b/templates/ContentGenerator/Instructor/UserDetail/set_row.html.ep @@ -0,0 +1,41 @@ +% use WeBWorK::Utils qw(format_set_name_display); +% +% # my ($set, $userSet, $mergedSet, $version) = @_; +% my $urlpath = $cg->r->urlpath; +% my $editForUserID = $urlpath->arg('userID'); +% my $setID = $set->set_id; +% my $version = stash 'version'; + + + + + + % if (defined $mergedSet) { + + <%= link_to format_set_name_display($version ? "$setID (version $version)" : $setID) => + $cg->systemLink( + $urlpath->new( + type => 'instructor_set_detail', + args => { + courseID => $urlpath->arg('courseID'), + setID => $setID . ($version ? ",v$version" : '') + } + ), + params => { effectiveUser => $editForUserID, editForUser => $editForUserID } + ) =%> + + % if ($version) { + <%= hidden_field "set.$setID,v$version.assignment" => 'delete' =%> + % } + % } else { + <%= format_set_name_display($setID) %> + % } + + + <%= include 'ContentGenerator/Instructor/UserDetail/set_date_table', + globalRecord => $set, userRecord => $userSet, mergedRecord => $mergedSet =%> + + diff --git a/templates/ContentGenerator/Instructor/UserList.html.ep b/templates/ContentGenerator/Instructor/UserList.html.ep new file mode 100644 index 0000000000..671404872e --- /dev/null +++ b/templates/ContentGenerator/Instructor/UserList.html.ep @@ -0,0 +1,118 @@ +% use WeBWorK::Utils qw(getAssetURL); +% +% content_for js => begin + <%= javascript getAssetURL($ce, 'js/apps/ShowHide/show_hide.js'), defer => undef =%> + <%= javascript getAssetURL($ce, 'js/apps/ActionTabs/actiontabs.js'), defer => undef =%> + <%= javascript getAssetURL($ce, 'js/apps/UserList/userlist.js'), defer => undef =%> + <%= javascript getAssetURL($ce, 'js/apps/SelectAll/selectall.js'), defer => undef =%> +% end +% +% unless ($authz->hasPermissions(param('user'), 'access_instructor_tools')) { +
      <%= maketext('You are not authorized to access instructor tools.') =%>
      + % last; +% } +% if (($cg->{passwordMode} || $cg->{editMode}) && !$authz->hasPermissions(param('user'), 'modify_student_data')) { +
      <%= maketext('You are not authorized to modify student data') =%>
      + % last; +% } +% +% # Site identifying information + + +% +<%= form_for $cg->systemLink($urlpath, authen => 0), method => 'POST', + name => 'userlist', id => 'user-list-form', class => 'font-sm', begin =%> + <%= $cg->hidden_authen_fields =%> + % if (@{ $cg->{visibleUserIDs} }) { + % for (@{ $cg->{visibleUserIDs} }) { + <%= hidden_field visible_users => $_ =%> + % } + % } else { + <%= hidden_field no_visible_users => '1' =%> + % } + % if (@{ $cg->{prevVisibleUserIDs} }) { + % for (@{ $cg->{prevVisibleUserIDs} }) { + <%= hidden_field prev_visible_users => $_ =%> + % } + % } else { + <%= hidden_field no_prev_visible_users => '1' =%> + % } + <%= hidden_field editMode => $cg->{editMode} =%> + <%= hidden_field passwordMode => $cg->{passwordMode} =%> + <%= hidden_field primarySortField => $cg->{primarySortField} =%> + <%= hidden_field secondarySortField => $cg->{secondarySortField} =%> + <%= hidden_field ternarySortField => $cg->{ternarySortField} =%> + % + % # Output action forms + % my $default_choice; + % + % for my $actionID (@$formsToShow) { + % next if $formPerms->{$actionID} && !$authz->hasPermissions(param('user'), $formPerms->{$actionID}); + % + % my $active = ''; + % unless ($default_choice) { $active = ' active'; $default_choice = $actionID; } + % + % content_for 'tab-list' => begin + + % end + % content_for 'tab-content' => begin +
      " id="<%= $actionID %>" + role="tabpanel" aria-labelledby="<%= $actionID %>-tab"> + <%= include "ContentGenerator/Instructor/UserList/${actionID}_form" =%> +
      + % end + % } + % + <%= hidden_field action => $default_choice, id => 'current_action' =%> +
      +
        <%= content 'tab-list' =%>
      +
      <%= content 'tab-content' %>
      +
      + % +
      + <%= submit_button maketext('Take Action!'), id => 'take_action', class => 'btn btn-primary' =%> +
      + % +

      <%= maketext('Showing [_1] out of [_2] users', + scalar(@{ $cg->{visibleUsers} }), scalar(@{ $cg->{allUserIDs} })) =%>

      + % + % if ($cg->{passwordMode}) { +

      + <%= maketext(q{If a password field is left blank, the student's current password will be maintained.}) =%> +

      + % } + % if ($cg->{editMode}) { +

      + <%= maketext( + 'Click on the login name to edit individual problem set data, (e.g. due dates) for these students.') =%> +

      + % } + % + <%= include 'ContentGenerator/Instructor/UserList/user_list' =%> +<% end =%> diff --git a/templates/ContentGenerator/Instructor/UserList/add_form.html.ep b/templates/ContentGenerator/Instructor/UserList/add_form.html.ep new file mode 100644 index 0000000000..e1433d8b8a --- /dev/null +++ b/templates/ContentGenerator/Instructor/UserList/add_form.html.ep @@ -0,0 +1,9 @@ +
      + <%= label_for 'add_entry', class => 'col-form-label col-form-label-sm col-auto', begin =%> + <%= maketext('Add how many users?') %>* + <% end =%> +
      + <%= text_field number_of_students => 1, id => 'add_entry', size => 3, 'aria-required' => 'true', + class => 'form-control form-control-sm' =%> +
      +
      diff --git a/templates/ContentGenerator/Instructor/UserList/cancel_edit_form.html.ep b/templates/ContentGenerator/Instructor/UserList/cancel_edit_form.html.ep new file mode 100644 index 0000000000..04d9646c9c --- /dev/null +++ b/templates/ContentGenerator/Instructor/UserList/cancel_edit_form.html.ep @@ -0,0 +1 @@ +<%= maketext('Abandon changes') =%> diff --git a/templates/ContentGenerator/Instructor/UserList/cancel_password_form.html.ep b/templates/ContentGenerator/Instructor/UserList/cancel_password_form.html.ep new file mode 100644 index 0000000000..3c1965a19c --- /dev/null +++ b/templates/ContentGenerator/Instructor/UserList/cancel_password_form.html.ep @@ -0,0 +1 @@ +<%= maketext('Abandon changes') %> diff --git a/templates/ContentGenerator/Instructor/UserList/delete_form.html.ep b/templates/ContentGenerator/Instructor/UserList/delete_form.html.ep new file mode 100644 index 0000000000..011a72d2c5 --- /dev/null +++ b/templates/ContentGenerator/Instructor/UserList/delete_form.html.ep @@ -0,0 +1,16 @@ +
      +
      + <%= maketext('Warning: Deletion destroys all user-related data and is not undoable!') =%> +
      +
      + <%= label_for delete_select => maketext('Delete which users?'), + class => 'col-form-label col-form-label-sm col-auto' =%> +
      + <%= select_field 'action.delete.scope' => [ + [ maketext('no users') => 'none', selected => undef ], + [ maketext('selected users') => 'selected' ] + ], + id => 'delete_select', class => 'form-select form-select-sm' =%> +
      +
      +
      diff --git a/templates/ContentGenerator/Instructor/UserList/edit_form.html.ep b/templates/ContentGenerator/Instructor/UserList/edit_form.html.ep new file mode 100644 index 0000000000..0a4821cd94 --- /dev/null +++ b/templates/ContentGenerator/Instructor/UserList/edit_form.html.ep @@ -0,0 +1,11 @@ +
      + <%= label_for edit_select => maketext('Edit which users?'), class => 'col-form-label col-form-label-sm col-auto' =%> +
      + <%= select_field 'action.edit.scope' => [ + [ maketext('all users') => 'all' ], + [ maketext('visible users') => 'visible' ], + [ maketext('selected users') => 'selected', selected => undef ] + ], + id => 'edit_select', class => 'form-select form-select-sm' =%> +
      +
      diff --git a/templates/ContentGenerator/Instructor/UserList/export_form.html.ep b/templates/ContentGenerator/Instructor/UserList/export_form.html.ep new file mode 100644 index 0000000000..e22d058026 --- /dev/null +++ b/templates/ContentGenerator/Instructor/UserList/export_form.html.ep @@ -0,0 +1,37 @@ +
      +
      + <%= label_for export_select_scope => maketext('Export which users?'), + class => 'col-form-label col-form-label-sm col-sm-auto' =%> +
      + <%= select_field 'action.export.scope' => [ + [ maketext('all users') => 'all' ], + [ maketext('visible users') => 'visible', selected => undef ], + [ maketext('selected users') => 'selected' ], + ], + id => 'export_select_scope', class => 'form-select form-select-sm' =%> +
      +
      +
      + <%= label_for export_select_target => maketext('Export to what kind of file?'), + class => 'col-form-label col-form-label-sm col-sm-auto' =%> +
      + <%= select_field 'action.export.target' => [ + [ maketext('Enter filename below') => 'new' ], + $cg->getCSVList + ], + id => 'export_select_target', class => 'form-select form-select-sm' =%> +
      +
      +
      + <%= label_for 'export_filename', class => 'col-form-label col-form-label-sm col-sm-auto', begin =%> + <%= maketext('Filename') %>* + <% end =%> +
      +
      + <%= text_field 'action.export.new' => '', id => 'export_filename', 'aria-required' => 'true', + class => 'form-control form-control-sm' =%> + .lst +
      +
      +
      +
      diff --git a/templates/ContentGenerator/Instructor/UserList/filter_form.html.ep b/templates/ContentGenerator/Instructor/UserList/filter_form.html.ep new file mode 100644 index 0000000000..c4a8cf8e30 --- /dev/null +++ b/templates/ContentGenerator/Instructor/UserList/filter_form.html.ep @@ -0,0 +1,39 @@ +
      +
      + <%= label_for filter_select => maketext('Show which users?'), + class => 'col-form-label col-form-label-sm col-sm-auto' =%> +
      + <%= select_field 'action.filter.scope' => [ + [ maketext('all users') => 'all' ], + [ maketext('no users') => 'none' ], + [ maketext('selected users') => 'selected' ], + [ maketext('users who match on selected field') => 'match_regex', selected => undef ] + ], + id => 'filter_select', class => 'form-select form-select-sm' =%> +
      +
      +
      +
      + <%= label_for 'filter_type_select' => maketext('What field should filtered users match on?'), + class => 'col-form-label col-form-label-sm col-sm-auto' =%> +
      + <%= select_field 'action.filter.field' => [ + map { [ + maketext($fieldProperties->{$_}{name}) => $_, + $_ eq 'user_id' ? (selected => undef) : () + ] } grep { $_ ne 'email_address' } @$fields + ], + id => 'filter_type_select', class => 'form-select form-select-sm' =%> +
      +
      +
      + <%= label_for 'filter_text', class => 'col-form-label col-form-label-sm col-sm-auto', begin =%> + <%= maketext('Filter by what text?') %>* + <% end =%> +
      + <%= text_field 'action.filter.user_ids' => '', id => 'filter_text', 'aria-required' => 'true', + class => 'form-control form-control-sm' =%> +
      +
      +
      +
      diff --git a/templates/ContentGenerator/Instructor/UserList/import_form.html.ep b/templates/ContentGenerator/Instructor/UserList/import_form.html.ep new file mode 100644 index 0000000000..ad01a53eb7 --- /dev/null +++ b/templates/ContentGenerator/Instructor/UserList/import_form.html.ep @@ -0,0 +1,34 @@ +
      +
      + <%= label_for import_select_source => maketext('Import users from what file?'), + class => 'col-form-label col-form-label-sm col-sm-auto' =%> +
      + <%= select_field 'action.import.source' => [ $cg->getCSVList ], + id => 'import_select_source', class => 'form-select form-select-sm', dir => 'ltr' =%> +
      +
      +
      + <%= label_for import_select_replace => maketext('Replace which users?'), + class => 'col-form-label col-form-label-sm col-sm-auto' =%> +
      + <%= select_field 'action.import.replace' => [ + [ maketext('any users') => 'any' ], + [ maketext('visible users') => 'visible' ], + [ maketext('selected users') => 'selected' ], + [ maketext('no users') => 'none', selected => undef ] + ], + id => 'import_select_replace', class => 'form-select form-select-sm' =%> +
      +
      +
      + <%= label_for import_select_add => maketext('Add which new users?'), + class => 'col-form-label col-form-label-sm col-sm-auto' =%> +
      + <%= select_field 'action.import.add' => [ + [ maketext('any users') => 'any', selected => undef ], + [ maketext('no users') => 'none' ] + ], + id => 'import_select_add', class => 'form-select form-select-sm' =%> +
      +
      +
      diff --git a/templates/ContentGenerator/Instructor/UserList/password_form.html.ep b/templates/ContentGenerator/Instructor/UserList/password_form.html.ep new file mode 100644 index 0000000000..956f9bf1b6 --- /dev/null +++ b/templates/ContentGenerator/Instructor/UserList/password_form.html.ep @@ -0,0 +1,12 @@ +
      + <%= label_for password_select => maketext('Give new password to which users?'), + class => 'col-form-label col-form-label-sm col-auto' =%> +
      + <%= select_field 'action.password.scope' => [ + [ maketext('all users') => 'all' ], + [ maketext('visible users') => 'visible' ], + [ maketext('selected users') => 'selected', selected => undef ] + ], + id => 'password_select', class => 'form-select form-select-sm' =%> +
      +
      diff --git a/templates/ContentGenerator/Instructor/UserList/save_edit_form.html.ep b/templates/ContentGenerator/Instructor/UserList/save_edit_form.html.ep new file mode 100644 index 0000000000..6a8054a030 --- /dev/null +++ b/templates/ContentGenerator/Instructor/UserList/save_edit_form.html.ep @@ -0,0 +1 @@ +<%= maketext('Save changes') %> diff --git a/templates/ContentGenerator/Instructor/UserList/save_password_form.html.ep b/templates/ContentGenerator/Instructor/UserList/save_password_form.html.ep new file mode 100644 index 0000000000..6a8054a030 --- /dev/null +++ b/templates/ContentGenerator/Instructor/UserList/save_password_form.html.ep @@ -0,0 +1 @@ +<%= maketext('Save changes') %> diff --git a/templates/ContentGenerator/Instructor/UserList/sort_form.html.ep b/templates/ContentGenerator/Instructor/UserList/sort_form.html.ep new file mode 100644 index 0000000000..25dd170eac --- /dev/null +++ b/templates/ContentGenerator/Instructor/UserList/sort_form.html.ep @@ -0,0 +1,42 @@ +% my @sortFields = grep { $_ ne 'email_address' } @$fields; +
      +
      + <%= label_for sort_select_1 => maketext('Sort by') . ':', class => 'col-form-label col-form-label-sm', + style => 'width:4.5rem' =%> +
      + <%= select_field 'action.sort.primary' => [ + map { [ + maketext($fieldProperties->{$_}{name}) => $_, + $_ eq 'last_name' ? (selected => undef) : () + ] } @sortFields + ], + id => 'sort_select_1', class => 'form-select form-select-sm' =%> +
      +
      +
      + <%= label_for sort_select_2 => maketext('Then by') . ':', class => 'col-form-label col-form-label-sm', + style => 'width:4.5rem' =%> +
      + <%= select_field 'action.sort.secondary' => [ + map { [ + maketext($fieldProperties->{$_}{name}) => $_, + $_ eq 'first_name' ? (selected => undef) : () + ] } @sortFields + ], + id => 'sort_select_2', class => 'form-select form-select-sm' =%> +
      +
      +
      + <%= label_for sort_select_3 => maketext('Then by') . ':', class => 'col-form-label col-form-label-sm', + style => 'width:4.5rem' =%> +
      + <%= select_field 'action.sort.ternary' => [ + map { [ + maketext($fieldProperties->{$_}{name}) => $_, + $_ eq 'user_id' ? (selected => undef) : () + ] } @sortFields + ], + id => 'sort_select_3', class => 'form-select form-select-sm' =%> +
      +
      +
      diff --git a/templates/ContentGenerator/Instructor/UserList/user_list.html.ep b/templates/ContentGenerator/Instructor/UserList/user_list.html.ep new file mode 100644 index 0000000000..f46b7312f7 --- /dev/null +++ b/templates/ContentGenerator/Instructor/UserList/user_list.html.ep @@ -0,0 +1,90 @@ +% my $courseName = $urlpath->arg('courseID'); +% +% if ($cg->{passwordMode}) { + % content_for 'user-list-table-headings' => begin + <%= maketext('New Password') %> + % end +% } +% +% unless ($cg->{editMode} || $cg->{passwordMode}) { + % content_for 'user-list-table-headings' => begin + + <%= check_box 'select-all' => 'on', id => 'select-all', 'aria-label' => maketext('Select all users'), + data => { select_group => 'selected_users' }, class => 'select-all form-check-input' =%> + + + <%= label_for 'select-all' => + link_to maketext('Login Name') => '#', class => 'sort-header', + data => { sort_field => 'user_id' } =%> + + <%= maketext('Login Status') %> + <%= maketext('Assigned Sets') %> + + <%= link_to maketext('First Name') => '#', class => 'sort-header', + data => { sort_field => 'first_name' } %> + + + <%= link_to maketext('Last Name') => '#', class => 'sort-header', + data => { sort_field => 'last_name' } =%> + + <%= maketext('Email Link') %> + + <%= link_to maketext('Student ID') => '#', class => 'sort-header', + data => { sort_field => 'student_id' } =%> + + + <%= link_to maketext('Status') => '#', class => 'sort-header', + data => { sort_field => 'status' } =%> + + + <%= link_to maketext('Section') => '#', class => 'sort-header', + data => { sort_field => 'section' } =%> + + + <%= link_to maketext('Recitation') => '#', class => 'sort-header', + data => { sort_field => 'recitation' } =%> + + + <%= link_to maketext('Comment') => '#', class => 'sort-header', + data => { sort_field => 'comment' } =%> + + + <%= link_to maketext('Permission Level') => '#', class => 'sort-header', + data => { sort_field => 'permission' } =%> + + % end +% } else { + % content_for 'user-list-table-headings' => begin + % for my $field (@$fields) { + <%= $fieldProperties->{$field}{name} %> + % } + % end +% } +% +
      + + + + + <%= content 'user-list-table-headings' =%> + + + + % my %selectedUserIDs = map { $_ => 1 } @{ $cg->{selectedUserIDs} }; + % for (@{ $cg->{visibleUsers} }) { + <%= include 'ContentGenerator/Instructor/UserList/user_row', + user => $_, userSelected => exists $selectedUserIDs{ $_->user_id } =%> + % } + +
      <%= maketext('Users List') %>
      +
      +% +% # If there are no users shown print message. +% unless (@{ $cg->{visibleUsers} }) { +

      + + <%= maketext('No students shown. Choose one of the options above to list the students in the course.') =%> + +

      +% } diff --git a/templates/ContentGenerator/Instructor/UserList/user_list_field.html.ep b/templates/ContentGenerator/Instructor/UserList/user_list_field.html.ep new file mode 100644 index 0000000000..cb8a320da6 --- /dev/null +++ b/templates/ContentGenerator/Instructor/UserList/user_list_field.html.ep @@ -0,0 +1,56 @@ +% my $fieldName = 'user.' . $user->user_id . '.' . $field; +% my $properties = $fieldProperties->{$field}; +% +% if ($properties->{type} eq 'text') { + % my $value = $user->$field; + % if ($cg->{editMode}) { + <%= text_field $fieldName => $value, id => $fieldName . '_id', size => $properties->{size}, + class => 'form-control form-control-sm d-inline w-auto', + 'aria-labelledby' => ($fieldName =~ s/^.*\.([^.]*)$/$1/r) . '_header' =%> + % } else { + % if (!$cg->{passwordMode} && $field eq 'email_address') { + % if ($value =~ /\S/) { + <%= link_to maketext('Email') => "mailto:$value" =%> + % } + % } else { + <%= $value =%> + % } + % } +% } elsif ($properties->{type} eq 'status') { + % my $value = $user->$field; + % my $status_name = $ce->status_abbrev_to_name($value); + % if ($cg->{editMode}) { + % if (defined $status_name) { + % $value = ($ce->status_name_to_abbrevs($status_name))[0]; + % } + <%= select_field $fieldName => [ + map { [ + maketext($_) => $ce->{statuses}{$_}{abbrevs}[0], + $ce->{statuses}{$_}{abbrevs}[0] eq $value ? (selected => undef) : () + ] } keys %{ $ce->{statuses} } + ], + id => $fieldName . '_id', class => 'form-select form-select-sm w-auto flex-grow-0', + aria_labelledby => ($fieldName =~ s/^.*\.([^.]*)$/$1/r) . '_header' =%> + % } else { + <%= $status_name ? maketext($status_name) : $value =%> + % } +% } elsif ($properties->{type} eq 'permission') { + % # Use the permission that was saved in the user record in pre_header_initialize. + % my $value = $user->{permission}; + % if ($cg->{editMode}) { + % my @values; + % for my $role (sort { $ce->{userRoles}{$a} <=> $ce->{userRoles}{$b} } keys %{ $ce->{userRoles} }) { + % next unless $ce->{userRoles}{$role} <= $db->getPermissionLevel(param('user'))->permission; + % push(@values, [ + % maketext($role) => $ce->{userRoles}{$role}, + % $value eq $ce->{userRoles}{$role} ? (selected => undef) : () + % ]); + % } + % + <%= select_field $fieldName => \@values, + id => $fieldName . '_id', class => 'form-select form-select-sm w-auto flex-grow-0', + aria_labelledby => ($fieldName =~ s/^.*\.([^.]*)$/$1/r) . '_header' =%> + % } else { + <%= maketext((grep { $ce->{userRoles}{$_} eq $value } keys %{ $ce->{userRoles} })[0]) %> + % } +% } diff --git a/templates/ContentGenerator/Instructor/UserList/user_row.html.ep b/templates/ContentGenerator/Instructor/UserList/user_row.html.ep new file mode 100644 index 0000000000..cb49bb209c --- /dev/null +++ b/templates/ContentGenerator/Instructor/UserList/user_row.html.ep @@ -0,0 +1,100 @@ +% my $courseName = $urlpath->arg('courseID'); +% +% my $statusClass = $ce->status_abbrev_to_name($user->status); +% + + % unless ($cg->{editMode} || $cg->{passwordMode}) { + % # Select checkboxes + + <%= check_box selected_users => $user->user_id, id => $user->user_id . '_checkbox', + class => 'form-check-input', $userSelected ? (checked => undef) : () =%> + + % # User id + +
      + % # Make the user id the label for the select user checkbox. + <%= label_for $user->user_id . '_checkbox', begin =%> + % if (!$authz->hasPermissions(param('user'), 'become_student')) { + <%= $user->user_id =%> + % } else { + <%= link_to $user->user_id => $cg->systemLink( + $urlpath->new(type => 'set_list', args => { courseID => $courseName }), + params => { effectiveUser => $user->user_id } + ) =%> + % } + <% end =%> + <%= link_to $cg->systemLink( + $urlpath->new(type => 'instructor_user_list', args => { courseID => $courseName }), + params => { editMode => 1, visible_users => $user->user_id } + ), begin =%> + + % end +
      + + % # Login Status + + % if ( + % $db->existsKeyWhere({ + % user_id => $user->user_id, + % timestamp => { '>=' => time - $ce->{sessionKeyTimeout} } + % }) + % ) + % { + <%= maketext('Active') %> + % } else { + <%= maketext('Inactive') %> + % } + + % } + % + % if ($cg->{passwordMode}) { + % # New password field + + % if ($user->user_id eq param('user')) { + % # Don't allow a professor to change their own password from this form. +
      + <%= maketext('You may not change your own password here!') =%> +
      + % } else { + % my $fieldName = 'user.' . $user->user_id . '.new_password'; + % param($fieldName, undef); + <%= text_field $fieldName => '', id => "${fieldName}_id", 'aria-labelledby' => 'new_password_header', + size => 14, class => 'form-control form-control-sm d-inline w-auto' =%> + % } + + % # User ID +
      <%= $user->user_id %>
      + % } elsif ($cg->{editMode}) { + % # User ID ("edit sets assigned to user" link) + + <%= link_to $user->user_id => $cg->systemLink($urlpath->new( + type => 'instructor_user_detail', + args => { courseID => $courseName, userID => $user->user_id } + )) =%> + + % } else { + % # User ID ("edit sets assigned to user" link) + + % my $sets = $db->countUserSets($user->user_id); + % if (!$authz->hasPermissions(param('user'), 'assign_problem_sets')) { + <%= $sets =%>/<%= $cg->{totalSets} =%> + % } else { + <%= link_to "$sets/$cg->{totalSets}" => $cg->systemLink($urlpath->new( + type => 'instructor_user_detail', + args => { courseID => $courseName, userID => $user->user_id } + )) =%> + % } + + % } + % # User Fields + % for my $field ($user->NONKEYFIELDS, 'permission') { + % next unless defined $fieldProperties->{$field}; + +
      + <%= include 'ContentGenerator/Instructor/UserList/user_list_field', user => $user, field => $field =%> +
      + + % } + diff --git a/templates/ContentGenerator/Instructor/UsersAssignedToSet.html.ep b/templates/ContentGenerator/Instructor/UsersAssignedToSet.html.ep new file mode 100644 index 0000000000..a47744c8db --- /dev/null +++ b/templates/ContentGenerator/Instructor/UsersAssignedToSet.html.ep @@ -0,0 +1,113 @@ +% use WeBWorK::Utils qw(format_set_name_display); +% +% unless ($authz->hasPermissions(param('user'), 'access_instructor_tools')) { +
      <%= maketext('You are not authorized to access instructor tools.') %>
      + % last; +% } +% +% unless ($authz->hasPermissions(param('user'), 'assign_problem_sets')) { +
      <%= maketext('You are not authorized to assign homework sets.') %>
      + % last; +% } +% +% my $setID = $urlpath->arg('setID'); +% +<%= form_for $cg->systemLink($urlpath, authen => 0), method => 'post', begin =%> +
      + <%= submit_button maketext('Assign to All Current Users'), name => 'assignToAll', + class => 'btn btn-primary' =%> + <%= maketext('This action can take a long time if there are many students.') %> +
      +
      +

      <%= maketext('Do not uncheck students, unless you know what you are doing.') %>

      +

      <%= maketext('There is NO undo for unassigning students.') %>

      +
      +
      + <%== maketext( + "When you unassign by unchecking a student's name, you destroy all of the data for homework set [_1] " + . 'for this student. You will then need to reassign the set to these students and they will receive ' + . 'new versions of the problems. Make sure this is what you want to do before unchecking students.', + tag('b', dir => 'ltr', format_set_name_display($setID)) + ) =%> +
      +
      + + + + + + + + + + + + + % for my $user (@{ $cg->{user_records} }) { + % my $userID = $user->user_id; + % my $userSet = $db->getUserSet($userID, $setID); + % + + + + + + % if (defined $userSet) { + + + % } else { + + + % } + + % } + +
      <%= maketext('Assigned') %><%= maketext('Login Name') %><%= maketext('Student Name') %><%= maketext('Section') %><%= maketext('Close Date') %><%= maketext('Edit Data') %>
      + > + +
      + <%= label_for "selected_$userID" => $userID =%> +
      +       		+ <%= $user->last_name . ', ' . $user->first_name =%> + <%= $user->section %> + <%= $cg->formatDateTime($userSet->due_date, '', + 'datetime_format_short', $ce->{language}) =%> + + <%= link_to maketext('Edit data for [_1]', $userID) => $cg->systemLink( + $urlpath->new( + type => param('pageVersion') || 'instructor_set_detail', + args => { courseID => $urlpath->arg('courseID'), setID => $setID } + ), + params => { editForUser => $userID } + ) =%> +
      +
      + <%= $cg->hidden_authen_fields =%> + <%= submit_button maketext('Save'), name => 'assignToSelected', class => 'btn btn-primary' =%> +
      +
      +
      + <%== maketext( + 'There is NO undo for this function. Do not use it unless you know what you are doing! ' + . 'When you unassign a student using this button, or by unchecking their name, you destroy all ' + . 'of the data for homework set [_1] for this student.', + tag('span', dir => 'ltr', format_set_name_display($setID)) + ) =%> +
      +
      + <%= submit_button maketext('Unassign from All Users'), name => 'unassignFromAll', + class => 'btn btn-primary' =%> + + +
      +
      +
      +<% end =%> diff --git a/templates/ContentGenerator/Login.html.ep b/templates/ContentGenerator/Login.html.ep new file mode 100644 index 0000000000..dbc8b6beff --- /dev/null +++ b/templates/ContentGenerator/Login.html.ep @@ -0,0 +1,77 @@ +% # WeBWorK::Authen::verify will set the note "authen_error" if invalid authentication is found. If this is done, +% # it's a signal to us to yell at the user for doing that, since Authen isn't a content-generating module. +% if (stash('authen_error')) { +
      <%= stash('authen_error') =%>
      +% } +% +% my $course = $urlpath->arg('courseID') =~ s/_/ /gr; +% +% if ($externalAuth) { + % my $LMS = $ce->{LMS_url} ? link_to($ce->{LMS_name} => $ce->{LMS_url}) : $ce->{LMS_name}; + % + % if (!stash('authen_error') || $authen eq 'WeBWorK::Authen::LTIBasic') { +

      + <%== maketext('The course [_1] uses an external authentication system ([_2]). ' + . 'Please return to that system to access this course.', + tag('strong', $course), $LMS) =%> +

      + % } else { +

      + <%== maketext('The course [_1] uses an external authentication system ([_2]). You\'ve authenticated ' + . 'through that system, but aren\'t allowed to log in to this course.', + tag('strong', $course), $LMS) =%> +

      + % } +% } else { +

      <%== maketext('Please enter your username and password for [_1] below:', tag('b', $course)) %>

      + % + % if ($ce->{session_management_via} ne 'session_cookie') { +

      + <%== maketext('If you check [_1] your login information will be remembered by the browser you are using, ' + . 'allowing you to visit WeBWorK pages without typing your user name and password (until your session ' + . 'expires). This feature is not safe for public workstations, untrusted machines, and machines ' + . 'over which you do not have direct control.', + tag('strong', maketext('Remember Me')) + ) =%> +

      + % } + % + <%= form_for $c->uri, method => 'POST', id => 'login_form', begin =%> + <%= $hidden_fields =%> + % +
      +
      + % # Prevent user from being filled in for practice users (they should use the "Guest Login" button). + % param('user', undef) if param('user') && param('user') =~ m/^$ce->{practiceUserPrefix}/; + % + <%= text_field user => '', id => 'uname', 'aria-required' => 'true', class => 'form-control', + placeholder => '', autocapitalize => 'none', spellcheck => 'false' =%> + <%= label_for uname => maketext('Username') =%> +
      +
      + <%= password_field 'passwd', id => 'pswd', 'aria-required' => 'true', class => 'form-control', + placeholder => '' =%> + <%= label_for pswd => maketext('Password') =%> +
      + % if ($ce->{session_management_via} ne 'session_cookie') { +
      + <%= check_box(send_cookie => 'on', id => 'rememberme', class => 'form-check-input') =%> + <%= label_for rememberme => maketext('Remember Me') =%> +
      + % } + <%= submit_button(maketext('Continue'), class => 'btn btn-primary') =%> +
      + % + % # Guest login + % if (@$allowedGuestUsers) { +
      +

      + <%== maketext('This course supports guest logins. Click [_1] to log into this course as a guest.', + tag('b', maketext('Guest Login'))) =%> +

      + <%= submit_button maketext('Guest Login'), + name => 'login_practice_user', class => 'btn btn-primary' =%> +
      + % } + <% end =%> +% } diff --git a/templates/ContentGenerator/LoginProctor.html.ep b/templates/ContentGenerator/LoginProctor.html.ep new file mode 100644 index 0000000000..1e439e1567 --- /dev/null +++ b/templates/ContentGenerator/LoginProctor.html.ep @@ -0,0 +1,96 @@ +% unless (defined $userSet) { +
      + <%= maketext('Proctor authorization requested for a nonexistent set.') =%> +
      + % last; +% } +% +
      <%= maketext('Proctor authorization required.') %>
      +% +% # WeBWorK::Authen::verifyProctor will set the "authen_error" stash value if authentication is not valid. +% # In that case, show the error. +% if (stash('authen_error')) { +
      <%= stash('authen_error') %>
      +% } +% +% # Print a message about submission times if we're submitting an answer. +% if (param('submitAnswers')) { + % my $dueTime = $userSet->due_date; + % my ($color, $msg) = ('#ddddff', ''); + % if ($dueTime + $ce->{gatewayGracePeriod} < $submitTime) { + % $color = '#ffffaa'; + % $msg = maketext('The time limit on this assignment was exceeded. The assignment may be checked, ' + % . 'but the result will not be counted.'); + % } + % +
      +
      +
      <%= maketext('Grading Assignment') %>
      +
      + <%= maketext('Submission time:') %> <%= scalar(localtime($submitTime)) %> +
      +
      + <%= maketext('Closes:') %> <%= scalar(localtime($dueTime)) %> +
      + % if ($msg) { +
      <%= $msg %>
      + % } +
      +
      +% } +% +%= form_for $c->uri, method => 'POST', begin + % # Add the form data posted to the requested URI in hidden fields. + % my @fields_to_print = + % grep { !/^(user|effectiveUser|passwd|key|force_password_authen|proctor_user|proctor_key|proctor_password)$/ } + % param; + % if (@fields_to_print) { + <%= $cg->hidden_fields(@fields_to_print) %> + % } + <%= $cg->hidden_authen_fields =%> + % + <%= hidden_field past_proctor_user => param('past_proctor_user') || param('proctor_user') =%> + <%= hidden_field past_proctor_key => param('past_proctor_key') || param('proctor_key') =%> + % + % if (param('submitAnswers') + % || ($userSet->restricted_login_proctor eq '' || $userSet->restricted_login_proctor eq 'No')) + % { + % # The user info and username field for the proctor. +
      +
      <%= maketext(q{User's username is:}) %> <%= param('effectiveUser') // '' %>
      +
      + <%= maketext(q{User's name is:}) %> + <%= $cg->{effectiveUser}->first_name %> <%= $cg->{effectiveUser}->last_name %> +
      +
      +
      + % # Prevent the proctor_user field from being filled with the parameter value. + % param('proctor_user', undef); + <%= text_field proctor_user => '', id => 'proctor_user', class => 'form-control', placeholder => '', + autocapitalize => 'none', spellcheck => 'false', autocomplete => 'new-password' =%> + <%= label_for proctor_user => maketext('Proctor Username') =%> +
      + % } else { + % # Restricted set login +
      + + <%= maketext( + 'This set has a set-level proctor password to authorize logins. Enter the password below.') =%> + +
      + <%= hidden_field proctor_user => "set_id:$setID" =%> + % } + % + % # The password field for the proctor. +
      + <%= password_field 'proctor_passwd', + id => 'proctor_passwd', + class => 'form-control', + placeholder => '', + autocomplete => 'new-password' + =%> + <%= label_for proctor_passwd => maketext('Proctor Password') =%> +
      + % + <%= submit_button maketext('Continue'), class => 'btn btn-primary' =%> +% end diff --git a/templates/ContentGenerator/Logout.html.ep b/templates/ContentGenerator/Logout.html.ep new file mode 100644 index 0000000000..dd70ee82d6 --- /dev/null +++ b/templates/ContentGenerator/Logout.html.ep @@ -0,0 +1,26 @@ +% my $courseID = $urlpath->arg('courseID'); +% +

      <%= maketext('You have been logged out of WeBWorK.') =%>

      +% +% # The following check may not work when a sequence of authentication modules are used, because the preferred module +% # might be external, e.g., LTIBasic, but a non-external one, e.g., Basic_TheLastChance or even just WeBWorK::Authen, +% # might handle the ongoing session management. So this should be set in the course environment when a sequence of +% # authentication modules is used. +% if ($ce->{external_auth} || $authen->{external_auth}) { +

      + <%== maketext( + 'The course [_1] uses an external authentication system ([_2]). Please go there to log in again.', + tag('strong', $courseID), + $ce->{LMS_url} ? link_to(tag('strong', $ce->{LMS_name}) => $ce->{LMS_url}) : $ce->{LMS_name} + ) =%> +

      +% } else { + <%= form_for + $c->location + . $urlpath->newFromModule('WeBWorK::ContentGenerator::ProblemSets', $c, courseID => $courseID)->path, + method => 'POST', + begin =%> + <%= hidden_field force_passwd_authen => 1 =%> +

      <%= submit_button maketext('Log In Again'), name => 'submit', class => 'btn btn-primary' =%>

      + <% end =%> +% } diff --git a/templates/ContentGenerator/Options.html.ep b/templates/ContentGenerator/Options.html.ep new file mode 100644 index 0000000000..b123bd9e4c --- /dev/null +++ b/templates/ContentGenerator/Options.html.ep @@ -0,0 +1,192 @@ +% unless (defined $cg->{user}) { +
      <%= maketext('User "[_1]" not found.', param('user')) %>
      + % last; +% } +% +% unless (defined $cg->{effectiveUser}) { +
      <%= maketext('User "[_1]" not found.', param('effectiveUser')) %>
      + % last; +% } +% +% my $userID = $cg->{user}->user_id; +% my $e_user_name = $cg->{effectiveUser}->first_name . ' ' . $cg->{effectiveUser}->last_name; +% +%= form_for $c->uri, method => 'POST', begin + <%= $cg->hidden_authen_fields =%> + % + % if ($authz->hasPermissions($userID, 'change_password')) { +

      <%= maketext('Change Password') %>

      +
      +
      +
      + <%= label_for 'currPassword', class => 'col-form-label col-sm-6', begin =%> + <%= maketext( + q{[_1]'s Current Password}, + $cg->{user}->first_name . ' ' . $cg->{user}->last_name + ) =%> + <% end =%> +
      + <%= password_field 'currPassword', id => 'currPassword', class => 'form-control', dir => 'ltr', + $cg->{has_password} ? () : (disabled => 1) =%> +
      +
      +
      + <%= label_for newPassword => maketext("[_1]'s New Password", $e_user_name), + class => 'col-form-label col-sm-6' =%> +
      + <%= password_field 'newPassword', id => 'newPassword', class => 'form-control', dir => 'ltr' =%> +
      +
      +
      + <%= label_for confirmPassword => maketext("Confirm [_1]'s New Password", $e_user_name), + class => 'col-form-label col-sm-6' =%> +
      + <%= password_field 'confirmPassword', id => 'confirmPassword', + class => 'form-control', dir => 'ltr' =%> +
      +
      +
      +
      + % } + % + % if ($authz->hasPermissions($userID, 'change_email_address')) { +

      <%= maketext('Change Email Address') %>

      +
      +
      +
      + <%= label_for currAddress => maketext("[_1]'s Current Address", $e_user_name), + class => 'col-form-label col-sm-6' =%> +
      + <%= text_field currAddress => $cg->{effectiveUser}->email_address, + readonly => undef, id => 'currAddress', class => 'form-control', dir => 'ltr' =%> +
      +
      +
      + <%= label_for newAddress => maketext("[_1]'s New Address", $e_user_name), + class => 'col-form-label col-sm-6' =%> +
      + <%= text_field newAddress => '', id => 'newAddress', class => 'form-control', dir => 'ltr' =%> +
      +
      +
      +
      + % } + % + % if ($authz->hasPermissions($userID, 'change_pg_display_settings')) { +

      <%= maketext('Change Display Settings') %>

      + % + % my $display_settings_block = begin + % my $curr_displayMode = $cg->{effectiveUser}->displayMode || $ce->{pg}{options}{displayMode}; + % my %display_modes = %{ WeBWorK::PG::DISPLAY_MODES() }; + % my @active_modes = grep { exists $display_modes{$_} } @{ $ce->{pg}{displayModes} }; + % + % if (@active_modes > 1) { +
      +
      + <%= maketext('View equations as') . ':' =%> + % for (@active_modes) { +
      + <%= radio_button displayMode => $_, id => "displayMode-$_", class => 'form-check-input', + $_ eq $curr_displayMode ? (checked => undef) : () =%> + <%= label_for "displayMode-$_" => $_, class => 'form-check-label' =%> +
      + % } +
      +
      + %} + % + % if ($authz->hasPermissions($userID, 'can_show_old_answers')) { + % my $curr_showOldAnswers = + % $cg->{effectiveUser}->showOldAnswers ne '' + % ? $cg->{effectiveUser}->showOldAnswers + % : $ce->{pg}{options}{showOldAnswers}; +
      +
      + <%= maketext('Show saved answers?') =%> + % for (1, 0) { +
      + <%= radio_button showOldAnswers => $_, + id => "showOldAnswers$_", class => 'form-check-input', + $_ eq $curr_showOldAnswers ? (checked => undef) : () =%> + <%= label_for "showOldAnswers$_" => $_ ? maketext('Yes') : maketext('No'), + class => 'form-check-label' =%> +
      + % } +
      +
      + % } + % + % if ($ce->{pg}{specialPGEnvironmentVars}{entryAssist} eq 'MathView') { + % # Note, 0 is a legal value, so we can't use || in setting this + % my $curr_useMathView = + % $cg->{effectiveUser}->useMathView ne '' + % ? $cg->{effectiveUser}->useMathView + % : $ce->{pg}{options}{useMathView}; +
      +
      + <%= maketext('Use Equation Editor?') %>
      + % for (1, 0) { +
      + <%= radio_button useMathView => $_, + id => "useMathView$_", class => 'form-check-input', + $_ eq $curr_useMathView ? (checked => undef) : () =%> + <%= label_for "useMathView$_" => $_ ? maketext('Yes') : maketext('No'), + class => 'form-check-label' =%> +
      + % } + +
      + % } + % + % if ($ce->{pg}{specialPGEnvironmentVars}{entryAssist} eq 'WIRIS') { + % # Note, 0 is a legal value, so we can't use || in setting this + % my $curr_useWirisEditor = + % $cg->{effectiveUser}->useWirisEditor ne '' + % ? $cg->{effectiveUser}->useWirisEditor + % : $ce->{pg}{options}{useWirisEditor}; +
      +
      + <%= maketext('Use Equation Editor?') %> + % for (1, 0) { +
      + <%= radio_button useWirisEditor => $_, + id => "useWirisEditor$_", class => 'form-check-input', + $_ eq $curr_useWirisEditor ? (checked => undef) : () =%> + <%= label_for "useWirisEditor$_" => $_ ? maketext('Yes') : maketext('No'), + class => 'form-check-label' =%> +
      + % } +
      +
      + % } + % + % if ($ce->{pg}{specialPGEnvironmentVars}{entryAssist} eq 'MathQuill') { + % # Note, 0 is a legal value, so we can't use || in setting this + % my $curr_useMathQuill = + % $cg->{effectiveUser}->useMathQuill ne '' + % ? $cg->{effectiveUser}->useMathQuill + % : $ce->{pg}{options}{useMathQuill}; +
      +
      + <%= maketext('Use live equation rendering?') %> + % for (1, 0) { +
      + <%= radio_button useMathQuill => $_, + id => "useMathQuill$_", class => 'form-check-input', + $_ eq $curr_useMathQuill ? (checked => undef) : () =%> + <%= label_for "useMathQuill$_" => $_ ? maketext('Yes') : maketext('No'), + class => 'form-check-label' =%> +
      + % } +
      +
      + % } + % end + % my $result = $display_settings_block->(); + % if ($result) { +
      <%= $result =%>
      + % } + % } + % + <%= submit_button maketext('Change User Settings'), name => 'changeOptions', class => 'btn btn-primary' =%> +% end diff --git a/templates/ContentGenerator/Problem.html.ep b/templates/ContentGenerator/Problem.html.ep new file mode 100644 index 0000000000..d4b8cdf6ae --- /dev/null +++ b/templates/ContentGenerator/Problem.html.ep @@ -0,0 +1,100 @@ +% use WeBWorK::Utils qw(getAssetURL); +% +% content_for css => begin + % # Output css for jquery-ui for problems to use. + <%= stylesheet getAssetURL($ce, 'node_modules/jquery-ui-dist/jquery-ui.min.css') =%> + % + <%= stylesheet $cg->url({ type => 'webwork', name => 'theme', file => 'achievements.css' }) =%> + % + % # Add CSS files requested by problems via ADD_CSS_FILE() in the PG file + % # or via a setting of $ce->{pg}{specialPGEnvironmentVars}{extra_css_files} + % # which can be set in course.conf (the value should be an anonomous array). + % my @cssFiles; + % if (ref($ce->{pg}{specialPGEnvironmentVars}{extra_css_files}) eq 'ARRAY') { + % push(@cssFiles, { file => $_, external => 0 }) for @{ $ce->{pg}{specialPGEnvironmentVars}{extra_css_files} }; + % } + % if (ref($cg->{pg}{flags}{extra_css_files}) eq 'ARRAY') { + % push @cssFiles, @{ $cg->{pg}{flags}{extra_css_files} }; + % } + % my %cssFilesAdded; # Used to avoid duplicates + % for (@cssFiles) { + % next if $cssFilesAdded{ $_->{file} }; + % $cssFilesAdded{ $_->{file} } = 1; + % if ($_->{external}) { + <%= stylesheet $_->{file} =%> + % } else { + <%= stylesheet getAssetURL($ce, $_->{file}) =%> + % } + % } +% end +% +% content_for js => begin + % # Output javascript for jquery-ui for problems to use. + <%= javascript getAssetURL($ce, 'node_modules/jquery-ui-dist/jquery-ui.min.js') =%> + % + % # This is for tagging menus (if allowed) + % if ($authz->hasPermissions(param('user'), 'modify_tags')) { + <%= javascript getAssetURL($ce, 'js/apps/TagWidget/tagwidget.js'), id => 'tag-widget-script', defer => undef, + data => { taxo => "$ce->{webworkURLs}{htdocs}/DATA/tagging-taxonomy.json" } =%> + % } + % + % # This is for the problem grader + % if ($cg->{will}{showProblemGrader}) { + <%= javascript getAssetURL($ce, 'js/apps/ProblemGrader/problemgrader.js'), defer => undef =%> + %} + % + % # This is for any page specific js. Right now its just used for achievement popups + <%= javascript getAssetURL($ce, 'js/apps/Problem/problem.js'), defer => undef =%> + % + % # Add JS files requested by problems via ADD_JS_FILE() in the PG file. + % if (ref($cg->{pg}{flags}{extra_js_files}) eq 'ARRAY') { + % my %jsFiles; + % for (@{ $cg->{pg}{flags}{extra_js_files} }) { + % next if $jsFiles{ $_->{file} }; + % $jsFiles{ $_->{file} } = 1; + % my %attributes = ref($_->{attributes}) eq 'HASH' ? %{ $_->{attributes} } : (); + % if ($_->{external}) { + <%= javascript $_->{file}, %attributes =%> + % } else { + <%= javascript getAssetURL($ce, $_->{file}), %attributes =%> + % } + % } + % } +% end +% +<%== $cg->post_header_text =%> +
      <%= $cg->output_tag_info %>
      +
      <%= $cg->output_custom_edit_message %>
      +
      <%= $cg->output_summary %>
      +
      +
      <%= $cg->output_achievement_message %>
      +
      +
      <%= $cg->output_comments %>
      +
      <%= $cg->output_grader %>
      +
      +
      + <%= form_for $c->uri, method => 'POST', name => 'problemMainForm', + id => 'problemMainForm', class => 'problem-main-form', begin =%> + <%= $cg->hidden_authen_fields =%> + <%= hidden_field(startTime => param('startTime') || time) =%> + <% if ($cg->can('output_hidden_info')) { + <%= $cg->output_hidden_info =%> + % } +
      +
      output_problem_lang_and_dir %>> + <%= $cg->output_problem_body =%> +
      + <%= $cg->output_message =%> +
      +
      <%= $cg->output_checkboxes %>
      +
      <%= $cg->output_submit_buttons %>
      +
      <%= $cg->output_score_summary %>
      + <%= $cg->output_misc =%> + <% end =%> +
      +
      +
      + <%= $cg->output_past_answer_button =%> + <%= $cg->output_email_instructor =%> +
      diff --git a/templates/ContentGenerator/Problem/checkboxes.html.ep b/templates/ContentGenerator/Problem/checkboxes.html.ep new file mode 100644 index 0000000000..115e54f0a9 --- /dev/null +++ b/templates/ContentGenerator/Problem/checkboxes.html.ep @@ -0,0 +1,72 @@ +% my %can = %{ $cg->{can} }; +% my %will = %{ $cg->{will} }; +% +% if ($can{showCorrectAnswers} + % || $can{showProblemGrader} + % || $can{showAnsGroupInfo} + % || $can{showAnsHashInfo} + % || $can{showPGInfo} + % || $can{showResourceInfo}) +% { + <%= maketext('Show:') %> +% } +% +% if ($can{showCorrectAnswers}) { +
      + +
      +% } +% +% if ($can{showProblemGrader} && !$will{showMeAnother}) { +
      + +
      +% } +% +% if ($can{showAnsGroupInfo}) { +
      + +
      +% } +% +% if ($can{showResourceInfo}) { +
      + +
      +% } +% +% if ($can{showAnsHashInfo}) { +
      + +
      +% } +% +% if ($can{showPGInfo}) { +
      + +
      +% } diff --git a/templates/ContentGenerator/Problem/messages.html.ep b/templates/ContentGenerator/Problem/messages.html.ep new file mode 100644 index 0000000000..a6f99eef74 --- /dev/null +++ b/templates/ContentGenerator/Problem/messages.html.ep @@ -0,0 +1,50 @@ +% use WeBWorK::Utils qw(before after); +% +% if ($cg->{pg}{result}{msg}) { +

      <%= maketext('Note') %>: <%== $cg->{pg}{result}{msg} %>

      +% } +% +% if ($ce->{pg}{ansEvalDefaults}{enableReducedScoring} + % && $cg->{set}->enable_reduced_scoring + % && after($cg->{set}->reduced_scoring_date, $c->submitTime) + % && before($cg->{set}->due_date, $c->submitTime)) +% { +

      + <%= maketext('Note') %>: + + <%= maketext( + 'You are in the Reduced Scoring Period. All work counts for [_1]% of the original.', + $ce->{pg}{ansEvalDefaults}{reducedScoringValue} * 100 + ) =%> + +

      +% } +% +% if ($cg->{pg}{flags}{hintExists} && $authz->hasPermissions($cg->{userID}, 'always_show_hint')) { + % my $showHintsAfter = + % $cg->{set}->hide_hint ? -1 + % : $cg->{problem}->showHintsAfter > -2 ? $cg->{problem}->showHintsAfter + % : $ce->{pg}{options}{showHintsAfter}; +

      + <%= maketext('Note') %>: + + <%= maketext( + $showHintsAfter == -1 + ? 'The hint shown is an instructor preview and will not be shown to students.' + : 'The hint shown is an instructor preview and will be shown to students after ' + . "$showHintsAfter attempts." + ) =%> + +

      +% } +% +% if ($cg->{pg}{flags}{solutionExists} && $authz->hasPermissions($cg->{userID}, 'always_show_solution')) { +

      + <%= maketext('Note') %>: + + <%= maketext('The solution shown is an instructor preview and ' + . 'will only be shown to students after the due date.' + ) =%> + +

      +% } diff --git a/templates/ContentGenerator/Problem/siblings.html.ep b/templates/ContentGenerator/Problem/siblings.html.ep new file mode 100644 index 0000000000..45e92e3580 --- /dev/null +++ b/templates/ContentGenerator/Problem/siblings.html.ep @@ -0,0 +1,54 @@ +
      +

      <%= maketext('Problems') %>

      + % if ($num_of_problems > 0 && $ce->{pg}{options}{enableProgressBar}) { + % my $unattempted = $num_of_problems - $total_correct - $total_incorrect - $total_inprogress; + % my $progress_bar_correct_width = $total_correct * 100 / $num_of_problems; + % my $progress_bar_incorrect_width = $total_incorrect * 100 / $num_of_problems; + % my $progress_bar_inprogress_width = $total_inprogress * 100 / $num_of_problems; + % my $progress_bar_unattempted_width = $unattempted * 100 / $num_of_problems; + % +
      + % if ($total_correct > 0) { +
      + % # Perfect scores deserve some stars (★)! + % if ($total_correct == $num_of_problems) { + ★Perfect★ + % } +
      + % } + % if ($total_inprogress > 0) { +
      +
      + % } + % if ($total_incorrect > 0) { +
      +
      + % } + % if ($unattempted > 0) { +
      +
      + % } +
      + % } +
        + % for (@$items) { +
      • <%= $_ %>
        • + % } +
      +
      diff --git a/templates/ContentGenerator/Problem/student_nav.html.ep b/templates/ContentGenerator/Problem/student_nav.html.ep new file mode 100644 index 0000000000..b19f0ed367 --- /dev/null +++ b/templates/ContentGenerator/Problem/student_nav.html.ep @@ -0,0 +1,103 @@ +% # Cap the number of students shown to at most 200. +% my $numAfter = $#$userRecords - $currentUserIndex; +% my $numBefore = 200 - ($numAfter < 100 ? $numAfter : 100); +% my $minStudentIndex = $currentUserIndex < $numBefore ? 0 : $currentUserIndex - $numBefore; +% my $maxStudentIndex = $minStudentIndex + 200 < $#$userRecords ? $minStudentIndex + 200 : $#$userRecords; +% +
      +
      + % if ($prevUser) { + <%= link_to $cg->systemLink( + $problemPage, + params => { + effectiveUser => $prevUser->user_id, + showProblemGrader => $cg->{will}{showProblemGrader}, + $filter ? (studentNavFilter => $filter) : () + } + ), + data => { bs_toggle => 'tooltip', bs_placement => 'top' }, + title => $prevUser->{displayName}, + class => 'btn btn-primary student-nav-button', + begin =%> + + <% end =%> + % } else { + + % } +
      + <%= link_to $userRecords->[$currentUserIndex]{displayName} => '#', + id => 'studentSelector', class => 'btn btn-primary dropdown-toggle', role => 'button', + data => { bs_toggle => 'dropdown' }, 'aria-expanded' => 'false' =%> + +
      + % if ($nextUser) { + <%= link_to $cg->systemLink( + $problemPage, + params => { + effectiveUser => $nextUser->user_id, + showProblemGrader => $cg->{will}{showProblemGrader}, + $filter ? (studentNavFilter => $filter) : () + } + ), + data => { bs_toggle => 'tooltip', bs_placement => 'top' }, + title => $nextUser->{displayName}, + class => 'btn btn-primary student-nav-button', + begin =%> + + <%= end %> + % } else { + + % } +
      + % # Create a section/recitation "filter by" dropdown if there are sections or recitations. + % if (keys %$filters) { +
      + <%= link_to $filter ? $filters->{$filter}[0] : maketext('Showing all students') => '#', + id => 'studentSelectorFilter', class => 'btn btn-primary dropdown-toggle', role => 'button', + data => { bs_toggle => 'dropdown' }, 'aria-expanded' => 'false' =%> + +
      + % } +
      diff --git a/templates/ContentGenerator/Problem/submit_buttons.html.ep b/templates/ContentGenerator/Problem/submit_buttons.html.ep new file mode 100644 index 0000000000..6d1ea23751 --- /dev/null +++ b/templates/ContentGenerator/Problem/submit_buttons.html.ep @@ -0,0 +1,81 @@ +% use WeBWorK::Utils qw(before); +% +% my $ce = $cg->r->ce; +% my %can = %{ $cg->{can} }; +% my %will = %{ $cg->{will} }; +% my $effectiveUser = param('effectiveUser'); +% +% if ($will{requestNewSeed}) { + <%= submit_button maketext('Request New Version'), id => 'submitAnswers_id', name => 'requestNewSeed', + formtarget => '_self', class => 'btn btn-primary' =%> +% } else { + <%= submit_button maketext('Preview My Answers'), id => 'previewAnswers_id', formtarget => '_self', + name => 'previewAnswers', class => 'btn btn-primary mb-1' =%> + % + % if ($can{checkAnswers}) { + <%= submit_button maketext('Check Answers'), id => 'checkAnswers_id', formtarget => '_self', + name => 'checkAnswers', class => 'btn btn-primary mb-1' =%> + % } + % + % if ($can{getSubmitButton}) { + % if (param('user') ne $effectiveUser) { + % # If acting as a student, make it clear that answer submissions will + % # apply to the student's records, not the instructor's. + <%= submit_button maketext('Submit Answers for [_1]', $effectiveUser), id => 'submitAnswers_id', + name => 'submitAnswers', class => 'btn btn-primary' =%> + % } else { + <%= submit_button maketext('Submit Answers'), id => 'submitAnswers_id', name => 'submitAnswers', + formtarget => '_self', class => 'btn btn-primary mb-1' =%> + % } + % } + % + % my %showMeAnother = %{ $cg->{showMeAnother} }; + % if ($can{showMeAnother}) { + % # only output showMeAnother button if we're not on the showMeAnother page + <%= link_to maketext('Show me another') => $cg->systemLink($urlpath->newFromModule( + 'WeBWorK::ContentGenerator::ShowMeAnother', + $c, + courseID => $urlpath->arg('courseID'), + setID => $cg->{problem}->set_id, + problemID => $cg->{problem}->problem_id + )), + class => 'set-id-tooltip btn btn-primary mb-1', + id => 'SMA_button', + target => 'WW_Show_Me_Another', + data => { + bs_toggle => 'tooltip', + bs_placement => 'right', + bs_title => maketext( + 'You can use this feature [quant,_1,more time,more times,as many times as you want] ' + . 'on this problem', + $showMeAnother{MaxReps} >= $showMeAnother{Count} + ? ($showMeAnother{MaxReps} - $showMeAnother{Count}) + : '' + ) + } =%> + % } else { + % # If showMeAnother is available for the course, and for the current problem (but not yet + % # because the student hasn't tried enough times) then gray it out. Otherwise display nothing. + % # If $showMeAnother{TriesNeeded} is somehow not an integer or is -2, use the default value. + % $showMeAnother{TriesNeeded} = $ce->{pg}{options}{showMeAnotherDefault} + % if ($showMeAnother{TriesNeeded} !~ /^[+-]?\d+$/ || $showMeAnother{TriesNeeded} == -2); + % if ($ce->{pg}{options}{enableShowMeAnother} && $showMeAnother{TriesNeeded} > -1) { + % my $exhausted = + % ($showMeAnother{Count} >= $showMeAnother{MaxReps} && $showMeAnother{MaxReps} > -1) ? 'exhausted' : ''; + + + + % } + % } +% } diff --git a/templates/ContentGenerator/ProblemSet.html.ep b/templates/ContentGenerator/ProblemSet.html.ep new file mode 100644 index 0000000000..d30d5548ff --- /dev/null +++ b/templates/ContentGenerator/ProblemSet.html.ep @@ -0,0 +1,64 @@ +% use WeBWorK::Utils qw(before between); +% +% if ($cg->{invalidSet}) { +
      +

      + <%= maketext( + 'The selected problem set ([_1]) is not a valid set for [_2].', $urlpath->arg('setID'), + param('effectiveUser') + ) =%> +

      +

      <%== $cg->{invalidSet} %>

      +
      + % last; +% } +% +% my $set = $cg->{set}; +% +% if ($ce->{pg}{ansEvalDefaults}{enableReducedScoring} + % && $set->enable_reduced_scoring + % && $set->reduced_scoring_date + % && $set->reduced_scoring_date != $set->due_date +% ) { + % my $reduced_scoring_date = $set->reduced_scoring_date; + % my $reducedScoringPerCent = int(100 * $ce->{pg}{ansEvalDefaults}{reducedScoringValue} + .5); + % + % if (before($reduced_scoring_date)) { +
      + <%= maketext( + 'After the reduced scoring period begins all work counts for [_1]% of its value.', + $reducedScoringPerCent + ) =%> +
      + % } elsif (between($reduced_scoring_date, $set->due_date)) { +
      + <%= maketext( + 'This set is in its reduced scoring period. All work counts for [_1]% of its value.', + $reducedScoringPerCent + ) =%> +
      + % } else { +
      + <%= maketext( + 'This set had a reduced scoring period that started on [_1] and ended on [_2]. ' + . 'During that period all work counted for [_3]% of its value.', + $cg->formatDateTime($reduced_scoring_date), $cg->formatDateTime($set->due_date), $reducedScoringPerCent + ) =%> +
      + % } +% } +% +<%= $set->assignment_type =~ /gateway/ ? $cg->gateway_body : $cg->problem_list =%> +% +
      + <%= $cg->feedbackMacro( + module => $urlpath->module, + set => $set->set_id, + problem => '', + displayMode => $cg->{displayMode}, + showOldAnswers => '', + showCorrectAnswers => '', + showHints => '', + showSolutions => '', + ) =%> +
      diff --git a/templates/ContentGenerator/ProblemSet/info.html.ep b/templates/ContentGenerator/ProblemSet/info.html.ep new file mode 100644 index 0000000000..3e9714e53d --- /dev/null +++ b/templates/ContentGenerator/ProblemSet/info.html.ep @@ -0,0 +1,25 @@ +% if (defined $cg->{set} && $authz->hasPermissions(param('user'), 'modify_problem_sets')) { +

      + <%= maketext('Set Info') =%> + <%= link_to maketext('Edit') => $cg->systemLink( + $urlpath->newFromModule( + 'WeBWorK::ContentGenerator::Instructor::PGProblemEditor', $c, + courseID => $urlpath->arg('courseID'), + setID => $cg->{set}->set_id, + problemID => 0 + ), + params => { file_type => 'set_header' } + ), + target => 'WW_Editor', class => 'btn btn-sm btn-info m-1' =%> +

      +% } else { +

      <%= maketext('Set Info') %>

      +% } +% +% if ($cg->{pg}{flags}{error_flag}) { +
      + <%= $cg->errorOutput($cg->{pg}{errors}, $cg->{pg}{body_text}) =%> +
      +% } else { + <%== $cg->{pg}{body_text} =%> +% } diff --git a/templates/ContentGenerator/ProblemSet/problem_list.html.ep b/templates/ContentGenerator/ProblemSet/problem_list.html.ep new file mode 100644 index 0000000000..8d5ce1bf63 --- /dev/null +++ b/templates/ContentGenerator/ProblemSet/problem_list.html.ep @@ -0,0 +1,60 @@ +% my $set = $cg->{set}; +% +% if (@$problems) { + % my $isJitarSet = $set->assignment_type eq 'jitar'; + % + % # This table contains a summary, a caption, and scope variables for the columns. +
      + + + + + + + + + + % if ($isJitarSet) { + + + % } + % if ($cg->{canScoreProblems}) { + + % } + + + + % for my $problem (@$problems) { + <%= include 'ContentGenerator/ProblemSet/problem_list_row', + problem => $problem, isJitarSet => $isJitarSet =%> + % } + +
      <%= maketext('Problems') %>
      <%= maketext('Name') %><%= maketext('Attempts') %><%= maketext('Remaining') %><%= maketext('Worth') %><%= maketext('Status') %> + <%= maketext('Adjusted Status') =%> +   + <%= link_to '#', class => 'help-popup', tabindex => 0, role => 'button', + data => { + bs_placement => 'top', + bs_toggle => 'popover', + bs_content => maketext( + q{The adjusted status of a problem is the larger of the problem's status and} + . 'the weighted average of the status of those problems which count ' + . 'towards the parent grade.' + ) + }, + begin =%> + + <% end =%> + <%= maketext('Counts for Parent') %><%= maketext('Grader') %>
      +
      +% } else { +

      <%= maketext('This homework set contains no problems.') %>

      +% } +% +
      + <%= link_to maketext('Download PDF or TeX Hardcopy for Current Set') => $cg->systemLink($urlpath->newFromModule( + 'WeBWorK::ContentGenerator::Hardcopy', $c, + courseID => $urlpath->arg('courseID'), + setID => $urlpath->arg('setID') + )), class => 'btn btn-primary' =%> +
      diff --git a/templates/ContentGenerator/ProblemSet/problem_list_row.html.ep b/templates/ContentGenerator/ProblemSet/problem_list_row.html.ep new file mode 100644 index 0000000000..4eb6831819 --- /dev/null +++ b/templates/ContentGenerator/ProblemSet/problem_list_row.html.ep @@ -0,0 +1,89 @@ +% use WeBWorK::Utils qw(is_jitar_problem_closed is_jitar_problem_hidden jitar_problem_adjusted_status +% jitar_id_to_seq wwRound); +% +% my $courseID = $urlpath->arg('courseID'); +% my $setID = $cg->{set}->set_id; +% my $problemID = $problem->problem_id; +% my $problemNumber = $problemID; +% my $problemLevel = 0; +% +% if ($isJitarSet + % && !$authz->hasPermissions($problem->user_id, 'view_unopened_sets') + % && is_jitar_problem_hidden($db, $problem->user_id, $setID, $problemID)) +% { + % # If the problem is closed, don't show it. +% } else { + % if ($isJitarSet) { + % my @seq = jitar_id_to_seq($problemID); + % $problemLevel = $#seq; + % $problemNumber = join('.', @seq); + % } + % + % my $attempts = $problem->num_correct + $problem->num_incorrect; + % my $linkClasses = $problemLevel != 0 ? "nested-problem-$problemLevel" : ''; + % + + % # Problem number + + % if ( + % $isJitarSet + % && !$authz->hasPermissions($problem->user_id, 'view_unopened_sets') + % && is_jitar_problem_closed($db, $ce, $problem->user_id, $setID, $problemID) + % ) + % { + % # If the problem is jitar restricted, then show it greyed out. + + <%= maketext('Problem [_1]', $problemNumber) %> + + % } else { + <%= link_to( + maketext('Problem [_1]', $problemNumber) => $cg->systemLink($urlpath->newFromModule( + 'WeBWorK::ContentGenerator::Problem', $c, + courseID => $courseID, + setID => $setID, + problemID => $problemID + )), + class => "$linkClasses text-nowrap" + ) =%> + % } + + % # Attempts + <%= $attempts %> + % # Remaining number of attempts + <%= ($problem->max_attempts || -1) < 0 ? maketext('unlimited') : $problem->max_attempts - $attempts %> + % # Problem value (Worth) + + % if (!$isJitarSet || $problemLevel == 0 || $problem->counts_parent_grade) { + <%= $problem->value %> + % } + + % # Status + <%= wwRound(0, $problem->status * 100) %>% + % # Jitar problem status and counts for parent columns. + % if ($isJitarSet) { + + % if ($problemLevel == 0) { + <%= wwRound(0, jitar_problem_adjusted_status($problem, $db) * 100) %>% + % } + + + <%= $isJitarSet && $problemLevel != 0 && $problem->counts_parent_grade + ? maketext('Yes') + : maketext('No') =%> + + % } + % # Grader + % if ($cg->{canScoreProblems}) { + + % if ($cg->{gradeableProblems}[$problemID]) { + <%= link_to( + maketext('Grade Problem') => $cg->systemLink($urlpath->new( + type => 'instructor_problem_grader', + args => { courseID => $courseID, setID => $setID, problemID => $problemID } + )) + ) =%> + % } + + % } + +% } diff --git a/templates/ContentGenerator/ProblemSet/siblings.html.ep b/templates/ContentGenerator/ProblemSet/siblings.html.ep new file mode 100644 index 0000000000..d1ea0cd138 --- /dev/null +++ b/templates/ContentGenerator/ProblemSet/siblings.html.ep @@ -0,0 +1,24 @@ +% use WeBWorK::Utils qw(format_set_name_display); +% +
      +

      <%= maketext('Sets') %>

      +
        + % for my $setID (@$setIDs) { +
      • + <%= tag 'a', + $setID eq $urlpath->arg('setID') + ? (class => 'nav-link active') + : ( + href => $cg->systemLink($urlpath->newFromModule( + $urlpath->module, $c, + courseID => $urlpath->arg('courseID'), + setID => $setID + )), + class => 'nav-link', + ), + id => $setID, + format_set_name_display($setID) =%> +
        • + % } +
      +
      diff --git a/templates/ContentGenerator/ProblemSet/version_list.html.ep b/templates/ContentGenerator/ProblemSet/version_list.html.ep new file mode 100644 index 0000000000..edaa75e8a1 --- /dev/null +++ b/templates/ContentGenerator/ProblemSet/version_list.html.ep @@ -0,0 +1,261 @@ +% use WeBWorK::Utils qw(is_restricted); +% +% my $courseID = $urlpath->arg('courseID'); +% my $set = $cg->{set}; +% my $user = param('user'); +% my $multiSet = $authz->hasPermissions($user, 'view_multiple_sets'); +% my $maxVersions = $set->versions_per_interval || 0; +% +% my $urlModule = + % $set->assignment_type =~ /proctored/ + % ? 'WeBWorK::ContentGenerator::ProctoredGatewayQuiz' + % : 'WeBWorK::ContentGenerator::GatewayQuiz'; +% +% if ($continueVersion) { + % # Display information about the current test and a continue open test button. + % if ($timeLimit > 0) { + % if ($timeNow >= $continueVersion->due_date) { + % # If the currently open test is in the grace period, display a mesage stating this. +
      + <%= maketext( + 'There is no time remaining on the currently open test. ' + . 'Click continue below and then click "Grade Test" within [_1] seconds ' + . 'to submit the test for a grade.', + $continueTimeLeft + ) =%> +
      + % } else { + % my $seconds = $continueTimeLeft; + % my $hours = int($seconds / 3600); + % $seconds %= 3600; + % my $minutes = int($seconds / 60); + % $seconds %= 60; + % my $timeText = ''; + % + % # Several cases are needed to format time to work well with translation. + % if ($hours && $minutes) { +
      + <%= maketext( + 'You have [quant,_1,hour] and [quant,_2,minute] remaining to complete the currently open test.', + $hours, + $minutes + ) =%> +
      + % } elsif ($hours || ($minutes && (!$seconds || $seconds > 299))) { + % # Translation Note: In this case only one of hours or minutes is non-zero, + % # so the zero case of the "quant" will be used for the other one. +
      + <%= maketext( + 'You have [quant,_1,hour,hours,][quant,_2,minute,minutes,] ' + . 'remaining to complete the currently open test.', + $hours, + $minutes + ) =%> +
      + % } else { + % if ($minutes) { +
      + <%= maketext( + 'You have [quant,_1,minute] and [quant,_2,second] ' + . 'remaining to complete the currently open test.', + $minutes, + $seconds + ) =%> +
      + % } else { +
      + <%= maketext( + 'You have [quant,_1,second] remaining to complete the currently open test.', + $seconds + ) =%> +
      + % } + % } + % } + % } + % + % if ($set->assignment_type =~ /proctor/) { +
      + <%= maketext('This test requires a proctor password to continue.') =%> +
      + % } + % +
      + <%= link_to maketext('Continue Open Test') => $cg->systemLink($urlpath->newFromModule( + $urlModule, $c, + courseID => $courseID, + setID => $set->set_id . ',v' . $continueVersion->version_id + )), + class => 'btn btn-primary' =%> +
      +% } elsif (($timeNow >= $set->open_date || $authz->hasPermissions($user, 'view_hidden_sets')) + % && $timeNow <= $set->due_date + % && !($ce->{options}{enableConditionalRelease} && is_restricted($db, $set, param('effectiveUser'))) + % && ($maxVersions <= 0 || $currentVersions < $maxVersions)) +% { + % # Display information about a new test and a start new test button. + % # Print time limit for timed tests + % if ($timeLimit > 0) { + % my $hours = int($timeLimit / 3600); + % my $minutes = int(($timeLimit % 3600) / 60); + % my $timeText = ''; + % + % # Two cases to format time to work well with translation. + % if ($hours && $minutes) { +
      + <%= maketext( + 'This is a timed test. You will have [quant,_1,hour] and [quant,_2,minute] to complete the test.', + $hours, + $minutes + ) =%> +
      + % } else { +
      + % # Translation Note: In this case only one of hours or minutes is non-zero, + % # so the zero case of the "quant" will be used for the other one. + <%= maketext( + 'This is a timed test. You will have [quant,_1,hour,hours,]' + . '[quant,_2,minute,minutes,] to complete the test.', + $hours, + $minutes + ) =%> +
      + % } + % } + % + % if ($set->assignment_type =~ /proctor/) { +
      <%= maketext('This test requires a proctor password to start.') %>
      + % } + % +
      + <%= link_to maketext('Start New Test') => $cg->systemLink($urlpath->newFromModule( + $urlModule, $c, + courseID => $courseID, + setID => $set->set_id + )), + class => 'btn btn-primary' =%> +
      +% } else { + % # Message about if/when next version will be available. + % my $msg = maketext('No more tests available.'); + % + % # Can they open a test in the future? + % if ($timeInterval > 0) { + % my $nextTime = ($currentVersions == $maxVersions) ? $lastTime + $timeInterval : $timeNow + $timeInterval; + % if ($nextTime < $set->due_date) { + % $msg = maketext('Next test will be available by [_1].', + % $cg->formatDateTime($nextTime, 0, $ce->{studentDateDisplayFormat})); + % } + % } + % + % # Is it past due date? + % if ($timeNow >= $set->due_date) { + % $msg = maketext('This test is closed.'); + % } + % +
      <%= $msg %>
      +% } +% +% if (@$setVersions) { + <% my $version_list = begin =%> +
      + + + + + + + + + + + + + + % for my $ver (@$versionData) { + % my $interactive = maketext('Version [_1]', $ver->{version}); + % if ($authz->hasPermissions($user, 'view_hidden_work') || $ver->{show_link}) { + <% $interactive = link_to $interactive => $cg->systemLink($urlpath->newFromModule( + $ver->{proctored} + ? 'WeBWorK::ContentGenerator::ProctoredGatewayQuiz' + : 'WeBWorK::ContentGenerator::GatewayQuiz', + $c, + courseID => $courseID, + setID => $ver->{id} + )), + class => 'set-id-tooltip text-nowrap', + data => { + bs_toggle => 'tooltip', + bs_placement => 'right', + bs_title => $set->description + } =%> + % } + % + % # Download hardcopy. + % my $control = ''; + % if ($multiSet) { + <% $control = check_box selected_sets => $ver->{id}, + id => $ver->{id}, class => 'form-check-input'; =%> + % # Make interactive the label for the control. + % $interactive = label_for $ver->{id} => $interactive; + % } elsif ($ver->{show_download}) { + % # Only display download option if answers are available. + <% $control = link_to $cg->systemLink( + $urlpath->newFromModule( + 'WeBWorK::ContentGenerator::Hardcopy', $c, + courseID => $courseID, + setID => $ver->{id} + ), + params => { selected_sets => $ver->{id} } + ), + class => 'hardcopy-link', + begin =%> + + <% end =%> + % } + % + + + + + + + + + % } + +
      <%= maketext('Test Versions') %>
      <%= maketext('Versions') %><%= maketext('Status') %><%= maketext('Score') %><%= maketext('Start') %><%= maketext('End') %> + +
      <%= $interactive %><%= $ver->{status} %><%= $ver->{score} %><%= $ver->{start} %><%= $ver->{end} %><%= $control %>
      +
      + <% end =%> + % + % if ($multiSet) { + % # Show form for generating hardcopies of test versions. + <%= form_for $cg->systemLink( + $urlpath->newFromModule('WeBWorK::ContentGenerator::Hardcopy', $c, courseID => $courseID), + authen => 0 + ), + name => 'problem-sets-form', id => 'problem-sets-form', method => 'POST', + begin =%> + <%= $cg->hidden_authen_fields =%> + <%= $version_list->() =%> +
      + <%= input_tag reset => maketext('Deselect All Test Versions'), + id => 'clear', type => 'reset', class => 'btn btn-primary' =%> +
      +
      + <%= submit_button maketext('Download PDF or TeX Hardcopy for Selected Tests'), + id => 'hardcopy', name => 'hardcopy', class => 'btn btn-primary' =%> +
      + <% end =%> + % } else { + <%= $version_list->() =%> + % } +% } else { +

      <%= maketext('No versions of this test have been taken.') %>

      +% } diff --git a/templates/ContentGenerator/ProblemSets.html.ep b/templates/ContentGenerator/ProblemSets.html.ep new file mode 100644 index 0000000000..2a2f51abe9 --- /dev/null +++ b/templates/ContentGenerator/ProblemSets.html.ep @@ -0,0 +1,98 @@ +% # If navigation is restricted, then don't show the body and instead display a +% # message informing the user to access assignments via an LMS. +% unless ($authz->hasPermissions(param('user'), 'navigation_allowed')) { +
      + + <%= maketext('You must access assignments from your Course Management System ([_1]).', + $ce->{LMS_url} ? link_to($ce->{LMS_name} => $ce->{LMS_url}) : $ce->{LMS_name}) =%> + +
      + % last; +% } +% +% content_for set_table => begin + % # Create the set table. +
      + + + % + % # Setlist table headers + % my $sort = param('sort') || 'status'; + + + + + + + + % + + % my $sets = stash('sets') // []; + % + % # Regular sets and gateway template sets are merged, but sorted either by name or urgency. + % # Versions are not shown here. Instead they are on the ProblemSet page for the gateway quiz. + % for my $set (@$sets) { + % if ($set->visible || $authz->hasPermissions(param('user'), 'view_hidden_sets')) { + <%= $cg->setListRow($set) =%> + % } + % } + +
      <%= maketext('Homework Sets') %>
      + % if ($sort eq 'name') { + <%= maketext('Name') %> + % } else { + <%= link_to maketext('Name') => $cg->systemLink($urlpath, params => { sort => 'name' }) =%> + % } + + % if ($sort eq 'status') { + <%= maketext('Status') %> + % } else { + <%= link_to maketext('Status') => + $cg->systemLink($urlpath, params => { sort => 'status' }) =%> + % } + + +
      +
      +% end +% +% if ($authz->hasPermissions(param('user'), 'view_multiple_sets')) { + <%= form_for $cg->systemLink( + $urlpath->newFromModule( + 'WeBWorK::ContentGenerator::Hardcopy', + $c, courseID => $urlpath->arg('courseID') + ), + authen => 0 + ), + name => 'problem-sets-form', + id => 'problem-sets-form', + method => 'POST', + begin =%> + <%= $cg->hidden_authen_fields =%> + <%= content 'set_table' =%> +
      + <%= input_tag reset => maketext('Deselect All Sets'), + id => 'clear', type => 'reset', class => 'btn btn-info' =%> +
      +
      + <%= submit_button maketext('Generate Hardcopy for Selected Sets'), + id => 'hardcopy', name => 'hardcopy', class => 'btn btn-info' =%> +
      + <% end =%> +% } else { + <%= content 'set_table' =%> +% } +% +<%= $cg->feedbackMacro( + module => $urlpath->module, + set => '', + problem => '', + displayMode => '', + showOldAnswers => '', + showCorrectAnswers => '', + showHints => '', + showSolutions => '', +) =%> diff --git a/templates/ContentGenerator/ProblemSets/info.html.ep b/templates/ContentGenerator/ProblemSets/info.html.ep new file mode 100644 index 0000000000..59841acb02 --- /dev/null +++ b/templates/ContentGenerator/ProblemSets/info.html.ep @@ -0,0 +1,27 @@ +% last unless stash('course_info_contents') || stash('course_info_error'); +% +% if ($authz->hasPermissions(param('user'), 'access_instructor_tools')) { +

      + <%= maketext('Course Info') =%> + <%= link_to( + maketext('Edit') => $cg->systemLink( + $urlpath->newFromModule( + 'WeBWorK::ContentGenerator::Instructor::PGProblemEditor', $c, + courseID => $urlpath->arg('courseID') + ), + params => { file_type => 'course_info' } + ), + target => 'WW_Editor', + class => 'btn btn-sm btn-info m-1' + ) =%> +

      + % if (stash('course_info_error')) { +
      <%= stash('course_info_error') %>
      + % } +% } else { +

      <%= maketext('Course Info') %>

      +% } +% +% if (stash('course_info_contents')) { + <%== stash('course_info_contents') =%> +% } diff --git a/templates/ContentGenerator/ProctoredGatewayQuiz.html.ep b/templates/ContentGenerator/ProctoredGatewayQuiz.html.ep new file mode 100644 index 0000000000..90e9fe9321 --- /dev/null +++ b/templates/ContentGenerator/ProctoredGatewayQuiz.html.ep @@ -0,0 +1 @@ +%= include 'ContentGenerator/GatewayQuiz' diff --git a/templates/ContentGenerator/ShowMeAnother.html.ep b/templates/ContentGenerator/ShowMeAnother.html.ep new file mode 100644 index 0000000000..a06550e7d8 --- /dev/null +++ b/templates/ContentGenerator/ShowMeAnother.html.ep @@ -0,0 +1 @@ +%= include 'ContentGenerator/Problem' diff --git a/templates/ContentGenerator/ShowMeAnother/messages.html.ep b/templates/ContentGenerator/ShowMeAnother/messages.html.ep new file mode 100644 index 0000000000..0a8ccdd757 --- /dev/null +++ b/templates/ContentGenerator/ShowMeAnother/messages.html.ep @@ -0,0 +1,38 @@ +% use WeBWorK::Utils qw(before after); +% +% if ($cg->{pg}{result}{msg}) { +

      <%= maketext('Note') %>: <%= $cg->{pg}{result}{msg} %>

      +% } +% +% if ($cg->{pg}{flags}{hintExists} + % && $authz->hasPermissions($cg->{userName}, 'always_show_hint') + % && !$cg->{options}{showHints}) { + % my $showHintsAfter = + % $cg->{set}->hide_hint ? -1 + % : $cg->{problem}->showHintsAfter > -2 ? $cg->{problem}->showHintsAfter + % : $ce->{pg}{options}{showHintsAfter}; +

      + <%= maketext('Note') %>: + + <%= maketext( + $showHintsAfter == -1 + ? 'The hint shown is an instructor preview and will not be shown to students.' + : 'The hint shown is an instructor preview and will be shown to students after ' + . "$showHintsAfter attempts on the original problem." + ) =%> + +

      +% } +% +% if ($cg->{pg}{flags}{solutionExists} + % && $authz->hasPermissions($cg->{userName}, 'always_show_solution') + % && !$cg->{options}{showSolutions}) { +

      + <%= maketext('Note') %>: + + <%= maketext('The solution shown is an instructor preview and ' + . 'will only be shown to students after the due date.' + ) =%> + +

      +% } diff --git a/templates/HTML/CodeMirrorEditor/controls.html.ep b/templates/HTML/CodeMirrorEditor/controls.html.ep new file mode 100644 index 0000000000..c91a9996fc --- /dev/null +++ b/templates/HTML/CodeMirrorEditor/controls.html.ep @@ -0,0 +1,33 @@ +% # Output the html elements for setting the CodeMirror options. +
      +
      +
      + <%= label_for selectTheme => maketext('Theme:'), class => 'col-form-label col-auto' =%> +
      + <%= select_field selectTheme => $themeValues, + id => 'selectTheme', class => 'form-select form-select-sm d-inline w-auto' =%> +
      +
      +
      +
      +
      + <%= label_for selectKeymap => maketext('Key Map:'), class => 'col-form-label col-auto' =%> +
      + <%= select_field selectKeymap => $keymapValues, + id => 'selectKeymap', class => 'form-select form-select-sm d-inline w-auto' =%> +
      +
      +
      +
      +
      + <%= check_box 'enableSpell', id => 'enableSpell', class => 'form-check-input' =%> + <%= label_for enableSpell => maketext('Enable Spell Checking'), class => 'form-check-label' =%> +
      +
      +
      +
      + <%= check_box 'forceRTL', id => 'forceRTL', class => 'form-check-input' =%> + <%= label_for forceRTL => maketext('Force editor to RTL'), class => 'form-check-label' =%> +
      +
      +
      diff --git a/templates/HTML/CodeMirrorEditor/js.html.ep b/templates/HTML/CodeMirrorEditor/js.html.ep new file mode 100644 index 0000000000..d92ab0fa17 --- /dev/null +++ b/templates/HTML/CodeMirrorEditor/js.html.ep @@ -0,0 +1,28 @@ +% use WeBWorK::Utils qw(getAssetURL); +% +% if ($ce->{options}{PGCodeMirror}) { + % content_for css => begin + <%= stylesheet getAssetURL($ce, 'node_modules/codemirror/lib/codemirror.css') =%> + % + % for my $addon (@$codemirrorAddonsCSS) { + <%= stylesheet getAssetURL($ce, "node_modules/codemirror/addon/$addon") =%> + % } + <%= stylesheet getAssetURL($ce, 'js/apps/PGCodeMirror/pgeditor.css') =%> + % end + % + % content_for js => begin + <%= javascript getAssetURL($ce, 'node_modules/codemirror/lib/codemirror.js'), defer => undef =%> + % + % for my $addon (@$codemirrorAddonsJS) { + <%= javascript getAssetURL($ce, "node_modules/codemirror/addon/$addon"), defer => undef =%> + % } + % + <%= javascript getAssetURL($ce, 'js/apps/PGCodeMirror/PG.js'), defer => undef =%> + <%= javascript getAssetURL($ce, 'js/apps/PGCodeMirror/pgeditor.js'), defer => undef =%> + % end +% } +% +% # The textarea styles in this file are still needed if CodeMirror is disabled. +% content_for css => begin + <%= stylesheet getAssetURL($ce, 'js/apps/PGCodeMirror/pgeditor.css') =%> +% end diff --git a/templates/HTML/ScrollingRecordList/scrollingRecordList.html.ep b/templates/HTML/ScrollingRecordList/scrollingRecordList.html.ep new file mode 100644 index 0000000000..a59711892c --- /dev/null +++ b/templates/HTML/ScrollingRecordList/scrollingRecordList.html.ep @@ -0,0 +1,30 @@ +
      +
      + <%= label_for "$name!sort" => maketext('Sort:'), + class => 'col-form-label col-form-label-sm col-2 pe-1 text-nowrap' =%> +
      + <%= select_field "$name!sort" => $sorts, id => "$name!sort", class => 'form-select form-select-sm' =%> +
      +
      +
      + <%= label_for "$name!format" => maketext('Format:'), + class => 'col-form-label col-form-label-sm col-2 pe-1 text-nowrap' =%> +
      + <%= select_field "$name!format" => $formats, id => "$name!format", class => 'form-select form-select-sm' =%> +
      +
      +
      + <%= label_for "$name!filter" => maketext("Filter:"), + class => 'col-form-label col-form-label-sm col-2 pe-1 text-nowrap' =%> +
      + <%= select_field "$name!filter" => $filters, id => "$name!filter", class => 'form-select form-select-sm', + multiple => undef, size => 5 =%> +
      +
      +
      + <%= submit_button $options->{refresh_button_name} // maketext('Change Display Settings'), + name => "$name!refresh", class => 'btn btn-secondary btn-sm mb-2' =%> +
      + <%= select_field $name => $formattedRecords, id => $name, class => 'form-select form-select-sm', + %{ $options->{attrs} // {} } =%> +
      diff --git a/templates/HTML/SingleProblemGrader/grader.html.ep b/templates/HTML/SingleProblemGrader/grader.html.ep new file mode 100644 index 0000000000..bef6f4fc58 --- /dev/null +++ b/templates/HTML/SingleProblemGrader/grader.html.ep @@ -0,0 +1,142 @@ +% use WeBWorK::Utils 'wwRound'; +% +
      +
      +
      + % # Subscores for each answer in the problem. + % if (@{ $grader->{pg}{flags}{ANSWER_ENTRY_ORDER} } > 1) { + % # Determine the scores and weights for each part of the problem. + % my $total = 0; + % my (@scores, @weights); + % for my $ans_id (@{ $grader->{pg}{flags}{ANSWER_ENTRY_ORDER} }) { + % push(@scores, wwRound(0, $grader->{pg}{answers}{$ans_id}{score} * 100)); + % push(@weights, $grader->{pg}{answers}{$ans_id}{weight} // 1); + % $total += $weights[-1]; + % } + % + % # Normalize the weights + % @weights = map { $_ / $total } @weights; + % + % for my $part (0 .. $#scores) { +
      + <%= label_for "score_problem$grader->{problem_id}_$grader->{pg}{flags}{ANSWER_ENTRY_ORDER}[$part]", + class => 'col-fixed col-form-label', + begin =%> + <%= maketext('Answer [_1] Score (%):', $part + 1) =%> + <%= link_to '#', + class => 'help-popup', + data => { + bs_content => maketext( + 'The initial value is the answer sub score for the answer ' + . 'that is currently shown. If this is modified, it will be used to compute ' + . 'the total problem score below. This score is not saved, and will reset to ' + . 'the score for the shown answer if the page is reloaded.' + ), + bs_placement => 'top', + bs_toggle => 'popover' + }, + begin =%> + + <% end =%> + <% end =%> +
      + <%= number_field 'answer-part-score' => $scores[$part], + class => 'answer-part-score form-control form-control-sm d-inline', + id => + "score_problem$grader->{problem_id}_$grader->{pg}{flags}{ANSWER_ENTRY_ORDER}[$part]", + data => { + problem_id => $grader->{problem_id}, + answer_labels => + '["' . join('","', @{ $grader->{pg}{flags}{ANSWER_ENTRY_ORDER} }) . '"]', + weight => $weights[$part] + }, + min => 0, + max => 100, + autocomplete => 'off' =%> +   + <%== maketext('Weight: [_1]%', wwRound(2, $weights[$part] * 100)) =%> +
      +
      + % } + % } + + % # Total problem score +
      + <%= label_for "score_problem$grader->{problem_id}", + class => 'col-fixed col-form-label', + begin =%> + <%= maketext('Problem Score (%):') %> + <%= link_to '#', + class => 'help-popup', + data => { + bs_content => + maketext('The initial value is the currently saved score for this student.') + . ( + @{ $grader->{pg}{flags}{ANSWER_ENTRY_ORDER} } > 1 + ? ' ' + . maketext( + 'This is the only part of the score that is actually saved. ' + . 'This is computed from the answer sub scores above using the weights shown if they ' + . 'are modified. Alternatively, enter the score you want saved here ' + . '(the above sub scores will be ignored).' + ) + : '' + ), + bs_placement => 'top', + bs_toggle => 'popover' + }, + begin =%> + + Help Icon + <% end =%> + <% end =%> +
      + <%= number_field 'grader-problem-score' => wwRound(0, $grader->{recorded_score} * 100), + min => 0, + max => 100, + autocomplete => "off", + id => "score_problem$grader->{problem_id}", + class => "problem-score form-control form-control-sm d-inline", + data => { problem_id => $grader->{problem_id} } =%> +
      +
      + + % # Instructor comment + % if ($grader->{past_answer_id}) { +
      + <%= label_for "comment_problem$grader->{problem_id}" => maketext('Comment:'), + class => 'col-fixed col-form-label' =%> +
      + <%= text_area 'grader-instructor-comment' => $grader->{comment_string}, + id => "comment_problem$grader->{problem_id}", + class => 'grader-problem-comment form-control d-inline', + data => { problem_id => $grader->{problem_id} }, + rows => 3 =%> + +
      +
      + % } + + % # Save button +
      +
      + +
      +
      +
      {problem_id}" %>" class="problem-grader-message">
      +
      +
      +
      +
      +
      diff --git a/templates/RPCRenderFormats/default.html.ep b/templates/RPCRenderFormats/default.html.ep index 2c6717243a..3191fdb752 100644 --- a/templates/RPCRenderFormats/default.html.ep +++ b/templates/RPCRenderFormats/default.html.ep @@ -61,7 +61,7 @@ % } %== $LTIGradeMessage - + % %= hidden_field answersSubmitted => 1 %= hidden_field sourceFilePath => $sourceFilePath %= hidden_field problemSource => $problemSource @@ -90,7 +90,7 @@ % if ($formatName eq 'debug' && $ws->{inputs_ref}{clientDebug}) { %= hidden_field clientDebug => $ws->{inputs_ref}{clientDebug} % } - + %
      % # Submit buttons (all are shown by default) % if ($showPreviewButton ne '0') { diff --git a/templates/exception.html.ep b/templates/exception.html.ep new file mode 100644 index 0000000000..13fe17abb1 --- /dev/null +++ b/templates/exception.html.ep @@ -0,0 +1,19 @@ +% use Date::Format; +% use UUID::Tiny ':std'; +% +% my $uuid = create_uuid_as_string(UUID_SHA1, UUID_NS_URL, $c->req->url->path->to_string) + % . "::" . create_uuid_as_string(UUID_TIME); +% my $time = time2str('%a %b %d %H:%M:%S %Y', time); +% +% # Log the error to the Mojolicious error log +% if (config('JSON_ERROR_LOG')) { + % log->error($c->jsonMessage($uuid, $time)) if $c->can('jsonMessage'); +% } else { + % log->error($c->textMessage($uuid, $time)) if $c->can('textMessage'); +% } +% +% if (config('MIN_HTML_ERRORS')) { + <%= include 'exception_min', uuid => $uuid, time => $time, status => 500 =%> +% } else { + <%= include 'exception_default', uuid => $uuid, time => $time, status => 500 =%> +% } diff --git a/templates/exception_default.html.ep b/templates/exception_default.html.ep new file mode 100644 index 0000000000..46c063d6cb --- /dev/null +++ b/templates/exception_default.html.ep @@ -0,0 +1,120 @@ + + +% + + + + + WeBWorK error + +% + + +
      +

      WeBWorK error

      +

      An error occured while processing your request.

      +

      + For help, please send mail to this site's webmaster\ + % # $ENV{WEBWORK_SERVER_ADMIN} is set from $webwork_server_admin_email in site.conf. + <% if ($ENV{WEBWORK_SERVER_ADMIN}) { =%> + <%= link_to $ENV{WEBWORK_SERVER_ADMIN} => "mailto:$ENV{WEBWORK_SERVER_ADMIN}" %>\ + <% } =%>\ + , including all of the following information as well as what what you were doing when the error occured. +

      +

      Error record identifier

      +

      <%= $uuid =%>

      + % if (my $warnings = stash 'warnings') { +

      Warning messages

      +
        + % for (split m/\n+/, $warnings) { +
      • <%= $_ %>
        • + % } +
      + % } + % if (my $exception = stash 'exception') { +

      Error messages

      +

      <%= $exception->message =%>

      +

      Context

      +
        + % for (@{$exception->lines_before}) { + 
      • <%= $_->[0] %>: <%= $_->[1] %>
        • + % } + % if (defined $exception->line->[1]) { +
      • + 
        <% =%>\
+							<%= $exception->line->[0] %>: <%= $exception->line->[1] %><% =%>\
+
        +
        • + % } + % for (@{$exception->lines_after}) { + 
      • <%= $_->[0] %>: <%= $_->[1] %>
        • + % } +
      +

      Call stack

      +
        + % for (@{ $exception->frames }) { +
      • in <%= $_->[3] %> called at line <%= $_->[2] %> of <%= $_->[1] %>
        • + % # Stop when the backtrace gets back to the WeBWorK handler. + % # Everything after that is in the Mojolicious library code. + % last if $_->[0] eq 'Mojolicious::WeBWorK::Controller::Handler'; + % } +
      + % } +

      Request information

      +
      +

      The HTTP request information is included in the following table.

      +
      + + + + + + + + + + + + + + + + + + +
      HTTP request information
      ItemData
      Method<%= $c->req->method %>
      URI + <%= $c->req->url->to_abs->to_string %> +
      HTTP Headers + + + + + + + % my %headers = %{ $c->req->headers->to_hash }; + % if (defined($headers{'sec-ch-ua'})) { + % # Avoid warnings about the value of 'sec-ch-ua'. + % # (It is doubtful that this is needed anymore.) + % $headers{'sec-ch-ua'} = join('', $headers{'sec-ch-ua'}); + % $headers{'sec-ch-ua'} =~ s/\"//g; + % } + % for (keys %headers) { + + + + + % } +
      HTTP request headers
      KeyValue
      + <%= $_ %> + + <%= $headers{$_} %> +
      +
      +
      +
      +

      Time generated:

      +

      <%= $time %>

      +
      + +% + diff --git a/templates/exception_min.html.ep b/templates/exception_min.html.ep new file mode 100644 index 0000000000..eec4053658 --- /dev/null +++ b/templates/exception_min.html.ep @@ -0,0 +1,31 @@ + + +% + + + + + WeBWorK error + +% + + +
      +

      WeBWorK error

      +

      An error occured while processing your request.

      +

      + For help, please send mail to this site's webmaster\ + % # $ENV{WEBWORK_SERVER_ADMIN} is set from $webwork_server_admin_email in site.conf. + <% if ($ENV{WEBWORK_SERVER_ADMIN}) { =%> + <%= link_to $ENV{WEBWORK_SERVER_ADMIN} => "mailto:$ENV{WEBWORK_SERVER_ADMIN}" %>\ + <% } =%>\ + , including the following information as well as what what you were doing when the error occured. +

      +

      Error record identifier

      +

      <%= $uuid %>

      +

      Time generated:

      +

      <%= $time %>

      +
      + +% + From c5e544c57f0458723322494e4a2f90b44b46d9b9 Mon Sep 17 00:00:00 2001 From: Glenn Rice Date: Tue, 27 Dec 2022 08:30:22 -0600 Subject: [PATCH 084/490] Move WeBWorK::ContentGenerator::Instructor to WeBWorK::Utils::Instructor. It no longer derives from WeBWorK::ContentGenerator and instead exports its methods. --- lib/WeBWorK/Authen/LTIAdvanced.pm | 7 +- lib/WeBWorK/ContentGenerator/GatewayQuiz.pm | 3 +- lib/WeBWorK/ContentGenerator/Grades.pm | 3 +- .../Instructor/AchievementEditor.pm | 2 +- .../Instructor/AchievementList.pm | 5 +- .../Instructor/AchievementUserEditor.pm | 2 +- .../ContentGenerator/Instructor/AddUsers.pm | 5 +- .../ContentGenerator/Instructor/Assigner.pm | 8 +- .../ContentGenerator/Instructor/Config.pm | 2 +- .../Instructor/FileManager.pm | 2 +- .../ContentGenerator/Instructor/Index.pm | 2 +- .../Instructor/PGProblemEditor.pm | 44 ++-- .../Instructor/ProblemSetDetail.pm | 8 +- .../Instructor/ProblemSetList.pm | 12 +- .../ContentGenerator/Instructor/Scoring.pm | 2 +- .../Instructor/ScoringDownload.pm | 2 +- .../ContentGenerator/Instructor/SendMail.pm | 10 +- .../ContentGenerator/Instructor/SetMaker.pm | 10 +- .../Instructor/ShowAnswers.pm | 2 +- .../ContentGenerator/Instructor/Stats.pm | 2 +- .../Instructor/StudentProgress.pm | 2 +- .../ContentGenerator/Instructor/UserDetail.pm | 5 +- .../ContentGenerator/Instructor/UserList.pm | 2 +- .../Instructor/UsersAssignedToSet.pm | 7 +- lib/WeBWorK/HTML/CodeMirrorEditor.pm | 6 +- lib/WeBWorK/HTML/SingleProblemGrader.pm | 6 +- .../{ContentGenerator => Utils}/Instructor.pm | 196 ++++++------------ lib/WebworkSOAP.pm | 1 - .../ProblemSetList/import_form.html.ep | 4 +- .../SetMaker/browse_setdef_panel.html.ep | 4 +- .../Instructor/UserList/export_form.html.ep | 4 +- .../Instructor/UserList/import_form.html.ep | 4 +- 32 files changed, 162 insertions(+), 212 deletions(-) rename lib/WeBWorK/{ContentGenerator => Utils}/Instructor.pm (76%) diff --git a/lib/WeBWorK/Authen/LTIAdvanced.pm b/lib/WeBWorK/Authen/LTIAdvanced.pm index a1f5fce96e..327782a504 100644 --- a/lib/WeBWorK/Authen/LTIAdvanced.pm +++ b/lib/WeBWorK/Authen/LTIAdvanced.pm @@ -30,7 +30,7 @@ use WeBWorK::Debug; use DBI; use WeBWorK::Utils qw(formatDateTime); use WeBWorK::Localize; -use WeBWorK::ContentGenerator::Instructor; +use WeBWorK::Utils::Instructor qw(assignSetToUser); use URI::Escape; use Net::OAuth; @@ -657,8 +657,7 @@ sub create_user { $r->authz->{PermissionLevel} = $newPermissionLevel; #cache the Permission Level Record. # Assign existing sets - my $instructorTools = WeBWorK::ContentGenerator::Instructor->new($r); - my @setsToAssign = (); + my @setsToAssign = (); my @globalSetIDs = $db->listGlobalSets; my @GlobalSets = $db->getGlobalSets(@globalSetIDs); @@ -666,7 +665,7 @@ sub create_user { # assign all visible or "published" sets if ($globalSet->visible) { push @setsToAssign, $globalSet; - $instructorTools->assignSetToUser($userID, $globalSet); + assignSetToUser($db, $userID, $globalSet); } } $self->{numberOfSetsAssigned} = scalar @setsToAssign; diff --git a/lib/WeBWorK/ContentGenerator/GatewayQuiz.pm b/lib/WeBWorK/ContentGenerator/GatewayQuiz.pm index bc8b826d1d..46e3c84798 100644 --- a/lib/WeBWorK/ContentGenerator/GatewayQuiz.pm +++ b/lib/WeBWorK/ContentGenerator/GatewayQuiz.pm @@ -34,6 +34,7 @@ use WeBWorK::PG::ImageGenerator; # Use the ContentGenerator formatDateTime, not the version in Utils. use WeBWorK::Utils qw(writeLog writeCourseLogGivenTime encodeAnswers decodeAnswers path_is_subdir before after between wwRound is_restricted); +use WeBWorK::Utils::Instructor qw(assignSetVersionToUser); use WeBWorK::Utils::Rendering qw(getTranslatorDebuggingOptions renderPG); use WeBWorK::Utils::ProblemProcessing qw/create_ans_str_from_responses compute_reduced_score/; use WeBWorK::DB::Utils qw(global2user); @@ -584,7 +585,7 @@ async sub pre_header_initialize { # Assign the set, get the right name, version number, etc., and redefine the $set and $problem for the # remainder of this method. my $setTmpl = $db->getUserSet($effectiveUserID, $setID); - WeBWorK::ContentGenerator::Instructor::assignSetVersionToUser($self, $effectiveUserID, $setTmpl); + assignSetVersionToUser($db, $effectiveUserID, $setTmpl); $setVersionNumber++; # Get a clean version of the set and merged version to use in the rest of the routine. diff --git a/lib/WeBWorK/ContentGenerator/Grades.pm b/lib/WeBWorK/ContentGenerator/Grades.pm index 6b59ede810..5c587dcb0a 100644 --- a/lib/WeBWorK/ContentGenerator/Grades.pm +++ b/lib/WeBWorK/ContentGenerator/Grades.pm @@ -18,8 +18,7 @@ use parent qw(WeBWorK::ContentGenerator); =head1 NAME -WeBWorK::ContentGenerator::Instructor::Stats - Display statistics by user or -problem set. +WeBWorK::ContentGenerator::Grades - Display statistics by user. =cut diff --git a/lib/WeBWorK/ContentGenerator/Instructor/AchievementEditor.pm b/lib/WeBWorK/ContentGenerator/Instructor/AchievementEditor.pm index cfccf2c604..e28ef67482 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/AchievementEditor.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/AchievementEditor.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::Instructor::AchievementEditor; -use parent qw(WeBWorK::ContentGenerator::Instructor); +use parent qw(WeBWorK::ContentGenerator); =head1 NAME diff --git a/lib/WeBWorK/ContentGenerator/Instructor/AchievementList.pm b/lib/WeBWorK/ContentGenerator/Instructor/AchievementList.pm index 51d86b76e5..28750f42c5 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/AchievementList.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/AchievementList.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::Instructor::AchievementList; -use parent qw(WeBWorK::ContentGenerator::Instructor); +use parent qw(WeBWorK::ContentGenerator); =head1 NAME @@ -51,6 +51,7 @@ use Mojo::File; use Text::CSV; use WeBWorK::Utils qw(sortAchievements x); +use WeBWorK::Utils::Instructor qw(read_dir); # Forms use constant EDIT_FORMS => [qw(save_edit cancel_edit)]; @@ -677,7 +678,7 @@ sub getAxpList { my ($self) = @_; my $ce = $self->{ce}; my $dir = $ce->{courseDirs}->{achievements}; - return $self->read_dir($dir, qr/.*\.axp/); + return read_dir($dir, qr/.*\.axp/); } 1; diff --git a/lib/WeBWorK/ContentGenerator/Instructor/AchievementUserEditor.pm b/lib/WeBWorK/ContentGenerator/Instructor/AchievementUserEditor.pm index de47581f4c..4c07e695b2 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/AchievementUserEditor.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/AchievementUserEditor.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::Instructor::AchievementUserEditor; -use parent qw(WeBWorK::ContentGenerator::Instructor); +use parent qw(WeBWorK::ContentGenerator); =head1 NAME diff --git a/lib/WeBWorK/ContentGenerator/Instructor/AddUsers.pm b/lib/WeBWorK/ContentGenerator/Instructor/AddUsers.pm index 85a0ec44f8..c91862774d 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/AddUsers.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/AddUsers.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::Instructor::AddUsers; -use parent qw(WeBWorK::ContentGenerator::Instructor); +use parent qw(WeBWorK::ContentGenerator); =head1 NAME @@ -26,6 +26,7 @@ use strict; use warnings; use WeBWorK::Utils qw/cryptPassword trim_spaces/; +use WeBWorK::Utils::Instructor qw(assignSetsToUsers); sub initialize { my ($self) = @_; @@ -99,7 +100,7 @@ sub initialize { } if (defined $r->param('assignSets')) { my @setIDs = $r->param('assignSets'); - $self->assignSetsToUsers(\@setIDs, \@userIDs); + assignSetsToUsers($db, \@setIDs, \@userIDs); } } diff --git a/lib/WeBWorK/ContentGenerator/Instructor/Assigner.pm b/lib/WeBWorK/ContentGenerator/Instructor/Assigner.pm index 8df877a61c..aa1bc60db4 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/Assigner.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/Assigner.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::Instructor::Assigner; -use parent qw(WeBWorK::ContentGenerator::Instructor); +use parent qw(WeBWorK::ContentGenerator); =head1 NAME @@ -25,6 +25,8 @@ WeBWorK::ContentGenerator::Instructor::Assigner - Assign homework sets to users. use strict; use warnings; +use WeBWorK::Utils::Instructor qw(assignSetsToUsers unassignSetsFromUsers); + async sub pre_header_initialize { my ($self) = @_; my $r = $self->r; @@ -48,12 +50,12 @@ async sub pre_header_initialize { if (@selected_users && @selected_sets) { my @results; # This is not used? if (defined $r->param('assign')) { - $self->assignSetsToUsers(\@selected_sets, \@selected_users); + assignSetsToUsers($db, \@selected_sets, \@selected_users); $self->addgoodmessage($r->maketext('All assignments were made successfully.')); } if (defined $r->param('unassign')) { if (defined $r->param('unassignFromAllSafety') and $r->param('unassignFromAllSafety') == 1) { - $self->unassignSetsFromUsers(\@selected_sets, \@selected_users) if (defined $r->param('unassign')); + unassignSetsFromUsers($db, \@selected_sets, \@selected_users) if (defined $r->param('unassign')); $self->addgoodmessage($r->maketext('All unassignments were made successfully.')); } else { # asked for unassign, but no safety radio toggle $self->addbadmessage($r->maketext( diff --git a/lib/WeBWorK/ContentGenerator/Instructor/Config.pm b/lib/WeBWorK/ContentGenerator/Instructor/Config.pm index f42e0af2d5..f9322ae05f 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/Config.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/Config.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::Instructor::Config; -use parent qw(WeBWorK::ContentGenerator::Instructor); +use parent qw(WeBWorK::ContentGenerator); =head1 NAME diff --git a/lib/WeBWorK/ContentGenerator/Instructor/FileManager.pm b/lib/WeBWorK/ContentGenerator/Instructor/FileManager.pm index fc21d888be..e49f1f89f9 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/FileManager.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/FileManager.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::Instructor::FileManager; -use parent qw(WeBWorK::ContentGenerator::Instructor); +use parent qw(WeBWorK::ContentGenerator); =head1 NAME diff --git a/lib/WeBWorK/ContentGenerator/Instructor/Index.pm b/lib/WeBWorK/ContentGenerator/Instructor/Index.pm index 923c69a87e..65c374c227 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/Index.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/Index.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::Instructor::Index; -use parent qw(WeBWorK::ContentGenerator::Instructor); +use parent qw(WeBWorK::ContentGenerator); =head1 NAME diff --git a/lib/WeBWorK/ContentGenerator/Instructor/PGProblemEditor.pm b/lib/WeBWorK/ContentGenerator/Instructor/PGProblemEditor.pm index 8e1018681a..736ee682ef 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/PGProblemEditor.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/PGProblemEditor.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::Instructor::PGProblemEditor; -use parent qw(WeBWorK::ContentGenerator::Instructor); +use parent qw(WeBWorK::ContentGenerator); =head1 NAME @@ -115,6 +115,7 @@ use File::Copy; use WeBWorK::Utils qw(jitar_id_to_seq not_blank path_is_subdir seq_to_jitar_id x surePathToFile readDirectory readFile max); +use WeBWorK::Utils::Instructor qw(assignProblemToAllSetUsers addProblemToSet); use constant DEFAULT_SEED => 123456; @@ -854,13 +855,14 @@ sub add_problem_handler { } # Update problem record - my $problemRecord = $self->addProblemToSet( + my $problemRecord = addProblemToSet( + $db, $r->ce->{problemDefaults}, setName => $targetSetName, sourceFile => $sourceFilePath, problemID => $targetProblemNumber, ); - $self->assignProblemToAllSetUsers($problemRecord); + assignProblemToAllSetUsers($db, $problemRecord); $self->addgoodmessage($r->maketext( 'Added [_1] to [_2] as problem [_3]', @@ -1081,7 +1083,8 @@ sub save_handler { sub save_as_handler { my ($self) = @_; - my $r = $self->r; + my $r = $self->r; + my $db = $r->db; $self->{status_message} = $r->c; @@ -1107,10 +1110,10 @@ sub save_as_handler { # Grab the problemContents from the form in order to save it to a new permanent file. # Later we will unlink (delete) the current temporary file. - $self->{r_problemContents} = \(fixProblemContents($self->r->param('problemContents'))); + $self->{r_problemContents} = \(fixProblemContents($r->param('problemContents'))); # Construct the output file path - my $outputFilePath = $self->r->ce->{courseDirs}{templates} . "/$new_file_name"; + my $outputFilePath = $r->ce->{courseDirs}{templates} . "/$new_file_name"; if (defined $outputFilePath && -e $outputFilePath) { $do_not_save = 1; $self->addbadmessage($r->maketext( @@ -1138,9 +1141,9 @@ sub save_as_handler { } elsif ($saveMode eq 'rename' && -r $outputFilePath) { # Modify source file path in problem. if ($file_type eq 'set_header') { - my $setRecord = $self->r->db->getGlobalSet($self->{setID}); + my $setRecord = $db->getGlobalSet($self->{setID}); $setRecord->set_header($new_file_name); - if ($self->r->db->putGlobalSet($setRecord)) { + if ($db->putGlobalSet($setRecord)) { $self->addgoodmessage($r->maketext( 'The set header for set [_1] has been renamed to "[_2]".', $self->{setID}, $self->shortPath($outputFilePath) @@ -1152,9 +1155,9 @@ sub save_as_handler { )); } } elsif ($file_type eq 'hardcopy_header') { - my $setRecord = $self->r->db->getGlobalSet($self->{setID}); + my $setRecord = $db->getGlobalSet($self->{setID}); $setRecord->hardcopy_header($new_file_name); - if ($self->r->db->putGlobalSet($setRecord)) { + if ($db->putGlobalSet($setRecord)) { $self->addgoodmessage($r->maketext( 'The hardcopy header for set [_1] has been renamed to "[_2]".', $self->{setID}, $self->shortPath($outputFilePath) @@ -1168,16 +1171,14 @@ sub save_as_handler { } else { my $problemRecord; if ($self->{versionID}) { - $problemRecord = $self->r->db->getMergedProblemVersion($r->param('effectiveUser'), + $problemRecord = $db->getMergedProblemVersion($r->param('effectiveUser'), $self->{setID}, $1, $self->{problemID}); } else { - $problemRecord = $self->r->db->getGlobalProblem($self->{setID}, $self->{problemID}); + $problemRecord = $db->getGlobalProblem($self->{setID}, $self->{problemID}); } $problemRecord->source_file($new_file_name); my $result = - $self->{versionID} - ? $self->r->db->putProblemVersion($problemRecord) - : $self->r->db->putGlobalProblem($problemRecord); + $self->{versionID} ? $db->putProblemVersion($problemRecord) : $db->putGlobalProblem($problemRecord); if ($result) { $self->addgoodmessage($r->maketext( @@ -1195,24 +1196,25 @@ sub save_as_handler { } } } elsif ($saveMode eq 'add_to_set_as_new_problem') { - my $set = $self->r->db->getGlobalSet($self->{setID}); + my $set = $db->getGlobalSet($self->{setID}); # For jitar sets new problems are put as top level problems at the end. if ($set->assignment_type eq 'jitar') { - my @problemIDs = $self->r->db->listGlobalProblems($self->{setID}); + my @problemIDs = $db->listGlobalProblems($self->{setID}); @problemIDs = sort { $a <=> $b } @problemIDs; my @seq = jitar_id_to_seq($problemIDs[-1]); $targetProblemNumber = seq_to_jitar_id($seq[0] + 1); } else { - $targetProblemNumber = 1 + max($self->r->db->listGlobalProblems($self->{setID})); + $targetProblemNumber = 1 + max($db->listGlobalProblems($self->{setID})); } - my $problemRecord = $self->addProblemToSet( + my $problemRecord = addProblemToSet( + $db, $r->ce->{problemDefaults}, setName => $self->{setID}, sourceFile => $new_file_name, problemID => $targetProblemNumber, # Added to end of set ); - $self->assignProblemToAllSetUsers($problemRecord); + assignProblemToAllSetUsers($db, $problemRecord); $self->addgoodmessage($r->maketext( 'Added [_1] to [_2] as problem [_3].', $new_file_name, @@ -1265,7 +1267,7 @@ sub save_as_handler { 'WeBWorK::ContentGenerator::Instructor::PGProblemEditor', $r, courseID => $self->{courseID}, setID => $self->{setID}, - problemID => $do_not_save ? $self->{problemID} : max($self->r->db->listGlobalProblems($self->{setID})) + problemID => $do_not_save ? $self->{problemID} : max($db->listGlobalProblems($self->{setID})) ); $new_file_type = $file_type; } else { diff --git a/lib/WeBWorK/ContentGenerator/Instructor/ProblemSetDetail.pm b/lib/WeBWorK/ContentGenerator/Instructor/ProblemSetDetail.pm index 3d5e7f0873..a1ef0e716e 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/ProblemSetDetail.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/ProblemSetDetail.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::Instructor::ProblemSetDetail; -use parent qw(WeBWorK::ContentGenerator::Instructor); +use parent qw(WeBWorK::ContentGenerator); =head1 NAME @@ -27,6 +27,7 @@ use strict; use warnings; use WeBWorK::Utils qw(cryptPassword jitar_id_to_seq seq_to_jitar_id x format_set_name_internal format_set_name_display); +use WeBWorK::Utils::Instructor qw(assignProblemToAllSetUsers addProblemToSet); # These constants determine which fields belong to what type of record. use constant SET_FIELDS => [ @@ -1837,7 +1838,8 @@ sub initialize { close($TEMPFILE); # Update problem record - my $problemRecord = $self->addProblemToSet( + my $problemRecord = addProblemToSet( + $db, $ce->{problemDefaults}, setName => $setID, sourceFile => $new_file_path, problemID => $setRecord->assignment_type eq 'jitar' @@ -1845,7 +1847,7 @@ sub initialize { : $targetProblemNumber, ); - $self->assignProblemToAllSetUsers($problemRecord); + assignProblemToAllSetUsers($db, $problemRecord); $self->addgoodmessage($r->maketext( "Added [_1] to [_2] as problem [_3]", $new_file_path, $setID, $targetProblemNumber diff --git a/lib/WeBWorK/ContentGenerator/Instructor/ProblemSetList.pm b/lib/WeBWorK/ContentGenerator/Instructor/ProblemSetList.pm index fb93fd0111..6049a5c06a 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/ProblemSetList.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/ProblemSetList.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::Instructor::ProblemSetList; -use parent qw(WeBWorK::ContentGenerator::Instructor); +use parent qw(WeBWorK::ContentGenerator); =head1 NAME @@ -83,6 +83,7 @@ use Mojo::File; use WeBWorK::Debug; use WeBWorK::Utils qw(timeToSec listFilesRecursive jitar_id_to_seq seq_to_jitar_id x format_set_name_internal format_set_name_display); +use WeBWorK::Utils::Instructor qw(assignSetToUser assignSetToAllUsers addProblemToSet); use constant HIDE_SETS_THRESHOLD => 500; use constant DEFAULT_VISIBILITY_STATE => 1; @@ -595,7 +596,7 @@ sub create_handler { } # Assign set to current active user. my $userName = $r->param('user'); - $self->assignSetToUser($userName, $newSetRecord); # Cures weird date error when no-one assigned to set. + assignSetToUser($db, $userName, $newSetRecord); # Cures weird date error when no-one assigned to set. $self->addgoodmessage($r->maketext( 'Set [_1] was assigned to [_2].', $r->tag('span', dir => 'ltr', format_set_name_display($newSetID)), $userName @@ -988,7 +989,8 @@ sub importSetsFromDef { # add problems my $freeProblemID = WeBWorK::Utils::max($db->listGlobalProblems($setName)) + 1; foreach my $rh_problem (@problemList) { - $self->addProblemToSet( + addProblemToSet( + $db, $ce->{problemDefaults}, setName => $setName, sourceFile => $rh_problem->{source_file}, problemID => $rh_problem->{problemID} ? $rh_problem->{problemID} : $freeProblemID++, @@ -1003,10 +1005,10 @@ sub importSetsFromDef { } if ($assign eq "all") { - $self->assignSetToAllUsers($setName); + assignSetToAllUsers($db, $ce, $setName); } else { my $userName = $r->param('user'); - $self->assignSetToUser($userName, $newSetRecord); ## always assign set to instructor + assignSetToUser($db, $userName, $newSetRecord); ## always assign set to instructor } } diff --git a/lib/WeBWorK/ContentGenerator/Instructor/Scoring.pm b/lib/WeBWorK/ContentGenerator/Instructor/Scoring.pm index eec6588881..e333e84584 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/Scoring.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/Scoring.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::Instructor::Scoring; -use parent qw(WeBWorK::ContentGenerator::Instructor); +use parent qw(WeBWorK::ContentGenerator); =head1 NAME diff --git a/lib/WeBWorK/ContentGenerator/Instructor/ScoringDownload.pm b/lib/WeBWorK/ContentGenerator/Instructor/ScoringDownload.pm index 709aec6d0b..0264290193 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/ScoringDownload.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/ScoringDownload.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::Instructor::ScoringDownload; -use parent qw(WeBWorK::ContentGenerator::Instructor); +use parent qw(WeBWorK::ContentGenerator); =head1 NAME diff --git a/lib/WeBWorK/ContentGenerator/Instructor/SendMail.pm b/lib/WeBWorK/ContentGenerator/Instructor/SendMail.pm index cf9e7bf032..4da6e31235 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/SendMail.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/SendMail.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::Instructor::SendMail; -use parent qw(WeBWorK::ContentGenerator::Instructor); +use parent qw(WeBWorK::ContentGenerator); =head1 NAME @@ -32,6 +32,7 @@ use Data::Dump qw/dump/; use Text::Wrap qw(wrap); use WeBWorK::Debug; +use WeBWorK::Utils::Instructor qw(read_dir); sub initialize { my ($self) = @_; @@ -503,14 +504,13 @@ sub read_input_file { sub get_message_file_names { my $self = shift; - return $self->read_dir($self->{ce}->{courseDirs}->{email}, '\\.msg$'); + return read_dir($self->{ce}{courseDirs}{email}, '\\.msg$'); } sub get_merge_file_names { my $self = shift; - return 'None', - $self->read_dir($self->{ce}->{courseDirs}->{scoring}, '\\.csv$') - ; #FIXME ? check that only readable files are listed. + # FIXME: Check that only readable files are listed. + return 'None', read_dir($self->{ce}{courseDirs}{scoring}, '\\.csv$'); } sub mail_message_to_recipients { diff --git a/lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm b/lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm index 0b7e6120c0..2dea730e89 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::Instructor::SetMaker; -use parent qw(WeBWorK::ContentGenerator::Instructor); +use parent qw(WeBWorK::ContentGenerator); =head1 NAME @@ -33,6 +33,7 @@ use WeBWorK::Utils qw(readDirectory sortByName x format_set_name_internal); use WeBWorK::Utils::Tags; use WeBWorK::Utils::LibraryStats; use WeBWorK::Utils::ListingDB qw(getSectionListings); +use WeBWorK::Utils::Instructor qw(assignSetToUser assignProblemToAllSetUsers addProblemToSet); # Use x to mark strings for maketext use constant MY_PROBLEMS => x('My Problems'); @@ -298,12 +299,13 @@ sub add_selected { for my $selected (@selected) { if ($selected->[1] & ADDED) { my $file = $selected->[0]; - my $problemRecord = $self->addProblemToSet( + my $problemRecord = addProblemToSet( + $db, $self->r->ce->{problemDefaults}, setName => $setName, sourceFile => $file ); $freeProblemID++; - $self->assignProblemToAllSetUsers($problemRecord); + assignProblemToAllSetUsers($db, $problemRecord); $selected->[1] |= SUCCESS; $addedcount++; } @@ -648,7 +650,7 @@ async sub pre_header_initialize { $self->addbadmessage("Problem creating set $newSetName
      $@"); } else { $self->addgoodmessage($r->maketext("Set [_1] has been created.", $newSetName)); - $self->assignSetToUser($userName, $newSetRecord); + assignSetToUser($db, $userName, $newSetRecord); $self->addgoodmessage($r->maketext("Set [_1] was assigned to [_2]", $newSetName, $userName)); } } diff --git a/lib/WeBWorK/ContentGenerator/Instructor/ShowAnswers.pm b/lib/WeBWorK/ContentGenerator/Instructor/ShowAnswers.pm index 467c2e5423..f45e8b6cde 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/ShowAnswers.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/ShowAnswers.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::Instructor::ShowAnswers; -use parent qw(WeBWorK::ContentGenerator::Instructor); +use parent qw(WeBWorK::ContentGenerator); =head1 NAME diff --git a/lib/WeBWorK/ContentGenerator/Instructor/Stats.pm b/lib/WeBWorK/ContentGenerator/Instructor/Stats.pm index 6b76341426..7bcc6f5d87 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/Stats.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/Stats.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::Instructor::Stats; -use parent qw(WeBWorK::ContentGenerator::Instructor); +use parent qw(WeBWorK::ContentGenerator); =head1 NAME diff --git a/lib/WeBWorK/ContentGenerator/Instructor/StudentProgress.pm b/lib/WeBWorK/ContentGenerator/Instructor/StudentProgress.pm index 4e36b10a03..4c622f2a58 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/StudentProgress.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/StudentProgress.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::Instructor::StudentProgress; -use parent qw(WeBWorK::ContentGenerator::Instructor); +use parent qw(WeBWorK::ContentGenerator); =head1 NAME diff --git a/lib/WeBWorK/ContentGenerator/Instructor/UserDetail.pm b/lib/WeBWorK/ContentGenerator/Instructor/UserDetail.pm index a8e05e7811..c78af2c8ad 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/UserDetail.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/UserDetail.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::Instructor::UserDetail; -use parent qw(WeBWorK::ContentGenerator::Instructor); +use parent qw(WeBWorK::ContentGenerator); =head1 NAME @@ -26,6 +26,7 @@ use strict; use warnings; use WeBWorK::Utils qw(x); +use WeBWorK::Utils::Instructor qw(assignSetToUser); use WeBWorK::Debug; # We use the x function to mark strings for localizaton @@ -84,7 +85,7 @@ sub initialize { # Does the user want this set to be assigned to the selected user? if (exists $selectedSets{$setID}) { # Assign the set if it isn't assigned already. - $self->assignSetToUser($editForUserID, $setRecord) if (!$userSets{$setID}); + assignSetToUser($db, $editForUserID, $setRecord) if (!$userSets{$setID}); # Override dates my $userSetRecord = $db->getUserSet($editForUserID, $setID); diff --git a/lib/WeBWorK/ContentGenerator/Instructor/UserList.pm b/lib/WeBWorK/ContentGenerator/Instructor/UserList.pm index 69c0e8710d..658deb0f46 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/UserList.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/UserList.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::Instructor::UserList; -use parent qw(WeBWorK::ContentGenerator::Instructor); +use parent qw(WeBWorK::ContentGenerator); =head1 NAME diff --git a/lib/WeBWorK/ContentGenerator/Instructor/UsersAssignedToSet.pm b/lib/WeBWorK/ContentGenerator/Instructor/UsersAssignedToSet.pm index cd5e7d6510..e526545034 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/UsersAssignedToSet.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/UsersAssignedToSet.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::Instructor::UsersAssignedToSet; -use parent qw(WeBWorK::ContentGenerator::Instructor); +use parent qw(WeBWorK::ContentGenerator); =head1 NAME @@ -28,6 +28,7 @@ use warnings; use WeBWorK::Debug; use WeBWorK::Utils qw(format_set_name_display); +use WeBWorK::Utils::Instructor qw(assignSetToUser assignSetToAllUsers); sub initialize { my ($self) = @_; @@ -49,7 +50,7 @@ sub initialize { if (defined $r->param('assignToAll')) { debug("assignSetToAllUsers($setID)"); $self->addgoodmessage($r->maketext("Problems have been assigned to all current users.")); - $self->assignSetToAllUsers($setID); + assignSetToAllUsers($db, $r->ce, $setID); debug("done assignSetToAllUsers($setID)"); } elsif (defined $r->param('unassignFromAll') && defined($r->param('unassignFromAllSafety')) @@ -79,7 +80,7 @@ sub initialize { if (exists $selectedUsers{$selectedUser}) { unless ($setUsers{$selectedUser}) { # skip users already in the set debug("assignSetToUser($selectedUser, ...)"); - $self->assignSetToUser($selectedUser, $setRecord); + assignSetToUser($db, $selectedUser, $setRecord); debug("done assignSetToUser($selectedUser, ...)"); } } else { diff --git a/lib/WeBWorK/HTML/CodeMirrorEditor.pm b/lib/WeBWorK/HTML/CodeMirrorEditor.pm index 8a624ec89f..fcc5460f31 100644 --- a/lib/WeBWorK/HTML/CodeMirrorEditor.pm +++ b/lib/WeBWorK/HTML/CodeMirrorEditor.pm @@ -18,9 +18,9 @@ use parent qw(Exporter); =head1 NAME -WeBWorK::ContentGenerator::Instructor::CodeMirrorEditor is a module for -displaying a CodeMirror editor on a page. This is currently used by the -AchievementEditor.pm and PGProblemEditor.pm modules. +WeBWorK::HTML::CodeMirrorEditor is a module for displaying a CodeMirror editor +on a page. This is currently used by the AchievementEditor.pm and +PGProblemEditor.pm modules. =cut diff --git a/lib/WeBWorK/HTML/SingleProblemGrader.pm b/lib/WeBWorK/HTML/SingleProblemGrader.pm index bc626114de..6911795d6a 100644 --- a/lib/WeBWorK/HTML/SingleProblemGrader.pm +++ b/lib/WeBWorK/HTML/SingleProblemGrader.pm @@ -17,9 +17,9 @@ package WeBWorK::HTML::SingleProblemGrader; =head1 NAME -WeBWorK::ContentGenerator::Instructor::SingleProblemGrader is a module for -manually grading a single webwork problem. It is displayed with the problem -when an instructor is acting as a student. +WeBWorK::HTML::SingleProblemGrader is a module for manually grading a single +webwork problem. It is displayed with the problem when an instructor is acting +as a student. =cut diff --git a/lib/WeBWorK/ContentGenerator/Instructor.pm b/lib/WeBWorK/Utils/Instructor.pm similarity index 76% rename from lib/WeBWorK/ContentGenerator/Instructor.pm rename to lib/WeBWorK/Utils/Instructor.pm index 50d0ad269f..67869dd9a8 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor.pm +++ b/lib/WeBWorK/Utils/Instructor.pm @@ -13,13 +13,12 @@ # Artistic License for more details. ################################################################################ -package WeBWorK::ContentGenerator::Instructor; -use parent qw(WeBWorK::ContentGenerator); +package WeBWorK::Utils::Instructor; +use parent qw(Exporter); =head1 NAME -WeBWorK::ContentGenerator::Instructor - Abstract superclass for the Instructor -tools, providing useful utility functions. +WeBWorK::Utils::Instructor - Useful instructor utility tools. =cut @@ -32,6 +31,24 @@ use WeBWorK::DB::Utils qw(initializeUserProblem); use WeBWorK::Debug; use WeBWorK::Utils qw(jitar_id_to_seq seq_to_jitar_id); +our @EXPORT_OK = qw( + assignSetToUser + assignSetVersionToUser + assignProblemToUser + assignProblemToUserSetVersion + assignSetToAllUsers + unassignSetFromAllUsers + assignAllSetsToUser + unassignAllSetsFromUser + assignSetsToUsers + unassignSetsFromUsers + assignProblemToAllSetUsers + addProblemToSet + read_dir + getCSVList + getDefList +); + =head1 METHODS =cut @@ -44,7 +61,7 @@ use WeBWorK::Utils qw(jitar_id_to_seq seq_to_jitar_id); =over -=item assignSetToUser($userID, $GlobalSet) +=item assignSetToUser($db, $userID, $GlobalSet) Assigns the given set and all problems contained therein to the given user. If the set (or any problems in the set) are already assigned to the user, a list of @@ -53,9 +70,8 @@ failure messages is returned. =cut sub assignSetToUser { - my ($self, $userID, $GlobalSet) = @_; + my ($db, $userID, $GlobalSet) = @_; my $setID = $GlobalSet->set_id; - my $db = $self->{db}; my $UserSet = $db->newUserSet; $UserSet->user_id($userID); @@ -76,7 +92,7 @@ sub assignSetToUser { my @GlobalProblems = grep { defined $_ } $db->getAllGlobalProblems($setID); foreach my $GlobalProblem (@GlobalProblems) { - my @result = $self->assignProblemToUser($userID, $GlobalProblem); + my @result = assignProblemToUser($db, $userID, $GlobalProblem); push @results, @result if @result and not $set_assigned; } @@ -84,8 +100,9 @@ sub assignSetToUser { } sub assignSetVersionToUser { - my ($self, $userID, $GlobalSet) = @_; - # in: ($self,) $userID = the userID of the user to which to assign the set, + my ($db, $userID, $GlobalSet) = @_; + # in: $db = a database connection + # $userID = the userID of the user to which to assign the set, # $GlobalSet = the global set object. # out: a new set version is assigned to the user. # note: we assume that the global set and user are well defined. I think this @@ -94,7 +111,6 @@ sub assignSetVersionToUser { # the setID and the setVersionID my $setID = $GlobalSet->set_id; - my $db = $self->{db}; # figure out what version we're on, reset setID, get a new user set # FIXME: old version; new call follows @@ -130,34 +146,14 @@ sub assignSetVersionToUser { foreach my $GlobalProblem (@GlobalProblems) { $GlobalProblem->set_id($setID); - # this is getting called from within ContentGenerator, so that $self - # isn't an Instructor object---therefore, calling $self->assign... - # doesn't work. the following is an ugly workaround that works b/c - # both Instructor and ContentGenerator objects have $self->{db} - # FIXME it would be nice to have a better solution to this - my @result = assignProblemToUserSetVersion($self, $userID, $userSet, $GlobalProblem, \%groupProblems); + my @result = assignProblemToUserSetVersion($db, $userID, $userSet, $GlobalProblem, \%groupProblems); push(@results, @result) if (@result && !$set_assigned); } return @results; } -=item unassignSetFromUser($userID, $setID, $problemID) - -Unassigns the given set and all problems therein from the given user. - -=cut - -sub unassignSetFromUser { - my ($self, $userID, $setID) = @_; - my $db = $self->{db}; - - $db->deleteUserSet($userID, $setID); - - return; -} - -=item assignProblemToUser($userID, $GlobalProblem, $seed) +=item assignProblemToUser($db, $userID, $GlobalProblem, $seed) Assigns the given problem to the given user. If the problem is already assigned to the user, an error string is returned. If $seed is defined, the UserProblem @@ -166,8 +162,7 @@ will be given that seed. =cut sub assignProblemToUser { - my ($self, $userID, $GlobalProblem, $seed) = @_; - my $db = $self->{db}; + my ($db, $userID, $GlobalProblem, $seed) = @_; my $UserProblem = $db->newUserProblem; $UserProblem->user_id($userID); @@ -194,8 +189,7 @@ sub assignProblemToUser { # $seed is optional -- if set, the UserProblem will be given that seed sub assignProblemToUserSetVersion { - my ($self, $userID, $userSet, $GlobalProblem, $groupProbRef, $seed) = @_; - my $db = $self->{db}; + my ($db, $userID, $userSet, $GlobalProblem, $groupProbRef, $seed) = @_; # conditional to allow selection of problems from a group of problems, # defined in a set. @@ -278,21 +272,6 @@ sub assignProblemToUserSetVersion { return (); } -=item unassignProblemFromUser($userID, $setID, $problemID) - -Unassigns the given problem from the given user. - -=cut - -sub unassignProblemFromUser { - my ($self, $userID, $setID, $problemID) = @_; - my $db = $self->{db}; - - $db->deleteUserProblem($userID, $setID, $problemID); - - return; -} - =back =cut @@ -305,7 +284,7 @@ sub unassignProblemFromUser { =over -=item assignSetToAllUsers($setID) +=item assignSetToAllUsers($db, $ce, $setID) Assigns the set specified and all problems contained therein to all users in the course. This is more efficient than repeatedly calling assignSetToUser(). @@ -314,8 +293,7 @@ If any assignments fail, a list of failure messages is returned. =cut sub assignSetToAllUsers { - my ($self, $setID) = @_; - my $db = $self->{db}; + my ($db, $ce, $setID) = @_; debug("$setID: getting user list"); my @userRecords = $db->getUsersWhere({ user_id => { not_like => 'set_id:%' } }); @@ -328,7 +306,7 @@ sub assignSetToAllUsers { my @results; foreach my $User (@userRecords) { - next unless $self->r->ce->status_abbrev_has_behavior($User->status, "include_in_assignment"); + next unless $ce->status_abbrev_has_behavior($User->status, "include_in_assignment"); my $UserSet = $db->newUserSet; my $userID = $User->user_id; $UserSet->user_id($userID); @@ -343,7 +321,7 @@ sub assignSetToAllUsers { debug("$setID: adding UserProblems for $userID"); foreach my $GlobalProblem (@GlobalProblems) { - my @result = $self->assignProblemToUser($userID, $GlobalProblem); + my @result = assignProblemToUser($db, $userID, $GlobalProblem); push @results, @result if @result; } debug("$setID: (done with that)"); @@ -352,26 +330,25 @@ sub assignSetToAllUsers { return @results; } -=item unassignSetFromAllUsers($setID) +=item unassignSetFromAllUsers($db, $setID) Unassigns the specified sets and all problems contained therein from all users. =cut sub unassignSetFromAllUsers { - my ($self, $setID) = @_; - my $db = $self->{db}; + my ($db, $setID) = @_; my @userIDs = $db->listSetUsers($setID); foreach my $userID (@userIDs) { - $self->unassignSetFromUser($userID, $setID); + $db->deleteUserSet($userID, $setID); } return; } -=item assignAllSetsToUser($userID) +=item assignAllSetsToUser($db, $userID) Assigns all sets in the course and all problems contained therein to the specified user. If any assignments fail, a list of failure messages is @@ -380,35 +357,33 @@ returned. =cut sub assignAllSetsToUser { - my ($self, $userID) = @_; - my $db = $self->{db}; + my ($db, $userID) = @_; my @GlobalSets = $db->getGlobalSetsWhere(); my @results; for my $GlobalSet (@GlobalSets) { - my @result = $self->assignSetToUser($userID, $GlobalSet); + my @result = assignSetToUser($db, $userID, $GlobalSet); push @results, @result if @result; } return @results; } -=item unassignAllSetsFromUser($userID) +=item unassignAllSetsFromUser($db, $userID) Unassigns all sets and all problems contained therein from the specified user. =cut sub unassignAllSetsFromUser { - my ($self, $userID) = @_; - my $db = $self->{db}; + my ($db, $userID) = @_; my @setIDs = $db->listUserSets($userID); foreach my $setID (@setIDs) { - $self->unassignSetFromUser($userID, $setID); + $db->deleteUserSet($userID, $setID); } return; @@ -426,7 +401,7 @@ sub unassignAllSetsFromUser { =over -=item assignSetsToUsers($setIDsRef, $userIDsRef) +=item assignSetsToUsers($db, $setIDsRef, $userIDsRef) Assign each of the given sets to each of the given users. If any assignments fail, a list of failure messages is returned. @@ -434,8 +409,7 @@ fail, a list of failure messages is returned. =cut sub assignSetsToUsers { - my ($self, $setIDsRef, $userIDsRef) = @_; - my $db = $self->{db}; + my ($db, $setIDsRef, $userIDsRef) = @_; my @setIDs = @$setIDsRef; my @userIDs = @$userIDsRef; @@ -445,7 +419,7 @@ sub assignSetsToUsers { foreach my $GlobalSet (@GlobalSets) { foreach my $userID (@userIDs) { - my @result = $self->assignSetToUser($userID, $GlobalSet); + my @result = assignSetToUser($db, $userID, $GlobalSet); push @results, @result if @result; } } @@ -453,20 +427,20 @@ sub assignSetsToUsers { return @results; } -=item unassignSetsFromUsers($setIDsRef, $userIDsRef) +=item unassignSetsFromUsers($db, $setIDsRef, $userIDsRef) Unassign each of the given sets from each of the given users. =cut sub unassignSetsFromUsers { - my ($self, $setIDsRef, $userIDsRef) = @_; + my ($db, $setIDsRef, $userIDsRef) = @_; my @setIDs = @$setIDsRef; my @userIDs = @$userIDsRef; foreach my $setID (@setIDs) { foreach my $userID (@userIDs) { - $self->unassignSetFromUser($userID, $setID); + $db->deleteUserSet($userID, $setID); } } @@ -481,15 +455,14 @@ assigned. If any assignments fail, a list of failure messages is returned. =cut sub assignProblemToAllSetUsers { - my ($self, $GlobalProblem) = @_; - my $db = $self->{db}; + my ($db, $GlobalProblem) = @_; my $setID = $GlobalProblem->set_id; my @userIDs = $db->listSetUsers($setID); my @results; foreach my $userID (@userIDs) { - my @result = $self->assignProblemToUser($userID, $GlobalProblem); + my @result = assignProblemToUser($db, $userID, $GlobalProblem); push @results, @result if @result; } @@ -511,15 +484,14 @@ sub assignProblemToAllSetUsers { =cut sub addProblemToSet { - my ($self, %args) = @_; - my $db = $self->r->db; - my $value_default = $self->{ce}->{problemDefaults}->{value}; - my $max_attempts_default = $self->{ce}->{problemDefaults}->{max_attempts}; - my $showMeAnother_default = $self->{ce}->{problemDefaults}->{showMeAnother}; - my $att_to_open_children_default = $self->{ce}->{problemDefaults}->{att_to_open_children}; - my $counts_parent_grade_default = $self->{ce}->{problemDefaults}->{counts_parent_grade}; - my $showHintsAfter_default = $self->{ce}{problemDefaults}{showHintsAfter}; - my $prPeriod_default = $self->{ce}->{problemDefaults}->{prPeriod}; + my ($db, $problemDefaults, %args) = @_; + my $value_default = $problemDefaults->{value}; + my $max_attempts_default = $problemDefaults->{max_attempts}; + my $showMeAnother_default = $problemDefaults->{showMeAnother}; + my $att_to_open_children_default = $problemDefaults->{att_to_open_children}; + my $counts_parent_grade_default = $problemDefaults->{counts_parent_grade}; + my $showHintsAfter_default = $problemDefaults->{showHintsAfter}; + my $prPeriod_default = $problemDefaults->{prPeriod}; # showMeAnotherCount is the number of times that showMeAnother has been clicked; initially 0 my $showMeAnotherCount = 0; @@ -591,7 +563,6 @@ sub addProblemToSet { =cut sub read_dir { # read a directory - my $self = shift; my $directory = shift; my $pattern = shift; my @files = sort grep {/$pattern/} WeBWorK::Utils::readDirectory($directory); @@ -614,9 +585,8 @@ sub read_dir { # read a directory # list classlist files sub getCSVList { - my ($self) = @_; - my $ce = $self->{ce}; - my $dir = $ce->{courseDirs}->{templates}; + my ($ce) = @_; + my $dir = $ce->{courseDirs}{templates}; return grep { not m/^\./ and m/\.lst$/ and -f "$dir/$_" } WeBWorK::Utils::readDirectory($dir); } @@ -640,8 +610,7 @@ sub loadSetDefListFile { } sub getDefList { - my $self = shift; - my $ce = $self->{ce}; + my $ce = shift; my $topdir = $ce->{courseDirs}{templates}; # Search to a depth of the setDefSearchDepth value plus the depth of the templates directory. @@ -678,45 +647,6 @@ sub getDefList { return @found_set_defs[ sort { $depths[$a] <=> $depths[$b] || $caps[$a] cmp $caps[$b] } 0 .. $#found_set_defs ]; } -sub getScoringFileList { - my ($self) = @_; - my $ce = $self->{ce}; - my $dir = $ce->{courseDirs}->{scoring}; - return $self->read_dir($dir, qr/.*\.csv/); -} - -sub getTemplateFileList { # find all .pg files under the template tree (time consuming) - my ($self) = shift; - my $subDir = shift; - my $ce = $self->{ce}; - $subDir = '' unless defined $subDir; - my $dir = $ce->{courseDirs}->{templates} . "/$subDir"; - # FIXME currently allows one to see most files in the templates directory. - # a better facility for handling auxiliary files would be nice. - return $self->read_dir($dir, qr/\.pg$|.*\.html|\.png|\.gif|\.txt|\.pl/); -} - -sub getTemplateDirList { # find all .pg files under the template tree (time consuming) - my ($self) = @_; - my $ce = $self->{ce}; - my $dir = $ce->{courseDirs}->{templates}; - my @list; - my $wanted = sub { - if (-d $_) { - my $current = $_; - return if $current =~ /CVS/; - return if -l $current; # don't list links - my $name = $File::Find::name; - $name = " Top" if $current = /^\./; # top directory - $name =~ s/^$dir\///; - push @list, $name; - } - }; - File::Find::find($wanted, $dir); - @list = sort @list; - return @list; -} - =back =cut diff --git a/lib/WebworkSOAP.pm b/lib/WebworkSOAP.pm index aa9f25e54d..dbbbcfd254 100644 --- a/lib/WebworkSOAP.pm +++ b/lib/WebworkSOAP.pm @@ -8,7 +8,6 @@ use WeBWorK::Utils::CourseManagement use WeBWorK::DB; use WeBWorK::DB::Utils qw(initializeUserProblem); use WeBWorK::CourseEnvironment; -use WeBWorK::ContentGenerator::Instructor; use WebworkSOAP::Classes::GlobalSet; use WebworkSOAP::Classes::UserSet; diff --git a/templates/ContentGenerator/Instructor/ProblemSetList/import_form.html.ep b/templates/ContentGenerator/Instructor/ProblemSetList/import_form.html.ep index 91ac47a178..1bfab6154d 100644 --- a/templates/ContentGenerator/Instructor/ProblemSetList/import_form.html.ep +++ b/templates/ContentGenerator/Instructor/ProblemSetList/import_form.html.ep @@ -1,3 +1,5 @@ +% use WeBWorK::Utils::Instructor qw(getDefList); +%
      <%= label_for import_amt_select => maketext('Import how many sets?'), @@ -16,7 +18,7 @@
      <%= select_field 'action.import.source' => [ [ maketext('Enter filenames below') => '', selected => undef ], - $cg->getDefList + getDefList($ce) ], id => 'import_source_select', class => 'form-select form-select-sm', dir => 'ltr', size => param('action.import.number') || 1, diff --git a/templates/ContentGenerator/Instructor/SetMaker/browse_setdef_panel.html.ep b/templates/ContentGenerator/Instructor/SetMaker/browse_setdef_panel.html.ep index 60f03094be..8b32dae069 100644 --- a/templates/ContentGenerator/Instructor/SetMaker/browse_setdef_panel.html.ep +++ b/templates/ContentGenerator/Instructor/SetMaker/browse_setdef_panel.html.ep @@ -1,4 +1,6 @@ -% my @list_of_set_defs = $cg->getDefList; +% use WeBWorK::Utils::Instructor qw(getDefList); +% +% my @list_of_set_defs = getDefList($ce); % % if (!@list_of_set_defs) {
      diff --git a/templates/ContentGenerator/Instructor/UserList/export_form.html.ep b/templates/ContentGenerator/Instructor/UserList/export_form.html.ep index e22d058026..41ed33b6b3 100644 --- a/templates/ContentGenerator/Instructor/UserList/export_form.html.ep +++ b/templates/ContentGenerator/Instructor/UserList/export_form.html.ep @@ -1,3 +1,5 @@ +% use WeBWorK::Utils::Instructor qw(getCSVList); +%
      <%= label_for export_select_scope => maketext('Export which users?'), @@ -17,7 +19,7 @@
      <%= select_field 'action.export.target' => [ [ maketext('Enter filename below') => 'new' ], - $cg->getCSVList + getCSVList($ce) ], id => 'export_select_target', class => 'form-select form-select-sm' =%>
      diff --git a/templates/ContentGenerator/Instructor/UserList/import_form.html.ep b/templates/ContentGenerator/Instructor/UserList/import_form.html.ep index ad01a53eb7..6797d5f7b0 100644 --- a/templates/ContentGenerator/Instructor/UserList/import_form.html.ep +++ b/templates/ContentGenerator/Instructor/UserList/import_form.html.ep @@ -1,9 +1,11 @@ +% use WeBWorK::Utils::Instructor qw(getCSVList); +%
      <%= label_for import_select_source => maketext('Import users from what file?'), class => 'col-form-label col-form-label-sm col-sm-auto' =%>
      - <%= select_field 'action.import.source' => [ $cg->getCSVList ], + <%= select_field 'action.import.source' => [ getCSVList($ce) ], id => 'import_select_source', class => 'form-select form-select-sm', dir => 'ltr' =%>
      From cf2e9da919b5549242b842e633e4b78b399e119f Mon Sep 17 00:00:00 2001 From: Glenn Rice Date: Tue, 27 Dec 2022 16:25:06 -0600 Subject: [PATCH 085/490] Dispatch with the Mojolicious router. Make all ContentGenerator modules actual controllers and use the Mojolicous router for dispatching requests. The WeBWorK::Request module is now the WeBWorK::Controller module. It derives from the Mojolicious::Controller package, and is that base class for all WeBWorK Mojolicious controller modules. The WeBWorK::ContentGenerator module derives from that, and as before all other content generator modules derive from that. So the package hierarchy is: Mojolicious::Controller -> WeBWorK::Controller -> WeBWorK::ContentGenerator -> WeBWorK::ContentGenerator::... In the ContentGenerator modules the old $r variable (which stood for an Apache::Request) has been replaced with $c (for Mojolicious::Controller). Furthermore, $self is gone. There is only $c. The old $self and $r are now both $c. The current controller module is available in the templates (made available by Mojolicious) as $c, so this naming is consistent bot in the module itself and in the templates. Yeah, $self is also made available in the templates by Mojolicious and $c == $self, but $c is shorter and this is consistent with the Mojolicious documentation also. Note that signatures have been enabled in all content generator modules (and a few other modules). lib/WeBWorK.pm still initializes all ContentGenerator requests by initializing the course environment and checking authentication, but then it relinquishes control to the appropriate ContentGenerator controller module. That is except for the case when the user is not authenticate, in which case the Login.pm module is rendered directly, and the case that login proctor authentication is needed, in which case the LoginProctor.pm module is rendered directly. This is done in the `around_action` hook. Mojolicious routes are initialized in the WeBWork::Utils::Routes module. That module also has two convenience methods that return webwork specific parameters that are not Mojo::Routes:Route properties. Those are the route_title which returns the translated display title for a route, and route_navigation_is_restricted, which determines if a route is allowed for LTI navigation restricted users. Note that the WeBWorK::URLPath module is no more. Everything that did can be done directly with the Mojo::Routes or Mojo::Routes::Route modules or the two convenience methods of the WeBWork::Utils::Routes module. The most prominently utilized Mojolicious method that replaces the old WeBWorK::URLPath usage is the `url_for` Mojolicious::Controller method. This returns a Mojo::URL. It automatically incorporates stash values (previously urlpath args) for the current route into the generated url. Furthermore, the Mojo::URL `query` method is used to simplify adding query parameters. The WeBWorK::ContentGenerator `systemLink` method is rewritten to utilize this. That modules `url_args` and `url_authen_args` methods are revised to not directly generate the tail of the url, but to return a hash that can be passed to the `query` method. Note that the WeBWorK::FakeRequest module has been deleted. That is not only not used, but also won't work anymore. It could be made to work again, but it would take some effort and we really don't need it anymore. --- htdocs/themes/math4/system.html.ep | 90 +- lib/Caliper/Event.pm | 10 +- lib/Caliper/Sensor.pm | 10 +- lib/FormatRenderedProblem.pm | 28 +- lib/HardcopyRenderedProblem.pm | 30 +- lib/Mojolicious/WeBWorK.pm | 69 +- lib/Mojolicious/WeBWorK/Controller/Handler.pm | 118 -- lib/WeBWorK.pm | 427 ++---- lib/WeBWorK/AchievementEvaluator.pm | 18 +- lib/WeBWorK/AchievementItems.pm | 28 +- lib/WeBWorK/AchievementItems/AddNewTestGW.pm | 33 +- lib/WeBWorK/AchievementItems/DoubleProb.pm | 38 +- lib/WeBWorK/AchievementItems/DoubleSet.pm | 30 +- lib/WeBWorK/AchievementItems/DuplicateProb.pm | 48 +- lib/WeBWorK/AchievementItems/ExtendDueDate.pm | 30 +- .../AchievementItems/ExtendDueDateGW.pm | 33 +- .../AchievementItems/FullCreditProb.pm | 38 +- lib/WeBWorK/AchievementItems/FullCreditSet.pm | 30 +- .../AchievementItems/HalfCreditProb.pm | 38 +- lib/WeBWorK/AchievementItems/HalfCreditSet.pm | 30 +- lib/WeBWorK/AchievementItems/ReducedCred.pm | 30 +- .../ResetIncorrectAttempts.pm | 38 +- lib/WeBWorK/AchievementItems/ResurrectGW.pm | 30 +- lib/WeBWorK/AchievementItems/ResurrectHW.pm | 30 +- .../AchievementItems/SuperExtendDueDate.pm | 30 +- lib/WeBWorK/AchievementItems/Surprise.pm | 21 +- lib/WeBWorK/Authen.pm | 205 ++- lib/WeBWorK/Authen/CAS.pm | 28 +- lib/WeBWorK/Authen/Cosign.pm | 30 +- lib/WeBWorK/Authen/LDAP.pm | 4 +- lib/WeBWorK/Authen/LTIAdvanced.pm | 170 ++- lib/WeBWorK/Authen/LTIAdvanced/SubmitGrade.pm | 59 +- lib/WeBWorK/Authen/LTIBasic.pm | 164 ++- lib/WeBWorK/Authen/Moodle.pm | 28 +- lib/WeBWorK/Authen/Proctor.pm | 57 +- lib/WeBWorK/Authen/Shibboleth.pm | 44 +- lib/WeBWorK/Authz.pm | 119 +- lib/WeBWorK/ConfigObject.pm | 69 +- lib/WeBWorK/ConfigObject/boolean.pm | 28 +- lib/WeBWorK/ConfigObject/checkboxlist.pm | 41 +- lib/WeBWorK/ConfigObject/list.pm | 27 +- lib/WeBWorK/ConfigObject/number.pm | 11 +- lib/WeBWorK/ConfigObject/permission.pm | 33 +- lib/WeBWorK/ConfigObject/popuplist.pm | 26 +- lib/WeBWorK/ConfigObject/text.pm | 5 +- lib/WeBWorK/ConfigObject/time.pm | 12 +- lib/WeBWorK/ConfigObject/timezone.pm | 12 +- lib/WeBWorK/ContentGenerator.pm | 772 ++++------ lib/WeBWorK/ContentGenerator/Achievements.pm | 78 +- lib/WeBWorK/ContentGenerator/CourseAdmin.pm | 1238 ++++++++--------- .../ContentGenerator/EquationDisplay.pm | 23 +- lib/WeBWorK/ContentGenerator/Feedback.pm | 194 ++- lib/WeBWorK/ContentGenerator/GatewayQuiz.pm | 616 ++++---- lib/WeBWorK/ContentGenerator/Grades.pm | 112 +- lib/WeBWorK/ContentGenerator/Hardcopy.pm | 515 ++++--- lib/WeBWorK/ContentGenerator/Home.pm | 21 +- .../Instructor/AchievementEditor.pm | 280 ++-- .../Instructor/AchievementList.pm | 293 ++-- .../Instructor/AchievementUserEditor.pm | 56 +- .../ContentGenerator/Instructor/AddUsers.pm | 53 +- .../ContentGenerator/Instructor/Assigner.pm | 55 +- .../ContentGenerator/Instructor/Config.pm | 56 +- .../Instructor/FileManager.pm | 619 ++++----- .../ContentGenerator/Instructor/Index.pm | 156 +-- .../ContentGenerator/Instructor/LTIUpdate.pm | 66 +- .../Instructor/PGProblemEditor.pm | 886 ++++++------ .../Instructor/ProblemGrader.pm | 66 +- .../Instructor/ProblemSetDetail.pm | 438 +++--- .../Instructor/ProblemSetList.pm | 699 +++++----- .../ContentGenerator/Instructor/Scoring.pm | 195 ++- .../Instructor/ScoringDownload.pm | 25 +- .../ContentGenerator/Instructor/SendMail.pm | 318 ++--- .../ContentGenerator/Instructor/SetMaker.pm | 338 ++--- .../Instructor/ShowAnswers.pm | 75 +- .../ContentGenerator/Instructor/Stats.pm | 269 ++-- .../Instructor/StudentProgress.pm | 116 +- .../ContentGenerator/Instructor/UserDetail.pm | 87 +- .../ContentGenerator/Instructor/UserList.pm | 455 +++--- .../Instructor/UsersAssignedToSet.pm | 46 +- .../ContentGenerator/InstructorRPCHandler.pm | 37 +- lib/WeBWorK/ContentGenerator/Login.pm | 80 +- lib/WeBWorK/ContentGenerator/LoginProctor.pm | 68 +- lib/WeBWorK/ContentGenerator/Logout.pm | 41 +- lib/WeBWorK/ContentGenerator/Options.pm | 109 +- lib/WeBWorK/ContentGenerator/Problem.pm | 1084 +++++++-------- lib/WeBWorK/ContentGenerator/ProblemSet.pm | 205 ++- lib/WeBWorK/ContentGenerator/ProblemSets.pm | 204 ++- .../ContentGenerator/ProctoredGatewayQuiz.pm | 5 +- lib/WeBWorK/ContentGenerator/RenderViaRPC.pm | 42 +- lib/WeBWorK/ContentGenerator/ShowMeAnother.pm | 278 ++-- lib/WeBWorK/ContentGenerator/Skeleton.pm | 61 +- lib/WeBWorK/Controller.pm | 206 +++ lib/WeBWorK/FakeRequest.pm | 180 --- lib/WeBWorK/Form.pm | 21 +- lib/WeBWorK/HTML/AttemptsTable.pm | 157 +-- lib/WeBWorK/HTML/CodeMirrorEditor.pm | 23 +- lib/WeBWorK/HTML/ScrollingRecordList.pm | 27 +- lib/WeBWorK/HTML/SingleProblemGrader.pm | 21 +- lib/WeBWorK/Request.pm | 200 --- lib/WeBWorK/URLPath.pm | 1164 ---------------- lib/WeBWorK/Utils.pm | 58 +- lib/WeBWorK/Utils/ListingDB.pm | 112 +- lib/WeBWorK/Utils/ProblemProcessing.pm | 135 +- lib/WeBWorK/Utils/Rendering.pm | 20 +- lib/WeBWorK/Utils/Routes.pm | 529 +++++++ .../Controller => WebworkSOAP}/SOAP.pm | 4 +- lib/WebworkWebservice.pm | 36 +- lib/WebworkWebservice/CourseActions.pm | 8 +- lib/WebworkWebservice/RenderProblem.pm | 2 +- .../ContentGenerator/Achievements.html.ep | 10 +- .../Achievements/achievement_items.html.ep | 11 +- .../Achievements/cheevobigbox.html.ep | 4 +- .../Base/error_output.html.ep | 7 +- .../Base/feedback_macro_email.html.ep | 9 +- .../Base/feedback_macro_form.html.ep | 6 +- .../ContentGenerator/Base/footer.html.ep | 2 +- templates/ContentGenerator/Base/links.html.ep | 146 +- .../Base/login_status.html.ep | 22 +- .../Base/warning_output.html.ep | 2 +- .../ContentGenerator/CourseAdmin.html.ep | 24 +- .../CourseAdmin/add_course_form.html.ep | 8 +- .../archive_course_confirm.html.ep | 10 +- .../CourseAdmin/archive_course_form.html.ep | 6 +- .../CourseAdmin/delete_course_confirm.html.ep | 10 +- .../CourseAdmin/delete_course_form.html.ep | 6 +- .../CourseAdmin/edit_location_form.html.ep | 8 +- .../hide_inactive_course_form.html.ep | 8 +- .../CourseAdmin/manage_location_form.html.ep | 12 +- .../CourseAdmin/registration_form.html.ep | 4 +- .../CourseAdmin/rename_course_confirm.html.ep | 12 +- .../rename_course_confirm_short.html.ep | 10 +- .../CourseAdmin/rename_course_form.html.ep | 6 +- .../unarchive_course_confirm.html.ep | 19 +- .../CourseAdmin/unarchive_course_form.html.ep | 6 +- .../upgrade_course_confirm.html.ep | 8 +- .../CourseAdmin/upgrade_course_form.html.ep | 13 +- .../ContentGenerator/EquationDisplay.html.ep | 4 +- templates/ContentGenerator/Feedback.html.ep | 6 +- .../ContentGenerator/GatewayQuiz.html.ep | 239 ++-- .../ContentGenerator/GatewayQuiz/nav.html.ep | 95 +- templates/ContentGenerator/Grades.html.ep | 4 +- templates/ContentGenerator/Hardcopy.html.ep | 22 +- .../ContentGenerator/Hardcopy/form.html.ep | 10 +- templates/ContentGenerator/Home.html.ep | 10 +- .../Instructor/AchievementEditor.html.ep | 10 +- .../AchievementEditor/save_as_form.html.ep | 6 +- .../AchievementEditor/save_form.html.ep | 4 +- .../Instructor/AchievementList.html.ep | 15 +- .../AchievementList/default_table.html.ep | 27 +- .../AchievementList/edit_table.html.ep | 4 +- .../AchievementList/export_table.html.ep | 2 +- .../AchievementList/import_form.html.ep | 2 +- .../Instructor/AchievementUserEditor.html.ep | 9 +- .../Instructor/AddUsers.html.ep | 14 +- .../Instructor/Assigner.html.ep | 8 +- .../Instructor/Config.html.ep | 12 +- .../Instructor/FileManager.html.ep | 16 +- .../Instructor/FileManager/confirm.html.ep | 2 +- .../Instructor/FileManager/delete.html.ep | 4 +- .../Instructor/FileManager/refresh.html.ep | 10 +- .../FileManager/refresh_edit.html.ep | 4 +- .../Instructor/FileManager/view.html.ep | 4 +- .../ContentGenerator/Instructor/Index.html.ep | 25 +- .../Instructor/LTIUpdate.html.ep | 8 +- .../Instructor/PGProblemEditor.html.ep | 40 +- .../PGProblemEditor/add_problem_form.html.ep | 6 +- .../PGProblemEditor/hardcopy_form.html.ep | 4 +- .../PGProblemEditor/revert_form.html.ep | 8 +- .../PGProblemEditor/save_as_form.html.ep | 28 +- .../PGProblemEditor/save_form.html.ep | 8 +- .../PGProblemEditor/view_form.html.ep | 6 +- .../Instructor/ProblemGrader.html.ep | 33 +- .../Instructor/ProblemSetDetail.html.ep | 100 +- .../Instructor/ProblemSetList.html.ep | 32 +- .../ProblemSetList/set_list_field.html.ep | 8 +- .../ProblemSetList/set_list_row.html.ep | 32 +- .../ProblemSetList/set_list_table.html.ep | 10 +- .../Instructor/Scoring.html.ep | 26 +- .../Instructor/SendMail.html.ep | 12 +- .../Instructor/SendMail/main_form.html.ep | 56 +- .../Instructor/SetMaker.html.ep | 40 +- .../SetMaker/browse_library_panel.html.ep | 4 +- .../browse_library_panel_advanced.html.ep | 2 +- .../SetMaker/browse_local_panel.html.ep | 4 +- .../Instructor/SetMaker/problem_row.html.ep | 29 +- .../Instructor/SetMaker/top_row.html.ep | 18 +- .../Instructor/ShowAnswers.html.ep | 2 +- .../ShowAnswers/instructor-selectors.html.ep | 16 +- .../ShowAnswers/past-answers-table.html.ep | 6 +- .../ContentGenerator/Instructor/Stats.html.ep | 14 +- .../Instructor/Stats/index.html.ep | 15 +- .../Instructor/Stats/problem_menu.html.ep | 27 +- .../Instructor/Stats/problem_stats.html.ep | 24 +- .../Instructor/Stats/set_stats.html.ep | 43 +- .../Instructor/Stats/siblings.html.ep | 26 +- .../Stats/student_filter_menu.html.ep | 12 +- .../Instructor/Stats/student_stats.html.ep | 11 +- .../Instructor/StudentProgress.html.ep | 6 +- .../StudentProgress/set_progress.html.ep | 56 +- .../Instructor/UserDetail.html.ep | 47 +- .../UserDetail/set_date_table.html.ep | 2 +- .../Instructor/UserDetail/set_row.html.ep | 18 +- .../Instructor/UserList.html.ep | 31 +- .../Instructor/UserList/user_list.html.ep | 14 +- .../UserList/user_list_field.html.ep | 8 +- .../Instructor/UserList/user_row.html.ep | 32 +- .../Instructor/UsersAssignedToSet.html.ep | 17 +- templates/ContentGenerator/Login.html.ep | 4 +- .../ContentGenerator/LoginProctor.html.ep | 8 +- templates/ContentGenerator/Logout.html.ep | 10 +- templates/ContentGenerator/Options.html.ep | 44 +- templates/ContentGenerator/Problem.html.ep | 57 +- .../Problem/checkboxes.html.ep | 4 +- .../ContentGenerator/Problem/messages.html.ep | 20 +- .../Problem/student_nav.html.ep | 22 +- .../Problem/submit_buttons.html.ep | 17 +- templates/ContentGenerator/ProblemSet.html.ep | 24 +- .../ContentGenerator/ProblemSet/info.html.ep | 17 +- .../ProblemSet/problem_list.html.ep | 12 +- .../ProblemSet/problem_list_row.html.ep | 24 +- .../ProblemSet/siblings.html.ep | 11 +- .../ProblemSet/version_list.html.ep | 48 +- .../ContentGenerator/ProblemSets.html.ep | 24 +- .../ContentGenerator/ProblemSets/info.html.ep | 14 +- .../ShowMeAnother/messages.html.ep | 22 +- 225 files changed, 7933 insertions(+), 11207 deletions(-) delete mode 100644 lib/Mojolicious/WeBWorK/Controller/Handler.pm create mode 100644 lib/WeBWorK/Controller.pm delete mode 100644 lib/WeBWorK/FakeRequest.pm delete mode 100644 lib/WeBWorK/Request.pm delete mode 100644 lib/WeBWorK/URLPath.pm create mode 100644 lib/WeBWorK/Utils/Routes.pm rename lib/{Mojolicious/WeBWorK/Controller => WebworkSOAP}/SOAP.pm (93%) diff --git a/htdocs/themes/math4/system.html.ep b/htdocs/themes/math4/system.html.ep index c7e546326b..87d8df7f56 100644 --- a/htdocs/themes/math4/system.html.ep +++ b/htdocs/themes/math4/system.html.ep @@ -1,5 +1,5 @@ -output_course_lang_and_dir %>> +output_course_lang_and_dir %>> @@ -20,44 +20,44 @@ % ################################################################################ % + href="<%= $c->url({ type => 'webwork', name => 'htdocs', file => 'images/favicon.ico' }) %>"> % % # CSS Loads -<%= stylesheet $cg->url({ type => 'webwork', name => 'theme', file => 'bootstrap.css' }) =%> -<%= stylesheet $cg->url({ +<%= stylesheet $c->url({ type => 'webwork', name => 'theme', file => 'bootstrap.css' }) =%> +<%= stylesheet $c->url({ type => 'webwork', name => 'htdocs', file => 'node_modules/@fortawesome/fontawesome-free/css/all.min.css' }) =%> -<%= stylesheet $cg->url({ type => 'webwork', name => 'theme', file => 'math4.css' }) =%> +<%= stylesheet $c->url({ type => 'webwork', name => 'theme', file => 'math4.css' }) =%> <%= content 'css' =%> -% if ($cg->exists_theme_file('math4-overrides.css')) { - <%= stylesheet $cg->url({ type => 'webwork', name => 'theme', file => 'math4-overrides.css' }) =%> +% if ($c->exists_theme_file('math4-overrides.css')) { + <%= stylesheet $c->url({ type => 'webwork', name => 'theme', file => 'math4-overrides.css' }) =%> % } % % # Webwork configuration for javascript - + % % # JS Loads -<%= javascript $cg->url({ type => 'webwork', name => 'htdocs', file => 'js/apps/MathJaxConfig/mathjax-config.js' }), +<%= javascript $c->url({ type => 'webwork', name => 'htdocs', file => 'js/apps/MathJaxConfig/mathjax-config.js' }), defer => undef =%> -<%= javascript $cg->url({ type => 'webwork', name => 'htdocs', file => 'node_modules/mathjax/es5/tex-svg.js' }), +<%= javascript $c->url({ type => 'webwork', name => 'htdocs', file => 'node_modules/mathjax/es5/tex-svg.js' }), id => 'MathJax-script', defer => undef =%> -<%= javascript $cg->url({ type => 'webwork', name => 'htdocs', file => 'node_modules/jquery/dist/jquery.min.js' }) %> -<%= javascript $cg->url({ +<%= javascript $c->url({ type => 'webwork', name => 'htdocs', file => 'node_modules/jquery/dist/jquery.min.js' }) %> +<%= javascript $c->url({ type => 'webwork', name => 'htdocs', file => 'node_modules/bootstrap/dist/js/bootstrap.bundle.min.js' }), defer => undef =%> -<%= javascript $cg->url({ type => 'webwork', name => 'theme', file => 'math4.js' }), defer => undef =%> +<%= javascript $c->url({ type => 'webwork', name => 'theme', file => 'math4.js' }), defer => undef =%> <%= content 'js' =%> -% if ($cg->exists_theme_file('math4-overrides.js')) { - <%= javascript $cg->url({ type => 'webwork', name => 'theme', file => 'math4-overrides.js' }), defer => undef =%> +% if ($c->exists_theme_file('math4-overrides.js')) { + <%= javascript $c->url({ type => 'webwork', name => 'theme', file => 'math4-overrides.js' }), defer => undef =%> % } % -% if ($cg->can('head')) { - <%== $cg->head =%> +% if ($c->can('head')) { + <%== $c->head =%> % } % -<%= $cg->path({ style => 'text', text => ' : ', textonly => '1' }) %> +<%= $c->path({ style => 'text', text => ' : ', textonly => '1' }) %> % @@ -66,14 +66,14 @@
      % # Header % # Breadcrumb
      % # Navigation - % if ($cg->can('links') || $cg->can('siblings') || $cg->can('options')) { + % if ($c->can('links') || $c->can('siblings') || $c->can('options')) { % } % % # Main Content Area
      % % # Navigation, e.g.: Prev, Up, Next for homeworks - % if ($cg->can('nav')) { - <%= $cg->nav({ style => 'buttons', separator => '' }) =%> + % if ($c->can('nav')) { + <%= $c->nav({ style => 'buttons', separator => '' }) =%> % } % % # Page Title - % if ($cg->can('title')) { + % if ($c->can('page_title')) {
      -

      <%== $cg->title %>

      +

      <%== $c->page_title %>

      % } % % # Message for the user - % if ($cg->can('message')) { -
      <%= $cg->message %>
      + % if ($c->can('message')) { +
      <%= $c->message %>
      % } % % # Indicate presence of perl warnings - % if ($cg->have_warnings) { + % if ($c->have_warnings) {
      -
      <%== $cg->warningMessage %>
      +
      <%== $c->warningMessage %>
      % } % % # Display the page body.
      -
      +
      <%= content =%>
      - % if ($cg->can('info')) { + % if ($c->can('info')) {
      - <%= $cg->info =%> + <%= $c->info =%>
      % }
      % - % if ($cg->have_warnings) { -
      <%= $cg->warnings %>
      + % if ($c->have_warnings) { +
      <%= $c->warnings %>
      % } - % if ($cg->can('message')) { -
      <%= $cg->message %>
      + % if ($c->can('message')) { +
      <%= $c->message %>
      % }
      diff --git a/lib/Caliper/Event.pm b/lib/Caliper/Event.pm index 2745f7bd1c..10d60aa7e3 100644 --- a/lib/Caliper/Event.pm +++ b/lib/Caliper/Event.pm @@ -14,13 +14,13 @@ use Caliper::Sensor; # Constructor sub add_defaults { - my ($r, $event_hash) = @_; - my $ce = $r->{ce}; - my $db = $r->{db}; + my ($c, $event_hash) = @_; + my $ce = $c->ce; + my $db = $c->db; my $ug = new Data::UUID; - my $user_id = $r->param('user'); - my $session_key = $r->param('key'); + my $user_id = $c->param('user'); + my $session_key = $c->param('key'); my $uuid = $ug->create_str; my $actor = Caliper::Actor::generate_actor($ce, $db, $user_id); diff --git a/lib/Caliper/Sensor.pm b/lib/Caliper/Sensor.pm index 07d1f22bb3..84c3b80cda 100644 --- a/lib/Caliper/Sensor.pm +++ b/lib/Caliper/Sensor.pm @@ -36,20 +36,20 @@ sub caliperEnabled { } sub sendEvent { - my ($self, $r, $event_hash) = @_; + my ($self, $c, $event_hash) = @_; - return $self->sendEvents($r, [$event_hash]); + return $self->sendEvents($c, [$event_hash]); } sub sendEvents { - my ($self, $r, $array_of_events) = @_; + my ($self, $c, $array_of_events) = @_; return 0 unless $self->caliperEnabled(); for my $event_hash (@$array_of_events) { - Caliper::Event::add_defaults($r, $event_hash); + Caliper::Event::add_defaults($c, $event_hash); } - my $ce = $r->{ce}; + my $ce = $c->ce; my $resource_iri = Caliper::ResourseIri->new($ce); my $async = HTTP::Async->new; $async->timeout(5); diff --git a/lib/FormatRenderedProblem.pm b/lib/FormatRenderedProblem.pm index 011150fd83..51f81d6a66 100644 --- a/lib/FormatRenderedProblem.pm +++ b/lib/FormatRenderedProblem.pm @@ -62,7 +62,7 @@ sub formatRenderedProblem { $forbidGradePassback = 1; # due to render error } - my $SITE_URL = $ws->r->server_root_url; + my $SITE_URL = $ws->c->server_root_url; my $displayMode = $ws->{inputs_ref}{displayMode} // 'MathJax'; @@ -159,7 +159,7 @@ sub formatRenderedProblem { # Do not produce an AttemptsTable when we had a rendering error. if (!$renderErrorOccurred) { my $tbl = WeBWorK::HTML::AttemptsTable->new( - $rh_result->{answers} // {}, $ws->r, + $rh_result->{answers} // {}, $ws->c, answersSubmitted => $ws->{inputs_ref}{answersSubmitted} // 0, answerOrder => $rh_result->{flags}{ANSWER_ENTRY_ORDER} // [], displayMode => $displayMode, @@ -231,7 +231,7 @@ sub formatRenderedProblem { $output->{pg_version} = $ce->{PG_VERSION}; # Convert to JSON and render. - $ws->r->render(data => JSON->new->utf8(0)->encode($output)); + $ws->c->render(data => JSON->new->utf8(0)->encode($output)); } # Setup arnd render the appropriate template in the templates/RPCRenderFormats folder depending on the outputformat. @@ -245,7 +245,7 @@ sub formatRenderedProblem { lh => WeBWorK::Localize::getLangHandle($ws->{inputs_ref}{language} // 'en'), rh_result => $rh_result, SITE_URL => $SITE_URL, - FORM_ACTION_URL => $SITE_URL . $ws->r->webwork_url . '/render_rpc', + FORM_ACTION_URL => $SITE_URL . $ws->c->webwork_url . '/render_rpc', COURSE_LANG_AND_DIR => get_lang_and_dir($formLanguage), theme => $ws->{inputs_ref}{theme} || $ce->{defaultTheme}, courseID => $ws->{inputs_ref}{courseID} // '', @@ -283,9 +283,9 @@ sub formatRenderedProblem { pretty_print => \&pretty_print ); - return $ws->r->render(%template_params) if $formatName eq 'json' || !$ws->{inputs_ref}{send_pg_flags}; - return $ws->r->render( - json => { html => $ws->r->render_to_string(%template_params), pg_flags => $rh_result->{flags} }); + return $ws->c->render(%template_params) if $formatName eq 'json' || !$ws->{inputs_ref}{send_pg_flags}; + return $ws->c->render( + json => { html => $ws->c->render_to_string(%template_params), pg_flags => $rh_result->{flags} }); } sub saveGradeToLTI { @@ -378,22 +378,22 @@ EOS $response->content =~ /\s*(\w+)\s*<\/imsx_codeMajor>/; my $message = $1; if ($message ne 'success') { - $LTIGradeMessage = $ws->r->tag('p', "Unable to update LMS grade. Error: $message")->to_string; + $LTIGradeMessage = $ws->c->tag('p', "Unable to update LMS grade. Error: $message")->to_string; push(@{ $rh_result->{debug_messages} }, xml_escape($response->content)); } else { - $LTIGradeMessage = $ws->r->tag('p', 'Grade sucessfully saved.')->to_string; + $LTIGradeMessage = $ws->c->tag('p', 'Grade sucessfully saved.')->to_string; } } else { - $LTIGradeMessage = $ws->r->tag('p', 'Unable to update LMS grade. Error: ' . $response->message)->to_string; + $LTIGradeMessage = $ws->c->tag('p', 'Unable to update LMS grade. Error: ' . $response->message)->to_string; push(@{ $rh_result->{debug_messages} }, xml_escape($response->content)); } } # save parameters for next time - $LTIGradeMessage .= $ws->r->hidden_field(lis_outcome_service_url => $request_url)->to_string; - $LTIGradeMessage .= $ws->r->hidden_field(oauth_consumer_key => $consumer_key)->to_string; - $LTIGradeMessage .= $ws->r->hidden_field(oauth_signature_method => $signature_method)->to_string; - $LTIGradeMessage .= $ws->r->hidden_field(lis_result_sourcedid => $sourcedid)->to_string; + $LTIGradeMessage .= $ws->c->hidden_field(lis_outcome_service_url => $request_url)->to_string; + $LTIGradeMessage .= $ws->c->hidden_field(oauth_consumer_key => $consumer_key)->to_string; + $LTIGradeMessage .= $ws->c->hidden_field(oauth_signature_method => $signature_method)->to_string; + $LTIGradeMessage .= $ws->c->hidden_field(lis_result_sourcedid => $sourcedid)->to_string; return $LTIGradeMessage; } diff --git a/lib/HardcopyRenderedProblem.pm b/lib/HardcopyRenderedProblem.pm index 918cd390ff..91022bcb31 100644 --- a/lib/HardcopyRenderedProblem.pm +++ b/lib/HardcopyRenderedProblem.pm @@ -33,7 +33,7 @@ use Mojo::File qw(path tempdir); sub hardcopyRenderedProblem { my $ws = shift; # $ws is a WebworkWebservice object. - my $r = $ws->r; + my $c = $ws->c; my $ce = $ws->ce; my $rh_result = $ws->return_object; @@ -94,9 +94,9 @@ sub hardcopyRenderedProblem { # Send the pdf file if it was successfully generated with no errors. my $pdf_file = $working_dir->child('hardcopy.pdf'); if (-e $pdf_file && !@errors) { - $r->res->headers->content_type('application/pdf'); - $r->res->headers->add('Content-Disposition' => qq{attachment; filename=$returnFileName.pdf}); - $r->reply->file($pdf_file); + $c->res->headers->content_type('application/pdf'); + $c->res->headers->add('Content-Disposition' => qq{attachment; filename=$returnFileName.pdf}); + $c->reply->file($pdf_file); return; } } @@ -108,9 +108,9 @@ sub hardcopyRenderedProblem { # Send the zip file if it exists. my $zip_file = $temp_dir_path->child('hardcopy.zip'); if (-e $zip_file) { - $r->res->headers->content_type('application/zip'); - $r->res->headers->add('Content-Disposition' => qq{attachment; filename=$returnFileName.zip}); - $r->reply->file($zip_file); + $c->res->headers->content_type('application/zip'); + $c->res->headers->add('Content-Disposition' => qq{attachment; filename=$returnFileName.zip}); + $c->reply->file($zip_file); return; } @@ -126,7 +126,7 @@ sub generate_hardcopy_tex { my $src_file = $working_dir->child('hardcopy.tex'); # Copy the common tex files into the working directory - my $ce = $ws->r->ce; + my $ce = $ws->c->ce; my $common_dir = path($ce->{webworkDirs}{texinputs_common}); for (qw{packages.tex CAPA.tex PGML.tex}) { eval { $common_dir->child($_)->copy_to($working_dir) }; @@ -181,8 +181,8 @@ sub generate_hardcopy_pdf { # Call pdflatex my $pdflatex_cmd = 'TEXINPUTS=.:' - . shell_quote($ws->r->ce->{webworkDirs}{texinputs_common}) . ': ' - . $ws->r->ce->{externalPrograms}{pdflatex} + . shell_quote($ws->c->ce->{webworkDirs}{texinputs_common}) . ': ' + . $ws->c->ce->{externalPrograms}{pdflatex} . ' > pdflatex.stdout 2> pdflatex.stderr hardcopy'; if (my $rawexit = system $pdflatex_cmd) { @@ -202,8 +202,8 @@ sub generate_hardcopy_pdf { sub write_tex { my ($ws, $FH, $errors) = @_; - my $r = $ws->r; - my $ce = $r->ce; + my $c = $ws->c; + my $ce = $c->ce; # Determine snippets theme directory. my $themeDir = "$ce->{webworkDirs}{conf}/snippets/hardcopyThemes/" @@ -218,7 +218,7 @@ sub write_tex { sub write_problem_tex { my ($ws, $FH) = @_; - my $r = $ws->r; + my $c = $ws->c; my $rh_result = $ws->return_object; @@ -233,7 +233,7 @@ sub write_problem_tex { if (@ans_entry_order) { my $correctTeX = "\n\n\\vspace{\\baselineskip}\\par{\\small{\\it " - . $r->maketext("Correct Answers:") + . $c->maketext("Correct Answers:") . "}\n\\begin{itemize}\n"; for (@ans_entry_order) { @@ -253,7 +253,7 @@ sub write_problem_tex { # If there are any PG warnings and the view_problem_debugging_info parameter was set, # then append the warnings to end of the tex file. if ($ws->{inputs_ref}{view_problem_debugging_info} && $rh_result->{pg_warnings}) { - print $FH "\n\n\\vspace{\\baselineskip}\\par\n" . $r->maketext('Warning messages:') . "\n\\begin{itemize}\n"; + print $FH "\n\n\\vspace{\\baselineskip}\\par\n" . $c->maketext('Warning messages:') . "\n\\begin{itemize}\n"; for (split("\n", $rh_result->{pg_warnings})) { print $FH "\\item \\verb|$_|\n"; } diff --git a/lib/Mojolicious/WeBWorK.pm b/lib/Mojolicious/WeBWorK.pm index 45ad8f3817..fadf3ab54d 100644 --- a/lib/Mojolicious/WeBWorK.pm +++ b/lib/Mojolicious/WeBWorK.pm @@ -14,6 +14,7 @@ ################################################################################ package Mojolicious::WeBWorK; +use Mojo::Base 'Mojolicious', -signatures, -async_await; =head1 NAME @@ -21,11 +22,12 @@ Mojolicious::WeBWorK - Mojolicious app for WeBWorK 2. =cut -use Mojo::Base 'Mojolicious', -signatures; use Env qw(WEBWORK_SERVER_ADMIN); use WeBWorK; use WeBWorK::CourseEnvironment; +use WeBWorK::Utils qw(x writeTimingLogEntry); +use WeBWorK::Utils::Routes qw(setup_content_generator_routes); sub startup ($app) { # Set up logging. @@ -80,9 +82,10 @@ sub startup ($app) { $app->helper( maketext => sub ($c, @args) { - return $c->language_handle->(@args); + return $args[0] unless $c->stash->{language_handle}; + return $c->stash->{language_handle}->(@args); # Comment out the above line and uncomment below to check that your strings are run through maketext. - #return 'xXx' . $c->language_handle->(@args) . 'xXx'; + #return 'xXx' . $c->stash->{language_handle}->(@args) . 'xXx'; } ); @@ -101,8 +104,52 @@ sub startup ($app) { ); } + $app->hook( + around_action => async sub ($next, $c, $action, $last) { + return $next->() unless $c->isa('WeBWorK::ContentGenerator'); + + my $uri = $c->req->url->path->to_string; + $c->stash->{warnings} //= ''; + + $c->stash->{orig_sig_warn} = $SIG{__WARN__}; + + $SIG{__WARN__} = sub { + my ($warning) = @_; + chomp $warning; + $c->stash->{warnings} .= "$warning\n"; + $c->log->warn("[$uri] $warning"); + }; + + $c->timing->begin('content_generator_rendering'); + + my ($result, $message) = eval { await WeBWorK::dispatch($c) }; + return $c->reply->exception($@) if $@; + return $c->render(text => $message, status => 404) if !$result && $message; + return $next->() if $result; + + return 0; + } + ); + + $app->hook( + after_dispatch => sub ($c) { + $SIG{__WARN__} = $c->stash->{orig_sig_warn} if defined $c->stash->{orig_sig_warn}; + + if ($c->isa('WeBWorK::ContentGenerator') && $c->ce) { + writeTimingLogEntry( + $c->ce, + '[' . $c->url_for . ']', + sprintf('runTime = %.3f sec', $c->timing->elapsed('content_generator_rendering')) . ' ' + . $c->ce->{dbLayoutName}, + '' + ); + } + } + ); + # Router my $r = $app->routes; + push(@{ $r->namespaces }, 'WeBWorK::ContentGenerator'); # Provide access to webwork2 and pg resources. A resource from $webwork_htdocs_dir is used if present, then # $pg_dir/htdocs is checked if the file is not found there. @@ -127,7 +174,7 @@ sub startup ($app) { # Provide access to course-specific resources. $r->any( - "$webwork_courses_url/:course/*static" => sub ($c) { + "$webwork_courses_url/#course/*static" => sub ($c) { my $file = "$webwork_courses_dir/" . $c->stash('course') . '/html/' . $c->stash('static'); return $c->reply->file($file) if -r $file; return $c->render(data => 'File not found', status => 404); @@ -148,9 +195,10 @@ sub startup ($app) { # comparison, and in perl all strings containing alphabetic characters are numerically equal. So if this is not # numeric all keys that are passed in will succeed in authentication. Very dangerous! if ($config->{soap_authen_key} =~ /^\d*$/) { - $app->log->info("SOAP endpoints enabled"); + $app->log->info('SOAP endpoints enabled'); $WeBWorK::SeedCE{soap_authen_key} = $config->{soap_authen_key}; + push(@{ $r->namespaces }, 'WebworkSOAP'); $r->any('/webwork2_wsdl')->to('SOAP#wsdl'); $r->post('/webwork2_rpc')->to('SOAP#dispatch'); } else { @@ -159,10 +207,15 @@ sub startup ($app) { } } - # Send all routes under $webwork_url to the handler. # Note that these routes must come last to support the case that $webwork_url is '/'. - $r->any($webwork_url)->to('Handler#handler'); - $r->any("$webwork_url/*path-info")->to('Handler#handler'); + + my $cg_r = $r->under($webwork_url)->name('root'); + $cg_r->get('/')->to('Home#go')->name('root'); + + # The course admin route is set up here because of its special stash value. + $cg_r->any('/admin')->to('CourseAdmin#go', courseID => 'admin')->name('course_admin'); + + setup_content_generator_routes($cg_r); $r->any( '/' => sub ($c) { diff --git a/lib/Mojolicious/WeBWorK/Controller/Handler.pm b/lib/Mojolicious/WeBWorK/Controller/Handler.pm deleted file mode 100644 index 0767b77293..0000000000 --- a/lib/Mojolicious/WeBWorK/Controller/Handler.pm +++ /dev/null @@ -1,118 +0,0 @@ -################################################################################ -# WeBWorK Online Homework Delivery System -# Copyright © 2000-2022 The WeBWorK Project, https://github.com/openwebwork -# -# This program is free software; you can redistribute it and/or modify it under -# the terms of either: (a) the GNU General Public License as published by the -# Free Software Foundation; either version 2, or (at your option) any later -# version, or (b) the "Artistic License" which comes with this package. -# -# This program is distributed in the hope that it will be useful, but WITHOUT -# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS -# FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the -# Artistic License for more details. -################################################################################ - -package Mojolicious::WeBWorK::Controller::Handler; - -=head1 NAME - -Mojolicious::WeBWorK::Controller::Handler - This controller dispatches -requests to the main WeBWorK dispatcher. - -=cut - -use Mojo::Base 'WeBWorK::Request', -signatures, -async_await; -use JSON::MaybeXS; - -async sub handler ($c) { - my $uri = $c->req->url->path->to_string; - - $c->stash->{warnings} = ''; - - my $tx = $c->render_later->tx; - - # This can not be defined "local" below or Future::AsyncAwait will panic. - # Instead save the warning handler and restore it later. - my $origWarn = $SIG{__WARN__}; - - $SIG{__WARN__} = sub { - my ($warning) = @_; - chomp $warning; - $c->stash->{warnings} .= "$warning\n"; - $c->log->warn("[$uri] $warning"); - }; - - await WeBWorK::dispatch($c); - - $SIG{__WARN__} = $origWarn; - - return; -} - -=head1 ERROR OUTPUT FUNCTIONS - -=over - -=item textMessage($c, $exception, $uuid, $time) - -Format a message for HTML output reporting an exception and any -associated warnings. - -=cut - -sub textMessage ($c, $uuid, $time) { - my $uri = $c->req->url->to_abs->to_string; - - my $exception = $c->stash->{exception} // ''; - - my %headers = %{ $c->req->headers->to_hash }; - # Avoid JSON errors for the value of 'sec-ch-ua'. - if (defined($headers{'sec-ch-ua'})) { - $headers{'sec-ch-ua'} = join('', $headers{'sec-ch-ua'}); - $headers{'sec-ch-ua'} =~ s/\"//g; - } - - my $additional_json = encode_json({ - 'Error record identifier' => $uuid, - Time => $time, - Method => $c->req->method, - URI => $uri, - 'HTTP Headers' => {%headers}, - Warnings => [ defined $c->stash->{warnings} ? split m/\n+/, $c->stash->{warnings} : () ], - }); - - return "[$uuid] [$uri] $additional_json $exception"; -} - -=item jsonMessage($c, $uuid, $time) - -Format a JSON message for log output reporting an exception and any -associated warnings. - -=cut - -sub jsonMessage ($c, $uuid, $time) { - my %headers = %{ $c->req->headers->to_hash }; - # Avoid JSON errors for the value of 'sec-ch-ua'. - if (defined($headers{'sec-ch-ua'})) { - $headers{'sec-ch-ua'} = join('', $headers{'sec-ch-ua'}); - $headers{'sec-ch-ua'} =~ s/\"//g; - } - - return encode_json({ - 'Error record identifier' => $uuid, - Time => $time, - Method => $c->req->method, - URI => $c->req->url->to_abs->to_string, - 'HTTP Headers' => {%headers}, - Warnings => [ defined $c->stash->{warnings} ? split m/\n+/, $c->stash->{warnings} : () ], - Exception => $c->stash->{exception} ? $c->stash->{exception}->to_string : '' - }); -} - -=back - -=cut - -1; diff --git a/lib/WeBWorK.pm b/lib/WeBWorK.pm index 77f7ce4f84..a9dce3ebd8 100644 --- a/lib/WeBWorK.pm +++ b/lib/WeBWorK.pm @@ -14,34 +14,34 @@ ################################################################################ package WeBWorK; +use Mojo::Base -signatures, -async_await; =head1 NAME -WeBWorK - Dispatch requests to the appropriate content generator. +WeBWorK - Check authentication and initialize the course environment for a +content generator controller action. =head1 SYNOPSIS - my $result = eval { WeBWorK::dispatch($c) }; + my $result = eval { await WeBWorK::dispatch($c) }; die "something bad happened: $@" if $@; =head1 DESCRIPTION -C is the dispatcher for the WeBWorK system. Given a Mojolicious::Controller -object, it performs authentication and determines which subclass of -C to call. +C is the content generator initializer for the WeBWorK system. It +performs authentication and initializes the course environment. If +authentication is needed, then it renders the WeBWorK::ContentGenerator::Login +module. If proctor authentication is needed, then it renders the +WeBWorK::ContentGenerator::LoginProctor module. Otherwise it returns control to +the action of the content generator module for the designated route. =cut -use strict; -use warnings; - use Time::HiRes qw/time/; -use HTML::Entities qw/encode_entities/; -use Future::AsyncAwait; use WeBWorK::Localize; -# load WeBWorK::Constants before anything else -# this sets package variables in several packages + +# Load WeBWorK::Constants before anything else. This sets package variables in several packages. use WeBWorK::Constants; use WeBWorK::Authen; @@ -49,40 +49,26 @@ use WeBWorK::Authz; use WeBWorK::CourseEnvironment; use WeBWorK::DB; use WeBWorK::Debug; -use WeBWorK::Request; use WeBWorK::Upload; -use WeBWorK::URLPath; -use WeBWorK::Utils qw(runtime_use writeTimingLogEntry); - -use constant LOGIN_MODULE => "WeBWorK::ContentGenerator::Login"; -use constant PROCTOR_LOGIN_MODULE => "WeBWorK::ContentGenerator::LoginProctor"; - -BEGIN { - # pre-compile all content generators - # Login and LoginProctor need to be handled separately, since they don't have paths - map { eval "require $_"; die $@ if $@ } - WeBWorK::URLPath->all_modules, - LOGIN_MODULE, - PROCTOR_LOGIN_MODULE; - # other candidates for preloading: - # - DB Record, Schema, and Driver classes (esp. Driver::SQL as it loads DBI) - # - CourseManagement subclasses (ditto. sql_single.pm) - # - WeBWorK::PG, which loads WeBWorK::PG::Translator - # - Authen subclasses -} +use WeBWorK::Utils qw(runtime_use); +use WeBWorK::ContentGenerator::Login; +use WeBWorK::ContentGenerator::LoginProctor; our %SeedCE; -async sub dispatch { - my $r = shift; +# This will either return 0 or 1. If it returns 1, then the around_action hook will render the content generator module +# for the path. If it returns 0, then it either must render (login or proctor login) or it must also return a message +# indicating why it didn't render. This can also throw an exception in which case the around_action hook will render +# the exception template. +async sub dispatch ($c) { + # Cache the initial submission time. This can be used at any point throughout processing of this request. + # Note that this is Time::HiRes's time, which gives floating point values. + $c->submitTime(time); - $r->submitTime(time); # this is Time::HiRes's time, which gives floating point values - - my $method = $r->req->method; - my $location = $r->location; - my $uri = $r->uri; - my $path_info = $r->stash('path-info') || ''; - my $args = $r->req->params->to_string || ''; + my $method = $c->req->method; + my $location = $c->location; + my $uri = $c->url_for; + my $args = $c->req->params->to_string || ''; debug("\n\n===> Begin " . __PACKAGE__ . "::dispatch() <===\n\n"); debug("Hi, I'm the new dispatcher!\n"); @@ -92,87 +78,53 @@ async sub dispatch { debug("The site location is $location\n"); debug("The request method is $method\n"); debug("The URI is $uri\n"); - debug("The path-info is $path_info\n"); debug("The argument string is $args\n"); - debug(("-" x 80) . "\n"); - - debug("The first thing we need to do is munge the path a little:\n"); + debug(('-' x 80) . "\n"); - ###################################################################### - # Create a URLPath object - ###################################################################### my ($path) = $uri =~ m/$location(.*)/; - $path = "/" if $path eq ""; # no path at all - - debug("We can't trust the path-info, so we make our own path.\n"); - debug("path-info claims: $path_info\n"); - debug("but it's really: $path\n"); - debug("(if it's empty, we set it to \"/\".)\n"); - - $path =~ s|/+|/|g; - debug("...and here it is without repeated slashes: $path\n"); - - # lookbehind assertion for "not a slash" - # matches the boundary after the last char - $path =~ s|(?<=[^/])$|/|; - debug("...and here it is with a trailing slash: $path\n"); - - debug(("-" x 80) . "\n"); - - debug("Now we need to look at the path a little to figure out where we are\n"); - - debug("-------------------- call to WeBWorK::URLPath::newFromPath\n"); - my $urlPath = WeBWorK::URLPath->newFromPath($path, $r); - # pointer to parent request for access to the $ce and language translation ability - # need to add this pointer whenever a new URLPath is created. - debug("-------------------- call to WeBWorK::URLPath::newFromPath\n"); - - unless ($urlPath) { - debug("This path is invalid... see you later!\n"); - die "The path '$path' is not valid.\n"; - } - - my $displayModule = $urlPath->module; - my %displayArgs = $urlPath->args; - - unless ($displayModule) { - debug("The display module is empty, so we can DECLINE here.\n"); - $path = encode_entities($path); - die "No display module found for path '$path'."; - } - - if ($urlPath->type =~ /^render_rpc|instructor_rpc|html2xml$/) { - $r->{rpc} = 1; - - $r->adaptLegacyParameters if $urlPath->type eq 'html2xml'; + $path .= '/' if $path !~ m(/$); + debug("The path is $path\n"); + + debug("The current route is " . $c->current_route . "\n"); + debug("Here is some information about this route:\n"); + + my $displayModule = ref $c; + my %routeCaptures = %{ $c->stash->{'mojo.captures'} }; + + if ($c->current_route =~ /^render_rpc|instructor_rpc|html2xml$/) { + $c->{rpc} = 1; + + # This provides compatibility for legacy html2xml parameters. + # This should be deleted when the html2xml endpoint is removed. + if ($c->current_route eq 'html2xml') { + for ( + [ 'userID', 'user' ], + [ 'courseName', 'courseID' ], + [ 'course_password', 'passwd' ], + [ 'session_key', 'key' ] + ) + { + $c->param($_->[1], $c->param($_->[0])) if defined $c->param($_->[0]) && !defined $c->param($_->[1]); + } + } # Get the courseID from the parameters for a remote procedure call. - $displayArgs{courseID} = $r->param('courseID') if $r->param('courseID'); + $routeCaptures{courseID} = $c->param('courseID') if $c->param('courseID'); } - debug("The display module for this path is: $displayModule\n"); - debug("...and here are the arguments we'll pass to it:\n"); - foreach my $key (keys %displayArgs) { - debug("\t$key => $displayArgs{$key}\n"); + debug("The display module for this route is $displayModule\n"); + debug("This route has the following captures:\n"); + for my $key (keys %routeCaptures) { + debug("\t$key => $routeCaptures{$key}\n"); } - my $selfPath = $urlPath->path; - my $parent = $urlPath->parent; - my $parentPath = $parent ? $parent->path : ""; - - debug("Reconstructing the original path gets us: $selfPath\n"); - debug("And we can generate the path to our parent, too: $parentPath\n"); - debug("(We could also figure out who our children are, but we'd need to supply additional arguments.)\n"); - debug(("-" x 80) . "\n"); - - debug("The URLPath looks good, we'll add it to the request.\n"); - $r->urlpath($urlPath); + debug(('-' x 80) . "\n"); debug("Now we want to look at the parameters we got.\n"); debug("The raw params:\n"); - foreach my $key ($r->param) { - #make it so we dont debug plain text passwords + for my $key ($c->param) { + # Make it so we dont debug plain text passwords my $vals; if ($key eq 'passwd' || $key eq 'confirmPassword' @@ -182,278 +134,125 @@ async sub dispatch { { $vals = '**********'; } else { - my @vals = $r->param($key); - $vals = join(", ", map {"'$_'"} @vals); + my @vals = $c->param($key); + $vals = join(', ', map {qq{"$_"}} @vals); } debug("\t$key => $vals\n"); } - #mungeParams($r); - # - #debug("The munged params:\n"); - #foreach my $key ($r->param) { - # debug("\t$key\n"); - # debug("\t\t$_\n") foreach $r->param($key); - #} - - debug(("-" x 80) . "\n"); + debug(('-' x 80) . "\n"); - #################################################################### - # Create Course Environment $ce - #################################################################### + # Create Course Environment debug("We need to get a course environment (with or without a courseID!)\n"); - my $ce = eval { new WeBWorK::CourseEnvironment({ %SeedCE, courseName => $displayArgs{courseID} }) }; + my $ce = eval { WeBWorK::CourseEnvironment->new({ %SeedCE, courseName => $routeCaptures{courseID} }) }; $@ and die "Failed to initialize course environment: $@\n"; debug("Here's the course environment: $ce\n"); - $r->ce($ce); + $c->ce($ce); - ###################### - # Localizing language - ###################### - my $language = $ce->{language} || "en"; - # $r->language_handle( WeBWorK::Localize->get_handle($language) ); - $r->language_handle(WeBWorK::Localize::getLoc($language)); + # Localization + my $language = $ce->{language} || 'en'; + $c->language_handle(WeBWorK::Localize::getLoc($language)); - my @uploads = @{ $r->req->uploads }; + my @uploads = @{ $c->req->uploads }; foreach my $u (@uploads) { - # make sure it's a "real" upload + # Make sure it's a "real" upload. next unless $u->filename; - # store the upload + # Store the upload. my $upload = WeBWorK::Upload->store($u, dir => $ce->{webworkDirs}{uploadCache}); - # store the upload ID and hash in the file upload field + # Store the upload ID and hash in the file upload field. my $id = $upload->id; my $hash = $upload->hash; - $r->param($u->name => "$id $hash"); + $c->param($u->name => "$id $hash"); } - # create these out here. they should fail if they don't have the right information - # this lets us not be so careful about whether these objects are defined when we use them. - # instead, we just create the behavior that if they don't have a valid $db they fail. - my $authz = new WeBWorK::Authz($r); - $r->authz($authz); + # Create these out here. They should fail if they don't have the right information. + # This lets us not be so careful about whether these objects are defined when we use them. + # Instead, we just create the behavior that if they don't have a valid $db they fail. + my $authz = WeBWorK::Authz->new($c); + $c->authz($authz); my $user_authen_module = WeBWorK::Authen::class($ce, 'user_module'); runtime_use $user_authen_module; - my $authen = $user_authen_module->new($r); + my $authen = $user_authen_module->new($c); debug("Using user_authen_module $user_authen_module: $authen\n"); - $r->authen($authen); + $c->authen($authen); my $db; - if ($displayArgs{courseID}) { - debug("We got a courseID from the URLPath, now we can do some stuff:\n"); + if ($routeCaptures{courseID}) { + debug("We got a courseID from the route, now we can do some stuff:\n"); - unless (-e $ce->{courseDirs}->{root}) { - die "Course '$displayArgs{courseID}' not found: $!"; - } + return (0, 'This course does not exist.') unless -e $ce->{courseDirs}{root}; debug("...we can create a database object...\n"); - $db = new WeBWorK::DB($ce->{dbLayout}); + $db = WeBWorK::DB->new($ce->{dbLayout}); debug("(here's the DB handle: $db)\n"); - $r->db($db); + $c->db($db); # Don't check authentication if the user is logging out. if ($displayModule ne 'WeBWorK::ContentGenerator::Logout') { my $authenOK = $authen->verify; if ($authenOK) { - my $userID = $r->param("user"); + my $userID = $c->param('user'); debug("Hi, $userID, glad you made it.\n"); - # tell authorizer to cache this user's permission level + # Tell authorizer to cache this user's permission level $authz->setCachedUser($userID); debug("Now we deal with the effective user:\n"); - my $eUserID = $r->param("effectiveUser") || $userID; + my $eUserID = $c->param('effectiveUser') || $userID; debug("userID=$userID eUserID=$eUserID\n"); if ($userID ne $eUserID) { debug("userID and eUserID differ... seeing if userID has 'become_student' permission.\n"); - my $su_authorized = $authz->hasPermissions($userID, "become_student"); + my $su_authorized = $authz->hasPermissions($userID, 'become_student'); if ($su_authorized) { debug("Ok, looks like you're allowed to become $eUserID. Whoopie!\n"); } else { debug("Uh oh, you're not allowed to become $eUserID. Nice try!\n"); - die "You do not have permission to act as another user. - Close down your browser (this clears temporary cookies), - restart and try again.\n"; + return (0, + "You do not have permission to act as another user.\n" + . 'Close down your browser (this clears temporary cookies), restart and try again.'); } } - # set effectiveUser in case it was changed or not set to begin with - $r->param("effectiveUser" => $eUserID); + # Set effectiveUser in case it was changed or not set to begin with. + $c->param('effectiveUser' => $eUserID); - # if we're doing a proctored test, after the user has been authenticated - # we need to also check on the proctor. note that in the gateway quiz - # module we double check this, to be sure that someone isn't taking a - # proctored quiz but calling the unproctored ContentGenerator - my $urlProducedPath = $urlPath->path(); - if ($urlProducedPath =~ /proctored_test_mode/i) { - my $proctor_authen_module = WeBWorK::Authen::class($ce, "proctor_module"); + # If this is a proctored test, then after the user has been authenticated + # we need to also check on the proctor. Note that in the gateway quiz + # module this is double checked to be sure that someone isn't taking a + # proctored quiz but calling the unproctored ContentGenerator. + if ($c->current_route =~ /^proctored_gateway_quiz|proctored_gateway_proctor_login$/) { + my $proctor_authen_module = WeBWorK::Authen::class($ce, 'proctor_module'); runtime_use $proctor_authen_module; - my $authenProctor = $proctor_authen_module->new($r); + my $authenProctor = $proctor_authen_module->new($c); debug("Using proctor_authen_module $proctor_authen_module: $authenProctor\n"); my $procAuthOK = $authenProctor->verify(); - if (not $procAuthOK) { - $displayModule = PROCTOR_LOGIN_MODULE; + if (!$procAuthOK) { + await WeBWorK::ContentGenerator::LoginProctor->new($c)->go; + return 0; } } + return 1; } else { - debug("Bad news: authentication failed!\n"); # For a remote procedure call continue on to the original display module. # It will give the authentication failure response. - $displayModule = LOGIN_MODULE if !$r->{rpc}; - debug("set displayModule to $displayModule\n"); - } - } - } - - # store the time before we invoke the content generator - my $cg_start = time; # this is Time::HiRes's time, which gives floating point values - - debug(("-" x 80) . "\n"); - debug("Finally, we'll load the display module...\n"); - - runtime_use($displayModule); - - debug("...instantiate it...\n"); - - my $instance = $displayModule->new($r); - - debug("...and call it:\n"); - debug("-------------------- call to ${displayModule}::go\n"); - - my $result = await $instance->go(); - - debug("-------------------- call to ${displayModule}::go\n"); + return 1 if $c->{rpc}; - my $cg_end = time; - my $cg_duration = $cg_end - $cg_start; - writeTimingLogEntry( - $ce, - "[" . $r->uri . "]", - sprintf("runTime = %.3f sec", $cg_duration) . " " . $ce->{dbLayoutName}, "" - ); - - debug("returning result: " . (defined $result ? $result : "UNDEF") . "\n"); - return $result; -} - -sub mungeParams { - my ($r) = @_; - - my @paramQueue; - - # remove all the params from the request, and store them in the param queue - foreach my $key ($r->param) { - push @paramQueue, [ $key => [ $r->param($key) ] ]; - $r->parms->unset($key); - } - - # exhaust the param queue, decoding encoded params - while (@paramQueue) { - my ($key, $values) = @{ shift @paramQueue }; - - if ($key =~ m/\,/) { - # we have multiple params encoded in a single param - # split them up and add them to the end of the queue - push @paramQueue, map { [ $_, $values ] } split m/\,/, $key; - } elsif ($key =~ m/\:/) { - # we have a whole param encoded in a key - # split it up and add it to the end of the queue - my ($newKey, $newValue) = split m/\:/, $key; - push @paramQueue, [ $newKey, [$newValue] ]; - } else { - # this is a "normal" param - # add it to the param list - if (defined $r->param($key)) { - # the param already exists -- append the values we have - $r->param($key => [ $r->param($key), @$values ]); - } else { - # the param doesn't exist -- create it with the values we have - $r->param($key => $values); + debug("Bad news: authentication failed!\n"); + await WeBWorK::ContentGenerator::Login->new($c)->go(); + debug("set displayModule to WeBWorK::ContentGenerator::Login\n"); + return 0; } } } -} -# split_cap subroutine - ghe3 - -# A sort of wrapper for the built-in split function which uses capital letters as a delimiter, and returns a string containing the separated substrings separated by a whitespace. Used to make actionID's more readable. - -sub split_cap { - my $str = shift; - - my @str_arr = split(//, $str); - my $count = scalar(@str_arr); - - my $i = 0; - my $prev = 0; - my @result = (); - my $hasCapital = 0; - foreach (@str_arr) { - if ($_ =~ /[A-Z]/) { - $hasCapital = 1; - push(@result, join("", @str_arr[ $prev .. $i - 1 ])); - $prev = $i; - } - $i++; - } - - unless ($hasCapital) { - return $str; - } else { - push(@result, join("", @str_arr[ $prev .. $count - 1 ])); - return join(" ", @result); - } + return 1; } -# underscore_to_whitespace subroutine - -# a simple subroutine for converting underscores in a given string to whitespace - -sub underscore_to_whitespace { - my $str = shift; - - my @strArr = split("", $str); - foreach (@strArr) { - if ($_ eq "_") { - $_ = " "; - } - } - - my $result = join("", @strArr); - - return $result; -} - -sub remove_duplicates { - my @arr = @_; - - my %unique; - my @result; - - foreach (@arr) { - if (defined $unique{$_}) { - next; - } else { - push(@result, $_); - $unique{$_} = "seen"; - } - } - - return @result; - -} - -=head1 AUTHOR - -Written by Dennis Lambe, malsyned at math.rochester.edu. Modified by Sam -Hathaway, sh002i at math.rochester.edu. - -=cut - 1; diff --git a/lib/WeBWorK/AchievementEvaluator.pm b/lib/WeBWorK/AchievementEvaluator.pm index c26fb831d3..7a7c42bf9b 100644 --- a/lib/WeBWorK/AchievementEvaluator.pm +++ b/lib/WeBWorK/AchievementEvaluator.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::AchievementEvaluator; -use parent qw(Exporter); +use Mojo::Base 'Exporter', -signatures; =head1 NAME @@ -22,9 +22,6 @@ use parent qw(Exporter); =cut -use strict; -use warnings; - use DateTime; use WeBWorK::Utils qw(sortAchievements nfreeze_base64 thaw_base64); @@ -33,11 +30,10 @@ use WWSafe; our @EXPORT_OK = qw(checkForAchievements); -sub checkForAchievements { - my ($problem_in, $pg, $r, %options) = @_; +sub checkForAchievements ($problem_in, $pg, $c, %options) { our $problem = $problem_in; - my $db = $r->db; - my $ce = $r->ce; + my $db = $c->db; + my $ce = $c->ce; # Date and time for course timezone (may differ from the server timezone) # Saved into separate array @@ -45,7 +41,7 @@ sub checkForAchievements { my $dtCourseTime = DateTime->from_epoch(epoch => time(), time_zone => $ce->{siteDefaults}{timezone} || 'local'); # Set up variables and get achievements - my $cheevoMessage = $r->c; + my $cheevoMessage = $c->c; my $user_id = $problem->user_id; my $set_id = $problem->set_id; @@ -246,7 +242,7 @@ sub checkForAchievements { } # Construct the cheevo message using the cheevoMessage template. - push(@$cheevoMessage, $r->include('AchievementEvaluator/cheevoMessage', achievement => $achievement)); + push(@$cheevoMessage, $c->include('AchievementEvaluator/cheevoMessage', achievement => $achievement)); my $points = $achievement->points; #just in case points is an ininitialzied variable @@ -269,7 +265,7 @@ sub checkForAchievements { $db->putGlobalUserAchievement($globalUserAchievement); if (@$cheevoMessage) { - return $r->tag( + return $c->tag( 'div', class => 'cheevo-toast-container toast-container position-absolute top-0 start-50 translate-middle-x p-3', diff --git a/lib/WeBWorK/AchievementItems.pm b/lib/WeBWorK/AchievementItems.pm index ec3f64ceac..81ed8e9bb9 100644 --- a/lib/WeBWorK/AchievementItems.pm +++ b/lib/WeBWorK/AchievementItems.pm @@ -14,12 +14,10 @@ ################################################################################ package WeBWorK::AchievementItems; +use Mojo::Base -signatures; use WeBWorK::Utils qw(thaw_base64); -use strict; -use warnings; - # List of available achievement items. Make sure to add any new items to this list. Furthermore, the elements in this # list have to match the class name of the achievement item classes loaded below. use constant ITEMS => [ qw( @@ -51,14 +49,12 @@ Note: the ID has to match the name of the class. =cut -sub id { return shift->{id}; } -sub name { return shift->{name}; } -sub description { return shift->{description}; } +sub id ($c) { return $c->{id}; } +sub name ($c) { return $c->{name}; } +sub description ($c) { return $c->{description}; } # This is a global method that returns all of the provided users items. -sub UserItems { - my ($userName, $db, $ce) = @_; - +sub UserItems ($userName, $db, $ce) { # return unless the user has global achievement data my $globalUserAchievement = $db->getGlobalUserAchievement($userName); @@ -78,9 +74,7 @@ sub UserItems { # Utility method for outputing a form row with a label and popup menu. # The id, label_text, and values are required parameters. -sub form_popup_menu_row { - my ($r, %options) = @_; - +sub form_popup_menu_row ($c, %options) { my %params = ( id => '', label_text => '', @@ -96,16 +90,16 @@ sub form_popup_menu_row { $params{menu_attr}{class} //= 'form-select'; $params{menu_container_attr}{class} //= 'col-8'; - my $row_contents = $r->c( - $r->label_for($params{id} => $params{label_text}, %{ $params{label_attr} }), - $r->tag( + my $row_contents = $c->c( + $c->label_for($params{id} => $params{label_text}, %{ $params{label_attr} }), + $c->tag( 'div', %{ $params{menu_container_attr} }, - $r->select_field($params{id} => $params{values}, id => $params{id}, %{ $params{menu_attr} }) + $c->select_field($params{id} => $params{values}, id => $params{id}, %{ $params{menu_attr} }) ) )->join(''); - return $params{add_container} ? $r->tag('div', class => 'row mb-3', $row_contents) : $row_contents; + return $params{add_container} ? $c->tag('div', class => 'row mb-3', $row_contents) : $row_contents; } END { diff --git a/lib/WeBWorK/AchievementItems/AddNewTestGW.pm b/lib/WeBWorK/AchievementItems/AddNewTestGW.pm index e28cf4d23b..4ddfaa143a 100644 --- a/lib/WeBWorK/AchievementItems/AddNewTestGW.pm +++ b/lib/WeBWorK/AchievementItems/AddNewTestGW.pm @@ -14,18 +14,13 @@ ################################################################################ package WeBWorK::AchievementItems::AddNewTestGW; -use parent qw(WeBWorK::AchievementItems); +use Mojo::Base 'WeBWorK::AchievementItems', -signatures; # Item to allow students to take an addition test -use strict; -use warnings; - use WeBWorK::Utils qw(before between x nfreeze_base64 thaw_base64 format_set_name_display); -sub new { - my ($class) = @_; - +sub new ($class) { return bless { id => 'AddNewTestGW', name => x('Oil of Cleansing'), @@ -36,11 +31,10 @@ sub new { }, $class; } -sub print_form { - my ($self, $sets, $setProblemCount, $r) = @_; - my $db = $r->db; +sub print_form ($self, $sets, $setProblemCount, $c) { + my $db = $c->db; - my $effectiveUserName = $r->param('effectiveUser') // $r->param('user'); + my $effectiveUserName = $c->param('effectiveUser') // $c->param('user'); my @unfilteredsets = $db->getMergedSets(map { [ $effectiveUserName, $_ ] } $db->listUserSets($effectiveUserName)); my @openGateways; @@ -52,22 +46,21 @@ sub print_form { && between($set->open_date, $set->due_date); } - return $r->c( - $r->tag('p', $r->maketext('Add a new test for which Gateway?')), + return $c->c( + $c->tag('p', $c->maketext('Add a new test for which Gateway?')), WeBWorK::AchievementItems::form_popup_menu_row( - $r, + $c, id => 'adtgw_gw_id', - label_text => $r->maketext('Gateway Name'), + label_text => $c->maketext('Gateway Name'), values => \@openGateways, menu_attr => { dir => 'ltr' } ) )->join(''); } -sub use_item { - my ($self, $userName, $r) = @_; - my $db = $r->db; - my $ce = $r->ce; +sub use_item ($self, $userName, $c) { + my $db = $c->db; + my $ce = $c->ce; # Validate data my $globalUserAchievement = $db->getGlobalUserAchievement($userName); @@ -76,7 +69,7 @@ sub use_item { my $globalData = thaw_base64($globalUserAchievement->frozen_hash); return "You are $self->{id} trying to use an item you don't have" unless $globalData->{ $self->{id} }; - my $setID = $r->param('adtgw_gw_id'); + my $setID = $c->param('adtgw_gw_id'); return 'You need to input a Gateway Name' unless defined $setID; my $set = $db->getMergedSet($userName, $setID); diff --git a/lib/WeBWorK/AchievementItems/DoubleProb.pm b/lib/WeBWorK/AchievementItems/DoubleProb.pm index 5410830095..87155beb0a 100644 --- a/lib/WeBWorK/AchievementItems/DoubleProb.pm +++ b/lib/WeBWorK/AchievementItems/DoubleProb.pm @@ -14,18 +14,13 @@ ################################################################################ package WeBWorK::AchievementItems::DoubleProb; -use parent qw(WeBWorK::AchievementItems); +use Mojo::Base 'WeBWorK::AchievementItems', -signatures; # Item to make a problem worth double. -use strict; -use warnings; - use WeBWorK::Utils qw(between x nfreeze_base64 thaw_base64 format_set_name_display); -sub new { - my ($class) = @_; - +sub new ($class) { return bless { id => 'DoubleProb', name => x('Cupcake of Enlargement'), @@ -33,9 +28,7 @@ sub new { }, $class; } -sub print_form { - my ($self, $sets, $setProblemCount, $r) = @_; - +sub print_form ($self, $sets, $setProblemCount, $c) { # Construct a dropdown with open sets and another with problems. # Javascript ensures the appropriate number of problems are shown for the selected set. @@ -61,33 +54,32 @@ sub print_form { push(@problemIDs, [ $i => $i, $i > $openSets[0][3]{max} ? (style => 'display:none') : () ]); } - return $r->c( - $r->tag( + return $c->c( + $c->tag( 'p', - $r->maketext( + $c->maketext( 'Please choose the set name and problem number of the question which should have its weight doubled.') ), WeBWorK::AchievementItems::form_popup_menu_row( - $r, + $c, id => 'dbp_set_id', - label_text => $r->maketext('Set Name'), + label_text => $c->maketext('Set Name'), values => \@openSets, menu_attr => { dir => 'ltr', data => { problems => 'dbp_problem_id' } } ), WeBWorK::AchievementItems::form_popup_menu_row( - $r, + $c, id => 'dbp_problem_id', - label_text => $r->maketext('Problem Number'), + label_text => $c->maketext('Problem Number'), values => \@problemIDs, menu_container_attr => { class => 'col-3' } ) )->join(''); } -sub use_item { - my ($self, $userName, $r) = @_; - my $db = $r->db; - my $ce = $r->ce; +sub use_item ($self, $userName, $c) { + my $db = $c->db; + my $ce = $c->ce; # Validate data @@ -97,10 +89,10 @@ sub use_item { my $globalData = thaw_base64($globalUserAchievement->frozen_hash); return "You are $self->{id} trying to use an item you don't have" unless $globalData->{ $self->{id} }; - my $setID = $r->param('dbp_set_id'); + my $setID = $c->param('dbp_set_id'); return 'You need to input a Set Name' unless defined $setID; - my $problemID = $r->param('dbp_problem_id'); + my $problemID = $c->param('dbp_problem_id'); return 'You need to input a Problem Number' unless $problemID; my $globalproblem = $db->getMergedProblem($userName, $setID, $problemID); diff --git a/lib/WeBWorK/AchievementItems/DoubleSet.pm b/lib/WeBWorK/AchievementItems/DoubleSet.pm index bc1d4dcdce..603e10ca08 100644 --- a/lib/WeBWorK/AchievementItems/DoubleSet.pm +++ b/lib/WeBWorK/AchievementItems/DoubleSet.pm @@ -14,18 +14,13 @@ ################################################################################ package WeBWorK::AchievementItems::DoubleSet; -use parent qw(WeBWorK::AchievementItems); +use Mojo::Base 'WeBWorK::AchievementItems', -signatures; # Item to make a homework set worth twice as much -use strict; -use warnings; - use WeBWorK::Utils qw(between x nfreeze_base64 thaw_base64 format_set_name_display); -sub new { - my ($class) = @_; - +sub new ($class) { return bless { id => 'DoubleSet', name => x('Cake of Enlargement'), @@ -33,9 +28,7 @@ sub new { }, $class; } -sub print_form { - my ($self, $sets, $setProblemCount, $r) = @_; - +sub print_form ($self, $sets, $setProblemCount, $c) { my @openSets; for my $i (0 .. $#$sets) { @@ -43,22 +36,21 @@ sub print_form { if (between($sets->[$i]->open_date, $sets->[$i]->due_date) && $sets->[$i]->assignment_type eq 'default'); } - return $r->c( - $r->tag('p', $r->maketext('Choose the set which you would like to be worth twice as much.')), + return $c->c( + $c->tag('p', $c->maketext('Choose the set which you would like to be worth twice as much.')), WeBWorK::AchievementItems::form_popup_menu_row( - $r, + $c, id => 'dub_set_id', - label_text => $r->maketext('Set Name'), + label_text => $c->maketext('Set Name'), values => \@openSets, menu_attr => { dir => 'ltr' } ) )->join(''); } -sub use_item { - my ($self, $userName, $r) = @_; - my $db = $r->db; - my $ce = $r->ce; +sub use_item ($self, $userName, $c) { + my $db = $c->db; + my $ce = $c->ce; # Validate data @@ -68,7 +60,7 @@ sub use_item { my $globalData = thaw_base64($globalUserAchievement->frozen_hash); return "You are $self->{id} trying to use an item you don't have" unless $globalData->{ $self->{id} }; - my $setID = $r->param('dub_set_id'); + my $setID = $c->param('dub_set_id'); return 'You need to input a Set Name' unless defined $setID; my $set = $db->getMergedSet($userName, $setID); diff --git a/lib/WeBWorK/AchievementItems/DuplicateProb.pm b/lib/WeBWorK/AchievementItems/DuplicateProb.pm index 4532e72bdf..4757c12d99 100644 --- a/lib/WeBWorK/AchievementItems/DuplicateProb.pm +++ b/lib/WeBWorK/AchievementItems/DuplicateProb.pm @@ -14,18 +14,13 @@ ################################################################################ package WeBWorK::AchievementItems::DuplicateProb; -use parent qw(WeBWorK::AchievementItems); +use Mojo::Base 'WeBWorK::AchievementItems', -signatures; # Item to turn one problem into another problem -use strict; -use warnings; - use WeBWorK::Utils qw(between x nfreeze_base64 thaw_base64 format_set_name_display); -sub new { - my ($class, $r) = @_; - +sub new ($class) { return bless { id => 'DuplicateProb', name => x('Box of Transmogrification'), @@ -33,9 +28,7 @@ sub new { }, $class; } -sub print_form { - my ($self, $sets, $setProblemCount, $r) = @_; - +sub print_form ($self, $sets, $setProblemCount, $c) { # Show open sets and allow for a choice of two problems from the set. my @openSets; @@ -60,41 +53,41 @@ sub print_form { push(@problemIDs, [ $i => $i, $i > $openSets[0][3]{max} ? (style => 'display:none') : () ]); } - return $r->c( - $r->tag( + return $c->c( + $c->tag( 'p', - $r->maketext( + $c->maketext( 'Please choose the set, the problem you would like to copy, ' . 'and the problem you would like to copy it to.' ) ), WeBWorK::AchievementItems::form_popup_menu_row( - $r, + $c, id => 'tran_set_id', - label_text => $r->maketext('Set Name'), + label_text => $c->maketext('Set Name'), values => \@openSets, menu_attr => { dir => 'ltr', data => { problems => 'tran_problem_id', problems2 => 'tran_problem_id2' } } ), - $r->tag( + $c->tag( 'div', class => 'row mb-3', - $r->c( + $c->c( WeBWorK::AchievementItems::form_popup_menu_row( - $r, + $c, id => 'tran_problem_id', values => \@problemIDs, - label_text => $r->maketext('Copy this Problem'), + label_text => $c->maketext('Copy this Problem'), menu_container_attr => { class => 'col-2 ps-0' }, add_container => 0 ), WeBWorK::AchievementItems::form_popup_menu_row( - $r, + $c, id => 'tran_problem_id2', values => \@problemIDs, - label_text => $r->maketext('To this Problem'), + label_text => $c->maketext('To this Problem'), menu_container_attr => { class => 'col-2 ps-0' }, add_container => 0 ) @@ -103,10 +96,9 @@ sub print_form { )->join(''); } -sub use_item { - my ($self, $userName, $r) = @_; - my $db = $r->db; - my $ce = $r->ce; +sub use_item ($self, $userName, $c) { + my $db = $c->db; + my $ce = $c->ce; # Validate data @@ -116,13 +108,13 @@ sub use_item { my $globalData = thaw_base64($globalUserAchievement->frozen_hash); return "You are $self->{id} trying to use an item you don't have" unless $globalData->{ $self->{id} }; - my $setID = $r->param('tran_set_id'); + my $setID = $c->param('tran_set_id'); return 'You need to input a Set Name' unless defined $setID; - my $problemID = $r->param('tran_problem_id'); + my $problemID = $c->param('tran_problem_id'); return 'You need to input a Problem Number' unless $problemID; - my $problemID2 = $r->param('tran_problem_id2'); + my $problemID2 = $c->param('tran_problem_id2'); return 'You need to input a Problem Number' unless $problemID2; return 'You need to pick 2 different problems!' if $problemID == $problemID2; diff --git a/lib/WeBWorK/AchievementItems/ExtendDueDate.pm b/lib/WeBWorK/AchievementItems/ExtendDueDate.pm index fb44e24f6c..afe330d881 100644 --- a/lib/WeBWorK/AchievementItems/ExtendDueDate.pm +++ b/lib/WeBWorK/AchievementItems/ExtendDueDate.pm @@ -14,18 +14,13 @@ ################################################################################ package WeBWorK::AchievementItems::ExtendDueDate; -use parent qw(WeBWorK::AchievementItems); +use Mojo::Base 'WeBWorK::AchievementItems', -signatures; # Item to extend a close date by 24 hours. -use strict; -use warnings; - use WeBWorK::Utils qw(between x nfreeze_base64 thaw_base64 format_set_name_display); -sub new { - my ($class) = @_; - +sub new ($class) { return bless { id => 'ExtendDueDate', name => x('Tunic of Extension'), @@ -33,9 +28,7 @@ sub new { }, $class; } -sub print_form { - my ($self, $sets, $setProblemCount, $r) = @_; - +sub print_form ($self, $sets, $setProblemCount, $c) { my @openSets; for my $i (0 .. $#$sets) { @@ -43,22 +36,21 @@ sub print_form { if (between($sets->[$i]->open_date, $sets->[$i]->due_date) && $sets->[$i]->assignment_type eq 'default'); } - return $r->c( - $r->tag('p', $r->maketext('Choose the set whose close date you would like to extend.')), + return $c->c( + $c->tag('p', $c->maketext('Choose the set whose close date you would like to extend.')), WeBWorK::AchievementItems::form_popup_menu_row( - $r, + $c, id => 'ext_set_id', - label_text => $r->maketext('Set Name'), + label_text => $c->maketext('Set Name'), values => \@openSets, menu_attr => { dir => 'ltr' } ) )->join(''); } -sub use_item { - my ($self, $userName, $r) = @_; - my $db = $r->db; - my $ce = $r->ce; +sub use_item ($self, $userName, $c) { + my $db = $c->db; + my $ce = $c->ce; # Validate data @@ -68,7 +60,7 @@ sub use_item { my $globalData = thaw_base64($globalUserAchievement->frozen_hash); return "You are $self->{id} trying to use an item you don't have" unless $globalData->{ $self->{id} }; - my $setID = $r->param('ext_set_id'); + my $setID = $c->param('ext_set_id'); return 'You need to input a Set Name' unless defined $setID; my $set = $db->getMergedSet($userName, $setID); diff --git a/lib/WeBWorK/AchievementItems/ExtendDueDateGW.pm b/lib/WeBWorK/AchievementItems/ExtendDueDateGW.pm index db27bc216c..03cf2bed81 100644 --- a/lib/WeBWorK/AchievementItems/ExtendDueDateGW.pm +++ b/lib/WeBWorK/AchievementItems/ExtendDueDateGW.pm @@ -14,18 +14,13 @@ ################################################################################ package WeBWorK::AchievementItems::ExtendDueDateGW; -use parent qw(WeBWorK::AchievementItems); +use Mojo::Base 'WeBWorK::AchievementItems', -signatures; # Item to extend the due date on a gateway -use strict; -use warnings; - use WeBWorK::Utils qw(between x nfreeze_base64 thaw_base64 format_set_name_display); -sub new { - my ($class) = @_; - +sub new ($class) { return bless { id => 'ExtendDueDateGW', name => x('Amulet of Extension'), @@ -34,11 +29,10 @@ sub new { }, $class; } -sub print_form { - my ($self, $sets, $setProblemCount, $r) = @_; - my $db = $r->db; +sub print_form ($self, $sets, $setProblemCount, $c) { + my $db = $c->db; - my $effectiveUserName = $r->param('effectiveUser') // $r->param('user'); + my $effectiveUserName = $c->param('effectiveUser') // $c->param('user'); my @unfilteredsets = $db->getMergedSets(map { [ $effectiveUserName, $_ ] } $db->listUserSets($effectiveUserName)); my @openGateways; @@ -50,22 +44,21 @@ sub print_form { && between($set->open_date, $set->due_date); } - return $r->c( - $r->tag('p', $r->maketext('Extend the close date for which Gateway?')), + return $c->c( + $c->tag('p', $c->maketext('Extend the close date for which Gateway?')), WeBWorK::AchievementItems::form_popup_menu_row( - $r, + $c, id => 'eddgw_gw_id', - label_text => $r->maketext('Gateway Name'), + label_text => $c->maketext('Gateway Name'), values => \@openGateways, menu_attr => { dir => 'ltr' } ) )->join(''); } -sub use_item { - my ($self, $userName, $r) = @_; - my $db = $r->db; - my $ce = $r->ce; +sub use_item ($self, $userName, $c) { + my $db = $c->db; + my $ce = $c->ce; # Validate data @@ -75,7 +68,7 @@ sub use_item { my $globalData = thaw_base64($globalUserAchievement->frozen_hash); return "You are $self->{id} trying to use an item you don't have" unless $globalData->{ $self->{id} }; - my $setID = $r->param('eddgw_gw_id'); + my $setID = $c->param('eddgw_gw_id'); return 'You need to input a Gateway Name' unless defined $setID; my $set = $db->getMergedSet($userName, $setID); diff --git a/lib/WeBWorK/AchievementItems/FullCreditProb.pm b/lib/WeBWorK/AchievementItems/FullCreditProb.pm index 14422746a2..3525012a6b 100644 --- a/lib/WeBWorK/AchievementItems/FullCreditProb.pm +++ b/lib/WeBWorK/AchievementItems/FullCreditProb.pm @@ -14,18 +14,13 @@ ################################################################################ package WeBWorK::AchievementItems::FullCreditProb; -use parent qw(WeBWorK::AchievementItems); +use Mojo::Base 'WeBWorK::AchievementItems', -signatures; # Item to give full credit on a single problem -use strict; -use warnings; - use WeBWorK::Utils qw(between x nfreeze_base64 thaw_base64 format_set_name_display); -sub new { - my ($class) = @_; - +sub new ($class) { return bless { id => 'FullCreditProb', name => x('Greater Rod of Revelation'), @@ -33,9 +28,7 @@ sub new { }, $class; } -sub print_form { - my ($self, $sets, $setProblemCount, $r) = @_; - +sub print_form ($self, $sets, $setProblemCount, $c) { # Construct a dropdown with open sets and another with problems. # Javascript ensures the appropriate number of problems are shown for the selected set. @@ -61,33 +54,32 @@ sub print_form { push(@problemIDs, [ $i => $i, $i > $openSets[0][3]{max} ? (style => 'display:none') : () ]); } - return $r->c( - $r->tag( + return $c->c( + $c->tag( 'p', - $r->maketext( + $c->maketext( 'Please choose the set name and problem number of the question which should be given full credit.') ), WeBWorK::AchievementItems::form_popup_menu_row( - $r, + $c, id => 'fcp_set_id', - label_text => $r->maketext('Set Name'), + label_text => $c->maketext('Set Name'), values => \@openSets, menu_attr => { dir => 'ltr', data => { problems => 'fcp_problem_id' } } ), WeBWorK::AchievementItems::form_popup_menu_row( - $r, + $c, id => 'fcp_problem_id', - label_text => $r->maketext('Problem Number'), + label_text => $c->maketext('Problem Number'), values => \@problemIDs, menu_container_attr => { class => 'col-3' } ) )->join(''); } -sub use_item { - my ($self, $userName, $r) = @_; - my $db = $r->db; - my $ce = $r->ce; +sub use_item ($self, $userName, $c) { + my $db = $c->db; + my $ce = $c->ce; # Validate data @@ -97,10 +89,10 @@ sub use_item { my $globalData = thaw_base64($globalUserAchievement->frozen_hash); return "You are $self->{id} trying to use an item you don't have" unless $globalData->{ $self->{id} }; - my $setID = $r->param('fcp_set_id'); + my $setID = $c->param('fcp_set_id'); return 'You need to input a Set Name' unless defined $setID; - my $problemID = $r->param('fcp_problem_id'); + my $problemID = $c->param('fcp_problem_id'); return 'You need to input a Problem Number' unless $problemID; my $problem = $db->getUserProblem($userName, $setID, $problemID); diff --git a/lib/WeBWorK/AchievementItems/FullCreditSet.pm b/lib/WeBWorK/AchievementItems/FullCreditSet.pm index b6b4a475cb..85d05f95b2 100644 --- a/lib/WeBWorK/AchievementItems/FullCreditSet.pm +++ b/lib/WeBWorK/AchievementItems/FullCreditSet.pm @@ -14,18 +14,13 @@ ################################################################################ package WeBWorK::AchievementItems::FullCreditSet; -use parent qw(WeBWorK::AchievementItems); +use Mojo::Base 'WeBWorK::AchievementItems', -signatures; # Item to give half credit on all problems in a homework set. -use strict; -use warnings; - use WeBWorK::Utils qw(between x nfreeze_base64 thaw_base64 format_set_name_display); -sub new { - my ($class) = @_; - +sub new ($class) { return bless { id => 'FullCreditSet', name => x('Greater Tome of Enlightenment'), @@ -33,9 +28,7 @@ sub new { }, $class; } -sub print_form { - my ($self, $sets, $setProblemCount, $r) = @_; - +sub print_form ($self, $sets, $setProblemCount, $c) { my @openSets; for my $i (0 .. $#$sets) { @@ -43,22 +36,21 @@ sub print_form { if (between($sets->[$i]->open_date, $sets->[$i]->due_date) && $sets->[$i]->assignment_type eq 'default'); } - return $r->c( - $r->tag('p', $r->maketext('Please choose the set for which all problems should be given full credit.')), + return $c->c( + $c->tag('p', $c->maketext('Please choose the set for which all problems should be given full credit.')), WeBWorK::AchievementItems::form_popup_menu_row( - $r, + $c, id => 'fcs_set_id', - label_text => $r->maketext('Set Name'), + label_text => $c->maketext('Set Name'), values => \@openSets, menu_attr => { dir => 'ltr' } ) )->join(''); } -sub use_item { - my ($self, $userName, $r) = @_; - my $db = $r->db; - my $ce = $r->ce; +sub use_item ($self, $userName, $c) { + my $db = $c->db; + my $ce = $c->ce; # Validate data @@ -68,7 +60,7 @@ sub use_item { my $globalData = thaw_base64($globalUserAchievement->frozen_hash); return "You are $self->{id} trying to use an item you don't have" unless $globalData->{ $self->{id} }; - my $setID = $r->param('fcs_set_id'); + my $setID = $c->param('fcs_set_id'); return 'You need to input a Set Name' unless defined $setID; my @probIDs = $db->listUserProblems($userName, $setID); diff --git a/lib/WeBWorK/AchievementItems/HalfCreditProb.pm b/lib/WeBWorK/AchievementItems/HalfCreditProb.pm index 2370c903c4..268aa9219f 100644 --- a/lib/WeBWorK/AchievementItems/HalfCreditProb.pm +++ b/lib/WeBWorK/AchievementItems/HalfCreditProb.pm @@ -14,18 +14,13 @@ ################################################################################ package WeBWorK::AchievementItems::HalfCreditProb; -use parent qw(WeBWorK::AchievementItems); +use Mojo::Base 'WeBWorK::AchievementItems', -signatures; # Item to give half credit on a single problem. -use strict; -use warnings; - use WeBWorK::Utils qw(between x nfreeze_base64 thaw_base64 format_set_name_display); -sub new { - my ($class) = @_; - +sub new ($class) { return bless { id => 'HalfCreditProb', name => x('Lesser Rod of Revelation'), @@ -33,9 +28,7 @@ sub new { }, $class; } -sub print_form { - my ($self, $sets, $setProblemCount, $r) = @_; - +sub print_form ($self, $sets, $setProblemCount, $c) { # Construct a dropdown with open sets and another with problems. # Javascript ensures the appropriate number of problems are shown for the selected set. @@ -61,33 +54,32 @@ sub print_form { push(@problemIDs, [ $i => $i, $i > $openSets[0][3]{max} ? (style => 'display:none') : () ]); } - return $r->c( - $r->tag( + return $c->c( + $c->tag( 'p', - $r->maketext( + $c->maketext( 'Please choose the set name and problem number of the question which should be given half credit.') ), WeBWorK::AchievementItems::form_popup_menu_row( - $r, + $c, id => 'hcp_set_id', - label_text => $r->maketext('Set Name'), + label_text => $c->maketext('Set Name'), values => \@openSets, menu_attr => { dir => 'ltr', data => { problems => 'hcp_problem_id' } } ), WeBWorK::AchievementItems::form_popup_menu_row( - $r, + $c, id => 'hcp_problem_id', values => \@problemIDs, - label_text => $r->maketext('Problem Number'), + label_text => $c->maketext('Problem Number'), menu_container_attr => { class => 'col-3' } ) )->join(''); } -sub use_item { - my ($self, $userName, $r) = @_; - my $db = $r->db; - my $ce = $r->ce; +sub use_item ($self, $userName, $c) { + my $db = $c->db; + my $ce = $c->ce; # Validate data @@ -97,10 +89,10 @@ sub use_item { my $globalData = thaw_base64($globalUserAchievement->frozen_hash); return "You are $self->{id} trying to use an item you don't have" unless $globalData->{ $self->{id} }; - my $setID = $r->param('hcp_set_id'); + my $setID = $c->param('hcp_set_id'); return 'You need to input a Set Name' unless defined $setID; - my $problemID = $r->param('hcp_problem_id'); + my $problemID = $c->param('hcp_problem_id'); return 'You need to input a Problem Number' unless $problemID; my $problem = $db->getUserProblem($userName, $setID, $problemID); diff --git a/lib/WeBWorK/AchievementItems/HalfCreditSet.pm b/lib/WeBWorK/AchievementItems/HalfCreditSet.pm index fc27a6698c..d841a27f00 100644 --- a/lib/WeBWorK/AchievementItems/HalfCreditSet.pm +++ b/lib/WeBWorK/AchievementItems/HalfCreditSet.pm @@ -14,18 +14,13 @@ ################################################################################ package WeBWorK::AchievementItems::HalfCreditSet; -use parent qw(WeBWorK::AchievementItems); +use Mojo::Base 'WeBWorK::AchievementItems', -signatures; # Item to give half credit on all problems in a homework set. -use strict; -use warnings; - use WeBWorK::Utils qw(between x nfreeze_base64 thaw_base64 format_set_name_display); -sub new { - my ($class) = @_; - +sub new ($class) { return bless { id => 'HalfCreditSet', name => x('Lesser Tome of Enlightenment'), @@ -33,9 +28,7 @@ sub new { }, $class; } -sub print_form { - my ($self, $sets, $setProblemCount, $r) = @_; - +sub print_form ($self, $sets, $setProblemCount, $c) { my @openSets; for my $i (0 .. $#$sets) { @@ -43,22 +36,21 @@ sub print_form { if (between($sets->[$i]->open_date, $sets->[$i]->due_date) && $sets->[$i]->assignment_type eq 'default'); } - return $r->c( - $r->tag('p', $r->maketext('Please choose the set for which all problems should have half credit added.')), + return $c->c( + $c->tag('p', $c->maketext('Please choose the set for which all problems should have half credit added.')), WeBWorK::AchievementItems::form_popup_menu_row( - $r, + $c, id => 'hcs_set_id', - label_text => $r->maketext('Set Name'), + label_text => $c->maketext('Set Name'), values => \@openSets, menu_attr => { dir => 'ltr' } ) )->join(''); } -sub use_item { - my ($self, $userName, $r) = @_; - my $db = $r->db; - my $ce = $r->ce; +sub use_item ($self, $userName, $c) { + my $db = $c->db; + my $ce = $c->ce; # Validate data @@ -68,7 +60,7 @@ sub use_item { my $globalData = thaw_base64($globalUserAchievement->frozen_hash); return "You are $self->{id} trying to use an item you don't have" unless $globalData->{ $self->{id} }; - my $setID = $r->param('hcs_set_id'); + my $setID = $c->param('hcs_set_id'); return 'You need to input a Set Name' unless defined $setID; my @probIDs = $db->listUserProblems($userName, $setID); diff --git a/lib/WeBWorK/AchievementItems/ReducedCred.pm b/lib/WeBWorK/AchievementItems/ReducedCred.pm index 54c9ca15ce..ebb242454c 100644 --- a/lib/WeBWorK/AchievementItems/ReducedCred.pm +++ b/lib/WeBWorK/AchievementItems/ReducedCred.pm @@ -14,19 +14,14 @@ ################################################################################ package WeBWorK::AchievementItems::ReducedCred; -use parent qw(WeBWorK::AchievementItems); +use Mojo::Base 'WeBWorK::AchievementItems', -signatures; # Item to extend a close date by 24 hours for reduced credit # Reduced scoring needs to be enabled for this item to work. -use strict; -use warnings; - use WeBWorK::Utils qw(after between x nfreeze_base64 thaw_base64 format_set_name_display); -sub new { - my ($class) = @_; - +sub new ($class) { return bless { id => 'ReducedCred', name => x('Ring of Reduction'), @@ -37,9 +32,7 @@ sub new { }, $class; } -sub print_form { - my ($self, $sets, $setProblemCount, $r) = @_; - +sub print_form ($self, $sets, $setProblemCount, $c) { my @openSets; for my $i (0 .. $#$sets) { @@ -47,22 +40,21 @@ sub print_form { if (between($sets->[$i]->open_date, $sets->[$i]->due_date) && $sets->[$i]->assignment_type eq 'default'); } - return $r->c( - $r->tag('p', $r->maketext('Choose the set which you would like to enable partial credit for.')), + return $c->c( + $c->tag('p', $c->maketext('Choose the set which you would like to enable partial credit for.')), WeBWorK::AchievementItems::form_popup_menu_row( - $r, + $c, id => 'red_set_id', - label_text => $r->maketext('Set Name'), + label_text => $c->maketext('Set Name'), values => \@openSets, menu_attr => { dir => 'ltr' } ) )->join(''); } -sub use_item { - my ($self, $userName, $r) = @_; - my $db = $r->db; - my $ce = $r->ce; +sub use_item ($self, $userName, $c) { + my $db = $c->db; + my $ce = $c->ce; # Validate data @@ -76,7 +68,7 @@ sub use_item { my $globalData = thaw_base64($globalUserAchievement->frozen_hash); return "You are $self->{id} trying to use an item you don't have" unless $globalData->{ $self->{id} }; - my $setID = $r->param('red_set_id'); + my $setID = $c->param('red_set_id'); return "You need to input a Set Name" unless defined $setID; my $set = $db->getMergedSet($userName, $setID); diff --git a/lib/WeBWorK/AchievementItems/ResetIncorrectAttempts.pm b/lib/WeBWorK/AchievementItems/ResetIncorrectAttempts.pm index 230d421df7..f4fb590b24 100644 --- a/lib/WeBWorK/AchievementItems/ResetIncorrectAttempts.pm +++ b/lib/WeBWorK/AchievementItems/ResetIncorrectAttempts.pm @@ -14,18 +14,13 @@ ################################################################################ package WeBWorK::AchievementItems::ResetIncorrectAttempts; -use parent qw(WeBWorK::AchievementItems); +use Mojo::Base 'WeBWorK::AchievementItems', -signatures; # Item to reset number of incorrect attempts. -use strict; -use warnings; - use WeBWorK::Utils qw(between x nfreeze_base64 thaw_base64 format_set_name_display); -sub new { - my ($class) = @_; - +sub new ($class) { return bless { id => 'ResetIncorrectAttempts', name => x('Potion of Forgetfulness'), @@ -33,9 +28,7 @@ sub new { }, $class; } -sub print_form { - my ($self, $sets, $setProblemCount, $r) = @_; - +sub print_form ($self, $sets, $setProblemCount, $c) { # Construct a dropdown with open sets and another with problems. # Javascript ensures the appropriate number of problems are shown for the selected set. @@ -61,35 +54,34 @@ sub print_form { push(@problemIDs, [ $i => $i, $i > $openSets[0][3]{max} ? (style => 'display:none') : () ]); } - return $r->c( - $r->tag( + return $c->c( + $c->tag( 'p', - $r->maketext( + $c->maketext( 'Please choose the set name and problem number of the question which ' . 'should have its incorrect attempt count reset.' ) ), WeBWorK::AchievementItems::form_popup_menu_row( - $r, + $c, id => 'ria_set_id', - label_text => $r->maketext('Set Name'), + label_text => $c->maketext('Set Name'), values => \@openSets, menu_attr => { dir => 'ltr', data => { problems => 'ria_problem_id' } } ), WeBWorK::AchievementItems::form_popup_menu_row( - $r, + $c, id => 'ria_problem_id', - label_text => $r->maketext('Problem Number'), + label_text => $c->maketext('Problem Number'), values => \@problemIDs, menu_container_attr => { class => 'col-3' } ) )->join(''); } -sub use_item { - my ($self, $userName, $r) = @_; - my $db = $r->db; - my $ce = $r->ce; +sub use_item ($self, $userName, $c) { + my $db = $c->db; + my $ce = $c->ce; # Validate data @@ -99,10 +91,10 @@ sub use_item { my $globalData = thaw_base64($globalUserAchievement->frozen_hash); return "You are $self->{id} trying to use an item you don't have" unless $globalData->{ $self->{id} }; - my $setID = $r->param('ria_set_id'); + my $setID = $c->param('ria_set_id'); return 'You need to input a Set Name' unless defined $setID; - my $problemID = $r->param('ria_problem_id'); + my $problemID = $c->param('ria_problem_id'); return 'You need to input a Problem Number' unless $problemID; my $problem = $db->getUserProblem($userName, $setID, $problemID); diff --git a/lib/WeBWorK/AchievementItems/ResurrectGW.pm b/lib/WeBWorK/AchievementItems/ResurrectGW.pm index 7cae8cd287..62ae9f437d 100644 --- a/lib/WeBWorK/AchievementItems/ResurrectGW.pm +++ b/lib/WeBWorK/AchievementItems/ResurrectGW.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::AchievementItems::ResurrectGW; -use parent qw(WeBWorK::AchievementItems); +use Mojo::Base 'WeBWorK::AchievementItems', -signatures; # Item to extend the due date on a gateway @@ -23,9 +23,7 @@ use warnings; use WeBWorK::Utils qw(x nfreeze_base64 thaw_base64 format_set_name_display); -sub new { - my ($class) = @_; - +sub new ($class) { return bless { id => 'ResurrectGW', name => x('Necromancers Charm'), @@ -36,11 +34,10 @@ sub new { }, $class; } -sub print_form { - my ($self, $sets, $setProblemCount, $r) = @_; - my $db = $r->db; +sub print_form ($self, $sets, $setProblemCount, $c) { + my $db = $c->db; - my $effectiveUserName = $r->param('effectiveUser') // $r->param('user'); + my $effectiveUserName = $c->param('effectiveUser') // $c->param('user'); my @unfilteredsets = $db->getMergedSets(map { [ $effectiveUserName, $_ ] } $db->listUserSets($effectiveUserName)); my @sets; @@ -50,22 +47,21 @@ sub print_form { if ($set->assignment_type =~ /gateway/ && $set->set_id !~ /,v\d+$/); } - return $r->c( - $r->tag('p', $r->maketext('Resurrect which Gateway?')), + return $c->c( + $c->tag('p', $c->maketext('Resurrect which Gateway?')), WeBWorK::AchievementItems::form_popup_menu_row( - $r, + $c, id => 'resgw_gw_id', - label_text => $r->maketext('Gateway Name'), + label_text => $c->maketext('Gateway Name'), values => \@sets, menu_attr => { dir => 'ltr' } ) )->join(''); } -sub use_item { - my ($self, $userName, $r) = @_; - my $db = $r->db; - my $ce = $r->ce; +sub use_item ($self, $userName, $c) { + my $db = $c->db; + my $ce = $c->ce; # Validate data @@ -75,7 +71,7 @@ sub use_item { my $globalData = thaw_base64($globalUserAchievement->frozen_hash); return "You are $self->{id} trying to use an item you don't have" unless $globalData->{ $self->{id} }; - my $setID = $r->param('resgw_gw_id'); + my $setID = $c->param('resgw_gw_id'); return 'You need to input a Gateway Name' unless defined $setID; my $set = $db->getUserSet($userName, $setID); diff --git a/lib/WeBWorK/AchievementItems/ResurrectHW.pm b/lib/WeBWorK/AchievementItems/ResurrectHW.pm index 877671f437..f31c111db4 100644 --- a/lib/WeBWorK/AchievementItems/ResurrectHW.pm +++ b/lib/WeBWorK/AchievementItems/ResurrectHW.pm @@ -14,18 +14,13 @@ ################################################################################ package WeBWorK::AchievementItems::ResurrectHW; -use parent qw(WeBWorK::AchievementItems); +use Mojo::Base 'WeBWorK::AchievementItems', -signatures; # Item to resurrect a homework for 24 hours -use strict; -use warnings; - use WeBWorK::Utils qw(after x nfreeze_base64 thaw_base64 format_set_name_display); -sub new { - my ($class) = @_; - +sub new ($class) { return bless { id => 'ResurrectHW', name => x('Scroll of Resurrection'), @@ -33,9 +28,7 @@ sub new { }, $class; } -sub print_form { - my ($self, $sets, $setProblemCount, $r) = @_; - +sub print_form ($self, $sets, $setProblemCount, $c) { # List all of the sets that are closed or past their reduced scoring date. my @closedSets; @@ -47,22 +40,21 @@ sub print_form { || ($sets->[$i]->reduced_scoring_date && after($$sets[$i]->reduced_scoring_date))); } - return $r->c( - $r->tag('p', $r->maketext('Choose the set which you would like to resurrect.')), + return $c->c( + $c->tag('p', $c->maketext('Choose the set which you would like to resurrect.')), WeBWorK::AchievementItems::form_popup_menu_row( - $r, + $c, id => 'res_set_id', - label_text => $r->maketext('Set Name'), + label_text => $c->maketext('Set Name'), values => \@closedSets, menu_attr => { dir => 'ltr' } ) )->join(''); } -sub use_item { - my ($self, $userName, $r) = @_; - my $db = $r->db; - my $ce = $r->ce; +sub use_item ($self, $userName, $c) { + my $db = $c->db; + my $ce = $c->ce; # Validate data @@ -72,7 +64,7 @@ sub use_item { my $globalData = thaw_base64($globalUserAchievement->frozen_hash); return "You are $self->{id} trying to use an item you don't have" unless $globalData->{ $self->{id} }; - my $setID = $r->param('res_set_id'); + my $setID = $c->param('res_set_id'); return 'You need to input a Set Name' unless defined $setID; my $set = $db->getUserSet($userName, $setID); diff --git a/lib/WeBWorK/AchievementItems/SuperExtendDueDate.pm b/lib/WeBWorK/AchievementItems/SuperExtendDueDate.pm index 8e5586f119..d06480c9fe 100644 --- a/lib/WeBWorK/AchievementItems/SuperExtendDueDate.pm +++ b/lib/WeBWorK/AchievementItems/SuperExtendDueDate.pm @@ -14,18 +14,13 @@ ################################################################################ package WeBWorK::AchievementItems::SuperExtendDueDate; -use parent qw(WeBWorK::AchievementItems); +use Mojo::Base 'WeBWorK::AchievementItems', -signatures; # Item to extend a close date by 48 hours. -use strict; -use warnings; - use WeBWorK::Utils qw(between x nfreeze_base64 thaw_base64 format_set_name_display); -sub new { - my ($class) = @_; - +sub new ($class) { return bless { id => 'SuperExtendDueDate', name => x('Robe of Longevity'), @@ -33,9 +28,7 @@ sub new { }, $class; } -sub print_form { - my ($self, $sets, $setProblemCount, $r) = @_; - +sub print_form ($self, $sets, $setProblemCount, $c) { my @openSets; for my $i (0 .. $#$sets) { @@ -43,22 +36,21 @@ sub print_form { if (between($sets->[$i]->open_date, $sets->[$i]->due_date) && $sets->[$i]->assignment_type eq 'default'); } - return $r->c( - $r->tag('p', $r->maketext('Choose the set whose close date you would like to extend.')), + return $c->c( + $c->tag('p', $c->maketext('Choose the set whose close date you would like to extend.')), WeBWorK::AchievementItems::form_popup_menu_row( - $r, + $c, id => 'ext_set_id', - label_text => $r->maketext('Set Name'), + label_text => $c->maketext('Set Name'), values => \@openSets, menu_attr => { dir => 'ltr' } ) )->join(''); } -sub use_item { - my ($self, $userName, $r) = @_; - my $db = $r->db; - my $ce = $r->ce; +sub use_item ($self, $userName, $c) { + my $db = $c->db; + my $ce = $c->ce; # Validate data @@ -68,7 +60,7 @@ sub use_item { my $globalData = thaw_base64($globalUserAchievement->frozen_hash); return "You are $self->{id} trying to use an item you don't have" unless $globalData->{ $self->{id} }; - my $setID = $r->param('ext_set_id'); + my $setID = $c->param('ext_set_id'); return 'You need to input a Set Name' unless defined $setID; my $set = $db->getMergedSet($userName, $setID); diff --git a/lib/WeBWorK/AchievementItems/Surprise.pm b/lib/WeBWorK/AchievementItems/Surprise.pm index aa68bd54bf..ca40ee146e 100644 --- a/lib/WeBWorK/AchievementItems/Surprise.pm +++ b/lib/WeBWorK/AchievementItems/Surprise.pm @@ -14,18 +14,13 @@ ################################################################################ package WeBWorK::AchievementItems::Surprise; -use parent qw(WeBWorK::AchievementItems); +use Mojo::Base 'WeBWorK::AchievementItems', -signatures; # Item to print a suprise message -use strict; -use warnings; - use WeBWorK::Utils qw(x); -sub new { - my ($class) = @_; - +sub new ($class) { return bless { id => 'Surprise', name => x('Mysterious Package (with Ribbons)'), @@ -33,22 +28,20 @@ sub new { }, $class; } -sub print_form { - my ($self, $sets, $setProblemCount, $r) = @_; - +sub print_form ($self, $sets, $setProblemCount, $c) { # The form opens the file "suprise_message.txt" in the achievements # folder and prints the contents of the file. - open my $MESSAGE, '<', "$r->{ce}{courseDirs}{achievements}/surprise_message.txt" - or return $r->tag('p', $r->maketext(q{I couldn't find the file [ACHIEVEMENT_DIR]/surprise_message.txt!})); + open my $MESSAGE, '<', "$c->{ce}{courseDirs}{achievements}/surprise_message.txt" + or return $c->tag('p', $c->maketext(q{I couldn't find the file [ACHIEVEMENT_DIR]/surprise_message.txt!})); local $/ = undef; my $message = <$MESSAGE>; close $MESSAGE; - return $r->tag('div', $r->b($message)); + return $c->tag('div', $c->b($message)); } -sub use_item { +sub use_item ($self, $userName, $c) { # This doesn't do anything. } diff --git a/lib/WeBWorK/Authen.pm b/lib/WeBWorK/Authen.pm index aa172a9c11..c2730246ab 100644 --- a/lib/WeBWorK/Authen.pm +++ b/lib/WeBWorK/Authen.pm @@ -28,7 +28,7 @@ WeBWorK::Authen - Check user identity, manage session keys. require $class_name; # create an authen object - my $authen = $class_name->new($r); + my $authen = $class_name->new($c); # verify credentials $authen->verify or die "Authentication failed"; @@ -53,7 +53,6 @@ use version; use Date::Format; use Socket qw/unpack_sockaddr_in inet_ntoa/; # for logging -use URI::Escape; use Carp; use Scalar::Util qw(weaken); use Mojo::Util qw(url_escape url_unescape); @@ -131,21 +130,21 @@ sub class { sub call_next_authen_method { my $self = shift; - my $r = $self->{r}; - my $ce = $r->{ce}; + my $c = $self->{c}; + my $ce = $c->{ce}; my $user_authen_module = WeBWorK::Authen::class($ce, "user_module"); #debug("user_authen_module = |$user_authen_module|"); if (!defined($user_authen_module) or ($user_authen_module eq "")) { - $self->{error} = $r->maketext( + $self->{error} = $c->maketext( "No authentication method found for your request. If this recurs, please speak with your instructor."); $self->{log_error} .= "None of the specified authentication modules could handle the request."; return (0); } else { runtime_use $user_authen_module; - my $authen = $user_authen_module->new($r); + my $authen = $user_authen_module->new($c); #debug("Using user_authen_module $user_authen_module: $authen\n"); - $r->authen($authen); + $c->authen($authen); return $authen->verify; } @@ -159,19 +158,19 @@ sub call_next_authen_method { =over -=item new($r) +=item new($c) -Instantiates a new WeBWorK::Authen object for the given WeBWorK::Requst ($r). +Instantiates a new WeBWorK::Authen object for the given WeBWorK::Controller ($c). =cut sub new { - my ($invocant, $r) = @_; + my ($invocant, $c) = @_; my $class = ref($invocant) || $invocant; - my $self = { r => $r, }; - weaken $self->{r}; + my $self = { c => $c, }; + weaken $self->{c}; #initialize - $GENERIC_ERROR_MESSAGE = $r->maketext("Invalid user ID or password."); + $GENERIC_ERROR_MESSAGE = $c->maketext("Invalid user ID or password."); bless $self, $class; return $self; } @@ -194,7 +193,7 @@ sub request_has_data_for_this_verification_module { sub verify { debug("BEGIN VERIFY"); my $self = shift; - my $r = $self->{r}; + my $c = $self->{c}; if (!($self->request_has_data_for_this_verification_module)) { return ($self->call_next_authen_method()); @@ -222,8 +221,8 @@ sub verify { if (defined($log_error) and $log_error eq "inactivity timeout") { # We don't want to override the localized inactivity timeout message. # so do not check next "if" in this case. - } elsif (defined($r->param("user")) or defined($r->param("user_id"))) { - $error = $r->maketext( + } elsif (defined($c->param("user")) or defined($c->param("user_id"))) { + $error = $c->maketext( "Your authentication failed. Please try again. Please speak with your instructor if you need help." ); } @@ -233,12 +232,12 @@ sub verify { $self->maybe_kill_cookie; # if error message has a least one non-space character. if (defined($error) and $error =~ /\S/) { - $r->stash(authen_error => $error); + $c->stash(authen_error => $error); # FIXME this is a hack to accomodate the webworkservice remixes } } - my $caliper_sensor = Caliper::Sensor->new($self->{r}->ce); + my $caliper_sensor = Caliper::Sensor->new($self->{c}->ce); if ($caliper_sensor->caliperEnabled() && $result && $self->{initial_login}) { my $login_event = { 'type' => 'SessionEvent', @@ -246,7 +245,7 @@ sub verify { 'profile' => 'SessionProfile', 'object' => Caliper::Entity::webwork_app() }; - $caliper_sensor->sendEvents($self->{r}, [$login_event]); + $caliper_sensor->sendEvents($self->{c}, [$login_event]); } debug("END VERIFY"); @@ -275,8 +274,8 @@ Future calls to was_verified() will return false, until verify() is called again sub forget_verification { my ($self) = @_; - my $r = $self->{r}; - my $ce = $r->{ce}; + my $c = $self->{c}; + my $ce = $c->ce; $self->{was_verified} = 0; @@ -292,9 +291,9 @@ sub forget_verification { sub do_verify { my $self = shift; - my $r = $self->{r}; - my $ce = $r->ce; - my $db = $r->db; + my $c = $self->{c}; + my $ce = $c->ce; + my $db = $c->db; return 0 unless $db; debug("db ok"); @@ -324,13 +323,13 @@ sub trim { # used to trim leading and trailing white space from user_id and p sub get_credentials { my ($self) = @_; - my $r = $self->{r}; - my $ce = $r->ce; - my $db = $r->db; + my $c = $self->{c}; + my $ce = $c->ce; + my $db = $c->db; debug("self is $self "); # allow guest login: if the "Guest Login" button was clicked, we find an unused # practice user and create a session for it. - if ($r->param("login_practice_user")) { + if ($c->param("login_practice_user")) { my @allowedGuestUserIDs = map { $_->user_id } grep { $ce->status_abbrev_has_behavior($_->status, "allow_course_access") } @@ -351,25 +350,25 @@ sub get_credentials { } $self->{log_error} = "no guest logins are available"; - $self->{error} = $r->maketext("No guest logins are available. Please try again in a few minutes."); + $self->{error} = $c->maketext("No guest logins are available. Please try again in a few minutes."); return 0; } my ($cookieUser, $cookieKey, $cookieTimeStamp) = $self->fetchCookie; - if (defined $cookieUser and defined $r->param("user")) { - if ($cookieUser ne $r->param("user")) { - #croak ("cookieUser = $cookieUser and paramUser = ". $r->param("user") . " are different."); + if (defined $cookieUser and defined $c->param("user")) { + if ($cookieUser ne $c->param("user")) { + #croak ("cookieUser = $cookieUser and paramUser = ". $c->param("user") . " are different."); $self->maybe_kill_cookie; # use parameter "user" rather than cookie "user"; } # Use session key for verification # else use cookieKey for verification # else use cookie user name but use password provided by request. - if (defined $r->param("key")) { - $self->{user_id} = $r->param("user"); - $self->{session_key} = $r->param("key"); - $self->{password} = $r->param("passwd"); + if (defined $c->param("key")) { + $self->{user_id} = $c->param("user"); + $self->{session_key} = $c->param("key"); + $self->{password} = $c->param("passwd"); $self->{login_type} = "normal"; $self->{credential_source} = "params"; $self->{user_id} = trim($self->{user_id}); @@ -393,7 +392,7 @@ sub get_credentials { } else { $self->{user_id} = $cookieUser; $self->{session_key} = $cookieKey; # will be undefined - $self->{password} = $r->param("passwd"); + $self->{password} = $c->param("passwd"); $self->{cookie_timestamp} = $cookieTimeStamp; $self->{login_type} = "normal"; $self->{credential_source} = "params_and_cookie"; @@ -410,10 +409,10 @@ sub get_credentials { } } # at least the user ID is available in request parameters - if (defined $r->param("user")) { - $self->{user_id} = $r->param("user"); - $self->{session_key} = $r->param("key"); - $self->{password} = $r->param("passwd"); + if (defined $c->param("user")) { + $self->{user_id} = $c->param("user"); + $self->{session_key} = $c->param("key"); + $self->{password} = $c->param("passwd"); $self->{login_type} = "normal"; $self->{credential_source} = "params"; $self->{user_id} = trim($self->{user_id}); @@ -442,16 +441,16 @@ sub get_credentials { sub check_user { my $self = shift; - my $r = $self->{r}; - my $ce = $r->ce; - my $db = $r->db; - my $authz = $r->authz; + my $c = $self->{c}; + my $ce = $c->ce; + my $db = $c->db; + my $authz = $c->authz; my $user_id = $self->{user_id}; if (defined $user_id and $user_id eq "") { $self->{log_error} = "no user id specified"; - $self->{error} .= $r->maketext("You must specify a user ID."); + $self->{error} .= $c->maketext("You must specify a user ID."); return 0; } @@ -482,8 +481,8 @@ sub check_user { sub verify_practice_user { my $self = shift; - my $r = $self->{r}; - my $ce = $r->ce; + my $c = $self->{c}; + my $ce = $c->ce; my $user_id = $self->{user_id}; my $session_key = $self->{session_key}; @@ -527,7 +526,7 @@ sub verify_practice_user { sub verify_normal_user { my $self = shift; - my $r = $self->{r}; + my $c = $self->{c}; my $user_id = $self->{user_id}; my $session_key = $self->{session_key}; @@ -551,7 +550,7 @@ sub verify_normal_user { } else { # ($auth_result < 0) => required data was not present if ($keyMatches and not $timestampValid) { $self->{log_error} = "inactivity timeout"; - $self->{error} .= $r->maketext("Your session has timed out due to inactivity. Please log in again."); + $self->{error} .= $c->maketext("Your session has timed out due to inactivity. Please log in again."); } return 0; } @@ -563,7 +562,7 @@ sub verify_normal_user { # -1 == required data was not present (i.e. password missing) sub authenticate { my $self = shift; - my $r = $self->{r}; + my $c = $self->{c}; my $user_id = $self->{user_id}; my $password = $self->{password}; @@ -577,10 +576,10 @@ sub authenticate { sub maybe_send_cookie { my $self = shift; - my $r = $self->{r}; - my $ce = $r->{ce}; + my $c = $self->{c}; + my $ce = $c->{ce}; - return if $r->{rpc}; + return if $c->{rpc}; my ($cookie_user, $cookie_key, $cookie_timestamp, $setID) = $self->fetchCookie; @@ -600,7 +599,7 @@ sub maybe_send_cookie { and $self->{session_key} eq $cookie_key); # (c) the user asked to have a cookie sent and is not a guest user. - my $user_requests_cookie = ($self->{login_type} ne "guest" and ($r->param("send_cookie") // 0)) + my $user_requests_cookie = ($self->{login_type} ne "guest" and ($c->param("send_cookie") // 0)) ; # prevent warning if "send_cookie" param is not defined. # (d) session management is done via cookies. @@ -625,21 +624,21 @@ sub maybe_send_cookie { sub maybe_kill_cookie { my $self = shift; - return if $self->{r}{rpc}; + return if $self->{c}{rpc}; $self->killCookie(@_); } sub set_params { my $self = shift; - my $r = $self->{r}; + my $c = $self->{c}; # A2 - params are not non-modifiable, with no explanation or workaround given in docs. WTF! - $r->param("user", $self->{user_id}); - $r->param("key", $self->{session_key}); - $r->param("passwd", ""); + $c->param("user", $self->{user_id}); + $c->param("key", $self->{session_key}); + $c->param("passwd", ""); - debug("params user='", $r->param("user"), "' key='", $r->param("key"), "'"); + debug("params user='", $c->param("user"), "' key='", $c->param("key"), "'"); } ################################################################################ @@ -648,7 +647,7 @@ sub set_params { sub checkPassword { my ($self, $userID, $possibleClearPassword) = @_; - my $db = $self->{r}->db; + my $db = $self->{c}->db; my $Password = $db->getPassword($userID); # checked if (defined $Password) { @@ -717,7 +716,7 @@ sub checkPassword { # if ($possibleCryptPassword eq $realCryptPassword) { # # update WeBWorK password # use WeBWorK::Utils qw(cryptPassword); -# my $db = $self->{r}->db; +# my $db = $self->{c}->db; # my $Password = $db->getPassword($userID); # my $pass = cryptPassword($clearTextPassword); # $Password->password($pass); @@ -734,8 +733,8 @@ sub checkPassword { sub unexpired_session_exists { my ($self, $userID) = @_; - my $ce = $self->{r}->ce; - my $db = $self->{r}->db; + my $ce = $self->{c}->ce; + my $db = $self->{c}->db; my $Key = $db->getKey($userID); # checked return 0 unless defined $Key; @@ -759,9 +758,9 @@ sub unexpired_session_exists { # The $userID is modified in that case and will not work in the hasPermissions call. sub create_session { my ($self, $userID, $newKey, $trueUserID) = @_; - my $r = $self->{r}; - my $ce = $r->ce; - my $db = $r->db; + my $c = $self->{c}; + my $ce = $c->ce; + my $db = $c->db; my $timestamp = time; unless ($newKey) { @@ -772,8 +771,7 @@ sub create_session { $newKey = join("", @chars[ map rand(@chars), 1 .. $length ]); } - my $setID = - !$r->authz->hasPermissions($trueUserID // $userID, 'navigation_allowed') ? $r->urlpath->arg("setID") : ''; + my $setID = !$c->authz->hasPermissions($trueUserID // $userID, 'navigation_allowed') ? $c->stash('setID') : ''; my $Key = $db->newKey(user_id => $userID, key => $newKey, timestamp => $timestamp, set_id => $setID); @@ -799,8 +797,8 @@ sub create_session { # if $updateTimestamp is true, the timestamp on a valid session is updated sub check_session { my ($self, $userID, $possibleKey, $updateTimestamp) = @_; - my $ce = $self->{r}->ce; - my $db = $self->{r}->db; + my $ce = $self->{c}->ce; + my $db = $self->{c}->db; my $Key = $db->getKey($userID); # checked return 0 unless defined $Key; @@ -831,9 +829,9 @@ sub check_session { sub killSession { my $self = shift; - my $r = $self->{r}; - my $ce = $r->{ce}; - my $db = $r->{db}; + my $c = $self->{c}; + my $ce = $c->{ce}; + my $db = $c->{db}; my $caliper_sensor = Caliper::Sensor->new($ce); if ($caliper_sensor->caliperEnabled()) { @@ -843,7 +841,7 @@ sub killSession { 'profile' => 'SessionProfile', 'object' => Caliper::Entity::webwork_app() }; - $caliper_sensor->sendEvents($self->{r}, [$login_event]); + $caliper_sensor->sendEvents($self->{c}, [$login_event]); } $self->forget_verification; @@ -851,7 +849,7 @@ sub killSession { $self->killCookie(); } - my $userID = $r->param("user"); + my $userID = $c->param("user"); if (defined($userID)) { $db->deleteKey($userID); } @@ -862,14 +860,13 @@ sub killSession { ################################################################################ sub fetchCookie { - my $self = shift; - my $r = $self->{r}; - my $ce = $r->ce; - my $urlpath = $r->urlpath; + my $self = shift; + my $c = $self->{c}; + my $ce = $c->ce; - return if $r->{rpc}; + return if $c->{rpc}; - my $cookie = $r->cookie('WeBWorKCourseAuthen.' . $urlpath->arg('courseID')); + my $cookie = $c->cookie('WeBWorKCourseAuthen.' . $c->stash('courseID')); if ($cookie) { $cookie = url_unescape($cookie); @@ -890,18 +887,18 @@ sub fetchCookie { sub sendCookie { my ($self, $userID, $key, $setID) = @_; - my $r = $self->{r}; - my $ce = $r->ce; + my $c = $self->{c}; + my $ce = $c->ce; - return if $r->{rpc}; + return if $c->{rpc}; - my $courseID = $r->urlpath->arg("courseID"); + my $courseID = $c->stash('courseID'); # This sets the setID in the cookie on initial login. - $setID = $r->urlpath->arg("setID") + $setID = $c->stash('setID') if !$setID - && $r->authen->was_verified - && !$r->authz->hasPermissions($userID, 'navigation_allowed'); + && $c->authen->was_verified + && !$c->authz->hasPermissions($userID, 'navigation_allowed'); my $timestamp = time; @@ -925,10 +922,10 @@ sub sendCookie { # authentication. # If the hostname is 'localhost' or '127.0.0.1', then the cookie domain must be omitted. - my $hostname = $r->req->url->to_abs->host; + my $hostname = $c->req->url->to_abs->host; $cookie_params->{domain} = $hostname if ($hostname ne 'localhost' && $hostname ne '127.0.0.1'); - $r->cookie( + $c->cookie( "WeBWorKCourseAuthen.$courseID" => url_escape("$userID\t$key\t$timestamp" . ($setID ? "\t$setID" : '')), $cookie_params ); @@ -936,10 +933,10 @@ sub sendCookie { sub killCookie { my ($self) = @_; - my $r = $self->{r}; - my $ce = $r->ce; + my $c = $self->{c}; + my $ce = $c->ce; - my $courseID = $r->urlpath->arg("courseID"); + my $courseID = $c->stash('courseID'); my $cookie_params = { max_age => 0, @@ -950,10 +947,10 @@ sub killCookie { }; # If the hostname is 'localhost' or '127.0.0.1', then the cookie domain must be omitted. - my $hostname = $r->req->url->to_abs->host; + my $hostname = $c->req->url->to_abs->host; $cookie_params->{domain} = $hostname if ($hostname ne 'localhost' && $hostname ne '127.0.0.1'); - $r->cookie("WeBWorKCourseAuthen.$courseID" => '', $cookie_params); + $c->cookie("WeBWorKCourseAuthen.$courseID" => '', $cookie_params); } # This method is only used for a user that does not have the navigation_allowed permission, @@ -962,8 +959,8 @@ sub get_session_set_id { my $self = shift; my $setID; - if ($self->{r}{ce}{session_management_via} eq 'key') { - my $Key = $self->{r}{db}->getKey($self->{r}->param('user')); + if ($self->{c}->ce->{session_management_via} eq 'key') { + my $Key = $self->{c}->db->getKey($self->{c}->param('user')); return $Key->set_id; } else { my $setID; @@ -978,20 +975,20 @@ sub get_session_set_id { sub write_log_entry { my ($self, $message) = @_; - my $r = $self->{r}; + my $c = $self->{c}; my $user_id = $self->{user_id} // ''; my $login_type = $self->{login_type} // ''; my $credential_source = $self->{credential_source} // ''; - my $remote_host = $r->useragent_ip || 'UNKNOWN'; - my $remote_port = $r->remote_port || 'UNKNOWN'; - my $user_agent = $r->headers_in->{'User-Agent'}; + my $remote_host = $c->tx->remote_address || 'UNKNOWN'; + my $remote_port = $c->tx->remote_port || 'UNKNOWN'; + my $user_agent = $c->req->headers->user_agent; my $log_msg = "$message user_id=$user_id login_type=$login_type credential_source=$credential_source " . "host=$remote_host port=$remote_port UA=$user_agent"; debug("Writing to login log: '$log_msg'.\n"); - writeCourseLog($r->ce, 'login_log', $log_msg); + writeCourseLog($c->ce, 'login_log', $log_msg); } 1; diff --git a/lib/WeBWorK/Authen/CAS.pm b/lib/WeBWorK/Authen/CAS.pm index b0f65e8634..b5fe3f965a 100644 --- a/lib/WeBWorK/Authen/CAS.pm +++ b/lib/WeBWorK/Authen/CAS.pm @@ -27,7 +27,7 @@ use WeBWorK::Debug; sub checkSetUser { my ($self, $user_id, $new_id) = @_; - my $ce = $self->{r}->ce; + my $ce = $self->{c}->ce; unless (defined $ce->{authen}{cas_options}{sudoers}) { $self->{error} = "Set-user capability is not enabled."; @@ -61,8 +61,8 @@ sub checkSetUser { sub get_credentials { my $self = shift; - my $r = $self->{r}; - my $ce = $r->ce; + my $c = $self->{c}; + my $ce = $c->ce; # Disable password authentication $self->{external_auth} = 1; @@ -75,17 +75,17 @@ sub get_credentials { # when authenticating javascript web service requests (e.g., the # Library Browser). - if ($r->{rpc}) { + if ($c->{rpc}) { debug("falling back to superclass get_credentials (rpc call)"); return $self->SUPER::get_credentials(@_); } # if we come in with a user_id, then we've already authenticated # through the CAS. So just check the provided user and session key. - if (defined $r->param('key') && defined $r->param('user')) { + if (defined $c->param('key') && defined $c->param('user')) { # These lines were copied from the superclass get_credentials. - $self->{session_key} = $r->param('key'); - $self->{user_id} = $r->param('user'); + $self->{session_key} = $c->param('key'); + $self->{user_id} = $c->param('user'); $self->{login_type} = 'normal'; $self->{credential_source} = 'params'; debug("CAS params user '", $self->{user_id}, "' key '", $self->{session_key}, "'"); @@ -93,7 +93,7 @@ sub get_credentials { # determine the enrollment status of any other student if # they know the userid (which is public information at # Berkeley). That would be a privacy violation. - my $Key = $r->db->getKey($self->{user_id}); + my $Key = $c->db->getKey($self->{user_id}); unless (defined $Key && $Key->key eq $self->{session_key}) { debug( 'undefined or invalid session key: $Key->key = ', @@ -102,7 +102,7 @@ sub get_credentials { $self->{session_key} ); $self->{error} = "Invalid session key"; - $r->param('key' => undef); + $c->param('key' => undef); return $self->get_credentials(); } return 1; @@ -115,14 +115,14 @@ sub get_credentials { # CAFile => $cas_certs); my $cas = new AuthCAS(%{ $ce->{authen}{cas_options}{AuthCAS_opts} }); - my $service = $r->unparsed_uri(); + my $service = $c->unparsed_uri(); # Remove the "ticket=..." parameter that the CAS server added # (Not sure if the second test is really needed.) $service =~ s/[?&]ticket=[^&]*$// or $service =~ s/([?&])ticket=[^&]*&/$1/; $service = $ce->{server_root_url} . $service; debug("service = $service"); - my $ticket = $r->param('ticket'); + my $ticket = $c->param('ticket'); unless (defined $ticket) { # there's no ticket, so redirect to get one # @@ -143,7 +143,7 @@ sub get_credentials { return 0; } else { debug("ticket is good, user is $user_id"); - my $new_id = $r->param('setUser'); + my $new_id = $c->param('setUser'); if (defined $new_id) { return 0 unless checkSetUser($self, $user_id, $new_id); @@ -151,7 +151,7 @@ sub get_credentials { $user_id = $new_id; } $self->{'user_id'} = $user_id; - $self->{r}->param('user', $user_id); + $self->{c}->param('user', $user_id); $self->{session_key} = undef; $self->{password} = "not\tvalid"; $self->{login_type} = 'normal'; @@ -176,7 +176,7 @@ sub checkPassword { sub logout_user { my ($self) = @_; - my $ce = $self->{r}->ce; + my $ce = $self->{c}->ce; # Using AuthCAS::getServerLogoutURL($service) would be overkill, # and (more important) it would send us back here after logging out, diff --git a/lib/WeBWorK/Authen/Cosign.pm b/lib/WeBWorK/Authen/Cosign.pm index f5f85ebe29..4be9d8e572 100644 --- a/lib/WeBWorK/Authen/Cosign.pm +++ b/lib/WeBWorK/Authen/Cosign.pm @@ -25,7 +25,7 @@ to use: include in localOverrides.conf or course.conf and add /webwork2 or /webwork2/courseName as a CosignProtected Location -if $r->ce->{cosignoff} is set for a course, authentication reverts +if $c->ce->{cosignoff} is set for a course, authentication reverts to standard WeBWorK authentication. =cut @@ -41,16 +41,16 @@ use WeBWorK::Debug; sub get_credentials { my ($self) = @_; - my $r = $self->{r}; - my $ce = $r->ce; - my $db = $r->db; + my $c = $self->{c}; + my $ce = $c->ce; + my $db = $c->db; if ($ce->{cosignoff}) { return $self->SUPER::get_credentials(); } else { if (defined($ENV{'REMOTE_USER'})) { $self->{'user_id'} = $ENV{'REMOTE_USER'}; - $self->{r}->param("user", $ENV{'REMOTE_USER'}); + $self->{c}->param("user", $ENV{'REMOTE_USER'}); } else { return 0; } @@ -74,7 +74,7 @@ sub get_credentials { sub site_checkPassword { my ($self, $userID, $clearTextPassword) = @_; - if ($self->{r}->ce->{cosignoff}) { + if ($self->{c}->ce->{cosignoff}) { return 0; #return $self->SUPER::checkPassword( $userID, $clearTextPassword ); } else { @@ -87,7 +87,7 @@ sub site_checkPassword { # disable cookie functionality sub maybe_send_cookie { my ($self, @args) = @_; - if ($self->{r}->ce->{cosignoff}) { + if ($self->{c}->ce->{cosignoff}) { return $self->SUPER::maybe_send_cookie(@args); } else { # nothing to do here @@ -96,7 +96,7 @@ sub maybe_send_cookie { sub fetchCookie { my ($self, @args) = @_; - if ($self->{r}->ce->{cosignoff}) { + if ($self->{c}->ce->{cosignoff}) { return $self->SUPER::fetchCookie(@args); } else { # nothing to do here @@ -105,7 +105,7 @@ sub fetchCookie { sub sendCookie { my ($self, @args) = @_; - if ($self->{r}->ce->{cosignoff}) { + if ($self->{c}->ce->{cosignoff}) { return $self->SUPER::sendCookie(@args); } else { # nothing to do here @@ -114,7 +114,7 @@ sub sendCookie { sub killCookie { my ($self, @args) = @_; - if ($self->{r}->ce->{cosignoff}) { + if ($self->{c}->ce->{cosignoff}) { return $self->SUPER::killCookie(@args); } else { # nothing to do here @@ -125,16 +125,16 @@ sub killCookie { # logout script or what have you, but I don't see a way around that. sub forget_verification { my ($self, @args) = @_; - my $r = $self->{r}; + my $c = $self->{c}; - if ($r->ce->{cosignoff}) { + if ($c->ce->{cosignoff}) { return $self->SUPER::forget_verification(@args); } else { $self->{was_verified} = 0; - # $r->headers_out->{"Location"} = $r->ce->{cosign_logout_script}; - # $r->send_http_header; + # $c->headers_out->{"Location"} = $c->ce->{cosign_logout_script}; + # $c->send_http_header; # return; - $self->{redirect} = $r->ce->{cosign_logout_script}; + $self->{redirect} = $c->ce->{cosign_logout_script}; } } diff --git a/lib/WeBWorK/Authen/LDAP.pm b/lib/WeBWorK/Authen/LDAP.pm index 6743ebe299..801c54082e 100644 --- a/lib/WeBWorK/Authen/LDAP.pm +++ b/lib/WeBWorK/Authen/LDAP.pm @@ -23,7 +23,7 @@ use Net::LDAP qw/LDAP_INVALID_CREDENTIALS/; sub checkPassword { my ($self, $userID, $possibleClearPassword) = @_; - my $ce = $self->{r}->ce; + my $ce = $self->{c}->ce; my $failover = $ce->{authen}{ldap_options}{failover}; debug("LDAP module is doing the password checking.\n"); @@ -46,7 +46,7 @@ sub checkPassword { sub ldap_authen_uid { my ($self, $uid, $password) = @_; - my $ce = $self->{r}->ce; + my $ce = $self->{c}->ce; my $hosts = $ce->{authen}{ldap_options}{net_ldap_hosts}; my $opts = $ce->{authen}{ldap_options}{net_ldap_opts}; my $base = $ce->{authen}{ldap_options}{net_ldap_base}; diff --git a/lib/WeBWorK/Authen/LTIAdvanced.pm b/lib/WeBWorK/Authen/LTIAdvanced.pm index 327782a504..92ab707695 100644 --- a/lib/WeBWorK/Authen/LTIAdvanced.pm +++ b/lib/WeBWorK/Authen/LTIAdvanced.pm @@ -40,16 +40,16 @@ $Net::OAuth::PROTOCOL_VERSION = Net::OAuth::PROTOCOL_VERSION_1_0A; =over -=item new($r) +=item new($c) -Instantiates a new WeBWorK::Authen object for the given WeBWorK::Requst ($r). +Instantiates a new WeBWorK::Authen object for the given WeBWorK::Controller ($c). =cut sub new { - my ($invocant, $r) = @_; + my ($invocant, $c) = @_; my $class = ref($invocant) || $invocant; - my $self = { r => $r, }; + my $self = { c => $c, }; #initialize bless $self, $class; return $self; @@ -86,19 +86,19 @@ our @lis_person_sourcedid_options = ( sub request_has_data_for_this_verification_module { debug("LTIAdvanced has been called for data verification"); my $self = shift; - my $r = $self->{r}; + my $c = $self->{c}; # See comment in get_credentials() - if ($r->{rpc}) { + if ($c->{rpc}) { debug("LTIAdvanced returning 1 because it is an rpc call"); return 1; } # We need at least these things to verify an oauth request - if (!(defined $r->param("oauth_consumer_key")) - || !(defined $r->param("oauth_signature")) - || !(defined $r->param("oauth_nonce")) - || !(defined $r->param("oauth_timestamp"))) + if (!(defined $c->param("oauth_consumer_key")) + || !(defined $c->param("oauth_signature")) + || !(defined $c->param("oauth_nonce")) + || !(defined $c->param("oauth_timestamp"))) { debug("LTIAdvanced returning that it has insufficent data"); return (0); @@ -110,8 +110,8 @@ sub request_has_data_for_this_verification_module { sub get_credentials { my $self = shift; - my $r = $self->{r}; - my $ce = $r->{ce}; + my $c = $self->{c}; + my $ce = $c->{ce}; debug("LTIAdvanced::get_credentials has been called\n"); @@ -123,7 +123,7 @@ sub get_credentials { # when authenticating javascript web service requests (e.g., the # Library Browser). # Similar changes are needed in check_user() and verify_normal_user(). - if ($r->{rpc}) { + if ($c->{rpc}) { debug("falling back to superclass get_credentials (rpc call)"); return $self->SUPER::get_credentials(@_); } @@ -131,17 +131,15 @@ sub get_credentials { ## Printing parameters to main page can help people set things up ## so we dont use the debug channel here if ($ce->{debug_lti_parameters}) { - my $rh_headers = $r->headers_in; #request headers - - my @parameter_names = $r->param; # form parameter names + my @parameter_names = $c->param; # form parameter names my $parameter_report = ''; foreach my $key (@parameter_names) { - $parameter_report .= "$key => " . $r->param($key) . "\n"; + $parameter_report .= "$key => " . $c->param($key) . "\n"; } warn("===== parameters received =======\n", $parameter_report); } - my $oauth_time = $r->param("oauth_timestamp"); + my $oauth_time = $c->param("oauth_timestamp"); my $curr_time = time(); my $delta_time = $curr_time - $oauth_time; my $delta_min = (0.0 + $delta_time) / (60.0); @@ -163,10 +161,10 @@ sub get_credentials { if (!$ce->{preferred_source_of_username}) { warn "LTI is not properly configured (no preferred_source_of_username). Please contact your instructor or system administrator."; - $self->{error} = $r->maketext( + $self->{error} = $c->maketext( "There was an error during the login process. Please speak to your instructor or system administrator."); debug("No preferred_source_of_username in " - . $r->ce->{'courseName'} + . $c->ce->{'courseName'} . " so LTIAdvanced::get_credentials is returning a 0\n"); return 0; } @@ -175,16 +173,16 @@ sub get_credentials { my $type_of_source = ""; $self->{email} = ""; # set an initial value to avoid warnings when not provided - if (defined($r->param("lis_person_contact_email_primary"))) { - $self->{email} = uri_unescape($r->param("lis_person_contact_email_primary")) // ""; + if (defined($c->param("lis_person_contact_email_primary"))) { + $self->{email} = uri_unescape($c->param("lis_person_contact_email_primary")) // ""; } if ($ce->{preferred_source_of_username} eq "lis_person_sourcedid") { foreach my $key (@lis_person_sourcedid_options) { - if ($r->param($key)) { + if ($c->param($key)) { $user_id_source = $key; $type_of_source = "preferred_source_of_username"; - $self->{user_id} = $r->param($key); + $self->{user_id} = $c->param($key); last; } } @@ -197,20 +195,20 @@ sub get_credentials { # Strip off the part of the address after @ if requested to do so: $self->{user_id} =~ s/@.*$// if $ce->{strip_address_from_email}; - } elsif ($r->param($ce->{preferred_source_of_username})) { + } elsif ($c->param($ce->{preferred_source_of_username})) { $user_id_source = $ce->{preferred_source_of_username}; $type_of_source = "preferred_source_of_username"; - $self->{user_id} = $r->param($ce->{preferred_source_of_username}); + $self->{user_id} = $c->param($ce->{preferred_source_of_username}); } # Fallback if necessary if (!defined($self->{user_id}) && $ce->{fallback_source_of_username}) { if ($ce->{fallback_source_of_username} eq "lis_person_sourcedid") { foreach my $key (@lis_person_sourcedid_options) { - if ($r->param($key)) { + if ($c->param($key)) { $user_id_source = $key; $type_of_source = "fallback_source_of_username"; - $self->{user_id} = $r->param($key); + $self->{user_id} = $c->param($key); last; } } @@ -223,10 +221,10 @@ sub get_credentials { # Strip off the part of the address after @ if requested to do so: $self->{user_id} =~ s/@.*$// if $ce->{strip_address_from_email}; - } elsif ($r->param($ce->{fallback_source_of_username})) { + } elsif ($c->param($ce->{fallback_source_of_username})) { $user_id_source = $ce->{fallback_source_of_username}; $type_of_source = "fallback_source_of_username"; - $self->{user_id} = $r->param($ce->{fallback_source_of_username}); + $self->{user_id} = $c->param($ce->{fallback_source_of_username}); } } @@ -235,7 +233,7 @@ sub get_credentials { # Make user_id lowercase for consistency in naming if configured. $self->{user_id} = lc($self->{user_id}) if ($ce->{lti_lowercase_username}); - map { $self->{ $_->[0] } = $r->param($_->[1]); } ( + map { $self->{ $_->[0] } = $c->param($_->[1]); } ( [ 'role', 'roles' ], [ 'last_name', 'lis_person_name_family' ], [ 'first_name', 'lis_person_name_given' ], @@ -249,9 +247,9 @@ sub get_credentials { ); if (defined($ce->{preferred_source_of_student_id}) - && defined($r->param($ce->{preferred_source_of_student_id}))) + && defined($c->param($ce->{preferred_source_of_student_id}))) { - $self->{student_id} = $r->param($ce->{preferred_source_of_student_id}); + $self->{student_id} = $c->param($ce->{preferred_source_of_student_id}); } else { $self->{student_id} = ""; # fall back to avoid a warning when debug_lti_parameters enabled } @@ -281,7 +279,7 @@ sub get_credentials { } warn "LTI is not properly configured (failed to set user_id from preferred_source_of_username or fallback_source_of_username). Please contact your instructor or system administrator."; - $self->{error} = $r->maketext( + $self->{error} = $c->maketext( "There was an error during the login process. Please speak to your instructor or system administrator."); debug("LTIAdvanced::get_credentials is returning a 0\n"); return 0; @@ -290,22 +288,22 @@ sub get_credentials { # minor modification of method in superclass sub check_user { my $self = shift; - my $r = $self->{r}; - my ($ce, $db, $authz) = map { $r->$_; } ('ce', 'db', 'authz'); + my $c = $self->{c}; + my ($ce, $db, $authz) = map { $c->$_; } ('ce', 'db', 'authz'); my $user_id = $self->{user_id}; debug("LTIAdvanced::check_user has been called for user_id = |$user_id|"); # See comment in get_credentials() - if ($r->{rpc}) { + if ($c->{rpc}) { #debug("falling back to superclass check_user (rpc call)"); return $self->SUPER::check_user(@_); } if (!defined($user_id) || (defined $user_id && $user_id eq "")) { $self->{log_error} .= "no user id specified"; - $self->{error} = $r->maketext( + $self->{error} = $c->maketext( "There was an error during the login process. Please speak to your instructor or system administrator."); return 0; } @@ -330,7 +328,7 @@ sub check_user { } foreach my $key (keys(%options), ($use_lis_person_sourcedid_options ? @lis_person_sourcedid_options : ())) { - if (defined($r->param($key))) { + if (defined($c->param($key))) { debug( "User |$user_id| is unknown but may be an new user from an LSM via LTI. Saw a value for $key About to return a 1" ); @@ -339,20 +337,20 @@ sub check_user { } $self->{log_error} .= " $user_id - user unknown"; - $self->{error} = $r->maketext( + $self->{error} = $c->maketext( "There was an error during the login process. Please speak to your instructor or system administrator."); return 0; } unless ($ce->status_abbrev_has_behavior($User->status, "allow_course_access")) { $self->{log_error} .= "LOGIN FAILED $user_id - course access denied"; - $self->{error} = $r->maketext("Authentication failed. Please speak to your instructor."); + $self->{error} = $c->maketext("Authentication failed. Please speak to your instructor."); return 0; } unless ($authz->hasPermissions($user_id, "login")) { $self->{log_error} .= "LOGIN FAILED $user_id - no permission to login"; - $self->{error} = $r->maketext("Authentication failed. Please speak to your instructor."); + $self->{error} = $c->maketext("Authentication failed. Please speak to your instructor."); return 0; } @@ -365,12 +363,12 @@ sub verify_practice_user { return (0); } sub verify_normal_user { my $self = shift; - my ($r, $user_id, $session_key) = map { $self->{$_}; } ('r', 'user_id', 'session_key'); + my ($c, $user_id, $session_key) = map { $self->{$_}; } ('c', 'user_id', 'session_key'); debug("LTIAdvanced::verify_normal_user called for user |$user_id|"); # See comment in get_credentials() - if ($r->{rpc}) { + if ($c->{rpc}) { #debug("falling back to superclass verify_normal_user (rpc call)"); return $self->SUPER::verify_normal_user(@_); } @@ -387,11 +385,11 @@ sub verify_normal_user { # Parameters CANNOT be modified until after LTIAdvanced authentication # has been done, because the parameters passed with the request # are used in computing the OAuth_signature. If there - # are any changes in $r->{paramcache} (see Request.pm) + # are any changes in $c->{paramcache} (see Controller.pm) # before authentication occurs, then authentication will FAIL # even if the consumer_secret is correct. - $r->param("user" => $user_id); + $c->param("user" => $user_id); if ($auth_result eq "1") { $self->{session_key} = $self->create_session($user_id); @@ -406,49 +404,45 @@ sub verify_normal_user { sub authenticate { my $self = shift; - my ($r, $user) = map { $self->{$_}; } ('r', 'user_id'); + my ($c, $user) = map { $self->{$_}; } ('c', 'user_id'); # See comment in get_credentials() - if ($r->{rpc}) { + if ($c->{rpc}) { #debug("falling back to superclass authenticate (rpc call)"); return $self->SUPER::authenticate(@_); } debug("LTIAdvanced::authenticate called for user |$user|"); - debug "ref(r) = |" . ref($r) . "|"; - debug "ref of r->{paramcache} = |" . ref($r->{paramcache}) . "|"; + debug "ref(c) = |" . ref($c) . "|"; + debug "ref of c->{paramcache} = |" . ref($c->{paramcache}) . "|"; - my $ce = $r->ce; - my $db = $r->db; - my $courseName = $r->ce->{'courseName'}; + my $ce = $c->ce; + my $db = $c->db; + my $courseName = $c->ce->{'courseName'}; # Check nonce to see whether request is legitimate debug("Nonce = |" . $self->{oauth_nonce} . "|"); - my $nonce = WeBWorK::Authen::LTIAdvanced::Nonce->new($r, $self->{oauth_nonce}, $self->{oauth_timestamp}); + my $nonce = WeBWorK::Authen::LTIAdvanced::Nonce->new($c, $self->{oauth_nonce}, $self->{oauth_timestamp}); if (!($nonce->ok)) { - $self->{error} .= $r->maketext( + $self->{error} .= $c->maketext( "There was an error during the login process. Please speak to your instructor or system administrator if this recurs." ); debug("Failed to verify nonce"); return 0; } - debug("r->param(oauth_signature) = |" . $r->param("oauth_signature") . "|"); + debug("c->param(oauth_signature) = |" . $c->param("oauth_signature") . "|"); my %request_hash; - my @keys = keys %{ $r->{paramcache} }; + my @keys = keys %{ $c->{paramcache} }; foreach my $key (@keys) { - $request_hash{$key} = $r->param($key); + $request_hash{$key} = $c->param($key); debug("$key->|" . $request_hash{$key} . "|"); } my $requestHash = \%request_hash; # We need to provide the request URL when verifying the OAuth request. # We use the url request by default, but also allow it to be overriden - my $path = $ce->{server_root_url} . $ce->{webwork_url}; - $path = $ce->{LTIBasicToThisSiteURL} ? $ce->{LTIBasicToThisSiteURL} : $path; - - # append the path the the server url - $path = $path . $r->urlpath()->path; + my $path = $ce->{LTIBasicToThisSiteURL} || ($c->url_for->to_abs =~ s|/?$|/|r); if ($ce->{debug_lti_parameters}) { warn("The following path was reconstructed by WeBWorK. It should match the path in the LMS:"); @@ -481,7 +475,7 @@ sub authenticate { debug("construction of Net::OAuth object failed: $@"); debug("eval failed: ", $@, "

      "); - $self->{error} .= $r->maketext( + $self->{error} .= $c->maketext( "There was an error during the login process. Please speak to your instructor or system administrator."); $self->{log_error} .= "Construction of OAuth request record failed"; return 0; @@ -491,7 +485,7 @@ sub authenticate { debug("LTIAdvanced::authenticate request-> verify failed"); debug("OAuth verification Failed "); - $self->{error} .= $r->maketext( + $self->{error} .= $c->maketext( "There was an error during the login process. Please speak to your instructor or system administrator."); $self->{log_error} .= "OAuth verification failed. Check the Consumer Secret and that the URL in the LMS exactly matches the WeBWorK URL."; @@ -513,7 +507,7 @@ sub authenticate { if (!$db->existsUser($userID)) { # New User. Create User record if ($ce->{block_lti_create_user}) { # We don't yet have the next string in the PO/POT files - so the next line is disabled. -# $r->maketext("Account creation is currently disabled in this course. Please speak to your instructor or system administrator."); +# $c->maketext("Account creation is currently disabled in this course. Please speak to your instructor or system administrator."); $self->{log_error} .= "Account creation blocked by block_lti_create_user setting. Did not create user $userID."; if ($ce->{debug_lti_parameters}) { @@ -525,7 +519,7 @@ sub authenticate { } else { # Attempt to create the user, and warn if that fails. unless ($self->create_user()) { - $r->maketext( + $c->maketext( "There was an error during the login process. Please speak to your instructor or system administrator." ); $self->{log_error} .= "Failed to create user $userID."; @@ -555,7 +549,7 @@ sub authenticate { if ($LTIGradeMode eq 'course' || $LTIGradeMode eq 'homework') { - my $submitGrade = WeBWorK::Authen::LTIAdvanced::SubmitGrade->new($r); + my $submitGrade = WeBWorK::Authen::LTIAdvanced::SubmitGrade->new($c); $submitGrade->update_sourcedid($userID); } @@ -563,7 +557,7 @@ sub authenticate { } debug("LTIAdvanced is returning a failed authentication"); - $self->{error} = $r->maketext( + $self->{error} = $c->maketext( "There was an error during the login process. Please speak to your instructor or system administrator."); return (0); } @@ -571,17 +565,17 @@ sub authenticate { # create a new user trying to log in sub create_user { my $self = shift; - my $r = $self->{r}; + my $c = $self->{c}; my $userID = $self->{user_id}; - my $ce = $r->ce; - my $db = $r->db; - my $courseName = $r->ce->{'courseName'}; + my $ce = $c->ce; + my $db = $c->db; + my $courseName = $c->ce->{'courseName'}; ############################################################ # Determine the roles defined for this user by the LTI request # and assign a permission level on that basis. ############################################################ - my $LTIrolesString = $r->param("roles"); + my $LTIrolesString = $c->param("roles"); my @LTIroles = split /,/, $LTIrolesString; #remove the urn string if its present @@ -621,7 +615,7 @@ sub create_user { if ($LTI_webwork_permissionLevel > $ce->{userRoles}->{ $ce->{LTIAccountCreationCutoff} }) { $self->{log_error} .= "userID: $userID -- Unknown instructor attempting to log in via LTI. Instructor accounts must be created manually"; - croak $r->maketext( + croak $c->maketext( "The instructor account with user id [_1] does not exist. Please create the account manually via WeBWorK.", $userID ); @@ -654,7 +648,7 @@ sub create_user { $newPermissionLevel->user_id($userID); $newPermissionLevel->permission($LTI_webwork_permissionLevel); $db->addPermissionLevel($newPermissionLevel); - $r->authz->{PermissionLevel} = $newPermissionLevel; #cache the Permission Level Record. + $c->authz->{PermissionLevel} = $newPermissionLevel; #cache the Permission Level Record. # Assign existing sets my @setsToAssign = (); @@ -706,11 +700,11 @@ sub create_user { # possibly update a user logging in sub maybe_update_user { my $self = shift; - my $r = $self->{r}; + my $c = $self->{c}; my $userID = $self->{user_id}; - my $ce = $r->ce; - my $db = $r->db; - my $courseName = $r->ce->{'courseName'}; + my $ce = $c->ce; + my $db = $c->db; + my $courseName = $c->ce->{'courseName'}; my $user = $db->getUser($userID); my $permissionLevel = $db->getPermissionLevel($userID); @@ -790,10 +784,10 @@ use constant NONCE_PURGE_FREQUENCY => 7200; # 2 hours use constant NONCE_LIFETIME => 21600; # 6 hours sub new { - my ($invocant, $r, $nonce, $timestamp) = @_; + my ($invocant, $c, $nonce, $timestamp) = @_; my $class = ref($invocant) || $invocant; my $self = { - r => $r, + c => $c, nonce => $nonce, timestamp => $timestamp, }; @@ -803,9 +797,9 @@ sub new { sub ok { my $self = shift; - my $r = $self->{r}; - my $ce = $r->{ce}; - my $db = $self->{r}->{db}; + my $c = $self->{c}; + my $ce = $c->ce; + my $db = $c->db; $self->maybe_purge_nonces(); @@ -841,9 +835,9 @@ sub ok { sub maybe_purge_nonces { my $self = shift; - my $r = $self->{r}; - my $ce = $r->{ce}; - my $db = $self->{r}->{db}; + my $c = $self->{c}; + my $ce = $c->ce; + my $db = $c->db; my $time = time; my $lastPurge = $db->getSettingValue('lastNoncePurge'); diff --git a/lib/WeBWorK/Authen/LTIAdvanced/SubmitGrade.pm b/lib/WeBWorK/Authen/LTIAdvanced/SubmitGrade.pm index 028f6bf9dd..4fca85a5b6 100644 --- a/lib/WeBWorK/Authen/LTIAdvanced/SubmitGrade.pm +++ b/lib/WeBWorK/Authen/LTIAdvanced/SubmitGrade.pm @@ -38,12 +38,12 @@ use Digest::SHA qw(sha1_base64); # This package contains utilities for submitting grades to the LMS sub new { - my ($invocant, $r) = @_; + my ($invocant, $c) = @_; my $class = ref($invocant) || $invocant; - my $self = { r => $r, }; + my $self = { c => $c, }; # sanity check - my $ce = $r->{ce}; - my $db = $self->{r}->{db}; + my $ce = $c->ce; + my $db = $self->{c}->db; unless (ref($ce // '') and ref($db) // '') { warn("course environment is not defined") unless ref($ce // ''); @@ -61,13 +61,13 @@ sub new { sub update_sourcedid { my $self = shift; my $userID = shift; - my $r = $self->{r}; - my $ce = $r->{ce}; - my $db = $self->{r}->{db}; + my $c = $self->{c}; + my $ce = $c->ce; + my $db = $self->{c}->db; # These parameters are used to build the passback request # warn if no outcome service url - if (!defined($r->param('lis_outcome_service_url'))) { + if (!defined($c->param('lis_outcome_service_url'))) { carp "The parameter lis_outcome_service_url is not defined. Unable to report grades to the LMS." . " Are external grades enabled in the LMS?" if $ce->{debug_lti_grade_passback}; @@ -75,31 +75,31 @@ sub update_sourcedid { # otherwise keep it up to date my $lis_outcome_service_url = $db->getSettingValue('lis_outcome_service_url'); if (!defined($lis_outcome_service_url) - || $lis_outcome_service_url ne $r->param('lis_outcome_service_url')) + || $lis_outcome_service_url ne $c->param('lis_outcome_service_url')) { - $db->setSettingValue('lis_outcome_service_url', $r->param('lis_outcome_service_url')); + $db->setSettingValue('lis_outcome_service_url', $c->param('lis_outcome_service_url')); } } # these parameters have to be here or we couldn't have gotten this far my $consumer_key = $db->getSettingValue('consumer_key'); if (!defined($consumer_key) - || $consumer_key ne $r->param('oauth_consumer_key')) + || $consumer_key ne $c->param('oauth_consumer_key')) { - $db->setSettingValue('consumer_key', $r->param('oauth_consumer_key')); + $db->setSettingValue('consumer_key', $c->param('oauth_consumer_key')); } my $signature_method = $db->getSettingValue('signature_method'); if (!defined($signature_method) - || $signature_method ne $r->param('oauth_signature_method')) + || $signature_method ne $c->param('oauth_signature_method')) { - $db->setSettingValue('signature_method', $r->param('oauth_signature_method')); + $db->setSettingValue('signature_method', $c->param('oauth_signature_method')); } # The $sourcedid is what identifies the user and assignment # to the LMS. It is either a course grade or a set grade # depending on the request and the mode we are in. - my $sourcedid = $r->param('lis_result_sourcedid'); + my $sourcedid = $c->param('lis_result_sourcedid'); if (!defined($sourcedid)) { warn "No LISSourceID! Some LMS's do not give grades to instructors, but this " . "could also be a sign that external grades are not enabled in your LMS." @@ -112,8 +112,7 @@ sub update_sourcedid { $db->putUser($User); } } elsif ($ce->{LTIGradeMode} eq 'homework') { - my $urlpath = $r->urlpath; - my $setID = $urlpath->arg("setID"); + my $setID = $c->stash('setID'); if (!defined($setID)) { warn "Not a link to a Problem Set and in homework grade mode." . " Links to WeBWorK should point to specific problem sets."; @@ -141,9 +140,9 @@ sub update_sourcedid { sub submit_course_grade { my $self = shift; my $userID = shift; - my $r = $self->{r}; - my $ce = $r->{ce}; - my $db = $self->{r}->{db}; + my $c = $self->{c}; + my $ce = $c->ce; + my $db = $self->{c}->db; my $score = grade_all_sets($db, $userID); my $user = $db->getUser($userID); @@ -163,9 +162,9 @@ sub submit_set_grade { my $self = shift; my $userID = shift; my $setID = shift; - my $r = $self->{r}; - my $ce = $r->{ce}; - my $db = $self->{r}->{db}; + my $c = $self->{c}; + my $ce = $c->ce; + my $db = $c->db; my $user = $db->getUser($userID); @@ -206,9 +205,9 @@ sub submit_grade { my $self = shift; my $sourcedid = shift; my $score = shift; - my $r = $self->{r}; - my $ce = $r->{ce}; - my $db = $self->{r}->{db}; + my $c = $self->{c}; + my $ce = $c->ce; + my $db = $self->{c}->db; $score = wwRound(2, $score); @@ -534,9 +533,9 @@ sub mass_update { my ($self, $update, $name, $name2) = @_; $name ||= ''; $name2 ||= ''; - my $r = $self->{r}; - my $ce = $r->ce; - my $db = $r->db; + my $c = $self->{c}; + my $ce = $c->ce; + my $db = $c->db; # sanity check unless (ref($ce)) { @@ -608,7 +607,7 @@ sub mass_update { }; if ($@) { # Write errors to the Mojolicious log. - $r->log->error("An error occured while trying to mass_update grades via LTI: $@\n"); + $c->log->error("An error occured while trying to mass_update grades via LTI: $@\n"); } $self->{post_processing_mode} = 0; } diff --git a/lib/WeBWorK/Authen/LTIBasic.pm b/lib/WeBWorK/Authen/LTIBasic.pm index 933900ad32..a2195f4179 100644 --- a/lib/WeBWorK/Authen/LTIBasic.pm +++ b/lib/WeBWorK/Authen/LTIBasic.pm @@ -51,16 +51,16 @@ our $GENERIC_UNKNOWN_INSTRUCTOR_ERROR_MESSAGE = =over -=item new($r) +=item new($c) -Instantiates a new WeBWorK::Authen object for the given WeBWorK::Requst ($r). +Instantiates a new WeBWorK::Authen object for the given WeBWorK::Controller ($c). =cut sub new { - my ($invocant, $r) = @_; + my ($invocant, $c) = @_; my $class = ref($invocant) || $invocant; - my $self = { r => $r, }; + my $self = { c => $c, }; #initialize bless $self, $class; return $self; @@ -142,17 +142,17 @@ our @lis_person_sourcedid_options = ( sub request_has_data_for_this_verification_module { #debug("LTIBasic has been called for data verification"); my $self = shift; - my $r = $self->{r}; + my $c = $self->{c}; # See comment in get_credentials() - if ($r->{rpc}) { + if ($c->{rpc}) { #debug("LTIBasic returning 1 because it is an rpc call"); return 1; } - if (!(defined $r->param("oauth_consumer_key")) - or !(defined $r->param("oauth_signature")) - or !(defined $r->param("oauth_nonce")) - or !(defined $r->param("oauth_timestamp"))) + if (!(defined $c->param("oauth_consumer_key")) + or !(defined $c->param("oauth_signature")) + or !(defined $c->param("oauth_nonce")) + or !(defined $c->param("oauth_timestamp"))) { #debug("LTIBasic returning that it has insufficent data"); return (0); @@ -164,19 +164,17 @@ sub request_has_data_for_this_verification_module { sub get_credentials { my $self = shift; - my $r = $self->{r}; - my $ce = $r->{ce}; + my $c = $self->{c}; + my $ce = $c->ce; #debug("LTIBasic::get_credentials has been called\n"); ## debug code MEG if ($ce->{debug_lti_parameters}) { - my $rh_headers = $r->headers_in; #request headers - - my @parameter_names = $r->param; # form parameter names + my @parameter_names = $c->param; # form parameter names my $parameter_report = ''; foreach my $key (@parameter_names) { - $parameter_report .= "$key => " . $r->param($key) . "\n"; + $parameter_report .= "$key => " . $c->param($key) . "\n"; } warn("===== parameters received =======\n", $parameter_report); } @@ -194,7 +192,7 @@ sub get_credentials { # Library Browser). # Similar changes are needed in check_user() and verify_normal_user(). - if ($r->{rpc}) { + if ($c->{rpc}) { #debug("falling back to superclass get_credentials (rpc call)"); return $self->SUPER::get_credentials(@_); } @@ -204,10 +202,10 @@ sub get_credentials { if (!$ce->{preferred_source_of_username}) { warn "LTI is not properly configured (no preferred_source_of_username). Please contact your instructor or system administrator."; - $self->{error} = $r->maketext( + $self->{error} = $c->maketext( "There was an error during the login process. Please speak to your instructor or system administrator."); debug("No preferred_source_of_username in " - . $r->ce->{'courseName'} + . $c->ce->{'courseName'} . " so LTIBasic::get_credentials is returning a 0\n"); return 0; } @@ -216,16 +214,16 @@ sub get_credentials { my $type_of_source = ""; $self->{email} = ""; # set an initial value to avoid warnings when not provided - if (defined($r->param("lis_person_contact_email_primary"))) { - $self->{email} = uri_unescape($r->param("lis_person_contact_email_primary")) // ""; + if (defined($c->param("lis_person_contact_email_primary"))) { + $self->{email} = uri_unescape($c->param("lis_person_contact_email_primary")) // ""; } if ($ce->{preferred_source_of_username} eq "lis_person_sourcedid") { foreach my $key (@lis_person_sourcedid_options) { - if ($r->param($key)) { + if ($c->param($key)) { $user_id_source = $key; $type_of_source = "preferred_source_of_username"; - $self->{user_id} = $r->param($key); + $self->{user_id} = $c->param($key); last; } } @@ -238,20 +236,20 @@ sub get_credentials { # Strip off the part of the address after @ if requested to do so: $self->{user_id} =~ s/@.*$// if $ce->{strip_address_from_email}; - } elsif ($r->param($ce->{preferred_source_of_username})) { + } elsif ($c->param($ce->{preferred_source_of_username})) { $user_id_source = $ce->{preferred_source_of_username}; $type_of_source = "preferred_source_of_username"; - $self->{user_id} = $r->param($ce->{preferred_source_of_username}); + $self->{user_id} = $c->param($ce->{preferred_source_of_username}); } # Fallback if necessary if (!defined($self->{user_id}) && $ce->{fallback_source_of_username}) { if ($ce->{fallback_source_of_username} eq "lis_person_sourcedid") { foreach my $key (@lis_person_sourcedid_options) { - if ($r->param($key)) { + if ($c->param($key)) { $user_id_source = $key; $type_of_source = "fallback_source_of_username"; - $self->{user_id} = $r->param($key); + $self->{user_id} = $c->param($key); last; } } @@ -264,16 +262,16 @@ sub get_credentials { # Strip off the part of the address after @ if requested to do so: $self->{user_id} =~ s/@.*$// if $ce->{strip_address_from_email}; - } elsif ($r->param($ce->{fallback_source_of_username})) { + } elsif ($c->param($ce->{fallback_source_of_username})) { $user_id_source = $ce->{fallback_source_of_username}; $type_of_source = "fallback_source_of_username"; - $self->{user_id} = $r->param($ce->{fallback_source_of_username}); + $self->{user_id} = $c->param($ce->{fallback_source_of_username}); } } # if we were able to set a user_id if (defined($self->{user_id}) && $self->{user_id} ne "") { - map { $self->{ $_->[0] } = $r->param($_->[1]); } ( + map { $self->{ $_->[0] } = $c->param($_->[1]); } ( #['user_id', 'lis_person_sourcedid'], [ 'role', 'roles' ], [ 'last_name', 'lis_person_name_family' ], @@ -289,9 +287,9 @@ sub get_credentials { ); if (defined($ce->{preferred_source_of_student_id}) - && defined($r->param($ce->{preferred_source_of_student_id}))) + && defined($c->param($ce->{preferred_source_of_student_id}))) { - $self->{student_id} = $r->param($ce->{preferred_source_of_student_id}); + $self->{student_id} = $c->param($ce->{preferred_source_of_student_id}); } else { $self->{student_id} = ""; # fall back to avoid a warning when debug_lti_parameters enabled } @@ -328,7 +326,7 @@ sub get_credentials { #debug("LTIBasic::get_credentials is returning a 0\n"); warn "LTI is not properly configured (failed to obtain user_id from preferred_source_of_username or fallback_source_of_username). Please contact your instructor or system administrator."; - $self->{error} = $r->maketext( + $self->{error} = $c->maketext( "There was an error during the login process. Please speak to your instructor or system administrator."); return 0; } @@ -336,23 +334,23 @@ sub get_credentials { # minor modification of method in superclass sub check_user { my $self = shift; - my $r = $self->{r}; - my ($ce, $db, $authz) = map { $r->$_; } ('ce', 'db', 'authz'); + my $c = $self->{c}; + my ($ce, $db, $authz) = map { $c->$_; } ('ce', 'db', 'authz'); my $user_id = $self->{user_id}; #debug("LTIBasic::check_user has been called for user_id = |$user_id|"); # See comment in get_credentials() - if ($r->{rpc}) { + if ($c->{rpc}) { #debug("falling back to superclass check_user (rpc call)"); return $self->SUPER::check_user(@_); } if (!defined($user_id) or (defined $user_id and $user_id eq "")) { $self->{log_error} .= "no user id specified"; - my $LMS = $ce->{LMS_url} ? $r->link_to($ce->{LMS_name} => $ce->{LMS_url}) : $ce->{LMS_name}; - $self->{error} = $r->maketext($GENERIC_MISSING_USER_ID_ERROR_MESSAGE, $LMS); + my $LMS = $ce->{LMS_url} ? $c->link_to($ce->{LMS_name} => $ce->{LMS_url}) : $ce->{LMS_name}; + $self->{error} = $c->maketext($GENERIC_MISSING_USER_ID_ERROR_MESSAGE, $LMS); return 0; } @@ -376,7 +374,7 @@ sub check_user { } foreach my $key (keys(%options), ($use_lis_person_sourcedid_options ? @lis_person_sourcedid_options : ())) { - if (defined($r->param($key))) { + if (defined($c->param($key))) { debug( "User |$user_id| is unknown but may be an new user from an LSM via LTI. Saw a value for $key About to return a 1" ); @@ -385,20 +383,20 @@ sub check_user { } $self->{log_error} .= " $user_id - user unknown"; - $self->{error} = $r->maketext( + $self->{error} = $c->maketext( "There was an error during the login process. Please speak to your instructor or system administrator."); return 0; } unless ($ce->status_abbrev_has_behavior($User->status, "allow_course_access")) { $self->{log_error} .= "LOGIN FAILED $user_id - course access denied"; - $self->{error} = $r->maketext($GENERIC_DENIED_LOGIN_ERROR_MESSAGE); + $self->{error} = $c->maketext($GENERIC_DENIED_LOGIN_ERROR_MESSAGE); return 0; } unless ($authz->hasPermissions($user_id, "login")) { $self->{log_error} .= "LOGIN FAILED $user_id - no permission to login"; - $self->{error} = $r->maketext($GENERIC_DENIED_LOGIN_ERROR_MESSAGE); + $self->{error} = $c->maketext($GENERIC_DENIED_LOGIN_ERROR_MESSAGE); return 0; } #debug("LTIBasic::check_user is about to return a 1."); @@ -410,12 +408,12 @@ sub verify_practice_user { return (0); } sub verify_normal_user { my $self = shift; - my ($r, $user_id, $session_key) = map { $self->{$_}; } ('r', 'user_id', 'session_key'); + my ($c, $user_id, $session_key) = map { $self->{$_}; } ('c', 'user_id', 'session_key'); #debug("LTIBasic::verify_normal_user called for user |$user_id|"); # See comment in get_credentials() - if ($r->{rpc}) { + if ($c->{rpc}) { #debug("falling back to superclass verify_normal_user (rpc call)"); return $self->SUPER::verify_normal_user(@_); } @@ -433,11 +431,11 @@ sub verify_normal_user { # are used in computing the OAuth_signature. If there - # are any changes in $r -> {paramcache} (see Request.pm) + # are any changes in $c->{paramcache} (see Controller.pm) # before authentication occurs, then authentication will FAIL # even if the consumer_secret is correct. - $r->param("user" => $user_id); + $c->param("user" => $user_id); if ($auth_result eq "1") { #debug("About to call create_session."); @@ -445,7 +443,7 @@ sub verify_normal_user { #debug("session_key=|" . $self -> {session_key} . "|."); return 1; } else { - $self->{error} = $r->maketext($auth_result); + $self->{error} = $c->maketext($auth_result); $self->{log_error} .= "$user_id - authentication failed: " . $self->{error}; return 0; } @@ -453,47 +451,47 @@ sub verify_normal_user { sub authenticate { my $self = shift; - my ($r, $user) = map { $self->{$_}; } ('r', 'user_id'); + my ($c, $user) = map { $self->{$_}; } ('c', 'user_id'); # See comment in get_credentials() - if ($r->{rpc}) { + if ($c->{rpc}) { #debug("falling back to superclass authenticate (rpc call)"); return $self->SUPER::authenticate(@_); } #debug("LTIBasic::authenticate called for user |$user|"); - #debug "ref(r) = |". ref($r) . "|"; - #debug "ref of r->{paramcache} = |" . ref($r -> {paramcache}) . "|"; - #debug "request_method = |" . $r -> request_method . "|"; - my $ce = $r->ce; - my $db = $r->db; - my $courseName = $r->ce->{'courseName'}; + #debug "ref(c) = |". ref($c) . "|"; + #debug "ref of c->{paramcache} = |" . ref($c -> {paramcache}) . "|"; + #debug "request_method = |" . $c -> request_method . "|"; + my $ce = $c->ce; + my $db = $c->db; + my $courseName = $c->ce->{'courseName'}; my $webmaster = $ce->{Local_Email_Addresses}->{Webmaster}; my $verify_code = 0; my $timestamp = 0; # Check nonce to see whether request is legitimate #debug("Nonce = |" . $self-> {oauth_nonce} . "|"); - my $nonce = WeBWorK::Authen::LTIBasic::Nonce->new($r, $self->{oauth_nonce}, $self->{oauth_timestamp}); + my $nonce = WeBWorK::Authen::LTIBasic::Nonce->new($c, $self->{oauth_nonce}, $self->{oauth_timestamp}); if (!($nonce->ok)) { - my $LMS = $ce->{LMS_url} ? $r->link_to($ce->{LMS_name} => $ce->{LMS_url}) : $ce->{LMS_name}; - #debug( "eval failed: ", $@, "

      "; print_keys($r);); - $self->{error} .= $r->maketext( + my $LMS = $ce->{LMS_url} ? $c->link_to($ce->{LMS_name} => $ce->{LMS_url}) : $ce->{LMS_name}; + #debug( "eval failed: ", $@, "

      "; print_keys($c);); + $self->{error} .= $c->maketext( $GENERIC_ERROR_MESSAGE . ": Something was wrong with your Nonce LTI parameters. If this recurs, please speak with your instructor", $LMS ); return 0; } - #debug( "r->param(oauth_signature) = |" . $r -> param("oauth_signature") . "|"); + #debug( "c->param(oauth_signature) = |" . $c -> param("oauth_signature") . "|"); my %request_hash; - my @keys = keys %{ $r->{paramcache} }; + my @keys = keys %{ $c->{paramcache} }; foreach my $key (@keys) { - $request_hash{$key} = $r->param($key); + $request_hash{$key} = $c->param($key); #debug("$key -> |" . $requestHash -> {$key} . "|"); } my $requestHash = \%request_hash; - my $path = $ce->{server_root_url} . $ce->{webwork_url} . $r->urlpath()->path; + my $path = $c->url_for->to_abs =~ s|/?$|/|r; $path = $ce->{LTIBasicToThisSiteURL} ? $ce->{LTIBasicToThisSiteURL} : $path; my $altpath = $path; @@ -520,19 +518,19 @@ sub authenticate { if ($@) { #debug("construction of Net::OAuth object failed: $@"); - #debug( "eval failed: ", $@, "

      "; print_keys($r);); - $self->{error} .= $r->maketext("Your authentication failed. Please return to Oncourse and login again."); - $self->{error} .= $r->maketext( + #debug( "eval failed: ", $@, "

      "; print_keys($c);); + $self->{error} .= $c->maketext("Your authentication failed. Please return to Oncourse and login again."); + $self->{error} .= $c->maketext( "Something was wrong with your LTI parameters. If this recurs, please speak with your instructor"); $self->{log_error} .= "Construction of OAuth request record failed"; return 0; } else { if (!$request->verify && !$altrequest->verify) { #debug("LTIBasic::authenticate request-> verify failed"); - #debug("

      OAuth verification Failed

      "; print_keys($r)); - $self->{error} .= $r->maketext("Your authentication failed. Please return to Oncourse and login again."); + #debug("

      OAuth verification Failed

      "; print_keys($c)); + $self->{error} .= $c->maketext("Your authentication failed. Please return to Oncourse and login again."); $self->{error} .= - $r->maketext("Your LTI OAuth verification failed. If this recurs, please speak with your instructor"); + $c->maketext("Your LTI OAuth verification failed. If this recurs, please speak with your instructor"); $self->{log_error} .= "OAuth verification failed. Check the Consumer Secret."; return 0; } else { @@ -542,7 +540,7 @@ sub authenticate { # and assign a permission level on that basis. ############################################################ my $userID = $self->{user_id}; - my $LTIrolesString = $r->param("roles"); + my $LTIrolesString = $c->param("roles"); my @LTIroles = split /,/, $LTIrolesString; #remove the urn string if its present @@ -578,7 +576,7 @@ sub authenticate { # The code works for the U. of Rochester Blackboard ################################################################## - # my $LTI_section = $r->param("context_label"); # for example: MTH208.2014FALL.54648 + # my $LTI_section = $c->param("context_label"); # for example: MTH208.2014FALL.54648 # my ($course_number, $semester, $CRN) = split(/\./, $LTI_section); # if ($self->{section} eq "unknown" and $CRN ) { # $self->{section}= $CRN//"unknown"; # update unknown sections from CRN if possible @@ -597,8 +595,8 @@ sub authenticate { if ($ce->{debug_lti_parameters}); if ($LTI_webwork_permissionLevel > $ce->{userRoles}->{"ta"}) { $self->{log_error} .= "userID: $userID --" . ' ' . $GENERIC_UNKNOWN_INSTRUCTOR_ERROR_MESSAGE; - croak $r->maketext("userID: [_1] --", $userID) - . $r->maketext($GENERIC_UNKNOWN_INSTRUCTOR_ERROR_MESSAGE); + croak $c->maketext("userID: [_1] --", $userID) + . $c->maketext($GENERIC_UNKNOWN_INSTRUCTOR_ERROR_MESSAGE); } my $newUser = $db->newUser(); $newUser->user_id($userID); @@ -620,7 +618,7 @@ sub authenticate { $newPermissionLevel->user_id($userID); $newPermissionLevel->permission($LTI_webwork_permissionLevel); $db->addPermissionLevel($newPermissionLevel); - $r->authz->{PermissionLevel} = $newPermissionLevel; #cache the Permission Level Record. + $c->authz->{PermissionLevel} = $newPermissionLevel; #cache the Permission Level Record. # Assign existing sets # This module is not a subclass of WeBWorK::ContentGenerator::Instuctor, # do the methods defined therein for assigning problem sets and problems @@ -812,7 +810,7 @@ sub authenticate { } } #debug("LTIBasic is returning a failed authentication"); - $self->{error} = $r->maketext($GENERIC_ERROR_MESSAGE, $ce->{LMS_name}); + $self->{error} = $c->maketext($GENERIC_ERROR_MESSAGE, $ce->{LMS_name}); return (0); } @@ -825,10 +823,10 @@ sub authenticate { package WeBWorK::Authen::LTIBasic::Nonce; sub new { - my ($invocant, $r, $nonce, $timestamp) = @_; + my ($invocant, $c, $nonce, $timestamp) = @_; my $class = ref($invocant) || $invocant; my $self = { - r => $r, + c => $c, nonce => $nonce, timestamp => $timestamp, }; @@ -838,12 +836,12 @@ sub new { sub ok { my $self = shift; - my $r = $self->{r}; - my $ce = $r->{ce}; + my $c = $self->{c}; + my $ce = $c->ce; if ($self->{timestamp} < time() - $ce->{NonceLifeTime}) { return 0; } - my $db = $self->{r}->{db}; + my $db = $self->{c}->db; my $Key = $db->getKey($self->{nonce}); # If we *haven't* used this nonce before then we are OK. @@ -877,12 +875,12 @@ sub ok { ################################################################################ sub print_keys { - my ($self, $r) = @_; - my @keys = keys %{ $r->{paramcache} }; + my ($self, $c) = @_; + my @keys = keys %{ $c->{paramcache} }; my %request_hash; my $key; foreach $key (@keys) { - $request_hash{$key} = $r->param($key); + $request_hash{$key} = $c->param($key); warn("$key -> |" . $request_hash{$key} . "|"); } my $requestHash = \%request_hash; diff --git a/lib/WeBWorK/Authen/Moodle.pm b/lib/WeBWorK/Authen/Moodle.pm index c222746008..43b4de6c12 100644 --- a/lib/WeBWorK/Authen/Moodle.pm +++ b/lib/WeBWorK/Authen/Moodle.pm @@ -52,7 +52,7 @@ sub new { # (this is similar to what happens when a guest user is selected.) sub get_credentials { my $self = shift; - my $r = $self->{r}; + my $c = $self->{c}; my $super_result = $self->SUPER::get_credentials; if ($super_result) { @@ -98,7 +98,7 @@ sub site_fixup { # this is overridden to accommodate this. sub checkPassword { my ($self, $userID, $possibleClearPassword) = @_; - my $db = $self->{r}->db; + my $db = $self->{c}->db; debug("Moodle module is doing the password checking.\n"); @@ -166,14 +166,14 @@ sub init_mdl_session { my $self = shift; # version-specific stuff - $self->{moodle17} = $self->{r}->ce->{authen}{moodle_options}{moodle17}; + $self->{moodle17} = $self->{c}->ce->{authen}{moodle_options}{moodle17}; $self->{sql_session_table} = $self->{moodle17} ? "sessions2" : "sessions"; $self->{sql_data_field} = $self->{moodle17} ? "sessdata" : "data"; $self->{mdl_dbh} = DBI->connect_cached( - $self->{r}->ce->{authen}{moodle_options}{dsn}, - $self->{r}->ce->{authen}{moodle_options}{username}, - $self->{r}->ce->{authen}{moodle_options}{password}, + $self->{c}->ce->{authen}{moodle_options}{dsn}, + $self->{c}->ce->{authen}{moodle_options}{username}, + $self->{c}->ce->{authen}{moodle_options}{password}, { PrintError => 0, RaiseError => 1, @@ -188,10 +188,10 @@ sub fetch_moodle_session { # Note that we don't worry about the user being in this course at this point. # That is taken care of in Schema::Moodle::User. my ($self) = @_; - my $r = $self->{r}; - my $db = $r->db; + my $c = $self->{c}; + my $db = $c->db; - my $cookie = $r->req->cookie('MoodleSession'); + my $cookie = $c->req->cookie('MoodleSession'); return unless $cookie; my $session_table = $self->prefix_table($self->{sql_session_table}); @@ -219,10 +219,10 @@ sub fetch_moodle_session { sub update_moodle_session { # extend the timeout of the current moodle session, if one exists. my ($self) = @_; - my $r = $self->{r}; - my $db = $r->db; + my $c = $self->{c}; + my $db = $c->db; - my $cookie = $r->req->cookie('MoodleSession'); + my $cookie = $c->req->cookie('MoodleSession'); return unless $cookie; my $config_table = $self->prefix_table("config"); @@ -244,8 +244,8 @@ sub update_moodle_session { sub prefix_table { my ($self, $base) = @_; - if (defined $self->{r}->ce->{authen}{moodle_options}{table_prefix}) { - return $self->{r}->ce->{authen}{moodle_options}{table_prefix} . $base; + if (defined $self->{c}->ce->{authen}{moodle_options}{table_prefix}) { + return $self->{c}->ce->{authen}{moodle_options}{table_prefix} . $base; } else { return $base; } diff --git a/lib/WeBWorK/Authen/Proctor.pm b/lib/WeBWorK/Authen/Proctor.pm index b61cab63e2..d38cfeb4d7 100644 --- a/lib/WeBWorK/Authen/Proctor.pm +++ b/lib/WeBWorK/Authen/Proctor.pm @@ -31,14 +31,14 @@ use constant GENERIC_ERROR_MESSAGE => 'Invalid user ID or password.'; sub verify { my $self = shift; - my $r = $self->{r}; + my $c = $self->{c}; # At this point the usual authentication has already occurred and the user has been verified. If the # use_grade_auth_proctor option is set to 'No', then proctor authorization is not not needed. So return # 1 here to skip proctor authorization and proceed on to the GatewayQuiz module which will grade the test. - if ($r->param('submitAnswers')) { - my ($setName, $versionNum) = grok_vsetID($r->urlpath->arg('setID')); - my $userSet = $r->db->getMergedSetVersion($r->param('effectiveUser'), $setName, $versionNum); + if ($c->param('submitAnswers')) { + my ($setName, $versionNum) = grok_vsetID($c->stash('setID')); + my $userSet = $c->db->getMergedSetVersion($c->param('effectiveUser'), $setName, $versionNum); return 1 if $userSet && $userSet->use_grade_auth_proctor eq 'No'; } @@ -51,24 +51,23 @@ sub verify { # 3. user_id/session_key/password come from params proctor_user/proctor_key/proctor_passwd sub get_credentials { my ($self) = @_; - my $r = $self->{r}; - my $ce = $r->ce; - my $db = $r->db; + my $c = $self->{c}; + my $ce = $c->ce; + my $db = $c->db; - my $urlpath = $r->urlpath; - my ($set_id, $version_id) = grok_vsetID($urlpath->arg('setID')); + my ($set_id, $version_id) = grok_vsetID($c->stash('setID')); # at least the user ID is available in request parameters - if (defined $r->param('proctor_user')) { - my $student_user_id = $r->param('effectiveUser'); - $self->{user_id} = $r->param('proctor_user'); + if (defined $c->param('proctor_user')) { + my $student_user_id = $c->param('effectiveUser'); + $self->{user_id} = $c->param('proctor_user'); if ($self->{user_id} eq $set_id) { $self->{user_id} = "set_id:$set_id"; } - $self->{session_key} = $r->param('proctor_key'); - $self->{password} = $r->param('proctor_passwd'); + $self->{session_key} = $c->param('proctor_key'); + $self->{password} = $c->param('proctor_passwd'); $self->{login_type} = - $r->param('submitAnswers') ? "proctor_grading:$student_user_id" : "proctor_login:$student_user_id"; + $c->param('submitAnswers') ? "proctor_grading:$student_user_id" : "proctor_login:$student_user_id"; $self->{credential_source} = 'params'; return 1; } @@ -78,14 +77,14 @@ sub get_credentials { # to proctor quizzes sub check_user { my $self = shift; - my $r = $self->{r}; - my $ce = $r->ce; - my $db = $r->db; - my $authz = $r->authz; + my $c = $self->{c}; + my $ce = $c->ce; + my $db = $c->db; + my $authz = $c->authz; - my $submitAnswers = $r->param('submitAnswers'); + my $submitAnswers = $c->param('submitAnswers'); my $user_id = $self->{user_id}; - my $past_proctor_id = $r->param('past_proctor_user') || $user_id; + my $past_proctor_id = $c->param('past_proctor_user') || $user_id; # for set-level authentication we prepended "set_id:" my $show_user_id = $user_id; @@ -135,8 +134,8 @@ sub check_user { # authorization to grade the quiz. Require a grade proctor permission level # to start a quiz that skips authorization to grade it. This ensures that # a grade proctor level of authorization is always required. - my ($setName, $versionNum) = grok_vsetID($r->urlpath->arg('setID')); - my $userSet = $db->getMergedSet($r->param('effectiveUser'), $setName); + my ($setName, $versionNum) = grok_vsetID($c->stash('setID')); + my $userSet = $db->getMergedSet($c->param('effectiveUser'), $setName); unless ( $authz->hasPermissions($user_id, 'proctor_quiz_grade') || (($userSet->use_grade_auth_proctor eq 'Yes' || $userSet->restricted_login_proctor eq 'Yes') @@ -166,11 +165,11 @@ sub check_user { # proctor_user, proctor_key, and proctor_passwd are used sub set_params { my $self = shift; - my $r = $self->{r}; + my $c = $self->{c}; - $r->param('proctor_user', $self->{user_id}); - $r->param('proctor_key', $self->{session_key}); - $r->param('proctor_passwd', ''); + $c->param('proctor_user', $self->{user_id}); + $c->param('proctor_key', $self->{session_key}); + $c->param('proctor_passwd', ''); } # rewrite the userID to include both the proctor's and the student's user ID @@ -192,9 +191,9 @@ sub check_session { # proctor key ID rewriting helper sub proctor_key_id { my ($self, $userID, $newKey) = @_; - my $r = $self->{r}; + my $c = $self->{c}; - my $proctor_key_id = $r->param('effectiveUser') . ',' . $userID; + my $proctor_key_id = $c->param('effectiveUser') . ',' . $userID; $proctor_key_id .= ',g' if $self->{login_type} =~ /^proctor_grading/; return $proctor_key_id; diff --git a/lib/WeBWorK/Authen/Shibboleth.pm b/lib/WeBWorK/Authen/Shibboleth.pm index 4ab14c89a4..86d9c5b917 100644 --- a/lib/WeBWorK/Authen/Shibboleth.pm +++ b/lib/WeBWorK/Authen/Shibboleth.pm @@ -18,7 +18,7 @@ use base qw/WeBWorK::Authen/; =head1 NAME -WeBWorK::Authen::Shibboleth - Authentication plug in for Shibboleth. +WeBWorK::Authen::Shibboleth - Authentication plug in for Shibboleth. This is basd on Cosign.pm For documentation, please refer to http://webwork.maa.org/wiki/External_(Shibboleth)_Authentication @@ -28,16 +28,16 @@ to use: include in localOverrides.conf or course.conf and add /webwork2/courseName as a Shibboleth Protected Location or enable lazy session. -if $r->ce->{shiboff} is set for a course, authentication reverts +if $c->ce->{shiboff} is set for a course, authentication reverts to standard WeBWorK authentication. add the following to localOverrides.conf to setup the Shibboleth - + $shibboleth{login_script} = "/Shibboleth.sso/Login"; # login handler $shibboleth{logout_script} = "/Shibboleth.sso/Logout?return=".$server_root_url.$webwork_url; # return URL after logout $shibboleth{session_header} = "Shib-Session-ID"; # the header to identify if there is an existing shibboleth session $shibboleth{manage_session_timeout} = 1; # allow shib to manage session time instead of webwork -$shibboleth{hash_user_id_method} = "MD5"; # possible values none, MD5. Use it when you want to hide real user_ids from showing in url. +$shibboleth{hash_user_id_method} = "MD5"; # possible values none, MD5. Use it when you want to hide real user_ids from showing in url. $shibboleth{hash_user_id_salt} = ""; # salt for hash function #define mapping between shib and webwork $shibboleth{mapping}{user_id} = "username"; @@ -56,11 +56,11 @@ use WeBWorK::Debug; sub get_credentials { my ($self) = @_; - my $r = $self->{r}; - my $ce = $r->ce; - my $db = $r->db; + my $c = $self->{c}; + my $ce = $c->ce; + my $db = $c->db; - if ($ce->{shiboff} || $r->param('bypassShib')) { + if ($ce->{shiboff} || $c->param('bypassShib')) { return $self->SUPER::get_credentials(@_); } @@ -71,7 +71,7 @@ sub get_credentials { # failure. $self->{external_auth} = 1; - if ($r->param("user") && !$r->param("force_passwd_authen")) { + if ($c->param("user") && !$c->param("force_passwd_authen")) { return $self->SUPER::get_credentials(@_); } @@ -90,7 +90,7 @@ sub get_credentials { $user_id = $digest->hexdigest; } $self->{'user_id'} = $user_id; - $self->{r}->param("user", $user_id); + $self->{c}->param("user", $user_id); # the session key isn't used (Shibboleth is managing this # for us), and we want to force checking against the @@ -104,16 +104,16 @@ sub get_credentials { } debug("Couldn't shib header or user_id"); - my $go_to = $ce->{shibboleth}{login_script} . "?target=" . $r->uri; + my $go_to = $ce->{shibboleth}{login_script} . "?target=" . $c->url_for->to_abs; $self->{redirect} = $go_to; - $r->redirect_to($go_to); + $c->redirect_to($go_to); return 0; } sub site_checkPassword { my ($self, $userID, $clearTextPassword) = @_; - if ($self->{r}->ce->{shiboff} || $self->{r}->param('bypassShib')) { + if ($self->{c}->ce->{shiboff} || $self->{c}->param('bypassShib')) { return $self->SUPER::checkPassword(@_); } else { # this is easy; if we're here at all, we've authenticated @@ -125,7 +125,7 @@ sub site_checkPassword { # disable cookie functionality sub maybe_send_cookie { my ($self, @args) = @_; - if ($self->{r}->ce->{shiboff}) { + if ($self->{c}->ce->{shiboff}) { return $self->SUPER::maybe_send_cookie(@_); } else { # nothing to do here @@ -134,7 +134,7 @@ sub maybe_send_cookie { sub fetchCookie { my ($self, @args) = @_; - if ($self->{r}->ce->{shiboff}) { + if ($self->{c}->ce->{shiboff}) { return $self->SUPER::fetchCookie(@_); } else { # nothing to do here @@ -143,7 +143,7 @@ sub fetchCookie { sub sendCookie { my ($self, @args) = @_; - if ($self->{r}->ce->{shiboff}) { + if ($self->{c}->ce->{shiboff}) { return $self->SUPER::sendCookie(@_); } else { # nothing to do here @@ -152,7 +152,7 @@ sub sendCookie { sub killCookie { my ($self, @args) = @_; - if ($self->{r}->ce->{shiboff}) { + if ($self->{c}->ce->{shiboff}) { return $self->SUPER::killCookie(@_); } else { # nothing to do here @@ -163,13 +163,13 @@ sub killCookie { # logout script or what have you, but I don't see a way around that. sub forget_verification { my ($self, @args) = @_; - my $r = $self->{r}; + my $c = $self->{c}; - if ($r->ce->{shiboff}) { + if ($c->ce->{shiboff}) { return $self->SUPER::forget_verification(@_); } else { $self->{was_verified} = 0; - $self->{redirect} = $r->ce->{shibboleth}{logout_script}; + $self->{redirect} = $c->ce->{shibboleth}{logout_script}; } } @@ -178,8 +178,8 @@ sub forget_verification { # override function: allow shib to handle the session time out sub check_session { my ($self, $userID, $possibleKey, $updateTimestamp) = @_; - my $ce = $self->{r}->ce; - my $db = $self->{r}->db; + my $ce = $self->{c}->ce; + my $db = $self->{c}->db; if ($ce->{shiboff}) { return $self->SUPER::check_session(@_); diff --git a/lib/WeBWorK/Authz.pm b/lib/WeBWorK/Authz.pm index 23032c9682..3b98891957 100644 --- a/lib/WeBWorK/Authz.pm +++ b/lib/WeBWorK/Authz.pm @@ -21,8 +21,8 @@ WeBWorK::Authz - check user permissions. =head1 SYNOPSIS - # create new authorizer -- $r is a WeBWorK::Request object. - my $authz = new WeBWorK::Authz($r); + # create new authorizer -- $c is a WeBWorK::Controller object. + my $authz = new WeBWorK::Authz($c); # tell authorizer to cache permission level of user spammy. $authz->setCachedUser("spammy"); @@ -72,20 +72,20 @@ use version; =over -=item WeBWorK::Authz->new($r) +=item WeBWorK::Authz->new($c) -Creates a new authorizer instance. $r is a WeBWorK::Request object. It must +Creates a new authorizer instance. $c is a WeBWorK::Controller object. It must already have its C and C fields set. =cut sub new { - my ($invocant, $r) = @_; + my ($invocant, $c) = @_; my $class = ref($invocant) || $invocant; - my $self = { r => $r, }; - weaken $self->{r}; + my $self = { c => $c, }; + #weaken $self->{c}; - $r->{permission_retrieval_error} = 0; + $c->{permission_retrieval_error} = 0; bless $self, $class; return $self; } @@ -111,15 +111,15 @@ WeBWorK to cache the "real" user. sub setCachedUser { my ($self, $userID) = @_; - my $r = $self->{r}; - my $db = $r->db; + my $c = $self->{c}; + my $db = $c->db; delete $self->{userID}; delete $self->{PermissionLevel}; if (defined $userID) { $self->{userID} = $userID; - if (!$db->existsUser($userID) && defined($r->param("lis_person_sourcedid"))) { + if (!$db->existsUser($userID) && defined($c->param("lis_person_sourcedid"))) { # This is a new user referred via an LTI link. # Do not attempt to cache the permission here. # Rather, the LTIBasic authentication module should cache the permission. @@ -144,17 +144,17 @@ sub setCachedUser { { # cache the permission level record in this request to avoid later database calls $self->{PermissionLevel} = $PermissionLevel; - } elsif (defined($r->param("lis_person_sourcedid")) - or defined($r->param("lis_person_sourced_id")) - or defined($r->param("lis_person_source_id")) - or defined($r->param("lis_person_sourceid")) - or defined($r->param("lis_person_contact_email_primary"))) + } elsif (defined($c->param("lis_person_sourcedid")) + or defined($c->param("lis_person_sourced_id")) + or defined($c->param("lis_person_source_id")) + or defined($c->param("lis_person_sourceid")) + or defined($c->param("lis_person_contact_email_primary"))) { # This is a new user referred via an LTI link. # Do not attempt to cache the permission here. # Rather, the LTIBasic authentication module should cache the permission. return 1; - } elsif (defined($r->param("oauth_nonce"))) { + } elsif (defined($c->param("oauth_nonce"))) { # This is a LTI attempt that doesn't have an lis_person_sourcedid username. croak( "Your request did not specify your username. Perhaps you were attempting to authenticate via LTI but the LTI tool did not transmit " @@ -162,8 +162,8 @@ sub setCachedUser { ); } else { - if ($r->{permission_retrieval_error} == 0) { - $r->{permission_retrieval_error} = 1; + if ($c->{permission_retrieval_error} == 0) { + $c->{permission_retrieval_error} = 1; croak "Unable to retrieve your permissions, perhaps due to a collision " . "between your request and that of another user " . "(or possibly an unfinished request of yours). " @@ -203,9 +203,9 @@ sub hasPermissions { my ($self, $userID, $activity, $exactness) = @_; if (!defined($exactness)) { $exactness = 'ge'; } - my $r = $self->{r}; - my $ce = $r->ce; - my $db = $r->db; + my $c = $self->{c}; + my $ce = $c->ce; + my $db = $c->db; # this may need to be changed if we get other permission level data sources return 0 unless defined $db; @@ -236,12 +236,12 @@ sub hasPermissions { if (defined $PermissionLevel) { $permission_level = $PermissionLevel->permission; - } elsif (defined($r->param("lis_person_sourcedid"))) { + } elsif (defined($c->param("lis_person_sourcedid"))) { # This is an LTI login. Let's see if the LITBasic authentication module will handle this. #return 1; } else { # uh, oh. this user has no permission level record! - if ($r->{permission_retrieval_error} != 1) { + if ($c->{permission_retrieval_error} != 1) { warn "User '$userID' has no PermissionLevel record -- assuming no permission."; } return 0; @@ -289,9 +289,9 @@ sub hasPermissions { ######################### IU Addition ############### sub hasExactPermissions { my ($self, $userID, $activity) = @_; - my $r = $self->{r}; - my $ce = $r->ce; - my $db = $r->db; + my $c = $self->{c}; + my $ce = $c->ce; + my $db = $c->db; # my $Permission = $db->getPermissionLevel($user); # checked # return 0 unless defined $Permission; @@ -322,7 +322,7 @@ sub hasExactPermissions { $permission_level = $PermissionLevel->permission; } else { # uh, oh. this user has no permission level record! - if ($r->{permission_retrieval_error} != 1) { + if ($c->{permission_retrieval_error} != 1) { warn "User '$userID' has no PermissionLevel record -- assuming no permission."; } return 0; @@ -351,21 +351,20 @@ sub hasExactPermissions { #### set-level authorization routines sub checkSet { - my $self = shift; - my $r = $self->{r}; - my $ce = $r->ce; - my $db = $r->db; - my $urlPath = $r->urlpath; + my $self = shift; + my $c = $self->{c}; + my $ce = $c->ce; + my $db = $c->db; - my $node_name = $urlPath->type; + my $node_name = $c->current_route; # First check to see if we have to worried about set-level access restrictions. return 0 unless (grep {/^$node_name$/} (qw(problem_list problem_detail gateway_quiz proctored_gateway_quiz))); # To check set restrictions we need a set and a user. - my $setName = $urlPath->arg("setID"); - my $userName = $r->param("user"); - my $effectiveUserName = $r->param("effectiveUser"); + my $setName = $c->stash('setID'); + my $userName = $c->param("user"); + my $effectiveUserName = $c->param("effectiveUser"); # If there is no input userName, then the content generator will be forcing a login, so just bail. return 0 if (!$userName || !$effectiveUserName); @@ -386,17 +385,17 @@ sub checkSet { if ($db->existsSetVersion($effectiveUserName, $setName, $verNum)) { $set = $db->getMergedSetVersion($effectiveUserName, $setName, $verNum); } else { - return $r->maketext("Requested version ([_1]) of set '[_2]' is not assigned to user [_3].", + return $c->maketext("Requested version ([_1]) of set '[_2]' is not assigned to user [_3].", $verNum, $setName, $effectiveUserName); } } if (!$set) { - return $r->maketext("Requested set '[_1]' could not be found in the database for user [_2].", + return $c->maketext("Requested set '[_1]' could not be found in the database for user [_2].", $setName, $effectiveUserName); } # Don't allow versioned sets to be viewed from the problem-list page. if ($node_name eq 'problem_list') { - return $r->maketext("Requested version ([_1]) of set '[_2]' can not be directly accessed.", $verNum, + return $c->maketext("Requested version ([_1]) of set '[_2]' can not be directly accessed.", $verNum, $setName); } } else { @@ -410,11 +409,11 @@ sub checkSet { # happens for instructor tool users. return 0; } else { - return $r->maketext("Requested set '[_1]' is not assigned to user [_2].", $setName, $effectiveUserName); + return $c->maketext("Requested set '[_1]' is not assigned to user [_2].", $setName, $effectiveUserName); } } if (!$set) { - return $r->maketext("Requested set '[_1]' could not be found in the database for user [_2].", + return $c->maketext("Requested set '[_1]' could not be found in the database for user [_2].", $setName, $effectiveUserName); } } @@ -434,13 +433,13 @@ sub checkSet { ) ) { - return $r->maketext("Requested set '[_1]' is not yet open.", $setName); + return $c->maketext("Requested set '[_1]' is not yet open.", $setName); } # Check to make sure that the set is visible, and that the user is allowed to view hidden sets. my $visible = $set && $set->visible ne '0' && $set->visible ne '1' ? 1 : $set->visible; if (!$visible && !$self->hasPermissions($userName, "view_hidden_sets")) { - return $r->maketext("Requested set '[_1]' is not available yet.", $setName); + return $c->maketext("Requested set '[_1]' is not available yet.", $setName); } # Check to see if conditional release conditions have been met. @@ -448,18 +447,18 @@ sub checkSet { && is_restricted($db, $set, $effectiveUserName) && !$self->hasPermissions($userName, "view_unopened_sets")) { - return $r->maketext("The prerequisite conditions have not been met for set '[_1]'.", $setName); + return $c->maketext("The prerequisite conditions have not been met for set '[_1]'.", $setName); } # Check to be sure that gateways are being sent to the correct content generator. if (defined($set->assignment_type) && $set->assignment_type =~ /gateway/ && $node_name eq 'problem_detail') { - return $r->maketext( + return $c->maketext( "Requested set '[_1]' is a test/quiz assignment but the regular homework assignment content " . 'generator [_2] was called. Try re-entering the set from the problem sets listing page.', $setName, $node_name ); } elsif ((!defined($set->assignment_type) || $set->assignment_type eq 'default') && $node_name =~ /gateway/) { - return $r->maketext( + return $c->maketext( "Requested set '[_1]' is a homework assignment but the gateway/quiz content generator [_2] was called. " . 'Try re-entering the set from the problem sets listing page.', $setName, $node_name @@ -472,10 +471,10 @@ sub checkSet { if (defined($set->assignment_type) && $set->assignment_type =~ /proctored/ && $node_name ne 'problem_list' - && !WeBWorK::Authen::Proctor->new($r, $ce, $db)->verify()) + && !WeBWorK::Authen::Proctor->new($c, $ce, $db)->verify()) { - return $r->maketext( - "Requested set '[_1]' is a proctored test, but no valid proctor authorization has been obtained.", + return $c->maketext( + 'Requested set "[_1]" is a proctored test, but no valid proctor authorization has been obtained.', $setName); } @@ -488,8 +487,8 @@ sub checkSet { my $LTIGradeMode = $ce->{LTIGradeMode} // ''; if ($LTIGradeMode eq 'homework' && !$self->hasPermissions($userName, "view_unopened_sets")) { - my $LMS = $ce->{LMS_url} ? $r->link_to($ce->{LMS_name} => $ce->{LMS_url}) : $ce->{LMS_name}; - return $r->maketext( + my $LMS = $ce->{LMS_url} ? $c->link_to($ce->{LMS_name} => $ce->{LMS_url}) : $ce->{LMS_name}; + return $c->maketext( 'You must use your Learning Management System ([_1]) to access this set. ' . 'Try logging in to the Learning Management System and visiting the set from there.', $LMS @@ -507,14 +506,12 @@ sub invalidIPAddress { my $self = shift; my $set = shift; - my $r = $self->{r}; - my $db = $r->db; - my $ce = $r->ce; - my $urlPath = $r->urlpath; - # my $setName = $urlPath->arg("setID"); # not always defined + my $c = $self->{c}; + my $db = $c->db; + my $ce = $c->ce; my $setName = $set->set_id; - my $userName = $r->param("user"); - my $effectiveUserName = $r->param("effectiveUser"); + my $userName = $c->param("user"); + my $effectiveUserName = $c->param("effectiveUser"); return 0 if (!defined($set->restrict_ip) @@ -522,7 +519,7 @@ sub invalidIPAddress { || $set->restrict_ip eq 'No' || $self->hasPermissions($userName, 'view_ip_restricted_sets')); - my $clientIP = new Net::IP($r->useragent_ip); + my $clientIP = new Net::IP($c->tx->remote_address); # make sure that we're using the non-versioned set name $setName =~ s/,v\d+$//; @@ -534,7 +531,7 @@ sub invalidIPAddress { # if there are no addresses in the locations, return an error that # says this - return $r->maketext( + return $c->maketext( "Client ip address [_1] is not allowed to work this assignment, because the assignment has ip address restrictions and there are no allowed locations associated with the restriction. Contact your professor to have this problem resolved.", $clientIP->ip() ) if (!@restrictAddresses); diff --git a/lib/WeBWorK/ConfigObject.pm b/lib/WeBWorK/ConfigObject.pm index b0de6118cf..2f13f7e611 100644 --- a/lib/WeBWorK/ConfigObject.pm +++ b/lib/WeBWorK/ConfigObject.pm @@ -1,36 +1,27 @@ package WeBWorK::ConfigObject; +use Mojo::Base -signatures; # Base object class for all config objects -use strict; -use warnings; - -use URI::Escape; - -sub new { - my ($class, $self, $module) = @_; - # The module should be a content generator module. - $self->{Module} = $module; - $self->{name} = ($self->{var} =~ s/[{]/_/gr) =~ s/[}]//gr; +sub new ($class, $self, $c) { + # The current content generator controller object. + $self->{c} = $c; + $self->{name} = ($self->{var} =~ s/[{]/_/gr) =~ s/[}]//gr; return bless $self, $class; } # Only input is a value to display, and should produce an html string. -sub display_value { - my ($self, $val) = @_; +sub display_value ($self, $val) { return $val; } # This should return the value to compare to the new value. This is *not* what is displayed. -sub comparison_value { - my ($self, $val) = @_; +sub comparison_value ($self, $val) { return $val; } # Get the value of the corresponding variable in the provided course environment. -sub get_value { - my ($self, $ce) = @_; - +sub get_value ($self, $ce) { my @keys = $self->{var} =~ m/([^{}]+)/g; return '' unless @keys; @@ -43,20 +34,17 @@ sub get_value { # If use_current is true then return the current course environment value for this setting. # Otherwise use the value of the html form element. -sub convert_newval_source { - my ($self, $use_current) = @_; +sub convert_newval_source ($self, $use_current) { if ($use_current) { - return $self->comparison_value($self->get_value($self->{Module}->r->ce)); + return $self->comparison_value($self->get_value($self->{c}->ce)); } else { - return $self->{Module}->r->param($self->{name}) // ''; + return $self->{c}->param($self->{name}) // ''; } } # Bit of text to put in the configuration file. The result should be an assignment which is executable by perl. oldval # will be the value of the perl variable, and newval will be whatever an entry widget produces. -sub save_string { - my ($self, $oldval, $use_current) = @_; - +sub save_string ($self, $oldval, $use_current = 0) { my $newval = $self->convert_newval_source($use_current); return '' if $self->comparison_value($oldval) eq $newval; @@ -65,9 +53,8 @@ sub save_string { } # A widget to interact with the user -sub entry_widget { - my ($self, $default) = @_; - return $self->{Module}->r->text_field( +sub entry_widget ($self, $default) { + return $self->{c}->text_field( $self->{name} => $default, id => $self->{name}, size => $self->{width} || 15, @@ -76,33 +63,29 @@ sub entry_widget { } # This produces the documentation string and image link to more documentation. It is the same for all config types. -sub what_string { - my ($self) = @_; - my $r = $self->{Module}->r; +sub what_string ($self) { + my $c = $self->{c}; - return $r->tag( + return $c->tag( 'div', class => 'd-flex justify-content-between align-items-center', - $r->c( - $r->tag( + $c->c( + $c->tag( 'div', ref $self eq 'WeBWorK::ConfigObject::checkboxlist' - ? $r->b($r->maketext($self->{doc})) - : $r->label_for($self->{name} => $r->b($r->maketext($self->{doc}))) + ? $c->b($c->maketext($self->{doc})) + : $c->label_for($self->{name} => $c->b($c->maketext($self->{doc}))) ), - $r->link_to( - $r->tag( + $c->link_to( + $c->tag( 'i', class => 'icon fas fa-question-circle', 'aria-hidden' => 'true', data => { alt => 'help' }, '' - ) => $self->{Module}->systemLink( - $r->urlpath->new( - type => 'instructor_config', - args => { courseID => $r->urlpath->arg('courseID') } - ), - params => { show_long_doc => 1, var_name => uri_escape($self->{var}) } + ) => $c->systemLink( + $c->url_for('instructor_config'), + params => { show_long_doc => 1, var_name => $self->{var} } ), target => '_blank' ) diff --git a/lib/WeBWorK/ConfigObject/boolean.pm b/lib/WeBWorK/ConfigObject/boolean.pm index bb3ee67755..2f8ad7766a 100644 --- a/lib/WeBWorK/ConfigObject/boolean.pm +++ b/lib/WeBWorK/ConfigObject/boolean.pm @@ -14,34 +14,26 @@ ################################################################################ package WeBWorK::ConfigObject::boolean; -use parent qw(WeBWorK::ConfigObject); +use Mojo::Base 'WeBWorK::ConfigObject', -signatures; -use strict; -use warnings; +sub comparison_value ($self, $value) { return $value ? 1 : 0; } -sub comparison_value { my ($self, $value) = @_; return $value ? 1 : 0; } - -sub display_value { - my ($self, $val) = @_; - my $r = $self->{Module}->r; - return $r->maketext('True') if $val; - return $r->maketext('False'); +sub display_value ($self, $val) { + return $self->{c}->maketext('True') if $val; + return $self->{c}->maketext('False'); } -sub save_string { - my ($self, $oldval, $use_current) = @_; +sub save_string ($self, $oldval, $use_current = 0) { my $newval = $self->convert_newval_source($use_current); return '' if $self->comparison_value($oldval) eq $newval; return "\$$self->{var} = $newval;\n"; } -sub entry_widget { - my ($self, $default) = @_; - my $r = $self->{Module}->r; - return $r->select_field( +sub entry_widget ($self, $default) { + return $self->{c}->select_field( $self->{name} => [ - [ $r->maketext('True') => 1, $default == 1 ? (selected => undef) : () ], - [ $r->maketext('False') => 0, $default == 0 ? (selected => undef) : () ] + [ $self->{c}->maketext('True') => 1, $default == 1 ? (selected => undef) : () ], + [ $self->{c}->maketext('False') => 0, $default == 0 ? (selected => undef) : () ] ], id => $self->{name}, class => 'form-select form-select-sm' diff --git a/lib/WeBWorK/ConfigObject/checkboxlist.pm b/lib/WeBWorK/ConfigObject/checkboxlist.pm index edd660b5ed..359a8536a1 100644 --- a/lib/WeBWorK/ConfigObject/checkboxlist.pm +++ b/lib/WeBWorK/ConfigObject/checkboxlist.pm @@ -14,32 +14,25 @@ ################################################################################ package WeBWorK::ConfigObject::checkboxlist; -use parent qw(WeBWorK::ConfigObject); +use Mojo::Base 'WeBWorK::ConfigObject', -signatures; -use strict; -use warnings; - -sub display_value { - my ($self, $val) = @_; - my $r = $self->{Module}->r; - return $r->c(@{ $val // [] })->join($r->tag('br')); +sub display_value ($self, $val) { + return $self->{c}->c(@{ $val // [] })->join($self->{c}->tag('br')); } # r->param() returns an array, so a custom version of convert_newval_source is needed. -sub convert_newval_source { - my ($self, $use_current) = @_; +sub convert_newval_source ($self, $use_current) { if ($use_current) { - return @{ $self->get_value($self->{Module}->r->ce) }; + return @{ $self->get_value($self->{c}->ce) }; } else { - return $self->{Module}->r->param($self->{name}); + return $self->{c}->param($self->{name}); } } -sub save_string { - my ($self, $oldval, $use_current) = @_; +sub save_string ($self, $oldval, $use_current = 0) { my @newvals = $self->convert_newval_source($use_current); if ($self->{min} && scalar(@newvals) < $self->{min}) { - $self->{Module}->addbadmessage("You need to select at least $self->{min} display mode."); + $self->{c}->addbadmessage("You need to select at least $self->{min} display mode."); return '' if $use_current; return $self->save_string($oldval, 1); } @@ -47,24 +40,22 @@ sub save_string { return "\$$self->{var} = [" . join(',', map {"'$_'"} @newvals) . "];\n"; } -sub comparison_value { - my ($self, $val) = @_; +sub comparison_value ($self, $val) { return join(',', @{ $val // [] }); } -sub entry_widget { - my ($self, $default) = @_; - my $r = $self->{Module}->r; - return $r->c( +sub entry_widget ($self, $default) { + my $c = $self->{c}; + return $c->c( map { - $r->tag( + $c->tag( 'div', class => 'form-check', - $r->tag( + $c->tag( 'label', class => 'form-check-label', - $r->c( - $r->check_box( + $c->c( + $c->check_box( $self->{name} => $_, { map { $_ => 1 } @$default }->{$_} ? (checked => undef) : (), class => 'form-check-input', diff --git a/lib/WeBWorK/ConfigObject/list.pm b/lib/WeBWorK/ConfigObject/list.pm index bcea486d02..261fb7ab03 100644 --- a/lib/WeBWorK/ConfigObject/list.pm +++ b/lib/WeBWorK/ConfigObject/list.pm @@ -14,26 +14,20 @@ ################################################################################ package WeBWorK::ConfigObject::list; -use parent qw(WeBWorK::ConfigObject); +use Mojo::Base 'WeBWorK::ConfigObject', -signatures; -use strict; -use warnings; - -sub display_value { - my ($self, $val) = @_; - my $r = $self->{Module}->r; - return $r->b(' ') if ref $val ne 'ARRAY'; - my $str = $r->c(@$val)->join(',' . $r->tag('br')); - return $str =~ /\S/ ? $str : $r->b(' '); +sub display_value ($self, $val) { + my $c = $self->{c}; + return $c->b(' ') if ref $val ne 'ARRAY'; + my $str = $c->c(@$val)->join(',' . $c->tag('br')); + return $str =~ /\S/ ? $str : $c->b(' '); } -sub comparison_value { - my ($self, $val) = @_; +sub comparison_value ($self, $val) { return join(',', @{ $val // [] }); } -sub save_string { - my ($self, $oldval, $use_current) = @_; +sub save_string ($self, $oldval, $use_current = 0) { my $newval = $self->convert_newval_source($use_current); $oldval = $self->comparison_value($oldval); @@ -49,10 +43,9 @@ sub save_string { return "\$$self->{var} = [" . join(',', map {"'$_'"} map { $_ =~ s/['"`]//gr } split(',', $newval)) . "];\n"; } -sub entry_widget { - my ($self, $default) = @_; +sub entry_widget ($self, $default) { my $str = join(', ', @{ $default // [] }); - return $self->{Module}->r->text_area( + return $self->{c}->text_area( $self->{name} => $str =~ /\S/ ? $str : '', id => $self->{name}, rows => 4, diff --git a/lib/WeBWorK/ConfigObject/number.pm b/lib/WeBWorK/ConfigObject/number.pm index 7070335586..1d45e8dce1 100644 --- a/lib/WeBWorK/ConfigObject/number.pm +++ b/lib/WeBWorK/ConfigObject/number.pm @@ -14,17 +14,12 @@ ################################################################################ package WeBWorK::ConfigObject::number; -use parent qw(WeBWorK::ConfigObject); - -use strict; -use warnings; - -sub save_string { - my ($self, $oldval, $use_current) = @_; +use Mojo::Base 'WeBWorK::ConfigObject', -signatures; +sub save_string ($self, $oldval, $use_current = 0) { my $newval = $self->convert_newval_source($use_current) =~ s/['"`]//gr; if ($newval !~ m/^[+-]?\d*(\.\d*)?$/) { - $self->{Module}->addbadmessage(qq{Invalid numeric value "$newval" for variable \$$self->{var}. } + $self->{c}->addbadmessage(qq{Invalid numeric value "$newval" for variable \$$self->{var}. } . 'Reverting to the system default value.'); return ''; } diff --git a/lib/WeBWorK/ConfigObject/permission.pm b/lib/WeBWorK/ConfigObject/permission.pm index 2cf0f2cb6e..1bf28ed72d 100644 --- a/lib/WeBWorK/ConfigObject/permission.pm +++ b/lib/WeBWorK/ConfigObject/permission.pm @@ -14,43 +14,36 @@ ################################################################################ package WeBWorK::ConfigObject::permission; -use parent qw(WeBWorK::ConfigObject); +use Mojo::Base 'WeBWorK::ConfigObject', -signatures; -use strict; -use warnings; - -sub comparison_value { - my ($self, $val) = @_; +sub comparison_value ($self, $val) { return $val // 'nobody'; } # This tries to produce a string from a permission number. If you feed it a string, that's what you get back. -sub display_value { - my ($self, $val) = @_; - my $r = $self->{Module}->r; - return $r->maketext('nobody') if !defined $val; - my %reverseUserRoles = reverse %{ $r->ce->{userRoles} }; - return defined $reverseUserRoles{$val} ? $r->maketext($reverseUserRoles{$val}) : $r->maketext($val); +sub display_value ($self, $val) { + my $c = $self->{c}; + return $c->maketext('nobody') if !defined $val; + my %reverseUserRoles = reverse %{ $c->ce->{userRoles} }; + return defined $reverseUserRoles{$val} ? $c->maketext($reverseUserRoles{$val}) : $c->maketext($val); } -sub save_string { - my ($self, $oldval, $use_current) = @_; +sub save_string ($self, $oldval, $use_current = 0) { my $newval = $self->convert_newval_source($use_current); return '' if $self->comparison_value($oldval) eq $newval; return "\$$self->{var} = '$newval';\n"; } -sub entry_widget { - my ($self, $default) = @_; - my $r = $self->{Module}->r; +sub entry_widget ($self, $default) { + my $c = $self->{c}; # The value of a permission can be undefined (for nobody), a standard permission number, or some other number - my %userRoles = %{ $r->ce->{userRoles} }; + my %userRoles = %{ $c->ce->{userRoles} }; my @values = sort { $userRoles{$a} <=> $userRoles{$b} } keys %userRoles; - return $r->select_field( + return $c->select_field( $self->{name} => - [ map { [ $r->maketext($_) => $_, ($default // 'nobody') eq $_ ? (selected => undef) : () ] } @values ], + [ map { [ $c->maketext($_) => $_, ($default // 'nobody') eq $_ ? (selected => undef) : () ] } @values ], id => $self->{name}, class => 'form-select form-select-sm', ); diff --git a/lib/WeBWorK/ConfigObject/popuplist.pm b/lib/WeBWorK/ConfigObject/popuplist.pm index 29324e1abe..50f6a29397 100644 --- a/lib/WeBWorK/ConfigObject/popuplist.pm +++ b/lib/WeBWorK/ConfigObject/popuplist.pm @@ -14,32 +14,26 @@ ################################################################################ package WeBWorK::ConfigObject::popuplist; -use parent qw(WeBWorK::ConfigObject); +use Mojo::Base 'WeBWorK::ConfigObject', -signatures; -use strict; -use warnings; - -sub display_value { - my ($self, $val) = @_; - my $r = $self->{Module}->r; +sub display_value ($self, $val) { + my $c = $self->{c}; $val //= 'ur'; - return $r->c($r->maketext($self->{labels}{$val}))->join($r->tag('br')) if ($self->{labels}{$val}); - return $r->c($val)->join($r->tag('br')); + return $c->c($c->maketext($self->{labels}{$val}))->join($c->tag('br')) if ($self->{labels}{$val}); + return $c->c($val)->join($c->tag('br')); } -sub save_string { - my ($self, $oldval, $use_current) = @_; +sub save_string ($self, $oldval, $use_current = 0) { my $newval = $self->convert_newval_source($use_current); return '' if $self->comparison_value($oldval) eq $newval; return ("\$$self->{var} = '$newval';\n"); } -sub entry_widget { - my ($self, $default) = @_; - my $r = $self->{Module}->r; - return $r->select_field( +sub entry_widget ($self, $default) { + my $c = $self->{c}; + return $c->select_field( $self->{name} => [ - map { [ $r->maketext($self->{labels}{$_} // $_) => $_, $default eq $_ ? (selected => undef) : () ] } + map { [ $c->maketext($self->{labels}{$_} // $_) => $_, $default eq $_ ? (selected => undef) : () ] } @{ $self->{values} } ], id => $self->{name}, diff --git a/lib/WeBWorK/ConfigObject/text.pm b/lib/WeBWorK/ConfigObject/text.pm index 23714a2037..1780eb8b84 100644 --- a/lib/WeBWorK/ConfigObject/text.pm +++ b/lib/WeBWorK/ConfigObject/text.pm @@ -14,10 +14,7 @@ ################################################################################ package WeBWorK::ConfigObject::text; -use parent qw(WeBWorK::ConfigObject); - -use strict; -use warnings; +use Mojo::Base 'WeBWorK::ConfigObject', -signatures; # The base ConfigObject handles everything for this package. This is just a namespace. diff --git a/lib/WeBWorK/ConfigObject/time.pm b/lib/WeBWorK/ConfigObject/time.pm index c53ae865d2..74429bc222 100644 --- a/lib/WeBWorK/ConfigObject/time.pm +++ b/lib/WeBWorK/ConfigObject/time.pm @@ -14,22 +14,16 @@ ################################################################################ package WeBWorK::ConfigObject::time; -use parent qw(WeBWorK::ConfigObject); +use Mojo::Base 'WeBWorK::ConfigObject', -signatures; # Just like WeBWorK::ConfigObject::text, but it validates the time before saving. -use strict; -use warnings; - -sub save_string { - my ($self, $oldval, $use_current) = @_; - +sub save_string ($self, $oldval, $use_current = 0) { my $newval = $self->convert_newval_source($use_current); return '' if $self->comparison_value($oldval) eq $newval; if ($newval !~ /^(01|1|02|2|03|3|04|4|05|5|06|6|07|7|08|8|09|9|10|11|12):[0-5]\d(am|pm|AM|PM)$/) { - $self->{Module} - ->addbadmessage(qq{String "$newval" is not a valid time. Reverting to the system default value.}); + $self->{c}->addbadmessage(qq{String "$newval" is not a valid time. Reverting to the system default value.}); return ''; } diff --git a/lib/WeBWorK/ConfigObject/timezone.pm b/lib/WeBWorK/ConfigObject/timezone.pm index 9d369acbbf..590bd0a09e 100644 --- a/lib/WeBWorK/ConfigObject/timezone.pm +++ b/lib/WeBWorK/ConfigObject/timezone.pm @@ -14,24 +14,18 @@ ################################################################################ package WeBWorK::ConfigObject::timezone; -use parent qw(WeBWorK::ConfigObject); +use Mojo::Base 'WeBWorK::ConfigObject', -signatures; # Just like WeBWorK::ConfigObject::text, but it validates the timezone before saving. -use strict; -use warnings; - use DateTime::TimeZone; -sub save_string { - my ($self, $oldval, $use_current) = @_; - +sub save_string ($self, $oldval, $use_current = 0) { my $newval = $self->convert_newval_source($use_current); return '' if $self->comparison_value($oldval) eq $newval; if (not DateTime::TimeZone->is_valid_name($newval)) { - $self->{Module} - ->addbadmessage("String '$newval' is not a valid time zone. Reverting to the system default value."); + $self->{c}->addbadmessage("String '$newval' is not a valid time zone. Reverting to the system default value."); return ''; } diff --git a/lib/WeBWorK/ContentGenerator.pm b/lib/WeBWorK/ContentGenerator.pm index 5b9f032482..f2d4c30333 100644 --- a/lib/WeBWorK/ContentGenerator.pm +++ b/lib/WeBWorK/ContentGenerator.pm @@ -14,6 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator; +use Mojo::Base 'WeBWorK::Controller', -signatures, -async_await; =head1 NAME @@ -21,11 +22,11 @@ WeBWorK::ContentGenerator - base class for modules that generate page content. =head1 SYNOPSIS - # start with a WeBWorK::Request object: $r + # start with a WeBWorK::Controller object: $c use WeBWorK::ContentGenerator::SomeSubclass; - my $cg = WeBWorK::ContentGenerator::SomeSubclass->new($r); + my $cg = WeBWorK::ContentGenerator::SomeSubclass->new($c); my $result = $cg->go(); =head1 DESCRIPTION @@ -40,18 +41,13 @@ miscellaneous utilities are provided. =cut -use strict; -use warnings; - use Carp; use Date::Format; -use URI::Escape; use MIME::Base64; use Scalar::Util qw(weaken); use HTML::Entities; use Encode; use Email::Sender::Transport::SMTP; -use Future::AsyncAwait; use WeBWorK::File::Scoring qw(parse_scoring_file); use WeBWorK::PG; @@ -59,39 +55,7 @@ use WeBWorK::Localize; use WeBWorK::Utils qw(jitar_id_to_seq fetchEmailRecipients generateURLs getAssetURL format_set_name_display); use WeBWorK::Authen::LTIAdvanced::SubmitGrade; use WeBWorK::Utils::LanguageAndDirection qw(get_lang_and_dir); - -############################################################################### - -=head1 CONSTRUCTOR - -=over - -=item new($r) - -Creates a new instance of a content generator. Supply a WeBWorK::Request object -$r. - -=cut - -sub new { - my ($invocant, $r) = @_; - my $class = ref($invocant) || $invocant; - my $self = { - r => $r, # this is now a WeBWorK::Request - ce => $r->ce(), # these three are here for - db => $r->db(), # backward-compatability - authz => $r->authz(), # with unconverted CGs - }; - weaken $self->{r}; - bless $self, $class; - return $self; -} - -=back - -=cut - -################################################################################ +use WeBWorK::Utils::Routes qw(route_title route_navigation_is_restricted); =head1 INVOCATION @@ -141,68 +105,68 @@ The method content() is called to send the page content to client. =cut -async sub go { - my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; +async sub go ($c) { + my $ce = $c->ce; # If grades are begin passed back to the LTI then we peroidically update all of the grades because things can get # out of sync if instructors add or modify sets. - if ($ce->{LTIGradeMode} && ref $r->db) { - my $grader = WeBWorK::Authen::LTIAdvanced::SubmitGrade->new($r); + if ($ce->{LTIGradeMode} && ref $c->db) { + my $grader = WeBWorK::Authen::LTIAdvanced::SubmitGrade->new($c); $grader->mass_update('auto'); } # Check to determine if this is a problem set response. Individual content generators must check - # $self->{invalidSet} and react appropriately. - $self->{invalidSet} = $r->authz->checkSet(); + # $c->{invalidSet} and react appropriately. + $c->{invalidSet} = $c->authz->checkSet; # We only write to the activity log if it has been defined and if we are in a specific course. The latter check is # to prevent attempts to write to a course log file when viewing the top-level list of courses page. - WeBWorK::Utils::writeCourseLog($ce, 'activity_log', $self->prepare_activity_entry) - if ($r->urlpath->arg('courseID') && $r->ce->{courseFiles}{logs}{activity_log}); + WeBWorK::Utils::writeCourseLog($ce, 'activity_log', $c->prepare_activity_entry) + if ($c->stash('courseID') && $c->ce->{courseFiles}{logs}{activity_log}); + + my $tx = $c->render_later->tx; - if ($self->can('pre_header_initialize')) { - my $pre_header_initialize = $self->pre_header_initialize(@_); + if ($c->can('pre_header_initialize')) { + my $pre_header_initialize = $c->pre_header_initialize; await $pre_header_initialize if ref $pre_header_initialize eq 'Future' || ref $pre_header_initialize eq 'Mojo::Promise'; } # Reply with a file. - if (defined $self->{reply_with_file}) { - return $self->do_reply_with_file($self->{reply_with_file}); + if (defined $c->{reply_with_file}) { + return $c->do_reply_with_file($c->{reply_with_file}); } # Reply with a redirect. - if (defined $self->{reply_with_redirect}) { - return $self->do_reply_with_redirect($self->{reply_with_redirect}); + if (defined $c->{reply_with_redirect}) { + return $c->do_reply_with_redirect($c->{reply_with_redirect}); } - if ($self->can('initialize')) { - my $initialize = $self->initialize; + if ($c->can('initialize')) { + my $initialize = $c->initialize; await $initialize if ref $initialize eq 'Future' || ref $initialize eq 'Mojo::Promise'; } - $self->content(); + $c->content; # All content generator modules must have rendered at this point unless there was an error in which case an error # response will be rendered. There is no special handing for HEAD requests. Mojolicious takes care of that in its # render methods. This just returns the status code of the response (typically set by the Mojolicious render # methods. Although this return value isn't actually used at this point. - return $self->header(@_); + return $c->header; } =item r() -Returns a reference to the WeBWorK::Request object associated with this -instance. +Returns a reference to $c (this object) which is a WeBWorK::Controller object. -=cut +FIXME: This method will be removed once all ContentGenerator modules +are converted. -sub r { - my ($self) = @_; +=cut - return $self->{r}; +sub r ($c) { + return $c; } =item do_reply_with_file($fileHash) @@ -211,31 +175,28 @@ Handler for reply_with_file(), used by go(). DO NOT CALL THIS METHOD DIRECTLY. =cut -sub do_reply_with_file { - my ($self, $fileHash) = @_; - my $r = $self->r; - +sub do_reply_with_file ($c, $fileHash) { my $type = $fileHash->{type}; my $source = $fileHash->{source}; my $name = $fileHash->{name}; my $delete_after = $fileHash->{delete_after}; # If there was a problem, render the appropriate error response. - return $r->render(text => 'File not found', status => 404) unless -e $source; - return $r->render(text => 'Insufficient permissions', status => 403) unless -r $source; + return $c->render(text => 'File not found', status => 404) unless -e $source; + return $c->render(text => 'Insufficient permissions', status => 403) unless -r $source; # Send our custom HTTP header. - $r->res->headers->content_type($type); - $r->res->headers->add("Content-Disposition" => qq{attachment; filename="$name"}); + $c->res->headers->content_type($type); + $c->res->headers->add("Content-Disposition" => qq{attachment; filename="$name"}); # send the file - $r->reply->file($source); + $c->reply->file($source); if ($delete_after) { - unlink $source or warn "failed to unlink $source after sending: $!"; + unlink $source or $c->log->warn("failed to unlink $source after sending: $!"); } - return $r->res->code; + return $c->res->code; } =item do_reply_with_redirect($url) @@ -244,19 +205,15 @@ Handler for reply_with_redirect(), used by go(). DO NOT CALL THIS METHOD DIRECTL =cut -sub do_reply_with_redirect { - my ($self, $url) = @_; - my $r = $self->r; - $r->redirect_to($url); - return $r->res->code; +sub do_reply_with_redirect ($c, $url) { + $c->redirect_to($url); + return $c->res->code; } =back =cut -################################################################################ - =head1 DATA MODIFIERS Modifiers allow the caller to register a piece of data for later retrieval in a @@ -275,16 +232,15 @@ Must be called from pre_header_initialize(). =cut -sub reply_with_file { - my ($self, $type, $source, $name, $delete_after) = @_; - $delete_after ||= ""; - - $self->{reply_with_file} = { +sub reply_with_file ($c, $type, $source, $name, $delete_after = 0) { + $c->{reply_with_file} = { type => $type, source => $source, name => $name, delete_after => $delete_after, }; + + return; } =item reply_with_redirect($url) @@ -296,10 +252,9 @@ Must be called from pre_header_initialize(). =cut -sub reply_with_redirect { - my ($self, $url) = @_; - - $self->{reply_with_redirect} = $url; +sub reply_with_redirect ($c, $url) { + $c->{reply_with_redirect} = $url; + return; } =item addmessage($message) @@ -311,13 +266,11 @@ Must be called before the message() template escape is invoked. =cut -sub addmessage { - my ($self, $message) = @_; - +sub addmessage ($c, $message) { return '' unless defined $message; - - $self->{status_message} //= $self->r->c; - push(@{ $self->{status_message} }, $message); + $c->{status_message} //= $c->c; + push(@{ $c->{status_message} }, $message); + return; } =item addgoodmessage($message) @@ -327,9 +280,9 @@ message() template escape handler. =cut -sub addgoodmessage { - my ($self, $message) = @_; - $self->addmessage($self->r->tag('p', class => 'alert alert-success p-1 my-2', $self->r->b($message))); +sub addgoodmessage ($c, $message) { + $c->addmessage($c->tag('p', class => 'alert alert-success p-1 my-2', $c->b($message))); + return; } =item addbadmessage($message) @@ -339,9 +292,9 @@ message() template escape handler. =cut -sub addbadmessage { - my ($self, $message) = @_; - $self->addmessage($self->r->tag('p', class => 'alert alert-danger p-1 my-2', $self->r->b($message))); +sub addbadmessage ($c, $message) { + $c->addmessage($c->tag('p', class => 'alert alert-danger p-1 my-2', $c->b($message))); + return; } =item prepare_activity_entry() @@ -351,15 +304,14 @@ This can be overriden by different modules. =cut -sub prepare_activity_entry { - my $self = shift; - my $r = $self->r; +sub prepare_activity_entry ($c) { + my $location = $c->location; my $string = - $r->urlpath->path + ($c->req->url->path->to_string =~ s/^$location//r) . " ---> " - . join("\t", (map { $_ eq 'key' || $_ eq 'passwd' ? '' : $_ . " => " . $r->param($_) } $r->param())); + . join("\t", (map { $_ eq 'key' || $_ eq 'passwd' ? '' : $_ . " => " . $c->param($_) } $c->param())); $string =~ s/\t+/\t/g; - return ($string); + return $string; } =back @@ -402,7 +354,7 @@ rendering a response (as it really should have been done before. sub header { my $self = shift; - return $self->r->res->code; + return $self->res->code; } =item initialize() @@ -423,9 +375,8 @@ This calls WeBWorK::Utils::LanguageAndDirection::get_lang_and_dir. =cut -sub output_course_lang_and_dir { - my $self = shift; - return get_lang_and_dir($self->r->ce->{language}); +sub output_course_lang_and_dir ($c) { + return get_lang_and_dir($c->ce->{language}); } =item webwork_logo() @@ -434,19 +385,17 @@ Create the link to the webwork installation landing page with a logo and alt tex =cut -sub webwork_logo { - my $self = shift; - my $r = $self->r; - my $ce = $r->ce; - my $theme = $r->param('theme') || $ce->{defaultTheme}; +sub webwork_logo ($c) { + my $ce = $c->ce; + my $theme = $c->param('theme') || $ce->{defaultTheme}; my $htdocs = $ce->{webwork_htdocs_url}; - if ($r->authen->was_verified && !$r->authz->hasPermissions($r->param('user'), 'navigation_allowed')) { + if ($c->authen->was_verified && !$c->authz->hasPermissions($c->param('user'), 'navigation_allowed')) { # If navigation is restricted for this user, then the webwork logo is not a link to the courses page. - return $r->tag('span', $r->image("$htdocs/themes/$theme/images/webwork_logo.svg", alt => 'WeBWorK')); + return $c->tag('span', $c->image("$htdocs/themes/$theme/images/webwork_logo.svg", alt => 'WeBWorK')); } else { - return $r->link_to( - $r->image("$htdocs/themes/$theme/images/webwork_logo.svg", alt => $r->maketext('to courses page')) => + return $c->link_to( + $c->image("$htdocs/themes/$theme/images/webwork_logo.svg", alt => $c->maketext('to courses page')) => $ce->{webwork_url}); } } @@ -457,16 +406,14 @@ Create the link to the host institution with a logo and alt text =cut -sub institution_logo { - my $self = shift; - my $r = $self->r; - my $ce = $r->ce; - my $theme = $r->param("theme") || $ce->{defaultTheme}; +sub institution_logo ($c) { + my $ce = $c->ce; + my $theme = $c->param("theme") || $ce->{defaultTheme}; my $htdocs = $ce->{webwork_htdocs_url}; - return $r->link_to( - $r->image( + return $c->link_to( + $c->image( "$htdocs/themes/$theme/images/" . $ce->{institutionLogo}, - alt => $r->maketext("to [_1] main web site", $ce->{institutionName}) + alt => $c->maketext("to [_1] main web site", $ce->{institutionName}) ) => $ce->{institutionURL} ); } @@ -485,12 +432,10 @@ the template is looked up in the course environment. =cut -sub content { - my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; +sub content ($c) { + my $ce = $c->ce; - my $theme = $r->param('theme') || $ce->{defaultTheme}; + my $theme = $c->param('theme') || $ce->{defaultTheme}; $theme = $ce->{defaultTheme} if $theme =~ m!(?:^|/)\.\.(?:/|$)!; my $layout = $ce->{defaultThemeTemplate} // 'system'; @@ -515,11 +460,7 @@ sub content { } } - return $r->render( - template => ((ref($self) =~ s/^WeBWorK:://r) =~ s/::/\//gr), - layout => $layoutName, - cg => $self - ); + return $c->render(template => ((ref($c) =~ s/^WeBWorK:://r) =~ s/::/\//gr), layout => $layoutName); } =back @@ -558,27 +499,24 @@ Links that should appear on every page. =cut -sub links { - my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; - my $db = $r->db; - my $authen = $r->authen; - my $authz = $r->authz; - my $urlpath = $r->urlpath; +sub links ($c) { + my $ce = $c->ce; + my $db = $c->db; + my $authen = $c->authen; + my $authz = $c->authz; # Grab data from the request. - my $courseID = $urlpath->arg('courseID'); - my $userID = $r->param('user'); - my $eUserID = $r->param('effectiveUser'); - my $setID = $urlpath->arg('setID'); - my $problemID = $urlpath->arg('problemID'); - my $achievementID = $urlpath->arg('achievementID'); + my $userID = $c->param('user'); + my $eUserID = $c->param('effectiveUser'); + my $courseID = $c->stash('courseID'); + my $setID = $c->stash('setID'); + my $problemID = $c->stash('problemID'); + my $achievementID = $c->stash('achievementID'); # Determine if navigation is restricted for this user. my $restricted_navigation = $authen->was_verified && !$authz->hasPermissions($userID, 'navigation_allowed'); - # If navigation is restricted and the setID was not in the urlpath, + # If navigation is restricted and the setID was not in the route stash, # then get the setID this user is restricted to view from the authen cookie. $setID = $authen->get_session_set_id if (!$setID && $restricted_navigation); @@ -596,49 +534,27 @@ sub links { # System link parameters that are common to all links (except the Courses link). my %systemlink_params = ( - $r->param('displayMode') ? (displayMode => $r->param('displayMode')) : (), - $r->param('showOldAnswers') ? (showOldAnswers => $r->param('showOldAnswers')) : () + $c->param('displayMode') ? (displayMode => $c->param('displayMode')) : (), + $c->param('showOldAnswers') ? (showOldAnswers => $c->param('showOldAnswers')) : () ); + my $current_url = $c->url_for; + # Subroutine for generating links. my $makelink = sub { - my ($module, %options) = @_; + my ($route_name, %options) = @_; - my $new_urlpath = $self->r->urlpath->newFromModule( - "WeBWorK::ContentGenerator::$module", - $r, - courseID => $courseID, - %{ $options{urlpath_args} || {} } - ); + my $new_url = $c->url_for($route_name, courseID => $courseID, %{ $options{captures} || {} }); - my $active = $options{active}; - - # Try to set $active automatically by comparing the generated urlpath to the existing one. - if (!defined $active) { - if ($urlpath->module eq $new_urlpath->module) { - my @args = sort keys %{ { $urlpath->args } }; - my @new_args = sort keys %{ { $new_urlpath->args } }; - if (@args == @new_args) { - $active = 1; - for my $i (0 .. $#args) { - if ($args[$i] ne $new_args[$i]) { - $active = 0; - last; - } - } - } else { - $active = 0; - } - } else { - $active = 0; - } - } + # If 'active' is not set in the options, then determine the active link + # by comparing the generated url to the current url. + my $active = $options{active} // $c->current_route eq $route_name && $new_url eq $current_url; - # Do not use HTML::Entities::encode_entities the link text. + # Do not use HTML::Entities::encode_entities on the link text. # Mojolicious has already encoded html entities at this point. - return $r->link_to( - ($options{text} // $new_urlpath->name(1)) => $self->systemLink( - $new_urlpath, params => { %systemlink_params, %{ $options{systemlink_params} // {} } } + return $c->link_to( + ($options{text} // route_title($c, $route_name)) => $c->systemLink( + $new_url, params => { %systemlink_params, %{ $options{systemlink_params} // {} } } ), class => 'nav-link' . ($active ? ' active' : ''), $options{target} ? (target => $options{target}) : (), @@ -646,12 +562,12 @@ sub links { ); }; - return $r->include( + return $c->include( 'ContentGenerator/Base/links', courseID => $courseID, userID => $userID, eUserID => $eUserID, - urlUserID => $urlpath->arg('userID'), + urlUserID => $c->stash('userID'), setID => $setID, prettySetID => format_set_name_display($setID // ''), problemID => $problemID, @@ -681,8 +597,7 @@ For example: Not defined in this package. -View options related to the content displayed in the body or info areas. See also -optionsMacro(). +View options related to the content displayed in the body or info areas. =item path($args) @@ -697,44 +612,39 @@ $args is a reference to a hash containing the following fields: if style=image, the ALT text of each separator image textonly => suppress all HTML, return only plain text -The implementation in this package takes information from the WeBWorK::URLPath -associated with the current request. +The implementation in this package gathers the route information from the +current request. =cut -sub path { - my ($self, $args) = @_; - my $r = $self->r; - my $urlpath = $r->urlpath; +sub path ($c, $args = {}) { + my $route = $c->app->routes->lookup($c->current_route); # Determine if navigation is restricted for this user. my $restrict_navigation = - $r->authen->was_verified && !$r->authz->hasPermissions($r->param('user'), 'navigation_allowed'); + $c->authen->was_verified && !$c->authz->hasPermissions($c->param('user'), 'navigation_allowed'); my @path; do { - my $name = $urlpath->name; - # If it is a problemID for a jitar set (something which requires - # a fair bit of checking), then display the pretty id. - if (defined $urlpath->module && $urlpath->module eq 'WeBWorK::ContentGenerator::Problem') { - if ($urlpath->parent->name) { - my $set = $r->db->getGlobalSet($urlpath->parent->name); - if ($set && $set->assignment_type eq 'jitar') { - $name = join('.', jitar_id_to_seq($r->param('problemID'))); - } + my $title = route_title($c, $route->name); + # If it is a problemID for a jitar set, then display the pretty id. + if ($route->name eq 'problem_detail' && $c->stash('setID')) { + my $set = $c->db->getGlobalSet($c->stash('setID')); + if ($set && $set->assignment_type eq 'jitar') { + $title = join('.', jitar_id_to_seq($c->stash('problemID'))); } } # If navigation is restricted for this user and path, then don't provide the link. - unshift @path, $name, - $restrict_navigation && $urlpath->navigation_restricted ? '' : $r->location . $urlpath->path; - } while ($urlpath = $urlpath->parent); + unshift @path, $title, + $restrict_navigation && route_navigation_is_restricted($route) ? '' : $c->url_for($route->name); + } while (($route = $route->parent) && ref($route) eq 'Mojolicious::Routes::Route'); # We don't want the last path element to be a link. $path[-1] = ''; - return $self->pathMacro($args, @path); + return $c->pathMacro($args, @path); } =item siblings() @@ -757,10 +667,9 @@ will give standard WeBWorK time format. Wording and other formatting can be done in the template itself. =cut -sub timestamp { - my ($self, $args) = @_; +sub timestamp ($c) { # Need to use the formatDateTime in this file (some subclasses access Util's version). - return $self->formatDateTime(time); + return $c->formatDateTime(time); } =item message() @@ -771,43 +680,35 @@ Print any messages (error or non-error) resulting from the last form submission. This could be used to give Sucess and Failure messages after an action is performed by a module. The implementation in this package outputs the value of the field -$self->{status_message}, if it is present. +$c->{status_message}, if it is present. =cut -sub message { - my ($self) = @_; - - $self->{status_message} //= $self->r->c; - return $self->{status_message}->join('') if @{ $self->{status_message} }; - - return ''; +sub message ($c) { + $c->{status_message} //= $c->c; + return $c->{status_message}->join(''); } -=item title() +=item page_title() Defined in this package. Print the title of the current page. -The implementation in this package takes information from the WeBWorK::URLPath -associated with the current request. +The implementation in this package takes information from the current route. =cut -sub title { - my ($self, $args) = @_; - my $r = $self->r; - my $ce = $r->ce; - my $db = $r->db; - my $urlpath = $r->urlpath; +sub page_title ($c) { + my $ce = $c->ce; + my $db = $c->db; - # If the urlpath type is 'set_list' and the course has a course title then display that. - if (($urlpath->type // '') eq 'set_list' && $db->settingExists('courseTitle')) { + # If the current route name is 'set_list' and the course has a course title then display that. + if ($c->current_route eq 'set_list' && $db->settingExists('courseTitle')) { return $db->getSettingValue('courseTitle'); } else { - # Display the urlpath name - return $urlpath->name(1); + # Display the route name + return route_title($c, $c->current_route); } } @@ -823,9 +724,8 @@ that can be accessed in javascript files. =cut -sub webwork_url { - my $self = shift; - return $self->r->location; +sub webwork_url ($c) { + return $c->location; } =item warnings() @@ -839,34 +739,27 @@ The implementation in this package checks for a stash key named =cut -sub warnings { - my ($self) = @_; - my $r = $self->r; - - return $self->r->include('ContentGenerator/Base/warning_output', - warnings => [ split m/\n+/, $r->stash('warnings') ]) - if $r->stash('warnings'); +sub warnings ($c) { + return $c->include('ContentGenerator/Base/warning_output', warnings => [ split m/\n+/, $c->stash('warnings') ]) + if $c->stash('warnings'); return ''; } =item help() Display a link to context-sensitive help. If the argument C is defined, -the link will be to the help document for that name. Otherwise the module of the -WeBWorK::URLPath node for the current system location will be used. +the link will be to the help document for that name. Otherwise the current +content generator package name will be used. =cut -sub help { - my $self = shift; - my $args = shift; - +sub help ($c, $args) { my $name = $args->{name}; - $name = $self->r->urlpath->module unless defined($name); + $name = ref($c) unless defined($name); $name =~ s/WeBWorK::ContentGenerator:://; $name =~ s/://g; - $self->helpMacro($name, $args); + return $c->helpMacro($name, $args); } =item url($args) @@ -882,9 +775,8 @@ environment. $args is a reference to a hash containing the following fields: =cut -sub url { - my ($self, $args) = @_; - my $ce = $self->r->ce; +sub url ($c, $args) { + my $ce = $c->ce; my $type = $args->{type} // 'webwork'; my $name = $args->{name} // ''; my $file = $args->{file}; @@ -935,13 +827,13 @@ This package just uses the UNIVERSAL::can() function. A subclass could redefine this method to, for example, "hide" a method from the template: - sub can { - my ($self, $arg) = @_; + sub can ($c, $arg) { + my ($c, $arg) = @_; if ($arg eq "floobar") { return 0; } else { - return $self->SUPER::can($arg); + return $c->SUPER::can($arg); } } @@ -957,11 +849,8 @@ there are pg errors. =cut -sub have_warnings { - my ($self) = @_; - my $r = $self->r; - - return $r->stash('warnings') || $self->{pgerrors}; +sub have_warnings ($c) { + return $c->stash('warnings') || $c->{pgerrors}; } =item exists_theme_file @@ -971,9 +860,8 @@ and false otherwise =cut -sub exists_theme_file { - my ($self, $arg) = @_; - my $ce = $self->r->ce; +sub exists_theme_file ($c, $arg) { + my $ce = $c->ce; return -e "$ce->{webworkDirs}{themes}/$ce->{defaultTheme}/$arg"; } @@ -1005,27 +893,22 @@ Helper macro for the C<#path> escape sequence: $args is a hash reference containing the "style", "image", "text", and "textonly" arguments to the escape. @path consists of ordered key-value pairs of the form: - "Page Name" => URL + "Page Name" => Mojo::URL -If the page should not have a link associated with it, the URL should be left -empty. Authentication data is added to each URL so you don't have to. A fully- -formed path line is returned, suitable for returning by a function implementing -the C<#path> escape. - -FIXME: authentication data probably shouldn't be added here any more, now that -we have systemLink(). +If the page should not have a link associated with it, the URL should be the +empty string. Authentication data is added to each URL so you don't have to. A +fully-formed path line is returned, suitable for returning by a function +implementing the C<#path> escape. =cut -sub pathMacro { - my ($self, $args, @path) = @_; - my $r = $self->r; +sub pathMacro ($c, $args, @path) { my %args = %$args; $args{style} = 'text' if $args{textonly}; - my $auth = $self->url_authen_args; + my %auth = $c->url_authen_args; - my $result = $r->c; + my $result = $c->c; while (@path) { my $name = shift @path; my $url = shift @path; @@ -1037,13 +920,13 @@ sub pathMacro { if ($url && !$args{textonly}) { if ($args{style} eq 'bootstrap') { - push @$result, $r->tag('li', class => 'breadcrumb-item', $r->link_to($name => "$url?$auth")); + push @$result, $c->tag('li', class => 'breadcrumb-item', $c->link_to($name => $url->query(\%auth))); } else { - push @$result, $r->link_to($name => "$url?$auth"); + push @$result, $c->link_to($name => $url->querylu(%auth)); } } else { if ($args{style} eq 'bootstrap') { - push @$result, $r->tag('li', class => 'breadcrumb-item active', $name); + push @$result, $c->tag('li', class => 'breadcrumb-item active', $name); } else { push @$result, $name; } @@ -1053,65 +936,29 @@ sub pathMacro { return $result->join($args{text}); } -=item siblingsMacro(@siblings) - -Helper macro for the C<#siblings> escape sequence. @siblings consists of ordered -key-value pairs of the form: - - "Sibling Name" => URL - -If the sibling should not have a link associated with it, the URL should be left -empty. Authentication data is added to each URL so you don't have to. A fully- -formed siblings block is returned, suitable for returning by a function -implementing the C<#siblings> escape. - -FIXME: authentication data probably shouldn't be added here any more, now that -we have systemLink(). - -=cut - -sub siblingsMacro { - my ($self, @siblings) = @_; - my $r = $self->r; - - my $auth = $self->url_authen_args; - - my @result; - while (@siblings) { - my $name = shift @siblings; - my $url = shift @siblings; - my $id = $name; - $id =~ s/\W/\_/g; - push @result, $r->tag('span', id => $id, $url ? $r->link_to($name => "$url?$auth") : $name); - } - - return join($r->tag('br'), @result) . "\n"; -} - =item navMacro($args, $tail, @links) Helper macro for the C<#nav> escape sequence: C<$args> is a hash reference containing the "style" and "separator" arguments to the escape. -C<@siblings> consists of ordered tuples of the form: +C<@links> consists of ordered tuples of the form: - "Link Name", URL, ImageBaseName + "Link Name", Mojo::URL -If the sibling should not have a link associated with it, the URL should be left -empty. C<$tail> is appended to each URL, after the authentication information. -A fully-formed nav line is returned, suitable for returning by a function -implementing the C<#nav> escape. +If a nav element should not have a link associated with it, the URL should be +the empty string. C<$tail> should be a hash reference of URL query parameters +to add to each URL after the authentication information. A fully-formed nav +line is returned, suitable for returning by a function implementing the C<#nav> +escape. =cut -sub navMacro { - my ($self, $args, $tail, @links) = @_; - my $r = $self->r; - my $ce = $r->ce; +sub navMacro ($c, $args, $tail, @links) { + my $ce = $c->ce; my %args = %$args; - my $auth = $self->url_authen_args; + my %auth = $c->url_authen_args; - my $result = $r->c; + my $result = $c->c; while (@links) { my $name = shift @links; my $url = shift @links; @@ -1119,8 +966,8 @@ sub navMacro { my $html = ($direction && $args{style} eq "buttons") ? $direction : $name; push @$result, $url - ? $r->link_to($html => "$url?$auth$tail", class => 'btn btn-primary') - : $r->tag('span', class => 'btn btn-primary disabled', $html); + ? $c->link_to($html => $url->query(%auth, %$tail), class => 'btn btn-primary') + : $c->tag('span', class => 'btn btn-primary disabled', $html); } return $result->join($args{separator}); @@ -1136,32 +983,17 @@ $args->{label} is the displayed label, and $args->{class} is added to the html c =cut -sub helpMacro { - my $self = shift; - my $name = shift; - my $args = shift; - my $r = $self->r; - +sub helpMacro ($c, $name, $args) { my $label = $args->{label} - // $r->tag('i', class => 'icon fas fa-question-circle', 'aria-hidden' => 'true', data => { alt => ' ? ' }, ''); + // $c->tag('i', class => 'icon fas fa-question-circle', 'aria-hidden' => 'true', data => { alt => ' ? ' }, ''); delete $args->{label}; $args->{class} = 'help-macro ' . ($args->{class} // ''); - my $ce = $self->r->ce; + my $ce = $c->ce; $name = 'no_help' unless -e "$ce->{webworkDirs}{local_help}/$name.html"; - return $r->link_to($label => "$ce->{webworkURLs}{local_help}/$name.html", target => 'ww_help', %$args); -} - -=item sub optionsMacro - -This function has been depreciated - -=cut - -sub optionsMacro { - return ''; + return $c->link_to($label => "$ce->{webworkURLs}{local_help}/$name.html", target => 'ww_help', %$args); } =item feedbackMacro(%params) @@ -1172,46 +1004,23 @@ module and their values. =cut -sub feedbackMacro { - my ($self, %params) = @_; - my $r = $self->r; - my $authz = $r->authz; - my $userID = $r->param("user"); - - # don't do anything unless the user has permission to - return "" unless $authz->hasPermissions($userID, "submit_feedback"); - - my $feedbackURL = $r->ce->{courseURLs}{feedbackURL}; - my $feedbackFormURL = $r->ce->{courseURLs}{feedbackFormURL}; - if (defined $feedbackURL and $feedbackURL ne "") { - return $self->feedback_macro_url($feedbackURL); - } elsif (defined $feedbackFormURL and $feedbackFormURL ne "") { - return $self->feedback_macro_form($feedbackFormURL, %params); +sub feedbackMacro ($c, %params) { + return '' unless $c->authz->hasPermissions($c->param('user'), 'submit_feedback'); + + if ($c->ce->{courseURLs}{feedbackURL}) { + return $c->link_to(($c->maketext($c->ce->{feedback_button_name}) || $c->maketext('Email instructor')) => + $c->ce->{courseURLs}{feedbackURL}); + } elsif ($c->ce->{courseURLs}{feedbackFormURL}) { + return $c->include( + 'ContentGenerator/Base/feedback_macro_form', + params => \%params, + feedbackFormURL => $c->ce->{courseURLs}{feedbackFormURL} + ); } else { - return $self->feedback_macro_email(%params); + return $c->include('ContentGenerator/Base/feedback_macro_email', params => \%params); } } -sub feedback_macro_email { - my ($self, %params) = @_; - return $self->r->include('ContentGenerator/Base/feedback_macro_email', params => \%params); -} - -sub feedback_macro_form { - my ($self, $feedbackFormURL, %params) = @_; - return $self->r->include( - 'ContentGenerator/Base/feedback_macro_form', - params => \%params, - feedbackFormURL => $feedbackFormURL - ); -} - -sub feedback_macro_url { - my ($self, $url) = @_; - my $r = $self->r; - return $r->link_to(($r->maketext($r->ce->{feedback_button_name}) || $r->maketext('Email instructor')) => $url); -} - =back =cut @@ -1236,21 +1045,18 @@ inputs that are created. =cut -sub hidden_fields { - my ($self, @fields) = @_; - my $r = $self->r; - +sub hidden_fields ($c, @fields) { my %options = ref $fields[0] eq 'HASH' ? %{ shift @fields } : (); my $id_prefix = $options{id_prefix} // ''; - @fields = $r->param unless @fields; + @fields = $c->param unless @fields; - my $html = $r->c; + my $html = $c->c; for my $param (@fields) { - my @values = $r->param($param); + my @values = $c->param($param); for my $value (@values) { next unless defined($value); - push(@$html, $r->hidden_field($param => $value, id => "${id_prefix}hidden_$param")); + push(@$html, $c->hidden_field($param => $value, id => "${id_prefix}hidden_$param")); } } @@ -1266,12 +1072,10 @@ An optional $id_prefix may be passed as the first argument of this method. =cut -sub hidden_authen_fields { - my ($self, $id_prefix) = @_; - - return $self->hidden_fields({ id_prefix => $id_prefix }, 'user', 'effectiveUser', 'key', 'theme') +sub hidden_authen_fields ($c, $id_prefix = undef) { + return $c->hidden_fields({ id_prefix => $id_prefix }, 'user', 'effectiveUser', 'key', 'theme') if defined $id_prefix; - return $self->hidden_fields('user', 'effectiveUser', 'key', 'theme'); + return $c->hidden_fields('user', 'effectiveUser', 'key', 'theme'); } =item hidden_proctor_authen_fields() @@ -1281,10 +1085,9 @@ proctor authentication. =cut -sub hidden_proctor_authen_fields { - my $self = shift; - if ($self->r->param('proctor_user')) { - return $self->hidden_fields('proctor_user', 'proctor_key'); +sub hidden_proctor_authen_fields ($c) { + if ($c->param('proctor_user')) { + return $c->hidden_fields('proctor_user', 'proctor_key'); } else { return ''; } @@ -1292,47 +1095,40 @@ sub hidden_proctor_authen_fields { =item url_args(@fields) -Return a URL query string (without the leading `?') containing values for each -field mentioned in @fields, or all fields if list is empty. Data is taken from -the current request. +Return a hash containing values for each field mentioned in @fields, or all +fields if list is empty. Data is taken from the current request. This return +value is suitable for passing to the Mojo::URL query method. =cut -sub url_args { - my ($self, @fields) = @_; - my $r = $self->r; +sub url_args ($c, @fields) { + @fields = $c->param unless @fields; - @fields = $r->param unless @fields; - - my @pairs; + my %params; for my $param (@fields) { - my @values = $r->param($param); - for my $value (@values) { - push @pairs, uri_escape_utf8($param) . "=" . uri_escape($value); - } + $params{$param} = [ $c->param($param) ] if defined $c->param($param); } - return join("&", @pairs); + return %params; } =item url_authen_args() -Use url_args to return a URL query string for request fields used in -authentication. +Use url_args to return a hash of request fields used in authentication that is +suitable for passing to the Mojo::URL query method. =cut -sub url_authen_args { - my ($self) = @_; - my $ce = $self->r->ce; +sub url_authen_args ($c) { + my $ce = $c->ce; # When cookie based session management is in use, there should be no need # to reveal the user and key in the URL. Putting it there makes session # hijacking easier, in particular should a student share such a URL. - if ($ce->{session_management_via} eq "session_cookie") { - return $self->url_args("effectiveUser", "theme"); + if ($ce->{session_management_via} eq 'session_cookie') { + return $c->url_args('effectiveUser', 'theme'); } else { - return $self->url_args("user", "effectiveUser", "key", "theme"); + return $c->url_args('user', 'effectiveUser', 'key', 'theme'); } } @@ -1348,7 +1144,7 @@ sub url_authen_args { =item systemLink($urlpath, %options) -Generate a link to another part of the system. $urlpath is WeBWorK::URLPath +Generate a link to another part of the system. $urlpath is Mojo::URL object from which the base path will be taken. %options can consist of: =over @@ -1385,12 +1181,8 @@ via email. =cut -# FIXME: there should probably be an option for prepending "http://hostname:port" -sub systemLink { - my ($self, $urlpath, %options) = @_; - my $r = $self->r; - - my %params = (); +sub systemLink ($c, $urlpath, %options) { + my %params; if (exists $options{params}) { if (ref $options{params} eq "HASH") { %params = %{ $options{params} }; @@ -1402,16 +1194,13 @@ sub systemLink { } } - my $authen = exists $options{authen} ? $options{authen} : 1; - if ($authen) { - + if ($options{authen} // 1) { # When cookie based session management is in use, there should be no need # to reveal the user and key in the URL. Putting it there makes session # hijacking easier, in particular should a student share such a URL. - - if ($r->ce->{session_management_via} eq "session_cookie") { - undef($params{user}) if exists $params{user}; - undef($params{key}) if exists $params{key}; + if ($c->ce->{session_management_via} eq "session_cookie") { + delete $params{user}; + delete $params{key}; } else { $params{user} = undef unless exists $params{user}; $params{key} = undef unless exists $params{key}; @@ -1421,49 +1210,13 @@ sub systemLink { $params{theme} = undef unless exists $params{theme}; } - my $url; - - $url = $r->ce->{server_root_url} if $options{use_abs_url}; - $url .= $r->location . $urlpath->path; - my $first = 1; + my $url = $options{use_abs_url} ? $urlpath->to_abs : $urlpath; for my $name (keys %params) { - my $value = $params{$name}; - - my @values; - if (defined $value) { - if (ref $value eq "ARRAY") { - @values = @$value; - } else { - @values = $value; - } - } elsif (defined $r->param($name)) { - @values = $r->param($name); - } - #FIXME -- evntually we'd like to catch where this happens - if ($name eq 'user' and @values > 1) { - warn 'internal error -- user has been multiply defined! ' - . 'You may need to logout and log back in to correct this.'; - my $user = $r->param("user"); - $r->param(user => $user); - @values = ($user); - warn "requesting page is ", $r->headers_in->{'Referer'}; - warn "Parameters are ", join("|", $r->param()); - - } - - if (@values) { - if ($first) { - $url .= "?"; - $first = 0; - } else { - $url .= "&"; - } - $url .= join "&", map { "$name=" . HTML::Entities::encode_entities($_) } @values; - } + $params{$name} = [ $c->param($name) ] if (!defined $params{$name} && defined $c->param($name)); } - return $url; + return %params ? $url->query(%params) : $url; } =item nbsp($string) @@ -1473,8 +1226,7 @@ Otherwise $string is returned. =cut -sub nbsp { - my ($self, $str) = @_; +sub nbsp ($c, $str) { return (defined $str && $str =~ /\S/) ? $str : ' '; } @@ -1485,9 +1237,8 @@ problem rendering. =cut -sub errorOutput { - my ($self, $error, $details) = @_; - return $self->r->include('ContentGenerator/Base/error_output', error => $error, details => $details); +sub errorOutput ($c, $error, $details) { + return $c->include('ContentGenerator/Base/error_output', error => $error, details => $details); } =item warningMessage @@ -1496,9 +1247,8 @@ Used to display a generic warning message at the top of the page =cut -sub warningMessage { - my $self = shift; - return $self->r->maketext('Warning: There may be something wrong with this question. ' +sub warningMessage ($c) { + return $c->maketext('Warning: There may be something wrong with this question. ' . 'Please inform your instructor including the warning messages below.'); } @@ -1511,11 +1261,8 @@ UNIX datetime (epoch) in the server's timezone. =cut -sub parseDateTime { - my ($self, $string, $display_tz) = @_; - my $ce = $self->r->ce; - $display_tz ||= $ce->{siteDefaults}{timezone}; - return WeBWorK::Utils::parseDateTime($string, $display_tz); +sub parseDateTime ($c, $string, $display_tz = undef) { + return WeBWorK::Utils::parseDateTime($string, $display_tz || $c->ce->{siteDefaults}{timezone}); } =item $string = formatDateTime($dateTime, $display_tz) @@ -1528,9 +1275,8 @@ $siteDefaults{timezone} is used. =cut -sub formatDateTime { - my ($self, $dateTime, $display_tz, $formatString, $locale) = @_; - my $ce = $self->r->ce; +sub formatDateTime ($c, $dateTime, $display_tz = undef, $formatString = undef, $locale = undef) { + my $ce = $c->ce; $display_tz ||= $ce->{siteDefaults}{timezone}; $locale ||= $ce->{siteDefaults}{locale}; return WeBWorK::Utils::formatDateTime($dateTime, $display_tz, $formatString, $locale); @@ -1543,10 +1289,9 @@ prepends the path to the scoring directory. =cut -sub read_scoring_file { - my ($self, $fileName) = @_; +sub read_scoring_file ($c, $fileName) { return {} if $fileName eq "None"; # callers expect a hashref in all cases - return parse_scoring_file($self->r->ce->{courseDirs}{scoring} . "/$fileName"); + return parse_scoring_file($c->ce->{courseDirs}{scoring} . "/$fileName"); } =item createEmailSenderTransportSMTP @@ -1558,23 +1303,22 @@ Wrapper that creates an Email::Sender::Transport::SMTP object # this function abstracts the process of creating a transport layer for SendMail # it is used in Feedback.pm, SendMail.pm and Utils/ProblemProcessing.pm (for JITAR messages) -sub createEmailSenderTransportSMTP { - my $self = shift; - my $ce = $self->r->ce; +sub createEmailSenderTransportSMTP ($c) { + my $ce = $c->ce; my $transport; - if (defined $ce->{mail}->{smtpPort}) { + if (defined $ce->{mail}{smtpPort}) { $transport = Email::Sender::Transport::SMTP->new({ - host => $ce->{mail}->{smtpServer}, - ssl => $ce->{mail}->{tls_allowed} // 0, ## turn off ssl security by default - port => $ce->{mail}->{smtpPort}, - timeout => $ce->{mail}->{smtpTimeout}, + host => $ce->{mail}{smtpServer}, + ssl => $ce->{mail}{tls_allowed} // 0, ## turn off ssl security by default + port => $ce->{mail}{smtpPort}, + timeout => $ce->{mail}{smtpTimeout}, # debug => 1, }); } else { $transport = Email::Sender::Transport::SMTP->new({ - host => $ce->{mail}->{smtpServer}, - ssl => $ce->{mail}->{tls_allowed} // 0, ## turn off ssl security by default - timeout => $ce->{mail}->{smtpTimeout}, + host => $ce->{mail}{smtpServer}, + ssl => $ce->{mail}{tls_allowed} // 0, ## turn off ssl security by default + timeout => $ce->{mail}{smtpTimeout}, # debug => 1, }); } diff --git a/lib/WeBWorK/ContentGenerator/Achievements.pm b/lib/WeBWorK/ContentGenerator/Achievements.pm index f04e70df31..5706de405a 100644 --- a/lib/WeBWorK/ContentGenerator/Achievements.pm +++ b/lib/WeBWorK/ContentGenerator/Achievements.pm @@ -15,7 +15,7 @@ # This module prints out the list of achievements that a student has earned package WeBWorK::ContentGenerator::Achievements; -use parent qw(WeBWorK::ContentGenerator); +use Mojo::Base 'WeBWorK::ContentGenerator', -signatures; =head1 NAME @@ -24,48 +24,35 @@ This produces a list of earned achievements for each student. =cut -use strict; -use warnings; - use WeBWorK::Utils qw(sortAchievements thaw_base64); use WeBWorK::AchievementItems; -sub head { - my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; - - return ''; -} - -sub initialize { - my ($self) = @_; - my $r = $self->r; - my $db = $r->db; - my $ce = $r->ce; +sub initialize ($c) { + my $db = $c->db; + my $ce = $c->ce; # Get user Data - $self->{userName} = $r->param('user'); - $self->{studentName} = $r->param('effectiveUser') // $self->{userName}; - $self->{globalData} = $db->getGlobalUserAchievement($self->{studentName}); + $c->{userName} = $c->param('user'); + $c->{studentName} = $c->param('effectiveUser') // $c->{userName}; + $c->{globalData} = $db->getGlobalUserAchievement($c->{studentName}); # Check to see if user items are enabled and if the user has achievement data. - if ($ce->{achievementItemsEnabled} && defined $self->{globalData}) { - my $itemsWithCounts = WeBWorK::AchievementItems::UserItems($self->{studentName}, $db, $ce); - $self->{achievementItems} = $itemsWithCounts; + if ($ce->{achievementItemsEnabled} && defined $c->{globalData}) { + my $itemsWithCounts = WeBWorK::AchievementItems::UserItems($c->{studentName}, $db, $ce); + $c->{achievementItems} = $itemsWithCounts; - my $usedItem = $r->param('useditem'); + my $usedItem = $c->param('useditem'); # If the useditem parameter is defined then the student wanted to use an item, so lets do that by calling the # appropriate item's use method and printing results. if (defined $usedItem) { - my $error = $itemsWithCounts->[$usedItem][0]->use_item($self->{studentName}, $r); + my $error = $itemsWithCounts->[$usedItem][0]->use_item($c->{studentName}, $c); if ($error) { - $self->addbadmessage($error); + $c->addbadmessage($error); } else { if ($itemsWithCounts->[$usedItem][1] != 1) { --$itemsWithCounts->[$usedItem][1]; } else { splice(@$itemsWithCounts, $usedItem, 1); } - $self->addgoodmessage($r->maketext('Reward used successfully!')); + $c->addgoodmessage($c->maketext('Reward used successfully!')); } } } @@ -73,22 +60,20 @@ sub initialize { return; } -sub getAchievementLevelData { - my ($self) = @_; - +sub getAchievementLevelData ($c) { my ($achievement, $level_progress, $level_goal, $level_percentage); - if ($self->{globalData}->level_achievement_id) { - $achievement = $self->r->db->getAchievement($self->{globalData}->level_achievement_id); + if ($c->{globalData}->level_achievement_id) { + $achievement = $c->db->getAchievement($c->{globalData}->level_achievement_id); } if ($achievement) { - if ($self->{globalData}->next_level_points) { + if ($c->{globalData}->next_level_points) { # Get prev_level_points from the globalData frozen_hash in the database. - my $globalData = $self->{globalData}->frozen_hash ? thaw_base64($self->{globalData}->frozen_hash) : {}; + my $globalData = $c->{globalData}->frozen_hash ? thaw_base64($c->{globalData}->frozen_hash) : {}; my $prev_level = $globalData->{prev_level_points} || 0; - $level_goal = $self->{globalData}->next_level_points - $prev_level; - $level_progress = $self->{globalData}->achievement_points - $prev_level; + $level_goal = $c->{globalData}->next_level_points - $prev_level; + $level_progress = $c->{globalData}->achievement_points - $prev_level; $level_progress = 0 if $level_progress < 0; $level_progress = $level_goal if $level_progress > $level_goal; $level_percentage = int(100 * $level_progress / $level_goal); @@ -103,17 +88,16 @@ sub getAchievementLevelData { ); } -sub getAchievementItemsData { - my ($self) = @_; - my $db = $self->r->db; +sub getAchievementItemsData ($c) { + my $db = $c->db; - my $userID = $self->{studentName}; + my $userID = $c->{studentName}; my (@items, %itemCounts, @sets, @setProblemCount); - if ($self->r->ce->{achievementItemsEnabled} && $self->{achievementItems}) { + if ($c->ce->{achievementItemsEnabled} && $c->{achievementItems}) { # Remove count data so @items is structured as originally designed. - for my $item (@{ $self->{achievementItems} }) { + for my $item (@{ $c->{achievementItems} }) { push(@items, $item->[0]); $itemCounts{ $item->[0]->id() } = $item->[1]; } @@ -137,13 +121,11 @@ sub getAchievementItemsData { ); } -sub getAchievementsData { - my ($self) = @_; - my $r = $self->r; - my $db = $r->db; - my $ce = $r->ce; +sub getAchievementsData ($c) { + my $db = $c->db; + my $ce = $c->ce; - my $userID = $self->{studentName}; + my $userID = $c->{studentName}; my (@visibleAchievements, %userAchievements); diff --git a/lib/WeBWorK/ContentGenerator/CourseAdmin.pm b/lib/WeBWorK/ContentGenerator/CourseAdmin.pm index 905e8f74e1..25e685c29d 100644 --- a/lib/WeBWorK/ContentGenerator/CourseAdmin.pm +++ b/lib/WeBWorK/ContentGenerator/CourseAdmin.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::CourseAdmin; -use parent qw(WeBWorK::ContentGenerator); +use Mojo::Base 'WeBWorK::ContentGenerator', -signatures; =head1 NAME @@ -22,9 +22,6 @@ WeBWorK::ContentGenerator::CourseAdmin - Add, rename, and delete courses. =cut -use strict; -use warnings; - use Net::IP; # needed for location management use File::Path 'remove_tree'; use File::stat; @@ -38,34 +35,31 @@ use WeBWorK::Utils::CourseManagement qw(addCourse renameCourse retitleCourse del use WeBWorK::Utils::CourseIntegrityCheck; use WeBWorK::DB; -async sub pre_header_initialize { - my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; - my $db = $r->db; - my $authz = $r->authz; - my $urlpath = $r->urlpath; - my $user = $r->param('user'); +sub pre_header_initialize ($c) { + my $ce = $c->ce; + my $db = $c->db; + my $authz = $c->authz; + my $user = $c->param('user'); return unless $authz->hasPermissions($user, 'create_and_delete_courses'); # Get result and send to message - my $status_message = $r->param('status_message'); - $self->addmessage($r->tag('p', class => 'my-2', $r->b($status_message))) if $status_message; + my $status_message = $c->param('status_message'); + $c->addmessage($c->tag('p', class => 'my-2', $c->b($status_message))) if $status_message; # Check that the non-native tables are present in the database. # These are the tables which are not course specific. my @table_update_messages = initNonNativeTables($ce, $ce->{dbLayoutName}); - $self->addgoodmessage($r->c(@table_update_messages)->join($r->tag('br'))) if @table_update_messages; + $c->addgoodmessage($c->c(@table_update_messages)->join($c->tag('br'))) if @table_update_messages; my @errors; my $method_to_call; - my $subDisplay = $r->param('subDisplay'); + my $subDisplay = $c->param('subDisplay'); if (defined $subDisplay) { if ($subDisplay eq 'add_course') { - if (defined $r->param('add_course')) { - @errors = $self->add_course_validate; + if (defined $c->param('add_course')) { + @errors = $c->add_course_validate; if (@errors) { $method_to_call = 'add_course_form'; } else { @@ -75,25 +69,25 @@ async sub pre_header_initialize { $method_to_call = 'add_course_form'; } } elsif ($subDisplay eq 'rename_course') { - if (defined $r->param('rename_course')) { - @errors = $self->rename_course_validate; + if (defined $c->param('rename_course')) { + @errors = $c->rename_course_validate; if (@errors) { $method_to_call = 'rename_course_form'; } else { $method_to_call = 'rename_course_confirm'; } - } elsif (defined $r->param('confirm_rename_course')) { - @errors = $self->rename_course_validate; + } elsif (defined $c->param('confirm_rename_course')) { + @errors = $c->rename_course_validate; if (@errors) { $method_to_call = 'rename_course_form'; } else { $method_to_call = 'do_rename_course'; } - } elsif (defined $r->param('confirm_retitle_course')) { + } elsif (defined $c->param('confirm_retitle_course')) { $method_to_call = 'do_retitle_course'; - } elsif (defined $r->param('upgrade_course_tables')) { - @errors = $self->rename_course_validate; + } elsif (defined $c->param('upgrade_course_tables')) { + @errors = $c->rename_course_validate; if (@errors) { $method_to_call = 'rename_course_form'; } else { @@ -103,62 +97,62 @@ async sub pre_header_initialize { $method_to_call = 'rename_course_form'; } } elsif ($subDisplay eq 'delete_course') { - if (defined $r->param('delete_course')) { - @errors = $self->delete_course_validate; + if (defined $c->param('delete_course')) { + @errors = $c->delete_course_validate; if (@errors) { $method_to_call = 'delete_course_form'; } else { $method_to_call = 'delete_course_confirm'; } - } elsif (defined $r->param('confirm_delete_course')) { - @errors = $self->delete_course_validate; + } elsif (defined $c->param('confirm_delete_course')) { + @errors = $c->delete_course_validate; if (@errors) { $method_to_call = 'delete_course_form'; } else { $method_to_call = 'do_delete_course'; } - } elsif (defined($r->param('delete_course_refresh'))) { + } elsif (defined($c->param('delete_course_refresh'))) { $method_to_call = 'delete_course_form'; } else { $method_to_call = 'delete_course_form'; } } elsif ($subDisplay eq 'archive_course') { - if (defined $r->param('archive_course') || defined $r->param('skip_archive_course')) { - @errors = $self->archive_course_validate; + if (defined $c->param('archive_course') || defined $c->param('skip_archive_course')) { + @errors = $c->archive_course_validate; if (@errors) { $method_to_call = 'archive_course_form'; } else { $method_to_call = 'archive_course_confirm'; } - } elsif (defined $r->param('confirm_archive_course')) { - @errors = $self->archive_course_validate; + } elsif (defined $c->param('confirm_archive_course')) { + @errors = $c->archive_course_validate; if (@errors) { $method_to_call = 'archive_course_form'; } else { $method_to_call = 'do_archive_course'; } - } elsif (defined $r->param('upgrade_course_tables')) { - @errors = $self->archive_course_validate; + } elsif (defined $c->param('upgrade_course_tables')) { + @errors = $c->archive_course_validate; if (@errors) { $method_to_call = 'archive_course_form'; } else { $method_to_call = 'archive_course_confirm'; } - } elsif (defined($r->param('archive_course_refresh'))) { + } elsif (defined($c->param('archive_course_refresh'))) { $method_to_call = 'archive_course_form'; } else { $method_to_call = 'archive_course_form'; } } elsif ($subDisplay eq 'unarchive_course') { - if (defined $r->param('unarchive_course')) { - @errors = $self->unarchive_course_validate; + if (defined $c->param('unarchive_course')) { + @errors = $c->unarchive_course_validate; if (@errors) { $method_to_call = 'unarchive_course_form'; } else { $method_to_call = 'unarchive_course_confirm'; } - } elsif (defined $r->param('confirm_unarchive_course')) { - @errors = $self->unarchive_course_validate; + } elsif (defined $c->param('confirm_unarchive_course')) { + @errors = $c->unarchive_course_validate; if (@errors) { $method_to_call = 'unarchive_course_form'; } else { @@ -168,15 +162,15 @@ async sub pre_header_initialize { $method_to_call = 'unarchive_course_form'; } } elsif ($subDisplay eq 'upgrade_course') { - if (defined $r->param('upgrade_course')) { - @errors = $self->upgrade_course_validate; + if (defined $c->param('upgrade_course')) { + @errors = $c->upgrade_course_validate; if (@errors) { $method_to_call = 'upgrade_course_form'; } else { $method_to_call = 'upgrade_course_confirm'; } - } elsif (defined $r->param('confirm_upgrade_course')) { - @errors = $self->upgrade_course_validate; + } elsif (defined $c->param('confirm_upgrade_course')) { + @errors = $c->upgrade_course_validate; if (@errors) { $method_to_call = 'upgrade_course_form'; } else { @@ -186,98 +180,95 @@ async sub pre_header_initialize { $method_to_call = 'upgrade_course_form'; } } elsif ($subDisplay eq 'manage_locations') { - if (defined($r->param('manage_location_action'))) { - $method_to_call = $r->param('manage_location_action'); + if (defined($c->param('manage_location_action'))) { + $method_to_call = $c->param('manage_location_action'); } else { $method_to_call = 'manage_location_form'; } } elsif ($subDisplay eq 'hide_inactive_course') { - if (defined($r->param('hide_course'))) { - @errors = $self->hide_course_validate; + if (defined($c->param('hide_course'))) { + @errors = $c->hide_course_validate; if (@errors) { $method_to_call = 'hide_inactive_course_form'; } else { $method_to_call = 'do_hide_inactive_course'; } - } elsif (defined($r->param('unhide_course'))) { - @errors = $self->unhide_course_validate; + } elsif (defined($c->param('unhide_course'))) { + @errors = $c->unhide_course_validate; if (@errors) { $method_to_call = 'hide_inactive_course_form'; } else { $method_to_call = 'do_unhide_inactive_course'; } - } elsif (defined($r->param('hide_course_refresh'))) { + } elsif (defined($c->param('hide_course_refresh'))) { $method_to_call = 'hide_inactive_course_form'; } else { $method_to_call = 'hide_inactive_course_form'; } } elsif ($subDisplay eq 'registration') { - if (defined($r->param('register_site'))) { + if (defined($c->param('register_site'))) { $method_to_call = 'do_registration'; } } else { - @errors = "Unrecognized sub-display @{[ $r->tag('b', $subDisplay) ]}."; + @errors = "Unrecognized sub-display @{[ $c->tag('b', $subDisplay) ]}."; } } - $self->{errors} = \@errors; - $self->{method_to_call} = $method_to_call; + $c->{errors} = \@errors; + $c->{method_to_call} = $method_to_call; return; } -sub add_course_form { - my ($self) = @_; - return $self->r->include('ContentGenerator/CourseAdmin/add_course_form'); +sub add_course_form ($c) { + return $c->include('ContentGenerator/CourseAdmin/add_course_form'); } -sub add_course_validate { - my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; +sub add_course_validate ($c) { + my $ce = $c->ce; - my $add_courseID = trim_spaces($r->param('add_courseID')) || ''; - my $add_initial_userID = trim_spaces($r->param('add_initial_userID')) || ''; - my $add_initial_password = trim_spaces($r->param('add_initial_password')) || ''; - my $add_initial_confirmPassword = trim_spaces($r->param('add_initial_confirmPassword')) || ''; - my $add_initial_firstName = trim_spaces($r->param('add_initial_firstName')) || ''; - my $add_initial_lastName = trim_spaces($r->param('add_initial_lastName')) || ''; - my $add_initial_email = trim_spaces($r->param('add_initial_email')) || ''; - my $add_dbLayout = trim_spaces($r->param('add_dbLayout')) || ''; + my $add_courseID = trim_spaces($c->param('add_courseID')) || ''; + my $add_initial_userID = trim_spaces($c->param('add_initial_userID')) || ''; + my $add_initial_password = trim_spaces($c->param('add_initial_password')) || ''; + my $add_initial_confirmPassword = trim_spaces($c->param('add_initial_confirmPassword')) || ''; + my $add_initial_firstName = trim_spaces($c->param('add_initial_firstName')) || ''; + my $add_initial_lastName = trim_spaces($c->param('add_initial_lastName')) || ''; + my $add_initial_email = trim_spaces($c->param('add_initial_email')) || ''; + my $add_dbLayout = trim_spaces($c->param('add_dbLayout')) || ''; my @errors; if ($add_courseID eq '') { - push @errors, $r->maketext('You must specify a course ID.'); + push @errors, $c->maketext('You must specify a course ID.'); } unless ($add_courseID =~ /^[\w-]*$/) { # regex copied from CourseAdministration.pm - push @errors, $r->maketext('Course ID may only contain letters, numbers, hyphens, and underscores.'); + push @errors, $c->maketext('Course ID may only contain letters, numbers, hyphens, and underscores.'); } if (grep { $add_courseID eq $_ } listCourses($ce)) { - push @errors, $r->maketext('A course with ID [_1] already exists.', $add_courseID); + push @errors, $c->maketext('A course with ID [_1] already exists.', $add_courseID); } if (length($add_courseID) > $ce->{maxCourseIdLength}) { - push @errors, $r->maketext('Course ID cannot exceed [_1] characters.', $ce->{maxCourseIdLength}); + push @errors, $c->maketext('Course ID cannot exceed [_1] characters.', $ce->{maxCourseIdLength}); } if ($add_initial_userID ne '') { if ($add_initial_password eq '') { - push @errors, $r->maketext('You must specify a password for the initial instructor.'); + push @errors, $c->maketext('You must specify a password for the initial instructor.'); } if ($add_initial_confirmPassword eq '') { - push @errors, $r->maketext('You must confirm the password for the initial instructor.'); + push @errors, $c->maketext('You must confirm the password for the initial instructor.'); } if ($add_initial_password ne $add_initial_confirmPassword) { - push @errors, $r->maketext('The password and password confirmation for the instructor must match.'); + push @errors, $c->maketext('The password and password confirmation for the instructor must match.'); } if ($add_initial_firstName eq '') { - push @errors, $r->maketext('You must specify a first name for the initial instructor.'); + push @errors, $c->maketext('You must specify a first name for the initial instructor.'); } if ($add_initial_lastName eq '') { - push @errors, $r->maketext('You must specify a last name for the initial instructor.'); + push @errors, $c->maketext('You must specify a last name for the initial instructor.'); } if ($add_initial_email eq '') { - push @errors, $r->maketext('You must specify an email address for the initial instructor.'); + push @errors, $c->maketext('You must specify an email address for the initial instructor.'); } } @@ -295,31 +286,28 @@ sub add_course_validate { return @errors; } -sub do_add_course { - my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; - my $db = $r->db; - my $authz = $r->authz; - my $urlpath = $r->urlpath; +sub do_add_course ($c) { + my $ce = $c->ce; + my $db = $c->db; + my $authz = $c->authz; - my $add_courseID = trim_spaces($r->param('add_courseID')) || ''; - my $add_courseTitle = trim_spaces($r->param('add_courseTitle')) || ''; - my $add_courseInstitution = trim_spaces($r->param('add_courseInstitution')) || ''; + my $add_courseID = trim_spaces($c->param('add_courseID')) || ''; + my $add_courseTitle = trim_spaces($c->param('add_courseTitle')) || ''; + my $add_courseInstitution = trim_spaces($c->param('add_courseInstitution')) || ''; - my $add_admin_users = trim_spaces($r->param('add_admin_users')) || ''; + my $add_admin_users = trim_spaces($c->param('add_admin_users')) || ''; - my $add_initial_userID = trim_spaces($r->param('add_initial_userID')) || ''; - my $add_initial_password = trim_spaces($r->param('add_initial_password')) || ''; - my $add_initial_confirmPassword = trim_spaces($r->param('add_initial_confirmPassword')) || ''; - my $add_initial_firstName = trim_spaces($r->param('add_initial_firstName')) || ''; - my $add_initial_lastName = trim_spaces($r->param('add_initial_lastName')) || ''; - my $add_initial_email = trim_spaces($r->param('add_initial_email')) || ''; + my $add_initial_userID = trim_spaces($c->param('add_initial_userID')) || ''; + my $add_initial_password = trim_spaces($c->param('add_initial_password')) || ''; + my $add_initial_confirmPassword = trim_spaces($c->param('add_initial_confirmPassword')) || ''; + my $add_initial_firstName = trim_spaces($c->param('add_initial_firstName')) || ''; + my $add_initial_lastName = trim_spaces($c->param('add_initial_lastName')) || ''; + my $add_initial_email = trim_spaces($c->param('add_initial_email')) || ''; - my $add_templates_course = trim_spaces($r->param('add_templates_course')) || ''; - my $add_config_file = trim_spaces($r->param('add_config_file')) || ''; + my $add_templates_course = trim_spaces($c->param('add_templates_course')) || ''; + my $add_config_file = trim_spaces($c->param('add_config_file')) || ''; - my $add_dbLayout = trim_spaces($r->param('add_dbLayout')) || ''; + my $add_dbLayout = trim_spaces($c->param('add_dbLayout')) || ''; my $ce2 = WeBWorK::CourseEnvironment->new({ %WeBWorK::SeedCE, courseName => $add_courseID, @@ -337,7 +325,7 @@ sub do_add_course { if ($add_admin_users ne '') { for my $userID ($db->listUsers) { if ($userID eq $add_initial_userID) { - $self->addbadmessage($r->maketext( + $c->addbadmessage($c->maketext( 'User "[_1]" will not be copied from admin course as it is the initial instructor.', $userID )); next; @@ -391,7 +379,7 @@ sub do_add_course { $optional_arguments{courseInstitution} = $add_courseInstitution; } - my $output = $r->c; + my $output = $c->c; eval { addCourse( @@ -407,11 +395,11 @@ sub do_add_course { my $error = $@; push( @$output, - $r->tag( + $c->tag( 'div', class => 'alert alert-danger p-1 mb-2', - $r->c($r->tag('p', "An error occured while creating the course $add_courseID:"), - $r->tag('div', class => 'font-monospace', $error))->join('') + $c->c($c->tag('p', "An error occured while creating the course $add_courseID:"), + $c->tag('div', class => 'font-monospace', $error))->join('') ) ); # Get rid of any partially built courses. @@ -460,10 +448,10 @@ sub do_add_course { if (my $oldUser = $db->getUser($composite_id)) { push( @$output, - $r->tag( + $c->tag( 'div', class => 'alert alert-danger p-1 mb-2', - $r->maketext('Replacing old data for [_1]: status: [_2]', $composite_id, $oldUser->status) + $c->maketext('Replacing old data for [_1]: status: [_2]', $composite_id, $oldUser->status) ) ); $db->deleteUser($composite_id); @@ -477,25 +465,19 @@ sub do_add_course { } push( @$output, - $r->tag( + $c->tag( 'div', class => 'alert alert-success p-1 mb-2', - $r->maketext('Successfully created the course [_1]', $add_courseID) + $c->maketext('Successfully created the course [_1]', $add_courseID) ) ); push( @$output, - $r->tag( + $c->tag( 'div', class => 'text-center mb-2', - $r->link_to( - $r->maketext('Log into [_1]', $add_courseID) => $self->systemLink( - $urlpath->newFromModule( - 'WeBWorK::ContentGenerator::ProblemSets', - $r, courseID => $add_courseID - ), - authen => 0 - ) + $c->link_to( + $c->maketext('Log into [_1]', $add_courseID) => 'set_list' => { courseID => $add_courseID } ) ) ); @@ -504,20 +486,17 @@ sub do_add_course { return $output->join(''); } -sub rename_course_form { - my ($self) = @_; - return $self->r->include('ContentGenerator/CourseAdmin/rename_course_form'); +sub rename_course_form ($c) { + return $c->include('ContentGenerator/CourseAdmin/rename_course_form'); } -sub rename_course_confirm { - my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; +sub rename_course_confirm ($c) { + my $ce = $c->ce; - my $rename_oldCourseID = $r->param('rename_oldCourseID') || ''; - my $rename_newCourseID = $r->param('rename_newCourseID') || ''; - my $rename_newCourseTitle = $r->param('rename_newCourseTitle') || ''; - my $rename_newCourseInstitution = $r->param('rename_newCourseInstitution') || ''; + my $rename_oldCourseID = $c->param('rename_oldCourseID') || ''; + my $rename_newCourseID = $c->param('rename_newCourseID') || ''; + my $rename_newCourseTitle = $c->param('rename_newCourseTitle') || ''; + my $rename_newCourseInstitution = $c->param('rename_newCourseInstitution') || ''; my $ce2 = WeBWorK::CourseEnvironment->new({ %WeBWorK::SeedCE, courseName => $rename_oldCourseID }); @@ -530,24 +509,24 @@ sub rename_course_confirm { my $rename_oldCourseInstitution = $oldDB->getSettingValue('courseInstitution') // ''; my ($change_course_title_str, $change_course_institution_str) = ('', ''); - if ($r->param('rename_newCourseTitle_checkbox')) { + if ($c->param('rename_newCourseTitle_checkbox')) { $change_course_title_str = - $r->maketext('Change title from [_1] to [_2]', $rename_oldCourseTitle, $rename_newCourseTitle); + $c->maketext('Change title from [_1] to [_2]', $rename_oldCourseTitle, $rename_newCourseTitle); } - if ($r->param('rename_newCourseInstitution_checkbox')) { - $change_course_institution_str = $r->maketext('Change course institution from [_1] to [_2]', + if ($c->param('rename_newCourseInstitution_checkbox')) { + $change_course_institution_str = $c->maketext('Change course institution from [_1] to [_2]', $rename_oldCourseInstitution, $rename_newCourseInstitution); } # If we are only changing the title or institution, and not the courseID, then we can cut this short. - return $r->include( + return $c->include( 'ContentGenerator/CourseAdmin/rename_course_confirm_short', rename_oldCourseTitle => $rename_oldCourseTitle, change_course_title_str => $change_course_title_str, rename_oldCourseInstitution => $rename_oldCourseInstitution, change_course_institution_str => $change_course_institution_str, rename_oldCourseID => $rename_oldCourseID - ) unless $r->param('rename_newCourseID_checkbox'); + ) unless $c->param('rename_newCourseID_checkbox'); if ($ce2->{dbLayoutName}) { my $CIchecker = WeBWorK::Utils::CourseIntegrityCheck->new(ce => $ce2); @@ -557,7 +536,7 @@ sub rename_course_confirm { # Upgrade the database if requested. my @upgrade_report; - if ($r->param('upgrade_course_tables')) { + if ($c->param('upgrade_course_tables')) { my @schema_table_names = keys %$dbStatus; my @tables_to_create = grep { $dbStatus->{$_}->[0] == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_A } @schema_table_names; @@ -575,7 +554,7 @@ sub rename_course_confirm { # Check directories my ($directories_ok, $directory_report) = $CIchecker->checkCourseDirectories($ce2); - return $r->include( + return $c->include( 'ContentGenerator/CourseAdmin/rename_course_confirm', upgrade_report => \@upgrade_report, tables_ok => $tables_ok, @@ -590,49 +569,47 @@ sub rename_course_confirm { rename_newCourseID => $rename_newCourseID ); } else { - return $r->tag('p', class => 'text-danger fw-bold', "Unable to find database layout for $rename_oldCourseID"); + return $c->tag('p', class => 'text-danger fw-bold', "Unable to find database layout for $rename_oldCourseID"); } } -sub rename_course_validate { - my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; +sub rename_course_validate ($c) { + my $ce = $c->ce; - my $rename_oldCourseID = $r->param('rename_oldCourseID') || ''; - my $rename_newCourseID = $r->param('rename_newCourseID') || ''; - my $rename_newCourseID_checkbox = $r->param('rename_newCourseID_checkbox') || ''; + my $rename_oldCourseID = $c->param('rename_oldCourseID') || ''; + my $rename_newCourseID = $c->param('rename_newCourseID') || ''; + my $rename_newCourseID_checkbox = $c->param('rename_newCourseID_checkbox') || ''; - my $rename_newCourseTitle = $r->param('rename_newCourseTitle') || ''; - my $rename_newCourseTitle_checkbox = $r->param('rename_newCourseTitle_checkbox') || ''; - my $rename_newCourseInstitution = $r->param('rename_newCourseInstitution') || ''; - my $rename_newCourseInstitution_checkbox = $r->param('rename_newCourseInstitution_checkbox') || ''; + my $rename_newCourseTitle = $c->param('rename_newCourseTitle') || ''; + my $rename_newCourseTitle_checkbox = $c->param('rename_newCourseTitle_checkbox') || ''; + my $rename_newCourseInstitution = $c->param('rename_newCourseInstitution') || ''; + my $rename_newCourseInstitution_checkbox = $c->param('rename_newCourseInstitution_checkbox') || ''; my @errors; if ($rename_oldCourseID eq '') { - push @errors, $r->maketext('You must select a course to rename.'); + push @errors, $c->maketext('You must select a course to rename.'); } if ($rename_newCourseID eq '' and $rename_newCourseID_checkbox eq 'on') { - push @errors, $r->maketext('You must specify a new name for the course.'); + push @errors, $c->maketext('You must specify a new name for the course.'); } if ($rename_oldCourseID eq $rename_newCourseID and $rename_newCourseID_checkbox eq 'on') { - push @errors, $r->maketext(q{Can't rename to the same name.}); + push @errors, $c->maketext(q{Can't rename to the same name.}); } if ($rename_newCourseID_checkbox eq 'on' && length($rename_newCourseID) > $ce->{maxCourseIdLength}) { - push @errors, $r->maketext('Course ID cannot exceed [_1] characters.', $ce->{maxCourseIdLength}); + push @errors, $c->maketext('Course ID cannot exceed [_1] characters.', $ce->{maxCourseIdLength}); } unless ($rename_newCourseID =~ /^[\w-]*$/) { # regex copied from CourseAdministration.pm - push @errors, $r->maketext('Course ID may only contain letters, numbers, hyphens, and underscores.'); + push @errors, $c->maketext('Course ID may only contain letters, numbers, hyphens, and underscores.'); } if (grep { $rename_newCourseID eq $_ } listCourses($ce)) { - push @errors, $r->maketext('A course with ID [_1] already exists.', $rename_newCourseID); + push @errors, $c->maketext('A course with ID [_1] already exists.', $rename_newCourseID); } if ($rename_newCourseTitle eq '' and $rename_newCourseTitle_checkbox eq 'on') { - push @errors, $r->maketext('You must specify a new title for the course.'); + push @errors, $c->maketext('You must specify a new title for the course.'); } if ($rename_newCourseInstitution eq '' and $rename_newCourseInstitution_checkbox eq 'on') { - push @errors, $r->maketext('You must specify a new institution for the course.'); + push @errors, $c->maketext('You must specify a new institution for the course.'); } unless ($rename_newCourseID or $rename_newCourseID_checkbox @@ -640,7 +617,7 @@ sub rename_course_validate { or $rename_newCourseInstitution_checkbox) { push @errors, - $r->maketext( + $c->maketext( 'No changes specified. You must mark the checkbox of the item(s) to be changed and enter the change data.' ); } @@ -648,22 +625,19 @@ sub rename_course_validate { return @errors; } -sub do_retitle_course { - my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; - my $db = $r->db; - my $urlpath = $r->urlpath; +sub do_retitle_course ($c) { + my $ce = $c->ce; + my $db = $c->db; - my $rename_oldCourseID = $r->param('rename_oldCourseID') || ''; + my $rename_oldCourseID = $c->param('rename_oldCourseID') || ''; # There is no new course, but there are new titles and institutions - my $rename_newCourseTitle = $r->param('rename_newCourseTitle') || ''; - my $rename_newCourseInstitution = $r->param('rename_newCourseInstitution') || ''; - my $rename_oldCourseTitle = $r->param('rename_oldCourseTitle') || ''; - my $rename_oldCourseInstitution = $r->param('rename_oldCourseInstitution') || ''; - my $title_checkbox = $r->param('rename_newCourseTitle_checkbox') || ''; - my $institution_checkbox = $r->param('rename_newCourseInstitution_checkbox') || ''; + my $rename_newCourseTitle = $c->param('rename_newCourseTitle') || ''; + my $rename_newCourseInstitution = $c->param('rename_newCourseInstitution') || ''; + my $rename_oldCourseTitle = $c->param('rename_oldCourseTitle') || ''; + my $rename_oldCourseInstitution = $c->param('rename_oldCourseInstitution') || ''; + my $title_checkbox = $c->param('rename_newCourseTitle_checkbox') || ''; + my $institution_checkbox = $c->param('rename_newCourseInstitution_checkbox') || ''; # $rename_newCourseID = $rename_oldCourseID ; #since they are the same FIXME # define new courseTitle and new courseInstitution @@ -678,18 +652,18 @@ sub do_retitle_course { eval { retitleCourse(courseID => $rename_oldCourseID, ce => $ce2, dbOptions => {}, %optional_arguments); }; if ($@) { my $error = $@; - return $r->tag( + return $c->tag( 'div', class => 'alert alert-danger p-1 mb-2', - $r->c( - $r->tag( + $c->c( + $c->tag( 'p', - $r->maketext( + $c->maketext( 'An error occured while changing the title of the course [_1].', $rename_oldCourseID ) ), - $r->tag('div', class => 'font-monospace', $error) + $c->tag('div', class => 'font-monospace', $error) )->join('') ); } else { @@ -698,9 +672,9 @@ sub do_retitle_course { 'hosted_courses', join( "\t", "\t", - $r->maketext('Retitled'), + $c->maketext('Retitled'), '', '', - $r->maketext( + $c->maketext( '[_1] title and institution changed from [_2] to [_3] and from [_4] to [_5]', $rename_oldCourseID, $rename_oldCourseTitle, $rename_newCourseTitle, $rename_oldCourseInstitution, $rename_newCourseInstitution @@ -708,64 +682,56 @@ sub do_retitle_course { ) ); - return $r->c( - $r->tag( + return $c->c( + $c->tag( 'div', class => 'alert alert-success p-1 my-2', - $r->c( - ($title_checkbox) ? $r->tag( + $c->c( + ($title_checkbox) ? $c->tag( 'div', - $r->maketext( + $c->maketext( 'The title of the course [_1] has been changed from [_2] to [_3]', $rename_oldCourseID, $rename_oldCourseTitle, $rename_newCourseTitle ) ) : '', - ($institution_checkbox) ? $r->tag( + ($institution_checkbox) ? $c->tag( 'div', - $r->maketext( + $c->maketext( 'The institution associated with the course [_1] has been changed from [_2] to [_3]', $rename_oldCourseID, $rename_oldCourseInstitution, $rename_newCourseInstitution ) ) : '' )->join('') ), - $r->tag( + $c->tag( 'div', class => 'text-center', - $r->link_to( - $r->maketext('Log into [_1]', $rename_oldCourseID) => $self->systemLink( - $urlpath->newFromModule( - 'WeBWorK::ContentGenerator::ProblemSets', - $r, courseID => $rename_oldCourseID - ), - authen => 0 - ) + $c->link_to( + $c->maketext('Log into [_1]', $rename_oldCourseID) => 'set_list' => + { courseID => $rename_oldCourseID } ) ) )->join(''); } } -sub do_rename_course { - my ($self) = @_; - my $r = $self->r; - - my $rename_oldCourseID = $r->param('rename_oldCourseID') || ''; - my $rename_newCourseID = $r->param('rename_newCourseID') || ''; +sub do_rename_course ($c) { + my $rename_oldCourseID = $c->param('rename_oldCourseID') || ''; + my $rename_newCourseID = $c->param('rename_newCourseID') || ''; # define new courseTitle and new courseInstitution my %optional_arguments = (); my ($title_message, $institution_message); - if ($r->param('rename_newCourseTitle_checkbox')) { - $optional_arguments{courseTitle} = $r->param('rename_newCourseTitle') || ''; - $title_message = $r->maketext('The title of the course [_1] is now [_2]', + if ($c->param('rename_newCourseTitle_checkbox')) { + $optional_arguments{courseTitle} = $c->param('rename_newCourseTitle') || ''; + $title_message = $c->maketext('The title of the course [_1] is now [_2]', $rename_newCourseID, $optional_arguments{courseTitle}); } - if ($r->param('rename_newCourseInstitution_checkbox')) { - $optional_arguments{courseInstitution} = $r->param('rename_newCourseInstitution') || ''; - $institution_message = $r->maketext('The institution associated with the course [_1] is now [_2]', + if ($c->param('rename_newCourseInstitution_checkbox')) { + $optional_arguments{courseInstitution} = $c->param('rename_newCourseInstitution') || ''; + $institution_message = $c->maketext('The institution associated with the course [_1] is now [_2]', $rename_newCourseID, $optional_arguments{courseInstitution}); } @@ -781,68 +747,61 @@ sub do_rename_course { }; if ($@) { my $error = $@; - return $r->tag( + return $c->tag( 'div', class => 'alert alert-danger p-1 mb-2', - $r->c( - $r->tag( + $c->c( + $c->tag( 'p', - $r->maketext( + $c->maketext( 'An error occured while renaming the course [_1] to [_2]:', $rename_oldCourseID, $rename_newCourseID ) ), - $r->tag('div', class => 'font-monospace', $error) + $c->tag('div', class => 'font-monospace', $error) )->join('') ); } else { - writeLog($r->ce, 'hosted_courses', + writeLog($c->ce, 'hosted_courses', join("\t", "\tRenamed", '', '', "$rename_oldCourseID to $rename_newCourseID")); - return $r->c( - $r->tag( + return $c->c( + $c->tag( 'div', class => 'alert alert-success p-1 mb-2', - $r->c( - $title_message ? $r->tag('p', $title_message) : '', - $institution_message ? $r->tag('p', $institution_message) : '', - $r->tag( + $c->c( + $title_message ? $c->tag('p', $title_message) : '', + $institution_message ? $c->tag('p', $institution_message) : '', + $c->tag( 'p', class => 'mb-0', - $r->maketext( + $c->maketext( 'Successfully renamed the course [_1] to [_2]', $rename_oldCourseID, $rename_newCourseID ) ) )->join('') ), - $r->tag( + $c->tag( 'div', style => 'text-align: center', - $r->link_to( - $r->maketext('Log into [_1]', $rename_newCourseID) => $self->systemLink( - $r->urlpath->newFromModule( - 'WeBWorK::ContentGenerator::ProblemSets', - $r, courseID => $rename_newCourseID - ), - authen => 0 - ) + $c->link_to( + $c->maketext('Log into [_1]', $rename_newCourseID) => 'set_list' => + { courseID => $rename_newCourseID } ) ) )->join(''); } } -sub delete_course_form { - my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; +sub delete_course_form ($c) { + my $ce = $c->ce; - my @courseIDs = grep { $_ ne $r->urlpath->arg('courseID') } listCourses($ce); + my @courseIDs = grep { $_ ne $c->stash('courseID') } listCourses($ce); my %courseLabels; if (@courseIDs) { my $coursesDir = $ce->{webworkDirs}{courses}; - my $delete_listing_format = $r->param('delete_listing_format'); + my $delete_listing_format = $c->param('delete_listing_format'); unless (defined $delete_listing_format) { $delete_listing_format = 'alphabetically'; } # Use the default # Get and store last modify time for login.log for all courses. Also get visibility status. @@ -864,9 +823,9 @@ sub delete_course_form { push(@noLoginLogIDs, $courseID); } if (-f "$coursesDir/$courseID/hide_directory") { - $coursesData{$courseID}{status} = $r->maketext('hidden'); + $coursesData{$courseID}{status} = $c->maketext('hidden'); } else { - $coursesData{$courseID}{status} = $r->maketext('visible'); + $coursesData{$courseID}{status} = $c->maketext('visible'); } $courseLabels{$courseID} = "$courseID ($coursesData{$courseID}{status} :: $coursesData{$courseID}{local_modify_time}) "; @@ -884,39 +843,33 @@ sub delete_course_form { } } - return $r->include( + return $c->include( 'ContentGenerator/CourseAdmin/delete_course_form', courseIDs => \@courseIDs, courseLabels => \%courseLabels ); } -sub delete_course_validate { - my ($self) = @_; - my $r = $self->r; - +sub delete_course_validate ($c) { my @errors; - if (!$r->param('delete_courseID')) { - push @errors, $r->maketext('You must specify a course name.'); - } elsif ($r->param('delete_courseID') eq $r->urlpath->arg('courseID')) { - push @errors, $r->maketext('You cannot delete the course you are currently using.'); + if (!$c->param('delete_courseID')) { + push @errors, $c->maketext('You must specify a course name.'); + } elsif ($c->param('delete_courseID') eq $c->stash('courseID')) { + push @errors, $c->maketext('You cannot delete the course you are currently using.'); } return @errors; } -sub delete_course_confirm { - my ($self) = @_; - return $self->r->include('ContentGenerator/CourseAdmin/delete_course_confirm'); +sub delete_course_confirm ($c) { + return $c->include('ContentGenerator/CourseAdmin/delete_course_confirm'); } -sub do_delete_course { - my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; - my $db = $r->db; +sub do_delete_course ($c) { + my $ce = $c->ce; + my $db = $c->db; - my $delete_courseID = $r->param('delete_courseID') || ''; + my $delete_courseID = $c->param('delete_courseID') || ''; # dbOptions is left over from when we had 'gdbm' and 'sql' database layouts. For now the hash can remain empty. eval { @@ -929,11 +882,11 @@ sub do_delete_course { if ($@) { my $error = $@; - return $r->tag( + return $c->tag( 'div', class => 'alert alert-danger p-1 my-2', - $r->c($r->tag('p', $r->maketext('An error occured while deleting the course [_1]:', $delete_courseID)), - $r->tag('div', class => 'font-monospace', $error))->join('') + $c->c($c->tag('p', $c->maketext('An error occured while deleting the course [_1]:', $delete_courseID)), + $c->tag('div', class => 'font-monospace', $error))->join('') ); } else { # Mark the contact person in the admin course as dropped. @@ -950,23 +903,23 @@ sub do_delete_course { writeLog($ce, 'hosted_courses', join("\t", "\tDeleted", '', '', $delete_courseID)); - return $r->c( - $r->tag( + return $c->c( + $c->tag( 'div', class => 'alert alert-success p-1 my-2', - $r->maketext('Successfully deleted the course [_1].', $delete_courseID), + $c->maketext('Successfully deleted the course [_1].', $delete_courseID), ), - $r->form_for( - $r->uri, + $c->form_for( + $c->current_route, method => 'POST', - $r->c( - $self->hidden_authen_fields, - $self->hidden_fields('subDisplay'), - $r->tag( + $c->c( + $c->hidden_authen_fields, + $c->hidden_fields('subDisplay'), + $c->tag( 'div', class => 'text-center', - $r->submit_button( - $r->maketext('OK'), + $c->submit_button( + $c->maketext('OK'), name => 'decline_delete_course', class => 'btn btn-primary' ) @@ -977,10 +930,8 @@ sub do_delete_course { } } -sub archive_course_form { - my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; +sub archive_course_form ($c) { + my $ce = $c->ce; my @courseIDs = listCourses($ce); my %courseLabels; @@ -1005,14 +956,14 @@ sub archive_course_form { push(@noLoginLogIDs, $courseID); } if (-f "$ce->{webworkDirs}{courses}/$courseID/hide_directory") { - $coursesData{$courseID}{status} = $r->maketext('hidden'); + $coursesData{$courseID}{status} = $c->maketext('hidden'); } else { - $coursesData{$courseID}{status} = $r->maketext('visible'); + $coursesData{$courseID}{status} = $c->maketext('visible'); } $courseLabels{$courseID} = "$courseID ($coursesData{$courseID}{status} :: $coursesData{$courseID}{local_modify_time}) "; } - if (($r->param('archive_listing_format') // 'alphabetically') eq 'last_login') { + if (($c->param('archive_listing_format') // 'alphabetically') eq 'last_login') { # This should be an empty array except for the model course @noLoginLogIDs = sort { lc($a) cmp lc($b) } @noLoginLogIDs; @loginLogIDs = sort { $coursesData{$a}{epoch_modify_time} <=> $coursesData{$b}{epoch_modify_time} } @@ -1024,39 +975,37 @@ sub archive_course_form { } } - return $r->include( + return $c->include( 'ContentGenerator/CourseAdmin/archive_course_form', courseIDs => \@courseIDs, courseLabels => \%courseLabels ); } -sub archive_course_validate { - my ($self) = @_; - my $r = $self->r; - - my @archive_courseIDs = $r->param('archive_courseIDs'); +sub archive_course_validate ($c) { + my @archive_courseIDs = $c->param('archive_courseIDs'); my @errors; + + push(@errors, $c->maketext('You must select a course to archive')) unless @archive_courseIDs; + for my $archive_courseID (@archive_courseIDs) { if ($archive_courseID eq '') { - push @errors, $r->maketext('You must specify a course name.'); - } elsif ($archive_courseID eq $r->urlpath->arg('courseID')) { - push @errors, $r->maketext('You cannot archive the course you are currently using.'); + push @errors, $c->maketext('You must specify a course name.'); + } elsif ($archive_courseID eq $c->stash('courseID')) { + push @errors, $c->maketext('You cannot archive the course you are currently using.'); } } return @errors; } -sub archive_course_confirm { - my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; +sub archive_course_confirm ($c) { + my $ce = $c->ce; - my @archive_courseIDs = $r->param('archive_courseIDs'); + my @archive_courseIDs = $c->param('archive_courseIDs'); # If we are skipping a course remove one from the list of courses - shift @archive_courseIDs if defined $r->param('skip_archive_course'); + shift @archive_courseIDs if defined $c->param('skip_archive_course'); my $archive_courseID = $archive_courseIDs[0]; @@ -1070,7 +1019,7 @@ sub archive_course_confirm { # Upgrade the database if requested. my @upgrade_report; - if ($r->param('upgrade_course_tables')) { + if ($c->param('upgrade_course_tables')) { my @schema_table_names = keys %$dbStatus; my @tables_to_create = grep { $dbStatus->{$_}->[0] == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_A } @schema_table_names; @@ -1086,10 +1035,10 @@ sub archive_course_confirm { } # Update and check directories. - my $dir_update_messages = $r->param('upgrade_course_tables') ? $CIchecker->updateCourseDirectories : []; + my $dir_update_messages = $c->param('upgrade_course_tables') ? $CIchecker->updateCourseDirectories : []; my ($directories_ok, $directory_report) = $CIchecker->checkCourseDirectories($ce2); - return $r->include( + return $c->include( 'ContentGenerator/CourseAdmin/archive_course_confirm', ce2 => $ce2, upgrade_report => \@upgrade_report, @@ -1102,17 +1051,15 @@ sub archive_course_confirm { archive_courseIDs => \@archive_courseIDs ); } else { - return $r->tag('p', class => 'text-danger fw-bold', "Unable to find database layout for $archive_courseID"); + return $c->tag('p', class => 'text-danger fw-bold', "Unable to find database layout for $archive_courseID"); } } -sub do_archive_course { - my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; - my $db = $r->db; +sub do_archive_course ($c) { + my $ce = $c->ce; + my $db = $c->db; - my @archive_courseIDs = $r->param('archive_courseIDs'); + my @archive_courseIDs = $c->param('archive_courseIDs'); my $archive_courseID = $archive_courseIDs[0]; my $ce2 = WeBWorK::CourseEnvironment->new({ %WeBWorK::SeedCE, courseName => $archive_courseID }); @@ -1131,43 +1078,43 @@ sub do_archive_course { if ($@) { my $error = $@; - return $r->tag( + return $c->tag( 'div', class => 'alert alert-danger p-1 mb-2', - $r->c( - $r->tag('p', $r->maketext('An error occured while archiving the course [_1]:', $archive_courseID)), - $r->tag('div', class => 'font-monospace', $error) + $c->c( + $c->tag('p', $c->maketext('An error occured while archiving the course [_1]:', $archive_courseID)), + $c->tag('div', class => 'font-monospace', $error) )->join('') ); } else { - my $output = $r->c; - push(@$output, $r->tag('div', class => 'alert alert-danger p-1 mb-2', $message)) if $message; + my $output = $c->c; + push(@$output, $c->tag('div', class => 'alert alert-danger p-1 mb-2', $message)) if $message; push( @$output, - $r->tag( + $c->tag( 'div', class => 'alert alert-success p-1 mb-2', - $r->maketext('Successfully archived the course [_1].', $archive_courseID) + $c->maketext('Successfully archived the course [_1].', $archive_courseID) ) ); writeLog($ce, 'hosted_courses', join("\t", "\tarchived", '', '', $archive_courseID,)); - if ($r->param('delete_course')) { + if ($c->param('delete_course')) { eval { deleteCourse(courseID => $archive_courseID, ce => $ce2, dbOptions => {}); }; if ($@) { my $error = $@; push( @$output, - $r->tag( + $c->tag( 'div', class => 'alert alert-danger p-1 mb-2', - $r->c( - $r->tag( + $c->c( + $c->tag( 'p', - $r->maketext('An error occured while deleting the course [_1]:', $archive_courseID) + $c->maketext('An error occured while deleting the course [_1]:', $archive_courseID) ), - $r->tag('div', class => 'font-monospace', $error) + $c->tag('div', class => 'font-monospace', $error) )->join('') ) ); @@ -1189,10 +1136,10 @@ sub do_archive_course { push( @$output, - $r->tag( + $c->tag( 'div', class => 'alert alert-success p-1 mb-2', - $r->maketext('Successfully deleted the course [_1].', $archive_courseID), + $c->maketext('Successfully deleted the course [_1].', $archive_courseID), ) ); } @@ -1202,24 +1149,24 @@ sub do_archive_course { if (@archive_courseIDs) { push( @$output, - $r->form_for( - $r->uri, + $c->form_for( + $c->current_route, method => 'POST', - $r->c( - $self->hidden_authen_fields, - $self->hidden_fields(qw(subDisplay delete_course)), - (map { $r->hidden_field(archive_courseIDs => $_) } @archive_courseIDs), - $r->tag( + $c->c( + $c->hidden_authen_fields, + $c->hidden_fields(qw(subDisplay delete_course)), + (map { $c->hidden_field(archive_courseIDs => $_) } @archive_courseIDs), + $c->tag( 'div', class => 'd-flex justify-content-center gap-2', - $r->c( - $r->submit_button( - $r->maketext('Stop archiving courses'), + $c->c( + $c->submit_button( + $c->maketext('Stop archiving courses'), name => 'decline_archive_course', class => 'btn btn-primary' ), - $r->submit_button( - $r->maketext('Archive next course'), + $c->submit_button( + $c->maketext('Archive next course'), name => 'archive_course', class => 'btn btn-primary' ) @@ -1231,18 +1178,18 @@ sub do_archive_course { } else { push( @$output, - $r->form_for( - $r->uri, + $c->form_for( + $c->current_route, method => 'POST', - $r->c( - $self->hidden_authen_fields, - $self->hidden_fields('subDisplay'), - $r->hidden_field(archive_courseIDs => $archive_courseID), - $r->tag( + $c->c( + $c->hidden_authen_fields, + $c->hidden_fields('subDisplay'), + $c->hidden_field(archive_courseIDs => $archive_courseID), + $c->tag( 'div', class => 'd-flex justify-content-center gap-2', - $r->submit_button( - $r->maketext('OK'), + $c->submit_button( + $c->maketext('OK'), name => 'decline_archive_course', class => 'btn btn-primary' ) @@ -1256,74 +1203,66 @@ sub do_archive_course { } } -sub unarchive_course_form { - my ($self) = @_; - return $self->r->include('ContentGenerator/CourseAdmin/unarchive_course_form'); +sub unarchive_course_form ($c) { + return $c->include('ContentGenerator/CourseAdmin/unarchive_course_form'); } -sub unarchive_course_validate { - my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; - my $urlpath = $r->urlpath; +sub unarchive_course_validate ($c) { + my $ce = $c->ce; - my $unarchive_courseID = $r->param('unarchive_courseID') || ''; - my $new_courseID = $r->param('new_courseID') || ''; + my $unarchive_courseID = $c->param('unarchive_courseID') || ''; + my $new_courseID = $c->param('new_courseID') || ''; # Use the archive name for the course unless a course id was provided. - my $courseID = ($r->param('create_newCourseID') ? $new_courseID : $unarchive_courseID) =~ s/\.tar\.gz$//r; + my $courseID = ($c->param('create_newCourseID') ? $new_courseID : $unarchive_courseID) =~ s/\.tar\.gz$//r; debug(" unarchive_courseID $unarchive_courseID new_courseID $new_courseID "); my @errors; if ($courseID eq '') { - push @errors, $r->maketext('You must specify a course name.'); + push @errors, $c->maketext('You must specify a course name.'); } elsif (-d "$ce->{webworkDirs}->{courses}/$courseID") { # Check that a directory for this course doesn't already exist. push @errors, - $r->maketext( + $c->maketext( 'A directory already exists with the name [_1]. ' . 'You must first delete this existing course before you can unarchive.', $courseID ); } elsif (length($courseID) > $ce->{maxCourseIdLength}) { - push @errors, $r->maketext('Course ID cannot exceed [_1] characters.', $ce->{maxCourseIdLength}); + push @errors, $c->maketext('Course ID cannot exceed [_1] characters.', $ce->{maxCourseIdLength}); } return @errors; } -sub unarchive_course_confirm { - my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; +sub unarchive_course_confirm ($c) { + my $ce = $c->ce; - my $unarchive_courseID = $r->param('unarchive_courseID') || ''; - my $new_courseID = $r->param('new_courseID') || ''; + my $unarchive_courseID = $c->param('unarchive_courseID') || ''; + my $new_courseID = $c->param('new_courseID') || ''; - my $courseID = ($r->param('create_newCourseID') ? $new_courseID : $unarchive_courseID) =~ s/\.tar\.gz//r; + my $courseID = ($c->param('create_newCourseID') ? $new_courseID : $unarchive_courseID) =~ s/\.tar\.gz//r; debug(" unarchive_courseID $unarchive_courseID new_courseID $new_courseID "); - return $self->r->include( + return $c->include( 'ContentGenerator/CourseAdmin/unarchive_course_confirm', unarchive_courseID => $unarchive_courseID, courseID => $courseID ); } -sub do_unarchive_course { - my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; +sub do_unarchive_course ($c) { + my $ce = $c->ce; - my $new_courseID = $r->param('new_courseID'); + my $new_courseID = $c->param('new_courseID'); - return $r->tag('div', class => 'alert alert-danger p-1 mb-2', $r->maketext('You must specify a course name.')) + return $c->tag('div', class => 'alert alert-danger p-1 mb-2', $c->maketext('You must specify a course name.')) unless $new_courseID; - my $unarchive_courseID = $r->param('unarchive_courseID') || ''; + my $unarchive_courseID = $c->param('unarchive_courseID') || ''; unarchiveCourse( newCourseID => $new_courseID, @@ -1334,50 +1273,44 @@ sub do_unarchive_course { if ($@) { my $error = $@; - return $r->tag( + return $c->tag( 'div', class => 'alert alert-danger p-1 mb-2', - $r->c( - $r->tag( - 'p', $r->maketext('An error occured while archiving the course [_1]:', $unarchive_courseID) + $c->c( + $c->tag( + 'p', $c->maketext('An error occured while archiving the course [_1]:', $unarchive_courseID) ), - $r->tag('div', class => 'font-monospace', $error) + $c->tag('div', class => 'font-monospace', $error) )->join('') ); } else { writeLog($ce, 'hosted_courses', join("\t", "\tunarchived", '', '', "$unarchive_courseID to $new_courseID",)); - return $r->c( - $r->tag( + return $c->c( + $c->tag( 'div', class => 'alert alert-success p-1 mb-2', - $r->maketext('Successfully unarchived [_1] to the course [_2]', $unarchive_courseID, $new_courseID), + $c->maketext('Successfully unarchived [_1] to the course [_2]', $unarchive_courseID, $new_courseID), ), - $r->tag( + $c->tag( 'div', class => 'text-center', - $r->link_to( - $r->maketext('Log into [_1]', $new_courseID) => $self->systemLink( - $r->urlpath->newFromModule( - 'WeBWorK::ContentGenerator::ProblemSets', - $r, courseID => $new_courseID - ), - authen => 0 - ) + $c->link_to( + $c->maketext('Log into [_1]', $new_courseID) => 'set_list' => { courseID => $new_courseID } ), ), - $r->form_for( - $r->uri, + $c->form_for( + $c->current_route, method => 'POST', - $r->c( - $self->hidden_authen_fields, - $self->hidden_fields('subDisplay'), - $r->hidden_field(unarchive_courseID => $unarchive_courseID), - $r->tag( + $c->c( + $c->hidden_authen_fields, + $c->hidden_fields('subDisplay'), + $c->hidden_field(unarchive_courseID => $unarchive_courseID), + $c->tag( 'div', class => 'd-flex justify-content-center mt-2', - $r->submit_button( - $r->maketext('Unarchive Next Course'), + $c->submit_button( + $c->maketext('Unarchive Next Course'), name => 'decline_unarchive_course', class => 'btn btn-primary' ) @@ -1390,34 +1323,28 @@ sub do_unarchive_course { # Course upgrade methods -sub upgrade_course_form { - my ($self) = @_; - return $self->r->include('ContentGenerator/CourseAdmin/upgrade_course_form'); +sub upgrade_course_form ($c) { + return $c->include('ContentGenerator/CourseAdmin/upgrade_course_form'); } -sub upgrade_course_validate { - my $self = shift; - my $r = $self->r; - +sub upgrade_course_validate ($c) { my @errors; - for ($r->param('upgrade_courseIDs')) { - push @errors, $r->maketext('You must specify a course name.') if ($_ eq ''); + for ($c->param('upgrade_courseIDs')) { + push @errors, $c->maketext('You must specify a course name.') if ($_ eq ''); } return @errors; } -sub upgrade_course_confirm { - my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; - my $db = $r->db; +sub upgrade_course_confirm ($c) { + my $ce = $c->ce; + my $db = $c->db; - my @upgrade_courseIDs = $r->param('upgrade_courseIDs'); + my @upgrade_courseIDs = $c->param('upgrade_courseIDs'); my ($extra_database_tables_exist, $extra_database_fields_exist) = (0, 0); - my $status_output = $r->c; + my $status_output = $c->c; for my $upgrade_courseID (@upgrade_courseIDs) { next unless $upgrade_courseID =~ /\S/; # skip empty values @@ -1431,42 +1358,42 @@ sub upgrade_course_confirm { # Report on database status my ($tables_ok, $dbStatus) = $CIchecker->checkCourseTables($upgrade_courseID); my ($all_tables_ok, $extra_database_tables, $extra_database_fields, $db_report) = - $self->formatReportOnDatabaseTables($tables_ok, $dbStatus, $upgrade_courseID); + $c->formatReportOnDatabaseTables($dbStatus, $upgrade_courseID); - my $course_output = $r->c; + my $course_output = $c->c; # Add the report on course database to the output. push( @$course_output, - $r->tag( + $c->tag( 'div', class => 'form-check mb-2', - $r->tag( + $c->tag( 'label', class => 'form-check-label', - $r->c( - $r->check_box( + $c->c( + $c->check_box( upgrade_courseIDs => $upgrade_courseID, checked => undef, class => 'form-check-input', ), - $r->maketext('Upgrade [_1]', $upgrade_courseID) + $c->maketext('Upgrade [_1]', $upgrade_courseID) )->join('') ) ) ); - push(@$course_output, $r->tag('h2', $r->maketext('Report for course [_1]:', $upgrade_courseID))); - push(@$course_output, $r->tag('div', class => 'mb-2', $r->maketext('Database:'))); + push(@$course_output, $c->tag('h2', $c->maketext('Report for course [_1]:', $upgrade_courseID))); + push(@$course_output, $c->tag('div', class => 'mb-2', $c->maketext('Database:'))); push(@$course_output, $db_report); if ($extra_database_tables) { $extra_database_tables_exist = 1; push( @$course_output, - $r->tag( + $c->tag( 'p', class => 'text-danger fw-bold', - $r->maketext('There are extra database tables which are not defined in the schema. ') + $c->maketext('There are extra database tables which are not defined in the schema. ') . 'Check the checkbox by the table to delete it when upgrading the course. ' . 'Warning: Deletion destroys all data contained in the table and is not undoable!' ) @@ -1477,10 +1404,10 @@ sub upgrade_course_confirm { $extra_database_fields_exist = 1; push( @$course_output, - $r->tag( + $c->tag( 'p', class => 'text-danger fw-bold', - $r->maketext( + $c->maketext( 'There are extra database fields which are not defined in the schema for at least one table. ' . 'Check the checkbox by the field to delete it when upgrading the course. ' . 'Warning: Deletion destroys all data contained in the field and is not undoable!' @@ -1491,17 +1418,17 @@ sub upgrade_course_confirm { # Report on directory status my ($directories_ok, $directory_report) = $CIchecker->checkCourseDirectories; - push(@$course_output, $r->tag('div', class => 'mb-2', $r->maketext('Directory structure:'))); + push(@$course_output, $c->tag('div', class => 'mb-2', $c->maketext('Directory structure:'))); push( @$course_output, - $r->tag( + $c->tag( 'ul', - $r->c( + $c->c( map { - $r->tag( + $c->tag( 'li', - $r->c("$_->[0]: ", - $r->tag('span', class => $_->[2] ? 'text-success' : 'text-danger', $_->[1])) + $c->c("$_->[0]: ", + $c->tag('span', class => $_->[2] ? 'text-success' : 'text-danger', $_->[1])) ->join('') ) } @$directory_report @@ -1511,19 +1438,19 @@ sub upgrade_course_confirm { push( @$course_output, $directories_ok - ? $r->tag('p', class => 'text-success mb-0', $r->maketext('Directory structure is ok')) - : $r->tag( + ? $c->tag('p', class => 'text-success mb-0', $c->maketext('Directory structure is ok')) + : $c->tag( 'p', class => 'text-danger mb-0', - $r->maketext( + $c->maketext( 'Directory structure is missing directories or the webserver lacks sufficient privileges.') ) ); - push(@$status_output, $r->tag('div', class => 'border border-dark rounded p-2 mb-2', $course_output->join(''))); + push(@$status_output, $c->tag('div', class => 'border border-dark rounded p-2 mb-2', $course_output->join(''))); } - return $r->include( + return $c->include( 'ContentGenerator/CourseAdmin/upgrade_course_confirm', upgrade_courseIDs => \@upgrade_courseIDs, extra_database_tables_exist => $extra_database_tables_exist, @@ -1532,13 +1459,10 @@ sub upgrade_course_confirm { ); } -sub do_upgrade_course { - my $self = shift; - my $r = $self->r; +sub do_upgrade_course ($c) { + my $output = $c->c; - my $output = $r->c; - - for my $upgrade_courseID ($r->param('upgrade_courseIDs')) { + for my $upgrade_courseID ($c->param('upgrade_courseIDs')) { next unless $upgrade_courseID =~ /\S/; # Omit blank course IDs # Update one course @@ -1559,7 +1483,7 @@ sub do_upgrade_course { push( @upgrade_report, $CIchecker->updateCourseTables( - $upgrade_courseID, [@tables_to_create], [ ($r->param("$upgrade_courseID.delete_tableIDs")) ] + $upgrade_courseID, [@tables_to_create], [ ($c->param("$upgrade_courseID.delete_tableIDs")) ] ) ); for my $table_name (@tables_to_alter) { @@ -1567,7 +1491,7 @@ sub do_upgrade_course { @upgrade_report, $CIchecker->updateTableFields( $upgrade_courseID, $table_name, - [ ($r->param("$upgrade_courseID.$table_name.delete_fieldIDs")) ] + [ ($c->param("$upgrade_courseID.$table_name.delete_fieldIDs")) ] ) ); } @@ -1576,29 +1500,29 @@ sub do_upgrade_course { ($tables_ok, $dbStatus) = $CIchecker->checkCourseTables($upgrade_courseID); my ($all_tables_ok, $extra_database_tables, $extra_database_fields, $db_report) = - $self->formatReportOnDatabaseTables($tables_ok, $dbStatus); + $c->formatReportOnDatabaseTables($dbStatus); # Prepend course name - $db_report = $r->c($r->tag('div', class => 'mb-2', $r->maketext('Database:')), $db_report); + $db_report = $c->c($c->tag('div', class => 'mb-2', $c->maketext('Database:')), $db_report); # Report on databases and report summary if ($extra_database_tables) { push( @$db_report, - $r->tag( + $c->tag( 'p', class => 'text-danger fw-bold', - $r->maketext('There are extra database tables which are not defined in the schema.') + $c->maketext('There are extra database tables which are not defined in the schema.') ) ); } if ($extra_database_fields) { push( @$db_report, - $r->tag( + $c->tag( 'p', class => 'text-danger fw-bold', - $r->maketext( + $c->maketext( 'There are extra database fields which are not defined in the schema for at least one table.') ) ); @@ -1609,10 +1533,10 @@ sub do_upgrade_course { my ($directories_ok, $directory_report) = $CIchecker->checkCourseDirectories; # Show status - my $course_report = $r->c; - push(@$course_report, $r->tag('h2', $r->maketext('Report for course [_1]:', $upgrade_courseID))); + my $course_report = $c->c; + push(@$course_report, $c->tag('h2', $c->maketext('Report for course [_1]:', $upgrade_courseID))); push(@$course_report, - map { $r->tag('p', class => ($_->[1] ? 'text-success' : 'text-danger my-0') . ' fw-bold', $_->[0]) } + map { $c->tag('p', class => ($_->[1] ? 'text-success' : 'text-danger my-0') . ' fw-bold', $_->[0]) } @upgrade_report); push(@$course_report, @$db_report); @@ -1620,27 +1544,27 @@ sub do_upgrade_course { # Show report on directory status push( @$course_report, - $r->tag('div', class => 'mb-2', $r->maketext('Directory structure:')), - $r->tag( + $c->tag('div', class => 'mb-2', $c->maketext('Directory structure:')), + $c->tag( 'ul', - $r->c( + $c->c( map { - $r->tag( + $c->tag( 'li', - $r->c("$_->[0]: ", - $r->tag('span', class => $_->[2] ? 'text-success' : 'text-danger', $_->[1])) + $c->c("$_->[0]: ", + $c->tag('span', class => $_->[2] ? 'text-success' : 'text-danger', $_->[1])) ->join('') ) } @$directory_report )->join('') ), - $r->tag( + $c->tag( 'ul', - $r->c( + $c->c( map { - $r->tag( + $c->tag( 'li', - $r->tag( + $c->tag( 'span', class => $_->[2] ? 'text-success' : 'text-danger', $_->[1] @@ -1650,32 +1574,32 @@ sub do_upgrade_course { )->join('') ), $directories_ok - ? $r->tag('p', class => 'text-success mb-0', $r->maketext('Directory structure is ok')) - : $r->tag( + ? $c->tag('p', class => 'text-success mb-0', $c->maketext('Directory structure is ok')) + : $c->tag( 'p', class => 'text-danger mb-0', - $r->maketext( + $c->maketext( 'Directory structure is missing directories or the webserver lacks sufficient privileges.') ) ); - push(@$output, $r->tag('div', class => 'border border-dark rounded p-2 mb-2', $course_report->join(''))); + push(@$output, $c->tag('div', class => 'border border-dark rounded p-2 mb-2', $course_report->join(''))); } # Submit buttons -- return to beginning - push(@$output, $r->tag('h2', $r->maketext('Upgrade process completed'))); + push(@$output, $c->tag('h2', $c->maketext('Upgrade process completed'))); push( @$output, - $r->form_for( - $r->uri, + $c->form_for( + $c->current_route, method => 'POST', - $r->c( - $self->hidden_authen_fields, - $self->hidden_fields('subDisplay'), - $r->tag( + $c->c( + $c->hidden_authen_fields, + $c->hidden_fields('subDisplay'), + $c->tag( 'p', class => 'text-center', - $r->submit_button( - $r->maketext('Done'), + $c->submit_button( + $c->maketext('Done'), name => 'decline_upgrade_course', class => 'btn btn-primary' ) @@ -1689,30 +1613,26 @@ sub do_upgrade_course { # Location management routines -sub manage_location_form { - my ($self) = @_; - my $r = $self->r; - my $db = $r->db; +sub manage_location_form ($c) { + my $db = $c->db; # Get a list of all existing locations my @locations = sort { lc($a->location_id) cmp lc($b->location_id) } $db->getAllLocations(); - return $r->include( + return $c->include( 'ContentGenerator/CourseAdmin/manage_location_form', locations => \@locations, locAddr => { map { $_->location_id => [ $db->listLocationAddresses($_->location_id) ] } @locations } ); } -sub add_location_handler { - my $self = shift(); - my $r = $self->r; - my $db = $r->db; +sub add_location_handler ($c) { + my $db = $c->db; # Get the new location data. - my $locationID = $r->param('new_location_name'); - my $locationDescr = $r->param('new_location_description'); - my $locationAddr = $r->param('new_location_addresses'); + my $locationID = $c->param('new_location_name'); + my $locationDescr = $c->param('new_location_description'); + my $locationAddr = $c->param('new_location_addresses'); # Break the addresses up $locationAddr =~ s/\s*-\s*/-/g; @@ -1743,28 +1663,28 @@ sub add_location_handler { } } - my $output = $r->c; + my $output = $c->c; if (!@addresses || !$locationID || !$locationDescr) { push( @$output, - $r->tag( + $c->tag( 'div', class => 'alert alert-danger p-1 mb-2', - $r->maketext( + $c->maketext( 'Missing required input data. Please check that you have ' . 'filled in all of the create location fields and resubmit.' ) ) ); } elsif ($badAddr) { - $r->param('new_location_addresses', $locationAddr); + $c->param('new_location_addresses', $locationAddr); push( @$output, - $r->tag( + $c->tag( 'div', class => 'alert alert-danger p-1 mb-2', - $r->maketext( + $c->maketext( 'Address(es) [_1] is(are) not in a recognized form. Please check your data entry and resubmit.', $badAddr ) @@ -1773,10 +1693,10 @@ sub add_location_handler { } elsif ($db->existsLocation($locationID)) { push( @$output, - $r->tag( + $c->tag( 'div', class => 'alert alert-danger p-1 mb-2', - $r->maketext( + $c->maketext( 'A location with the name [_1] already exists in the database. ' . 'Did you mean to edit that location instead?', $locationID @@ -1786,10 +1706,10 @@ sub add_location_handler { } elsif ($badLocAddr) { push( @$output, - $r->tag( + $c->tag( 'div', { class => 'alert alert-danger p-1 mb-2' }, - $r->maketext( + $c->maketext( 'Address(es) [_1] already exist in the database. THIS SHOULD NOT HAPPEN! ' . 'Please double check the integrity of the WeBWorK database before continuing.', $badLocAddr @@ -1814,17 +1734,17 @@ sub add_location_handler { # we've added the location, so clear those param # entries - $r->param('manage_location_action', 'none'); - $r->param('new_location_name', ''); - $r->param('new_location_description', ''); - $r->param('new_location_addresses', ''); + $c->param('manage_location_action', 'none'); + $c->param('new_location_name', ''); + $c->param('new_location_description', ''); + $c->param('new_location_addresses', ''); push( @$output, - $r->tag( + $c->tag( 'div', class => 'alert alert-success p-1 mb-2', - $r->maketext( + $c->maketext( 'Location [_1] has been created, with addresses [_2].', $locationID, join(', ', @addresses) ) @@ -1832,59 +1752,57 @@ sub add_location_handler { ); } - push(@$output, $self->manage_location_form); + push(@$output, $c->manage_location_form); return $output->join(''); } -sub delete_location_handler { - my $self = shift; - my $r = $self->r; - my $db = $r->db; +sub delete_location_handler ($c) { + my $db = $c->db; # Determine which location was requested to be deleted. - my $locationID = $r->param('delete_location'); + my $locationID = $c->param('delete_location'); # Check for selected deletions if appropriate. my @delLocations = ($locationID); if ($locationID eq 'selected_locations') { - @delLocations = $r->param('delete_selected'); + @delLocations = $c->param('delete_selected'); $locationID = @delLocations; } # Has the confirmation been checked? - my $confirm = $r->param('delete_confirm'); + my $confirm = $c->param('delete_confirm'); - my $output = $r->c; + my $output = $c->c; my $badID; if (!$locationID) { push( @$output, - $r->tag( + $c->tag( 'div', class => 'alert alert-danger p-1 mb-2', - $r->maketext('Please provide a location name to delete.') + $c->maketext('Please provide a location name to delete.') ) ); - } elsif ($badID = $self->existsLocations_helper(@delLocations)) { + } elsif ($badID = $c->existsLocations_helper(@delLocations)) { push( @$output, - $r->tag( + $c->tag( 'div', class => 'alert alert-danger p-1 mb-2', - $r->maketext('No location with name [_1] exists in the database', $badID) + $c->maketext('No location with name [_1] exists in the database', $badID) ) ); } elsif (!$confirm || $confirm ne 'true') { push( @$output, - $r->tag( + $c->tag( 'div', class => 'alert alert-danger p-1 mb-2', - $r->maketext('Location deletion requires confirmation.') + $c->maketext('Location deletion requires confirmation.') ) ); } else { @@ -1893,35 +1811,32 @@ sub delete_location_handler { } push( @$output, - $r->tag( + $c->tag( 'div', class => 'alert alert-success p-1 mb-2', - $r->maketext('Deleted Location(s): [_1]', join(', ', @delLocations)) + $c->maketext('Deleted Location(s): [_1]', join(', ', @delLocations)) ) ); - $r->param('manage_location_action', 'none'); - $r->param('delete_location', ''); + $c->param('manage_location_action', 'none'); + $c->param('delete_location', ''); } - push(@$output, $self->manage_location_form); + push(@$output, $c->manage_location_form); return $output->join(''); } -sub existsLocations_helper { - my ($self, @locations) = @_; - my $db = $self->r->db; +sub existsLocations_helper ($c, @locations) { + my $db = $c->db; for (@locations) { return $_ if !$db->existsLocation($_); } return 0; } -sub edit_location_form { - my $self = shift; - my $r = $self->r; - my $db = $r->db; +sub edit_location_form ($c) { + my $db = $c->db; - my $locationID = $r->param('edit_location'); + my $locationID = $c->param('edit_location'); if ($db->existsLocation($locationID)) { my $location = $db->getLocation($locationID); # This doesn't give that nice a sort for IP addresses, because there is the problem with 192.168.1.168 sorting @@ -1929,62 +1844,60 @@ sub edit_location_form { # on dealing only with IPv4. Rather than deal with either of those, we'll leave this for now. my @locAddresses = sort { $a cmp $b } $db->listLocationAddresses($locationID); - return $r->include( + return $c->include( 'ContentGenerator/CourseAdmin/edit_location_form', location => $location, locationID => $locationID, locAddresses => \@locAddresses ); } else { - return $r->c( - $r->tag( + return $c->c( + $c->tag( 'div', class => 'alert alert-danger p-1 mb-2', - $r->maketext( + $c->maketext( 'Location [_1] does not exist in the WeBWorK database. Please check your input ' . '(perhaps you need to reload the location management page?).', $locationID ) ), - $self->manage_location_form + $c->manage_location_form )->join(''); } } -sub edit_location_handler { - my $self = shift; - my $r = $self->r; - my $db = $r->db; +sub edit_location_handler ($c) { + my $db = $c->db; - my $locationID = $r->param('edit_location'); - my $locationDesc = $r->param('location_description'); - my $addAddresses = $r->param('new_location_addresses'); - my @delAddresses = $r->param('delete_location_addresses'); - my $deleteAll = $r->param('delete_all_addresses'); + my $locationID = $c->param('edit_location'); + my $locationDesc = $c->param('location_description'); + my $addAddresses = $c->param('new_location_addresses'); + my @delAddresses = $c->param('delete_location_addresses'); + my $deleteAll = $c->param('delete_all_addresses'); # Gut check if (!$locationID) { - return $r->c( - $r->tag( + return $c->c( + $c->tag( 'div', class => 'alert alert-danger p-1 mb-2', - $r->maketext('No location specified to edit. Please check your input data.') + $c->maketext('No location specified to edit. Please check your input data.') ), - $self->manage_location_form + $c->manage_location_form )->join(''); } elsif (!$db->existsLocation($locationID)) { - return $r->c( - $r->tag( + return $c->c( + $c->tag( 'div', class => 'alert alert-danger p-1 mb-2', - $r->maketext( + $c->maketext( 'Location [_1] does not exist in the WeBWorK database. ' . 'Please check your input (perhaps you need to reload the location management page?).', $locationID ) ), - $self->manage_location_form + $c->manage_location_form )->join(''); } else { my $location = $db->getLocation($locationID); @@ -1999,7 +1912,7 @@ sub edit_location_handler { if ($locationDesc && $location->description ne $locationDesc) { $location->description($locationDesc); $db->putLocation($location); - $doneMsg = $r->tag('p', class => 'my-0', $r->maketext('Updated location description.')); + $doneMsg = $c->tag('p', class => 'my-0', $c->maketext('Updated location description.')); } # Get the addresses to add out of the text field. @@ -2051,31 +1964,31 @@ sub edit_location_handler { $db->addLocationAddress($locAddr); } - my $addrMsg = $r->c; + my $addrMsg = $c->c; push( @$addrMsg, - $r->tag( + $c->tag( 'p', class => 'my-0', - $r->maketext('Deleted addresses [_1] from location.', join(', ', @toDel)) + $c->maketext('Deleted addresses [_1] from location.', join(', ', @toDel)) ) ) if @toDel; push( @$addrMsg, - $r->tag( + $c->tag( 'p', class => 'my-0', - $r->maketext('Added addresses [_1] to location [_2].', join(', ', @toAdd), $locationID) + $c->maketext('Added addresses [_1] to location [_2].', join(', ', @toAdd), $locationID) ) ) if @toAdd; - my $badMsg = $r->c; + my $badMsg = $c->c; push( @$badMsg, - $r->tag( + $c->tag( 'p', class => 'my-0', - $r->maketext( + $c->maketext( 'Address(es) [_1] in the add list is(are) already in the location [_2], and so were skipped.', join(', ', @noAdd), $locationID ) @@ -2083,10 +1996,10 @@ sub edit_location_handler { ) if @noAdd; push( @$badMsg, - $r->tag( + $c->tag( 'p', class => 'my-0', - $r->maketext( + $c->maketext( 'Address(es) [_1] is(are) not in a recognized form. Please check your data entry and try again.', $badAddr ) @@ -2094,47 +2007,45 @@ sub edit_location_handler { ) if $badAddr; push( @$badMsg, - $r->tag( + $c->tag( 'p', class => 'my-0', - $r->maketext( + $c->maketext( 'Address(es) [_1] in the delete list is(are) not in the location [_2], and so were skipped.', join(', ', @noDel), $locationID ) ) ) if @noDel; - my $output = $r->c; - push(@$output, $r->tag('div', class => 'alert alert-danger p-1 mb-2', $badMsg->join(''))) + my $output = $c->c; + push(@$output, $c->tag('div', class => 'alert alert-danger p-1 mb-2', $badMsg->join(''))) if @$badMsg; if ($doneMsg || @$addrMsg) { push( @$output, - $r->tag( + $c->tag( 'div', class => 'alert alert-success p-1 mb-2', - $r->c($doneMsg, @$addrMsg)->join('') + $c->c($doneMsg, @$addrMsg)->join('') ) ); } else { push( @$output, - $r->tag( + $c->tag( 'div', class => 'alert alert-danger p-1 mb-2', - $r->maketext('No valid changes submitted for location [_1].', $locationID) + $c->maketext('No valid changes submitted for location [_1].', $locationID) ) ); } - push(@$output, $self->edit_location_form); + push(@$output, $c->edit_location_form); return $output->join(''); } } -sub hide_inactive_course_form { - my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; +sub hide_inactive_course_form ($c) { + my $ce = $c->ce; my @courseIDs = listCourses($ce); @@ -2153,14 +2064,14 @@ sub hide_inactive_course_form { push(@noLoginLogIDs, $courseID); } if (-f "$ce->{webworkDirs}{courses}/$courseID/hide_directory") { - $coursesData{$courseID}{status} = $r->maketext('hidden'); + $coursesData{$courseID}{status} = $c->maketext('hidden'); } else { - $coursesData{$courseID}{status} = $r->maketext('visible'); + $coursesData{$courseID}{status} = $c->maketext('visible'); } $courseLabels{$courseID} = "$courseID ($coursesData{$courseID}{status} :: $coursesData{$courseID}{local_modify_time})"; } - if (($r->param('hide_listing_format') // 'alphabetically') eq 'last_login') { + if (($c->param('hide_listing_format') // 'alphabetically') eq 'last_login') { # This should be an empty array except for the model course. @noLoginLogIDs = sort { lc($a) cmp lc($b) } @noLoginLogIDs; @loginLogIDs = sort { $coursesData{$a}{epoch_modify_time} <=> $coursesData{$b}{epoch_modify_time} } @@ -2171,36 +2082,32 @@ sub hide_inactive_course_form { @hideCourseIDs = sort { lc($a) cmp lc($b) } @courseIDs; } - return $r->include( + return $c->include( 'ContentGenerator/CourseAdmin/hide_inactive_course_form', hideCourseIDs => \@hideCourseIDs, courseLabels => \%courseLabels ); } -sub hide_course_validate { - my ($self) = @_; - my $r = $self->r; - return $r->maketext('You must specify a course name.') unless $r->param('hide_courseIDs'); +sub hide_course_validate ($c) { + return $c->maketext('You must specify a course name.') unless $c->param('hide_courseIDs'); return; } -sub do_hide_inactive_course { - my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; +sub do_hide_inactive_course ($c) { + my $ce = $c->ce; my (@succeeded_courses, @failed_courses); my $already_hidden_count = 0; - for my $hide_courseID ($r->param('hide_courseIDs')) { + for my $hide_courseID ($c->param('hide_courseIDs')) { my $hideDirFile = "$ce->{webworkDirs}{courses}/$hide_courseID/hide_directory"; if (-f $hideDirFile) { ++$already_hidden_count; next; } if (open(my $HIDEFILE, '>', $hideDirFile)) { - print $HIDEFILE $r->maketext( + print $HIDEFILE $c->maketext( 'Place a file named "hide_directory" in a course or other directory and it will not show up ' . 'in the courses list on the WeBWorK home page. It will still appear in the ' . 'Course Administration listing.'); @@ -2211,25 +2118,25 @@ sub do_hide_inactive_course { } } - my $output = $r->c; + my $output = $c->c; if (@failed_courses) { push( @$output, - $r->tag( + $c->tag( 'div', class => 'alert alert-danger p-1 mb-2', - $r->c( - $r->tag( + $c->c( + $c->tag( 'p', - $r->maketext( + $c->maketext( 'Errors occured while hiding the courses listed below when attempting to create the ' . q{file hide_directory in the course's directory. Check the ownership and permissions } . q{of the course's directory, e.g "[_1]".}, "$ce->{webworkDirs}{courses}/$failed_courses[0]/" ) ), - $r->tag('ul', $r->c(map { $r->tag('li', $_) } @failed_courses)->join('')) + $c->tag('ul', $c->c(map { $c->tag('li', $_) } @failed_courses)->join('')) )->join('') ) ); @@ -2240,38 +2147,34 @@ sub do_hide_inactive_course { if (!@succeeded_courses && $already_hidden_count) { if (@failed_courses) { $succeeded_message = - $r->maketext('Except for the errors listed above, all selected courses are already hidden.'); + $c->maketext('Except for the errors listed above, all selected courses are already hidden.'); } else { - $succeeded_message = $r->maketext('All selected courses are already hidden.'); + $succeeded_message = $c->maketext('All selected courses are already hidden.'); } } elsif (@succeeded_courses) { - $succeeded_message = $r->c( - $r->tag('p', $r->maketext('The following courses were successfully hidden:')), - $r->tag('ul', $r->c(map { $r->tag('li', $_) } @succeeded_courses)->join('')) + $succeeded_message = $c->c( + $c->tag('p', $c->maketext('The following courses were successfully hidden:')), + $c->tag('ul', $c->c(map { $c->tag('li', $_) } @succeeded_courses)->join('')) )->join(''); } - push(@$output, $r->tag('div', class => 'alert alert-success p-1 mb-2', $succeeded_message)) if ($succeeded_message); + push(@$output, $c->tag('div', class => 'alert alert-success p-1 mb-2', $succeeded_message)) if ($succeeded_message); return $output->join(''); } -sub unhide_course_validate { - my ($self) = @_; - my $r = $self->r; - return $r->maketext('You must specify a course name.') unless $r->param('hide_courseIDs'); +sub unhide_course_validate ($c) { + return $c->maketext('You must specify a course name.') unless $c->param('hide_courseIDs'); return; } -sub do_unhide_inactive_course { - my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; +sub do_unhide_inactive_course ($c) { + my $ce = $c->ce; my (@succeeded_courses, @failed_courses); my $already_visible_count = 0; - for my $unhide_courseID ($r->param('hide_courseIDs')) { + for my $unhide_courseID ($c->param('hide_courseIDs')) { my $hideDirFile = "$ce->{webworkDirs}{courses}/$unhide_courseID/hide_directory"; unless (-f $hideDirFile) { ++$already_visible_count; @@ -2284,25 +2187,25 @@ sub do_unhide_inactive_course { } } - my $output = $r->c; + my $output = $c->c; if (@failed_courses) { push( @$output, - $r->tag( + $c->tag( 'div', class => 'alert alert-danger p-1 mb-2', - $r->c( - $r->tag( + $c->c( + $c->tag( 'p', - $r->maketext( + $c->maketext( 'Errors occured while unhiding the courses listed below when attempting delete the file ' . q{hide_directory in the course's directory. Check the ownership and permissions of } . q{the course's directory, e.g "[_1]".}, "$ce->{webworkDirs}{courses}/$failed_courses[0]/" ) ), - $r->tag('ul', $r->c(map { $r->tag('li', $_) } @failed_courses)->join('')) + $c->tag('ul', $c->c(map { $c->tag('li', $_) } @failed_courses)->join('')) )->join('') ) ); @@ -2313,47 +2216,45 @@ sub do_unhide_inactive_course { if (!@succeeded_courses && $already_visible_count) { if (@failed_courses) { $succeeded_message = - $r->maketext('Except for the errors listed above, all selected courses are already unhidden.'); + $c->maketext('Except for the errors listed above, all selected courses are already unhidden.'); } else { - $succeeded_message = $r->maketext('All selected courses are already unhidden.'); + $succeeded_message = $c->maketext('All selected courses are already unhidden.'); } } elsif (@succeeded_courses) { - $succeeded_message = $r->c( - $r->tag('p', $r->maketext('The following courses were successfully unhidden:')), - $r->tag('ul', $r->c(map { $r->tag('li', $_) } @succeeded_courses)->join('')) + $succeeded_message = $c->c( + $c->tag('p', $c->maketext('The following courses were successfully unhidden:')), + $c->tag('ul', $c->c(map { $c->tag('li', $_) } @succeeded_courses)->join('')) )->join(''); } if ($succeeded_message) { - push(@$output, $r->tag('div', class => 'alert alert-success p-1 mb-2', $succeeded_message)); + push(@$output, $c->tag('div', class => 'alert alert-success p-1 mb-2', $succeeded_message)); } return $output->join(''); } -sub do_registration { - my $self = shift; - my $r = $self->r; - my $ce = $r->ce; +sub do_registration ($c) { + my $ce = $c->ce; `echo "info" > $ce->{courseDirs}{root}/registered_$ce->{WW_VERSION}`; - return $r->tag( + return $c->tag( 'div', class => 'mt-2 mx-auto w-50 text-center', - $r->c( - $r->tag( + $c->c( + $c->tag( 'p', 'Registration banner has been hidden. ' . 'We appreciate your registering your server with the WeBWorK Project!' ), - $r->form_for( - $r->uri, + $c->form_for( + $c->current_route, method => 'POST', - $r->c( - $self->hidden_authen_fields, - $r->submit_button( - $r->maketext('Continue'), + $c->c( + $c->hidden_authen_fields, + $c->submit_button( + $c->maketext('Continue'), name => 'registration_completed', label => 'Continue', class => 'btn btn-primary' @@ -2365,40 +2266,37 @@ sub do_registration { } # Format a list of tables and fields in the database, and the status of each. -sub formatReportOnDatabaseTables { - my ($self, $tables_ok, $dbStatus, $courseID) = @_; - my $r = $self->r; - +sub formatReportOnDatabaseTables ($c, $dbStatus, $courseID = undef) { my %table_status_message = ( WeBWorK::Utils::CourseIntegrityCheck::SAME_IN_A_AND_B => - $r->tag('span', class => 'text-success me-2', $r->maketext('Table is ok')), - WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_A => $r->tag( + $c->tag('span', class => 'text-success me-2', $c->maketext('Table is ok')), + WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_A => $c->tag( 'span', class => 'text-danger me-2', - $r->maketext('Table defined in schema but missing in database') + $c->maketext('Table defined in schema but missing in database') ), - WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_B => $r->tag( + WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_B => $c->tag( 'span', class => 'text-danger me-2', - $r->maketext('Table defined in database but missing in schema') + $c->maketext('Table defined in database but missing in schema') ), - WeBWorK::Utils::CourseIntegrityCheck::DIFFER_IN_A_AND_B => $r->tag( + WeBWorK::Utils::CourseIntegrityCheck::DIFFER_IN_A_AND_B => $c->tag( 'span', class => 'text-danger me-2', - $r->maketext('Schema and database table definitions do not agree') + $c->maketext('Schema and database table definitions do not agree') ) ); my %field_status_message = ( WeBWorK::Utils::CourseIntegrityCheck::SAME_IN_A_AND_B => - $r->tag('span', class => 'text-success me-2', $r->maketext('Field is ok')), + $c->tag('span', class => 'text-success me-2', $c->maketext('Field is ok')), WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_A => - $r->tag('span', class => 'text-danger me-2', $r->maketext('Field missing in database')), + $c->tag('span', class => 'text-danger me-2', $c->maketext('Field missing in database')), WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_B => - $r->tag('span', class => 'text-danger me-2', $r->maketext('Field missing in schema')), - WeBWorK::Utils::CourseIntegrityCheck::DIFFER_IN_A_AND_B => $r->tag( + $c->tag('span', class => 'text-danger me-2', $c->maketext('Field missing in schema')), + WeBWorK::Utils::CourseIntegrityCheck::DIFFER_IN_A_AND_B => $c->tag( 'span', class => 'text-danger me-2', - $r->maketext('Schema and database field definitions do not agree') + $c->maketext('Schema and database field definitions do not agree') ) ); @@ -2406,10 +2304,10 @@ sub formatReportOnDatabaseTables { my $extra_database_tables = 0; my $extra_database_fields = 0; - my $db_report = $r->c; + my $db_report = $c->c; for my $table (sort keys %$dbStatus) { - my $table_report = $r->c; + my $table_report = $c->c; my $table_status = $dbStatus->{$table}[0]; push(@$table_report, $table . ': ', $table_status_message{$table_status}); @@ -2420,41 +2318,41 @@ sub formatReportOnDatabaseTables { $extra_database_tables = 1; push( @$table_report, - $r->tag( + $c->tag( 'span', class => 'form-check d-inline-block', - $r->tag( + $c->tag( 'label', class => 'form-check-label', - $r->c($r->check_box("$courseID.delete_tableIDs" => $table, class => 'form-check-input'), - $r->maketext('Delete table when upgrading'))->join('') + $c->c($c->check_box("$courseID.delete_tableIDs" => $table, class => 'form-check-input'), + $c->maketext('Delete table when upgrading'))->join('') ) ) ) if defined $courseID; } elsif ($table_status == WeBWorK::Utils::CourseIntegrityCheck::DIFFER_IN_A_AND_B) { my %fieldInfo = %{ $dbStatus->{$table}[1] }; - my $fields_report = $r->c; + my $fields_report = $c->c; for my $key (keys %fieldInfo) { my $field_status = $fieldInfo{$key}[0]; - my $field_report = $r->c("$key: $field_status_message{$field_status}"); + my $field_report = $c->c("$key: $field_status_message{$field_status}"); if ($field_status == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_B) { $extra_database_fields = 1; push( @$field_report, - $r->tag( + $c->tag( 'span', class => 'form-check d-inline-block', - $r->tag( + $c->tag( 'label', class => 'form-check-label', - $r->c( - $r->check_box( + $c->c( + $c->check_box( "$courseID.$table.delete_fieldIDs" => $key, class => 'form-check-input' ), - $r->maketext('Delete field when upgrading') + $c->maketext('Delete field when upgrading') )->join('') ) ) @@ -2462,16 +2360,16 @@ sub formatReportOnDatabaseTables { } elsif ($field_status == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_A) { $all_tables_ok = 0; } - push(@$fields_report, $r->tag('li', $field_report->join(''))); + push(@$fields_report, $c->tag('li', $field_report->join(''))); } - push(@$table_report, $r->tag('ul', $fields_report->join(''))); + push(@$table_report, $c->tag('ul', $fields_report->join(''))); } - push(@$db_report, $r->tag('li', $table_report->join(''))); + push(@$db_report, $c->tag('li', $table_report->join(''))); } - $db_report = $r->c($r->tag('ul', $db_report->join(''))); + $db_report = $c->c($c->tag('ul', $db_report->join(''))); - push(@$db_report, $r->tag('p', class => 'text-success', $r->maketext('Database tables are ok'))) if $all_tables_ok; + push(@$db_report, $c->tag('p', class => 'text-success', $c->maketext('Database tables are ok'))) if $all_tables_ok; return ($all_tables_ok, $extra_database_tables, $extra_database_fields, $db_report->join('')); } diff --git a/lib/WeBWorK/ContentGenerator/EquationDisplay.pm b/lib/WeBWorK/ContentGenerator/EquationDisplay.pm index 2fff98f81b..91bd71dbbd 100644 --- a/lib/WeBWorK/ContentGenerator/EquationDisplay.pm +++ b/lib/WeBWorK/ContentGenerator/EquationDisplay.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::EquationDisplay; -use parent qw(WeBWorK::ContentGenerator); +use Mojo::Base 'WeBWorK::ContentGenerator', -signatures; =head1 NAME @@ -22,14 +22,10 @@ WeBWorK::ContentGenerator::EquationDisplay -- create .png version of TeX equatio =cut -use strict; -use warnings; - use WeBWorK::PG::ImageGenerator; -sub display_equation { - my ($self, $str) = @_; - my $ce = $self->r->ce; +sub display_equation ($c, $str) { + my $ce = $c->ce; my $image_gen = WeBWorK::PG::ImageGenerator->new( tempDir => $ce->{webworkDirs}{tmp}, @@ -49,20 +45,17 @@ sub display_equation { return $imageTag; } -sub initialize { - my ($self) = @_; - my $r = $self->r; - - my $equationStr = $r->param('eq') // ''; +sub initialize ($c) { + my $equationStr = $c->param('eq') // ''; # Prepare to display the typeset image and the HTML code that links to the source image. The HTML code is linked # also to the image address This requires digging out the link from the string returned by display_equation and # ImageGenerator. The server name and port are included in the new url. - $r->stash->{typesetStr} = $equationStr ? $self->display_equation($equationStr) : ''; + $c->stash->{typesetStr} = $equationStr ? $c->display_equation($equationStr) : ''; # Add the host name to the string. - my $hostName = $r->req->url->to_abs->host_port; - $r->stash->{typesetStr} =~ s|src="|src="http://$hostName|; + my $hostName = $c->req->url->to_abs->host_port; + $c->stash->{typesetStr} =~ s|src="|src="http://$hostName|; return; } diff --git a/lib/WeBWorK/ContentGenerator/Feedback.pm b/lib/WeBWorK/ContentGenerator/Feedback.pm index f0bd6e4c6c..1da6b6a3fd 100644 --- a/lib/WeBWorK/ContentGenerator/Feedback.pm +++ b/lib/WeBWorK/ContentGenerator/Feedback.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::Feedback; -use parent qw(WeBWorK::ContentGenerator); +use Mojo::Base 'WeBWorK::ContentGenerator', -signatures; =head1 NAME @@ -22,10 +22,6 @@ WeBWorK::ContentGenerator::Feedback - Send mail to professors. =cut -use strict; -use warnings; -use utf8; - use Data::Dumper; use Email::Stuffer; use Try::Tiny; @@ -38,7 +34,7 @@ use WeBWorK::Utils qw/decodeAnswers/; # # user # key -# module +# route # set (if from ProblemSet or Problem) # problem (if from Problem) # displayMode (if from Problem) @@ -52,31 +48,29 @@ use WeBWorK::Utils qw/decodeAnswers/; # user object for current user # permission level of current user # current session key -# which ContentGenerator module called Feedback? +# which ContentGenerator route called Feedback? # set object for current set (if from ProblemSet or Problem) # problem object for current problem (if from Problem) # display options (if from Problem) -sub initialize { - my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; - my $db = $r->db; - my $authz = $r->authz; +sub initialize ($c) { + my $ce = $c->ce; + my $db = $c->db; + my $authz = $c->authz; # get form fields - my $userID = $r->param('user'); - my $module = $r->param('module'); - my $setID = $r->param('set'); - my $problemID = $r->param('problem'); - my $from = $r->param('from'); - my $feedback = $r->param('feedback'); - my $courseID = $r->urlpath->arg('courseID'); + my $userID = $c->param('user'); + my $route = $c->param('route'); + my $setID = $c->param('set'); + my $problemID = $c->param('problem'); + my $from = $c->param('from'); + my $feedback = $c->param('feedback'); + my $courseID = $c->stash('courseID'); my ($user, $set, $problem); $user = $db->getUser($userID) if $userID; - $r->stash->{user_email_address} = $user ? $user->email_address : ''; + $c->stash->{user_email_address} = $user ? $user->email_address : ''; if (defined $user) { $set = $db->getMergedSet($userID, $setID) if defined $setID && $setID ne ''; @@ -89,17 +83,17 @@ sub initialize { } # Generate context URLs. - (my $emailableURL, $r->stash->{returnURL}) = $self->generateURLs(set_id => $setID, problem_id => $problemID); + (my $emailableURL, $c->stash->{returnURL}) = $c->generateURLs(set_id => $setID, problem_id => $problemID); return unless $authz->hasPermissions($userID, 'submit_feedback'); # Determine the recipients of the email. - my @recipients = $self->getFeedbackRecipients($user); - $r->stash->{numRecipients} = scalar @recipients; + my @recipients = $c->getFeedbackRecipients($user); + $c->stash->{numRecipients} = scalar @recipients; - return unless $r->stash->{numRecipients}; + return unless $c->stash->{numRecipients}; - if (defined $r->param('sendFeedback')) { + if (defined $c->param('sendFeedback')) { # Get verbosity level. my $verbosity = $ce->{mail}{feedbackVerbosity}; @@ -120,11 +114,11 @@ sub initialize { } unless ($sender) { - $r->stash->{send_error} = $r->maketext('No Sender specified.'); + $c->stash->{send_error} = $c->maketext('No Sender specified.'); return; } unless ($feedback) { - $r->stash->{send_error} = $r->maketext('Message was blank.'); + $c->stash->{send_error} = $c->maketext('Message was blank.'); return; } @@ -142,14 +136,10 @@ sub initialize { $subject =~ s/%([$chars])/defined $subject_map{$1} ? $subject_map{$1} : ''/eg; # Get info about remote user. - my $remote_host = $r->useragent_ip || 'UNKNOWN'; - my $remote_port = $r->remote_port || 'UNKNOWN'; + my $remote_host = $c->tx->remote_address || 'UNKNOWN'; + my $remote_port = $c->tx->remote_port || 'UNKNOWN'; - my $systemURL = $self->systemLink( - $r->urlpath->newFromModule("WeBWorK::ContentGenerator::Home", $r), - authen => 0, - use_abs_url => 1 - ); + my $systemURL = $c->url_for('root')->to_abs; my $msg = qq/This message was automatically generated by the WeBWorK system at $systemURL, in response to a request from $remote_host:$remote_port. @@ -166,28 +156,28 @@ $emailableURL $msg .= qq/***** Data about the problem processor: ***** \n\n/ . 'Display Mode: ' - . $r->param('displayMode') . "\n" + . $c->param('displayMode') . "\n" . 'Show Old Answers: ' - . ($r->param('showOldAnswers') ? 'yes' : 'no') . "\n" + . ($c->param('showOldAnswers') ? 'yes' : 'no') . "\n" . 'Show Correct Answers: ' - . ($r->param('showCorrectAnswers') ? 'yes' : 'no') . "\n" + . ($c->param('showCorrectAnswers') ? 'yes' : 'no') . "\n" . 'Show Hints: ' - . ($r->param('showHints') ? 'yes' : 'no') . "\n" + . ($c->param('showHints') ? 'yes' : 'no') . "\n" . 'Show Solutions: ' - . ($r->param('showSolutions') ? 'yes' : 'no') . "\n\n"; + . ($c->param('showSolutions') ? 'yes' : 'no') . "\n\n"; } if ($user && $verbosity >= 1) { $msg .= "***** Data about the user: *****\n\n"; - $msg .= $self->format_user($user) . "\n"; + $msg .= $c->format_user($user) . "\n"; } if ($problem && $verbosity >= 1) { $msg .= "***** Data about the problem: *****\n\n"; - $msg .= $self->format_userproblem($problem) . "\n"; + $msg .= $c->format_userproblem($problem) . "\n"; } if ($set && $verbosity >= 1) { - $msg .= "***** Data about the homework set: *****\n\n" . $self->format_userset($set) . "\n"; + $msg .= "***** Data about the homework set: *****\n\n" . $c->format_userset($set) . "\n"; } if ($ce && $verbosity >= 2) { $msg .= "***** Data about the environment: *****\n\n" . Dumper($ce) . "\n\n"; @@ -198,7 +188,7 @@ $emailableURL ->header('X-Remote-Host' => $remote_host); # Extra headers - $email->header('X-WeBWorK-Module', $module) if defined $module; + $email->header('X-WeBWorK-Route', $route) if defined $route; $email->header('X-WeBWorK-Course', $courseID) if defined $courseID; if ($user) { $email->header('X-WeBWorK-User', $user->user_id); @@ -209,7 +199,7 @@ $emailableURL $email->header('X-WeBWorK-Problem', $problem->problem_id) if $problem; # Add the attachment if one was provided. - my $fileIDhash = $r->param('attachment'); + my $fileIDhash = $c->param('attachment'); if ($fileIDhash) { my $attachment = WeBWorK::Upload->retrieve(split(/\s+/, $fileIDhash), dir => $ce->{webworkDirs}{uploadCache}); @@ -227,16 +217,16 @@ $emailableURL # Check to see that this is an allowed filetype. unless (lc($filename =~ s/.*\.//r) =~ /^(jpe?g|gif|png|pdf|zip|txt|csv)$/) { - $r->stash->{send_error} = - $r->maketext('The filetype of the attached file "[_1]" is not allowed.', $filename); + $c->stash->{send_error} = + $c->maketext('The filetype of the attached file "[_1]" is not allowed.', $filename); return; } # Check to see that the attached file does not exceed the allowed size. if (length($contents) > $ce->{mail}{maxAttachmentSize} * 1000000) { - $r->stash->{send_error} = - $r->maketext('The attached file "[_1]" exceeds the allowed attachment size of [quant,_2,megabyte].', + $c->stash->{send_error} = + $c->maketext('The attached file "[_1]" exceeds the allowed attachment size of [quant,_2,megabyte].', $filename, $ce->{mail}{maxAttachmentSize}); return; } @@ -256,28 +246,25 @@ $emailableURL try { $email->send_or_die({ # createEmailSenderTransportSMTP is defined in ContentGenerator - transport => $self->createEmailSenderTransportSMTP(), + transport => $c->createEmailSenderTransportSMTP(), $ce->{mail}{set_return_path} ? (from => $ce->{mail}{set_return_path}) : () }); } catch { - $r->stash->{send_error} = $r->maketext('Failed to send message: [_1]', $_); + $c->stash->{send_error} = $c->maketext('Failed to send message: [_1]', $_); }; } return; } -sub title { - my ($self) = @_; - my $r = $self->r; - return $r->ce->{feedback_button_name} || $r->maketext('E-mail Instructor'); +sub page_title ($c) { + return $c->ce->{feedback_button_name} || $c->maketext('E-mail Instructor'); } -sub getFeedbackRecipients { - my ($self, $user) = @_; - my $ce = $self->r->ce; - my $db = $self->r->db; - my $authz = $self->r->authz; +sub getFeedbackRecipients ($c, $user) { + my $ce = $c->ce; + my $db = $c->db; + my $authz = $c->authz; my @recipients; @@ -304,72 +291,69 @@ sub getFeedbackRecipients { return @recipients; } -sub format_user { - my ($self, $User) = @_; - my $ce = $self->r->ce; +sub format_user ($c, $user) { + my $ce = $c->ce; - my $result = "User ID: " . $User->user_id . "\n"; - $result .= "Name: " . $User->full_name . "\n"; - $result .= "Email: " . $User->email_address . "\n"; + my $result = "User ID: " . $user->user_id . "\n"; + $result .= "Name: " . $user->full_name . "\n"; + $result .= "Email: " . $user->email_address . "\n"; unless ($ce->{blockStudentIDinFeedback}) { - $result .= "Student ID: " . $User->student_id . "\n"; + $result .= "Student ID: " . $user->student_id . "\n"; } - my $status_name = $ce->status_abbrev_to_name($User->status); + my $status_name = $ce->status_abbrev_to_name($user->status); my $status_string = defined $status_name - ? "$status_name ('" . $User->status . "')" - : $User->status . " (unknown status abbreviation)"; + ? "$status_name ('" . $user->status . "')" + : $user->status . " (unknown status abbreviation)"; $result .= "Status: $status_string\n"; - $result .= "Section: " . $User->section . "\n"; - $result .= "Recitation: " . $User->recitation . "\n"; - $result .= "Comment: " . $User->comment . "\n"; + $result .= "Section: " . $user->section . "\n"; + $result .= "Recitation: " . $user->recitation . "\n"; + $result .= "Comment: " . $user->comment . "\n"; return $result; } -sub format_userset { - my ($self, $Set) = @_; - my $ce = $self->r->ce; +sub format_userset ($c, $set) { + my $ce = $c->ce; - my $result = "Set ID: " . $Set->set_id . "\n"; - $result .= "Set header file: " . $Set->set_header . "\n"; - $result .= "Hardcopy header file: " . $Set->hardcopy_header . "\n"; + my $result = "Set ID: " . $set->set_id . "\n"; + $result .= "Set header file: " . $set->set_header . "\n"; + $result .= "Hardcopy header file: " . $set->hardcopy_header . "\n"; my $tz = $ce->{siteDefaults}{timezone}; - $result .= "Open date: " . $self->formatDateTime($Set->open_date, $tz) . "\n"; - $result .= "Due date: " . $self->formatDateTime($Set->due_date, $tz) . "\n"; - $result .= "Answer date: " . $self->formatDateTime($Set->answer_date, $tz) . "\n"; - $result .= "Visible: " . ($Set->visible ? "yes" : "no") . "\n"; - $result .= "Assignment type: " . $Set->assignment_type . "\n"; - if ($Set->assignment_type =~ /gateway/) { - $result .= "Attempts per version: " . $Set->assignment_type . "\n"; - $result .= "Time interval: " . $Set->time_interval . "\n"; - $result .= "Versions per interval: " . $Set->versions_per_interval . "\n"; - $result .= "Version time limit: " . $Set->version_time_limit . "\n"; - $result .= "Version creation time: " . $self->formatDateTime($Set->version_creation_time, $tz) . "\n"; - $result .= "Problem randorder: " . $Set->problem_randorder . "\n"; - $result .= "Version last attempt time: " . $Set->version_last_attempt_time . "\n"; + $result .= "Open date: " . $c->formatDateTime($set->open_date, $tz) . "\n"; + $result .= "Due date: " . $c->formatDateTime($set->due_date, $tz) . "\n"; + $result .= "Answer date: " . $c->formatDateTime($set->answer_date, $tz) . "\n"; + $result .= "Visible: " . ($set->visible ? "yes" : "no") . "\n"; + $result .= "Assignment type: " . $set->assignment_type . "\n"; + if ($set->assignment_type =~ /gateway/) { + $result .= "Attempts per version: " . $set->assignment_type . "\n"; + $result .= "Time interval: " . $set->time_interval . "\n"; + $result .= "Versions per interval: " . $set->versions_per_interval . "\n"; + $result .= "Version time limit: " . $set->version_time_limit . "\n"; + $result .= "Version creation time: " . $c->formatDateTime($set->version_creation_time, $tz) . "\n"; + $result .= "Problem randorder: " . $set->problem_randorder . "\n"; + $result .= "Version last attempt time: " . $set->version_last_attempt_time . "\n"; } return $result; } -sub format_userproblem { - my ($self, $Problem) = @_; - my $ce = $self->r->ce; +sub format_userproblem ($c, $problem) { + my $ce = $c->ce; - my $result = "Problem ID: " . $Problem->problem_id . "\n"; - $result .= "Source file: " . $Problem->source_file . "\n"; - $result .= "Value: " . $Problem->value . "\n"; + my $result = "Problem ID: " . $problem->problem_id . "\n"; + $result .= "Source file: " . $problem->source_file . "\n"; + $result .= "Value: " . $problem->value . "\n"; $result .= - "Max attempts " . ($Problem->max_attempts == -1 ? "unlimited" : $Problem->max_attempts) . "\n"; - $result .= "Random seed: " . $Problem->problem_seed . "\n"; - $result .= "Status: " . $Problem->status . "\n"; - $result .= "Attempted: " . ($Problem->attempted ? "yes" : "no") . "\n"; + "Max attempts " . ($problem->max_attempts == -1 ? "unlimited" : $problem->max_attempts) . "\n"; + $result .= "Random seed: " . $problem->problem_seed . "\n"; + $result .= "Status: " . $problem->status . "\n"; + $result .= "Attempted: " . ($problem->attempted ? "yes" : "no") . "\n"; - my %last_answer = decodeAnswers($Problem->last_answer); + my %last_answer = decodeAnswers($problem->last_answer); if (%last_answer) { $result .= "Last answer:\n"; foreach my $key (sort keys %last_answer) { @@ -379,8 +363,8 @@ sub format_userproblem { $result .= "Last answer: none\n"; } - $result .= "Number of correct attempts: " . $Problem->num_correct . "\n"; - $result .= "Number of incorrect attempts: " . $Problem->num_incorrect . "\n"; + $result .= "Number of correct attempts: " . $problem->num_correct . "\n"; + $result .= "Number of incorrect attempts: " . $problem->num_incorrect . "\n"; return $result; } diff --git a/lib/WeBWorK/ContentGenerator/GatewayQuiz.pm b/lib/WeBWorK/ContentGenerator/GatewayQuiz.pm index 46e3c84798..943af8ac76 100644 --- a/lib/WeBWorK/ContentGenerator/GatewayQuiz.pm +++ b/lib/WeBWorK/ContentGenerator/GatewayQuiz.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::GatewayQuiz; -use parent qw(WeBWorK::ContentGenerator); +use Mojo::Base 'WeBWorK::ContentGenerator', -signatures, -async_await; =head1 NAME @@ -23,10 +23,6 @@ deal with versioning sets =cut -use strict; -use warnings; - -use Future::AsyncAwait; use Mojo::Promise; use WeBWorK::Form; @@ -47,40 +43,37 @@ use Caliper::Sensor; use Caliper::Entity; # Disable links for gateway tests. -sub can { - my ($self, $arg) = @_; - return $arg eq 'links' ? 0 : $self->SUPER::can($arg); +sub can ($c, $arg) { + return $arg eq 'links' ? 0 : $c->SUPER::can($arg); } # "can" methods # Subroutines to determine if a user "can" perform an action. Each subroutine is # called with the following arguments: -# ($self, $user, $effectiveUser, $set, $problem, $tmplSet) +# ($c, $user, $permissionLevel, $effectiveUser, $set, $problem, $tmplSet) # In addition can_recordAnswers and can_checkAnswers have the argument $submitAnswers # that is used to distinguish between this submission and the next. -sub can_showOldAnswers { - my ($self, $user, $permissionLevel, $effectiveUser, $set, $problem, $tmplSet) = @_; - my $authz = $self->r->authz; +sub can_showOldAnswers ($c, $user, $permissionLevel, $effectiveUser, $set, $problem, $tmplSet) { + my $authz = $c->authz; return 0 unless $authz->hasPermissions($user->user_id, 'can_show_old_answers'); return ( - before($set->due_date, $self->r->submitTime) + before($set->due_date, $c->submitTime) || $authz->hasPermissions($user->user_id, 'view_hidden_work') || ($set->hide_work eq 'N' - || ($set->hide_work eq 'BeforeAnswerDate' && after($tmplSet->answer_date, $self->r->submitTime))) + || ($set->hide_work eq 'BeforeAnswerDate' && after($tmplSet->answer_date, $c->submitTime))) ); } -sub can_showCorrectAnswers { - my ($self, $user, $permissionLevel, $effectiveUser, $set, $problem, $tmplSet) = @_; - my $authz = $self->r->authz; +sub can_showCorrectAnswers ($c, $user, $permissionLevel, $effectiveUser, $set, $problem, $tmplSet) { + my $authz = $c->authz; # Allow correct answers to be viewed after all attempts at a version # are exhausted or if it is after the answer date. my $attemptsPerVersion = $set->attempts_per_version || 0; - my $attemptsUsed = $problem->num_correct + $problem->num_incorrect + ($self->{submitAnswers} ? 1 : 0); + my $attemptsUsed = $problem->num_correct + $problem->num_incorrect + ($c->{submitAnswers} ? 1 : 0); # This is complicated by trying to address hiding scores by problem. That is, if $set->hide_score_by_problem and # $set->hide_score are both set, then we should allow scores to be shown, but not show the score on any individual @@ -89,7 +82,7 @@ sub can_showCorrectAnswers { return ( ( ( - after($set->answer_date, $self->r->submitTime) || ($attemptsUsed >= $attemptsPerVersion + after($set->answer_date, $c->submitTime) || ($attemptsUsed >= $attemptsPerVersion && $attemptsPerVersion != 0 && $set->due_date == $set->answer_date) ) @@ -98,40 +91,36 @@ sub can_showCorrectAnswers { && ( $authz->hasPermissions($user->user_id, 'view_hidden_work') || $set->hide_score_by_problem eq 'N' && ($set->hide_score eq 'N' - || ($set->hide_score eq 'BeforeAnswerDate' && after($tmplSet->answer_date, $self->r->submitTime))) + || ($set->hide_score eq 'BeforeAnswerDate' && after($tmplSet->answer_date, $c->submitTime))) ) ); } -sub can_showProblemGrader { - my ($self, $user, $permissionLevel, $effectiveUser, $set) = @_; - my $authz = $self->r->authz; +sub can_showProblemGrader ($c, $user, $permissionLevel, $effectiveUser, $set, $problem, $tmplSet) { + my $authz = $c->authz; return ($authz->hasPermissions($user->user_id, 'access_instructor_tools') && $authz->hasPermissions($user->user_id, 'score_sets') && $set->set_id ne 'Undefined_Set' - && !$self->{invalidSet}); + && !$c->{invalidSet}); } -sub can_showHints { return 1; } +sub can_showHints ($c) { return 1; } -sub can_showSolutions { - my ($self, $user, $permissionLevel, $effectiveUser, $set, $problem, $tmplSet) = @_; - my $authz = $self->r->authz; +sub can_showSolutions ($c, $user, $permissionLevel, $effectiveUser, $set, $problem, $tmplSet) { + my $authz = $c->authz; return 1 if $authz->hasPermissions($user->user_id, 'always_show_solution'); # This is the same as can_showCorrectAnswers. - return $self->can_showCorrectAnswers($user, $permissionLevel, $effectiveUser, $set, $problem, $tmplSet, - $self->{submitAnswers}); + return $c->can_showCorrectAnswers($user, $permissionLevel, $effectiveUser, $set, $problem, $tmplSet); } # Allow for a version_last_attempt_time which is the time the set was submitted. If that is present we use that instead # of the current time to decide if answers can be recorded. This deals with the time between the submission time and # the proctor authorization. -sub can_recordAnswers { - my ($self, $user, $permissionLevel, $effectiveUser, $set, $problem, $tmplSet, $submitAnswers) = @_; - my $authz = $self->r->authz; +sub can_recordAnswers ($c, $user, $permissionLevel, $effectiveUser, $set, $problem, $tmplSet = 0, $submitAnswers = 0) { + my $authz = $c->authz; # Never record answers for undefined sets return 0 if $set->set_id eq 'Undefined_Set'; @@ -147,12 +136,12 @@ sub can_recordAnswers { my $submitTime = ($set->assignment_type eq 'proctored_gateway' && $set->version_last_attempt_time) ? $set->version_last_attempt_time - : $self->r->submitTime; + : $c->submitTime; return $authz->hasPermissions($user->user_id, 'record_answers_before_open_date') if before($set->open_date, $submitTime); - if (between($set->open_date, $set->due_date + $self->{ce}{gatewayGracePeriod}, $submitTime)) { + if (between($set->open_date, $set->due_date + $c->ce->{gatewayGracePeriod}, $submitTime)) { # Look at maximum attempts per version, not for the set, to determine the number of attempts allowed. my $attemptsPerVersion = $set->attempts_per_version || 0; my $attemptsUsed = $problem->num_correct + $problem->num_incorrect + ($submitAnswers ? 1 : 0); @@ -165,7 +154,7 @@ sub can_recordAnswers { } return $authz->hasPermissions($user->user_id, 'record_answers_after_due_date') - if between(($set->due_date + $self->{ce}{gatewayGracePeriod}), $set->answer_date, $submitTime); + if between(($set->due_date + $c->ce->{gatewayGracePeriod}), $set->answer_date, $submitTime); return $authz->hasPermissions($user->user_id, 'record_answers_after_answer_date') if after($set->answer_date, $submitTime); @@ -176,18 +165,17 @@ sub can_recordAnswers { # Allow for a version_last_attempt_time which is the time the set was submitted. If that is present, then use that # instead of the current time to decide if answers can be checked. This deals with the time between the submission time # and the proctor authorization. -sub can_checkAnswers { - my ($self, $user, $permissionLevel, $effectiveUser, $set, $problem, $tmplSet, $submitAnswers) = @_; - my $authz = $self->r->authz; +sub can_checkAnswers ($c, $user, $permissionLevel, $effectiveUser, $set, $problem, $tmplSet, $submitAnswers = 0) { + my $authz = $c->authz; return 0 - if $self->can_recordAnswers($user, $permissionLevel, $effectiveUser, $set, $problem, $tmplSet, $submitAnswers) + if $c->can_recordAnswers($user, $permissionLevel, $effectiveUser, $set, $problem, $tmplSet, $submitAnswers) && !$authz->hasPermissions($user->user_id, 'can_check_and_submit_answers'); my $submitTime = ($set->assignment_type eq 'proctored_gateway' && $set->version_last_attempt_time) ? $set->version_last_attempt_time - : $self->r->submitTime; + : $c->submitTime; return $authz->hasPermissions($user->user_id, 'check_answers_before_open_date') if before($set->open_date, $submitTime); @@ -197,9 +185,9 @@ sub can_checkAnswers { # To deal with this, use the least restrictive view of hiding, and then filter for the problems themselves later. my $canShowProblemScores = - $self->can_showProblemScores($user, $permissionLevel, $effectiveUser, $set, $problem, $tmplSet); + $c->can_showProblemScores($user, $permissionLevel, $effectiveUser, $set, $problem, $tmplSet); - if (between($set->open_date, $set->due_date + $self->{ce}{gatewayGracePeriod}, $submitTime)) { + if (between($set->open_date, $set->due_date + $c->ce->{gatewayGracePeriod}, $submitTime)) { # Look at maximum attempts per version, not for the set, to determine the number of attempts allowed. my $attempts_per_version = $set->attempts_per_version || 0; my $attempts_used = $problem->num_correct + $problem->num_incorrect + ($submitAnswers ? 1 : 0); @@ -214,7 +202,7 @@ sub can_checkAnswers { } return $authz->hasPermissions($user->user_id, 'check_answers_after_due_date') && $canShowProblemScores - if between(($set->due_date + $self->{ce}{gatewayGracePeriod}), $set->answer_date, $submitTime); + if between(($set->due_date + $c->ce->{gatewayGracePeriod}), $set->answer_date, $submitTime); return $authz->hasPermissions($user->user_id, 'check_answers_after_answer_date') && $canShowProblemScores if after($set->answer_date, $submitTime); @@ -222,54 +210,47 @@ sub can_checkAnswers { return 0; } -sub can_showScore { - my ($self, $user, $permissionLevel, $effectiveUser, $set, $problem, $tmplSet) = @_; +sub can_showScore ($c, $user, $permissionLevel, $effectiveUser, $set, $problem, $tmplSet) { return - $self->r->authz->hasPermissions($user->user_id, 'view_hidden_work') + $c->authz->hasPermissions($user->user_id, 'view_hidden_work') || $set->hide_score eq 'N' - || ($set->hide_score eq 'BeforeAnswerDate' && after($tmplSet->answer_date, $self->r->submitTime)); + || ($set->hide_score eq 'BeforeAnswerDate' && after($tmplSet->answer_date, $c->submitTime)); } -sub can_showProblemScores { - my ($self, $user, $permissionLevel, $effectiveUser, $set, $problem, $tmplSet) = @_; - return $self->can_showScore($user, $permissionLevel, $effectiveUser, $set, $problem, $tmplSet) - && ($set->hide_score_by_problem eq 'N' || $self->r->authz->hasPermissions($user->user_id, 'view_hidden_work')); +sub can_showProblemScores ($c, $user, $permissionLevel, $effectiveUser, $set, $problem, $tmplSet) { + return $c->can_showScore($user, $permissionLevel, $effectiveUser, $set, $problem, $tmplSet) + && ($set->hide_score_by_problem eq 'N' || $c->authz->hasPermissions($user->user_id, 'view_hidden_work')); } -sub can_showWork { - my ($self, $user, $permissionLevel, $effectiveUser, $set, $problem, $tmplSet) = @_; - return $self->r->authz->hasPermissions($user->user_id, 'view_hidden_work') +sub can_showWork ($c, $user, $permissionLevel, $effectiveUser, $set, $problem, $tmplSet) { + return $c->authz->hasPermissions($user->user_id, 'view_hidden_work') || ($set->hide_work eq 'N' - || ($set->hide_work eq 'BeforeAnswerDate' && $self->r->submitTime > $tmplSet->answer_date)); + || ($set->hide_work eq 'BeforeAnswerDate' && $c->submitTime > $tmplSet->answer_date)); } -sub can_useMathView { - my ($self) = @_; - return $self->r->ce->{pg}{specialPGEnvironmentVars}{entryAssist} eq 'MathView'; +sub can_useMathView ($c) { + return $c->ce->{pg}{specialPGEnvironmentVars}{entryAssist} eq 'MathView'; } -sub can_useWirisEditor { - my ($self) = @_; - return $self->r->ce->{pg}{specialPGEnvironmentVars}{entryAssist} eq 'WIRIS'; +sub can_useWirisEditor ($c) { + return $c->ce->{pg}{specialPGEnvironmentVars}{entryAssist} eq 'WIRIS'; } -sub can_useMathQuill { - my ($self) = @_; - return $self->r->ce->{pg}{specialPGEnvironmentVars}{entryAssist} eq 'MathQuill'; +sub can_useMathQuill ($c) { + return $c->ce->{pg}{specialPGEnvironmentVars}{entryAssist} eq 'MathQuill'; } # Output utility -sub attemptResults { - my ($self, $pg, $showCorrectAnswers, $showAttemptResults, $showSummary) = @_; - my $ce = $self->{ce}; +sub attemptResults ($c, $pg, $showCorrectAnswers, $showAttemptResults, $showSummary) { + my $ce = $c->ce; # Create AttemptsTable object my $tbl = WeBWorK::HTML::AttemptsTable->new( $pg->{answers}, - $self->r, + $c, answersSubmitted => 1, answerOrder => $pg->{flags}{ANSWER_ENTRY_ORDER}, - displayMode => $self->{displayMode}, + displayMode => $c->{displayMode}, showHeadline => 0, showAnswerNumbers => 0, showAttemptAnswers => $ce->{pg}{options}{showEvaluatedAnswers}, @@ -298,14 +279,12 @@ sub attemptResults { return $answerTemplate; } -sub get_instructor_comment { - my ($self, $problem) = @_; - +sub get_instructor_comment ($c, $problem) { return unless ref($problem) =~ /ProblemVersion/; - my $db = $self->r->db; + my $db = $c->db; my $userPastAnswerID = $db->latestProblemPastAnswer( - $self->{ce}{courseName}, + $c->ce->{courseName}, $problem->user_id, $problem->set_id . ',v' . $problem->version_id, $problem->problem_id ); @@ -320,31 +299,27 @@ sub get_instructor_comment { # Template methods -async sub pre_header_initialize { - my ($self) = @_; - my $r = $self->r; - +async sub pre_header_initialize ($c) { # Make sure these are defined for the templates. - $r->stash->{problems} = []; - $r->stash->{pg_results} = []; - $r->stash->{startProb} = 0; - $r->stash->{endProb} = 0; - $r->stash->{numPages} = 0; - $r->stash->{pageNumber} = 0; - $r->stash->{problem_numbers} = []; - $r->stash->{probOrder} = []; + $c->stash->{problems} = []; + $c->stash->{pg_results} = []; + $c->stash->{startProb} = 0; + $c->stash->{endProb} = 0; + $c->stash->{numPages} = 0; + $c->stash->{pageNumber} = 0; + $c->stash->{problem_numbers} = []; + $c->stash->{probOrder} = []; # If authz->checkSet has failed, then this set is invalid. No need to proceeded. - return if $self->{invalidSet}; + return if $c->{invalidSet}; - my $ce = $r->ce; - my $db = $r->db; - my $authz = $r->authz; - my $urlpath = $r->urlpath; + my $ce = $c->ce; + my $db = $c->db; + my $authz = $c->authz; - my $setID = $urlpath->arg('setID'); - my $userID = $r->param('user'); - my $effectiveUserID = $r->param('effectiveUser'); + my $setID = $c->stash('setID'); + my $userID = $c->param('user'); + my $effectiveUserID = $c->param('effectiveUser'); # User checks my $user = $db->getUser($userID); @@ -374,10 +349,10 @@ async sub pre_header_initialize { if ($setID eq 'Undefined_Set') { # Make sure these are defined $requestedVersion = 1; - $self->{assignment_type} = 'gateway'; + $c->{assignment_type} = 'gateway'; if (!$authz->hasPermissions($userID, 'modify_problem_sets')) { - $self->{invalidSet} = 'You do not have the authorization level required to view/edit undefined sets.'; + $c->{invalidSet} = 'You do not have the authorization level required to view/edit undefined sets.'; # Define these so that we can drop through to report the error in body. $tmplSet = fake_set($db); @@ -385,8 +360,8 @@ async sub pre_header_initialize { $problem = fake_problem($db); } else { # In this case we're creating a fake set from the input, so the input must include a source file. - if (!$r->param('sourceFilePath')) { - $self->{invalidSet} = + if (!$c->param('sourceFilePath')) { + $c->{invalidSet} = 'An Undefined_Set was requested, but no source file for the contained problem was provided.'; # Define these so that we can drop through to report the error in body. @@ -395,7 +370,7 @@ async sub pre_header_initialize { $problem = fake_problem($db); } else { - my $sourceFPath = $r->param('sourceFilePath'); + my $sourceFPath = $c->param('sourceFilePath'); die('sourceFilePath is unsafe!') unless path_is_subdir($sourceFPath, $ce->{courseDirs}{templates}, 1); @@ -430,18 +405,18 @@ async sub pre_header_initialize { $problem->source_file($sourceFPath); $problem->user_id($effectiveUserID); $problem->value(1); - $problem->problem_seed($r->param('problemSeed')) if ($r->param('problemSeed')); + $problem->problem_seed($c->param('problemSeed')) if ($c->param('problemSeed')); } } } else { # Get the template set, i.e., the non-versioned set that's assigned to the user. - # If this failed in authz->checkSet, then $self->{invalidSet} is set. + # If this failed in authz->checkSet, then $c->{invalidSet} is set. $tmplSet = $db->getMergedSet($effectiveUserID, $setID); # Now that is has been validated that this is a gateway test, save the assignment test for the processing of # proctor keys for graded proctored tests. If a set was not obtained from the database, store a fake value here # to be able to continue. - $self->{assignment_type} = $tmplSet->assignment_type || 'gateway'; + $c->{assignment_type} = $tmplSet->assignment_type || 'gateway'; # next, get the latest (current) version of the set if we don't have a # requested version number @@ -457,10 +432,10 @@ async sub pre_header_initialize { die('No requested version when returning to problem?!') if ( ( - $r->param('previewAnswers') - || $r->param('checkAnswers') - || $r->param('submitAnswers') - || $r->param('newPage') + $c->param('previewAnswers') + || $c->param('checkAnswers') + || $c->param('submitAnswers') + || $c->param('newPage') ) && !$requestedVersion ); @@ -490,9 +465,9 @@ async sub pre_header_initialize { # date. If a specific version has not been requested and conditional release is enabled, then this also checks to # see if the conditions have been met for a conditional release. my $isOpen = ( - $requestedVersion ? ($set && $set->open_date && after($set->open_date, $self->r->submitTime)) : ($tmplSet + $requestedVersion ? ($set && $set->open_date && after($set->open_date, $c->submitTime)) : ($tmplSet && $tmplSet->open_date - && after($tmplSet->open_date, $self->r->submitTime) + && after($tmplSet->open_date, $c->submitTime) && !($ce->{options}{enableConditionalRelease} && is_restricted($db, $tmplSet, $effectiveUserID))) ) || $authz->hasPermissions($userID, 'view_unopened_sets'); @@ -500,7 +475,7 @@ async sub pre_header_initialize { my $isClosed = $tmplSet && $tmplSet->due_date - && after($tmplSet->due_date, $self->r->submitTime) + && after($tmplSet->due_date, $c->submitTime) && !$authz->hasPermissions($userID, 'record_answers_after_due_date'); # To determine if we need a new version, we need to know whether this version exceeds the number of attempts per @@ -543,12 +518,12 @@ async sub pre_header_initialize { my $currentNumVersions = 0; # this is the number of versions in the time interval my $totalNumVersions = 0; - if ($setVersionNumber && !$self->{invalidSet} && $setID ne 'Undefined_Set') { + if ($setVersionNumber && !$c->{invalidSet} && $setID ne 'Undefined_Set') { my @setVersionIDs = $db->listSetVersions($effectiveUserID, $setID); my @setVersions = $db->getSetVersions(map { [ $effectiveUserID, $setID,, $_ ] } @setVersionIDs); for (@setVersions) { $totalNumVersions++; - $currentNumVersions++ if (!$timeInterval || $_->version_creation_time() > ($r->submitTime - $timeInterval)); + $currentNumVersions++ if (!$timeInterval || $_->version_creation_time() > ($c->submitTime - $timeInterval)); } } @@ -556,7 +531,7 @@ async sub pre_header_initialize { my $versionIsOpen = 0; - if ($isOpen && !$isClosed && !$self->{invalidSet}) { + if ($isOpen && !$isClosed && !$c->{invalidSet}) { # If specific version was not requested, then create a new one if needed. if (!$requestedVersion) { if ( @@ -567,7 +542,7 @@ async sub pre_header_initialize { ( ($maxAttemptsPerVersion == 0 && $currentNumAttempts > 0) || ($maxAttemptsPerVersion != 0 && $currentNumAttempts >= $maxAttemptsPerVersion) - || $r->submitTime >= $set->due_date + $ce->{gatewayGracePeriod} + || $c->submitTime >= $set->due_date + $ce->{gatewayGracePeriod} ) && (!$versionsPerInterval || $currentNumVersions < $versionsPerInterval) ) @@ -577,7 +552,7 @@ async sub pre_header_initialize { || ( $authz->hasPermissions($userID, 'record_answers_when_acting_as_student') || ($authz->hasPermissions($userID, 'create_new_set_version_when_acting_as_student') - && $r->param('createnew_ok')) + && $c->param('createnew_ok')) ) ) ) @@ -596,7 +571,7 @@ async sub pre_header_initialize { $problem = $db->getMergedProblemVersion($effectiveUserID, $setID, $setVersionNumber, $setPNum[0]); # Convert the floating point value from Time::HiRes to an integer for use below. Truncate towards 0. - my $timeNowInt = int($r->submitTime); + my $timeNowInt = int($c->submitTime); # Set up creation time, and open and due dates. my $ansOffset = $set->answer_date - $set->due_date; @@ -604,7 +579,7 @@ async sub pre_header_initialize { $set->open_date($timeNowInt); # Figure out the due date, taking into account the time limit cap. my $dueTime = - $timeLimit == 0 || ($set->time_limit_cap && $r->submitTime + $timeLimit > $set->due_date) + $timeLimit == 0 || ($set->time_limit_cap && $c->submitTime + $timeLimit > $set->due_date) ? $set->due_date : $timeNowInt + $timeLimit; @@ -632,14 +607,14 @@ async sub pre_header_initialize { $currentNumAttempts = 0; } elsif ($maxAttempts != -1 && $totalNumVersions > $maxAttempts) { - $self->{invalidSet} = 'No new versions of this assignment are available, ' + $c->{invalidSet} = 'No new versions of this assignment are available, ' . 'because you have already taken the maximum number allowed.'; } elsif ($effectiveUserID ne $userID && $authz->hasPermissions($userID, 'create_new_set_version_when_acting_as_student')) { - $self->{invalidSet} = + $c->{invalidSet} = "User $effectiveUserID is being acted " . 'as. If you continue, you will create a new version of this set ' . 'for that user, which will count against their allowed maximum ' @@ -647,20 +622,20 @@ async sub pre_header_initialize { . 'IS NOT WHAT YOU WANT TO DO. Please be sure that you want to ' . 'do this before clicking the "Create new set version" link ' . 'below. Alternately, PRESS THE "BACK" BUTTON and continue.'; - $self->{invalidVersionCreation} = 1; + $c->{invalidVersionCreation} = 1; } elsif ($effectiveUserID ne $userID) { - $self->{invalidSet} = "User $effectiveUserID is being acted as. " + $c->{invalidSet} = "User $effectiveUserID is being acted as. " . 'When acting as another user, new versions of the set cannot be created.'; - $self->{invalidVersionCreation} = 2; + $c->{invalidVersionCreation} = 2; } elsif (($maxAttemptsPerVersion == 0 || $currentNumAttempts < $maxAttemptsPerVersion) - && $r->submitTime < $set->due_date() + $ce->{gatewayGracePeriod}) + && $c->submitTime < $set->due_date() + $ce->{gatewayGracePeriod}) { - if (between($set->open_date(), $set->due_date() + $ce->{gatewayGracePeriod}, $r->submitTime)) { + if (between($set->open_date(), $set->due_date() + $ce->{gatewayGracePeriod}, $c->submitTime)) { $versionIsOpen = 1; } else { - $self->{invalidSet} = + $c->{invalidSet} = 'No new versions of this assignment are available, because the set is not open or its time' . ' limit has expired.'; } @@ -668,7 +643,7 @@ async sub pre_header_initialize { } elsif ($versionsPerInterval && ($currentNumVersions >= $versionsPerInterval)) { - $self->{invalidSet} = + $c->{invalidSet} = 'You have already taken all available versions of this test in the current time interval. ' . 'You may take the test again after the time interval has expired.'; @@ -682,20 +657,20 @@ async sub pre_header_initialize { || $authz->hasPermissions($userID, 'record_set_version_answers_when_acting_as_student')) ) { - if (between($set->open_date(), $set->due_date() + $ce->{gatewayGracePeriod}, $r->submitTime)) { + if (between($set->open_date(), $set->due_date() + $ce->{gatewayGracePeriod}, $c->submitTime)) { $versionIsOpen = 1; } } } - } elsif (!$self->{invalidSet} && !$requestedVersion) { - $self->{invalidSet} = 'This set is closed. No new set versions may be taken.'; + } elsif (!$c->{invalidSet} && !$requestedVersion) { + $c->{invalidSet} = 'This set is closed. No new set versions may be taken.'; } # If the set or problem is invalid, then delete any proctor keys if any and return. - if ($self->{invalidSet} || $self->{invalidProblem}) { - if (defined $self->{assignment_type} && $self->{assignment_type} eq 'proctored_gateway') { - my $proctorID = $r->param('proctor_user'); + if ($c->{invalidSet} || $c->{invalidProblem}) { + if (defined $c->{assignment_type} && $c->{assignment_type} eq 'proctored_gateway') { + my $proctorID = $c->param('proctor_user'); if ($proctorID) { eval { $db->deleteKey("$effectiveUserID,$proctorID"); }; eval { $db->deleteKey("$effectiveUserID,$proctorID,g"); }; @@ -707,41 +682,41 @@ async sub pre_header_initialize { # Save problem and user data my $psvn = $set->psvn(); - $self->{tmplSet} = $tmplSet; - $self->{set} = $set; - $self->{problem} = $problem; + $c->{tmplSet} = $tmplSet; + $c->{set} = $set; + $c->{problem} = $problem; - $self->{userID} = $userID; - $self->{user} = $user; - $self->{effectiveUser} = $effectiveUser; + $c->{userID} = $userID; + $c->{user} = $user; + $c->{effectiveUser} = $effectiveUser; - $self->{isOpen} = $isOpen; - $self->{isClosed} = $isClosed; - $self->{versionIsOpen} = $versionIsOpen; + $c->{isOpen} = $isOpen; + $c->{isClosed} = $isClosed; + $c->{versionIsOpen} = $versionIsOpen; # Form processing # Get the current page, if it's given. - my $currentPage = $r->param('currentPage') || 1; + my $currentPage = $c->param('currentPage') || 1; # This is a hack to manage changing pages. Set previewAnswers to # false if the "pageChangeHack" input is set (a page change link was used). - $r->param('previewAnswers', 0) if ($r->param('pageChangeHack')); + $c->param('previewAnswers', 0) if $c->param('pageChangeHack'); - $self->{displayMode} = $user->displayMode || $ce->{pg}{options}{displayMode}; + $c->{displayMode} = $user->displayMode || $ce->{pg}{options}{displayMode}; # Set options from request parameters. - $self->{redisplay} = $r->param('redisplay'); - $self->{submitAnswers} = $r->param('submitAnswers') || 0; - $self->{checkAnswers} = $r->param('checkAnswers') // 0; - $self->{previewAnswers} = $r->param('previewAnswers') // 0; - $self->{formFields} = { WeBWorK::Form->new_from_paramable($r)->Vars }; + $c->{redisplay} = $c->param('redisplay'); + $c->{submitAnswers} = $c->param('submitAnswers') || 0; + $c->{checkAnswers} = $c->param('checkAnswers') // 0; + $c->{previewAnswers} = $c->param('previewAnswers') // 0; + $c->{formFields} = { WeBWorK::Form->new_from_paramable($c)->Vars }; # Permissions # Bail without doing anything if the set isn't yet open for this user. - if (!($self->{isOpen} || $authz->hasPermissions($userID, 'view_unopened_sets'))) { - $self->{invalidSet} = 'This set is not yet open.'; + if (!($c->{isOpen} || $authz->hasPermissions($userID, 'view_unopened_sets'))) { + $c->{invalidSet} = 'This set is not yet open.'; return; } @@ -749,19 +724,19 @@ async sub pre_header_initialize { my %want = ( showOldAnswers => $user->showOldAnswers ne '' ? $user->showOldAnswers : $ce->{pg}{options}{showOldAnswers}, # showProblemGrader implies showCorrectAnswers. This is a convenience for grading. - showCorrectAnswers => ($r->param('showProblemGrader') || 0) - || ($r->param('showCorrectAnswers') && ($self->{submitAnswers} || $self->{checkAnswers})) + showCorrectAnswers => ($c->param('showProblemGrader') || 0) + || ($c->param('showCorrectAnswers') && ($c->{submitAnswers} || $c->{checkAnswers})) || 0, - showProblemGrader => $r->param('showProblemGrader') + showProblemGrader => $c->param('showProblemGrader') || 0, # Hints are not yet implemented in gateway quzzes. showHints => 0, # showProblemGrader implies showSolutions. Another convenience for grading. - showSolutions => $r->param('showProblemGrader') - || ($r->param('showSolutions') && ($self->{submitAnswers} || $self->{checkAnswers})), - recordAnswers => $self->{submitAnswers} && !$authz->hasPermissions($userID, 'avoid_recording_answers'), + showSolutions => $c->param('showProblemGrader') + || ($c->param('showSolutions') && ($c->{submitAnswers} || $c->{checkAnswers})), + recordAnswers => $c->{submitAnswers} && !$authz->hasPermissions($userID, 'avoid_recording_answers'), # we also want to check answers if we were checking answers and are switching between pages - checkAnswers => $self->{checkAnswers}, + checkAnswers => $c->{checkAnswers}, useMathView => $user->useMathView ne '' ? $user->useMathView : $ce->{pg}{options}{useMathView}, useWirisEditor => $user->useWirisEditor ne '' ? $user->useWirisEditor : $ce->{pg}{options}{useWirisEditor}, useMathQuill => $user->useMathQuill ne '' ? $user->useMathQuill : $ce->{pg}{options}{useMathQuill}, @@ -784,30 +759,30 @@ async sub pre_header_initialize { # Does the user have permission to use certain options? my @args = ($user, $permissionLevel, $effectiveUser, $set, $problem, $tmplSet); my %can = ( - showOldAnswers => $self->can_showOldAnswers(@args), - showCorrectAnswers => $self->can_showCorrectAnswers(@args), - showProblemGrader => $self->can_showProblemGrader(@args), - showHints => $self->can_showHints(@args), - showSolutions => $self->can_showSolutions(@args), - recordAnswers => $self->can_recordAnswers(@args), - checkAnswers => $self->can_checkAnswers(@args), - recordAnswersNextTime => $self->can_recordAnswers(@args, $self->{submitAnswers}), - checkAnswersNextTime => $self->can_checkAnswers(@args, $self->{submitAnswers}), - showScore => $self->can_showScore(@args), - showProblemScores => $self->can_showProblemScores(@args), - showWork => $self->can_showWork(@args), - useMathView => $self->can_useMathView, - useWirisEditor => $self->can_useWirisEditor, - useMathQuill => $self->can_useMathQuill + showOldAnswers => $c->can_showOldAnswers(@args), + showCorrectAnswers => $c->can_showCorrectAnswers(@args), + showProblemGrader => $c->can_showProblemGrader(@args), + showHints => $c->can_showHints, + showSolutions => $c->can_showSolutions(@args), + recordAnswers => $c->can_recordAnswers(@args), + checkAnswers => $c->can_checkAnswers(@args), + recordAnswersNextTime => $c->can_recordAnswers(@args, $c->{submitAnswers}), + checkAnswersNextTime => $c->can_checkAnswers(@args, $c->{submitAnswers}), + showScore => $c->can_showScore(@args), + showProblemScores => $c->can_showProblemScores(@args), + showWork => $c->can_showWork(@args), + useMathView => $c->can_useMathView, + useWirisEditor => $c->can_useWirisEditor, + useMathQuill => $c->can_useMathQuill ); # Final values for options my %will = map { $_ => $can{$_} && ($must{$_} || $want{$_}) } keys %must; - $self->{want} = \%want; - $self->{must} = \%must; - $self->{can} = \%can; - $self->{will} = \%will; + $c->{want} = \%want; + $c->{must} = \%must; + $c->{can} = \%can; + $c->{will} = \%will; # Set up problem numbering and multipage variables. @@ -826,7 +801,7 @@ async sub pre_header_initialize { # Update startProb and endProb for multipage tests if ($set->problems_per_page) { $numProbPerPage = $set->problems_per_page; - $pageNumber = $r->param('newPage') || $currentPage; + $pageNumber = $c->param('newPage') || $currentPage; $numPages = scalar(@problemNumbers) / $numProbPerPage; $numPages = int($numPages) + 1 if (int($numPages) != $numPages); @@ -868,7 +843,7 @@ async sub pre_header_initialize { my @pg_results; # pg errors are stored here. - $self->{errors} = []; + $c->{errors} = []; # Process the problems as needed. my @mergedProblems; @@ -884,16 +859,16 @@ async sub pre_header_initialize { my $problemN = $mergedProblems[$pIndex]; if (!defined $problemN) { - $self->{invalidSet} = 'One or more of the problems in this set have not been assigned to you.'; + $c->{invalidSet} = 'One or more of the problems in this set have not been assigned to you.'; return; } # sticky answers are set up here - if (!($self->{submitAnswers} || $self->{previewAnswers} || $self->{checkAnswers} || $r->param('newPage')) + if (!($c->{submitAnswers} || $c->{previewAnswers} || $c->{checkAnswers} || $c->param('newPage')) && $will{showOldAnswers}) { my %oldAnswers = decodeAnswers($problemN->last_answer); - $self->{formFields}{$_} = $oldAnswers{$_} for (keys %oldAnswers); + $c->{formFields}{$_} = $oldAnswers{$_} for (keys %oldAnswers); } push(@problems, $problemN); @@ -901,8 +876,8 @@ async sub pre_header_initialize { # If this problem DOES NOT need to be translated, store a defined but false placeholder in the array. my $pg = 0; # This is the actual translation of each problem. - if ((grep {/^$pIndex$/} @probsToDisplay) || $self->{submitAnswers}) { - push @renderPromises, $self->getProblemHTML($self->{effectiveUser}, $set, $self->{formFields}, $problemN); + if ((grep {/^$pIndex$/} @probsToDisplay) || $c->{submitAnswers}) { + push @renderPromises, $c->getProblemHTML($c->{effectiveUser}, $set, $c->{formFields}, $problemN); # If this problem DOES need to be translated, store an undefined placeholder in the array. # This will be replaced with the rendered problem after all of the above promises are awaited. $pg = undef; @@ -917,21 +892,21 @@ async sub pre_header_initialize { $_ = (shift @renderedPG)->[0] if !defined $_; } - $r->stash->{problems} = \@problems; - $r->stash->{pg_results} = \@pg_results; - $r->stash->{startProb} = $startProb; - $r->stash->{endProb} = $endProb; - $r->stash->{numPages} = $numPages; - $r->stash->{pageNumber} = $pageNumber; - $r->stash->{problem_numbers} = \@problemNumbers; - $r->stash->{probOrder} = \@probOrder; + $c->stash->{problems} = \@problems; + $c->stash->{pg_results} = \@pg_results; + $c->stash->{startProb} = $startProb; + $c->stash->{endProb} = $endProb; + $c->stash->{numPages} = $numPages; + $c->stash->{pageNumber} = $pageNumber; + $c->stash->{problem_numbers} = \@problemNumbers; + $c->stash->{probOrder} = \@probOrder; my $versionID = $set->version_id; my $setVName = "$setID,v$versionID"; # Report everything with the request submit time. Convert the floating point # value from Time::HiRes to an integer for use below. Truncate towards 0. - my $timeNowInt = int($r->submitTime); + my $timeNowInt = int($c->submitTime); # Answer processing @@ -941,14 +916,14 @@ async sub pre_header_initialize { my $LTIGradeResult = -1; # Save results to database as appropriate - if ($self->{submitAnswers} || (($self->{previewAnswers} || $r->param('newPage')) && $can{recordAnswers})) { + if ($c->{submitAnswers} || (($c->{previewAnswers} || $c->param('newPage')) && $can{recordAnswers})) { # If answers are being submitted, then save the problems to the database. If this is a preview or pages change # and answers can be recorded, then save the last answer for future reference. # First, deal with answers being submitted for a proctored exam. Delete the proctor keys that authorized the # grading, so that it isn't possible to log in and take another proctored test without being reauthorized. - if ($self->{submitAnswers} && $self->{assignment_type} eq 'proctored_gateway') { - my $proctorID = $r->param('proctor_user'); + if ($c->{submitAnswers} && $c->{assignment_type} eq 'proctored_gateway') { + my $proctorID = $c->param('proctor_user'); # If there are no attempts left, delete all proctor keys for this user. if ($set->attempts_per_version - 1 - $problem->num_correct - $problem->num_incorrect <= 0) { @@ -958,9 +933,9 @@ async sub pre_header_initialize { eval { $db->deleteKey("$effectiveUserID,$proctorID,g"); }; # In this case there may be a past login proctor key that can be kept so that another login to continue # working the test is not needed. - if ($r->param('past_proctor_user') && $r->param('past_proctor_key')) { - $r->param('proctor_user', $r->param('past_proctor_user')); - $r->param('proctor_key', $r->param('past_proctor_key')); + if ($c->param('past_proctor_user') && $c->param('past_proctor_key')) { + $c->param('proctor_user', $c->param('past_proctor_user')); + $c->param('proctor_key', $c->param('past_proctor_key')); } } # This is unsubtle, but we'd rather not have bogus keys sitting around. @@ -984,11 +959,11 @@ async sub pre_header_initialize { if (ref $pg_result) { my ($past_answers_string, $scores, $isEssay); # Not used here ($past_answers_string, $encoded_last_answer_string, $scores, $isEssay) = - create_ans_str_from_responses($self, $pg_result); + create_ans_str_from_responses($c, $pg_result); } else { my $prefix = sprintf('Q%04d_', $problemNumbers[$i]); - my @fields = sort grep {/^(?!previous).*$prefix/} (keys %{ $self->{formFields} }); - my %answersToStore = map { $_ => $self->{formFields}->{$_} } @fields; + my @fields = sort grep {/^(?!previous).*$prefix/} (keys %{ $c->{formFields} }); + my %answersToStore = map { $_ => $c->{formFields}->{$_} } @fields; my @answer_order = @fields; $encoded_last_answer_string = encodeAnswers(%answersToStore, @answer_order); } @@ -998,15 +973,15 @@ async sub pre_header_initialize { $pureProblem->last_answer($encoded_last_answer_string); # Store the state in the database if answers are being recorded. - if ($self->{submitAnswers} && $will{recordAnswers}) { + if ($c->{submitAnswers} && $will{recordAnswers}) { my $score = - compute_reduced_score($ce, $problem, $set, $pg_result->{state}{recorded_score}, $r->submitTime); + compute_reduced_score($ce, $problem, $set, $pg_result->{state}{recorded_score}, $c->submitTime); $problem->status($score) if $score > $problem->status; $problem->sub_status($problem->status) if (!$ce->{pg}{ansEvalDefaults}{enableReducedScoring} || !$set->enable_reduced_scoring - || before($set->reduced_scoring_date, $r->submitTime)); + || before($set->reduced_scoring_date, $c->submitTime)); $problem->attempted(1); $problem->num_correct($pg_result->{state}{num_of_correct_ans}); @@ -1023,12 +998,12 @@ async sub pre_header_initialize { # used in a string comparison. Don't compare translated strings! $scoreRecordedMessage[ $probOrder[$i] ] = 'recorded'; } else { - $scoreRecordedMessage[ $probOrder[$i] ] = $r->maketext('Your score was not recorded because ' + $scoreRecordedMessage[ $probOrder[$i] ] = $c->maketext('Your score was not recorded because ' . 'there was a failure in storing the problem record to the database.'); } # Write the transaction log - writeLog($self->{ce}, 'transaction', + writeLog($c->ce, 'transaction', $problem->problem_id . "\t" . $problem->set_id . "\t" . $problem->user_id . "\t" @@ -1041,21 +1016,21 @@ async sub pre_header_initialize { . $problem->last_answer . "\t" . $problem->num_correct . "\t" . $problem->num_incorrect); - } elsif ($self->{submitAnswers}) { + } elsif ($c->{submitAnswers}) { # This is the case answers were submitted but can not be saved. Report an error message. - if ($self->{isClosed}) { + if ($c->{isClosed}) { $scoreRecordedMessage[ $probOrder[$i] ] = - $r->maketext('Your score was not recorded because this problem set version is not open.'); + $c->maketext('Your score was not recorded because this problem set version is not open.'); } elsif ($problem->num_correct + $problem->num_incorrect >= $set->attempts_per_version) { - $scoreRecordedMessage[ $probOrder[$i] ] = $r->maketext( + $scoreRecordedMessage[ $probOrder[$i] ] = $c->maketext( 'Your score was not recorded because you have no attempts remaining on this set version.'); - } elsif (!$self->{versionIsOpen}) { - my $endTime = ($set->version_last_attempt_time) ? $set->version_last_attempt_time : $r->submitTime; + } elsif (!$c->{versionIsOpen}) { + my $endTime = ($set->version_last_attempt_time) ? $set->version_last_attempt_time : $c->submitTime; if ($endTime > $set->due_date && $endTime < $set->due_date + $ce->{gatewayGracePeriod}) { $endTime = $set->due_date; } my $elapsed = int(($endTime - $set->open_date) / 0.6 + 0.5) / 100; - $scoreRecordedMessage[ $probOrder[$i] ] = $r->maketext( + $scoreRecordedMessage[ $probOrder[$i] ] = $c->maketext( 'Your score was not recorded because you have exceeded the time limit for this test. ' . '(Time taken: [_1] min; allowed: [_2] min.)', $elapsed, @@ -1063,7 +1038,7 @@ async sub pre_header_initialize { ($set->due_date - $set->open_date) / 60 ); } else { - $scoreRecordedMessage[ $probOrder[$i] ] = $r->maketext('Your score was not recorded.'); + $scoreRecordedMessage[ $probOrder[$i] ] = $c->maketext('Your score was not recorded.'); } } else { # The final case is that of a preview or page change. Save the last answers for the problems. @@ -1072,9 +1047,9 @@ async sub pre_header_initialize { } # Try to update the student score on the LMS if that option is enabled. - my $LTIGradeMode = $self->{ce}{LTIGradeMode} // ''; - if ($self->{submitAnswers} && $will{recordAnswers} && $LTIGradeMode && $self->{ce}{LTIGradeOnSubmit}) { - my $grader = WeBWorK::Authen::LTIAdvanced::SubmitGrade->new($r); + my $LTIGradeMode = $c->ce->{LTIGradeMode} // ''; + if ($c->{submitAnswers} && $will{recordAnswers} && $LTIGradeMode && $c->ce->{LTIGradeOnSubmit}) { + my $grader = WeBWorK::Authen::LTIAdvanced::SubmitGrade->new($c); if ($LTIGradeMode eq 'course') { $LTIGradeResult = $grader->submit_course_grade($effectiveUserID); } elsif ($LTIGradeMode eq 'homework') { @@ -1085,16 +1060,16 @@ async sub pre_header_initialize { # Finally, log student answers answers are being submitted, provided that answers can be recorded. Note that # this will log an overtime submission (or any case where someone submits the test, or spoofs a request to # submit a test). - my $answer_log = $self->{ce}{courseFiles}{logs}{answer_log}; + my $answer_log = $c->ce->{courseFiles}{logs}{answer_log}; - if (defined $answer_log && $self->{submitAnswers}) { + if (defined $answer_log && $c->{submitAnswers}) { for my $i (0 .. $#problems) { next unless ref($pg_results[ $probOrder[$i] ]); my $problem = $problems[ $probOrder[$i] ]; my ($past_answers_string, $encoded_last_answer_string, $scores, $isEssay) = - create_ans_str_from_responses($self, $pg_results[ $probOrder[$i] ]); + create_ans_str_from_responses($c, $pg_results[ $probOrder[$i] ]); $past_answers_string =~ s/\t+$/\t/; if (!$past_answers_string || $past_answers_string =~ /^\t$/) { @@ -1103,7 +1078,7 @@ async sub pre_header_initialize { # Write to courseLog, use the recorded time of when the submission was received, but as an integer writeCourseLogGivenTime( - $self->{ce}, + $c->ce, 'answer_log', $timeNowInt, join('', @@ -1113,7 +1088,7 @@ async sub pre_header_initialize { # Add to PastAnswer db my $pastAnswer = $db->newPastAnswer(); - $pastAnswer->course_id($urlpath->arg('courseID')); + $pastAnswer->course_id($c->stash('courseID')); $pastAnswer->user_id($problem->user_id); $pastAnswer->set_id($setVName); $pastAnswer->problem_id($problem->problem_id); @@ -1125,13 +1100,13 @@ async sub pre_header_initialize { } } - my $caliper_sensor = Caliper::Sensor->new($self->{ce}); + my $caliper_sensor = Caliper::Sensor->new($c->ce); if ($caliper_sensor->caliperEnabled() && defined $answer_log) { my $events = []; - my $startTime = $r->param('startTime'); - my $endTime = int($r->submitTime); - if ($self->{submitAnswers} && $will{recordAnswers}) { + my $startTime = $c->param('startTime'); + my $endTime = int($c->submitTime); + if ($c->{submitAnswers} && $will{recordAnswers}) { for my $i (0 .. $#problems) { my $problem = $problems[ $probOrder[$i] ]; my $pg = $pg_results[ $probOrder[$i] ]; @@ -1140,13 +1115,11 @@ async sub pre_header_initialize { 'action' => 'Completed', 'profile' => 'AssessmentProfile', 'object' => Caliper::Entity::problem_user( - $self->{ce}, $db, - $problem->set_id(), $versionID, - $problem->problem_id(), $problem->user_id(), - $pg + $c->ce, $db, $problem->set_id(), $versionID, $problem->problem_id(), + $problem->user_id(), $pg ), 'generated' => Caliper::Entity::answer( - $self->{ce}, + $c->ce, $db, $problem->set_id(), $versionID, @@ -1163,9 +1136,9 @@ async sub pre_header_initialize { 'type' => 'AssessmentEvent', 'action' => 'Submitted', 'profile' => 'AssessmentProfile', - 'object' => Caliper::Entity::problem_set($self->{ce}, $db, $setID), + 'object' => Caliper::Entity::problem_set($c->ce, $db, $setID), 'generated' => Caliper::Entity::problem_set_attempt( - $self->{ce}, $db, $setID, $versionID, $effectiveUserID, $startTime, $endTime + $c->ce, $db, $setID, $versionID, $effectiveUserID, $startTime, $endTime ), }; push @$events, $submitted_set_event; @@ -1174,9 +1147,9 @@ async sub pre_header_initialize { 'type' => 'AssessmentEvent', 'action' => 'Paused', 'profile' => 'AssessmentProfile', - 'object' => Caliper::Entity::problem_set($self->{ce}, $db, $setID), + 'object' => Caliper::Entity::problem_set($c->ce, $db, $setID), 'generated' => Caliper::Entity::problem_set_attempt( - $self->{ce}, $db, $setID, $versionID, $effectiveUserID, $startTime, $endTime + $c->ce, $db, $setID, $versionID, $effectiveUserID, $startTime, $endTime ), }; push @$events, $paused_set_event; @@ -1188,26 +1161,26 @@ async sub pre_header_initialize { 'object' => Caliper::Entity::webwork_app(), }; push @$events, $tool_use_event; - $caliper_sensor->sendEvents($r, $events); + $caliper_sensor->sendEvents($c, $events); # Reset start time - $r->param('startTime', ''); + $c->param('startTime', ''); } } debug('end answer processing'); - $self->{scoreRecordedMessage} = \@scoreRecordedMessage; - $self->{LTIGradeResult} = $LTIGradeResult; + $c->{scoreRecordedMessage} = \@scoreRecordedMessage; + $c->{LTIGradeResult} = $LTIGradeResult; # Additional set-level database manipulation: We want to save the time that a set was submitted, and for proctored # tests we want to reset the assignment type after a set is submitted for the last time so that it's possible to # look at it later without getting proctor authorization. if ( ( - $self->{submitAnswers} + $c->{submitAnswers} && ( $will{recordAnswers} - || (!$set->version_last_attempt_time && $r->submitTime > $set->due_date + $ce->{gatewayGracePeriod}) + || (!$set->version_last_attempt_time && $c->submitTime > $set->due_date + $ce->{gatewayGracePeriod}) ) ) || ( @@ -1218,7 +1191,7 @@ async sub pre_header_initialize { $userID ne $effectiveUserID && $authz->hasPermissions($userID, 'record_answers_when_acting_as_student') && $set->attempts_per_version > 0 - && ($problem->num_correct + $problem->num_incorrect + ($self->{submitAnswers} ? 1 : 0) >= + && ($problem->num_correct + $problem->num_incorrect + ($c->{submitAnswers} ? 1 : 0) >= $set->attempts_per_version) ) ) @@ -1228,10 +1201,10 @@ async sub pre_header_initialize { # Save the submission time if we're recording the answer, or if the first submission occurs after the due_date. $set->version_last_attempt_time($timeNowInt) if ( - $self->{submitAnswers} + $c->{submitAnswers} && ( $will{recordAnswers} - || (!$set->version_last_attempt_time && $r->submitTime > $set->due_date + $ce->{gatewayGracePeriod}) + || (!$set->version_last_attempt_time && $c->submitTime > $set->due_date + $ce->{gatewayGracePeriod}) ) ); @@ -1244,7 +1217,7 @@ async sub pre_header_initialize { $userID ne $effectiveUserID && $authz->hasPermissions($userID, 'record_answers_when_acting_as_student') && $set->attempts_per_version > 0 - && ($problem->num_correct + $problem->num_incorrect + ($self->{submitAnswers} ? 1 : 0) >= + && ($problem->num_correct + $problem->num_incorrect + ($c->{submitAnswers} ? 1 : 0) >= $set->attempts_per_version) ) ) @@ -1263,19 +1236,19 @@ async sub pre_header_initialize { my @probStatus; # Figure out the recorded score for the set, and the score on this attempt. - $self->{recordedScore} = 0; - $self->{totalPossible} = 0; + $c->{recordedScore} = 0; + $c->{totalPossible} = 0; for (@problems) { my $pv = $_->value // 1; - $self->{totalPossible} += $pv; - $self->{recordedScore} += $_->status * $pv if defined $_->status; - push(@probStatus, ($r->param('probstatus' . $_->problem_id) || $_->status || 0)); + $c->{totalPossible} += $pv; + $c->{recordedScore} += $_->status * $pv if defined $_->status; + push(@probStatus, ($c->param('probstatus' . $_->problem_id) || $_->status || 0)); } # To get the attempt score, determine the score for each problem, and multiply the total for the problem by the # weight (value) of the problem. Avoid translating all of the problems when checking answers. # Note that it is okay to ignore problem order here as all arrays used are index the same. - $self->{attemptScore} = 0; + $c->{attemptScore} = 0; if ($will{recordAnswers} || $will{checkAnswers}) { my $i = 0; for my $pg (@pg_results) { @@ -1283,103 +1256,90 @@ async sub pre_header_initialize { my $pScore = 0; if (ref $pg) { # If a pg object is available, then use the pg recorded score and save it in the @probStatus array. - $pScore = compute_reduced_score($ce, $problems[$i], $set, $pg->{state}{recorded_score}, $r->submitTime); + $pScore = compute_reduced_score($ce, $problems[$i], $set, $pg->{state}{recorded_score}, $c->submitTime); $probStatus[$i] = $pScore if $pScore > $probStatus[$i]; } else { # If a pg object is not available, then use the saved problem status. $pScore = $probStatus[$i]; } - $self->{attemptScore} += $pScore * $pValue; + $c->{attemptScore} += $pScore * $pValue; $i++; } - $self->{attemptScore} = wwRound(2, $self->{attemptScore}); + $c->{attemptScore} = wwRound(2, $c->{attemptScore}); } - $self->{probStatus} = \@probStatus; + $c->{probStatus} = \@probStatus; # To compute the elapsed time, take into account the last submission time or the current time if the test hasn't # been submitted. Also, if the submission is during the grace period, then round it to the due date. - $self->{exceededAllowedTime} = 0; + $c->{exceededAllowedTime} = 0; my $endTime = $set->version_last_attempt_time ? $set->version_last_attempt_time : $timeNowInt; if ($endTime > $set->due_date && $endTime < $set->due_date + $ce->{gatewayGracePeriod}) { $endTime = $set->due_date; } elsif ($endTime > $set->due_date) { - $self->{exceededAllowedTime} = 1; + $c->{exceededAllowedTime} = 1; } - $self->{elapsedTime} = int(($endTime - $set->open_date) / 0.6 + 0.5) / 100; + $c->{elapsedTime} = int(($endTime - $set->open_date) / 0.6 + 0.5) / 100; # Get the number of attempts and number of remaining attempts. - $self->{attemptNumber} = - $problem->num_correct + $problem->num_incorrect + ($self->{submitAnswers} && $will{recordAnswers} ? 1 : 0); - $self->{numAttemptsLeft} = ($set->attempts_per_version || 0) - $self->{attemptNumber}; + $c->{attemptNumber} = + $problem->num_correct + $problem->num_incorrect + ($c->{submitAnswers} && $will{recordAnswers} ? 1 : 0); + $c->{numAttemptsLeft} = ($set->attempts_per_version || 0) - $c->{attemptNumber}; return; } -sub head { - my ($self) = @_; - return '' unless ref $self->r->stash->{pg_results} eq 'ARRAY'; +sub head ($c) { + return '' unless ref $c->stash->{pg_results} eq 'ARRAY'; my $head_text = ''; - for (@{ $self->r->stash->{pg_results} }) { + for (@{ $c->stash->{pg_results} }) { next unless ref $_; $head_text .= $_->{head_text} if $_->{head_text}; } return $head_text; } -sub path { - my ($self, $args) = @_; - - my $r = $self->r; - my $ce = $self->{ce}; - my $setID = $r->urlpath->arg('setID'); - my $root = $ce->{webworkURLs}{root}; +sub path ($c, $args) { + my $ce = $c->ce; + my $setID = $c->stash('setID'); my $courseName = $ce->{courseName}; - my $navigation_allowed = $r->authz->hasPermissions($r->param('user'), 'navigation_allowed'); + my $navigation_allowed = $c->authz->hasPermissions($c->param('user'), 'navigation_allowed'); - return $self->pathMacro( + return $c->pathMacro( $args, - 'WeBWorK' => $navigation_allowed ? $root : '', - $courseName => $navigation_allowed ? "$root/$courseName" : '', - $setID eq 'Undefined_Set' || $self->{invalidSet} + 'WeBWorK' => $navigation_allowed ? $c->url_for('root') : '', + $courseName => $navigation_allowed ? $c->url_for('set_list') : '', + $setID eq 'Undefined_Set' || $c->{invalidSet} ? ($setID => '') : ( - $self->{set}->set_id => "$root/" - . $r->urlpath->newFromModule( - 'WeBWorK::ContentGenerator::ProblemSet', $r, - courseID => $courseName, - setID => $self->{set}->set_id - )->path, - 'v' . $self->{set}->version_id => '' + $c->{set}->set_id => $c->url_for('problem_list', setID => $c->{set}->set_id), + 'v' . $c->{set}->version_id => '' ), ); } -sub nav { - my ($self, $args) = @_; - my $r = $self->r; - my $db = $r->db; - my $userID = $r->param('user'); - my $effectiveUserID = $r->param('effectiveUser'); +sub nav ($c, $args) { + my $db = $c->db; + my $userID = $c->param('user'); + my $effectiveUserID = $c->param('effectiveUser'); - return '' if $self->{invalidSet}; + return '' if $c->{invalidSet}; # Set up and display a student navigation for those that have permission to act as a student. - if ($r->authz->hasPermissions($userID, 'become_student') && $effectiveUserID ne $userID) { - my $setID = $self->{set}->set_id; + if ($c->authz->hasPermissions($userID, 'become_student') && $effectiveUserID ne $userID) { + my $setID = $c->{set}->set_id; return '' if $setID eq 'Undefined_Set'; - my $setVersion = $self->{set}->version_id; - my $courseName = $self->{ce}{courseName}; + my $setVersion = $c->{set}->version_id; # Find all versions of this set that have been taken (excluding those taken by the current user). my @users = $db->listSetVersionsWhere({ user_id => { not_like => $userID }, set_id => { like => "$setID,v\%" } }); my @allUserRecords = $db->getUsers(map { $_->[0] } @users); - my $filter = $r->param('studentNavFilter'); + my $filter = $c->param('studentNavFilter'); # Format the student names for display, and associate the users with the test versions. my %filters; @@ -1389,11 +1349,11 @@ sub nav { # recitation. This user will be switched to when the filter is selected. my $section = $allUserRecords[$_]->section; $filters{"section:$section"} = - [ $r->maketext('Filter by section [_1]', $section), $allUserRecords[$_]->user_id, $users[$_][2] ] + [ $c->maketext('Filter by section [_1]', $section), $allUserRecords[$_]->user_id, $users[$_][2] ] if $section && !$filters{"section:$section"}; my $recitation = $allUserRecords[$_]->recitation; $filters{"recitation:$recitation"} = - [ $r->maketext('Filter by recitation [_1]', $recitation), $allUserRecords[$_]->user_id, $users[$_][2] ] + [ $c->maketext('Filter by recitation [_1]', $recitation), $allUserRecords[$_]->user_id, $users[$_][2] ] if $recitation && !$filters{"recitation:$recitation"}; # Only keep this user if it satisfies the selected filter if a filter was selected. @@ -1435,77 +1395,61 @@ sub nav { $userRecords[$currentTestIndex]{currentTest} = 1; # Show the student nav. - return $r->include( + return $c->include( 'ContentGenerator/GatewayQuiz/nav', userRecords => \@userRecords, setVersion => $setVersion, prevTest => $prevTest, nextTest => $nextTest, currentTestIndex => $currentTestIndex, - setPage => $r->urlpath->newFromModule(__PACKAGE__, $r, courseID => $courseName, setID => "$setID,v%s"), - filters => \%filters, - filter => $filter + filters => \%filters, + filter => $filter ); } } -sub warningMessage { - my $self = shift; - return $self->r->maketext('Warning: There may be something wrong with a question in this test. ' +sub warningMessage ($c) { + return $c->maketext('Warning: There may be something wrong with a question in this test. ' . 'Please inform your instructor including the warning messages below.'); } # Evaluation utility -async sub getProblemHTML { - my ($self, $effectiveUser, $set, $formFields, $mergedProblem, $pgFile) = @_; - # $effectiveUser is the current effective user, $set is the merged set version, $formFields is a reference to the - # hash of parameters from the input form that need to be passed to the translator, and $mergedProblem and $pgFile - # are what we'd expect. $pgFile is optional. The translated problem is returned. - - my $r = $self->r; +# $effectiveUser is the current effective user, $set is the merged set version, $formFields is a reference to the +# hash of parameters from the input form that need to be passed to the translator, and $mergedProblem +# is what we'd expect. +async sub getProblemHTML ($c, $effectiveUser, $set, $formFields, $mergedProblem) { my $setID = $set->set_id; my $setVersionNumber = $set->version_id; - if ((!defined $mergedProblem || !$mergedProblem->problem_id) && $pgFile) { - $mergedProblem = WeBWorK::DB::Record::ProblemVersion->new( - set_id => $setID, - version_id => $setVersionNumber, - problem_id => 0, - login_id => $effectiveUser->user_id, - source_file => $pgFile, - # The rest of problem fields are not needed. - ); - } - # Figure out solutions are allowed and call renderPG accordingly. - my $showCorrectAnswers = $self->{will}{showCorrectAnswers}; - my $showHints = $self->{will}{showHints}; - my $showSolutions = $self->{will}{showSolutions}; - my $processAnswers = $self->{will}{checkAnswers}; + my $showCorrectAnswers = $c->{will}{showCorrectAnswers}; + my $showHints = $c->{will}{showHints}; + my $showSolutions = $c->{will}{showSolutions}; + my $processAnswers = $c->{will}{checkAnswers}; # FIXME: I'm not sure that problem_id is what we want here. my $problemNumber = $mergedProblem->problem_id; my $pg = await renderPG( - $r, + $c, $effectiveUser, $set, $mergedProblem, $set->psvn, $formFields, { - displayMode => $self->{displayMode}, + displayMode => $c->{displayMode}, showHints => $showHints, showSolutions => $showSolutions, refreshMath2img => $showHints || $showSolutions, processAnswers => 1, QUIZ_PREFIX => 'Q' . sprintf('%04d', $problemNumber) . '_', - useMathQuill => $self->{will}{useMathQuill}, - useMathView => $self->{will}{useMathView}, - useWirisEditor => $self->{will}{useWirisEditor}, + useMathQuill => $c->{will}{useMathQuill}, + useMathView => $c->{will}{useMathView}, + useWirisEditor => $c->{will}{useWirisEditor}, forceScaffoldsOpen => 1, - isInstructor => $r->authz->hasPermissions($self->{userID}, 'view_answers'), - debuggingOptions => getTranslatorDebuggingOptions($r->authz, $self->{userID}) + isInstructor => $c->authz->hasPermissions($c->{userID}, 'view_answers'), + debuggingOptions => getTranslatorDebuggingOptions($c->authz, $c->{userID}) }, ); @@ -1514,7 +1458,7 @@ async sub getProblemHTML { warn $pg->{warnings} if $pg->{warnings}; if ($pg->{flags}{error_flag}) { - push @{ $self->{errors} }, + push @{ $c->{errors} }, { set => "$setID,v$setVersionNumber", problem => $mergedProblem->problem_id, diff --git a/lib/WeBWorK/ContentGenerator/Grades.pm b/lib/WeBWorK/ContentGenerator/Grades.pm index 5c587dcb0a..7c0a9e4d1d 100644 --- a/lib/WeBWorK/ContentGenerator/Grades.pm +++ b/lib/WeBWorK/ContentGenerator/Grades.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::Grades; -use parent qw(WeBWorK::ContentGenerator); +use Mojo::Base 'WeBWorK::ContentGenerator', -signatures; =head1 NAME @@ -22,28 +22,19 @@ WeBWorK::ContentGenerator::Grades - Display statistics by user. =cut -use strict; -use warnings; - use WeBWorK::Utils qw(jitar_id_to_seq wwRound after grade_set format_set_name_display); use WeBWorK::Localize; -sub initialize { - my $self = shift; - my $r = $self->r; - - $self->{studentID} = $r->param('effectiveUser') // $r->param('user'); - +sub initialize ($c) { + $c->{studentID} = $c->param('effectiveUser') // $c->param('user'); return; } -sub scoring_info { - my ($self) = @_; - my $r = $self->r; - my $db = $r->db; - my $ce = $r->ce; +sub scoring_info ($c) { + my $db = $c->db; + my $ce = $c->ce; - my $user = $db->getUser($self->{studentID}); + my $user = $db->getUser($c->{studentID}); return '' unless $user; my $message_file = 'report_grades.msg'; @@ -52,8 +43,8 @@ sub scoring_info { # Return if the files don't exist. if (!(-e "$ce->{courseDirs}{scoring}/$merge_file" && -e "$filePath")) { - if ($r->authz->hasPermissions($r->param('user'), 'access_instructor_tools')) { - return $r->maketext( + if ($c->authz->hasPermissions($c->param('user'), 'access_instructor_tools')) { + return $c->maketext( 'There is no additional grade information. A message about additional grades can go in ' . '~[TMPL~]/email/[_1]. It is merged with the file ~[Scoring~]/[_2]. These files can be ' . 'edited using the "Email" link and the "File Manager" link in the left margin.', @@ -64,7 +55,7 @@ sub scoring_info { } } - my $rh_merge_data = $self->read_scoring_file($merge_file, ','); + my $rh_merge_data = $c->read_scoring_file($merge_file); my $text; my $header = ''; if (-e $filePath and -r $filePath) { @@ -76,7 +67,7 @@ sub scoring_info { close($FILE); } else { return r->c('There is no additional grade information.', - $r->tag('br'), "The message file $filePath cannot be found.")->join(''); + $c->tag('br'), "The message file $filePath cannot be found.")->join(''); } my $status_name = $ce->status_abbrev_to_name($user->status); @@ -118,18 +109,18 @@ sub scoring_info { $msg =~ s/\r//g; $msg =~ s/\n/
      /g; - my $output = $r->c($r->tag( + my $output = $c->c($c->tag( 'div', class => 'additional-scoring-msg card bg-light p-2', - $r->c($r->tag('h3', $r->maketext('Scoring Message')), $msg)->join('') + $c->c($c->tag('h3', $c->maketext('Scoring Message')), $msg)->join('') )); push( @$output, - $r->tag( + $c->tag( 'div', class => 'mt-2', - $r->maketext( + $c->maketext( 'This scoring message is generated from ~[TMPL~]/email/[_1]. It is merged with the file ' . '~[Scoring~]/[_2]. These files can be edited using the "Email" link and the "File Manager" ' . 'link in the left margin.', @@ -137,21 +128,19 @@ sub scoring_info { $merge_file ) ) - ) if $r->authz->hasPermissions($r->param('user'), 'access_instructor_tools'); + ) if $c->authz->hasPermissions($c->param('user'), 'access_instructor_tools'); return $output->join(''); } -sub displayStudentStats { - my ($self, $studentID) = @_; - my $r = $self->r; - my $db = $r->db; - my $ce = $r->ce; - my $authz = $r->authz; +sub displayStudentStats ($c, $studentID) { + my $db = $c->db; + my $ce = $c->ce; + my $authz = $c->authz; my $studentRecord = $db->getUser($studentID); unless ($studentRecord) { - $self->addbadmessage($r->maketext('Record for user [_1] not found.', $studentID)); + $c->addbadmessage($c->maketext('Record for user [_1] not found.', $studentID)); return ''; } @@ -220,13 +209,10 @@ sub displayStudentStats { my $numGatewayVersions = 0; my $bestGatewayScore = 0; - my $rows = $r->c; + my $rows = $c->c; for my $setID (@allSetIDs) { my $act_as_student_set_url = - "$ce->{webworkURLs}{root}/$courseName/$setID/?user=" - . $r->param('user') - . "&effectiveUser=$effectiveUser&key=" - . $r->param('key'); + $c->systemLink($c->url_for('problem_list', setID => $setID), params => { effectiveUser => $effectiveUser }); my $set = $setsByID{$setID}; # If the set is a template gateway set and there are no versions, we acknowledge that the set exists and the @@ -234,14 +220,14 @@ sub displayStudentStats { if (defined $setVersionsCount{$setID}) { next if $setVersionsCount{$setID}; push @$rows, - $r->tag( + $c->tag( 'tr', - $r->c( - $r->tag('td', dir => 'ltr', format_set_name_display($setID)), - $r->tag( + $c->c( + $c->tag('td', dir => 'ltr', format_set_name_display($setID)), + $c->tag( 'td', colspan => $max_problems + 3, - $r->tag('em', $r->maketext('No versions of this assignment have been taken.')) + $c->tag('em', $c->maketext('No versions of this assignment have been taken.')) ) )->join('') ); @@ -254,25 +240,25 @@ sub displayStudentStats { && $set->assignment_type =~ /gateway/ && defined $set->hide_score && ( - !$authz->hasPermissions($r->param('user'), 'view_hidden_work') + !$authz->hasPermissions($c->param('user'), 'view_hidden_work') && ($set->hide_score eq 'Y' || ($set->hide_score eq 'BeforeAnswerDate' && time < $set->answer_date)) ) ) { push( @$rows, - $r->tag( + $c->tag( 'tr', - $r->c( - $r->tag( + $c->c( + $c->tag( 'td', dir => 'ltr', format_set_name_display($setID) . ' (version ' . $set->version_id . ')' ), - $r->tag( + $c->tag( 'td', colspan => $max_problems + 3, - $r->tag('em', $r->maketext('Display of scores for this set is not allowed.')) + $c->tag('em', $c->maketext('Display of scores for this set is not allowed.')) ) )->join('') ) @@ -300,7 +286,7 @@ sub displayStudentStats { my $show_problem_scores = 1; if (defined $set->hide_score_by_problem - && !$authz->hasPermissions($r->param('user'), 'view_hidden_work') + && !$authz->hasPermissions($c->param('user'), 'view_hidden_work') && $set->hide_score_by_problem eq 'Y') { $show_problem_scores = 0; @@ -310,19 +296,19 @@ sub displayStudentStats { my $score = defined $problem_scores->[$i] && $show_problem_scores ? $problem_scores->[$i] : ''; push( @html_prob_scores, - $r->tag( + $c->tag( 'td', class => 'problem-data', - $r->c( - $r->tag( + $c->c( + $c->tag( 'span', class => $score eq '100' ? 'correct' : $score eq ' . ' ? 'unattempted' : '', - $r->b($score) + $c->b($score) ), - $r->tag('br'), + $c->tag('br'), (defined $problem_incorrect_attempts->[$i] && $show_problem_scores) ? $problem_incorrect_attempts->[$i] - : $r->b(' ') + : $c->b(' ') )->join('') ) ); @@ -369,24 +355,24 @@ sub displayStudentStats { } } - push @$rows, $r->tag( + push @$rows, $c->tag( 'tr', - $r->c( - $r->tag( + $c->c( + $c->tag( 'th', scope => 'row', dir => 'ltr', - $r->link_to(format_set_name_display($setID) => $act_as_student_set_url) + $c->link_to(format_set_name_display($setID) => $act_as_student_set_url) ), - $r->tag('td', $r->tag('span', class => $class, $totalRightPercent . '%')), - $r->tag('td', sprintf('%0.2f', $totalRight)), # score - $r->tag('td', $total), # out of + $c->tag('td', $c->tag('span', class => $class, $totalRightPercent . '%')), + $c->tag('td', sprintf('%0.2f', $totalRight)), # score + $c->tag('td', $total), # out of @html_prob_scores # problems )->join('') ); } - return $r->include( + return $c->include( 'ContentGenerator/Grades/student_stats', fullName => $fullName, max_problems => $max_problems, diff --git a/lib/WeBWorK/ContentGenerator/Hardcopy.pm b/lib/WeBWorK/ContentGenerator/Hardcopy.pm index be86f9554a..02721520a9 100644 --- a/lib/WeBWorK/ContentGenerator/Hardcopy.pm +++ b/lib/WeBWorK/ContentGenerator/Hardcopy.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::Hardcopy; -use parent qw(WeBWorK::ContentGenerator); +use Mojo::Base 'WeBWorK::ContentGenerator', -signatures, -async_await; =head1 NAME @@ -23,12 +23,8 @@ problem sets. =cut -use strict; -use warnings; - use File::Path; use File::Temp qw/tempdir/; -use Future::AsyncAwait; use String::ShellQuote; use Archive::Zip qw(:ERROR_CODES); @@ -62,7 +58,7 @@ our %HC_FORMATS = ( ); our @HC_FORMAT_DISPLAY_ORDER = ('tex', 'pdf'); -# custom fields used in $self hash +# custom fields used in $c hash # FOR HEAVEN'S SAKE, PLEASE KEEP THIS UP-TO-DATE! # # file_path @@ -117,25 +113,23 @@ our @HC_FORMAT_DISPLAY_ORDER = ('tex', 'pdf'); # UI subroutines ################################################################################ -async sub pre_header_initialize { - my $self = shift; - my $r = $self->r; - my $ce = $r->ce; - my $db = $r->db; - my $authz = $r->authz; +async sub pre_header_initialize ($c) { + my $ce = $c->ce; + my $db = $c->db; + my $authz = $c->authz; - my $userID = $r->param('user'); - my $eUserID = $r->param('effectiveUser'); - my @setIDs = $r->param('selected_sets'); - my @userIDs = $r->param('selected_users'); - my $hardcopy_format = $r->param('hardcopy_format'); - my $generate_hardcopy = $r->param('generate_hardcopy'); + my $userID = $c->param('user'); + my $eUserID = $c->param('effectiveUser'); + my @setIDs = $c->param('selected_sets'); + my @userIDs = $c->param('selected_users'); + my $hardcopy_format = $c->param('hardcopy_format'); + my $generate_hardcopy = $c->param('generate_hardcopy'); # This should never happen, but apparently it did once (see bug #714), so we check for it. die 'Parameter "user" not defined -- this should never happen' unless defined $userID; # Check to see if the user is authorized to view source file paths. - $self->{can_show_source_file} = + $c->{can_show_source_file} = ($db->getPermissionLevel($userID)->permission >= $ce->{pg}{specialPGEnvironmentVars}{PRINT_FILE_NAMES_PERMISSION_LEVEL}) || (grep { $_ eq $userID } @{ $ce->{pg}{specialPGEnvironmentVars}{PRINT_FILE_NAMES_FOR} }); @@ -148,28 +142,28 @@ async sub pre_header_initialize { # Make sure the format is valid. unless (grep { $_ eq $hardcopy_format } keys %HC_FORMATS) { - $self->addbadmessage(qq{"$hardcopy_format" is not a valid hardcopy format.}); + $c->addbadmessage(qq{"$hardcopy_format" is not a valid hardcopy format.}); $validation_failed = 1; } # Make sure we are allowed to generate hardcopy in this format. unless ($authz->hasPermissions($userID, "download_hardcopy_format_$hardcopy_format")) { - $self->addbadmessage( - $r->maketext('You do not have permission to generate hardcopy in [_1] format.', $hardcopy_format)); + $c->addbadmessage( + $c->maketext('You do not have permission to generate hardcopy in [_1] format.', $hardcopy_format)); $validation_failed = 1; } # Make sure we are allowed to use this hardcopy theme. unless ($authz->hasPermissions($userID, 'download_hardcopy_change_theme') - || !defined($r->param('hardcopy_theme'))) + || !defined($c->param('hardcopy_theme'))) { - $self->addbadmessage($r->maketext('You do not have permission to change the hardcopy theme.')); + $c->addbadmessage($c->maketext('You do not have permission to change the hardcopy theme.')); $validation_failed = 1; } # Is there at least one user selected? unless (@userIDs) { - $self->addbadmessage($r->maketext('Please select at least one user and try again.')); + $c->addbadmessage($c->maketext('Please select at least one user and try again.')); $validation_failed = 1; } @@ -178,7 +172,7 @@ async sub pre_header_initialize { # When professors don't select any sets the size of @setIDs is 0. # The following test catches both cases and prevents warning messages in the case of a professor's empty array. unless (@setIDs && $setIDs[0] =~ /\S+/) { - $self->addbadmessage($r->maketext('Please select at least one set and try again.')); + $c->addbadmessage($c->maketext('Please select at least one set and try again.')); $validation_failed = 1; } @@ -192,17 +186,17 @@ async sub pre_header_initialize { my $perm_viewunopened = $authz->hasPermissions($userID, 'view_unopened_sets'); if (@setIDs > 1 && !$perm_multiset) { - $self->addbadmessage('You are not permitted to generate hardcopy for multiple sets. ' + $c->addbadmessage('You are not permitted to generate hardcopy for multiple sets. ' . 'Please select a single set and try again.'); $validation_failed = 1; } if (@userIDs > 1 && !$perm_multiuser) { - $self->addbadmessage('You are not permitted to generate hardcopy for multiple users. ' + $c->addbadmessage('You are not permitted to generate hardcopy for multiple users. ' . 'Please select a single user and try again.'); $validation_failed = 1; } if (@userIDs && $userIDs[0] ne $eUserID && !$perm_multiuser) { - $self->addbadmessage('You are not permitted to generate hardcopy for other users.'); + $c->addbadmessage('You are not permitted to generate hardcopy for other users.'); $validation_failed = 1; # FIXME: Download_hardcopy_multiuser controls both whether a user can generate hardcopy # that contains sets for multiple users AND whether the user can generate hardcopy that contains @@ -239,8 +233,8 @@ async sub pre_header_initialize { ) { $validation_failed = 1; - $self->addbadmessage( - $r->maketext('You are not permitted to generate a hardcopy for an unopened set.')); + $c->addbadmessage( + $c->maketext('You are not permitted to generate a hardcopy for an unopened set.')); last; } @@ -253,8 +247,8 @@ async sub pre_header_initialize { ) { $validation_failed = 1; - $self->addbadmessage( - $r->maketext( + $c->addbadmessage( + $c->maketext( 'You are not permitted to generate a hardcopy for a set with hidden work.') ); last; @@ -262,9 +256,9 @@ async sub pre_header_initialize { if ($authz->invalidIPAddress($userSet)) { $validation_failed = 1; - $self->addbadmessage($r->maketext( + $c->addbadmessage($c->maketext( 'You are not allowed to generate a hardcopy for [_1] from your IP address, [_2].', - $userSet->set_id, $r->useragent_ip + $userSet->set_id, $c->tx->remote_address )); last; } @@ -279,35 +273,35 @@ async sub pre_header_initialize { } unless ($validation_failed) { - $self->{canShowScore} = \%canShowScore; - $self->{mergedSets} = \%mergedSets; - my $result = await $self->generate_hardcopy($hardcopy_format, \@userIDs, \@setIDs); - if ($self->has_errors) { + $c->{canShowScore} = \%canShowScore; + $c->{mergedSets} = \%mergedSets; + my $result = await $c->generate_hardcopy($hardcopy_format, \@userIDs, \@setIDs); + if ($c->has_errors) { # Store the result data in self hash so that body() can make a link to it. - $self->{file_path} = $result->{file_path}; - $self->{temp_file_map} = $result->{temp_file_map}; + $c->{file_path} = $result->{file_path}; + $c->{temp_file_map} = $result->{temp_file_map}; } else { # Send the file only (it is deleted from the server after it is sent). - $self->reply_with_file($result->{file_type}, $result->{file_path}, $result->{file_name}, 1); + $c->reply_with_file($result->{file_type}, $result->{file_path}, $result->{file_name}, 1); } } return; } - my $tempFile = $r->param('tempFilePath'); + my $tempFile = $c->param('tempFilePath'); if ($tempFile) { - my $courseID = $r->urlpath->arg('courseID'); + my $courseID = $c->stash('courseID'); my $baseName = $tempFile =~ s/.*\/([^\/]*)$/$1/r; my $fullFilePath = "$ce->{webworkDirs}{tmp}/$courseID/hardcopy/$userID/$tempFile"; unless (-e $fullFilePath) { - $self->addbadmessage($r->maketext('The requested file "[_1]" does not exist on the server.', $tempFile)); + $c->addbadmessage($c->maketext('The requested file "[_1]" does not exist on the server.', $tempFile)); return; } unless ($baseName =~ /\.$userID\./ || $authz->hasPermissions($userID, 'download_hardcopy_multiuser')) { - $self->addbadmessage($r->maketext('You do not have permission to access the requested file "[_1]".'), + $c->addbadmessage($c->maketext('You do not have permission to access the requested file "[_1]".'), $tempFile); return; } @@ -318,35 +312,33 @@ async sub pre_header_initialize { $type = 'application/pdf' if $baseName =~ m/\.pdf/; $type = 'application/zip' if $baseName =~ m/\.zip/; - $self->reply_with_file($type, $fullFilePath, $baseName); + $c->reply_with_file($type, $fullFilePath, $baseName); } return; } -sub display_form { - my ($self) = @_; - my $r = $self->r; - my $db = $r->db; - my $ce = $r->ce; - my $authz = $r->authz; - my $userID = $r->param("user"); - my $eUserID = $r->param("effectiveUser"); +sub display_form ($c) { + my $db = $c->db; + my $ce = $c->ce; + my $authz = $c->authz; + my $userID = $c->param("user"); + my $eUserID = $c->param("effectiveUser"); # first time we show up here, fill in some values - unless ($r->param("in_hc_form")) { + unless ($c->param("in_hc_form")) { # if a set was passed in via the path_info, add that to the list of sets. - my $singleSet = $r->urlpath->arg("setID"); + my $singleSet = $c->stash('setID'); if (defined $singleSet && $singleSet ne '') { - my @selected_sets = $r->param("selected_sets"); - $r->param("selected_sets" => [ @selected_sets, $singleSet ]) + my @selected_sets = $c->param("selected_sets"); + $c->param("selected_sets" => [ @selected_sets, $singleSet ]) unless grep { $_ eq $singleSet } @selected_sets; } # if no users are selected, select the effective user - my @selected_users = $r->param("selected_users"); + my @selected_users = $c->param("selected_users"); unless (@selected_users) { - $r->param("selected_users" => $eUserID); + $c->param("selected_users" => $eUserID); } } @@ -366,7 +358,7 @@ sub display_form { } # get format names hash for radio buttons - my %format_labels = map { $_ => $r->maketext($HC_FORMATS{$_}{name}) || $_ } @formats; + my %format_labels = map { $_ => $c->maketext($HC_FORMATS{$_}{name}) || $_ } @formats; my $canShowCorrectAnswers = 0; @@ -405,7 +397,7 @@ sub display_form { } else { # single user mode $user = $db->getUser($eUserID); - $selected_set_id = $r->param("selected_sets") // ''; + $selected_set_id = $c->param("selected_sets") // ''; $user_id = $user->user_id; @@ -448,7 +440,7 @@ sub display_form { $selected_set_id =~ s/,v(\d+)$/ (version $1)/; } - return $r->include( + return $c->include( 'ContentGenerator/Hardcopy/form', canShowCorrectAnswers => $canShowCorrectAnswers, multiuser => $perm_multiuser && $perm_multiset, @@ -470,43 +462,41 @@ sub display_form { # harddcopy generating subroutines ################################################################################ -async sub generate_hardcopy { - my ($self, $format, $userIDsRef, $setIDsRef) = @_; - my $r = $self->r; - my $ce = $r->ce; - my $db = $r->db; - my $authz = $r->authz; +async sub generate_hardcopy ($c, $format, $userIDsRef, $setIDsRef) { + my $ce = $c->ce; + my $db = $c->db; + my $authz = $c->authz; - my $courseID = $r->urlpath->arg('courseID'); - my $userID = $r->param('user'); + my $courseID = $c->stash('courseID'); + my $userID = $c->param('user'); # Create the temporary directory. Use mkpath to ensure it exists (mkpath is pretty much `mkdir -p`). my $temp_dir_parent_path = "$ce->{webworkDirs}{tmp}/$courseID/hardcopy/$userID"; eval { mkpath($temp_dir_parent_path) }; if ($@) { - $self->add_error("Couldn't create hardcopy directory $temp_dir_parent_path: ", $r->tag('code', $@)); + $c->add_error("Couldn't create hardcopy directory $temp_dir_parent_path: ", $c->tag('code', $@)); return; } # Create a randomly named working directory in the hardcopy directory. my $temp_dir_path = eval { tempdir('work.XXXXXXXX', DIR => $temp_dir_parent_path) }; if ($@) { - $self->add_error(q{Couldn't create temporary working directory: }, $r->tag('code', $@)); + $c->add_error(q{Couldn't create temporary working directory: }, $c->tag('code', $@)); return; } # Do some error checking. unless (-e $temp_dir_path) { - $self->add_error( + $c->add_error( 'Temporary directory "', - $r->tag('code', $temp_dir_path), + $c->tag('code', $temp_dir_path), q{" does not exist, but creation didn't fail. This shouldn't happen.} ); return; } unless (-w $temp_dir_path) { - $self->add_error('Temporary directory "', $r->tag('code', $temp_dir_path), '" is not writeable.'); - $self->delete_temp_dir($temp_dir_path); + $c->add_error('Temporary directory "', $c->tag('code', $temp_dir_path), '" is not writeable.'); + $c->delete_temp_dir($temp_dir_path); return; } @@ -516,37 +506,32 @@ async sub generate_hardcopy { # Create TeX file. if (open my $FH, '>:encoding(UTF-8)', $tex_file_path) { - await $self->write_multiuser_tex($FH, $userIDsRef, $setIDsRef); + await $c->write_multiuser_tex($FH, $userIDsRef, $setIDsRef); close $FH; } else { - $self->add_error( - 'Failed to open file "', - $r->tag('code', $tex_file_path), - '" for writing: ', - $r->tag('code', $!) - ); - $self->delete_temp_dir($temp_dir_path); + $c->add_error('Failed to open file "', $c->tag('code', $tex_file_path), '" for writing: ', $c->tag('code', $!)); + $c->delete_temp_dir($temp_dir_path); return; } # If no problems were successfully rendered, we can't continue. - unless ($self->{at_least_one_problem_rendered_without_error}) { - $self->add_error(q{No problems rendered. Can't continue.}); - $self->delete_temp_dir($temp_dir_path); + unless ($c->{at_least_one_problem_rendered_without_error}) { + $c->add_error(q{No problems rendered. Can't continue.}); + $c->delete_temp_dir($temp_dir_path); return; } # If the hardcopy.tex file was not generated, fail now. unless (-e "$temp_dir_path/hardcopy.tex") { - $self->add_error( + $c->add_error( '"', - $r->tag('code', 'hardcopy.tex'), + $c->tag('code', 'hardcopy.tex'), '" not written to temporary directory "', - $r->tag('code', $temp_dir_path), + $c->tag('code', $temp_dir_path), q{". Can't continue.} ); - $self->delete_temp_dir($temp_dir_path); + $c->delete_temp_dir($temp_dir_path); return; } @@ -562,7 +547,7 @@ async sub generate_hardcopy { # @temp_files is a list of temporary files of interest used by the subroutine. # (all are relative to $temp_dir_path) my $format_subr = $HC_FORMATS{$format}{subr}; - my ($final_file_name, @temp_files) = $self->$format_subr($temp_dir_path, $final_file_basename); + my ($final_file_name, @temp_files) = $c->$format_subr($temp_dir_path, $final_file_basename); my $final_file_path = "$temp_dir_path/$final_file_name"; # Calculate paths for each temp file of interest. These paths are relative to the $temp_dir_parent_path. @@ -572,12 +557,12 @@ async sub generate_hardcopy { # Make sure the final file exists. unless (-e $final_file_path) { - $self->add_error( + $c->add_error( 'Final hardcopy file "', - $r->tag('code', $final_file_path), + $c->tag('code', $final_file_path), "' not found after calling '", - $r->tag('code', $format_subr), - "': ", $r->tag('code', $!) + $c->tag('code', $format_subr), + "': ", $c->tag('code', $!) ); return { temp_file_map => \%temp_file_map }; } @@ -587,16 +572,16 @@ async sub generate_hardcopy { my $mv_cmd = '2>&1 ' . $ce->{externalPrograms}{mv} . ' ' . shell_quote($final_file_path, $final_file_final_path); my $mv_out = readpipe $mv_cmd; if ($?) { - $self->add_error( + $c->add_error( 'Failed to move hardcopy file "', - $r->tag('code', $final_file_name), + $c->tag('code', $final_file_name), '" from "', - $r->tag('code', $temp_dir_path), + $c->tag('code', $temp_dir_path), '" to "', - $r->tag('code', $temp_dir_parent_path), + $c->tag('code', $temp_dir_parent_path), '":', - $r->tag('br'), - $r->tag('pre', $mv_out) + $c->tag('br'), + $c->tag('pre', $mv_out) ); $final_file_final_path = "$temp_dir_rel_path/$final_file_name"; } @@ -604,10 +589,10 @@ async sub generate_hardcopy { # If there were any errors, then the final file will not be served directly, but will be served via reply_with_file # and the full file path will be built at that time. So the path needs to be relative to the temporary directory # parent path. - $final_file_final_path =~ s/^$temp_dir_parent_path\/// if ($self->has_errors); + $final_file_final_path =~ s/^$temp_dir_parent_path\/// if ($c->has_errors); # remove the temp directory if there are no errors - $self->delete_temp_dir($temp_dir_path) unless ($self->has_errors || $PreserveTempFiles); + $c->delete_temp_dir($temp_dir_path) unless ($c->has_errors || $PreserveTempFiles); warn "Preserved temporary files in directory '$temp_dir_path'.\n" if $PreserveTempFiles; @@ -620,17 +605,14 @@ async sub generate_hardcopy { } # helper function to remove temp dirs -sub delete_temp_dir { - my ($self, $temp_dir_path) = @_; - my $r = $self->r; - - my $rm_cmd = '2>&1 ' . $self->r->ce->{externalPrograms}{rm} . ' -rf ' . shell_quote($temp_dir_path); +sub delete_temp_dir ($c, $temp_dir_path) { + my $rm_cmd = '2>&1 ' . $c->ce->{externalPrograms}{rm} . ' -rf ' . shell_quote($temp_dir_path); my $rm_out = readpipe $rm_cmd; if ($?) { - $self->add_error( + $c->add_error( 'Failed to remove temporary directory "', - $r->tag('code', $temp_dir_path), - '":', $r->tag('br'), $r->tag('pre', $rm_out) + $c->tag('code', $temp_dir_path), + '":', $c->tag('br'), $c->tag('pre', $rm_out) ); } @@ -645,58 +627,55 @@ sub delete_temp_dir { # error (also located in $temp_dir_path). These are returned whether or not an error actually # occured. -sub generate_hardcopy_tex { - my ($self, $temp_dir_path, $final_file_basename) = @_; - my $r = $self->r; - +sub generate_hardcopy_tex ($c, $temp_dir_path, $final_file_basename) { my $src_name = "hardcopy.tex"; my $bundle_path = "$temp_dir_path/$final_file_basename"; # Create directory for the tex bundle if (!mkdir $bundle_path) { - $self->add_error( + $c->add_error( 'Failed to create directory "', - $r->tag('code', $bundle_path), - '": ', $r->tag('br'), $r->tag('pre', $!) + $c->tag('code', $bundle_path), + '": ', $c->tag('br'), $c->tag('pre', $!) ); return $src_name; } # Move the tex file into the bundle directory my $mv_cmd = - "2>&1 " . $self->r->ce->{externalPrograms}{mv} . " " . shell_quote("$temp_dir_path/$src_name", $bundle_path); + "2>&1 " . $c->ce->{externalPrograms}{mv} . " " . shell_quote("$temp_dir_path/$src_name", $bundle_path); my $mv_out = readpipe $mv_cmd; if ($?) { - $self->add_error( + $c->add_error( 'Failed to move "', - $r->tag('code', $src_name), + $c->tag('code', $src_name), '" into directory "', - $r->tag('code', $bundle_path), - '":', $r->tag('br'), $r->tag('pre', $mv_out) + $c->tag('code', $bundle_path), + '":', $c->tag('br'), $c->tag('pre', $mv_out) ); return $src_name; } # Copy the common tex files into the bundle directory - my $ce = $self->r->ce; + my $ce = $c->ce; for (qw{packages.tex CAPA.tex PGML.tex}) { my $cp_cmd = "2>&1 $ce->{externalPrograms}{cp} " . shell_quote("$ce->{webworkDirs}{texinputs_common}/$_", $bundle_path); my $cp_out = readpipe $cp_cmd; if ($?) { - $self->add_error( + $c->add_error( 'Failed to copy "', - $r->tag('code', "$ce->{webworkDirs}{texinputs_common}/$_"), + $c->tag('code', "$ce->{webworkDirs}{texinputs_common}/$_"), '" into directory "', - $r->tag('code', $bundle_path), - '":', $r->tag('br'), $r->tag('pre', $cp_out) + $c->tag('code', $bundle_path), + '":', $c->tag('br'), $c->tag('pre', $cp_out) ); } } # Attempt to copy image files used into the working directory. - my $resource_list = $self->{resource_list}; + my $resource_list = $c->{resource_list}; if (ref $resource_list eq 'ARRAY' && @$resource_list) { if (open(my $in_fh, "<", "$bundle_path/$src_name")) { local $/; @@ -711,12 +690,12 @@ sub generate_hardcopy_tex { my $cp_cmd = "2>&1 $ce->{externalPrograms}{cp} " . shell_quote($resource, $bundle_path); my $cp_out = readpipe $cp_cmd; if ($?) { - $self->add_error( + $c->add_error( 'Failed to copy image "', - $r->tag('code', $resource), + $c->tag('code', $resource), '" into directory "', - $r->tag('code', $bundle_path), - '":', $r->tag('br'), $r->tag('pre', $cp_out) + $c->tag('code', $bundle_path), + '":', $c->tag('br'), $c->tag('pre', $cp_out) ); } } @@ -727,7 +706,7 @@ sub generate_hardcopy_tex { print $out_fh $data; close $out_fh; } else { - $self->add_error('Failed to open "', $r->tag('code', "$bundle_path/$src_name"), '" for reading.'); + $c->add_error('Failed to open "', $c->tag('code', "$bundle_path/$src_name"), '" for reading.'); } } @@ -737,16 +716,14 @@ sub generate_hardcopy_tex { my $zip_file = "$final_file_basename.zip"; unless ($zip->writeToFileNamed("$temp_dir_path/$zip_file") == AZ_OK) { - $self->add_error('Failed to create zip archive of directory "', $r->tag('code', $bundle_path), '"'); + $c->add_error('Failed to create zip archive of directory "', $c->tag('code', $bundle_path), '"'); return "$bundle_path/$src_name"; } return $zip_file; } -sub find_log_first_error { - my $log = shift; - +sub find_log_first_error ($log) { my ($line, $first_error); while ($line = <$log>) { if ($first_error) { @@ -760,25 +737,22 @@ sub find_log_first_error { return $first_error; } -sub generate_hardcopy_pdf { - my ($self, $temp_dir_path, $final_file_basename) = @_; - my $r = $self->r; - +sub generate_hardcopy_pdf ($c, $temp_dir_path, $final_file_basename) { # call pdflatex - we don't want to chdir in the mod_perl process, as # that might step on the feet of other things (esp. in Apache 2.0) my $pdflatex_cmd = "cd " . shell_quote($temp_dir_path) . " && " . "TEXINPUTS=.:" - . shell_quote($self->r->ce->{webworkDirs}{texinputs_common}) . ": " - . $self->r->ce->{externalPrograms}{pdflatex} + . shell_quote($c->ce->{webworkDirs}{texinputs_common}) . ": " + . $c->ce->{externalPrograms}{pdflatex} . " >pdflatex.stdout 2>pdflatex.stderr hardcopy"; if (my $rawexit = system $pdflatex_cmd) { my $exit = $rawexit >> 8; my $signal = $rawexit & 127; my $core = $rawexit & 128; - $self->add_error( + $c->add_error( 'Failed to convert TeX to PDF with command "', - $r->tag('code', $pdflatex_cmd), + $c->tag('code', $pdflatex_cmd), qq{" (exit=$exit signal=$signal core=$core).} ); @@ -789,15 +763,15 @@ sub generate_hardcopy_pdf { my $first_error = find_log_first_error($LOG); close $LOG; if (defined $first_error) { - $self->add_error('First error in TeX log is:', $r->tag('br'), $r->tag('pre', $first_error)); + $c->add_error('First error in TeX log is:', $c->tag('br'), $c->tag('pre', $first_error)); } else { - $self->add_error('No errors encoundered in TeX log.'); + $c->add_error('No errors encoundered in TeX log.'); } } else { - $self->add_error('Could not read TeX log: ', $r->tag('code', $!)); + $c->add_error('Could not read TeX log: ', $c->tag('code', $!)); } } else { - $self->add_error('No TeX log was found.'); + $c->add_error('No TeX log was found.'); } } @@ -807,20 +781,20 @@ sub generate_hardcopy_pdf { my $src_name = "hardcopy.pdf"; my $dest_name = "$final_file_basename.pdf"; my $mv_cmd = "2>&1 " - . $self->r->ce->{externalPrograms}{mv} . " " + . $c->ce->{externalPrograms}{mv} . " " . shell_quote("$temp_dir_path/$src_name", "$temp_dir_path/$dest_name"); my $mv_out = readpipe $mv_cmd; if ($?) { - $self->add_error( + $c->add_error( 'Failed to rename "', - $r->tag('code', $src_name), + $c->tag('code', $src_name), '" to "', - $r->tag('code', $dest_name), + $c->tag('code', $dest_name), '" in directory "', - $r->tag('code', $temp_dir_path), + $c->tag('code', $temp_dir_path), '":', - $r->tag('br'), - $r->tag('pre', $mv_out) + $c->tag('br'), + $c->tag('pre', $mv_out) ); $final_file_name = $src_name; } else { @@ -834,79 +808,73 @@ sub generate_hardcopy_pdf { # TeX aggregating subroutines ################################################################################ -async sub write_multiuser_tex { - my ($self, $FH, $userIDsRef, $setIDsRef) = @_; - my $r = $self->r; - my $ce = $r->ce; +async sub write_multiuser_tex ($c, $FH, $userIDsRef, $setIDsRef) { + my $ce = $c->ce; my @userIDs = @$userIDsRef; my @setIDs = @$setIDsRef; # get snippets - my $theme = $r->param('hardcopy_theme') // $ce->{hardcopyTheme}; + my $theme = $c->param('hardcopy_theme') // $ce->{hardcopyTheme}; my $themeDir = $ce->{webworkDirs}->{conf} . '/snippets/hardcopyThemes/' . $theme; my $preamble = $ce->{webworkFiles}->{hardcopySnippets}->{preamble} // "$themeDir/hardcopyPreamble.tex"; my $postamble = $ce->{webworkFiles}->{hardcopySnippets}->{postamble} // "$themeDir/hardcopyPostamble.tex"; my $divider = $ce->{webworkFiles}->{hardcopySnippets}->{userDivider} // "$themeDir/hardcopyUserDivider.tex"; # write preamble - $self->write_tex_file($FH, $preamble); + $c->write_tex_file($FH, $preamble); # write section for each user while (defined(my $userID = shift @userIDs)) { - await $self->write_multiset_tex($FH, $userID, @setIDs); - $self->write_tex_file($FH, $divider) if @userIDs; # divide users, but not after the last user + await $c->write_multiset_tex($FH, $userID, @setIDs); + $c->write_tex_file($FH, $divider) if @userIDs; # divide users, but not after the last user } # write postamble - $self->write_tex_file($FH, $postamble); + $c->write_tex_file($FH, $postamble); return; } -async sub write_multiset_tex { - my ($self, $FH, $targetUserID, @setIDs) = @_; - my $r = $self->r; - my $ce = $r->ce; - my $db = $r->db; +async sub write_multiset_tex ($c, $FH, $targetUserID, @setIDs) { + my $ce = $c->ce; + my $db = $c->db; # get user record - my $TargetUser = $db->getUser($targetUserID); # checked + my $TargetUser = $db->getUser($targetUserID); unless ($TargetUser) { - $self->add_error( + $c->add_error( q{Can't generate hardcopy for user "}, - $r->tag('code', $targetUserID), + $c->tag('code', $targetUserID), qq{" -- no such user exists.\n} ); return; } # get set divider - my $theme = $r->param('hardcopy_theme') // $ce->{hardcopyTheme}; + my $theme = $c->param('hardcopy_theme') // $ce->{hardcopyTheme}; my $themeDir = $ce->{webworkDirs}->{conf} . '/snippets/hardcopyThemes/' . $theme; my $divider = $ce->{webworkFiles}->{hardcopySnippets}->{setDivider} // "$themeDir/hardcopySetDivider.tex"; # write each set while (defined(my $setID = shift @setIDs)) { - await $self->write_set_tex($FH, $TargetUser, $setID); - $self->write_tex_file($FH, $divider) if @setIDs; # divide sets, but not after the last set + await $c->write_set_tex($FH, $TargetUser, $setID); + $c->write_tex_file($FH, $divider) if @setIDs; # divide sets, but not after the last set } return; } -async sub write_set_tex { - my ($self, $FH, $TargetUser, $setID) = @_; - my $r = $self->r; - my $ce = $r->ce; - my $db = $r->db; - my $authz = $r->authz; - my $userID = $r->param("user"); +async sub write_set_tex ($c, $FH, $TargetUser, $setID) { + my $ce = $c->ce; + my $db = $c->db; + my $authz = $c->authz; + my $userID = $c->param("user"); # we may already have the MergedSet from checking hide_work and # hide_score in pre_header_initialize; check to see if that's true, # and otherwise, get the set. - my %mergedSets = %{ $self->{mergedSets} }; + my %mergedSets = %{ $c->{mergedSets} }; my $uid = $TargetUser->user_id; my $MergedSet; my $versioned = 0; @@ -925,14 +893,14 @@ async sub write_set_tex { } } # save versioned info for use in write_problem_tex - $self->{versioned} = $versioned; + $c->{versioned} = $versioned; unless ($MergedSet) { - $self->add_error( + $c->add_error( q{Can't generate hardcopy for set "}, - $r->tag('code', $setID), + $c->tag('code', $setID), '" for user "', - $r->tag('code', $TargetUser->user_id), + $c->tag('code', $TargetUser->user_id), '" -- set is not assigned to that user.' ); return; @@ -940,17 +908,17 @@ async sub write_set_tex { # see if the *real* user is allowed to access this problem set if ($MergedSet->open_date > time && !$authz->hasPermissions($userID, "view_unopened_sets")) { - $self->add_error( + $c->add_error( q{Can't generate hardcopy for set "}, - $r->tag('code', $setID), + $c->tag('code', $setID), '" for user "', - $r->tag('code', $TargetUser->user_id), + $c->tag('code', $TargetUser->user_id), '" -- set is not yet open.' ); return; } if (!$MergedSet->visible && !$authz->hasPermissions($userID, "view_hidden_sets")) { - $self->addbadmessage($r->maketext( + $c->addbadmessage($c->maketext( q{Can't generate hardcopy for set "[_1]" for user "[_2]". The set is not visible to students.}, $setID, $TargetUser->user_id, )); @@ -958,7 +926,7 @@ async sub write_set_tex { } # get snippets - my $theme = $r->param('hardcopy_theme') // $ce->{hardcopyTheme}; + my $theme = $c->param('hardcopy_theme') // $ce->{hardcopyTheme}; my $themeDir = $ce->{webworkDirs}->{conf} . '/snippets/hardcopyThemes/' . $theme; my $header = $MergedSet->hardcopy_header @@ -993,7 +961,7 @@ async sub write_set_tex { } # write set header - await $self->write_problem_tex($FH, $TargetUser, $MergedSet, 0, $header); # 0 => pg file specified directly + await $c->write_problem_tex($FH, $TargetUser, $MergedSet, 0, $header); # 0 => pg file specified directly print $FH "\\medskip\\hrule\\nobreak\\smallskip"; @@ -1002,28 +970,26 @@ async sub write_set_tex { # problem numbers my $i = 1; while (my $problemID = shift @problemIDs) { - $self->write_tex_file($FH, $divider) if $i > 1; - $self->{versioned} = $i if $versioned; - await $self->write_problem_tex($FH, $TargetUser, $MergedSet, $problemID); + $c->write_tex_file($FH, $divider) if $i > 1; + $c->{versioned} = $i if $versioned; + await $c->write_problem_tex($FH, $TargetUser, $MergedSet, $problemID); $i++; } # write footer - await $self->write_problem_tex($FH, $TargetUser, $MergedSet, 0, $footer); # 0 => pg file specified directly + await $c->write_problem_tex($FH, $TargetUser, $MergedSet, 0, $footer); # 0 => pg file specified directly return; } -async sub write_problem_tex { - my ($self, $FH, $TargetUser, $MergedSet, $problemID, $pgFile) = @_; - my $r = $self->r; - my $ce = $r->ce; - my $db = $r->db; - my $authz = $r->authz; - my $userID = $r->param("user"); - my $eUserID = $r->param("effectiveUser"); - my $versioned = $self->{versioned}; - my %canShowScore = %{ $self->{canShowScore} }; +async sub write_problem_tex ($c, $FH, $TargetUser, $MergedSet, $problemID = 0, $pgFile = undef) { + my $ce = $c->ce; + my $db = $c->db; + my $authz = $c->authz; + my $userID = $c->param("user"); + my $eUserID = $c->param("effectiveUser"); + my $versioned = $c->{versioned}; + my %canShowScore = %{ $c->{canShowScore} }; my @errors; @@ -1042,13 +1008,13 @@ async sub write_problem_tex { # handle nonexistent problem unless ($MergedProblem) { - $self->add_error( + $c->add_error( q{Can't generate hardcopy for problem "}, - $r->tag('code', $problemID), + $c->tag('code', $problemID), '" in set "', - $r->tag('code', $MergedSet->set_id), + $c->tag('code', $MergedSet->set_id), '" for user "', - $r->tag('code', $MergedSet->user_id), + $c->tag('code', $MergedSet->user_id), '" -- problem does not exist in that set or is not assigned to that user.' ); return; @@ -1073,11 +1039,11 @@ async sub write_problem_tex { # (eventually, we'd like to be able to use the same code as Problem) my $versionName = $MergedSet->set_id . (($versioned) ? ",v" . $MergedSet->version_id : ''); - my $showCorrectAnswers = $r->param("showCorrectAnswers") || 0; - my $printStudentAnswers = $r->param("printStudentAnswers") || 0; - my $showHints = $r->param("showHints") || 0; - my $showSolutions = $r->param("showSolutions") || 0; - my $showComments = $r->param("showComments") || 0; + my $showCorrectAnswers = $c->param("showCorrectAnswers") || 0; + my $printStudentAnswers = $c->param("printStudentAnswers") || 0; + my $showHints = $c->param("showHints") || 0; + my $showSolutions = $c->param("showSolutions") || 0; + my $showComments = $c->param("showComments") || 0; unless ( ( @@ -1109,7 +1075,7 @@ async sub write_problem_tex { } my $pg = await renderPG( - $r, + $c, $TargetUser, $MergedSet, $MergedProblem, @@ -1130,7 +1096,7 @@ async sub write_problem_tex { } ); - push(@{ $self->{resource_list} }, map { $pg->{resource_list}{$_} } keys %{ $pg->{resource_list} }) + push(@{ $c->{resource_list} }, map { $pg->{resource_list}{$_} } keys %{ $pg->{resource_list} }) if ref $pg->{resource_list} eq 'HASH'; # only bother to generate this info if there were warnings or errors @@ -1138,27 +1104,20 @@ async sub write_problem_tex { my $problem_name; my $problem_desc; if ($pg->{warnings} ne '' || $pg->{flags}->{error_flag}) { - my $edit_urlpath = $r->urlpath->newFromModule( - "WeBWorK::ContentGenerator::Instructor::PGProblemEditor", $r, - courseID => $r->urlpath->arg("courseID"), - setID => $MergedProblem->set_id, - problemID => $MergedProblem->problem_id, + $edit_url = $c->systemLink( + $c->url_for( + 'instructor_problem_editor_withset_withproblem', + setID => $MergedProblem->set_id, + problemID => $MergedProblem->problem_id, + ), + $MergedProblem->problem_id == 0 + # link for a fake problem (like a header file) + ? (params => + { sourceFilePath => $MergedProblem->source_file, problemSeed => $MergedProblem->problem_seed }) + # link for a real problem + : (), ); - if ($MergedProblem->problem_id == 0) { - # link for an fake problem (like a header file) - $edit_url = $self->systemLink( - $edit_urlpath, - params => { - sourceFilePath => $MergedProblem->source_file, - problemSeed => $MergedProblem->problem_seed, - }, - ); - } else { - # link for a real problem - $edit_url = $self->systemLink($edit_urlpath); - } - if ($MergedProblem->problem_id == 0) { $problem_name = "snippet"; $problem_desc = @@ -1182,41 +1141,41 @@ async sub write_problem_tex { # deal with PG warnings if ($pg->{warnings}) { - $self->add_error( - $r->link_to( - $r->tag('button', type => 'button', class => 'btn btn-sm btn-secondary', $r->maketext('Edit')) => + $c->add_error( + $c->link_to( + $c->tag('button', type => 'button', class => 'btn btn-sm btn-secondary', $c->maketext('Edit')) => $edit_url, target => 'WW_Editor' ), ' ', - $r->b($r->maketext( + $c->b($c->maketext( "Warnings encountered while processing [_1]. Error text: [_2]", $problem_desc, - $r->tag('br') . $r->tag('pre', $pg->{warnings}) + $c->tag('br') . $c->tag('pre', $pg->{warnings}) )) ); } # deal with PG errors if ($pg->{flags}{error_flag}) { - $self->add_error( - $r->link_to( - $r->tag('button', type => 'button', class => 'btn btn-sm btn-secondary', $r->maketext('Edit')) => + $c->add_error( + $c->link_to( + $c->tag('button', type => 'button', class => 'btn btn-sm btn-secondary', $c->maketext('Edit')) => $edit_url, target => 'WW_Editor' ), ' ', - $r->b($r->maketext( + $c->b($c->maketext( 'Errors encountered while processing [_1]. This [_2] has been omitted from the hardcopy. ' . 'Error text: [_3]', - $problem_desc, $problem_name, $r->tag('br') . $r->tag('pre', $pg->{errors}) + $problem_desc, $problem_name, $c->tag('br') . $c->tag('pre', $pg->{errors}) )) ); return; } # if we got here, there were no errors (because errors cause a return above) - $self->{at_least_one_problem_rendered_without_error} = 1; + $c->{at_least_one_problem_rendered_without_error} = 1; my $body_text = $pg->{body_text}; @@ -1225,19 +1184,19 @@ async sub write_problem_tex { # Use the pretty problem number if its a jitar problem my $id = $MergedProblem->problem_id; my $prettyID = join('.', jitar_id_to_seq($id)); - print $FH "{\\bf " . $r->maketext("Problem [_1].", $prettyID) . "}"; + print $FH "{\\bf " . $c->maketext("Problem [_1].", $prettyID) . "}"; } elsif ($MergedProblem->problem_id != 0) { print $FH "{\\bf " - . $r->maketext("Problem [_1].", $versioned ? $versioned : $MergedProblem->problem_id) . "}"; + . $c->maketext("Problem [_1].", $versioned ? $versioned : $MergedProblem->problem_id) . "}"; } my $problemValue = $MergedProblem->value; if (defined($problemValue)) { - my $points = $problemValue == 1 ? $r->maketext('point') : $r->maketext('points'); + my $points = $problemValue == 1 ? $c->maketext('point') : $c->maketext('points'); print $FH " {\\bf\\footnotesize($problemValue $points)}"; } - if ($self->{can_show_source_file} && $r->param("show_source_file") eq "Yes") { + if ($c->{can_show_source_file} && $c->param("show_source_file") eq "Yes") { print $FH " {\\footnotesize\\path|" . $MergedProblem->source_file . "|}"; } @@ -1256,26 +1215,26 @@ async sub write_problem_tex { my $pgScore = $pg->{state}->{recorded_score}; my $corrMsg = ' submitted: '; if ($pgScore == 1) { - $corrMsg .= $r->maketext('(correct)'); + $corrMsg .= $c->maketext('(correct)'); } elsif ($pgScore == 0) { - $corrMsg .= $r->maketext('(incorrect)'); + $corrMsg .= $c->maketext('(incorrect)'); } else { - $corrMsg .= $r->maketext('(score [_1])', $pgScore); + $corrMsg .= $c->maketext('(score [_1])', $pgScore); } $corrMsg .= "\n \\\\ \n recorded: "; my $recScore = $MergedProblem->status; if ($recScore == 1) { - $corrMsg .= $r->maketext('(correct)'); + $corrMsg .= $c->maketext('(correct)'); } elsif ($recScore == 0) { - $corrMsg .= $r->maketext('(incorrect)'); + $corrMsg .= $c->maketext('(incorrect)'); } else { - $corrMsg .= $r->maketext('(score [_1])', $recScore); + $corrMsg .= $c->maketext('(score [_1])', $recScore); } my $stuAnswers = "\\par{\\small{\\it " - . $r->maketext("Answer(s) submitted:") . "}\n" + . $c->maketext("Answer(s) submitted:") . "}\n" . "\\vspace{-\\parskip}\\begin{itemize}\n"; for my $ansName (@ans_entry_order) { my $stuAns; @@ -1297,7 +1256,7 @@ async sub write_problem_tex { } if ($showComments) { - my $userPastAnswerID = $db->latestProblemPastAnswer($r->urlpath->arg("courseID"), + my $userPastAnswerID = $db->latestProblemPastAnswer($c->stash('courseID'), $MergedProblem->user_id, $versionName, $MergedProblem->problem_id); my $pastAnswer = $userPastAnswerID ? $db->getPastAnswer($userPastAnswerID) : 0; @@ -1305,7 +1264,7 @@ async sub write_problem_tex { my $commentMsg = "\\par{\\small{\\it " - . $r->maketext("Instructor Feedback:") . "}\n" + . $c->maketext("Instructor Feedback:") . "}\n" . "\\vspace{-\\parskip}\n" . "\\begin{lstlisting}\n$comment\\end{lstlisting}\n" . "\\par\n"; @@ -1316,7 +1275,7 @@ async sub write_problem_tex { # isn't defined for versioned sets? this seems odd FIXME GWCHANGE if ($showCorrectAnswers && $MergedProblem->problem_id != 0 && @ans_entry_order) { my $correctTeX = - "\\par{\\small{\\it " . $r->maketext("Correct Answers:") . "}\n" . "\\vspace{-\\parskip}\\begin{itemize}\n"; + "\\par{\\small{\\it " . $c->maketext("Correct Answers:") . "}\n" . "\\vspace{-\\parskip}\\begin{itemize}\n"; foreach my $ansName (@ans_entry_order) { my $correctAnswer = $pg->{answers}{$ansName}{correct_ans_latex_string} @@ -1332,13 +1291,10 @@ async sub write_problem_tex { return; } -sub write_tex_file { - my ($self, $FH, $file) = @_; - my $r = $self->r; - +sub write_tex_file ($c, $FH, $file) { my $tex = eval { readFile($file) }; if ($@) { - $self->add_error('Failed to include TeX file "', $r->tag('code', $file), '": ', $r->tag('pre', $@)); + $c->add_error('Failed to include TeX file "', $c->tag('code', $file), '": ', $c->tag('pre', $@)); } else { print $FH $tex; } @@ -1348,19 +1304,16 @@ sub write_tex_file { # utilities ################################################################################ -sub add_error { - my ($self, @error_parts) = @_; - push @{ $self->{hardcopy_errors} }, $self->r->c(@error_parts)->join(''); +sub add_error ($c, @error_parts) { + push @{ $c->{hardcopy_errors} }, $c->c(@error_parts)->join(''); } -sub has_errors { - my ($self) = @_; - return scalar @{ $self->{hardcopy_errors} // [] }; +sub has_errors ($c) { + return scalar @{ $c->{hardcopy_errors} // [] }; } -sub get_errors { - my ($self) = @_; - return $self->{hardcopy_errors}; +sub get_errors ($c) { + return $c->{hardcopy_errors}; } 1; diff --git a/lib/WeBWorK/ContentGenerator/Home.pm b/lib/WeBWorK/ContentGenerator/Home.pm index cede71a430..d58a8646a8 100644 --- a/lib/WeBWorK/ContentGenerator/Home.pm +++ b/lib/WeBWorK/ContentGenerator/Home.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::Home; -use parent qw(WeBWorK::ContentGenerator); +use Mojo::Base 'WeBWorK::ContentGenerator', -signatures; =head1 NAME @@ -22,37 +22,30 @@ WeBWorK::ContentGenerator::Home - display a list of courses. =cut -use strict; -use warnings; - use WeBWorK::Utils qw(readFile); use WeBWorK::Localize; -sub info { - my ($self) = @_; - my $r = $self->r; - +sub info ($c) { my $result; # This section should be kept in sync with the Login.pm version - my $site_info = $r->ce->{webworkFiles}{site_info}; + my $site_info = $c->ce->{webworkFiles}{site_info}; if ($site_info && -f $site_info) { # Show the site info file. my $text = eval { readFile($site_info) }; if ($@) { - $result = $r->tag('div', class => 'alert alert-danger p-1 mb-0', $@); + $result = $c->tag('div', class => 'alert alert-danger p-1 mb-0', $@); } elsif ($text =~ /\S/) { $result = $text; } } - return $result ? $r->c($r->tag('h2', $r->maketext('Site Information')), $result)->join('') : ''; + return $result ? $c->c($c->tag('h2', $c->maketext('Site Information')), $result)->join('') : ''; } # Override the can method to disable links for the home page. -sub can { - my ($self, $arg) = @_; - return $arg eq 'links' ? 0 : $self->SUPER::can($arg); +sub can ($c, $arg) { + return $arg eq 'links' ? 0 : $c->SUPER::can($arg); } 1; diff --git a/lib/WeBWorK/ContentGenerator/Instructor/AchievementEditor.pm b/lib/WeBWorK/ContentGenerator/Instructor/AchievementEditor.pm index e28ef67482..e41cc9f38e 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/AchievementEditor.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/AchievementEditor.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::Instructor::AchievementEditor; -use parent qw(WeBWorK::ContentGenerator); +use Mojo::Base 'WeBWorK::ContentGenerator', -signatures; =head1 NAME @@ -22,11 +22,7 @@ WeBWorK::ContentGenerator::Instructor::AchievementEditor - edit an achevement ev =cut -use strict; -use warnings; - use HTML::Entities; -use URI::Escape; use File::Copy; use WeBWorK::Utils qw(not_blank path_is_subdir x); @@ -39,36 +35,33 @@ use constant ACTION_FORM_TITLES => { use constant DEFAULT_ICON => 'defaulticon.png'; -async sub pre_header_initialize { - my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; - my $urlpath = $r->urlpath; - my $authz = $r->authz; - my $user = $r->param('user'); - $self->{courseID} = $urlpath->arg('courseID'); - $self->{achievementID} = $r->urlpath->arg('achievementID'); +sub pre_header_initialize ($c) { + my $ce = $c->ce; + my $authz = $c->authz; + my $user = $c->param('user'); + $c->{courseID} = $c->stash('courseID'); + $c->{achievementID} = $c->stash('achievementID'); # Make sure that are defined for the templates. - $r->stash->{formsToShow} = ACTION_FORMS(); - $r->stash->{actionFormTitles} = ACTION_FORM_TITLES(); - $r->stash->{achievementContents} = ''; + $c->stash->{formsToShow} = ACTION_FORMS(); + $c->stash->{actionFormTitles} = ACTION_FORM_TITLES(); + $c->stash->{achievementContents} = ''; # Check permissions return unless ($authz->hasPermissions($user, 'edit_achievements')); # Get the achievement - my $Achievement = $r->db->getAchievement($self->{achievementID}); + my $Achievement = $c->db->getAchievement($c->{achievementID}); if (!$Achievement) { - $self->addbadmessage("Achievement $self->{achievementID} not found!"); + $c->addbadmessage("Achievement $c->{achievementID} not found!"); return; } - $self->{achievement} = $Achievement; - $self->{sourceFilePath} = $ce->{courseDirs}{achievements} . '/' . $Achievement->test; + $c->{achievement} = $Achievement; + $c->{sourceFilePath} = $ce->{courseDirs}{achievements} . '/' . $Achievement->test; - my $actionID = $r->param('action'); + my $actionID = $c->param('action'); # Perform a save or save_as action if ($actionID) { @@ -77,102 +70,72 @@ async sub pre_header_initialize { } my $actionHandler = "${actionID}_handler"; - $self->$actionHandler; + $c->$actionHandler; } return; } -sub initialize { - my ($self) = @_; - my $r = $self->r; - my $authz = $r->authz; - my $user = $r->param('user'); - my $sourceFilePath = $self->{sourceFilePath}; +sub initialize ($c) { + my $authz = $c->authz; + my $user = $c->param('user'); + my $sourceFilePath = $c->{sourceFilePath}; return unless ($authz->hasPermissions($user, 'edit_achievements')); - $self->addmessage($r->param('status_message') || ''); # Record status messages carried over from a redirect + $c->addmessage($c->param('status_message') || ''); # Record status messages carried over from a redirect # Check source file path if (not(-e $sourceFilePath)) { - $self->addbadmessage('The file "' . $self->shortPath($sourceFilePath) . '" cannot be found.'); + $c->addbadmessage('The file "' . $c->shortPath($sourceFilePath) . '" cannot be found.'); return; } # Find the text for the achievement. - unless ($r->stash->{achievementContents} =~ /\S/) { - unless (path_is_subdir($sourceFilePath, $r->ce->{courseDirs}{achievements}, 1)) { - $self->addbadmessage('Path is Unsafe!'); + unless ($c->stash->{achievementContents} =~ /\S/) { + unless (path_is_subdir($sourceFilePath, $c->ce->{courseDirs}{achievements}, 1)) { + $c->addbadmessage('Path is Unsafe!'); return; } - eval { $r->stash->{achievementContents} = WeBWorK::Utils::readFile($sourceFilePath) }; - $r->stash->{achievementContents} = $@ if $@; + eval { $c->stash->{achievementContents} = WeBWorK::Utils::readFile($sourceFilePath) }; + $c->stash->{achievementContents} = $@ if $@; } return; } -sub path { - my ($self, $args) = @_; - my $r = $self->r; - my $urlpath = $r->urlpath; - my $courseName = $urlpath->arg('courseID'); - - # Build a path to the achievement being edited by hand, since it is not the same as the urlpath. - # For this page the breadcrumb path shows the achievement being edited. - return $self->pathMacro( - $args, - 'WeBWork' => $r->location, - $courseName => $r->location . "/$courseName", - $r->maketext('Achievement') => $r->location . "/$courseName/instructor/achievement_list", - $r->urlpath->arg('achievementID') => undef - ); -} - -sub title { - my $self = shift; - my $r = $self->r; - - return $r->maketext('Achievement Evaluator for achievement [_1]', $r->urlpath->arg('achievementID')); +sub page_title ($c) { + return $c->maketext('Achievement Evaluator for achievement [_1]', $c->stash('achievementID')); } # Convert long paths to [ACHEVDIR] -sub shortPath { - my $self = shift; - my $file = shift; - my $ache = $self->r->ce->{courseDirs}{achievements}; +sub shortPath ($c, $file) { + my $ache = $c->ce->{courseDirs}{achievements}; $file =~ s|^$ache|[ACHEVDIR]|; return $file; } -sub getRelativeSourceFilePath { - my ($self, $sourceFilePath) = @_; - - my $achievementsDir = $self->r->ce->{courseDirs}->{achievements}; +sub getRelativeSourceFilePath ($c, $sourceFilePath) { + my $achievementsDir = $c->ce->{courseDirs}->{achievements}; $sourceFilePath =~ s|^${achievementsDir}/*||; # remove templates path and any slashes that follow - return $sourceFilePath; } # saveFileChanges does most of the work. It is a separate method so that it can # be called from either pre_header_initialize or initilize, depending on # whether a redirect is needed or not. -sub saveFileChanges { - my ($self, $outputFilePath, $achievementContents) = @_; - - my $r = $self->r; - my $ce = $r->ce; +sub saveFileChanges ($c, $outputFilePath, $achievementContents = undef) { + my $ce = $c->ce; if (defined($achievementContents) and ref($achievementContents)) { $achievementContents = ${$achievementContents}; } elsif (!not_blank($achievementContents)) { # if the AchievementContents is undefined or empty - $achievementContents = $self->r->stash->{achievementContents}; + $achievementContents = $c->stash->{achievementContents}; } unless (not_blank($outputFilePath)) { - $self->addbadmessage($r->maketext('You must specify an file name in order to save a new file.')); + $c->addbadmessage($c->maketext('You must specify an file name in order to save a new file.')); return ''; } my $do_not_save = 0; # flag to prevent saving of file @@ -200,8 +163,8 @@ sub saveFileChanges { } # Catch errors in saving files, - $self->{saveError} = $do_not_save; # Don't do redirects if the file was not saved. - # Don't unlink files or send success messages + $c->{saveError} = $do_not_save; # Don't do redirects if the file was not saved. + # Don't unlink files or send success messages if ($writeFileErrors) { # Get the current directory from the outputFilePath @@ -211,193 +174,162 @@ sub saveFileChanges { my $errorMessage; # Check why we failed to give better error messages if (not -w $ce->{courseDirs}->{achievements}) { - $errorMessage = $r->maketext( + $errorMessage = $c->maketext( 'Write permissions have not been enabled in the templates directory. No changes can be made.'); } elsif (not -w $currentDirectory) { - $errorMessage = $r->maketext( + $errorMessage = $c->maketext( 'Write permissions have not been enabled in "[_1]". ' . 'Changes must be saved to a different directory for viewing.', - $self->shortPath($currentDirectory) + $c->shortPath($currentDirectory) ); } elsif (-e $outputFilePath and not -w $outputFilePath) { - $errorMessage = $r->maketext( + $errorMessage = $c->maketext( 'Write permissions have not been enabled for "[_1]". ' . 'Changes must be saved to another file for viewing.', - $self->shortPath($outputFilePath) + $c->shortPath($outputFilePath) ); } else { $errorMessage = - $r->maketext('Unable to write to "[_1]": [_2]', $self->shortPath($outputFilePath), $writeFileErrors); + $c->maketext('Unable to write to "[_1]": [_2]', $c->shortPath($outputFilePath), $writeFileErrors); } - $self->{failure} = 1; - $self->addbadmessage($errorMessage); + $c->{failure} = 1; + $c->addbadmessage($errorMessage); } - if (!$writeFileErrors && !$do_not_save && defined $outputFilePath && !$self->{failure}) { - $self->addgoodmessage($r->maketext('Saved to file "[_1]"', $self->shortPath($outputFilePath))); + if (!$writeFileErrors && !$do_not_save && defined $outputFilePath && !$c->{failure}) { + $c->addgoodmessage($c->maketext('Saved to file "[_1]"', $c->shortPath($outputFilePath))); } + + return; } -sub fixAchievementContents { - my $AchievementContents = shift; +sub fixAchievementContents ($achievementContents) { # Handle the problem of line endings. # Make sure that all of the line endings are of unix type. # Convert \r\n to \n - $AchievementContents =~ s/\r\n/\n/g; - $AchievementContents =~ s/\r/\n/g; - return $AchievementContents; + $achievementContents =~ s/\r\n/\n/g; + $achievementContents =~ s/\r/\n/g; + return $achievementContents; } -sub save_handler { - my ($self) = @_; - my $r = $self->r; - my $courseName = $self->{courseID}; - my $achievementName = $self->{achievementID}; +sub save_handler ($c) { + my $courseName = $c->{courseID}; + my $achievementName = $c->{achievementID}; # Grab the achievementContents from the form in order to save it to the source path - $self->r->stash->{achievementContents} = fixAchievementContents($self->r->param('achievementContents')); + $c->stash->{achievementContents} = fixAchievementContents($c->param('achievementContents')); # Construct the output file path - $self->saveFileChanges($self->{sourceFilePath}); + $c->saveFileChanges($c->{sourceFilePath}); return; } -sub save_as_handler { - my ($self) = @_; - my $r = $self->r; - my $db = $r->db; - $self->{status_message} = $r->c; ## DPVC -- remove bogus old messages - my $courseName = $self->{courseID}; - my $achievementName = $self->{achievementID}; - my $effectiveUserName = $self->r->param('effectiveUser'); +sub save_as_handler ($c) { + my $db = $c->db; + $c->{status_message} = $c->c; ## DPVC -- remove bogus old messages + my $courseName = $c->{courseID}; + my $achievementName = $c->{achievementID}; + my $effectiveUserName = $c->param('effectiveUser'); my $do_not_save = 0; - my $saveMode = $r->param('action.save_as.saveMode') || 'no_save_mode_selected'; - my $new_file_name = $r->param('action.save_as.target_file') || ''; - my $sourceFilePath = $r->param('action.save_as.source_file') || ''; - my $targetAchievementID = $r->param('action.save_as.id') || ''; + my $saveMode = $c->param('action.save_as.saveMode') || 'no_save_mode_selected'; + my $new_file_name = $c->param('action.save_as.target_file') || ''; + my $sourceFilePath = $c->param('action.save_as.source_file') || ''; + my $targetAchievementID = $c->param('action.save_as.id') || ''; - $self->{sourceFilePath} = $sourceFilePath; # store for use in saveFileChanges - $new_file_name =~ s/^\s*//; #remove initial and final white space + $c->{sourceFilePath} = $sourceFilePath; # store for use in saveFileChanges + $new_file_name =~ s/^\s*//; #remove initial and final white space $new_file_name =~ s/\s*$//; - if ($new_file_name !~ /\S/) { # need a non-blank file name - # setting $self->{failure} stops saving and any redirects + if ($new_file_name !~ /\S/) { # need a non-blank file name + # setting $c->{failure} stops saving and any redirects $do_not_save = 1; - $self->addbadmessage($r->maketext('Please specify a file to save to.')); + $c->addbadmessage($c->maketext('Please specify a file to save to.')); } # Grab the achievementContents from the form in order to save it to a new permanent file - $self->r->stash->{achievementContents} = fixAchievementContents($self->r->param('achievementContents')); - warn 'achievement contents is empty' unless $self->r->stash->{achievementContents}; + $c->stash->{achievementContents} = fixAchievementContents($c->param('achievementContents')); + warn 'achievement contents is empty' unless $c->stash->{achievementContents}; # Rescue the user in case they forgot to end the file name with .at $new_file_name =~ s/\.at$//; # remove it if it is there $new_file_name .= '.at'; # put it there # Construct the output file path - my $outputFilePath = $self->r->ce->{courseDirs}->{achievements} . '/' . $new_file_name; + my $outputFilePath = $c->ce->{courseDirs}->{achievements} . '/' . $new_file_name; if (defined $outputFilePath and -e $outputFilePath) { # setting $do_not_save stops saving and any redirects $do_not_save = 1; - $self->addbadmessage($r->maketext( + $c->addbadmessage($c->maketext( 'File "[_1]" exists. File not saved. No changes have been made.', - $self->shortPath($outputFilePath) + $c->shortPath($outputFilePath) )); } elsif ($saveMode eq 'use_in_new' && !$targetAchievementID) { - $self->addbadmessage( - $r->maketext('No new Achievement ID specified. No new achievement created. File not saved.')); + $c->addbadmessage( + $c->maketext('No new Achievement ID specified. No new achievement created. File not saved.')); $do_not_save = 1; } elsif ($saveMode eq 'use_in_new' && $db->existsAchievement($targetAchievementID)) { - $self->addbadmessage($r->maketext('Achievement ID exists! No new achievement created. File not saved.')); + $c->addbadmessage($c->maketext('Achievement ID exists! No new achievement created. File not saved.')); $do_not_save = 1; } else { - $self->{editFilePath} = $outputFilePath; - $self->{inputFilePath} = ''; + $c->{editFilePath} = $outputFilePath; + $c->{inputFilePath} = ''; } return '' if $do_not_save; #Save changes - $self->saveFileChanges($outputFilePath); + $c->saveFileChanges($outputFilePath); if ($saveMode eq 'use_in_current' and -r $outputFilePath) { # Modify evaluator path in current achievement - my $achievement = $self->r->db->getAchievement($achievementName); + my $achievement = $c->db->getAchievement($achievementName); $achievement->test($new_file_name); - if ($self->r->db->putAchievement($achievement)) { - $self->addgoodmessage($r->maketext( + if ($c->db->putAchievement($achievement)) { + $c->addgoodmessage($c->maketext( 'The evaluator for [_1] has been renamed to "[_2]".', $achievementName, - $self->shortPath($outputFilePath) + $c->shortPath($outputFilePath) )); } else { - $self->addbadmessage( - $r->maketext('Unable to change the evaluator for set [_1]. Unknown error.', $achievementName)); + $c->addbadmessage( + $c->maketext('Unable to change the evaluator for set [_1]. Unknown error.', $achievementName)); } } elsif ($saveMode eq 'use_in_new') { # Create a new achievement to use the evaluator in - my $achievement = $self->r->db->newAchievement(); + my $achievement = $c->db->newAchievement(); $achievement->achievement_id($targetAchievementID); $achievement->test($new_file_name); $achievement->icon(DEFAULT_ICON()); - $self->r->db->addAchievement($achievement); - $self->addgoodmessage($r->maketext( + $c->db->addAchievement($achievement); + $c->addgoodmessage($c->maketext( 'Achievement [_1] created with evaluator "[_2]".', $targetAchievementID, - $self->shortPath($outputFilePath) + $c->shortPath($outputFilePath) )); } elsif ($saveMode eq 'dont_use') { # Don't change any achievements - just report - $self->addgoodmessage($r->maketext('A new file has been created at "[_1]"', $self->shortPath($outputFilePath))); + $c->addgoodmessage($c->maketext('A new file has been created at "[_1]"', $c->shortPath($outputFilePath))); } else { - $self->addbadmessage($r->maketext(q{Don't recognize saveMode: |[_1]|. Unknown error.}, $saveMode)); + $c->addbadmessage($c->maketext(q{Don't recognize saveMode: |[_1]|. Unknown error.}, $saveMode)); } # Set up redirect # The redirect gives the server time to detect that the new file exists. - my $problemPage; - - if ($saveMode eq 'dont_use') { - $problemPage = $self->r->urlpath->newFromModule( - 'WeBWorK::ContentGenerator::Instructor::AchievementEditor', $r, - courseID => $courseName, - achievementID => $achievementName - ); - } elsif ($saveMode eq 'use_in_current') { - $problemPage = $self->r->urlpath->newFromModule( - 'WeBWorK::ContentGenerator::Instructor::AchievementEditor', $r, - courseID => $courseName, - achievementID => $achievementName - ); - } elsif ($saveMode eq 'use_in_new') { - $problemPage = $self->r->urlpath->newFromModule( - 'WeBWorK::ContentGenerator::Instructor::AchievementEditor', $r, - courseID => $courseName, - achievementID => $targetAchievementID - ); - } else { - $self->addbadmessage('Please use radio buttons to choose the method for saving this file. ' - . "Can't recognize saveMode: |$saveMode|."); - # Can't continue since paths have not been properly defined. - return ''; - } - - my $relativeOutputFilePath = $self->getRelativeSourceFilePath($outputFilePath); - - my $viewURL = $self->systemLink( - $problemPage, + $c->reply_with_redirect($c->systemLink( + $c->url_for( + 'instructor_achievement_editor', + achievementID => $saveMode eq 'use_in_new' ? $targetAchievementID : $achievementName + ), params => { - sourceFilePath => $relativeOutputFilePath, - status_message => uri_escape_utf8($self->{status_message}->join('')) + sourceFilePath => $c->getRelativeSourceFilePath($outputFilePath), + status_message => $c->{status_message}->join('') } - ); - - $self->reply_with_redirect($viewURL); + )); return; } diff --git a/lib/WeBWorK/ContentGenerator/Instructor/AchievementList.pm b/lib/WeBWorK/ContentGenerator/Instructor/AchievementList.pm index 28750f42c5..a4b1a8e574 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/AchievementList.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/AchievementList.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::Instructor::AchievementList; -use parent qw(WeBWorK::ContentGenerator); +use Mojo::Base 'WeBWorK::ContentGenerator', -signatures; =head1 NAME @@ -44,9 +44,6 @@ links to edit the evaluator and the individual user data. =cut -use strict; -use warnings; - use Mojo::File; use Text::CSV; @@ -73,21 +70,18 @@ use constant FORM_TITLES => { cancel_export => x('Cancel Export') }; -sub initialize { - my ($self) = @_; - my $r = $self->r; - my $urlpath = $r->urlpath; - my $db = $r->db; - my $ce = $r->ce; - my $authz = $r->authz; - my $courseName = $urlpath->arg('courseID'); - my $achievementID = $urlpath->arg('achievementID'); - my $user = $r->param('user'); +sub initialize ($c) { + my $db = $c->db; + my $ce = $c->ce; + my $authz = $c->authz; + my $courseName = $c->stash('courseID'); + my $achievementID = $c->stash('achievementID'); + my $user = $c->param('user'); # Make sure these are available in the templates. - $r->stash->{formsToShow} = VIEW_FORMS(); - $r->stash->{formTitles} = FORM_TITLES(); - $r->stash->{achievements} = []; + $c->stash->{formsToShow} = VIEW_FORMS(); + $c->stash->{formTitles} = FORM_TITLES(); + $c->stash->{achievements} = []; # Check permissions return unless $authz->hasPermissions($user, 'edit_achievements'); @@ -112,32 +106,32 @@ sub initialize { ### End Transition Code. ### my @users = $db->listUsers; - $self->{allAchievementIDs} = \@allAchievementIDs; - $self->{totalUsers} = scalar @users; + $c->{allAchievementIDs} = \@allAchievementIDs; + $c->{totalUsers} = scalar @users; - $self->{selectedAchievementIDs} = [ $r->param('selected_achievements') ]; + $c->{selectedAchievementIDs} = [ $c->param('selected_achievements') ]; - $self->{editMode} = $r->param('editMode') || 0; + $c->{editMode} = $c->param('editMode') || 0; # Call action handler - my $actionID = $r->param('action'); - $self->{actionID} = $actionID; + my $actionID = $c->param('action'); + $c->{actionID} = $actionID; if ($actionID) { unless (grep { $_ eq $actionID } @{ VIEW_FORMS() }, @{ EDIT_FORMS() }, @{ EXPORT_FORMS() }) { die "Action $actionID not found"; } my $actionHandler = "${actionID}_handler"; - $self->addmessage($r->tag('p', class => 'mb-1', $r->maketext('Results of last action performed: '))); - $self->addmessage($self->$actionHandler); + $c->addmessage($c->tag('p', class => 'mb-1', $c->maketext('Results of last action performed: '))); + $c->addmessage($c->$actionHandler); } else { - $self->addgoodmessage($r->maketext('Please select action to be performed.')); + $c->addgoodmessage($c->maketext('Please select action to be performed.')); } - $r->stash->{formsToShow} = $self->{editMode} ? EDIT_FORMS() : $self->{exportMode} ? EXPORT_FORMS() : VIEW_FORMS(); + $c->stash->{formsToShow} = $c->{editMode} ? EDIT_FORMS() : $c->{exportMode} ? EXPORT_FORMS() : VIEW_FORMS(); # Get and sort achievements. Achievements are sorted by in the order they are evaluated. - $r->stash->{achievements} = [ sortAchievements($r->db->getAchievements(@{ $self->{allAchievementIDs} })) ]; + $c->stash->{achievements} = [ sortAchievements($c->db->getAchievements(@{ $c->{allAchievementIDs} })) ]; return; } @@ -149,41 +143,36 @@ sub initialize { # actions are shown in edit mode. # Handler for editing achievements. Just changes the view mode. -sub edit_handler { - my ($self) = @_; - my $r = $self->r; +sub edit_handler ($c) { my $result; - my $scope = $r->param('action.edit.scope'); + my $scope = $c->param('action.edit.scope'); if ($scope eq "all") { - $self->{selectedAchievementIDs} = $self->{allAchievementIDs}; - $result = $r->maketext("editing all achievements"); + $c->{selectedAchievementIDs} = $c->{allAchievementIDs}; + $result = $c->maketext("editing all achievements"); } elsif ($scope eq "selected") { - $result = $r->maketext("editing selected achievements"); + $result = $c->maketext("editing selected achievements"); } - $self->{editMode} = 1; + $c->{editMode} = 1; - return $r->tag('div', class => 'alert alert-success p-1 mb-0', $result); + return $c->tag('div', class => 'alert alert-success p-1 mb-0', $result); } # Handler for assigning achievements to users -sub assign_handler { - my ($self) = @_; - - my $r = $self->r; - my $db = $r->db; - my $ce = $r->ce; +sub assign_handler ($c) { + my $db = $c->db; + my $ce = $c->ce; - my $scope = $r->param('action.assign.scope'); - my $overwrite = $r->param('action.assign.overwrite') eq 'everything'; + my $scope = $c->param('action.assign.scope'); + my $overwrite = $c->param('action.assign.overwrite') eq 'everything'; my @achievementIDs; my @users = $db->listUsers; if ($scope eq "all") { - @achievementIDs = @{ $self->{allAchievementIDs} }; + @achievementIDs = @{ $c->{allAchievementIDs} }; } else { - @achievementIDs = @{ $self->{selectedAchievementIDs} }; + @achievementIDs = @{ $c->{selectedAchievementIDs} }; } # Enable all achievements @@ -226,28 +215,24 @@ sub assign_handler { } } - return $r->tag('div', class => 'alert alert-success p-1 mb-0', $r->maketext('Assigned achievements to users')); + return $c->tag('div', class => 'alert alert-success p-1 mb-0', $c->maketext('Assigned achievements to users')); } # Handler for scoring -sub score_handler { - my ($self) = @_; - - my $r = $self->r; - my $ce = $r->ce; - my $db = $r->db; - my $urlpath = $r->urlpath; - my $courseName = $urlpath->arg("courseID"); +sub score_handler ($c) { + my $ce = $c->ce; + my $db = $c->db; + my $courseName = $c->stash('courseID'); - my $scope = $r->param('action.score.scope'); + my $scope = $c->param('action.score.scope'); my @achievementsToScore; if ($scope eq "none") { @achievementsToScore = (); } elsif ($scope eq "all") { - @achievementsToScore = @{ $self->{allAchievementIDs} }; + @achievementsToScore = @{ $c->{allAchievementIDs} }; } elsif ($scope eq "selected") { - @achievementsToScore = $r->param('selected_achievements'); + @achievementsToScore = $c->param('selected_achievements'); } # Define file name @@ -264,14 +249,14 @@ sub score_handler { $scoreFilePath = WeBWorK::Utils::surePathToFile($ce->{courseDirs}->{scoring}, $scoreFilePath); my $SCORE = Mojo::File->new($scoreFilePath)->open('>:encoding(UTF-8)') - or return $r->tag( + or return $c->tag( 'div', class => 'alert alert-danger p-1 mb-0', - $r->maketext("Failed to open [_1]", $scoreFilePath) + $c->maketext("Failed to open [_1]", $scoreFilePath) ); # Print out header info - print $SCORE $r->maketext("username, last name, first name, section, achievement level, achievement score,"); + print $SCORE $c->maketext("username, last name, first name, section, achievement level, achievement score,"); my @achievements = $db->getAchievements(@achievementsToScore); @achievements = sortAchievements(@achievements); @@ -323,19 +308,16 @@ sub score_handler { $SCORE->close; # Include a download link - return $r->tag( + return $c->tag( 'div', class => 'alert alert-success p-1 mb-0', - $r->b($r->maketext( + $c->b($c->maketext( 'Achievement scores saved to [_1]', - $r->link_to( - $scoreFileName => $self->systemLink( - $urlpath->newFromModule( - "WeBWorK::ContentGenerator::Instructor::FileManager", - $r, courseID => $courseName - ), + $c->link_to( + $scoreFileName => $c->systemLink( + $c->url_for('instructor_file_manager'), params => - { action => "View", files => "${courseName}_achievement_scores.csv", pwd => "scoring" } + { action => 'View', files => "${courseName}_achievement_scores.csv", pwd => 'scoring' } ) ) )) @@ -343,22 +325,19 @@ sub score_handler { } # Handler for delete action -sub delete_handler { - my ($self) = @_; +sub delete_handler ($c) { + my $db = $c->db; - my $r = $self->r; - my $db = $r->db; - - my $scope = $r->param('action.delete.scope'); + my $scope = $c->param('action.delete.scope'); my @achievementIDsToDelete = (); if ($scope eq "selected") { - @achievementIDsToDelete = @{ $self->{selectedAchievementIDs} }; + @achievementIDsToDelete = @{ $c->{selectedAchievementIDs} }; } - my %allAchievementIDs = map { $_ => 1 } @{ $self->{allAchievementIDs} }; - my %selectedAchievementIDs = map { $_ => 1 } @{ $self->{selectedAchievementIDs} }; + my %allAchievementIDs = map { $_ => 1 } @{ $c->{allAchievementIDs} }; + my %selectedAchievementIDs = map { $_ => 1 } @{ $c->{selectedAchievementIDs} }; # Iterate over selected achievements and delete. for my $achievementID (@achievementIDsToDelete) { @@ -369,42 +348,39 @@ sub delete_handler { } # Update local fields - $self->{allAchievementIDs} = [ keys %allAchievementIDs ]; - $self->{selectedAchievementIDs} = [ keys %selectedAchievementIDs ]; + $c->{allAchievementIDs} = [ keys %allAchievementIDs ]; + $c->{selectedAchievementIDs} = [ keys %selectedAchievementIDs ]; my $num = @achievementIDsToDelete; - return $r->tag( + return $c->tag( 'div', class => 'alert alert-success p-1 mb-0', - $r->maketext('Deleted [quant,_1,achievement]', $num) + $c->maketext('Deleted [quant,_1,achievement]', $num) ); } # Handler for creating an ahcievement -sub create_handler { - my ($self) = @_; - - my $r = $self->r; - my $db = $r->db; - my $ce = $r->ce; - my $user = $r->param('user'); +sub create_handler ($c) { + my $db = $c->db; + my $ce = $c->ce; + my $user = $c->param('user'); # Create achievement - my $newAchievementID = $r->param('action.create.id'); - return $r->tag( + my $newAchievementID = $c->param('action.create.id'); + return $c->tag( 'div', class => 'alert alert-danger p-1 mb-0', - $r->maketext("Failed to create new achievement: no achievement ID specified!") + $c->maketext("Failed to create new achievement: no achievement ID specified!") ) unless $newAchievementID =~ /\S/; - return $r->tag( + return $c->tag( 'div', class => 'alert alert-danger p-1 mb-0', - $r->maketext("Achievement [_1] exists. No achievement created", $newAchievementID) + $c->maketext("Achievement [_1] exists. No achievement created", $newAchievementID) ) if $db->existsAchievement($newAchievementID); my $newAchievementRecord = $db->newAchievement; - my $oldAchievementID = $self->{selectedAchievementIDs}->[0]; + my $oldAchievementID = $c->{selectedAchievementIDs}->[0]; - my $type = $r->param('action.create.type'); + my $type = $c->param('action.create.type'); # Either assign empty data or copy over existing data if ($type eq "empty") { @@ -414,10 +390,10 @@ sub create_handler { $newAchievementRecord->test('blankachievement.at'); $db->addAchievement($newAchievementRecord); } elsif ($type eq "copy") { - return $r->tag( + return $c->tag( 'div', class => 'alert alert-danger p-1 mb-0', - $r->maketext("Failed to duplicate achievement: no achievement selected for duplication!") + $c->maketext("Failed to duplicate achievement: no achievement selected for duplication!") ) unless $oldAchievementID =~ /\S/; $newAchievementRecord = $db->getAchievement($oldAchievementID); $newAchievementRecord->achievement_id($newAchievementID); @@ -432,38 +408,36 @@ sub create_handler { $db->addUserAchievement($userAchievement); # Add to local list of achievements - push @{ $self->{allAchievementIDs} }, $newAchievementID; + push @{ $c->{allAchievementIDs} }, $newAchievementID; - return $r->tag( + return $c->tag( 'div', class => 'alert alert-danger p-1 mb-0', - $r->maketext("Failed to create new achievement: [_1]", $@) + $c->maketext("Failed to create new achievement: [_1]", $@) ) if $@; - return $r->tag( + return $c->tag( 'div', class => 'alert alert-success p-1 mb-0', - $r->maketext('Successfully created new achievement [_1]', $newAchievementID) + $c->maketext('Successfully created new achievement [_1]', $newAchievementID) ); } # Handler for importing achievements -sub import_handler { - my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; - my $db = $r->db; - - my $fileName = $r->param('action.import.source'); - my $assign = $r->param('action.import.assign'); +sub import_handler ($c) { + my $ce = $c->ce; + my $db = $c->db; + + my $fileName = $c->param('action.import.source'); + my $assign = $c->param('action.import.assign'); my @users = $db->listUsers; - my %allAchievementIDs = map { $_ => 1 } @{ $self->{allAchievementIDs} }; + my %allAchievementIDs = map { $_ => 1 } @{ $c->{allAchievementIDs} }; my $filePath = $ce->{courseDirs}->{achievements} . '/' . $fileName; # Open file name my $fh = Mojo::File->new($filePath)->open('<:encoding(UTF-8)') or - return $r->tag('div', class => 'alert alert-danger p-1 mb-0', $r->maketext("Failed to open [_1]", $filePath)); + return $c->tag('div', class => 'alert alert-danger p-1 mb-0', $c->maketext("Failed to open [_1]", $filePath)); # Read in lines from file my $count = 0; @@ -534,55 +508,47 @@ sub import_handler { $fh->close; - $self->{allAchievementIDs} = [ keys %allAchievementIDs ]; + $c->{allAchievementIDs} = [ keys %allAchievementIDs ]; - return $r->tag( + return $c->tag( 'div', class => 'alert alert-success p-1 mb-0', - $r->maketext('Imported [quant,_1,achievement]', $count) + $c->maketext('Imported [quant,_1,achievement]', $count) ); } # Export handler # This does not actually export any files, rather it sends us to a new page in order to export the files. -sub export_handler { - my ($self) = @_; - my $r = $self->r; +sub export_handler ($c) { my $result; - my $scope = $r->param('action.export.scope'); + my $scope = $c->param('action.export.scope'); if ($scope eq "all") { - $result = $r->maketext("exporting all achievements"); - $self->{selectedAchievementIDs} = $self->{allAchievementIDs}; + $result = $c->maketext("exporting all achievements"); + $c->{selectedAchievementIDs} = $c->{allAchievementIDs}; } elsif ($scope eq "selected") { - $result = $r->maketext("exporting selected achievements"); - $self->{selectedAchievementIDs} = [ $r->param('selected_achievements') ]; + $result = $c->maketext("exporting selected achievements"); + $c->{selectedAchievementIDs} = [ $c->param('selected_achievements') ]; } - $self->{exportMode} = 1; + $c->{exportMode} = 1; - return $r->tag('div', class => 'alert alert-success p-1 mb-0', $result); + return $c->tag('div', class => 'alert alert-success p-1 mb-0', $result); } # Handler for leaving the export page. -sub cancel_export_handler { - my ($self) = @_; - my $r = $self->r; - - $self->{exportMode} = 0; +sub cancel_export_handler ($c) { + $c->{exportMode} = 0; - return $r->tag('div', class => 'alert alert-danger p-1 mb-0', $r->maketext('export abandoned')); + return $c->tag('div', class => 'alert alert-danger p-1 mb-0', $c->maketext('export abandoned')); } # Handler actually exporting achievements. -sub save_export_handler { - my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; - my $db = $r->db; - my $urlpath = $r->urlpath; - my $courseName = $urlpath->arg('courseID'); +sub save_export_handler ($c) { + my $ce = $c->ce; + my $db = $c->db; + my $courseName = $c->stash('courseID'); - my @achievementIDsToExport = @{ $self->{selectedAchievementIDs} }; + my @achievementIDsToExport = @{ $c->{selectedAchievementIDs} }; # Get file path my $FileName = "${courseName}_achievements.axp"; @@ -598,7 +564,7 @@ sub save_export_handler { my $fh = Mojo::File->new($FilePath)->open('>:encoding(UTF-8)') or - return $r->tag('div', class => 'alert alert-danger p-1 mb-0', $r->maketext('Failed to open [_1]', $FilePath)); + return $c->tag('div', class => 'alert alert-danger p-1 mb-0', $c->maketext('Failed to open [_1]', $FilePath)); my $csv = Text::CSV->new({ eol => "\n" }); @@ -617,32 +583,26 @@ sub save_export_handler { $fh->close; - $self->{exportMode} = 0; + $c->{exportMode} = 0; - return $r->tag( + return $c->tag( 'div', class => 'alert alert-success p-1 mb-0', - $r->maketext('Exported achievements to [_1]', $FileName) + $c->maketext('Exported achievements to [_1]', $FileName) ); } # Handler for cancelling edits. -sub cancel_edit_handler { - my ($self) = @_; - my $r = $self->r; - - $self->{editMode} = 0; - - return $r->tag('div', class => 'alert alert-danger p-1 mb-0', $r->maketext('changes abandoned')); +sub cancel_edit_handler ($c) { + $c->{editMode} = 0; + return $c->tag('div', class => 'alert alert-danger p-1 mb-0', $c->maketext('changes abandoned')); } # Handler for saving edits. -sub save_edit_handler { - my ($self) = @_; - my $r = $self->r; - my $db = $r->db; +sub save_edit_handler ($c) { + my $db = $c->db; - my @selectedAchievementIDs = @{ $self->{selectedAchievementIDs} }; + my @selectedAchievementIDs = @{ $c->{selectedAchievementIDs} }; for my $achievementID (@selectedAchievementIDs) { my $Achievement = $db->getAchievement($achievementID); @@ -655,12 +615,12 @@ sub save_edit_handler { my $param = "achievement.${achievementID}.${field}"; if ($field eq 'assignment_type') { - my @types = $r->param($param); + my @types = $c->param($param); $Achievement->assignment_type(join(',', @types)); } else { - if (defined $r->param($param)) { - $Achievement->$field($r->param($param)); + if (defined $c->param($param)) { + $Achievement->$field($c->param($param)); } } } @@ -668,17 +628,14 @@ sub save_edit_handler { $db->putAchievement($Achievement); } - $self->{editMode} = 0; + $c->{editMode} = 0; - return $r->tag('div', class => 'alert alert-success p-1 mb-0', $r->maketext('changes saved')); + return $c->tag('div', class => 'alert alert-success p-1 mb-0', $c->maketext('changes saved')); } # Get list of files that can be imported. -sub getAxpList { - my ($self) = @_; - my $ce = $self->{ce}; - my $dir = $ce->{courseDirs}->{achievements}; - return read_dir($dir, qr/.*\.axp/); +sub getAxpList ($c) { + return read_dir($c->ce->{courseDirs}{achievements}, qr/.*\.axp/); } 1; diff --git a/lib/WeBWorK/ContentGenerator/Instructor/AchievementUserEditor.pm b/lib/WeBWorK/ContentGenerator/Instructor/AchievementUserEditor.pm index 4c07e695b2..c86cffede2 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/AchievementUserEditor.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/AchievementUserEditor.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::Instructor::AchievementUserEditor; -use parent qw(WeBWorK::ContentGenerator); +use Mojo::Base 'WeBWorK::ContentGenerator', -signatures; =head1 NAME @@ -23,59 +23,53 @@ users assigned to an achievement. =cut -use strict; -use warnings; - -sub initialize { - my ($self) = @_; - my $r = $self->r; - my $urlpath = $r->urlpath; - my $authz = $r->authz; - my $db = $r->db; - my $achievementID = $urlpath->arg('achievementID'); - my $user = $r->param('user'); +sub initialize ($c) { + my $authz = $c->authz; + my $db = $c->db; + my $achievementID = $c->stash('achievementID'); + my $user = $c->param('user'); # Make sure this is defined for the template. - $r->stash->{userRecords} = []; + $c->stash->{userRecords} = []; # Check permissions return unless $authz->hasPermissions($user, 'edit_achievements'); my @all_users = $db->listUsers; - my %selectedUsers = map { $_ => 1 } $r->param('selected'); + my %selectedUsers = map { $_ => 1 } $c->param('selected'); my $doAssignToSelected = 0; #Check and see if we need to assign or unassign things - if (defined $r->param('assignToAll')) { - $self->addmessage($r->tag( + if (defined $c->param('assignToAll')) { + $c->addmessage($c->tag( 'p', class => 'alert alert-success p-1 mb-0', - $r->maketext('Achievement has been assigned to all users.') + $c->maketext('Achievement has been assigned to all users.') )); %selectedUsers = map { $_ => 1 } @all_users; $doAssignToSelected = 1; - } elsif (defined $r->param('unassignFromAll') - && defined($r->param('unassignFromAllSafety')) - && $r->param('unassignFromAllSafety') == 1) + } elsif (defined $c->param('unassignFromAll') + && defined($c->param('unassignFromAllSafety')) + && $c->param('unassignFromAllSafety') == 1) { %selectedUsers = (); - $self->addmessage($r->tag( + $c->addmessage($c->tag( 'p', class => 'alert alert-danger p-1 mb-0', - $r->maketext('Achievement has been unassigned to all students.') + $c->maketext('Achievement has been unassigned to all students.') )); $doAssignToSelected = 1; - } elsif (defined $r->param('assignToSelected')) { - $self->addmessage($r->tag( + } elsif (defined $c->param('assignToSelected')) { + $c->addmessage($c->tag( 'p', class => 'alert alert-success p-1 mb-0', - $r->maketext('Achievement has been assigned to selected users.') + $c->maketext('Achievement has been assigned to selected users.') )); $doAssignToSelected = 1; - } elsif (defined $r->param('unassignFromAll')) { + } elsif (defined $c->param('unassignFromAll')) { # no action taken - $self->addmessage($r->tag('p', class => 'alert alert-danger p-1 mb-0', $r->maketext('No action taken'))); + $c->addmessage($c->tag('p', class => 'alert alert-danger p-1 mb-0', $c->maketext('No action taken'))); } #do actual assignment and unassignment @@ -87,7 +81,7 @@ sub initialize { # update existing user data (in case fields were changed) my $userAchievement = $db->getUserAchievement($selectedUser, $achievementID); - my $updatedEarned = $r->param("$selectedUser.earned") ? 1 : 0; + my $updatedEarned = $c->param("$selectedUser.earned") ? 1 : 0; my $earned = $userAchievement->earned ? 1 : 0; if ($updatedEarned != $earned) { @@ -110,7 +104,7 @@ sub initialize { $db->putGlobalUserAchievement($globalUserAchievement); } - $userAchievement->counter($r->param("$selectedUser.counter")); + $userAchievement->counter($c->param("$selectedUser.counter")); $db->putUserAchievement($userAchievement); } elsif (exists $selectedUsers{$selectedUser}) { @@ -138,14 +132,14 @@ sub initialize { my @userRecords; for my $currentUser (@all_users) { - my $userObj = $r->db->getUser($currentUser); + my $userObj = $c->db->getUser($currentUser); die "Unable to find user object for $currentUser. " unless $userObj; push(@userRecords, $userObj); } @userRecords = sort { (lc($a->section) cmp lc($b->section)) || (lc($a->last_name) cmp lc($b->last_name)) } @userRecords; - $r->stash->{userRecords} = \@userRecords; + $c->stash->{userRecords} = \@userRecords; return; } diff --git a/lib/WeBWorK/ContentGenerator/Instructor/AddUsers.pm b/lib/WeBWorK/ContentGenerator/Instructor/AddUsers.pm index c91862774d..90a87a922f 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/AddUsers.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/AddUsers.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::Instructor::AddUsers; -use parent qw(WeBWorK::ContentGenerator); +use Mojo::Base 'WeBWorK::ContentGenerator', -signatures; =head1 NAME @@ -22,54 +22,49 @@ WeBWorK::ContentGenerator::Instructor::AddUsers - Menu interface for adding user =cut -use strict; -use warnings; - use WeBWorK::Utils qw/cryptPassword trim_spaces/; use WeBWorK::Utils::Instructor qw(assignSetsToUsers); -sub initialize { - my ($self) = @_; - my $r = $self->r; - my $db = $r->db; - my $ce = $r->ce; - my $authz = $r->authz; +sub initialize ($c) { + my $db = $c->db; + my $ce = $c->ce; + my $authz = $c->authz; - my $user = $r->param('user'); + my $user = $c->param('user'); # Check permissions return unless $authz->hasPermissions($user, 'access_instructor_tools'); return unless $authz->hasPermissions($user, 'modify_student_data'); - if (defined $r->param('addStudents')) { - $self->{studentEntryReport} = $r->c; + if (defined $c->param('addStudents')) { + $c->{studentEntryReport} = $c->c; my @userIDs; - my $numberOfStudents = $r->param('number_of_students') // 0; + my $numberOfStudents = $c->param('number_of_students') // 0; # FIXME: Handle errors if user already exists as well as all other errors that could occur (including errors # when adding the permission, adding the password, and assigning sets to the users). for my $i (1 .. $numberOfStudents) { - my $new_user_id = trim_spaces($r->param("new_user_id_$i")); - my $new_password = cryptPassword($r->param("student_id_$i")); + my $new_user_id = trim_spaces($c->param("new_user_id_$i")); + my $new_password = cryptPassword($c->param("student_id_$i")); next unless $new_user_id; my $newUser = $db->newUser; $newUser->user_id($new_user_id); - $newUser->last_name(trim_spaces($r->param("last_name_$i"))); - $newUser->first_name(trim_spaces($r->param("first_name_$i"))); - $newUser->student_id(trim_spaces($r->param("student_id_$i"))); - $newUser->email_address(trim_spaces($r->param("email_address_$i"))); - $newUser->section(trim_spaces($r->param("section_$i"))); - $newUser->recitation(trim_spaces($r->param("recitation_$i"))); - $newUser->comment(trim_spaces($r->param("comment_$i"))); + $newUser->last_name(trim_spaces($c->param("last_name_$i"))); + $newUser->first_name(trim_spaces($c->param("first_name_$i"))); + $newUser->student_id(trim_spaces($c->param("student_id_$i"))); + $newUser->email_address(trim_spaces($c->param("email_address_$i"))); + $newUser->section(trim_spaces($c->param("section_$i"))); + $newUser->recitation(trim_spaces($c->param("recitation_$i"))); + $newUser->comment(trim_spaces($c->param("comment_$i"))); $newUser->status($ce->status_name_to_abbrevs($ce->{default_status})); eval { $db->addUser($newUser) }; if ($@) { push( - @{ $self->{studentEntryReport} }, - $r->include( + @{ $c->{studentEntryReport} }, + $c->include( 'ContentGenerator/Instructor/AddUsers/student_entry_report', newUser => $newUser, addError => $@ @@ -89,8 +84,8 @@ sub initialize { $db->addPassword($newPassword); push( - @{ $self->{studentEntryReport} }, - $r->include( + @{ $c->{studentEntryReport} }, + $c->include( 'ContentGenerator/Instructor/AddUsers/student_entry_report', newUser => $newUser, addError => '' @@ -98,8 +93,8 @@ sub initialize { ); } } - if (defined $r->param('assignSets')) { - my @setIDs = $r->param('assignSets'); + if (defined $c->param('assignSets')) { + my @setIDs = $c->param('assignSets'); assignSetsToUsers($db, \@setIDs, \@userIDs); } } diff --git a/lib/WeBWorK/ContentGenerator/Instructor/Assigner.pm b/lib/WeBWorK/ContentGenerator/Instructor/Assigner.pm index aa1bc60db4..1eec98a78a 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/Assigner.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/Assigner.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::Instructor::Assigner; -use parent qw(WeBWorK::ContentGenerator); +use Mojo::Base 'WeBWorK::ContentGenerator', -signatures; =head1 NAME @@ -22,43 +22,38 @@ WeBWorK::ContentGenerator::Instructor::Assigner - Assign homework sets to users. =cut -use strict; -use warnings; - use WeBWorK::Utils::Instructor qw(assignSetsToUsers unassignSetsFromUsers); -async sub pre_header_initialize { - my ($self) = @_; - my $r = $self->r; - my $db = $r->db; - my $authz = $r->authz; - my $ce = $r->ce; - my $user = $r->param('user'); +sub pre_header_initialize ($c) { + my $db = $c->db; + my $authz = $c->authz; + my $ce = $c->ce; + my $user = $c->param('user'); # Make sure these are defined for the template. - $r->stash->{users} = []; - $r->stash->{globalSets} = []; + $c->stash->{users} = []; + $c->stash->{globalSets} = []; # Permissions dealt with in the body return '' unless $authz->hasPermissions($user, 'access_instructor_tools'); return '' unless $authz->hasPermissions($user, 'assign_problem_sets'); - my @selected_users = $r->param('selected_users'); - my @selected_sets = $r->param('selected_sets'); + my @selected_users = $c->param('selected_users'); + my @selected_sets = $c->param('selected_sets'); - if (defined $r->param('assign') || defined $r->param('unassign')) { + if (defined $c->param('assign') || defined $c->param('unassign')) { if (@selected_users && @selected_sets) { my @results; # This is not used? - if (defined $r->param('assign')) { + if (defined $c->param('assign')) { assignSetsToUsers($db, \@selected_sets, \@selected_users); - $self->addgoodmessage($r->maketext('All assignments were made successfully.')); + $c->addgoodmessage($c->maketext('All assignments were made successfully.')); } - if (defined $r->param('unassign')) { - if (defined $r->param('unassignFromAllSafety') and $r->param('unassignFromAllSafety') == 1) { - unassignSetsFromUsers($db, \@selected_sets, \@selected_users) if (defined $r->param('unassign')); - $self->addgoodmessage($r->maketext('All unassignments were made successfully.')); + if (defined $c->param('unassign')) { + if (defined $c->param('unassignFromAllSafety') and $c->param('unassignFromAllSafety') == 1) { + unassignSetsFromUsers($db, \@selected_sets, \@selected_users) if (defined $c->param('unassign')); + $c->addgoodmessage($c->maketext('All unassignments were made successfully.')); } else { # asked for unassign, but no safety radio toggle - $self->addbadmessage($r->maketext( + $c->addbadmessage($c->maketext( 'Unassignments were not done. ' . 'You need to select "Allow unassign" and then click on the Unassign button.' )); @@ -66,22 +61,22 @@ async sub pre_header_initialize { } if (@results) { # Can't get here? - $self->addbadmessage( - $r->c('The following error(s) occured while assigning:', - $r->tag('ul', $r->c(map { $r->tag('li', $_) } @results)->join('')))->join('') + $c->addbadmessage( + $c->c('The following error(s) occured while assigning:', + $c->tag('ul', $c->c(map { $c->tag('li', $_) } @results)->join('')))->join('') ); } } else { - $self->addbadmessage('You must select one or more users below.') + $c->addbadmessage('You must select one or more users below.') unless @selected_users; - $self->addbadmessage('You must select one or more sets below.') + $c->addbadmessage('You must select one or more sets below.') unless @selected_sets; } } # Get all users except the set level proctors, and restrict to the sections or recitations that are allowed for the # user if such restrictions are defined. - $r->stash->{users} = [ + $c->stash->{users} = [ $db->getUsersWhere({ user_id => { not_like => 'set_id:%' }, $ce->{viewable_sections}{$user} || $ce->{viewable_recitations}{$user} @@ -95,7 +90,7 @@ async sub pre_header_initialize { }) ]; - $r->stash->{globalSets} = [ $db->getGlobalSetsWhere ]; + $c->stash->{globalSets} = [ $db->getGlobalSetsWhere ]; return; } diff --git a/lib/WeBWorK/ContentGenerator/Instructor/Config.pm b/lib/WeBWorK/ContentGenerator/Instructor/Config.pm index f9322ae05f..a9b52e6996 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/Config.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/Config.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::Instructor::Config; -use parent qw(WeBWorK::ContentGenerator); +use Mojo::Base 'WeBWorK::ContentGenerator', -signatures; =head1 NAME @@ -22,9 +22,6 @@ WeBWorK::ContentGenerator::Instructor::Config - Config =cut -use strict; -use warnings; - use WeBWorK::CourseEnvironment; use WeBWorK::ConfigObject::text; use WeBWorK::ConfigObject::timezone; @@ -49,8 +46,7 @@ use WeBWorK::ConfigObject::popuplist; # 'PopupList' for variables that hold a list of values to be selected from. # Write contents to outputFilePath and return error messages if any. -sub writeFile { - my ($outputFilePath, $contents) = @_; +sub writeFile ($outputFilePath, $contents) { if (open my $OUTPUTFILE, '>:encoding(UTF-8)', $outputFilePath) { print $OUTPUTFILE $contents; close $OUTPUTFILE; @@ -66,34 +62,30 @@ sub writeFile { } # Make a new config object from data -sub objectify { - my ($self, $data) = @_; - return "WeBWorK::ConfigObject::$data->{type}"->new($data, $self); +sub objectify ($c, $data) { + return "WeBWorK::ConfigObject::$data->{type}"->new($data, $c); } -sub generate_navigation_tabs { - my ($self, $current_tab, @tab_names) = @_; - my $r = $self->r; - my $tabs = $r->c; +sub generate_navigation_tabs ($c, $current_tab, @tab_names) { + my $tabs = $c->c; for my $tab (0 .. (scalar(@tab_names) - 1)) { if ($current_tab eq "tab$tab") { - push(@$tabs, $r->tag('span', class => 'nav-link active', $r->maketext($tab_names[$tab]))); + push(@$tabs, $c->tag('span', class => 'nav-link active', $c->maketext($tab_names[$tab]))); } else { push( @$tabs, - $r->link_to( - $r->maketext($tab_names[$tab]) => - $self->systemLink($r->urlpath, params => { section_tab => "tab$tab" }), + $c->link_to( + $c->maketext($tab_names[$tab]) => + $c->systemLink($c->url_for, params => { section_tab => "tab$tab" }), class => 'nav-link' ) ); } } - return $r->tag('nav', class => 'config-tabs nav nav-pills justify-content-center my-4', $tabs->join('')); + return $c->tag('nav', class => 'config-tabs nav nav-pills justify-content-center my-4', $tabs->join('')); } -sub getConfigValues { - my ($self, $ce) = @_; +sub getConfigValues ($c, $ce) { my $configValues = $ce->{ConfigValues}; # Get the list of theme folders in the theme directory and remove . and .. and 'layouts'. @@ -137,15 +129,13 @@ sub getConfigValues { return $configValues; } -async sub pre_header_initialize { - my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; - my $configValues = $self->getConfigValues($ce); +sub pre_header_initialize ($c) { + my $ce = $c->ce; + my $configValues = $c->getConfigValues($ce); # Get a course environment without course.conf - $self->{default_ce} = WeBWorK::CourseEnvironment->new({ %WeBWorK::SeedCE, }); + $c->{default_ce} = WeBWorK::CourseEnvironment->new({ %WeBWorK::SeedCE, }); - $self->{ce_file_dir} = $ce->{courseDirs}{root}; + $c->{ce_file_dir} = $ce->{courseDirs}{root}; # Get a copy of the course environment which does not have simple.conf loaded my $ce3 = WeBWorK::CourseEnvironment->new({ @@ -153,7 +143,7 @@ async sub pre_header_initialize { courseName => $ce->{courseName}, web_config_filename => 'noSuchFilePlease' }); - if ($r->param('make_changes')) { + if ($c->param('make_changes')) { my $fileoutput = "#!perl # This file is automatically generated by WeBWorK's web-based # configuration module. Do not make changes directly to this @@ -161,14 +151,14 @@ async sub pre_header_initialize { # changes are saved.\n\n"; # Get the number of the current tab - my $tab = $r->param('section_tab') || 'tab0'; + my $tab = $c->param('section_tab') || 'tab0'; $tab =~ s/tab//; # We completely rewrite the simple configuration file, so we need to go through all sections. for my $configSection (@{$configValues}) { my @configSectionArray = @{$configSection}; shift @configSectionArray; for my $con (@configSectionArray) { - my $conobject = $self->objectify($con); + my $conobject = $c->objectify($con); if ($tab) { # This tab is hidden so use the current course environment value. $fileoutput .= $conobject->save_string($con->get_value($ce3), 1); @@ -179,11 +169,11 @@ async sub pre_header_initialize { } $tab--; } - my @write_result = writeFile("$self->{ce_file_dir}/simple.conf", $fileoutput); + my @write_result = writeFile("$c->{ce_file_dir}/simple.conf", $fileoutput); if (@write_result) { - $self->addbadmessage($r->c(@write_result)->join($r->tag('br'))); + $c->addbadmessage($c->c(@write_result)->join($c->tag('br'))); } else { - $self->addgoodmessage($r->maketext('Changes saved')); + $c->addgoodmessage($c->maketext('Changes saved')); } } diff --git a/lib/WeBWorK/ContentGenerator/Instructor/FileManager.pm b/lib/WeBWorK/ContentGenerator/Instructor/FileManager.pm index e49f1f89f9..03452ad70e 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/FileManager.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/FileManager.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::Instructor::FileManager; -use parent qw(WeBWorK::ContentGenerator); +use Mojo::Base 'WeBWorK::ContentGenerator', -signatures; =head1 NAME @@ -22,10 +22,6 @@ WeBWorK::ContentGenerator::Instructor::FileManager.pm -- simple directory manage =cut -use strict; -use warnings; -use utf8; - use File::Path; use File::Copy; use File::Spec; @@ -48,20 +44,17 @@ my %uploadDir = ( ); # Check that the user is authorized, and see if there is a download to perform. -async sub pre_header_initialize { - my $self = shift; - my $r = $self->r; - - return unless $r->authz->hasPermissions($r->param('user'), 'manage_course_files'); +sub pre_header_initialize ($c) { + return unless $c->authz->hasPermissions($c->param('user'), 'manage_course_files'); - my $action = $r->param('action'); - $self->Download if $action && ($action eq 'Download' || $action eq $r->maketext('Download')); + my $action = $c->param('action'); + $c->Download if $action && ($action eq 'Download' || $action eq $c->maketext('Download')); - $self->downloadFile($r->param('download')) if defined $r->param('download'); + $c->downloadFile($c->param('download')) if defined $c->param('download'); - if ($r->param('archiveCourse')) { - my $ce = $r->ce; - my $courseID = $r->urlpath->arg('courseID'); + if ($c->param('archiveCourse')) { + my $ce = $c->ce; + my $courseID = $c->stash('courseID'); my $message = eval { WeBWorK::Utils::CourseManagement::archiveCourse( @@ -71,34 +64,32 @@ async sub pre_header_initialize { ); }; if ($@) { - $self->addbadmessage($r->maketext('Failed to generate course archive: [_1]', $@)); + $c->addbadmessage($c->maketext('Failed to generate course archive: [_1]', $@)); } else { - $self->addgoodmessage($r->maketext('Archived course as [_1].tar.gz.', $courseID)); + $c->addgoodmessage($c->maketext('Archived course as [_1].tar.gz.', $courseID)); } - $self->addbadmessage($message) if ($message); + $c->addbadmessage($message) if ($message); } - $self->{pwd} = $self->checkPWD($r->param('pwd') || HOME); - $self->{courseRoot} = $r->ce->{courseDirs}{root}; - $self->{courseName} = $r->urlpath->arg('courseID'); + $c->{pwd} = $c->checkPWD($c->param('pwd') || HOME); + $c->{courseRoot} = $c->ce->{courseDirs}{root}; + $c->{courseName} = $c->stash('courseID'); return; } # Download a given file -sub downloadFile { - my $self = shift; - my $r = $self->r; - my $file = checkName(shift); - my $pwd = $self->checkPWD(shift || $self->r->param('pwd') || HOME); +sub downloadFile ($c, $filename, $directory = '') { + my $file = checkName($filename); + my $pwd = $c->checkPWD($directory || $c->param('pwd') || HOME); return unless $pwd; - $pwd = $self->{ce}{courseDirs}{root} . '/' . $pwd; + $pwd = $c->{ce}{courseDirs}{root} . '/' . $pwd; unless (-e "$pwd/$file") { - $self->addbadmessage($r->maketext(q{The file you are trying to download doesn't exist})); + $c->addbadmessage($c->maketext(q{The file you are trying to download doesn't exist})); return; } unless (-f "$pwd/$file") { - $self->addbadmessage($r->maketext('You can only download regular files.')); + $c->addbadmessage($c->maketext('You can only download regular files.')); return; } my $type = 'application/octet-stream'; @@ -106,79 +97,71 @@ sub downloadFile { $type = 'image/gif' if $file =~ m/\.gif/; $type = 'image/jpeg' if $file =~ m/\.(jpg|jpeg)/; $type = 'image/png' if $file =~ m/\.png/; - $self->reply_with_file($type, "$pwd/$file", $file, 0); + $c->reply_with_file($type, "$pwd/$file", $file, 0); + return; } # First time through -sub Init { - my $self = shift; - $self->r->param('unpack', 1); - $self->r->param('autodelete', 1); - $self->r->param('format', 'Automatic'); - $self->Refresh; -} - -sub HiddenFlags { - my $self = shift; - my $r = $self->r; - return $r->c( - $r->hidden_field(dates => ''), - $r->hidden_field(overwrite => ''), - $r->hidden_field(unpack => ''), - $r->hidden_field(autodelete => ''), - $r->hidden_field(autodelete => 'Automatic'), +sub Init ($c) { + $c->param('unpack', 1); + $c->param('autodelete', 1); + $c->param('format', 'Automatic'); + return $c->Refresh; +} + +sub HiddenFlags ($c) { + return $c->c( + $c->hidden_field(dates => ''), + $c->hidden_field(overwrite => ''), + $c->hidden_field(unpack => ''), + $c->hidden_field(autodelete => ''), + $c->hidden_field(autodelete => 'Automatic'), )->join(''); } # Display the directory listing and associated buttons. -sub Refresh { - my ($self) = @_; - return $self->r->include('ContentGenerator/Instructor/FileManager/refresh'); +sub Refresh ($c) { + return $c->include('ContentGenerator/Instructor/FileManager/refresh'); } # Move to the parent directory -sub ParentDir { - my $self = shift; - $self->{pwd} = '.' unless ($self->{pwd} =~ s!/[^/]*$!!); - $self->Refresh; +sub ParentDir ($c) { + $c->{pwd} = '.' unless ($c->{pwd} =~ s!/[^/]*$!!); + return $c->Refresh; } # Move to the parent directory -sub Go { - my $self = shift; - $self->{pwd} = $self->r->param('directory'); - $self->Refresh; +sub Go ($c) { + $c->{pwd} = $c->param('directory'); + return $c->Refresh; } # Open a directory or view a file -sub View { - my $self = shift; - my $r = $self->r; - - my $filename = $self->getFile('view'); +sub View ($c) { + my $filename = $c->getFile('view'); return '' unless $filename; - my $name = "$self->{pwd}/$filename" =~ s!^\./?!!r; - my $file = "$self->{courseRoot}/$self->{pwd}/$filename"; + my $name = "$c->{pwd}/$filename" =~ s!^\./?!!r; + my $file = "$c->{courseRoot}/$c->{pwd}/$filename"; # Don't follow symbolic links - if ($self->isSymLink($file)) { - $self->addbadmessage($r->maketext('You may not follow symbolic links')); - return $self->Refresh; + if ($c->isSymLink($file)) { + $c->addbadmessage($c->maketext('You may not follow symbolic links')); + return $c->Refresh; } # Handle directories by making them the working directory if (-d $file) { - $self->{pwd} .= '/' . $filename; - return $self->Refresh; + $c->{pwd} .= '/' . $filename; + return $c->Refresh; } unless (-f $file) { - $self->addbadmessage($r->maketext(q{You can't view files of that type})); - return $self->Refresh; + $c->addbadmessage($c->maketext(q{You can't view files of that type})); + return $c->Refresh; } - return $r->include( + return $c->include( 'ContentGenerator/Instructor/FileManager/view', filename => $filename, name => $name, @@ -187,357 +170,325 @@ sub View { } # Edit a file -sub Edit { - my $self = shift; - my $filename = $self->getFile('edit'); +sub Edit ($c) { + my $filename = $c->getFile('edit'); return '' unless $filename; - my $file = "$self->{courseRoot}/$self->{pwd}/$filename"; - my $r = $self->r; - my $userID = $r->param('user'); - my $ce = $r->ce; - my $authz = $r->authz; + my $file = "$c->{courseRoot}/$c->{pwd}/$filename"; + my $userID = $c->param('user'); + my $ce = $c->ce; + my $authz = $c->authz; # If its a restricted file, dont allow the web editor to edit it unless that option has been set for the course. for my $restrictedFile (@{ $ce->{uneditableCourseFiles} }) { - if (File::Spec->canonpath($file) eq File::Spec->canonpath("$self->{courseRoot}/$restrictedFile") + if (File::Spec->canonpath($file) eq File::Spec->canonpath("$c->{courseRoot}/$restrictedFile") && !$authz->hasPermissions($userID, 'edit_restricted_files')) { - $self->addbadmessage($r->maketext('You do not have permission to edit this file.')); - return $self->Refresh; + $c->addbadmessage($c->maketext('You do not have permission to edit this file.')); + return $c->Refresh; } } if (-d $file) { - $self->addbadmessage($r->maketext(q{You can't edit a directory})); - return $self->Refresh; + $c->addbadmessage($c->maketext(q{You can't edit a directory})); + return $c->Refresh; } unless (-f $file) { - $self->addbadmessage($r->maketext('You can only edit text files')); - return $self->Refresh; + $c->addbadmessage($c->maketext('You can only edit text files')); + return $c->Refresh; } if (-T $file) { - return $self->RefreshEdit(readFile($file), $filename); + return $c->RefreshEdit(readFile($file), $filename); } else { - $self->addbadmessage($r->maketext('The file does not appear to be a text file')); - return $self->Refresh; + $c->addbadmessage($c->maketext('The file does not appear to be a text file')); + return $c->Refresh; } - return ''; } # Save the edited file -sub Save { - my $self = shift; - my $filename = shift; - my $r = $self->r; - my $pwd = $self->{pwd}; +sub Save ($c, $filename = '') { + my $pwd = $c->{pwd}; if ($filename) { - $pwd = substr($filename, length($self->{courseRoot}) + 1) =~ s!(/|^)([^/]*)$!!r; + $pwd = substr($filename, length($c->{courseRoot}) + 1) =~ s!(/|^)([^/]*)$!!r; $filename = $2; $pwd = '.' if $pwd eq ''; } else { - $filename = $self->getFile('save'); + $filename = $c->getFile('save'); return unless $filename; } - my $file = "$self->{courseRoot}/$pwd/$filename"; - my $data = $self->r->param('data'); + my $file = "$c->{courseRoot}/$pwd/$filename"; + my $data = $c->param('data'); if (defined($data)) { $data =~ s/\r\n?/\n/g; # convert DOS and Mac line ends to unix if (open(my $OUTFILE, '>:encoding(UTF-8)', $file)) { print $OUTFILE $data; close($OUTFILE); - if ($@) { $self->addbadmessage($r->maketext('Failed to save: [_1]', $@)) } - else { $self->addgoodmessage($r->maketext('File saved')) } + if ($@) { $c->addbadmessage($c->maketext('Failed to save: [_1]', $@)) } + else { $c->addgoodmessage($c->maketext('File saved')) } } else { - $self->addbadmessage($r->maketext(q{Can't write to file [_1]}, $!)); + $c->addbadmessage($c->maketext(q{Can't write to file [_1]}, $!)); } } else { $data = ''; - $self->addbadmessage($r->maketext('Error: no file data was submitted!')); + $c->addbadmessage($c->maketext('Error: no file data was submitted!')); } - $self->{pwd} = $pwd; - $self->RefreshEdit($data, $filename); + $c->{pwd} = $pwd; + return $c->RefreshEdit($data, $filename); } # Save the edited file under a new name -sub SaveAs { - my $self = shift; - - my $newfile = $self->r->param('name'); - my $original = $self->r->param('files'); - $newfile = $self->verifyPath($newfile, $original); - return $self->Save($newfile) if $newfile; - $self->RefreshEdit($self->r->param('data'), $original); +sub SaveAs ($c) { + my $newfile = $c->param('name'); + my $original = $c->param('files'); + $newfile = $c->verifyPath($newfile, $original); + return $c->Save($newfile) if ($newfile); + return $c->RefreshEdit($c->param('data'), $original); } # Display the Edit page -sub RefreshEdit { - my ($self, $data, $file) = @_; - return $self->r->include('ContentGenerator/Instructor/FileManager/refresh_edit', contents => $data, file => $file); +sub RefreshEdit ($c, $data, $file) { + return $c->include('ContentGenerator/Instructor/FileManager/refresh_edit', contents => $data, file => $file); } # Copy a file -sub Copy { - my $self = shift; - my $r = $self->r; - my $dir = "$self->{courseRoot}/$self->{pwd}"; - my $original = $self->getFile('copy'); +sub Copy ($c) { + my $dir = "$c->{courseRoot}/$c->{pwd}"; + my $original = $c->getFile('copy'); return '' unless $original; my $oldfile = "$dir/$original"; if (-d $oldfile) { # FIXME: need to do recursive directory copy - $self->addbadmessage('Directory copies are not yet implemented'); - return $self->Refresh; + $c->addbadmessage('Directory copies are not yet implemented'); + return $c->Refresh; } - if ($self->r->param('confirmed')) { - my $newfile = $self->r->param('name'); - if ($newfile = $self->verifyPath($newfile, $original)) { + if ($c->param('confirmed')) { + my $newfile = $c->param('name'); + if ($newfile = $c->verifyPath($newfile, $original)) { if (copy($oldfile, $newfile)) { - $self->addgoodmessage($r->maketext('File successfully copied')); - return $self->Refresh; + $c->addgoodmessage($c->maketext('File successfully copied')); + return $c->Refresh; } else { - $self->addbadmessage($r->maketext(q{Can't copy file: [_1]}, $!)); + $c->addbadmessage($c->maketext(q{Can't copy file: [_1]}, $!)); } } } - return $r->c($self->Confirm($r->maketext('Copy file as:'), uniqueName($dir, $original), $r->maketext('Copy')), - $r->hidden_field(files => $original))->join(''); + return $c->c($c->Confirm($c->maketext('Copy file as:'), uniqueName($dir, $original), $c->maketext('Copy')), + $c->hidden_field(files => $original))->join(''); } # Rename a file -sub Rename { - my $self = shift; - my $r = $self->r; - my $dir = "$self->{courseRoot}/$self->{pwd}"; - my $original = $self->getFile('rename'); +sub Rename ($c) { + my $dir = "$c->{courseRoot}/$c->{pwd}"; + my $original = $c->getFile('rename'); return '' unless $original; my $oldfile = "$dir/$original"; - if ($self->r->param('confirmed')) { - my $newfile = $self->r->param('name'); - if ($newfile = $self->verifyPath($newfile, $original)) { + if ($c->param('confirmed')) { + my $newfile = $c->param('name'); + if ($newfile = $c->verifyPath($newfile, $original)) { if (rename $oldfile, $newfile) { - $self->addgoodmessage($r->maketext('File successfully renamed')); - return $self->Refresh; + $c->addgoodmessage($c->maketext('File successfully renamed')); + return $c->Refresh; } else { - $self->addbadmessage($r->maketext(q{Can't rename file: [_1]}, $!)); + $c->addbadmessage($c->maketext(q{Can't rename file: [_1]}, $!)); } } } - return $r->c($self->Confirm($r->maketext('Rename file as:'), $original, $r->maketext('Rename')), - $r->hidden_field(files => $original))->join(''); + return $c->c($c->Confirm($c->maketext('Rename file as:'), $original, $c->maketext('Rename')), + $c->hidden_field(files => $original))->join(''); } # Delete a file -sub Delete { - my $self = shift; - my $r = $self->r; - my @files = $self->r->param('files'); +sub Delete ($c) { + my @files = $c->param('files'); if (!@files) { - $self->addbadmessage($r->maketext('You must select at least one file to delete')); - return $self->Refresh; + $c->addbadmessage($c->maketext('You must select at least one file to delete')); + return $c->Refresh; } - my $dir = "$self->{courseRoot}/$self->{pwd}"; - if ($self->r->param('confirmed')) { + my $dir = "$c->{courseRoot}/$c->{pwd}"; + if ($c->param('confirmed')) { # If confirmed, go ahead and delete the files for my $file (@files) { - if (defined $self->checkPWD("$self->{pwd}/$file", 1)) { + if (defined $c->checkPWD("$c->{pwd}/$file", 1)) { if (-d "$dir/$file" && !-l "$dir/$file") { my $removed = eval { rmtree("$dir/$file", 0, 1) }; if ($removed) { - $self->addgoodmessage( - $r->maketext('Directory "[_1]" removed (items deleted: [_2])', $file, $removed)); + $c->addgoodmessage( + $c->maketext('Directory "[_1]" removed (items deleted: [_2])', $file, $removed)); } else { - $self->addbadmessage($r->maketext('Directory "[_1]" not removed: [_2]', $file, $!)); + $c->addbadmessage($c->maketext('Directory "[_1]" not removed: [_2]', $file, $!)); } } else { if (unlink("$dir/$file")) { - $self->addgoodmessage($r->maketext('File "[_1]" successfully removed', $file)); + $c->addgoodmessage($c->maketext('File "[_1]" successfully removed', $file)); } else { - $self->addbadmessage($r->maketext('File "[_1]" not removed: [_2]', $file, $!)); + $c->addbadmessage($c->maketext('File "[_1]" not removed: [_2]', $file, $!)); } } } else { - $self->addbadmessage($r->maketext('Illegal file "[_1]" specified', $file)); + $c->addbadmessage($c->maketext('Illegal file "[_1]" specified', $file)); last; } } - return $self->Refresh; + return $c->Refresh; } else { - return $r->include('ContentGenerator/Instructor/FileManager/delete', dir => $dir, files => \@files); + return $c->include('ContentGenerator/Instructor/FileManager/delete', dir => $dir, files => \@files); } } # Make a gzipped tar archive -sub MakeArchive { - my $self = shift; - my $r = $self->r; - my @files = $self->r->param('files'); +sub MakeArchive ($c) { + my @files = $c->param('files'); if (scalar(@files) == 0) { - $self->addbadmessage($r->maketext('You must select at least one file for the archive')); - return $self->Refresh; + $c->addbadmessage($c->maketext('You must select at least one file for the archive')); + return $c->Refresh; } - my $dir = $self->{courseRoot} . '/' . $self->{pwd}; - my $archive = uniqueName($dir, (scalar(@files) == 1) ? $files[0] . '.tgz' : $self->{courseName} . '.tgz'); - my $tar = - 'cd ' . shell_quote($dir) . " && $self->{ce}{externalPrograms}{tar} -cvzf " . shell_quote($archive, @files); + my $dir = "$c->{courseRoot}/$c->{pwd}"; + my $archive = uniqueName($dir, (scalar(@files) == 1) ? $files[0] . '.tgz' : "$c->{courseName}.tgz"); + my $tar = 'cd ' . shell_quote($dir) . " && $c->{ce}{externalPrograms}{tar} -cvzf " . shell_quote($archive, @files); @files = readpipe $tar . ' 2>&1'; if ($? == 0) { my $n = scalar(@files); - $self->addgoodmessage($r->maketext('Archive "[_1]" created successfully ([quant, _2, file])', $archive, $n)); + $c->addgoodmessage($c->maketext('Archive "[_1]" created successfully ([quant, _2, file])', $archive, $n)); } else { - $self->addbadmessage( - $r->maketext(q{Can't create archive "[_1]": command returned [_2]}, $archive, systemError($?))); + $c->addbadmessage( + $c->maketext(q{Can't create archive "[_1]": command returned [_2]}, $archive, systemError($?))); } - return $self->Refresh; + return $c->Refresh; } # Unpack a gzipped tar archive -sub UnpackArchive { - my $self = shift; - my $r = $self->r; - my $archive = $self->getFile('unpack'); +sub UnpackArchive ($c) { + my $archive = $c->getFile('unpack'); return '' unless $archive; if ($archive !~ m/\.(tar|tar\.gz|tgz)$/) { - $self->addbadmessage($r->maketext('You can only unpack files ending in ".tgz", ".tar" or ".tar.gz"')); + $c->addbadmessage($c->maketext('You can only unpack files ending in ".tgz", ".tar" or ".tar.gz"')); } else { - $self->unpack($archive); + $c->unpack_archive($archive); } - return $self->Refresh; + return $c->Refresh; } -sub unpack { - my $self = shift; - my $r = $self->r; - my $archive = shift; - my $z = 'z'; - $z = '' if $archive =~ m/\.tar$/; - my $dir = $self->{courseRoot} . '/' . $self->{pwd}; - my $tar = 'cd ' . shell_quote($dir) . " && $self->{ce}{externalPrograms}{tar} -vx${z}f " . shell_quote($archive); - my @files = readpipe $tar . ' 2>&1'; +sub unpack_archive ($c, $archive) { + my $z = $archive =~ m/\.tar$/ ? '' : 'z'; + my $dir = "$c->{courseRoot}/$c->{pwd}"; + my $tar = 'cd ' . shell_quote($dir) . " && $c->{ce}{externalPrograms}{tar} -vx${z}f " . shell_quote($archive); + my @files = readpipe "$tar 2>&1"; if ($? == 0) { my $n = scalar(@files); - $self->addgoodmessage($r->maketext('[quant,_1,file] unpacked successfully', $n)); + $c->addgoodmessage($c->maketext('[quant,_1,file] unpacked successfully', $n)); return 1; } else { - $self->addbadmessage($r->maketext(q{Can't unpack "[_1]": command returned [_2]}, $archive, systemError($?))); + $c->addbadmessage($c->maketext(q{Can't unpack "[_1]": command returned [_2]}, $archive, systemError($?))); return 0; } } # Make a new file and edit it -sub NewFile { - my $self = shift; - my $r = $self->r; - - if ($self->r->param('confirmed')) { - my $name = $self->r->param('name'); - if (my $file = $self->verifyName($name, 'file')) { +sub NewFile ($c) { + if ($c->param('confirmed')) { + my $name = $c->param('name'); + if (my $file = $c->verifyName($name, 'file')) { if (open(my $NEWFILE, '>:encoding(UTF-8)', $file)) { close $NEWFILE; - return $self->RefreshEdit('', $name); + return $c->RefreshEdit('', $name); } else { - $self->addbadmessage($r->maketext(q{Can't create file: [_1]}, $!)); + $c->addbadmessage($c->maketext(q{Can't create file: [_1]}, $!)); } } } - return $self->Confirm($r->maketext('New file name:'), '', $r->maketext('New File')); + return $c->Confirm($c->maketext('New file name:'), '', $c->maketext('New File')); } # Make a new directory -sub NewFolder { - my $self = shift; - my $r = $self->r; - - if ($self->r->param('confirmed')) { - my $name = $self->r->param('name'); - if (my $dir = $self->verifyName($name, 'directory')) { +sub NewFolder ($c) { + if ($c->param('confirmed')) { + my $name = $c->param('name'); + if (my $dir = $c->verifyName($name, 'directory')) { if (mkdir $dir, 0750) { - $self->{pwd} .= '/' . $name; - return $self->Refresh; + $c->{pwd} .= "/$name"; + return $c->Refresh; } else { - $self->addbadmessage($r->maketext(q{Can't create directory: [_1]}, $!)); + $c->addbadmessage($c->maketext(q{Can't create directory: [_1]}, $!)); } } } - return $self->Confirm($r->maketext('New folder name:'), '', $r->maketext('New Folder')); + return $c->Confirm($c->maketext('New folder name:'), '', $c->maketext('New Folder')); } # Download a file -sub Download { - my $self = shift; - my $r = $self->r; - my $pwd = $self->checkPWD($self->r->param('pwd') || HOME); +sub Download ($c) { + my $pwd = $c->checkPWD($c->param('pwd') || HOME); return unless $pwd; - my $filename = $self->getFile('download'); + my $filename = $c->getFile('download'); return unless $filename; - my $file = $self->{ce}{courseDirs}{root} . '/' . $pwd . '/' . $filename; + my $file = "$c->{ce}{courseDirs}{root}/$pwd/$filename"; + + if (-d $file) { $c->addbadmessage($c->maketext(q{You can't download directories})); return } + unless (-f $file) { $c->addbadmessage($c->maketext(q{You can't download files of that type})); return } - if (-d $file) { $self->addbadmessage($r->maketext(q{You can't download directories})); return } - unless (-f $file) { $self->addbadmessage($r->maketext(q{You can't download files of that type})); return } + $c->param('download', $filename); - $self->r->param('download', $filename); + return; } # Upload a file to the server -sub Upload { - my $self = shift; - my $r = $self->r; - my $dir = "$self->{courseRoot}/$self->{pwd}"; - my $fileIDhash = $self->r->param('file'); +sub Upload ($c) { + my $dir = "$c->{courseRoot}/$c->{pwd}"; + my $fileIDhash = $c->param('file'); unless ($fileIDhash) { - $self->addbadmessage($r->maketext('You have not chosen a file to upload.')); - return $self->Refresh; + $c->addbadmessage($c->maketext('You have not chosen a file to upload.')); + return $c->Refresh; } my ($id, $hash) = split(/\s+/, $fileIDhash); - my $upload = WeBWorK::Upload->retrieve($id, $hash, dir => $self->{ce}{webworkDirs}{uploadCache}); + my $upload = WeBWorK::Upload->retrieve($id, $hash, dir => $c->{ce}{webworkDirs}{uploadCache}); my $name = checkName($upload->filename); - my $action = $self->r->param('formAction') || 'Cancel'; - if ($self->r->param('confirmed')) { - if ($action eq 'Cancel' || $action eq $r->maketext('Cancel')) { + my $action = $c->param('formAction') || 'Cancel'; + if ($c->param('confirmed')) { + if ($action eq 'Cancel' || $action eq $c->maketext('Cancel')) { $upload->dispose; - return $self->Refresh; + return $c->Refresh; } - $name = checkName($self->r->param('name')) if ($action eq 'Rename' || $action eq $r->maketext('Rename')); + $name = checkName($c->param('name')) if ($action eq 'Rename' || $action eq $c->maketext('Rename')); } if (-e "$dir/$name") { - unless ($self->r->param('overwrite') || $action eq 'Overwrite' || $action eq $r->maketext('Overwrite')) { - return $r->c( - $self->Confirm( - $r->tag( + unless ($c->param('overwrite') || $action eq 'Overwrite' || $action eq $c->maketext('Overwrite')) { + return $c->c( + $c->Confirm( + $c->tag( 'p', - $r->b( - $r->maketext('File [_1] already exists. Overwrite it, or rename it as:', $name) + $c->b( + $c->maketext('File [_1] already exists. Overwrite it, or rename it as:', $name) ) ), uniqueName($dir, $name), - $r->maketext('Rename'), - $r->maketext('Overwrite') + $c->maketext('Rename'), + $c->maketext('Overwrite') ), - $r->hidden_field(action => 'Upload'), - $r->hidden_field(file => $fileIDhash) + $c->hidden_field(action => 'Upload'), + $c->hidden_field(file => $fileIDhash) )->join(''); } } - $self->checkFileLocation($name, $self->{pwd}); + $c->checkFileLocation($name, $c->{pwd}); my $file = "$dir/$name"; - my $type = $self->getFlag('format', 'Automatic'); + my $type = $c->getFlag('format', 'Automatic'); my $data; # Check if we need to convert linebreaks @@ -561,29 +512,28 @@ sub Upload { print $UPLOAD $data; # print massaged data to file. close $UPLOAD; } else { - $self->addbadmessage($r->maketext(q{Can't create file "[_1]": [_2]}, $name, $!)); + $c->addbadmessage($c->maketext(q{Can't create file "[_1]": [_2]}, $name, $!)); } } else { $upload->disposeTo($file); } if (-e $file) { - $self->addgoodmessage($r->maketext('File "[_1]" uploaded successfully', $name)); - if ($name =~ m/\.(tar|tar\.gz|tgz)$/ && $self->getFlag('unpack')) { - if ($self->unpack($name) && $self->getFlag('autodelete')) { - if (unlink($file)) { $self->addgoodmessage($r->maketext('Archive "[_1]" deleted', $name)) } - else { $self->addbadmessage($r->maketext(q{Can't delete archive "[_1]": [_2]}, $name, $!)) } + $c->addgoodmessage($c->maketext('File "[_1]" uploaded successfully', $name)); + if ($name =~ m/\.(tar|tar\.gz|tgz)$/ && $c->getFlag('unpack')) { + if ($c->unpack_archive($name) && $c->getFlag('autodelete')) { + if (unlink($file)) { $c->addgoodmessage($c->maketext('Archive "[_1]" deleted', $name)) } + else { $c->addbadmessage($c->maketext(q{Can't delete archive "[_1]": [_2]}, $name, $!)) } } } } - return $self->Refresh; + return $c->Refresh; } # Print a confirmation dialog box -sub Confirm { - my ($self, $message, $value, $button, $button2) = @_; - return $self->r->include( +sub Confirm ($c, $message, $value, $button, $button2 = '') { + return $c->include( 'ContentGenerator/Instructor/FileManager/confirm', message => $message, value => $value, @@ -593,39 +543,34 @@ sub Confirm { } # Check that there is exactly one valid file -sub getFile { - my $self = shift; - my $action = shift; - my $r = $self->r; - my @files = $self->r->param('files'); +sub getFile ($c, $action) { + my @files = $c->param('files'); if (scalar(@files) > 1) { - $self->addbadmessage($r->maketext('You can only [_1] one file at a time.', $action)); - $self->Refresh unless $action eq 'download'; + $c->addbadmessage($c->maketext('You can only [_1] one file at a time.', $action)); + $c->Refresh unless $action eq 'download'; return; } if (scalar(@files) == 0 || $files[0] eq '') { - $self->addbadmessage($r->maketext('You need to select a file to [_1].', $action)); - $self->Refresh unless $action eq 'download'; + $c->addbadmessage($c->maketext('You need to select a file to [_1].', $action)); + $c->Refresh unless $action eq 'download'; return; } - my $pwd = $self->checkPWD($self->{pwd} || $self->r->param('pwd') || HOME) || '.'; - if ($self->isSymLink($pwd . '/' . $files[0])) { - $self->addbadmessage($r->maketext('You may not follow symbolic links')); - $self->Refresh unless $action eq 'download'; + my $pwd = $c->checkPWD($c->{pwd} || $c->param('pwd') || HOME) || '.'; + if ($c->isSymLink($pwd . '/' . $files[0])) { + $c->addbadmessage($c->maketext('You may not follow symbolic links')); + $c->Refresh unless $action eq 'download'; return; } - unless ($self->checkPWD($pwd . '/' . $files[0], 1)) { - $self->addbadmessage($r->maketext('You have specified an illegal file')); - $self->Refresh unless $action eq 'download'; + unless ($c->checkPWD($pwd . '/' . $files[0], 1)) { + $c->addbadmessage($c->maketext('You have specified an illegal file')); + $c->Refresh unless $action eq 'download'; return; } return $files[0]; } # Get the entries for the directory menu -sub directoryMenu { - my ($self, $dir) = @_; - +sub directoryMenu ($c, $dir) { $dir =~ s!^\.(/|$)!!; my @dirs = split('/', $dir); @@ -635,14 +580,13 @@ sub directoryMenu { $dir = pop(@dirs); push(@values, [ $dir => $pwd ]); } - push(@values, [ $self->{courseName} => '.' ]); + push(@values, [ $c->{courseName} => '.' ]); return \@values; } # Get the directory listing -sub directoryListing { - my ($self, $pwd) = @_; - my $dir = "$self->{courseRoot}/$pwd"; +sub directoryListing ($c, $pwd) { + my $dir = "$c->{courseRoot}/$pwd"; return unless -d $dir; @@ -660,13 +604,13 @@ sub directoryListing { push(@values, [ $label => $name ]); } } - if ($self->getFlag('dates')) { + if ($c->getFlag('dates')) { $len += 3; for my $name (@values) { my $file = "$dir/$name->[1]"; my ($size, $date) = (lstat($file))[ 7, 9 ]; $name->[0] = - $self->r->b( + $c->b( sprintf("%-${len}s%-16s%10s", $name->[0], -d $file ? ('', '') : (getDate($date), getSize($size))) =~ s/\s/ /gr); } @@ -674,13 +618,12 @@ sub directoryListing { return \@values; } -sub getDate { - my ($sec, $min, $hour, $day, $month, $year) = localtime(shift); +sub getDate ($date) { + my ($sec, $min, $hour, $day, $month, $year) = localtime($date); return sprintf('%02d-%02d-%04d %02d:%02d', $month + 1, $day, $year + 1900, $hour, $min); } -sub getSize { - my $size = shift; +sub getSize ($size) { return $size . ' B ' if $size < 1024; return sprintf('%.1f KB', $size / 1024) if $size < 1024 * 100; return sprintf('%d KB', int($size / 1024)) if $size < 1024 * 1024; @@ -689,14 +632,12 @@ sub getSize { } # Check if a file is a symbolic link that we are not allowed to follow. -sub isSymLink { - my $self = shift; - my $file = shift; +sub isSymLink ($c, $file) { return 0 unless -l $file; - my $courseRoot = $self->{ce}{courseDirs}{root}; + my $courseRoot = $c->{ce}{courseDirs}{root}; $courseRoot = readlink($courseRoot) if -l $courseRoot; - my $pwd = $self->{pwd} || $self->r->param('pwd') || HOME; + my $pwd = $c->{pwd} || $c->param('pwd') || HOME; my $link = File::Spec->rel2abs(readlink($file), "$courseRoot/$pwd"); # Remove /./ and dir/../ constructs @@ -704,7 +645,7 @@ sub isSymLink { while ($link =~ s!((\.[^./]+|\.\.[^/]+|[^./][^/]*)/\.\.(/|$))!!) { } # Look through the list of valid paths to see if this link is OK - my $valid = $self->{ce}{webworkDirs}{valid_symlinks}; + my $valid = $c->{ce}{webworkDirs}{valid_symlinks}; if (defined $valid && $valid) { for my $path (@{$valid}) { return 0 if substr($link, 0, length($path)) eq $path; @@ -715,11 +656,7 @@ sub isSymLink { } # Normalize the working directory and check if it is OK. -sub checkPWD { - my $self = shift; - my $pwd = shift; - my $renameError = shift; - +sub checkPWD ($c, $pwd, $renameError = 0) { $pwd =~ s!//+!/!g; # remove duplicate slashes $pwd =~ s!(^|/)~!$1_!g; # remove ~user references $pwd =~ s!(^|/)(\.(/|$))+!$1!g; # remove dot directories @@ -733,10 +670,10 @@ sub checkPWD { # check for bad symbolic links my @dirs = split('/', $pwd); pop(@dirs) if $renameError; # don't check file iteself in this case - my @path = ($self->{ce}{courseDirs}{root}); + my @path = ($c->{ce}{courseDirs}{root}); for my $dir (@dirs) { push @path, $dir; - return if ($self->isSymLink(join('/', @path))); + return if ($c->isSymLink(join('/', @path))); } my $original = $pwd; @@ -750,22 +687,18 @@ sub checkPWD { } # Check that a file is uploaded to the correct directory -sub checkFileLocation { - my $self = shift; - my $r = $self->r; - my $extension = shift; +sub checkFileLocation ($c, $extension, $dir) { $extension =~ s/.*\.//; - my $dir = shift; my $location = $uploadDir{$extension}; - return unless defined($location); + return unless defined $location; return if $dir =~ m/^$location$/; $location =~ s!/\.\*!!; return if $dir =~ m/^$location$/; - $self->addbadmessage( - $r->maketext('Files with extension ".[_1]" usually belong in "[_2]"', $extension, $location) + $c->addbadmessage( + $c->maketext('Files with extension ".[_1]" usually belong in "[_2]"', $extension, $location) . ( - ($extension eq 'csv') - ? $r->maketext('. If this is a class roster, rename it to have extension ".lst"') + $extension eq 'csv' + ? $c->maketext('. If this is a class roster, rename it to have extension ".lst"') : '' ) ); @@ -774,8 +707,7 @@ sub checkFileLocation { } # Check a name for bad characters, etc. -sub checkName { - my $file = shift; +sub checkName ($file) { $file =~ s!.*[/\\]!!; # remove directory $file =~ s/[^-_.a-zA-Z0-9 ]/_/g; # no illegal characters $file =~ s/^\./_/; # no initial dot @@ -784,9 +716,7 @@ sub checkName { } # Get a unique name (in case it already exists) -sub uniqueName { - my $dir = shift; - my $name = shift; +sub uniqueName ($dir, $name) { return $name unless (-e "$dir/$name"); my $type = ''; my $n = 1; @@ -797,80 +727,67 @@ sub uniqueName { } # Verify that a name can be added to the current directory. -sub verifyName { - my $self = shift; - my $name = shift; - my $object = shift; - my $r = $self->r; +sub verifyName ($c, $name, $object) { if ($name) { unless ($name =~ m!/!) { unless ($name =~ m!^\.!) { unless ($name =~ m![^-_.a-zA-Z0-9 ]!) { - my $file = "$self->{courseRoot}/$self->{pwd}/$name"; + my $file = "$c->{courseRoot}/$c->{pwd}/$name"; return $file unless (-e $file); - $self->addbadmessage($r->maketext('A file with that name already exists')); + $c->addbadmessage($c->maketext('A file with that name already exists')); } else { - $self->addbadmessage($r->maketext('Your [_1] name contains illegal characters', $object)); + $c->addbadmessage($c->maketext('Your [_1] name contains illegal characters', $object)); } } else { - $self->addbadmessage($r->maketext('Your [_1] name may not begin with a dot', $object)); + $c->addbadmessage($c->maketext('Your [_1] name may not begin with a dot', $object)); } } else { - $self->addbadmessage($r->maketext('Your [_1] name may not contain a path component', $object)); + $c->addbadmessage($c->maketext('Your [_1] name may not contain a path component', $object)); } } else { - $self->addbadmessage($r->maketext('You must specify a [_1] name', $object)); + $c->addbadmessage($c->maketext('You must specify a [_1] name', $object)); } return; } # Verify that a file path is valid -sub verifyPath { - my $self = shift; - my $path = shift; - my $name = shift; - my $r = $self->r; - +sub verifyPath ($c, $path, $name) { if ($path) { unless ($path =~ m![^-_.a-zA-Z0-9 /]!) { unless ($path =~ m!^/!) { - $path = $self->checkPWD($self->{pwd} . '/' . $path, 1); + $path = $c->checkPWD($c->{pwd} . '/' . $path, 1); if ($path) { - $path = $self->{courseRoot} . '/' . $path; - $path .= '/' . $name if -d $path && $name; + $path = $c->{courseRoot} . '/' . $path; + $path .= "/$name" if -d $path && $name; return $path unless (-e $path); - $self->addbadmessage($r->maketext('A file with that name already exists')); + $c->addbadmessage($c->maketext('A file with that name already exists')); } else { - $self->addbadmessage($r->maketext('You have specified an illegal path')); + $c->addbadmessage($c->maketext('You have specified an illegal path')); } } else { - $self->addbadmessage($r->maketext('You can not specify an absolute path')); + $c->addbadmessage($c->maketext('You can not specify an absolute path')); } } else { - $self->addbadmessage($r->maketext('Your file name contains illegal characters')); + $c->addbadmessage($c->maketext('Your file name contains illegal characters')); } } else { - $self->addbadmessage($r->maketext('You must specify a file name')); + $c->addbadmessage($c->maketext('You must specify a file name')); } return; } # Get the value of a parameter flag -sub getFlag { - my ($self, $flag, $default) = @_; - $default //= 0; - return $self->r->param($flag) // $default; +sub getFlag ($c, $flag, $default = 0) { + return $c->param($flag) // $default; } # Check if a string is plain text -sub isText { - my $string = shift; +sub isText ($string) { return utf8::is_utf8($string); } # Interpret command return errors -sub systemError { - my $status = shift; +sub systemError ($status) { return "error: $!" if $status == 0xFF00; return 'exit status ' . ($status >> 8) if ($status & 0xFF) == 0; return 'signal ' . ($status &= ~0x80); diff --git a/lib/WeBWorK/ContentGenerator/Instructor/Index.pm b/lib/WeBWorK/ContentGenerator/Instructor/Index.pm index 65c374c227..ef4d9e8345 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/Index.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/Index.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::Instructor::Index; -use parent qw(WeBWorK::ContentGenerator); +use Mojo::Base 'WeBWorK::ContentGenerator', -signatures; =head1 NAME @@ -23,9 +23,6 @@ pages =cut -use strict; -use warnings; - use WeBWorK::Utils qw(x format_set_name_internal); use constant E_MAX_ONE_SET => x('Please select at most one set.'); @@ -36,32 +33,29 @@ use constant E_MIN_ONE_SET => x('Please select at least one set.'); use constant E_SET_NAME => x('Please specify a homework set name.'); use constant E_BAD_NAME => x('Please use only letters, digits, dashes, underscores, and periods in your set name.'); -async sub pre_header_initialize { - my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; - my $db = $r->db; - my $authz = $r->authz; - my $urlpath = $r->urlpath; +sub pre_header_initialize ($c) { + my $ce = $c->ce; + my $db = $c->db; + my $authz = $c->authz; # Make sure these are defined for the template. - $r->stash->{users} = []; - $r->stash->{globalSets} = []; - $r->stash->{E_MAX_ONE_SET} = E_MAX_ONE_SET; - $r->stash->{E_ONE_USER} = E_ONE_USER; - $r->stash->{E_ONE_SET} = E_ONE_SET; - $r->stash->{E_MIN_ONE_USER} = E_MIN_ONE_USER; - $r->stash->{E_MIN_ONE_SET} = E_MIN_ONE_SET; - $r->stash->{E_SET_NAME} = E_SET_NAME; - $r->stash->{E_BAD_NAME} = E_BAD_NAME; - $r->stash->{courseID} = $urlpath->arg('courseID'); - - my $userID = $r->param('user'); + $c->stash->{users} = []; + $c->stash->{globalSets} = []; + $c->stash->{E_MAX_ONE_SET} = E_MAX_ONE_SET; + $c->stash->{E_ONE_USER} = E_ONE_USER; + $c->stash->{E_ONE_SET} = E_ONE_SET; + $c->stash->{E_MIN_ONE_USER} = E_MIN_ONE_USER; + $c->stash->{E_MIN_ONE_SET} = E_MIN_ONE_SET; + $c->stash->{E_SET_NAME} = E_SET_NAME; + $c->stash->{E_BAD_NAME} = E_BAD_NAME; + $c->stash->{courseID} = $c->stash('courseID'); + + my $userID = $c->param('user'); return unless ($authz->hasPermissions($userID, 'access_instructor_tools')); - my @selectedUserIDs = $r->param('selected_users'); - my @selectedSetIDs = $r->param('selected_sets'); + my @selectedUserIDs = $c->param('selected_users'); + my @selectedSetIDs = $c->param('selected_sets'); my $nusers = @selectedUserIDs; my $nsets = @selectedSetIDs; @@ -69,108 +63,94 @@ async sub pre_header_initialize { my $firstUserID = $nusers ? $selectedUserIDs[0] : ''; my $firstSetID = $nsets ? $selectedSetIDs[0] : ''; - # These will be used to construct a new URL. - my $module; - my %args = (courseID => $r->stash->{courseID}); - my %params; - - my $pfx = 'WeBWorK::ContentGenerator'; - my $ipfx = 'WeBWorK::ContentGenerator::Instructor'; + # These will be used to construct the target URL. + my ($route, %args, %params); my @error; # Depending on which button was pushed, fill in values for URL construction. - if (defined $r->param('sets_assigned_to_user')) { + if (defined $c->param('sets_assigned_to_user')) { if ($nusers == 1) { - $module = "${ipfx}::UserDetail"; + $route = 'instructor_user_detail'; $args{userID} = $firstUserID; } else { push @error, E_ONE_USER; } - } elsif (defined $r->param('users_assigned_to_set')) { + } elsif (defined $c->param('users_assigned_to_set')) { if ($nsets == 1) { - $module = "${ipfx}::UsersAssignedToSet"; + $route = 'instructor_users_assigned_to_set'; $args{setID} = $firstSetID; } else { push @error, E_ONE_SET; } - } elsif (defined $r->param('edit_sets')) { + } elsif (defined $c->param('edit_sets')) { if ($nsets == 1) { - $module = "${ipfx}::ProblemSetDetail"; + $route = 'instructor_set_detail'; $args{setID} = $firstSetID; } else { push @error, E_ONE_SET; } - } elsif (defined $r->param('prob_lib')) { + } elsif (defined $c->param('prob_lib')) { if ($nsets == 1) { - $module = "${ipfx}::SetMaker"; + $route = 'instructor_set_maker'; $params{local_sets} = $firstSetID; } elsif ($nsets == 0) { - $module = "${ipfx}::SetMaker"; + $route = 'instructor_set_maker'; } else { push @error, E_ONE_SET; } - } elsif (defined $r->param('user_stats')) { + } elsif (defined $c->param('user_stats')) { if ($nusers == 1) { - $module = "${ipfx}::Stats"; - $args{statType} = 'student'; - $args{userID} = $firstUserID; + $route = 'instructor_user_statistics'; + $args{userID} = $firstUserID; } else { push @error, E_ONE_USER; } - } elsif (defined $r->param('set_stats')) { + } elsif (defined $c->param('set_stats')) { if ($nsets == 1) { - $module = "${ipfx}::Stats"; - $args{statType} = 'set'; - $args{setID} = $firstSetID; + $route = 'instructor_set_statistics'; + $args{setID} = $firstSetID; } else { push @error, E_ONE_SET; } - } elsif (defined $r->param('user_progress')) { + } elsif (defined $c->param('user_progress')) { if ($nusers == 1) { - $module = "${ipfx}::StudentProgress"; - $args{statType} = 'student'; - $args{userID} = $firstUserID; + $route = 'instructor_user_progress'; + $args{userID} = $firstUserID; } else { push @error, E_ONE_USER; } - } elsif (defined $r->param('set_progress')) { + } elsif (defined $c->param('set_progress')) { if ($nsets == 1) { - $module = "${ipfx}::StudentProgress"; + $route = 'instructor_set_progress'; $args{statType} = 'set'; $args{setID} = $firstSetID; } else { push @error, E_ONE_SET; } - } elsif (defined $r->param('user_options')) { + } elsif (defined $c->param('user_options')) { if ($nusers == 1) { - $module = "${pfx}::Options"; + $route = 'options'; $params{effectiveUser} = $firstUserID; } else { push @error, E_ONE_USER; } - } elsif (defined $r->param('act_as_user')) { - if ($nusers == 1 and $nsets <= 1) { + } elsif (defined $c->param('act_as_user')) { + if ($nusers == 1 && $nsets <= 1) { if ($nsets) { - # Unfortunately, we need to know what type of set it is to figure out the correct module. - my $set = $db->getGlobalSet($firstSetID); - if (defined($set) && $set->assignment_type =~ /gateway/) { - $module = "${pfx}::GatewayQuiz"; - } else { - $module = "${pfx}::ProblemSet"; - } + $route = 'problem_list'; $args{setID} = $firstSetID; } else { - $module = "${pfx}::ProblemSets"; + $route = 'set_list'; } $params{effectiveUser} = $firstUserID; } else { push @error, E_ONE_USER unless $nusers == 1; push @error, E_MAX_ONE_SET unless $nsets <= 1; } - } elsif (defined $r->param('edit_set_for_users')) { + } elsif (defined $c->param('edit_set_for_users')) { if ($nusers >= 1 and $nsets == 1) { - $module = "${ipfx}::ProblemSetDetail"; + $route = 'instructor_set_detail'; $args{setID} = $firstSetID; $params{editForUser} = \@selectedUserIDs; } else { @@ -178,11 +158,11 @@ async sub pre_header_initialize { push @error, E_ONE_SET unless $nsets == 1; } - } elsif (defined $r->param('create_set')) { - my $setname = format_set_name_internal($r->param("new_set_name") // ''); + } elsif (defined $c->param('create_set')) { + my $setname = format_set_name_internal($c->param('new_set_name') // ''); if ($setname) { if ($setname =~ /^[\w.-]*$/) { - $module = "${ipfx}::SetMaker"; + $route = 'instructor_set_maker'; $params{new_local_set} = 'Create a New Set in this Course'; $params{new_set_name} = $setname; $params{selfassign} = 1; @@ -192,40 +172,38 @@ async sub pre_header_initialize { } else { push @error, E_SET_NAME; } - } elsif (defined $r->param('add_users')) { - $module = "${ipfx}::AddUsers"; - } elsif (defined $r->param('email_users')) { - $module = "${ipfx}::SendMail"; - } elsif (defined $r->param('transfer_files')) { - $module = "${ipfx}::FileManager"; + } elsif (defined $c->param('add_users')) { + $route = 'instructor_add_users'; + } elsif (defined $c->param('email_users')) { + $route = 'instructor_mail_merge'; + } elsif (defined $c->param('transfer_files')) { + $route = 'instructor_file_manager'; } push @error, x('You are not allowed to act as a student.') - if (defined $r->param('act_as_user') && !$authz->hasPermissions($userID, 'become_student')); + if (defined $c->param('act_as_user') && !$authz->hasPermissions($userID, 'become_student')); push @error, x('You are not allowed to modify homework sets.') - if ((defined $r->param('edit_sets') || defined $r->param('edit_set_for_users')) + if ((defined $c->param('edit_sets') || defined $c->param('edit_set_for_users')) && !$authz->hasPermissions($userID, 'modify_problem_sets')); push @error, x('You are not allowed to assign homework sets.') - if ((defined $r->param('sets_assigned_to_user') || defined $r->param('users_assigned_to_set')) + if ((defined $c->param('sets_assigned_to_user') || defined $c->param('users_assigned_to_set')) && !$authz->hasPermissions($userID, 'assign_problem_sets')); push @error, x('You are not allowed to modify student data.') - if ((defined $r->param('user_options') || defined $r->param('user_options')) + if ((defined $c->param('user_options') || defined $c->param('user_options')) && !$authz->hasPermissions($userID, 'modify_student_data')); if (@error) { # Handle errors - $self->addbadmessage($r->c(map { $r->maketext($_) } @error)->join($r->tag('br'))); - } elsif ($module) { + $c->addbadmessage($c->c(map { $c->maketext($_) } @error)->join($c->tag('br'))); + } elsif ($route) { # Redirect to target page - my $page = $urlpath->newFromModule($module, $r, %args); - my $url = $self->systemLink($page, params => \%params); - $self->reply_with_redirect($url); + $c->reply_with_redirect($c->systemLink($c->url_for($route, %args), params => \%params)); return; } # Get all users except the set level proctors, and restrict to the sections or recitations that are allowed for the # user if such restrictions are defined. This list is sorted by last_name, then first_name, then user_id. - $r->stash->{users} = [ + $c->stash->{users} = [ $db->getUsersWhere( { user_id => { not_like => 'set_id:%' }, @@ -244,7 +222,7 @@ async sub pre_header_initialize { ) ]; - $r->stash->{globalSets} = [ $db->getGlobalSetsWhere ]; + $c->stash->{globalSets} = [ $db->getGlobalSetsWhere ]; return; } diff --git a/lib/WeBWorK/ContentGenerator/Instructor/LTIUpdate.pm b/lib/WeBWorK/ContentGenerator/Instructor/LTIUpdate.pm index 32fce52dfc..3716cdf86e 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/LTIUpdate.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/LTIUpdate.pm @@ -16,90 +16,82 @@ # This page is for triggering LTI grade updates package WeBWorK::ContentGenerator::Instructor::LTIUpdate; -use parent qw(WeBWorK::ContentGenerator); - -use strict; -use warnings; +use Mojo::Base 'WeBWorK::ContentGenerator', -signatures; use WeBWorK::Utils(qw(format_set_name_display getAssetURL)); -sub initialize { - my $self = shift; - my $r = $self->r; - my $db = $r->db; - my $ce = $r->ce; +sub initialize ($c) { + my $db = $c->db; + my $ce = $c->ce; # Make sure these are defined for the template. - $r->stash->{sets} = []; - $r->stash->{users} = []; - $r->stash->{lastUpdate} = 0; + $c->stash->{sets} = []; + $c->stash->{users} = []; + $c->stash->{lastUpdate} = 0; - return unless ($r->authz->hasPermissions($r->param('user'), 'score_sets') && $ce->{LTIGradeMode}); + return unless ($c->authz->hasPermissions($c->param('user'), 'score_sets') && $ce->{LTIGradeMode}); - $r->stash->{sets} = [ sort $db->listGlobalSets ] if $ce->{LTIGradeMode} eq 'homework'; - $r->stash->{users} = [ sort $db->listUsers ]; - $r->stash->{lastUpdate} = $db->getSettingValue('LTILastUpdate') || 0; + $c->stash->{sets} = [ sort $db->listGlobalSets ] if $ce->{LTIGradeMode} eq 'homework'; + $c->stash->{users} = [ sort $db->listUsers ]; + $c->stash->{lastUpdate} = $db->getSettingValue('LTILastUpdate') || 0; - return unless ($r->param('updateLTI')); + return unless ($c->param('updateLTI')); - my $setID = $r->param('updateSetID') || 'All Sets'; - my $userID = $r->param('updateUserID') || 'All Users'; + my $setID = $c->param('updateSetID') || 'All Sets'; + my $userID = $c->param('updateUserID') || 'All Users'; my $prettySetID = format_set_name_display($setID); # Test if setID and userID are valid. unless ($userID eq 'All Users' || $db->getUser($userID)) { - $self->addbadmessage($r->maketext('Update aborted. Invalid user [_1].', $userID)); + $c->addbadmessage($c->maketext('Update aborted. Invalid user [_1].', $userID)); return; } unless ($ce->{LTIGradeMode} eq 'course' || $setID eq 'All Sets' || $db->getGlobalSet($setID)) { - $self->addbadmessage($r->maketext('Update aborted. Invalid set [_1].', $prettySetID)); + $c->addbadmessage($c->maketext('Update aborted. Invalid set [_1].', $prettySetID)); return; } my @updateParms; if ($setID eq 'All Sets' && $userID eq 'All Users') { @updateParms = ('all'); - $self->addgoodmessage($ce->{LTIGradeMode} eq 'homework' - ? $r->maketext('LTI update of all users and sets started.') - : $r->maketext('LTI update of all users started.')); + $c->addgoodmessage($ce->{LTIGradeMode} eq 'homework' + ? $c->maketext('LTI update of all users and sets started.') + : $c->maketext('LTI update of all users started.')); } elsif ($setID eq 'All Sets') { @updateParms = ('user', $userID); - $self->addgoodmessage($r->maketext('LTI update of user [_1] started.', $userID)); + $c->addgoodmessage($c->maketext('LTI update of user [_1] started.', $userID)); } elsif ($userID eq 'All Users') { @updateParms = ('set', $setID); - $self->addgoodmessage($r->maketext('LTI update of set [_1] started.', $prettySetID)); + $c->addgoodmessage($c->maketext('LTI update of set [_1] started.', $prettySetID)); } elsif ($ce->{LTIGradeMode} eq 'homework') { @updateParms = ('user_set', $userID, $setID); - $self->addgoodmessage($r->maketext('LTI update of user [_1] and set [_2] started.', $userID, $prettySetID)); + $c->addgoodmessage($c->maketext('LTI update of user [_1] and set [_2] started.', $userID, $prettySetID)); } else { # Abort update. A post with a valid setID was sent in course LTIGradeMode, # but the page shouldn't allow this. Don't set an updateMessage for this case. return; } - my $grader = WeBWorK::Authen::LTIAdvanced::SubmitGrade->new($r); + my $grader = WeBWorK::Authen::LTIAdvanced::SubmitGrade->new($c); $grader->mass_update(@updateParms); } -sub format_interval { - my $self = shift; - my $r = $self->r; - my $seconds = shift; +sub format_interval ($c, $seconds) { my $minutes = int($seconds / 60); my $hours = int($minutes / 60); my $days = int($hours / 24); my $out = ''; - return $r->maketext('0 seconds') unless $seconds > 0; + return $c->maketext('0 seconds') unless $seconds > 0; $seconds = $seconds - 60 * $minutes; $minutes = $minutes - 60 * $hours; $hours = $hours - 24 * $days; - $out .= $r->maketext('[quant,_1,day]', $days) . ' ' if $days; - $out .= $r->maketext('[quant,_1,hour]', $hours) . ' ' if $hours; - $out .= $r->maketext('[quant,_1,minute]', $minutes) . ' ' if $minutes; - $out .= $r->maketext('[quant,_1,second]', $seconds) . ' ' if $seconds; + $out .= $c->maketext('[quant,_1,day]', $days) . ' ' if $days; + $out .= $c->maketext('[quant,_1,hour]', $hours) . ' ' if $hours; + $out .= $c->maketext('[quant,_1,minute]', $minutes) . ' ' if $minutes; + $out .= $c->maketext('[quant,_1,second]', $seconds) . ' ' if $seconds; chop($out); return $out; diff --git a/lib/WeBWorK/ContentGenerator/Instructor/PGProblemEditor.pm b/lib/WeBWorK/ContentGenerator/Instructor/PGProblemEditor.pm index 736ee682ef..1334a98a53 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/PGProblemEditor.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/PGProblemEditor.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::Instructor::PGProblemEditor; -use parent qw(WeBWorK::ContentGenerator); +use Mojo::Base 'WeBWorK::ContentGenerator', -signatures; =head1 NAME @@ -106,11 +106,6 @@ not exist. The path to the actual file being edited is stored in inputFilePath. =cut -use strict; -use warnings; - -use HTML::Entities; -use URI::Escape; use File::Copy; use WeBWorK::Utils qw(jitar_id_to_seq not_blank path_is_subdir seq_to_jitar_id x @@ -132,35 +127,32 @@ use constant ACTION_FORM_TITLES => { my $BLANKPROBLEM = 'blankProblem.pg'; -async sub pre_header_initialize { - my $self = shift; - my $r = $self->r; - my $ce = $r->ce; - my $urlpath = $r->urlpath; - my $authz = $r->authz; - my $user = $r->param('user'); +sub pre_header_initialize ($c) { + my $ce = $c->ce; + my $authz = $c->authz; + my $user = $c->param('user'); # Check permissions return unless $authz->hasPermissions($user, 'access_instructor_tools') && $authz->hasPermissions($user, 'modify_problem_sets'); - $self->{courseID} = $urlpath->arg('courseID'); - $self->{setID} = $urlpath->arg('setID'); - $self->{problemID} = $urlpath->arg('problemID'); + $c->{courseID} = $c->stash('courseID'); + $c->{setID} = $c->stash('setID'); + $c->{problemID} = $c->stash('problemID'); # Parse setID which may come in with version data - $self->{fullSetID} = $self->{setID}; - if (defined $self->{fullSetID} && $self->{fullSetID} =~ /^([^,]*),v(\d+)$/) { - $self->{setID} = $1; - $self->{versionID} = $2; + $c->{fullSetID} = $c->{setID}; + if (defined $c->{fullSetID} && $c->{fullSetID} =~ /^([^,]*),v(\d+)$/) { + $c->{setID} = $1; + $c->{versionID} = $2; } # Determine displayMode and problemSeed that are needed for viewing the problem. # They are also two of the parameters which can be set by the editor. # Note that the problem seed may be overridden by the value obtained from the problem record later. - $self->{displayMode} = $r->param('displayMode') // $ce->{pg}{options}{displayMode}; - $self->{problemSeed} = (($r->param('problemSeed') // '') =~ s/^\s*|\s*$//gr) || DEFAULT_SEED(); + $c->{displayMode} = $c->param('displayMode') // $ce->{pg}{options}{displayMode}; + $c->{problemSeed} = (($c->param('problemSeed') // '') =~ s/^\s*|\s*$//gr) || DEFAULT_SEED(); # Save file to permanent or temporary file, then redirect for viewing if it was requested to view in a new window. # Any file "saved as" should be assigned to "Undefined_Set" and redirected to be viewed again in the editor. @@ -170,133 +162,130 @@ async sub pre_header_initialize { # Course info files are redirected to the ProblemSets.pm page # Insure that file_type is defined - $self->{file_type} = ($r->param('file_type') // '') =~ s/^\s*|\s*$//gr; + $c->{file_type} = ($c->param('file_type') // '') =~ s/^\s*|\s*$//gr; # If file_type has not been defined we are dealing with a set header or regular problem. - if (!$self->{file_type}) { + if (!$c->{file_type}) { # If sourceFilePath is defined in the form, then the path will be obtained from that. # If the problem number is defined and is 0 then a header file is being edited. # If the problem number is not zero, a problem is being edited. - if (not_blank($r->param('sourceFilePath'))) { - $self->{file_type} = - $r->param('sourceFilePath') =~ m!/headers/|Header\.pg$! ? 'set_header' : 'source_path_for_problem_file'; - } elsif (defined $self->{problemID}) { - if ($self->{problemID} =~ /^\d+$/ && $self->{problemID} == 0) { - $self->{file_type} = 'set_header' unless $self->{file_type} eq 'hardcopy_header'; + if (not_blank($c->param('sourceFilePath'))) { + $c->{file_type} = + $c->param('sourceFilePath') =~ m!/headers/|Header\.pg$! ? 'set_header' : 'source_path_for_problem_file'; + } elsif (defined $c->{problemID}) { + if ($c->{problemID} =~ /^\d+$/ && $c->{problemID} == 0) { + $c->{file_type} = 'set_header' unless $c->{file_type} eq 'hardcopy_header'; } else { - $self->{file_type} = 'problem'; + $c->{file_type} = 'problem'; } } else { - $self->{file_type} = 'blank_problem'; + $c->{file_type} = 'blank_problem'; } } # Clean up sourceFilePath and check that sourceFilePath is relative to the templates file - if ($self->{file_type} eq 'source_path_for_problem_file') { - my $sourceFilePath = $r->param('sourceFilePath'); + if ($c->{file_type} eq 'source_path_for_problem_file') { + my $sourceFilePath = $c->param('sourceFilePath'); $sourceFilePath =~ s/$ce->{courseDirs}{templates}//; $sourceFilePath =~ s|^/||; - $self->{sourceFilePath} = $sourceFilePath; + $c->{sourceFilePath} = $sourceFilePath; } # Initialize these values in case of failure in the getFilePaths method. - $self->{editFilePath} = ''; - $self->{tempFilePath} = ''; - $self->{inputFilePath} = ''; + $c->{editFilePath} = ''; + $c->{tempFilePath} = ''; + $c->{inputFilePath} = ''; # Determine the paths for the file. # getFilePath defines: - # $self->{editFilePath}: path to the permanent file to be edited - # $self->{tempFilePath}: path to the temporary file to be edited with .tmp suffix - # $self->{inputFilePath}: path to the file for input, (this is either the editFilePath or the tempFilePath) - $self->getFilePaths; + # $c->{editFilePath}: path to the permanent file to be edited + # $c->{tempFilePath}: path to the temporary file to be edited with .tmp suffix + # $c->{inputFilePath}: path to the file for input, (this is either the editFilePath or the tempFilePath) + $c->getFilePaths; # Default problem contents - $self->{r_problemContents} = \''; + $c->{r_problemContents} = \''; - $self->{status_message} //= $r->c; + $c->{status_message} //= $c->c; # Determine action. If an invalid action is sent in, assume this is an initial edit. - $self->{action} = $r->param('action') // ''; - if ($self->{action} && grep { $_ eq $self->{action} } @{ ACTION_FORMS() }) { - my $actionHandler = "$self->{action}_handler"; - $self->$actionHandler; + $c->{action} = $c->param('action') // ''; + if ($c->{action} && grep { $_ eq $c->{action} } @{ ACTION_FORMS() }) { + my $actionHandler = "$c->{action}_handler"; + $c->$actionHandler; } return; } -sub initialize { - my $self = shift; - my $r = $self->r; - my $ce = $r->ce; - my $db = $r->db; - my $authz = $r->authz; - my $user = $r->param('user'); +sub initialize ($c) { + my $ce = $c->ce; + my $db = $c->db; + my $authz = $c->authz; + my $user = $c->param('user'); # Make sure these are defined for the templates. - $r->stash->{problemContents} = ''; - $r->stash->{formsToShow} = ACTION_FORMS(); - $r->stash->{actionFormTitles} = ACTION_FORM_TITLES(); + $c->stash->{problemContents} = ''; + $c->stash->{formsToShow} = ACTION_FORMS(); + $c->stash->{actionFormTitles} = ACTION_FORM_TITLES(); # Check permissions return unless $authz->hasPermissions($user, 'access_instructor_tools') && $authz->hasPermissions($user, 'modify_problem_sets'); - my $file_type = $r->param('file_type') || ''; + my $file_type = $c->param('file_type') || ''; # Record status messages carried over if this is a redirect - $self->addmessage($r->param('status_message') || ''); + $c->addmessage($c->param('status_message') || ''); - $self->addbadmessage($r->maketext('Changes in this file have not yet been permanently saved.')) - if $self->{inputFilePath} eq $self->{tempFilePath} && -r $self->{tempFilePath}; + $c->addbadmessage($c->maketext('Changes in this file have not yet been permanently saved.')) + if $c->{inputFilePath} eq $c->{tempFilePath} && -r $c->{tempFilePath}; - if (!-e $self->{inputFilePath}) { - $self->addbadmessage( - $r->maketext('The file "[_1]" cannot be found.', $self->shortPath($self->{inputFilePath}))); - } elsif (!-w $self->{inputFilePath} && $file_type ne 'blank_problem') { - $self->addbadmessage($r->maketext( + if (!-e $c->{inputFilePath}) { + $c->addbadmessage($c->maketext('The file "[_1]" cannot be found.', $c->shortPath($c->{inputFilePath}))); + } elsif (!-w $c->{inputFilePath} && $file_type ne 'blank_problem') { + $c->addbadmessage($c->maketext( 'The file "[_1]" is protected! ' . 'To edit this text you must first make a copy of this file using the "New Version" action below.', - $self->shortPath($self->{inputFilePath}) + $c->shortPath($c->{inputFilePath}) )); } - if ($self->{inputFilePath} =~ /$BLANKPROBLEM$/ && $file_type ne 'blank_problem') { - $self->addbadmessage($r->maketext( + if ($c->{inputFilePath} =~ /$BLANKPROBLEM$/ && $file_type ne 'blank_problem') { + $c->addbadmessage($c->maketext( 'The file "[_1]" is a blank problem!' . 'To edit this text you must use the "New Version" action below to save it to another file.', - $self->shortPath($self->{inputFilePath}) + $c->shortPath($c->{inputFilePath}) )); } # Find the text for the problem, either in the temporary file if it exists, in the original file in the template # directory, or in the problem contents gathered in the initialization phase. - my $problemContents = ${ $self->{r_problemContents} }; + my $problemContents = ${ $c->{r_problemContents} }; unless ($problemContents =~ /\S/) { # non-empty contents - if (-r $self->{tempFilePath} && !-d $self->{tempFilePath}) { - if (path_is_subdir($self->{tempFilePath}, $ce->{courseDirs}{templates}, 1)) { - eval { $problemContents = readFile($self->{tempFilePath}) }; + if (-r $c->{tempFilePath} && !-d $c->{tempFilePath}) { + if (path_is_subdir($c->{tempFilePath}, $ce->{courseDirs}{templates}, 1)) { + eval { $problemContents = readFile($c->{tempFilePath}) }; $problemContents = $@ if $@; - $self->{inputFilePath} = $self->{tempFilePath}; + $c->{inputFilePath} = $c->{tempFilePath}; } else { - $r->stash->{file_error} = $r->maketext('Unable to open a temporary file at the given location.'); + $c->stash->{file_error} = $c->maketext('Unable to open a temporary file at the given location.'); } - } elsif (-r $self->{editFilePath} && !-d $self->{editFilePath}) { - if (path_is_subdir($self->{editFilePath}, $ce->{courseDirs}{templates}, 1) - || $self->{editFilePath} eq $ce->{webworkFiles}{screenSnippets}{setHeader} - || $self->{editFilePath} eq $ce->{webworkFiles}{hardcopySnippets}{setHeader} - || $self->{editFilePath} eq $ce->{webworkFiles}{screenSnippets}{blankProblem}) + } elsif (-r $c->{editFilePath} && !-d $c->{editFilePath}) { + if (path_is_subdir($c->{editFilePath}, $ce->{courseDirs}{templates}, 1) + || $c->{editFilePath} eq $ce->{webworkFiles}{screenSnippets}{setHeader} + || $c->{editFilePath} eq $ce->{webworkFiles}{hardcopySnippets}{setHeader} + || $c->{editFilePath} eq $ce->{webworkFiles}{screenSnippets}{blankProblem}) { - eval { $problemContents = readFile($self->{editFilePath}) }; + eval { $problemContents = readFile($c->{editFilePath}) }; $problemContents = $@ if $@; - $self->{inputFilePath} = $self->{editFilePath}; + $c->{inputFilePath} = $c->{editFilePath}; } else { - $r->stash->{file_error} = $r->maketext('The given file path is not a valid location.'); + $c->stash->{file_error} = $c->maketext('The given file path is not a valid location.'); } } else { # File not existing is not an error @@ -304,64 +293,53 @@ sub initialize { } } - $r->stash->{problemContents} = $problemContents; + $c->stash->{problemContents} = $problemContents; - $self->{prettyProblemNumber} = $self->{problemID} // ''; - $self->{set} = $self->r->db->getGlobalSet($self->{setID}) if $self->{setID}; - $self->{prettyProblemNumber} = join('.', jitar_id_to_seq($self->{prettyProblemNumber})) - if $self->{set} && $self->{set}->assignment_type eq 'jitar'; + $c->{prettyProblemNumber} = $c->{problemID} // ''; + $c->{set} = $c->db->getGlobalSet($c->{setID}) if $c->{setID}; + $c->{prettyProblemNumber} = join('.', jitar_id_to_seq($c->{prettyProblemNumber})) + if $c->{set} && $c->{set}->assignment_type eq 'jitar'; return; } -sub path { - my ($self, $args) = @_; - my $r = $self->r; - my $urlpath = $r->urlpath; - my $courseName = $urlpath->arg('courseID'); - my $setName = $urlpath->arg('setID') // ''; - my $problemNumber = $urlpath->arg('problemID') || ''; - - # We need to build a path to the problem being edited by hand, since it is not the same as the urlpath for this +sub path ($c, $args) { + # We need to build a path to the problem being edited by hand, since it is not the same as the url path for this # page. The bread crumb path leads back to the problem being edited, not to the Instructor tool. - return $self->pathMacro( + return $c->pathMacro( $args, - 'WeBWorK' => $r->location, - $courseName => $r->location . "/$courseName", - $setName => $r->location . "/$courseName/$setName", - $self->{prettyProblemNumber} => $r->location . "/$courseName/$setName/$problemNumber", - $r->maketext('Editor') => '' + 'WeBWorK' => $c->url_for('root'), + $c->stash('courseID') => $c->url_for('set_list'), + ($c->stash('setID') // '') => $c->url_for('problem_list'), + $c->{prettyProblemNumber} => $c->url_for('problem_detail', problemID => $c->stash('problemID') || ''), + $c->maketext('Editor') => '' ); } -sub title { - my $self = shift; - my $r = $self->r; - my $courseName = $r->urlpath->arg('courseID'); - my $setID = $r->urlpath->arg('setID'); - my $problemNumber = $r->urlpath->arg('problemID'); +sub page_title ($c) { + my $setID = $c->stash('setID'); + my $problemID = $c->stash('problemID'); - return $r->maketext('Set Header for set [_1]', $setID) if $self->{file_type} eq 'set_header'; - return $r->maketext('Hardcopy Header for set [_1]', $setID) if $self->{file_type} eq 'hardcopy_header'; - return $r->maketext('Course Information for course [_1]', $courseName) if $self->{file_type} eq 'course_info'; + return $c->maketext('Set Header for set [_1]', $setID) if $c->{file_type} eq 'set_header'; + return $c->maketext('Hardcopy Header for set [_1]', $setID) if $c->{file_type} eq 'hardcopy_header'; + return $c->maketext('Course Information for course [_1]', $c->stash('courseID')) + if $c->{file_type} eq 'course_info'; if ($setID) { - my $set = $r->db->getGlobalSet($setID); + my $set = $c->db->getGlobalSet($setID); if ($set && $set->assignment_type eq 'jitar') { - $problemNumber = join('.', jitar_id_to_seq($problemNumber)); + $problemID = join('.', jitar_id_to_seq($problemID)); } } - return $r->maketext('Problem [_1]', $problemNumber); + return $c->maketext('Problem [_1]', $problemID); } # Convert initial path component to [TMPL], [COURSE], or [WW]. -sub shortPath { - my ($self, $file) = @_; - - my $tmpl = $self->r->ce->{courseDirs}{templates}; - my $root = $self->r->ce->{courseDirs}{root}; - my $ww = $self->r->ce->{webworkDirs}{root}; +sub shortPath ($c, $file) { + my $tmpl = $c->ce->{courseDirs}{templates}; + my $root = $c->ce->{courseDirs}{root}; + my $ww = $c->ce->{webworkDirs}{root}; $file =~ s|^$tmpl|[TMPL]|; $file =~ s|^$root|[COURSE]|; $file =~ s|^$ww|[WW]|; @@ -371,22 +349,17 @@ sub shortPath { # Utilities -sub getRelativeSourceFilePath { - my ($self, $sourceFilePath) = @_; - - my $templatesDir = $self->r->ce->{courseDirs}{templates}; +sub getRelativeSourceFilePath ($c, $sourceFilePath) { + my $templatesDir = $c->ce->{courseDirs}{templates}; $sourceFilePath =~ s|^$templatesDir/*||; # remove templates path and any slashes that follow - return $sourceFilePath; } # determineLocalFilePath constructs a local file path parallel to a library file path -sub determineLocalFilePath { - my ($self, $path) = @_; - - my $default_screen_header_path = $self->r->ce->{webworkFiles}{hardcopySnippets}{setHeader}; - my $default_hardcopy_header_path = $self->r->ce->{webworkFiles}{screenSnippets}{setHeader}; - my $setID = $self->{setID} // int(rand(1000)); +sub determineLocalFilePath ($c, $path) { + my $default_screen_header_path = $c->ce->{webworkFiles}{hardcopySnippets}{setHeader}; + my $default_hardcopy_header_path = $c->ce->{webworkFiles}{screenSnippets}{setHeader}; + my $setID = $c->{setID} // int(rand(1000)); if ($path =~ /Library/) { # Truncate the url up to a segment such as ...rochesterLibrary/ and prepend local. @@ -407,40 +380,37 @@ sub determineLocalFilePath { # This does not create the directories in the path to the file. # It returns an absolute path to the file. # $path should be an absolute path to the original file. -sub determineTempEditFilePath { - my ($self, $path) = @_; - my $r = $self->r; - my $user = $r->param('user'); - my $setID = $self->{setID}; +sub determineTempEditFilePath ($c, $path) { + my $user = $c->param('user'); + my $setID = $c->{setID}; - my $templatesDirectory = $r->ce->{courseDirs}{templates}; - my $tmpEditFileDirectory = $self->getTempEditFileDirectory(); + my $templatesDirectory = $c->ce->{courseDirs}{templates}; + my $tmpEditFileDirectory = $c->getTempEditFileDirectory(); - $self->addbadmessage($r->maketext('The path to the original file should be absolute.')) + $c->addbadmessage($c->maketext('The path to the original file should be absolute.')) unless $path =~ m|^/|; if ($path =~ /^$tmpEditFileDirectory/) { - $self->addbadmessage($r->maketext('The path can not be the temporary edit directory.')); + $c->addbadmessage($c->maketext('The path can not be the temporary edit directory.')); } else { if ($path =~ /^$templatesDirectory/) { $path =~ s|^$templatesDirectory||; $path =~ s|^/||; # remove the initial slash if any $path = "$tmpEditFileDirectory/$path.$user.tmp"; - } elsif ($path eq $self->r->ce->{webworkFiles}{screenSnippets}{blankProblem}) { + } elsif ($path eq $c->ce->{webworkFiles}{screenSnippets}{blankProblem}) { # Handle the case of the blank problem in snippets. $path = "$tmpEditFileDirectory/blank.$setID.$user.tmp"; - } elsif ($path eq $self->r->ce->{webworkFiles}{hardcopySnippets}{setHeader}) { + } elsif ($path eq $c->ce->{webworkFiles}{hardcopySnippets}{setHeader}) { # Handle the case of the screen header in snippets. $path = "$tmpEditFileDirectory/screenHeader.$setID.$user.tmp"; - } elsif ($path eq $self->r->ce->{webworkFiles}{screenSnippets}{setHeader}) { + } elsif ($path eq $c->ce->{webworkFiles}{screenSnippets}{setHeader}) { # Handle the case of the hardcopy header in snippets. $path = "$tmpEditFileDirectory/hardcopyHeader.$setID.$user.tmp"; } else { # If all else fails, just use a failsafe filename. This is reused in all of these cases. # This shouldn't be possible in any case. $path = "$tmpEditFileDirectory/failsafe.$setID.$user.tmp"; - $self->addbadmessage( - $r->maketext('The original path is not in a valid location. Using failsafe [_1]', $path)); + $c->addbadmessage($c->maketext('The original path is not in a valid location. Using failsafe [_1]', $path)); } } @@ -449,16 +419,14 @@ sub determineTempEditFilePath { # Determine the original path to a file corresponding to a temporary edit file. # Returns a path that is relative to the template directory. -sub determineOriginalEditFilePath { - my ($self, $path) = @_; - my $r = $self->r; - my $ce = $r->ce; +sub determineOriginalEditFilePath ($c, $path) { + my $ce = $c->ce; # Unless path is absolute, assume that it is relative to the template directory. my $newpath = $path =~ m|^/| ? $path : "$ce->{courseDirs}{templates}/$path"; - if ($self->isTempEditFilePath($newpath)) { - my $tmpEditFileDirectory = $self->getTempEditFileDirectory(); + if ($c->isTempEditFilePath($newpath)) { + my $tmpEditFileDirectory = $c->getTempEditFileDirectory(); $newpath =~ s|^$tmpEditFileDirectory/||; if ($newpath =~ m|blank\.[^/]*$|) { @@ -468,59 +436,54 @@ sub determineOriginalEditFilePath { } elsif (($newpath =~ m|screenHeader\.[^/]*$|)) { $newpath = $ce->{webworkFiles}{screenSnippets}{setHeader}; } else { - my $user = $r->param('user'); + my $user = $c->param('user'); $newpath =~ s|\.$user\.tmp$||; } } else { - $self->addbadmessage("This path |$newpath| is not the path to a temporary edit file."); + $c->addbadmessage("This path |$newpath| is not the path to a temporary edit file."); # Returns the original path. } return $newpath; } -sub getTempEditFileDirectory { - my $self = shift; - my $courseDirectories = $self->r->ce->{courseDirs}; +sub getTempEditFileDirectory ($c) { + my $courseDirectories = $c->ce->{courseDirs}; return $courseDirectories->{tmpEditFileDir} // "$courseDirectories->{templates}/tmpEdit"; } -sub isTempEditFilePath { - my ($self, $path) = @_; - +sub isTempEditFilePath ($c, $path) { # Unless path is absolute, assume that it is relative to the template directory. - $path = $self->r->ce->{courseDirs}{templates} . "/$path" unless $path =~ m|^/|; + $path = $c->ce->{courseDirs}{templates} . "/$path" unless $path =~ m|^/|; - my $tmpEditFileDirectory = $self->getTempEditFileDirectory(); + my $tmpEditFileDirectory = $c->getTempEditFileDirectory(); return $path =~ /^$tmpEditFileDirectory/ ? 1 : 0; } # Determine file paths. This defines the following variables: -# $self->{editFilePath} -- path to permanent file -# $self->{tempFilePath} -- temporary file name to use (may not exist) -# $self->{inputFilePath} -- actual file to read and edit (will be one of the above) -sub getFilePaths { - my $self = shift; - my $r = $self->r; - my $ce = $r->ce; - my $db = $r->db; +# $c->{editFilePath} -- path to permanent file +# $c->{tempFilePath} -- temporary file name to use (may not exist) +# $c->{inputFilePath} -- actual file to read and edit (will be one of the above) +sub getFilePaths ($c) { + my $ce = $c->ce; + my $db = $c->db; my $editFilePath; - if ($self->{file_type} eq 'course_info') { + if ($c->{file_type} eq 'course_info') { $editFilePath = "$ce->{courseDirs}{templates}/$ce->{courseFiles}{course_info}"; - } elsif ($self->{file_type} eq 'blank_problem') { + } elsif ($c->{file_type} eq 'blank_problem') { $editFilePath = $ce->{webworkFiles}{screenSnippets}{blankProblem}; - $self->addbadmessage($r->maketext( + $c->addbadmessage($c->maketext( 'This is a blank problem template file and can not be edited directly. Use the "New Version" ' . 'action below to create a local copy of the file and add it to the current problem set.' )); - } elsif ($self->{file_type} eq 'set_header' || $self->{file_type} eq 'hardcopy_header') { - my $set_record = $db->getGlobalSet($self->{setID}); + } elsif ($c->{file_type} eq 'set_header' || $c->{file_type} eq 'hardcopy_header') { + my $set_record = $db->getGlobalSet($c->{setID}); if (defined $set_record) { - my $header_file = $set_record->{ $self->{file_type} }; + my $header_file = $set_record->{ $c->{file_type} }; if ($header_file && $header_file ne 'defaultHeader') { if ($header_file =~ m|^/|) { # Absolute address @@ -532,89 +495,87 @@ sub getFilePaths { # If the set record doesn't specify the filename for a header or it specifies the defaultHeader, # then the set uses the default from snippets. $editFilePath = $ce->{webworkFiles}{screenSnippets}{setHeader} - if $self->{file_type} eq 'set_header'; + if $c->{file_type} eq 'set_header'; $editFilePath = $ce->{webworkFiles}{hardcopySnippets}{setHeader} - if $self->{file_type} eq 'hardcopy_header'; + if $c->{file_type} eq 'hardcopy_header'; } } else { - $self->addbadmessage("Cannot find a set record for set $self->{setID}"); + $c->addbadmessage("Cannot find a set record for set $c->{setID}"); return; } - } elsif ($self->{file_type} eq 'problem') { + } elsif ($c->{file_type} eq 'problem') { # First try getting the merged problem for the effective user. - my $effectiveUserName = $r->param('effectiveUser'); + my $effectiveUserName = $c->param('effectiveUser'); my $problem_record = - $self->{versionID} - ? $db->getMergedProblemVersion($effectiveUserName, $self->{setID}, $self->{versionID}, $self->{problemID}) - : $db->getMergedProblem($effectiveUserName, $self->{setID}, $self->{problemID}); + $c->{versionID} + ? $db->getMergedProblemVersion($effectiveUserName, $c->{setID}, $c->{versionID}, $c->{problemID}) + : $db->getMergedProblem($effectiveUserName, $c->{setID}, $c->{problemID}); # If that doesn't work, then the problem is not yet assigned. So get the global record. - $problem_record = $db->getGlobalProblem($self->{setID}, $self->{problemID}) unless defined $problem_record; + $problem_record = $db->getGlobalProblem($c->{setID}, $c->{problemID}) unless defined $problem_record; if (defined $problem_record) { $editFilePath = "$ce->{courseDirs}{templates}/" . $problem_record->source_file; # Define the problem seed for later use. - $self->{problemSeed} = $problem_record->problem_seed if $problem_record->can('problem_seed'); + $c->{problemSeed} = $problem_record->problem_seed if $problem_record->can('problem_seed'); } else { - $self->addbadmessage( - $r->maketext("Cannot find a problem record for set $self->{setID} / problem $self->{problemID}")); + $c->addbadmessage( + $c->maketext("Cannot find a problem record for set $c->{setID} / problem $c->{problemID}")); return; } - } elsif ($self->{file_type} eq 'source_path_for_problem_file') { - my $forcedSourceFile = $self->{sourceFilePath}; + } elsif ($c->{file_type} eq 'source_path_for_problem_file') { + my $forcedSourceFile = $c->{sourceFilePath}; # If the source file is in the temporary edit directory find the original source file. # The source file is relative to the templates directory. - if ($self->isTempEditFilePath($forcedSourceFile)) { - $forcedSourceFile = $self->determineOriginalEditFilePath($forcedSourceFile); # Original file path - $self->addgoodmessage($r->maketext('The original path to the file is [_1].', $forcedSourceFile)); + if ($c->isTempEditFilePath($forcedSourceFile)) { + $forcedSourceFile = $c->determineOriginalEditFilePath($forcedSourceFile); # Original file path + $c->addgoodmessage($c->maketext('The original path to the file is [_1].', $forcedSourceFile)); } if (not_blank($forcedSourceFile)) { - $self->{problemSeed} = DEFAULT_SEED(); + $c->{problemSeed} = DEFAULT_SEED(); $editFilePath = "$ce->{courseDirs}{templates}/$forcedSourceFile"; } else { - $self->addbadmessage($r->maketext('Cannot find a file path to save to.')); + $c->addbadmessage($c->maketext('Cannot find a file path to save to.')); return; } } if (-d $editFilePath) { - $self->addbadmessage($r->maketext('The file "[_1]" is a directory!', $self->shortPath($editFilePath))); + $c->addbadmessage($c->maketext('The file "[_1]" is a directory!', $c->shortPath($editFilePath))); } if (-e $editFilePath && !-r $editFilePath) { # It's ok if the file doesn't exist. Perhaps we're going to create it with save as. - $self->addbadmessage($r->maketext('The file "[_1]" cannot be read!', $self->shortPath($editFilePath))); + $c->addbadmessage($c->maketext('The file "[_1]" cannot be read!', $c->shortPath($editFilePath))); } # The path to the permanent file is now verified and stored in $editFilePath - $self->{editFilePath} = $editFilePath; - $self->{tempFilePath} = $self->determineTempEditFilePath($editFilePath); + $c->{editFilePath} = $editFilePath; + $c->{tempFilePath} = $c->determineTempEditFilePath($editFilePath); - # $self->{inputFilePath} is $self->{tempFilePath} if it is exists and is readable. - # Otherwise it is the original $self->{editFilePath}. - $self->{inputFilePath} = -r $self->{tempFilePath} ? $self->{tempFilePath} : $self->{editFilePath}; + # $c->{inputFilePath} is $c->{tempFilePath} if it is exists and is readable. + # Otherwise it is the original $c->{editFilePath}. + $c->{inputFilePath} = -r $c->{tempFilePath} ? $c->{tempFilePath} : $c->{editFilePath}; return; } -sub saveFileChanges { - my ($self, $outputFilePath, $problemContents) = @_; - my $r = $self->r; - my $ce = $r->ce; +sub saveFileChanges ($c, $outputFilePath, $problemContents = undef) { + my $ce = $c->ce; $problemContents = $$problemContents if defined $problemContents && ref $problemContents; - $problemContents = ${ $self->{r_problemContents} } unless not_blank($problemContents); + $problemContents = ${ $c->{r_problemContents} } unless not_blank($problemContents); # Read and update the targetFile and targetFile.tmp files in the directory. # If a .tmp file already exists use that, unless the revert button has been pressed. # The .tmp files are removed when the file is or when the revert occurs. unless (not_blank($outputFilePath)) { - $self->addbadmessage($r->maketext('You must specify a file name in order to save a new file.')); + $c->addbadmessage($c->maketext('You must specify a file name in order to save a new file.')); return; } unless (path_is_subdir($outputFilePath, $ce->{courseDirs}{templates}, 1)) { - $self->addbadmessage($r->maktext( + $c->addbadmessage($c->maktext( 'The file [_1] is not contained in the course templates directory and can not be modified.', $outputFilePath )); @@ -639,37 +600,37 @@ sub saveFileChanges { my $errorMessage; if (!-w $ce->{courseDirs}{templates}) { - $errorMessage = $r->maketext( + $errorMessage = $c->maketext( 'Write permissions have not been enabled in the templates directory. No changes can be made.'); } elsif (!-w $currentDirectory) { - $errorMessage = $r->maketext( + $errorMessage = $c->maketext( 'Write permissions have not been enabled in "[_1]".' . 'Changes must be saved to a different directory for viewing.', - $self->shortPath($currentDirectory) + $c->shortPath($currentDirectory) ); } elsif (-e $outputFilePath && !-w $outputFilePath) { - $errorMessage = $r->maketext( + $errorMessage = $c->maketext( 'Write permissions have not been enabled for "[_1]". ' . 'Changes must be saved to another file for viewing.', - $self->shortPath($outputFilePath) + $c->shortPath($outputFilePath) ); } else { - $errorMessage = $r->b($r->maketext( + $errorMessage = $c->b($c->maketext( 'Unable to write to "[_1]": [_2]', - $self->shortPath($outputFilePath), - $r->tag('pre', $writeFileErrors) + $c->shortPath($outputFilePath), + $c->tag('pre', $writeFileErrors) )); } - $self->addbadmessage($errorMessage); + $c->addbadmessage($errorMessage); return; } # If the file is being saved as a new file in a new location, and the file is accompanied by auxiliary files # transfer them as well. If the file is a pg file, then assume there are auxiliary files. Copy all files not # ending in .pg from the original directory to the new one. - if ($self->{action} eq 'save_as' && $outputFilePath =~ /\.pg/) { - my $sourceDirectory = $self->{sourceFilePath} || ''; + if ($c->{action} eq 'save_as' && $outputFilePath =~ /\.pg/) { + my $sourceDirectory = $c->{sourceFilePath} || ''; my $outputDirectory = $outputFilePath; $sourceDirectory =~ s|/[^/]+\.pg$||; $outputDirectory =~ s|/[^/]+\.pg$||; @@ -684,11 +645,11 @@ sub saveFileChanges { # Don't copy directories and don't copy files that have already been copied. if (-f $fromPath && -r $fromPath && !-e $toPath) { # Need to use binary transfer for image files. File::Copy does this. - $self->addbadmessage($r->maketext('Error copying [_1] to [_2].', $fromPath, $toPath)) + $c->addbadmessage($c->maketext('Error copying [_1] to [_2].', $fromPath, $toPath)) unless copy($fromPath, $toPath); } } - $self->addgoodmessage($r->maketext( + $c->addgoodmessage($c->maketext( 'Copied auxiliary files from [_1] to new location at [_2].', $sourceDirectory, $outputDirectory )); @@ -697,25 +658,25 @@ sub saveFileChanges { # Clean up temp files on save or save_as. # Unlink the temporary file if there are no errors and the save or save_as button has been pushed. - if (($self->{action} eq 'save' || $self->{action} eq 'save_as') && -w $self->{tempFilePath}) { - if (path_is_subdir($self->{tempFilePath}, $ce->{courseDirs}{templates}, 1)) { - $self->addgoodmessage($r->maketext('Deleted temp file at [_1]', $self->shortPath($self->{tempFilePath}))); - unlink($self->{tempFilePath}); + if (($c->{action} eq 'save' || $c->{action} eq 'save_as') && -w $c->{tempFilePath}) { + if (path_is_subdir($c->{tempFilePath}, $ce->{courseDirs}{templates}, 1)) { + $c->addgoodmessage($c->maketext('Deleted temp file at [_1]', $c->shortPath($c->{tempFilePath}))); + unlink($c->{tempFilePath}); # Update the file paths. - $self->{tempFilePath} = $self->determineTempEditFilePath($self->{editFilePath}); - $self->{inputFilePath} = $self->{editFilePath}; + $c->{tempFilePath} = $c->determineTempEditFilePath($c->{editFilePath}); + $c->{inputFilePath} = $c->{editFilePath}; } else { - $self->addbadmessage($r->maketext( + $c->addbadmessage($c->maketext( 'The temporary file [_1] is not in the course templates directory and can not be deleted!', - $self->{tempFilePath} + $c->{tempFilePath} )); } } # Announce that the file was saved unless it was a temporary file. - unless ($self->isTempEditFilePath($outputFilePath)) { - $self->addgoodmessage($r->maketext('Saved to file "[_1]"', $self->shortPath($outputFilePath))); + unless ($c->isTempEditFilePath($outputFilePath)) { + $c->addgoodmessage($c->maketext('Saved to file "[_1]"', $c->shortPath($outputFilePath))); } return; @@ -728,97 +689,74 @@ sub fixProblemContents { return $problemContents =~ s/(\r\n)|(\r)/\n/gr; } -sub view_handler { - my ($self) = @_; - my $r = $self->r; - - my $problemSeed = $r->param('action.view.seed') // DEFAULT_SEED(); - my $displayMode = $r->param('action.view.displayMode') // $self->r->ce->{pg}{options}{displayMode}; +sub view_handler ($c) { + my $problemSeed = $c->param('action.view.seed') // DEFAULT_SEED(); + my $displayMode = $c->param('action.view.displayMode') // $c->ce->{pg}{options}{displayMode}; # Grab the problemContents from the form in order to save it to the tmp file. - $self->{r_problemContents} = \(fixProblemContents($self->r->param('problemContents'))); + $c->{r_problemContents} = \(fixProblemContents($c->param('problemContents'))); - $self->saveFileChanges($self->{tempFilePath}); + $c->saveFileChanges($c->{tempFilePath}); - my $relativeTempFilePath = $self->getRelativeSourceFilePath($self->{tempFilePath}); + my $relativeTempFilePath = $c->getRelativeSourceFilePath($c->{tempFilePath}); # Construct redirect URL and redirect to it. - if ($self->{file_type} eq 'problem' || $self->{file_type} eq 'source_path_for_problem_file') { + if ($c->{file_type} eq 'problem' || $c->{file_type} eq 'source_path_for_problem_file') { # Redirect to Problem.pm or GatewayQuiz.pm. # We need to know if the set is a gateway set to determine the redirect. - my $globalSet = $self->r->db->getGlobalSet($self->{setID}); + my $globalSet = $c->db->getGlobalSet($c->{setID}); - $self->reply_with_redirect($self->systemLink( + $c->reply_with_redirect($c->systemLink( defined $globalSet && $globalSet->assignment_type =~ /gateway/ - ? $self->r->urlpath->newFromModule( - 'WeBWorK::ContentGenerator::GatewayQuiz', $r, - courseID => $self->{courseID}, - setID => 'Undefined_Set' - ) - : $self->r->urlpath->newFromModule( - 'WeBWorK::ContentGenerator::Problem', $r, - courseID => $self->{courseID}, - setID => $self->{setID}, - problemID => $self->{problemID} - ), + ? $c->url_for('gateway_quiz', setID => 'Undefined_Set') + : $c->url_for('problem_detail', setID => $c->{setID}, problemID => $c->{problemID}), params => { displayMode => $displayMode, problemSeed => $problemSeed, editMode => 'temporaryFile', sourceFilePath => $relativeTempFilePath, - status_message => uri_escape_utf8($self->{status_message}->join('')) + status_message => $c->{status_message}->join('') } )); - } elsif ($self->{file_type} eq 'set_header') { + } elsif ($c->{file_type} eq 'set_header') { # Redirect to ProblemSet - $self->reply_with_redirect($self->systemLink( - $self->r->urlpath->newFromModule( - 'WeBWorK::ContentGenerator::ProblemSet', $r, - courseID => $self->{courseID}, - setID => $self->{setID}, - ), + $c->reply_with_redirect($c->systemLink( + $c->url_for('problem_list', setID => $c->{setID}), params => { - set_header => $self->{tempFilePath}, + set_header => $c->{tempFilePath}, displayMode => $displayMode, problemSeed => $problemSeed, editMode => 'temporaryFile', sourceFilePath => $relativeTempFilePath, - status_message => uri_escape_utf8($self->{status_message}->join('')) + status_message => $c->{status_message}->join('') } )); - } elsif ($self->{file_type} eq 'hardcopy_header') { + } elsif ($c->{file_type} eq 'hardcopy_header') { # Redirect to ProblemSet?? It's difficult to view temporary changes for hardcopy headers. - $self->reply_with_redirect($self->systemLink( - $self->r->urlpath->newFromModule( - 'WeBWorK::ContentGenerator::ProblemSet', $r, - courseID => $self->{courseID}, - setID => $self->{setID}, - ), + $c->reply_with_redirect($c->systemLink( + $c->url_for('problem_list', setID => $c->{setID}), params => { - set_header => $self->{tempFilePath}, + set_header => $c->{tempFilePath}, displayMode => $displayMode, problemSeed => $problemSeed, editMode => 'temporaryFile', sourceFilePath => $relativeTempFilePath, - status_message => uri_escape_utf8($self->{status_message}->join('')) + status_message => $c->{status_message}->join('') } )); - } elsif ($self->{file_type} eq 'course_info') { + } elsif ($c->{file_type} eq 'course_info') { # Redirect to ProblemSets.pm. - $self->reply_with_redirect($self->systemLink( - $self->r->urlpath->newFromModule( - 'WeBWorK::ContentGenerator::ProblemSets', - $r, courseID => $self->{courseID} - ), + $c->reply_with_redirect($c->systemLink( + $c->url_for('set_list'), params => { - course_info => $self->{tempFilePath}, + course_info => $c->{tempFilePath}, editMode => 'temporaryFile', sourceFilePath => $relativeTempFilePath, - status_message => uri_escape_utf8($self->{status_message}->join('')) + status_message => $c->{status_message}->join('') } )); } else { - die "I don't know how to redirect this file type $self->{file_type}."; + die "I don't know how to redirect this file type $c->{file_type}."; } return; @@ -828,16 +766,14 @@ sub view_handler { # something goes wrong and the action gets called. sub hardcopy_action { } -sub add_problem_handler { - my ($self) = @_; - my $r = $self->r; - my $db = $r->db; +sub add_problem_handler ($c) { + my $db = $c->db; - my $templatesPath = $self->r->ce->{courseDirs}{templates}; - my $sourceFilePath = $self->{editFilePath} =~ s|^$templatesPath/||r; + my $templatesPath = $c->ce->{courseDirs}{templates}; + my $sourceFilePath = $c->{editFilePath} =~ s|^$templatesPath/||r; - my $targetSetName = $r->param('action.add_problem.target_set'); - my $targetFileType = $r->param('action.add_problem.file_type'); + my $targetSetName = $c->param('action.add_problem.target_set'); + my $targetFileType = $c->param('action.add_problem.file_type'); if ($targetFileType eq 'problem') { my $targetProblemNumber; @@ -856,7 +792,7 @@ sub add_problem_handler { # Update problem record my $problemRecord = addProblemToSet( - $db, $r->ce->{problemDefaults}, + $db, $c->ce->{problemDefaults}, setName => $targetSetName, sourceFile => $sourceFilePath, problemID => $targetProblemNumber, @@ -864,7 +800,7 @@ sub add_problem_handler { assignProblemToAllSetUsers($db, $problemRecord); - $self->addgoodmessage($r->maketext( + $c->addgoodmessage($c->maketext( 'Added [_1] to [_2] as problem [_3]', $sourceFilePath, $targetSetName, @@ -874,88 +810,80 @@ sub add_problem_handler { : $targetProblemNumber ) )); - $self->{file_type} = 'problem'; # Change file type to problem if it is not already that. + $c->{file_type} = 'problem'; # Change file type to problem if it is not already that. # Redirect to problem editor page. - $self->reply_with_redirect($self->systemLink( - $self->r->urlpath->newFromModule( - 'WeBWorK::ContentGenerator::Instructor::PGProblemEditor', $r, - courseID => $self->{courseID}, + $c->reply_with_redirect($c->systemLink( + $c->url_for( + 'instructor_problem_editor_withset_withproblem', setID => $targetSetName, problemID => $targetProblemNumber, ), params => { - displayMode => $self->{displayMode}, - problemSeed => $self->{problemSeed}, + displayMode => $c->{displayMode}, + problemSeed => $c->{problemSeed}, editMode => 'savedFile', - sourceFilePath => $self->getRelativeSourceFilePath($sourceFilePath), - status_message => uri_escape_utf8($self->{status_message}->join('')), + sourceFilePath => $c->getRelativeSourceFilePath($sourceFilePath), + status_message => $c->{status_message}->join(''), file_type => 'problem', } )); } elsif ($targetFileType eq 'set_header') { # Update set record - my $setRecord = $self->r->db->getGlobalSet($targetSetName); + my $setRecord = $c->db->getGlobalSet($targetSetName); $setRecord->set_header($sourceFilePath); - if ($self->r->db->putGlobalSet($setRecord)) { - $self->addgoodmessage($r->maketext( + if ($c->db->putGlobalSet($setRecord)) { + $c->addgoodmessage($c->maketext( 'Added "[_1]" to [_2] as new set header', - $self->shortPath($sourceFilePath), + $c->shortPath($sourceFilePath), $targetSetName )); } else { - $self->addbadmessage($r->maketext( - 'Unable to make "[_1]" the set header for [_2].', $self->shortPath($sourceFilePath), + $c->addbadmessage($c->maketext( + 'Unable to make "[_1]" the set header for [_2].', + $c->shortPath($sourceFilePath), $targetSetName )); } - $self->{file_type} = 'set_header'; # Change file type to set_header if not already so. + $c->{file_type} = 'set_header'; # Change file type to set_header if not already so. # Redirect - $self->reply_with_redirect($self->systemLink( - $self->r->urlpath->newFromModule( - 'WeBWorK::ContentGenerator::ProblemSet', $r, - courseID => $self->{courseID}, - setID => $targetSetName - ), + $c->reply_with_redirect($c->systemLink( + $c->url_for('problem_list', setID => $targetSetName), params => { - displayMode => $self->{displayMode}, + displayMode => $c->{displayMode}, editMode => 'savedFile', - status_message => uri_escape_utf8($self->{status_message}->join('')), + status_message => $c->{status_message}->join(''), } )); } elsif ($targetFileType eq 'hardcopy_header') { # Update set record - my $setRecord = $self->r->db->getGlobalSet($targetSetName); + my $setRecord = $c->db->getGlobalSet($targetSetName); $setRecord->hardcopy_header($sourceFilePath); - if ($self->r->db->putGlobalSet($setRecord)) { - $self->addgoodmessage($r->maketext( + if ($c->db->putGlobalSet($setRecord)) { + $c->addgoodmessage($c->maketext( 'Added "[_1]" to [_2] as new hardcopy header', - $self->shortPath($sourceFilePath), + $c->shortPath($sourceFilePath), $targetSetName )); } else { - $self->addbadmessage( - $r->maketext('Unable to make "[_1]" the hardcopy header for [_2].'), - $self->shortPath($sourceFilePath), + $c->addbadmessage( + $c->maketext('Unable to make "[_1]" the hardcopy header for [_2].'), + $c->shortPath($sourceFilePath), $targetSetName ); } - $self->{file_type} = 'hardcopy_header'; # Change file type to set_header if not already so. + $c->{file_type} = 'hardcopy_header'; # Change file type to set_header if not already so. # Redirect - $self->reply_with_redirect($self->systemLink( - $self->r->urlpath->newFromModule( - 'WeBWorK::ContentGenerator::Hardcopy', $r, - courseID => $self->{courseID}, - setID => $targetSetName - ), + $c->reply_with_redirect($c->systemLink( + $c->url_for('hardcopy_preselect_set', setID => $targetSetName), params => { - displayMode => $self->{displayMode}, + displayMode => $c->{displayMode}, editMode => 'savedFile', - status_message => uri_escape_utf8($self->{status_message}->join('')), + status_message => $c->{status_message}->join(''), } )); } else { @@ -965,140 +893,111 @@ sub add_problem_handler { return; } -sub save_handler { - my $self = shift; - my $r = $self->r; - +sub save_handler ($c) { # Grab the problemContents from the form in order to save it to a new permanent file. # Later we will unlink (delete) the current temporary file. - $self->{r_problemContents} = \(fixProblemContents($self->r->param('problemContents'))); + $c->{r_problemContents} = \(fixProblemContents($c->param('problemContents'))); # Sanity check in case the user has edited the problem set while editing a problem. # This can cause the current editor contents to overwrite the new file that is saved for the problem. - if ($self->{editFilePath} ne $r->param('action.save.source_file')) { - $self->addbadmessage($r->maketext( + if ($c->{editFilePath} ne $c->param('action.save.source_file')) { + $c->addbadmessage($c->maketext( 'File not saved. The file name for this problem does not match the file name the editor was opened with. ' . 'The problem set may have changed. Please reopen this file from the homework sets editor.' )); } else { - $self->saveFileChanges($self->{editFilePath}); + $c->saveFileChanges($c->{editFilePath}); } # Don't redirect unless it was requested to open in a new window. - return unless $r->param('newWindowSave'); + return unless $c->param('newWindowSave'); - if ($self->{file_type} eq 'problem' || $self->{file_type} eq 'source_path_for_problem_file') { + if ($c->{file_type} eq 'problem' || $c->{file_type} eq 'source_path_for_problem_file') { # Redirect to Problem.pm or GatewayQuiz.pm. # We need to know if the set is a gateway set to determine the redirect. - my $globalSet = $self->r->db->getGlobalSet($self->{setID}); + my $globalSet = $c->db->getGlobalSet($c->{setID}); - $self->reply_with_redirect($self->systemLink( + $c->reply_with_redirect($c->systemLink( defined $globalSet && $globalSet->assignment_type =~ /gateway/ - ? $self->r->urlpath->newFromModule( - 'WeBWorK::ContentGenerator::GatewayQuiz', $r, - courseID => $self->{courseID}, - setID => 'Undefined_Set' - ) - : $self->r->urlpath->newFromModule( - 'WeBWorK::ContentGenerator::Problem', $r, - courseID => $self->{courseID}, - setID => $self->{setID}, - problemID => $self->{problemID} - ), + ? $c->url_for('gateway_quiz', setID => 'Undefined_Set') + : $c->url_for('problem_detail', setID => $c->{setID}, problemID => $c->{problemID}), params => { - displayMode => $self->{displayMode}, - problemSeed => $self->{problemSeed}, + displayMode => $c->{displayMode}, + problemSeed => $c->{problemSeed}, editMode => 'savedFile', - sourceFilePath => $self->getRelativeSourceFilePath($self->{editFilePath}), - status_message => uri_escape_utf8($self->{status_message}->join('')) + sourceFilePath => $c->getRelativeSourceFilePath($c->{editFilePath}), + status_message => $c->{status_message}->join('') } )); - } elsif ($self->{file_type} eq 'set_header') { - # Redirect to ProblemSet - $self->reply_with_redirect($self->systemLink( - $self->r->urlpath->newFromModule( - 'WeBWorK::ContentGenerator::ProblemSet', $r, - courseID => $self->{courseID}, - setID => $self->{setID}, - ), + } elsif ($c->{file_type} eq 'set_header') { + # Redirect to ProblemSet.pm + $c->reply_with_redirect($c->systemLink( + $c->url_for('problem_list', setID => $c->{setID}), params => { - displayMode => $self->{displayMode}, - problemSeed => $self->{problemSeed}, + displayMode => $c->{displayMode}, + problemSeed => $c->{problemSeed}, editMode => 'savedFile', - status_message => uri_escape_utf8($self->{status_message}->join('')) + status_message => $c->{status_message}->join('') } )); - } elsif ($self->{file_type} eq 'hardcopy_header') { - # Redirect to ProblemSet - $self->reply_with_redirect($self->systemLink( - $self->r->urlpath->newFromModule( - 'WeBWorK::ContentGenerator::Hardcopy', $r, - courseID => $self->{courseID}, - setID => $self->{setID}, - ), + } elsif ($c->{file_type} eq 'hardcopy_header') { + # Redirect to Hardcopy.pm + $c->reply_with_redirect($c->systemLink( + $c->url_for('hardcopy_preselect_set', setID => $c->{setID}), params => { - displayMode => $self->{displayMode}, - problemSeed => $self->{problemSeed}, + displayMode => $c->{displayMode}, + problemSeed => $c->{problemSeed}, editMode => 'savedFile', - status_message => uri_escape_utf8($self->{status_message}->join('')) + status_message => $c->{status_message}->join('') } )); - } elsif ($self->{file_type} eq 'course_info') { + } elsif ($c->{file_type} eq 'course_info') { # Redirect to ProblemSets.pm - $self->reply_with_redirect($self->systemLink( - $self->r->urlpath->newFromModule( - 'WeBWorK::ContentGenerator::ProblemSets', - $r, courseID => $self->{courseID} - ), - params => { - editMode => 'savedFile', - status_message => uri_escape_utf8($self->{status_message}->join('')) - } + $c->reply_with_redirect($c->systemLink( + $c->url_for('set_list'), + params => { editMode => 'savedFile', status_message => $c->{status_message}->join('') } )); - } elsif ($self->{file_type} eq 'source_path_for_problem_file') { - # Redirect to ProblemSets.pm - $self->reply_with_redirect($self->systemLink( - $self->r->urlpath->newFromModule( - 'WeBWorK::ContentGenerator::Instructor::PGProblemEditor', $r, - courseID => $self->{courseID}, - setID => $self->{setID}, - problemID => $self->{problemID} + } elsif ($c->{file_type} eq 'source_path_for_problem_file') { + # Redirect to PGProblemEditor.pm + $c->reply_with_redirect($c->systemLink( + $c->url_for( + 'instructor_problem_editor_withset_withproblem', + setID => $c->{setID}, + problemID => $c->{problemID} ), params => { - displayMode => $self->{displayMode}, - problemSeed => $self->{problemSeed}, + displayMode => $c->{displayMode}, + problemSeed => $c->{problemSeed}, editMode => 'savedFile', # The path relative to the templates directory is required. - sourceFilePath => $self->{editFilePath}, + sourceFilePath => $c->{editFilePath}, file_type => 'source_path_for_problem_file', - status_message => uri_escape_utf8($self->{status_message}->join('')) + status_message => $c->{status_message}->join('') } )); } else { - die "Unsupported save file type $self->{file_type}."; + die "Unsupported save file type $c->{file_type}."; } return; } -sub save_as_handler { - my ($self) = @_; - my $r = $self->r; - my $db = $r->db; +sub save_as_handler ($c) { + my $db = $c->db; - $self->{status_message} = $r->c; + $c->{status_message} = $c->c; my $do_not_save = 0; - my $saveMode = $r->param('action.save_as.saveMode') || 'no_save_mode_selected'; - my $new_file_name = ($r->param('action.save_as.target_file') || '') =~ s/^\s*|\s*$//gr; - $self->{sourceFilePath} = $r->param('action.save_as.source_file') || ''; # Store for use in saveFileChanges. - my $file_type = $r->param('action.save_as.file_type') || ''; + my $saveMode = $c->param('action.save_as.saveMode') || 'no_save_mode_selected'; + my $new_file_name = ($c->param('action.save_as.target_file') || '') =~ s/^\s*|\s*$//gr; + $c->{sourceFilePath} = $c->param('action.save_as.source_file') || ''; # Store for use in saveFileChanges. + my $file_type = $c->param('action.save_as.file_type') || ''; # Need a non-blank file name. if (!$new_file_name) { $do_not_save = 1; - $self->addbadmessage($r->maketext('Please specify a file to save to.')); + $c->addbadmessage($c->maketext('Please specify a file to save to.')); } # Rescue the user in case they forgot to end the file name with the pg extension. @@ -1110,28 +1009,28 @@ sub save_as_handler { # Grab the problemContents from the form in order to save it to a new permanent file. # Later we will unlink (delete) the current temporary file. - $self->{r_problemContents} = \(fixProblemContents($r->param('problemContents'))); + $c->{r_problemContents} = \(fixProblemContents($c->param('problemContents'))); # Construct the output file path - my $outputFilePath = $r->ce->{courseDirs}{templates} . "/$new_file_name"; + my $outputFilePath = $c->ce->{courseDirs}{templates} . "/$new_file_name"; if (defined $outputFilePath && -e $outputFilePath) { $do_not_save = 1; - $self->addbadmessage($r->maketext( + $c->addbadmessage($c->maketext( 'File "[_1]" exists. File not saved. No changes have been made. ' . 'You can change the file path for this problem manually from the "Hmwk Sets Editor" page', - $self->shortPath($outputFilePath) + $c->shortPath($outputFilePath) )); - $self->addgoodmessage($r->maketext( + $c->addgoodmessage($c->maketext( 'The text box now contains the source of the original problem. ' . 'You can recover lost edits by using the Back button on your browser.' )); } else { - $self->{editFilePath} = $outputFilePath; + $c->{editFilePath} = $outputFilePath; # saveFileChanges will update the tempFilePath and inputFilePath as needed. Don't do that here. } unless ($do_not_save) { - $self->saveFileChanges($outputFilePath); + $c->saveFileChanges($outputFilePath); my $targetProblemNumber; if ($file_type eq 'course_info') { @@ -1141,84 +1040,82 @@ sub save_as_handler { } elsif ($saveMode eq 'rename' && -r $outputFilePath) { # Modify source file path in problem. if ($file_type eq 'set_header') { - my $setRecord = $db->getGlobalSet($self->{setID}); + my $setRecord = $db->getGlobalSet($c->{setID}); $setRecord->set_header($new_file_name); if ($db->putGlobalSet($setRecord)) { - $self->addgoodmessage($r->maketext( - 'The set header for set [_1] has been renamed to "[_2]".', $self->{setID}, - $self->shortPath($outputFilePath) + $c->addgoodmessage($c->maketext( + 'The set header for set [_1] has been renamed to "[_2]".', $c->{setID}, + $c->shortPath($outputFilePath) )); } else { - $self->addbadmessage($r->maketext( - 'Unable to change the set header for set [_1]. Unknown error.', - $self->{setID} - )); + $c->addbadmessage($c->maketext( + 'Unable to change the set header for set [_1]. Unknown error.', $c->{setID})); } } elsif ($file_type eq 'hardcopy_header') { - my $setRecord = $db->getGlobalSet($self->{setID}); + my $setRecord = $db->getGlobalSet($c->{setID}); $setRecord->hardcopy_header($new_file_name); if ($db->putGlobalSet($setRecord)) { - $self->addgoodmessage($r->maketext( - 'The hardcopy header for set [_1] has been renamed to "[_2]".', $self->{setID}, - $self->shortPath($outputFilePath) + $c->addgoodmessage($c->maketext( + 'The hardcopy header for set [_1] has been renamed to "[_2]".', $c->{setID}, + $c->shortPath($outputFilePath) )); } else { - $self->addbadmessage($r->maketext( + $c->addbadmessage($c->maketext( 'Unable to change the hardcopy header for set [_1]. Unknown error.', - $self->{setID} + $c->{setID} )); } } else { my $problemRecord; - if ($self->{versionID}) { - $problemRecord = $db->getMergedProblemVersion($r->param('effectiveUser'), - $self->{setID}, $1, $self->{problemID}); + if ($c->{versionID}) { + $problemRecord = + $db->getMergedProblemVersion($c->param('effectiveUser'), $c->{setID}, $1, $c->{problemID}); } else { - $problemRecord = $db->getGlobalProblem($self->{setID}, $self->{problemID}); + $problemRecord = $db->getGlobalProblem($c->{setID}, $c->{problemID}); } $problemRecord->source_file($new_file_name); my $result = - $self->{versionID} ? $db->putProblemVersion($problemRecord) : $db->putGlobalProblem($problemRecord); + $c->{versionID} ? $db->putProblemVersion($problemRecord) : $db->putGlobalProblem($problemRecord); if ($result) { - $self->addgoodmessage($r->maketext( - 'The source file for "set [_1] / problem [_2] has been changed from "[_3]" to "[_4]".', - $self->{fullSetID}, - $self->{prettyProblemNumber}, - $self->shortPath($self->{sourceFilePath}), - $self->shortPath($outputFilePath) + $c->addgoodmessage($c->maketext( + 'The source file for "set [_1] / problem [_2]" has been changed from "[_3]" to "[_4]".', + $c->{fullSetID}, + $c->{prettyProblemNumber}, + $c->shortPath($c->{sourceFilePath}), + $c->shortPath($outputFilePath) )); } else { - $self->addbadmessage($r->maketext( + $c->addbadmessage($c->maketext( 'Unable to change the source file path for set [_1], problem [_2]. Unknown error.', - $self->{fullSetID}, $self->{prettyProblemNumber} + $c->{fullSetID}, $c->{prettyProblemNumber} )); } } } elsif ($saveMode eq 'add_to_set_as_new_problem') { - my $set = $db->getGlobalSet($self->{setID}); + my $set = $db->getGlobalSet($c->{setID}); # For jitar sets new problems are put as top level problems at the end. if ($set->assignment_type eq 'jitar') { - my @problemIDs = $db->listGlobalProblems($self->{setID}); + my @problemIDs = $db->listGlobalProblems($c->{setID}); @problemIDs = sort { $a <=> $b } @problemIDs; my @seq = jitar_id_to_seq($problemIDs[-1]); $targetProblemNumber = seq_to_jitar_id($seq[0] + 1); } else { - $targetProblemNumber = 1 + max($db->listGlobalProblems($self->{setID})); + $targetProblemNumber = 1 + max($db->listGlobalProblems($c->{setID})); } my $problemRecord = addProblemToSet( - $db, $r->ce->{problemDefaults}, - setName => $self->{setID}, + $db, $c->ce->{problemDefaults}, + setName => $c->{setID}, sourceFile => $new_file_name, problemID => $targetProblemNumber, # Added to end of set ); assignProblemToAllSetUsers($db, $problemRecord); - $self->addgoodmessage($r->maketext( + $c->addgoodmessage($c->maketext( 'Added [_1] to [_2] as problem [_3].', $new_file_name, - $self->{setID}, + $c->{setID}, ( $set->assignment_type eq 'jitar' ? join('.', jitar_id_to_seq($targetProblemNumber)) @@ -1226,14 +1123,14 @@ sub save_as_handler { ) )); } elsif ($saveMode eq 'new_independent_problem') { - $self->addgoodmessage($r->maketext( + $c->addgoodmessage($c->maketext( 'A new file has been created at "[_1]" with the contents below.', - $self->shortPath($outputFilePath) + $c->shortPath($outputFilePath) )); - $self->addgoodmessage($r->maketext(' No changes have been made to set [_1]', $self->{setID})) - if ($self->{setID} ne 'Undefined_Set'); + $c->addgoodmessage($c->maketext(' No changes have been made to set [_1]', $c->{setID})) + if ($c->{setID} ne 'Undefined_Set'); } else { - $self->addbadmessage($r->maketext('Unkown saveMode: [_1].', $saveMode)); + $c->addbadmessage($c->maketext('Unkown saveMode: [_1].', $saveMode)); return; } } @@ -1243,76 +1140,67 @@ sub save_as_handler { my $new_file_type; if ($saveMode eq 'new_course_info') { - $problemPage = $self->r->urlpath->newFromModule('WeBWorK::ContentGenerator::Instructor::PGProblemEditor', - $r, courseID => $self->{courseID}); + $problemPage = $c->url_for('instructor_problem_editor'); $new_file_type = 'course_info'; } elsif ($saveMode eq 'new_independent_problem') { - $problemPage = $self->r->urlpath->newFromModule( - 'WeBWorK::ContentGenerator::Instructor::PGProblemEditor', $r, - courseID => $self->{courseID}, - setID => 'Undefined_Set', - problemID => 1 - ); + $problemPage = + $c->url_for('instructor_problem_editor_withset_withproblem', setID => 'Undefined_Set', problemID => 1); $new_file_type = 'source_path_for_problem_file'; } elsif ($saveMode eq 'rename') { - $problemPage = $self->r->urlpath->newFromModule( - 'WeBWorK::ContentGenerator::Instructor::PGProblemEditor', $r, - courseID => $self->{courseID}, - setID => $self->{setID}, - problemID => $self->{problemID} + $problemPage = $c->url_for( + 'instructor_problem_editor_withset_withproblem', + setID => $c->{setID}, + problemID => $c->{problemID} ); $new_file_type = $file_type; } elsif ($saveMode eq 'add_to_set_as_new_problem') { - $problemPage = $self->r->urlpath->newFromModule( - 'WeBWorK::ContentGenerator::Instructor::PGProblemEditor', $r, - courseID => $self->{courseID}, - setID => $self->{setID}, - problemID => $do_not_save ? $self->{problemID} : max($db->listGlobalProblems($self->{setID})) + $problemPage = $c->url_for( + 'instructor_problem_editor_withset_withproblem', + setID => $c->{setID}, + problemID => $do_not_save ? $c->{problemID} : max($db->listGlobalProblems($c->{setID})) ); $new_file_type = $file_type; } else { - $self->addbadmessage($r->maketext( + $c->addbadmessage($c->maketext( 'Please use radio buttons to choose the method for saving this file. Uknown saveMode: [_1].', $saveMode )); return; } - $self->reply_with_redirect($self->systemLink( + $c->reply_with_redirect($c->systemLink( $problemPage, params => { # The path relative to the templates directory is required. - sourceFilePath => $self->getRelativeSourceFilePath($outputFilePath), - problemSeed => $self->{problemSeed}, + sourceFilePath => $c->getRelativeSourceFilePath($outputFilePath), + problemSeed => $c->{problemSeed}, file_type => $new_file_type, - status_message => uri_escape_utf8($self->{status_message}->join('')) + status_message => $c->{status_message}->join('') } )); return; } -sub revert_handler { - my $self = shift; - my $r = $self->r; - my $ce = $r->ce; +sub revert_handler ($c) { + my $ce = $c->ce; - $self->{inputFilePath} = $self->{editFilePath}; + $c->{inputFilePath} = $c->{editFilePath}; - unless (path_is_subdir($self->{tempFilePath}, $ce->{courseDirs}{templates}, 1)) { - $self->addbadmessage($r->maketext( + unless (path_is_subdir($c->{tempFilePath}, $ce->{courseDirs}{templates}, 1)) { + $c->addbadmessage($c->maketext( 'The temporary file [_1] is not contained in the course templates directory and can not be deleted.', - $self->{tempFilePath} + $c->{tempFilePath} )); return; } # Unlink the temp files; - unlink($self->{tempFilePath}); - $self->addgoodmessage($r->maketext('Deleted temporary file [_1].', $self->shortPath($self->{tempFilePath}))); + unlink($c->{tempFilePath}); + $c->addgoodmessage($c->maketext('Deleted temporary file [_1].', $c->shortPath($c->{tempFilePath}))); - $self->{r_problemContents} = \''; - $r->param('problemContents', undef); + $c->{r_problemContents} = \''; + $c->param('problemContents', undef); - $self->addgoodmessage($r->maketext('Reverted to original file "[_1]".', $self->shortPath($self->{editFilePath}))); + $c->addgoodmessage($c->maketext('Reverted to original file "[_1]".', $c->shortPath($c->{editFilePath}))); return; } diff --git a/lib/WeBWorK/ContentGenerator/Instructor/ProblemGrader.pm b/lib/WeBWorK/ContentGenerator/Instructor/ProblemGrader.pm index 5884e80812..4d87064934 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/ProblemGrader.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/ProblemGrader.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::Instructor::ProblemGrader; -use parent qw(WeBWorK::ContentGenerator); +use Mojo::Base 'WeBWorK::ContentGenerator', -signatures, -async_await; =head1 NAME @@ -23,34 +23,28 @@ manually grading webwork problems. =cut -use strict; -use warnings; - -use Future::AsyncAwait; use HTML::Entities; use WeBWorK::Utils qw(sortByName wwRound); use WeBWorK::Utils::Rendering qw(renderPG); use WeBWorK::PG; +use WeBWorK::Form; -async sub initialize { - my ($self) = @_; - my $r = $self->r; - my $urlpath = $r->urlpath; - my $authz = $r->authz; - my $db = $r->db; - my $ce = $r->ce; - my $courseName = $urlpath->arg('courseID'); - my $setID = $urlpath->arg('setID'); - my $problemID = $urlpath->arg('problemID'); - my $userID = $r->param('user'); +async sub initialize ($c) { + my $authz = $c->authz; + my $db = $c->db; + my $ce = $c->ce; + my $courseName = $c->stash('courseID'); + my $setID = $c->stash('setID'); + my $problemID = $c->stash('problemID'); + my $userID = $c->param('user'); return unless $authz->hasPermissions($userID, 'access_instructor_tools'); return unless $authz->hasPermissions($userID, 'score_sets'); # Get all users except the set level proctors, and restrict to the sections or recitations that are allowed for the # user if such restrictions are defined. The users are sorted first by section, then by last name. - $self->{users} = [ + $c->{users} = [ $db->getUsersWhere( { user_id => { not_like => 'set_id:%' }, @@ -71,7 +65,7 @@ async sub initialize { # First process student problems and answers and cache relevant data used both for # saving grades and displaying the grader table. - for my $user (@{ $self->{users} }) { + for my $user (@{ $c->{users} }) { $user->{data}{problem} = $db->getUserProblem($user->user_id, $setID, $problemID); next unless $user->{data}{problem}; @@ -81,24 +75,24 @@ async sub initialize { } # Update grades if saving. - if ($r->param('assignGrades')) { - $self->addmessage($r->tag( + if ($c->param('assignGrades')) { + $c->addmessage($c->tag( 'p', class => 'alert alert-success p-1 my-2', - $r->maketext('Grades have been saved for all current users.') + $c->maketext('Grades have been saved for all current users.') )); - for my $user (@{ $self->{users} }) { + for my $user (@{ $c->{users} }) { my $userID = $user->user_id; my $userProblem = $user->{data}{problem}; - next unless $userProblem && defined $r->param("$userID.score"); + next unless $userProblem && defined $c->param("$userID.score"); # Update grades and set flags. $userProblem->{flags} =~ s/needs_grading/graded/; - if ($r->param("$userID.mark_correct")) { + if ($c->param("$userID.mark_correct")) { $userProblem->status(1); } else { - my $newscore = $r->param("$userID.score") / 100; + my $newscore = $c->param("$userID.score") / 100; if ($newscore != $userProblem->status) { $userProblem->status($newscore); } @@ -107,7 +101,7 @@ async sub initialize { $db->putUserProblem($userProblem); # Save the instructor comment to the latest past answer. - if (my $comment = $r->param("$userID.comment") && defined $user->{data}{past_answer}) { + if (my $comment = $c->param("$userID.comment") && defined $user->{data}{past_answer}) { $user->{data}{past_answer}->comment_string($comment); warn q{Couldn't save comment} unless $db->putPastAnswer($user->{data}{past_answer}); } @@ -117,20 +111,20 @@ async sub initialize { my $user = $db->getUser($userID); return unless $user; # This should never happen at this point. - $self->{set} = $db->getMergedSet($userID, $setID); - $self->{problem} = $db->getMergedProblem($userID, $setID, $problemID); + $c->{set} = $db->getMergedSet($userID, $setID); + $c->{problem} = $db->getMergedProblem($userID, $setID, $problemID); - return unless $self->{set} && $self->{problem}; + return unless $c->{set} && $c->{problem}; # Render the problem text. - $self->{pg} = await renderPG( - $r, $user, - $self->{set}, - $self->{problem}, - $self->{set}->psvn, - { WeBWorK::Form->new_from_paramable($r)->Vars }, + $c->{pg} = await renderPG( + $c, $user, + $c->{set}, + $c->{problem}, + $c->{set}->psvn, + { WeBWorK::Form->new_from_paramable($c)->Vars }, { - displayMode => $user->displayMode || $r->ce->{pg}{options}{displayMode}, + displayMode => $user->displayMode || $c->ce->{pg}{options}{displayMode}, showHints => 0, showSolutions => 0, refreshMath2img => 0, diff --git a/lib/WeBWorK/ContentGenerator/Instructor/ProblemSetDetail.pm b/lib/WeBWorK/ContentGenerator/Instructor/ProblemSetDetail.pm index a1ef0e716e..322bdead1b 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/ProblemSetDetail.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/ProblemSetDetail.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::Instructor::ProblemSetDetail; -use parent qw(WeBWorK::ContentGenerator); +use Mojo::Base 'WeBWorK::ContentGenerator', -signatures; =head1 NAME @@ -23,9 +23,6 @@ specific user/set information as well as problem information =cut -use strict; -use warnings; - use WeBWorK::Utils qw(cryptPassword jitar_id_to_seq seq_to_jitar_id x format_set_name_internal format_set_name_display); use WeBWorK::Utils::Instructor qw(assignProblemToAllSetUsers addProblemToSet); @@ -528,12 +525,9 @@ use constant FIELD_PROPERTIES_GWQUIZ => { # Create a table of fields for the given parameters, one row for each db field. # If only the setID is included, it creates a table of set information. # If the problemID is included, it creates a table of problem information. -sub fieldTable { - my ($self, $userID, $setID, $problemID, $globalRecord, $userRecord, $setType) = @_; - - my $r = $self->r; - my $ce = $r->ce; - my @editForUser = $r->param('editForUser'); +sub fieldTable ($c, $userID, $setID, $problemID, $globalRecord, $userRecord, $setType = undef) { + my $ce = $c->ce; + my @editForUser = $c->param('editForUser'); my $forUsers = scalar(@editForUser); my $forOneUser = $forUsers == 1; my $isGWset = defined $setType && $setType =~ /gateway/ ? 1 : 0; @@ -564,20 +558,20 @@ sub fieldTable { @fieldOrder = @{ SET_FIELD_ORDER() }; ($extraFields, $ipFields, $numLocations, $procFields) = - $self->extraSetFields($userID, $setID, $globalRecord, $userRecord, $forUsers); + $c->extraSetFields($userID, $setID, $globalRecord, $userRecord, $forUsers); } - my $rows = $r->c; + my $rows = $c->c; if ($forUsers) { push( @$rows, - $r->tag( + $c->tag( 'tr', - $r->c( - $r->tag('td', colspan => '3', ''), - $r->tag('th', $r->maketext('User Value')), - $r->tag('th', $r->maketext('Class value')) + $c->c( + $c->tag('td', colspan => '3', ''), + $c->tag('th', $c->maketext('User Value')), + $c->tag('th', $c->maketext('Class value')) )->join('') ) ); @@ -637,8 +631,8 @@ sub fieldTable { next if ($field eq 'prPeriod' && !$ce->{pg}{options}{enablePeriodicRandomization}); unless ($properties{type} eq 'hidden') { - my @row = $self->fieldHTML($userID, $setID, $problemID, $globalRecord, $userRecord, $field); - push(@$rows, $r->tag('tr', $r->c(map { $r->tag('td', $_) } @row)->join(''))) if @row > 1; + my @row = $c->fieldHTML($userID, $setID, $problemID, $globalRecord, $userRecord, $field); + push(@$rows, $c->tag('tr', $c->c(map { $c->tag('td', $_) } @row)->join(''))) if @row > 1; } # Finally, put in extra fields that are exceptions to the usual display mechanism. @@ -651,7 +645,7 @@ sub fieldTable { my $problemRecord = $userRecord; push( @$rows, - $r->include( + $c->include( 'ContentGenerator/Instructor/ProblemSetDetail/attempts_row', problemID => $problemID, problemRecord => $problemRecord @@ -659,7 +653,7 @@ sub fieldTable { ); } - return $r->tag( + return $c->tag( 'table', class => 'table table-sm table-borderless align-middle font-sm w-auto mb-0', $rows->join('') @@ -669,24 +663,21 @@ sub fieldTable { # Returns a list of information and HTML widgets for viewing and editing the specified db fields. # If only the setID is included, it creates a list of set information. # If the problemID is included, it creates a list of problem information. -sub fieldHTML { - my ($self, $userID, $setID, $problemID, $globalRecord, $userRecord, $field) = @_; - - my $r = $self->r; - my $db = $r->db; - my @editForUser = $r->param('editForUser'); +sub fieldHTML ($c, $userID, $setID, $problemID, $globalRecord, $userRecord, $field) { + my $db = $c->db; + my @editForUser = $c->param('editForUser'); my $forUsers = @editForUser; my $forOneUser = $forUsers == 1; - return $r->maketext('No data exists for set [_1] and problem [_2]', $setID, $problemID) unless $globalRecord; - return $r->maketext('No user specific data exists for user [_1]', $userID) + return $c->maketext('No data exists for set [_1] and problem [_2]', $setID, $problemID) unless $globalRecord; + return $c->maketext('No user specific data exists for user [_1]', $userID) if $forOneUser && $globalRecord && !$userRecord; my %properties = %{ FIELD_PROPERTIES()->{$field} }; my %labels = %{ $properties{labels} }; for my $key (keys %labels) { - $labels{$key} = $r->maketext($labels{$key}); + $labels{$key} = $c->maketext($labels{$key}); } return '' if $properties{type} eq 'hidden'; @@ -726,7 +717,7 @@ sub fieldHTML { $userValue = defined $userValue ? ($labels{$userValue} || $userValue) : $blankfield; if ($field =~ /_date/) { - $globalValue = $self->formatDateTime($globalValue, '', 'datetime_format_short', $r->ce->{language}) + $globalValue = $c->formatDateTime($globalValue, '', 'datetime_format_short', $c->ce->{language}) if $forUsers && defined $globalValue && $globalValue ne ''; } @@ -756,34 +747,34 @@ sub fieldHTML { if ($edit) { if ($field =~ /_date/) { - $inputType = $r->tag( + $inputType = $c->tag( 'div', class => 'input-group input-group-sm flatpickr', - $r->c( - $r->text_field( + $c->c( + $c->text_field( "$recordType.$recordID.$field", $forUsers ? $userValue : $globalValue, id => "$recordType.$recordID.${field}_id", class => 'form-control form-control-sm' . ($field eq 'open_date' ? ' datepicker-group' : ''), - placeholder => $r->maketext('None Specified'), + placeholder => $c->maketext('None Specified'), data => { input => undef, - done_text => $r->maketext('Done'), - locale => $r->ce->{language}, - timezone => $r->ce->{siteDefaults}{timezone}, + done_text => $c->maketext('Done'), + locale => $c->ce->{language}, + timezone => $c->ce->{siteDefaults}{timezone}, override => "$recordType.$recordID.$field.override_id" }, $forUsers && $check ? ('aria-labelledby' => "$recordType.$recordID.$field.label") : (), ), - $r->tag( + $c->tag( 'a', class => 'btn btn-secondary btn-sm', data => { toggle => undef }, role => 'button', tabindex => 0, - 'aria-label' => $r->maketext('Pick date and time'), - $r->tag('i', class => 'fas fa-calendar-alt', 'aria-hidden' => 'true', '') + 'aria-label' => $c->maketext('Pick date and time'), + $c->tag('i', class => 'fas fa-calendar-alt', 'aria-hidden' => 'true', '') ) )->join('') ); @@ -791,7 +782,7 @@ sub fieldHTML { my $value = $forUsers ? $userValue : $globalValue; $value = format_set_name_display($value =~ s/\s*,\s*/,/gr) if $field eq 'restricted_release'; - $inputType = $r->text_field( + $inputType = $c->text_field( "$recordType.$recordID.$field", $value, id => "$recordType.$recordID.${field}_id", data => { override => "$recordType.$recordID.$field.override_id" }, @@ -814,7 +805,7 @@ sub fieldHTML { $value = ($forUsers && $userRecord->$field ne '' ? $userRecord->$field : $globalRecord->$field); } - $inputType = $r->select_field( + $inputType = $c->select_field( "$recordType.$recordID.$field", [ map { [ $labels{$_} => $_, $_ eq $value ? (selected => undef) : () ] } @{ $properties{choices} } ], @@ -827,7 +818,7 @@ sub fieldHTML { my $gDisplVal = (defined $properties{labels} && defined $properties{labels}{$globalValue}) - ? $r->maketext($properties{labels}{$globalValue}) + ? $c->maketext($properties{labels}{$globalValue}) : $globalValue; $gDisplVal = format_set_name_display($gDisplVal) if $field eq 'restricted_release'; @@ -836,7 +827,7 @@ sub fieldHTML { push @return, ( $check - ? $r->check_box( + ? $c->check_box( "$recordType.$recordID.$field.override", $field, id => "$recordType.$recordID.$field.override_id", class => 'form-check-input', @@ -846,9 +837,9 @@ sub fieldHTML { ) if $forUsers; push @return, - $r->label_for( + $c->label_for( ($forUsers && $check ? "$recordType.$recordID.$field.override_id" : "$recordType.$recordID.${field}_id"), - $r->maketext($properties{name}), + $c->maketext($properties{name}), $forUsers && $check ? (class => 'form-check-label mb-0', id => "$recordType.$recordID.$field.label") : (class => 'form-label mb-0'), @@ -856,20 +847,20 @@ sub fieldHTML { push @return, $properties{help_text} - ? $r->tag( + ? $c->tag( 'a', class => 'help-popup', role => 'button', tabindex => 0, data => { - bs_content => $r->maketext($properties{help_text}), + bs_content => $c->maketext($properties{help_text}), bs_placement => 'top', bs_toggle => 'popover' }, - $r->tag( + $c->tag( 'i', class => 'icon fas fa-question-circle', - data => { alt => $r->maketext('Help Icon') }, + data => { alt => $c->maketext('Help Icon') }, 'aria-hidden' => 'true' ) ) @@ -880,7 +871,7 @@ sub fieldHTML { push @return, ( $gDisplVal ne '' - ? $r->text_field( + ? $c->text_field( "$recordType.$recordID.$field.class_value", $gDisplVal, readonly => undef, @@ -896,10 +887,8 @@ sub fieldHTML { } # Return weird fields that are non-native or which are displayed for only some sets. -sub extraSetFields { - my ($self, $userID, $setID, $globalRecord, $userRecord, $forUsers) = @_; - my $db = $self->r->{db}; - my $r = $self->r; +sub extraSetFields ($c, $userID, $setID, $globalRecord, $userRecord, $forUsers) { + my $db = $c->{db}; my $extraFields = ''; @@ -914,18 +903,16 @@ sub extraSetFields { if (($gwfield eq "time_interval" || $gwfield eq "versions_per_interval") && ($forUsers && $userRecord->can('version_id'))); - my @fieldData = $self->fieldHTML($userID, $setID, undef, $globalRecord, $userRecord, $gwfield); + my @fieldData = $c->fieldHTML($userID, $setID, undef, $globalRecord, $userRecord, $gwfield); if (@fieldData && defined($fieldData[0]) && $fieldData[0] ne '') { $num_columns = @fieldData if @fieldData > $num_columns; - push(@gwFields, $r->tag('tr', $r->c(map { $r->tag('td', $_) } @fieldData)->join(''))); + push(@gwFields, $c->tag('tr', $c->c(map { $c->tag('td', $_) } @fieldData)->join(''))); } } - $extraFields = $r->c( + $extraFields = $c->c( $num_columns - ? $r->tag( - 'tr', $r->tag('td', colspan => $num_columns, $r->tag('em', $r->maketext('Test parameters'))) - ) + ? $c->tag('tr', $c->tag('td', colspan => $num_columns, $c->tag('em', $c->maketext('Test parameters')))) : '', @gwFields )->join(''); @@ -935,16 +922,16 @@ sub extraSetFields { my $jthdr = ''; my @jtFields; for my $jtfield (@{ JITAR_SET_FIELD_ORDER() }) { - my @fieldData = $self->fieldHTML($userID, $setID, undef, $globalRecord, $userRecord, $jtfield); + my @fieldData = $c->fieldHTML($userID, $setID, undef, $globalRecord, $userRecord, $jtfield); if (@fieldData && defined($fieldData[0]) && $fieldData[0] ne '') { $num_columns = @fieldData if (@fieldData > $num_columns); - push(@jtFields, $r->tag('tr', $r->c(map { $r->tag('td', $_) } @fieldData)->join(''))); + push(@jtFields, $c->tag('tr', $c->c(map { $c->tag('td', $_) } @fieldData)->join(''))); } } - $extraFields = $r->c( + $extraFields = $c->c( $num_columns - ? $r->tag('tr', - $r->tag('td', colspan => $num_columns, $r->tag('em', $r->maketext('Just-In-Time parameters')))) + ? $c->tag('tr', + $c->tag('td', colspan => $num_columns, $c->tag('em', $c->maketext('Just-In-Time parameters')))) : '', @jtFields )->join(''); @@ -955,16 +942,16 @@ sub extraSetFields { # If this is a proctored test, then add a dropdown menu to configure using a grade proctor # and a proctored set password input. if ($globalRecord->assignment_type eq 'proctored_gateway') { - $procFields = $r->c( + $procFields = $c->c( # Dropdown menu to configure using a grade proctor. - $r->tag( + $c->tag( 'tr', - $r->c( - map { $r->tag('td', $_) } - $self->fieldHTML($userID, $setID, undef, $globalRecord, $userRecord, 'use_grade_auth_proctor') + $c->c( + map { $c->tag('td', $_) } + $c->fieldHTML($userID, $setID, undef, $globalRecord, $userRecord, 'use_grade_auth_proctor') )->join('') ), - $forUsers ? '' : $r->include( + $forUsers ? '' : $c->include( 'ContentGenerator/Instructor/ProblemSetDetail/restricted_login_proctor_password_row', globalRecord => $globalRecord ) @@ -995,7 +982,7 @@ sub extraSetFields { $ipOverride = 1; } - $ipFields = $r->include( + $ipFields = $c->include( 'ContentGenerator/Instructor/ProblemSetDetail/ip_locations_row', forUsers => $forUsers, ipOverride => $ipOverride, @@ -1009,11 +996,8 @@ sub extraSetFields { # This is a recursive function which displays the tree structure of jitar sets. # Each child is displayed as a nested ordered list. -sub print_nested_list { - my ($self, $nestedHash) = @_; - my $r = $self->r; - - my $output = $r->c; +sub print_nested_list ($c, $nestedHash) { + my $output = $c->c; # This hash contains information about the problem at this node. Output the problem row and delete the "id" and # "row" keys. Any remaining keys are references to child nodes which are shown in a sub list via the recursion. @@ -1023,22 +1007,22 @@ sub print_nested_list { my $id = delete $nestedHash->{id}; push( @$output, - $r->tag( + $c->tag( 'li', class => 'psd_list_item', id => "psd_list_item_$id", - $r->c( + $c->c( delete $nestedHash->{row}, - $r->tag( + $c->tag( 'ol', class => 'sortable-branch collapse', id => "psd_sublist_$id", sub { - my $sub_output = $r->c; + my $sub_output = $c->c; my @keys = keys %$nestedHash; if (@keys) { for (sort { $a <=> $b } @keys) { - push(@$sub_output, $self->print_nested_list($nestedHash->{$_})); + push(@$sub_output, $c->print_nested_list($nestedHash->{$_})); } } return $sub_output->join(''); @@ -1053,10 +1037,7 @@ sub print_nested_list { } # Handles rearrangement necessary after changes to problem ordering. -sub handle_problem_numbers { - my ($self, $newProblemNumbers, $db, $setID) = @_; - my $r = $self->r; - +sub handle_problem_numbers ($c, $newProblemNumbers, $db, $setID) { # Check to see that everything has a number and if anything was renumbered. my $force = 0; for my $j (keys %$newProblemNumbers) { @@ -1080,10 +1061,10 @@ sub handle_problem_numbers { next if $newProblemNumbers->{$j} == $j; $problemHash{$j} = $db->getGlobalProblem($setID, $j); - die $r->maketext("global [_1] for set [_2] not found.", $j, $setID) unless $problemHash{$j}; + die $c->maketext("global [_1] for set [_2] not found.", $j, $setID) unless $problemHash{$j}; foreach my $user (@setUsers) { $userProblemHash{$user}{$j} = $db->getUserProblem($user, $setID, $j); - warn $r->maketext( + warn $c->maketext( "UserProblem missing for user=[_1] set=[_2] problem=[_3]. This may indicate database corruption.", $user, $setID, $j) . "\n" @@ -1135,25 +1116,23 @@ sub handle_problem_numbers { # Primarily saves any changes into the correct set or problem records (global vs user). # Also deals with deleting or rearranging problems. -sub initialize { - my ($self) = @_; - my $r = $self->r; - my $db = $r->db; - my $ce = $r->ce; - my $authz = $r->authz; - my $user = $r->param('user'); - my $setID = $r->urlpath->arg('setID'); +sub initialize ($c) { + my $db = $c->db; + my $ce = $c->ce; + my $authz = $c->authz; + my $user = $c->param('user'); + my $setID = $c->stash('setID'); # Make sure these are defined for the templates. - $r->stash->{fullSetID} = $setID; - $r->stash->{headers} = HEADER_ORDER(); - $r->stash->{field_properties} = FIELD_PROPERTIES(); - $r->stash->{display_modes} = WeBWorK::PG::DISPLAY_MODES(); - $r->stash->{unassignedUsers} = []; - $r->stash->{problemIDList} = []; - $r->stash->{globalProblems} = {}; - $r->stash->{userProblems} = {}; - $r->stash->{mergedProblems} = {}; + $c->stash->{fullSetID} = $setID; + $c->stash->{headers} = HEADER_ORDER(); + $c->stash->{field_properties} = FIELD_PROPERTIES(); + $c->stash->{display_modes} = WeBWorK::PG::DISPLAY_MODES(); + $c->stash->{unassignedUsers} = []; + $c->stash->{problemIDList} = []; + $c->stash->{globalProblems} = {}; + $c->stash->{userProblems} = {}; + $c->stash->{mergedProblems} = {}; # A set may be provided with a version number (as in setID,v#). # If so obtain the template set id and version number. @@ -1163,22 +1142,22 @@ sub initialize { $setID =~ s/,v(\d+)$//; } - $r->stash->{setID} = $setID; - $r->stash->{editingSetVersion} = $editingSetVersion; + $c->stash->{setID} = $setID; + $c->stash->{editingSetVersion} = $editingSetVersion; my $setRecord = $db->getGlobalSet($setID); - $r->stash->{setRecord} = $setRecord; + $c->stash->{setRecord} = $setRecord; return unless $setRecord; return unless ($authz->hasPermissions($user, 'access_instructor_tools')); return unless ($authz->hasPermissions($user, 'modify_problem_sets')); - my @editForUser = $r->param('editForUser'); + my @editForUser = $c->param('editForUser'); my $forUsers = scalar(@editForUser); - $r->stash->{forUsers} = $forUsers; + $c->stash->{forUsers} = $forUsers; my $forOneUser = $forUsers == 1; - $r->stash->{forOneUser} = $forOneUser; + $c->stash->{forOneUser} = $forOneUser; # If editing a versioned set, it only makes sense edit it for one user. return if ($editingSetVersion && !$forOneUser); @@ -1189,17 +1168,17 @@ sub initialize { my %undoLabels; for my $key (keys %properties) { %{ $undoLabels{$key} } = - map { $r->maketext($properties{$key}{labels}{$_}) => $_ } keys %{ $properties{$key}{labels} }; + map { $c->maketext($properties{$key}{labels}{$_}) => $_ } keys %{ $properties{$key}{labels} }; } my ($open_date, $due_date, $answer_date, $reduced_scoring_date); my $error = 0; - if (defined $r->param('submit_changes')) { + if (defined $c->param('submit_changes')) { my @names = ("open_date", "due_date", "answer_date", "reduced_scoring_date"); my %dates; for (@names) { - $dates{$_} = $r->param("set.$setID.$_") || ''; + $dates{$_} = $c->param("set.$setID.$_") || ''; if (defined $undoLabels{$_}{ $dates{$_} } || !$dates{$_}) { $dates{$_} = $setRecord->$_; } @@ -1210,20 +1189,19 @@ sub initialize { ($open_date, $due_date, $answer_date, $reduced_scoring_date) = map { $dates{$_} || 0 } @names; if ($answer_date < $due_date || $answer_date < $open_date) { - $self->addbadmessage( - $r->maketext("Answers cannot be made available until on or after the close date!")); - $error = $r->param('submit_changes'); + $c->addbadmessage($c->maketext("Answers cannot be made available until on or after the close date!")); + $error = $c->param('submit_changes'); } if ($due_date < $open_date) { - $self->addbadmessage($r->maketext("Answers cannot be due until on or after the open date!")); - $error = $r->param('submit_changes'); + $c->addbadmessage($c->maketext("Answers cannot be due until on or after the open date!")); + $error = $c->param('submit_changes'); } my $enable_reduced_scoring = $ce->{pg}{ansEvalDefaults}{enableReducedScoring} && ( - defined($r->param("set.$setID.enable_reduced_scoring")) - ? $r->param("set.$setID.enable_reduced_scoring") + defined($c->param("set.$setID.enable_reduced_scoring")) + ? $c->param("set.$setID.enable_reduced_scoring") : $setRecord->enable_reduced_scoring); if ( @@ -1233,9 +1211,9 @@ sub initialize { || $reduced_scoring_date < $open_date) ) { - $self->addbadmessage( - $r->maketext("The reduced scoring date should be between the open date and close date.")); - $error = $r->param('submit_changes'); + $c->addbadmessage( + $c->maketext("The reduced scoring date should be between the open date and close date.")); + $error = $c->param('submit_changes'); } # Make sure the dates are not more than 10 years in the future. @@ -1243,28 +1221,28 @@ sub initialize { my $seconds_per_year = 31_556_926; my $cutoff = $curr_time + $seconds_per_year * 10; if ($open_date > $cutoff) { - $self->addbadmessage( - $r->maketext("Error: open date cannot be more than 10 years from now in set [_1]", $setID)); - $error = $r->param('submit_changes'); + $c->addbadmessage( + $c->maketext("Error: open date cannot be more than 10 years from now in set [_1]", $setID)); + $error = $c->param('submit_changes'); } if ($due_date > $cutoff) { - $self->addbadmessage( - $r->maketext("Error: close date cannot be more than 10 years from now in set [_1]", $setID)); - $error = $r->param('submit_changes'); + $c->addbadmessage( + $c->maketext("Error: close date cannot be more than 10 years from now in set [_1]", $setID)); + $error = $c->param('submit_changes'); } if ($answer_date > $cutoff) { - $self->addbadmessage( - $r->maketext("Error: answer date cannot be more than 10 years from now in set [_1]", $setID)); - $error = $r->param('submit_changes'); + $c->addbadmessage( + $c->maketext("Error: answer date cannot be more than 10 years from now in set [_1]", $setID)); + $error = $c->param('submit_changes'); } } } if ($error) { - $self->addbadmessage($r->maketext("No changes were saved!")); + $c->addbadmessage($c->maketext("No changes were saved!")); } - if (defined $r->param('submit_changes') && !$error) { + if (defined $c->param('submit_changes') && !$error) { my $oldAssignmentType = $setRecord->assignment_type(); @@ -1287,11 +1265,11 @@ sub initialize { foreach my $record (@userRecords) { foreach my $field (@{ SET_FIELDS() }) { next unless canChange($forUsers, $field); - my $override = $r->param("set.$setID.$field.override"); + my $override = $c->param("set.$setID.$field.override"); if (defined $override && $override eq $field) { - my $param = $r->param("set.$setID.$field"); + my $param = $c->param("set.$setID.$field"); $param = defined $properties{$field}->{default} ? $properties{$field}->{default} : "" unless defined $param && $param ne ""; @@ -1338,10 +1316,10 @@ sub initialize { # database routines to deal with the versioned setID, or fudging it at this end by manually putting in the # versioned ID setID,v#. Neither of these seems desirable, so for now it's not allowed if (!$editingSetVersion) { - if ($r->param("set.$setID.selected_ip_locations.override")) { + if ($c->param("set.$setID.selected_ip_locations.override")) { foreach my $record (@userRecords) { my $userID = $record->user_id; - my @selectedLocations = $r->param("set.$setID.selected_ip_locations"); + my @selectedLocations = $c->param("set.$setID.selected_ip_locations"); my @userSetLocations = $db->listUserSetLocations($userID, $setID); my @addSetLocations = (); my @delSetLocations = (); @@ -1378,14 +1356,14 @@ sub initialize { foreach my $field (@{ SET_FIELDS() }) { next unless canChange($forUsers, $field); - my $param = $r->param("set.$setID.$field"); + my $param = $c->param("set.$setID.$field"); $param = defined $properties{$field}->{default} ? $properties{$field}->{default} : "" unless defined $param && $param ne ""; my $unlabel = $undoLabels{$field}->{$param}; $param = $unlabel if defined $unlabel; if ($field =~ /restricted_release/ && $param) { $param = format_set_name_internal($param =~ s/\s*,\s*/,/gr); - $self->check_sets($db, $param); + $c->check_sets($db, $param); } if (defined($properties{$field}->{convertby}) && $properties{$field}->{convertby} && $param) { $param = $param * $properties{$field}->{convertby}; @@ -1405,8 +1383,8 @@ sub initialize { $db->putGlobalSet($setRecord); # Save IP restriction Location information - if (defined($r->param("set.$setID.restrict_ip")) and $r->param("set.$setID.restrict_ip") ne 'No') { - my @selectedLocations = $r->param("set.$setID.selected_ip_locations"); + if (defined($c->param("set.$setID.restrict_ip")) && $c->param("set.$setID.restrict_ip") ne 'No') { + my @selectedLocations = $c->param("set.$setID.selected_ip_locations"); my @globalSetLocations = $db->listGlobalSetLocations($setID); my @addSetLocations = (); my @delSetLocations = (); @@ -1434,12 +1412,12 @@ sub initialize { } # Save proctored problem proctor user information - if ($r->param("set.$setID.restricted_login_proctor_password") + if ($c->param("set.$setID.restricted_login_proctor_password") && $setRecord->assignment_type eq 'proctored_gateway') { # In this case add a set-level proctor or update the password. my $procID = "set_id:$setID"; - my $pass = $r->param("set.$setID.restricted_login_proctor_password"); + my $pass = $c->param("set.$setID.restricted_login_proctor_password"); # Should we carefully check in this case that the user and password exist? The code in the add stanza # is pretty careful to be sure that there's a one-to-one correspondence between the existence of the # user and the setting of the set restricted_login_proctor field, so we assume that just checking the @@ -1448,7 +1426,7 @@ sub initialize { # A new password was submitted. So save it. my $dbPass = eval { $db->getPassword($procID) }; if ($@) { - $self->addbadmessage($r->maketext( + $c->addbadmessage($c->maketext( 'Error getting old set-proctor password from the database: [_1]. ' . 'No update to the password was done.', $@ @@ -1474,7 +1452,7 @@ sub initialize { eval { $db->addUser($procUser) }; if ($@) { - $self->addbadmessage($r->maketext("Error adding set-level proctor: [_1]", $@)); + $c->addbadmessage($c->maketext("Error adding set-level proctor: [_1]", $@)); } else { $db->addPermissionLevel($procPerm); $db->addPassword($procPass); @@ -1503,7 +1481,7 @@ sub initialize { my @problemRecords = $db->getGlobalProblems(map { [ $setID, $_ ] } @problemIDs); foreach my $problemRecord (@problemRecords) { my $problemID = $problemRecord->problem_id; - die $r->maketext("Global problem [_1] for set [_2] not found.", $problemID, $setID) unless $problemRecord; + die $c->maketext("Global problem [_1] for set [_2] not found.", $problemID, $setID) unless $problemRecord; if ($forUsers) { # Since we're editing for specific users, we don't allow the GlobalProblem record to be altered on that @@ -1529,10 +1507,10 @@ sub initialize { for my $field (@{ PROBLEM_FIELDS() }) { next unless canChange($forUsers, $field); - my $override = $r->param("problem.$problemID.$field.override"); + my $override = $c->param("problem.$problemID.$field.override"); if (defined $override && $override eq $field) { - my $param = $r->param("problem.$problemID.$field"); + my $param = $c->param("problem.$problemID.$field"); $param = defined $properties{$field}->{default} ? $properties{$field}->{default} : "" unless defined $param && $param ne ""; my $unlabel = $undoLabels{$field}->{$param}; @@ -1540,7 +1518,7 @@ sub initialize { # Protect exploits with source_file if ($field eq 'source_file') { if ($param =~ /\.\./ || $param =~ /^\//) { - $self->addbadmessage($r->maketext( + $c->addbadmessage($c->maketext( 'Source file paths cannot include .. or start with /: ' . 'your source file path was modified.' )); @@ -1560,7 +1538,7 @@ sub initialize { for my $field (@{ USER_PROBLEM_FIELDS() }) { next unless canChange($forUsers, $field); - my $param = $r->param("problem.$problemID.$field"); + my $param = $c->param("problem.$problemID.$field"); $param = defined $properties{$field}->{default} ? $properties{$field}->{default} : "" unless defined $param && $param ne ""; my $unlabel = $undoLabels{$field}->{$param}; @@ -1568,7 +1546,7 @@ sub initialize { # Protect exploits with source_file if ($field eq 'source_file') { if ($param =~ /\.\./ || $param =~ /^\//) { - $self->addbadmessage($r->maketext( + $c->addbadmessage($c->maketext( 'Source file paths cannot include .. or start with /: ' . 'your source file path was modified.' )); @@ -1597,7 +1575,7 @@ sub initialize { foreach my $field (@{ PROBLEM_FIELDS() }) { next unless canChange($forUsers, $field); - my $param = $r->param("problem.$problemID.$field"); + my $param = $c->param("problem.$problemID.$field"); $param = defined $properties{$field}->{default} ? $properties{$field}->{default} : "" unless defined $param && $param ne ""; my $unlabel = $undoLabels{$field}->{$param}; @@ -1606,7 +1584,7 @@ sub initialize { # Protect exploits with source_file if ($field eq 'source_file') { if ($param =~ /\.\./ || $param =~ /^\//) { - $self->addbadmessage($r->maketext( + $c->addbadmessage($c->maketext( 'Source file paths cannot include .. or start with /: ' . 'your source file path was modified.' )); @@ -1626,7 +1604,7 @@ sub initialize { # Changes" on the global page MUCH faster. my %useful; foreach my $field (@{ USER_PROBLEM_FIELDS() }) { - my $param = $r->param("problem.$problemID.$field"); + my $param = $c->param("problem.$problemID.$field"); $useful{$field} = 1 if defined $param and $param ne ""; } @@ -1637,7 +1615,7 @@ sub initialize { foreach my $field (keys %useful) { next unless canChange($forUsers, $field); - my $param = $r->param("problem.$problemID.$field"); + my $param = $c->param("problem.$problemID.$field"); $param = defined $properties{$field}->{default} ? $properties{$field}->{default} : "" unless defined $param && $param ne ""; my $unlabel = $undoLabels{$field}->{$param}; @@ -1653,7 +1631,7 @@ sub initialize { # Mark the specified problems as correct for all users (not applicable when editing a set version, because this # only shows up when editing for users or editing the global set/problem, not for one user) - for my $problemID ($r->param('markCorrect')) { + for my $problemID ($c->param('markCorrect')) { my @userProblemIDs = $forUsers ? (map { [ $_, $setID, $problemID ] } @editForUser) @@ -1690,7 +1668,7 @@ sub initialize { } # Delete all problems marked for deletion (not applicable when editing for users). - foreach my $problemID ($r->param('deleteProblem')) { + foreach my $problemID ($c->param('deleteProblem')) { $db->deleteGlobalProblem($setID, $problemID); # If it is a jitar, then delete all of the child problems. @@ -1731,10 +1709,10 @@ sub initialize { # we dont want to confuse the script by changing the problem # ids out from under it so remove the params foreach my $id (@ids) { - $r->param("prob_num_$id", undef); + $c->param("prob_num_$id", undef); } - handle_problem_numbers($self, \%newProblemNumbers, $db, $setID); + $c->handle_problem_numbers(\%newProblemNumbers, $db, $setID); } # Reorder problems @@ -1748,25 +1726,25 @@ sub initialize { my @idSeq; my $id = $jj; - next unless $r->param('prob_num_' . $id); + next unless $c->param('prob_num_' . $id); - unshift @idSeq, $r->param('prob_num_' . $id); - while (defined $r->param('prob_parent_id_' . $id)) { - $id = $r->param('prob_parent_id_' . $id); - unshift @idSeq, $r->param('prob_num_' . $id); + unshift @idSeq, $c->param('prob_num_' . $id); + while (defined $c->param('prob_parent_id_' . $id)) { + $id = $c->param('prob_parent_id_' . $id); + unshift @idSeq, $c->param('prob_num_' . $id); } $newProblemNumbers{$jj} = seq_to_jitar_id(@idSeq); } else { - $newProblemNumbers{$jj} = $r->param('prob_num_' . $jj); + $newProblemNumbers{$jj} = $c->param('prob_num_' . $jj); } } - handle_problem_numbers($self, \%newProblemNumbers, $db, $setID) unless defined $r->param('undo_changes'); + $c->handle_problem_numbers(\%newProblemNumbers, $db, $setID) unless defined $c->param('undo_changes'); # Make problem numbers consecutive if required - if ($r->param('force_renumber')) { + if ($c->param('force_renumber')) { my %newProblemNumbers = (); my $prevNum = 0; my @prevSeq = (0); @@ -1776,12 +1754,12 @@ sub initialize { my @idSeq; my $id = $jj; - next unless $r->param('prob_num_' . $id); + next unless $c->param('prob_num_' . $id); - unshift @idSeq, $r->param('prob_num_' . $id); - while (defined $r->param('prob_parent_id_' . $id)) { - $id = $r->param('prob_parent_id_' . $id); - unshift @idSeq, $r->param('prob_num_' . $id); + unshift @idSeq, $c->param('prob_num_' . $id); + while (defined $c->param('prob_parent_id_' . $id)) { + $id = $c->param('prob_parent_id_' . $id); + unshift @idSeq, $c->param('prob_num_' . $id); } # we dont really care about the content of idSeq @@ -1803,16 +1781,16 @@ sub initialize { } } - handle_problem_numbers($self, \%newProblemNumbers, $db, $setID) unless defined $r->param('undo_changes'); + $c->handle_problem_numbers(\%newProblemNumbers, $db, $setID) unless defined $c->param('undo_changes'); } # Add blank problem if needed - if (defined($r->param("add_blank_problem")) and $r->param("add_blank_problem") == 1) { + if (defined($c->param("add_blank_problem")) and $c->param("add_blank_problem") == 1) { # Get number of problems to add and clean the entry - my $newBlankProblems = (defined($r->param("add_n_problems"))) ? $r->param("add_n_problems") : 1; + my $newBlankProblems = (defined($c->param("add_n_problems"))) ? $c->param("add_n_problems") : 1; $newBlankProblems = int($newBlankProblems); my $MAX_NEW_PROBLEMS = 20; - my @ids = $self->r->db->listGlobalProblems($setID); + my @ids = $c->db->listGlobalProblems($setID); if ($setRecord->assignment_type eq 'jitar') { for (my $i = 0; $i <= $#ids; $i++) { @@ -1833,7 +1811,7 @@ sub initialize { my $new_file_path = "set$setID/" . BLANKPROBLEM(); my $fullPath = WeBWorK::Utils::surePathToFile($ce->{courseDirs}{templates}, '/' . $new_file_path); - open(my $TEMPFILE, '>', $fullPath) or warn $r->maketext(q{Can't write to file [_1]}, $fullPath); + open(my $TEMPFILE, '>', $fullPath) or warn $c->maketext(q{Can't write to file [_1]}, $fullPath); print $TEMPFILE $problemContents; close($TEMPFILE); @@ -1848,13 +1826,13 @@ sub initialize { ); assignProblemToAllSetUsers($db, $problemRecord); - $self->addgoodmessage($r->maketext( + $c->addgoodmessage($c->maketext( "Added [_1] to [_2] as problem [_3]", $new_file_path, $setID, $targetProblemNumber )); } } else { - $self->addbadmessage($r->maketext( + $c->addbadmessage($c->maketext( "Could not add [_1] problems to this set. The number must be between 1 and [_2]", $newBlankProblems, $MAX_NEW_PROBLEMS )); @@ -1862,7 +1840,7 @@ sub initialize { } # Sets the specified header to "defaultHeader" so that the default file will get used. - foreach my $header ($r->param('defaultHeader')) { + foreach my $header ($c->param('defaultHeader')) { $setRecord->$header("defaultHeader"); } } @@ -1879,32 +1857,32 @@ sub initialize { } } @editForUser = sort @assignedUsers; - $r->param('editForUser', \@editForUser); + $c->param('editForUser', \@editForUser); } - $r->stash->{unassignedUsers} = \@unassignedUsers; + $c->stash->{unassignedUsers} = \@unassignedUsers; # Check that if a set version for a user is being edited, that it exists as well return if $editingSetVersion && !$db->existsSetVersion($editForUser[0], $setID, $editingSetVersion); # Get global problem records for all problems sorted by problem id. my @globalProblems = $db->getGlobalProblemsWhere({ set_id => $setID }, 'problem_id'); - $r->stash->{problemIDList} = [ map { $_->problem_id } @globalProblems ]; - $r->stash->{globalProblems} = { map { $_->problem_id => $_ } @globalProblems }; + $c->stash->{problemIDList} = [ map { $_->problem_id } @globalProblems ]; + $c->stash->{globalProblems} = { map { $_->problem_id => $_ } @globalProblems }; # If editing for one user, get user problem records for all problems also sorted by problem_id. if (@editForUser == 1) { - $r->stash->{userProblems} = { map { $_->problem_id => $_ } + $c->stash->{userProblems} = { map { $_->problem_id => $_ } $db->getUserProblemsWhere({ user_id => $editForUser[0], set_id => $setID }, 'problem_id') }; if ($editingSetVersion) { - $r->stash->{mergedProblems} = { + $c->stash->{mergedProblems} = { map { $_->problem_id => $_ } $db->getMergedProblemVersionsWhere( { user_id => $editForUser[0], set_id => { like => "$setID,v\%" } }, 'problem_id' ) }; } else { - $r->stash->{mergedProblems} = { map { $_->problem_id => $_ } + $c->stash->{mergedProblems} = { map { $_->problem_id => $_ } $db->getMergedProblemsWhere({ user_id => $editForUser[0], set_id => $setID }, 'problem_id') }; } } @@ -1912,24 +1890,22 @@ sub initialize { # Reset all the parameters dealing with set/problem/header information. It may not be obvious why this is necessary # when saving changes, but when the problems are reordered the param problem.1.source_file needs to be the source # file of the problem that is NOW #1 and not the problem that WAS #1. - for my $param ($r->param) { - $r->param($param, undef) if $param =~ /^(set|problem|header)\./ && $param !~ /displaymode/; + for my $param ($c->param) { + $c->param($param, undef) if $param =~ /^(set|problem|header)\./ && $param !~ /displaymode/; } # Reset checkboxes that should always be unchecked when the page loads. - $r->param('deleteProblem', undef); - $r->param('markCorrect', undef); - $r->param('force_renumber', undef); - $r->param('add_blank_problem', undef); + $c->param('deleteProblem', undef); + $c->param('markCorrect', undef); + $c->param('force_renumber', undef); + $c->param('add_blank_problem', undef); return; } # Helper method for checking if two values are different. # The return values will usually be thrown away, but they could be useful for debugging. -sub changed { - my ($first, $second) = @_; - +sub changed ($first, $second) { return "def/undef" if defined $first && !defined $second; return "undef/def" if !defined $first && defined $second; return "" if !defined $first && !defined $second; @@ -1942,9 +1918,7 @@ sub changed { # any means it can be changed for anyone # one means it can ONLY be changed for one at a time. (eg problem_seed) # all means it can ONLY be changed for all at a time. (eg set_header) -sub canChange { - my ($forUsers, $field) = @_; - +sub canChange ($forUsers, $field) { my %properties = %{ FIELD_PROPERTIES() }; my $forOneUser = $forUsers == 1; @@ -1957,14 +1931,11 @@ sub canChange { } # Helper method that determines if a file is valid and returns a pretty error message. -sub checkFile { - my ($self, $filePath, $headerType) = @_; - - my $r = $self->r; - my $ce = $r->ce; +sub checkFile ($c, $filePath, $headerType) { + my $ce = $c->ce; - return $r->maketext("No source filePath specified") unless $filePath; - return $r->maketext("Problem source is drawn from a grouping set") if $filePath =~ /^group/; + return $c->maketext("No source filePath specified") unless $filePath; + return $c->maketext("Problem source is drawn from a grouping set") if $filePath =~ /^group/; if ($filePath eq "defaultHeader") { if ($headerType eq 'set_header') { @@ -1972,7 +1943,7 @@ sub checkFile { } elsif ($headerType eq 'hardcopy_header') { $filePath = $ce->{webworkFiles}{hardcopySnippets}{setHeader}; } else { - return $r->maketext("Invalid headerType [_1]", $headerType); + return $c->maketext("Invalid headerType [_1]", $headerType); } } else { # Only filePaths in the template directory can be accessed. @@ -1981,55 +1952,48 @@ sub checkFile { my $fileError; return "" if -e $filePath && -f $filePath && -r $filePath; - return $r->maketext("This source file is not readable!") if -e $filePath && -f $filePath; - return $r->maketext("This source file is a directory!") if -d $filePath; - return $r->maketext("This source file does not exist!") unless -e $filePath; - return $r->maketext("This source file is not a plain file!"); + return $c->maketext("This source file is not readable!") if -e $filePath && -f $filePath; + return $c->maketext("This source file is a directory!") if -d $filePath; + return $c->maketext("This source file does not exist!") unless -e $filePath; + return $c->maketext("This source file is not a plain file!"); } # Make sure restrictor sets exist. -sub check_sets { - my ($self, $db, $sets_string) = @_; +sub check_sets ($c, $db, $sets_string) { my @proposed_sets = split(/\s*,\s*/, $sets_string); - foreach (@proposed_sets) { - $self->addbadmessage("Error: $_ is not a valid set name in restricted release list!") + for (@proposed_sets) { + $c->addbadmessage("Error: $_ is not a valid set name in restricted release list!") unless $db->existsGlobalSet($_); } return; } -sub userCountMessage { - my ($self, $count, $numUsers) = @_; - my $r = $self->r; - +sub userCountMessage ($c, $count, $numUsers) { if ($count == 0) { - return $r->tag('em', $r->maketext('no students')); + return $c->tag('em', $c->maketext('no students')); } elsif ($count == $numUsers) { - return $r->maketext('all students'); + return $c->maketext('all students'); } elsif ($count == 1) { - return $r->maketext('1 student'); + return $c->maketext('1 student'); } elsif ($count > $numUsers || $count < 0) { - return $r->tag('em', $r->maketext('an impossible number of users: [_1] out of [_2]', $count, $numUsers)); + return $c->tag('em', $c->maketext('an impossible number of users: [_1] out of [_2]', $count, $numUsers)); } else { - return $r->maketext('[_1] students out of [_2]', $count, $numUsers); + return $c->maketext('[_1] students out of [_2]', $count, $numUsers); } } -sub setCountMessage { - my ($self, $count, $numSets) = @_; - my $r = $self->r; - +sub setCountMessage ($c, $count, $numSets) { if ($count == 0) { - return $r->tag('em', $r->maketext('no sets')); + return $c->tag('em', $c->maketext('no sets')); } elsif ($count == $numSets) { - return $r->maketext('all sets'); + return $c->maketext('all sets'); } elsif ($count == 1) { - return $r->maketext('1 set'); + return $c->maketext('1 set'); } elsif ($count > $numSets || $count < 0) { - return $r->tag('em', $self->r->maketext('an impossible number of sets: [_1] out of [_2]', $count, $numSets)); + return $c->tag('em', $c->maketext('an impossible number of sets: [_1] out of [_2]', $count, $numSets)); } else { - return $r->maketext('[_1] sets', $count); + return $c->maketext('[_1] sets', $count); } } diff --git a/lib/WeBWorK/ContentGenerator/Instructor/ProblemSetList.pm b/lib/WeBWorK/ContentGenerator/Instructor/ProblemSetList.pm index 6049a5c06a..ec1662dbf1 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/ProblemSetList.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/ProblemSetList.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::Instructor::ProblemSetList; -use parent qw(WeBWorK::ContentGenerator); +use Mojo::Base 'WeBWorK::ContentGenerator', -signatures; =head1 NAME @@ -75,9 +75,6 @@ Delete sets: # FIXME: rather than having two types of boolean modes $editMode and $exportMode # make one $mode variable that contains a string like "edit", "view", or "export" -use strict; -use warnings; - use Mojo::File; use WeBWorK::Debug; @@ -141,135 +138,123 @@ use constant FIELD_TYPES => { enable_reduced_scoring => 'check' }; -async sub pre_header_initialize { - my ($self) = @_; - my $r = $self->r; - my $db = $r->db; - my $authz = $r->authz; - my $urlpath = $r->urlpath; - my $user = $r->param('user'); - my $courseName = $urlpath->arg("courseID"); +sub pre_header_initialize ($c) { + my $db = $c->db; + my $authz = $c->authz; + my $user = $c->param('user'); + my $courseName = $c->stash('courseID'); # Check permissions - return unless $authz->hasPermissions($user, "access_instructor_tools"); + return unless $authz->hasPermissions($user, 'access_instructor_tools'); # Get the list of global sets and the number of users and cache them for later use. - $self->{allSetIDs} = [ $db->listGlobalSets() ]; - $self->{totalUsers} = $db->countUsers; - - if (defined $r->param("action") and $r->param("action") eq "score" and $authz->hasPermissions($user, "score_sets")) - { - my $scope = $r->param("action.score.scope"); - my @setsToScore = (); - - if ($scope eq "none") { - return $r->maketext("No sets selected for scoring"); - } elsif ($scope eq "all") { - @setsToScore = @{ $self->{allSetIDs} }; - } elsif ($scope eq "visible") { - @setsToScore = @{ $r->param("visibleSetIDs") }; - } elsif ($scope eq "selected") { - @setsToScore = $r->param("selected_sets"); + $c->{allSetIDs} = [ $db->listGlobalSets ]; + $c->{totalUsers} = $db->countUsers; + + if (defined $c->param('action') && $c->param('action') eq 'score' && $authz->hasPermissions($user, 'score_sets')) { + my $scope = $c->param('action.score.scope'); + my @setsToScore; + + if ($scope eq 'none') { + return $c->maketext('No sets selected for scoring'); + } elsif ($scope eq 'all') { + @setsToScore = @{ $c->{allSetIDs} }; + } elsif ($scope eq 'visible') { + @setsToScore = @{ $c->param('visibleSetIDs') }; + } elsif ($scope eq 'selected') { + @setsToScore = $c->param('selected_sets'); } - my $uri = $self->systemLink( - $urlpath->newFromModule('WeBWorK::ContentGenerator::Instructor::Scoring', $r, courseID => $courseName), - params => { - scoreSelected => "ScoreSelected", - selectedSet => \@setsToScore, - } - ); - - $self->reply_with_redirect($uri); + $c->reply_with_redirect($c->systemLink( + $c->url_for('instructor_scoring'), + params => { scoreSelected => 'ScoreSelected', selectedSet => \@setsToScore } + )); } return; } -sub initialize { - my ($self) = @_; - my $r = $self->r; - my $urlpath = $r->urlpath; - my $db = $r->db; - my $ce = $r->ce; - my $authz = $r->authz; - my $courseName = $urlpath->arg("courseID"); - my $setID = $urlpath->arg("setID"); - my $user = $r->param('user'); +sub initialize ($c) { + my $db = $c->db; + my $ce = $c->ce; + my $authz = $c->authz; + my $courseName = $c->stash('courseID'); + my $setID = $c->stash('setID'); + my $user = $c->param('user'); # Make sure these are defined for the templats. - $r->stash->{fieldNames} = VIEW_FIELD_ORDER(); - $r->stash->{formsToShow} = VIEW_FORMS(); - $r->stash->{formTitles} = FORM_TITLES(); - $r->stash->{formPerms} = FORM_PERMS(); - $r->stash->{fieldTypes} = FIELD_TYPES(); - $r->stash->{sets} = []; + $c->stash->{fieldNames} = VIEW_FIELD_ORDER(); + $c->stash->{formsToShow} = VIEW_FORMS(); + $c->stash->{formTitles} = FORM_TITLES(); + $c->stash->{formPerms} = FORM_PERMS(); + $c->stash->{fieldTypes} = FIELD_TYPES(); + $c->stash->{sets} = []; # Determine if the user has permisson to do anything here. return unless $authz->hasPermissions($user, 'access_instructor_tools'); # Determine if edit mode or export mode is request, and check permissions for these modes. - $self->{editMode} = $r->param("editMode") || 0; - return if $self->{editMode} && !$authz->hasPermissions($user, 'modify_problem_sets'); + $c->{editMode} = $c->param("editMode") || 0; + return if $c->{editMode} && !$authz->hasPermissions($user, 'modify_problem_sets'); - $self->{exportMode} = $r->param("exportMode") || 0; - return if $self->{exportMode} && !$authz->hasPermissions($user, 'modify_set_def_files'); + $c->{exportMode} = $c->param("exportMode") || 0; + return if $c->{exportMode} && !$authz->hasPermissions($user, 'modify_set_def_files'); - if (defined $r->param("visible_sets")) { - $self->{visibleSetIDs} = [ $r->param("visible_sets") ]; - } elsif (defined $r->param("no_visible_sets")) { - $self->{visibleSetIDs} = []; + if (defined $c->param("visible_sets")) { + $c->{visibleSetIDs} = [ $c->param("visible_sets") ]; + } elsif (defined $c->param("no_visible_sets")) { + $c->{visibleSetIDs} = []; } else { - if (@{ $self->{allSetIDs} } > HIDE_SETS_THRESHOLD) { - $self->{visibleSetIDs} = []; + if (@{ $c->{allSetIDs} } > HIDE_SETS_THRESHOLD) { + $c->{visibleSetIDs} = []; } else { - $self->{visibleSetIDs} = $self->{allSetIDs}; + $c->{visibleSetIDs} = $c->{allSetIDs}; } } - $self->{prevVisibleSetIDs} = $self->{visibleSetIDs}; + $c->{prevVisibleSetIDs} = $c->{visibleSetIDs}; - if (defined $r->param("selected_sets")) { - $self->{selectedSetIDs} = [ $r->param("selected_sets") ]; + if (defined $c->param("selected_sets")) { + $c->{selectedSetIDs} = [ $c->param("selected_sets") ]; } else { - $self->{selectedSetIDs} = []; + $c->{selectedSetIDs} = []; } - $self->{primarySortField} = $r->param("primarySortField") || "due_date"; - $self->{secondarySortField} = $r->param("secondarySortField") || "open_date"; + $c->{primarySortField} = $c->param("primarySortField") || "due_date"; + $c->{secondarySortField} = $c->param("secondarySortField") || "open_date"; # Call action handler - my $actionID = $r->param("action"); - $self->{actionID} = $actionID; + my $actionID = $c->param("action"); + $c->{actionID} = $actionID; if ($actionID) { unless (grep { $_ eq $actionID } @{ VIEW_FORMS() }, @{ EDIT_FORMS() }, @{ EXPORT_FORMS() }) { - die $r->maketext("Action [_1] not found", $actionID); + die $c->maketext("Action [_1] not found", $actionID); } # Check permissions if (not FORM_PERMS()->{$actionID} or $authz->hasPermissions($user, FORM_PERMS()->{$actionID})) { my $actionHandler = "${actionID}_handler"; - $self->addmessage($r->tag('p', class => 'mb-1', $r->maketext("Results of last action performed") . ": ")); - $self->addmessage($self->$actionHandler); + $c->addmessage($c->tag('p', class => 'mb-1', $c->maketext("Results of last action performed") . ": ")); + $c->addmessage($c->$actionHandler); } else { - $self->addbadmessage($r->maketext('You are not authorized to perform this action.')); + $c->addbadmessage($c->maketext('You are not authorized to perform this action.')); } } else { - $self->addgoodmessage($r->maketext("Please select action to be performed.")); + $c->addgoodmessage($c->maketext("Please select action to be performed.")); } - $r->stash->{fieldNames} = - $self->{editMode} ? EDIT_FIELD_ORDER() : $self->{exportMode} ? EXPORT_FIELD_ORDER() : VIEW_FIELD_ORDER(); - if (!$r->ce->{pg}{ansEvalDefaults}{enableReducedScoring}) { - $r->stash->{fieldNames} = - [ grep { !/enable_reduced_scoring|reduced_scoring_date/ } @{ $r->stash->{fieldNames} } ]; + $c->stash->{fieldNames} = + $c->{editMode} ? EDIT_FIELD_ORDER() : $c->{exportMode} ? EXPORT_FIELD_ORDER() : VIEW_FIELD_ORDER(); + if (!$c->ce->{pg}{ansEvalDefaults}{enableReducedScoring}) { + $c->stash->{fieldNames} = + [ grep { !/enable_reduced_scoring|reduced_scoring_date/ } @{ $c->stash->{fieldNames} } ]; } - $r->stash->{formsToShow} = $self->{editMode} ? EDIT_FORMS() : $self->{exportMode} ? EXPORT_FORMS() : VIEW_FORMS(); + $c->stash->{formsToShow} = $c->{editMode} ? EDIT_FORMS() : $c->{exportMode} ? EXPORT_FORMS() : VIEW_FORMS(); # Get requested sets in the requested order. - $r->stash->{sets} = [ - @{ $self->{visibleSetIDs} } - ? $db->getGlobalSetsWhere({ set_id => $self->{visibleSetIDs} }, - [ $self->{primarySortField}, $self->{secondarySortField} ]) + $c->stash->{sets} = [ + @{ $c->{visibleSetIDs} } + ? $db->getGlobalSetsWhere({ set_id => $c->{visibleSetIDs} }, + [ $c->{primarySortField}, $c->{secondarySortField} ]) : () ]; @@ -285,145 +270,133 @@ sub initialize { # This action handler modifies the "visibleSetIDs" field based on the contents # of the "action.filter.scope" parameter and the "selected_sets". -sub filter_handler { - my ($self) = @_; - - my $r = $self->r; - my $db = $r->db; +sub filter_handler ($c) { + my $db = $c->db; my $result; - my $scope = $r->param('action.filter.scope'); + my $scope = $c->param('action.filter.scope'); if ($scope eq "all") { - $result = $r->maketext("showing all sets"); - $self->{visibleSetIDs} = $self->{allSetIDs}; + $result = $c->maketext("showing all sets"); + $c->{visibleSetIDs} = $c->{allSetIDs}; } elsif ($scope eq "none") { - $result = $r->maketext("showing no sets"); - $self->{visibleSetIDs} = []; + $result = $c->maketext("showing no sets"); + $c->{visibleSetIDs} = []; } elsif ($scope eq "selected") { - $result = $r->maketext("showing selected sets"); - $self->{visibleSetIDs} = [ $r->param('selected_sets') ]; + $result = $c->maketext("showing selected sets"); + $c->{visibleSetIDs} = [ $c->param('selected_sets') ]; } elsif ($scope eq "match_ids") { - $result = $r->maketext("showing matching sets"); - my @searchTerms = map { format_set_name_internal($_) } split /\s*,\s*/, $r->param('action.filter.set_ids'); + $result = $c->maketext("showing matching sets"); + my @searchTerms = map { format_set_name_internal($_) } split /\s*,\s*/, $c->param('action.filter.set_ids'); my $regexTerms = join('|', @searchTerms); - my @setIDs = grep {/$regexTerms/i} @{ $self->{allSetIDs} }; - $self->{visibleSetIDs} = \@setIDs; + my @setIDs = grep {/$regexTerms/i} @{ $c->{allSetIDs} }; + $c->{visibleSetIDs} = \@setIDs; } elsif ($scope eq "visible") { - $result = $r->maketext("showing sets that are visible to students"); - $self->{visibleSetIDs} = [ map { $_->[0] } $db->listGlobalSetsWhere({ visible => 1 }) ]; + $result = $c->maketext("showing sets that are visible to students"); + $c->{visibleSetIDs} = [ map { $_->[0] } $db->listGlobalSetsWhere({ visible => 1 }) ]; } elsif ($scope eq "unvisible") { - $result = $r->maketext("showing sets that are hidden from students"); - $self->{visibleSetIDs} = [ map { $_->[0] } $db->listGlobalSetsWhere({ visible => 0 }) ]; + $result = $c->maketext("showing sets that are hidden from students"); + $c->{visibleSetIDs} = [ map { $_->[0] } $db->listGlobalSetsWhere({ visible => 0 }) ]; } - return $r->tag('div', class => 'alert alert-success p-1 mb-0', $result); + return $c->tag('div', class => 'alert alert-success p-1 mb-0', $result); } -sub sort_handler { - my ($self) = @_; - my $r = $self->r; - - my $primary = $r->param('action.sort.primary'); - my $secondary = $r->param('action.sort.secondary'); +sub sort_handler ($c) { + my $primary = $c->param('action.sort.primary'); + my $secondary = $c->param('action.sort.secondary'); - $self->{primarySortField} = $primary; - $self->{secondarySortField} = $secondary; + $c->{primarySortField} = $primary; + $c->{secondarySortField} = $secondary; my %names = ( - set_id => $r->maketext("Set Name"), - open_date => $r->maketext("Open Date"), - due_date => $r->maketext("Close Date"), - answer_date => $r->maketext("Answer Date"), - visible => $r->maketext("Visibility"), + set_id => $c->maketext("Set Name"), + open_date => $c->maketext("Open Date"), + due_date => $c->maketext("Close Date"), + answer_date => $c->maketext("Answer Date"), + visible => $c->maketext("Visibility"), ); - return $r->tag( + return $c->tag( 'div', class => 'alert alert-success p-1 mb-0', - $r->maketext("Sort by [_1] and then by [_2]", $names{$primary}, $names{$secondary}) + $c->maketext("Sort by [_1] and then by [_2]", $names{$primary}, $names{$secondary}) ); } -sub edit_handler { - my ($self) = @_; - my $r = $self->r; - +sub edit_handler ($c) { my $result; - my $scope = $r->param('action.edit.scope'); + my $scope = $c->param('action.edit.scope'); if ($scope eq "all") { - $result = $r->maketext("editing all sets"); - $self->{visibleSetIDs} = $self->{allSetIDs}; + $result = $c->maketext("editing all sets"); + $c->{visibleSetIDs} = $c->{allSetIDs}; } elsif ($scope eq "visible") { - $result = $r->maketext("editing listed sets"); + $result = $c->maketext("editing listed sets"); # leave visibleSetIDs alone } elsif ($scope eq "selected") { - $result = $r->maketext("editing selected sets"); - $self->{visibleSetIDs} = [ $r->param('selected_sets') ]; + $result = $c->maketext("editing selected sets"); + $c->{visibleSetIDs} = [ $c->param('selected_sets') ]; } - $self->{editMode} = 1; + $c->{editMode} = 1; - return $r->tag('div', class => 'alert alert-success p-1 mb-0', $result); + return $c->tag('div', class => 'alert alert-success p-1 mb-0', $result); } -sub publish_handler { - my ($self) = @_; - - my $r = $self->r; - my $db = $r->db; +sub publish_handler ($c) { + my $db = $c->db; my $result = ""; - my $scope = $r->param('action.publish.scope'); - my $value = $r->param('action.publish.value'); + my $scope = $c->param('action.publish.scope'); + my $value = $c->param('action.publish.value'); - my $verb = $value ? $r->maketext("made visible for") : $r->maketext("hidden from"); + my $verb = $value ? $c->maketext("made visible for") : $c->maketext("hidden from"); my @setIDs; if ($scope eq "none") { @setIDs = (); - $result = $r->tag('div', class => 'alert alert-danger p-1 mb-0', $r->maketext("No change made to any set")); + $result = $c->tag('div', class => 'alert alert-danger p-1 mb-0', $c->maketext("No change made to any set")); } elsif ($scope eq "all") { - @setIDs = @{ $self->{allSetIDs} }; + @setIDs = @{ $c->{allSetIDs} }; $result = $value - ? $r->tag( + ? $c->tag( 'div', class => 'alert alert-success p-1 mb-0', - $r->maketext("All sets made visible for all students") + $c->maketext("All sets made visible for all students") ) - : $r->tag( + : $c->tag( 'div', class => 'alert alert-success p-1 mb-0', - $r->maketext("All sets hidden from all students") + $c->maketext("All sets hidden from all students") ); } elsif ($scope eq "visible") { - @setIDs = @{ $self->{visibleSetIDs} }; + @setIDs = @{ $c->{visibleSetIDs} }; $result = $value - ? $r->tag( + ? $c->tag( 'div', class => 'alert alert-success p-1 mb-0', - $r->maketext("All listed sets were made visible for all the students") + $c->maketext("All listed sets were made visible for all the students") ) - : $r->tag( + : $c->tag( 'div', class => 'alert alert-success p-1 mb-0', - $r->maketext("All listed sets were hidden from all the students") + $c->maketext("All listed sets were hidden from all the students") ); } elsif ($scope eq "selected") { - @setIDs = $r->param('selected_sets'); + @setIDs = $c->param('selected_sets'); $result = $value - ? $r->tag( + ? $c->tag( 'div', class => 'alert alert-success p-1 mb-0', - $r->maketext("All selected sets made visible for all students") + $c->maketext("All selected sets made visible for all students") ) - : $r->tag( + : $c->tag( 'div', class => 'alert alert-success p-1 mb-0', - $r->maketext("All selected sets hidden from all students") + $c->maketext("All selected sets hidden from all students") ); } @@ -431,58 +404,44 @@ sub publish_handler { my @sets = $db->getGlobalSets(@setIDs); map { $_->visible($value); $db->putGlobalSet($_); } @sets; - return $r->tag('div', class => 'alert alert-success p-1 mb-0', $result); + return $c->tag('div', class => 'alert alert-success p-1 mb-0', $result); } -sub score_handler { - my ($self) = @_; - - my $r = $self->r; - my $urlpath = $r->urlpath; - my $courseName = $urlpath->arg("courseID"); +sub score_handler ($c) { + my $courseName = $c->stash('courseID'); - my $scope = $r->param('action.score.scope'); + my $scope = $c->param('action.score.scope'); my @setsToScore; - if ($scope eq "none") { + if ($scope eq 'none') { @setsToScore = (); - return $r->maketext("No sets selected for scoring"); - } elsif ($scope eq "all") { - @setsToScore = @{ $self->{allSetIDs} }; - } elsif ($scope eq "visible") { - @setsToScore = @{ $self->{visibleSetIDs} }; - } elsif ($scope eq "selected") { - @setsToScore = $r->param('selected_sets'); + return $c->maketext('No sets selected for scoring'); + } elsif ($scope eq 'all') { + @setsToScore = @{ $c->{allSetIDs} }; + } elsif ($scope eq 'visible') { + @setsToScore = @{ $c->{visibleSetIDs} }; + } elsif ($scope eq 'selected') { + @setsToScore = $c->param('selected_sets'); } - my $uri = $self->systemLink( - $urlpath->newFromModule('WeBWorK::ContentGenerator::Instructor::Scoring', $r, courseID => $courseName), - params => { - scoreSelected => "Score Selected", - selectedSet => \@setsToScore, - } - ); - - return $uri; + return $c->systemLink($c->url_for('instructor_scoring'), + params => { scoreSelected => 'Score Selected', selectedSet => \@setsToScore }); } -sub delete_handler { - my ($self) = @_; +sub delete_handler ($c) { + my $db = $c->db; - my $r = $self->r; - my $db = $r->db; - - my $scope = $r->param('action.delete.scope'); + my $scope = $c->param('action.delete.scope'); my @setIDsToDelete = (); if ($scope eq "selected") { - @setIDsToDelete = @{ $self->{selectedSetIDs} }; + @setIDsToDelete = @{ $c->{selectedSetIDs} }; } - my %allSetIDs = map { $_ => 1 } @{ $self->{allSetIDs} }; - my %visibleSetIDs = map { $_ => 1 } @{ $self->{visibleSetIDs} }; - my %selectedSetIDs = map { $_ => 1 } @{ $self->{selectedSetIDs} }; + my %allSetIDs = map { $_ => 1 } @{ $c->{allSetIDs} }; + my %visibleSetIDs = map { $_ => 1 } @{ $c->{visibleSetIDs} }; + my %selectedSetIDs = map { $_ => 1 } @{ $c->{selectedSetIDs} }; foreach my $setID (@setIDsToDelete) { delete $allSetIDs{$setID}; @@ -491,59 +450,56 @@ sub delete_handler { $db->deleteGlobalSet($setID); } - $self->{allSetIDs} = [ keys %allSetIDs ]; - $self->{visibleSetIDs} = [ keys %visibleSetIDs ]; - $self->{selectedSetIDs} = [ keys %selectedSetIDs ]; + $c->{allSetIDs} = [ keys %allSetIDs ]; + $c->{visibleSetIDs} = [ keys %visibleSetIDs ]; + $c->{selectedSetIDs} = [ keys %selectedSetIDs ]; my $num = @setIDsToDelete; - return $r->tag('div', class => 'alert alert-success p-1 mb-0', $r->maketext('deleted [_1] sets', $num)); + return $c->tag('div', class => 'alert alert-success p-1 mb-0', $c->maketext('deleted [_1] sets', $num)); } -sub create_handler { - my ($self) = @_; - - my $r = $self->r; - my $db = $r->db; - my $ce = $r->ce; +sub create_handler ($c) { + my $db = $c->db; + my $ce = $c->ce; - my $newSetID = format_set_name_internal($r->param('action.create.name') // ''); - return $r->tag( + my $newSetID = format_set_name_internal($c->param('action.create.name') // ''); + return $c->tag( 'div', class => 'alert alert-danger p-1 mb-0', - $r->maketext("Failed to create new set: set name cannot exceed 100 characters.") + $c->maketext("Failed to create new set: set name cannot exceed 100 characters.") ) if (length($newSetID) > 100); - return $r->tag( + return $c->tag( 'div', class => 'alert alert-danger p-1 mb-0', - $r->maketext("Failed to create new set: no set name specified!") + $c->maketext("Failed to create new set: no set name specified!") ) unless $newSetID =~ /\S/; - return $r->tag( + return $c->tag( 'div', class => 'alert alert-danger p-1 mb-0', - $r->maketext( + $c->maketext( "The set name '[_1]' is already in use. Pick a different name if you would like to start a new set.", $newSetID) . " " - . $r->maketext("No set created.") + . $c->maketext("No set created.") ) if $db->existsGlobalSet($newSetID); my $newSetRecord = $db->newGlobalSet; - my $oldSetID = $self->{selectedSetIDs}->[0]; + my $oldSetID = $c->{selectedSetIDs}->[0]; - my $type = $r->param('action.create.type'); + my $type = $c->param('action.create.type'); # It's convenient to set the due date two weeks from now so that it is # not accidentally available to students. my $dueDate = time + 2 * ONE_WEEK(); my $display_tz = $ce->{siteDefaults}{timezone}; - my $fDueDate = $self->formatDateTime($dueDate, $display_tz, "%m/%d/%Y at %I:%M%P"); + my $fDueDate = $c->formatDateTime($dueDate, $display_tz, "%m/%d/%Y at %I:%M%P"); my $dueTime = $ce->{pg}{timeAssignDue}; # We replace the due time by the one from the config variable # and try to bring it back to unix time if possible $fDueDate =~ s/\d\d:\d\d(am|pm|AM|PM)/$dueTime/; - $dueDate = $self->parseDateTime($fDueDate, $display_tz); + $dueDate = $c->parseDateTime($fDueDate, $display_tz); if ($type eq "empty") { $newSetRecord->set_id($newSetID); @@ -559,10 +515,10 @@ sub create_handler { $newSetRecord->assignment_type('default'); $db->addGlobalSet($newSetRecord); } elsif ($type eq "copy") { - return $r->tag( + return $c->tag( 'div', class => 'alert alert-danger p-1 mb-0', - $r->maketext('Failed to duplicate set: no set selected for duplication!') + $c->maketext('Failed to duplicate set: no set selected for duplication!') ) unless $oldSetID =~ /\S/; $newSetRecord = $db->getGlobalSet($oldSetID); $newSetRecord->set_id($newSetID); @@ -595,53 +551,50 @@ sub create_handler { } } # Assign set to current active user. - my $userName = $r->param('user'); + my $userName = $c->param('user'); assignSetToUser($db, $userName, $newSetRecord); # Cures weird date error when no-one assigned to set. - $self->addgoodmessage($r->maketext( + $c->addgoodmessage($c->maketext( 'Set [_1] was assigned to [_2].', - $r->tag('span', dir => 'ltr', format_set_name_display($newSetID)), $userName + $c->tag('span', dir => 'ltr', format_set_name_display($newSetID)), $userName )); - push @{ $self->{visibleSetIDs} }, $newSetID; - push @{ $self->{allSetIds} }, $newSetID; + push @{ $c->{visibleSetIDs} }, $newSetID; + push @{ $c->{allSetIds} }, $newSetID; - return $r->tag('div', class => 'alert alert-danger p-1 mb-0', $r->maketext('Failed to create new set: [_1]', $@)) + return $c->tag('div', class => 'alert alert-danger p-1 mb-0', $c->maketext('Failed to create new set: [_1]', $@)) if $@; - return $r->tag( + return $c->tag( 'div', class => 'alert alert-success p-1 mb-0', - $r->b($r->maketext( + $c->b($c->maketext( 'Successfully created new set [_1]', - $r->tag('span', dir => 'ltr', format_set_name_display($newSetID)) + $c->tag('span', dir => 'ltr', format_set_name_display($newSetID)) )) ); } -sub import_handler { - my ($self) = @_; - my $r = $self->r; - - my ($added, $skipped) = $self->importSetsFromDef( - $r->param('action.import.number') > 1 +sub import_handler ($c) { + my ($added, $skipped) = $c->importSetsFromDef( + $c->param('action.import.number') > 1 ? '' # Cannot assign set names to multiple imports. - : format_set_name_internal($r->param('action.import.name')), - $r->param('action.import.assign'), - $r->param('action.import.start.date') // 0, - $r->param('action.import.source') + : format_set_name_internal($c->param('action.import.name')), + $c->param('action.import.assign'), + $c->param('action.import.start.date') // 0, + $c->param('action.import.source') ); # Make new sets visible. - push @{ $self->{visibleSetIDs} }, @$added; - push @{ $self->{allSetIDs} }, @$added; + push @{ $c->{visibleSetIDs} }, @$added; + push @{ $c->{allSetIDs} }, @$added; my $numAdded = @$added; my $numSkipped = @$skipped; - return $r->tag( + return $c->tag( 'div', class => 'alert alert-success p-1 mb-0', - $r->maketext( + $c->maketext( '[_1] sets added, [_2] sets skipped. Skipped sets: ([_3])', $numAdded, $numSkipped, join(', ', @$skipped) ) @@ -649,63 +602,52 @@ sub import_handler { } # this does not actually export any files, rather it sends us to a new page in order to export the files -sub export_handler { - my ($self) = @_; - my $r = $self->r; - +sub export_handler ($c) { my $result; - my $scope = $r->param('action.export.scope'); + my $scope = $c->param('action.export.scope'); if ($scope eq "all") { - $result = $r->maketext("All sets were selected for export."); - $self->{selectedSetIDs} = $self->{visibleSetIDs} = $self->{allSetIDs}; + $result = $c->maketext("All sets were selected for export."); + $c->{selectedSetIDs} = $c->{visibleSetIDs} = $c->{allSetIDs}; } elsif ($scope eq "visible") { - $result = $r->maketext("Visible sets were selected for export."); - $self->{selectedSetIDs} = $self->{visibleSetIDs}; + $result = $c->maketext("Visible sets were selected for export."); + $c->{selectedSetIDs} = $c->{visibleSetIDs}; } elsif ($scope eq "selected") { - $result = $r->maketext("Sets were selected for export."); - $self->{selectedSetIDs} = $self->{visibleSetIDs} = [ $r->param('selected_sets') ]; + $result = $c->maketext("Sets were selected for export."); + $c->{selectedSetIDs} = $c->{visibleSetIDs} = [ $c->param('selected_sets') ]; } - $self->{exportMode} = 1; + $c->{exportMode} = 1; - return $r->tag('div', class => 'alert alert-success p-1 mb-0', $result); + return $c->tag('div', class => 'alert alert-success p-1 mb-0', $result); } -sub cancel_export_handler { - my ($self) = @_; - my $r = $self->r; - - #$self->{selectedSetIDs) = $self->{visibleSetIDs}; - # only do the above if we arrived here via "edit selected users" - if (defined $r->param("prev_visible_sets")) { - $self->{visibleSetIDs} = [ $r->param("prev_visible_sets") ]; - } elsif (defined $r->param("no_prev_visible_sets")) { - $self->{visibleSetIDs} = []; +sub cancel_export_handler ($c) { + if (defined $c->param("prev_visible_sets")) { + $c->{visibleSetIDs} = [ $c->param("prev_visible_sets") ]; + } elsif (defined $c->param("no_prev_visible_sets")) { + $c->{visibleSetIDs} = []; } else { # leave it alone } - $self->{exportMode} = 0; + $c->{exportMode} = 0; - return $r->tag('div', class => 'alert alert-danger p-1 mb-0', $r->maketext('export abandoned')); + return $c->tag('div', class => 'alert alert-danger p-1 mb-0', $c->maketext('export abandoned')); } -sub save_export_handler { - my ($self) = @_; - my $r = $self->r; - - my @setIDsToExport = @{ $self->{selectedSetIDs} }; +sub save_export_handler ($c) { + my @setIDsToExport = @{ $c->{selectedSetIDs} }; - my %filenames = map { $_ => ($r->param("set.$_") || $_) } @setIDsToExport; + my %filenames = map { $_ => ($c->param("set.$_") || $_) } @setIDsToExport; - my ($exported, $skipped, $reason) = $self->exportSetsToDef(%filenames); + my ($exported, $skipped, $reason) = $c->exportSetsToDef(%filenames); - if (defined $r->param("prev_visible_sets")) { - $self->{visibleSetIDs} = [ $r->param("prev_visible_sets") ]; - } elsif (defined $r->param("no_prev_visble_sets")) { - $self->{visibleSetIDs} = []; + if (defined $c->param("prev_visible_sets")) { + $c->{visibleSetIDs} = [ $c->param("prev_visible_sets") ]; + } elsif (defined $c->param("no_prev_visble_sets")) { + $c->{visibleSetIDs} = []; } - $self->{exportMode} = 0; + $c->{exportMode} = 0; my $numExported = @$exported; my $numSkipped = @$skipped; @@ -713,42 +655,35 @@ sub save_export_handler { my @reasons = map { "set $_ - " . $reason->{$_} } keys %$reason; - return $r->tag( + return $c->tag( 'div', class => "alert $resultFont p-1 mb-0", - $r->b($r->maketext( + $c->b($c->maketext( '[_1] sets exported, [_2] sets skipped. Skipped sets: ([_3])', $numExported, $numSkipped, - $numSkipped ? $r->tag('ul', $r->c(map { $r->tag('li', $_) } @reasons)->join('')) : '' + $numSkipped ? $c->tag('ul', $c->c(map { $c->tag('li', $_) } @reasons)->join('')) : '' )) ); } -sub cancel_edit_handler { - my ($self) = @_; - my $r = $self->r; - - #$self->{selectedSetIDs) = $self->{visibleSetIDs}; - # only do the above if we arrived here via "edit selected users" - if (defined $r->param("prev_visible_sets")) { - $self->{visibleSetIDs} = [ $r->param("prev_visible_sets") ]; - } elsif (defined $r->param("no_prev_visible_sets")) { - $self->{visibleSetIDs} = []; +sub cancel_edit_handler ($c) { + if (defined $c->param("prev_visible_sets")) { + $c->{visibleSetIDs} = [ $c->param("prev_visible_sets") ]; + } elsif (defined $c->param("no_prev_visible_sets")) { + $c->{visibleSetIDs} = []; } else { # leave it alone } - $self->{editMode} = 0; + $c->{editMode} = 0; - return $r->tag('div', class => 'alert alert-danger p-1 mb-0', $r->maketext('changes abandoned')); + return $c->tag('div', class => 'alert alert-danger p-1 mb-0', $c->maketext('changes abandoned')); } -sub save_edit_handler { - my ($self) = @_; - my $r = $self->r; - my $db = $r->db; - my $ce = $r->ce; +sub save_edit_handler ($c) { + my $db = $c->db; + my $ce = $c->ce; - my @visibleSetIDs = @{ $self->{visibleSetIDs} }; + my @visibleSetIDs = @{ $c->{visibleSetIDs} }; foreach my $setID (@visibleSetIDs) { next unless defined($setID); my $Set = $db->getGlobalSet($setID); @@ -756,7 +691,7 @@ sub save_edit_handler { die "record for visible set $setID not found" unless $Set; foreach my $field ($Set->NONKEYFIELDS()) { - my $value = $r->param("set.$setID.$field"); + my $value = $c->param("set.$setID.$field"); if (defined $value) { if ($field =~ /_date/) { $Set->$field($value); @@ -778,44 +713,44 @@ sub save_edit_handler { my $curr_time = time; my $seconds_per_year = 31_556_926; my $cutoff = $curr_time + $seconds_per_year * 10; - return $r->tag( + return $c->tag( 'div', class => 'alert alert-danger p-1 mb-0', - $r->maketext("Error: open date cannot be more than 10 years from now in set [_1]", $setID) + $c->maketext("Error: open date cannot be more than 10 years from now in set [_1]", $setID) ) if $Set->open_date > $cutoff; - return $r->tag( + return $c->tag( 'div', class => 'alert alert-danger p-1 mb-0', - $r->maketext("Error: close date cannot be more than 10 years from now in set [_1]", $setID) + $c->maketext("Error: close date cannot be more than 10 years from now in set [_1]", $setID) ) if $Set->due_date > $cutoff; - return $r->tag( + return $c->tag( 'div', class => 'alert alert-danger p-1 mb-0', - $r->maketext("Error: answer date cannot be more than 10 years from now in set [_1]", $setID) + $c->maketext("Error: answer date cannot be more than 10 years from now in set [_1]", $setID) ) if $Set->answer_date > $cutoff; # Check that the open, due and answer dates are in increasing order. # Bail if this is not correct. if ($Set->open_date > $Set->due_date) { - return $r->tag( + return $c->tag( 'div', class => 'alert alert-danger p-1 mb-0', - $r->maketext("Error: Close date must come after open date in set [_1]", $setID) + $c->maketext("Error: Close date must come after open date in set [_1]", $setID) ); } if ($Set->due_date > $Set->answer_date) { - return $r->tag( + return $c->tag( 'div', class => 'alert alert-danger p-1 mb-0', - $r->maketext("Error: Answer date must come after close date in set [_1]", $setID) + $c->maketext("Error: Answer date must come after close date in set [_1]", $setID) ); } # check that the reduced scoring date is in the right place my $enable_reduced_scoring = $ce->{pg}{ansEvalDefaults}{enableReducedScoring} && ( - defined($r->param("set.$setID.enable_reduced_scoring")) - ? $r->param("set.$setID.enable_reduced_scoring") + defined($c->param("set.$setID.enable_reduced_scoring")) + ? $c->param("set.$setID.enable_reduced_scoring") : $Set->enable_reduced_scoring); if ( @@ -825,10 +760,10 @@ sub save_edit_handler { || $Set->reduced_scoring_date < $Set->open_date) ) { - return $r->tag( + return $c->tag( 'div', class => 'alert alert-danger p-1 mb-0', - $r->maketext( + $c->maketext( "Error: Reduced scoring date must come between the open date and close date in set [_1]", $setID ) @@ -838,43 +773,41 @@ sub save_edit_handler { $db->putGlobalSet($Set); } - if (defined $r->param("prev_visible_sets")) { - $self->{visibleSetIDs} = [ $r->param("prev_visible_sets") ]; - } elsif (defined $r->param("no_prev_visble_sets")) { - $self->{visibleSetIDs} = []; + if (defined $c->param("prev_visible_sets")) { + $c->{visibleSetIDs} = [ $c->param("prev_visible_sets") ]; + } elsif (defined $c->param("no_prev_visble_sets")) { + $c->{visibleSetIDs} = []; } else { # leave it alone } - $self->{editMode} = 0; + $c->{editMode} = 0; - return $r->tag('div', class => 'alert alert-success p-1 mb-0', $r->maketext("changes saved")); + return $c->tag('div', class => 'alert alert-success p-1 mb-0', $c->maketext("changes saved")); } # Utilities -sub importSetsFromDef { - my ($self, $newSetName, $assign, $startdate, @setDefFiles) = @_; - my $r = $self->r; - my $ce = $r->ce; - my $db = $r->db; - my $dir = $ce->{courseDirs}->{templates}; +sub importSetsFromDef ($c, $newSetName, $assign, $startdate, @setDefFiles) { + my $ce = $c->ce; + my $db = $c->db; + my $dir = $ce->{courseDirs}{templates}; my $mindate = 0; - # if the user includes "following files" in a multiple selection - # it shows up here as "" which causes the importing to die - # so, we select on filenames containing non-whitespace + # If the user includes "following files" in a multiple selection + # it shows up here as "" which causes the importing to die. + # So, we select on filenames containing non-whitespace. @setDefFiles = grep {/\S/} @setDefFiles; # FIXME: do we really want everything to fail on one bad file name? foreach my $fileName (@setDefFiles) { - die $r->maketext("won't be able to read from file [_1]/[_2]: does it exist? is it readable?", $dir, $fileName) + die $c->maketext("won't be able to read from file [_1]/[_2]: does it exist? is it readable?", $dir, $fileName) unless -r "$dir/$fileName"; } # Get a list of set ids of existing sets in the course. This is used to # ensure that an imported set does not already exist. - my %allSets = map { $_ => 1 } @{ $self->{allSetIDs} }; + my %allSets = map { $_ => 1 } @{ $c->{allSetIDs} }; my (@added, @skipped); @@ -890,7 +823,7 @@ sub importSetsFromDef { $hideScore, $hideScoreByProblem, $hideWork, $timeCap, $restrictIP, $restrictLoc, $relaxRestrictIP, $description, $emailInstructor, $restrictProbProgression - ) = $self->readSetDef($set_definition_file); + ) = $c->readSetDef($set_definition_file); my @problemList = @{$ra_problemData}; # Use the original name if form doesn't specify a new one. @@ -946,7 +879,7 @@ sub importSetsFromDef { #create the set eval { $db->addGlobalSet($newSetRecord) }; - die $r->maketext("addGlobalSet [_1] in ProblemSetList: [_2]", $setName, $@) if $@; + die $c->maketext("addGlobalSet [_1] in ProblemSetList: [_2]", $setName, $@) if $@; #do we need to add locations to the set_locations table? if ($restrictIP ne 'No' && $restrictLoc) { @@ -956,7 +889,7 @@ sub importSetsFromDef { $newSetLocation->set_id($setName); $newSetLocation->location_id($restrictLoc); eval { $db->addGlobalSetLocation($newSetLocation) }; - warn($r->maketext( + warn($c->maketext( "error adding set location [_1] for set [_2]: [_3]", $restrictLoc, $setName, $@ )) @@ -964,7 +897,7 @@ sub importSetsFromDef { } else { # this should never happen. warn( - $r->maketext( + $c->maketext( "input set location [_1] already exists for set [_2].", $restrictLoc, $setName ) . "\n" @@ -972,7 +905,7 @@ sub importSetsFromDef { } } else { warn( - $r->maketext("restriction location [_1] does not exist. IP restrictions have been ignored.", + $c->maketext("restriction location [_1] does not exist. IP restrictions have been ignored.", $restrictLoc) . "\n" ); @@ -1007,7 +940,7 @@ sub importSetsFromDef { if ($assign eq "all") { assignSetToAllUsers($db, $ce, $setName); } else { - my $userName = $r->param('user'); + my $userName = $c->param('user'); assignSetToUser($db, $userName, $newSetRecord); ## always assign set to instructor } } @@ -1030,28 +963,24 @@ sub importSetsFromDef { return \@added, \@skipped; } -sub readSetDef { - my ($self, $fileName) = @_; - my $templateDir = $self->{ce}->{courseDirs}->{templates}; - my $filePath = "$templateDir/$fileName"; - my $weight_default = $self->{ce}->{problemDefaults}->{value}; - my $max_attempts_default = $self->{ce}->{problemDefaults}->{max_attempts}; - my $att_to_open_children_default = - $self->{ce}->{problemDefaults}->{att_to_open_children}; - my $counts_parent_grade_default = - $self->{ce}->{problemDefaults}->{counts_parent_grade}; - my $showMeAnother_default = $self->{ce}->{problemDefaults}->{showMeAnother}; - my $showHintsAfter_default = $self->{ce}{problemDefaults}{showHintsAfter}; - my $prPeriod_default = $self->{ce}->{problemDefaults}->{prPeriod}; +sub readSetDef ($c, $fileName) { + my $ce = $c->ce; + my $templateDir = $ce->{courseDirs}{templates}; + my $filePath = "$templateDir/$fileName"; + my $weight_default = $ce->{problemDefaults}{value}; + my $max_attempts_default = $ce->{problemDefaults}{max_attempts}; + my $att_to_open_children_default = $ce->{problemDefaults}{att_to_open_children}; + my $counts_parent_grade_default = $ce->{problemDefaults}{counts_parent_grade}; + my $showMeAnother_default = $ce->{problemDefaults}{showMeAnother}; + my $showHintsAfter_default = $ce->{problemDefaults}{showHintsAfter}; + my $prPeriod_default = $ce->{problemDefaults}{prPeriod}; my $setName = ''; - my $r = $self->r; - if ($fileName =~ m|^(.*/)?set([.\w-]+)\.def$|) { $setName = $2; } else { - $self->addbadmessage( + $c->addbadmessage( qq{The setDefinition file name must begin with set and must end with }, qq{.def. Every thing in between becomes the name of the set. For example }, qq{set1.def, setExam.def, and setsample7.def define }, @@ -1154,15 +1083,15 @@ sub readSetDef { $listType = $item; last; } else { - warn $r->maketext("readSetDef error, can't read the line: ||[_1]||", $line); + warn $c->maketext("readSetDef error, can't read the line: ||[_1]||", $line); } } # Check and format dates - my ($time1, $time2, $time3) = map { $self->parseDateTime($_); } ($openDate, $dueDate, $answerDate); + my ($time1, $time2, $time3) = map { $c->parseDateTime($_); } ($openDate, $dueDate, $answerDate); unless ($time1 <= $time2 and $time2 <= $time3) { - warn $r->maketext('The open date: [_1], close date: [_2], and answer date: [_3] ' + warn $c->maketext('The open date: [_1], close date: [_2], and answer date: [_3] ' . 'must be defined and in chronological order.', $openDate, $dueDate, $answerDate); } @@ -1174,10 +1103,10 @@ sub readSetDef { if ($reducedScoringDate) { if (($reducedScoringDate =~ m+12/31/1969+) || ($reducedScoringDate =~ m+01/01/1970+)) { my $origReducedScoringDate = $reducedScoringDate; - $reducedScoringDate = $self->parseDateTime($reducedScoringDate); + $reducedScoringDate = $c->parseDateTime($reducedScoringDate); if ($reducedScoringDate != 0) { # In this case we want to treat it BY FORCE as if the value did correspond to epoch 0. - warn $r->maketext( + warn $c->maketext( 'The reduced credit date [_1] in the file probably was generated from ' . 'the Unix epoch 0 value and is being treated as if it was Unix epoch 0.', $origReducedScoringDate @@ -1187,20 +1116,20 @@ sub readSetDef { } else { # Original behavior, which may cause problems for some time-zones when epoch 0 was set and does not # parse back to 0. - $reducedScoringDate = $self->parseDateTime($reducedScoringDate); + $reducedScoringDate = $c->parseDateTime($reducedScoringDate); } } if ($reducedScoringDate) { if ($reducedScoringDate < $time1 || $reducedScoringDate > $time2) { - warn $r->maketext("The reduced credit date should be between the open date [_1] and close date [_2]", + warn $c->maketext("The reduced credit date should be between the open date [_1] and close date [_2]", $openDate, $dueDate); } elsif ($reducedScoringDate == 0 && $enableReducedScoring ne 'Y') { # In this case - the date in the file was Unix epoch 0 (or treated as such), # and unless $enableReducedScoring eq 'Y' we will leave it as 0. } } else { - $reducedScoringDate = $time2 - 60 * $r->{ce}->{pg}{ansEvalDefaults}{reducedScoringPeriod}; + $reducedScoringDate = $time2 - 60 * $ce->{pg}{ansEvalDefaults}{reducedScoringPeriod}; } if ($enableReducedScoring ne '' && $enableReducedScoring eq 'Y') { @@ -1209,7 +1138,7 @@ sub readSetDef { $enableReducedScoring = 0; } elsif ($enableReducedScoring ne '') { warn( - $r->maketext("The value [_1] for enableReducedScoring is not valid; it will be replaced with 'N'.", + $c->maketext("The value [_1] for enableReducedScoring is not valid; it will be replaced with 'N'.", $enableReducedScoring) . "\n" ); @@ -1236,7 +1165,7 @@ sub readSetDef { && $hideScore ne 'BeforeAnswerDate') { warn( - $r->maketext("The value [_1] for the hideScore option is not valid; it will be replaced with 'N'.", + $c->maketext("The value [_1] for the hideScore option is not valid; it will be replaced with 'N'.", $hideScore) . "\n" ); @@ -1247,7 +1176,7 @@ sub readSetDef { && $hideScoreByProblem ne 'BeforeAnswerDate') { warn( - $r->maketext("The value [_1] for the hideScore option is not valid; it will be replaced with 'N'.", + $c->maketext("The value [_1] for the hideScore option is not valid; it will be replaced with 'N'.", $hideScoreByProblem) . "\n" ); @@ -1258,7 +1187,7 @@ sub readSetDef { && $hideWork ne 'BeforeAnswerDate') { warn( - $r->maketext("The value [_1] for the hideWork option is not valid; it will be replaced with 'N'.", + $c->maketext("The value [_1] for the hideWork option is not valid; it will be replaced with 'N'.", $hideWork) . "\n" ); @@ -1266,7 +1195,7 @@ sub readSetDef { } if ($timeCap ne '0' && $timeCap ne '1') { warn( - $r->maketext( + $c->maketext( "The value [_1] for the capTimeLimit option is not valid; it will be replaced with '0'.", $timeCap) . "\n" @@ -1278,7 +1207,7 @@ sub readSetDef { && $restrictIP ne 'RestrictTo') { warn( - $r->maketext( + $c->maketext( "The value [_1] for the restrictIP option is not valid; it will be replaced with 'No'.", $restrictIP) . "\n" @@ -1292,7 +1221,7 @@ sub readSetDef { && $relaxRestrictIP ne 'AfterVersionAnswerDate') { warn( - $r->maketext( + $c->maketext( "The value [_1] for the relaxRestrictIP option is not valid; it will be replaced with 'No'.", $relaxRestrictIP) . "\n" @@ -1386,7 +1315,7 @@ sub readSetDef { if ($item eq 'problem_start') { next; } elsif ($item eq 'source_file') { - warn($r->maketext('No source_file for problem in .def file')) unless $value; + warn($c->maketext('No source_file for problem in .def file')) unless $value; $name = $value; } elsif ($item eq 'value') { $weight = ($value) ? $value : $weight_default; @@ -1468,7 +1397,7 @@ sub readSetDef { $countsParentGrade = ''; } else { - warn $r->maketext("readSetDef error, can't read the line: ||[_1]||", $line); + warn $c->maketext("readSetDef error, can't read the line: ||[_1]||", $line); } } @@ -1485,16 +1414,14 @@ sub readSetDef { $emailInstructor, $restrictProbProgression ); } else { - warn $r->maketext("Can't open file [_1]", $filePath) . "\n"; + warn $c->maketext("Can't open file [_1]", $filePath) . "\n"; + return; } } -sub exportSetsToDef { - my ($self, %filenames) = @_; - - my $r = $self->r; - my $ce = $r->ce; - my $db = $r->db; +sub exportSetsToDef ($c, %filenames) { + my $ce = $c->ce; + my $db = $c->db; my (@exported, @skipped, %reason); @@ -1506,14 +1433,14 @@ SET: foreach my $set (keys %filenames) { # files can be exported to sub directories but not parent directories if ($fileName =~ /\.\./) { push @skipped, $set; - $reason{$set} = $r->maketext("Illegal filename contains '..'"); + $reason{$set} = $c->maketext("Illegal filename contains '..'"); next SET; } my $setRecord = $db->getGlobalSet($set); unless (defined $setRecord) { push @skipped, $set; - $reason{$set} = $r->maketext("No record found."); + $reason{$set} = $c->maketext("No record found."); next SET; } my $filePath = $ce->{courseDirs}->{templates} . '/' . $fileName; @@ -1521,13 +1448,13 @@ SET: foreach my $set (keys %filenames) { # back up existing file if (-e $filePath) { rename($filePath, "$filePath.bak") - or $reason{$set} = $r->maketext("Existing file [_1] could not be backed up and was lost.", $filePath); + or $reason{$set} = $c->maketext("Existing file [_1] could not be backed up and was lost.", $filePath); } - my $openDate = $self->formatDateTime($setRecord->open_date); - my $dueDate = $self->formatDateTime($setRecord->due_date); - my $answerDate = $self->formatDateTime($setRecord->answer_date); - my $reducedScoringDate = $self->formatDateTime($setRecord->reduced_scoring_date); + my $openDate = $c->formatDateTime($setRecord->open_date); + my $dueDate = $c->formatDateTime($setRecord->due_date); + my $answerDate = $c->formatDateTime($setRecord->answer_date); + my $reducedScoringDate = $c->formatDateTime($setRecord->reduced_scoring_date); my $description = $setRecord->description; if ($description) { $description =~ s/\r?\n//g; @@ -1645,7 +1572,7 @@ EOF $filePath = WeBWorK::Utils::surePathToFile($ce->{courseDirs}->{templates}, $filePath); eval { - open(my $SETDEF, '>', $filePath) or die $r->maketext("Failed to open [_1]", $filePath); + open(my $SETDEF, '>', $filePath) or die $c->maketext("Failed to open [_1]", $filePath); print $SETDEF $fileContents; close $SETDEF; }; diff --git a/lib/WeBWorK/ContentGenerator/Instructor/Scoring.pm b/lib/WeBWorK/ContentGenerator/Instructor/Scoring.pm index e333e84584..d310e142d1 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/Scoring.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/Scoring.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::Instructor::Scoring; -use parent qw(WeBWorK::ContentGenerator); +use Mojo::Base 'WeBWorK::ContentGenerator', -signatures; =head1 NAME @@ -22,9 +22,6 @@ WeBWorK::ContentGenerator::Instructor::Scoring - Generate scoring data files =cut -use strict; -use warnings; - use WeBWorK::Debug; use WeBWorK::Utils qw(readFile jitar_id_to_seq jitar_problem_adjusted_status wwRound x); use WeBWorK::ContentGenerator::Instructor::FileManager; @@ -33,41 +30,38 @@ our @userInfoColumnHeadings = (x("STUDENT ID"), x("login ID"), x("LAST NAME"), x("FIRST NAME"), x("SECTION"), x("RECITATION")); our @userInfoFields = ("student_id", "user_id", "last_name", "first_name", "section", "recitation"); -sub initialize { - my ($self) = @_; - my $r = $self->r; - my $urlpath = $r->urlpath; - my $ce = $r->ce; - my $db = $r->db; - my $authz = $r->authz; +sub initialize ($c) { + my $ce = $c->ce; + my $db = $c->db; + my $authz = $c->authz; my $scoringDir = $ce->{courseDirs}->{scoring}; - my $courseName = $urlpath->arg("courseID"); - my $user = $r->param('user'); + my $courseName = $c->stash('courseID'); + my $user = $c->param('user'); # Check permission return unless $authz->hasPermissions($user, "access_instructor_tools"); return unless $authz->hasPermissions($user, "score_sets"); - my @selected = $r->param('selectedSet'); - my $scoringFileName = $r->param('scoringFileName') || "${courseName}_totals"; + my @selected = $c->param('selectedSet'); + my $scoringFileName = $c->param('scoringFileName') || "${courseName}_totals"; $scoringFileName =~ s/\.csv\s*$//; $scoringFileName .= '.csv'; # must end in .csv my $scoringFileNameOK = ($scoringFileName eq WeBWorK::ContentGenerator::Instructor::FileManager::checkName($scoringFileName)); - $self->{scoringFileName} = $scoringFileName; + $c->{scoringFileName} = $scoringFileName; - $self->{padFields} = defined($r->param('padFields')) ? 1 : 0; - $self->{includePercentEachSet} = defined($r->param('includePercentEachSet')) ? 1 : 0; + $c->{padFields} = defined($c->param('padFields')) ? 1 : 0; + $c->{includePercentEachSet} = defined($c->param('includePercentEachSet')) ? 1 : 0; # Save the list of global sets sorted by set_id. my @setRecords = $db->getGlobalSetsWhere({}, 'set_id'); - $self->{ra_set_ids} = [ map { $_->set_id } @setRecords ]; - $self->{rh_set_records} = { map { $_->set_id => $_ } @setRecords }; + $c->{ra_set_ids} = [ map { $_->set_id } @setRecords ]; + $c->{rh_set_records} = { map { $_->set_id => $_ } @setRecords }; if (@selected && $scoringFileNameOK) { my @totals = (); - my $recordSingleSetScores = $r->param('recordSingleSetScores'); + my $recordSingleSetScores = $c->param('recordSingleSetScores'); # Get all users sorted by last_name, then first_name, then user_id. debug("pre-fetching users"); @@ -83,38 +77,37 @@ sub initialize { my $scoringType = ($recordSingleSetScores) ? 'everything' : 'totals'; my (@everything, @normal, @full, @info, @totalsColumn); - @info = $self->scoreSet($selected[0], "info", undef, \%Users, \@sortedUserIDs) if defined($selected[0]); + @info = $c->scoreSet($selected[0], "info", undef, \%Users, \@sortedUserIDs) if defined($selected[0]); @totals = @info; - my $showIndex = defined($r->param('includeIndex')) ? defined($r->param('includeIndex')) : 0; + my $showIndex = defined($c->param('includeIndex')) ? defined($c->param('includeIndex')) : 0; foreach my $setID (@selected) { next unless defined $setID; if ($scoringType eq 'everything') { - @everything = $self->scoreSet($setID, "everything", $showIndex, \%Users, \@sortedUserIDs); - @normal = $self->everything2normal(@everything); - @full = $self->everything2full(@everything); - @info = $self->everything2info(@everything); - @totalsColumn = $self->everything2totals(@everything); - $self->appendColumns(\@totals, \@totalsColumn); - $self->writeCSV("$scoringDir/s${setID}scr.csv", @normal); - $self->writeCSV("$scoringDir/s${setID}ful.csv", @full); + @everything = $c->scoreSet($setID, "everything", $showIndex, \%Users, \@sortedUserIDs); + @normal = $c->everything2normal(@everything); + @full = $c->everything2full(@everything); + @info = $c->everything2info(@everything); + @totalsColumn = $c->everything2totals(@everything); + $c->appendColumns(\@totals, \@totalsColumn); + $c->writeCSV("$scoringDir/s${setID}scr.csv", @normal); + $c->writeCSV("$scoringDir/s${setID}ful.csv", @full); } else { - @totalsColumn = $self->scoreSet($setID, "totals", $showIndex, \%Users, \@sortedUserIDs); - $self->appendColumns(\@totals, \@totalsColumn); + @totalsColumn = $c->scoreSet($setID, "totals", $showIndex, \%Users, \@sortedUserIDs); + $c->appendColumns(\@totals, \@totalsColumn); } } - my @sum_scores = - $self->sumScores(\@totals, $showIndex, \%Users, \@sortedUserIDs, $self->{includePercentEachSet}); - $self->appendColumns(\@totals, \@sum_scores); - $self->writeCSV("$scoringDir/$scoringFileName", @totals); + my @sum_scores = $c->sumScores(\@totals, $showIndex, \%Users, \@sortedUserIDs, $c->{includePercentEachSet}); + $c->appendColumns(\@totals, \@sum_scores); + $c->writeCSV("$scoringDir/$scoringFileName", @totals); } else { - if ($r->param('score-sets') && !@selected) { # nothing selected for scoring - $self->addbadmessage($r->maketext("You must select one or more sets for scoring!")); + if ($c->param('score-sets') && !@selected) { # nothing selected for scoring + $c->addbadmessage($c->maketext("You must select one or more sets for scoring!")); } if (!$scoringFileNameOK) { # fileName is not properly formed - $self->addbadmessage($r->maketext("Your file name is not valid! ")); - $self->addbadmessage($r->maketext( + $c->addbadmessage($c->maketext("Your file name is not valid! ")); + $c->addbadmessage($c->maketext( "A file name cannot begin with a dot, it cannot be empty, it cannot contain a " . "directory path component and only the characters -_.a-zA-Z0-9 and space are allowed." )); @@ -132,10 +125,8 @@ sub initialize { # everything: "full" plus a totals column # info: student info columns only # totals: total column only -sub scoreSet { - my ($self, $setID, $format, $showIndex, $UsersRef, $sortedUserIDsRef) = @_; - my $r = $self->r; - my $db = $r->db; +sub scoreSet ($c, $setID, $format, $showIndex, $UsersRef, $sortedUserIDsRef) { + my $db = $c->db; my @scoringData; my $scoringItems = { info => 0, @@ -149,7 +140,7 @@ sub scoreSet { $format = "normal" unless $format eq "full" or $format eq "everything" or $format eq "totals" or $format eq "info"; my $columnsPerProblem = ($format eq "full" or $format eq "everything") ? 3 : 1; - my $setRecord = $self->{rh_set_records}{$setID}; + my $setRecord = $c->{rh_set_records}{$setID}; die "global set $setID not found. " unless $setRecord; my %Users = %$UsersRef; # user objects hashed on user ID @@ -219,12 +210,12 @@ sub scoreSet { } if ($scoringItems->{header}) { - $scoringData[0][0] = $r->maketext("NO OF FIELDS"); - $scoringData[1][0] = $r->maketext("SET NAME"); - $scoringData[2][0] = $r->maketext("PROB NUMBER"); - $scoringData[3][0] = $r->maketext("CLOSE DATE"); - $scoringData[4][0] = $r->maketext("CLOSE TIME"); - $scoringData[5][0] = $r->maketext("PROB VALUE"); + $scoringData[0][0] = $c->maketext("NO OF FIELDS"); + $scoringData[1][0] = $c->maketext("SET NAME"); + $scoringData[2][0] = $c->maketext("PROB NUMBER"); + $scoringData[3][0] = $c->maketext("CLOSE DATE"); + $scoringData[4][0] = $c->maketext("CLOSE TIME"); + $scoringData[5][0] = $c->maketext("PROB VALUE"); # Write identifying information about the users @@ -234,7 +225,7 @@ sub scoreSet { $scoringData[$i][$field] = ""; } } - $scoringData[6][$field] = $r->maketext($userInfoColumnHeadings[$field]); + $scoringData[6][$field] = $c->maketext($userInfoColumnHeadings[$field]); for (my $user = 0; $user < @sortedUserIDs; $user++) { my $fieldName = $userInfoFields[$field]; $scoringData[ $user + 7 ][$field] = $Users{ $sortedUserIDs[$user] }->$fieldName; @@ -300,7 +291,7 @@ sub scoreSet { debug("done pre-fetching user problems for set $setID"); # Write the problem data - my $dueDateString = $self->formatDateTime($setRecord->due_date); + my $dueDateString = $c->formatDateTime($setRecord->due_date); my ($dueDate, $dueTime) = $dueDateString =~ /^(.*) at (.*)$/; my $valueTotal = 0; my %userStatusTotals = (); @@ -327,21 +318,21 @@ sub scoreSet { $scoringData[3][$column] = $dueDate; $scoringData[4][$column] = $dueTime; $scoringData[5][$column] = $globalProblem->value; - $scoringData[6][$column] = $r->maketext("STATUS"); + $scoringData[6][$column] = $c->maketext("STATUS"); my $extraColumns = 0; if ($isJitarSet) { $extraColumns++; - $scoringData[6][ $column + $extraColumns ] = $r->maketext("ADJ STATUS"); + $scoringData[6][ $column + $extraColumns ] = $c->maketext("ADJ STATUS"); } if ($scoringItems->{header} and $scoringItems->{problemAttempts}) { # Fill in with blanks, or maybe the problem number $extraColumns++; - $scoringData[6][ $column + $extraColumns ] = $r->maketext("#corr"); + $scoringData[6][ $column + $extraColumns ] = $c->maketext("#corr"); $extraColumns++; - $scoringData[6][ $column + $extraColumns ] = $r->maketext("#incorr"); + $scoringData[6][ $column + $extraColumns ] = $c->maketext("#incorr"); } for (my $row = 0; $row < 6; $row++) { @@ -438,7 +429,7 @@ sub scoreSet { $scoringData[3][$totalsColumn] = ""; $scoringData[4][$totalsColumn] = ""; $scoringData[5][$totalsColumn] = $valueTotal; - $scoringData[6][$totalsColumn] = $r->maketext("total"); + $scoringData[6][$totalsColumn] = $c->maketext("total"); if ($scoringItems->{successIndex}) { $scoringData[0][ $totalsColumn + 1 ] = ""; @@ -447,7 +438,7 @@ sub scoreSet { $scoringData[3][ $totalsColumn + 1 ] = ""; $scoringData[4][ $totalsColumn + 1 ] = ""; $scoringData[5][ $totalsColumn + 1 ] = '100'; - $scoringData[6][ $totalsColumn + 1 ] = $r->maketext("index"); + $scoringData[6][ $totalsColumn + 1 ] = $c->maketext("index"); } for (my $user = 0; $user < @sortedUserIDs; $user++) { $userStatusTotals{$user} = $userStatusTotals{$user} || 0; @@ -462,18 +453,12 @@ sub scoreSet { return @scoringData; } -sub sumScores { # Create a totals column for each student - # Also create columns with percentage grades per assignment if requested - my $self = shift; - my $r_totals = shift; - my $showIndex = shift; - my $r_users = shift; - my $r_sorted_user_ids = shift; - my $addPercentagePerAssignmentColumns = shift; - my $r = $self->r; - my $db = $r->db; - my @scoringData = (); - my $index_increment = ($showIndex) ? 2 : 1; +# Create a totals column for each student +# Also create columns with percentage grades per assignment if requested +sub sumScores ($c, $r_totals, $showIndex, $r_users, $r_sorted_user_ids, $addPercentagePerAssignmentColumns) { + my $db = $c->db; + my @scoringData = (); + my $index_increment = ($showIndex) ? 2 : 1; # This whole thing is a hack, but here goes. We're going to sum the appropriate columns of the totals file: # I believe we have $r_totals->[rows]->[cols] -- the way it's printed out. my $start_column = 6; #The problem column @@ -511,13 +496,13 @@ sub sumScores { # Create a totals column for each student } my @HeaderRowsData0 = ('', ''); - my @HeaderRowsData1 = ($r->maketext('summary'), $r->maketext('%score')); + my @HeaderRowsData1 = ($c->maketext('summary'), $c->maketext('%score')); my @HeaderRowsData2 = ('', ''); if ($addPercentagePerAssignmentColumns) { for (my $j = $start_column; $j <= $last_column; $j += $index_increment) { push(@HeaderRowsData0, ''); push(@HeaderRowsData1, $r_totals->[1]->[$j]); # The assignment number - push(@HeaderRowsData2, $r->maketext('%score')); + push(@HeaderRowsData2, $c->maketext('%score')); } } $scoringData[1] = [@HeaderRowsData1]; @@ -534,22 +519,20 @@ sub sumScores { # Create a totals column for each student # Often it's more efficient to just get everything out of the database # and then pick out what you want later. Hence, these "everything2*" functions -sub everything2info { - my ($self, @everything) = @_; - my @result = (); +sub everything2info ($c, @everything) { + my @result; foreach my $row (@everything) { push @result, [ @{$row}[ 0 .. 4 ] ]; } return @result; } -sub everything2normal { - my ($self, @everything) = @_; - my @result = (); +sub everything2normal ($c, @everything) { + my @result; my $adjstatus = 0; # If its has adjusted status columns we need to include those as well. - my $str = $self->r->maketext('ADJ STATUS'); + my $str = $c->maketext('ADJ STATUS'); if ( grep { grep {/$str/} @@ -580,8 +563,7 @@ sub everything2normal { return @result; } -sub everything2full { - my ($self, @everything) = @_; +sub everything2full ($c, @everything) { my @result = (); foreach my $row (@everything) { push @result, [ @{$row}[ 0 .. ($#{$row} - 1) ] ]; @@ -589,17 +571,15 @@ sub everything2full { return @result; } -sub everything2totals { - my ($self, @everything) = @_; - my @result = (); +sub everything2totals ($c, @everything) { + my @result; foreach my $row (@everything) { push @result, [ ${$row}[ $#{$row} ] ]; } return @result; } -sub appendColumns { - my ($self, $a1, $a2) = @_; +sub appendColumns ($c, $a1, $a2) { my @a1 = @$a1; my @a2 = @$a2; for (my $i = 0; $i < @a1; $i++) { @@ -612,9 +592,7 @@ sub appendColumns { # row of data: # (["c1r1", "c1r2", "c1r3"], ["c2r1", "c2r2", "c2r3"]) # Write a CSV file from an array in the same format that readCSV produces -sub writeCSV { - my ($self, $filename, @csv) = @_; - +sub writeCSV ($c, $filename, @csv) { my @lengths = (); for (my $row = 0; $row < @csv; $row++) { for (my $column = 0; $column < @{ $csv[$row] }; $column++) { @@ -641,7 +619,7 @@ sub writeCSV { foreach my $row (@csv) { my @rowPadded = (); foreach (my $column = 0; $column < @$row; $column++) { - push @rowPadded, $self->pad($row->[$column], $lengths[$column] + 1); + push @rowPadded, $c->pad($row->[$column], $lengths[$column] + 1); } print $fh join(",", @rowPadded); print $fh "\n"; @@ -655,21 +633,19 @@ sub writeCSV { # to use old ww1.x code to read the output anymore, I recommend switching to using # these routines, which are more versatile and compatable with other programs which # deal with CSV files. -sub readStandardCSV { - my ($self, $fileName) = @_; - my @result = (); - my @rows = split m/\n/, readFile($fileName); +sub readStandardCSV ($c, $fileName) { + my @result; + my @rows = split m/\n/, readFile($fileName); foreach my $row (@rows) { - push @result, [ $self->splitQuoted($row) ]; + push @result, [ $c->splitQuoted($row) ]; } return @result; } -sub writeStandardCSV { - my ($self, $filename, @csv) = @_; +sub writeStandardCSV ($c, $filename, @csv) { open my $fh, ">:encoding(UTF-8)", $filename; foreach my $row (@csv) { - print $fh (join ",", map { $self->quote($_) } @$row); + print $fh (join ",", map { $c->quote($_) } @$row); print $fh "\n"; } close $fh; @@ -679,8 +655,7 @@ sub writeStandardCSV { # This particular unquote method unquotes (optionally) quoted strings in the # traditional CSV style (double-quote for literal quote, etc.) -sub unquote { - my ($self, $string) = @_; +sub unquote ($c, $string) { if ($string =~ m/^"(.*)"$/) { $string = $1; $string =~ s/""/"/; @@ -690,8 +665,7 @@ sub unquote { # Should you wish to treat whitespace differently, this routine has been designed # to make it easy to do so. -sub splitQuoted { - my ($self, $string) = @_; +sub splitQuoted ($c, $string) { my ($leadingSpace, $preText, $quoted, $postText, $trailingSpace, $result); my @result = (); my $continue = 1; @@ -722,8 +696,7 @@ sub splitQuoted { } # This particular quoting method does CSV-style (double a quote to escape it) quoting when necessary. -sub quote { - my ($self, $string) = @_; +sub quote ($c, $string) { if ($string =~ m/[", ]/) { $string =~ s/"/""/; $string = "\"$string\""; @@ -731,18 +704,16 @@ sub quote { return $string; } -sub pad { - my ($self, $string, $padTo) = @_; - $string = '' unless defined $string; - return $string unless $self->{padFields} == 1; +sub pad ($c, $string, $padTo) { + $string = '' unless defined $string; + return $string unless $c->{padFields} == 1; my $spaces = $padTo - length $string; # return " "x$spaces.$string; return $string . " " x $spaces; } -sub maxLength { - my ($self, $arrayRef) = @_; +sub maxLength ($c, $arrayRef) { my $max = 0; foreach my $cell (@$arrayRef) { $max = length $cell unless length $cell < $max; diff --git a/lib/WeBWorK/ContentGenerator/Instructor/ScoringDownload.pm b/lib/WeBWorK/ContentGenerator/Instructor/ScoringDownload.pm index 0264290193..ebac76381a 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/ScoringDownload.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/ScoringDownload.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::Instructor::ScoringDownload; -use parent qw(WeBWorK::ContentGenerator); +use Mojo::Base 'WeBWorK::ContentGenerator', -signatures; =head1 NAME @@ -22,37 +22,32 @@ WeBWorK::ContentGenerator::Instructor::ScoringDownload - Download scoring data f =cut -use strict; -use warnings; - # FIXME: This should be integrated into scoring.pm, and this file deleted. use WeBWorK::ContentGenerator::Instructor::FileManager; -async sub pre_header_initialize { - my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; - my $authz = $r->authz; +sub pre_header_initialize ($c) { + my $ce = $c->ce; + my $authz = $c->authz; my $scoringDir = $ce->{courseDirs}->{scoring}; - my $file = $r->param('getFile'); - my $user = $r->param('user'); + my $file = $c->param('getFile'); + my $user = $c->param('user'); # the parameter 'getFile" needs to be sanitized. (see bug #3793 ) # See checkName in FileManager.pm for a more complete sanitization. if ($authz->hasPermissions($user, "score_sets")) { unless ($file eq WeBWorK::ContentGenerator::Instructor::FileManager::checkName($file)) { # - $self->addbadmessage($r->maketext("Your file name is not valid! ")); - $self->addbadmessage($r->maketext( + $c->addbadmessage($c->maketext("Your file name is not valid! ")); + $c->addbadmessage($c->maketext( "A file name cannot begin with a dot, it cannot be empty, it cannot contain a " . "directory path component and only the characters -_.a-zA-Z0-9 and space are allowed." )); } else { - $self->reply_with_file("text/comma-separated-values", "$scoringDir/$file", $file, 0); + $c->reply_with_file("text/comma-separated-values", "$scoringDir/$file", $file, 0); # 0==don't delete file after downloading } } else { - $self->addbadmessage("You do not have permission to access scoring data."); + $c->addbadmessage("You do not have permission to access scoring data."); } return; diff --git a/lib/WeBWorK/ContentGenerator/Instructor/SendMail.pm b/lib/WeBWorK/ContentGenerator/Instructor/SendMail.pm index 4da6e31235..492511541f 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/SendMail.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/SendMail.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::Instructor::SendMail; -use parent qw(WeBWorK::ContentGenerator); +use Mojo::Base 'WeBWorK::ContentGenerator', -signatures; =head1 NAME @@ -22,9 +22,6 @@ WeBWorK::ContentGenerator::Instructor::SendMail - Entry point for User-specific =cut -use strict; -use warnings; - use Email::Address::XS; use Email::Stuffer; use Try::Tiny; @@ -34,16 +31,14 @@ use Text::Wrap qw(wrap); use WeBWorK::Debug; use WeBWorK::Utils::Instructor qw(read_dir); -sub initialize { - my ($self) = @_; - my $r = $self->r; - my $db = $r->db; - my $ce = $r->ce; - my $authz = $r->authz; - my $user = $r->param('user'); +sub initialize ($c) { + my $db = $c->db; + my $ce = $c->ce; + my $authz = $c->authz; + my $user = $c->param('user'); my @selected_filters; - if (defined($r->param('classList!filter'))) { @selected_filters = $r->param('classList!filter'); } + if (defined($c->param('classList!filter'))) { @selected_filters = $c->param('classList!filter'); } else { @selected_filters = ("all"); } # Check permissions @@ -55,9 +50,9 @@ sub initialize { my $scoringDirectory = $ce->{courseDirs}->{scoring}; my $templateDirectory = $ce->{courseDirs}->{templates}; - my $openfilename = $r->param('openfilename'); - my $savefilename = $r->param('savefilename'); - my $mergefile = $r->param('merge_file'); + my $openfilename = $c->param('openfilename'); + my $savefilename = $c->param('savefilename'); + my $mergefile = $c->param('merge_file'); #FIXME get these values from global course environment (see subroutines as well) my $default_msg_file = 'default.msg'; @@ -82,19 +77,19 @@ sub initialize { # Figure out action from submit data my $action = ''; - if ($r->param('sendEmail')) { + if ($c->param('sendEmail')) { $action = 'sendEmail'; - } elsif ($r->param('saveMessage')) { + } elsif ($c->param('saveMessage')) { $action = 'saveMessage'; - } elsif ($r->param('saveAs')) { + } elsif ($c->param('saveAs')) { $action = 'saveAs'; - } elsif ($r->param('saveDefault')) { + } elsif ($c->param('saveDefault')) { $action = 'saveDefault'; - } elsif ($r->param('openMessage')) { + } elsif ($c->param('openMessage')) { $action = 'openMessage'; - } elsif ($r->param('updateSettings')) { + } elsif ($c->param('updateSettings')) { $action = 'updateSettings'; - } elsif ($r->param('previewMessage')) { + } elsif ($c->param('previewMessage')) { $action = 'previewMessage'; } @@ -102,18 +97,18 @@ sub initialize { my $ur = $db->getUser($user); # Store data - $self->{defaultFrom} = $ur->rfc822_mailbox; - $self->{defaultReply} = $ur->rfc822_mailbox; - $self->{defaultSubject} = $self->r->urlpath->arg("courseID") . " notice"; + $c->{defaultFrom} = $ur->rfc822_mailbox; + $c->{defaultReply} = $ur->rfc822_mailbox; + $c->{defaultSubject} = $c->stash('courseID') . ' notice'; - $self->{rows} = (defined($r->param('rows'))) ? $r->param('rows') : $ce->{mail}->{editor_window_rows}; - $self->{columns} = (defined($r->param('columns'))) ? $r->param('columns') : $ce->{mail}->{editor_window_columns}; - $self->{default_msg_file} = $default_msg_file; - $self->{old_default_msg_file} = $old_default_msg_file; - $self->{merge_file} = $mergefile; + $c->{rows} = (defined($c->param('rows'))) ? $c->param('rows') : $ce->{mail}->{editor_window_rows}; + $c->{columns} = (defined($c->param('columns'))) ? $c->param('columns') : $ce->{mail}->{editor_window_columns}; + $c->{default_msg_file} = $default_msg_file; + $c->{old_default_msg_file} = $old_default_msg_file; + $c->{merge_file} = $mergefile; - my @classList = (defined($r->param('classList'))) ? $r->param('classList') : ($user); - $self->{preview_user} = $classList[0] || $user; + my @classList = (defined($c->param('classList'))) ? $c->param('classList') : ($user); + $c->{preview_user} = $classList[0] || $user; # Gather database data # Get all users except set level proctors and practice users. If the current user has restrictions on viewable @@ -137,18 +132,18 @@ sub initialize { @Users = grep { $ce->status_abbrev_has_behavior($_->status, "include_in_email") } @Users; # Cache the user records for later use. - $self->{ra_user_records} = \@Users; + $c->{ra_user_records} = \@Users; # Gather list of recipients my @send_to; - my $recipients = $r->param('send_to') // ''; + my $recipients = $c->param('send_to') // ''; if ($recipients eq 'all_students') { @send_to = map { $_->user_id } @Users; } elsif ($recipients eq 'studentID') { - @send_to = $r->param('classList'); + @send_to = $c->param('classList'); } - $self->{ra_send_to} = \@send_to; + $c->{ra_send_to} = \@send_to; # Check the validity of the input file name my $input_file = ''; @@ -159,7 +154,7 @@ sub initialize { if (-R "${emailDirectory}/$openfilename") { $input_file = $openfilename; } else { - $self->addbadmessage($r->maketext( + $c->addbadmessage($c->maketext( 'The file [_1] is not readable by the webserver. ' . q{Check that it's permissions are set correctly.}, "$emailDirectory/$openfilename" @@ -167,19 +162,18 @@ sub initialize { } } else { $input_file = $default_msg_file; - $self->addbadmessage($r->maketext( + $c->addbadmessage($c->maketext( 'The file [_1] cannot be found. ' . 'Check whether it exists and whether the directory [_2] can be read by the webserver. ', "$emailDirectory/$openfilename", $emailDirectory )); - $self->addbadmessage( - $r->maketext('Using contents of the default message [_1] instead.', $default_msg_file)); + $c->addbadmessage($c->maketext('Using contents of the default message [_1] instead.', $default_msg_file)); } } else { $input_file = $default_msg_file; } - $self->{input_file} = $input_file; + $c->{input_file} = $input_file; # Determine the file name to save message into my $output_file = 'FIXME no output file specified'; @@ -189,7 +183,7 @@ sub initialize { if (defined($savefilename) and $savefilename) { $output_file = $savefilename; } else { - $self->addbadmessage($r->maketext('No filename was specified for saving! The message was not saved.')); + $c->addbadmessage($c->maketext('No filename was specified for saving! The message was not saved.')); } } elsif (defined($input_file)) { $output_file = $input_file; @@ -197,59 +191,59 @@ sub initialize { # Sanity check on save file name if ($output_file =~ /^[~.]/ || $output_file =~ /\.\./) { - $self->addbadmessage($r->maketext( + $c->addbadmessage($c->maketext( 'For security reasons, you cannot specify a message file from a directory higher than the ' . q{email directory (you can't use ../blah/blah for example). } . 'Please specify a different file or move the needed file to the email directory.' )); } unless ($output_file =~ m|\.msg$|) { - $self->addbadmessage($r->maketext( + $c->addbadmessage($c->maketext( 'Invalid file name "[_1]". All email file names must end with the ".msg" extension. ' . 'Choose a file name with the ".msg" extension. The message was not saved.', $output_file )); } - $self->{output_file} = $output_file; + $c->{output_file} = $output_file; # Determine input source my $input_source; if ($action) { - $input_source = (defined($r->param('body')) and $action ne 'openMessage') ? 'form' : 'file'; + $input_source = (defined($c->param('body')) and $action ne 'openMessage') ? 'form' : 'file'; } else { - $input_source = (defined($r->param('body'))) ? 'form' : 'file'; + $input_source = (defined($c->param('body'))) ? 'form' : 'file'; } # Get inputs my ($from, $replyTo, $r_text, $subject); if ($input_source eq 'file') { - ($from, $replyTo, $subject, $r_text) = $self->read_input_file("$emailDirectory/$input_file"); + ($from, $replyTo, $subject, $r_text) = $c->read_input_file("$emailDirectory/$input_file"); } elsif ($input_source eq 'form') { # read info from the form # bail if there is no message body - $from = $r->param('from'); - $replyTo = $r->param('replyTo'); - $subject = $r->param('subject'); - my $body = $r->param('body'); + $from = $c->param('from'); + $replyTo = $c->param('replyTo'); + $subject = $c->param('subject'); + my $body = $c->param('body'); # Sanity check: body must contain non-white space - $self->addbadmessage($r->maketext('You didn\'t enter any message.')) - unless $r->param('body') =~ /\S/; + $c->addbadmessage($c->maketext('You didn\'t enter any message.')) + unless $c->param('body') =~ /\S/; $r_text = \$body; } - my $remote_host = $r->useragent_ip || "UNKNOWN"; + my $remote_host = $c->tx->remote_address || "UNKNOWN"; # Store data - $self->{from} = $from; - $self->{replyTo} = $replyTo; - $self->{subject} = $subject; - $self->{remote_host} = $remote_host; - $self->{r_text} = $r_text; + $c->{from} = $from; + $c->{replyTo} = $replyTo; + $c->{subject} = $subject; + $c->{remote_host} = $remote_host; + $c->{r_text} = $r_text; #Determine the appropriate script action from the buttons # first time actions @@ -272,7 +266,7 @@ sub initialize { # error actions (various) # if no form is submitted, gather data needed to produce the mail form and return - my $to = $r->param('To'); + my $to = $c->param('To'); my $script_action = ''; if (not $action @@ -304,7 +298,7 @@ sub initialize { # overwrite protection if ($action eq 'saveAs' and -e "$emailDirectory/$output_file") { - $self->addbadmessage($r->maketext( + $c->addbadmessage($c->maketext( 'The file [_1] already exists and cannot be overwritten. The message was not saved.', "$emailDirectory/$openfilename" )); @@ -316,108 +310,101 @@ sub initialize { rename("$emailDirectory/$default_msg_file", "$emailDirectory/$old_default_msg_file") or die "Can't rename $emailDirectory/$default_msg_file to $emailDirectory/$old_default_msg_file ", "Check permissions for webserver on directory $emailDirectory. $!"; - $self->addgoodmessage($r->maketext('Backup file [_1] created.', "$emailDirectory/$old_default_msg_file"),); + $c->addgoodmessage($c->maketext('Backup file [_1] created.', "$emailDirectory/$old_default_msg_file"),); } # Save the message - $self->saveMessageFile($temp_body, "${emailDirectory}/$output_file") + $c->saveMessageFile($temp_body, "${emailDirectory}/$output_file") unless ($output_file =~ /^[~.]/ || $output_file =~ /\.\./ || $output_file !~ m|\.msg$|); unless (!-w "${emailDirectory}/$output_file") { # if there are no errors report success - $self->addgoodmessage($r->maketext('Message saved to file [_1].', "$emailDirectory/$output_file")); - $self->{input_file} = $output_file; + $c->addgoodmessage($c->maketext('Message saved to file [_1].', "$emailDirectory/$output_file")); + $c->{input_file} = $output_file; $db->setSettingValue("${user}_openfile", $output_file); } } elsif ($action eq 'previewMessage') { - $self->{response} = 'preview'; + $c->{response} = 'preview'; } elsif ($action eq 'sendEmail') { # verify format of From address (one valid rfc2822/rfc5322 address) - my @parsed_from_addrs = Email::Address::XS->parse($self->{from}); + my @parsed_from_addrs = Email::Address::XS->parse($c->{from}); unless (@parsed_from_addrs == 1) { - $self->addbadmessage($r->maketext("From field must contain one valid email address.")); + $c->addbadmessage($c->maketext("From field must contain one valid email address.")); return; } # verify format of Reply-to address (zero or more valid rfc2822/ref5322 addresses) - if (defined $self->{replyTo} and $self->{replyTo} ne "") { - my @parsed_replyto_addrs = Email::Address::XS->parse($self->{replyTo}); + if (defined $c->{replyTo} and $c->{replyTo} ne "") { + my @parsed_replyto_addrs = Email::Address::XS->parse($c->{replyTo}); unless (@parsed_replyto_addrs > 0) { - $self->addbadmessage($r->maketext("Invalid Reply-to address.")); + $c->addbadmessage($c->maketext("Invalid Reply-to address.")); return; } } # Check that recipients have been selected. - unless (@{ $self->{ra_send_to} }) { - $self->addbadmessage( - $r->maketext('No recipients selected. Please select one or more recipients from the list below.')); + unless (@{ $c->{ra_send_to} }) { + $c->addbadmessage( + $c->maketext('No recipients selected. Please select one or more recipients from the list below.')); return; } # get merge file - my $merge_file = (defined($self->{merge_file})) ? $self->{merge_file} : 'None'; - my $delimiter = ','; - my $rh_merge_data = $self->read_scoring_file("$merge_file", "$delimiter"); + my $merge_file = (defined($c->{merge_file})) ? $c->{merge_file} : 'None'; + my $rh_merge_data = $c->read_scoring_file($merge_file); unless (ref($rh_merge_data)) { - $self->addbadmessage($r->maketext("No merge data file")); - $self->addbadmessage($r->maketext("Can't read merge file [_1]. No message sent", $merge_file)); + $c->addbadmessage($c->maketext("No merge data file")); + $c->addbadmessage($c->maketext("Can't read merge file [_1]. No message sent", $merge_file)); return; } - $self->{rh_merge_data} = $rh_merge_data; + $c->{rh_merge_data} = $rh_merge_data; # we don't set the response until we're sure that email can be sent - $self->{response} = 'send_email'; + $c->{response} = 'send_email'; # FIXME i'm not sure why we're pulling this out here -- mail_message_to_recipients does have # access to the course environment and should just grab it directly - $self->{smtpServer} = $ce->{mail}->{smtpServer}; + $c->{smtpServer} = $ce->{mail}->{smtpServer}; # Do actual mailing in the after the response is sent, since it could take a long time # FIXME we need to do a better job providing status notifications for long-running email jobs Mojo::IOLoop->timer( 1 => sub { # catch exceptions generated during the sending process - my $result_message = eval { $self->mail_message_to_recipients() }; + my $result_message = eval { $c->mail_message_to_recipients() }; if ($@) { # add the die message to the result message $result_message .= "An error occurred while trying to send email.\n" . "The error message is:\n\n$@\n\n"; # and also write it to the Mojolicious log - $r->log->error("An error occurred while trying to send email: $@\n"); + $c->log->error("An error occurred while trying to send email: $@\n"); } # this could fail too... - eval { $self->email_notification($result_message) }; + eval { $c->email_notification($result_message) }; if ($@) { - $r->log->error("An error occured while trying to send the email notification: $@\n"); + $c->log->error("An error occured while trying to send the email notification: $@\n"); } } ); } else { - $self->addbadmessage($r->maketext("Didn't recognize action")); + $c->addbadmessage($c->maketext("Didn't recognize action")); } return; } -sub print_preview { - my ($self) = @_; - my $r = $self->r; - my $urlpath = $r->urlpath; - my $setID = $urlpath->arg("setID"); - +sub print_preview ($c) { # Get preview user - my $ur = $r->db->getUser($self->{preview_user}); - die "record for preview user " . $self->{preview_user} . " not found." unless $ur; + my $ur = $c->db->getUser($c->{preview_user}); + die "record for preview user " . $c->{preview_user} . " not found." unless $ur; # Get merge file - my $merge_file = (defined($self->{merge_file})) ? $self->{merge_file} : 'None'; - my $delimiter = ','; - my $rh_merge_data = $self->read_scoring_file("$merge_file", "$delimiter"); + my $merge_file = (defined($c->{merge_file})) ? $c->{merge_file} : 'None'; + my $rh_merge_data = $c->read_scoring_file($merge_file); - my ($msg, $preview_header) = $self->process_message($ur, $rh_merge_data, 1); # 1 == for preview + my ($msg, $preview_header) = $c->process_message($ur, $rh_merge_data, 1); # 1 == for preview - my $recipients = join(" ", @{ $self->{ra_send_to} }); + my $recipients = join(" ", @{ $c->{ra_send_to} }); # The content in message is going to be displayed in HTML. # It needs to have html entities escaped to avoid problems with things like . @@ -425,9 +412,9 @@ sub print_preview { $msg = join( "", "To: ", $ur->email_address, "\n", - "From: ", $self->{from}, "\n", - "Reply-To: ", $self->{replyTo}, "\n", - "Subject: ", $self->{subject}, "\n", + "From: ", $c->{from}, "\n", + "Reply-To: ", $c->{replyTo}, "\n", + "Subject: ", $c->{subject}, "\n", # In a real mails we would UTF-8 encode the message and give the Content-Type header. For the preview which is # displayed as html, just add the header, but do NOT use Encode::encode("UTF-8",$msg). "Content-Type: text/plain; charset=UTF-8\n\n", @@ -435,7 +422,7 @@ sub print_preview { "\n" ); - return $r->include( + return $c->include( 'ContentGenerator/Instructor/SendMail/preview', preview_header => $preview_header, ur => $ur, @@ -444,38 +431,28 @@ sub print_preview { ); } -sub print_form { - my ($self) = @_; - return $self->r->include('ContentGenerator/Instructor/SendMail/main_form'); -} - # Utility methods -sub saveMessageFile { - my ($self, $body, $msgFileName) = @_; - +sub saveMessageFile ($c, $body, $msgFileName) { open(my $PROBLEM, ">:encoding(UTF-8)", $msgFileName) - || $self->addbadmessage("Could not open $msgFileName for writing. " + || $c->addbadmessage("Could not open $msgFileName for writing. " . 'Check that the permissions for this file are 660 (-rw-rw----).'); print $PROBLEM $body if -w $msgFileName; close $PROBLEM; chmod 0660, "$msgFileName" - || $self->addbadmessage("CAN'T CHANGE PERMISSIONS ON FILE $msgFileName"); + || $c->addbadmessage("CAN'T CHANGE PERMISSIONS ON FILE $msgFileName"); return; } -sub read_input_file { - my ($self, $filePath) = @_; - my $r = $self->r; - +sub read_input_file ($c, $filePath) { my ($text, @text); my $header = ''; my ($subject, $from, $replyTo); if (-e "$filePath" and -r "$filePath") { open my $FILE, "<:encoding(UTF-8)", $filePath - or do { $self->addbadmessage($r->maketext(q{Can't open [_1]}, $filePath)); return }; + or do { $c->addbadmessage($c->maketext(q{Can't open [_1]}, $filePath)); return }; while ($header !~ s/Message:\s*$//m and not eof($FILE)) { $header .= <$FILE>; } @@ -484,44 +461,40 @@ sub read_input_file { $text =~ s/^\s*//; # remove initial white space if any. $header =~ /^From:\s(.*)$/m; - $from = $1 or $from = $self->{defaultFrom}; + $from = $1 or $from = $c->{defaultFrom}; $header =~ /^Reply-To:\s(.*)$/m; - $replyTo = $1 or $replyTo = $self->{defaultReply}; + $replyTo = $1 or $replyTo = $c->{defaultReply}; $header =~ /^Subject:\s(.*)$/m; $subject = $1; } else { - $from = $self->{defaultFrom}; - $replyTo = $self->{defaultReply}; + $from = $c->{defaultFrom}; + $replyTo = $c->{defaultReply}; $text = (-e "$filePath") ? "FIXME file $filePath can't be read" : "FIXME file $filePath doesn't exist"; - $subject = $self->{defaultSubject}; + $subject = $c->{defaultSubject}; } return ($from, $replyTo, $subject, \$text); } -sub get_message_file_names { - my $self = shift; - return read_dir($self->{ce}{courseDirs}{email}, '\\.msg$'); +sub get_message_file_names ($c) { + return read_dir($c->{ce}{courseDirs}{email}, '\\.msg$'); } -sub get_merge_file_names { - my $self = shift; +sub get_merge_file_names ($c) { # FIXME: Check that only readable files are listed. - return 'None', read_dir($self->{ce}{courseDirs}{scoring}, '\\.csv$'); + return 'None', read_dir($c->{ce}{courseDirs}{scoring}, '\\.csv$'); } -sub mail_message_to_recipients { - my $self = shift; - my $r = $self->r; - my $ce = $r->ce; - my $subject = $self->{subject}; - my $from = $self->{from}; - my @recipients = @{ $self->{ra_send_to} }; - my $rh_merge_data = $self->{rh_merge_data}; - my $merge_file = $self->{merge_file}; +sub mail_message_to_recipients ($c) { + my $ce = $c->ce; + my $subject = $c->{subject}; + my $from = $c->{from}; + my @recipients = @{ $c->{ra_send_to} }; + my $rh_merge_data = $c->{rh_merge_data}; + my $merge_file = $c->{merge_file}; my $result_message = ''; my $failed_messages = 0; my $error_messages = ''; @@ -529,7 +502,7 @@ sub mail_message_to_recipients { for my $recipient (@recipients) { $error_messages = ''; - my $ur = $self->{db}->getUser($recipient); + my $ur = $c->db->getUser($recipient); unless ($ur) { $error_messages .= "Record for user $recipient not found\n"; next; @@ -539,11 +512,11 @@ sub mail_message_to_recipients { next; } - my $msg = eval { $self->process_message($ur, $rh_merge_data) }; + my $msg = eval { $c->process_message($ur, $rh_merge_data) }; $error_messages .= "There were errors in processing user $recipient, merge file $merge_file. \n$@\n" if $@; my $email = Email::Stuffer->to($ur->email_address)->from($from)->subject($subject)->text_body($msg) - ->header('X-Remote-Host' => $self->{remote_host}); + ->header('X-Remote-Host' => $c->{remote_host}); # $ce->{mail}{set_return_path} is the address used to report returned email if defined and non empty. # It is an argument used in sendmail() (aka Email::Stuffer::send_or_die). @@ -555,7 +528,7 @@ sub mail_message_to_recipients { try { $email->send_or_die({ # createEmailSenderTransportSMTP is defined in ContentGenerator - transport => $self->createEmailSenderTransportSMTP(), + transport => $c->createEmailSenderTransportSMTP(), $ce->{mail}{set_return_path} ? (from => $ce->{mail}{set_return_path}) : () }); debug 'email sent successfully to ' . $ur->email_address; @@ -566,7 +539,7 @@ sub mail_message_to_recipients { next; }; - $result_message .= $r->maketext("Message sent to [_1] at [_2].", $recipient, $ur->email_address) . "\n" + $result_message .= $c->maketext("Message sent to [_1] at [_2].", $recipient, $ur->email_address) . "\n" unless $error_messages; } continue { #update failed messages before continuing loop if ($error_messages) { @@ -574,44 +547,38 @@ sub mail_message_to_recipients { $result_message .= $error_messages; } } - my $courseName = $self->r->urlpath->arg("courseID"); my $number_of_recipients = scalar(@recipients) - $failed_messages; - return $r->maketext( - "A message with the subject line \"[_1]\" has been sent to [quant,_2,recipient] in the class [_3]. " - . "There were [_4] message(s) that could not be sent.", - $subject, $number_of_recipients, $courseName, $failed_messages) + return $c->maketext( + 'A message with the subject line "[_1]" has been sent to [quant,_2,recipient] in the class [_3]. ' + . 'There were [_4] message(s) that could not be sent.', + $subject, $number_of_recipients, $c->stash('courseID'), $failed_messages + ) . "\n\n" . $result_message; } -sub email_notification { - my ($self, $result_message) = @_; - my $ce = $self->r->ce; +sub email_notification ($c, $result_message) { + my $ce = $c->ce; - my $email = Email::Stuffer->to($self->{defaultFrom})->from($self->{defaultFrom})->subject('WeBWorK email sent') - ->text_body($result_message)->header('X-Remote-Host' => $self->{remote_host}); + my $email = Email::Stuffer->to($c->{defaultFrom})->from($c->{defaultFrom})->subject('WeBWorK email sent') + ->text_body($result_message)->header('X-Remote-Host' => $c->{remote_host}); try { $email->send_or_die({ # createEmailSenderTransportSMTP is defined in ContentGenerator - transport => $self->createEmailSenderTransportSMTP(), + transport => $c->createEmailSenderTransportSMTP(), $ce->{mail}{set_return_path} ? (from => $ce->{mail}{set_return_path}) : () }); } catch { - $self->r->log->error("Error sending email: $_"); + $c->log->error("Error sending email: $_"); }; - $self->r->log->info("\nWW::Instructor::SendMail:: instructor message sent from $self->{defaultFrom}\n"); + $c->log->info("\nWW::Instructor::SendMail:: instructor message sent from $c->{defaultFrom}\n"); return; } -sub getRecord { - my $self = shift; - my $line = shift; - my $delimiter = shift; - $delimiter = ',' unless defined($delimiter); - +sub getRecord ($c, $line, $delimiter = ',') { # Takes a delimited line as a parameter and returns an # array. Note that all white space is removed. If the # last field is empty, the last element of the returned @@ -626,16 +593,11 @@ sub getRecord { return @lineArray; } -sub process_message { - my $self = shift; - my $ur = shift; - my $rh_merge_data = shift; - my $for_preview = shift; - my $r = $self->r; - my $text = defined($self->{r_text}) ? ${ $self->{r_text} } : 'FIXME no text was produced by initialization!!'; - my $merge_file = (defined($self->{merge_file})) ? $self->{merge_file} : 'None'; +sub process_message ($c, $ur, $rh_merge_data, $for_preview) { + my $text = defined($c->{r_text}) ? ${ $c->{r_text} } : 'FIXME no text was produced by initialization!!'; + my $merge_file = (defined($c->{merge_file})) ? $c->{merge_file} : 'None'; - my $status_name = $self->r->ce->status_abbrev_to_name($ur->status); + my $status_name = $c->ce->status_abbrev_to_name($ur->status); $status_name = $ur->status unless defined $status_name; #user macros that can be used in the email message @@ -652,7 +614,7 @@ sub process_message { # FIXME this is inefficient. The info should be cached my @COL = defined($rh_merge_data->{$SID}) ? @{ $rh_merge_data->{$SID} } : (); if ($merge_file ne 'None' and not defined($rh_merge_data->{$SID}) and $for_preview) { - $self->addbadmessage("No merge data for student id: $SID, name: $FN $LN, login: $LOGIN"); + $c->addbadmessage("No merge data for student id: $SID, name: $FN $LN, login: $LOGIN"); } unshift(@COL, ""); ## this makes COL[1] the first column my $endCol = @COL; @@ -678,19 +640,17 @@ sub process_message { if ($for_preview) { my @preview_COL = @COL; shift @preview_COL; # shift back for preview - return $msg, $r->c('', $self->data_format(1 .. ($#COL)), '
      ', $self->data_format2(@preview_COL))->join(' '); + return $msg, $c->c('', $c->data_format(1 .. ($#COL)), '
      ', $c->data_format2(@preview_COL))->join(' '); } else { return $msg; } } -sub data_format { - my ($self, @data) = @_; +sub data_format ($c, @data) { return map { "COL[$_]" . ' ' x (3 - length($_)) } @data; # problems if $_ has length bigger than 4 } -sub data_format2 { - my ($self, @data) = @_; +sub data_format2 ($c, @data) { return map { $_ =~ s/\s/ /gr } map { sprintf('%-8.8s', $_) } @data; } diff --git a/lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm b/lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm index 2dea730e89..e0e5f0a4cb 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::Instructor::SetMaker; -use parent qw(WeBWorK::ContentGenerator); +use Mojo::Base 'WeBWorK::ContentGenerator', -signatures; =head1 NAME @@ -22,9 +22,6 @@ WeBWorK::ContentGenerator::Instructor::SetMaker - Make homework sets. =cut -use strict; -use warnings; - use File::Find; use Mojo::File; @@ -55,10 +52,8 @@ my %ignoredir = ( 'achievements' => 1, ); -sub prepare_activity_entry { - my $self = shift; - my $r = $self->r; - my $user = $self->r->param('user') || 'NO_USER'; +sub prepare_activity_entry ($c) { + my $user = $c->param('user') || 'NO_USER'; return ("In SetMaker as user $user"); } @@ -81,10 +76,7 @@ sub prepare_activity_entry { ## always listed as a separate directory even if it contains only one ## pg file. -sub get_library_sets { - my $self = shift; - my $top = shift; - my $dir = shift; +sub get_library_sets ($c, $top, $dir) { # ignore directories that give us an error my @lis = eval { readDirectory($dir) }; if ($@) { @@ -103,14 +95,14 @@ sub get_library_sets { my @pgdirs; my @dirs = grep { !$ignoredir{$_} && -d "$dir/$_" } @lis; if ($top == 1) { - @dirs = grep { !$self->{problibs}{$_} } @dirs; + @dirs = grep { !$c->{problibs}{$_} } @dirs; } # Never include Library or Contrib at the top level if ($top == 1) { @dirs = grep { $_ ne 'Library' && $_ ne 'Contrib' } @dirs; } foreach my $subdir (@dirs) { - my @results = $self->get_library_sets(0, "$dir/$subdir"); + my @results = $c->get_library_sets(0, "$dir/$subdir"); $pgcount += shift @results; push(@pgdirs, @results); } @@ -119,12 +111,8 @@ sub get_library_sets { return (0, @pgdirs, $dir); } -sub get_library_pgs { - my $self = shift; - my $top = shift; - my $base = shift; - my $dir = shift; - my @lis = readDirectory("$base/$dir"); +sub get_library_pgs ($c, $top, $base, $dir) { + my @lis = readDirectory("$base/$dir"); return () if (grep {/^=library-ignore$/} @lis); return () if !$top && (grep {/^=library-no-combine$/} @lis); @@ -134,36 +122,32 @@ sub get_library_pgs { my @dirs = grep { !$ignoredir{$_} && -d "$base/$dir/$_" } @lis; if ($top == 1) { - @dirs = grep { !$self->{problibs}{$_} } @dirs; + @dirs = grep { !$c->{problibs}{$_} } @dirs; } - foreach my $subdir (@dirs) { push(@pgs, $self->get_library_pgs(0, "$base/$dir", $subdir)) } + foreach my $subdir (@dirs) { push(@pgs, $c->get_library_pgs(0, "$base/$dir", $subdir)) } return unless $top || (scalar(@pgs) == 1 && $others) || (grep {/^=library-combine-up$/} @lis); return (map {"$dir/$_"} @pgs); } -sub list_pg_files { - my ($self, $templates, $dir) = @_; +sub list_pg_files ($c, $templates, $dir) { my $top = ($dir eq '.') ? 1 : 2; - my @pgs = $self->get_library_pgs($top, $templates, $dir); + my @pgs = $c->get_library_pgs($top, $templates, $dir); return sortByName(undef, @pgs); } ## Try to make reading of set defs more flexible. Additional strategies ## for fixing a path can be added here. -sub munge_pg_file_path { - my $self = shift; - my $pg_path = shift; - my $path_to_set_def = shift; - my $end_path = $pg_path; +sub munge_pg_file_path ($c, $pg_path, $path_to_set_def) { + my $end_path = $pg_path; # if the path is ok, don't fix it - return ($pg_path) if (-e $self->r->ce->{courseDirs}{templates} . "/$pg_path"); + return ($pg_path) if (-e $c->ce->{courseDirs}{templates} . "/$pg_path"); # if we have followed a link into a self contained course to get # to the set.def file, we need to insert the start of the path to # the set.def file $end_path = "$path_to_set_def/$pg_path"; - return ($end_path) if (-e $self->r->ce->{courseDirs}{templates} . "/$end_path"); + return ($end_path) if (-e $c->ce->{courseDirs}{templates} . "/$end_path"); # if we got this far, this path is bad, but we let it produce # an error so the user knows there is a troublesome path in the # set.def file. @@ -173,15 +157,12 @@ sub munge_pg_file_path { ## Problems straight from the OPL database come with MO and static ## tag information. This is for other times, like next/prev page. -sub getDBextras { - my ($self, $sourceFileName) = @_; - my $r = $self->r; - +sub getDBextras ($c, $sourceFileName) { if ($sourceFileName =~ /^Library/) { - return @{ WeBWorK::Utils::ListingDB::getDBextras($r, $sourceFileName) }; + return @{ WeBWorK::Utils::ListingDB::getDBextras($c, $sourceFileName) }; } - my $filePath = $r->ce->{courseDirs}{templates} . "/$sourceFileName"; + my $filePath = $c->ce->{courseDirs}{templates} . "/$sourceFileName"; my $tag_obj = WeBWorK::Utils::Tags->new($filePath); my $isMO = $tag_obj->{MO} || 0; my $isstatic = $tag_obj->{Static} || 0; @@ -225,10 +206,8 @@ sub end_prob_group { ## Read a set definition file. This could be abstracted since it happens ## elsewhere. Here we don't have to process so much of the file. -sub read_set_def { - my ($self, $filePathOrig) = @_; - my $r = $self->r; - my $filePath = $r->ce->{courseDirs}{templates} . "/$filePathOrig"; +sub read_set_def ($c, $filePathOrig) { + my $filePath = $c->ce->{courseDirs}{templates} . "/$filePathOrig"; $filePathOrig =~ s/set.*\.def$//; $filePathOrig =~ s|/$||; $filePathOrig = "." if ($filePathOrig !~ /\S/); @@ -258,11 +237,11 @@ sub read_set_def { } close $SETFILENAME; } else { - $self->addbadmessage($r->maketext("Cannot open [_1]", $filePath)); + $c->addbadmessage($c->maketext("Cannot open [_1]", $filePath)); } # This is where we would potentially munge the pg file paths # One possibility - @pg_files = map { $self->munge_pg_file_path($_, $filePathOrig) } @pg_files; + @pg_files = map { $c->munge_pg_file_path($_, $filePathOrig) } @pg_files; return (@pg_files); } @@ -270,15 +249,14 @@ sub read_set_def { ## and whether or not they are selected, and whether or not they should ## be hidden -sub get_past_problem_files { - my $r = shift; +sub get_past_problem_files ($c) { my @found = (); my $count = 1; - while (defined($r->param("filetrial$count"))) { + while (defined($c->param("filetrial$count"))) { my $val = 0; - $val |= ADDED if ($r->param("trial$count")); - $val |= HIDDEN if ($r->param("hideme$count")); - push @found, [ $r->param("filetrial$count"), $val ]; + $val |= ADDED if ($c->param("trial$count")); + $val |= HIDDEN if ($c->param("hideme$count")); + push @found, [ $c->param("filetrial$count"), $val ]; $count++; } return (\@found); @@ -286,11 +264,8 @@ sub get_past_problem_files { #### For adding new problems -sub add_selected { - my $self = shift; - my $db = shift; - my $setName = shift; - my @past_problems = @{ $self->{past_problems} }; +sub add_selected ($c, $db, $setName) { + my @past_problems = @{ $c->{past_problems} }; my @selected = @past_problems; my $freeProblemID; @@ -300,7 +275,7 @@ sub add_selected { if ($selected->[1] & ADDED) { my $file = $selected->[0]; my $problemRecord = addProblemToSet( - $db, $self->r->ce->{problemDefaults}, + $db, $c->ce->{problemDefaults}, setName => $setName, sourceFile => $file ); @@ -315,15 +290,13 @@ sub add_selected { ############# List of sets of problems in templates directory -sub get_problem_directories { - my ($self, $lib) = @_; - my $r = $self->r; - my $ce = $r->ce; +sub get_problem_directories ($c, $lib) { + my $ce = $c->ce; my $source = $ce->{courseDirs}{templates}; - my $main_problems = $r->maketext(MY_PROBLEMS); + my $main_problems = $c->maketext(MY_PROBLEMS); my $isTop = 1; - if ($lib) { $source .= "/$lib"; $main_problems = $r->maketext(MAIN_PROBLEMS); $isTop = 2 } - my @all_problem_directories = $self->get_library_sets($isTop, $source); + if ($lib) { $source .= "/$lib"; $main_problems = $c->maketext(MAIN_PROBLEMS); $isTop = 2 } + my @all_problem_directories = $c->get_library_sets($isTop, $source); my $includetop = shift @all_problem_directories; for (my $j = 0; $j < scalar(@all_problem_directories); $j++) { @@ -336,9 +309,7 @@ sub get_problem_directories { ### Mainly deal with more like this -sub process_search { - my ($r, @dbsearch) = @_; - +sub process_search ($c, @dbsearch) { # Build a hash of MLT entries keyed by morelt_id my %mlt = (); my $mltind; @@ -362,7 +333,7 @@ sub process_search { for my $mltid (keys %mlt) { my @idlist = @{ $mlt{$mltid} }; if (scalar(@idlist) > 1) { - my $leader = WeBWorK::Utils::ListingDB::getMLTleader($r, $mltid) || 0; + my $leader = WeBWorK::Utils::ListingDB::getMLTleader($c, $mltid) || 0; my $hold = undef; for my $subindx (@idlist) { if ($dbsearch[$subindx]->{pgid} == $leader) { @@ -415,52 +386,43 @@ sub process_search { return @dbsearch; } -async sub pre_header_initialize { - my ($self) = @_; - my $r = $self->r; - +sub pre_header_initialize ($c) { # Make sure these are defined for the templates. - $r->stash->{pg_files} = []; - $r->stash->{plist} = []; + $c->stash->{pg_files} = []; + $c->stash->{plist} = []; - $self->{error} = 0; - my $ce = $r->ce; - my $db = $r->db; - my $maxShown = $r->param('max_shown') || 20; + $c->{error} = 0; + my $ce = $c->ce; + my $db = $c->db; + my $maxShown = $c->param('max_shown') || 20; $maxShown = 10000000 if ($maxShown eq 'All'); # let's hope there aren't more - my $library_basic = $r->param('library_is_basic') || 1; - $self->{problem_seed} = $r->param('problem_seed') || 1234; + my $library_basic = $c->param('library_is_basic') || 1; + $c->{problem_seed} = $c->param('problem_seed') || 1234; # Grab library sets to display from parameters list. We will modify this as we go through the if/else tree. - $self->{current_library_set} = $r->param('library_sets'); + $c->{current_library_set} = $c->param('library_sets'); # These directories will have individual buttons - $self->{problibs} = $ce->{courseFiles}{problibs} // {}; + $c->{problibs} = $ce->{courseFiles}{problibs} // {}; - my $userName = $r->param('user'); + my $userName = $c->param('user'); my $user = $db->getUser($userName); # checked die "record for user $userName (real user) does not exist." unless defined $user; - my $authz = $r->authz; + my $authz = $c->authz; return unless ($authz->hasPermissions($userName, "modify_problem_sets")); # Now one action we have to deal with here - if ($r->param('edit_local')) { - my $urlpath = $r->urlpath; - my $db = $r->db; - my $checkset = $db->getGlobalSet($r->param('local_sets')); + if ($c->param('edit_local')) { + my $db = $c->db; + my $checkset = $db->getGlobalSet($c->param('local_sets')); if (not defined($checkset)) { - $self->{error} = 1; - $self->addbadmessage($r->maketext('You need to select a "Target Set" before you can edit it.')); + $c->{error} = 1; + $c->addbadmessage($c->maketext('You need to select a "Target Set" before you can edit it.')); } else { - my $page = $urlpath->newFromModule( - 'WeBWorK::ContentGenerator::Instructor::ProblemSetDetail', $r, - setID => $r->param('local_sets'), - courseID => $urlpath->arg("courseID") - ); - my $url = $self->systemLink($page); - $self->reply_with_redirect($url); + $c->reply_with_redirect( + $c->systemLink($c->url_for('instructor_set_detail', setID => $c->param('local_sets')))); } } @@ -469,27 +431,27 @@ async sub pre_header_initialize { # List of problems we have already printed # If we don't end up reusing problems, this will be wiped out. # If we do redisplay the same problems, we must adjust this accordingly. - $self->{past_problems} = get_past_problem_files($r); + $c->{past_problems} = get_past_problem_files($c); - my $none_shown = @{ $self->{past_problems} } == 0; + my $none_shown = @{ $c->{past_problems} } == 0; my @pg_files = (); my $use_previous_problems = 1; - my $first_shown = $r->param('first_shown') || 0; - my $last_shown = $r->param('last_shown'); + my $first_shown = $c->param('first_shown') || 0; + my $last_shown = $c->param('last_shown'); if (not defined($last_shown)) { $last_shown = -1; } - my $first_index = $r->param('first_index') || 0; - my $last_index = $r->param('last_index'); + my $first_index = $c->param('first_index') || 0; + my $last_index = $c->param('last_index'); if (not defined($last_index)) { $last_index = -1; } - my $total_probs = $r->param('total_probs') || 0; + my $total_probs = $c->param('total_probs') || 0; my @all_past_list = (); # These include requested, but not shown my ($j, $count, $omlt, $nmlt, $hold) = (0, 0, -1, 0, 0); - while (defined($r->param("all_past_list$j"))) { - $nmlt = $r->param("all_past_mlt$j") || 0; - push @all_past_list, { 'filepath' => $r->param("all_past_list$j"), 'morelt' => $nmlt }; + while (defined($c->param("all_past_list$j"))) { + $nmlt = $c->param("all_past_mlt$j") || 0; + push @all_past_list, { 'filepath' => $c->param("all_past_list$j"), 'morelt' => $nmlt }; if ($nmlt != $omlt or $nmlt == 0) { $count++ if ($j > 0); if ($j > $hold + 1) { @@ -506,117 +468,117 @@ async sub pre_header_initialize { $count++ if ($j > 0); # Default of which problem selector to display - my $browse_which = $r->param('browse_which') || 'browse_npl_library'; + my $browse_which = $c->param('browse_which') || 'browse_npl_library'; # Check for problem lib buttons my $browse_lib = ''; - for my $lib (keys %{ $self->{problibs} }) { - if ($r->param("browse_$lib")) { + for my $lib (keys %{ $c->{problibs} }) { + if ($c->param("browse_$lib")) { $browse_lib = "browse_$lib"; last; } } # Start the logic through if elsif elsif ... - debug("browse_lib", $r->param("$browse_lib")); - debug("browse_npl_library", $r->param("browse_npl_library")); - debug("browse_course_sets", $r->param("browse_course_sets")); - debug("browse_setdefs", $r->param("browse_setdefs")); + debug("browse_lib", $c->param("$browse_lib")); + debug("browse_npl_library", $c->param("browse_npl_library")); + debug("browse_course_sets", $c->param("browse_course_sets")); + debug("browse_setdefs", $c->param("browse_setdefs")); # Asked to browse certain problems if ($browse_lib ne '') { - $browse_which = $browse_lib; - $self->{current_library_set} = ""; - $use_previous_problems = 0; - @pg_files = (); - } elsif ($r->param('browse_npl_library')) { - $browse_which = 'browse_npl_library'; - $self->{current_library_set} = ""; - $use_previous_problems = 0; - @pg_files = (); - } elsif ($r->param('browse_local')) { + $browse_which = $browse_lib; + $c->{current_library_set} = ""; + $use_previous_problems = 0; + @pg_files = (); + } elsif ($c->param('browse_npl_library')) { + $browse_which = 'browse_npl_library'; + $c->{current_library_set} = ""; + $use_previous_problems = 0; + @pg_files = (); + } elsif ($c->param('browse_local')) { $browse_which = 'browse_local'; $use_previous_problems = 0; @pg_files = (); - } elsif ($r->param('browse_course_sets')) { + } elsif ($c->param('browse_course_sets')) { $browse_which = 'browse_course_sets'; $use_previous_problems = 0; @pg_files = (); - } elsif ($r->param('browse_setdefs')) { - $browse_which = 'browse_setdefs'; - $self->{current_library_set} = ""; - $use_previous_problems = 0; - @pg_files = (); - } elsif ($r->param('rerandomize')) { + } elsif ($c->param('browse_setdefs')) { + $browse_which = 'browse_setdefs'; + $c->{current_library_set} = ""; + $use_previous_problems = 0; + @pg_files = (); + } elsif ($c->param('rerandomize')) { # Change the seed value - $self->{problem_seed} = 1 + $self->{problem_seed}; - $self->addbadmessage($r->maketext('Changing the problem seed for display, but there are no problems showing.')) + $c->{problem_seed} = 1 + $c->{problem_seed}; + $c->addbadmessage($c->maketext('Changing the problem seed for display, but there are no problems showing.')) if $none_shown; - } elsif ($r->param('cleardisplay')) { + } elsif ($c->param('cleardisplay')) { # Clear the display @pg_files = (); $use_previous_problems = 0; - } elsif ($r->param('view_local_set')) { + } elsif ($c->param('view_local_set')) { # View problems selected from the local list - my $set_to_display = $self->{current_library_set}; + my $set_to_display = $c->{current_library_set}; if (!defined $set_to_display || $set_to_display eq '') { - $self->addbadmessage($r->maketext('You need to select a set to view.')); + $c->addbadmessage($c->maketext('You need to select a set to view.')); } else { - $set_to_display = '.' if $set_to_display eq $r->maketext(MY_PROBLEMS); - $set_to_display = substr($browse_which, 7) if $set_to_display eq $r->maketext(MAIN_PROBLEMS); - @pg_files = $self->list_pg_files($ce->{courseDirs}{templates}, "$set_to_display"); + $set_to_display = '.' if $set_to_display eq $c->maketext(MY_PROBLEMS); + $set_to_display = substr($browse_which, 7) if $set_to_display eq $c->maketext(MAIN_PROBLEMS); + @pg_files = $c->list_pg_files($ce->{courseDirs}{templates}, "$set_to_display"); @pg_files = map { { 'filepath' => $_, 'morelt' => 0 } } @pg_files; $use_previous_problems = 0; } - } elsif ($r->param('view_course_set')) { + } elsif ($c->param('view_course_set')) { # View problems selected from the a set in this course - my $set_to_display = $self->{current_library_set}; + my $set_to_display = $c->{current_library_set}; debug("set_to_display is $set_to_display"); if (!defined $set_to_display || $set_to_display eq '') { - $self->addbadmessage($r->maketext("You need to select a set from this course to view.")); + $c->addbadmessage($c->maketext("You need to select a set from this course to view.")); } else { @pg_files = map { { 'filepath' => $_->source_file, 'morelt' => 0 } } $db->getGlobalProblemsWhere({ set_id => $set_to_display }); $use_previous_problems = 0; } - } elsif ($r->param('lib_view')) { + } elsif ($c->param('lib_view')) { # View from the library database @pg_files = (); - # TODO: deprecate OPLv1 -- replace getSectionListings with getDBListings($r,0) - my @dbsearch = getSectionListings($r); - @pg_files = process_search($r, @dbsearch); + # TODO: deprecate OPLv1 -- replace getSectionListings with getDBListings($c,0) + my @dbsearch = getSectionListings($c); + @pg_files = process_search($c, @dbsearch); $use_previous_problems = 0; - } elsif ($r->param('view_setdef_set')) { + } elsif ($c->param('view_setdef_set')) { # View a set from a set*.def - my $set_to_display = $self->{current_library_set}; + my $set_to_display = $c->{current_library_set}; debug("set_to_display is $set_to_display"); if (!defined $set_to_display || $set_to_display eq '') { - $self->addbadmessage($r->maketext("You need to select a set definition file to view.")); + $c->addbadmessage($c->maketext("You need to select a set definition file to view.")); } else { - @pg_files = $self->read_set_def($set_to_display); + @pg_files = $c->read_set_def($set_to_display); @pg_files = map { { 'filepath' => $_, 'morelt' => 0 } } @pg_files; } $use_previous_problems = 0; - } elsif ($r->param('edit_local')) { + } elsif ($c->param('edit_local')) { # Edit the current local homework set # Already handled - } elsif ($r->param('new_local_set')) { + } elsif ($c->param('new_local_set')) { # Make a new local homework set - if ($r->param('new_set_name') !~ /^[\w .-]*$/) { - $self->addbadmessage($r->maketext( + if ($c->param('new_set_name') !~ /^[\w .-]*$/) { + $c->addbadmessage($c->maketext( 'The name "[_1]" is not a valid set name. ' . 'Use only letters, digits, dashes, underscores, periods, and spaces.', - $r->param('new_set_name') + $c->param('new_set_name') )); } else { # If we want to munge the input set name, do it here. - my $newSetName = format_set_name_internal($r->param('new_set_name')); - debug("local_sets was ", $r->param('local_sets')); - $r->param('local_sets', $newSetName); ## use of two parameter param - debug("new value of local_sets is ", $r->param('local_sets')); + my $newSetName = format_set_name_internal($c->param('new_set_name')); + debug("local_sets was ", $c->param('local_sets')); + $c->param('local_sets', $newSetName); ## use of two parameter param + debug("new value of local_sets is ", $c->param('local_sets')); if (!$newSetName) { - $self->addbadmessage($r->maketext("You did not specify a new set name.")); + $c->addbadmessage($c->maketext("You did not specify a new set name.")); } elsif (defined $db->getGlobalSet($newSetName)) { - $self->addbadmessage($r->maketext( + $c->addbadmessage($c->maketext( "The set name '[_1]' is already in use. Pick a different name if you would like to start a new set.", $newSetName )); @@ -630,14 +592,14 @@ async sub pre_header_initialize { my $dueDate = time + 2 * 60 * 60 * 24 * 7; my $display_tz = $ce->{siteDefaults}{timezone}; - my $fDueDate = $self->formatDateTime($dueDate, $display_tz, "%m/%d/%Y at %I:%M%P"); + my $fDueDate = $c->formatDateTime($dueDate, $display_tz, "%m/%d/%Y at %I:%M%P"); my $dueTime = $ce->{pg}{timeAssignDue}; # We replace the due time by the one from the config variable # and try to bring it back to unix time if possible $fDueDate =~ s/\d\d:\d\d(am|pm|AM|PM)/$dueTime/; - $dueDate = $self->parseDateTime($fDueDate, $display_tz); + $dueDate = $c->parseDateTime($fDueDate, $display_tz); $newSetRecord->open_date($dueDate - 60 * $ce->{pg}{assignOpenPriorToDue}); $newSetRecord->due_date($dueDate); $newSetRecord->answer_date($dueDate + 60 * $ce->{pg}{answersOpenAfterDueDate}); @@ -647,15 +609,15 @@ async sub pre_header_initialize { $newSetRecord->assignment_type('default'); eval { $db->addGlobalSet($newSetRecord) }; if ($@) { - $self->addbadmessage("Problem creating set $newSetName
      $@"); + $c->addbadmessage("Problem creating set $newSetName
      $@"); } else { - $self->addgoodmessage($r->maketext("Set [_1] has been created.", $newSetName)); + $c->addgoodmessage($c->maketext("Set [_1] has been created.", $newSetName)); assignSetToUser($db, $userName, $newSetRecord); - $self->addgoodmessage($r->maketext("Set [_1] was assigned to [_2]", $newSetName, $userName)); + $c->addgoodmessage($c->maketext("Set [_1] was assigned to [_2]", $newSetName, $userName)); } } } - } elsif ($r->param('next_page')) { + } elsif ($c->param('next_page')) { # Can set first/last problem, but not index yet $first_index = $last_index + 1; my $oli = 0; @@ -665,7 +627,7 @@ async sub pre_header_initialize { $last_index = $oli; } $last_index = end_prob_group($last_index, @all_past_list); - } elsif ($r->param('prev_page')) { + } elsif ($c->param('prev_page')) { # Can set first/last index, but not problem yet $last_index = $first_index - 1; my $oli = 0; @@ -675,18 +637,18 @@ async sub pre_header_initialize { $first_index = $oli; } $first_index = 0 if ($first_index < 0); - } elsif ($r->param('library_basic')) { + } elsif ($c->param('library_basic')) { $library_basic = 1; for my $jj (qw(textchapter textsection textbook)) { - $r->param('library_' . $jj, undef); + $c->param('library_' . $jj, undef); } - } elsif ($r->param('library_advanced')) { + } elsif ($c->param('library_advanced')) { $library_basic = 2; - } elsif ($r->param('library_reset')) { + } elsif ($c->param('library_reset')) { for my $jj (qw(chapters sections subjects textbook textchapter textsection keywords)) { - $r->param('library_' . $jj, undef); + $c->param('library_' . $jj, undef); } - $r->param('level', undef); + $c->param('level', undef); } else { # No action requested, probably our first time here } @@ -746,25 +708,25 @@ async sub pre_header_initialize { # If there are problems to view and a target set is selected, then create a hash of source files in the target set. if (@plist) { - my $setName = $r->param('local_sets'); + my $setName = $c->param('local_sets'); if (defined $setName) { - $self->{isInSet} = - { map { $_->[0] => 1 } $r->db->{problem}->get_fields_where(['source_file'], { set_id => $setName }) }; + $c->{isInSet} = + { map { $_->[0] => 1 } $c->db->{problem}->get_fields_where(['source_file'], { set_id => $setName }) }; } } # Now store data in self for retreival by body - $self->{first_shown} = $first_shown; - $self->{last_shown} = $last_shown; - $self->{first_index} = $first_index; - $self->{last_index} = $last_index; - $self->{total_probs} = $total_probs; - $self->{browse_which} = $browse_which; - $self->{all_db_sets} = \@all_db_sets; - $self->{library_basic} = $library_basic; - $self->{library_stats_handler} = $library_stats_handler; - $r->stash->{pg_files} = \@pg_files; - $r->stash->{plist} = \@plist; + $c->{first_shown} = $first_shown; + $c->{last_shown} = $last_shown; + $c->{first_index} = $first_index; + $c->{last_index} = $last_index; + $c->{total_probs} = $total_probs; + $c->{browse_which} = $browse_which; + $c->{all_db_sets} = \@all_db_sets; + $c->{library_basic} = $library_basic; + $c->{library_stats_handler} = $library_stats_handler; + $c->stash->{pg_files} = \@pg_files; + $c->stash->{plist} = \@plist; return; } diff --git a/lib/WeBWorK/ContentGenerator/Instructor/ShowAnswers.pm b/lib/WeBWorK/ContentGenerator/Instructor/ShowAnswers.pm index f45e8b6cde..6ed4641156 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/ShowAnswers.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/ShowAnswers.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::Instructor::ShowAnswers; -use parent qw(WeBWorK::ContentGenerator); +use Mojo::Base 'WeBWorK::ContentGenerator', -signatures, -async_await; =head1 NAME @@ -22,10 +22,6 @@ WeBWorK::ContentGenerator::Instructor::ShowAnswers.pm -- display past answers o =cut -use strict; -use warnings; - -use Future::AsyncAwait; use Text::CSV; use Mojo::File; @@ -34,20 +30,17 @@ use WeBWorK::Utils::Rendering qw(renderPG); use constant PAST_ANSWERS_FILENAME => 'past_answers'; -async sub initialize { - my $self = shift; - my $r = $self->r; - my $urlpath = $r->urlpath; - my $db = $r->db; - my $ce = $r->ce; - my $authz = $r->authz; - my $user = $r->param('user'); +async sub initialize ($c) { + my $db = $c->db; + my $ce = $c->ce; + my $authz = $c->authz; + my $user = $c->param('user'); - my $selectedSets = [ $r->param('selected_sets') ] // []; - my $selectedProblems = [ $r->param('selected_problems') ] // []; + my $selectedSets = [ $c->param('selected_sets') ] // []; + my $selectedProblems = [ $c->param('selected_problems') ] // []; unless ($authz->hasPermissions($user, "view_answers")) { - $self->addbadmessage("You aren't authorized to view past answers"); + $c->addbadmessage("You aren't authorized to view past answers"); return; } @@ -56,12 +49,12 @@ async sub initialize { # acting the current studentID, setID and problemID will be maintained my $extraStopActingParams; - $extraStopActingParams->{selected_users} = $r->param('selected_users'); - $extraStopActingParams->{selected_sets} = $r->param('selected_sets'); - $extraStopActingParams->{selected_problems} = $r->param('selected_problems'); - $r->{extraStopActingParams} = $extraStopActingParams; + $extraStopActingParams->{selected_users} = $c->param('selected_users'); + $extraStopActingParams->{selected_sets} = $c->param('selected_sets'); + $extraStopActingParams->{selected_problems} = $c->param('selected_problems'); + $c->{extraStopActingParams} = $extraStopActingParams; - my $selectedUsers = [ $r->param('selected_users') ] // []; + my $selectedUsers = [ $c->param('selected_users') ] // []; my $instructor = $authz->hasPermissions($user, "access_instructor_tools"); @@ -129,8 +122,8 @@ async sub initialize { #(why isn't this stored somewhere) my $unversionedSetName = $setName; $unversionedSetName =~ s/,v[0-9]*$//; - my $displayMode = $self->{displayMode}; - my $formFields = { WeBWorK::Form->new_from_paramable($r)->Vars }; + my $displayMode = $c->{displayMode}; + my $formFields = { WeBWorK::Form->new_from_paramable($c)->Vars }; my $set = $db->getMergedSet($studentUser, $unversionedSetName); my $problem = $db->getMergedProblem($studentUser, $unversionedSetName, $problemNumber); my $userobj = $db->getUser($studentUser); @@ -140,7 +133,7 @@ async sub initialize { my $gProblem = $db->getGlobalProblem($unversionedSetName, $problemNumber); my $pg = await renderPG( - $r, $userobj, $set, $problem, + $c, $userobj, $set, $problem, $set->psvn, $formFields, { # translation options @@ -189,11 +182,11 @@ async sub initialize { } } - $self->{records} = \%records; - $self->{prettyProblemNumbers} = \%prettyProblemNumbers; + $c->{records} = \%records; + $c->{prettyProblemNumbers} = \%prettyProblemNumbers; # Prepare a csv if we are an instructor - if ($instructor && $r->param('createCSV')) { + if ($instructor && $c->param('createCSV')) { my $filename = PAST_ANSWERS_FILENAME; my $scoringDir = $ce->{courseDirs}->{scoring}; my $fullFilename = "${scoringDir}/${filename}.csv"; @@ -211,13 +204,13 @@ async sub initialize { my $csv = Text::CSV->new({ "eol" => "\n" }); my @columns; - $columns[0] = $r->maketext('User ID'); - $columns[1] = $r->maketext('Set ID'); - $columns[2] = $r->maketext('Problem Number'); - $columns[3] = $r->maketext('Timestamp'); - $columns[4] = $r->maketext('Scores'); - $columns[5] = $r->maketext('Answers'); - $columns[6] = $r->maketext('Comment'); + $columns[0] = $c->maketext('User ID'); + $columns[1] = $c->maketext('Set ID'); + $columns[2] = $c->maketext('Problem Number'); + $columns[3] = $c->maketext('Timestamp'); + $columns[4] = $c->maketext('Scores'); + $columns[5] = $c->maketext('Answers'); + $columns[6] = $c->maketext('Comment'); $csv->print($fh, \@columns); @@ -230,7 +223,7 @@ async sub initialize { foreach my $answerID (sort { $a <=> $b } keys %{ $records{$studentID}{$setID}{$probNum} }) { my %record = %{ $records{$studentID}{$setID}{$probNum}{$answerID} }; - $columns[3] = $self->formatDateTime($record{time}); + $columns[3] = $c->formatDateTime($record{time}); $columns[4] = join(',', @{ $record{scores} }); $columns[5] = join("\t", @{ $record{answers} }); $columns[6] = $record{comment}; @@ -243,19 +236,17 @@ async sub initialize { $fh->close; } else { - $r->log->warn("Unable to open $fullFilename for writing"); + $c->log->warn("Unable to open $fullFilename for writing"); } } return; } -sub getInstructorData { - my $self = shift; - my $r = $self->r; - my $db = $r->db; - my $ce = $r->ce; - my $user = $r->param('user'); +sub getInstructorData ($c) { + my $db = $c->db; + my $ce = $c->ce; + my $user = $c->param('user'); # Get all users except the set level proctors, and restrict to the sections or recitations that are allowed for # the user if such restrictions are defined. diff --git a/lib/WeBWorK/ContentGenerator/Instructor/Stats.pm b/lib/WeBWorK/ContentGenerator/Instructor/Stats.pm index 7bcc6f5d87..82363937ae 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/Stats.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/Stats.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::Instructor::Stats; -use parent qw(WeBWorK::ContentGenerator); +use Mojo::Base 'WeBWorK::ContentGenerator', -signatures; =head1 NAME @@ -23,29 +23,23 @@ homework set (including sv graphs). =cut -use strict; -use warnings; - use SVG; use WeBWorK::Utils qw(jitar_id_to_seq jitar_problem_adjusted_status format_set_name_display grade_set); -sub initialize { - my $self = shift; - my $r = $self->r; - my $urlpath = $r->urlpath; - my $db = $r->db; - my $ce = $r->ce; - my $user = $r->param('user'); +sub initialize ($c) { + my $db = $c->db; + my $ce = $c->ce; + my $user = $c->param('user'); # Check permissions - return unless $r->authz->hasPermissions($user, 'access_instructor_tools'); + return unless $c->authz->hasPermissions($user, 'access_instructor_tools'); # Cache a list of all users except set level proctors and practice users, and restrict to the sections or # recitations that are allowed for the user if such restrictions are defined. This list is sorted by last_name, # then first_name, then user_id. This is used in multiple places in this module, and is guaranteed to be used at # least once. So it is done here to prevent extra database access. - $self->{student_records} = [ + $c->{student_records} = [ $db->getUsersWhere( { user_id => [ -and => { not_like => 'set_id:%' }, { not_like => "$ce->{practiceUserPrefix}\%" } ], @@ -62,115 +56,74 @@ sub initialize { ) ]; - $self->{type} = $urlpath->arg('statType') || ''; - if ($self->{type} eq 'student') { - $self->{studentID} = $urlpath->arg('userID') || $user; - } elsif ($self->{type} eq 'set') { - $self->{setID} = $urlpath->arg('setID') || 0; - my $setRecord = $db->getGlobalSet($self->{setID}); + if ($c->current_route eq 'instructor_user_statistics') { + $c->{studentID} = $c->stash('userID'); + } elsif ($c->current_route =~ /^instructor_(set|problem)_statistics$/) { + my $setRecord = $db->getGlobalSet($c->stash('setID')); return unless $setRecord; - $self->{setRecord} = $setRecord; - my $problemID = $urlpath->arg('problemID') || 0; + $c->{setRecord} = $setRecord; + my $problemID = $c->stash('problemID') || 0; if ($problemID) { - $self->{prettyID} = + $c->{prettyID} = $setRecord->assignment_type eq 'jitar' ? join('.', jitar_id_to_seq($problemID)) : $problemID; - $self->{type} = 'problem'; - my $problemRecord = $db->getGlobalProblem($self->{setID}, $problemID); + my $problemRecord = $db->getGlobalProblem($c->stash('setID'), $problemID); return unless $problemRecord; - $self->{problemRecord} = $problemRecord; + $c->{problemRecord} = $problemRecord; } } return; } -sub title { - my $self = shift; - my $r = $self->r; +sub page_title ($c) { + return '' unless $c->authz->hasPermissions($c->param('user'), 'access_instructor_tools'); - return '' unless $r->authz->hasPermissions($r->param('user'), 'access_instructor_tools'); + my $setID = $c->stash('setID') || ''; - my $type = $self->{type}; - if ($type eq 'student') { - return $r->maketext('Statistics for student [_1]', $self->{studentID}); - } elsif ($type eq 'set') { - return $r->maketext('Statistics for [_1]', - $r->tag('span', dir => 'ltr', format_set_name_display($self->{setID}))); - } elsif ($type eq 'problem') { - return $r->maketext( + if ($c->current_route eq 'instructor_user_statistics') { + return $c->maketext('Statistics for student [_1]', $c->{studentID}); + } elsif ($c->current_route eq 'instructor_set_statistics') { + return $c->maketext('Statistics for [_1]', $c->tag('span', dir => 'ltr', format_set_name_display($setID))); + } elsif ($c->current_route eq 'instructor_problem_statistics') { + return $c->maketext( 'Statsitcs for [_1] problem [_2]', - $r->tag('span', dir => 'ltr', format_set_name_display($self->{setID})), - $self->{prettyID} - ); - } - - return $r->maketext('Statistics'); -} - -sub path { - my ($self, $args) = @_; - my $r = $self->r; - my $urlpath = $r->urlpath; - my $courseName = $urlpath->arg('courseID'); - my $setID = $self->{setID} || ''; - my $problemID = $urlpath->arg('problemID') || ''; - my $prettyID = $self->{prettyID} || ''; - my $type = $self->{type}; - - my @path = ( - WeBWork => $r->location, - $courseName => $r->location . "/$courseName", - 'Instructor Tools' => $r->location . "/$courseName/instructor", - Statistics => $r->location . "/$courseName/instructor/stats", - ); - if ($type eq 'student') { - push(@path, $self->{studentID} => ''); - } elsif ($type eq 'set') { - push(@path, format_set_name_display($setID) => ''); - } elsif ($type eq 'problem') { - push( - @path, format_set_name_display($setID) => $r->location . "/$courseName/instructor/stats/set/$setID", - $prettyID => '' + $c->tag('span', dir => 'ltr', format_set_name_display($setID)), + $c->{prettyID} ); - } else { - $path[-1] = ''; } - return $self->pathMacro($args, @path); + return $c->maketext('Statistics'); } -sub siblings { - my $self = shift; +sub siblings ($c) { # Stats and StudentProgress share this template. - return $self->r->include('ContentGenerator/Instructor/Stats/siblings', header => $self->r->maketext('Statistics')); + return $c->include('ContentGenerator/Instructor/Stats/siblings', header => $c->maketext('Statistics')); } # Apply the currently selected filter to the the student records cached in initialize, and return a reference to the # list of students and a reference to a hash of section/recitation filters. -sub filter_students { - my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; - my $db = $r->db; - my $user = $r->param('user'); +sub filter_students ($c) { + my $ce = $c->ce; + my $db = $c->db; + my $user = $c->param('user'); # Create a hash of sections and recitations, if there are any for the course. # Filter out all records except for current/auditing students for stats. # Filter out students not in selected section/recitation. - my $filter = $r->param('filter'); + my $filter = $c->param('filter'); my %filters; my @outStudents; - for my $student (@{ $self->{student_records} }) { + for my $student (@{ $c->{student_records} }) { # Only include current/auditing students in stats. next unless ($ce->status_abbrev_has_behavior($student->status, 'include_in_stats') && $db->getPermissionLevel($student->user_id)->permission == $ce->{userRoles}{student}); my $section = $student->section; - $filters{"section:$section"} = $r->maketext('Section [_1]', $section) + $filters{"section:$section"} = $c->maketext('Section [_1]', $section) if $section && !$filters{"section:$section"}; my $recitation = $student->recitation; - $filters{"recitation:$recitation"} = $r->maketext('Recitation [_1]', $recitation) + $filters{"recitation:$recitation"} = $c->maketext('Recitation [_1]', $recitation) if $recitation && !$filters{"recitation:$recitation"}; # Only add users who match the selected section/recitation. @@ -183,24 +136,22 @@ sub filter_students { return (\@outStudents, \%filters); } -sub set_stats { - my $self = shift; - my $r = $self->r; - - return $r->tag('div', class => 'alert alert-danger p-1', $r->maketext('Global set [_1] not found.', $self->{setID})) - unless $self->{setRecord}; +sub set_stats ($c) { + return $c->tag( + 'div', + class => 'alert alert-danger p-1', + $c->maketext('Global set [_1] not found.', $c->stash('setID')) + ) unless $c->{setRecord}; - my $urlpath = $r->urlpath; - my $db = $r->db; - my $courseID = $urlpath->arg('courseID'); + my $db = $c->db; # Get a list of the global problem records for this set. - my @problems = $db->getGlobalProblemsWhere({ set_id => $self->{setID} }, 'problem_id'); + my @problems = $db->getGlobalProblemsWhere({ set_id => $c->stash('setID') }, 'problem_id'); # Total point value of the set. my $totalValue = 0; - my $isJitarSet = $self->{setRecord}->assignment_type eq 'jitar'; + my $isJitarSet = $c->{setRecord}->assignment_type eq 'jitar'; # For jitar sets we need to know which problems are top level problems. my %topLevelProblems; @@ -224,16 +175,9 @@ sub set_stats { $problem->{prettyID} = $isJitarSet ? join('.', jitar_id_to_seq($problem->problem_id)) : $problem->problem_id; # Link to individual problem stats page. - $problem->{statsLink} = $self->systemLink( - $urlpath->newFromModule( - 'WeBWorK::ContentGenerator::Instructor::Stats', $r, - courseID => $courseID, - statType => 'set', - setID => $self->{setID}, - problemID => $probID - ), - params => $r->param('filter') ? { filter => $r->param('filter') } : {} - ); + $problem->{statsLink} = + $c->systemLink($c->url_for('instructor_set_statistics', setID => $c->stash('setID'), problemID => $probID), + params => $c->param('filter') ? { filter => $c->param('filter') } : {}); $showGraderRow = 1 if $problem->flags =~ /essay/; @@ -251,7 +195,7 @@ sub set_stats { # Only count top level problems for Jitar sets. my $num_problems = $isJitarSet ? scalar(keys %topLevelProblems) : scalar(@problems); - my ($students, $filters) = $self->filter_students; + my ($students, $filters) = $c->filter_students; for my $studentRecord (@$students) { my $student = $studentRecord->user_id; my $totalRight = 0; @@ -261,10 +205,11 @@ sub set_stats { # Get problem data for student. my @problemRecords; my $noSkip = 0; - if ($self->{setRecord}->assignment_type =~ /gateway/) { + if ($c->{setRecord}->assignment_type =~ /gateway/) { # Only use the quiz version with the best score. my @setVersions = - $db->getMergedSetVersionsWhere({ user_id => $student, set_id => { like => "$self->{setID},v\%" } }); + $db->getMergedSetVersionsWhere( + { user_id => $student, set_id => { like => $c->stash('setID') . ',v%' } }); if (@setVersions) { my $maxVersion = 1; my $maxStatus = 0; @@ -275,13 +220,13 @@ sub set_stats { $maxVersion = $verSet->version_id; } } - @problemRecords = $db->getAllMergedProblemVersions($student, $self->{setID}, $maxVersion); + @problemRecords = $db->getAllMergedProblemVersions($student, $c->stash('setID'), $maxVersion); } else { # Check if student is assigned to the quiz but hasn't started any version. - $noSkip = 1 if $db->getMergedSet($student, $self->{setID}); + $noSkip = 1 if $db->getMergedSet($student, $c->stash('setID')); } } else { - @problemRecords = $db->getUserProblemsWhere({ user_id => $student, set_id => $self->{setID} }); + @problemRecords = $db->getUserProblemsWhere({ user_id => $student, set_id => $c->stash('setID') }); } # Don't include students who are not assigned to set. next unless ($noSkip || @problemRecords); @@ -368,10 +313,10 @@ sub set_stats { @buckets = reverse(@buckets); # Overall average - my ($mean, $stddev) = $self->compute_stats(@score_list); - my ($overallAvgAttempts) = $self->compute_stats(grep { !/-/ } @avgAttempts); + my ($mean, $stddev) = $c->compute_stats(@score_list); + my ($overallAvgAttempts) = $c->compute_stats(grep { !/-/ } @avgAttempts); my $overallSuccess = $overallAvgAttempts ? $mean**2 / $overallAvgAttempts : 0; - ($overallSuccess) = $self->compute_stats(@index_list); + ($overallSuccess) = $c->compute_stats(@index_list); # Data for the SVG bar graph showing the percentage of students with correct answers for each problem. my (@svgProblemData, @svgProblemLabels, @jitarBars); @@ -399,7 +344,7 @@ sub set_stats { push(@svgProblemLabels, length $_->{prettyID} > 4 ? '##' : $_->{prettyID}); } - return $r->include( + return $c->include( 'ContentGenerator/Instructor/Stats/set_stats', filters => $filters, problems => \@problems, @@ -426,30 +371,29 @@ sub set_stats { ); } -sub problem_stats { - my $self = shift; - my $r = $self->r; - - return $r->tag('div', class => 'alert alert-danger p-1', $r->maketext('Global set [_1] not found.', $self->{setID})) - unless ($self->{setRecord}); +sub problem_stats ($c) { + return $c->tag( + 'div', + class => 'alert alert-danger p-1', + $c->maketext('Global set [_1] not found.', $c->stash('setID')) + ) unless $c->{setRecord}; - return $r->tag( + return $c->tag( 'div', class => 'alert alert-danger p-1', - $r->maketext('Global problem [_1] not found for set [_2].', $self->{prettyID}, $self->{setID}) - ) unless ($self->{problemRecord}); + $c->maketext('Global problem [_1] not found for set [_2].', $c->{prettyID}, $c->stash('setID')) + ) unless $c->{problemRecord}; - my $db = $r->db; - my $ce = $r->ce; - my $urlpath = $r->urlpath; - my $user = $r->param('user'); - my $courseID = $urlpath->arg('courseID'); - my $problemID = $urlpath->arg('problemID'); + my $db = $c->db; + my $ce = $c->ce; + my $user = $c->param('user'); + my $courseID = $c->stash('courseID'); + my $problemID = $c->stash('problemID'); - my $isJitarSet = $self->{setRecord}->assignment_type eq 'jitar'; - my $topLevelJitar = $self->{prettyID} !~ /\./; + my $isJitarSet = $c->{setRecord}->assignment_type eq 'jitar'; + my $topLevelJitar = $c->{prettyID} !~ /\./; - my ($students, $filters) = $self->filter_students; + my ($students, $filters) = $c->filter_students; my (@problemScores, @adjustedScores, @problemAttempts, @successList); my $activeStudents = 0; my $inactiveStudents = 0; @@ -457,10 +401,11 @@ sub problem_stats { my $student = $studentRecord->user_id; my $studentProblem; - if ($self->{setRecord}->assignment_type =~ /gateway/) { + if ($c->{setRecord}->assignment_type =~ /gateway/) { my @problemRecords = $db->getProblemVersionsWhere( - { user_id => $student, problem_id => $problemID, set_id => { like => "$self->{setID},v\%" } }); + { user_id => $student, problem_id => $problemID, set_id => { like => $c->stash('setID') . ',v%' } } + ); my $maxRecord = 0; my $maxStatus = 0; for (0 .. $#problemRecords) { @@ -471,7 +416,7 @@ sub problem_stats { } $studentProblem = $problemRecords[$maxRecord]; } else { - $studentProblem = $db->getMergedProblem($student, $self->{setID}, $problemID); + $studentProblem = $db->getMergedProblem($student, $c->stash('setID'), $problemID); } # Don't include students who are not assigned to set. next unless ($studentProblem); @@ -521,15 +466,15 @@ sub problem_stats { $maxCount = int($maxCount / 5) + 1; # Overall statistics - my ($mean, $stddev) = $self->compute_stats(@problemScores); - my ($mean2, $stddev2) = $self->compute_stats(@problemAttempts); + my ($mean, $stddev) = $c->compute_stats(@problemScores); + my ($mean2, $stddev2) = $c->compute_stats(@problemAttempts); my $successIndex = $mean2 ? $mean**2 / $mean2 : 0; - return $r->include( + return $c->include( 'ContentGenerator/Instructor/Stats/problem_stats', filters => $filters, problemID => $problemID, - problems => [ $db->getGlobalProblemsWhere({ set_id => $self->{setID} }, 'problem_id') ], + problems => [ $db->getGlobalProblemsWhere({ set_id => $c->stash('setID') }, 'problem_id') ], buckets => \@buckets, maxCount => $maxCount, isJitarSet => $isJitarSet, @@ -549,8 +494,7 @@ sub problem_stats { } # Determines the percentage of students whose score is greater than a given value. -sub determine_percentiles { - my ($self, $percent_brackets, @data) = @_; +sub determine_percentiles ($c, $percent_brackets, @data) { my @list_of_scores = sort { $a <=> $b } @data; my $num_students = $#list_of_scores; # For example, $percentiles{75} = @list_of_scores[int(25 * $num_students / 100)] @@ -562,8 +506,7 @@ sub determine_percentiles { } # Replace an array such as "[0, 0, 0, 86, 86, 100, 100, 100]" by "[0, '-', '-', 86, '-', 100, '-', '-']" -sub prevent_repeats { - my ($self, @inarray) = @_; +sub prevent_repeats ($c, @inarray) { my @outarray; my $saved_item = shift @inarray; push @outarray, $saved_item; @@ -580,32 +523,28 @@ sub prevent_repeats { } # Create percentile bracket table. -sub bracket_table { - my ($self, $brackets, $data, $headers, %options) = @_; - my $r = $self->r; - +sub bracket_table ($c, $brackets, $data, $headers, %options) { my @dataOut = ([@$brackets]); - push(@{ $dataOut[-1] }, $r->maketext('Top Score')) if $options{showMax}; + push(@{ $dataOut[-1] }, $c->maketext('Top Score')) if $options{showMax}; for (@$data) { my %percentiles = - ref($_) eq 'ARRAY' ? $self->determine_percentiles($brackets, @$_) : map { $_ => '-' } @$brackets; + ref($_) eq 'ARRAY' ? $c->determine_percentiles($brackets, @$_) : map { $_ => '-' } @$brackets; my @tableData = map { $percentiles{$_} } @$brackets; - @tableData = reverse(@tableData) if $options{reverse}; - @tableData = $self->prevent_repeats(@tableData) if ref($_) eq 'ARRAY'; + @tableData = reverse(@tableData) if $options{reverse}; + @tableData = $c->prevent_repeats(@tableData) if ref($_) eq 'ARRAY'; push(@tableData, $options{reverse} ? $percentiles{min} : $percentiles{max}) if $options{showMax}; push(@dataOut, \@tableData); } - return $r->include( + return $c->include( 'ContentGenerator/Instructor/Stats/stats_table', - tableHeaders => [ $r->maketext('Percent of Students'), @$headers ], + tableHeaders => [ $c->maketext('Percent of Students'), @$headers ], tableData => \@dataOut ); } # Compute Mean / Std Deviation. -sub compute_stats { - my ($self, @data) = @_; +sub compute_stats ($c, @data) { my $n = scalar(@data); return (0, 0, 0) unless ($n > 0); my $sum = 0; @@ -618,12 +557,10 @@ sub compute_stats { } # Create SVG bar graph from input data. -sub build_bar_chart { - my ($self, $data, %options) = @_; - my $r = $self->r; +sub build_bar_chart ($c, $data, %options) { return '' unless (@$data); - $self->{barCount} = 1 unless $self->{barCount}; - my $id = $self->{barCount}++; + $c->{barCount} = 1 unless $c->{barCount}; + my $id = $c->{barCount}++; my %opts = ( yAxisLabels => [], xAxisLabels => [], @@ -744,7 +681,7 @@ sub build_bar_chart { 'font-family' => 'sans-serif', 'font-size' => 12, 'text-anchor' => 'start', - )->cdata($r->maketext('Correct Adjusted Status')); + )->cdata($c->maketext('Correct Adjusted Status')); $svg->rect( x => $opts{leftMargin} + $plotWidth + 10, y => $opts{topMargin} + 40, @@ -759,7 +696,7 @@ sub build_bar_chart { 'font-family' => 'sans-serif', 'font-size' => 12, 'text-anchor' => 'start', - )->cdata($r->maketext('Correct Status')); + )->cdata($c->maketext('Correct Status')); } # y-axis labels. @@ -832,11 +769,11 @@ sub build_bar_chart { # FIXME: The invalid html attribute xmlns:svg needs to be removed. The SVG module needs to be fixed to not # add this invalid attribute when rendering for html. - return $r->tag( + return $c->tag( 'div', class => 'img-fluid mb-3', style => "max-width: ${imageWidth}px", - $r->b($svg->render =~ s/xmlns:svg="[^"]*"//r) + $c->b($svg->render =~ s/xmlns:svg="[^"]*"//r) ); } diff --git a/lib/WeBWorK/ContentGenerator/Instructor/StudentProgress.pm b/lib/WeBWorK/ContentGenerator/Instructor/StudentProgress.pm index 4c622f2a58..c2ab02cb1e 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/StudentProgress.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/StudentProgress.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::Instructor::StudentProgress; -use parent qw(WeBWorK::ContentGenerator); +use Mojo::Base 'WeBWorK::ContentGenerator', -signatures; =head1 NAME @@ -22,28 +22,22 @@ WeBWorK::ContentGenerator::Instructor::StudentProgress - Display Student Progres =cut -use strict; -use warnings; - use WeBWorK::Utils qw(jitar_id_to_seq wwRound grade_set format_set_name_display); use WeBWorK::Utils::Grades qw(list_set_versions); -sub initialize { - my $self = shift; - my $r = $self->{r}; - my $urlpath = $r->urlpath; - my $db = $self->{db}; - my $ce = $self->{ce}; - my $user = $r->param('user'); +sub initialize ($c) { + my $db = $c->db; + my $ce = $c->ce; + my $user = $c->param('user'); # Check permissions - return unless $r->authz->hasPermissions($user, "access_instructor_tools"); + return unless $c->authz->hasPermissions($user, "access_instructor_tools"); # Cache a list of all users except set level proctors and practice users, and restrict to the sections or # recitations that are allowed for the user if such restrictions are defined. This list is sorted by last_name, # then first_name, then user_id. This is used in multiple places in this module, and is guaranteed to be used at # least once. So it is done here to prevent extra database access. - $self->{student_records} = [ + $c->{student_records} = [ $db->getUsersWhere( { user_id => [ -and => { not_like => 'set_id:%' }, { not_like => "$ce->{practiceUserPrefix}\%" } ], @@ -60,62 +54,50 @@ sub initialize { ) ]; - $self->{type} = $urlpath->arg("statType") || ''; - if ($self->{type} eq 'student') { - $self->{studentID} = $r->urlpath->arg("userID") || $user; - } elsif ($self->{type} eq 'set') { - $self->{setID} = $r->urlpath->arg("setID") || 0; - my $setRecord = $db->getGlobalSet($self->{setID}); + if ($c->current_route eq 'instructor_user_progress') { + $c->{studentID} = $c->stash('userID'); + } elsif ($c->current_route eq 'instructor_set_progress') { + my $setRecord = $db->getGlobalSet($c->stash('setID')); return unless $setRecord; - $self->{setRecord} = $setRecord; + $c->{setRecord} = $setRecord; } return; } -sub title { - my ($self) = @_; - my $r = $self->r; - - return '' unless $r->authz->hasPermissions($r->param('user'), 'access_instructor_tools'); +sub page_title ($c) { + return '' unless $c->authz->hasPermissions($c->param('user'), 'access_instructor_tools'); - my $type = $self->{type}; - if ($type eq 'student') { - return $r->maketext('Student Progress for [_1] student [_2]', $self->{ce}{courseName}, $self->{studentID}); - } elsif ($type eq 'set') { - return $r->maketext( + if ($c->current_route eq 'instructor_user_progress') { + return $c->maketext('Student Progress for [_1] student [_2]', $c->ce->{courseName}, $c->{studentID}); + } elsif ($c->current_route eq 'instructor_set_progress') { + return $c->maketext( 'Student Progress for [_1] set [_2]. Closes [_3]', - $self->{ce}{courseName}, - $r->tag('span', dir => 'ltr', format_set_name_display($self->{setID})), - $self->formatDateTime($self->{setRecord}->due_date) + $c->ce->{courseName}, + $c->tag('span', dir => 'ltr', format_set_name_display($c->stash('setID'))), + $c->formatDateTime($c->{setRecord}->due_date) ); } - return $r->maketext('Student Progress'); + return $c->maketext('Student Progress'); } -sub siblings { - my $self = shift; +sub siblings ($c) { # Stats and StudentProgress share this template. - return $self->r->include('ContentGenerator/Instructor/Stats/siblings', - header => $self->r->maketext('Student Progress')); + return $c->include('ContentGenerator/Instructor/Stats/siblings', header => $c->maketext('Student Progress')); } # Display student progress table -sub displaySets { - my $self = shift; - my $r = $self->r; - my $urlpath = $r->urlpath; - my $db = $r->db; - my $ce = $r->ce; +sub displaySets ($c) { + my $db = $c->db; + my $ce = $c->ce; - my $setIsVersioned = - defined $self->{setRecord}->assignment_type && $self->{setRecord}->assignment_type =~ /gateway/; + my $setIsVersioned = defined $c->{setRecord}->assignment_type && $c->{setRecord}->assignment_type =~ /gateway/; # The returning parameter lets us set defaults for versioned sets - if ($setIsVersioned && !$r->param('returning')) { - $r->param('show_date', 1) if !$r->param('show_date'); - $r->param('show_testtime', 1) if !$r->param('show_testtime'); + if ($setIsVersioned && !$c->param('returning')) { + $c->param('show_date', 1) if !$c->param('show_date'); + $c->param('show_testtime', 1) if !$c->param('show_testtime'); } # For versioned sets some of the columns are optionally shown. The following flags keep track of which ones to @@ -124,25 +106,25 @@ sub displaySets { my %showColumns = $setIsVersioned ? ( - date => $r->param('show_date') // 0, - testtime => $r->param('show_testtime') // 0, - problems => $r->param('show_problems') // 0, - section => $r->param('show_section') // 0, - recit => $r->param('show_recitation') // 0, - login => $r->param('show_login') // 0, + date => $c->param('show_date') // 0, + testtime => $c->param('show_testtime') // 0, + problems => $c->param('show_problems') // 0, + section => $c->param('show_section') // 0, + recit => $c->param('show_recitation') // 0, + login => $c->param('show_login') // 0, ) : (date => 0, testtime => 0, problems => 1, section => 1, recit => 1, login => 1); - my $showBestOnly = $setIsVersioned ? $r->param('show_best_only') : 0; + my $showBestOnly = $setIsVersioned ? $c->param('show_best_only') : 0; my @score_list; my @user_set_list; - for my $studentRecord (@{ $self->{student_records} }) { + for my $studentRecord (@{ $c->{student_records} }) { next unless $ce->status_abbrev_has_behavior($studentRecord->status, 'include_in_stats'); my $studentName = $studentRecord->user_id; my ($allSetVersionNames, $notAssignedSet) = - list_set_versions($db, $studentName, $self->{setID}, $setIsVersioned); + list_set_versions($db, $studentName, $c->stash('setID'), $setIsVersioned); next if $notAssignedSet; @@ -167,9 +149,9 @@ sub displaySets { $testTime = $timeLimit if ($testTime > $timeLimit); $testTime = sprintf('%3.1f min', $testTime); } elsif (time - $set->open_date < $set->version_time_limit) { - $testTime = $r->maketext('still open'); + $testTime = $c->maketext('still open'); } else { - $testTime = $r->maketext('time limit exceeded'); + $testTime = $c->maketext('time limit exceeded'); } } else { $set = $db->getMergedSet($studentName, $setName); @@ -224,9 +206,9 @@ sub displaySets { } } - my $primary_sort_method = $r->param('primary_sort'); - my $secondary_sort_method = $r->param('secondary_sort'); - my $ternary_sort_method = $r->param('ternary_sort'); + my $primary_sort_method = $c->param('primary_sort'); + my $secondary_sort_method = $c->param('secondary_sort'); + my $ternary_sort_method = $c->param('ternary_sort'); my $sort_method = sub { my ($m, $n, $sort_method_name) = @_; @@ -251,11 +233,11 @@ sub displaySets { } @user_set_list; # Construct header - my @problems = map { $_->[1] } $db->listGlobalProblemsWhere({ set_id => $self->{setID} }, 'problem_id'); - @problems = ($r->maketext('None')) unless @problems; + my @problems = map { $_->[1] } $db->listGlobalProblemsWhere({ set_id => $c->stash('setID') }, 'problem_id'); + @problems = ($c->maketext('None')) unless @problems; # For a jitar set we only get the top level problems - if ($self->{setRecord}->assignment_type eq 'jitar') { + if ($c->{setRecord}->assignment_type eq 'jitar') { my @topLevelProblems; for my $id (@problems) { my @seq = jitar_id_to_seq($id); @@ -269,7 +251,7 @@ sub displaySets { $numCols++ if $showColumns{testtime}; $numCols += scalar(@problems) if $showColumns{problems}; - return $r->include( + return $c->include( 'ContentGenerator/Instructor/StudentProgress/set_progress', setIsVersioned => $setIsVersioned, showColumns => \%showColumns, diff --git a/lib/WeBWorK/ContentGenerator/Instructor/UserDetail.pm b/lib/WeBWorK/ContentGenerator/Instructor/UserDetail.pm index c78af2c8ad..58c9fc0dcf 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/UserDetail.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/UserDetail.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::Instructor::UserDetail; -use parent qw(WeBWorK::ContentGenerator); +use Mojo::Base 'WeBWorK::ContentGenerator', -signatures; =head1 NAME @@ -22,9 +22,6 @@ WeBWorK::ContentGenerator::Instructor::UserDetail - Detailed User specific infor =cut -use strict; -use warnings; - use WeBWorK::Utils qw(x); use WeBWorK::Utils::Instructor qw(assignSetToUser); use WeBWorK::Debug; @@ -38,36 +35,33 @@ use constant DATE_FIELDS => { }; use constant DATE_FIELDS_ORDER => [qw(open_date reduced_scoring_date due_date answer_date )]; -sub initialize { - my ($self) = @_; - my $r = $self->r; - my $urlpath = $r->urlpath; - my $db = $r->db; +sub initialize ($c) { + my $db = $c->db; # Make these available in the templates. - $r->stash->{fields} = DATE_FIELDS_ORDER(); - $r->stash->{fieldLabels} = DATE_FIELDS(); + $c->stash->{fields} = DATE_FIELDS_ORDER(); + $c->stash->{fieldLabels} = DATE_FIELDS(); - return unless $r->authz->hasPermissions($r->param('user'), 'access_instructor_tools'); + return unless $c->authz->hasPermissions($c->param('user'), 'access_instructor_tools'); - my $editForUserID = $urlpath->arg('userID'); + my $editForUserID = $c->stash('userID'); # Get the user whose records are to be modified. - $self->{userRecord} = $db->getUser($editForUserID); - return unless $self->{userRecord}; + $c->{userRecord} = $db->getUser($editForUserID); + return unless $c->{userRecord}; # Get the list of sets and the global set records and cache them for later use. This list is sorted by set_id. - $self->{setRecords} = [ $db->getGlobalSetsWhere({}, 'set_id') ]; + $c->{setRecords} = [ $db->getGlobalSetsWhere({}, 'set_id') ]; # Check to see if a save form has been submitted - if ($r->param('save_button') || $r->param('assignAll')) { + if ($c->param('save_button') || $c->param('assignAll')) { # Check each set to see if it is still assigned. my @assignedSets; - for my $set (@{ $self->{setRecords} }) { + for my $set (@{ $c->{setRecords} }) { # Add sets to the assigned list if the parameter is checked or the assign all button is pushed. (Already # assigned sets will be skipped later.) my $setID = $set->set_id; - push @assignedSets, $setID if defined $r->param("set.$setID.assignment"); + push @assignedSets, $setID if defined $c->param("set.$setID.assignment"); } # note: assignedSets are those sets that are assigned in the submitted form @@ -79,8 +73,8 @@ sub initialize { my %userSets = map { $_ => 1 } $db->listUserSets($editForUserID); # Go through each possible set - debug(' parameters ', join(' ', $r->param())); - for my $setRecord (@{ $self->{setRecords} }) { + debug(' parameters ', join(' ', $c->param())); + for my $setRecord (@{ $c->{setRecords} }) { my $setID = $setRecord->set_id; # Does the user want this set to be assigned to the selected user? if (exists $selectedSets{$setID}) { @@ -91,11 +85,11 @@ sub initialize { my $userSetRecord = $db->getUserSet($editForUserID, $setID); # Check to see if new dates meet criteria - my $rh_dates = $self->checkDates($setRecord, $setID); + my $rh_dates = $c->checkDates($setRecord, $setID); unless ($rh_dates->{error}) { # If no error update database for my $field (@{ DATE_FIELDS_ORDER() }) { - if (defined $r->param("set.$setID.$field.override")) { + if (defined $c->param("set.$setID.$field.override")) { $userSetRecord->$field($rh_dates->{$field}); } else { $userSetRecord->$field(undef); #stop override @@ -111,15 +105,15 @@ sub initialize { $db->getSetVersionsWhere({ user_id => $editForUserID, set_id => { like => "$setID,v\%" } }); for my $setVersionRecord (@setVer) { my $ver = $setVersionRecord->version_id; - my $action = $r->param("set.$setID,v$ver.assignment"); + my $action = $c->param("set.$setID,v$ver.assignment"); if (defined $action) { if ($action eq 'assigned') { # This version is not to be deleted. # Check to see if we're resetting the dates for this version. - my $rh_dates = $self->checkDates($setVersionRecord, "$setID,v$ver"); + my $rh_dates = $c->checkDates($setVersionRecord, "$setID,v$ver"); unless ($rh_dates->{error}) { for my $field (@{ DATE_FIELDS_ORDER() }) { - if (defined($r->param("set.$setID,v$ver.$field.override"))) { + if (defined($c->param("set.$setID,v$ver.$field.override"))) { $setVersionRecord->$field($rh_dates->{$field}); } else { $setVersionRecord->$field(undef); @@ -146,22 +140,22 @@ sub initialize { # This must be done after saving so that the updated data is obtained. # Create a hash of set ids to set records, and a hash of set ids to merged set records for this user. - $self->{userSetRecords} = + $c->{userSetRecords} = { map { $_->set_id => $_ } $db->getUserSetsWhere({ user_id => $editForUserID, set_id => { not_like => '%,v%' } }) }; - $self->{mergedSetRecords} = { map { $_->set_id => $_ } $db->getMergedSetsWhere({ user_id => $editForUserID }) }; + $c->{mergedSetRecords} = { map { $_->set_id => $_ } $db->getMergedSetsWhere({ user_id => $editForUserID }) }; # Get all versions and merged versions for gateway sets. - for my $set (@{ $self->{setRecords} }) { + for my $set (@{ $c->{setRecords} }) { next unless $set->assignment_type =~ /gateway/; my $setID = $set->set_id; - $self->{setVersions}{$setID} = [ + $c->{setVersions}{$setID} = [ $db->getSetVersionsWhere( { user_id => $editForUserID, set_id => { like => "$setID,v\%" } }, 'version_id' ) ]; - $self->{mergedVersions}{$setID} = [ + $c->{mergedVersions}{$setID} = [ $db->getMergedSetVersionsWhere( { user_id => $editForUserID, set_id => { like => "$setID,v\%" } }, \q{(SUBSTRING(set_id,INSTR(set_id,',v')+2)+0)} @@ -172,65 +166,60 @@ sub initialize { return; } -sub checkDates { - my $self = shift; - my $setRecord = shift; - my $setID = shift; - my $r = $self->r; - my $error = 0; +sub checkDates ($c, $setRecord, $setID) { + my $error = 0; # For each of the dates, use the override date if set. Otherwise use the value from the global set. my %dates; for my $field (@{ DATE_FIELDS_ORDER() }) { $dates{$field} = - (defined $r->param("set.$setID.$field.override") && $r->param("set.$setID.$field") ne '') - ? $r->param("set.$setID.$field") + (defined $c->param("set.$setID.$field.override") && $c->param("set.$setID.$field") ne '') + ? $c->param("set.$setID.$field") : $setRecord->$field; } my ($open_date, $reduced_scoring_date, $due_date, $answer_date) = map { $dates{$_} } @{ DATE_FIELDS_ORDER() }; unless ($answer_date && $due_date && $open_date) { - $self->addbadmessage("set $setID has errors in its dates: answer_date |$answer_date|, " + $c->addbadmessage("set $setID has errors in its dates: answer_date |$answer_date|, " . "due date |$due_date|, open_date |$open_date|"); $error = 1; } if ($answer_date < $due_date || $answer_date < $open_date) { - $self->addbadmessage("Answers cannot be made available until on or after the due date in set $setID!"); + $c->addbadmessage("Answers cannot be made available until on or after the due date in set $setID!"); $error = 1; } if ($due_date < $open_date) { - $self->addbadmessage("Answers cannot be due until on or after the open date in set $setID!"); + $c->addbadmessage("Answers cannot be due until on or after the open date in set $setID!"); $error = 1; } - if ($r->ce->{pg}{ansEvalDefaults}{enableReducedScoring} + if ($c->ce->{pg}{ansEvalDefaults}{enableReducedScoring} && $setRecord->enable_reduced_scoring && ($reduced_scoring_date < $open_date || $reduced_scoring_date > $due_date)) { - $self->addbadmessage( - "The reduced scoring date should be between the open date and the due date in set $setID!"); + $c->addbadmessage("The reduced scoring date should be between the open date and the due date in set $setID!"); $error = 1; } # Make sure the dates are not more than 10 years in the future. my $cutoff = time + 31_556_926 * 10; if ($open_date > $cutoff) { - $self->addbadmessage("Error: open date cannot be more than 10 years from now in set $setID"); + $c->addbadmessage("Error: open date cannot be more than 10 years from now in set $setID"); $error = 1; } if ($due_date > $cutoff) { - $self->addbadmessage("Error: due date cannot be more than 10 years from now in set $setID"); + $c->addbadmessage("Error: due date cannot be more than 10 years from now in set $setID"); $error = 1; } if ($answer_date > $cutoff) { - $self->addbadmessage("Error: answer date cannot be more than 10 years from now in set $setID"); + $c->addbadmessage("Error: answer date cannot be more than 10 years from now in set $setID"); $error = 1; } - $self->addbadmessage('No date changes were saved!') if ($error); + $c->addbadmessage('No date changes were saved!') if ($error); return { %dates, error => $error }; } diff --git a/lib/WeBWorK/ContentGenerator/Instructor/UserList.pm b/lib/WeBWorK/ContentGenerator/Instructor/UserList.pm index 658deb0f46..1def7d1aeb 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/UserList.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/UserList.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::Instructor::UserList; -use parent qw(WeBWorK::ContentGenerator); +use Mojo::Base 'WeBWorK::ContentGenerator', -signatures; =head1 NAME @@ -63,9 +63,6 @@ Export users: =cut -use strict; -use warnings; - use WeBWorK::File::Classlist qw(parse_classlist write_classlist); use WeBWorK::Utils qw(cryptPassword x); @@ -135,71 +132,65 @@ use constant FIELD_PROPERTIES => { permission => { name => x('Permission Level'), type => 'permission' }, }; -async sub pre_header_initialize { - my $self = shift; - my $r = $self->r; - my $authz = $r->authz; - my $urlpath = $r->urlpath; - my $ce = $r->ce; - my $db = $r->db; - my $user = $r->param('user'); +sub pre_header_initialize ($c) { + my $authz = $c->authz; + my $ce = $c->ce; + my $db = $c->db; + my $user = $c->param('user'); return unless $authz->hasPermissions($user, 'access_instructor_tools'); - $self->{editMode} = $r->param('editMode') || 0; - $self->{passwordMode} = $r->param('passwordMode') || 0; + $c->{editMode} = $c->param('editMode') || 0; + $c->{passwordMode} = $c->param('passwordMode') || 0; - return if ($self->{passwordMode} || $self->{editMode}) && !$authz->hasPermissions($user, 'modify_student_data'); + return if ($c->{passwordMode} || $c->{editMode}) && !$authz->hasPermissions($user, 'modify_student_data'); - if (defined $r->param('action') && $r->param('action') eq 'add') { + if (defined $c->param('action') && $c->param('action') eq 'add') { # Redirect to the addUser page - $self->reply_with_redirect($self->systemLink( - $urlpath->newFromModule( - 'WeBWorK::ContentGenerator::Instructor::AddUsers', - $r, courseID => $urlpath->arg('courseID') - ), - params => { number_of_students => $r->param('number_of_students') // 1 } + $c->reply_with_redirect($c->systemLink( + $c->url_for('instructor_add_users'), + params => { number_of_students => $c->param('number_of_students') // 1 } )); return; } # Get a list of all users except set-level proctors from the database. my @allUsers = $db->getUsersWhere({ user_id => { not_like => 'set_id:%' } }); - $self->{allUserIDs} = [ map { $_->user_id } @allUsers ]; + $c->{allUserIDs} = [ map { $_->user_id } @allUsers ]; # Get the number of sets in the course for use in the "assigned sets" links. - $self->{totalSets} = $db->countGlobalSets; - - if (defined $r->param('visible_user_string')) { - $self->{visibleUserIDs} = [ split /:/, $r->param('visible_user_string') ]; - } elsif (defined $r->param('visible_users')) { - $self->{visibleUserIDs} = [ $r->param('visible_users') ]; - } elsif (defined $r->param('no_visible_users')) { - $self->{visibleUserIDs} = []; + $c->{totalSets} = $db->countGlobalSets; + + if (defined $c->param('visible_user_string')) { + $c->{visibleUserIDs} = [ split /:/, $c->param('visible_user_string') ]; + } elsif (defined $c->param('visible_users')) { + $c->{visibleUserIDs} = [ $c->param('visible_users') ]; + } elsif (defined $c->param('no_visible_users')) { + $c->{visibleUserIDs} = []; } else { - if (@{ $self->{allUserIDs} } > HIDE_USERS_THRESHHOLD && !defined $r->param('show_all_users')) { - $self->{visibleUserIDs} = []; + if (@{ $c->{allUserIDs} } > HIDE_USERS_THRESHHOLD && !defined $c->param('show_all_users')) { + $c->{visibleUserIDs} = []; } else { - $self->{visibleUserIDs} = [ @{ $self->{allUserIDs} } ]; + $c->{visibleUserIDs} = [ @{ $c->{allUserIDs} } ]; } } - $self->{prevVisibleUserIDs} = $self->{visibleUserIDs}; + $c->{prevVisibleUserIDs} = $c->{visibleUserIDs}; - if (defined $r->param('selected_users')) { - $self->{selectedUserIDs} = [ $r->param('selected_users') ]; + if (defined $c->param('selected_users')) { + $c->{selectedUserIDs} = [ $c->param('selected_users') ]; } else { - $self->{selectedUserIDs} = []; + $c->{selectedUserIDs} = []; } - if (defined $r->param('labelSortMethod')) { - $self->{primarySortField} = $r->param('labelSortMethod'); - $self->{secondarySortField} = $r->param('primarySortField'); - $self->{ternarySortField} = $r->param('secondarySortField'); + if (defined $c->param('labelSortMethod')) { + $c->{primarySortField} = $c->param('labelSortMethod'); + $c->{secondarySortField} = $c->param('primarySortField'); + $c->{ternarySortField} = $c->param('secondarySortField'); } else { - $self->{primarySortField} = $r->param('primarySortField') || 'last_name'; - $self->{secondarySortField} = $r->param('secondarySortField') || 'first_name'; - $self->{ternarySortField} = $r->param('ternarySortField') || 'student_id'; + $c->{primarySortField} = $c->param('primarySortField') || 'last_name'; + $c->{secondarySortField} = $c->param('secondarySortField') || 'first_name'; + $c->{ternarySortField} = $c->param('ternarySortField') || 'student_id'; } my (%sections, %recitations); @@ -207,40 +198,39 @@ async sub pre_header_initialize { push @{ $sections{ defined $user->section ? $user->section : '' } }, $user->user_id; push @{ $recitations{ defined $user->recitation ? $user->recitation : '' } }, $user->user_id; } - $self->{sections} = \%sections; - $self->{recitations} = \%recitations; + $c->{sections} = \%sections; + $c->{recitations} = \%recitations; - my $actionID = $r->param('action'); + my $actionID = $c->param('action'); if ($actionID) { unless (grep { $_ eq $actionID } @{ VIEW_FORMS() }, @{ EDIT_FORMS() }, @{ PASSWORD_FORMS() }) { - die $r->maketext('Action [_1] not found', $actionID); + die $c->maketext('Action [_1] not found', $actionID); } if (!FORM_PERMS()->{$actionID} || $authz->hasPermissions($user, FORM_PERMS()->{$actionID})) { # Call the action handler my $actionHandler = "${actionID}_handler"; - $self->addgoodmessage($r->maketext( - 'Result of last action performed: [_1]', $r->tag('i', $self->$actionHandler))); + $c->addgoodmessage($c->maketext('Result of last action performed: [_1]', $c->tag('i', $c->$actionHandler))); } else { - $self->addbadmessage($r->maketext('You are not authorized to perform this action.')); + $c->addbadmessage($c->maketext('You are not authorized to perform this action.')); } } else { - $self->addgoodmessage($r->maketext("Please select action to be performed.")); + $c->addgoodmessage($c->maketext("Please select action to be performed.")); } # Get requested users - $self->{visibleUsers} = [ @{ $self->{visibleUserIDs} } ? $db->getUsers(@{ $self->{visibleUserIDs} }) : () ]; + $c->{visibleUsers} = [ @{ $c->{visibleUserIDs} } ? $db->getUsers(@{ $c->{visibleUserIDs} }) : () ]; - my $primarySortSub = SORT_SUBS()->{ $self->{primarySortField} }; - my $secondarySortSub = SORT_SUBS()->{ $self->{secondarySortField} }; - my $ternarySortSub = SORT_SUBS()->{ $self->{ternarySortField} }; + my $primarySortSub = SORT_SUBS()->{ $c->{primarySortField} }; + my $secondarySortSub = SORT_SUBS()->{ $c->{secondarySortField} }; + my $ternarySortSub = SORT_SUBS()->{ $c->{ternarySortField} }; # Add permission level to the user record hash so we can sort by it. - for my $user (@{ $self->{visibleUsers} }) { + for my $user (@{ $c->{visibleUsers} }) { my $permissionLevel = $db->getPermissionLevel($user->user_id); unless ($permissionLevel) { # Uh oh! No permission level record found! - $self->addbadmessage($r->maketext('Added missing permission level for user [_1].', $user->user_id)); + $c->addbadmessage($c->maketext('Added missing permission level for user [_1].', $user->user_id)); # Create a new permission level record. $permissionLevel = $db->newPermissionLevel; @@ -255,55 +245,51 @@ async sub pre_header_initialize { } # Always have a definite sort order in case the first three sorts don't determine things. - $self->{visibleUsers} = [ + $c->{visibleUsers} = [ sort { &$primarySortSub || &$secondarySortSub || &$ternarySortSub || byLastName || byFirstName || byUserID } - @{ $self->{visibleUsers} } + @{ $c->{visibleUsers} } ]; return; } -sub initialize { - my ($self) = @_; - my $r = $self->r; - +sub initialize ($c) { # Make sure these are defined for the template. # This is done here as it needs to occur after the action handler has been executed. - $r->stash->{formsToShow} = - $self->{editMode} ? EDIT_FORMS() : $self->{passwordMode} ? PASSWORD_FORMS() : VIEW_FORMS(); - $r->stash->{formTitles} = FORM_TITLES(); - $r->stash->{formPerms} = FORM_PERMS(); - $r->stash->{fields} = FIELDS(); - $r->stash->{fieldProperties} = FIELD_PROPERTIES(); + $c->stash->{formsToShow} = + $c->{editMode} ? EDIT_FORMS() : $c->{passwordMode} ? PASSWORD_FORMS() : VIEW_FORMS(); + $c->stash->{formTitles} = FORM_TITLES(); + $c->stash->{formPerms} = FORM_PERMS(); + $c->stash->{fields} = FIELDS(); + $c->stash->{fieldProperties} = FIELD_PROPERTIES(); + + return; } # Action handlers # This action handler modifies the "visibleUserIDs" field based on the contents # of the "action.filter.scope" parameter and the "selected_users". -sub filter_handler { - my ($self) = @_; - - my $r = $self->r; - my $db = $r->db; - my $ce = $r->ce; +sub filter_handler ($c) { + my $db = $c->db; + my $ce = $c->ce; my $result; - my $scope = $r->param('action.filter.scope'); + my $scope = $c->param('action.filter.scope'); if ($scope eq 'all') { - $result = $r->maketext('showing all users'); - $self->{visibleUserIDs} = $self->{allUserIDs}; + $result = $c->maketext('showing all users'); + $c->{visibleUserIDs} = $c->{allUserIDs}; } elsif ($scope eq 'none') { - $result = $r->maketext('showing no users'); - $self->{visibleUserIDs} = []; + $result = $c->maketext('showing no users'); + $c->{visibleUserIDs} = []; } elsif ($scope eq 'selected') { - $result = $r->maketext('showing selected users'); - $self->{visibleUserIDs} = [ $r->param('selected_users') ]; + $result = $c->maketext('showing selected users'); + $c->{visibleUserIDs} = [ $c->param('selected_users') ]; } elsif ($scope eq 'match_regex') { - $result = $r->maketext('showing matching users'); - my $regex = $r->param('action.filter.user_ids'); - my $field = $r->param('action.filter.field'); + $result = $c->maketext('showing matching users'); + my $regex = $c->param('action.filter.user_ids'); + my $field = $c->param('action.filter.field'); my @userRecords = $db->getUsersWhere({ user_id => { not_like => 'set_id:%' } }); my @userIDs; my %permissionLabels = reverse %{ $ce->{userRoles} }; @@ -319,102 +305,91 @@ sub filter_handler { } push @userIDs, $record->user_id if $record->{$field} =~ /^$regex/i; } - $self->{visibleUserIDs} = \@userIDs; + $c->{visibleUserIDs} = \@userIDs; } elsif ($scope eq 'match_ids') { - my @userIDs = split /\s*,\s*/, $r->param('action.filter.user_ids'); - $self->{visibleUserIDs} = \@userIDs; + my @userIDs = split /\s*,\s*/, $c->param('action.filter.user_ids'); + $c->{visibleUserIDs} = \@userIDs; } elsif ($scope eq 'match_section') { - my $section = $r->param('action.filter.section'); - $self->{visibleUserIDs} = $self->{sections}{$section}; # an arrayref + my $section = $c->param('action.filter.section'); + $c->{visibleUserIDs} = $c->{sections}{$section}; # an arrayref } elsif ($scope eq 'match_recitation') { - my $recitation = $r->param('action.filter.recitation'); - $self->{visibleUserIDs} = $self->{recitations}{$recitation}; # an arrayref + my $recitation = $c->param('action.filter.recitation'); + $c->{visibleUserIDs} = $c->{recitations}{$recitation}; # an arrayref } return $result; } -sub sort_handler { - my ($self) = @_; - my $r = $self->r; - - $self->{primarySortField} = $r->param('action.sort.primary'); - $self->{secondarySortField} = $r->param('action.sort.secondary'); - $self->{ternarySortField} = $r->param('action.sort.ternary'); +sub sort_handler ($c) { + $c->{primarySortField} = $c->param('action.sort.primary'); + $c->{secondarySortField} = $c->param('action.sort.secondary'); + $c->{ternarySortField} = $c->param('action.sort.ternary'); - return $r->maketext( + return $c->maketext( 'Users sorted by [_1], then by [_2], then by [_3]', - $r->maketext(FIELD_PROPERTIES()->{ $self->{primarySortField} }{name}), - $r->maketext(FIELD_PROPERTIES()->{ $self->{secondarySortField} }{name}), - $r->maketext(FIELD_PROPERTIES()->{ $self->{ternarySortField} }{name}) + $c->maketext(FIELD_PROPERTIES()->{ $c->{primarySortField} }{name}), + $c->maketext(FIELD_PROPERTIES()->{ $c->{secondarySortField} }{name}), + $c->maketext(FIELD_PROPERTIES()->{ $c->{ternarySortField} }{name}) ); } -sub edit_handler { - my ($self) = @_; - my $r = $self->r; - +sub edit_handler ($c) { my $result; - my $scope = $r->param('action.edit.scope'); + my $scope = $c->param('action.edit.scope'); if ($scope eq 'all') { - $result = $r->maketext('editing all users'); - $self->{visibleUserIDs} = $self->{allUserIDs}; + $result = $c->maketext('editing all users'); + $c->{visibleUserIDs} = $c->{allUserIDs}; } elsif ($scope eq 'visible') { - $result = $r->maketext('editing visible users'); + $result = $c->maketext('editing visible users'); # leave visibleUserIDs alone } elsif ($scope eq 'selected') { - $result = $r->maketext('editing selected users'); - $self->{visibleUserIDs} = [ $r->param('selected_users') ]; + $result = $c->maketext('editing selected users'); + $c->{visibleUserIDs} = [ $c->param('selected_users') ]; } - $self->{editMode} = 1; + $c->{editMode} = 1; return $result; } -sub password_handler { - my ($self) = @_; - my $r = $self->r; - +sub password_handler ($c) { my $result; - my $scope = $r->param('action.password.scope'); + my $scope = $c->param('action.password.scope'); if ($scope eq 'all') { - $result = $r->maketext('giving new passwords to all users'); - $self->{visibleUserIDs} = $self->{allUserIDs}; + $result = $c->maketext('giving new passwords to all users'); + $c->{visibleUserIDs} = $c->{allUserIDs}; } elsif ($scope eq 'visible') { - $result = $r->maketext('giving new passwords to visible users'); + $result = $c->maketext('giving new passwords to visible users'); # leave visibleUserIDs alone } elsif ($scope eq 'selected') { - $result = $r->maketext('giving new passwords to selected users'); - $self->{visibleUserIDs} = [ $r->param('selected_users') ]; + $result = $c->maketext('giving new passwords to selected users'); + $c->{visibleUserIDs} = [ $c->param('selected_users') ]; } - $self->{passwordMode} = 1; + $c->{passwordMode} = 1; return $result; } -sub delete_handler { - my ($self) = @_; - my $r = $self->r; - my $db = $r->db; - my $user = $r->param('user'); - my $scope = $r->param('action.delete.scope'); +sub delete_handler ($c) { + my $db = $c->db; + my $user = $c->param('user'); + my $scope = $c->param('action.delete.scope'); my @userIDsToDelete = (); if ($scope eq 'selected') { - @userIDsToDelete = @{ $self->{selectedUserIDs} }; + @userIDsToDelete = @{ $c->{selectedUserIDs} }; } - my %allUserIDs = map { $_ => 1 } @{ $self->{allUserIDs} }; - my %visibleUserIDs = map { $_ => 1 } @{ $self->{visibleUserIDs} }; - my %selectedUserIDs = map { $_ => 1 } @{ $self->{selectedUserIDs} }; + my %allUserIDs = map { $_ => 1 } @{ $c->{allUserIDs} }; + my %visibleUserIDs = map { $_ => 1 } @{ $c->{visibleUserIDs} }; + my %selectedUserIDs = map { $_ => 1 } @{ $c->{selectedUserIDs} }; my $error = ''; my $num = 0; foreach my $userID (@userIDsToDelete) { if ($user eq $userID) { # don't delete yourself!! - $error = $r->maketext('You cannot delete yourself!'); + $error = $c->maketext('You cannot delete yourself!'); next; } delete $allUserIDs{$userID}; @@ -424,25 +399,22 @@ sub delete_handler { $num++; } - $self->{allUserIDs} = [ keys %allUserIDs ]; - $self->{visibleUserIDs} = [ keys %visibleUserIDs ]; - $self->{selectedUserIDs} = [ keys %selectedUserIDs ]; + $c->{allUserIDs} = [ keys %allUserIDs ]; + $c->{visibleUserIDs} = [ keys %visibleUserIDs ]; + $c->{selectedUserIDs} = [ keys %selectedUserIDs ]; - return $r->maketext('Deleted [_1] users.', $num) . ($error ? " $error" : ''); + return $c->maketext('Deleted [_1] users.', $num) . ($error ? " $error" : ''); } -sub add_handler { +sub add_handler ($c) { # This action is redirected to the AddUsers.pm module using ../instructor/add_user/... return ''; } -sub import_handler { - my ($self) = @_; - my $r = $self->r; - - my $source = $r->param('action.import.source'); - my $add = $r->param('action.import.add'); - my $replace = $r->param('action.import.replace'); +sub import_handler ($c) { + my $source = $c->param('action.import.source'); + my $add = $c->param('action.import.add'); + my $replace = $c->param('action.import.replace'); my $fileName = $source; my $createNew = $add eq 'any'; @@ -454,35 +426,33 @@ sub import_handler { $replaceExisting = 'none'; } elsif ($replace eq 'visible') { $replaceExisting = 'listed'; - @replaceList = @{ $self->{visibleUserIDs} }; + @replaceList = @{ $c->{visibleUserIDs} }; } elsif ($replace eq 'selected') { $replaceExisting = 'listed'; - @replaceList = @{ $self->{selectedUserIDs} }; + @replaceList = @{ $c->{selectedUserIDs} }; } - my ($replaced, $added, $skipped) = $self->importUsersFromCSV($fileName, $createNew, $replaceExisting, @replaceList); + my ($replaced, $added, $skipped) = $c->importUsersFromCSV($fileName, $createNew, $replaceExisting, @replaceList); # make new users visible... do we really want to do this? probably. - push @{ $self->{visibleUserIDs} }, @$added; - push @{ $self->{allUserIDs} }, @$added; + push @{ $c->{visibleUserIDs} }, @$added; + push @{ $c->{allUserIDs} }, @$added; my $numReplaced = @$replaced; my $numAdded = @$added; my $numSkipped = @$skipped; - return $r->maketext('[_1] users replaced, [_2] users added, [_3] users skipped. Skipped users: ([_4])', + return $c->maketext('[_1] users replaced, [_2] users added, [_3] users skipped. Skipped users: ([_4])', $numReplaced, $numAdded, $numSkipped, join(', ', @$skipped)); } -sub export_handler { - my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; - my $dir = $ce->{courseDirs}->{templates}; +sub export_handler ($c) { + my $ce = $c->ce; + my $dir = $ce->{courseDirs}{templates}; - my $scope = $r->param('action.export.scope'); - my $target = $r->param('action.export.target'); - my $new = $r->param('action.export.new'); + my $scope = $c->param('action.export.scope'); + my $target = $c->param('action.export.target'); + my $new = $c->param('action.export.new'); #get name of templates directory as it appears in file manager $dir =~ s|.*/||; @@ -498,56 +468,51 @@ sub export_handler { my @userIDsToExport; if ($scope eq 'all') { - @userIDsToExport = @{ $self->{allUserIDs} }; + @userIDsToExport = @{ $c->{allUserIDs} }; } elsif ($scope eq 'visible') { - @userIDsToExport = @{ $self->{visibleUserIDs} }; + @userIDsToExport = @{ $c->{visibleUserIDs} }; } elsif ($scope eq 'selected') { - @userIDsToExport = @{ $self->{selectedUserIDs} }; + @userIDsToExport = @{ $c->{selectedUserIDs} }; } - $self->exportUsersToCSV($fileName, @userIDsToExport); + $c->exportUsersToCSV($fileName, @userIDsToExport); - return $r->maketext('[_1] users exported to file [_2]', scalar @userIDsToExport, "$dir/$fileName"); + return $c->maketext('[_1] users exported to file [_2]', scalar @userIDsToExport, "$dir/$fileName"); } -sub cancel_edit_handler { - my ($self) = @_; - my $r = $self->r; - - if (defined $r->param('prev_visible_users')) { - $self->{visibleUserIDs} = [ $r->param('prev_visible_users') ]; - } elsif (defined $r->param('no_prev_visible_users')) { - $self->{visibleUserIDs} = []; +sub cancel_edit_handler ($c) { + if (defined $c->param('prev_visible_users')) { + $c->{visibleUserIDs} = [ $c->param('prev_visible_users') ]; + } elsif (defined $c->param('no_prev_visible_users')) { + $c->{visibleUserIDs} = []; } - $self->{editMode} = 0; + $c->{editMode} = 0; - return $r->maketext('Changes abandoned'); + return $c->maketext('Changes abandoned'); } -sub save_edit_handler { - my ($self) = @_; - my $r = $self->r; - my $db = $r->db; - my $editorUser = $r->param('user'); +sub save_edit_handler ($c) { + my $db = $c->db; + my $editorUser = $c->param('user'); my $editorUserPermission = $db->getPermissionLevel($editorUser)->permission; - my @visibleUserIDs = @{ $self->{visibleUserIDs} }; + my @visibleUserIDs = @{ $c->{visibleUserIDs} }; foreach my $userID (@visibleUserIDs) { my $User = $db->getUser($userID); - die $r->maketext('record for visible user [_1] not found', $userID) unless $User; + die $c->maketext('record for visible user [_1] not found', $userID) unless $User; my $PermissionLevel = $db->getPermissionLevel($userID); - die $r->maketext('permissions for [_1] not defined', $userID) unless defined $PermissionLevel; + die $c->maketext('permissions for [_1] not defined', $userID) unless defined $PermissionLevel; foreach my $field ($User->NONKEYFIELDS()) { my $param = "user.$userID.$field"; - if (defined $r->param($param)) { - $User->$field($r->param($param)); + if (defined $c->param($param)) { + $User->$field($c->param($param)); } } foreach my $field ($PermissionLevel->NONKEYFIELDS()) { my $param = "permission.$userID.$field"; - if (defined $r->param($param) && $r->param($param) <= $editorUserPermission) { - $PermissionLevel->$field($r->param($param)); + if (defined $c->param($param) && $c->param($param) <= $editorUserPermission) { + $PermissionLevel->$field($c->param($param)); } } @@ -555,43 +520,38 @@ sub save_edit_handler { $db->putPermissionLevel($PermissionLevel); } - if (defined $r->param('prev_visible_users')) { - $self->{visibleUserIDs} = [ $r->param('prev_visible_users') ]; - } elsif (defined $r->param('no_prev_visible_users')) { - $self->{visibleUserIDs} = []; + if (defined $c->param('prev_visible_users')) { + $c->{visibleUserIDs} = [ $c->param('prev_visible_users') ]; + } elsif (defined $c->param('no_prev_visible_users')) { + $c->{visibleUserIDs} = []; } - $self->{editMode} = 0; + $c->{editMode} = 0; - return $r->maketext('Changes saved'); + return $c->maketext('Changes saved'); } -sub cancel_password_handler { - my ($self) = @_; - my $r = $self->r; - - if (defined $r->param('prev_visible_users')) { - $self->{visibleUserIDs} = [ $r->param('prev_visible_users') ]; - } elsif (defined $r->param('no_prev_visible_users')) { - $self->{visibleUserIDs} = []; +sub cancel_password_handler ($c) { + if (defined $c->param('prev_visible_users')) { + $c->{visibleUserIDs} = [ $c->param('prev_visible_users') ]; + } elsif (defined $c->param('no_prev_visible_users')) { + $c->{visibleUserIDs} = []; } - $self->{passwordMode} = 0; + $c->{passwordMode} = 0; - return $r->maketext('Changes abandoned'); + return $c->maketext('Changes abandoned'); } -sub save_password_handler { - my ($self) = @_; - my $r = $self->r; - my $db = $r->db; +sub save_password_handler ($c) { + my $db = $c->db; - my @visibleUserIDs = @{ $self->{visibleUserIDs} }; + my @visibleUserIDs = @{ $c->{visibleUserIDs} }; foreach my $userID (@visibleUserIDs) { my $User = $db->getUser($userID); - die $r->maketext('record for visible user [_1] not found', $userID) unless $User; + die $c->maketext('record for visible user [_1] not found', $userID) unless $User; my $param = "user.${userID}.new_password"; - if ($r->param($param)) { - my $newP = $r->param($param); + if ($c->param($param)) { + my $newP = $c->param($param); my $Password = eval { $db->getPassword($User->user_id) }; my $cryptPassword = cryptPassword($newP); if (!defined($Password)) { @@ -606,42 +566,39 @@ sub save_password_handler { } } - if (defined $r->param('prev_visible_users')) { - $self->{visibleUserIDs} = [ $r->param('prev_visible_users') ]; - } elsif (defined $r->param('no_prev_visible_users')) { - $self->{visibleUserIDs} = []; + if (defined $c->param('prev_visible_users')) { + $c->{visibleUserIDs} = [ $c->param('prev_visible_users') ]; + } elsif (defined $c->param('no_prev_visible_users')) { + $c->{visibleUserIDs} = []; } - $self->{passwordMode} = 0; + $c->{passwordMode} = 0; - return $r->maketext('New passwords saved'); + return $c->maketext('New passwords saved'); } # Sort methods -sub byUserID { lc $a->user_id cmp lc $b->user_id } +sub byUserID { return lc $a->user_id cmp lc $b->user_id } sub byFirstName { - (defined $a->first_name && defined $b->first_name) ? lc $a->first_name cmp lc $b->first_name : 0; + return (defined $a->first_name && defined $b->first_name) ? lc $a->first_name cmp lc $b->first_name : 0; } -sub byLastName { (defined $a->last_name && defined $b->last_name) ? lc $a->last_name cmp lc $b->last_name : 0; } -sub byEmailAddress { lc $a->email_address cmp lc $b->email_address } -sub byStudentID { lc $a->student_id cmp lc $b->student_id } -sub byStatus { lc $a->status cmp lc $b->status } -sub bySection { lc $a->section cmp lc $b->section } -sub byRecitation { lc $a->recitation cmp lc $b->recitation } -sub byComment { lc $a->comment cmp lc $b->comment } +sub byLastName { return (defined $a->last_name && defined $b->last_name) ? lc $a->last_name cmp lc $b->last_name : 0; } +sub byEmailAddress { return lc $a->email_address cmp lc $b->email_address } +sub byStudentID { return lc $a->student_id cmp lc $b->student_id } +sub byStatus { return lc $a->status cmp lc $b->status } +sub bySection { return lc $a->section cmp lc $b->section } +sub byRecitation { return lc $a->recitation cmp lc $b->recitation } +sub byComment { return lc $a->comment cmp lc $b->comment } # Permission level is added to the user record hash so we can sort by it if necessary. -sub byPermission { - return $a->{permission} <=> $b->{permission}; -} +sub byPermission { return $a->{permission} <=> $b->{permission}; } # Utilities # generate labels for section/recitation popup menus -sub menuLabels { - my ($self, $hashRef) = @_; +sub menuLabels ($c, $hashRef) { my %hash = %$hashRef; my %result; @@ -655,19 +612,17 @@ sub menuLabels { # FIXME REFACTOR this belongs in a utility class so that addcourse can use it! # (we need a whole suite of higher-level import/export functions somewhere) -sub importUsersFromCSV { - my ($self, $fileName, $createNew, $replaceExisting, @replaceList) = @_; - my $r = $self->r; - my $ce = $r->ce; - my $db = $r->db; +sub importUsersFromCSV ($c, $fileName, $createNew, $replaceExisting, @replaceList) { + my $ce = $c->ce; + my $db = $c->db; my $dir = $ce->{courseDirs}->{templates}; - my $user = $r->param('user'); + my $user = $c->param('user'); - die $r->maketext("illegal character in input: '/'") if $fileName =~ m|/|; - die $r->maketext("won't be able to read from file [_1]/[_2]: does it exist? is it readable?", $dir, $fileName) + die $c->maketext("illegal character in input: '/'") if $fileName =~ m|/|; + die $c->maketext("won't be able to read from file [_1]/[_2]: does it exist? is it readable?", $dir, $fileName) unless -r "$dir/$fileName"; - my %allUserIDs = map { $_ => 1 } @{ $self->{allUserIDs} }; + my %allUserIDs = map { $_ => 1 } @{ $c->{allUserIDs} }; my %replaceOK; if ($replaceExisting eq 'none') { %replaceOK = (); @@ -751,14 +706,12 @@ sub importUsersFromCSV { return \@replaced, \@added, \@skipped; } -sub exportUsersToCSV { - my ($self, $fileName, @userIDsToExport) = @_; - my $r = $self->r; - my $ce = $r->ce; - my $db = $r->db; +sub exportUsersToCSV ($c, $fileName, @userIDsToExport) { + my $ce = $c->ce; + my $db = $c->db; my $dir = $ce->{courseDirs}->{templates}; - die $r->maketext("illegal character in input: '/'") if $fileName =~ m|/|; + die $c->maketext("illegal character in input: '/'") if $fileName =~ m|/|; my @records; @@ -779,6 +732,8 @@ sub exportUsersToCSV { } write_classlist("$dir/$fileName", @records); + + return; } 1; diff --git a/lib/WeBWorK/ContentGenerator/Instructor/UsersAssignedToSet.pm b/lib/WeBWorK/ContentGenerator/Instructor/UsersAssignedToSet.pm index e526545034..156885eb43 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/UsersAssignedToSet.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/UsersAssignedToSet.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::Instructor::UsersAssignedToSet; -use parent qw(WeBWorK::ContentGenerator); +use Mojo::Base 'WeBWorK::ContentGenerator', -signatures; =head1 NAME @@ -23,52 +23,46 @@ users to which sets are assigned. =cut -use strict; -use warnings; - use WeBWorK::Debug; use WeBWorK::Utils qw(format_set_name_display); use WeBWorK::Utils::Instructor qw(assignSetToUser assignSetToAllUsers); -sub initialize { - my ($self) = @_; - my $r = $self->r; - my $urlpath = $r->urlpath; - my $authz = $r->authz; - my $db = $r->db; - my $setID = $urlpath->arg("setID"); - my $user = $r->param('user'); +sub initialize ($c) { + my $authz = $c->authz; + my $db = $c->db; + my $setID = $c->stash('setID'); + my $user = $c->param('user'); # Check permissions return unless $authz->hasPermissions($user, "access_instructor_tools"); return unless $authz->hasPermissions($user, "assign_problem_sets"); - my %selectedUsers = map { $_ => 1 } $r->param('selected'); + my %selectedUsers = map { $_ => 1 } $c->param('selected'); my $doAssignToSelected = 0; - if (defined $r->param('assignToAll')) { + if (defined $c->param('assignToAll')) { debug("assignSetToAllUsers($setID)"); - $self->addgoodmessage($r->maketext("Problems have been assigned to all current users.")); - assignSetToAllUsers($db, $r->ce, $setID); + $c->addgoodmessage($c->maketext("Problems have been assigned to all current users.")); + assignSetToAllUsers($db, $c->ce, $setID); debug("done assignSetToAllUsers($setID)"); - } elsif (defined $r->param('unassignFromAll') - && defined($r->param('unassignFromAllSafety')) - && $r->param('unassignFromAllSafety') == 1) + } elsif (defined $c->param('unassignFromAll') + && defined($c->param('unassignFromAllSafety')) + && $c->param('unassignFromAllSafety') == 1) { %selectedUsers = (); - $self->addgoodmessage($r->maketext("Problems for all students have been unassigned.")); + $c->addgoodmessage($c->maketext("Problems for all students have been unassigned.")); $doAssignToSelected = 1; - } elsif (defined $r->param('assignToSelected')) { - $self->addgoodmessage($r->maketext("Problems for selected students have been reassigned.")); + } elsif (defined $c->param('assignToSelected')) { + $c->addgoodmessage($c->maketext("Problems for selected students have been reassigned.")); $doAssignToSelected = 1; - } elsif (defined $r->param("unassignFromAll")) { + } elsif (defined $c->param("unassignFromAll")) { # no action taken - $self->addbadmessage($r->maketext("No action taken")); + $c->addbadmessage($c->maketext("No action taken")); } # Get all user records and cache them for later use. - $self->{user_records} = + $c->{user_records} = [ $db->getUsersWhere({ user_id => { not_like => 'set_id:%' } }, [qw/section last_name first_name/]) ]; if ($doAssignToSelected) { @@ -76,7 +70,7 @@ sub initialize { die "Unable to get global set record for $setID " unless $setRecord; my %setUsers = map { $_ => 1 } $db->listSetUsers($setID); - for my $selectedUser (map { $_->user_id } @{ $self->{user_records} }) { + for my $selectedUser (map { $_->user_id } @{ $c->{user_records} }) { if (exists $selectedUsers{$selectedUser}) { unless ($setUsers{$selectedUser}) { # skip users already in the set debug("assignSetToUser($selectedUser, ...)"); diff --git a/lib/WeBWorK/ContentGenerator/InstructorRPCHandler.pm b/lib/WeBWorK/ContentGenerator/InstructorRPCHandler.pm index 30a0a3215b..000c03bcb8 100644 --- a/lib/WeBWorK/ContentGenerator/InstructorRPCHandler.pm +++ b/lib/WeBWorK/ContentGenerator/InstructorRPCHandler.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::InstructorRPCHandler; -use parent qw(WeBWorK::ContentGenerator); +use Mojo::Base 'WeBWorK::ContentGenerator', -signatures, -async_await; =head1 NAME @@ -35,58 +35,49 @@ error occurs, then the response will contain an "error" key. =cut -use strict; -use warnings; - -use Future::AsyncAwait; use JSON; use WebworkWebservice; -async sub pre_header_initialize { - my $self = shift; - my $r = $self->r; - - unless ($r->authen->was_verified) { - $self->{output} = 'instructor_rpc: authentication failed.'; +async sub pre_header_initialize ($c) { + unless ($c->authen->was_verified) { + $c->{output} = 'instructor_rpc: authentication failed.'; return; } - my $rpc_command = $r->param('rpc_command'); + my $rpc_command = $c->param('rpc_command'); unless ($rpc_command) { - $self->{output} = 'instructor_rpc: rpc_command not provided.'; + $c->{output} = 'instructor_rpc: rpc_command not provided.'; return; } # The renderProblem command is not supported by this method. # The render_rpc endpoint should be used for that instead. if ($rpc_command eq 'renderProblem') { - $self->{output} = + $c->{output} = 'instructor_rpc: The renderProblem command is not supported by this endpoint. Use render_rpc instead'; return; } # Call the WebworkWebservice to execute the requested command. - my $rpc_service = WebworkWebservice->new($r); + my $rpc_service = WebworkWebservice->new($c); await $rpc_service->rpc_execute($rpc_command); - $self->{output} = $rpc_service; + $c->{output} = $rpc_service; return; } -sub content { - my $self = shift; - +sub content ($c) { # This endpoint always responds with a valid JSON response. - return $self->r->render(json => { error => $self->{output} }) if (ref($self->{output}) !~ /WebworkWebservice/); + return $c->render(json => { error => $c->{output} }) if (ref($c->{output}) !~ /WebworkWebservice/); - my $rpc_service = $self->{output}; + my $rpc_service = $c->{output}; if ($rpc_service->error_string) { - return $self->r->render(json => { error => $rpc_service->error_string }); + return $c->render(json => { error => $rpc_service->error_string }); } else { - return $self->r->render( + return $c->render( json => { server_response => $rpc_service->return_object->{text}, result_data => $rpc_service->return_object->{ra_out} // '' diff --git a/lib/WeBWorK/ContentGenerator/Login.pm b/lib/WeBWorK/ContentGenerator/Login.pm index 275821976b..2cf5be3e40 100644 --- a/lib/WeBWorK/ContentGenerator/Login.pm +++ b/lib/WeBWorK/ContentGenerator/Login.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::Login; -use parent qw(WeBWorK::ContentGenerator); +use Mojo::Base 'WeBWorK::ContentGenerator', -signatures; =head1 NAME @@ -22,39 +22,31 @@ WeBWorK::ContentGenerator::Login - display a login form. =cut -use strict; -use warnings; - use WeBWorK::Utils qw(readFile jitar_id_to_seq format_set_name_display); -sub title { - my ($self) = @_; - my $r = $self->r; - +sub page_title ($c) { # If the url is for a problem page, then the title is the set and problem id. - my $problemID = $self->r->urlpath->arg('problemID'); + my $problemID = $c->stash('problemID'); if ($problemID) { - my $setID = $self->r->urlpath->arg('setID'); + my $setID = $c->stash('setID'); # Print the pretty version of the problem id for a jitar set. - my $set = $r->db->getGlobalSet($setID); + my $set = $c->db->getGlobalSet($setID); if ($set && $set->assignment_type eq 'jitar') { $problemID = join('.', jitar_id_to_seq($problemID)); } - return $r->maketext('[_1]: Problem [_2]', - $r->tag('span', dir => 'ltr', format_set_name_display($setID)), $problemID); + return $c->maketext('[_1]: Problem [_2]', + $c->tag('span', dir => 'ltr', format_set_name_display($setID)), $problemID); } - return $self->SUPER::title(); + return $c->SUPER::page_title(); } -sub info { - my $self = shift; - my $r = $self->r; - my $ce = $r->ce; +sub info ($c) { + my $ce = $c->ce; - my $result = $r->c; + my $result = $c->c; # This section should be kept in sync with the Home.pm version. @@ -62,28 +54,25 @@ sub info { # Login info is relative to the templates directory. push( @$result, - $self->output_info_file( - $r->maketext('Login Info'), + $c->output_info_file( + $c->maketext('Login Info'), "$ce->{courseDirs}{templates}/$ce->{courseFiles}{login_info}" ) ) if ($ce->{courseFiles}{login_info}); - push(@$result, $self->output_info_file($r->maketext('Site Information'), $ce->{webworkFiles}{site_info})) + push(@$result, $c->output_info_file($c->maketext('Site Information'), $ce->{webworkFiles}{site_info})) if $ce->{webworkFiles}{site_info}; return $result->join(''); } -sub output_info_file { - my ($self, $info_title, $info_file) = @_; - my $r = $self->r; - +sub output_info_file ($c, $info_title, $info_file) { if (-f $info_file) { my $text = eval { readFile($info_file) }; if ($@) { - return $r->tag('h2', $info_title) . $r->tag('div', class => 'alert alert-danger p-1 mb-2', $@); + return $c->tag('h2', $info_title) . $c->tag('div', class => 'alert alert-danger p-1 mb-2', $@); } elsif ($text =~ /\S/) { - return $r->tag('h2', $info_title) . $text; + return $c->tag('h2', $info_title) . $text; } } @@ -91,19 +80,16 @@ sub output_info_file { } # Override the can method to disable links for the login page. -sub can { - my ($self, $arg) = @_; - return $arg eq 'links' ? 0 : $self->SUPER::can($arg); +sub can ($c, $arg) { + return $arg eq 'links' ? 0 : $c->SUPER::can($arg); } -async sub pre_header_initialize { - my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; - my $authen = $r->authen; +sub pre_header_initialize ($c) { + my $ce = $c->ce; + my $authen = $c->authen; if ($authen->{redirect}) { - $self->reply_with_redirect($authen->{redirect}); + $c->reply_with_redirect($authen->{redirect}); return; } @@ -111,21 +97,21 @@ async sub pre_header_initialize { # might be external, e.g., LTIBasic, but a non-external one, e.g., Basic_TheLastChance or even just WeBWorK::Authen, # might handle the ongoing session management. So this should be set in the course environment when a sequence of # authentication modules is used. - $r->stash->{externalAuth} = $ce->{external_auth} || $authen->{external_auth}; + $c->stash->{externalAuth} = $ce->{external_auth} || $authen->{external_auth}; my $hidden_fields = ''; my @allowedGuestUsers; - if (!$r->stash->{externalAuth}) { + if (!$c->stash->{externalAuth}) { # Preserve the form data posted to the requested URI - my @fields_to_print = grep { !m/^(user|passwd|key|force_passwd_authen)$/ } $r->param; + my @fields_to_print = grep { !m/^(user|passwd|key|force_passwd_authen)$/ } $c->param; # Important note. If hidden_fields is passed an empty array it prints ALL parameters as hidden fields. # That is not what we want in this case, so we don't print at all if @fields_to_print is empty. - $hidden_fields = $self->hidden_fields(@fields_to_print) if (@fields_to_print); + $hidden_fields = $c->hidden_fields(@fields_to_print) if (@fields_to_print); # Determine if there are valid practice users. - my @GuestUsers = $r->db->getUsersWhere({ user_id => { like => "$ce->{practiceUserPrefix}\%" } }); + my @GuestUsers = $c->db->getUsersWhere({ user_id => { like => "$ce->{practiceUserPrefix}\%" } }); for my $GuestUser (@GuestUsers) { next unless defined $GuestUser->status; next unless $GuestUser->status ne ''; @@ -134,16 +120,14 @@ async sub pre_header_initialize { } } - $r->stash->{hidden_fields} = $hidden_fields; - $r->stash->{allowedGuestUsers} = \@allowedGuestUsers; + $c->stash->{hidden_fields} = $hidden_fields; + $c->stash->{allowedGuestUsers} = \@allowedGuestUsers; return; } -sub head { - my ($self) = @_; - my $r = $self->r; - return $r->tag('meta', name => 'robots', content => $r->ce->{options}{metaRobotsContent} // 'none'); +sub head ($c) { + return $c->tag('meta', name => 'robots', content => $c->ce->{options}{metaRobotsContent} // 'none'); } 1; diff --git a/lib/WeBWorK/ContentGenerator/LoginProctor.pm b/lib/WeBWorK/ContentGenerator/LoginProctor.pm index 22e5fb5f53..8c3aa362e7 100644 --- a/lib/WeBWorK/ContentGenerator/LoginProctor.pm +++ b/lib/WeBWorK/ContentGenerator/LoginProctor.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::LoginProctor; -use parent qw(WeBWorK::ContentGenerator); +use Mojo::Base 'WeBWorK::ContentGenerator', -signatures, -async_await; =head1 NAME @@ -23,33 +23,26 @@ GatewayQuiz proctored tests. =cut -use strict; -use warnings; - -use Future::AsyncAwait; - use WeBWorK::Utils::Rendering qw(renderPG); use WeBWorK::DB::Utils qw(grok_vsetID); -async sub initialize { - my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; - my $db = $r->db; +async sub initialize ($c) { + my $ce = $c->ce; + my $db = $c->db; - my $userID = $r->param('user'); - my $effectiveUserID = $r->param('effectiveUser') || ''; + my $userID = $c->param('user'); + my $effectiveUserID = $c->param('effectiveUser') || ''; - $self->{effectiveUser} = $r->db->getUser($effectiveUserID); + $c->{effectiveUser} = $c->db->getUser($effectiveUserID); # The user set is needed to check for a set-restricted login proctor, and to show and possibly save the submission # time. To get the user set, the set name and version number are needed. Attempt to obtain those from the url path # setID. Otherwise, use the highest version number. - ($r->stash->{setID}, my $versionNum) = grok_vsetID($r->urlpath->arg('setID')); + ($c->stash->{setID}, my $versionNum) = grok_vsetID($c->stash('setID')); my $noSetVersions = 0; if (!$versionNum) { # Get a list of all available versions. - my @setVersions = $db->listSetVersions($effectiveUserID, $r->stash->{setID}); + my @setVersions = $db->listSetVersions($effectiveUserID, $c->stash->{setID}); if (@setVersions) { $versionNum = $setVersions[-1]; } else { @@ -60,66 +53,65 @@ async sub initialize { } # Get the merged set. If a test is being graded or this is a new version, get the merged template set instead. - $r->stash->{userSet} = - $noSetVersions || !$r->param('submitAnswers') - ? $db->getMergedSet($effectiveUserID, $r->stash->{setID}) - : $db->getMergedSetVersion($effectiveUserID, $r->stash->{setID}, $versionNum); + $c->stash->{userSet} = + $noSetVersions || !$c->param('submitAnswers') + ? $db->getMergedSet($effectiveUserID, $c->stash->{setID}) + : $db->getMergedSetVersion($effectiveUserID, $c->stash->{setID}, $versionNum); - if (defined $r->stash->{userSet}) { + if (defined $c->stash->{userSet}) { # If the set is being submitted, then save the submission time. - if ($r->param('submitAnswers')) { + if ($c->param('submitAnswers')) { # This should never happen. die 'Request to grade a set version before any tests have been taken.' if $noSetVersions; # Determine if answers can be recorded, and set last_attempt_time if appropriate. if (WeBWorK::ContentGenerator::GatewayQuiz::can_recordAnswers( - $self, + $c, $db->getUser($userID), $db->getPermissionLevel($userID), - $self->{effectiveUser}, - $r->stash->{userSet}, - $db->getMergedProblemVersion($effectiveUserID, $r->stash->{setID}, $versionNum, 1) + $c->{effectiveUser}, + $c->stash->{userSet}, + $db->getMergedProblemVersion($effectiveUserID, $c->stash->{setID}, $versionNum, 1) )) { - $r->stash->{userSet}->version_last_attempt_time(int($r->submitTime)); + $c->stash->{userSet}->version_last_attempt_time(int($c->submitTime)); # FIXME: This saves all of the merged set data into the set_user table. We live with this in other # places for versioned sets, but it's not ideal. - $db->putSetVersion($r->stash->{userSet}); + $db->putSetVersion($c->stash->{userSet}); } } } # Get problem set info. - my $set = $r->authz->{merged_set}; + my $set = $c->authz->{merged_set}; return unless $set; # Hack to prevent errors from uninitialized set_headers. $set->set_header('defaultHeader') unless $set->set_header =~ /\S/; - $self->{pg} = await renderPG( - $r, - $self->{effectiveUser}, + $c->{pg} = await renderPG( + $c, + $c->{effectiveUser}, $set, WeBWorK::DB::Record::UserProblem->new( problem_id => 0, set_id => $set->set_id, - login_id => $self->{effectiveUser}->user_id, + login_id => $c->{effectiveUser}->user_id, source_file => $set->set_header eq 'defaultHeader' ? $ce->{webworkFiles}{screenSnippets}{setHeader} : $set->set_header ), $set->psvn, {}, - { displayMode => $r->param('displayMode') || $ce->{pg}{options}{displayMode} } + { displayMode => $c->param('displayMode') || $ce->{pg}{options}{displayMode} } ); return; } -sub info { - my ($self) = @_; - return '' unless $self->{pg}; - return $self->r->c($self->r->tag('h2', $self->r->maketext('Set Info')), $self->{pg}{body_text})->join(''); +sub info ($c) { + return '' unless $c->{pg}; + return $c->c($c->tag('h2', $c->maketext('Set Info')), $c->{pg}{body_text})->join(''); } 1; diff --git a/lib/WeBWorK/ContentGenerator/Logout.pm b/lib/WeBWorK/ContentGenerator/Logout.pm index 8944ce7ac7..912dd26d3a 100644 --- a/lib/WeBWorK/ContentGenerator/Logout.pm +++ b/lib/WeBWorK/ContentGenerator/Logout.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::Logout; -use parent qw(WeBWorK::ContentGenerator); +use Mojo::Base 'WeBWorK::ContentGenerator', -signatures; =head1 NAME @@ -22,60 +22,51 @@ WeBWorK::ContentGenerator::Logout - invalidate key and display logout message. =cut -use strict; -use warnings; - use WeBWorK::Localize; use WeBWorK::Authen qw(write_log_entry); -async sub pre_header_initialize { - my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; - my $db = $r->db; - my $authen = $r->authen; +sub pre_header_initialize ($c) { + my $ce = $c->ce; + my $db = $c->db; + my $authen = $c->authen; - my $userID = $r->param('user_id'); + my $userID = $c->param('user_id'); $authen->killSession; $authen->WeBWorK::Authen::write_log_entry('LOGGED OUT'); # Check to see if there is a proctor key associated with this login. If there is a proctor user, then there must be # a proctored test. So try and delete the key. - my $proctorID = $r->param('proctor_user'); + my $proctorID = $c->param('proctor_user'); if ($proctorID) { eval { $db->deleteKey("$userID,$proctorID"); }; if ($@) { - $self->addbadmessage("Error when clearing proctor key: $@"); + $c->addbadmessage("Error when clearing proctor key: $@"); } # There may also be a proctor key from grading the test. eval { $db->deleteKey("$userID,$proctorID,g"); }; if ($@) { - $self->addbadmessage("Error when clearing proctor grading key: $@"); + $c->addbadmessage("Error when clearing proctor grading key: $@"); } } # Do any special processing needed by external authentication. $authen->logout_user if $authen->can('logout_user'); - $self->reply_with_redirect($authen->{redirect}) if $authen->{redirect}; + $c->reply_with_redirect($authen->{redirect}) if $authen->{redirect}; return; } # Override the can method to disable links for the logout page. -sub can { - my ($self, $arg) = @_; - return $arg eq 'links' ? 0 : $self->SUPER::can($arg); +sub can ($c, $arg) { + return $arg eq 'links' ? 0 : $c->SUPER::can($arg); } -sub path { - my ($self, $args) = @_; - my $r = $self->r; - - return $r->urlpath->arg('courseID') - if (($r->ce->{external_auth} || $r->authen->{external_auth}) && defined $r->urlpath->arg('courseID')); - return $self->SUPER::path($args); +sub path ($c, $args) { + return $c->stash('courseID') + if (($c->ce->{external_auth} || $c->authen->{external_auth}) && defined $c->stash('courseID')); + return $c->SUPER::path($args); } 1; diff --git a/lib/WeBWorK/ContentGenerator/Options.pm b/lib/WeBWorK/ContentGenerator/Options.pm index 4280e005bd..bdd6ffbb11 100644 --- a/lib/WeBWorK/ContentGenerator/Options.pm +++ b/lib/WeBWorK/ContentGenerator/Options.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::Options; -use parent qw(WeBWorK::ContentGenerator); +use Mojo::Base 'WeBWorK::ContentGenerator', -signatures; =head1 NAME @@ -22,126 +22,119 @@ WeBWorK::ContentGenerator::Options - Change user options. =cut -use strict; -use warnings; - use WeBWorK::Utils qw(cryptPassword); use WeBWorK::Localize; -sub initialize { - my ($self) = @_; - my $r = $self->r; - my $db = $r->db; - my $authz = $r->authz; +sub initialize ($c) { + my $db = $c->db; + my $authz = $c->authz; - my $userID = $r->param('user'); - $self->{user} = $db->getUser($userID); - return unless defined $self->{user}; + my $userID = $c->param('user'); + $c->{user} = $db->getUser($userID); + return unless defined $c->{user}; - my $effectiveUserID = $r->param('effectiveUser'); - $self->{effectiveUser} = $db->getUser($effectiveUserID); - return unless defined $self->{effectiveUser}; + my $effectiveUserID = $c->param('effectiveUser'); + $c->{effectiveUser} = $db->getUser($effectiveUserID); + return unless defined $c->{effectiveUser}; - my $changeOptions = $r->param('changeOptions'); + my $changeOptions = $c->param('changeOptions'); if ($authz->hasPermissions($userID, 'change_password')) { - my $currP = $r->param('currPassword'); - my $newP = $r->param('newPassword'); - my $confirmP = $r->param('confirmPassword'); + my $currP = $c->param('currPassword'); + my $newP = $c->param('newPassword'); + my $confirmP = $c->param('confirmPassword'); # Note that it is ok if the password doesn't exist because students might be setting it for the first time. - my $password = eval { $db->getPassword($self->{user}->user_id) }; + my $password = eval { $db->getPassword($c->{user}->user_id) }; if ($changeOptions && ($newP || $confirmP)) { my $effectiveUserPassword = - $userID ne $effectiveUserID ? eval { $db->getPassword($self->{effectiveUser}->user_id) } : $password; + $userID ne $effectiveUserID ? eval { $db->getPassword($c->{effectiveUser}->user_id) } : $password; # Check that either password is not defined or if it is defined then we have the right one. if (!defined $password || crypt($currP // '', $password->password) eq $password->password) { - my $e_user_name = $self->{effectiveUser}->first_name . ' ' . $self->{effectiveUser}->last_name; + my $e_user_name = $c->{effectiveUser}->first_name . ' ' . $c->{effectiveUser}->last_name; if ($newP eq $confirmP) { if (!defined $effectiveUserPassword) { $effectiveUserPassword = $db->newPassword(); - $effectiveUserPassword->user_id($self->{effectiveUser}->user_id); + $effectiveUserPassword->user_id($c->{effectiveUser}->user_id); $effectiveUserPassword->password(cryptPassword($newP)); eval { $db->addPassword($effectiveUserPassword) }; $password = $password // $effectiveUserPassword; if ($@) { - $self->addbadmessage( - $r->maketext("Couldn't change [_1]'s password: [_2]", $e_user_name, $@)); + $c->addbadmessage($c->maketext("Couldn't change [_1]'s password: [_2]", $e_user_name, $@)); } else { - $self->addgoodmessage($r->maketext("[_1]'s password has been changed.", $e_user_name)); + $c->addgoodmessage($c->maketext("[_1]'s password has been changed.", $e_user_name)); } } else { $effectiveUserPassword->password(cryptPassword($newP)); eval { $db->putPassword($effectiveUserPassword) }; $password = $password // $effectiveUserPassword; if ($@) { - $self->addbadmessage( - $r->maketext("Couldn't change [_1]'s password: [_2]", $e_user_name, $@)); + $c->addbadmessage($c->maketext("Couldn't change [_1]'s password: [_2]", $e_user_name, $@)); } else { - $self->addgoodmessage($r->maketext("[_1]'s password has been changed.", $e_user_name)); + $c->addgoodmessage($c->maketext("[_1]'s password has been changed.", $e_user_name)); } } } else { - $self->addbadmessage($r->maketext( + $c->addbadmessage($c->maketext( "The passwords you entered in the [_1] and [_2] fields don't match. " . 'Please retype your new password and try again.', - $r->tag('b', $r->maketext("[_1]'s New Password", $e_user_name)), - $r->tag('b', $r->maketext("Confirm [_1]'s New Password", $e_user_name)) + $c->tag('b', $c->maketext("[_1]'s New Password", $e_user_name)), + $c->tag('b', $c->maketext("Confirm [_1]'s New Password", $e_user_name)) )); } } else { - $self->addbadmessage($r->maketext( + $c->addbadmessage($c->maketext( 'The password you entered in the [_1] field does not match your current password. ' . 'Please retype your current password and try again.', - $r->tag( + $c->tag( 'b', - $r->maketext( + $c->maketext( "[_1]'s Current Password", - $self->{user}->first_name . ' ' . $self->{user}->last_name + $c->{user}->first_name . ' ' . $c->{user}->last_name ) ) )); } } - $self->{has_password} = defined $password; + $c->{has_password} = defined $password; } - my $newA = $r->param('newAddress'); + my $newA = $c->param('newAddress'); if ($changeOptions && $authz->hasPermissions($userID, 'change_email_address') && $newA) { - my $oldA = $self->{effectiveUser}->email_address; - $self->{effectiveUser}->email_address($newA); - eval { $db->putUser($self->{effectiveUser}) }; + my $oldA = $c->{effectiveUser}->email_address; + $c->{effectiveUser}->email_address($newA); + eval { $db->putUser($c->{effectiveUser}) }; if ($@) { - $self->{effectiveUser}->email_address($oldA); - $self->addbadmessage($r->maketext("Couldn't change your email address: [_1]", $@)); + $c->{effectiveUser}->email_address($oldA); + $c->addbadmessage($c->maketext("Couldn't change your email address: [_1]", $@)); } else { - $self->addgoodmessage($r->maketext('Your email address has been changed.')); + $c->addgoodmessage($c->maketext('Your email address has been changed.')); } } if ($changeOptions && $authz->hasPermissions($userID, 'change_pg_display_settings')) { if ( - (defined($r->param('displayMode')) && $self->{effectiveUser}->displayMode() ne $r->param('displayMode')) - || (defined($r->param('showOldAnswers')) - && $self->{effectiveUser}->showOldAnswers() ne $r->param('showOldAnswers')) - || (defined($r->param('useWirisEditor')) - && $self->{effectiveUser}->useWirisEditor() ne $r->param('useWirisEditor')) - || (defined($r->param('useMathQuill')) - && $self->{effectiveUser}->useMathQuill() ne $r->param('useMathQuill')) + (defined($c->param('displayMode')) && $c->{effectiveUser}->displayMode() ne $c->param('displayMode')) + || (defined($c->param('showOldAnswers')) + && $c->{effectiveUser}->showOldAnswers() ne $c->param('showOldAnswers')) + || (defined($c->param('useWirisEditor')) + && $c->{effectiveUser}->useWirisEditor() ne $c->param('useWirisEditor')) + || (defined($c->param('useMathQuill')) + && $c->{effectiveUser}->useMathQuill() ne $c->param('useMathQuill')) ) { - $self->{effectiveUser}->displayMode($r->param('displayMode')); - $self->{effectiveUser}->showOldAnswers($r->param('showOldAnswers')); - $self->{effectiveUser}->useWirisEditor($r->param('useWirisEditor')); - $self->{effectiveUser}->useMathQuill($r->param('useMathQuill')); + $c->{effectiveUser}->displayMode($c->param('displayMode')); + $c->{effectiveUser}->showOldAnswers($c->param('showOldAnswers')); + $c->{effectiveUser}->useWirisEditor($c->param('useWirisEditor')); + $c->{effectiveUser}->useMathQuill($c->param('useMathQuill')); - eval { $db->putUser($self->{effectiveUser}) }; + eval { $db->putUser($c->{effectiveUser}) }; if ($@) { - $self->addbadmessage($r->maketext("Couldn't save your display options: [_1]", $@)); + $c->addbadmessage($c->maketext("Couldn't save your display options: [_1]", $@)); } else { - $self->addgoodmessage($r->maketext('Your display options have been saved.')); + $c->addgoodmessage($c->maketext('Your display options have been saved.')); } } } diff --git a/lib/WeBWorK/ContentGenerator/Problem.pm b/lib/WeBWorK/ContentGenerator/Problem.pm index 0415328d01..8f1b5cc0e6 100644 --- a/lib/WeBWorK/ContentGenerator/Problem.pm +++ b/lib/WeBWorK/ContentGenerator/Problem.pm @@ -14,11 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::Problem; -use parent qw(WeBWorK::ContentGenerator); - -use strict; -use warnings; -use utf8; +use Mojo::Base 'WeBWorK::ContentGenerator', -signatures, -async_await; =head1 NAME @@ -26,8 +22,6 @@ WeBWorK::ContentGenerator::Problem - Allow a student to interact with a problem. =cut -use Future::AsyncAwait; - use WeBWorK::HTML::SingleProblemGrader; use WeBWorK::Debug; use WeBWorK::Form; @@ -84,89 +78,77 @@ use WeBWorK::HTML::AttemptsTable; # "can" methods # Subroutines to determine if a user "can" perform an action. Each subroutine is # called with the following arguments: -# ($self, $user, $effectiveUser, $set, $problem) +# ($c, $user, $effectiveUser, $set, $problem) # In addition can_recordAnswers and can_showMeAnother have the argument # $submitAnswers that is used to distinguish between this submission and the # next. -sub can_showOldAnswers { - my ($self, $user, $effectiveUser, $set, $problem) = @_; - return $self->r->authz->hasPermissions($user->user_id, 'can_show_old_answers'); +sub can_showOldAnswers ($c, $user, $effectiveUser, $set, $problem) { + return $c->authz->hasPermissions($user->user_id, 'can_show_old_answers'); } -sub can_showCorrectAnswers { - my ($self, $user, $effectiveUser, $set, $problem) = @_; - return after($set->answer_date, $self->r->submitTime) - || $self->r->authz->hasPermissions($user->user_id, 'show_correct_answers_before_answer_date'); +sub can_showCorrectAnswers ($c, $user, $effectiveUser, $set, $problem) { + return after($set->answer_date, $c->submitTime) + || $c->authz->hasPermissions($user->user_id, 'show_correct_answers_before_answer_date'); } -sub can_showProblemGrader { - my ($self, $user, $effectiveUser, $set, $problem) = @_; - my $authz = $self->r->authz; +sub can_showProblemGrader ($c, $user, $effectiveUser, $set, $problem) { + my $authz = $c->authz; return ($authz->hasPermissions($user->user_id, 'access_instructor_tools') && $authz->hasPermissions($user->user_id, 'score_sets') && $set->set_id ne 'Undefined_Set' - && !$self->{invalidSet}); + && !$c->{invalidSet}); } -sub can_showAnsGroupInfo { - my ($self, $user, $effectiveUser, $set, $problem) = @_; - return $self->r->authz->hasPermissions($user->user_id, 'show_answer_group_info'); +sub can_showAnsGroupInfo ($c, $user, $effectiveUser, $set, $problem) { + return $c->authz->hasPermissions($user->user_id, 'show_answer_group_info'); } -sub can_showAnsHashInfo { - my ($self, $user, $effectiveUser, $set, $problem) = @_; - return $self->r->authz->hasPermissions($user->user_id, 'show_answer_hash_info'); +sub can_showAnsHashInfo ($c, $user, $effectiveUser, $set, $problem) { + return $c->authz->hasPermissions($user->user_id, 'show_answer_hash_info'); } -sub can_showPGInfo { - my ($self, $user, $effectiveUser, $set, $problem) = @_; - return $self->r->authz->hasPermissions($user->user_id, 'show_pg_info'); +sub can_showPGInfo ($c, $user, $effectiveUser, $set, $problem) { + return $c->authz->hasPermissions($user->user_id, 'show_pg_info'); } -sub can_showResourceInfo { - my ($self, $user, $effectiveUser, $set, $problem) = @_; - return $self->r->authz->hasPermissions($user->user_id, 'show_resource_info'); +sub can_showResourceInfo ($c, $user, $effectiveUser, $set, $problem) { + return $c->authz->hasPermissions($user->user_id, 'show_resource_info'); } -sub can_showHints { - my ($self, $user, $effectiveUser, $set, $problem) = @_; - my $r = $self->r; - - return 1 if $r->authz->hasPermissions($user->user_id, 'always_show_hint'); +sub can_showHints ($c, $user, $effectiveUser, $set, $problem) { + return 1 if $c->authz->hasPermissions($user->user_id, 'always_show_hint'); my $showHintsAfter = $set->hide_hint ? -1 : $problem->showHintsAfter > -2 ? $problem->showHintsAfter - : $r->ce->{pg}{options}{showHintsAfter}; + : $c->ce->{pg}{options}{showHintsAfter}; return $showHintsAfter > -1 - && $showHintsAfter <= $problem->num_correct + $problem->num_incorrect + ($self->{submitAnswers} ? 1 : 0); + && $showHintsAfter <= $problem->num_correct + $problem->num_incorrect + ($c->{submitAnswers} ? 1 : 0); } -sub can_showSolutions { - my ($self, $user, $effectiveUser, $set, $problem) = @_; - my $authz = $self->r->authz; +sub can_showSolutions ($c, $user, $effectiveUser, $set, $problem) { + my $authz = $c->authz; return $authz->hasPermissions($user->user_id, 'always_show_solutions') - || after($set->answer_date, $self->r->submitTime) + || after($set->answer_date, $c->submitTime) || $authz->hasPermissions($user->user_id, 'show_solutions_before_answer_date'); } -sub can_recordAnswers { - my ($self, $user, $effectiveUser, $set, $problem, $submitAnswers) = @_; - my $authz = $self->r->authz; +sub can_recordAnswers ($c, $user, $effectiveUser, $set, $problem, $submitAnswers = 0) { + my $authz = $c->authz; if ($user->user_id ne $effectiveUser->user_id) { return $authz->hasPermissions($user->user_id, 'record_answers_when_acting_as_student'); } return $authz->hasPermissions($user->user_id, 'record_answers_before_open_date') - if (before($set->open_date, $self->r->submitTime)); + if (before($set->open_date, $c->submitTime)); - if (between($set->open_date, $set->due_date, $self->r->submitTime)) { + if (between($set->open_date, $set->due_date, $c->submitTime)) { my $max_attempts = $problem->max_attempts; my $attempts_used = $problem->num_correct + $problem->num_incorrect + ($submitAnswers ? 1 : 0); if ($max_attempts == -1 or $attempts_used < $max_attempts) { @@ -177,30 +159,29 @@ sub can_recordAnswers { } return $authz->hasPermissions($user->user_id, 'record_answers_after_due_date') - if (between($set->due_date, $set->answer_date, $self->r->submitTime)); + if (between($set->due_date, $set->answer_date, $c->submitTime)); return $authz->hasPermissions($user->user_id, 'record_answers_after_answer_date') - if (after($set->answer_date, $self->r->submitTime)); + if (after($set->answer_date, $c->submitTime)); return 0; } -sub can_checkAnswers { - my ($self, $user, $effectiveUser, $set, $problem) = @_; - my $authz = $self->r->authz; +sub can_checkAnswers ($c, $user, $effectiveUser, $set, $problem) { + my $authz = $c->authz; # If we can record answers then we dont need to be able to check them # unless we have that specific permission. return 0 - if ($self->can_recordAnswers($user, $effectiveUser, $set, $problem, $self->{submitAnswers}) + if ($c->can_recordAnswers($user, $effectiveUser, $set, $problem, $c->{submitAnswers}) && !$authz->hasPermissions($user->user_id, 'can_check_and_submit_answers')); return $authz->hasPermissions($user->user_id, 'check_answers_before_open_date') - if (before($set->open_date, $self->r->submitTime)); + if (before($set->open_date, $c->submitTime)); - if (between($set->open_date, $set->due_date, $self->r->submitTime)) { + if (between($set->open_date, $set->due_date, $c->submitTime)) { my $max_attempts = $problem->max_attempts; - my $attempts_used = $problem->num_correct + $problem->num_incorrect + ($self->{submitAnswers} ? 1 : 0); + my $attempts_used = $problem->num_correct + $problem->num_incorrect + ($c->{submitAnswers} ? 1 : 0); if ($max_attempts == -1 or $attempts_used < $max_attempts) { return $authz->hasPermissions($user->user_id, 'check_answers_after_open_date_with_attempts'); } else { @@ -209,44 +190,40 @@ sub can_checkAnswers { } return $authz->hasPermissions($user->user_id, 'check_answers_after_due_date') - if (between($set->due_date, $set->answer_date, $self->r->submitTime)); + if (between($set->due_date, $set->answer_date, $c->submitTime)); return $authz->hasPermissions($user->user_id, 'check_answers_after_answer_date') - if (after($set->answer_date, $self->r->submitTime)); + if (after($set->answer_date, $c->submitTime)); return 0; } -sub can_useMathView { - my ($self) = @_; - return $self->r->ce->{pg}{specialPGEnvironmentVars}{entryAssist} eq 'MathView'; +sub can_useMathView ($c) { + return $c->ce->{pg}{specialPGEnvironmentVars}{entryAssist} eq 'MathView'; } -sub can_useWirisEditor { - my ($self) = @_; - return $self->r->ce->{pg}{specialPGEnvironmentVars}{entryAssist} eq 'WIRIS'; +sub can_useWirisEditor ($c) { + return $c->ce->{pg}{specialPGEnvironmentVars}{entryAssist} eq 'WIRIS'; } -sub can_useMathQuill { - my ($self) = @_; - return $self->r->ce->{pg}{specialPGEnvironmentVars}{entryAssist} eq 'MathQuill'; +sub can_useMathQuill ($c) { + return $c->ce->{pg}{specialPGEnvironmentVars}{entryAssist} eq 'MathQuill'; } # Check if the showMeAnother button should be allowed. Note that this is done *before* the check to see if # showMeAnother is possible. -sub can_showMeAnother { - my ($self, $user, $effectiveUser, $set, $problem, $submitAnswers) = @_; - my $ce = $self->r->ce; +sub can_showMeAnother ($c, $user, $effectiveUser, $set, $problem, $submitAnswers = 0) { + my $ce = $c->ce; # If the showMeAnother button isn't enabled in the course configuration, # don't show it under any circumstances (not even for the instructor). return 0 unless $ce->{pg}{options}{enableShowMeAnother}; # Get the hash of information about showMeAnother - my %showMeAnother = %{ $self->{showMeAnother} }; + my %showMeAnother = %{ $c->{showMeAnother} }; - if (after($set->open_date, $self->r->submitTime) - || $self->r->authz->hasPermissions($self->r->param('user'), 'can_use_show_me_another_early')) + if (after($set->open_date, $c->submitTime) + || $c->authz->hasPermissions($c->param('user'), 'can_use_show_me_another_early')) { # If $showMeAnother{TriesNeeded} is somehow not an integer or if it is -2, use the default value. $showMeAnother{TriesNeeded} = $ce->{pg}{options}{showMeAnotherDefault} @@ -274,18 +251,16 @@ sub can_showMeAnother { return 0; } -sub attemptResults { - my ($self, $pg, $showCorrectAnswers, $showAttemptResults, $showSummary) = @_; - - my $ce = $self->r->ce; +sub attemptResults ($c, $pg, $showCorrectAnswers, $showAttemptResults, $showSummary) { + my $ce = $c->ce; # Create AttemptsTable object my $tbl = WeBWorK::HTML::AttemptsTable->new( $pg->{answers}, - $self->r, + $c, answersSubmitted => 1, - answerOrder => $pg->{flags}->{ANSWER_ENTRY_ORDER}, - displayMode => $self->{displayMode}, + answerOrder => $pg->{flags}{ANSWER_ENTRY_ORDER}, + displayMode => $c->{displayMode}, showAnswerNumbers => 0, showAttemptAnswers => $ce->{pg}{options}{showEvaluatedAnswers}, showAttemptPreviews => 1, @@ -314,59 +289,52 @@ sub attemptResults { return $answerTemplate; } -async sub pre_header_initialize { - my ($self) = @_; +async sub pre_header_initialize ($c) { + my $ce = $c->ce; + my $db = $c->db; + my $authz = $c->authz; - my $r = $self->r; - my $ce = $r->ce; - my $db = $r->db; - my $authz = $r->authz; - my $urlpath = $r->urlpath; - - my $setID = $urlpath->arg('setID'); - my $problemID = $r->urlpath->arg('problemID'); - my $userID = $r->param('user'); - my $effectiveUserID = $r->param('effectiveUser'); - $self->{editMode} = $r->param('editMode'); - - my $user = $db->getUser($userID); - die "record for user $userID (real user) does not exist." - unless defined $user; + my $setID = $c->stash('setID'); + my $problemID = $c->stash('problemID'); + my $userID = $c->param('user'); + my $effectiveUserID = $c->param('effectiveUser'); + $c->{editMode} = $c->param('editMode'); + my $user = $db->getUser($userID); my $effectiveUser = $db->getUser($effectiveUserID); - die "record for user $effectiveUserID (effective user) does not exist." - unless defined $effectiveUser; - # Check that the set is valid. $self->{invalidSet} is set in checkSet called by ContentGenerator.pm. - die $self->{invalidSet} if $self->{invalidSet}; + return unless defined $user && defined $effectiveUser; # This should be impossible. + + # Check that the set is valid. $c->{invalidSet} is set in checkSet called by ContentGenerator.pm. + return if $c->{invalidSet}; # Obtain the merged set for $effectiveUser - my $set = $db->getMergedSet($effectiveUserID, $setID); + $c->{set} = $db->getMergedSet($effectiveUserID, $setID); # Determine if the set should be considered open. # It is open if the user can view unopened sets or is an instructor editing a problem from the problem editor, # or it is after the set open date and is not conditionally restricted and is not jitar hidden or closed. - die 'You do not have permission to view unopened sets' + return unless $authz->hasPermissions($userID, 'view_unopened_sets') || $setID eq 'Undefined_Set' || ( - after($set->open_date, $self->r->submitTime) + after($c->{set}->open_date, $c->submitTime) && !( - ($ce->{options}{enableConditionalRelease} && is_restricted($db, $set, $effectiveUserID)) + ($ce->{options}{enableConditionalRelease} && is_restricted($db, $c->{set}, $effectiveUserID)) || ( - $set->assignment_type eq 'jitar' - && (is_jitar_problem_hidden($db, $effectiveUserID, $set->set_id, $problemID) - || is_jitar_problem_closed($db, $ce, $effectiveUserID, $set->set_id, $problemID)) + $c->{set}->assignment_type eq 'jitar' + && (is_jitar_problem_hidden($db, $effectiveUserID, $c->{set}->set_id, $problemID) + || is_jitar_problem_closed($db, $ce, $effectiveUserID, $c->{set}->set_id, $problemID)) ) ) ); # When a set is created enable_reduced_scoring is null, so we have to set it - if ($set && $set->enable_reduced_scoring ne '0' && $set->enable_reduced_scoring ne '1') { - my $globalSet = $db->getGlobalSet($set->set_id); + if ($c->{set} && $c->{set}->enable_reduced_scoring ne '0' && $c->{set}->enable_reduced_scoring ne '1') { + my $globalSet = $db->getGlobalSet($c->{set}->set_id); $globalSet->enable_reduced_scoring('0'); $db->putGlobalSet($globalSet); - $set = $db->getMergedSet($effectiveUserID, $setID); + $c->{set} = $db->getMergedSet($effectiveUserID, $setID); } # Obtain the merged problem for the effective user. @@ -377,38 +345,41 @@ async sub pre_header_initialize { # If a user set does not exist for this user and this set, then check # the global set. If that does not exist, then create a fake set. If it does, then add fake user data. - unless (defined $set) { + unless (defined $c->{set}) { my $userSetClass = $db->{set_user}->{record}; my $globalSet = $db->getGlobalSet($setID); if (not defined $globalSet) { - $set = fake_set($db); + $c->{set} = fake_set($db); } else { - $set = global2user($userSetClass, $globalSet); - $set->psvn(0); + $c->{set} = global2user($userSetClass, $globalSet); + $c->{set}->psvn(0); } } # If a problem is not defined obtain the global problem, convert it to a user problem, and add fake user data. unless (defined $problem) { - my $userProblemClass = $db->{problem_user}->{record}; - my $globalProblem = $db->getGlobalProblem($setID, $problemID); + my $globalProblem = $db->getGlobalProblem($setID, $problemID); # If the global problem doesn't exist either, bail! if (!defined $globalProblem) { - my $sourceFilePath = $r->param('sourceFilePath'); - die 'sourceFilePath is unsafe!' - unless path_is_subdir($sourceFilePath, $ce->{courseDirs}{templates}, 1); + my $sourceFilePath = $c->param('sourceFilePath'); # These are problems from setmaker. If declared invalid, they won't come up. - $self->{invalidProblem} = $self->{invalidSet} = 1 unless defined $sourceFilePath; + if (defined $sourceFilePath) { + die 'sourceFilePath is unsafe!' + unless path_is_subdir($sourceFilePath, $ce->{courseDirs}{templates}, 1); + } else { + $c->{invalidProblem} = $c->{invalidSet} = 1; + return; + } $problem = fake_problem($db); $problem->problem_id(1); $problem->source_file($sourceFilePath); $problem->user_id($effectiveUserID); } else { - $problem = global2user($userProblemClass, $globalProblem); + $problem = global2user($db->{problem_user}{record}, $globalProblem); $problem->user_id($effectiveUserID); $problem->problem_seed(0); $problem->status(0); @@ -423,8 +394,8 @@ async sub pre_header_initialize { # Deal with possible editor overrides. # If the caller is asking to override the source file, and editMode calls for a temporary file, do so. - my $sourceFilePath = $r->param('sourceFilePath'); - if (defined $self->{editMode} && $self->{editMode} eq 'temporaryFile' && defined $sourceFilePath) { + my $sourceFilePath = $c->param('sourceFilePath'); + if (defined $c->{editMode} && $c->{editMode} eq 'temporaryFile' && defined $sourceFilePath) { die 'sourceFilePath is unsafe!' unless path_is_subdir($sourceFilePath, $ce->{courseDirs}->{templates}, 1); $problem->source_file($sourceFilePath); @@ -432,51 +403,50 @@ async sub pre_header_initialize { # If the problem does not have a source file or no source file has been passed in # then this is really an invalid problem (probably from a bad URL). - $self->{invalidProblem} = !(defined $sourceFilePath || $problem->source_file); + $c->{invalidProblem} = !(defined $sourceFilePath || $problem->source_file); # If the caller is asking to override the problem seed, do so. - my $problemSeed = $r->param('problemSeed'); + my $problemSeed = $c->param('problemSeed'); if (defined $problemSeed && $problemSeed =~ /^[+-]?\d+$/) { $problem->problem_seed($problemSeed); } - $self->addmessage($set->visible - ? $r->tag('span', class => 'font-visible', $r->maketext('This set is visible to students.')) - : $r->tag('span', class => 'font-hidden', $r->maketext('This set is hidden from students.'))); + $c->addmessage($c->{set}->visible + ? $c->tag('span', class => 'font-visible', $c->maketext('This set is visible to students.')) + : $c->tag('span', class => 'font-hidden', $c->maketext('This set is hidden from students.'))); } else { # Test for additional problem validity if it's not already invalid. - $self->{invalidProblem} = - !(defined $problem && ($set->visible || $authz->hasPermissions($userID, 'view_hidden_sets'))); + $c->{invalidProblem} = + !(defined $problem && ($c->{set}->visible || $authz->hasPermissions($userID, 'view_hidden_sets'))); - $self->addbadmessage($r->maketext('This problem will not count towards your grade.')) - if $problem && !$problem->value && !$self->{invalidProblem}; + $c->addbadmessage($c->maketext('This problem will not count towards your grade.')) + if $problem && !$problem->value && !$c->{invalidProblem}; } - $self->{userID} = $userID; - $self->{effectiveUserID} = $effectiveUserID; - $self->{user} = $user; - $self->{effectiveUser} = $effectiveUser; - $self->{set} = $set; - $self->{problem} = $problem; + $c->{userID} = $userID; + $c->{effectiveUserID} = $effectiveUserID; + $c->{user} = $user; + $c->{effectiveUser} = $effectiveUser; + $c->{problem} = $problem; # Form processing # Set options from form fields (see comment at top of file for form fields). - my $displayMode = $r->param('displayMode') || $user->displayMode || $ce->{pg}->{options}->{displayMode}; - my $redisplay = $r->param('redisplay'); - $self->{submitAnswers} = $r->param('submitAnswers'); - my $checkAnswers = $r->param('checkAnswers'); - my $previewAnswers = $r->param('previewAnswers'); - my $requestNewSeed = $r->param('requestNewSeed') // 0; + my $displayMode = $c->param('displayMode') || $user->displayMode || $ce->{pg}->{options}->{displayMode}; + my $redisplay = $c->param('redisplay'); + $c->{submitAnswers} = $c->param('submitAnswers'); + my $checkAnswers = $c->param('checkAnswers'); + my $previewAnswers = $c->param('previewAnswers'); + my $requestNewSeed = $c->param('requestNewSeed') // 0; - my $formFields = { WeBWorK::Form->new_from_paramable($r)->Vars }; + my $formFields = { WeBWorK::Form->new_from_paramable($c)->Vars }; # Check for a page refresh which causes a cached form resubmission. In that case this is # not a valid submission of answers. if ( - $set->set_id ne 'Undefined_Set' - && $self->{submitAnswers} + $c->{set}->set_id ne 'Undefined_Set' + && $c->{submitAnswers} && ( !defined $formFields->{num_attempts} || (defined $formFields->{num_attempts} @@ -484,21 +454,21 @@ async sub pre_header_initialize { ) ) { - $self->{submitAnswers} = 0; - $self->{resubmitDetected} = 1; + $c->{submitAnswers} = 0; + $c->{resubmitDetected} = 1; } - $self->{displayMode} = $displayMode; - $self->{redisplay} = $redisplay; - $self->{checkAnswers} = $checkAnswers; - $self->{previewAnswers} = $previewAnswers; - $self->{formFields} = $formFields; + $c->{displayMode} = $displayMode; + $c->{redisplay} = $redisplay; + $c->{checkAnswers} = $checkAnswers; + $c->{previewAnswers} = $previewAnswers; + $c->{formFields} = $formFields; # Get the status message and add it to the messages. - $self->addmessage($r->tag('p', class => 'my-2', $r->b($r->param('status_message')))) if $r->param('status_message'); + $c->addmessage($c->tag('p', class => 'my-2', $c->b($c->param('status_message')))) if $c->param('status_message'); # Now that the necessary variables are set, return if the set or problem is invalid. - return if $self->{invalidSet} || $self->{invalidProblem}; + return if $c->{invalidSet} || $c->{invalidProblem}; # Construct a hash containing information for showMeAnother. # TriesNeeded: the number of times the student needs to attempt the problem before the button is available @@ -516,7 +486,7 @@ async sub pre_header_initialize { # Store the showMeAnother hash for the check to see if the button can be used # (this hash is updated and re-stored after the can, must, will hashes) - $self->{showMeAnother} = \%showMeAnother; + $c->{showMeAnother} = \%showMeAnother; # Permissions @@ -524,18 +494,18 @@ async sub pre_header_initialize { my %want = ( showOldAnswers => $user->showOldAnswers ne '' ? $user->showOldAnswers : $ce->{pg}{options}{showOldAnswers}, # showProblemGrader implies showCorrectAnswers. This is a convenience for grading. - showCorrectAnswers => $r->param('showCorrectAnswers') || $r->param('showProblemGrader') || 0, - showProblemGrader => $r->param('showProblemGrader') || 0, - showAnsGroupInfo => $r->param('showAnsGroupInfo') || $ce->{pg}{options}{showAnsGroupInfo}, - showAnsHashInfo => $r->param('showAnsHashInfo') || $ce->{pg}{options}{showAnsHashInfo}, - showPGInfo => $r->param('showPGInfo') || $ce->{pg}{options}{showPGInfo}, - showResourceInfo => $r->param('showResourceInfo') || $ce->{pg}{options}{showResourceInfo}, + showCorrectAnswers => $c->param('showCorrectAnswers') || $c->param('showProblemGrader') || 0, + showProblemGrader => $c->param('showProblemGrader') || 0, + showAnsGroupInfo => $c->param('showAnsGroupInfo') || $ce->{pg}{options}{showAnsGroupInfo}, + showAnsHashInfo => $c->param('showAnsHashInfo') || $ce->{pg}{options}{showAnsHashInfo}, + showPGInfo => $c->param('showPGInfo') || $ce->{pg}{options}{showPGInfo}, + showResourceInfo => $c->param('showResourceInfo') || $ce->{pg}{options}{showResourceInfo}, showHints => 1, showSolutions => 1, useMathView => $user->useMathView ne '' ? $user->useMathView : $ce->{pg}{options}{useMathView}, useWirisEditor => $user->useWirisEditor ne '' ? $user->useWirisEditor : $ce->{pg}{options}{useWirisEditor}, useMathQuill => $user->useMathQuill ne '' ? $user->useMathQuill : $ce->{pg}{options}{useMathQuill}, - recordAnswers => $self->{submitAnswers}, + recordAnswers => $c->{submitAnswers}, checkAnswers => $checkAnswers, getSubmitButton => 1, ); @@ -561,25 +531,25 @@ async sub pre_header_initialize { ); # Does the user have permission to use certain options? - my @args = ($user, $effectiveUser, $set, $problem); + my @args = ($user, $effectiveUser, $c->{set}, $problem); my %can = ( - showOldAnswers => $self->can_showOldAnswers(@args), - showCorrectAnswers => $self->can_showCorrectAnswers(@args), - showProblemGrader => $self->can_showProblemGrader(@args), - showAnsGroupInfo => $self->can_showAnsGroupInfo(@args), - showAnsHashInfo => $self->can_showAnsHashInfo(@args), - showPGInfo => $self->can_showPGInfo(@args), - showResourceInfo => $self->can_showResourceInfo(@args), - showHints => $self->can_showHints(@args), - showSolutions => $self->can_showSolutions(@args), - recordAnswers => $self->can_recordAnswers(@args), - checkAnswers => $self->can_checkAnswers(@args), - showMeAnother => $self->can_showMeAnother(@args), - getSubmitButton => $self->can_recordAnswers(@args, $self->{submitAnswers}), - useMathView => $self->can_useMathView, - useWirisEditor => $self->can_useWirisEditor, - useMathQuill => $self->can_useMathQuill, + showOldAnswers => $c->can_showOldAnswers(@args), + showCorrectAnswers => $c->can_showCorrectAnswers(@args), + showProblemGrader => $c->can_showProblemGrader(@args), + showAnsGroupInfo => $c->can_showAnsGroupInfo(@args), + showAnsHashInfo => $c->can_showAnsHashInfo(@args), + showPGInfo => $c->can_showPGInfo(@args), + showResourceInfo => $c->can_showResourceInfo(@args), + showHints => $c->can_showHints(@args), + showSolutions => $c->can_showSolutions(@args), + recordAnswers => $c->can_recordAnswers(@args), + checkAnswers => $c->can_checkAnswers(@args), + showMeAnother => $c->can_showMeAnother(@args, $c->{submitAnswers}), + getSubmitButton => $c->can_recordAnswers(@args, $c->{submitAnswers}), + useMathView => $c->can_useMathView, + useWirisEditor => $c->can_useWirisEditor, + useMathQuill => $c->can_useMathQuill, ); # Re-randomization based on the number of attempts and specified period @@ -592,15 +562,15 @@ async sub pre_header_initialize { $rerandomizePeriod = $problem->{prPeriod} if (defined $problem->{prPeriod} && $problem->{prPeriod} > -1); - $prEnabled = 0 if ($rerandomizePeriod < 1 || $self->{editMode}); + $prEnabled = 0 if ($rerandomizePeriod < 1 || $c->{editMode}); if ($prEnabled) { $problem->{prCount} = 0 if !defined $problem->{prCount} || $problem->{prCount} =~ /^\s*$/; - $problem->{prCount} += $self->{submitAnswers} ? 1 : 0; + $problem->{prCount} += $c->{submitAnswers} ? 1 : 0; $requestNewSeed = 0 - if ($problem->{prCount} < $rerandomizePeriod || after($set->due_date, $self->r->submitTime)); + if ($problem->{prCount} < $rerandomizePeriod || after($c->{set}->due_date, $c->submitTime)); if ($requestNewSeed) { # obtain new random seed to hopefully change the problem @@ -620,7 +590,7 @@ async sub pre_header_initialize { my %will = map { $_ => $can{$_} && ($want{$_} || $must{$_}) } keys %must; # Sticky answers - if (!($self->{submitAnswers} || $previewAnswers || $checkAnswers) && $will{showOldAnswers}) { + if (!($c->{submitAnswers} || $previewAnswers || $checkAnswers) && $will{showOldAnswers}) { my %oldAnswers = decodeAnswers($problem->last_answer); # Do this only if new answers are NOT being submitted if ($prEnabled && !$problem->{prCount}) { @@ -634,10 +604,11 @@ async sub pre_header_initialize { # Translation debug('begin pg processing'); my $pg = await renderPG( - $r, + $c, $effectiveUser, - $set, $problem, - $set->psvn, + $c->{set}, + $problem, + $c->{set}->psvn, $formFields, { displayMode => $displayMode, @@ -663,26 +634,26 @@ async sub pre_header_initialize { debug('end pg processing'); - $pg->{body_text} .= $r->hidden_field( - num_attempts => $problem->num_correct + $problem->num_incorrect + ($self->{submitAnswers} ? 1 : 0), + $pg->{body_text} .= $c->hidden_field( + num_attempts => $problem->num_correct + $problem->num_incorrect + ($c->{submitAnswers} ? 1 : 0), id => 'num_attempts' ); - if ($prEnabled && $problem->{prCount} >= $rerandomizePeriod && !after($set->due_date, $self->r->submitTime)) { - $showMeAnother{active} = 0; - $must{requestNewSeed} = 1; - $can{requestNewSeed} = 1; - $want{requestNewSeed} = 1; - $will{requestNewSeed} = 1; - $self->{showCorrectOnRandomize} = $ce->{pg}{options}{showCorrectOnRandomize}; + if ($prEnabled && $problem->{prCount} >= $rerandomizePeriod && !after($c->{set}->due_date, $c->submitTime)) { + $showMeAnother{active} = 0; + $must{requestNewSeed} = 1; + $can{requestNewSeed} = 1; + $want{requestNewSeed} = 1; + $will{requestNewSeed} = 1; + $c->{showCorrectOnRandomize} = $ce->{pg}{options}{showCorrectOnRandomize}; # If this happens, it means that the page was refreshed. So prevent the answers from # being recorded and the number of attempts from being increased. if ($problem->{prCount} > $rerandomizePeriod) { - $self->{resubmitDetected} = 1; - $must{recordAnswers} = 0; - $can{recordAnswers} = 0; - $want{recordAnswers} = 0; - $will{recordAnswers} = 0; + $c->{resubmitDetected} = 1; + $must{recordAnswers} = 0; + $can{recordAnswers} = 0; + $want{recordAnswers} = 0; + $will{recordAnswers} = 0; } } @@ -691,77 +662,72 @@ async sub pre_header_initialize { $can{showSolutions} &&= $pg->{flags}{solutionExists}; # Record errors - $self->{pgdebug} = $pg->{debug_messages} if ref $pg->{debug_messages} eq 'ARRAY'; - $self->{pgwarning} = $pg->{warning_messages} if ref $pg->{warning_messages} eq 'ARRAY'; - $self->{pginternalerrors} = $pg->{internal_debug_messages} if ref $pg->{internal_debug_messages} eq 'ARRAY'; - # $self->{pgerrors} is defined if any of the above are defined, and is nonzero if any are non-empty. - $self->{pgerrors} = - @{ $self->{pgdebug} // [] } || @{ $self->{pgwarning} // [] } || @{ $self->{pginternalerrors} // [] } - if defined $self->{pgdebug} || defined $self->{pgwarning} || defined $self->{pginternalerrors}; - - # If $self->{pgerrors} is not defined, then the PG messages arrays were not defined, + $c->{pgdebug} = $pg->{debug_messages} if ref $pg->{debug_messages} eq 'ARRAY'; + $c->{pgwarning} = $pg->{warning_messages} if ref $pg->{warning_messages} eq 'ARRAY'; + $c->{pginternalerrors} = $pg->{internal_debug_messages} if ref $pg->{internal_debug_messages} eq 'ARRAY'; + # $c->{pgerrors} is defined if any of the above are defined, and is nonzero if any are non-empty. + $c->{pgerrors} = @{ $c->{pgdebug} // [] } || @{ $c->{pgwarning} // [] } || @{ $c->{pginternalerrors} // [] } + if defined $c->{pgdebug} || defined $c->{pgwarning} || defined $c->{pginternalerrors}; + + # If $c->{pgerrors} is not defined, then the PG messages arrays were not defined, # which means $pg->{pgcore} was not defined and the translator died. warn 'Processing of this PG problem was not completed. Probably because of a syntax error. ' . 'The translator died prematurely and no PG warning messages were transmitted.' - unless defined $self->{pgerrors}; + unless defined $c->{pgerrors}; # Store fields - $self->{want} = \%want; - $self->{must} = \%must; - $self->{can} = \%can; - $self->{will} = \%will; - $self->{pg} = $pg; + $c->{want} = \%want; + $c->{must} = \%must; + $c->{can} = \%can; + $c->{will} = \%will; + $c->{pg} = $pg; # Process and log answers - $self->{scoreRecordedMessage} = process_and_log_answer($self) || ''; + $c->{scoreRecordedMessage} = process_and_log_answer($c) || ''; return; } -sub warnings { - my $self = shift; - my $r = $self->r; - - my $output = $r->c; +sub warnings ($c) { + my $output = $c->c; # Display warning messages - if (!defined $self->{pgerrors}) { + if (!defined $c->{pgerrors}) { push( @$output, - $r->tag( + $c->tag( 'div', - $r->c( - $r->tag('h3', style => 'color:red;', $r->maketext('PG question failed to render')), - $r->tag('p', $r->maketext('Unable to obtain error messages from within the PG question.')) + $c->c( + $c->tag('h3', style => 'color:red;', $c->maketext('PG question failed to render')), + $c->tag('p', $c->maketext('Unable to obtain error messages from within the PG question.')) )->join('') ) ); - } elsif ($self->{pgerrors} > 0) { - my @pgdebug = @{ $self->{pgdebug} // [] }; - my @pgwarning = @{ $self->{pgwarning} // [] }; - my @pginternalerrors = @{ $self->{pginternalerrors} // [] }; + } elsif ($c->{pgerrors} > 0) { + my @pgdebug = @{ $c->{pgdebug} // [] }; + my @pgwarning = @{ $c->{pgwarning} // [] }; + my @pginternalerrors = @{ $c->{pginternalerrors} // [] }; push( @$output, - $r->tag( + $c->tag( 'div', - $r->c( - $r->tag('h3', style => 'color:red;', $r->maketext('PG question processing error messages')), - @pgdebug ? $r->tag( + $c->c( + $c->tag('h3', style => 'color:red;', $c->maketext('PG question processing error messages')), + @pgdebug ? $c->tag( 'p', - $r->c( - $r->tag('h3', $r->maketext('PG debug messages')), r->c(@pgdebug)->join($r->tag('br')) - )->join('') + $c->c($c->tag('h3', $c->maketext('PG debug messages')), + $c->c(@pgdebug)->join($c->tag('br')))->join('') ) : '', - @pgwarning ? $r->tag( + @pgwarning ? $c->tag( 'p', - $r->c($r->tag('h3', $r->maketext('PG warning messages')), - $r->c(@pgwarning)->join($r->tag('br')))->join('') + $c->c($c->tag('h3', $c->maketext('PG warning messages')), + $c->c(@pgwarning)->join($c->tag('br')))->join('') ) : '', - @pginternalerrors ? $r->tag( + @pginternalerrors ? $c->tag( 'p', - $r->c( - $r->tag('h3', $r->maketext('PG internal errors')), - $r->c(@pginternalerrors)->join($r->tag('br')) + $c->c( + $c->tag('h3', $c->maketext('PG internal errors')), + $c->c(@pginternalerrors)->join($c->tag('br')) )->join('') ) : '' )->join('') @@ -769,44 +735,38 @@ sub warnings { ); } - push(@$output, $self->SUPER::warnings()); + push(@$output, $c->SUPER::warnings()); return $output->join(''); } -sub head { - my ($self) = @_; - return '' if ($self->{invalidSet}); - return $self->{pg}->{head_text} if $self->{pg}->{head_text}; +sub head ($c) { + return '' if ($c->{invalidSet}); + return $c->{pg}{head_text} if $c->{pg}{head_text}; return ''; } -sub post_header_text { - my ($self) = @_; - return '' if ($self->{invalidSet}); - return $self->{pg}->{post_header_text} if $self->{pg}->{post_header_text}; +sub post_header_text ($c) { + return '' if ($c->{invalidSet}); + return $c->{pg}->{post_header_text} if $c->{pg}->{post_header_text}; return ''; } -sub siblings { - my ($self) = @_; - my $r = $self->r; - my $db = $r->db; - my $ce = $r->ce; - my $authz = $r->authz; - my $urlpath = $r->urlpath; +sub siblings ($c) { + my $db = $c->db; + my $ce = $c->ce; + my $authz = $c->authz; # Can't show sibling problems if the set is invalid. - return '' if $self->{invalidSet}; + return '' if $c->{invalidSet}; - my $courseID = $urlpath->arg('courseID'); - my $setID = $self->{set}->set_id; - my $eUserID = $r->param('effectiveUser'); + my $setID = $c->{set}->set_id; + my $eUserID = $c->param('effectiveUser'); my @problemRecords = $db->getMergedProblemsWhere({ user_id => $eUserID, set_id => $setID }, 'problem_id'); my @problemIDs = map { $_->problem_id } @problemRecords; - my $isJitarSet = $setID ne 'Undefined_Set' && $self->{set}->assignment_type eq 'jitar' ? 1 : 0; + my $isJitarSet = $setID ne 'Undefined_Set' && $c->{set}->assignment_type eq 'jitar' ? 1 : 0; # Variables for the progress bar my $num_of_problems = 0; @@ -814,14 +774,14 @@ sub siblings { my $total_correct = 0; my $total_incorrect = 0; my $total_inprogress = 0; - my $currentProblemID = $self->{invalidProblem} ? 0 : $self->{problem}->problem_id; + my $currentProblemID = $c->{invalidProblem} ? 0 : $c->{problem}->problem_id; - my $progressBarEnabled = $r->ce->{pg}{options}{enableProgressBar}; + my $progressBarEnabled = $c->ce->{pg}{options}{enableProgressBar}; my @items; # Keep the grader open when linking to problems if it is already open. - my %problemGraderLink = $self->{will}{showProblemGrader} ? (params => { showProblemGrader => 1 }) : (); + my %problemGraderLink = $c->{will}{showProblemGrader} ? (params => { showProblemGrader => 1 }) : (); for my $problemID (@problemIDs) { if ($isJitarSet @@ -865,12 +825,7 @@ sub siblings { my $active = ($progressBarEnabled && $currentProblemID eq $problemID); - my $problemPage = $urlpath->newFromModule( - 'WeBWorK::ContentGenerator::Problem', $r, - courseID => $courseID, - setID => $setID, - problemID => $problemID - ); + my $problemPage = $c->url_for('problem_detail', setID => $setID, problemID => $problemID); if ($isJitarSet) { # If it is a jitar set, we need to hide and disable links to hidden or restricted problems. @@ -886,36 +841,36 @@ sub siblings { { push( @items, - $r->link_to( - $r->maketext('Problem [_1]', join('.', @seq)) => '#', + $c->link_to( + $c->maketext('Problem [_1]', join('.', @seq)) => '#', class => $class . ' disabled-problem', ) ); } else { push( @items, - $r->tag( + $c->tag( 'a', - $active ? () : (href => $self->systemLink($problemPage, %problemGraderLink)), + $active ? () : (href => $c->systemLink($problemPage, %problemGraderLink)), class => $class, - $r->b($r->maketext('Problem [_1]', join('.', @seq)) . $status_symbol) + $c->b($c->maketext('Problem [_1]', join('.', @seq)) . $status_symbol) ) ); } } else { push( @items, - $r->tag( + $c->tag( 'a', - $active ? () : (href => $self->systemLink($problemPage, %problemGraderLink)), + $active ? () : (href => $c->systemLink($problemPage, %problemGraderLink)), class => 'nav-link' . ($active ? ' active' : ''), - $r->b($r->maketext('Problem [_1]', $problemID) . $status_symbol) + $c->b($c->maketext('Problem [_1]', $problemID) . $status_symbol) ) ); } } - return $r->include( + return $c->include( 'ContentGenerator/Problem/siblings', items => \@items, num_of_problems => $num_of_problems, @@ -925,24 +880,22 @@ sub siblings { ); } -sub nav { - my ($self, $args) = @_; - my $r = $self->r; - my %can = %{ $self->{can} }; +sub nav ($c, $args) { + return '' if $c->{invalidProblem} || $c->{invalidSet}; + + my %can = %{ $c->{can} }; - my $db = $r->db; - my $ce = $r->ce; - my $authz = $r->authz; - my $urlpath = $r->urlpath; + my $db = $c->db; + my $ce = $c->ce; + my $authz = $c->authz; - my $courseID = $urlpath->arg('courseID'); - my $setID = $self->{set}->set_id; - my $problemID = $self->{invalidProblem} ? 0 : $self->{problem}->problem_id; - my $userID = $r->param('user'); - my $eUserID = $r->param('effectiveUser'); + my $setID = $c->{set}->set_id; + my $problemID = $c->{problem}->problem_id; + my $userID = $c->param('user'); + my $eUserID = $c->param('effectiveUser'); my $mergedSet = $db->getMergedSet($eUserID, $setID); - return '' if $self->{invalidSet} || !$mergedSet; + return '' if !$mergedSet; # Set up a student navigation for those that have permission to act as a student. my $userNav = ''; @@ -957,7 +910,7 @@ sub nav { [qw/last_name first_name user_id/] ); - my $filter = $r->param('studentNavFilter'); + my $filter = $c->param('studentNavFilter'); # Find the previous, current, and next users, and format the student names for display. # Also create a hash of sections and recitations if there are any for the course. @@ -968,10 +921,10 @@ sub nav { # Add to the sections and recitations if defined. Also store the first user found in that section or # recitation. This user will be switched to when the filter is selected. my $section = $_->section; - $filters{"section:$section"} = [ $r->maketext('Filter by section [_1]', $section), $_->user_id ] + $filters{"section:$section"} = [ $c->maketext('Filter by section [_1]', $section), $_->user_id ] if $section && !$filters{"section:$section"}; my $recitation = $_->recitation; - $filters{"recitation:$recitation"} = [ $r->maketext('Filter by recitation [_1]', $recitation), $_->user_id ] + $filters{"recitation:$recitation"} = [ $c->maketext('Filter by recitation [_1]', $recitation), $_->user_id ] if $recitation && !$filters{"recitation:$recitation"}; # Only keep this user if it satisfies the selected filter if a filter was selected. @@ -996,15 +949,10 @@ sub nav { # Mark the current user. $userRecords[$currentUserIndex]{currentUser} = 1; - my $problemPage = $urlpath->newFromModule( - __PACKAGE__, $r, - courseID => $courseID, - setID => $setID, - problemID => $problemID - ); + my $problemPage = $c->url_for('problem_detail', setID => $setID, problemID => $problemID); # Set up the student nav. - $userNav = $r->include( + $userNav = $c->include( 'ContentGenerator/Problem/student_nav', eUserID => $eUserID, problemPage => $problemPage, @@ -1022,7 +970,7 @@ sub nav { my ($prevID, $nextID); # Find the next or previous problem, and determine if it is actually open for a jitar set. - if (!$self->{invalidProblem}) { + if (!$c->{invalidProblem}) { my @problemIDs = map { $_->[2] } $db->listUserProblemsWhere({ user_id => $eUserID, set_id => $setID }, 'problem_id'); @@ -1054,114 +1002,97 @@ sub nav { my @links; if ($prevID) { - my $prevPage = $urlpath->newFromModule( - __PACKAGE__, $r, - courseID => $courseID, - setID => $setID, - problemID => $prevID - ); - push @links, $r->maketext('Previous Problem'), $r->location . $prevPage->path, $r->maketext('Previous Problem'); + push @links, $c->maketext('Previous Problem'), + $c->url_for('problem_detail', setID => $setID, problemID => $prevID), + $c->maketext('Previous Problem'); } else { - push @links, $r->maketext('Previous Problem'), '', $r->maketext('Previous Problem'); + push @links, $c->maketext('Previous Problem'), '', $c->maketext('Previous Problem'); } if (defined $setID && $setID ne 'Undefined_Set') { - push @links, $r->maketext('Problem List'), $r->location . $urlpath->parent->path, $r->maketext('Problem List'); + push @links, $c->maketext('Problem List'), $c->url_for('problem_list', setID => $setID), + $c->maketext('Problem List'); } else { - push @links, $r->maketext('Problem List'), '', $r->maketext('Problem List'); + push @links, $c->maketext('Problem List'), '', $c->maketext('Problem List'); } if ($nextID) { - my $nextPage = $urlpath->newFromModule( - __PACKAGE__, $r, - courseID => $courseID, - setID => $setID, - problemID => $nextID - ); - push @links, $r->maketext('Next Problem'), $r->location . $nextPage->path, $r->maketext('Next Problem'); + push @links, $c->maketext('Next Problem'), + $c->url_for('problem_detail', setID => $setID, problemID => $nextID), + $c->maketext('Next Problem'); } else { - push @links, $r->maketext('Next Problem'), '', $r->maketext('Next Problem'); + push @links, $c->maketext('Next Problem'), '', $c->maketext('Next Problem'); } - my $tail = ''; - $tail .= "&displayMode=$self->{displayMode}" if defined $self->{displayMode}; - $tail .= "&showOldAnswers=$self->{will}{showOldAnswers}" if defined $self->{will}{showOldAnswers}; - $tail .= "&showProblemGrader=$self->{will}{showProblemGrader}" if defined $self->{will}{showProblemGrader}; - $tail .= '&studentNavFilter=' . $r->param('studentNavFilter') if $r->param('studentNavFilter'); + my %tail; + $tail{displayMode} = $c->{displayMode} if defined $c->{displayMode}; + $tail{showOldAnswers} = $c->{will}{showOldAnswers} if defined $c->{will}{showOldAnswers}; + $tail{showProblemGrader} = $c->{will}{showProblemGrader} if defined $c->{will}{showProblemGrader}; + $tail{studentNavFilter} = $c->param('studentNavFilter') if $c->param('studentNavFilter'); - return $r->tag( + return $c->tag( 'div', class => 'row sticky-nav', role => 'navigation', 'aria-label' => 'problem navigation', - $r->c($r->tag('div', class => 'd-flex submit-buttons-container', $self->navMacro($args, $tail, @links)), + $c->c($c->tag('div', class => 'd-flex submit-buttons-container', $c->navMacro($args, \%tail, @links)), $userNav)->join('') ); } -sub path { - my ($self, $args) = @_; - my $r = $self->r; - my $urlpath = $r->urlpath; - my $courseID = $urlpath->arg('courseID'); - my $setID = $urlpath->arg('setID') || ''; - my $problemID = $urlpath->arg('problemID') || ''; - my $prettyProblemNumber = $problemID; - - if ($setID) { - my $set = $r->db->getGlobalSet($setID); - if ($set && $set->assignment_type eq 'jitar' && $problemID) { - $prettyProblemNumber = join('.', jitar_id_to_seq($problemID)); - } +sub path ($c, $args) { + my $prettyProblemNumber = $c->stash('problemID'); + + my $set = $c->db->getGlobalSet($c->stash('setID')); + if ($set && $set->assignment_type eq 'jitar' && $prettyProblemNumber) { + $prettyProblemNumber = join('.', jitar_id_to_seq($prettyProblemNumber)); } - my $navigation_allowed = $r->authz->hasPermissions($r->param('user'), 'navigation_allowed'); + my $navigation_allowed = $c->authz->hasPermissions($c->param('user'), 'navigation_allowed'); my @path = ( - WeBWorK => $navigation_allowed ? $r->location : '', - $courseID => $navigation_allowed ? $r->location . "/$courseID" : '', - $setID => $r->location . "/$courseID/$setID", + WeBWorK => $navigation_allowed ? $c->url_for('root') : '', + $c->stash('courseID') => $navigation_allowed ? $c->url_for('set_list') : '', + $c->stash('setID') => $c->url_for('problem_list'), ); - if ($urlpath->module =~ /ShowMeAnother$/) { + if ($c->current_route eq 'show_me_another') { push( @path, - $prettyProblemNumber => $r->location . "/$courseID/$setID/$problemID", + $prettyProblemNumber => $c->url_for('problem_detail'), 'Show Me Another' => '' ); } else { push(@path, $prettyProblemNumber => ''); } - return $self->pathMacro($args, @path); + return $c->pathMacro($args, @path); } -sub title { - my ($self) = @_; - my $r = $self->r; - my $db = $r->db; +sub page_title ($c) { + my $db = $c->db; - my $setID = $self->r->urlpath->arg('setID'); - my $problemID = $self->r->urlpath->arg('problemID'); + my $setID = $c->stash('setID'); + my $problemID = $c->stash('problemID'); my $set = $db->getGlobalSet($setID); if ($set && $set->assignment_type eq 'jitar') { $problemID = join('.', jitar_id_to_seq($problemID)); } my $header = - $r->maketext('[_1]: Problem [_2]', $r->tag('span', dir => 'ltr', format_set_name_display($setID)), $problemID); + $c->maketext('[_1]: Problem [_2]', $c->tag('span', dir => 'ltr', format_set_name_display($setID)), $problemID); # Return here if we don't have the requisite information. - return $header if ($self->{invalidSet} || $self->{invalidProblem}); + return $header if ($c->{invalidSet} || $c->{invalidProblem}); - my $ce = $r->ce; - my $problem = $self->{problem}; + my $ce = $c->ce; + my $problem = $c->{problem}; my $subheader = ''; my $problemValue = $problem->value; if (defined $problemValue && $problemValue ne '') { - $subheader .= $r->maketext('([quant,_1,point])', $problemValue); + $subheader .= $c->maketext('([quant,_1,point])', $problemValue); } # This uses the permission level and user id of the user assigned to the problem. @@ -1174,23 +1105,22 @@ sub title { } # Add the edit link to the sub header if the user has the permisions ot edit problems. - if ($r->authz->hasPermissions($r->param('user'), 'modify_problem_sets')) { - $subheader = $r->c( + if ($c->authz->hasPermissions($c->param('user'), 'modify_problem_sets')) { + $subheader = $c->c( $subheader, - $r->tag( + $c->tag( 'span', class => 'ms-2', - $r->link_to( - $r->maketext('Edit') => $self->systemLink( - $r->urlpath->newFromModule( - 'WeBWorK::ContentGenerator::Instructor::PGProblemEditor', $r, - courseID => $r->urlpath->arg('courseID'), - setID => $self->{set}->set_id, - problemID => $self->{problem}->problem_id + $c->link_to( + $c->maketext('Edit') => $c->systemLink( + $c->url_for( + 'instructor_problem_editor_withset_withproblem', + setID => $c->{set}->set_id, + problemID => $c->{problem}->problem_id ), # If we are here without a real homework set, carry that through. - $self->{set}->set_id eq 'Undefined_Set' - ? (params => [ 'sourceFilePath' => $r->param('sourceFilePath') ]) + $c->{set}->set_id eq 'Undefined_Set' + ? (params => [ 'sourceFilePath' => $c->param('sourceFilePath') ]) : () ), target => 'WW_Editor', @@ -1200,88 +1130,73 @@ sub title { )->join(''); } - return $r->c($header, $r->tag('span', class => 'problem-sub-header d-block', $subheader))->join(''); + return $c->c($header, $c->tag('span', class => 'problem-sub-header d-block', $subheader))->join(''); } # Add a lang and maybe also a dir setting to the DIV tag attributes, if needed by the PROBLEM language. -sub output_problem_lang_and_dir { - my $self = shift; - return get_problem_lang_and_dir( - $self->{pg}{flags}, - $self->r->ce->{perProblemLangAndDirSettingMode}, - $self->r->ce->{language} - ); +sub output_problem_lang_and_dir ($c) { + return get_problem_lang_and_dir($c->{pg}{flags}, $c->ce->{perProblemLangAndDirSettingMode}, $c->ce->{language}); } # Output the body of the current problem -sub output_problem_body { - my $self = shift; - my $r = $self->r; - +sub output_problem_body ($c) { # If there are translation errors then render those with the body text of the problem. - if ($self->{pg}{flags}{error_flag}) { - if ($r->authz->hasPermissions($r->param('user'), 'view_problem_debugging_info')) { + if ($c->{pg}{flags}{error_flag}) { + if ($c->authz->hasPermissions($c->param('user'), 'view_problem_debugging_info')) { # For instructors render the body text of the problem with the errors. - return $r->include( + return $c->include( 'ContentGenerator/Base/error_output', - error => $self->{pg}{errors}, - details => $self->{pg}{body_text} + error => $c->{pg}{errors}, + details => $c->{pg}{body_text} ); } else { # For students render the body text of the problem with a message about error details. - return $r->c( - $r->tag('div', id => 'output_problem_body', $r->b($self->{pg}{body_text})), - $r->include( + return $c->c( + $c->tag('div', id => 'output_problem_body', $c->b($c->{pg}{body_text})), + $c->include( 'ContentGenerator/Base/error_output', - error => $self->{pg}{errors}, - details => $r->maketext('You do not have permission to view the details of this error.') + error => $c->{pg}{errors}, + details => $c->maketext('You do not have permission to view the details of this error.') ) )->join(''); } } - return $r->tag('div', id => 'output_problem_body', $r->b($self->{pg}{body_text})); + return $c->tag('div', id => 'output_problem_body', $c->b($c->{pg}{body_text})); } # Output messages about the problem -sub output_message { - my $self = shift; - return $self->r->include('ContentGenerator/Problem/messages'); +sub output_message ($c) { + return $c->include('ContentGenerator/Problem/messages'); } # Output the problem grader if the user has permissions to grade problems -sub output_grader { - my $self = shift; - - if ($self->{will}{showProblemGrader}) { - return WeBWorK::HTML::SingleProblemGrader->new($self->r, $self->{pg}, $self->{problem})->insertGrader; +sub output_grader ($c) { + if ($c->{will}{showProblemGrader}) { + return WeBWorK::HTML::SingleProblemGrader->new($c, $c->{pg}, $c->{problem})->insertGrader; } return ''; } # Output the checkbox input elements that are available for the current problem -sub output_checkboxes { - my $self = shift; - return $self->r->include('ContentGenerator/Problem/checkboxes'); +sub output_checkboxes ($c) { + return $c->include('ContentGenerator/Problem/checkboxes'); } # Output the submit button input elements that are available for the current problem -sub output_submit_buttons { - my $self = shift; - return $self->r->include('ContentGenerator/Problem/submit_buttons'); +sub output_submit_buttons ($c) { + return $c->include('ContentGenerator/Problem/submit_buttons'); } # Output a summary of the student's current progress and status on the current problem. -sub output_score_summary { - my $self = shift; - my $r = $self->r; - my $ce = $r->ce; - my $db = $r->db; - my $problem = $self->{problem}; - my $set = $self->{set}; - my $pg = $self->{pg}; - my $effectiveUser = $r->param('effectiveUser') || $r->param('user'); +sub output_score_summary ($c) { + my $ce = $c->ce; + my $db = $c->db; + my $problem = $c->{problem}; + my $set = $c->{set}; + my $pg = $c->{pg}; + my $effectiveUser = $c->param('effectiveUser') || $c->param('user'); my $prEnabled = $ce->{pg}{options}{enablePeriodicRandomization} // 0; my $rerandomizePeriod = $ce->{pg}{options}{periodicRandomizationPeriod} // 0; @@ -1293,64 +1208,61 @@ sub output_score_summary { my $prMessage = ''; if ($prEnabled) { - my $attempts_before_rr = $self->{will}{requestNewSeed} ? 0 : ($rerandomizePeriod - $problem->{prCount}); + my $attempts_before_rr = $c->{will}{requestNewSeed} ? 0 : ($rerandomizePeriod - $problem->{prCount}); $prMessage = ' ' - . $r->maketext('You have [quant,_1,attempt,attempts] left before new version will be requested.', + . $c->maketext('You have [quant,_1,attempt,attempts] left before new version will be requested.', $attempts_before_rr) if $attempts_before_rr > 0; - $prMessage = ' ' . $r->maketext('Request new version now.') if ($attempts_before_rr == 0); + $prMessage = ' ' . $c->maketext('Request new version now.') if ($attempts_before_rr == 0); } - $prMessage = '' if after($set->due_date, $self->r->submitTime) or before($set->open_date, $self->r->submitTime); + $prMessage = '' if after($set->due_date, $c->submitTime) or before($set->open_date, $c->submitTime); my $setClosed = 0; my $setClosedMessage; - if (before($set->open_date, $self->r->submitTime) || after($set->due_date, $self->r->submitTime)) { + if (before($set->open_date, $c->submitTime) || after($set->due_date, $c->submitTime)) { $setClosed = 1; - if (before($set->open_date, $self->r->submitTime)) { - $setClosedMessage = $r->maketext('This homework set is not yet open.'); - } elsif (after($set->due_date, $self->r->submitTime)) { - $setClosedMessage = $r->maketext('This homework set is closed.'); + if (before($set->open_date, $c->submitTime)) { + $setClosedMessage = $c->maketext('This homework set is not yet open.'); + } elsif (after($set->due_date, $c->submitTime)) { + $setClosedMessage = $c->maketext('This homework set is closed.'); } } my $attempts = $problem->num_correct + $problem->num_incorrect; - my $output = $r->c; + my $output = $c->c; unless (defined $pg->{state}{state_summary_msg} && $pg->{state}{state_summary_msg} =~ /\S/) { push( @$output, - $self->{submitAnswers} ? $self->{scoreRecordedMessage} . $r->tag('br') : '', - $r->maketext('You have attempted this problem [quant,_1,time,times].', $attempts), + $c->{submitAnswers} ? $c->{scoreRecordedMessage} . $c->tag('br') : '', + $c->maketext('You have attempted this problem [quant,_1,time,times].', $attempts), $prMessage, - $r->tag('br'), - $self->{submitAnswers} + $c->tag('br'), + $c->{submitAnswers} ? ( - $r->maketext( + $c->maketext( 'You received a score of [_1] for this attempt.', - wwRound( - 0, - compute_reduced_score($ce, $problem, $set, $pg->{result}{score}, $self->r->submitTime) * - 100 - ) + wwRound(0, + compute_reduced_score($ce, $problem, $set, $pg->{result}{score}, $c->submitTime) * 100) . '%' ), - $r->tag('br') + $c->tag('br') ) : '', $problem->attempted ? ( - $r->maketext( + $c->maketext( 'Your overall recorded score is [_1]. [_2]', wwRound(0, $problem->status * 100) . '%', - $problem->value ? '' : $r->maketext('(This problem will not count towards your grade.)') + $problem->value ? '' : $c->maketext('(This problem will not count towards your grade.)') ), - $r->tag('br') + $c->tag('br') ) : '', - $setClosed ? $setClosedMessage : $r->maketext( + $setClosed ? $setClosedMessage : $c->maketext( 'You have [negquant,_1,unlimited attempts,attempt,attempts] remaining.', $problem->max_attempts - $attempts ) @@ -1404,8 +1316,8 @@ sub output_score_summary { { push( @$output, - $r->tag('br'), - $r->maketext( + $c->tag('br'), + $c->maketext( 'This problem has open subproblems. ' . 'You can visit them by using the links to the left or visiting the set page.' ) @@ -1414,8 +1326,8 @@ sub output_score_summary { if (scalar(@children_counts_indexs) == 1) { push( @$output, - $r->tag('br'), - $r->maketext( + $c->tag('br'), + $c->maketext( 'The grade for this problem is the larger of the score for this problem, ' . 'or the score of problem [_1].', join('.', @{ $problemSeqs[ $children_counts_indexs[0] ] }) @@ -1424,8 +1336,8 @@ sub output_score_summary { } elsif (scalar(@children_counts_indexs) > 1) { push( @$output, - $r->tag('br'), - $r->maketext( + $c->tag('br'), + $c->maketext( 'The grade for this problem is the larger of the score for this problem, ' . 'or the weighted average of the problems: [_1].', join(', ', map({ join('.', @{ $problemSeqs[$_] }) } @children_counts_indexs)) @@ -1443,8 +1355,8 @@ sub output_score_summary { if ($hasChildren) { push( @$output, - $r->tag('br'), - $r->maketext( + $c->tag('br'), + $c->maketext( 'You will not be able to proceed to problem [_1] until you have completed, ' . 'or run out of attempts, for this problem and its graded subproblems.', join('.', @{ $problemSeqs[$next_id] }) @@ -1455,8 +1367,8 @@ sub output_score_summary { { push( @$output, - $r->tag('br'), - $r->maketext( + $c->tag('br'), + $c->maketext( 'You will not be able to proceed to problem [_1] until you have completed, ' . 'or run out of attempts, for this problem.', join('.', @{ $problemSeqs[$next_id] }) @@ -1470,8 +1382,8 @@ sub output_score_summary { pop @seq; push( @$output, - $r->tag('br'), - $r->maketext( + $c->tag('br'), + $c->maketext( 'The score for this problem can count towards score of problem [_1].', join('.', @seq) ) ); @@ -1479,8 +1391,8 @@ sub output_score_summary { pop @seq; push( @$output, - $r->tag('br'), - $r->maketext( + $c->tag('br'), + $c->maketext( 'This score for this problem does not count for the score of problem [_1] or for the set.', join('.', @seq) ) @@ -1489,74 +1401,69 @@ sub output_score_summary { # If the instructor has set this up, then email the instructor a warning message if the student has run out of # attempts on a top level problem and all of its children and didn't get 100%. - if ($self->{submitAnswers} && $set->email_instructor) { + if ($c->{submitAnswers} && $set->email_instructor) { my $parentProb = $db->getMergedProblem($effectiveUser, $set->set_id, seq_to_jitar_id($seq[0])); warn("Couldn't find problem $seq[0] from set " . $set->set_id . ' in the database') unless $parentProb; if (jitar_problem_finished($parentProb, $db) && jitar_problem_adjusted_status($parentProb, $db) != 1) { - jitar_send_warning_email($self, $parentProb); + jitar_send_warning_email($c, $parentProb); } } } - return $r->tag('p', $output->join('')); + return $c->tag('p', $output->join('')); } # Output other necessary elements -sub output_misc { - my $self = shift; - my $r = $self->r; - - my $output = $r->c; +sub output_misc ($c) { + my $output = $c->c; # Save state for viewOptions push(@$output, - $r->hidden_field(showOldAnswers => $self->{will}{showOldAnswers}), - $r->hidden_field(displayMode => $self->{displayMode})); + $c->hidden_field(showOldAnswers => $c->{will}{showOldAnswers}), + $c->hidden_field(displayMode => $c->{displayMode})); - push(@$output, $r->hidden_field(editMode => $self->{editMode})) - if defined $self->{editMode} && $self->{editMode} eq 'temporaryFile'; + push(@$output, $c->hidden_field(editMode => $c->{editMode})) + if defined $c->{editMode} && $c->{editMode} eq 'temporaryFile'; - my $permissionLevel = $r->db->getPermissionLevel($r->param('user'))->permission; - my $professorPermissionLevel = $r->ce->{userRoles}{professor}; + my $permissionLevel = $c->db->getPermissionLevel($c->param('user'))->permission; + my $professorPermissionLevel = $c->ce->{userRoles}{professor}; # Only allow this for professors - push(@$output, $r->hidden_field(sourceFilePath => $self->{problem}{source_file})) - if defined $self->{problem}{source_file} && $permissionLevel >= $professorPermissionLevel; + push(@$output, $c->hidden_field(sourceFilePath => $c->{problem}{source_file})) + if defined $c->{problem}{source_file} && $permissionLevel >= $professorPermissionLevel; # Only allow this for professors - push(@$output, $r->hidden_field(problemSeed => $r->param('problemSeed'))) - if defined $r->param('problemSeed') && $permissionLevel >= $professorPermissionLevel; + push(@$output, $c->hidden_field(problemSeed => $c->param('problemSeed'))) + if defined $c->param('problemSeed') && $permissionLevel >= $professorPermissionLevel; # Make sure the student nav filter setting is preserved when the problem form is submitted. - push(@$output, $r->hidden_field(studentNavFilter => $r->param('studentNavFilter'))) - if $r->param('studentNavFilter'); + push(@$output, $c->hidden_field(studentNavFilter => $c->param('studentNavFilter'))) + if $c->param('studentNavFilter'); return $output->join(''); } # Output any instructor comments present in the latest past_answer entry -sub output_comments { - my $self = shift; - my $r = $self->r; - my $db = $r->db; - my $urlpath = $r->urlpath; +sub output_comments ($c) { + my $db = $c->db; my $userPastAnswerID = $db->latestProblemPastAnswer( - $urlpath->arg('courseID'), $r->param('effectiveUser'), - $urlpath->arg('setID'), $urlpath->arg('problemID') + $c->stash('courseID'), + $c->param('effectiveUser'), + $c->stash('setID'), $c->stash('problemID') ); # If there is a comment then display it. if ($userPastAnswerID) { my $userPastAnswer = $db->getPastAnswer($userPastAnswerID); if ($userPastAnswer->comment_string) { - return $r->tag( + return $c->tag( 'div', id => 'answerComment', class => 'answerComments mt-2', - $r->c($r->tag('b', 'Instructor Comment:'), $r->tag('div', $userPastAnswer->comment_string)) + $c->c($c->tag('b', 'Instructor Comment:'), $c->tag('div', $userPastAnswer->comment_string)) ->join('') ); } @@ -1567,73 +1474,71 @@ sub output_comments { # Output the summary of the questions that the student has answered # for the current problem, along with available information about correctness -sub output_summary { - my $self = shift; - my $r = $self->r; - my $db = $r->db; - my $pg = $self->{pg}; - my %will = %{ $self->{will} }; +sub output_summary ($c) { + my $db = $c->db; + my $pg = $c->{pg}; + my %will = %{ $c->{will} }; - my $output = $r->c; + my $output = $c->c; # Attempt summary if (defined $pg->{flags}{showPartialCorrectAnswers} && $pg->{flags}{showPartialCorrectAnswers} >= 0 - && $self->{submitAnswers}) + && $c->{submitAnswers}) { push( @$output, - $self->attemptResults( + $c->attemptResults( $pg, - $self->{showCorrectOnRandomize} // $will{showCorrectAnswers}, + $c->{showCorrectOnRandomize} // $will{showCorrectAnswers}, $pg->{flags}{showPartialCorrectAnswers}, 1 ) ); - } elsif ($will{checkAnswers} || $self->{will}{showProblemGrader}) { + } elsif ($will{checkAnswers} || $c->{will}{showProblemGrader}) { push( @$output, - $r->tag( + $c->tag( 'div', class => 'ResultsWithError d-inline-block mb-3', - $r->maketext('ANSWERS ONLY CHECKED -- ANSWERS NOT RECORDED') + $c->maketext('ANSWERS ONLY CHECKED -- ANSWERS NOT RECORDED') ), - $self->attemptResults($pg, $will{showCorrectAnswers}, 1, 1) + $c->attemptResults($pg, $will{showCorrectAnswers}, 1, 1) ); - } elsif ($self->{previewAnswers}) { + } elsif ($c->{previewAnswers}) { push( @$output, - $r->tag( + $c->tag( 'div', class => 'ResultsWithError d-inline-block mb-3', - $r->maketext('PREVIEW ONLY -- ANSWERS NOT RECORDED') + $c->maketext('PREVIEW ONLY -- ANSWERS NOT RECORDED') ), - $self->attemptResults($pg, 0, 0, 0) + $c->attemptResults($pg, 0, 0, 0) ); } push( @$output, - $r->tag( + $c->tag( 'div', class => 'ResultsWithError d-inline-block mb-3', - $r->maketext( + $c->maketext( 'ATTEMPT NOT ACCEPTED -- Please submit answers again (or request new version if neccessary).') ) - ) if $self->{resubmitDetected}; + ) if $c->{resubmitDetected}; - if ($self->{set}->set_id ne 'Undefined_Set' && $self->{set}->assignment_type eq 'jitar') { + if ($c->{set}->set_id ne 'Undefined_Set' && $c->{set}->assignment_type eq 'jitar') { my $hasChildren = 0; my @problemIDs = map { $_->[2] } - $db->listUserProblemsWhere({ user_id => $r->param('effectiveUser'), set_id => $self->{set}->set_id }, + $db->listUserProblemsWhere({ user_id => $c->param('effectiveUser'), set_id => $c->{set}->set_id }, 'problem_id'); my @problemSeqs; my $index; # This sets of an array of the sequence associated to the problem_id. for (my $i = 0; $i <= $#problemIDs; $i++) { - $index = $i if ($problemIDs[$i] == $self->{problem}->problem_id); + $index = $i if ($problemIDs[$i] == $c->{problem}->problem_id); my @seq = jitar_id_to_seq($problemIDs[$i]); push @problemSeqs, \@seq; } @@ -1652,20 +1557,20 @@ sub output_summary { $hasChildren && ( ( - $self->{problem}->att_to_open_children != -1 - && $self->{problem}->num_incorrect >= $self->{problem}->att_to_open_children + $c->{problem}->att_to_open_children != -1 + && $c->{problem}->num_incorrect >= $c->{problem}->att_to_open_children ) - || ($self->{problem}->max_attempts != -1 - && $self->{problem}->num_incorrect >= $self->{problem}->max_attempts) + || ($c->{problem}->max_attempts != -1 + && $c->{problem}->num_incorrect >= $c->{problem}->max_attempts) ) ) { push( @$output, - $r->tag( + $c->tag( 'div', class => 'showMeAnotherBox', - $r->maketext( + $c->maketext( 'This problem has open subproblems. You can visit them by using ' . 'the links to the left or visiting the set page.' ) @@ -1678,39 +1583,32 @@ sub output_summary { } # Output the achievement message if there is one. -sub output_achievement_message { - my $self = shift; - my $r = $self->r; - +sub output_achievement_message ($c) { # If achievements are enabled and this is not an undefined set, # check to see if there are new achievements and output them. - if ($r->ce->{achievementsEnabled} - && $self->{will}{recordAnswers} - && $self->{submitAnswers} - && $self->{problem}->set_id ne 'Undefined_Set') + if ($c->ce->{achievementsEnabled} + && $c->{will}{recordAnswers} + && $c->{submitAnswers} + && $c->{problem}->set_id ne 'Undefined_Set') { - return checkForAchievements($self->{problem}, $self->{pg}, $r); + return checkForAchievements($c->{problem}, $c->{pg}, $c); } return ''; } # Puts the tags in the page -sub output_tag_info { - my $self = shift; - my $r = $self->r; - - if ($r->authz->hasPermissions($r->param('user'), 'modify_tags')) { - return $r->c( - $r->tag( +sub output_tag_info ($c) { + if ($c->authz->hasPermissions($c->param('user'), 'modify_tags')) { + return $c->c( + $c->tag( 'div', id => 'tagger', class => 'tag-widget', - data => - { source_file_path => $r->ce->{courseDirs}{templates} . '/' . $self->{problem}{source_file} }, + data => { source_file_path => $c->ce->{courseDirs}{templates} . '/' . $c->{problem}{source_file} }, '' ), - $r->hidden_field(courseID => $self->r->urlpath->arg('courseID'), id => 'hidden_courseID') + $c->hidden_field(courseID => $c->stash('courseID'), id => 'hidden_courseID') )->join(''); } @@ -1718,18 +1616,15 @@ sub output_tag_info { } # Output a custom edit message -sub output_custom_edit_message { - my $self = shift; - my $r = $self->r; - - if ($r->authz->hasPermissions($r->param('user'), 'modify_problem_sets') - && $self->{editMode} - && $self->{editMode} eq 'temporaryFile') +sub output_custom_edit_message ($c) { + if ($c->authz->hasPermissions($c->param('user'), 'modify_problem_sets') + && $c->{editMode} + && $c->{editMode} eq 'temporaryFile') { - return $r->tag( + return $c->tag( 'p', class => 'temporaryFile', - $r->maketext('Viewing temporary file: [_1]', $self->{problem}->source_file) + $c->maketext('Viewing temporary file: [_1]', $c->{problem}->source_file) ); } @@ -1737,42 +1632,30 @@ sub output_custom_edit_message { } # Output the "Show Past Answers" button -sub output_past_answer_button { - my $self = shift; - my $r = $self->r; - my $urlpath = $r->urlpath; - - my $courseID = $urlpath->arg('courseID'); - - my $problemID = $self->{problem}->problem_id; - my $setRecord = $r->db->getGlobalSet($self->{problem}->set_id); +sub output_past_answer_button ($c) { + my $problemID = $c->{problem}->problem_id; + my $setRecord = $c->db->getGlobalSet($c->{problem}->set_id); if (defined $setRecord && $setRecord->assignment_type eq 'jitar') { $problemID = join('.', jitar_id_to_seq($problemID)); } - if ($r->authz->hasPermissions($r->param('user'), 'view_answers')) { - my $hiddenFields = $self->hidden_authen_fields; + if ($c->authz->hasPermissions($c->param('user'), 'view_answers')) { + my $hiddenFields = $c->hidden_authen_fields; $hiddenFields =~ s/\"hidden_/\"pastans-hidden_/g; - return $r->form_for( - $self->systemLink( - $urlpath->newFromModule( - 'WeBWorK::ContentGenerator::Instructor::ShowAnswers', - $r, courseID => $courseID - ), - authen => 0 - ), + return $c->form_for( + 'answer_log', method => 'POST', target => 'WW_Info', - $r->c( + $c->c( $hiddenFields, - $r->hidden_field(courseID => $courseID), - $r->hidden_field(selected_problems => $problemID), - $r->hidden_field(selected_sets => $self->{problem}->set_id), - $r->hidden_field(selected_users => $self->{problem}->user_id), - $r->tag( + $c->hidden_field(courseID => $c->stash('courseID')), + $c->hidden_field(selected_problems => $problemID), + $c->hidden_field(selected_sets => $c->{problem}->set_id), + $c->hidden_field(selected_users => $c->{problem}->user_id), + $c->tag( 'p', - $r->submit_button( - $r->maketext('Show Past Answers'), + $c->submit_button( + $c->maketext('Show Past Answers'), name => 'action', class => 'btn btn-primary' ) @@ -1785,32 +1668,29 @@ sub output_past_answer_button { } # Output the "Email Instructor" button -sub output_email_instructor { - my $self = shift; - my $r = $self->r; - - my $user = $r->db->getUser($r->param('user')); - - return $self->feedbackMacro( - module => __PACKAGE__, - courseId => $r->urlpath->arg('courseID'), - set => $self->{set}->set_id, - problem => $self->{problem}->problem_id, - problemPath => $self->{problem}->source_file, - randomSeed => $self->{problem}->problem_seed, - notifyAddresses => join(';', $self->fetchEmailRecipients('receive_feedback', $user)), - emailableURL => $self->generateURLs( +sub output_email_instructor ($c) { + my $user = $c->db->getUser($c->param('user')); + + return $c->feedbackMacro( + route => $c->current_route, + courseId => $c->stash('courseID'), + set => $c->{set}->set_id, + problem => $c->{problem}->problem_id, + problemPath => $c->{problem}->source_file, + randomSeed => $c->{problem}->problem_seed, + notifyAddresses => join(';', $c->fetchEmailRecipients('receive_feedback', $user)), + emailableURL => $c->generateURLs( url_type => 'absolute', - set_id => $self->{set}->set_id, - problem_id => $self->{problem}->problem_id + set_id => $c->{set}->set_id, + problem_id => $c->{problem}->problem_id ), studentName => $user->full_name, - displayMode => $self->{displayMode}, - showOldAnswers => $self->{will}{showOldAnswers}, - showCorrectAnswers => $self->{will}{showCorrectAnswers}, - showHints => $self->{will}{showHints}, - showSolutions => $self->{will}{showSolutions}, - pg_object => $self->{pg}, + displayMode => $c->{displayMode}, + showOldAnswers => $c->{will}{showOldAnswers}, + showCorrectAnswers => $c->{will}{showCorrectAnswers}, + showHints => $c->{will}{showHints}, + showSolutions => $c->{will}{showSolutions}, + pg_object => $c->{pg}, ); } diff --git a/lib/WeBWorK/ContentGenerator/ProblemSet.pm b/lib/WeBWorK/ContentGenerator/ProblemSet.pm index 97569ba541..1f57e38468 100644 --- a/lib/WeBWorK/ContentGenerator/ProblemSet.pm +++ b/lib/WeBWorK/ContentGenerator/ProblemSet.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::ProblemSet; -use parent qw(WeBWorK::ContentGenerator); +use Mojo::Base 'WeBWorK::ContentGenerator', -signatures, -async_await; =head1 NAME @@ -23,69 +23,59 @@ problem set. =cut -use strict; -use warnings; - -use Future::AsyncAwait; - use WeBWorK::Debug; use WeBWorK::Utils qw(path_is_subdir is_restricted wwRound before between after grade_set format_set_name_display); use WeBWorK::Utils::Rendering qw(renderPG); use WeBWorK::Localize; -async sub initialize { - my ($self) = @_; - my $r = $self->r; - my $db = $r->db; - my $ce = $r->ce; - my $urlpath = $r->urlpath; - my $authz = $r->authz; +async sub initialize ($c) { + my $db = $c->db; + my $ce = $c->ce; + my $authz = $c->authz; - # $self->{invalidSet} is set in checkSet which is called by ContentGenerator.pm - return if $self->{invalidSet}; + # $c->{invalidSet} is set in checkSet which is called by ContentGenerator.pm + return if $c->{invalidSet}; - # This will all be valid if checkSet did not set $self->{invalidSet}. - my $userID = $r->param('user'); - my $eUserID = $r->param('effectiveUser'); + # This will all be valid if checkSet did not set $c->{invalidSet}. + my $userID = $c->param('user'); + my $eUserID = $c->param('effectiveUser'); my $user = $db->getUser($userID); my $effectiveUser = $db->getUser($eUserID); - $self->{set} = $authz->{merged_set}; + $c->{set} = $authz->{merged_set}; - $self->{displayMode} = $user->displayMode || $ce->{pg}{options}{displayMode}; + $c->{displayMode} = $user->displayMode || $ce->{pg}{options}{displayMode}; # Display status messages. - $self->addmessage($r->tag('p', class => 'my-2', $r->b($r->param('status_message')))) if $r->param('status_message'); + $c->addmessage($c->tag('p', class => 'my-2', $c->b($c->param('status_message')))) if $c->param('status_message'); if ($authz->hasPermissions($userID, 'view_hidden_sets')) { - if ($self->{set}->visible) { - $self->addmessage( - $r->tag('span', class => 'font-visible', $r->maketext('This set is visible to students.'))); + if ($c->{set}->visible) { + $c->addmessage($c->tag('span', class => 'font-visible', $c->maketext('This set is visible to students.'))); } else { - $self->addmessage( - $r->tag('span', class => 'font-hidden', $r->maketext('This set is hidden from students.'))); + $c->addmessage($c->tag('span', class => 'font-hidden', $c->maketext('This set is hidden from students.'))); } } # Hack to prevent errors from uninitialized set_headers. - $self->{set}->set_header('defaultHeader') unless $self->{set}->set_header =~ /\S/; + $c->{set}->set_header('defaultHeader') unless $c->{set}->set_header =~ /\S/; my $screenSetHeader = - $self->{set}->set_header eq 'defaultHeader' + $c->{set}->set_header eq 'defaultHeader' ? $ce->{webworkFiles}{screenSnippets}{setHeader} - : $self->{set}->set_header; + : $c->{set}->set_header; # Note this may be different than the display mode above when previewing a temporary set header file. - my $displayMode = $r->param('displayMode') || $ce->{pg}{options}{displayMode}; + my $displayMode = $c->param('displayMode') || $ce->{pg}{options}{displayMode}; if ($authz->hasPermissions($userID, 'modify_problem_sets')) { - if (defined $r->param('editMode') && $r->param('editMode') eq 'temporaryFile') { - $screenSetHeader = $r->param('sourceFilePath'); + if (defined $c->param('editMode') && $c->param('editMode') eq 'temporaryFile') { + $screenSetHeader = $c->param('sourceFilePath'); $screenSetHeader = "$ce->{courseDirs}{templates}/$screenSetHeader" unless $screenSetHeader =~ m!^/!; die 'sourceFilePath is unsafe!' unless path_is_subdir($screenSetHeader, $ce->{courseDirs}{templates}); - $self->addmessage($r->tag( + $c->addmessage($c->tag( 'div', class => 'temporaryFile', - $r->maketext('Viewing temporary file: [_1]', $screenSetHeader) + $c->maketext('Viewing temporary file: [_1]', $screenSetHeader) )); } } @@ -94,47 +84,45 @@ async sub initialize { my $problem = WeBWorK::DB::Record::UserProblem->new( problem_id => 0, - set_id => $self->{set}->set_id, + set_id => $c->{set}->set_id, login_id => $effectiveUser->user_id, source_file => $screenSetHeader ); - $self->{pg} = await renderPG($r, $effectiveUser, $self->{set}, $problem, $self->{set}->psvn, {}, - { displayMode => $displayMode }); + $c->{pg} = + await renderPG($c, $effectiveUser, $c->{set}, $problem, $c->{set}->psvn, {}, { displayMode => $displayMode }); return; } -sub nav { - my ($self, $args) = @_; - my $r = $self->r; - +sub nav ($c, $args) { # Don't show the nav if the user does not have unrestricted navigation permissions. - return '' unless $r->authz->hasPermissions($r->param('user'), 'navigation_allowed'); + return '' unless $c->authz->hasPermissions($c->param('user'), 'navigation_allowed'); - my @links = - ($r->maketext('Homework Sets'), $r->location . $r->urlpath->parent->path, $r->maketext('Homework Sets')); - return $r->tag( + my @links = ( + $c->maketext('Homework Sets'), + $c->url_for($c->app->routes->lookup($c->current_route)->parent->name), + $c->maketext('Homework Sets') + ); + return $c->tag( 'div', class => 'row sticky-nav', role => 'navigation', aria_label => 'problem navigation', - $r->tag('div', $self->navMacro($args, '', @links)) + $c->tag('div', $c->navMacro($args, {}, @links)) ); } -sub title { - my $self = shift; - my $r = $self->r; - my $ce = $r->ce; +sub page_title ($c) { + my $ce = $c->ce; - # Using the url arguments won't break if the set/problem are invalid. - my $setID = $r->urlpath->arg('setID'); + # Using the url path parameters won't break if the set/problem are invalid. + my $setID = $c->stash('setID'); - my $title = $r->tag('span', dir => 'ltr', format_set_name_display($setID)); + my $title = $c->tag('span', dir => 'ltr', format_set_name_display($setID)); # Put either due date or reduced scoring date in the title. - my $set = $r->db->getMergedSet($r->param('effectiveUser'), $setID); + my $set = $c->db->getMergedSet($c->param('effectiveUser'), $setID); if (defined($set) && between($set->open_date, $set->due_date)) { if ($ce->{pg}{ansEvalDefaults}{enableReducedScoring} && $set->enable_reduced_scoring @@ -143,31 +131,28 @@ sub title { && before($set->reduced_scoring_date)) { $title .= ' - ' - . $r->maketext( + . $c->maketext( 'Due [_1], after which reduced scoring is available until [_2]', - $self->formatDateTime($set->reduced_scoring_date, undef, $ce->{studentDateDisplayFormat}), - $self->formatDateTime($set->due_date, undef, $ce->{studentDateDisplayFormat}) + $c->formatDateTime($set->reduced_scoring_date, undef, $ce->{studentDateDisplayFormat}), + $c->formatDateTime($set->due_date, undef, $ce->{studentDateDisplayFormat}) ); } elsif ($set->due_date) { $title .= ' - ' - . $r->maketext('Closes [_1]', - $self->formatDateTime($set->due_date, undef, $ce->{studentDateDisplayFormat})); + . $c->maketext('Closes [_1]', + $c->formatDateTime($set->due_date, undef, $ce->{studentDateDisplayFormat})); } } return $title; } -sub siblings { - my ($self) = @_; - my $r = $self->r; - my $db = $r->db; - my $ce = $r->ce; - my $authz = $r->authz; - my $urlpath = $r->urlpath; +sub siblings ($c) { + my $db = $c->db; + my $ce = $c->ce; + my $authz = $c->authz; - my $user = $r->param('user'); - my $eUserID = $r->param('effectiveUser'); + my $user = $c->param('user'); + my $eUserID = $c->param('effectiveUser'); # Restrict navigation to other problem sets if not allowed. return '' unless $authz->hasPermissions($user, 'navigation_allowed'); @@ -192,32 +177,30 @@ sub siblings { } @setIDs; } - return $r->include('ContentGenerator/ProblemSet/siblings', setIDs => \@setIDs); + return $c->include('ContentGenerator/ProblemSet/siblings', setIDs => \@setIDs); } sub info { - my ($self) = @_; - return '' unless $self->{pg}; - return $self->r->include('ContentGenerator/ProblemSet/info'); + my ($c) = @_; + return '' unless $c->{pg}; + return $c->include('ContentGenerator/ProblemSet/info'); } # This is called by the ContentGenerator/ProblemSet/body template for a regular homework set. # It lists the problems in the set. -sub problem_list { - my ($self) = @_; - my $r = $self->r; - my $authz = $r->authz; - my $db = $r->db; +sub problem_list ($c) { + my $authz = $c->authz; + my $db = $c->db; - my $setID = $r->urlpath->arg('setID'); - my $user = $r->param('user'); + my $setID = $c->stash('setID'); + my $user = $c->param('user'); my @problems = - $db->getMergedProblemsWhere({ user_id => $r->param('effectiveUser'), set_id => $setID }, 'problem_id'); + $db->getMergedProblemsWhere({ user_id => $c->param('effectiveUser'), set_id => $setID }, 'problem_id'); if (@problems) { # Check permissions and see if any of the problems are gradeable - $self->{canScoreProblems} = 0; + $c->{canScoreProblems} = 0; if ($authz->hasPermissions($user, 'access_instructor_tools') && $authz->hasPermissions($user, 'score_sets')) { my @setUsers = $db->listSetUsers($setID); my @globalProblems = $db->getGlobalProblemsWhere({ set_id => $setID }); @@ -225,31 +208,28 @@ sub problem_list { my @gradeableProblems; for my $problem (@globalProblems) { if ($problem->flags =~ /essay/) { - $self->{canScoreProblems} = 1; + $c->{canScoreProblems} = 1; $gradeableProblems[ $problem->problem_id ] = 1; } } - $self->{gradeableProblems} = \@gradeableProblems if $self->{canScoreProblems}; + $c->{gradeableProblems} = \@gradeableProblems if $c->{canScoreProblems}; } } - return $r->include('ContentGenerator/ProblemSet/problem_list', problems => \@problems); + return $c->include('ContentGenerator/ProblemSet/problem_list', problems => \@problems); } # This is called by the ContentGenerator/ProblemSet/body template for a test. # It gives some information about the test parameters, and lists the versions. -sub gateway_body { - my ($self) = @_; - my $r = $self->r; - my $authz = $r->authz; - my $ce = $r->ce; - my $db = $r->db; - my $urlpath = $r->urlpath; - - my $set = $self->{set}; - my $effectiveUser = $r->param('effectiveUser'); - my $user = $r->param('user'); +sub gateway_body ($c) { + my $authz = $c->authz; + my $ce = $c->ce; + my $db = $c->db; + + my $set = $c->{set}; + my $effectiveUser = $c->param('effectiveUser'); + my $user = $c->param('user'); my $timeNow = time; my $timeLimit = $set->version_time_limit || 0; @@ -285,17 +265,16 @@ sub gateway_body { # Build data hash for this version. my $data = {}; - $data->{id} = $set->set_id . ',v' . $verSet->version_id; - $data->{version} = $verSet->version_id; - $data->{start} = - $self->formatDateTime($verSet->version_creation_time, undef, $ce->{studentDateDisplayFormat}); + $data->{id} = $set->set_id . ',v' . $verSet->version_id; + $data->{version} = $verSet->version_id; + $data->{start} = $c->formatDateTime($verSet->version_creation_time, undef, $ce->{studentDateDisplayFormat}); $data->{proctored} = $verSet->assignment_type =~ /proctored/; # Display close date if this is not a timed test. my $closeText = ''; if (!$timeLimit) { - $closeText = $r->maketext('Closes on [_1]', - $self->formatDateTime($verSet->due_date, undef, $ce->{studentDateDisplayFormat})); + $closeText = $c->maketext('Closes on [_1]', + $c->formatDateTime($verSet->due_date, undef, $ce->{studentDateDisplayFormat})); } if (defined $verSet->version_last_attempt_time && $verSet->version_last_attempt_time > 0) { @@ -303,18 +282,18 @@ sub gateway_body { && ($maxSubmits <= 0 || ($maxSubmits > 0 && $verSubmits < $maxSubmits))) { if ($verSubmits > 0) { - $data->{end} = $r->maketext('Additional submissions available.') . " $closeText"; + $data->{end} = $c->maketext('Additional submissions available.') . " $closeText"; } else { $data->{end} = $closeText; } } else { $data->{end} = - $self->formatDateTime($verSet->version_last_attempt_time, undef, $ce->{studentDateDisplayFormat}); + $c->formatDateTime($verSet->version_last_attempt_time, undef, $ce->{studentDateDisplayFormat}); } } elsif ($timeNow < $verSet->due_date) { - $data->{end} = $r->maketext('Test not yet submitted.') . " $closeText"; + $data->{end} = $c->maketext('Test not yet submitted.') . " $closeText"; } else { - $data->{end} = $r->maketext('No submissions. Over time.'); + $data->{end} = $c->maketext('No submissions. Over time.'); } # Status Logic: Assuming it is always after the open date for test versions. @@ -332,13 +311,13 @@ sub gateway_body { if ($timeNow < $verSet->due_date + $ce->{gatewayGracePeriod}) { if ($maxSubmits > 0 && $verSubmits >= $maxSubmits) { - $data->{status} = $r->maketext('Completed.'); - $data->{status} .= $r->maketext(' Answers Available.') if ($canShowAns); + $data->{status} = $c->maketext('Completed.'); + $data->{status} .= $c->maketext(' Answers Available.') if ($canShowAns); } else { if ($verSubmits) { - $data->{status} = $r->maketext('Open. Submitted.'); + $data->{status} = $c->maketext('Open. Submitted.'); } else { - $data->{status} = $r->maketext('Open.'); + $data->{status} = $c->maketext('Open.'); } if (($maxSubmits == 0 && !$verSubmits) || $verSubmits < $maxSubmits) { $continueVersion = $verSet; @@ -348,11 +327,11 @@ sub gateway_body { } } else { if ($verSubmits > 0) { - $data->{status} = $r->maketext('Completed.'); + $data->{status} = $c->maketext('Completed.'); } else { - $data->{status} = $r->maketext('Closed.'); + $data->{status} = $c->maketext('Closed.'); } - $data->{status} .= $r->maketext(' Answers Available.') if ($canShowAns); + $data->{status} .= $c->maketext(' Answers Available.') if ($canShowAns); } # Only show download link if work is not hidden. @@ -376,7 +355,7 @@ sub gateway_body { push @versionData, $data; } - return $r->include( + return $c->include( 'ContentGenerator/ProblemSet/version_list', continueVersion => $continueVersion, continueTimeLeft => $continueTimeLeft, diff --git a/lib/WeBWorK/ContentGenerator/ProblemSets.pm b/lib/WeBWorK/ContentGenerator/ProblemSets.pm index 5cbcf3b466..f9ddcbb188 100644 --- a/lib/WeBWorK/ContentGenerator/ProblemSets.pm +++ b/lib/WeBWorK/ContentGenerator/ProblemSets.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::ProblemSets; -use parent qw(WeBWorK::ContentGenerator); +use Mojo::Base 'WeBWorK::ContentGenerator', -signatures; =head1 NAME @@ -22,9 +22,6 @@ WeBWorK::ContentGenerator::ProblemSets - Display a list of built problem sets. =cut -use strict; -use warnings; - use WeBWorK::Debug; use WeBWorK::Utils qw(after readFile sortByName path_is_subdir is_restricted format_set_name_display); use WeBWorK::Localize; @@ -36,12 +33,9 @@ use constant RECENT => 2 * 7 * 24 * 60 * 60; # Two-Weeks in seconds use constant DEFAULT_COURSE_INFO_TXT => "Put information about your course here. Click the edit button above to add your own message.\n"; -sub can { - my ($self, $arg) = @_; - +sub can ($c, $arg) { if ($arg eq 'info') { - my $r = $self->r; - my $ce = $r->ce; + my $ce = $c->ce; # Only show the info box if the viewer has permission # to edit it or if it is not the standard template box. @@ -51,30 +45,28 @@ sub can { my $text = DEFAULT_COURSE_INFO_TXT; $text = eval { readFile($course_info_path) } if (-f $course_info_path); - return $r->authz->hasPermissions($r->param('user'), 'access_instructor_tools') + return $c->authz->hasPermissions($c->param('user'), 'access_instructor_tools') || $text ne DEFAULT_COURSE_INFO_TXT; } - return $self->SUPER::can($arg); + return $c->SUPER::can($arg); } -sub initialize { - my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; - my $authz = $r->authz; +sub initialize ($c) { + my $ce = $c->ce; + my $authz = $c->authz; - my $user = $r->param('user'); + my $user = $c->param('user'); if ($authz->hasPermissions($user, 'access_instructor_tools')) { - my $status_message = $r->param('status_message'); - $self->addmessage($r->tag('p', class => 'my-2', $r->b($status_message))) if $status_message; + my $status_message = $c->param('status_message'); + $c->addmessage($c->tag('p', class => 'my-2', $c->b($status_message))) if $status_message; } if ($authz->hasPermissions($user, 'navigation_allowed')) { debug('Begin collecting merged sets'); - my @sets = $r->db->getMergedSetsWhere({ user_id => $r->param('effectiveUser') || $user }); + my @sets = $c->db->getMergedSetsWhere({ user_id => $c->param('effectiveUser') || $user }); # Remove proctored gateway sets for users without permission to view them unless ($authz->hasPermissions($user, 'view_proctored_tests')) { @@ -83,7 +75,7 @@ sub initialize { debug('Begin sorting merged sets'); - if (($r->param('sort') || 'status') eq 'status') { + if (($c->param('sort') || 'status') eq 'status') { @sets = sort byUrgency (@sets); } else { # Assume sort by 'name' if the parameter was not set to status. @@ -91,7 +83,7 @@ sub initialize { @sets = sortByName('set_id', @sets); } - $r->stash->{sets} = \@sets; + $c->stash->{sets} = \@sets; debug('End preparing merged sets'); } @@ -101,156 +93,144 @@ sub initialize { my $course_info_path = "$ce->{courseDirs}{templates}/$ce->{courseFiles}{course_info}"; if ($authz->hasPermissions($user, 'access_instructor_tools')) { - if (defined $r->param('editMode') && $r->param('editMode') eq 'temporaryFile') { - $course_info_path = $r->param('sourceFilePath'); + if (defined $c->param('editMode') && $c->param('editMode') eq 'temporaryFile') { + $course_info_path = $c->param('sourceFilePath'); $course_info_path = "$ce->{courseDirs}{templates}/$course_info_path" unless $course_info_path =~ m!^/!; unless (path_is_subdir($course_info_path, $ce->{courseDirs}{templates})) { - $self->addbadmessage('sourceFilePath is unsafe!'); + $c->addbadmessage('sourceFilePath is unsafe!'); return ''; } - $self->addmessage($r->tag( + $c->addmessage($c->tag( 'p', class => 'temporaryFile my-2', - $r->maketext('Viewing temporary file: [_1]', $course_info_path) + $c->maketext('Viewing temporary file: [_1]', $course_info_path) )); } } if (-f $course_info_path) { - $r->stash->{course_info_contents} = eval { readFile($course_info_path) }; - $r->stash->{course_info_error} = $@ if $@; + $c->stash->{course_info_contents} = eval { readFile($course_info_path) }; + $c->stash->{course_info_error} = $@ if $@; } return; } -sub info { - my ($self) = @_; - return $self->r->include('ContentGenerator/ProblemSets/info'); +sub info ($c) { + return $c->include('ContentGenerator/ProblemSets/info'); } -sub setListRow { - my ($self, $set) = @_; - my $r = $self->r; - my $ce = $r->ce; - my $db = $r->db; - my $authz = $r->authz; - my $user = $r->param('user'); - my $effectiveUser = $r->param('effectiveUser') || $user; - my $urlpath = $r->urlpath; +sub setListRow ($c, $set) { + my $ce = $c->ce; + my $db = $c->db; + my $authz = $c->authz; + my $user = $c->param('user'); + my $effectiveUser = $c->param('effectiveUser') || $user; my $globalSet = $db->getGlobalSet($set->set_id); my $gwtype = ($set->assignment_type() =~ /gateway/) ? 1 : 0; my $preOpenSets = $authz->hasPermissions($user, 'view_unopened_sets'); my @restricted = $ce->{options}{enableConditionalRelease} ? is_restricted($db, $set, $effectiveUser) : (); - my $courseName = $urlpath->arg('courseID'); + my $courseName = $c->stash('courseID'); my $display_name = format_set_name_display($set->set_id); # Add clock icon if timed gateway if ($gwtype && $set->{version_time_limit} > 0 && time < $set->due_date) { - $display_name = $r->c( - $r->tag( + $display_name = $c->c( + $c->tag( 'i', class => 'icon far fa-clock', - title => $r->maketext('Test/quiz with time limit.'), - data => { alt => $r->maketext('Test/quiz with time limit.') } + title => $c->maketext('Test/quiz with time limit.'), + data => { alt => $c->maketext('Test/quiz with time limit.') } ), ' ', - $r->tag('span', $display_name) + $c->tag('span', $display_name) )->join(''); } # This is the link to the set, it has tooltip with the set description. - my $interactive = $r->link_to( - $display_name => $self->systemLink($urlpath->newFromModule( - 'WeBWorK::ContentGenerator::ProblemSet', $r, - courseID => $courseName, - setID => $set->set_id - )), - class => 'set-id-tooltip', - data => { bs_toggle => 'tooltip', bs_placement => 'right', bs_title => $globalSet->description } + my $interactive = $c->link_to( + $display_name => $c->systemLink($c->url_for('problem_list', setID => $set->set_id)), + class => 'set-id-tooltip', + data => { bs_toggle => 'tooltip', bs_placement => 'right', bs_title => $globalSet->description } ); # Determine set status. my $status = ''; if (time < $set->open_date) { - $status = $r->maketext('Will open on [_1].', - $self->formatDateTime($set->open_date, undef, $ce->{studentDateDisplayFormat})); + $status = $c->maketext('Will open on [_1].', + $c->formatDateTime($set->open_date, undef, $ce->{studentDateDisplayFormat})); if (@restricted) { $status = - $r->c($status, restricted_progression_msg($r, 1, $set->restricted_status * 100, @restricted))->join(''); + $c->c($status, $c->restricted_progression_msg(1, $set->restricted_status * 100, @restricted))->join(''); } $interactive = $display_name unless $preOpenSets || ($gwtype && $db->countSetVersions($effectiveUser, $set->set_id)); } elsif (time < $set->due_date) { - $status = $self->set_due_msg($set); + $status = $c->set_due_msg($set); if (@restricted) { $interactive = $display_name unless $preOpenSets; $status = - $r->c($status, restricted_progression_msg($r, 0, $set->restricted_status * 100, @restricted))->join(''); + $c->c($status, $c->restricted_progression_msg(0, $set->restricted_status * 100, @restricted))->join(''); } elsif (defined $ce->{LTIGradeMode} && $ce->{LTIGradeMode} eq 'homework' && !$set->lis_source_did) { # The set shouldn't be shown if the LTI grade mode is set to homework and we don't # have a source did to use to send back grades. unless ($preOpenSets) { - $status = $r->c( + $status = $c->c( $status, - $r->tag('br'), - $r->maketext( + $c->tag('br'), + $c->maketext( 'You must log into this set via your Learning Management System ([_1]).', - $ce->{LMS_url} ? $r->link_to($ce->{LMS_name} => $ce->{LMS_url}) : $ce->{LMS_name} + $ce->{LMS_url} ? $c->link_to($ce->{LMS_name} => $ce->{LMS_url}) : $ce->{LMS_name} ) )->join(''); $interactive = $display_name; } } } elsif (time < $set->answer_date) { - $status = $r->maketext('Closed, answers on [_1].', - $self->formatDateTime($set->answer_date, undef, $ce->{studentDateDisplayFormat})); + $status = $c->maketext('Closed, answers on [_1].', + $c->formatDateTime($set->answer_date, undef, $ce->{studentDateDisplayFormat})); } elsif ($set->answer_date <= time and time < $set->answer_date + RECENT) { - $status = $r->maketext('Closed, answers recently available.'); + $status = $c->maketext('Closed, answers recently available.'); } else { - $status = $r->maketext('Closed, answers available.'); + $status = $c->maketext('Closed, answers available.'); } my $control = ''; if (!$gwtype) { if ($authz->hasPermissions($user, 'view_multiple_sets')) { - $control = $r->check_box(selected_sets => $set->set_id, id => $set->set_id, class => 'form-check-input'); + $control = $c->check_box(selected_sets => $set->set_id, id => $set->set_id, class => 'form-check-input'); # Make the interactive be the label for the control. - $interactive = $r->label_for($set->set_id => $interactive); + $interactive = $c->label_for($set->set_id => $interactive); } else { if (after($set->open_date) && (!@restricted || after($set->due_date))) { - $control = $r->link_to( - $r->tag( + $control = $c->link_to( + $c->tag( 'i', class => 'hardcopy-tooltip icon far fa-arrow-alt-circle-down fa-lg', 'aria-hidden' => 'true', - title => $r->maketext( + title => $c->maketext( 'Download [_1]', - $r->tag('span', dir => 'ltr', format_set_name_display($set->set_id)) + $c->tag('span', dir => 'ltr', format_set_name_display($set->set_id)) ), data => { - alt => $r->maketext( + alt => $c->maketext( 'Download [_1]', - $r->tag('span', dir => 'ltr', format_set_name_display($set->set_id)) + $c->tag('span', dir => 'ltr', format_set_name_display($set->set_id)) ), bs_toggle => 'tooltip', bs_placement => 'left' } - ) => $self->systemLink( - $urlpath->newFromModule( - 'WeBWorK::ContentGenerator::Hardcopy', $r, - courseID => $courseName, - setID => $set->set_id - ), + ) => $c->systemLink( + $c->url_for('hardcopy', setID => $set->set_id), params => { selected_sets => $set->set_id } ), class => 'hardcopy-link', @@ -259,14 +239,14 @@ sub setListRow { } } - $status = $r->tag('span', class => $set->visible ? 'font-visible' : 'font-hidden', $status) if $preOpenSets; + $status = $c->tag('span', class => $set->visible ? 'font-visible' : 'font-hidden', $status) if $preOpenSets; - return $r->tag( + return $c->tag( 'tr', - $r->c( - $r->tag('td', dir => 'ltr', $interactive), - $r->tag('td', $status), - $r->tag('td', class => 'hardcopy', $control) + $c->c( + $c->tag('td', dir => 'ltr', $interactive), + $c->tag('td', $status), + $c->tag('td', class => 'hardcopy', $control) )->join('') ); } @@ -298,65 +278,59 @@ sub byUrgency { return ($a_parts[0] cmp $b_parts[0]); } -sub set_due_msg { - my $self = shift; - my $set = shift; - - my $r = $self->r; - my $ce = $r->ce; +sub set_due_msg ($c, $set) { + my $ce = $c->ce; my $enable_reduced_scoring = $ce->{pg}{ansEvalDefaults}{enableReducedScoring} && $set->enable_reduced_scoring && $set->reduced_scoring_date && $set->reduced_scoring_date < $set->due_date; - my $reduced_scoring_date = $set->reduced_scoring_date; - my $beginReducedScoringPeriod = - $self->formatDateTime($reduced_scoring_date, undef, $ce->{studentDateDisplayFormat}); + my $reduced_scoring_date = $set->reduced_scoring_date; + my $beginReducedScoringPeriod = $c->formatDateTime($reduced_scoring_date, undef, $ce->{studentDateDisplayFormat}); my $t = time; if ($enable_reduced_scoring && $t < $reduced_scoring_date) { - return $r->c( - $r->maketext('Open, due [_1].', $beginReducedScoringPeriod), - $r->tag('br'), - $r->maketext( + return $c->c( + $c->maketext('Open, due [_1].', $beginReducedScoringPeriod), + $c->tag('br'), + $c->maketext( 'Afterward reduced credit can be earned until [_1].', - $self->formatDateTime($set->due_date(), undef, $ce->{studentDateDisplayFormat}) + $c->formatDateTime($set->due_date(), undef, $ce->{studentDateDisplayFormat}) ) )->join(''); } else { if ($enable_reduced_scoring && $reduced_scoring_date && $t > $reduced_scoring_date) { - return $r->c( - $r->maketext('Due date [_1] has passed.', $beginReducedScoringPeriod), - $r->tag('br'), - $r->maketext( + return $c->c( + $c->maketext('Due date [_1] has passed.', $beginReducedScoringPeriod), + $c->tag('br'), + $c->maketext( 'Reduced credit can still be earned until [_1].', - $self->formatDateTime($set->due_date(), undef, $ce->{studentDateDisplayFormat}) + $c->formatDateTime($set->due_date(), undef, $ce->{studentDateDisplayFormat}) ) )->join(''); } - return $r->maketext('Open, closes [_1].', - $self->formatDateTime($set->due_date(), undef, $ce->{studentDateDisplayFormat})); + return $c->maketext('Open, closes [_1].', + $c->formatDateTime($set->due_date(), undef, $ce->{studentDateDisplayFormat})); } } -sub restricted_progression_msg { - my ($r, $open, $restriction, @restricted) = @_; +sub restricted_progression_msg ($c, $open, $restriction, @restricted) { my $status = ' '; if (@restricted == 1) { - $status .= $r->maketext( + $status .= $c->maketext( 'To access this set you must score at least [_1]% on set [_2].', sprintf('%.0f', $restriction), - $r->tag('span', dir => 'ltr', format_set_name_display($restricted[0])) + $c->tag('span', dir => 'ltr', format_set_name_display($restricted[0])) ); } else { - $status .= $r->maketext( + $status .= $c->maketext( 'To access this set you must score at least [_1]% on the following sets: [_2].', sprintf('%.0f', $restriction), - join(', ', map { $r->tag('span', dir => 'ltr', format_set_name_display($_)) } @restricted) + join(', ', map { $c->tag('span', dir => 'ltr', format_set_name_display($_)) } @restricted) ); } diff --git a/lib/WeBWorK/ContentGenerator/ProctoredGatewayQuiz.pm b/lib/WeBWorK/ContentGenerator/ProctoredGatewayQuiz.pm index 66dea241e3..20fa38320f 100644 --- a/lib/WeBWorK/ContentGenerator/ProctoredGatewayQuiz.pm +++ b/lib/WeBWorK/ContentGenerator/ProctoredGatewayQuiz.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::ProctoredGatewayQuiz; -use parent qw(WeBWorK::ContentGenerator::GatewayQuiz); +use Mojo::Base 'WeBWorK::ContentGenerator::GatewayQuiz', -signatures; =head1 NAME @@ -23,7 +23,4 @@ this is a wrapper for GatewayQuiz.pm and has no content =cut -use strict; -use warnings; - 1; diff --git a/lib/WeBWorK/ContentGenerator/RenderViaRPC.pm b/lib/WeBWorK/ContentGenerator/RenderViaRPC.pm index 180e41668b..70a90ad91a 100644 --- a/lib/WeBWorK/ContentGenerator/RenderViaRPC.pm +++ b/lib/WeBWorK/ContentGenerator/RenderViaRPC.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::RenderViaRPC; -use parent qw(WeBWorK::ContentGenerator); +use Mojo::Base 'WeBWorK::ContentGenerator', -signatures, -async_await; =head1 NAME @@ -32,52 +32,40 @@ result is returned in the JSON or HTML format as determined by the request type. =cut -use strict; -use warnings; - -use Future::AsyncAwait; - use WebworkWebservice; -async sub pre_header_initialize { - my $self = shift; - my $r = $self->r; +async sub pre_header_initialize ($c) { + $c->{wantsjson} = ($c->param('outputformat') // '') eq 'json' || ($c->param('send_pg_flags') // 0); - $self->{wantsjson} = ($r->param('outputformat') // '') eq 'json' || ($r->param('send_pg_flags') // 0); - - unless ($r->authen->was_verified) { - $self->{output} = - $self->{wantsjson} - ? { error => 'render_rpc: authentication failed.' } - : 'render_rpc: authentication failed.'; + unless ($c->authen->was_verified) { + $c->{output} = + $c->{wantsjson} ? { error => 'render_rpc: authentication failed.' } : 'render_rpc: authentication failed.'; return; } - $r->param('displayMode', 'tex') if ($r->param('outputformat') eq 'pdf' || $r->param('outputformat') eq 'tex'); + $c->param('displayMode', 'tex') if ($c->param('outputformat') eq 'pdf' || $c->param('outputformat') eq 'tex'); - # Call the WebworkWebservice to render the problem and store the result in $self->return_object. - my $rpc_service = WebworkWebservice->new($r); + # Call the WebworkWebservice to render the problem and store the result in $c->return_object. + my $rpc_service = WebworkWebservice->new($c); await $rpc_service->rpc_execute('renderProblem'); if ($rpc_service->error_string) { - $self->{output} = $self->{wantsjson} ? { error => $rpc_service->error_string } : $rpc_service->error_string; + $c->{output} = $c->{wantsjson} ? { error => $rpc_service->error_string } : $rpc_service->error_string; return; } # Format the return in the requested format. A response is rendered unless there is an error. - $self->{output} = $rpc_service->formatRenderedProblem; + $c->{output} = $rpc_service->formatRenderedProblem; return; } -sub content { - my $self = shift; - +sub content ($c) { # If there were no errors a response will have been rendered. Return in that case. - return if $self->r->res->code; + return if $c->res->code; # Handle rendering of errors. - return $self->r->render(json => $self->{output}) if $self->{wantsjson}; - return $self->r->render(text => $self->{output}); + return $c->render(json => $c->{output}) if $c->{wantsjson}; + return $c->render(text => $c->{output}); } 1; diff --git a/lib/WeBWorK/ContentGenerator/ShowMeAnother.pm b/lib/WeBWorK/ContentGenerator/ShowMeAnother.pm index ce1d2a651f..947b159815 100644 --- a/lib/WeBWorK/ContentGenerator/ShowMeAnother.pm +++ b/lib/WeBWorK/ContentGenerator/ShowMeAnother.pm @@ -14,7 +14,7 @@ ################################################################################ package WeBWorK::ContentGenerator::ShowMeAnother; -use parent qw(WeBWorK::ContentGenerator::Problem); +use Mojo::Base 'WeBWorK::ContentGenerator::Problem', -signatures, -async_await; =head1 NAME @@ -22,53 +22,45 @@ WeBWorK::ContentGenerator::ShowMeAnother - Show students alternate versions of c =cut -use strict; -use warnings; - -use Future::AsyncAwait; - use WeBWorK::Debug; use WeBWorK::Utils qw(wwRound before after jitar_id_to_seq format_set_name_display); use WeBWorK::Utils::Rendering qw(getTranslatorDebuggingOptions renderPG); -async sub pre_header_initialize { - my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; - my $db = $r->db; - my $authz = $r->authz; - my $urlpath = $r->urlpath; - - my $setName = $urlpath->arg('setID'); - my $problemNumber = $r->urlpath->arg('problemID'); - my $userName = $r->param('user'); - my $effectiveUserName = $r->param('effectiveUser'); - my $key = $r->param('key'); - my $editMode = $r->param('editMode'); +async sub pre_header_initialize ($c) { + my $ce = $c->ce; + my $db = $c->db; + my $authz = $c->authz; + + my $setName = $c->stash('setID'); + my $problemNumber = $c->stash('problemID'); + my $userName = $c->param('user'); + my $effectiveUserName = $c->param('effectiveUser'); + my $key = $c->param('key'); + my $editMode = $c->param('editMode'); # We want to run the existing pre_header_initialize with # the database seed to get a pure copy of the original problem # to test against. - my $problemSeed = $r->param('problemSeed'); - $r->param('problemSeed', ''); + my $problemSeed = $c->param('problemSeed'); + $c->param('problemSeed', ''); # Run existsing initialization - await $self->SUPER::pre_header_initialize(); + await $c->SUPER::pre_header_initialize(); # This has to be set back because of sticky params. - $r->param('problemSeed', $problemSeed); - - my $user = $self->{user}; - my $effectiveUser = $self->{effectiveUser}; - my $set = $self->{set}; - my $problem = $self->{problem}; - my $displayMode = $self->{displayMode}; - my $redisplay = $self->{redisplay}; - my $submitAnswers = $self->{submitAnswers}; - my $checkAnswers = $self->{checkAnswers}; - my $previewAnswers = $self->{previewAnswers}; - my $formFields = $self->{formFields}; + $c->param('problemSeed', $problemSeed); + + my $user = $c->{user}; + my $effectiveUser = $c->{effectiveUser}; + my $set = $c->{set}; + my $problem = $c->{problem}; + my $displayMode = $c->{displayMode}; + my $redisplay = $c->{redisplay}; + my $submitAnswers = $c->{submitAnswers}; + my $checkAnswers = $c->{checkAnswers}; + my $previewAnswers = $c->{previewAnswers}; + my $formFields = $c->{formFields}; # a hash containing information for showMeAnother # active: has the button been pushed? @@ -87,7 +79,7 @@ async sub pre_header_initialize { && $ce->{pg}{options}{enableShowMeAnother} && ($problem->{showMeAnother} > -1 || $problem->{showMeAnother} == -2), CheckAnswers => $checkAnswers - && $r->param('showMeAnotherCheckAnswers') + && $c->param('showMeAnotherCheckAnswers') && $ce->{pg}{options}{enableShowMeAnother}, IsPossible => 1, TriesNeeded => $problem->{showMeAnother}, @@ -100,7 +92,7 @@ async sub pre_header_initialize { }, Count => $problem->{showMeAnotherCount}, Preview => $previewAnswers - && $r->param('showMeAnotherCheckAnswers') + && $c->param('showMeAnotherCheckAnswers') && $ce->{pg}{options}{enableShowMeAnother} ); @@ -113,29 +105,29 @@ async sub pre_header_initialize { # store the showMeAnother hash for the check to see if the button can be used # (this hash is updated and re-stored after the can, must, will hashes) - $self->{showMeAnother} = \%showMeAnother; + $c->{showMeAnother} = \%showMeAnother; # Show a message if we aren't allowed to show me another here. - unless ($self->can_showMeAnother($user, $effectiveUser, $set, $problem, 0)) { - $self->addbadmessage('You are not allowed to use Show Me Another for this problem.'); + unless ($c->can_showMeAnother($user, $effectiveUser, $set, $problem, 0)) { + $c->addbadmessage('You are not allowed to use Show Me Another for this problem.'); return; } - my $want = $self->{want}; + my $want = $c->{want}; $want->{showMeAnother} = 1; - my $must = $self->{must}; + my $must = $c->{must}; $must->{showMeAnother} = 0; # does the user have permission to use certain options? my @args = ($user, $effectiveUser, $set, $problem); - my $can = $self->{can}; - $can->{showMeAnother} = $self->can_showMeAnother(@args, $submitAnswers); + my $can = $c->{can}; + $can->{showMeAnother} = $c->can_showMeAnother(@args, $submitAnswers); # store text of original problem for later comparison with text from problem with new seed my $showMeAnotherOriginalPG = await renderPG( - $r, + $c, $effectiveUser, $set, $problem, $set->psvn, @@ -148,9 +140,9 @@ async sub pre_header_initialize { processAnswers => 0, permissionLevel => $db->getPermissionLevel($userName)->permission, effectivePermissionLevel => $db->getPermissionLevel($effectiveUserName)->permission, - useMathQuill => $self->{will}{useMathQuill}, - useMathView => $self->{will}{useMathView}, - useWirisEditor => $self->{will}{useWirisEditor}, + useMathQuill => $c->{will}{useMathQuill}, + useMathView => $c->{will}{useMathView}, + useWirisEditor => $c->{will}{useWirisEditor}, }, ); @@ -172,7 +164,7 @@ async sub pre_header_initialize { do { $newProblemSeed = int(rand(10000)) } until ($newProblemSeed != $oldProblemSeed); $problem->{problem_seed} = $newProblemSeed; my $showMeAnotherNewPG = await renderPG( - $r, + $c, $effectiveUser, $set, $problem, $set->psvn, @@ -185,9 +177,9 @@ async sub pre_header_initialize { processAnswers => 0, permissionLevel => $db->getPermissionLevel($userName)->permission, effectivePermissionLevel => $db->getPermissionLevel($effectiveUserName)->permission, - useMathQuill => $self->{will}{useMathQuill}, - useMathView => $self->{will}{useMathView}, - useWirisEditor => $self->{will}{useWirisEditor}, + useMathQuill => $c->{will}{useMathQuill}, + useMathView => $c->{will}{useMathView}, + useWirisEditor => $c->{will}{useWirisEditor}, }, ); @@ -232,7 +224,7 @@ async sub pre_header_initialize { #### One last check to see if students have hard coded in a key #### which matches the original problem my $showMeAnotherNewPG = await renderPG( - $r, + $c, $effectiveUser, $set, $problem, $set->psvn, @@ -245,9 +237,9 @@ async sub pre_header_initialize { processAnswers => 0, permissionLevel => $db->getPermissionLevel($userName)->permission, effectivePermissionLevel => $db->getPermissionLevel($effectiveUserName)->permission, - useMathQuill => $self->{will}{useMathQuill}, - useMathView => $self->{will}{useMathView}, - useWirisEditor => $self->{will}{useWirisEditor}, + useMathQuill => $c->{will}{useMathQuill}, + useMathView => $c->{will}{useMathView}, + useWirisEditor => $c->{will}{useWirisEditor}, }, ); @@ -279,13 +271,13 @@ async sub pre_header_initialize { $can->{checkAnswers} = $showMeAnother{options}{checkAnswers}; # If the user can see hints or solutions in the original problem, then the user is allowed to see them here # as well regardless of the SMA setting. - $can->{showHints} = $showMeAnother{options}{showHints} || $self->{can}{showHints}; - $can->{showSolutions} = $showMeAnother{options}{showSolutions} || $self->{can}{showSolutions}; + $can->{showHints} = $showMeAnother{options}{showHints} || $c->{can}{showHints}; + $can->{showSolutions} = $showMeAnother{options}{showSolutions} || $c->{can}{showSolutions}; } } # final values for options - my $will = $self->{will}; + my $will = $c->{will}; foreach (keys %$must) { $will->{$_} = $can->{$_} && ($want->{$_} || $must->{$_}); } @@ -295,7 +287,7 @@ async sub pre_header_initialize { debug('begin pg processing'); my $pg = await renderPG( - $r, + $c, $effectiveUser, $set, $problem, $set->psvn, @@ -308,9 +300,9 @@ async sub pre_header_initialize { processAnswers => 1, permissionLevel => $db->getPermissionLevel($userName)->permission, effectivePermissionLevel => $db->getPermissionLevel($effectiveUserName)->permission, - useMathQuill => $self->{will}{useMathQuill}, - useMathView => $self->{will}{useMathView}, - useWirisEditor => $self->{will}{useWirisEditor}, + useMathQuill => $c->{will}{useMathQuill}, + useMathView => $c->{will}{useMathView}, + useWirisEditor => $c->{will}{useWirisEditor}, forceScaffoldsOpen => 0, isInstructor => $authz->hasPermissions($userName, 'view_answers'), debuggingOptions => getTranslatorDebuggingOptions($authz, $userName) @@ -328,22 +320,21 @@ async sub pre_header_initialize { $can->{showSolutions} &&= $pg->{flags}{solutionExists}; # Record errors - $self->{pgdebug} = $pg->{debug_messages} if ref $pg->{debug_messages} eq 'ARRAY'; - $self->{pgwarning} = $pg->{warning_messages} if ref $pg->{warning_messages} eq 'ARRAY'; - $self->{pginternalerrors} = $pg->{internal_debug_messages} if ref $pg->{internal_debug_messages} eq 'ARRAY'; - # $self->{pgerrors} is defined if any of the above are defined, and is nonzero if any are non-empty. - $self->{pgerrors} = - @{ $self->{pgdebug} // [] } || @{ $self->{pgwarning} // [] } || @{ $self->{pginternalerrors} // [] } - if defined $self->{pgdebug} || defined $self->{pgwarning} || defined $self->{pginternalerrors}; - - # If $self->{pgerrors} is not defined, then the PG messages arrays were not defined, + $c->{pgdebug} = $pg->{debug_messages} if ref $pg->{debug_messages} eq 'ARRAY'; + $c->{pgwarning} = $pg->{warning_messages} if ref $pg->{warning_messages} eq 'ARRAY'; + $c->{pginternalerrors} = $pg->{internal_debug_messages} if ref $pg->{internal_debug_messages} eq 'ARRAY'; + # $c->{pgerrors} is defined if any of the above are defined, and is nonzero if any are non-empty. + $c->{pgerrors} = @{ $c->{pgdebug} // [] } || @{ $c->{pgwarning} // [] } || @{ $c->{pginternalerrors} // [] } + if defined $c->{pgdebug} || defined $c->{pgwarning} || defined $c->{pginternalerrors}; + + # If $c->{pgerrors} is not defined, then the PG messages arrays were not defined, # which means $pg->{pgcore} was not defined and the translator died. warn 'Processing of this PG problem was not completed. Probably because of a syntax error. ' . 'The translator died prematurely and no PG warning messages were transmitted.' - unless defined $self->{pgerrors}; + unless defined $c->{pgerrors}; - $self->{showMeAnother} = \%showMeAnother; - $self->{pg} = $pg; + $c->{showMeAnother} = \%showMeAnother; + $c->{pg} = $pg; return; } @@ -351,39 +342,36 @@ async sub pre_header_initialize { # We disable showOldAnswers because old answers are answers to the original # question and not to this question. -sub can_showOldAnswers { - +sub can_showOldAnswers ($c, $user, $effectiveUser, $set, $problem) { return 0; } -sub title { - my ($self) = @_; - my $r = $self->r; - my $db = $r->db; +sub page_title ($c) { + my $db = $c->db; # Using the url arguments won't break if the set/problem are invalid - my $setID = $self->r->urlpath->arg('setID'); - my $problemID = $self->r->urlpath->arg('problemID'); + my $setID = $c->stash('setID'); + my $problemID = $c->stash('problemID'); my $set = $db->getGlobalSet($setID); if ($set && $set->assignment_type eq 'jitar') { $problemID = join('.', jitar_id_to_seq($problemID)); } - my $header = $r->maketext('[_1]: Problem [_2] Show Me Another', - $r->tag('span', dir => 'ltr', format_set_name_display($setID)), $problemID); + my $header = $c->maketext('[_1]: Problem [_2] Show Me Another', + $c->tag('span', dir => 'ltr', format_set_name_display($setID)), $problemID); # Return here if we don't have the requisite information. - return $header if ($self->{invalidSet} || $self->{invalidProblem}); + return $header if ($c->{invalidSet} || $c->{invalidProblem}); - my $ce = $r->ce; - my $problem = $self->{problem}; + my $ce = $c->ce; + my $problem = $c->{problem}; my $subheader = ''; # FIXME: Should the show me another show points? my $problemValue = $problem->value; if (defined $problemValue) { - my $points = $problemValue == 1 ? $r->maketext('point') : $r->maketext('points'); + my $points = $problemValue == 1 ? $c->maketext('point') : $c->maketext('points'); $subheader .= "($problemValue $points)"; } @@ -396,7 +384,7 @@ sub title { $subheader .= ' ' . $problem->source_file; } - return $r->c($header, $r->tag('span', class => 'problem-sub-header d-block', $subheader))->join(''); + return $c->c($header, $c->tag('span', class => 'problem-sub-header d-block', $subheader))->join(''); } # If showMeAnother or check answers from showMeAnother is active, then don't show the navigation bar. @@ -405,77 +393,68 @@ sub nav { } # Output the body of the current problem -sub output_problem_body { - my $self = shift; - +sub output_problem_body ($c) { # Ignore body if SMA was pushed and no new problem will be shown. - return $self->SUPER::output_problem_body if $self->{will}{showMeAnother} && $self->{showMeAnother}{IsPossible}; + return $c->SUPER::output_problem_body if $c->{will}{showMeAnother} && $c->{showMeAnother}{IsPossible}; return ''; } # Output messages about the problem -sub output_message { - my $self = shift; - return $self->r->include('ContentGenerator/ShowMeAnother/messages'); +sub output_message ($c) { + return $c->include('ContentGenerator/ShowMeAnother/messages'); } # Prints out the checkbox input elements that are available for the current problem -sub output_checkboxes { - my $self = shift; - +sub output_checkboxes ($c) { # Skip check boxes if SMA was pushed and no new problem will be shown - return $self->SUPER::output_checkboxes if ($self->{showMeAnother}{IsPossible} && $self->{will}{showMeAnother}); + return $c->SUPER::output_checkboxes if $c->{showMeAnother}{IsPossible} && $c->{will}{showMeAnother}; return ''; } # Prints out the submit button input elements that are available for the current problem -sub output_submit_buttons { - my $self = shift; - +sub output_submit_buttons ($c) { # Skip buttons if SMA button has been pushed but there is no new problem shown - return $self->SUPER::output_submit_buttons if ($self->{showMeAnother}{IsPossible} && $self->{will}{showMeAnother}); + return $c->SUPER::output_submit_buttons if $c->{showMeAnother}{IsPossible} && $c->{will}{showMeAnother}; return ''; } # Outputs a summary of the student's current progress and status on the current problem -sub output_score_summary { +sub output_score_summary ($c) { # skip score summary return ''; } # Outputs the summary of the questions that the student has answered # for the current problem, along with available information about correctness -sub output_summary { - my $self = shift; - my $pg = $self->{pg}; - my %will = %{ $self->{will} }; - my %can = %{ $self->{can} }; - my %showMeAnother = %{ $self->{showMeAnother} }; - my $checkAnswers = $self->{checkAnswers}; - my $previewAnswers = $self->{previewAnswers}; - my $showPartialCorrectAnswers = $self->{pg}{flags}{showPartialCorrectAnswers}; - - my $r = $self->r; - my $ce = $r->ce; - my $db = $r->db; +sub output_summary ($c) { + my $pg = $c->{pg}; + my %will = %{ $c->{will} }; + my %can = %{ $c->{can} }; + my %showMeAnother = %{ $c->{showMeAnother} }; + my $checkAnswers = $c->{checkAnswers}; + my $previewAnswers = $c->{previewAnswers}; + my $showPartialCorrectAnswers = $c->{pg}{flags}{showPartialCorrectAnswers}; + + my $ce = $c->ce; + my $db = $c->db; # if $showMeAnother{Count} is somehow not an integer, make it one $showMeAnother{Count} = 0 unless ($showMeAnother{Count} =~ /^[+-]?\d+$/); - my $output = $r->c; + my $output = $c->c; if ($will{checkAnswers}) { if ($showMeAnother{CheckAnswers} && $can{showMeAnother}) { # if the student is checking answers to a new problem, give them a reminder that they are doing so push( @$output, - $r->tag( + $c->tag( 'div', class => 'showMeAnotherBox', - $r->maketext( + $c->maketext( 'You are currently checking answers to a different version of your problem - these ' . 'will not be recorded, and you should remember to return to your original problem ' . 'once you are done here.' @@ -488,10 +467,10 @@ sub output_summary { if ($showMeAnother{Preview} && $can{showMeAnother}) { push( @$output, - $r->tag( + $c->tag( 'div', class => 'showMeAnotherBox', - $r->maketext( + $c->maketext( 'You are currently previewing answers to a different version of your problem - these ' . 'will not be recorded, and you should remember to return to your original problem ' . 'once you are done here.' @@ -503,7 +482,7 @@ sub output_summary { # the feedback varies a little bit if Check Answers is available or not my $checkAnswersAvailable = ($showMeAnother{options}->{checkAnswers}) - ? $r->maketext('You may check your answers to this problem without affecting ' + ? $c->maketext('You may check your answers to this problem without affecting ' . 'the maximum number of tries to your original problem.') : ''; my $solutionShown = ''; @@ -512,45 +491,45 @@ sub output_summary { if ($showMeAnother{Count} <= $showMeAnother{MaxReps} || ($showMeAnother{MaxReps} == -1)) { # check to see if a solution exists for this problem, and vary the feedback accordingly if ($pg->{flags}{solutionExists} && $showMeAnother{options}->{showSolutions}) { - $solutionShown = $r->maketext('There is a written solution available.'); + $solutionShown = $c->maketext('There is a written solution available.'); } elsif ($showMeAnother{options}->{showSolutions} and $showMeAnother{options}->{showCorrect} and $showMeAnother{options}->{checkAnswers}) { - $solutionShown = $r->maketext('There is no written solution available for this problem, ' + $solutionShown = $c->maketext('There is no written solution available for this problem, ' . 'but you can still view the correct answers.'); } elsif ($showMeAnother{options}->{showSolutions}) { - $solutionShown = $r->maketext('There is no written solution available for this problem.'); + $solutionShown = $c->maketext('There is no written solution available for this problem.'); } } push( @$output, - $r->tag( + $c->tag( 'div', class => 'showMeAnotherBox', - $r->c( - $r->maketext('Here is a new version of your problem.'), $solutionShown, + $c->c( + $c->maketext('Here is a new version of your problem.'), $solutionShown, $checkAnswersAvailable )->join(' ') ), - $r->tag( + $c->tag( 'div', class => 'ResultsAlert', - $r->maketext(q{Remember to return to your original problem when you're finished here!}) + $c->maketext(q{Remember to return to your original problem when you're finished here!}) ) ); } elsif ($showMeAnother{active} && $showMeAnother{IsPossible} && !$can{showMeAnother}) { if ($showMeAnother{Count} >= $showMeAnother{MaxReps}) { my $solutionShown = ($showMeAnother{options}->{showSolutions} && $pg->{flags}{solutionExists}) - ? $r->maketext('The solution has been removed.') + ? $c->maketext('The solution has been removed.') : ''; push( @$output, - $r->tag( + $c->tag( 'div', class => 'ResultsAlert', - $r->maketext( + $c->maketext( 'You are only allowed to click on Show Me Another [quant,_1,time,times] per problem. ' . '[_2] Close this tab, and return to the original problem.', $showMeAnother{MaxReps}, @@ -561,10 +540,10 @@ sub output_summary { } elsif ($showMeAnother{Count} < $showMeAnother{TriesNeeded}) { push( @$output, - $r->tag( + $c->tag( 'div', class => 'ResultsAlert', - $r->maketext( + $c->maketext( 'You must attempt this problem [quant,_1,time,times] before Show Me Another is available.', $showMeAnother{TriesNeeded} ) @@ -576,10 +555,10 @@ sub output_summary { # find a new version of the problem push( @$output, - $r->tag( + $c->tag( 'div', class => 'ResultsAlert', - $r->maketext( + $c->maketext( 'WeBWorK was unable to generate a different version of this problem. ' . 'Close this tab, and return to the original problem.' ) @@ -588,34 +567,31 @@ sub output_summary { } if ($showMeAnother{IsPossible} && $will{showMeAnother}) { - push(@$output, $self->SUPER::output_summary); + push(@$output, $c->SUPER::output_summary); } return $output->join(''); } -sub output_comments { +sub output_comments ($c) { # skip instructor comments. return ''; } -sub output_grader { +sub output_grader ($c) { # skip instructor grader. return ''; } # Outputs the hidden fields required for the form -sub output_hidden_info { - my $self = shift; - my $r = $self->r; - +sub output_hidden_info ($c) { # Hidden field for clicking Preview Answers and Check Answers from a Show Me Another screen. # It needs to send the seed from showMeAnother back to the screen. - if ($self->{showMeAnother}{active} || $self->{showMeAnother}{CheckAnswers} || $self->{showMeAnother}{Preview}) { - return $r->c( - $r->hidden_field(showMeAnotherCheckAnswers => 1, id => 'showMeAnotherCheckAnswers_id'), + if ($c->{showMeAnother}{active} || $c->{showMeAnother}{CheckAnswers} || $c->{showMeAnother}{Preview}) { + return $c->c( + $c->hidden_field(showMeAnotherCheckAnswers => 1, id => 'showMeAnotherCheckAnswers_id'), # Output the problem seed from ShowMeAnother so that it can be used in Check Answers. - $r->hidden_field(problemSeed => $self->{problem}->problem_seed) + $c->hidden_field(problemSeed => $c->{problem}->problem_seed) )->join(''); } diff --git a/lib/WeBWorK/ContentGenerator/Skeleton.pm b/lib/WeBWorK/ContentGenerator/Skeleton.pm index 7d28a9a823..286628242c 100644 --- a/lib/WeBWorK/ContentGenerator/Skeleton.pm +++ b/lib/WeBWorK/ContentGenerator/Skeleton.pm @@ -25,7 +25,10 @@ # SKEL: Declare the name and superclass of your module here: package WeBWorK::ContentGenerator::Skeleton; -use parent qw(WeBWorK::ContentGenerator); +use Mojo::Base 'WeBWorK::ContentGenerator', -signatures; + +# Add '-async_await' above if needed. This is needed anytime a problem is +# rendered. # SKEL: change the name of the module below and provide a short description. Add # additional POD documentation as you see fit. @@ -39,32 +42,25 @@ the main body of the page. =cut -use strict; -use warnings; - # SKEL: Add "use" lines for libraries you will be using here. Note that you only # need to add a "use" line here if you will be instantiating now objects or -# calling free functions. If you have an existing instance (like $self->r) you +# calling free functions. If you have an existing instance (like $self->c) you # can use it without a corresponding "use" line. Sample lines are given below: # # You might need some utility functions: #use WeBWorK::Utils qw(function1 function2); # SKEL: If you need to do any processing before the HTTP header is sent, do it -# in this method: -# -#sub pre_header_initialize { -# my ($self) = @_; +# in this method. Note that this method may be async. # +#sub pre_header_initialize ($c) { # # Do your processing here! Don't print or return anything -- store data in -# # the self hash for later retrieveal. +# # the $c hash or in $c->stash for later retrieveal. #} # SKEL: This method is not actually of any use anymore. # -#sub header { -# my ($self) = @_; -# +#sub header ($c) { # # The return value of this method is not used. # # The practice is to return the status code of the response. # return 0; @@ -72,13 +68,12 @@ use warnings; # SKEL: If you need to do any processing after the HTTP header is sent, but before # any template processing occurs, or you need to calculate values that will be -# used in multiple methods, do it in this method: -# -#sub initialize { -# my ($self) = @_; +# used in multiple methods, do it in this method. Note that this method may be +# async. # +#sub initialize ($c) { # # Do your processing here! Don't print or return anything -- store data in -# # the self hash for later retrieveal. +# # the $c hash or in $c->stash for later retrieveal. #} # Note that all of the template methods below except head should ensure that the @@ -86,9 +81,7 @@ use warnings; # SKEL: If you need to add tags to the document , uncomment this method: # -#sub head { -# my ($self) = @_; -# +#sub head ($c) { # my $output = ''; # # You can append head tags to $output, like , - - - - -

      Example of embedding WeBWorK problems in HTML pages.

      -

      Problem 1

      -

      -This problem will help you to understand averages. -

      -
      - Click here to show problem1 -
      - - -

      Problem 2

      -

      -This problem gives you practice finding tangents to curves in the plane. -

      - -
      - Click here to show problem 2 -
      - - -

      Problem 3

      -

      -This is for debugging and shows all the details of the hash returned by PG. -

      - -
      - Click here to show problem 3 -
      - - -

      Problem 4

      -

      -This contains embedded PG code in base64 format. -

      -
      - Click here to show problem 4 -
      - - - \ No newline at end of file diff --git a/clients/t/test_formats_WWproblems.html b/clients/t/test_formats_WWproblems.html deleted file mode 100644 index 1f37c23dbf..0000000000 --- a/clients/t/test_formats_WWproblems.html +++ /dev/null @@ -1,106 +0,0 @@ - - - - - test formats for embedded problems - - - - -

      Format: sticky

      -

      -

      Format: standard (has error section -- but there should be no errors)

      -

      - -

      Format: simple

      -

      - -

      Format: body_text

      -

      - -

      Format: PTX

      -

      - -

      Format: JSON

      -

      - - - diff --git a/clients/t/test_simpleFormat_WWproblem.html b/clients/t/test_simpleFormat_WWproblem.html deleted file mode 100644 index 079cd45992..0000000000 --- a/clients/t/test_simpleFormat_WWproblem.html +++ /dev/null @@ -1,64 +0,0 @@ - - - - - Embed WW in HTML page - - - - - - - - - - -

      Problem 1-- xmlrpc version of a simple template

      -

      -Problem is rendered at daemon_course -- no student information is retained. -

      -
      - - -
      -

      Problem 2 -- webwork2 version of a simple template

      -

      -Direct access using RESTful url. Sign in is necessary and score is recorded. -

      -
      - -
      - - diff --git a/clients/t/test_toggled_embedded_WWproblems.html b/clients/t/test_toggled_embedded_WWproblems.html deleted file mode 100644 index 2587e2726f..0000000000 --- a/clients/t/test_toggled_embedded_WWproblems.html +++ /dev/null @@ -1,202 +0,0 @@ - - - - - Embedded WeBWorK Problems - - - - - - - - - - - - -

      Embedded WeBWorK Problems

      -

      -Problem 1 -- interval notation -

      - -
      - Click here to toggle problem display -
      - -

      -Problem 2 -- integration. Contains a Geogebra applet -

      - -
      - Click here to toggle problem display -
      - - -

      -Problem 3 -- the pg code for this problem is embedded in the html text using base64 encoding -

      - -
      - Click here to toggle problem display -
      - - -

      -Problem 4 -- PG lab. Enter PG code to test out here. -

      - -
      - Click here to toggle problem display -
      - - - - -

      -Problem 5 -- debug -- This problem is useful for debugging and shows all the details of the hash returned by PG. -

      - -
      - Click here to toggle problem display -
      - - -

      -Problem 6 -- A logic problem contributed from Montana State University. There -is a link "contribLibrary" in the daemon course to the "Contrib" library. See -http://github.com/openwebwork/webwork-open-problem-library -to see which problems are available in the OpenProblemLibrary and in Contrib. You can -also use the library browser to find the problems available in the OPL. - -

      - -
      - Click here to toggle problem display -
      - -
      -
      - Click here to toggle problem display: (PGinfo example) -
      - -
      - <%= label_for rows => maketext('Editor rows:'), - class => 'col-3 col-form-label col-form-label-sm' =%> -
      - <%= text_field rows => $c->{rows}, id => 'rows', size => 3, - class => 'form-control form-control-sm d-inline w-auto' =%> -
      -
      - <%= submit_button maketext('Update settings and refresh page'), - name => 'updateSettings', class => 'btn btn-secondary btn-sm' =%> -
      -
      <%= radio_button send_to => 'all_students', id => 'send_to_all', class => 'form-check-input' =%> <%= label_for send_to_all => maketext('Send to all students'), class => 'form-check-label' =%>
      -
      +
      <%= radio_button send_to => 'studentID', id => 'send_to_selected', class => 'form-check-input', checked => undef =%> - <%= label_for send_to_selected => maketext('Send to the students selected below'), + <%= label_for send_to_selected => maketext('Send to selected students'), class => 'form-check-label' =%>
      +
      + <%= submit_button maketext('Preview Message'), + name => 'previewMessage', class => 'btn btn-secondary btn-sm' =%> +
      +
      + <%= submit_button maketext('Send Email'), name => 'sendEmail', + class => 'btn btn-secondary btn-sm d-inline w-auto' =%> +
      + % # Insert a toast containing a list of available macros. +
      + +
      +
      + +
      +
      +
      +
      + <%= maketext('Students') %> +
      <%= scrollingRecordList( { @@ -92,67 +122,27 @@ default_sort => 'lnfn', default_format => 'lnfn_uid', default_filters => ['all'], - refresh_button_name => maketext('Update settings and refresh page'), + refresh_button_name => maketext('Change Display Settings'), attrs => { size => 5, multiple => undef } }, @{ $c->{ra_user_records} } ) =%>
      - % my $preview_record = $db->getUser($c->{preview_user}); - % if ($preview_record) { -
      - <%= submit_button maketext('Preview Message'), - name => 'previewMessage', class => 'btn btn-secondary btn-sm' =%> - - <%= maketext('for') %> -  <%= $preview_record->last_name %>, <%= $preview_record->first_name %> - (<%= $preview_record->user_id %>) - -
      - % } -
      -
      - % # Insert a toast containing a list of available macros. -
      - -
      -
      -
      % % # Merge file fragment and message text area field + % if ($merge_file ne 'None') { +
      + <%= maketext('Viewing data from merge file [_1] for user [_2].', $merge_file, $c->{preview_user}) =%> +
      + % } % my $rh_merge_data = $c->read_scoring_file($merge_file); % my @merge_data = eval { @{ $rh_merge_data->{ $db->getUser($c->{preview_user})->student_id } } }; % if ($@ && $merge_file ne 'None') { -
      <%= "No merge data for $c->{preview_user} in merge file: $merge_file" =%>
      +
      <%= maketext('No merge data found.') =%>
      % } elsif (@merge_data) { 
      <%== join('', ' ', $c->data_format(1 .. ($#merge_data + 1))) =%>\
 			
      <% =%>\
@@ -171,16 +161,12 @@
 		<% end =%>
 		<%= text_area body =>
 			defined $c->{r_text} ? ${ $c->{r_text} } : 'FIXME no text was produced by initialization!',
-			id => 'email-body', rows => $c->{rows}, class => 'form-control' %>
+			id => 'email-body', rows => $ce->{mail}->{editor_window_rows}, class => 'form-control' %>
      % % # Action buttons
      -
      - <%= submit_button maketext('Send Email'), name => 'sendEmail', - class => 'btn btn-secondary btn-sm d-inline w-auto' =%> -
      <%= submit_button maketext('Save'), name => 'saveMessage', class => 'btn btn-secondary btn-sm' =%> <%= maketext('to') . ' ' . $c->{output_file} %> diff --git a/templates/ContentGenerator/Instructor/SendMail/preview.html.ep b/templates/ContentGenerator/Instructor/SendMail/preview.html.ep index 9262093155..610b93e9aa 100644 --- a/templates/ContentGenerator/Instructor/SendMail/preview.html.ep +++ b/templates/ContentGenerator/Instructor/SendMail/preview.html.ep @@ -1,6 +1,7 @@

      <%= maketext('This sample mail would be sent to [_1]', $ur->email_address) %>

      <%= $msg %>

      <%= maketext('Merge file data:') %>

      +

      <%= maketext('Showing data from merge file: [_1]', $c->{merge_file}) %>

      <%== $preview_header %>
      % if (@{ $c->{ra_send_to} }) {

      <%= maketext('Emails to be sent to the following:') %>

      From edc94030f457413358fd602e8f30645925adff12 Mon Sep 17 00:00:00 2001 From: Glenn Rice Date: Sun, 14 May 2023 20:09:07 -0500 Subject: [PATCH 254/490] Add the "Preview Message for ..." back. Javascript ensures that the shown user is the one that the actual preview will be generated for. I don't like removing useful information in the UI. If it doesn't work right fix it. Don't remove it. --- htdocs/js/apps/SendMail/sendmail.js | 11 +++++ .../ContentGenerator/Instructor/SendMail.pm | 45 +++++++++---------- .../Instructor/SendMail.html.ep | 6 +++ .../Instructor/SendMail/main_form.html.ep | 25 ++++++++--- 4 files changed, 57 insertions(+), 30 deletions(-) create mode 100644 htdocs/js/apps/SendMail/sendmail.js diff --git a/htdocs/js/apps/SendMail/sendmail.js b/htdocs/js/apps/SendMail/sendmail.js new file mode 100644 index 0000000000..763155d5fb --- /dev/null +++ b/htdocs/js/apps/SendMail/sendmail.js @@ -0,0 +1,11 @@ +(() => { + const previewUserNameSpan = document.getElementById('preview-user'); + if (previewUserNameSpan) { + const classListSelect = document.getElementById('classList'); + classListSelect?.addEventListener('change', () => { + if (classListSelect.selectedIndex !== -1) + previewUserNameSpan.textContent = classListSelect.options[classListSelect.selectedIndex].textContent; + else previewUserNameSpan.textContent = previewUserNameSpan.dataset.default; + }); + } +})(); diff --git a/lib/WeBWorK/ContentGenerator/Instructor/SendMail.pm b/lib/WeBWorK/ContentGenerator/Instructor/SendMail.pm index 498339f417..b9ad6058fd 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/SendMail.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/SendMail.pm @@ -96,16 +96,17 @@ sub initialize ($c) { my $ur = $db->getUser($user); # Store data - $c->{defaultFrom} = $ur->rfc822_mailbox; - $c->{defaultReply} = $ur->rfc822_mailbox; - $c->{defaultSubject} = $c->stash('courseID') . ' notice'; + $c->{defaultPreviewUser} = $ur; + $c->{defaultFrom} = $ur->rfc822_mailbox; + $c->{defaultReply} = $ur->rfc822_mailbox; + $c->{defaultSubject} = $c->stash('courseID') . ' notice'; $c->{default_msg_file} = $default_msg_file; $c->{old_default_msg_file} = $old_default_msg_file; $c->{merge_file} = $mergefile; my @classList = (defined($c->param('classList'))) ? $c->param('classList') : ($user); - $c->{preview_user} = $classList[0] || $user; + $c->{preview_user} = $c->db->getUser($classList[0] || $user); # Gather database data # Get all users except set level proctors and practice users. If the current user has restrictions on viewable @@ -217,10 +218,10 @@ sub initialize ($c) { my ($from, $replyTo, $r_text, $subject); if ($input_source eq 'file') { ($from, $replyTo, $subject, $r_text) = $c->read_input_file("$emailDirectory/$input_file"); - $c->param('from', $from) if $from; - $c->param('replyTo', $replyTo) if $replyTo; - $c->param('subject', $subject) if $subject; - $c->param('body', ${$r_text}) if $r_text; + $c->param('from', $from) if $from; + $c->param('replyTo', $replyTo) if $replyTo; + $c->param('subject', $subject) if $subject; + $c->param('body', $$r_text) if $r_text; } elsif ($input_source eq 'form') { # read info from the form # bail if there is no message body @@ -376,28 +377,26 @@ sub initialize ($c) { } sub print_preview ($c) { - # Get preview user - my $ur = $c->db->getUser($c->{preview_user}); - die "record for preview user " . $c->{preview_user} . " not found." unless $ur; + die "record for preview user " . $c->{preview_user} . " not found." unless $c->{preview_user}; # Get merge file my $merge_file = (defined($c->{merge_file})) ? $c->{merge_file} : 'None'; my $rh_merge_data = $c->read_scoring_file($merge_file); - if (($c->{merge_file} // 'None') ne 'None' && !defined $rh_merge_data->{ $ur->student_id }) { + if (($c->{merge_file} // 'None') ne 'None' && !defined $rh_merge_data->{ $c->{preview_user}->student_id }) { $c->addbadmessage('No merge data for student id: ' - . $ur->student_id + . $c->{preview_user}->student_id . '; name: ' - . $ur->first_name . ' ' - . $ur->last_name + . $c->{preview_user}->first_name . ' ' + . $c->{preview_user}->last_name . '; login: ' - . $ur->user_id); + . $c->{preview_user}->user_id); } my ($msg, $preview_header) = processEmailMessage( ${ $c->{r_text} // \'' }, - $ur, $c->ce->status_abbrev_to_name($ur->status), - $rh_merge_data, 1 + $c->{preview_user}, $c->ce->status_abbrev_to_name($c->{preview_user}->status), + $rh_merge_data, 1 ); # The content in message is going to be displayed in HTML. @@ -405,10 +404,10 @@ sub print_preview ($c) { # Note that this escaping is done in the Mojolicious template automatically. $msg = join( "", - "To: ", $ur->email_address, "\n", - "From: ", $c->{from}, "\n", - "Reply-To: ", $c->{replyTo}, "\n", - "Subject: ", $c->{subject}, "\n", + "To: ", $c->{preview_user}->email_address, "\n", + "From: ", $c->{from}, "\n", + "Reply-To: ", $c->{replyTo}, "\n", + "Subject: ", $c->{subject}, "\n", # In a real mails we would UTF-8 encode the message and give the Content-Type header. For the preview which is # displayed as html, just add the header, but do NOT use Encode::encode("UTF-8",$msg). "Content-Type: text/plain; charset=UTF-8\n\n", @@ -419,7 +418,7 @@ sub print_preview ($c) { return $c->include( 'ContentGenerator/Instructor/SendMail/preview', preview_header => $preview_header, - ur => $ur, + ur => $c->{preview_user}, msg => $msg, recipients => join(" ", @{ $c->{ra_send_to} }) ); diff --git a/templates/ContentGenerator/Instructor/SendMail.html.ep b/templates/ContentGenerator/Instructor/SendMail.html.ep index 84f7743c77..c14ce6d1af 100644 --- a/templates/ContentGenerator/Instructor/SendMail.html.ep +++ b/templates/ContentGenerator/Instructor/SendMail.html.ep @@ -1,3 +1,9 @@ +% use WeBWorK::Utils qw(getAssetURL); +% +% content_for js => begin + <%= javascript getAssetURL($ce, 'js/apps/SendMail/sendmail.js'), defer => undef =%> +% end +% % unless ($authz->hasPermissions(param('user'), 'access_instructor_tools')) {
      <%= maketext('You are not authorized to access instructor tools') %>
      % last; diff --git a/templates/ContentGenerator/Instructor/SendMail/main_form.html.ep b/templates/ContentGenerator/Instructor/SendMail/main_form.html.ep index b38fcd1123..9573effdf0 100644 --- a/templates/ContentGenerator/Instructor/SendMail/main_form.html.ep +++ b/templates/ContentGenerator/Instructor/SendMail/main_form.html.ep @@ -66,10 +66,21 @@ <%= label_for send_to_selected => maketext('Send to selected students'), class => 'form-check-label' =%>
      -
      - <%= submit_button maketext('Preview Message'), + % if ($c->{preview_user}) { +
      + <%= submit_button maketext('Preview Message'), name => 'previewMessage', class => 'btn btn-secondary btn-sm' =%> -
      + + <%= maketext('for') %>  + + <%= $c->{preview_user}->last_name . ', ' . $c->{preview_user}->first_name + . ' (' . $c->{preview_user}->user_id . ')' =%> + + +
      + % }
      <%= submit_button maketext('Send Email'), name => 'sendEmail', class => 'btn btn-secondary btn-sm d-inline w-auto' =%> @@ -136,11 +147,12 @@ % # Merge file fragment and message text area field % if ($merge_file ne 'None') {
      - <%= maketext('Viewing data from merge file [_1] for user [_2].', $merge_file, $c->{preview_user}) =%> + <%= maketext('Viewing data from merge file [_1] for user [_2].', + $merge_file, $c->{preview_user}->user_id) =%>
      % } % my $rh_merge_data = $c->read_scoring_file($merge_file); - % my @merge_data = eval { @{ $rh_merge_data->{ $db->getUser($c->{preview_user})->student_id } } }; + % my @merge_data = eval { @{ $rh_merge_data->{ $c->{preview_user}->student_id } } }; % if ($@ && $merge_file ne 'None') {
      <%= maketext('No merge data found.') =%>
      % } elsif (@merge_data) { @@ -159,8 +171,7 @@ <%= label_for 'email-body', class => 'form-label', begin =%> <%= maketext("Email Body:") %>* <% end =%> - <%= text_area body => - defined $c->{r_text} ? ${ $c->{r_text} } : 'FIXME no text was produced by initialization!', + <%= text_area body => $c->{r_text} // 'FIXME no text was produced by initialization!', id => 'email-body', rows => $ce->{mail}->{editor_window_rows}, class => 'form-control' %>
      % From 7e590c3af395c8e00e5c7ee0063bc1d3213edf58 Mon Sep 17 00:00:00 2001 From: Glenn Rice Date: Sun, 14 May 2023 20:50:34 -0500 Subject: [PATCH 255/490] Remove the message file "Open" button and the merge file "View" button. Instead trigger the opening of the message file or merge file by javascript immediately when the selects are changed. --- htdocs/js/apps/SendMail/sendmail.js | 16 ++++++++++++++++ .../Instructor/SendMail/main_form.html.ep | 4 +--- 2 files changed, 17 insertions(+), 3 deletions(-) diff --git a/htdocs/js/apps/SendMail/sendmail.js b/htdocs/js/apps/SendMail/sendmail.js index 763155d5fb..e1d25ad8ad 100644 --- a/htdocs/js/apps/SendMail/sendmail.js +++ b/htdocs/js/apps/SendMail/sendmail.js @@ -8,4 +8,20 @@ else previewUserNameSpan.textContent = previewUserNameSpan.dataset.default; }); } + + for (const select of [ + ['openfilename', 'openMessage'], + ['merge_file', 'viewMergeFile'] + ]) { + document.getElementById(select[0])?.addEventListener('change', () => { + const mailForm = document.forms['mail-main-form']; + if (!mailForm) return; + const submit = document.createElement('input'); + submit.type = 'submit'; + submit.name = select[1]; + submit.style.display = 'none'; + mailForm.append(submit); + submit.click(); + }); + } })(); diff --git a/templates/ContentGenerator/Instructor/SendMail/main_form.html.ep b/templates/ContentGenerator/Instructor/SendMail/main_form.html.ep index 9573effdf0..21025813e1 100644 --- a/templates/ContentGenerator/Instructor/SendMail/main_form.html.ep +++ b/templates/ContentGenerator/Instructor/SendMail/main_form.html.ep @@ -2,7 +2,7 @@ % % my $merge_file = $c->{merge_file} // 'None'; % -<%= form_for current_route, method => 'post', begin =%> +<%= form_for current_route, id => 'mail-main-form', method => 'post', begin =%> <%= $c->hidden_authen_fields =%> % % # Email settings @@ -19,7 +19,6 @@ $c->get_message_file_names ], id => 'openfilename', class => 'form-select form-select-sm' =%> - <%= submit_button maketext('Open'), name => 'openMessage', class => 'btn btn-secondary' =%>
      <%= label_for 'merge_file', class => 'input-group-text', begin =%> @@ -30,7 +29,6 @@ $c->get_merge_file_names ], id => 'merge_file', class => 'form-select form-select-sm' =%> - <%= submit_button maketext('View'), name => 'viewMergeFile', class => 'btn btn-secondary' =%>
      <%= label_for from => maketext('From:'), From bf4e36e1e2d35fc10c940c2b122dab0d95194e21 Mon Sep 17 00:00:00 2001 From: Jaimos Skriletz Date: Sun, 14 May 2023 22:15:04 -0600 Subject: [PATCH 256/490] Remove save as default and update UI if no valid message file is found. Since the last selected message file is saved in the database, there is no need for a special default.msg file or a button to create one. Remove this button. If an invalid (or no) message file is found, add a selected 'None' option to to the drop down menu for the message file, remove the save button, and set the Save As file name to 'default.msg'. --- .../ContentGenerator/Instructor/SendMail.pm | 37 +++---------------- .../Instructor/SendMail/main_form.html.ep | 26 ++++++------- 2 files changed, 18 insertions(+), 45 deletions(-) diff --git a/lib/WeBWorK/ContentGenerator/Instructor/SendMail.pm b/lib/WeBWorK/ContentGenerator/Instructor/SendMail.pm index b9ad6058fd..57235be6f5 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/SendMail.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/SendMail.pm @@ -55,10 +55,6 @@ sub initialize ($c) { my $savefilename = $c->param('savefilename'); my $mergefile = $c->param('merge_file'); - #FIXME get these values from global course environment (see subroutines as well) - my $default_msg_file = 'default.msg'; - my $old_default_msg_file = 'old_default.msg'; - #if mergefile or openfilename haven't been defined via parameter # check the database to see if there is a file we should use. # if they have been defined via parameter then we should update the db @@ -84,8 +80,6 @@ sub initialize ($c) { $action = 'saveMessage'; } elsif ($c->param('saveAs')) { $action = 'saveAs'; - } elsif ($c->param('saveDefault')) { - $action = 'saveDefault'; } elsif ($c->param('openMessage')) { $action = 'openMessage'; } elsif ($c->param('previewMessage')) { @@ -100,10 +94,7 @@ sub initialize ($c) { $c->{defaultFrom} = $ur->rfc822_mailbox; $c->{defaultReply} = $ur->rfc822_mailbox; $c->{defaultSubject} = $c->stash('courseID') . ' notice'; - - $c->{default_msg_file} = $default_msg_file; - $c->{old_default_msg_file} = $old_default_msg_file; - $c->{merge_file} = $mergefile; + $c->{merge_file} = $mergefile; my @classList = (defined($c->param('classList'))) ? $c->param('classList') : ($user); $c->{preview_user} = $c->db->getUser($classList[0] || $user); @@ -146,7 +137,6 @@ sub initialize ($c) { # Check the validity of the input file name my $input_file = ''; # Make sure an input message file was submitted and exists. - # Otherwise use the default message. if (defined($openfilename)) { if (-e "${emailDirectory}/$openfilename") { if (-R "${emailDirectory}/$openfilename") { @@ -159,32 +149,25 @@ sub initialize ($c) { )); } } else { - $input_file = $default_msg_file; $c->addbadmessage($c->maketext( 'The file [_1] cannot be found. ' . 'Check whether it exists and whether the directory [_2] can be read by the webserver. ', "$emailDirectory/$openfilename", $emailDirectory )); - $c->addbadmessage($c->maketext('Using contents of the default message [_1] instead.', $default_msg_file)); } - } else { - $input_file = $default_msg_file; } $c->{input_file} = $input_file; # Determine the file name to save message into my $output_file = 'FIXME no output file specified'; - if ($action eq 'saveDefault') { - $output_file = $default_msg_file; - $c->param('openfilename', $output_file); - } elsif ($action eq 'saveMessage' or $action eq 'saveAs') { + if ($action eq 'saveMessage' or $action eq 'saveAs') { if (defined($savefilename) and $savefilename) { $output_file = $savefilename; } else { $c->addbadmessage($c->maketext('No filename was specified for saving! The message was not saved.')); } - } elsif (defined($input_file)) { + } else { $output_file = $input_file; } @@ -196,7 +179,7 @@ sub initialize ($c) { . 'Please specify a different file or move the needed file to the email directory.' )); } - unless ($output_file =~ m|\.msg$|) { + if ($output_file && $output_file !~ m|\.msg$|) { $c->addbadmessage($c->maketext( 'Invalid file name "[_1]". All email file names must end with the ".msg" extension. ' . 'Choose a file name with the ".msg" extension. The message was not saved.', @@ -248,11 +231,9 @@ sub initialize ($c) { #Determine the appropriate script action from the buttons # first time actions # open new file - # open default file # save actions # "save" button # "save as" button - # "save as default" button # preview actions # 'preview' button # email actions @@ -269,7 +250,7 @@ sub initialize ($c) { # If form is submitted deal with filled out forms # and various actions resulting from different buttons - if ($action eq 'saveMessage' or $action eq 'saveAs' or $action eq 'saveDefault') { + if ($action eq 'saveMessage' or $action eq 'saveAs') { # construct message body my $temp_body = ${$r_text}; @@ -294,14 +275,6 @@ sub initialize ($c) { return; } - # Back up existing file? - if ($action eq 'saveDefault' and -e "$emailDirectory/$default_msg_file") { - rename("$emailDirectory/$default_msg_file", "$emailDirectory/$old_default_msg_file") - or die "Can't rename $emailDirectory/$default_msg_file to $emailDirectory/$old_default_msg_file ", - "Check permissions for webserver on directory $emailDirectory. $!"; - $c->addgoodmessage($c->maketext('Backup file [_1] created.', "$emailDirectory/$old_default_msg_file"),); - } - # Save the message $c->saveMessageFile($temp_body, "${emailDirectory}/$output_file") unless ($output_file =~ /^[~.]/ || $output_file =~ /\.\./ || $output_file !~ m|\.msg$|); diff --git a/templates/ContentGenerator/Instructor/SendMail/main_form.html.ep b/templates/ContentGenerator/Instructor/SendMail/main_form.html.ep index 21025813e1..9f19cba672 100644 --- a/templates/ContentGenerator/Instructor/SendMail/main_form.html.ep +++ b/templates/ContentGenerator/Instructor/SendMail/main_form.html.ep @@ -15,8 +15,10 @@ <%= maketext('Message file:') %> <% end =%> <%= select_field openfilename => [ - map { [ $_ => $_, $_ eq $c->{input_file} ? (selected => undef) : () ] } - $c->get_message_file_names + map { [ + $_ => $_, ($_ eq 'None' || $_ eq $c->{input_file}) ? (selected => undef) : () + ] } + ($c->{input_file} ? () : 'None', $c->get_message_file_names) ], id => 'openfilename', class => 'form-select form-select-sm' =%>
      @@ -169,26 +171,24 @@ <%= label_for 'email-body', class => 'form-label', begin =%> <%= maketext("Email Body:") %>* <% end =%> - <%= text_area body => $c->{r_text} // 'FIXME no text was produced by initialization!', + <%= text_area body => $c->{r_text}, id => 'email-body', rows => $ce->{mail}->{editor_window_rows}, class => 'form-control' %>
      % % # Action buttons
      -
      - <%= submit_button maketext('Save'), name => 'saveMessage', class => 'btn btn-secondary btn-sm' =%> - <%= maketext('to') . ' ' . $c->{output_file} %> -
      + % if ($c->{input_file}) { +
      + <%= submit_button maketext('Save'), name => 'saveMessage', class => 'btn btn-secondary btn-sm' =%> + <%= maketext('to') . ' ' . $c->{output_file} %> +
      + % }
      <%= submit_button maketext('Save as') . ':', name => 'saveAs', id => 'saveAs', class => 'btn btn-secondary btn-sm' =%> - <%= text_field savefilename => $c->{output_file}, size => 20, - class => 'form-control form-control-sm', 'aria-labelledby' => 'saveAs' =%> -
      -
      - <%= submit_button maketext('Save as Default'), name => 'saveDefault', - class => 'btn btn-secondary btn-sm' =%> + <%= text_field savefilename => $c->{output_file} ? $c->{output_file} : 'default.msg', + size => 20, class => 'form-control form-control-sm', 'aria-labelledby' => 'saveAs' =%>
      From ecfa61816755f333a8421749292ff1058b516dd0 Mon Sep 17 00:00:00 2001 From: Jaimos Skriletz Date: Sun, 14 May 2023 22:40:52 -0600 Subject: [PATCH 257/490] Make 'to' bold in the "Save" button text to match "Preview Message" text. --- .../ContentGenerator/Instructor/SendMail/main_form.html.ep | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/templates/ContentGenerator/Instructor/SendMail/main_form.html.ep b/templates/ContentGenerator/Instructor/SendMail/main_form.html.ep index 9f19cba672..9664e7e82e 100644 --- a/templates/ContentGenerator/Instructor/SendMail/main_form.html.ep +++ b/templates/ContentGenerator/Instructor/SendMail/main_form.html.ep @@ -181,7 +181,9 @@ % if ($c->{input_file}) {
      <%= submit_button maketext('Save'), name => 'saveMessage', class => 'btn btn-secondary btn-sm' =%> - <%= maketext('to') . ' ' . $c->{output_file} %> + + <%= maketext('to') %> <%= $c->{output_file} %> +
      % }
      From 5d4dc7ab3ca65809a708e8b39e559761e184308f Mon Sep 17 00:00:00 2001 From: Jaimos Skriletz Date: Mon, 15 May 2023 00:02:34 -0600 Subject: [PATCH 258/490] Show valid rows from merge file on main SendMail form. Instead of just showing a single line (which may not exist) from the merge file to display its structure, show all valid rows in a scrollable pre block. --- .../ContentGenerator/Instructor/SendMail.pm | 2 +- .../Instructor/SendMail/main_form.html.ep | 30 +++++++++---------- 2 files changed, 16 insertions(+), 16 deletions(-) diff --git a/lib/WeBWorK/ContentGenerator/Instructor/SendMail.pm b/lib/WeBWorK/ContentGenerator/Instructor/SendMail.pm index 57235be6f5..76c257ee84 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/SendMail.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/SendMail.pm @@ -475,7 +475,7 @@ sub data_format ($c, @data) { } sub data_format2 ($c, @data) { - return map { $_ =~ s/\s/ /gr } map { sprintf('%-8.8s', $_) } @data; + return map { $_ =~ s/\s/ /gr } map { sprintf('%-8.7s', $_) } @data; } 1; diff --git a/templates/ContentGenerator/Instructor/SendMail/main_form.html.ep b/templates/ContentGenerator/Instructor/SendMail/main_form.html.ep index 9664e7e82e..cffee83e2a 100644 --- a/templates/ContentGenerator/Instructor/SendMail/main_form.html.ep +++ b/templates/ContentGenerator/Instructor/SendMail/main_form.html.ep @@ -144,22 +144,22 @@
      % - % # Merge file fragment and message text area field + % # Show valid rows of selected merge file. % if ($merge_file ne 'None') { -
      - <%= maketext('Viewing data from merge file [_1] for user [_2].', - $merge_file, $c->{preview_user}->user_id) =%> -
      - % } - % my $rh_merge_data = $c->read_scoring_file($merge_file); - % my @merge_data = eval { @{ $rh_merge_data->{ $c->{preview_user}->student_id } } }; - % if ($@ && $merge_file ne 'None') { -
      <%= maketext('No merge data found.') =%>
      - % } elsif (@merge_data) { - 
      <%== join('', ' ', $c->data_format(1 .. ($#merge_data + 1))) =%>\
-			
      <% =%>\
-			<%== join('', ' ', $c->data_format2(@merge_data)) =%>\
-
      +
      <%= maketext('Showing data from merge file: [_1]', $merge_file) =%>
      + % my $rh_merge_data = $c->read_scoring_file($merge_file); + % my @rows; + % for my $user (@{ $c->{ra_user_records} }) { + % push(@rows, $rh_merge_data->{$user->student_id}) if $rh_merge_data->{$user->student_id}; + % } + % if (@rows) { + 
      <% =%>\
+				<%== join('', ' ', $c->data_format(1 .. scalar(@{ $rows[0] }))) =%>
      <% =%>\
+				<%== join('
      ', map { join('', ' ', $c->data_format2(@$_)) } @rows) =%>\
+
      + % } else { +
      <%= maketext('No merge data found.') =%>
      + % } % } % % # Create a textbox with the subject and a textarea with the message. From 1fde4ffc01e0fd9f6d11f014060aee849e756596 Mon Sep 17 00:00:00 2001 From: Jaimos Skriletz Date: Mon, 15 May 2023 20:28:06 -0600 Subject: [PATCH 259/490] Make 'None' a message file option in SendMail.pm along with code cleanup. Make it so 'None' is always a possible to select for the message file. 'None' is the fall back and if the user the user selects 'None', it sets the from/reply/subject as default and creates an empty email body. Clean up code to handle with converting the parameter value 'None' to an undefined file name and back for both the message and merge file. Add warning message to prevent sending an email with an empty body. Remove the unused setting `$mail{editor_window_columns}` from defaults.conf. --- conf/defaults.config | 3 +- .../ContentGenerator/Instructor/SendMail.pm | 47 ++++++++++++++----- .../Instructor/SendMail/main_form.html.ep | 36 +++++++------- 3 files changed, 53 insertions(+), 33 deletions(-) diff --git a/conf/defaults.config b/conf/defaults.config index 692056313f..ffc96c9e17 100644 --- a/conf/defaults.config +++ b/conf/defaults.config @@ -99,11 +99,10 @@ $mail{feedbackVerbosity} = 1; # The default is yes $blockStudentIDinFeedback = 0; -# Defines the size of the Mail Merge editor window +# Defines the initial height of the Mail Merge editor window # FIXME: should this be here? it's UI, not mail # FIXME: replace this with the auto-size method that TWiki uses $mail{editor_window_rows} = 15; -$mail{editor_window_columns} = 100; ################################################################################## # Customizing the action of the "Email your instructor" button diff --git a/lib/WeBWorK/ContentGenerator/Instructor/SendMail.pm b/lib/WeBWorK/ContentGenerator/Instructor/SendMail.pm index 76c257ee84..ea6952c106 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/SendMail.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/SendMail.pm @@ -72,6 +72,10 @@ sub initialize ($c) { $mergefile = undef unless (-e "$ce->{courseDirs}{scoring}/$mergefile"); } + # None is the parameter value for no file. + $openfilename = undef if (defined($openfilename) && $openfilename eq 'None'); + $mergefile = undef if (defined($mergefile) && $mergefile eq 'None'); + # Figure out action from submit data my $action = ''; if ($c->param('sendEmail')) { @@ -94,7 +98,7 @@ sub initialize ($c) { $c->{defaultFrom} = $ur->rfc822_mailbox; $c->{defaultReply} = $ur->rfc822_mailbox; $c->{defaultSubject} = $c->stash('courseID') . ' notice'; - $c->{merge_file} = $mergefile; + $c->{merge_file} = $mergefile // 'None'; my @classList = (defined($c->param('classList'))) ? $c->param('classList') : ($user); $c->{preview_user} = $c->db->getUser($classList[0] || $user); @@ -135,7 +139,7 @@ sub initialize ($c) { $c->{ra_send_to} = \@send_to; # Check the validity of the input file name - my $input_file = ''; + my $input_file; # Make sure an input message file was submitted and exists. if (defined($openfilename)) { if (-e "${emailDirectory}/$openfilename") { @@ -157,10 +161,11 @@ sub initialize ($c) { )); } } - $c->{input_file} = $input_file; + $c->{input_file} = $input_file // 'None'; # Determine the file name to save message into my $output_file = 'FIXME no output file specified'; + $savefilename = $input_file if $action eq 'saveMessage'; if ($action eq 'saveMessage' or $action eq 'saveAs') { if (defined($savefilename) and $savefilename) { $output_file = $savefilename; @@ -168,7 +173,7 @@ sub initialize ($c) { $c->addbadmessage($c->maketext('No filename was specified for saving! The message was not saved.')); } } else { - $output_file = $input_file; + $output_file = $input_file // ''; } # Sanity check on save file name @@ -188,6 +193,7 @@ sub initialize ($c) { } $c->{output_file} = $output_file; + $c->param('savefilename', $output_file) if ($c->param('savefilename') && $output_file); # Determine input source my $input_source; @@ -200,7 +206,20 @@ sub initialize ($c) { # Get inputs my ($from, $replyTo, $r_text, $subject); if ($input_source eq 'file') { - ($from, $replyTo, $subject, $r_text) = $c->read_input_file("$emailDirectory/$input_file"); + if (defined($input_file)) { + ($from, $replyTo, $subject, $r_text) = $c->read_input_file("$emailDirectory/$input_file"); + } else { + $from = $c->{defaultFrom}; + $replyTo = $c->{defaultReply}; + $subject = $c->{defaultSubject}; + + # If action is openMessage and no file was found, then 'None' was selected. + # In this case empty the message body and set the saved file name to default.msg. + if ($action eq 'openMessage') { + $c->param('body', '') if $c->param('body'); + $c->param('savefilename', 'default.msg') if $c->param('savefilename'); + } + } $c->param('from', $from) if $from; $c->param('replyTo', $replyTo) if $replyTo; $c->param('subject', $subject) if $subject; @@ -213,9 +232,9 @@ sub initialize ($c) { $replyTo = $c->param('replyTo'); $subject = $c->param('subject'); my $body = $c->param('body'); - # Sanity check: body must contain non-white space + # Sanity check: body must contain non-white space when previewing message. $c->addbadmessage($c->maketext('You didn\'t enter any message.')) - unless $c->param('body') =~ /\S/; + unless ($action ne 'previewMessage' || $c->param('body') =~ /\S/); $r_text = \$body; } @@ -270,7 +289,7 @@ sub initialize ($c) { if ($action eq 'saveAs' and -e "$emailDirectory/$output_file") { $c->addbadmessage($c->maketext( 'The file [_1] already exists and cannot be overwritten. The message was not saved.', - "$emailDirectory/$openfilename" + "$emailDirectory/$output_file" )); return; } @@ -288,6 +307,12 @@ sub initialize ($c) { $c->{response} = 'preview'; } elsif ($action eq 'sendEmail') { + # Don't try to send an empty message. + unless (${ $c->{r_text} } =~ /\S/) { + $c->addbadmessage($c->maketext('Email body is empty. No message sent. ')); + return; + } + # verify format of From address (one valid rfc2822/rfc5322 address) my @parsed_from_addrs = Email::Address::XS->parse($c->{from}); unless (@parsed_from_addrs == 1) { @@ -312,7 +337,7 @@ sub initialize ($c) { } # get merge file - my $merge_file = (defined($c->{merge_file})) ? $c->{merge_file} : 'None'; + my $merge_file = $c->{merge_file}; my $rh_merge_data = $c->read_scoring_file($merge_file); unless (ref($rh_merge_data)) { $c->addbadmessage($c->maketext("No merge data file")); @@ -353,10 +378,10 @@ sub print_preview ($c) { die "record for preview user " . $c->{preview_user} . " not found." unless $c->{preview_user}; # Get merge file - my $merge_file = (defined($c->{merge_file})) ? $c->{merge_file} : 'None'; + my $merge_file = $c->{merge_file}; my $rh_merge_data = $c->read_scoring_file($merge_file); - if (($c->{merge_file} // 'None') ne 'None' && !defined $rh_merge_data->{ $c->{preview_user}->student_id }) { + if ($merge_file ne 'None' && !defined $rh_merge_data->{ $c->{preview_user}->student_id }) { $c->addbadmessage('No merge data for student id: ' . $c->{preview_user}->student_id . '; name: ' diff --git a/templates/ContentGenerator/Instructor/SendMail/main_form.html.ep b/templates/ContentGenerator/Instructor/SendMail/main_form.html.ep index cffee83e2a..57d3a072ed 100644 --- a/templates/ContentGenerator/Instructor/SendMail/main_form.html.ep +++ b/templates/ContentGenerator/Instructor/SendMail/main_form.html.ep @@ -1,7 +1,5 @@ % use WeBWorK::HTML::ScrollingRecordList qw/scrollingRecordList/; % -% my $merge_file = $c->{merge_file} // 'None'; -% <%= form_for current_route, id => 'mail-main-form', method => 'post', begin =%> <%= $c->hidden_authen_fields =%> % @@ -15,10 +13,8 @@ <%= maketext('Message file:') %> <% end =%> <%= select_field openfilename => [ - map { [ - $_ => $_, ($_ eq 'None' || $_ eq $c->{input_file}) ? (selected => undef) : () - ] } - ($c->{input_file} ? () : 'None', $c->get_message_file_names) + map { [ $_ => $_, $_ eq $c->{input_file} ? (selected => undef) : () ] } + ('None', $c->get_message_file_names) ], id => 'openfilename', class => 'form-select form-select-sm' =%>
      @@ -27,7 +23,7 @@ <%= maketext('Merge file:') %> <% end =%> <%= select_field merge_file => [ - map { [ $_ => $_, $_ eq $merge_file ? (selected => undef) : () ] } + map { [ $_ => $_, $_ eq $c->{merge_file} ? (selected => undef) : () ] } $c->get_merge_file_names ], id => 'merge_file', class => 'form-select form-select-sm' =%> @@ -145,16 +141,21 @@
      % % # Show valid rows of selected merge file. - % if ($merge_file ne 'None') { -
      <%= maketext('Showing data from merge file: [_1]', $merge_file) =%>
      - % my $rh_merge_data = $c->read_scoring_file($merge_file); + % if ($c->{merge_file} ne 'None') { +
      <%= maketext('Showing data from merge file: [_1]', $c->{merge_file}) =%>
      + % my $rh_merge_data = $c->read_scoring_file($c->{merge_file}); % my @rows; + % my $cols = 0; % for my $user (@{ $c->{ra_user_records} }) { - % push(@rows, $rh_merge_data->{$user->student_id}) if $rh_merge_data->{$user->student_id}; + % if ($rh_merge_data->{$user->student_id}) { + % my $this_row = $rh_merge_data->{$user->student_id}; + % push(@rows, $this_row); + % $cols = scalar(@$this_row) if scalar(@$this_row) > $cols; + % } % } % if (@rows) { 
      <% =%>\
-				<%== join('', ' ', $c->data_format(1 .. scalar(@{ $rows[0] }))) =%>
      <% =%>\
+				<%== join('', ' ', $c->data_format(1 .. $cols)) =%>
      <% =%>\
 				<%== join('
      ', map { join('', ' ', $c->data_format2(@$_)) } @rows) =%>\
      % } else { @@ -162,23 +163,18 @@ % } % } % - % # Create a textbox with the subject and a textarea with the message. - % # Print the actual body of message. - % if (defined $c->{message}) { -
      <%= $c->{message} %>
      - % }
      <%= label_for 'email-body', class => 'form-label', begin =%> <%= maketext("Email Body:") %>* <% end =%> <%= text_area body => $c->{r_text}, - id => 'email-body', rows => $ce->{mail}->{editor_window_rows}, class => 'form-control' %> + id => 'email-body', rows => $ce->{mail}{editor_window_rows}, class => 'form-control' %>
      % - % # Action buttons + % # Save buttons
      - % if ($c->{input_file}) { + % if ($c->{input_file} ne 'None') {
      <%= submit_button maketext('Save'), name => 'saveMessage', class => 'btn btn-secondary btn-sm' =%> From 8ca5832d8511a35f31d13a6bbf1946cc4775af26 Mon Sep 17 00:00:00 2001 From: Alex Jordan Date: Mon, 15 May 2023 21:47:38 -0700 Subject: [PATCH 260/490] put list-group-item-primary class on bug report link --- templates/ContentGenerator/Base/links.html.ep | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/templates/ContentGenerator/Base/links.html.ep b/templates/ContentGenerator/Base/links.html.ep index 6e187e175e..5a0a54300f 100644 --- a/templates/ContentGenerator/Base/links.html.ep +++ b/templates/ContentGenerator/Base/links.html.ep @@ -286,7 +286,7 @@ % && $ce->{webworkURLs}{bugReporter} ne '' % && $authz->hasPermissions($userID, 'report_bugs')) % { -
    • +
    • %= link_to maketext('Report bugs') => $ce->{webworkURLs}{bugReporter}, class => 'nav-link'
      • % } From 628dcc15547fe15d5fdf8de1b6052e1a5eeb5464 Mon Sep 17 00:00:00 2001 From: Glenn Rice Date: Tue, 16 May 2023 07:57:22 -0500 Subject: [PATCH 261/490] Use the empty string for the "None" values and don't save "None" to the database (and other clean up). I don't like saving the "None" value to the database. Furthermore, it is almost always the case that a default select value is better handled with an empty value. This is not an exception. @somiaj: Note that if you have 'None' saved in the database from when you were saving this to the database, you will get a warning on the page about that file not existing. That will go away once you toggle settings and it is removed from the database. Clean up some of the mess of `if (defined $var && $var)` conditionals. For values that are expected to one of undef, the empty string, or some nonempty string it is equivalent and much cleaner to just check `if ($var)`. Fix some of the 'Save as' messages. Currently if no filename is specified you get the message No filename was specified for saving! The message was not saved. and then you also are given the message Invalid file name "FIXME no output file specified". All email file names must end with the ".msg" extension. Choose a file name with the ".msg" extension. The message was not saved. which really doesn't make sense. Remove the setting of $c->{message}. It turns out that was still set. The display of that message has been deleted, and it really isn't needed anymore. Also remove some unused variables. --- .../ContentGenerator/Instructor/SendMail.pm | 71 +++++++++---------- .../Instructor/SendMail.html.ep | 1 - .../Instructor/SendMail/main_form.html.ep | 8 ++- 3 files changed, 38 insertions(+), 42 deletions(-) diff --git a/lib/WeBWorK/ContentGenerator/Instructor/SendMail.pm b/lib/WeBWorK/ContentGenerator/Instructor/SendMail.pm index ea6952c106..12ebde0663 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/SendMail.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/SendMail.pm @@ -38,18 +38,14 @@ sub initialize ($c) { my $authz = $c->authz; my $user = $c->param('user'); - my @selected_filters; - if (defined($c->param('classList!filter'))) { @selected_filters = $c->param('classList!filter'); } - else { @selected_filters = ("all"); } - # Check permissions return unless $authz->hasPermissions($user, "access_instructor_tools"); return unless $authz->hasPermissions($user, "send_mail"); # Gather directory data - my $emailDirectory = $ce->{courseDirs}->{email}; - my $scoringDirectory = $ce->{courseDirs}->{scoring}; - my $templateDirectory = $ce->{courseDirs}->{templates}; + my $emailDirectory = $ce->{courseDirs}{email}; + my $scoringDirectory = $ce->{courseDirs}{scoring}; + my $templateDirectory = $ce->{courseDirs}{templates}; my $openfilename = $c->param('openfilename'); my $savefilename = $c->param('savefilename'); @@ -59,23 +55,23 @@ sub initialize ($c) { # check the database to see if there is a file we should use. # if they have been defined via parameter then we should update the db - if (defined($openfilename) && $openfilename) { + if ($openfilename) { $db->setSettingValue("${user}_openfile", $openfilename); + } elsif (defined $openfilename) { + $db->deleteSetting("${user}_openfile"); } elsif ($db->settingExists("${user}_openfile")) { $openfilename = $db->getSettingValue("${user}_openfile"); } - if (defined($mergefile) && $mergefile) { + if ($mergefile) { $db->setSettingValue("${user}_mergefile", $mergefile); + } elsif (defined $mergefile) { + $db->deleteSetting("${user}_mergefile"); } elsif ($db->settingExists("${user}_mergefile")) { $mergefile = $db->getSettingValue("${user}_mergefile"); $mergefile = undef unless (-e "$ce->{courseDirs}{scoring}/$mergefile"); } - # None is the parameter value for no file. - $openfilename = undef if (defined($openfilename) && $openfilename eq 'None'); - $mergefile = undef if (defined($mergefile) && $mergefile eq 'None'); - # Figure out action from submit data my $action = ''; if ($c->param('sendEmail')) { @@ -98,9 +94,9 @@ sub initialize ($c) { $c->{defaultFrom} = $ur->rfc822_mailbox; $c->{defaultReply} = $ur->rfc822_mailbox; $c->{defaultSubject} = $c->stash('courseID') . ' notice'; - $c->{merge_file} = $mergefile // 'None'; + $c->{merge_file} = $mergefile // ''; - my @classList = (defined($c->param('classList'))) ? $c->param('classList') : ($user); + my @classList = $c->param('classList') // ($user); $c->{preview_user} = $c->db->getUser($classList[0] || $user); # Gather database data @@ -139,9 +135,9 @@ sub initialize ($c) { $c->{ra_send_to} = \@send_to; # Check the validity of the input file name - my $input_file; + my $input_file = ''; # Make sure an input message file was submitted and exists. - if (defined($openfilename)) { + if ($openfilename) { if (-e "${emailDirectory}/$openfilename") { if (-R "${emailDirectory}/$openfilename") { $input_file = $openfilename; @@ -161,13 +157,13 @@ sub initialize ($c) { )); } } - $c->{input_file} = $input_file // 'None'; + $c->{input_file} = $input_file; # Determine the file name to save message into - my $output_file = 'FIXME no output file specified'; + my $output_file = ''; $savefilename = $input_file if $action eq 'saveMessage'; if ($action eq 'saveMessage' or $action eq 'saveAs') { - if (defined($savefilename) and $savefilename) { + if ($savefilename) { $output_file = $savefilename; } else { $c->addbadmessage($c->maketext('No filename was specified for saving! The message was not saved.')); @@ -206,7 +202,7 @@ sub initialize ($c) { # Get inputs my ($from, $replyTo, $r_text, $subject); if ($input_source eq 'file') { - if (defined($input_file)) { + if ($input_file) { ($from, $replyTo, $subject, $r_text) = $c->read_input_file("$emailDirectory/$input_file"); } else { $from = $c->{defaultFrom}; @@ -261,8 +257,7 @@ sub initialize ($c) { # error actions (various) # if no form is submitted, gather data needed to produce the mail form and return - my $to = $c->param('To'); - my $script_action = ''; + my $to = $c->param('To'); return '' if (not $action or $action eq 'openMessage'); @@ -270,6 +265,19 @@ sub initialize ($c) { # and various actions resulting from different buttons if ($action eq 'saveMessage' or $action eq 'saveAs') { + # Check that an output file was specified and protect against overwriting an existing file. + if ($action eq 'saveAs') { + if (!$output_file) { + # A message has been already set if no output filename was specified. So just return here in that case. + return; + } elsif (-e "$emailDirectory/$output_file") { + $c->addbadmessage($c->maketext( + 'The file [_1] already exists and cannot be overwritten. The message was not saved.', + "$emailDirectory/$output_file" + )); + return; + } + } # construct message body my $temp_body = ${$r_text}; @@ -285,15 +293,6 @@ sub initialize ($c) { $temp_body ); - # overwrite protection - if ($action eq 'saveAs' and -e "$emailDirectory/$output_file") { - $c->addbadmessage($c->maketext( - 'The file [_1] already exists and cannot be overwritten. The message was not saved.', - "$emailDirectory/$output_file" - )); - return; - } - # Save the message $c->saveMessageFile($temp_body, "${emailDirectory}/$output_file") unless ($output_file =~ /^[~.]/ || $output_file =~ /\.\./ || $output_file !~ m|\.msg$|); @@ -349,10 +348,6 @@ sub initialize ($c) { # we don't set the response until we're sure that email can be sent $c->{response} = 'send_email'; - # FIXME i'm not sure why we're pulling this out here -- mail_message_to_recipients does have - # access to the course environment and should just grab it directly - $c->{smtpServer} = $ce->{mail}->{smtpServer}; - # Do actual mailing in the after the response is sent, since it could take a long time # FIXME we need to do a better job providing status notifications for long-running email jobs $c->minion->enqueue( @@ -381,7 +376,7 @@ sub print_preview ($c) { my $merge_file = $c->{merge_file}; my $rh_merge_data = $c->read_scoring_file($merge_file); - if ($merge_file ne 'None' && !defined $rh_merge_data->{ $c->{preview_user}->student_id }) { + if ($merge_file && !defined $rh_merge_data->{ $c->{preview_user}->student_id }) { $c->addbadmessage('No merge data for student id: ' . $c->{preview_user}->student_id . '; name: ' @@ -477,7 +472,7 @@ sub get_message_file_names ($c) { sub get_merge_file_names ($c) { # FIXME: Check that only readable files are listed. - return 'None', read_dir($c->{ce}{courseDirs}{scoring}, '\\.csv$'); + return read_dir($c->{ce}{courseDirs}{scoring}, '\\.csv$'); } sub getRecord ($c, $line, $delimiter = ',') { diff --git a/templates/ContentGenerator/Instructor/SendMail.html.ep b/templates/ContentGenerator/Instructor/SendMail.html.ep index c14ce6d1af..ce3b96ba87 100644 --- a/templates/ContentGenerator/Instructor/SendMail.html.ep +++ b/templates/ContentGenerator/Instructor/SendMail.html.ep @@ -30,7 +30,6 @@ % end % $c->addgoodmessage($message->()); - % $c->{message} = $message->(); % } % <%= include('ContentGenerator/Instructor/SendMail/main_form') =%> diff --git a/templates/ContentGenerator/Instructor/SendMail/main_form.html.ep b/templates/ContentGenerator/Instructor/SendMail/main_form.html.ep index 57d3a072ed..dd17bc1719 100644 --- a/templates/ContentGenerator/Instructor/SendMail/main_form.html.ep +++ b/templates/ContentGenerator/Instructor/SendMail/main_form.html.ep @@ -13,8 +13,9 @@ <%= maketext('Message file:') %> <% end =%> <%= select_field openfilename => [ + [ None => '' ], map { [ $_ => $_, $_ eq $c->{input_file} ? (selected => undef) : () ] } - ('None', $c->get_message_file_names) + $c->get_message_file_names ], id => 'openfilename', class => 'form-select form-select-sm' =%>
      @@ -23,6 +24,7 @@ <%= maketext('Merge file:') %> <% end =%> <%= select_field merge_file => [ + [ None => '' ], map { [ $_ => $_, $_ eq $c->{merge_file} ? (selected => undef) : () ] } $c->get_merge_file_names ], @@ -141,7 +143,7 @@
      % % # Show valid rows of selected merge file. - % if ($c->{merge_file} ne 'None') { + % if ($c->{merge_file}) {
      <%= maketext('Showing data from merge file: [_1]', $c->{merge_file}) =%>
      % my $rh_merge_data = $c->read_scoring_file($c->{merge_file}); % my @rows; @@ -174,7 +176,7 @@ % # Save buttons
      - % if ($c->{input_file} ne 'None') { + % if ($c->{input_file}) {
      <%= submit_button maketext('Save'), name => 'saveMessage', class => 'btn btn-secondary btn-sm' =%> From 7e328e43c0dc9e178f6c013e7f7a3acbd20a2ba6 Mon Sep 17 00:00:00 2001 From: Jaimos Skriletz Date: Tue, 16 May 2023 19:11:02 -0600 Subject: [PATCH 262/490] When previewing an email, show which users merge data is not found. Add a warming about which users in the recipients lists have no merge data when previewing an email. Also when no merge file is selected, state this instead of trying to list the merge file data. --- .../ContentGenerator/Instructor/SendMail.pm | 6 +++++- .../Instructor/SendMail/preview.html.ep | 17 +++++++++++++---- 2 files changed, 18 insertions(+), 5 deletions(-) diff --git a/lib/WeBWorK/ContentGenerator/Instructor/SendMail.pm b/lib/WeBWorK/ContentGenerator/Instructor/SendMail.pm index 12ebde0663..f383af1f4a 100644 --- a/lib/WeBWorK/ContentGenerator/Instructor/SendMail.pm +++ b/lib/WeBWorK/ContentGenerator/Instructor/SendMail.pm @@ -408,12 +408,16 @@ sub print_preview ($c) { "\n" ); + # Associate usernames to student ids to test if merge data is found. + my %student_ids = map { $_->user_id => $_->student_id } @{ $c->{ra_user_records} }; + return $c->include( 'ContentGenerator/Instructor/SendMail/preview', preview_header => $preview_header, ur => $c->{preview_user}, msg => $msg, - recipients => join(" ", @{ $c->{ra_send_to} }) + merge_data => $rh_merge_data, + student_ids => \%student_ids, ); } diff --git a/templates/ContentGenerator/Instructor/SendMail/preview.html.ep b/templates/ContentGenerator/Instructor/SendMail/preview.html.ep index 610b93e9aa..d354a20756 100644 --- a/templates/ContentGenerator/Instructor/SendMail/preview.html.ep +++ b/templates/ContentGenerator/Instructor/SendMail/preview.html.ep @@ -1,14 +1,23 @@

      <%= maketext('This sample mail would be sent to [_1]', $ur->email_address) %>

      <%= $msg %>
      -

      <%= maketext('Merge file data:') %>

      -

      <%= maketext('Showing data from merge file: [_1]', $c->{merge_file}) %>

      -
      <%== $preview_header %>
      +% if ($c->{merge_file}) { +

      <%= maketext('Merge file data:') %>

      +

      <%= maketext('Showing data from merge file [_1] for user [_2]:', $c->{merge_file}, $ur->user_id) %>

      + 
      <%== $preview_header %>
      +% } else { +

      <%= maketext('No merge file selected.') %>

      +% } % if (@{ $c->{ra_send_to} }) {

      <%= maketext('Emails to be sent to the following:') %>

        % for (@{ $c->{ra_send_to} }) { -
      • <%= $_ %>
        • +
      • + <%= $_ %> + % if ($c->{merge_file} && !$merge_data->{$student_ids->{$_}}) { + (<%= maketext('No merge data found') %>) + % } +
        • % }
      From abd1b0eaad4e56855830675b5cf60de0ee13bc71 Mon Sep 17 00:00:00 2001 From: Glenn Rice Date: Tue, 16 May 2023 21:40:59 -0500 Subject: [PATCH 263/490] Set the preview user when the page loads. This is done after a 100 ms timeout due to what seems to be a bug on Google Chrome. The value of the class list select is not set immediately on page load after the back button is pressed, and it takes a bit for it to be set. --- htdocs/js/apps/SendMail/sendmail.js | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) diff --git a/htdocs/js/apps/SendMail/sendmail.js b/htdocs/js/apps/SendMail/sendmail.js index e1d25ad8ad..48dfb2110e 100644 --- a/htdocs/js/apps/SendMail/sendmail.js +++ b/htdocs/js/apps/SendMail/sendmail.js @@ -1,12 +1,17 @@ (() => { const previewUserNameSpan = document.getElementById('preview-user'); - if (previewUserNameSpan) { - const classListSelect = document.getElementById('classList'); - classListSelect?.addEventListener('change', () => { + const classListSelect = document.getElementById('classList'); + if (previewUserNameSpan && classListSelect) { + const setPreviewUser = () => { if (classListSelect.selectedIndex !== -1) previewUserNameSpan.textContent = classListSelect.options[classListSelect.selectedIndex].textContent; else previewUserNameSpan.textContent = previewUserNameSpan.dataset.default; - }); + }; + classListSelect.addEventListener('change', setPreviewUser); + + // The timeout should not be needed. For some reason the classList select is not set correctly on Google + // Chrome when the page first loads after the back button is pressed, and it takes a bit for it to be set. + setTimeout(setPreviewUser, 100); } for (const select of [ From 810f2f0d33f870cd67ff3a17a29fb623ad3224e0 Mon Sep 17 00:00:00 2001 From: Jaimos Skriletz Date: Mon, 15 May 2023 21:27:52 -0600 Subject: [PATCH 264/490] Replace more gateways in the ui with test. --- lib/WeBWorK/AchievementItems/AddNewTestGW.pm | 10 +++++----- lib/WeBWorK/AchievementItems/ExtendDueDateGW.pm | 10 +++++----- lib/WeBWorK/AchievementItems/ResurrectGW.pm | 8 ++++---- lib/WeBWorK/Authz.pm | 4 ++-- lib/WeBWorK/Utils/Routes.pm | 2 +- .../Instructor/Stats/set_stats.html.ep | 5 ++--- 6 files changed, 19 insertions(+), 20 deletions(-) diff --git a/lib/WeBWorK/AchievementItems/AddNewTestGW.pm b/lib/WeBWorK/AchievementItems/AddNewTestGW.pm index 4ddfaa143a..8aa78fc499 100644 --- a/lib/WeBWorK/AchievementItems/AddNewTestGW.pm +++ b/lib/WeBWorK/AchievementItems/AddNewTestGW.pm @@ -25,8 +25,8 @@ sub new ($class) { id => 'AddNewTestGW', name => x('Oil of Cleansing'), description => x( - 'Unlock an additional version of a Gateway Test. If used before the close date of ' - . 'the Gateway Test this will allow you to generate a new version of the test.' + 'Unlock an additional version of a test. If used before the close date of ' + . 'the test this will allow you to generate a new version of the test.' ) }, $class; } @@ -47,11 +47,11 @@ sub print_form ($self, $sets, $setProblemCount, $c) { } return $c->c( - $c->tag('p', $c->maketext('Add a new test for which Gateway?')), + $c->tag('p', $c->maketext('Add a new version for which test?')), WeBWorK::AchievementItems::form_popup_menu_row( $c, id => 'adtgw_gw_id', - label_text => $c->maketext('Gateway Name'), + label_text => $c->maketext('Test Name'), values => \@openGateways, menu_attr => { dir => 'ltr' } ) @@ -70,7 +70,7 @@ sub use_item ($self, $userName, $c) { return "You are $self->{id} trying to use an item you don't have" unless $globalData->{ $self->{id} }; my $setID = $c->param('adtgw_gw_id'); - return 'You need to input a Gateway Name' unless defined $setID; + return 'You need to input a Test Name' unless defined $setID; my $set = $db->getMergedSet($userName, $setID); my $userSet = $db->getUserSet($userName, $setID); diff --git a/lib/WeBWorK/AchievementItems/ExtendDueDateGW.pm b/lib/WeBWorK/AchievementItems/ExtendDueDateGW.pm index 03cf2bed81..4c594b2516 100644 --- a/lib/WeBWorK/AchievementItems/ExtendDueDateGW.pm +++ b/lib/WeBWorK/AchievementItems/ExtendDueDateGW.pm @@ -24,8 +24,8 @@ sub new ($class) { return bless { id => 'ExtendDueDateGW', name => x('Amulet of Extension'), - description => x( - 'Extends the close date of a gateway test by 24 hours. Note: The test must still be open for this to work.') + description => + x('Extends the close date of a test by 24 hours. Note: The test must still be open for this to work.') }, $class; } @@ -45,11 +45,11 @@ sub print_form ($self, $sets, $setProblemCount, $c) { } return $c->c( - $c->tag('p', $c->maketext('Extend the close date for which Gateway?')), + $c->tag('p', $c->maketext('Extend the close date for which test?')), WeBWorK::AchievementItems::form_popup_menu_row( $c, id => 'eddgw_gw_id', - label_text => $c->maketext('Gateway Name'), + label_text => $c->maketext('Test Name'), values => \@openGateways, menu_attr => { dir => 'ltr' } ) @@ -69,7 +69,7 @@ sub use_item ($self, $userName, $c) { return "You are $self->{id} trying to use an item you don't have" unless $globalData->{ $self->{id} }; my $setID = $c->param('eddgw_gw_id'); - return 'You need to input a Gateway Name' unless defined $setID; + return 'You need to input a Test Name' unless defined $setID; my $set = $db->getMergedSet($userName, $setID); my $userSet = $db->getUserSet($userName, $setID); diff --git a/lib/WeBWorK/AchievementItems/ResurrectGW.pm b/lib/WeBWorK/AchievementItems/ResurrectGW.pm index 62ae9f437d..15bc20f8d3 100644 --- a/lib/WeBWorK/AchievementItems/ResurrectGW.pm +++ b/lib/WeBWorK/AchievementItems/ResurrectGW.pm @@ -28,7 +28,7 @@ sub new ($class) { id => 'ResurrectGW', name => x('Necromancers Charm'), description => x( - 'Reopens any gateway test for an additional 24 hours. This allows you to take a test even if the ' + 'Reopens any test for an additional 24 hours. This allows you to take a test even if the ' . 'close date has past. This item does not allow you to take additional versions of the test.' ) }, $class; @@ -48,11 +48,11 @@ sub print_form ($self, $sets, $setProblemCount, $c) { } return $c->c( - $c->tag('p', $c->maketext('Resurrect which Gateway?')), + $c->tag('p', $c->maketext('Resurrect which test?')), WeBWorK::AchievementItems::form_popup_menu_row( $c, id => 'resgw_gw_id', - label_text => $c->maketext('Gateway Name'), + label_text => $c->maketext('Test Name'), values => \@sets, menu_attr => { dir => 'ltr' } ) @@ -72,7 +72,7 @@ sub use_item ($self, $userName, $c) { return "You are $self->{id} trying to use an item you don't have" unless $globalData->{ $self->{id} }; my $setID = $c->param('resgw_gw_id'); - return 'You need to input a Gateway Name' unless defined $setID; + return 'You need to input a Test Name' unless defined $setID; my $set = $db->getUserSet($userName, $setID); return q{Couldn't find that set!} unless $set; diff --git a/lib/WeBWorK/Authz.pm b/lib/WeBWorK/Authz.pm index dfcfc4dc8e..c179b38ee8 100644 --- a/lib/WeBWorK/Authz.pm +++ b/lib/WeBWorK/Authz.pm @@ -453,13 +453,13 @@ sub checkSet { # Check to be sure that gateways are being sent to the correct content generator. if (defined($set->assignment_type) && $set->assignment_type =~ /gateway/ && $node_name eq 'problem_detail') { return $c->maketext( - "Requested set '[_1]' is a test/quiz assignment but the regular homework assignment content " + "Requested set '[_1]' is a test but the regular homework assignment content " . 'generator [_2] was called. Try re-entering the set from the problem sets listing page.', $setName, $node_name ); } elsif ((!defined($set->assignment_type) || $set->assignment_type eq 'default') && $node_name =~ /gateway/) { return $c->maketext( - "Requested set '[_1]' is a homework assignment but the gateway/quiz content generator [_2] was called. " + "Requested set '[_1]' is a homework assignment but the test content generator [_2] was called. " . 'Try re-entering the set from the problem sets listing page.', $setName, $node_name ); diff --git a/lib/WeBWorK/Utils/Routes.pm b/lib/WeBWorK/Utils/Routes.pm index 6795067c45..dc33326e02 100644 --- a/lib/WeBWorK/Utils/Routes.pm +++ b/lib/WeBWorK/Utils/Routes.pm @@ -243,7 +243,7 @@ my %routeParameters = ( unrestricted => 1 }, proctored_gateway_proctor_login => { - title => x('Proctored Gateway Quiz [_2] Proctor Login'), + title => x('Proctored Test [_2] Proctor Login'), module => 'LoginProctor', path => '/proctor_login', unrestricted => 1 diff --git a/templates/ContentGenerator/Instructor/Stats/set_stats.html.ep b/templates/ContentGenerator/Instructor/Stats/set_stats.html.ep index 5f9d114034..85a745e95d 100644 --- a/templates/ContentGenerator/Instructor/Stats/set_stats.html.ep +++ b/templates/ContentGenerator/Instructor/Stats/set_stats.html.ep @@ -45,9 +45,8 @@