├── .VERSION_PREFIX ├── deps.edn ├── .gitignore ├── bb.edn ├── bin └── proj ├── repl_sessions └── walkthrough.clj ├── CHANGELOG.md ├── pom.xml ├── README.md ├── LICENSE.txt └── src └── overtone └── at_at.clj /.VERSION_PREFIX: -------------------------------------------------------------------------------- 1 | 1.4 -------------------------------------------------------------------------------- /deps.edn: -------------------------------------------------------------------------------- 1 | {} 2 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .cake 2 | *.jar 3 | *.war 4 | lib 5 | classes 6 | build 7 | /at-at 8 | /target 9 | pom.xml.asc 10 | *.class 11 | /.lein-* 12 | /.nrepl-port 13 | .hgignore 14 | .hg/ 15 | .cpcache 16 | -------------------------------------------------------------------------------- /bb.edn: -------------------------------------------------------------------------------- 1 | {:deps 2 | {lambdaisland/open-source {:git/url "https://github.com/lambdaisland/open-source" 3 | :sha "b46bd6273c5c554f8374406a7482f6e0a6f1dd25" 4 | #_#_:local/root "../open-source"}}} 5 | -------------------------------------------------------------------------------- /bin/proj: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bb 2 | 3 | (ns proj (:require [lioss.main :as lioss])) 4 | 5 | (lioss/main 6 | {:license :epl 7 | :group-id "overtone" 8 | :gh-project "overtone/at-at" 9 | :org-name "Overtone" 10 | :org-url "https://overtone.github.io/" 11 | :inception-year 2011 12 | :description "Ahead-of-time function scheduler."}) 13 | 14 | 15 | ;; Local Variables: 16 | ;; mode:clojure 17 | ;; End: 18 | -------------------------------------------------------------------------------- /repl_sessions/walkthrough.clj: -------------------------------------------------------------------------------- 1 | (ns at-at.walkthrough 2 | (:require 3 | [overtone.at-at :as at])) 4 | 5 | (def my-pool (at-at/mk-pool)) 6 | 7 | (at/at (+ 1000 (at/now)) #(println "hello from the past!") my-pool) 8 | (at/after 1000 #(println "hello from the past!") my-pool) 9 | 10 | (at/every 1000 #(println "I am cool!") my-pool) 11 | (at/every 1000 #(println "I am cool!") my-pool :initial-delay 2000) 12 | (at/show-schedule my-pool) 13 | (at/stop (first (at/scheduled-jobs my-pool))) 14 | 15 | (at/interspaced 1000 #(println "I am cool!") my-pool) 16 | (at/stop-and-reset-pool! my-pool) 17 | (at/stop-and-reset-pool! my-pool :strategy :kill) 18 | 19 | (def tp (at/mk-pool)) 20 | (at/after 10000 #(println "hello") tp :desc "Hello printer") 21 | (at/every 5000 #(println "I am still alive!") tp :desc "Alive task") 22 | (at/show-schedule tp) 23 | 24 | (run! at/stop (at/scheduled-jobs tp)) 25 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Unreleased 2 | 3 | ## Added 4 | 5 | ## Fixed 6 | 7 | ## Changed 8 | 9 | # 1.4.65 (2024-10-19 / d813dc5) 10 | 11 | - Fix reflection warnings 12 | 13 | # 1.3.58 (2023-11-26 / cc6975b) 14 | 15 | - Add exception handling through `uncaught-exception-handler` 16 | - Make our thread pool threads recognizable by adding `at-at` to the thread name 17 | - Add pprint handlers for records 18 | - Add type hints to avoid reflection, and to be Babashka/GraalVM compatible 19 | - Make `shutdown-pool!` public 20 | 21 | ## 1.2.0 22 | _28th May 2013_ 23 | 24 | * BREAKING CHANGE - Remove support for specifying stop-delayed? and 25 | stop-periodic? scheduler strategies. 26 | * Jobs now correctly report as no longer being scheduled when pool is shutdown. 27 | 28 | ## 1.1.0 29 | _14th Jan 2013_ 30 | 31 | * Added new fn `interspaced` which will call fun repeatedly with a 32 | specified interspacing. 33 | * Added missing trailing quotes when printing schedule. -------------------------------------------------------------------------------- /pom.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4.0.0 4 | overtone 5 | at-at 6 | 1.4.65 7 | at-at 8 | Ahead-of-time function scheduler. 9 | https://github.com/overtone/at-at 10 | 2011 11 | 12 | Overtone 13 | https://overtone.github.io/ 14 | 15 | 16 | UTF-8 17 | 18 | 19 | 20 | Eclipse Public License 1.0 21 | https://www.eclipse.org/legal/epl-v10.html 22 | 23 | 24 | 25 | https://github.com/overtone/at-at 26 | scm:git:git://github.com/overtone/at-at.git 27 | scm:git:ssh://git@github.com/overtone/at-at.git 28 | 49311157d219469dfb81ea3170977c4216fd2b46 29 | 30 | 31 | 32 | src 33 | 34 | 35 | src 36 | 37 | 38 | 39 | 40 | org.apache.maven.plugins 41 | maven-compiler-plugin 42 | 3.8.1 43 | 44 | 1.8 45 | 1.8 46 | 47 | 48 | 49 | org.apache.maven.plugins 50 | maven-jar-plugin 51 | 3.2.0 52 | 53 | 54 | 55 | 49311157d219469dfb81ea3170977c4216fd2b46 56 | 57 | 58 | 59 | 60 | 61 | org.apache.maven.plugins 62 | maven-gpg-plugin 63 | 1.6 64 | 65 | 66 | sign-artifacts 67 | verify 68 | 69 | sign 70 | 71 | 72 | 73 | 74 | 75 | 76 | 77 | 78 | clojars 79 | https://repo.clojars.org/ 80 | 81 | 82 | 83 | 84 | clojars 85 | Clojars repository 86 | https://clojars.org/repo 87 | 88 | 89 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ________ 2 | _,.-Y | | Y-._ 3 | .-~" || | | | "-. 4 | I" ""=="|" !""! "|"[]""| _____ 5 | L__ [] |..------|: _[----I" .-{"-. 6 | I___| ..| l______|l_ [__L]_[I_/r(=}=-P 7 | [L______L_[________]______j~ '-=c_]/=-^ 8 | \_I_j.--.\==I|I==_/.--L_] 9 | [_((==)[`-----"](==)j 10 | I--I"~~"""~~"I--I 11 | |[]| |[]| 12 | l__j l__j 13 | |!!| |!!| 14 | |..| |..| 15 | ([]) ([]) 16 | ]--[ ]--[ 17 | [_L] [_L] -Row 18 | /|..|\ /|..|\ 19 | `=}--{=' `=}--{=' 20 | .-^--r-^-. .-^--r-^-. 21 | ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 22 | __ __ 23 | ____ _/ /_ ____ _/ /_ 24 | / __ `/ __/______/ __ `/ __/ 25 | / /_/ / /_ /_____/ /_/ / /_ 26 | \__,_/\__/ \__,_/\__/ 27 | 28 | 29 | 30 | ### at-at 31 | 32 | 33 | [![cljdoc badge](https://cljdoc.org/badge/overtone/at-at)](https://cljdoc.org/d/overtone/at-at) [![Clojars Project](https://img.shields.io/clojars/v/overtone/at-at.svg)](https://clojars.org/overtone/at-at) 34 | 35 | 36 | Simple ahead-of-time function scheduler. Allows you to schedule the execution of an anonymous function for a point in the future. 37 | 38 | 39 | ## Installation 40 | 41 | To use the latest release, add the following to your `deps.edn` ([Clojure CLI](https://clojure.org/guides/deps_and_cli)) 42 | 43 | ``` 44 | overtone/at-at {:mvn/version "1.4.65"} 45 | ``` 46 | 47 | or add the following to your `project.clj` ([Leiningen](https://leiningen.org/)) 48 | 49 | ``` 50 | [overtone/at-at "1.4.65"] 51 | ``` 52 | 53 | 54 | ### Basic Usage 55 | 56 | First pull in the lib: 57 | 58 | ```clj 59 | (require '[overtone.at-at :as at]) 60 | ``` 61 | 62 | `at-at` uses `ScheduledThreadPoolExecutor`s behind the scenes which use a thread pool to run the scheduled tasks. You therefore need create a pool before you can get going: 63 | 64 | ```clj 65 | (def my-pool (at/mk-pool)) 66 | ``` 67 | 68 | It is possible to pass in extra options `:cpu-count`, `:stop-delayed?` and `:stop-periodic?` to further configure your pool. See `mk-pool`'s docstring for further info. 69 | 70 | Next, schedule the function of your dreams. Here we schedule the function to execute in 1000 ms from now (i.e. 1 second): 71 | 72 | ```clj 73 | (at/at (+ 1000 (at/now)) #(println "hello from the past!") my-pool) 74 | ``` 75 | 76 | You may also specify a description for the scheduled task with the optional `:desc` key. 77 | 78 | Another way of achieving the same result is to use `after` which takes a delaty time in ms from now: 79 | 80 | ```clj 81 | (at/after 1000 #(println "hello from the past!") my-pool) 82 | ``` 83 | 84 | You can also schedule functions to occur periodically. Here we schedule the function to execute every second: 85 | 86 | ```clj 87 | (at/every 1000 #(println "I am cool!") my-pool) 88 | ``` 89 | 90 | This returns a scheduled-fn which may easily be stopped `stop`: 91 | 92 | ```clj 93 | (at/stop *1) 94 | ``` 95 | 96 | Or more forcefully killed with `kill`. 97 | 98 | It's also possible to start a periodic repeating fn with an initial delay: 99 | 100 | ```clj 101 | (at/every 1000 #(println "I am cool!") my-pool :initial-delay 2000) 102 | ``` 103 | 104 | Finally, you can also schedule tasks for a fixed delay (vs a rate): 105 | 106 | ```clj 107 | (at/interspaced 1000 #(println "I am cool!") my-pool) 108 | ``` 109 | 110 | This means that it will wait 1000 ms after the task is completed before 111 | starting the next one. 112 | 113 | ### Resetting a pool. 114 | 115 | When necessary it's possible to stop and reset a given pool: 116 | 117 | ```clj 118 | (at/stop-and-reset-pool! my-pool) 119 | ``` 120 | 121 | You may forcefully reset the pool using the `:kill` strategy: 122 | 123 | ```clj 124 | (at/stop-and-reset-pool! my-pool :strategy :kill) 125 | ``` 126 | 127 | ### Viewing running scheduled tasks. 128 | 129 | `at-at` keeps an eye on all the tasks you've scheduled. You can get a set of the current jobs (both scheduled and recurring) using `scheduled-jobs` and you can pretty-print a list of these job using `show-schedule`. The ids shown in the output of `show-schedule` are also accepted in `kill` and `stop`, provided you also specify the associated pool. See the `kill` and `stop` docstrings for more information. 130 | 131 | ```clj 132 | (def tp (at/mk-pool)) 133 | (at/after 10000 #(println "hello") tp :desc "Hello printer") 134 | (at/every 5000 #(println "I am still alive!") tp :desc "Alive task") 135 | (at/show-schedule tp) 136 | ;; [6][RECUR] created: Thu 12:03:35s, period: 5000ms, desc: "Alive task" 137 | ;; [5][SCHED] created: Thu 12:03:32s, starts at: Thu 12:03:42s, desc: "Hello printer" 138 | ``` 139 | 140 | ### History 141 | 142 | at-at was extracted from the awesome music making wonder that is Overtone (http://github.com/overtone/overtone) 143 | 144 | ### Release Tooling 145 | 146 | This project uses the Lambda Island release tooling. See `bin/proj --help` for options. To release a new version to Clojars: 147 | 148 | ``` 149 | bin/proj release 150 | ``` 151 | 152 | ### Authors 153 | 154 | * Sam Aaron 155 | * Jeff Rose 156 | * Michael Neale 157 | * Alexander Oloo 158 | * Arne Brasseur 159 | * Daniel MacDougall 160 | * Josh Comer 161 | 162 | (Ascii art borrowed from http://www.sanitarium.net/jokes/getjoke.cgi?132) 163 | 164 | 165 | ## License 166 | 167 | Copyright © 2011-2023 Sam Aaron, Jeff Rose, and contributors 168 | 169 | Available under the terms of the Eclipse Public License 1.0, see LICENSE.txt 170 | 171 | -------------------------------------------------------------------------------- /LICENSE.txt: -------------------------------------------------------------------------------- 1 | Eclipse Public License - v 1.0 2 | 3 | THE ACCOMPANYING PROGRAM IS PROVIDED UNDER THE TERMS OF THIS ECLIPSE 4 | PUBLIC LICENSE ("AGREEMENT"). ANY USE, REPRODUCTION OR DISTRIBUTION OF 5 | THE PROGRAM CONSTITUTES RECIPIENT'S ACCEPTANCE OF THIS AGREEMENT. 6 | 7 | 1. DEFINITIONS 8 | 9 | "Contribution" means: 10 | 11 | a) in the case of the initial Contributor, the initial code and 12 | documentation distributed under this Agreement, and 13 | 14 | b) in the case of each subsequent Contributor: 15 | 16 | i) changes to the Program, and 17 | 18 | ii) additions to the Program; 19 | 20 | where such changes and/or additions to the Program originate from and 21 | are distributed by that particular Contributor. A Contribution 22 | 'originates' from a Contributor if it was added to the Program by such 23 | Contributor itself or anyone acting on such Contributor's 24 | behalf. Contributions do not include additions to the Program which: 25 | (i) are separate modules of software distributed in conjunction with 26 | the Program under their own license agreement, and (ii) are not 27 | derivative works of the Program. 28 | 29 | "Contributor" means any person or entity that distributes the Program. 30 | 31 | "Licensed Patents" mean patent claims licensable by a Contributor 32 | which are necessarily infringed by the use or sale of its Contribution 33 | alone or when combined with the Program. 34 | 35 | "Program" means the Contributions distributed in accordance with this 36 | Agreement. 37 | 38 | "Recipient" means anyone who receives the Program under this 39 | Agreement, including all Contributors. 40 | 41 | 2. GRANT OF RIGHTS 42 | 43 | a) Subject to the terms of this Agreement, each Contributor hereby 44 | grants Recipient a non-exclusive, worldwide, royalty-free copyright 45 | license to reproduce, prepare derivative works of, publicly display, 46 | publicly perform, distribute and sublicense the Contribution of such 47 | Contributor, if any, and such derivative works, in source code and 48 | object code form. 49 | 50 | b) Subject to the terms of this Agreement, each Contributor hereby 51 | grants Recipient a non-exclusive, worldwide, royalty-free patent 52 | license under Licensed Patents to make, use, sell, offer to sell, 53 | import and otherwise transfer the Contribution of such Contributor, if 54 | any, in source code and object code form. This patent license shall 55 | apply to the combination of the Contribution and the Program if, at 56 | the time the Contribution is added by the Contributor, such addition 57 | of the Contribution causes such combination to be covered by the 58 | Licensed Patents. The patent license shall not apply to any other 59 | combinations which include the Contribution. No hardware per se is 60 | licensed hereunder. 61 | 62 | c) Recipient understands that although each Contributor grants the 63 | licenses to its Contributions set forth herein, no assurances are 64 | provided by any Contributor that the Program does not infringe the 65 | patent or other intellectual property rights of any other entity. Each 66 | Contributor disclaims any liability to Recipient for claims brought by 67 | any other entity based on infringement of intellectual property rights 68 | or otherwise. As a condition to exercising the rights and licenses 69 | granted hereunder, each Recipient hereby assumes sole responsibility 70 | to secure any other intellectual property rights needed, if any. For 71 | example, if a third party patent license is required to allow 72 | Recipient to distribute the Program, it is Recipient's responsibility 73 | to acquire that license before distributing the Program. 74 | 75 | d) Each Contributor represents that to its knowledge it has sufficient 76 | copyright rights in its Contribution, if any, to grant the copyright 77 | license set forth in this Agreement. 78 | 79 | 3. REQUIREMENTS 80 | 81 | A Contributor may choose to distribute the Program in object code form 82 | under its own license agreement, provided that: 83 | 84 | a) it complies with the terms and conditions of this Agreement; and 85 | 86 | b) its license agreement: 87 | 88 | i) effectively disclaims on behalf of all Contributors all warranties 89 | and conditions, express and implied, including warranties or 90 | conditions of title and non-infringement, and implied warranties or 91 | conditions of merchantability and fitness for a particular purpose; 92 | 93 | ii) effectively excludes on behalf of all Contributors all liability 94 | for damages, including direct, indirect, special, incidental and 95 | consequential damages, such as lost profits; 96 | 97 | iii) states that any provisions which differ from this Agreement are 98 | offered by that Contributor alone and not by any other party; and 99 | 100 | iv) states that source code for the Program is available from such 101 | Contributor, and informs licensees how to obtain it in a reasonable 102 | manner on or through a medium customarily used for software exchange. 103 | 104 | When the Program is made available in source code form: 105 | 106 | a) it must be made available under this Agreement; and 107 | 108 | b) a copy of this Agreement must be included with each copy of the Program. 109 | 110 | Contributors may not remove or alter any copyright notices contained 111 | within the Program. 112 | 113 | Each Contributor must identify itself as the originator of its 114 | Contribution, if any, in a manner that reasonably allows subsequent 115 | Recipients to identify the originator of the Contribution. 116 | 117 | 4. COMMERCIAL DISTRIBUTION 118 | 119 | Commercial distributors of software may accept certain 120 | responsibilities with respect to end users, business partners and the 121 | like. While this license is intended to facilitate the commercial use 122 | of the Program, the Contributor who includes the Program in a 123 | commercial product offering should do so in a manner which does not 124 | create potential liability for other Contributors. Therefore, if a 125 | Contributor includes the Program in a commercial product offering, 126 | such Contributor ("Commercial Contributor") hereby agrees to defend 127 | and indemnify every other Contributor ("Indemnified Contributor") 128 | against any losses, damages and costs (collectively "Losses") arising 129 | from claims, lawsuits and other legal actions brought by a third party 130 | against the Indemnified Contributor to the extent caused by the acts 131 | or omissions of such Commercial Contributor in connection with its 132 | distribution of the Program in a commercial product offering. The 133 | obligations in this section do not apply to any claims or Losses 134 | relating to any actual or alleged intellectual property 135 | infringement. In order to qualify, an Indemnified Contributor must: a) 136 | promptly notify the Commercial Contributor in writing of such claim, 137 | and b) allow the Commercial Contributor tocontrol, and cooperate with 138 | the Commercial Contributor in, the defense and any related settlement 139 | negotiations. The Indemnified Contributor may participate in any such 140 | claim at its own expense. 141 | 142 | For example, a Contributor might include the Program in a commercial 143 | product offering, Product X. That Contributor is then a Commercial 144 | Contributor. If that Commercial Contributor then makes performance 145 | claims, or offers warranties related to Product X, those performance 146 | claims and warranties are such Commercial Contributor's responsibility 147 | alone. Under this section, the Commercial Contributor would have to 148 | defend claims against the other Contributors related to those 149 | performance claims and warranties, and if a court requires any other 150 | Contributor to pay any damages as a result, the Commercial Contributor 151 | must pay those damages. 152 | 153 | 5. NO WARRANTY 154 | 155 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, THE PROGRAM IS 156 | PROVIDED ON AN "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY 157 | KIND, EITHER EXPRESS OR IMPLIED INCLUDING, WITHOUT LIMITATION, ANY 158 | WARRANTIES OR CONDITIONS OF TITLE, NON-INFRINGEMENT, MERCHANTABILITY 159 | OR FITNESS FOR A PARTICULAR PURPOSE. Each Recipient is solely 160 | responsible for determining the appropriateness of using and 161 | distributing the Program and assumes all risks associated with its 162 | exercise of rights under this Agreement , including but not limited to 163 | the risks and costs of program errors, compliance with applicable 164 | laws, damage to or loss of data, programs or equipment, and 165 | unavailability or interruption of operations. 166 | 167 | 6. DISCLAIMER OF LIABILITY 168 | 169 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, NEITHER RECIPIENT NOR 170 | ANY CONTRIBUTORS SHALL HAVE ANY LIABILITY FOR ANY DIRECT, INDIRECT, 171 | INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING 172 | WITHOUT LIMITATION LOST PROFITS), HOWEVER CAUSED AND ON ANY THEORY OF 173 | LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 174 | NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OR 175 | DISTRIBUTION OF THE PROGRAM OR THE EXERCISE OF ANY RIGHTS GRANTED 176 | HEREUNDER, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. 177 | 178 | 7. GENERAL 179 | 180 | If any provision of this Agreement is invalid or unenforceable under 181 | applicable law, it shall not affect the validity or enforceability of 182 | the remainder of the terms of this Agreement, and without further 183 | action by the parties hereto, such provision shall be reformed to the 184 | minimum extent necessary to make such provision valid and enforceable. 185 | 186 | If Recipient institutes patent litigation against any entity 187 | (including a cross-claim or counterclaim in a lawsuit) alleging that 188 | the Program itself (excluding combinations of the Program with other 189 | software or hardware) infringes such Recipient's patent(s), then such 190 | Recipient's rights granted under Section 2(b) shall terminate as of 191 | the date such litigation is filed. 192 | 193 | All Recipient's rights under this Agreement shall terminate if it 194 | fails to comply with any of the material terms or conditions of this 195 | Agreement and does not cure such failure in a reasonable period of 196 | time after becoming aware of such noncompliance. If all Recipient's 197 | rights under this Agreement terminate, Recipient agrees to cease use 198 | and distribution of the Program as soon as reasonably 199 | practicable. However, Recipient's obligations under this Agreement and 200 | any licenses granted by Recipient relating to the Program shall 201 | continue and survive. 202 | 203 | Everyone is permitted to copy and distribute copies of this Agreement, 204 | but in order to avoid inconsistency the Agreement is copyrighted and 205 | may only be modified in the following manner. The Agreement Steward 206 | reserves the right to publish new versions (including revisions) of 207 | this Agreement from time to time. No one other than the Agreement 208 | Steward has the right to modify this Agreement. The Eclipse Foundation 209 | is the initial Agreement Steward. The Eclipse Foundation may assign 210 | the responsibility to serve as the Agreement Steward to a suitable 211 | separate entity. Each new version of the Agreement will be given a 212 | distinguishing version number. The Program (including Contributions) 213 | may always be distributed subject to the version of the Agreement 214 | under which it was received. In addition, after a new version of the 215 | Agreement is published, Contributor may elect to distribute the 216 | Program (including its Contributions) under the new version. Except as 217 | expressly stated in Sections 2(a) and 2(b) above, Recipient receives 218 | no rights or licenses to the intellectual property of any Contributor 219 | under this Agreement, whether expressly, by implication, estoppel or 220 | otherwise. All rights in the Program not expressly granted under this 221 | Agreement are reserved. 222 | 223 | This Agreement is governed by the laws of the State of Washington and 224 | the intellectual property laws of the United States of America. No 225 | party to this Agreement will bring a legal action under this Agreement 226 | more than one year after the cause of action arose. Each party waives 227 | its rights to a jury trial in any resulting litigation. 228 | -------------------------------------------------------------------------------- /src/overtone/at_at.clj: -------------------------------------------------------------------------------- 1 | (ns overtone.at-at 2 | (:require 3 | [clojure.pprint :as pprint]) 4 | (:import 5 | (java.io Writer) 6 | (java.util.concurrent Executors Future ScheduledThreadPoolExecutor ThreadFactory ThreadPoolExecutor TimeUnit))) 7 | 8 | (declare job-string) 9 | 10 | (defn uncaught-exception-handler 11 | "Called when a scheduled function throws. Use `alter-var-root` to customize 12 | this." 13 | [^Throwable throwable job] 14 | (println (str throwable " thrown by at-at task: " (job-string job))) 15 | (.printStackTrace throwable) 16 | (throw throwable)) 17 | 18 | (defrecord PoolInfo [thread-pool jobs-ref id-count-ref]) 19 | (defrecord MutablePool [pool-atom]) 20 | (defrecord RecurringJob [id created-at ms-period initial-delay job pool-info desc scheduled?]) 21 | (defrecord ScheduledJob [id created-at initial-delay job pool-info desc scheduled?]) 22 | 23 | (defn- format-date 24 | "Format date object as a string such as: 15:23:35s" 25 | [date] 26 | (.format (java.text.SimpleDateFormat. "EEE hh':'mm':'ss's'") date)) 27 | 28 | (defmethod pprint/simple-dispatch PoolInfo [obj] 29 | (println (str "#"))) 31 | 32 | (defmethod print-method PoolInfo 33 | [obj ^Writer w] 34 | (.write w (str "#"))) 36 | 37 | (defmethod pprint/simple-dispatch MutablePool [obj] 38 | (println (str "#"))) 41 | 42 | (defmethod print-method MutablePool 43 | [obj ^Writer w] 44 | (.write w (str "#"))) 47 | 48 | (defmethod pprint/simple-dispatch RecurringJob [obj] 49 | (println (str "#"))) 55 | 56 | (defmethod print-method RecurringJob 57 | [obj ^Writer w] 58 | (.write w (str "#"))) 64 | 65 | (defmethod pprint/simple-dispatch ScheduledJob [obj] 66 | (println (str "#"))) 71 | 72 | (defmethod print-method ScheduledJob 73 | [obj ^Writer w] 74 | (.write w (str "#"))) 79 | 80 | (defn- switch! 81 | "Sets the value of atom to new-val. Similar to reset! except returns the 82 | immediately previous value." 83 | [atom new-val] 84 | (let [old-val @atom 85 | success? (compare-and-set! atom old-val new-val)] 86 | (if success? 87 | old-val 88 | (recur atom new-val)))) 89 | 90 | (defn- cpu-count 91 | "Returns the number of CPUs on this machine." 92 | [] 93 | (.availableProcessors (Runtime/getRuntime))) 94 | 95 | (defn- wrap-fun-with-exception-handler 96 | [fun job-info-prom] 97 | (fn [& args] 98 | (try 99 | (apply fun args) 100 | (catch Throwable t 101 | (uncaught-exception-handler t @job-info-prom))))) 102 | 103 | (defn- schedule-job 104 | "Schedule the fun to execute periodically in pool-info's pool with the 105 | specified initial-delay and ms-period. Returns a RecurringJob record." 106 | [pool-info fun initial-delay ms-period desc interspaced?] 107 | (let [initial-delay (long initial-delay) 108 | ms-period (long ms-period) 109 | ^ScheduledThreadPoolExecutor t-pool (:thread-pool pool-info) 110 | job-info-prom (promise) 111 | ^Callable fun (wrap-fun-with-exception-handler fun job-info-prom) 112 | job (if interspaced? 113 | (.scheduleWithFixedDelay t-pool 114 | fun 115 | initial-delay 116 | ms-period 117 | TimeUnit/MILLISECONDS) 118 | (.scheduleAtFixedRate t-pool 119 | fun 120 | initial-delay 121 | ms-period 122 | TimeUnit/MILLISECONDS)) 123 | start-time (System/currentTimeMillis) 124 | jobs-ref (:jobs-ref pool-info) 125 | id-count-ref (:id-count-ref pool-info) 126 | job-info (dosync 127 | (let [id (commute id-count-ref inc) 128 | job-info (RecurringJob. id 129 | start-time 130 | ms-period 131 | initial-delay 132 | job 133 | pool-info 134 | desc 135 | (atom true))] 136 | (commute jobs-ref assoc id job-info) 137 | job-info))] 138 | (deliver job-info-prom job-info) 139 | job-info)) 140 | 141 | (defn- wrap-fun-to-remove-itself 142 | [fun jobs-ref job-info-prom] 143 | (fn [& args] 144 | (let [job-info @job-info-prom 145 | id (:id job-info) 146 | sched-ref (:scheduled? job-info)] 147 | (reset! sched-ref false) 148 | (dosync 149 | (commute jobs-ref dissoc id)) 150 | (apply fun args)))) 151 | 152 | (defn- schedule-at 153 | "Schedule the fun to execute once in the pool-info's pool after the 154 | specified initial-delay. Returns a ScheduledJob record." 155 | [pool-info fun initial-delay desc] 156 | (let [initial-delay (long initial-delay) 157 | ^ScheduledThreadPoolExecutor t-pool (:thread-pool pool-info) 158 | jobs-ref (:jobs-ref pool-info) 159 | job-info-prom (promise) 160 | ^Callable fun (-> fun 161 | (wrap-fun-with-exception-handler job-info-prom) 162 | (wrap-fun-to-remove-itself jobs-ref job-info-prom)) 163 | job (.schedule t-pool fun initial-delay TimeUnit/MILLISECONDS) 164 | start-time (System/currentTimeMillis) 165 | id-count-ref (:id-count-ref pool-info) 166 | job-info (dosync 167 | (let [id (commute id-count-ref inc) 168 | job-info (ScheduledJob. id 169 | start-time 170 | initial-delay 171 | job 172 | pool-info 173 | desc 174 | (atom true))] 175 | (commute jobs-ref assoc id job-info) 176 | job-info))] 177 | (deliver job-info-prom job-info) 178 | job-info)) 179 | 180 | (defn- shutdown-pool-now! 181 | "Shut the pool down NOW!" 182 | [pool-info] 183 | (.shutdownNow ^ScheduledThreadPoolExecutor (:thread-pool pool-info)) 184 | (doseq [job (vals @(:jobs-ref pool-info))] 185 | (reset! (:scheduled? job) false))) 186 | 187 | (defn- shutdown-pool-gracefully! 188 | "Shut the pool down gracefully - waits until all previously 189 | submitted jobs have completed" 190 | [pool-info] 191 | (.shutdown ^ScheduledThreadPoolExecutor (:thread-pool pool-info)) 192 | (let [jobs (vals @(:jobs-ref pool-info))] 193 | (future 194 | (loop [jobs jobs] 195 | (doseq [job jobs] 196 | (when (and @(:scheduled? job) 197 | (or 198 | (.isCancelled ^Future (:job job)) 199 | (.isDone ^Future (:job job)))) 200 | (reset! (:scheduled? job) false))) 201 | 202 | (when-let [jobs (filter (fn [j] @(:scheduled? j)) jobs)] 203 | (Thread/sleep 500) 204 | (when (seq jobs) 205 | (recur jobs))))))) 206 | 207 | (defn- mk-sched-thread-pool 208 | "Create a new scheduled thread pool containing num-threads threads." 209 | [^Long num-threads] 210 | (let [thread-factory (Executors/defaultThreadFactory) 211 | t-pool (ScheduledThreadPoolExecutor. 212 | num-threads 213 | (reify ThreadFactory 214 | (newThread [this runnable] 215 | (let [thread (.newThread thread-factory runnable)] 216 | (.setName thread (str "at-at-" (.getName thread))) 217 | thread))))] 218 | t-pool)) 219 | 220 | (defn- mk-pool-info 221 | [t-pool] 222 | (PoolInfo. t-pool (ref {}) (ref 0N))) 223 | 224 | (defn mk-pool 225 | "Returns MutablePool record storing a mutable reference (atom) to a 226 | PoolInfo record which contains a newly created pool of threads to 227 | schedule new events for. Pool size defaults to the cpu count + 2." 228 | [& {:keys [cpu-count stop-delayed? stop-periodic?] 229 | :or {cpu-count (+ 2 (cpu-count))}}] 230 | (MutablePool. (atom (mk-pool-info (mk-sched-thread-pool cpu-count))))) 231 | 232 | (defn every 233 | "Calls fun every ms-period, and takes an optional initial-delay for 234 | the first call in ms. Returns a scheduled-fn which may be cancelled 235 | with stop / kill. 236 | 237 | Default options are 238 | {:initial-delay 0 :desc \"\"}" 239 | [ms-period fun pool & {:keys [initial-delay desc] 240 | :or {initial-delay 0 241 | desc ""}}] 242 | (schedule-job @(:pool-atom pool) fun initial-delay ms-period desc false)) 243 | 244 | (defn interspaced 245 | "Calls fun repeatedly with an interspacing of ms-period, i.e. the next 246 | call of fun will happen ms-period milliseconds after the completion 247 | of the previous call. Also takes an optional initial-delay for the 248 | first call in ms. Returns a scheduled-fn which may be cancelled with 249 | stop / kill. 250 | 251 | Default options are 252 | {:initial-delay 0 :desc \"\"}" 253 | [ms-period fun pool & {:keys [initial-delay desc] 254 | :or {initial-delay 0 255 | desc ""}}] 256 | (schedule-job @(:pool-atom pool) fun initial-delay ms-period desc true)) 257 | 258 | (defn now 259 | "Return the current time in ms" 260 | [] 261 | (System/currentTimeMillis)) 262 | 263 | (defn at 264 | "Schedules fun to be executed at ms-time (in milliseconds). 265 | Use (now) to get the current time in ms. 266 | 267 | Example usage: 268 | (at (+ 1000 (now)) 269 | #(println \"hello from the past\") 270 | pool 271 | :desc \"Message from the past\") ;=> prints 1s from now" 272 | [ms-time fun pool & {:keys [desc] 273 | :or {desc ""}}] 274 | (let [initial-delay (- ms-time (now)) 275 | pool-info @(:pool-atom pool)] 276 | (schedule-at pool-info fun initial-delay desc))) 277 | 278 | (defn after 279 | "Schedules fun to be executed after delay-ms (in 280 | milliseconds). 281 | 282 | Example usage: 283 | (after 1000 284 | #(println \"hello from the past\") 285 | pool 286 | :desc \"Message from the past\") ;=> prints 1s from now" 287 | [delay-ms fun pool & {:keys [desc] 288 | :or {desc ""}}] 289 | (let [pool-info @(:pool-atom pool)] 290 | (schedule-at pool-info fun delay-ms desc))) 291 | 292 | (defn shutdown-pool! 293 | [pool-info strategy] 294 | (case strategy 295 | :stop (shutdown-pool-gracefully! pool-info) 296 | :kill (shutdown-pool-now! pool-info))) 297 | 298 | (defn stop-and-reset-pool! 299 | "Shuts down the threadpool of given MutablePool using the specified 300 | strategy (defaults to :stop). Shutdown happens asynchronously on a 301 | separate thread. The pool is reset to a fresh new pool preserving 302 | the original size. Returns the old pool-info. 303 | 304 | Strategies for stopping the old pool: 305 | :stop - allows all running and scheduled tasks to complete before 306 | waiting 307 | :kill - forcefully interrupts all running tasks and does not wait 308 | 309 | Example usage: 310 | (stop-and-reset-pool! pool) ;=> pool is reset gracefully 311 | (stop-and-reset-pool! pool 312 | :strategy :kill) ;=> pool is reset forcefully" 313 | [pool & {:keys [strategy] 314 | :or {strategy :stop}}] 315 | (when-not (some #{strategy} #{:stop :kill}) 316 | (throw (Exception. (str "Error: unknown pool stopping strategy: " strategy ". Expecting one of :stop or :kill")))) 317 | (let [pool-atom (:pool-atom pool) 318 | ^ThreadPoolExecutor tp-executor (:thread-pool @pool-atom) 319 | num-threads (.getCorePoolSize tp-executor) 320 | new-t-pool (mk-sched-thread-pool num-threads) 321 | new-pool-info (mk-pool-info new-t-pool) 322 | old-pool-info (switch! pool-atom new-pool-info)] 323 | (future (shutdown-pool! old-pool-info strategy)) 324 | old-pool-info)) 325 | 326 | (defn- cancel-job 327 | "Cancel/stop scheduled fn if it hasn't already executed" 328 | [job-info cancel-immediately?] 329 | (if (:scheduled? job-info) 330 | (let [job (:job job-info) 331 | id (:id job-info) 332 | pool-info (:pool-info job-info) 333 | pool (:thread-pool pool-info) 334 | jobs-ref (:jobs-ref pool-info)] 335 | (.cancel ^Future job cancel-immediately?) 336 | (reset! (:scheduled? job-info) false) 337 | (dosync 338 | (let [job (get @jobs-ref id)] 339 | (commute jobs-ref dissoc id) 340 | (true? (and job (nil? (get @jobs-ref id))))))) ;;return true if success 341 | false)) 342 | 343 | (defn- cancel-job-id 344 | [id pool cancel-immediately?] 345 | (let [pool-info @(:pool-atom pool) 346 | jobs-info @(:jobs-ref pool-info) 347 | job-info (get jobs-info id)] 348 | (cancel-job job-info cancel-immediately?))) 349 | 350 | (defn stop 351 | "Stop a recurring or scheduled job gracefully either using a 352 | corresponding record or unique id. If you specify an id, you also 353 | need to pass the associated pool." 354 | ([job] (cancel-job job false)) 355 | ([id pool] (cancel-job-id id pool false))) 356 | 357 | (defn kill 358 | "kill a recurring or scheduled job forcefully either using a 359 | corresponding record or unique id. If you specify an id, you also 360 | need to pass the associated pool." 361 | ([job] (cancel-job job true)) 362 | ([id pool] (cancel-job-id id pool true))) 363 | 364 | (defn scheduled-jobs 365 | "Returns a set of all current jobs (both scheduled and recurring) 366 | for the specified pool." 367 | [pool] 368 | (let [pool-atom (:pool-atom pool) 369 | jobs @(:jobs-ref @pool-atom) 370 | jobs (vals jobs)] 371 | jobs)) 372 | 373 | (defn- format-start-time 374 | [date] 375 | (if (< date (now)) 376 | "" 377 | (str ", starts at: " (format-date date)))) 378 | 379 | (defn- recurring-job-string 380 | [job] 381 | (str "[" (:id job) "]" 382 | "[RECUR] created: " (format-date (:created-at job)) 383 | (format-start-time (+ (:created-at job) (:initial-delay job))) 384 | ", period: " (:ms-period job) "ms" 385 | (when (not= "" (:desc job)) 386 | (str ", desc: \"" (:desc job) "\"")))) 387 | 388 | (defn- scheduled-job-string 389 | [job] 390 | (str "[" (:id job) "]" 391 | "[SCHED] created: " (format-date (:created-at job)) 392 | (format-start-time (+ (:created-at job) (:initial-delay job))) 393 | (when (not= "" (:desc job)) 394 | (str ", desc: \"" (:desc job) "\"")))) 395 | 396 | (defn- job-string 397 | [job] 398 | (cond 399 | (= RecurringJob (type job)) (recurring-job-string job) 400 | (= ScheduledJob (type job)) (scheduled-job-string job))) 401 | 402 | (defn show-schedule 403 | "Pretty print all of the pool's scheduled jobs" 404 | ([pool] 405 | (let [jobs (scheduled-jobs pool)] 406 | (if (empty? jobs) 407 | (println "No jobs are currently scheduled.") 408 | (dorun 409 | (map #(println (job-string %)) jobs)))))) 410 | --------------------------------------------------------------------------------