https://dsss.be/w/ 2026-07-05T22:22:47+00:00 https://dsss.be/w/ https://dsss.be/w/_media/wiki:dokuwiki.svg text/html 2009-09-04T16:20:17+00:00 Anonymous (anonymous@undisclosed.example.com) https://dsss.be/w/perl:ansi_color?rev=1252081217&do=diff if you want to avoid installing Term::ANSIColor: sub ansi { my ($c) = @_; if (!$c) { return "\e[m"; } my %colors = qw( reset 0 bold 1 underline 4 inverse 7 black 30 red 31 green 32 yellow 33 blue 34 violet 35 magenta 35 cyan 36 white 37 on_black 40 on_red 41 on_green 42 on_yellow 43 on_blue 44 on_violet 45 on_magenta 45 on_cyan 46 on_white 47 ); my $r = join(';',ma… text/html 2009-08-13T16:57:02+00:00 Anonymous (anonymous@undisclosed.example.com) https://dsss.be/w/perl:command_line_options_and_usage_with_getopt_long?rev=1250182622&do=diff #!/usr/bin/perl use strict; use Getopt::Long; # declare option-related vars my $bVerbose; my $somevalue; # allow "-se" to mean "-s -e", also makes single-letter options case sensitive Getopt::Long::Configure ("bundling"); # stop parsing after the first non-option; needed to let you pass options # in the host command Getopt::Long::Configure ("require_order"); # parse command line options exit unless GetOptions( "help" => sub { usage(); }, "verbose|v" => \$bVerbose, "number|n=i" => sub {… text/html 2009-08-13T16:57:00+00:00 Anonymous (anonymous@undisclosed.example.com) https://dsss.be/w/perl:command_line_options_and_usage_with_getopts?rev=1250182620&do=diff #!/usr/bin/perl use Getopt::Std; my %opt; getopts( 'afqcrh', \%opt ) or usage(); usage() if ($opt{h} or !@ARGV); sub usage() { (my $progName = $0) =~ s#.*[/\\]##; print <<EODOC; TITLE INFO Usage: $progName [-a | -f | -q] [-r] [-c] [-h] [files] Options: -a Stuff -f Stuff -q Stuff EODOC exit; } text/html 2009-08-13T16:56:45+00:00 Anonymous (anonymous@undisclosed.example.com) https://dsss.be/w/perl:command_line_options_with_usage?rev=1250182605&do=diff # Tyler Bletsch use strict; # Get command line options while ($ARGV[0] =~ /^-(.)(.*)/) { shift; my ($opt,$param) = ($1,$2); if ($opt eq 'a') { next; } elsif ($opt eq 'b') { next; } else { &usage } } # Check for existance of remaining arguments &usage unless (@ARGV); ############################################################################### sub usage() { (my $progName = $0) =~ s#.*[/\\]##; print <<EODOC; TITLE Purpose Usage: $progName [options] [arguments] Options: a … text/html 2009-08-13T16:57:07+00:00 Anonymous (anonymous@undisclosed.example.com) https://dsss.be/w/perl:dns_stuff?rev=1250182627&do=diff use Socket; sub lookup { my ($a) = @_; return is_ip($a) ? ip2host($a)||$a : host2ip($a)||$a; } sub is_ip { $_[0] =~ /\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}/ } sub ip2host { my ($a) = @_; return gethostbyaddr(inet_aton($a), AF_INET) || undef; } sub host2ip { my ($a) = @_; my $hrec = (gethostbyname($a))[4] or return undef; return inet_ntoa($hrec); } text/html 2009-08-13T16:56:44+00:00 Anonymous (anonymous@undisclosed.example.com) https://dsss.be/w/perl:for_each_file?rev=1250182604&do=diff using standard module: use File::Find; find({ wanted => sub { # for each file # $_ is file name # $File::Find::name is full path # $File::Find::dir is directory path }, preprocess => sub { # process the list of files about to be wanted() # $File::Find::dir is directory path return @_; }, follow => 0, # follow symlinks? no_chdir => 0, # dont chdir (so $_ equals $File::Find::name) }, @directories); text/html 2009-08-13T16:56:42+00:00 Anonymous (anonymous@undisclosed.example.com) https://dsss.be/w/perl:forking_server?rev=1250182602&do=diff # Tyler Bletsch use IO::Socket; # Will listen on $listenPort my $sockListen = new IO::Socket::INET (LocalPort => $listenPort, Proto => 'tcp', Listen => 1000, Reuse => 1); die "Could not create socket: $!\n" unless $sockListen; print "Listening on port $listenPort.\n"; while (1) { print "Waiting to accept on port $listenPort...\n"; $sockClient = $sockListen->accept(); # Get next client $clientSockAddr = $sockClient->peername(); ($clientPort, $clientAddr) = sockaddr_in($clientSockAddr); $c… text/html 2010-01-08T21:50:55+00:00 Anonymous (anonymous@undisclosed.example.com) https://dsss.be/w/perl:index?rev=1262987455&do=diff Perl code snippets * Prototype class for OO * Real CSV Parsing * ANSI color * Sets * DNS stuff * Make a loop parallel * Command line options and usage with Getopt Long * Command line options and usage with getopts * command line options with usage * For each file * Forking server * kvpff * Loop with timekeeping * Single document web server * Read password without echo * Amazon preview leech Blobs of code sub max { my $r=$_[0]; for (@_) { if ($_>$r) { $r=$_ } … text/html 2009-08-13T16:56:40+00:00 Anonymous (anonymous@undisclosed.example.com) https://dsss.be/w/perl:kvpff?rev=1250182600&do=diff # Key Value Pair File Format reader/writer 1.0 # By Tyler Bletsch use Carp; # Format: # ; comment type one # # comment type two # ; # ; standard key value pair # key1=value1 # ; multiline value # key2=\ # This is literally the data. # The only problem is that there is no way to escape the end symbol, # which is a dot alone on a line (AKA "\n.\n"). # . # ; if your data has an equal sign, a multiline escape is used # ; (even if the data is one line) # … text/html 2009-08-13T16:56:38+00:00 Anonymous (anonymous@undisclosed.example.com) https://dsss.be/w/perl:loop_with_timekeeping?rev=1250182598&do=diff my $timeStart = time; my $itDone=0; my $itTotal; # Set to the total number of iterations # LOOP BEGIN { # LOOP BODY; $itDone++; my $timeProc = (time() - $timeStart)||1; my $speed = ($itDone/$timeProc) || -1; # files/second my $etaS = int($itTotal - $itDone)/$speed; #seconds my $etaM = int($etaS/60); $etaS %= 60; my $etaH = int($etaM/60); $etaM %= 60; printf " >> $itDone/$itTotal = %.1f%%, $timeProc s, %0.2f it/s, ETA %d:%02d:%02d\n",($itDone/$itTotal*100),$speed,$etaH,$etaM,$eta… text/html 2009-08-13T16:57:05+00:00 Anonymous (anonymous@undisclosed.example.com) https://dsss.be/w/perl:make_a_loop_parallel?rev=1250182625&do=diff Introduction Let's say you have a loop like: foreach my $host (@hosts) { system "ssh $host reboot"; } This is well and good, but it takes forever if you want to do 1500 clients. Therefore, we'd want to parallelize the loop. There are two ways to go about this: text/html 2010-01-08T21:52:18+00:00 Anonymous (anonymous@undisclosed.example.com) https://dsss.be/w/perl:prototype_class_for_oo?rev=1262987538&do=diff Awesome.pm: package Awesome; use strict; # static (class-wide) variable my $object_count = 0; # constructor -- a static method that creates and returns a new object sub new { my $class = shift; # remaining args are constructor parameters. # we'll assume it takes one param: name. this parameter gets saved in our new "object", a blessed hash ref my $self = {name => $_[0]}; bless($self,$class); $object_count++; # increment a static counter return $self; } # static method -- the firs… text/html 2009-08-13T16:56:34+00:00 Anonymous (anonymous@undisclosed.example.com) https://dsss.be/w/perl:read_password_without_echo?rev=1250182594&do=diff sub readPassword { my ($prompt) = @_; $prompt ||= 'password: '; my $password; if (eval "require Term::ReadKey") { # runtime load Term::ReadKey->import(qw/ReadMode ReadLine/); local $|=1; ReadMode('noecho'); print STDERR $prompt; chomp($password = ReadLine(0)); ReadMode('normal'); print STDERR "\n"; } else { print STDERR "WARNING: Unable to load Term::ReadKey -- TYPED PASSWORDS WILL BE ECHOED!\n"; print STDERR $prompt; chomp ($password = <STDIN>); } return $password; } text/html 2009-08-13T16:57:12+00:00 Anonymous (anonymous@undisclosed.example.com) https://dsss.be/w/perl:real_csv_parsing?rev=1250182632&do=diff sub parse_csv { if (!ref $_[0]) { # if given a file, open it and recurse on the handle my ($filename) = @_; open my $fp, $filename or die "$filename: $!\n"; my $r = parse_csv($fp); close $fp; return $r; } my ($fp) = @_; my $char; my $status; # yes, we're using a single-character FSM to parse CSV in perl # yes, I know about split and regexes, but that doesn't help with matched quotes & embedded commas # yes, I know about Text::CSV, but that doesn't support embedded newlines #… text/html 2009-08-13T16:57:09+00:00 Anonymous (anonymous@undisclosed.example.com) https://dsss.be/w/perl:sets?rev=1250182629&do=diff Consider finding the union and intersection of two unique arrays @a and @b: foreach $e (@a) { $union{$e} = 1 } foreach $e (@b) { if ( $union{$e} ) { $isect{$e} = 1 } $union{$e} = 1; } @union = keys %union; @isect = keys %isect; This would be more idiomatically written as: text/html 2009-08-13T16:56:36+00:00 Anonymous (anonymous@undisclosed.example.com) https://dsss.be/w/perl:single_document_web_server?rev=1250182596&do=diff This little script acts as a web server, but it serves only one document no matter what the requested URL was: the document embedded in the script itself. This is useful to throw on a machine in a lab environment to identify who owns it and what it's for.