Some Useful Perl Scripts

Below I give some of my Perl scripts which may prove useful to you. If you have any questions, please feel free to mail me. Generally these scripts will run both on UNIX and Windows environments.

DAYLIGHT SAVING TIME CHECK

This script can be used to test and find the exact time your system's local time will change from normal time to daylight saving time and vice versa. The script takes two parameters: The first one indicates the starting time, the second one indicates the ending time of the test period. Appropriate default values will be used if no parameter is given. Times are in seconds starting from January 1, 1970 (UTC).

#!/usr/bin/perl
# dstcheck.pl - Test daylight saving time changes.
# Fedon Kadifeli, October 1998 - April 2003.

$usage='dstcheck.pl startsec endsec';
$date='02/04/2003 11:50';
$version='0.05';

die "Usage: $usage\n" if $#ARGV != 1 && $#ARGV != -1;
$startsec = $ARGV[0];
$startsec = 733_276_801 if $startsec eq "";
$endsec = $ARGV[1];
$endsec = 1_289_000_000 if $endsec eq "";

$diff = 9999;
print " Testing seconds from $startsec to $endsec...\n";
for ($t=$startsec; $t<=$endsec; $t+=3600) {
  ($sec1,$min1,$hour1,$mday1,$mon1,$year1) = localtime($t);
  ($sec2,$min2,$hour2,$mday2,$mon2,$year2) = gmtime($t);
  $diff2 = $hour1 - $hour2;
  $diff2 += 24 if $diff2 < 0;
  if ($diff != $diff2) {
    $diff = $diff2;
    $plus = ($diff >= 0) ? "+" : "";
    $st = sprintf ("%d/%02d/%02d %02d:%02d:%02d",
      $year1+1900, $mon1+1, $mday1, $hour1, $min1, $sec1);
    $st .= sprintf (" [%d/%02d/%02d %02d:%02d:%02d UTC]",
      $year2+1900, $mon2+1, $mday2, $hour2, $min2, $sec2);
    print "$st $plus$diff - Seconds: $t\n";
  }
}

If you run this script using the command:

perl dstcheck.pl 796176001 1162080001

It should display something like:

Testing seconds from 796176001 to 1162080001...

1995/03/26 03:00:01 [1995/03/26 00:00:01 UTC] +3 - Seconds: 796176001
1995/10/29 02:00:01 [1995/10/29 00:00:01 UTC] +2 - Seconds: 814924801
1996/03/31 03:00:01 [1996/03/31 00:00:01 UTC] +3 - Seconds: 828230401
1996/10/27 02:00:01 [1996/10/27 00:00:01 UTC] +2 - Seconds: 846374401
1997/03/30 03:00:01 [1997/03/30 00:00:01 UTC] +3 - Seconds: 859680001
1997/10/26 02:00:01 [1997/10/26 00:00:01 UTC] +2 - Seconds: 877824001
1998/03/29 03:00:01 [1998/03/29 00:00:01 UTC] +3 - Seconds: 891129601
1998/10/25 02:00:01 [1998/10/25 00:00:01 UTC] +2 - Seconds: 909273601
1999/03/28 03:00:01 [1999/03/28 00:00:01 UTC] +3 - Seconds: 922579201
1999/10/31 02:00:01 [1999/10/31 00:00:01 UTC] +2 - Seconds: 941328001
2000/03/26 03:00:01 [2000/03/26 00:00:01 UTC] +3 - Seconds: 954028801
2000/10/29 02:00:01 [2000/10/29 00:00:01 UTC] +2 - Seconds: 972777601
2001/03/25 03:00:01 [2001/03/25 00:00:01 UTC] +3 - Seconds: 985478401
2001/10/28 02:00:01 [2001/10/28 00:00:01 UTC] +2 - Seconds: 1004227201
2002/03/31 03:00:01 [2002/03/31 00:00:01 UTC] +3 - Seconds: 1017532801
2002/10/27 02:00:01 [2002/10/27 00:00:01 UTC] +2 - Seconds: 1035676801
2003/03/30 03:00:01 [2003/03/30 00:00:01 UTC] +3 - Seconds: 1048982401
2003/10/26 02:00:01 [2003/10/26 00:00:01 UTC] +2 - Seconds: 1067126401
2004/03/28 03:00:01 [2004/03/28 00:00:01 UTC] +3 - Seconds: 1080432001
2004/10/31 02:00:01 [2004/10/31 00:00:01 UTC] +2 - Seconds: 1099180801
2005/03/27 03:00:01 [2005/03/27 00:00:01 UTC] +3 - Seconds: 1111881601
2005/10/30 02:00:01 [2005/10/30 00:00:01 UTC] +2 - Seconds: 1130630401
2006/03/26 03:00:01 [2006/03/26 00:00:01 UTC] +3 - Seconds: 1143331201
2006/10/29 02:00:01 [2006/10/29 00:00:01 UTC] +2 - Seconds: 1162080001

