scratchpad
crazyinsomniac
#<CODE>
##sub THEFAKEOUT contains the actual nodelet
## the rest of the stuff is just for testing puroses
## you can see real life results after __END__
#=pod
package FUDGE;
sub new { return bless {}, shift };
{ my $bob = 0;
sub sqlSelect{
$bob++;
## IsApproved?
return 1 if $bob==1;
## IsFrontpaged?
return 1 if $bob==2;
## ApprovedBy?
return 10277 if $bob==3;
## FrontpagedBy?
return 10277 if $bob==4;
## IsConsidered?
return "DELETE - OBVIOUS" if $bob==5;
# I frontpage, approve, and consider everything
};
}
package main;
use strict;
use warnings;
use vars qw( $NODE $DB );
$DB = new FUDGE;
$NODE = { type => { title => "note" } };
sub getId{10277}
sub linkNode{my($id,$alt)=@_;return"[id://$id".($alt?"|$alt]":"]");}
sub getVars {
return {
types => "note,monkdiscuss",
note_node => 1,
note_linktype => 1,
front_page => 1,
frontpage_linktype => 1,
};
};
sub getNode {}
print "THEFAKEOUT <br>\n ", THEFAKEOUT();
#=cut
sub THEFAKEOUT {
# ahoy hoy
# this just be the approval nodelet stripped naked (mostly)
# title: Node Status
# or
# Mini Approval Nodelet
# In the code below, you'll see a few comments like
# IsApproved?
# these ought to be made into htmlcodes, and eventually, make it
# into their own package, like Everything::Moderation::Approval
#[%
my $SETTING = getVars( getNode('approval nodelet settings','setting') );
my $type = $NODE->{type}{title};
my %types;
{
my @types = split /,/, $SETTING->{types};
@types{@types} = (1) x @types;
}
return unless $types{$type}
or
grep(
$_ eq $type,
qw( modulereview bookreview note sourcecode
snippet perltutorial perlnews
)
);
my $nid = getId($NODE);
my $ok = 0;
## IsApproved?
$ok = $DB->sqlSelect(
'*',
'links',
"from_node = $SETTING->{$type.'_node'}"
. " and to_node = $nid"
. " and linktype = $SETTING->{$type.'_linktype'}",
"limit 1"
) if $types{$type};
## IsFrontpaged?
my $fp = 0;
$fp = $DB->sqlSelect(
'*',
'links',
"from_node = $SETTING->{'front_page'}"
. " and to_node = $nid"
. " and linktype = $SETTING->{'frontpage_linktype'}",
"limit 1"
) if $types{$type};
## Node Type ~ like %S for titles in [id://27|basichead]
my $message = "Node Type: $NODE->{type}{title} <br />";
if( $ok || $fp ) {
my $okid = 0;
## ApprovedBy?
$okid = $DB->sqlSelect(
'user_id',
'approved',
qq{node_id = $nid and action = "ok"},
"order by tstamp desc limit 1"
) if $ok;
my $fpid = 0;
## FrontpagedBy?
$fpid = $DB->sqlSelect(
'user_id',
'approved',
qq{node_id = $nid and action = "fp"},
"order by tstamp desc limit 1"
) if $ok;
## The Actual Status Messages
if( $ok and $okid ) {
$message .= sprintf 'Approved by %s<br />', linkNode($okid);
} else {
$message .= "This node hasn't been approved yet<br />";
}
if( $fp and $fpid ){
$message .= sprintf 'Front-paged by %s<br />', linkNode($fpid);
}
}
## IsConsidered?
my $considered = $DB->sqlSelect(
'description',
'considernodes',
"considernodes_id = $nid"
);
if( $considered) {
$considered =~ s/^[(](.+?)[)](.*)/
sprintf '(%s) %s', linkNodeTitle($1), $2/eg;
$message .= linkNode(28877, 'Considered') . ': ' . $considered . '<hr />';
}
return $message . linkNode(17645, 'help');
#%]
}# end of sub THEFAKEOUT
__END__
#</CODE>
THEFAKEOUT <br>
Node Type: note <br />Approved by [id://10277]<br />Front-paged by [id://10277]<br />[id://28877|Considered]: DELETE - OBVIOUS<hr />[id://17645|help]
<hr>
<hr>
<hr>
<CODE>
use Benchmark qw( cmpthese timethese );
use Storable qw( freeze thaw );
use Data::Denter qw( Indent Undent );
timethese( 2_000, { Data::Denter => \&DENTOR, Storable => \&STORKO });
print "\n\n\n";
cmpthese( 2_000, { Data::Denter => \&DENTOR, Storable => \&STORKO });
sub DENTOR {
my $in = Indent \%BLARG;
my %out = Undent $in;
return();
}
sub STORKO {
my $in = freeze \%BLARG;
my %out = %{ thaw($in)};
return();
}
__END__
Benchmark: timing 2000 iterations of Data::Denter, Storable...
Data::Denter: 12 wallclock secs (11.71 usr + 0.01 sys = 11.72 CPU) @ 170.69/s (n=2000)
Storable: 6 wallclock secs ( 5.60 usr + 0.00 sys = 5.60 CPU) @ 357.27/s (n=2000)
Benchmark: timing 2000 iterations of Data::Denter, Storable...
Data::Denter: 12 wallclock secs (11.80 usr + 0.00 sys = 11.80 CPU) @ 169.53/s (n=2000)
Storable: 6 wallclock secs ( 5.62 usr + 0.00 sys = 5.62 CPU) @ 356.06/s (n=2000)
Rate Data::Denter Storable
Data::Denter 170/s -- -52%
Storable 356/s 110% --
</CODE>
<HR>
<CODE>
# $DB = tie ... DB_File .. BTREE
$DB->get($key, $value),
$DB->put($key, $value, R_NOOVERWRITE|R_SETCURSOR);
# is a dumber way of saying
$DB->seq($key, $value, R_CURSOR);
# now you know
</CODE>
<pre>/home/crazyinsomniac/.cpan
|-- CPAN
| `-- MyConfig.pm
|-- Metadata
|-- build
...</pre>
[talexb], re [id://148235|Re: Module Installs]<BR>
[http://www.perldoc.com/perl5.6.1/lib/CPAN.html] or
[perlman:lib:CPAN] or
see your own `perldoc CPAN'
<FONT SIZE=2>
<PRE><TT>
CONFIGURATION
When the CPAN module is installed, a site wide configuration file is
created as CPAN/Config.pm. The default values defined there can be
overridden in another configuration file: CPAN/MyConfig.pm. You can
store this file in $HOME/.cpan/CPAN/MyConfig.pm if you want, because
$HOME/.cpan is added to the search path of the CPAN module before the
use() or require() statements.
5) I am not root, how can I install a module in a personal directory?
You will most probably like something like this:
o conf makepl_arg "LIB=~/myperl/lib \
INSTALLMAN1DIR=~/myperl/man/man1 \
INSTALLMAN3DIR=~/myperl/man/man3"
install Sybase::Sybperl
You can make this setting permanent like all "o conf" settings with
"o conf commit".
You will have to add ~/myperl/man to the MANPATH environment
variable and also tell your perl programs to look into ~/myperl/lib,
e.g. by including
use lib "$ENV{HOME}/myperl/lib";
or setting the PERL5LIB environment variable.
Another thing you should bear in mind is that the UNINST parameter
should never be set if you are not root.
</TT></PRE></FONT>
This is MyConfig.pm (I just copied Config.pm, and changed things)
<CODE>bash-2.05$ cat MyConfig.pm
# This is CPAN.pm's systemwide configuration file. This file provides
# defaults for users, and the values can be changed in a per-user
# configuration file. The user-config file is being looked for as
# ~/.cpan/CPAN/MyConfig.pm.
$CPAN::Config = {
'build_cache' => q[10],
'build_dir' => q[/home/crazyinsomniac/.cpan/build],
'cache_metadata' => q[1],
'cpan_home' => q[/home/crazyinsomniac/.cpan],
'dontload_hash' => { },
'ftp' => q[/usr/bin/ftp],
'ftp_proxy' => q[],
'getcwd' => q[cwd],
'gzip' => q[/usr/bin/gzip],
'http_proxy' => q[],
'inactivity_timeout' => q[0],
'index_expire' => q[1],
'inhibit_startup_message' => q[0],
'keep_source_where' => q[/home/crazyinsomniac/.cpan/sources],
'lynx' => q[/usr/local/bin/lynx],
'make' => q[/usr/bin/make],
'make_arg' => q[],
'make_install_arg' => q[],
'makepl_arg' => q[LIB=/home/crazyinsomniac/perlmodlib PREFIX=/home/crazyinsomniac/perlmodlib INSTALLMANDIR=/home/crazyinsomniac/perlmodlib/man INSTALLMAN3DIR=/home/crazyinsomniac/perlmodlib/man3],
'ncftp' => q[],
'ncftpget' => q[],
'no_proxy' => q[],
'pager' => q[more],
'prerequisites_policy' => q[follow],
'scan_cache' => q[atstart],
'shell' => q[/bin/csh],
'tar' => q[/usr/bin/tar],
'term_is_latin' => q[1],
'unzip' => q[/usr/local/bin/unzip],
'urllist' => q[push],
'wait_list' => [q[wait://ls6.informatik.uni-dortmund.de:1404]],
'wget' => q[],
};
1;
__END__
</CODE>
Now to try to install (without uploading)
<CODE>
#!/usr/bin/perl -w
use CGI::Carp qw( fatalsToBrowser );
use CGI qw(:all);
use CPAN;
use Data::Dumper;
print header;
if( exists $ENV{QUERY_STRING} and $ENV{QUERY_STRING} =~ /runit/ ) {
print "installing Pod::Stripper, check back in a few minutes";
exec($^X, '-MCPAN', "-e'install(qq,Pod::Stripper,)'")
or print "couldn't exec";
} else {
print pre(escapeHTML(Dumper \%CPAN::Config));
# to make sure it's what you want
}
</CODE>
<H1>D'url JavaScript</H1>
<script language="javascript">
<!--//
// SCHEME://AUTHORITY/PATH?QUERY#FRAGMENT
var scheme = '([a-z]{3,7})';
var domain = '[0-9a-z.-]+';
var port = ':?\d?\d?\d?\d?';
var authority = '(' + domain + port + ')';
var path = '([0-9a-z\\./%]+)';
var query = '([^\s#]+)';
var fragment = '([^s]+)';
var urlRE = new RegExp( scheme // 1
+ '://'
+ authority // 2
+ path + '?' // 3
+ query + '?' // 4
+ fragment + '?' ); //5
urlRe = /urlRe/i; // make it case insensitive ...
var outsideLinksToggle = null;
function OutsideLinks() {
var theLinks = document.links;
var linxor = document.getElementById("linxor"); // <div id="linxor"></id>
var innerhtml = '';
if(outsideLinksToggle == null ) {
outsideLinksToggle = linxor.innerHTML;
var urls = 0;
for( ix = 0; ix < theLinks.length; ix++) {
var LNK = new String( theLinks[ix] );
var url = LNK.match(urlRE);
if( url != null) {
urls++;
if(url[2].substring('perlmonks.') != -1 ) {
innerhtml += ('<a href="' + LNK + '">' +LNK+ "</a><BR>");
}
}
}
innerhtml += ('<BR>theLinks.length('+theLinks.length+')<br>urls('+urls+')<HR>');
linxor.innerHTML += innerhtml;
} else {
linxor.innerHTML = outsideLinksToggle;
outsideLinksToggle = null;
}
}
document.write('<DIV ID="linxor"><B><a NAME="dlinxor" href="javascript:OutsideLinks()">Outside Links</a></B><BR></DIV>');
//-->
</script>
<HR>
<CODE>
<H1>D'url JavaScript</H1>
<script language="javascript">
<!--//
// SCHEME://AUTHORITY/PATH?QUERY#FRAGMENT
var scheme = '([a-z]{3,7})';
var domain = '[0-9a-z.-]+';
var port = ':?\d?\d?\d?\d?';
var authority = '(' + domain + port + ')';
var path = '([0-9a-z\\./%]+)';
var query = '([^\s#]+)';
var fragment = '([^s]+)';
var urlRE = new RegExp( scheme // 1
+ '://'
+ authority // 2
+ path + '?' // 3
+ query + '?' // 4
+ fragment + '?' ); //5
urlRe = /urlRe/i; // make it case insensitive ...
var outsideLinksToggle = null;
function OutsideLinks() {
var theLinks = document.links;
var linxor = document.getElementById("linxor"); // <div id="linxor"></id>
var innerhtml = '';
if(outsideLinksToggle == null ) {
outsideLinksToggle = linxor.innerHTML;
var urls = 0;
for( ix = 0; ix < theLinks.length; ix++) {
var LNK = new String( theLinks[ix] );
var url = LNK.match(urlRE);
if( url != null) {
urls++;
if(url[2].substring('perlmonks.') != -1 ) {
innerhtml += ('<a href="' + LNK + '">' +LNK+ "</a><BR>");
}
}
}
innerhtml += ('<BR>theLinks.length('+theLinks.length+')<br>urls('+urls+')<HR>');
linxor.innerHTML += innerhtml;
} else {
linxor.innerHTML = outsideLinksToggle;
outsideLinksToggle = null;
}
}
//-->
</script>
<DIV ID="linxor">
<B><a NAME="dlinxor" href="javascript:OutsideLinks()">
Outside Links</a></B><BR>
</DIV>
</CODE>
<br /><a HREF="/index.pl?node_id=106868">pmdev wiki</a>