#!/usr/bin/perl -wT use strict; use CGI; use Template::Toolkit; my $template = Template->new({ INCLUDE_PATH => '/path/to/html/files'}); my $page = 'index.html'; $template->process($page) or die "Failed to process $page" . $template->error; index.html: [% INCLUDE header.html title = "Teste do template toolkit" %] [% INCLUDE menu.html %]

Escolha um dos links no menu à esquerda.

Descrição dos links:

[% INCLUDE footer.html %] =========================================================== package SQL::Translator::Producer::PostgreSQL; ... sub drop_field { my ($old_field) = @_; my $out = sprintf('ALTER TABLE %s DROP COLUMN %s', $old_field->table->name, $old_field->name); return $out; } 1; ---- t/47-pg-producer.t my $dp = SQL::Translator::Producer::PostgreSQL->can('drop_field'); # my $drop_field = SQL::Translator::Producer::PostgreSQL::drop_field($field2); my $drop_field = $dp->($field2); is($drop_field, '', 'Drop field works'); ---- Undefined subroutine &SQL::Translator::Producer::PostgreSQL::drop_field called at t/47postgres-producer.t line 62. DB<1> x $dp 0 CODE(0x85d14a4) -> &CODE(0x85d14a4) in ??? DB<4> $foo = SQL::Translator::Producer::PostgreSQL->can('alter_field'); DB<5> x $foo 0 CODE(0x85d0bf8) -> &SQL::Translator::Producer::PostgreSQL::alter_field in lib/SQL/Translator/Producer/PostgreSQL.pm:646-679 ======================================================================================== my $options_coderef = sub { my ($obj, $option, $is_remote,$is_enabled, $was_enabled, $buf_position) = @_; if($option == TELOPT_TSPEED) { print "TSPEED enabled\n" if($is_enabled); } } $telnetSock->option_callback($options_coderef); my $suboption_coderef = sub { my ($obj, $option, $params) = @_; if($option == TELOPT_TSPEED) { print "Got $params for TSPEED\n"; } } $telnetSock->suboption_callback($suboption_coderef); # #$telnetSock->option_accept( # Will => "TELOPT_TSPEED", # Will => "TELOPT_TTYPE", # Will => "TELOPT_XDISPLOC", # Will => "TELOPT_NEW_ENVIRON", # Will => "TELOPT_LFLOW", ## Do => "TELOPT_XDISPLOC", ## Do => "TELOPT_XDISPLOC", #); ============================================================ Dumper Prompt attempting to run a nonexistant htmlcode on Everything pre1.0 .. Data::Dumper: Error In Code: No function or htmlcode named 'testme' exists. at /usr/lib/perl5/vendo +r_perl/5.8.6/CGI/Carp.pm line 314. Executed: 1: testme(); DDS: No arguments! at /usr/lib/perl5/vendor_perl/5.8.7/i686-linux-thread-multi/Data/Dump/Streamer.pm line 1090 Data::Dump::Streamer::Data('Data::Dump::Streamer=HASH(0x8ffd440)') called at /usr/lib/perl5/vendor_perl/5.8.7/i686-linux-thread-multi/Data/Dump/Streamer.pm line 1625 Data::Dump::Streamer::Out('Data::Dump::Streamer=HASH(0x8ffd440)') called at /usr/lib/perl5/vendor_perl/5.8.7/i686-linux-thread-multi/Data/Dump/Streamer.pm line 573 Data::Dump::Streamer::Dumper() called at (eval 781) line 15 eval ' return "" unless $query->param("dumper_action") eq \'Execute\'; my $execstr = $query->param("dumper_code"); my $str = ""; if($execstr) { my $error; my $code = do { local($SIG{__DIE__})= sub {}; local($SIG{__WARN__})= sub {}; # use Data::Dumper; use Data::Dump::Streamer \'Dumper\'; my $dump=Dumper(eval $execstr); $error=$@; eval{1}; $error || $dump }; my $line; if ($error) { $execstr=~s/^/sprintf "%3d: ",++$line/gem; $execstr=$query->escapeHTML($execstr); $execstr=~s/ / /g; $execstr=" $execstr "; } else { $execstr=wrapcode("\\n$execstr\\n"); } return ($error ? \' Error In Code: \' : " Result: ") . wrapcode( "\\n$code\\n" ) . " Executed: ". $execstr . " "; } else { return qq Nothing to Dump. ; } ;' called at /usr/local/everything/Everything/HTML.pm line 898 Everything::HTML::evalX('\x{a} return "" unless $query->param("dumper_action") eq \'Execu...', 'Everything::Node=HASH(0x8b8e74c)') called at /usr/local/everything/Everything/HTML.pm line 830 Everything::HTML::evalXTrapErrors('\x{a} return "" unless $query->param("dumper_action") eq \'Execu...', 'Everything::Node=HASH(0x8b8e74c)') called at /usr/local/everything/Everything/HTML.pm line 1277 Everything::HTML::embedCode('\x{a} return "" unless $query->param("dumper_action") eq \'Execu...', 'Everything::Node=HASH(0x8b8e74c)') called at /usr/local/everything/Everything/HTML.pm line 1430 Everything::HTML::oldparseCode('doctext', 'Everything::Node=HASH(0x8b8e74c)') called at /usr/local/everything/Everything/HTML.pm line 1332 Everything::HTML::parseCode('doctext', 'Everything::Node=HASH(0x8b8e74c)') called at (eval 767) line 2 eval ' my ($field, $nolinks) = @_; my $text = parseCode ($field, $NODE); $text =~ s/\\(.*?)\\/linkNodeTitle ($1, $NODE)/egs unless $nolinks; $text;' called at /usr/local/everything/Everything/HTML.pm line 898 Everything::HTML::evalX(' \x{9}my ($field, $nolinks) = @_;\x{a}\x{9}my $text = parseCode ($field, ...', 'Everything::Node=HASH(0x8ce5290)', 'doctext') called at /usr/local/everything/Everything/HTML.pm line 968 Everything::HTML::AUTOLOAD('doctext') called at (eval 761) line 1 eval 'parsecode(\'doctext\');' called at /usr/local/everything/Everything/HTML.pm line 898 Everything::HTML::evalX('parsecode(\'doctext\');', 'Everything::Node=HASH(0x8cc0018)') called at /usr/local/everything/Everything/HTML.pm line 830 Everything::HTML::evalXTrapErrors('parsecode(\'doctext\');', 'Everything::Node=HASH(0x8cc0018)') called at /usr/local/everything/Everything/HTML.pm line 1273 Everything::HTML::embedCode('\x{a} return "" unless $query->param("dumper_action") eq \'Execu...', 'Everything::Node=HASH(0x8cc0018)') called at /usr/local/everything/Everything/HTML.pm line 1430 Everything::HTML::oldparseCode('page', 'Everything::Node=HASH(0x8cc0018)') called at /usr/local/everything/Everything/HTML.pm line 1332 Everything::HTML::parseCode('page', 'Everything::Node=HASH(0x8cc0018)') called at /usr/local/everything/Everything/HTML.pm line 1815 Everything::HTML::displayPage('Everything::Node=HASH(0x8b8e74c)') called at /usr/local/everything/Everything/HTML.pm line 1959 Everything::HTML::gotoNode(357, 279) called at /usr/local/everything/Everything/HTML.pm line 2246 Everything::HTML::handleUserRequest() called at /usr/local/everything/Everything/HTML.pm line 2820 Everything::HTML::mod_perlInit('virtbook:root:C466lda:') called at /srv/www/localhost/htdocs/virtbook/index.pl line 11 1: 2: return "" unless $query->param("dumper_action") eq 'Execute'; 3: 4: my $execstr = $query->param("dumper_code"); 5: my $str = ""; 6: 7: if($execstr) 8: { 9: my $error; 10: my $code = do { 11: local($SIG{__DIE__})= sub {}; 12: local($SIG{__WARN__})= sub {}; 13: # use Data::Dumper; 14: use Data::Dump::Streamer 'Dumper'; 15: my $dump=Dumper(eval $execstr); 16: $error=$@; 17: eval{1}; 18: $error || $dump 19: }; 20: my $line; 21: if ($error) { 22: $execstr=~s/^/sprintf "%3d: ",++$line/gem; 23: $execstr=$query->escapeHTML($execstr); 24: $execstr=~s/ / /g; 25: $execstr="
$execstr
"; 26: } else { 27: $execstr=wrapcode("\n$execstr\n"); 28: } 29: return ($error ? '

