##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
\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}
";
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
', linkNode($okid);
} else {
$message .= "This node hasn't been approved yet
";
}
if( $fp and $fpid ){
$message .= sprintf 'Front-paged by %s
', 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 . '
##
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% --
##
##
# $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
##
##
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__
##
##
#!/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
}
##
##
D'url JavaScript