###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__
#
THEFAKEOUT
Node Type: note Approved by crazyinsomniac Front-paged by crazyinsomniac Considered: DELETE - OBVIOUS help
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) @ 35
+7.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) @ 35
+6.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
/home/crazyinsomniac/.cpan
|-- CPAN
| `-- MyConfig.pm
|-- Metadata
|-- build
...
talexb, re Re: Module Installs
http://www.perldoc.com/perl5.6.1/lib/CPAN.html or
perlman:lib:CPAN or
see your own `perldoc CPAN'
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.
This is MyConfig.pm (I just copied Config.pm, and changed things)
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/c
+razyinsomniac/perlmodlib INSTALLMANDIR=/home/crazyinsomniac/perlmodli
+b/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__
Now to try to install (without uploading)
#!/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
<script language="javascript">
</script>
<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>url
+s('+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>
pmdev wiki
|