| 
									
										
										
										
											2015-04-09 13:44:03 -04:00
										 |  |  | ! Copyright (C) 2014 John Benediktsson | 
					
						
							|  |  |  | ! See http://factorcode.org/license.txt for BSD license | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2014-06-28 18:44:17 -04:00
										 |  |  | USING: alien alien.c-types alien.data alien.destructors | 
					
						
							| 
									
										
										
										
											2015-04-09 13:44:03 -04:00
										 |  |  | alien.syntax command-line curl.ffi destructors io | 
					
						
							|  |  |  | io.encodings.string io.encodings.utf8 io.streams.c kernel math | 
					
						
							|  |  |  | namespaces present sequences ;
 | 
					
						
							| 
									
										
										
										
											2014-06-28 18:44:17 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | IN: curl | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | <PRIVATE
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | DESTRUCTOR: curl_easy_cleanup | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | DESTRUCTOR: fclose | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2014-07-22 11:40:06 -04:00
										 |  |  | : check-code ( code -- )
 | 
					
						
							|  |  |  |     CURLE_OK assert= ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2014-06-28 18:44:17 -04:00
										 |  |  | : curl-init ( -- CURL )
 | 
					
						
							|  |  |  |     curl_easy_init &curl_easy_cleanup ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2014-07-22 11:40:06 -04:00
										 |  |  | : curl-set-opt ( CURL key value -- )
 | 
					
						
							|  |  |  |     curl_easy_setopt check-code ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2014-06-28 18:44:17 -04:00
										 |  |  | : curl-set-url ( CURL url -- )
 | 
					
						
							| 
									
										
										
										
											2014-07-22 11:40:06 -04:00
										 |  |  |     CURLOPT_URL swap present curl-set-opt ;
 | 
					
						
							| 
									
										
										
										
											2014-06-28 18:44:17 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | : curl-set-file ( CURL path -- )
 | 
					
						
							| 
									
										
										
										
											2014-07-22 11:40:06 -04:00
										 |  |  |     CURLOPT_FILE swap "wb" fopen &fclose curl-set-opt ;
 | 
					
						
							| 
									
										
										
										
											2014-06-28 18:44:17 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | : curl-perform ( CURL -- )
 | 
					
						
							| 
									
										
										
										
											2014-07-22 11:40:06 -04:00
										 |  |  |     curl_easy_perform check-code ;
 | 
					
						
							| 
									
										
										
										
											2014-06-28 18:44:17 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | PRIVATE>
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : curl-download-to ( url path -- )
 | 
					
						
							|  |  |  |     [ | 
					
						
							|  |  |  |         curl-init | 
					
						
							|  |  |  |         [ swap curl-set-file ] | 
					
						
							|  |  |  |         [ swap curl-set-url ] | 
					
						
							|  |  |  |         [ curl-perform ] tri
 | 
					
						
							|  |  |  |     ] with-destructors ;
 | 
					
						
							| 
									
										
										
										
											2015-04-09 13:44:03 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | : curl-main ( -- )
 | 
					
						
							|  |  |  |     command-line get [ | 
					
						
							|  |  |  |         curl-init | 
					
						
							|  |  |  |         [ swap curl-set-url ] | 
					
						
							|  |  |  |         [ curl-perform ] bi
 | 
					
						
							|  |  |  |     ] each ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | MAIN: curl-main |