Форум Flasher.ru
Ближайшие курсы в Школе RealTime
Список интенсивных курсов: [см.]  
  
Специальные предложения: [см.]  
  
 
Блоги Правила Справка Пользователи Календарь Поиск рулит! Сообщения за день Все разделы прочитаны
 

Вернуться   Форум Flasher.ru > Блоги > e4xu

Всякие разные штуки сомнительной полезности сделанные в свободное от работы время.
Оценить эту запись

Если у вас есть Ubuntu, много свободного времени и желание сделать что-то необычное

Запись от wvxvw размещена 19.03.2011 в 14:16
Обновил(-а) wvxvw 19.03.2011 в 16:38

В таком случае вашему вниманию предлагается... веб сервер! И руководство по эксплуатации. Веб сервер умеет только что загружать картинки сгенеренные флешем, подписывать их и отдавать в публичный доступ. Конечно, пытливый читатель, если у него есть много времени, возможно найдет другое, более полезное применение этому необычному существу.
На самом деле сервер был написан не мной, а Edi Weitz. Он же автор большого количества библиотек для Common Lisp. Я только воспользовался готовыми библиотеками для того, чтобы собрать, что и собираюсь вам представить.
Кроме Edi Weitz, есть еще другой человек, косвенно имеющий отношение к происходящему - BlooDHounD, а именно его библиотека для работы с JPEG форматом. На всякий случай, если вы вдруг забыли: http://www.blooddy.by/en/crypto/ .
AS3 код скорее всего в комментариях не нуждается, вы наверняка сможете придумать более интересный способ получить картинку, чем нарисовать несколько концентрических прямоугольников, поэтому перейдем сразу к Lisp'у.
Т.как я только-только в самом начале изучения, то, скорее всего код изобилует всякими нелепостями, тем не менее - работает! Так вот, если вам захочется воспроизвести пример, вам понадобится SBCL, это один из диалектов, или если угодно, вендоров Common Lisp. С ним есть одна небольшая проблема - его текущая версия ушла далеко от того, что есть в Debian PPA, поэтому лучше не пользоваться aptitude, а скачать с сайта. Самым простым способом его установить - из бинарников, предварительно прочитав INSTALL рекомендации. Домашняя страница: http://www.sbcl.org/ .
Установив SBCL, у вас уже будет среда разработки, но еще не будет всех нужных библиотек.
Следующим шагом вам понадобится инстумент по заргузке библиотек. Стандарт ANSI предлагает только (require) функцию для заргузки. Но пользоватся ею иногда неудобно, особенно если нужно загрузить много файлов, скомпилировать и поместить куда нужно. Традиционно Common Lisp вендоры, SBCL в их числe, вместе с рантаймом и компиляторм предоставляют и ASDF библиотеку, предназначенную сделать (require) более универсальным. Но... как и много хороших начинаний, работает не всегда. Нужно знать что она делает, и что у нее должно получиться, чтобы ею пользоваться, что делает ее ультимативно бесполезной. Зная о такой ситуации Zach Beane написал http://www.quicklisp.org/beta/ QL библиотеку. Она и используется в этом примере для заргузки всех остальных используемых пакетов.
Кроме этого, используется библиотека, возможно извесная вам ранее из PHP - GD. Но не совсем та же библиотека, а ее разновидность скомпилированая для подргузки в другие языки, такие как C, ну или Lisp. Я воспользовался тем, что было в PPA: libgd-dev. Это алиас на две разные библиотеки, одна с xmp, вротая без. Что такое xmp я не знаю, но выбрал ту, что с ним - ну лучше же, чтобы было, разве нет? К ней все тот же Edi Weitz написал оболочку делающую ее использование возможным и в Lispe через CFFI (это такая библиотека для обращения к стороннему коду). Но эту оболочку вам прийдется компилировать самому - в коде есть ссылка на подpобные инструкции, ну или отркойте Make файл прилагающийся к ней и посмотрите как там сделано.
Листинги основного кода:
Common Lisp
Код:
; See how to get ql library here: http://www.quicklisp.org/beta/
; This assumes that quickload has been already installed and set
; to load automatically (ql:add-to-init-file)
; -----------------------------------------------------------------

; To start this program: $ sbcl
; (load "./image-upload-test.lisp")
; If everything goes well, then you have to see:
; "Starting test web server on localhost port 8080..."
; message.

; Regular expressions library
; Credits go here: http://weitz.de/cl-ppcre/
(ql:quickload :cl-ppcre)

; A library for processing and generation of XML
; Credits go here: http://common-lisp.net/project/cxml/ 
(ql:quickload :cxml)         

; CL bindings for GD graphic library
; Important installation instruction: http://weitz.de/cl-gd/#install
(ql:quickload :cl-gd)

