Here a small piece of code showing how to create a Notebook with icons at the side (think MSN). In this example you need two icons called "users.png" and "schedule.png" 16 x 16 pixels in directory "C:\Documents and Settings\Steve\My Documents\Projects\wx" and set the $loc_windows_linux flag to "l" or "w"
If you are a fan of Getopt::Long and you need to pass
negative numbers to your script from the command line, here is a code snippet which can help.
By default Getopt::Long reacts to command line arguments with
a dash (-). Thus, if you want to pass -5 on the command line,
Getopt::Long will strip off the minus sign and treat that as
the option '5'. That will result in an error if you are checking the results of GetOptions.
You can change the default behavior by setting the prefix to
something other than '-'. For example, in the code snippet below, prefix is set to the plus sign (+). Refer to Configuring Getopt::Long. Naturally, you should make sure this is well-documented in your usage POD.
use strict;
use warnings;
use Getopt::Long;
Getopt::Long::Configure('prefix=+');
my %opt;
GetOptions(\%opt, qw(help offset=i)) or die "error...\n";
$opt{offset} = 3 unless exists $opt{offset};
my $value = shift;
print ' result = ', $value + $opt{offset}, "\n";
I recently had the need to do such a thing, but I could not find any examples of using this feature. Perhaps this will be of use to someone in the future. I uploaded my actual script to CPAN: convert_eng
This forum post gives the following puzzle. You have a square chess board of sides n with a piece in each of three corner squares. In each step you can push a piece in one of the four directions parallel to the sides and then it slides till it hits another piece or the side of the board. Get a piece to the center in the fewest steps possible.
The perl script posted here computes the answer by brute force if invoked with n as the argument.
This script runs through an Outlook Express mail folder and pulls out email information for all mail after a given date. The information is then inserted into a table in a MS Word document to build a correspondence list as part of a meeting agenda document.
Much of the code dealing with the location of things is hard wired and will need to be changed in (I hope) obvious ways for your own application.
I was inspired by this Reddit thread to see if I could supplement the traditional regex primality test with a regex Euclidean algorithm. Here's the shortest one that occurred to me; it takes the two numbers (assumed to be positive integers) whose GCD we want to compute in $a and $b:
(1 x $a) =~ /(?:$1)*(.*)/ and ($a, $b) = ($b, length $1) while $b
At the end, $a is the GCD (and $b is 0). Life's even better if we're allowed to start with $a and $b strings of 1s of the desired length, and leave our answer in $a in the same form:
Since it's Halloween, I decided to decorate my terminal as a "haunted house". It looks pretty scary, but the cpan prompt wasn't quite there. I used this one-liner to change the "cpan>" prompt to Bela Lugosi's famous line: "_I_am_Dracula__". It only accepts letters or underscores, and it only changes the prompt temporarily for that session. Happy Halloween!
#!/sw/bin/perl
use strict;
use warnings;
my $prompt = '_I_am_Dracula__';
system("perl -MCPAN -e 'CPAN::shell($prompt)'");
All,
This is a follow up to Not Quite Longest Path Problem. I have written the following code which has resulted in becoming the all-time high scorer on FaceBook. It is designed to run on windows. The scoring routine allows me to write variations on get_next_word() to determine the optimal strategy.
I may add a few more levels but I am losing interest. The code was written in a hurry but it shouldn't be too difficult to decipher. Feel free to knock me off the leader board.
Update: I realized I didn't provide the code to construct 'word_list.db' Just replace 'four_dict.txt' with any word list of 4 letter words.
I had a need to create a set of directories - one per day. Normally I would use the date in ISO format: YYYY-MM-DD since it naturally sorts in date order. However for this particular application, I wanted reverse order - most recent date at the top, older and progressively less interesting dates following.
This routine generates a directory name based on a unix timestamp value (default 'today'), that includes a sort code prefix to force reverse date ordering:
Trying to debug an encoding problem? The following will try to figure out what encoding was used and what encoding should have been used.
use 5.008;
use strict;
use warnings;
use Encode qw( encode decode );
use charnames qw( :full );
my $expected
= "\N{LATIN CAPITAL LETTER I WITH CIRCUMFLEX}";
my $got
= "\N{LATIN CAPITAL LETTER A WITH TILDE}"
. "\N{LATIN CAPITAL LETTER Z WITH CARON}";
my @encs = (
'US-ASCII',
( map "UTF-$_", qw( 7 8 16be 16le 32be 32le ) ),
( map "UCS-$_", qw( 2be 2le 4be 4le ) ),
( map "iso-8859-$_", 1..11, 13..16 ),
( map "Windows-$_", 437, 737, 775, 850, 852, 855, # OEM pages
857, 858, 860, 861, 862, 863,
865, 866, 869,
874, 932, 936, 949, 950, # ANSI pages
1250..1258, ),
);
for my $enc_for_enc (@encs) {
my $encoded = encode($enc_for_enc, $expected);
for my $enc_for_dec (@encs) {
my $decoded = decode($enc_for_dec, $encoded);
next if $decoded ne $got;
print("$enc_for_enc as $enc_for_dec:\n");
for ($decoded =~ /./sg) {
my $code = ord;
my $name = charnames::viacode($code);
printf("(U+%04X) %s\n", $code, $name);
}
print("\n");
}
}
In the course of my math class in the engineering program I'm currently in it's often convenient to write up little programs that perform some calculation based on a function or algorithm. However, oftentimes a reasonable program makes calculations in a different way than humans might, and it becomes a challenge to parse the print statements I insert into the code to "show my work."
Well I finally decided to get around this problem after reading about inlining eval's in regular expressions while reading the Camel in a compromising position recently and faced with a particularly laborious exercise in my latest assignment:
Find the number of partitions of 7 and 8 using the formula for the number of partitions of a number (all possible combinations of adding smaller positive integers):
P(m,n) = {
1 if m or n = 1,
P(m,m) if m < n,
1 + P(m,m-1) if m = n > 1,
P(m,n-1) + P(m-n,n) if m > n > 1
}
The output to this program though is actually harder to put together than doing the problem manually! The recursion is depth-first and so the program goes straight to the bottom of each branch, and yet it's more natural to evaluate one level at a time and combine. Fortunately, Perl rocks my world:
sub P {
# Returns strings!
my ( $m, $n ) = @_;
if ( $m == 1 or $n == 1 ) {
return 1;
}
if ( $m < $n ) {
return "P($m,$m)";
}
if ( $m == $n ) {
return sprintf( "1 + P(%i,%i)", $m, $m - 1 );
}
if ( $m > $n ) {
return sprintf( "P(%i,%i) + P(%i,%i)", $m, $n - 1, $m - $n, $n
+ );
}
die "impossible!";
}
MAIN: {
local $_ = "P($m,$n)";
print;
while ( /\D/ ) {
# Put ints up front
1 while s/^(.+\)) \+ (\d+)/$2 + $1/;
# Add the ints
1 while s/(\d+) \+ (\d+)/$1 + $2/eg;
# Evaluate *one* level at a time
s/(P\(\d+,\d+\))/$1/eeg;
printf( "\n = %s", $_ );
}
}
Will take a list of hosts from either STDIN or a file. It will resolve the hosts and then try to
access them using SSH to extract manufacturer, serial number and product name using dmidecode. It
will then access the manufacturers support page to determine the warranty of the host. Currently
it works with IBM, HP and DELL.
Assumes you are using SSH Public Keys, if your key has a password use ssh-agent to automate the password typing.
Using it on HP has some shortcomings because of their support page. It requires you to specify country
and product number, neither is possbile to extract from a host in any automated faschion. To work around
this issue there is a convertion table for HP product name to product number and country will need to
be specified either per subnet or one default location.
This Padre plugin allows users to type shell commands/scripts into the active document and run them. The output from the command is then inserted into the document after the command. See the POD for examples.
Caveat emptor: I've only tested this on Linux, but it *should* work on pretty much any *nix like system.
Update: After working more on this module and polishing things up a bit I've uploaded the new-and-improved Padre::Plugin::ShellCommand to CPAN.
In responding to RFC: Padre::Plugin::MyTemplates, LanX pointed me to yasnippet (which loooks seriously cool). This got me wondering just how hard it would be to create a rudementary text/code expansion plugin for Padre.
I don't quite have this working the way I want it to yet, but it's close enough that I'm using it and probably won't work on it for a while. It has some room for improvement. For instance, my phone won't feed a file list to the computer through OBEX for some reason so I didn't include any way to browse the phone files. You just have to know the filename of any files you want to pull from the phone. It uses the obexftp utility because I didn't particularly feel like coding the actual file transfer from scratch, particularly since I'd have had to find and learn to use an obex library to do it.
#!/usr/bin/perl
#
#This script is intended to use obex to transfer files to and from my
#cell phone, a Samsung MyShot (yes, I know it has a more accurate mode
+l
#number, but I'm writing this thing after having given up on sleep for
+ the night)
use strict;
use warnings;
use Tk;
use vars qw($file $mw $phoneAddr);
#Set the bluetooth address of the phone
$phoneAddr="Phone BT Address";
$mw=new MainWindow(-title=>"FoneFiles");
$file=$mw->Entry();
my $fileButton=$mw->Button(-text=>"Get File to Push",-command=>\&getFi
+le);
my $getPutFrame=$mw->Frame();
my $getButton=$getPutFrame->Button(-text=>"Get",-command=>\&getGo);
my $putButton=$getPutFrame->Button(-text=>"Put",-command=>\&putGo);
#Main window geometry
$file->pack();
$fileButton->pack();
$getPutFrame->pack();
$getButton->pack(-side=>"left");
$putButton->pack(-side=>"left");
#sub to pick file to push to phone. I didn't write one to pick a file
+to get
#from the phone because it would work with my phone even if I did.
sub getFile {
my $filename=$mw->getOpenFile();
$file->configure(-text=>$filename);
}
#sub to get file from phone
sub getGo {
my $varFile=$file->get();
$varFile=~s/\ /\\ /;
my $notice=$mw->Toplevel(-title=>"Getting");
my $lab=$notice->Label(-text=>"Getting file from your phone. Pleas
+e wait")->pack;
$mw->update;
$notice->update;
#obexftp is a command line obex utility.
#This line will use the obex push protocol to get a file from
+the phone
`obexftp -b $phoneAddr --nopath --get $varFile`;
destroy $notice;
}
#sub to send a file to the phone
sub putGo {
my $varFile=$file->get();
$varFile=~s/\ /\\ /;
my $notice=$mw->Toplevel(-title=>"pushing");
my $lab=$notice->Label(-text=>"Pushing file to your phone. Please
+wait")->pack;
$mw->update;
$notice->update;
#This command uses obex push to push a file to the phone
`obexftp -b $phoneAddr --nopath --put $varFile`;
destroy $notice;
}
MainLoop;
