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; ####