Error In Code:

' : "

Result:

") 30: . wrapcode( "\n$code\n" ) 31: . "

Executed:

". $execstr . "
"; 32: } else { 33: return qq

Nothing to Dump.

; 34: } Call Stack: /usr/local/everything/Everything/HTML.pm:306:Everything::HTML::htmlErrorGods /usr/local/everything/Everything/HTML.pm:834:Everything::HTML::htmlFormatErr /usr/local/everything/Everything/HTML.pm:1277:Everything::HTML::evalXTrapErrors /usr/local/everything/Everything/HTML.pm:1430:Everything::HTML::embedCode /usr/local/everything/Everything/HTML.pm:1332:Everything::HTML::oldparseCode (eval 767):2:Everything::HTML::parseCode /usr/local/everything/Everything/HTML.pm:898:(eval) /usr/local/everything/Everything/HTML.pm:968:Everything::HTML::evalX (eval 761):1:Everything::HTML::AUTOLOAD /usr/local/everything/Everything/HTML.pm:898:(eval) /usr/local/everything/Everything/HTML.pm:830:Everything::HTML::evalX /usr/local/everything/Everything/HTML.pm:1273:Everything::HTML::evalXTrapErrors /usr/local/everything/Everything/HTML.pm:1430:Everything::HTML::embedCode /usr/local/everything/Everything/HTML.pm:1332:Everything::HTML::oldparseCode /usr/local/everything/Everything/HTML.pm:1815:Everything::HTML::parseCode /usr/local/everything/Everything/HTML.pm:1959:Everything::HTML::displayPage /usr/local/everything/Everything/HTML.pm:2246:Everything::HTML::gotoNode /usr/local/everything/Everything/HTML.pm:2820:Everything::HTML::handleUserRequest /srv/www/localhost/htdocs/virtbook/index.pl:11:Everything::HTML::mod_perlInitEnd Call Stack ================================================================ ^((((31\.(0?[13578]|1[02]))|((29|30)\.(0?[1,3-9]|1[0-2])))\.(1[6-9]|[2-9][0-9])?[0-9]{2})|(29\.0?2\.(((1[6-9]|[2-9][0-9])?(0[48]|[2468][048]|[13579][26])|((16|[2468][048]|[3579][26])00))))|(0?[1-9]|1[0-9]|2[0-8])\.((0?[1-9])|(1[0-2]))\.((1[6-9]|[2-9][0-9])?[0-9]{2}))$ =================================================================== SELECT W1.WMKEY as item, MD031A, MD051, MD020, MD311, MD331 FROM WMAG5 as w1 JOIN (select WMKEY, MAX(MDV02) from WMAG5 group by wmkey) as w2 on w1.wmkey=w2.wmkey ORDER BY WMAG5.WMKEY ============================================================= my $sock = new IO::Socket::INET( PeerAddr => $hostname, PeerPort => $port, Proto => 'tcp', Timeout => 60 ); die "Can't connect ($!)" unless $sock; my $sockets = IO::Select->new(); $sockets->new($sock); while(1) { my $data; my @handles; if($sockets) { @handles = $sockets->can_read(0.5); foreach $handle (@handles) { if($handle == $sock) { my $y = recv($sock, $data, 1024, 0); last if(!$data); use_data($data); } } } } =============================================================== (defun bdecode (str) (let* ((index 0) (rest nil) (val nil) (chr (substring str index 1))) (cond ((equal chr "e") (cons nil (substring str 1))) ; end of list/dict ((equal chr "i") ; integer (progn (setq index (+ 1 (string-match "e" str))) (setq rest (substring str index)) (setq val (string-to-number (substring str 1 (- index 1)))) (cons val rest))) ((equal chr "l") ; list (progn (let ((lst nil)) (setq val (bdecode (substring str 1))) (while (car val) (push (car val) lst) (setq val (bdecode (cdr val)))) (setq rest (cdr val)) (cons lst rest)))) ((equal chr "d") ; dictionary (progn (let ((dict nil) (key nil)) (setq key (bdecode (substring str 1))) (while (car key) (setq val (bdecode (cdr key))) (add-to-list 'dict (cons (car key) (car val))) (setq key (bdecode (cdr val)))) (setq rest (cdr key)) (cons dict rest)))) ((> (string-to-number chr) 0) ; string (progn (let ((len 0)) (setq index1 (+ 1 (or (string-match ":" str) (+ 1 (length str))))) (setq index2 (+ 1 (or (string-match "\\." str) (+ 1 (length str))))) (setq index (if (< index1 index2) index1 index2)) (setq len (string-to-number (substring str 0 (- len 1)))) (cond ((= len 0) nil) (t (cons (substring str index (+ len index)) (substring str (+ len index)))))))) ))) ================================================================================ Amusing DB2 fun: CASE WHEN t.action = 1 and q.name <> 'First_Level' THEN 0 WHEN q.name = 'First_Level' THEN -1 * fMISExcelTime(statustime) ELSE fMISExcelTime(statustime) AS Time, -> DB21034E The command was processed as an SQL statement because it was not a valid Command Line Processor command. During SQL processing it returned: SQL0104N An unexpected token ")" was found following "ExcelTime(statustime". Expected tokens may include: ")". SQLSTATE=42601 ================================================================== #!/usr/bin/perl -w use strict; use WWW::Mechanize; use Getopt::Long; my $action = 'prepend'; my $user = ''; my $passwd = ''; my $field = 'public'; my $code = 0; my $file = ''; GetOptions ('action:s' => \$action, 'user=s' => \$user, 'passwd=s' => \$passwd, 'field:s' => \$field, 'code' => \$code, 'file:s' => \$file ); die "Usage $0 --user \"User\" --passwd \"Password\" [--action \"prepend|append|replace\"] [--field \"public|private\"] [--code] [--file \"\"] " if(!$user || !$passwd) ; my $agent = WWW::Mechanize->new(); $agent->env_proxy(); # Login and get the node-to-be-retitled $agent->get("http://www.perlmonks.org/index.pl?node=$user;nodetype=user"); $agent->form_name('login'); $agent->current_form->value('user', $user); $agent->current_form->value('passwd', $passwd ); $agent->current_form->value('expires', '+10y'); $agent->submit(); $agent->follow('Edit'); $agent->form(2); my $orig; my $fieldname = ''; if($field eq 'public') { $orig = $agent->current_form->value('scratchpad_doctext'); $fieldname = 'doctext'; } elsif($field eq 'private') { $orig = $agent->current_form->value('scratchpad_privatetext'); $fieldname = 'privatetext'; } else { die "Usage $0 --user \"User\" --passwd \"Password\" [--action \"prepend|append|replace\"] [--field \"public|private\"] [--code] [--file \"\"]"; } print $orig; print "Current size: " . length($orig), "\n"; if(!$file) { exit; } open my $f, "<", $file or die "Can't open $file ($!)"; my @contents = <$f>; close($f); my $value = join('', @contents); print "Adding: $value\n"; if($code) { $value = '' . $value . ''; } if($action eq 'prepend') { $value = $value . "\n" . $orig; } elsif($action eq 'append') { $value = $orig . "\n" . $value; } print "New size: " . length($value), "\n"; $agent->current_form->value("scratchpad_$fieldname", $value); $agent->submit(); ================================================================== ================================================================= CDBI tables: CREATE TABLE Muds (ID INTEGER PRIMARY KEY, Status INTEGER, IP_Address VARCHAR(15), MudPort INTEGER, lib_id INTEGER, baselib_id INTEGER, driver_id INTEGER, type_id INTEGER, AdminEmail VARCHAR(30), update_id INTEGER); CREATE TABLE Intermud2 (mud_id INTEGER, Name VARCHAR(50), LastContact DATE, UDPPort INTEGER, inetd_id INTEGER, UpdateEmail VARCHAR(30)); CREATE TABLE Intermud3 (mud_id INTEGER, Name VARCHAR(50), LastContact DATE, OOBTcpPort INTEGER, OOBUdpPort INTEGER, OpenStatus VARCHAR(255)); CREATE TABLE MudUpdate (ID INTEGER, DateTime DATE, IPChange_id INTEGER); CREATE TABLE Libraries (ID INTEGER PRIMARY KEY, Name VARCHAR(50), Version VARCHAR(10)); CREATE TABLE Drivers (ID INTEGER PRIMARY KEY, Name VARCHAR(50), Version VARCHAR(10)); CREATE TABLE Types (ID INTEGER PRIMARY KEY, Name VARCHAR(20)); CREATE TABLE Inetds (ID INTEGER PRIMARY KEY, Name VARCHAR(20), Version VARCHAR(10)); CREATE TABLE MudServicesI3 (mud_id INTEGER, service_id INTEGER, Value VARCHAR(20), PRIMARY KEY (mud_id, service_id)); CREATE TABLE MudServicesI2 (mud_id INTEGER, service_id INTEGER, Send VARCHAR(5), Receive VARCHAR(5), PRIMARY KEY (mud_id, service_id)); CREATE TABLE ServicesI3 (ID INTEGER PRIMARY KEY, Name VARCHAR(20), servicetype_id INTEGER); CREATE TABLE ServiceTypesI3 (ID INTEGER PRIMARY KEY, Name VARCHAR(20)); CREATE TABLE ServicesI2 (ID INTEGER PRIMARY KEY, Name VARCHAR(20)); CREATE TABLE OtherData (mud_id INTEGER, Name VARCHAR(30), Value VARCHAR(255)); CREATE TABLE Channels (ID INTEGER PRIMARY KEY, Name VARCHAR(20), Type VARCHAR(20), Listen INTEGER); CREATE TABLE MudChannels (mud_id INTEGER, channel_id INTEGER, PRIMARY KEY (mud_id, channel_id)); CREATE TABLE ParametersI3 (Name VARCHAR(255), Value VARCHAR(255)); CREATE TABLE ParametersI2 (Name VARCHAR(255), Value VARCHAR(255)); CREATE TABLE Users (ID INTEGER PRIMARY KEY, Name VARCHAR(12), Password VARCHAR(20), Title VARCHAR(65), Desc VARCHAR(1024), Level VARCHAR(10), Location VARCHAR(15), Away VARCHAR(30), Room INTEGER, Login INTEGER, Logout INTEGER); CREATE TABLE Rooms (ID INTEGER PRIMARY KEY, Creator VARCHAR(12), Name VARCHAR(40), Description VARCHAR(1600)); CREATE TABLE RoomDetails (RoomId INTEGER, Name VARCHAR(40), Description VARCHAR(800), PRIMARY KEY (RoomId, Name)); CREATE TABLE UserParameters (user_id INTEGER, Name VARCHAR(20), Value VARCHAR(50)); CREATE TABLE IgnoredEvents (user_id INTEGER, Event VARCHAR(30)); CREATE TABLE IgnoredMuds (user_id INTEGER, Mud VARCHAR(50)); CREATE TABLE ColouredEvents (user_id INTEGER, Event VARCHAR(20), Colour VARCHAR(50), PRIMARY KEY (user_id, Event)); CREATE TABLE Aliases (user_id INTEGER, Name VARCHAR(20), Command VARCHAR(255), PRIMARY KEY (user_id, Name)); CREATE TABLE IPChanges (ID INTEGER PRIMARY KEY,From_id INTEGER, Date DATE, mud_id INTEGER, OldIP VARCHAR(15), NewIP VARCHAR(15), OldPort INTEGER, NewPort INTEGER); CREATE TABLE Templates (Name VARCHAR(20), Value VARCHAR(255)); CREATE TABLE Mail (ID INTEGER PRIMARY KEY, user_id INTEGER, MailFrom VARCHAR(20), Subject VARCHAR(255), Date DATE, Text VARCHAR(5000), Read BOOLEAN); ============================================================= Recursive SQL (DB2): (WITH X defines a temporary view) WITH trips(destination, route, totalcost) AS ((SELECT destination, destination, cost FROM flights WHERE origin = "SFO") UNION ALL (SELECT f.destination, t.route || ',' || f.destination, t.totalcost * f.cost FROM trips t, flights f WHERE t.destination = f.origin)) SELECT route, totalcost FROM trips WHERE destination = "JFK"; NB: There is no stop condition, so this will run indefinitely.. # ------------------------------------------------------------------------------ # subroutine: genDB2TimeStamp # generate string "YYYY-MM-DD-hh.mm.ss.xxxxxx" from "YYYYMMDDhhmmssxxxxxx" # Check of length must be done before calling subroutine. # Check of format will be done by calling db2-statement of after using subroutine # ------------------------------------------------------------------------------ function genDB2TimeStamp { typeset v1=$1 typeset result result=`echo "$v1" | $MIS_PERLPRG -e '$a=; $b = "-"; $c = "."; $YYYY = substr($a, 0,4); $MM = substr($a, 4,2); $DD = substr($a, 6,2); $hh = substr($a, 8,2); $mm = substr($a,10,2); $ss = substr($a,12,2); $ms = substr($a,14,6); print $YYYY . $b . $MM . $b . $DD . $b . $hh . $c . $mm . $c . $ss . $c . $ms;'` echo $result ============================================================== +-----------------------------------------------+ | ozlvl tzyrcl jpyol apn ypcnl pko | | ap lcylk cpyyztxev lyyzrcsls. fleyzlvlk | | vlz pkvly clyy pko vrchleily, oly pkv | | oxv iyprcsuxyl qxko, olk szlylk ozl veyxrcl | | pko oly kxspy olk ljzflk vhnnly fluyxrcs cxs. | | cpqozfl cpyyztxe! | +-----------------------------------------------+ +-----------------------------------------------+ | diese kirche wurde zum ruhme und | | zu ehren hurrikaps errichtet. gepriesen | | sei unser herr und schoepfer, der uns | | das fruchtbare land, den tieren die sprache | | und der natur den ewigen sommer gebracht hat. | | huldige hurrikap! | +-----------------------------------------------+ o=d z=i l=e v=s x=a p=u k=n y=r a=z n=m h=o s=t r=c c=h t=k e=p j=w i=f u=b f=g q=l ---------------------------------------------------------------- #!/opt/perl/bin/perl -w use Regexp::Common 'comment'; while() { if(/$RE{comment}{Perl}/) { print $_, " contains a perl comment\n"; } } __DATA__ #This is a comment print "# This is not a comment"; qw/ # Neither is this/ @array= ('#', "or this"); ?#array #or this --------------------------------------------------------------- The Pennsylvania Story Once upon a time in the Kingdom of Heaven, God was missing for six days. Eventually, Michael the archangel found him, resting on the seventh day. He inquired of God, "Where have you been?" God sighed a deep sigh of satisfaction and proudly pointed downwards through the clouds, "Look Michael, look what I've made." Archangel Michael looked puzzled and said, "What is it?" "It's a planet," replied God, "and I've put Life on it. I'm going to call it Earth and it's going to be a great place of balance." "Balance?", inquired Michael, still confused. God explained, pointing to different parts of earth, "For example, northern Europe will be a place of great opportunity and wealth while southern Europe is going to be poor; the Middle East over there will be a hot spot. Over there I've placed a continent of white people and over there is a continent of black people," God continued, pointing to different countries. "This one will be extremely hot and arid while this one will be very cold and covered in ice." The Archangel, impressed by God's work, then pointed to a large land mass and said, "What's that one?" "Ah," said God. "That's Pennsylvania, the most glorious place on earth. There are beautiful lakes, rivers, sunsets and rolling hills. The people from Pennsylvania are going to be modest, intelligent and humorous and they are going to be found traveling the world. They will be extremely sociable, hard working and high achieving, and they will be known throughout the world as diplomats and carriers of peace." Michael gasped in wonder and admiration but then, "What about balance, God? You said there would be balance!" God replied wisely, "Wait until you see the idiots I'm putting around them in New Jersey, New York, Maryland, Delaware, West Virginia and Ohio."