The output depends on the time zone of your system or environment. The above example is for Eastern European Time (i.e., GMT+02:00 Athens, Istanbul, Minsk). It may be different for your environment. The first column indicates the local time, the second column indicates the GMT (or UTC) time. The third column indicates the difference of your local time from UTC. In the above example, you see that your system will switch to UTC+3 at 1995/03/26 03:00:01 local time and back to UTC+2 at 1995/10/29 02:00:01.

CALENDAR

This script is similar to the UNIX cal command. It will display a calendar for the current or any given month. It takes two parameters: The first one is the month (1..12) and the second one is the year (four digits). If no parameter is given, the calendar for the current month is displayed. This script is only for Gregorian calendars.

#!/usr/bin/perl
# cal.pl - Display the calendar of a given month.
# Fedon Kadifeli, 1998 - April 2003.

use integer;

%mon_ord = (
 "jan" => 1,  "feb" => 2,  "mar" => 3,  "apr" => 4,
 "may" => 5,  "jun" => 6,  "jul" => 7,  "aug" => 8,
 "sep" => 9,  "oct" => 10, "nov" => 11, "dec" => 12,
);
@monames = ("",
  " January", " February",   "  March",   "  April",
    "   May",    "  June",    "  July",  "  August",
 "September",  " October", " November", " December"
);
@monlens = (0,31,28,31,30,31,30,31,31,30,31,30,31);

die "Usage: cal.pl [month] [year]\n" if $#ARGV > 1;

($t,$t,$t,$t,$mon1,$year1,$t,$t,$t) = localtime(time);
$mon = (defined $ARGV[0]) ? $ARGV[0] : $mon1+1;
if ($mon =~ /^ *\d{1,2} *$/) {
  die "Month must be between 1 and 12!\n" unless ($mon>=1 && $mon<=12);
} else {
  $mon = $mon_ord{lc(substr($mon,0,3))};
  die "Wrong month name: $ARGV[0]!\n" unless defined($mon);
}
$year = (defined $ARGV[1]) ? $ARGV[1] : $year1+1900;
die "Wrong year: $year!\n" unless $year =~ /^ *\d{4} *$/;
$year = int($year);
die "Year must be greater than 0!\n" unless $year>0;
print "\n\t$monames[$mon] $year\n\nSun  Mon  Tue  Wed  Thu  Fri  Sat\n";
$monlens[2] = 29 if ($year%400==0) || (($year%4==0) && ($year%100!=0));
--$year;
$st = 1 + $year*365 + $year/4 - $year/100 + $year/400;
for ($i=1; $i<$mon; ++$i) {
  $st += $monlens[$i];
}
$st %= 7;
for ($i=0; $i<$st; ++$i) {
  print "     ";
}
for ($i=1; $i<=$monlens[$mon]; ++$i) {
  printf "%3d  ", $i;
  print "\n" if ($st+$i)%7==0;
}
print "\n\n";

If you run this script using the command:

perl cal.pl 1 1965

It should display something like:

         January 1965

Sun  Mon  Tue  Wed  Thu  Fri  Sat
                           1    2
  3    4    5    6    7    8    9
 10   11   12   13   14   15   16
 17   18   19   20   21   22   23
 24   25   26   27   28   29   30
 31

GREP

This script is a simple version of the UNIX grep command and is similar to the Windows find command. It will search lines in files for a specific regular expression. The standard UNIX grep switches (-i: ignore case; -v: display not matching lines) are supported.

