my $total_population = $generations{$_};
$total_population += $generations{$_ - 1} if $generations{$_ - 1};
$total_population += $generations{$_ - 2} if $generations{$_ - 2};
####
dim sh, f, i, v
set sh = CreateObject("Shell.Application")
set f = sh.NameSpace(17) 'My Computer'
for each i in f.Items
' MsgBox i.Name & "=" & i.Type
if (i.Type = "CD Drive") then
for each v in i.Verbs
if (v.Name = "E&ject") then
v.DoIt()
end if
next
end if
next
##
##
use List::Util qw( shuffle );
use strict;
use warnings;
my @upper = 'A'..'Z';
my @lower = 'a'..'z';
$_ = "What That April With His Shoures Soote
The Drought Of Marche Hath Perced To The Roote
";
$" = '';
eval "y/@upper@lower/@{[shuffle @upper]}@{[shuffle @lower]}/";
print
##
##
sub parse_csv1 {
my $text = shift; # record containing comma-separated values
my @fields = ( );
while ($text =~ m{
# Either some non-quote/non-comma text:
( [^"',] + )
# ...or...
|
# ...a double-quoted field: (with "" allowed inside)
" # field's opening quote; don't save this
( now a field is either
(?: [^"] # non-quotes or
|
"" # adjacent quote pairs
) * # any number
)
" # field's closing quote; unsaved
}gx)
{
if (defined $1) {
$field = $1;
} else {
($field = $2) =~ s/""/"/g;
}
push @fields, $field;
}
return @fields;
}
##
##
my @f = parse_csv1('first,"second","thi,rd","fou""rth"');
print "$_\n" for @f;
##
##
first
second
thi
rd
fou
rth
##
##
( now a field is either
##
##
( # now a field is either
##
##
/* a basic one: */
div.header { background-color: #EEE; padding: 3px; border-bottom: 1px solid blue; }
ul.replies:before { content: url(http://perlmonks.org/images/bubbles.png) }
ul.replies { list-style-type: none; padding-left: 40px; }
li.reply { border: 1px solid blue; }
/* a fun one: */
div.header { background-color: #DFB; padding: 3px; }
ul.replies:before { content: url(http://perlmonks.org/images/bubbles.png) }
ul.replies { border-left: 2px solid red; padding: 3px; list-style-type: none; padding-left: 20px; }
li.reply { border-top: 2px solid blue; padding: 3px; }
/* both will need something like this: */
div.comment-on { text-align: center; font-size: larger; background-color: #DFB; }
##
##
Jebus, I can't type.
Perhaps a typing exercise would help.
*<* zdog has been kicked off channel #perlmonks by jcw (The quick brown fox kicked over the whining dog)
Yea, that worked.
*<* Signoff: castaway (Ping timeout)
*<* Signoff: theorbtwo (Ping timeout)
3 for the price of 1!
##
##
{
package Foo;
use overload '""' => \&as_string;
sub as_string { "Foo!" }
}
$_ = bless {}, 'Foo';
/(.*)/ and print "$1\n";
# does this print "Foo!" or "Foo=HASH(0xdeaded)"?
##
##
:set shiftwidth=2
:set foldcolumn=8 (not important)
:set foldmethod=indent
:1,$foldopen! (to open all folds)
##
##
use Tk::FileSelect;
use Data::Dumper;
use strict; use warnings;
my $mw = new MainWindow;
my $fs = $mw->FileSelect( -directory => '.' );
$fs->configure(-verify => ['-d'] );
print "$_: ",$fs->Subwidget($_),"\n" for
'dir_entry', # LabEntry
'file_entry', # LabEntry
'dir_list', # ScrlListbox
'file_list', # ScrlListbox
'dialog' # Dialog
;
my %ch;
$ch{$_} = $_ for $fs->children;
delete $ch{$_} for $fs->Subwidget;
my( $fr ) = @ch{ grep /Frame/, keys %ch };
my $b = $fr->Button( -text => "New Dir", -command => \&new_dir, );
$b->pack( -side => 'top', -fill => 'x', -expand => 1, );
my $file = $fs->Show;
die "> $file\n";
sub new_dir
{
$fs->Subwidget('dir_entry')->validate;
# note that this is the current "accepted" directory name from the
# dir entry. It may not be the name of an existing directory!
# but it will NOT have a trailing /* even if displayed.
# it's possible to wangle the direntry into a state where it
# has two slashes before the * and/or letters between
# the / and * for example: /x//* /x/y* /x//y*
# In all cases, the slash (both slashes, if present) up
# through the star are excluded from the value of -directory.
my $dir = $fs->cget('-directory');
print "Make a new dir under $dir !\n";
my $new_dirname = Prompt("Enter new folder name:"); # wave hands
my $new_dir = "$dir/$new_dirname";
mkdir $new_dir;
$fs->Accept_dir($new_dir);
}
##
##
package SNMPfu;
# pass an object which is either a Net::SNMP object
# (as returned by Net::SNMP->session) or an SNMP::Session
# object (as in the SNMP module/dist).
sub wrap
{
my $obj = shift;
bless $obj, __PACKAGE__ . '::' . ref $obj; # rebless
}
package SNMPfu::Net::SNMP; # wrapper for Net::SNMP
use base 'Net::SNMP';
sub get # wraps Net::SNMP::get_request
{
my( $self, $var_id ) = @_;
my $r = $self->get_request( -varbindlist => [$var_id] );
defined $r or die $self->error;
$r->{$var_id}
}
package SNMPfu::SNMP::Session; # wrapper for SNMP::Session
use base 'SNMP::Session';
sub get # wraps SNMP::Session::get
{
my( $self, $var_id ) = @_;
$self->get($var_id) # but I'm not sure this correct. Illustration only.
}
1;
##
##
my $sess = Net::SNMP->session( ... );
# or:
my $sess = SNMP::Session->new( ... );
SNMPfu::wrap( $sess );
my $val = $sess->get('sysDescr.0');
##
##
my $sh = new Win32::OLE 'Shell.Application' or die;
my $folder = $sh->NameSpace( $directory_path ) or die;
my $item = $folder->ParseName( $unqualified_filename ) or die;
$item->InvokeVerb('Edit');
##
##
/*
* cdrom_drives.js
* by jdporter
*/
var sh = WScript.CreateObject('Shell.Application');
var a = new Array();
var i;
for ( i = 65; i < 75; i++ ) { // test the first 10 drive letters
var p = String.fromCharCode(i,58,92); // letter + colon + backslash
try {
var fi = sh.NameSpace(p).Self; // will throw if bad path
if ( fi.IsFileSystem && fi.Type == 'Compact Disc' ) a.push(p);
}
catch(e) {
}
}
WScript.Echo(a.join("\n"));
##
##
use LWP::Simple;
use XML::Simple;
use strict;
my( $username, $password );
print "Username: "; chomp( $username = <> );
print "Password: "; chomp( $password = <> );
$username && $password or die "Abort.\n";
my $t = XMLin get "http://perlmonks.org/?node_id=32704;op=login;user=$username;passwd=$password;ticker=yes";
my $total;
my $n;
while ( my( $id, $hr ) = each %{ $t->{'NODE'} } )
{
$total += $hr->{'reputation'};
$n++;
}
print "$total rep in $n nodes\n";
##
##
use LWP::Simple;
use strict;
*a = \"http://perlmonks.org/?node_id";
printf qq
m%2d %7d %s\nm,m
leve.="(\d+)"l,m
exp="(\d+)"e,m
foruser="([^"]+)"ffor map get qq
m$a=16046;for_userid=$_m,map m
user_id="(\d+)"ug,get qq
m$a=15851m;
##
##