Date calc with SQL

Micro tip of the day: How many days has past since a date field in the database?

SELECT (TO\_DAYS(NOW()) - TO\_DAYS(date\_field)) AS days\_past FROM tablename

Fetching available newsgroups from a news server

This script fetches a list of available newsgroups (and descriptions) from a news server. The group list is returned as a hashref where the keys are the groupname and the value is a description of the group. 

#!/usr/bin/perl -w
use strict;
use Net::NNTP;
use MIME::Base64 qw(decode\_base64);
use MIME::QuotedPrint qw(decode\_qp);

my  $server= "sunsite.auc.dk";
print STDERR "connecting to $server... ";
my $nntp= Net::NNTP->new($server);
unless($nntp) {
  print STDERR "failedn";
  exit 1;
}
print STDERR "okn";

print STDERR "getting messages... ";
my $newstuff= $nntp->newnews(time - 7\*24\*2600, "dk.edb.programmering.perl");
unless($newstuff) {
  print STDERR "failedn";
  exit 1;
}
print STDERR "okn";

my @messages;
foreach my $msgid (@$newstuff) {
  my $head= $nntp->head($msgid);
  next unless $head;

  my %msg;
  push @messages, %msg;
  foreach(@$head) {
    next unless /^(Newsgroups|Subject|From):s+(.+)$/i;
    $msg{lc $1}= $2;
  }
}

my $last= "";
foreach(sort { $a->{newsgroups} cmp $b->{newsgroups} } @messages) {
  if($\_->{newsgroups} ne $last) {
    print "n" if $last;
    $last= $\_->{newsgroups};
    print "$last:n";
  }
  print "t" . decode\_header($\_->{subject}) .
    " - " . decode\_header($\_->{from}) ."n";
}

sub decode\_header {
  my($text)= @\_;

  $text=~ s/=?(iso-?8859-.?|us-ascii|utf-8)?(q|b)?(\[^?\]\*)?=(s\*(?==?))?/&decode\_header\_block(lc $1,$2,$3);/gei;
  return $text;
}

sub decode\_header\_block {
  my ($input,$enc,$text) = @\_;
  if ($enc =~ /q/i) {
    $text=~ s/\_/ /g;
    $text= decode\_qp($text);
  } else {
    $text= decode\_base64($text);
  }
  return $text; # oh well  \[:-)\]
}

exit();

Fetching recent headlines from a news server

The followig piece connects to a news-server and fetches subjects from the last week in a specific newsgroup (the Danish perl-newsgroup) and prints these. 

#!/usr/bin/perl -w
use strict;
use Net::NNTP;
use MIME::Base64 qw(decode\_base64);
use MIME::QuotedPrint qw(decode\_qp);

my  $server= "sunsite.auc.dk";
print STDERR "connecting to $server... ";
my $nntp= Net::NNTP->new($server);
unless($nntp) {
  print STDERR "failedn";
  exit 1;
}
print STDERR "okn";

print STDERR "getting messages... ";
my $newstuff= $nntp->newnews(time - 7\*24\*2600, "dk.edb.programmering.perl");
unless($newstuff) {
  print STDERR "failedn";
  exit 1;
}
print STDERR "okn";

my @messages;
foreach my $msgid (@$newstuff) {
  my $head= $nntp->head($msgid);
  next unless $head;

  my %msg;
  push @messages, %msg;
  foreach(@$head) {
    next unless /^(Newsgroups|Subject|From):s+(.+)$/i;
    $msg{lc $1}= $2;
  }
}

my $last= "";
foreach(sort { $a->{newsgroups} cmp $b->{newsgroups} } @messages) {
  if($\_->{newsgroups} ne $last) {
    print "n" if $last;
    $last= $\_->{newsgroups};
    print "$last:n";
  }
  print "t" . decode\_header($\_->{subject}) .
    " - " . decode\_header($\_->{from}) ."n";
}

sub decode\_header {
  my($text)= @\_;

  $text=~ s/=?(iso-?8859-.?|us-ascii|utf-8)?(q|b)?(\[^?\]\*)?=(s\*(?==?))?/&decode\_header\_block(lc $1,$2,$3);/gei;
  return $text;
}

sub decode\_header\_block {
  my ($input,$enc,$text) = @\_;
  if ($enc =~ /q/i) {
    $text=~ s/\_/ /g;
    $text= decode\_qp($text);
  } else {
    $text= decode\_base64($text);
  }
  return $text; # oh well  \[:-)\]
}

exit();

IP addresses in Perl

With Perl you can do many interesting transformations of IP-numbers. Below is two small examples allowing conversions from “IP quad” (xxx.xxx.xxx.xxx) format to a single decimal and back.

sub ip2dec ($) {
    return unpack N => pack CCCC => split /\\./ => shift;
}

sub dec2ip ($) {
    return join '.' => map { ($\_\[0\] >> 8\*(3-$\_)) % 256 } 0 .. 3;
}

In CPAN you can find many modules aimed at using and manipulating IP-addressees. Some include Net::IP and IP::Country.

Mark all messages as read in an imap folder

The follow script marks all files in a folder as read. You need to pass hostname, username and password as commandline parameters to the script and the script is hardwired to mark all files in a folder call “INBOX.spam” (Cyrus IMAP folder naming convention). 

#!/usr/bin/perl -w
use strict;

use Mail::IMAPClient::BodyStructure;
use Mail::IMAPClient;

my ($serv, $usr, $pwd) = (@ARGV); # server, username and password as comandline parameters...

my $imap = Mail::IMAPClient->new(Server=>$serv,User=>$usr,Password=>$pwd);
my @folders = $imap->folders;

foreach my $f (@folders) {
  print 	"$f is a folder with ", $imap->message\_count($f), " messages.n";
}

exit();