Beefy Boxes and Bandwidth Generously Provided by pair Networks
Come for the quick hacks, stay for the epiphanies.

castaway's scratchpad

by castaway (Parson)
on Jun 01, 2004 at 12:58 UTC ( [id://358016]=scratchpad: print w/replies, xml ) Need Help??

#!/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" . $templat +e->error; index.html: [% INCLUDE header.html title = "Teste do template toolkit" %] [% INCLUDE menu.html %] <!-- Inicio da parte de texto --> <div class="main"> <h2>Escolha um dos <span id="italico">links</span> no menu à esquerd +a.</h2> <h3>Descrição dos <span id="italico">links:</span></h3> <ul> <li><span id="bold">Registar-se:</span> permite a um novo utilizador efectuar o registo.</li> <li><span id="bold">Sair:</span> permite a um utilizador sair da sua conta.</li> </ul> </div> [% 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_fiel +d 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/T +ranslator/Producer/ ====================================================================== +================== my $options_coderef = sub { my ($obj, $option, $is_remote,$is_enabled, $was_enabled, $buf_positi +on) = @_; 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 p +re1.0 .. Data::Dumper: Error In Code: No function or htmlcode named 'testme' exists. at /usr/lib/perl5/vendo +r_perl/5.8.6/CGI/ line 314. Executed: 1: testme(); DDS: No arguments! at /usr/lib/perl5/vendor_perl/5.8.7/i686-linux-thread-mu +lti/Data/Dump/ line 1090 Data::Dump::Streamer::Data('Data: +:Dump::Streamer=HASH(0x8ffd440)') called at /usr/lib/perl5/vendor_per +l/5.8.7/i686-linux-thread-multi/Data/Dump/ line 1625 Data: +:Dump::Streamer::Out('Data::Dump::Streamer=HASH(0x8ffd440)') called a +t /usr/lib/perl5/vendor_perl/5.8.7/i686-linux-thread-multi/Data/Dump/ line 573 Data::Dump::Streamer::Dumper() called at (eval 7 +81) 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__})= su +b {}; local($SIG{__WARN__})= sub {}; # use Data::Dumper; use Data::Du +mp::Streamer \'Dumper\'; my $dump=Dumper(eval $execstr); $error=$@; e +val{1}; $error || $dump }; my $line; if ($error) { $execstr=~s/^/spri +ntf "%3d: ",++$line/gem; $execstr=$query->escapeHTML($execstr); $exec +str=~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/ line 898 Eve +rything::HTML::evalX('\x{a} return "" unless $query->param("dumper_ac +tion") eq \'Execu...', 'Everything::Node=HASH(0x8b8e74c)') called at +/usr/local/everything/Everything/ line 830 Everything::HTML::e +valXTrapErrors('\x{a} return "" unless $query->param("dumper_action") + eq \'Execu...', 'Everything::Node=HASH(0x8b8e74c)') called at /usr/l +ocal/everything/Everything/ line 1277 Everything::HTML::embedC +ode('\x{a} return "" unless $query->param("dumper_action") eq \'Execu +...', 'Everything::Node=HASH(0x8b8e74c)') called at /usr/local/everyt +hing/Everything/ line 1430 Everything::HTML::oldparseCode('doc +text', 'Everything::Node=HASH(0x8b8e74c)') called at /usr/local/every +thing/Everything/ line 1332 Everything::HTML::parseCode('docte +xt', 'Everything::Node=HASH(0x8b8e74c)') called at (eval 767) line 2 +eval ' my ($field, $nolinks) = @_; my $text = parseCode ($field, $NOD +E); $text =~ s/\\(.*?)\\/linkNodeTitle ($1, $NODE)/egs unless $nolink +s; $text;' called at /usr/local/everything/Everything/ line 89 +8 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/ lin +e 968 Everything::HTML::AUTOLOAD('doctext') called at (eval 761) line + 1 eval 'parsecode(\'doctext\');' called at /usr/local/everything/Eve +rything/ line 898 Everything::HTML::evalX('parsecode(\'doctext +\');', 'Everything::Node=HASH(0x8cc0018)') called at /usr/local/every +thing/Everything/ line 830 Everything::HTML::evalXTrapErrors(' +parsecode(\'doctext\');', 'Everything::Node=HASH(0x8cc0018)') called +at /usr/local/everything/Everything/ line 1273 Everything::HTM +L::embedCode('\x{a} return "" unless $query->param("dumper_action") e +q \'Execu...', 'Everything::Node=HASH(0x8cc0018)') called at /usr/loc +al/everything/Everything/ line 1430 Everything::HTML::oldparse +Code('page', 'Everything::Node=HASH(0x8cc0018)') called at /usr/local +/everything/Everything/ line 1332 Everything::HTML::parseCode( +'page', 'Everything::Node=HASH(0x8cc0018)') called at /usr/local/ever +ything/Everything/ line 1815 Everything::HTML::displayPage('Ev +erything::Node=HASH(0x8b8e74c)') called at /usr/local/everything/Ever +ything/ line 1959 Everything::HTML::gotoNode(357, 279) called +at /usr/local/everything/Everything/ line 2246 Everything::HTM +L::handleUserRequest() called at /usr/local/everything/Everything/HTM line 2820 Everything::HTML::mod_perlInit('virtbook:root:C466lda: +') called at /srv/www/localhost/htdocs/virtbook/ 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/ /&nbsp;/g; 25: $execstr="<pre>$execstr</pre>"; 26: } else { 27: $execstr=wrapcode("\n$execstr\n"); 28: } 29: return ($error ? '<h3>Error In Code:</h3>' : "<h3>Result:< +/h3>") 30: . wrapcode( "\n$code\n" ) 31: . "<h3>Executed:</h3>". $execstr . "<hr />"; 32: } else { 33: return qq<p>Nothing to Dump.</p>; 34: } Call Stack: /usr/local/everything/Everything/ +orGods /usr/local/everything/Everything/ +matErr /usr/local/everything/Everything/ +rapErrors /usr/local/everything/Everything/ +ode /usr/local/everything/Everything/ +seCode (eval 767):2:Everything::HTML::parseCode /usr/local/everything/Everything/ /usr/local/everything/Everything/ (eval 761):1:Everything::HTML::AUTOLOAD /usr/local/everything/Everything/ /usr/local/everything/Everything/ /usr/local/everything/Everything/ +rapErrors /usr/local/everything/Everything/ +ode /usr/local/everything/Everything/ +seCode /usr/local/everything/Everything/ +ode /usr/local/everything/Everything/ +yPage /usr/local/everything/Everything/ +de /usr/local/everything/Everything/ +UserRequest /srv/www/localhost/htdocs/virtbook/ +erlInitEnd 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 (- inde +x 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") ; diction +ary (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 (- le +n 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 <> 'First_Level' THEN 0 WHEN = '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 i +t returned: SQL0104N An unexpected token ")" was found following "ExcelTime(statu +stime". 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 \"prepen +d|append|replace\"] [--field \"public|private\"] [--code] [--file \"< +filename>\"] " if(!$user || !$passwd) ; my $agent = WWW::Mechanize->new(); $agent->env_proxy(); # Login and get the node-to-be-retitled $agent->get("$user;nodetype=use +r"); $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 \"pr +epend|append|replace\"] [--field \"public|private\"] [--code] [--file + \"<filename>\"]"; } 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 = '<co' . 'de>' . $value . '</co' . 'de>'; } 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, dri +ver_id INTEGER, type_id INTEGER, AdminEmail VARCHAR(30), update_id IN +TEGER); 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), Vers +ion VARCHAR(10)); CREATE TABLE Drivers (ID INTEGER PRIMARY KEY, Name VARCHAR(50), Versio +n 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 V +ARCHAR(5), Receive VARCHAR(5), PRIMARY KEY (mud_id, service_id)); CREATE TABLE ServicesI3 (ID INTEGER PRIMARY KEY, Name VARCHAR(20), ser +vicetype_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 VARCHA +R(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, L +ogout 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), Descriptio +n 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), Colou +r VARCHAR(50), PRIMARY KEY (user_id, Event)); CREATE TABLE Aliases (user_id INTEGER, Name VARCHAR(20), Command VARCH +AR(255), PRIMARY KEY (user_id, Name)); CREATE TABLE IPChanges (ID INTEGER PRIMARY KEY,From_id INTEGER, Date D +ATE, mud_id INTEGER, OldIP VARCHAR(15), NewIP VARCHAR(15), OldPort IN +TEGER, 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 "" from "YYYYMMDDhhmmssxxx +xxx" # 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=<STDIN>; $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(<DATA>) { 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 day +s. Eventually, Michael the archangel found him, resting on the sevent +h day. He inquired of God, "Where have you been?" God sighed a deep s +igh of satisfaction and proudly pointed downwards through the clouds, + "Look Michael, look what I've made." Archangel Michael looked puzzle +d 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, northe +rn Europe will be a place of great opportunity and wealth while south +ern 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 di +fferent countries. "This one will be extremely hot and arid while thi +s 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 t +hat one?" "Ah," said God. "That's Pennsylvania, the most glorious pla +ce on earth. There are beautiful lakes, rivers, sunsets and rolling h +ills. The people from Pennsylvania are going to be modest, intelligen +t and humorous and they are going to be found traveling the world. Th +ey will be extremely sociable, hard working and high achieving, and t +hey will be known throughout the world as diplomats and carriers of p +eace." 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."
Log In?

What's my password?
Create A New User
Domain Nodelet?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others imbibing at the Monastery: (3)
As of 2024-05-22 04:15 GMT
Find Nodes?
    Voting Booth?

    No recent polls found