; Hunchentoot HTTP server 
; see: http://www.weitz.de/hunchentoot/#reference 
(ql:quickload :hunchentoot)

; Author: wvxvw
; The code below is of a very dubious value. Of course you
; can use it if you want :) You are responsible for all
; damage done. 
(defpackage :image-upload-test)

(setq hunchentoot:*catch-errors-p* nil)

(setq hunchentoot:*dispatch-table*
	`(,(hunchentoot:create-regex-dispatcher 
		"\\/services\\/save\\/[^\\/]+" 
		'save-from-raw-post)
	,(hunchentoot:create-folder-dispatcher-and-handler 
		"/images/snapshots/" 
		"./images/snapshots/")
	,(hunchentoot:create-static-file-dispatcher-and-handler
		"/crossdomain.xml" 
		"./crossdomain.xml")
	,(hunchentoot:create-folder-dispatcher-and-handler
		"/flash/" "./flash/"))
)

(defun result-to-xml (text was-error)
	"Formats output into an XML document and sets servers' response headers
to be text/xml"
	(setf (hunchentoot:header-out "content-type") "text/xml")
	(format nil "~a~%"
		(cxml:with-xml-output (cxml:make-string-sink :indentation 2 :canonical nil)
			(cxml:with-element "result"
				(cxml:attribute "status" (if was-error "error" "ok"))
				(cxml:with-element (if was-error 
					"error-description" 
					"message-content")
					(cxml:text text)	
				)
			)
		)
	)
)

(defun find-name-re (uri)
	"Returns the last URI part before the query string"
	(let ((result "default"))
		(cl-ppcre:do-scans (start end re-start re-end "[^\\/\\?]+" uri)
			(setf result (subseq uri start end))
		)
		result
	)
)

(defun save-original-image (image-name)
	"Saves an image to a folder {*server-root*}/images/temp/{image-name}.jpeg"
	(let ((new-path (concatenate 'string "./images/temp/" image-name ".jpeg")))
		(with-open-file (stream new-path
			:direction :output :if-exists :supersede 
			:element-type '(unsigned-byte 8))
			(write-sequence 
				(hunchentoot:raw-post-data 
					:request hunchentoot:*request* 
					:force-binary t)
				stream)
		)
		new-path
	)
)

(defun save-image (old-name new-name)
	"Combines an image from the {old-name} image file and saves it to {new-name} file"
	(cl-gd:with-image-from-file (old old-name)
		(multiple-value-bind (width height)
			(cl-gd:image-size old)
			(cl-gd:with-image (new width (+ height 20) t)
				(cl-gd:allocate-color 0 0 0 :image new)
				(let ((white (cl-gd:allocate-color 255 255 255 :image new)))
					(cl-gd:copy-image old new 0 0 0 0 width height)
					(cl-gd:draw-string 5 (+ height 3)
						"Generated with cl-gd." 
						:image new
						:font :small 
						:color white
					)
				)
				(cl-gd:write-image-to-file 
					(concatenate 'string 
						"./images/snapshots/" 
						new-name ".jpeg")
					:image new :if-exists :supersede 
					:quality 100)
				(delete-file (pathname old-name))
			)
		)
	)
)

(defun save-from-raw-post ()
	"Accepts the request to \\/services\\/save\\/[^\\/]+ and generates 
response. Successful response will contain new image URL. Fail response will 
contain error message."
	(handler-case
		(let ((save-path (find-name-re (hunchentoot:request-uri 
			hunchentoot:*request*))))
			(if (hunchentoot:raw-post-data 
				:request hunchentoot:*request* 
				:force-binary t)
				(progn 
					(save-image (save-original-image save-path) save-path)
					; If we got this far, then we succeeded saving an image.
					; Let's tell client we're done.
					(result-to-xml (concatenate 'string 
						"images/snapshots/" save-path ".jpeg") nil)
				)
				; Of course you would want to be more sophisticated than that...
				(result-to-xml "The client did not send a proper request" t)
			)
		)
		; We will catch any condition and send it to the client
		; This may not be the best way to do it, and you 
		; will most probably want to return 500+ status as well
		; but Flash isn't able to read the body of the non-successful message...
		(condition (the-condition) (result-to-xml the-condition t))
	)
)

;;---------------------------->8 cut here 8<------------------------------------

(defun start-server ()
	(format t "Starting test web server on localhost port 8080...")
	(hunchentoot:start (make-instance 'hunchentoot:acceptor :port 8080))
)

(start-server)
ActionScript 3
Код AS3:
package tests
{
	import by.blooddy.crypto.image.JPEGEncoder;
 
	import flash.display.Bitmap;
	import flash.display.BitmapData;
	import flash.display.Loader;
	import flash.display.Sprite;
	import flash.display.StageAlign;
	import flash.display.StageScaleMode;
	import flash.events.ErrorEvent;
	import flash.events.Event;
	import flash.events.IOErrorEvent;
	import flash.events.SecurityErrorEvent;
	import flash.geom.Matrix;
	import flash.geom.Point;
	import flash.geom.Rectangle;
	import flash.net.URLLoader;
	import flash.net.URLLoaderDataFormat;
	import flash.net.URLRequest;
	import flash.net.URLRequestMethod;
	import flash.text.engine.ContentElement;
	import flash.text.engine.ElementFormat;
	import flash.text.engine.FontDescription;
	import flash.text.engine.TextBlock;
	import flash.text.engine.TextElement;
	import flash.text.engine.TextLine;
	import flash.utils.ByteArray;
 
	/**
	 * $ mxmlc tests.HunchnentootTest.as -o=HunchentootTest.swf \
	 * -static-link-runtime-shared-libraries=true -debug=true
	 */
	[SWF(width="800", height="600")]
 
	/**
	 * A demonstration of communication to Hunchentoot server and 
	 * a test service running at it for saving images.
	 * 
	 * @author wvxvw
	 * 
	 * @playerversion 10.1
	 */
	public class HunchentootTest extends Sprite
	{
		private const _loader:URLLoader = new URLLoader();
		private const _serviceURI:String = "/services/save/";
		private const _imageQality:uint = 95;
		private const _imageLoader:Loader = new Loader();
 
		public function HunchentootTest()
		{
			super();
			this.test();
		}
 
		private function test():void
		{
			super.stage.align = StageAlign.TOP_LEFT;
			super.stage.scaleMode = StageScaleMode.NO_SCALE;
			this._loader.dataFormat = URLLoaderDataFormat.BINARY;
			var image:BitmapData = new BitmapData(300, 200, false, 0xFF0000);
			image = this.drawRecursiveRectange(image, image.rect);
			var original:Bitmap = new Bitmap(image);
			super.addChild(original);
			var request:URLRequest = new URLRequest(
				this.buildRequestURL("test-" + (Math.random() * 0xFFFFFFFF).toString(32)));
			request.method = URLRequestMethod.POST;
			request.data = JPEGEncoder.encode(image, this._imageQality);
			this._loader.addEventListener(Event.COMPLETE, this.completeHandler);
			this._loader.addEventListener(IOErrorEvent.IO_ERROR, this.errorHandler);
			this._loader.addEventListener(
				SecurityErrorEvent.SECURITY_ERROR, this.errorHandler);
			this._loader.load(request);
			this._imageLoader.contentLoaderInfo.addEventListener(
				Event.COMPLETE, this.bytes_completeHandler);
			this._imageLoader.loadBytes(request.data as ByteArray);
		}
 
		private function bytes_completeHandler(event:Event):void
		{
			var data:BitmapData = new BitmapData(300, 220, false, 0);
			var source:BitmapData = (this._imageLoader.content as Bitmap).bitmapData;
			data.copyPixels(source, source.rect, new Point(0, 0));
			var block:TextBlock = 
				new TextBlock(
					new TextElement("Generated with BlooDHounD crypto lib.",
						new ElementFormat(new FontDescription("_sans"), 10, 0xFFFFFF)));
			data.draw(block.createTextLine(null, 300), 
				new Matrix(1, 0, 0, 1, 0, 213));
			var bitmap:Bitmap = new Bitmap(data);
			bitmap.y = 210;
			super.addChild(bitmap);
		}
 
		private function buildRequestURL(file:String):String
		{
			return this._serviceURI + file;
		}
 
		private function drawRecursiveRectange(image:BitmapData, 
			rectangle:Rectangle):BitmapData
		{
			var large:Rectangle = image.rect;
			var stepX:uint = large.width * 0.1;
			var stepY:uint = large.height * 0.1;
 
			if (Math.min(rectangle.width, rectangle.height) > Math.max(stepX, stepY))
			{
				image.fillRect(rectangle, Math.random() * 0xFFFFFF);
				rectangle.width -= stepX;
				rectangle.height -= stepY;
				rectangle.x += stepX * 0.5;
				rectangle.y += stepY * 0.5;
				return this.drawRecursiveRectange(image, rectangle);
			}
			return image;
		}
 
		private function completeHandler(event:Event):void
		{
			var result:XML = XML(this._loader.data);
			if (result.@status == "error")
			{
				trace("The server replied with an error:", 
					result.child("error-description"));
			}
			else if (result.@status == "ok")
			{
				this._imageLoader.contentLoaderInfo.removeEventListener(
					Event.COMPLETE, this.bytes_completeHandler);
				this._imageLoader.contentLoaderInfo.addEventListener(
					Event.COMPLETE, this.remote_completeHandler);
				this._imageLoader.unload();
				this._imageLoader.load(
					new URLRequest("/" + result.child("message-content")));
			}
			else trace("Protocol error!", this._loader.data);
		}
 
		private function remote_completeHandler(event:Event):void
		{
			var bitmap:Bitmap = 
				new Bitmap((this._imageLoader.content as Bitmap).bitmapData);
			bitmap.x = 310;
			super.addChild(bitmap);
		}
 
		private function errorHandler(event:ErrorEvent):void
		{
			trace(event);
		}
	}
}
Crossdomain.xml
Код:
<?xml version="1.0"?>
<!DOCTYPE cross-domain-policy SYSTEM "http://www.adobe.com/xml/dtds/cross-domain-policy.dtd">
<cross-domain-policy>
	<site-control permitted-cross-domain-policies="master-only" />
	<allow-access-from domain="*" />
</cross-domain-policy>
Вот что-то такое вы должны будете увидеть после запуска:

Название: hunchentoot-first-test.png
Просмотров: 890

Размер: 19.9 Кб

Завтра еще выложу проект.
Всего комментариев 5

Комментарии

Старый 20.03.2011 18:01 Psycho Tiger вне форума
Psycho Tiger
 
Аватар для Psycho Tiger
Я не очень вот понял. Это пример создания сервера для сохранения картинок на CLisp?
Старый 20.03.2011 18:14 wvxvw вне форума
wvxvw
 
Аватар для wvxvw
Угум, для сохранения и последующей раздачи.
Просто бытует мнение, что Лисп = матан / научные исследования / искуственный интеллект и т.п. И что он мало пригоден для повседневного програмирования. Не смотря на то, что я его еще очень плохо знаю, мне кажется, что это очень даже далеко от действительности. Пока то, что "осилил" очень даже нравится.
Старый 20.03.2011 18:31 Psycho Tiger вне форума
Psycho Tiger
 
Аватар для Psycho Tiger
Матан это скорее Хаскель =)
В принципе, даже на прологе можно программировать повседневные задачи, но вот там это пахнет извращением. А функциональные языки, скорее всего, когда-нибудь со временем займут часть той ниши, которую занимают сейчас ООП-языки.
Старый 21.03.2011 04:19 Котяра вне форума
Котяра
 
Аватар для Котяра
эрланг рулит.
если бы ещё иде красивое к нему, было бы шоколадно.
Код AS3:
fact(0) -> 1;
fact(N) -> N * fact(N-1).
Обновил(-а) Котяра 21.03.2011 в 04:24
Старый 21.03.2011 12:00 wvxvw вне форума
wvxvw
 
Аватар для wvxvw
Код:
(defun fact (n) (if (= n 0) 1 (* n (fact (- n 1)))))
А это уже лямбда счисления
Код:
Y(λT.TUPLE-2(λn.COND (=n 0)1((INDEX 2 T)n))(λn.*n((INDEX 1 T)(-n 1))))
А вообще, я даж не знаю, мне нравится потому, что я просто элементарно не могу запомнить 100500 конструкций и ключевых слов bash / sh и т.п. И Перл с Питоном меня тож как-то не привлекают. А на лиспе просто по-человечески удобно, если какую-то мелочь надо написать. А главное, язык простой, и легко понять, не нужно учить кучи конструкций и их побочных эффектов (хотя, в итоге тоже нужно, чтобы понимать чужой код, но для своего - достаточно только S-выражений, и можно написать что угодно).

EDIT: Да, еще, почему Лисп. После даже немного вникания в основы... некоторые вещи стали, ну как бы это сказать, вобщем, что-то, о чем раньше вообще не задумывался, и что казалось очевидным и само собой разумеющимся, вдруг оказалось вовсе не таким.
Например, математические функции сложения и умножения - ведь нет никакой реальной причины к тому, чтобы они были ограничены двумя аргументами. Но традиционная для других языков запись делает невозможным для функции прибавления принять более двух аргументов. Тот же Си, в котором переопределить можно практически все, что угодно - ну не заставить его никак принимать в функцию сложения более одного аргумента (чтобы сложить с другим).
Я не знаю правда, как с этим в Эрланг, хотя он с виду похож на Миранду, и там вроде была такая возможность...
Обновил(-а) wvxvw 21.03.2011 в 14:41
 

 


Часовой пояс GMT +4, время: 13:51.


Copyright © 1999-2008 Flasher.ru. All rights reserved.
Работает на vBulletin®. Copyright ©2000 - 2024, Jelsoft Enterprises Ltd. Перевод: zCarot
Администрация сайта не несёт ответственности за любую предоставленную посетителями информацию. Подробнее см. Правила.