Exemplo de programa simples em Perl TK

Bom nesse post eu mostrarei como exemplo um programa de minha autoria apesar de já existir versões para Web, Windows, Linux e até para o grande BeOS porem resolvi criar o meu próprio Post-It para o meu SO.
Usarei o Shadow Post-It para mostrar como o Perl utilizando Tk pode-se desenvolver ferramentas uteis e de tamanho bem pequeno.
Ok para esta demonstração imagino que o leitor ja tenha uma base de Perl caso contrário um excelente texto para isso poderá ser encontrado não seguinte endereço: http://perldoc.perl.org/perlintro.html

Abaixo segue o código com uma pequena imagem do utilitário cujo o código fonte tem aproximadamente 3Kb.



#!/usr/bin/perl

## Name: Shadow Post It
## Author: Daniel Vinciguerra - Daniel Shadow
## E-mail: daniel_5h4d0w@hotmail.com
## Site: http://danielshadow.blogspot.com
## Mantenha as referencias do autor original.

## Declaração dos modulos urilizados pelo programa.
use strict;
use Tk;
use Tk::Button;
use Tk::Frame;
use Tk::Text;

## Variaveis
my $postit;
my ($post, $arquivo);

## Aqui é declarada e chacada a localização do Banco de Dados ## Em SO Windows fica em C:\ já em SO Linux fica em /home/user/
if($ENV{POSTIT}){
$postit = $ENV{POST}
}else{
$postit = $ENV{HOME}.'/Post-it';
}

## Inicio da GUI (Interface gráfica do usuário)
my $mw=MainWindow->new(-title=>'Shadow Post It');
## Configurando o tamanho exato da janela
$mw->minsize(qw(150 150));
$mw->maxsize(qw(150 150));
my $Frame_Banner = $mw -> Frame ( -borderwidth=>2, -label=>'Shadow Post It', -relief=>'raised' ) -> pack(-fill=>'both');
my $Frame_Body = $mw -> Frame ( -background=>'Yellow', -relief=>'flat' ) -> pack(-ipady=>50, -ipadx=>80);
my $Text_post = $Frame_Body -> Text ( -background=>'Yellow', -relief=>'flat', -wrap=>'none', -state=>'normal' ) -> place(-height=>100, -width=>160);
my $Bt_Postit = $mw -> Button ( -background=>'Yellow', -text=>'Post It', -relief=>'flat', -state=>'normal', -command=>\&get_post ) -> pack(-fill=>'both');

## Checa para ver se o Banco de Dados existe...
## Caso exista ele extraira as informações dele e exibirá logo na execução.
if(-e $postit){
open(FILE, "< $postit") or die "\n Arquivo não encontrado!!!\n";
{
local $/=undef;
$arquivo = ;
}
$arquivo =~ s/^ //g;
$Text_post -> insert('end',"$arquivo");
close(FILE);
}
MainLoop;


## Iniciando a criação dos CallBacks (Funções do Programa)

sub get_post(){
## Este callback pegará as informações do Text Widget e ## salvará no Banco de Dados.

$post = $Text_post->get('1.0', 'end');

## Salvando informações no Banco de Dados...
open(POST, "> $postit") or die "\n Arquivo não encontrado!!!\n";
print POST ("$post");
close(POST);

## Limpa o Text Widget...
$Text_post -> delete('1.0','end');

## Inseri as novas informações no Text Widget...
open(FILE, "< $postit") or die "\n Arquivo não encontrado!!!\n";
{
local $/=undef;
$arquivo = ;
}
$arquivo =~ s/^ //g;
$Text_post -> insert('end',"$arquivo");
close(FILE);
return 0;
}


Pois bem isso é simplesmente um pequeno utilitário que construi devido minha constante falta de memória... Ele é bem util e bem pequeno como podem ver.
Porem meu objetivo aqui não é divulgar esta pequena ferramenta e sim mostrar como em poucas linhas pode-se se construir ferramentas e utilitários completamente funcionais e uteis com a Perl.

Por hoje é isso...