Public Scratchpad | Download, Select Code To D/L |
Web Host woes
me : I have accounts A and B, I want a third account C them : ok, we added C and deleted B me : no, I need B them : ok, we restored B and deleted A me : no, I need A them : ok, we restored A but not A's ability to edit files me : no, A needs to be able to edit files them : ok, we restored A's ability to edit all files except those starting with a dot like .htaccess me : nevermind, I'll change that myself.
My Mason apache.conf
PerlModule HTML::Mason::ApacheHandler <Location /~jeff/mason> PerlSetVar MasonCompRoot /home/jeff/public_html/mason SetHandler perl-script PerlHandler HTML::Mason::ApacheHandler </Location>
For hacker
my %uri = ( dl => 'http://www.plkr.org/download', snaps => 'http://www.plkr.org/developers/snapshots', tools => 'http://www.plkr.org/developers/tools', history => 'http://www.plkr.org/about', irc => 'http://www.plkr.org/users/chat', ); my $wanted_uri = $uri{$apr->param('a')||''}; if( $wanted_uri ){ print $apr->redirect( -status => 301, -uri => $wanted_uri ); exit; }
For bhorton63
#!/usr/bin/perl use warnings; use strict; use DBI; my $dbh=DBI->connect('dbi:CSV:',undef,undef,{RaiseError=>1}); $dbh->do($_) for( "DROP TABLE IF EXISTS updateTest", "CREATE TABLE updateTest (phrase TEXT)", "INSERT INTO updateTest (phrase) VALUES('old')" ); my($old) = $dbh->selectrow_array(" SELECT phrase FROM updateTest "); $dbh->do(" UPDATE updateTest SET phrase=? WHERE phrase=? ",{},'new','old'); my($new) = $dbh->selectrow_array(" SELECT phrase FROM updateTest "); print "OLD: $old\nNEW: $new\n"; $dbh->do(" DROP TABLE updateTest "); $dbh->disconnect; __END__
For hacker
# PREPARE ONLY ONCE, NOT EVERYTIME THROUGH THE LOOP my $word = $dbh->prepare(qq{SELECT term from dream_terms where term=?} +); sub link_lookup { my $lookup_word = shift; $word->execute($lookup_word); # YOU ONLY WANT ONE ROW, SO JUST FETCH ONE ROW # YOU ARE ONLY FETCHING ONE COLUMN SO JUST FETCH IT, DON"T BIND IT my($found_it) = $sth->fetchrow_array; # CHECK IF YOU FOUND SOMETHING BEFORE TRYING TO lcfirst NOTHING if ($found_it and $lookup_word eq lcfirst($found_it)) { print "FOUND A MATCH!<br />"; $linked_word = qq{ <a href="#$success_fail"> $lookup_word </a><br /> }; } else { print "YOU ARE HERE<br />"; $linked_word = $lookup_word; } $word->finish; return $linked_word; }
For perllove
#!/usr/bin/perl use warnings; use strict; use CGI; my $tail = qx(tail mvc.txt); print CGI::header(), qq{ <html> <head> <meta http-equiv="refresh" content="24" /> </head> <body> <pre>$tail</pre> </body> </html> }
For Bart
<script> var foo = { a:1 , b:2 , c:3 }; alert( foo['b'] ); </script>
CSS Quiz
What color is bar?<style> #foo #bar { color:red; } #bar { color:green; } </style> <div id="foo"> <div id="bar">bar</div> </div>
For grant123
#!/usr/bin/perl use warnings; use strict; print match("one two three","four five six"); print match("one two three","four onefive six"); print match("one two three","three five six"); sub match { my @left = split /\s+/, $_[0]; my @right = split /\s+/, $_[1]; return ( join( ',', ',', @left, ',' ) =~ /,(${\join'|',map quotemeta $_, @right}),/ ) ? 1 : 0; }
A simple Mason server
#!/usr/bin/perl use strict; use HTML::Mason; use CGI; use CGI::Carp qw(fatalsToBrowser); my $cgi = CGI->new(); my $fn = ( $cgi->param('fn') || 'list/list_items' ) . '.mas'; open(IN,"<",$fn) or die $!; my $templateStr = join '',<IN>; close IN; my $interpreter = HTML::Mason::Interp->new( ); my $component = $interpreter->make_component(comp_source=>$template +Str); my %args = $cgi->Vars; print $cgi->header(); $interpreter->exec($component,%args);
For farhan
my $in_file = "bill"; my $out_file = "far2"; open IF, "$in_file" or die $!; open OF, ">$out_file" or die $!; while(<IF>) { chomp; print OF $_; if($. == 4012) { print OF "... test"; } print OF "\n"; } print "Done\n"; close(IF); close(OF);
CGI.pm sticky forms
#!/usr/bin/perl -w use strict; use CGI; my $q = CGI->new; print $q->header, , $q->start_form(-action=>$q->url) , $q->textfield(-name=>'foo') , $q->submit , $q->end_form ; print "You entered :" . $q->param('foo') if $q->param;
Inheritance in JavaScript
<script src="/js/prototype.js"></script> <script src="/js/extend.js"></script> <script> var myBaseClass = Class.create({ initialize : function( seed ) { this.seed = seed }, show : function() { alert( this.seed ) } }); var myInheritedClass = myBaseClass.extend({ show : function() { this.seed += 5; this.SUPER() } }); myInstance = new myBaseClass(6); myInstance.show(); // result = 6 myInheritedInstance = new myInheritedClass(6); myInheritedInstance.show(); // result = 11 </script>
DBD::CSV addition function
$dbh->do("CREATE FUNCTION MyAdd"); sub MyAdd { my($self,$sth,$rowhash,@params)=@_; my $sum; $sum += $_ for @params; return $sum } my $sth = $dbh->prepare(" SELECT myAdd(id,9) AS foo FROM test ");
SQL::Translator - trying to get column defs in a structure
The code below produces:"ERROR (line 1): Invalid statement: Was expecting create, or comment on ..."#!perl -w use strict; use SQL::Translator; use SQL::Translator::Schema; use SQL::Translator::Parser::PostgreSQL; use Data::Dumper; my $sql = "CREATE TABLE foo (id INT PRIMARY KEY,bar VARCHAR(30)"; my $translator = SQL::Translator->new; SQL::Translator::Parser::PostgreSQL::parse($translator,$sql);
Text::CSV_XS for demerphq
#!perl -w use strict; use Text::CSV_XS; use IO::File; my $csv = Text::CSV_XS->new( {binary=>1} ); my $fh = IO::File->new('tmp.csv'); while (my $cols = $csv->getline($fh)) { last unless @$cols; printf "%s\n", join ':',@$cols; }
utf-8
#!perl -w use strict; require IO::Scalar; use Text::CSV_XS; use encoding 'utf-8'; my $csv = Text::CSV_XS->new( {binary=>1} ); my $fh = new IO::Scalar; use Test::More tests => 4; my $old = "\x{263A}"; $fh->open(\$old); my $cols = $csv->getline($fh); my $new = $cols->[0]; ok($old eq $new,'$old eq $new'); ok($old =~ /$new/,'$old =~ /$new/'); ok($old =~ /\Q$new/,'$old =~ /\Q$new/'); ok($new =~ /$old/,'$new =~ /$old/'); ok($new =~ /\Q$old/,'$new =~ /\Q$old/');
SELECT foo, bar
FROM baz JOIN qux
WHERE quimble = ?
AND bop = ?
MCB Bookmarks.html
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
<head>
<title>MCB Bookmarks</title>
<base target="main">
<link rel="stylesheet" href="mcb.css" type="text/css">
</head>
<body>
<a href="http://www.perlmonks.org/?node=Newest%20Nodes">Newest Nodes</
+a><br />
<a href="http://www.perlmonks.org/?node=Recently%20Active%20Threads">R
+ecently Active Threads</a><br />
<a href="http://www.perlmonks.org/?node_id=358896">View Scratchpad</a>
+<br />
<a href="http://www.perlmonks.org/?displaytype=edit;node_id=358896">Ed
+it Scratchpad</a><br />
<a href="http://tinymicros.com/pm/">PM Stats</a><br />
<a href="http://www.perlmonk.org/~mojotoad/cbs/">CB Stats</a><br />
<a href="http://www.perlmonks.org/?displaytype=raw;xmlstyle=clean;node
+=XP XML Ticker">XP</a><br />
</body>
</html>
DB Contractor Questions - For Limbic~Region
I usually start from the big picture and work down:
What domain of information is the database about?
(teaching assignments)
What reports do you want to generate from the db?
(list subjects taught by prof X)
(list profs who teach subject Y)
(list all profs and for each list all subjects they teach)
Are there other reports you might want in the future?
Based on the above, key entites are prof and subject.
are there any other relevant entities?
What is the relation between the entities
(each prof can teach many subjects,
each subject can be taught by many profs)
Any other potential relations?
What are the attributes for each entity?
(each prof has a name, each subject has a title)
Any other potential attributes?
Which attributes uniquely identify each entity?
(none, we have two profs named "Joe Clark")
Are the unique attributes guaranteed to be unique?
(nope)
Shall we use arbitrary unique identifiers?
(please do)
Based on what you've said so far, your database
should be composed of three tables with the
structure indicated below, does that sound right?
+-------+ +--------+ +---------+
| prof | | lookup | | subject |
+-------+ +--------+ +---------+
| *pid | <-->> | *pid | | stitle |
| pname | | *sid | <<--> | *sid |
+-------+ +--------+ +---------+
If not, find out why not and refactor.
Continue with more specific questions about field
definitions for each table, etc. ....
STDIN issues
This works
% cat > dbish.txt
/format box
DROP TABLE IF EXISTS x;
CREATE TABLE x (num INT, let CHAR);
INSERT INTO x VALUES (1,'a');
INSERT INTO x VALUES (2,'b');
SELECT * FROM x;
% perl -MDBI::Shell -e 'DBI::Shell->new("--batch","dbi:DBM:")->run' <
+dbish.txt;
This doesn't:
#!/usr/bin/perl -w
use strict;
use DBI::Shell;
my $str=" /format box
DROP TABLE IF EXISTS x;
CREATE TABLE x (num INT, let CHAR);
INSERT INTO x VALUES (1,'a');
INSERT INTO x VALUES (2,'b');
SELECT * FROM x;
";
open STDIN, '<', \$str;
DBI::Shell->new('--batch','dbi:DBM:')->run;
dual boot problems
I have a winXP system, I installed debian sarge on a partition with Lilo in th e MBR. It boots straight to Linux with no menu and I can't boot to winXP at all. Here's the relevant parts of /etc/lilo.conf.
boot=/dev/sda # the raw device (i.e. lilo in mbr)
root=/dev/sda5 # the linux partition
install=menu # we want a menu
other=/dev/sda2 # the winXP c:\ partition
Text::CSV_XS proposed new methods
use Text::CSV_XS;
$c = Text::CSV_XS->new; # use default separator,delimite
+r,escape
or $c = Text::CSV_XS->new(%attr); # set your own separators,delims
+,escapes
$c->open_file($filename) # open a CSV file
$c->open_string($string) # open a CSV string
@row = $c->fetchrow_array # fetch one row into an array
$row = $c->fetchrow_hashref # fetch one row into a hashref
$table = $c->fetchall_arrayref # fetch all rows into an array
+of arrays
$table = $c->fetchall_hashref($key) # fetch all rows into a hashref
$c->write_row( @array ) # insert a row from an array of
+ values
$c->write_table($filename,$arrayref) # create a CSV file from an ar
+rayref
$c->write_table($filename,$hashref) # create a CSV file from a hash
+ref
$c = open_file( $filename ); # loop through a file fetching
+hashrefs
while(my $row = $c->fetchrow_hashref){
if($row->{$column_name} eq $value){
# do something
}
}
There are two interfaces to this module, the new interface (shown abov
+e) has convenient shortcuts, the older interface is for backwards com
+patibility for previous users. B<Please note>: in the new interface
+binary mode defaults to true, whereas in the older interface it defau
+lts to false. This means that the new interface methods will, by def
+ault, handle embedded newlines and binary characters, whereas if you
+want that behaviour with the old methods, you must manually set binar
+y=>1 in the call to new().
Text::CSV_XS change for escape_char
The char used for escaping certain characters inside quoted fields,
by default the same character as the quote_char. (C<">).
If quote_char is specified in the call to new() and escape_char is not
+,
the escape_char becomes the same as the specified quote_char. A liter
+al
value for the quote character thus becomes "" if quote_char is " and '
+' if
quote_char is ' and just " or ' if quote_char is specified as undef.
+However
if the escape_char is specified in the call to new() as something else
+,
that value will be used.
These examples should all parse properly as a single CSV field:
$csv = Text::CSV_XS->new();
$csv->parse(q["Joe ""the giant"" Jackson"]) or die $csv->error_input
+;
$csv = Text::CSV_XS->new({ quote_char=>q['] });
$csv->parse(q['Joe ''the giant'' Jackson']) or die $csv->error_input;
$csv=Text::CSV_XS->new({quote_char=>undef});
$csv->parse(q[17" monitor]) or die $csv->error_input;
$csv = Text::CSV_XS->new({ quote_char=>q['], escape_char=>q[\\]});
$csv->parse(q['Joe \'the giant\' Jackson']) or die $csv->error_input;
$csv = Text::CSV_XS->new({ escape_char => q[\\] });
$csv->parse(q["Joe \"the giant\" Jackson"]) or die $csv->error_input;
Text::xSV
#!perl -w
use strict;
use Text::xSV;
my($cols,$data) = ( ['Name','City','Num'], [] );
for my $num(0..4999) {
push @$data, ["myself\nme","Portland,Oregon",$num];
}
create_xSV('test.xSV',$cols,$data);
read_xSV('test.xSV');
sub create_xSV {
my($fname,$cols,$data) = @_;
my $csv = Text::xSV->new( filename => $fname
, header => $cols
);
$csv->print_header();
$csv->print_row(@$_) for @$data;
}
sub read_xSV {
my $fname = shift;
my $csv = Text::xSV->new( filename=>$fname, close_fh=>1);
$csv->read_header();
my $count=0;
while ($csv->get_row()) {
print "$count ...";
my @row = $csv->extract(qw(Name City Num));
die 'Bad Read' unless "@row" eq "@{$data->[$count++]}";
}
print "Done!";
}
__END__
Tree structure with theorbtwo's Require Finder
#!/usr/bin/perl -w
use strict;
use vars qw/ $mods $files %ismod/;
use FindRequires;
use DBI;
my $dbh=DBI->connect('dbi:DBM(RaiseError=1):');
recurse($mods->[0],'');
sub recurse {
my($mod,$insert)=@_;
return unless $mod;
print "$insert$mod\n";
$insert .= ' ';
for my $modfile(@{$files->{$mod}}) {
recurse($modfile,$insert);
}
}
package FindRequires;
# by [theorbtwo]
use warnings;
use strict;
my $reallibimport;
use lib;
BEGIN {
$reallibimport = \&lib::import;
}
{
no warnings 'redefine';
sub lib::import {
$reallibimport->(@_);
($INC[0], $INC[1]) = ($INC[1], $INC[0]);
}
}
unshift @INC, sub {
my ($self, $lookingfor) = @_;
# != works if it is OK, but if it's not, this is probably a string
+.
# Use ne to avoid warning, even though we're about to die.
if ($INC[0] ne $self) {
die "\@INC got messed up";
}
# return if $lookingfor =~ /\.al$/;
if ($lookingfor =~ /\.pm$/) {
$lookingfor =~ s![:/]!::!g;
$lookingfor =~ s/\.pm$//;
}
my ($filename, $line,@mods);
my $level=0;
while (1) {
(undef, $filename, $line) = caller($level);
last unless $filename =~ /^\(eval/;
$level++;
}
my $modfile = $filename;
for my $i(@INC) {
$modfile =~ s!$i!!;
}
if ($modfile =~ /\.pm$/) {
$modfile =~ s![:/]!::!g;
$modfile =~ s/\.pm$//;
}
push @{$main::mods}, $modfile unless $main::ismod{$modfile}++;
push @{ $main::files->{$modfile} }, $lookingfor;
# print "$lookingfor required at line $line of [$modfile] $filenam
+e\n";
};
1;
Using DBD::AnyData to access an AoA with SQL
#!perl -w
use strict;
use DBI;
my $AoA = [ [qw(1 Hacker)]
, [qw(2 Perl)]
, [qw(3 Another)]
, [qw(4 Just)]
, [qw(5 junk)]
];
my $dbh=DBI->connect('dbi:AnyData(RaiseError=1):');
$dbh->ad_catalog('t','ARRAY',$AoA,{cols=>'id,phrase'});
print join ' ', @{ $dbh->selectcol_arrayref("
SELECT phrase FROM t WHERE phrase <> 'junk' ORDER BY id DESC
")};
ChatterBox WhiteBoard: A communal scratchpad
SELECT foo, bar
FROM baz JOIN qux
WHERE quimble = ?
AND bop = ?
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
<head>
<title>MCB Bookmarks</title>
<base target="main">
<link rel="stylesheet" href="mcb.css" type="text/css">
</head>
<body>
<a href="http://www.perlmonks.org/?node=Newest%20Nodes">Newest Nodes</
+a><br />
<a href="http://www.perlmonks.org/?node=Recently%20Active%20Threads">R
+ecently Active Threads</a><br />
<a href="http://www.perlmonks.org/?node_id=358896">View Scratchpad</a>
+<br />
<a href="http://www.perlmonks.org/?displaytype=edit;node_id=358896">Ed
+it Scratchpad</a><br />
<a href="http://tinymicros.com/pm/">PM Stats</a><br />
<a href="http://www.perlmonk.org/~mojotoad/cbs/">CB Stats</a><br />
<a href="http://www.perlmonks.org/?displaytype=raw;xmlstyle=clean;node
+=XP XML Ticker">XP</a><br />
</body>
</html>
% cat > dbish.txt
/format box
DROP TABLE IF EXISTS x;
CREATE TABLE x (num INT, let CHAR);
INSERT INTO x VALUES (1,'a');
INSERT INTO x VALUES (2,'b');
SELECT * FROM x;
% perl -MDBI::Shell -e 'DBI::Shell->new("--batch","dbi:DBM:")->run' <
+dbish.txt;
#!/usr/bin/perl -w
use strict;
use DBI::Shell;
my $str=" /format box
DROP TABLE IF EXISTS x;
CREATE TABLE x (num INT, let CHAR);
INSERT INTO x VALUES (1,'a');
INSERT INTO x VALUES (2,'b');
SELECT * FROM x;
";
open STDIN, '<', \$str;
DBI::Shell->new('--batch','dbi:DBM:')->run;
use Text::CSV_XS;
$c = Text::CSV_XS->new; # use default separator,delimite
+r,escape
or $c = Text::CSV_XS->new(%attr); # set your own separators,delims
+,escapes
$c->open_file($filename) # open a CSV file
$c->open_string($string) # open a CSV string
@row = $c->fetchrow_array # fetch one row into an array
$row = $c->fetchrow_hashref # fetch one row into a hashref
$table = $c->fetchall_arrayref # fetch all rows into an array
+of arrays
$table = $c->fetchall_hashref($key) # fetch all rows into a hashref
$c->write_row( @array ) # insert a row from an array of
+ values
$c->write_table($filename,$arrayref) # create a CSV file from an ar
+rayref
$c->write_table($filename,$hashref) # create a CSV file from a hash
+ref
$c = open_file( $filename ); # loop through a file fetching
+hashrefs
while(my $row = $c->fetchrow_hashref){
if($row->{$column_name} eq $value){
# do something
}
}
There are two interfaces to this module, the new interface (shown abov
+e) has convenient shortcuts, the older interface is for backwards com
+patibility for previous users. B<Please note>: in the new interface
+binary mode defaults to true, whereas in the older interface it defau
+lts to false. This means that the new interface methods will, by def
+ault, handle embedded newlines and binary characters, whereas if you
+want that behaviour with the old methods, you must manually set binar
+y=>1 in the call to new().
The char used for escaping certain characters inside quoted fields,
by default the same character as the quote_char. (C<">).
If quote_char is specified in the call to new() and escape_char is not
+,
the escape_char becomes the same as the specified quote_char. A liter
+al
value for the quote character thus becomes "" if quote_char is " and '
+' if
quote_char is ' and just " or ' if quote_char is specified as undef.
+However
if the escape_char is specified in the call to new() as something else
+,
that value will be used.
These examples should all parse properly as a single CSV field:
$csv = Text::CSV_XS->new();
$csv->parse(q["Joe ""the giant"" Jackson"]) or die $csv->error_input
+;
$csv = Text::CSV_XS->new({ quote_char=>q['] });
$csv->parse(q['Joe ''the giant'' Jackson']) or die $csv->error_input;
$csv=Text::CSV_XS->new({quote_char=>undef});
$csv->parse(q[17" monitor]) or die $csv->error_input;
$csv = Text::CSV_XS->new({ quote_char=>q['], escape_char=>q[\\]});
$csv->parse(q['Joe \'the giant\' Jackson']) or die $csv->error_input;
$csv = Text::CSV_XS->new({ escape_char => q[\\] });
$csv->parse(q["Joe \"the giant\" Jackson"]) or die $csv->error_input;
#!perl -w
use strict;
use Text::xSV;
my($cols,$data) = ( ['Name','City','Num'], [] );
for my $num(0..4999) {
push @$data, ["myself\nme","Portland,Oregon",$num];
}
create_xSV('test.xSV',$cols,$data);
read_xSV('test.xSV');
sub create_xSV {
my($fname,$cols,$data) = @_;
my $csv = Text::xSV->new( filename => $fname
, header => $cols
);
$csv->print_header();
$csv->print_row(@$_) for @$data;
}
sub read_xSV {
my $fname = shift;
my $csv = Text::xSV->new( filename=>$fname, close_fh=>1);
$csv->read_header();
my $count=0;
while ($csv->get_row()) {
print "$count ...";
my @row = $csv->extract(qw(Name City Num));
die 'Bad Read' unless "@row" eq "@{$data->[$count++]}";
}
print "Done!";
}
__END__
#!/usr/bin/perl -w
use strict;
use vars qw/ $mods $files %ismod/;
use FindRequires;
use DBI;
my $dbh=DBI->connect('dbi:DBM(RaiseError=1):');
recurse($mods->[0],'');
sub recurse {
my($mod,$insert)=@_;
return unless $mod;
print "$insert$mod\n";
$insert .= ' ';
for my $modfile(@{$files->{$mod}}) {
recurse($modfile,$insert);
}
}
package FindRequires;
# by [theorbtwo]
use warnings;
use strict;
my $reallibimport;
use lib;
BEGIN {
$reallibimport = \&lib::import;
}
{
no warnings 'redefine';
sub lib::import {
$reallibimport->(@_);
($INC[0], $INC[1]) = ($INC[1], $INC[0]);
}
}
unshift @INC, sub {
my ($self, $lookingfor) = @_;
# != works if it is OK, but if it's not, this is probably a string
+.
# Use ne to avoid warning, even though we're about to die.
if ($INC[0] ne $self) {
die "\@INC got messed up";
}
# return if $lookingfor =~ /\.al$/;
if ($lookingfor =~ /\.pm$/) {
$lookingfor =~ s![:/]!::!g;
$lookingfor =~ s/\.pm$//;
}
my ($filename, $line,@mods);
my $level=0;
while (1) {
(undef, $filename, $line) = caller($level);
last unless $filename =~ /^\(eval/;
$level++;
}
my $modfile = $filename;
for my $i(@INC) {
$modfile =~ s!$i!!;
}
if ($modfile =~ /\.pm$/) {
$modfile =~ s![:/]!::!g;
$modfile =~ s/\.pm$//;
}
push @{$main::mods}, $modfile unless $main::ismod{$modfile}++;
push @{ $main::files->{$modfile} }, $lookingfor;
# print "$lookingfor required at line $line of [$modfile] $filenam
+e\n";
};
1;
#!perl -w
use strict;
use DBI;
my $AoA = [ [qw(1 Hacker)]
, [qw(2 Perl)]
, [qw(3 Another)]
, [qw(4 Just)]
, [qw(5 junk)]
];
my $dbh=DBI->connect('dbi:AnyData(RaiseError=1):');
$dbh->ad_catalog('t','ARRAY',$AoA,{cols=>'id,phrase'});
print join ' ', @{ $dbh->selectcol_arrayref("
SELECT phrase FROM t WHERE phrase <> 'junk' ORDER BY id DESC
")};
updated 2004-09-24: brand new versioning per tye's suggestions, click the help button in the demo to read how it works
The scenario: Someone in the chatterbox posts a snippet in the communal scratchpad ... other monks edit the communal scratchpad. This would be a sort of primitive whiteboard, a one-page wiki, where monks could collaboratively work on a problem they were discussing in the chatterbox. It wouldn't be too useful for simple things like someone asking for help spotting a typo in a snippet but could be productive for exploring TIMTOWTDI and for group-developing solutions to problems.
Please give the demo a try!
My Mandatory Registration Complaint Letter
Mandatory registration is a terrible idea. It violates my privacy (I don't care what you do or don't use your database for, I don't want to be in it); it exposes me to spam and identity theft (yes, maybe your database is protected, but if every content site on the web starts using mandatory registration, one of them won't be); it's worthless since anyone can submit fake info (yes I could do that too, but frankly I don't want to).I used to visit ___ daily. Never again though.
my current hardware
other remote computers | cable modem | wap/nat/router -- wifi -- other local computers / \ / \ cat5 cable wifi / \ Computer #1 Computer #2 | \ / | VGA/USB VGA/USB | \ / | KVM Switch | / | \ | / PS2->USB \ | / | \ DVI VGA PS2 USB \ / | | Monitor Keyboard Mouse \ | / \ | / zone of error (me) | my chair
Questions for the Debian/VMware cluefull:
I am getting a new Dell 3.2gHz pentium 4 with 1gig memory, 250gig storage, WinXP professional installed. I'd like to:- add Debian + VMware.
- mostly use Debian but have WinXP available when I need it without dual boot
- access my data files from either OS.
- share some of my data files with other Win boxen on my home WiFi network
- installation - is this what I need to do?
- backup winXP
- reformat the hard drive, install Debian
- install VMware
- reinstall winXP as a guest OS
- setup - any thoughts on partition/directory structure/size - if I create the directories in Win I can mount them from linux but if I create them in linux, how do I access them from Win?
- anything else I should think about?
DBM::Deep
use DBM::Deep; my $file ='foo.db'; unlink $file if -e $file; my %h; tie %h, 'DBM::Deep', {file=>$file,autoflush=>1}; $h{key} = 'value'; untie %h; tie %h, 'DBM::Deep', {file=>$file,autoflush=>1}; print $h{key};
A Generic Inside-Out Wrapper
#!perl -w use strict; # # put any object inside a wrapper # access the object directly # and store variables privately in the wrapper # # my $obj = InsideOutWrapper->new( # $module, $wrapper_args, @module_args # ); # my $cgi = InsideOutWrapper->new('CGI'); my $lwp = InsideOutWrapper->new('LWP::UserAgent'); $cgi->param( 'foo'=> 5 ); # store in the CGI object $lwp->agent( 6 ); # store in the LWP::UA object $cgi->iow('bar'=>7 ); # store in the CGI Wrapper $lwp->iow('baz'=>8 ); # store in the LWP::UA Wrapper print "ok!\n" if '5678' eq join '' # retrieve the values , $cgi->param('foo') , $lwp->agent , $cgi->iow('bar') , $lwp->iow('baz') ; # check lists of all the private keys # print "ok!\n" if 'bar' eq join( '', $cgi->iow ) and 'baz' eq join( '', $lwp->iow ); exit; package InsideOutWrapper; use warnings; use strict; my %built; sub new { my($wrapper_class,$other_class,$wrapper_args,@other_args)=@_; my $class = $wrapper_class . '::' . $other_class; if (!$built{$class}++) { my $class_txt = get_class_txt(); $class_txt =~ s/__WRAPPER__/$class/g; $class_txt =~ s/__MOD__/$other_class/g; eval $class_txt; die $@ if $@; } return $class->new($wrapper_args,@other_args); } sub get_class_txt { return <<''; package __WRAPPER__; use strict; use warnings; use vars qw( $vars ); use base '__MOD__'; sub new { my($class,$wrapper_args,@other_args)=@_; my $obj = bless __MOD__->new(@other_args), $class; $vars->{$obj} = $wrapper_args; $obj; } sub iow { my($self,$key,$val)=@_; return keys %{ $vars->{$self} } unless defined $key; return $vars->{$self}->{$key} unless (defined $val); $vars->{$self}->{$key} = $val; } sub DESTROY { my $self = shift; delete $vars->{$self}; } } 1; __END__
Re: Tutorial: Introduction to Object-Oriented Programming