#!/usr/bin/perl
# grep.pl - Simulate UNIX grep command.
# Fedon Kadifeli, 1998 - April 2003.

$opt = shift;
if ($opt =~ s/^\-//) {
  $re = shift;
} else {
  $re = $opt;
  $opt = "";
}
die "Usage: grep.pl [-iv] regexp [files]\n" if ! defined $re;
$igncase = ($opt =~ s/i//g);
$nomatch = ($opt =~ s/v//g);
die "Unknown option `$opt'\n" if $opt ne "";
@ARGV = ("-") if $#ARGV < 0;
for $fn1 (@ARGV) {
 for $fn (glob $fn1) {
  if (open FH, "<$fn") {
    $pref = $fn eq "-" ? "" : "$fn:";
    if ($igncase) {
      while (<FH>) {
        print  "$pref$.:$_" if (/$re/i) xor $nomatch;
      }
    } else {
      while (<FH>) {
        print  "$pref$.:$_" if (/$re/) xor $nomatch;
      }
    }
    close FH;
  }
 }
}

SUBTITLE CONVERTER

These days DVD rips are very popular ways to store and watch movies on PCs. High quality video and sound can be stored on one or two conventional data CDs and you have similar playback options as in standard DVDs. One of these options is to display subtitles on the screen. There are different subtitle formats. Most subtitle files are normal text files. However, sometimes the subtitle's timing does match exactly to the sound of your movie at hand. There are several tools on Internet which can be used to fix such problems.

If you do not want to use these rather complex tools, you can use the following "simple" Perl script:

#!/usr/bin/perl
# st_conv.pl - Subtitle conversion tool.
#	See usage below.
# Fedon Kadifeli, November 2002 - February 2005.

use strict;
use warnings;

MAIN:
{
my $shift = 0;
my $shift_time_mode = 0;
my $mult = 1.0;
my $framerate = 1000;
my $fromsub;
my $tosub;
my $total = 0;
my $conv = 0;
my $wconv = 0;
my $o1;
my $o2;
my $subtitle;

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

sub CheckLines {
  my @lines = split /\|/, shift;
  my $nl = 0;
  my $ret = "";
  for (@lines) {
    my $ll = length;
    if ($ll > 50) {
      my $hl = int ($ll / 2);
      s/^(.{$hl,}?.*?) (.*)$/$1|$2/;
      warn "*** At $total. Too long ($ll char) subtitle split!\n";
      $nl++;
    }
    $ret .= "|$_";
    $nl++;
  }
  warn "*** At $total. $nl-line subtitle!\n" if ($nl > 3);
  return substr($ret,1);
} # CheckLines

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

sub TimetoString {
  my $t = shift;
  my $dp = shift;
  my $hh = int ($t / 3600);
  my $mm = int (($t - $hh * 3600) / 60);
  my $ss = int ($t - $hh * 3600 - $mm * 60);
  my $ttt = int (($t - int ($t)) * 1000 + 0.5);
  my $tstr = sprintf ("%02d:%02d:%02d%s%03d", $hh, $mm, $ss, $dp, $ttt);
  return $tstr;
} # TimetoString

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

sub ReadSubtitle {
  return 0 if (eof FH);
  my $ret = 1;
  if ($fromsub) {
    $total++;
    $_ = <FH>;
    if (/^\{(\d*)}{(\d*)}(.*?)\r?\n?$/) {
      $o1 = $1;
      $o2 = $2;
      $subtitle = $3;
      $conv++;
    } else {
      warn "*** At $total. Incorrect .sub format!\n";
      $ret++;
    }
  } else {
    $total++;
    $_ = <FH>;
    unless (/^ *\d+ *\s*$/) {
      warn "*** At $total. Number expected. $_ found!\n";
      $ret++;
    }
    return 0 if (eof FH);
    $_ = <FH>;
    if (/^(\d\d):(\d\d):(\d\d)[\.,](\d\d\d) --> (\d\d):(\d\d):(\d\d)[\.,](\d\d\d).*$/) {
      $o1 = $1*3600 + $2*60 + $3 + $4 / 1000.0;
      $o2 = $5*3600 + $6*60 + $7 + $8 / 1000.0;
      $subtitle = "";
      while (<FH>) {
        last if (/^\s*$/);
        $_ =~ s/\r?\n?$//;
        $subtitle .= "|" . $_;
      }
      $subtitle =~ s#^\|##;
      $conv++;
    } else {
      warn "*** At $total. .srt info expected. $_ found!\n";
      $ret++;
    }
  } 
  return $ret;  # ==1 if OK; >1 if warning(s)
} # ReadSubtitle

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

sub WriteSubtitle {
  $o1 *= $mult;
  $o2 *= $mult;
  $subtitle = CheckLines($subtitle);
  if ($tosub) {
    if (!$fromsub) { # .srt -> .sub
      $o1 *= $framerate;
      $o2 *= $framerate;
    }   
    if ($shift) {
      my $shift_frames = $shift;
      $shift_frames *= $framerate if $shift_time_mode;
      $o1 += $shift_frames;
      $o2 += $shift_frames;
    }
    if ($o1 > 0 && $o2 > 0) {
      $o1 = int ($o1 + 0.5);
      $o2 = int ($o2 + 0.5);
      $wconv++;
      print OFH "{$o1}{$o2}$subtitle\r\n";
    }
  } else {
    if ($fromsub) { # .sub -> .srt
      $o1 /= $framerate;
      $o2 /= $framerate;
    }   
    if ($shift) {
      my $shift_time = $shift;
      $shift_time /= $framerate if ! $shift_time_mode;
      $o1 += $shift_time;
      $o2 += $shift_time;
    }
    if ($o1 > 0 && $o2 > 0) {
      $o1 = TimetoString ($o1, ',');
      $o2 = TimetoString ($o2, ',');
      $subtitle =~ s#\|#\r\n#g;
      $wconv++;
      print OFH "$wconv\r\n$o1 --> $o2\r\n$subtitle\r\n\r\n";
    }
  }
} # WriteSubtitle

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

my $usage='
Usage:	st_conv.pl infile outfile [action(s)]

action:	(+|-)(frames|hh:mm:ss.ttt)
	*ddd.ddd
	@framerate [eg. 23.976, 25, 29.97]
';

die "$usage" if (($#ARGV < 1) || ($#ARGV > 4));

my $inf = shift;
my $outf = shift;

for my $action (@ARGV) {
  if ($action =~ /^([-+])(\d\d):(\d\d):(\d\d)[\.,](\d\d\d)$/) {
    $shift = $2*3600 + $3*60 + $4 + $5 / 1000.0;
    $shift = - $shift if ($1 eq "-");
    $shift_time_mode = 1;
  } elsif ($action =~ /^([-+])(\d*)$/) {
    $shift = $action * 1.0;
    $shift_time_mode = 0;
  } elsif ($action =~ /^\*(\d*\.\d*)$/) {
    $mult = $1 * 1.0;
  } elsif ($action =~ /^\@(\d+.?\d*)$/) {
    $framerate = $1 * 1.0;
  } else {
    die "Format of action ($action) is incorrect!\n$usage";
  }
} # for

if ($inf =~ /\.sub$/i) {
  $fromsub = 1;
} elsif ($inf =~ /\.srt$/i) {
  $fromsub = 0;
} else {
  die "File extension of first file must be .sub or .srt!\n$usage";
}
if ($outf =~ /\.sub$/i) {
  $tosub = 1;
} elsif ($outf =~ /\.srt$/i) {
  $tosub = 0;
} else {
  die "File extension of second file must be .sub or .srt!\n$usage";
}
my $frdisp = "";
if ( ($fromsub != $tosub) ||
     ($shift && $fromsub && $tosub && $shift_time_mode) ||
     ($shift && !$fromsub && !$tosub && !$shift_time_mode) ) {
  die "Framerate is not between 10 and 50!\n$usage" if ($framerate < 10) || ($framerate > 50);
  $frdisp = " - At $framerate frames/sec";
}

die "Cannot open input file!\n" unless (open(FH, "<$inf"));
die "Output file $outf exists!\n" if (open(OFH, "<$outf"));
close OFH;
die "Cannot open output file!\n" unless (open(OFH, ">$outf"));

warn "$inf  ==>  $outf\n\n";
warn "Action:\t" .
  "Shift by $shift " . ($shift_time_mode?"seconds":"frames") .
  " - Multiply by $mult" .
  $frdisp . "\n\n";

while (my $ret = ReadSubtitle) {
  WriteSubtitle if $ret == 1;
}

close FH;
close OFH;

warn "*** Conversion error! Input file probably in wrong format!\n" if ($conv != $total);
warn "$wconv out of $total lines converted.\n";
} # MAIN:

This script recognizes two different formats in input files:

  1. The frame format consists of subtitles specified in a single line. This type of files must have the extension .SUB. For example: 
    {33642}{33686}- I have to talk to you.|- Talk later?
    Here, the first two numbers represent the starting and ending frame numbers in the movie when the correspong text (the rest of the line) will be displayed.
  2. The time format consists of paragraphs each separated by a blank line. This type of files must have the extension .SRT. For example: 
    172
00:16:21,170 --> 00:16:24,129
- Can't we go somewhere else?
- Where?
    Here the first line is the subtitle sequence number, the second line specifies the starting and ending time in the movie when the corresponding text (the remaining lines up to the first empty line) will be displayed.

The script takes at least two parameters: The first one specifies the name of the input file (the file that will be read), the second one specifies the name of the output file (the file that will be created). The file extensions should be either .SUB or .SRT as described above. If they are different, then the necessary file format conversion will be done.

If you specify more that two parameters, these will indicate the actions to be done on subtitles. You can shift forward or backward or multiply the subtitle time information. Allowable formats for actions are:
+frame
-frame
+hh:mm:ss.ttt
-hh:mm:ss.ttt
*ddd.ddd
@framerate (eg. 23.976, 25, 29.97)

The framerate is necessary if you convert a file from .SUB to .SRT or vice versa or if the shift amount is given in a form that is not compatible with the format of the files.

Frame (which must be an integer number) will be added to or subtacted from both frame numbers of each line in the file. Similarly, hh:mm:ss.ttt (which must consist of the four numbers: hours, minutes, seconds, and milliseconds) will be added to or subtacted from both times in the file. The multiplier ddd.ddd (which must be a decimal number like 1.00125) will be multiplied with the subtitle time information in the file.

WEB "BROWSER"

If you want to "browse" some page from an http server on the Internet from command line, this very simple script may help you. This Perl script will connect to the server you specified using the port you give and will request and display a page.

#!/usr/bin/perl
# wb.pl - Simple web "browser".
# Fedon Kadifeli, 1997 - April 2003.

$usage='wb.pl [server [port [URL]]]';
$date='08/04/2003 15:50';
$version='0.03';

die "Usage: $usage\n" if $#ARGV>2;

( $server, $port, $url ) = @ARGV;

$port = 80 unless $port;
$server = 'localhost' unless $server;
$url = '/' unless $url;

$AF_INET = 2;
$SOCK_STREAM = 1;

$SIG{'INT'} = 'dokill';

sub dokill {
  kill 9,$child if $child;
}

$sockaddr = 'S n a4 x8';

($name,$aliases,$proto) = getprotobyname('tcp');
($name,$aliases,$port) = getservbyname($port,'tcp')
    unless $port =~ /^\d+$/;

($name,$aliases,undef,undef,$thataddr) = gethostbyname($server);
die "$server: $!\n" unless defined $thataddr;

$this = pack($sockaddr, $AF_INET, 0, "");
$that = pack($sockaddr, $AF_INET, $port, $thataddr);

@ip = unpack("C4", $thataddr);
print STDERR "Server: @ip - Port : $port - URL : $url\n";

socket(S, $AF_INET, $SOCK_STREAM, $proto) or die "socket: $!\n";
bind(S, $this)   or die "bind: $!\n";
connect(S,$that) or die "connect: $!\n";

select(S); $| = 1; select(STDOUT); 

print S "GET $url HTTP/1.0\n\n";
while( <S> ) {
  print;
}
close (S);

The script takes three parameters. You can use it like this:

perl wb.pl www.kadifeli.com 80 http://www.kadifeli.com/fedon/
perl wb.pl www.yahoo.com

In the first example we had to use the full URL in the third parameter since www.kadifeli.com is a "virtual host." In the second example, the implied third parameter / was enough.

© April 2003 - August 2005, Fedon Kadifeli.