Beefy Boxes and Bandwidth Generously Provided by pair Networks
The stupid question is the question not asked
 
PerlMonks  

crazyinsomniac's scratchpad

by crazyinsomniac (Prior)
on Jun 01, 2004 at 22:18 UTC ( #358681=scratchpad: print w/ replies, xml ) Need Help??

#
##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
Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others scrutinizing the Monastery: (13)
As of 2014-12-22 16:30 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    Is guessing a good strategy for surviving in the IT business?





    Results (121 votes), past polls