Audiobook chapter support for FFprobe (Perl) module

I have multiple audiobook files (m4b) that ffprobe is able to retrieve the chapters from just fine… except the chapter information is printed to stderr and never in the formatted (STDOUT) output. The Perl module FFprobe doesn’t handle the chapters so I submitted feature request #73803

Feature request is to format the chapter output.

jason@jason-Inspiron-1545 ~/bin $ ffprobe "/home/jason/Audiobooks/Ben Bova/Mars/Mars 1.m4b" 1>/dev/null
  libavutil    51.  7. 0 / 51.  7. 0
  libavcodec   53.  5. 0 / 53.  5. 0
  libavformat  53.  2. 0 / 53.  2. 0
  libavdevice  53.  0. 0 / 53.  0. 0
  libavfilter   2.  4. 0 /  2.  4. 0
  libswscale    2.  0. 0 /  2.  0. 0
  libpostproc  52.  0. 0 / 52.  0. 0
[mov,mp4,m4a,3gp,3g2,mj2 @ 0xddfac0] max_analyze_duration reached
Input #0, mov,mp4,m4a,3gp,3g2,mj2, from '/home/jason/Audiobooks/Ben Bova/Mars/Mars 1.m4b':
  Metadata:
    major_brand     : M4B 
    minor_version   : 0
    compatible_brands: M4B mp42isom
    creation_time   : 2009-09-08 16:19:29
    album           : Mars
    artist          : Ben Bova
    genre           : Audiobook
  Duration: 03:51:23.41, start: 0.000000, bitrate: 81 kb/s
    Chapter #0.0: start 0.000000, end 2779.567914
    Metadata:
      title           : Mars - 01 of 24
    Chapter #0.1: start 2779.567914, end 5555.049161
    Metadata:
      title           : Mars - 02 of 24
    Chapter #0.2: start 5555.049161, end 8334.617075
    Metadata:
      title           : Mars - 03 of 24
    Chapter #0.3: start 8334.617075, end 11110.098322
    Metadata:
      title           : Mars - 04 of 24
    Chapter #0.4: start 11110.098322, end 13883.419864
    Metadata:
      title           : Mars - 05 of 24
    Stream #0.0(und): Audio: aac, 44100 Hz, stereo, s16, 80 kb/s
    Metadata:
      creation_time   : 2009-09-08 16:19:29
    Stream #0.1(eng): Subtitle: text / 0x74786574
    Metadata:
      creation_time   : 2009-09-08 17:31:00
Unsupported codec with id 94213 for input stream 1

patch to add m4b chapter support:

82c82
< my ($tree, $branch, $tag, $stream);
---
>     my ($tree, $branch, $tag, $stream, $chapter);
100c100,108
< }
---
> 	} elsif ($line =~ m/Chapter \#(\d+\.*\d+): start (\d+\.*\d+)\, end (\d+\.*\d+)/i) {
>       my ($start, $end) = ($2, $3);
>       $chapter = $1;
>       $chapter =~ s/\.//g;
>       $chapter =~ s/^0+(\d)/$1/;
> 
>       $$tree{chapters}{$chapter} = { start => $start, end => $end };
>     } elsif ($line =~ /title\s+: (.+)$/) {
>       $$tree{chapters}{$chapter}{title} = $1;
101a110
>   }
Share Button

Run multiple versions of Perl from your home directory

Run multiple versions of Perl from your home directory using Perlbrew!

One thing to know:  Perl won’t compile if you have an encrypted home directory. 🙁 Bug has been fixed but not exactly how and it hasn’t been put into the Ubuntu updates yet.
Thanks goes to Kang-min Liu for creating Perlbrew!!!! 🙂

The recommended way to install perlbrew is to run these statements in your shell:

curl -LO http://xrl.us/perlbrew
    chmod +x perlbrew
    ./perlbrew install

After that, perlbrew installs itself to ~/perl5/perlbrew/bin, and you should follow the instruction on screen to setup your .bashrc or .cshrc to put it in your PATH.

Share Button

Perl Books online

Modern Perl  by chromaticModern Perl by chromatic (FREE ebook!)

and

The Perl Language Reference Manual (for Perl version 5.12.1)

The Perl Language Reference Manual (for Perl version 5.12.1)

Share Button

Howto: Unable to start Catalyst web applications using the built in development server? We have the answer

If you’re getting the “Can’t locate Catalyst/Engine/HTTP/Restarter.pm” error message, it is very likely you’re running a recent version of Catalyst:

script/lolcatalyst_lite_server.pl -r
Can't locate Catalyst/Engine/HTTP/Restarter.pm in @INC (@INC contains: /home/jason/catalyst-book-code/Chapter_3/LolCatalyst-Lite/script/../lib /etc/perl /usr/local/lib/perl/5.10.1 /usr/local/share/perl/5.10.1 /usr/lib/perl5 /usr/share/perl5 /usr/lib/perl/5.10 /usr/share/perl/5.10 /usr/local/lib/site_perl .). at /usr/lib/perl5/Class/MOP.pm line 116
        Class::MOP::load_first_existing_class('Catalyst::Engine::HTTP::Restarter') called at /usr/lib/perl5/Class/MOP.pm line 121
        Class::MOP::load_class('Catalyst::Engine::HTTP::Restarter') called at /usr/share/perl5/Catalyst.pm line 2634
        Catalyst::setup_engine('LolCatalyst::Lite', undef) called at /usr/share/perl5/Catalyst.pm line 1081
        Catalyst::setup('LolCatalyst::Lite') called at /home/jason/catalyst-book-code/Chapter_3/LolCatalyst-Lite/script/../lib/LolCatalyst/Lite.pm line 34
        require LolCatalyst/Lite.pm called at script/lolcatalyst_lite_server.pl line 55
Compilation failed in require at script/lolcatalyst_lite_server.pl line 55.

The problem is that Catalyst::Engine::HTTP::Restarter within Catalyst::Engine was replaced by Catalyst::Restarter within the Catalyst::Devel package. How to fix your application to use the updated development web server? Very easy. Rerun catalyst.pl with the “-scripts”, to rebuild just the scripts in the script directory, and “-force” to overwrite any files therein:

catalyst.pl -scripts -force LolCatalyst::Lite
 exists "LolCatalyst-Lite/script/lolcatalyst_lite_cgi.pl"
created "LolCatalyst-Lite/script/lolcatalyst_lite_cgi.pl"
 exists "LolCatalyst-Lite/script/lolcatalyst_lite_fastcgi.pl"
created "LolCatalyst-Lite/script/lolcatalyst_lite_fastcgi.pl"
 exists "LolCatalyst-Lite/script/lolcatalyst_lite_server.pl"
created "LolCatalyst-Lite/script/lolcatalyst_lite_server.pl"
 exists "LolCatalyst-Lite/script/lolcatalyst_lite_test.pl"
created "LolCatalyst-Lite/script/lolcatalyst_lite_test.pl"
 exists "LolCatalyst-Lite/script/lolcatalyst_lite_create.pl"
created "LolCatalyst-Lite/script/lolcatalyst_lite_create.pl"

If you’re interested in learning the Catalyst Web Framework (Perl based), I highly recommend The Definitive Guide to Catalyst: Writing Extensible, Scalable and Maintainable Perl–Based Web Applications.

Share Button

Get it here! Perl DBD::Sybase 1.09.01 for Active State Perl 5.10 and 5.8 on Windows XP/Vista/7 32bit

Assuming that you installed Sybase OpenClient 15.5 from the 15.5 PC Client:

Install ActiveState Perl from http://www.activestate.com (free) and install DBI if it isn’t already installed.  It should be but you never know…

  1. Start -> ActiveState Perl -> Perl Package Manager
  2. install DBI
  3. exit

Now, the easy part.  Install the DBD::Sybase 1.09.01 PPM:

  1. download DBD::Sybase 1.09.01 PPM
  2. extract zip file to temporary directory (e.g. c:\test)
  3. Start -> Run -> cmd.exe (as Administrator if Vista or Windows 7)
  4. cd \test
  5. ppm install DBD-Sybase.ppd
  6. exit

That’s it 🙂

It should automatically install the DBD::Sybase for Perl 5.8 or 5.10 depending on which version of Active State Perl you have installed.

Share Button

Get it here! Perl DBD::Sybase 1.09 for Active State Perl 5.10 on Windows XP/Vista/7 32bit

Assuming that you installed Sybase OpenClient 15.5 from the 15.5 PC Client:

Install ActiveState Perl from http://www.activestate.com (free) and install DBI if it isn’t already installed.  It should be but you never know…

  1. Start -> ActiveState Perl -> Perl Package Manager
  2. install DBI
  3. exit

Now, the easy part.  Install the DBD::Sybase 1.09 PPM:

  1. download DBD::Sybase 1.09 PPM
  2. extract zip file to temporary directory (e.g. c:\test)
  3. Start -> Run -> cmd.exe (as Administrator if Vista or Windows 7)
  4. cd \test
  5. ppm install DBD-Sybase.ppd
  6. exit

That’s it :)

Sybase
Share Button

A better way to convert your mp3 tags using Perl, POE, Linux::Inotify2 and POE::Wheel::Run (for you Sony PS3 or other media player)

So, what we have here is a country that tries to run itself on the commandments of a god who the people feel maybe wearing his underpants on his head. Has he abominated underpants?

No sir, but is probably only a matter of time.

Yesterday, I posted Howto: Convert your mp3 tags (id3v2 to id3v1) so your Playstation 3 can play your MP3s! and it worked fine but there was one little problem with it.

When we processed the files, namely running eye3D, we did so synchronously. Essentially, the file notification came in from the Linux kernel and we processed the file at that time. This may be an issue of overflowing the inotify queue within the Linux kernel if there are a lot of files to process.

A better solution would be to add the file to an internal queue and process the files in a sub process using POE::Wheel::Run. Of course we will limit the number of sub processes 🙂

#!/usr/bin/perl

use strict;
use warnings;

use File::Basename;
use File::Find ();
use Getopt::Std;
use Linux::Inotify2;
use POE qw( Kernel Session Wheel::Run );

$|++;

#######################################
#######################################

our @found_dirs;
our $max_concurrent_tasks;

sub watch_add_dir {
my ($heap_ref, $session, $dir_name) = @_;

##############
# Watch this directory with a call back
# to the watch_hdlr() subroutine via
# a message to the POE system
##############
$heap_ref-&gt;{inotify}-&gt;watch($dir_name, IN_CREATE|IN_CLOSE_WRITE, $session-&gt;postback("watch_hdlr"));
print " Watching directory $dir_name\n";
}

sub watch_hdlr {
my ($kernel, $heap, $session, $event) = ( $_[KERNEL], $_[HEAP], $_[SESSION], $_[ARG1][0] );

my $name = $event-&gt;fullname;
my $short_name = $event-&gt;name;

##############
# We can receive many many notifications
# for a file. If we've already processed
# the file, do nothing.
##############
unless ($heap-&gt;{inotify}{files}{$name}) {

##############
# If a new directory is added, we need
# to watch that directory too.
##############
if ($event-&gt;IN_CREATE &amp;&amp; -d $name) {
print "New directory: $name\n";
watch_add_dir($heap, $session, $name);
} elsif ($event-&gt;IN_CLOSE_WRITE) {

##############
# When a file descriptor that was opened for
# 'writing' is closed, then process that
# file it was being written to. We're
# assuming that the file is complete at this
# point as the operation will be a copy into
# the watched directory
##############
my $ext = ( fileparse($name, '\..*') )[2];

if (lc($ext) eq '.mp3') {
##############
# Add the file to the file process queue
##############
push @{ $heap-&gt;{task}{task_files} }, $name;

##############
# Mark that we have processed the file. If
# we don't we will end up processing the file
# in an infinite loop because we are modifying
# the files.
##############
$heap-&gt;{inotify}{files}{$name} = 1;

##############
# Yield to "task_next_file" through so
# that we can process files in the queue.
##############
$kernel-&gt;yield("task_next_file");
}

$heap-&gt;{inotify}{files}{$name} = 1;
}
}

##############
# While possible, it is highly unlikely that we will
# overflow the notification buffers within the Linux
# kernel. If so, we should report that.
##############
print "events for $name have been lost\n" if $event-&gt;IN_Q_OVERFLOW;
}

sub task_next_file {
my ($kernel, $heap) = @_[ KERNEL, HEAP ];

##############
# Process the files in the queue up
# to the $max_concurrent_tasks at
# once. Any extras will be processed
# when a file (task) completes.
##############
while ( keys( %{ $heap-&gt;{task} } ) &lt; $max_concurrent_tasks ) {
my $next_task_file = shift @{ $heap-&gt;{task}{task_files} };

##############
# If the $next_task_file is empty, then we can safely
# ignore it.
##############
last unless defined $next_task_file;

##############
# Use POE::Wheel::Run to fire off the
# file processing using a sub process
# to the process_file() subroutine
##############
my $task = POE::Wheel::Run-&gt;new (
Program =&gt; sub { process_file($next_task_file) },
StdoutEvent =&gt; "task_output",
CloseEvent =&gt; "task_done",
);

##############
# Update the session with the task
# information and the kernel with
# the SIG_CHILD handler. These are
# necessary for the task to execute.
##############
$heap-&gt;{task}-&gt;{ $task-&gt;ID } = $task;
$kernel-&gt;sig_child( $task-&gt;PID, "sig_child");
}
}

sub process_file {
my $file = shift;

print " Processed \"$file\"\n";

##############
# Use the eyeD3 package to convert
# the mp3 id3v2/3/4 to id3v1. If
# eyeD3 fails, we don't really care. 🙂
##############
my $cmd_output = `eyeD3 --to-v1.1 "$file"`;
$cmd_output = `eyeD3 --remove-v2 "$file"`;
}

sub find_wanted {
my $object = $File::Find::name;

if (-d $object) {
push @found_dirs, $object;
}
}

#######################################
#######################################
#######################################

my %arg_options;
my $watch_dir;

getopts('d:t:', \%arg_options);

if ($arg_options{d} &amp;&amp; -d $arg_options{d}) {
$watch_dir = $arg_options{d};

if ($arg_options{t} &amp;&amp; $arg_options{t} =~ /^\d+/) {
$max_concurrent_tasks = $arg_options{t};
} else {
$max_concurrent_tasks = 2;
}

##############
# We need to watch all existing sub directories
# so we will find them and add them to the
# @found_dirs array to be added to the watched
# directories when we create the Inotify object
##############
File::Find::find({wanted =&gt; \&amp;find_wanted}, $watch_dir);

POE::Session-&gt;create
( inline_states =&gt;
{ _start =&gt; sub {
my $inotify_FH;

##############
# alias this particular POE session to
# 'notify' so we can easily reference
# it later if needed
##############
$_[KERNEL]-&gt;alias_set('notify');

##############
# Create the Linux::INotify object
##############
$_[HEAP]{inotify} = new Linux::Inotify2
or die "Unable to create new inotify object: $!";

##############
# Add the preexisting directories to
# be watched from the @found_dirs array
##############
foreach my $dir (@found_dirs) {
watch_add_dir($_[HEAP], $_[SESSION], $dir);
}

##############
# We need to create a hash in the "notify"
# POE session so we can determine if we've
# processed a file already
##############
$_[HEAP]{inotify}{files} = {};

##############
# The Inotify notifications are received
# on a file descriptor. We need to read
# from it when there is something to be
# read
##############
open $inotify_FH, "&lt; &amp;=" . $_[HEAP]{inotify}-&gt;fileno
or die "Can’t fdopen: $!\n";

##############
# Inform POE to poll the file descriptor
##############
$_[KERNEL]-&gt;select_read( $inotify_FH, "inotify_poll" );
},
inotify_poll =&gt; sub {
$_[HEAP]{inotify}-&gt;poll;
},
watch_hdlr =&gt; \&amp;watch_hdlr,

##############
# Process the next file in the queue
##############
task_next_file =&gt; \&amp;task_next_file,

##############
# print the output of the job
##############
task_output =&gt; sub {
my $result = $_[ARG0];

print "$result\n";
},

##############
# When we are done with a file, go process the
# next file if there is one waiting
##############
task_done =&gt; sub {
my ($kernel, $heap, $task_id) = @_[ KERNEL, HEAP, ARG0 ];

delete $heap-&gt;{task}{$task_id};
$kernel-&gt;yield("task_next_file");
},
sig_child =&gt; sub {
my ($heap, $pid) = @_[ HEAP, ARG1 ];

my $details = delete $heap-&gt;{$pid};
},
},
);

POE::Kernel-&gt;run();
}

Example output:

ps3_mp3_converter.pl -d /home/jfroebe/j
 Watching directory /home/jfroebe/j
Watching directory /home/jfroebe/j/bin
Watching directory /home/jfroebe/j/doc
Watching directory /home/jfroebe/j/java
Watching directory /home/jfroebe/j/lib
Watching directory /home/jfroebe/j/j
Watching directory /home/jfroebe/j/j/tmp
Watching directory /home/jfroebe/j/sdk
Watching directory /home/jfroebe/j/sdk/demo
Watching directory /home/jfroebe/j/sdk/include
New directory: /home/jfroebe/j/Earth Final Conflict Soundtrack
Watching directory /home/jfroebe/j/Earth Final Conflict Soundtrack
Processed "/home/jfroebe/j/Earth Final Conflict Soundtrack/01 Main Title.mp3"
Processed "/home/jfroebe/j/Earth Final Conflict Soundtrack/02 The Scret of Strandhill-Redemption.mp3"
Processed "/home/jfroebe/j/Earth Final Conflict Soundtrack/03 Old Flame.mp3"
Processed "/home/jfroebe/j/Earth Final Conflict Soundtrack/04 Defector.mp3"
Processed "/home/jfroebe/j/Earth Final Conflict Soundtrack/05 Decidion.mp3"
Processed "/home/jfroebe/j/Earth Final Conflict Soundtrack/06 Float Like a Butterfly.mp3"
Processed "/home/jfroebe/j/Earth Final Conflict Soundtrack/07 Sandoval's Run.mp3"
Processed "/home/jfroebe/j/Earth Final Conflict Soundtrack/08 Bliss.mp3"
Processed "/home/jfroebe/j/Earth Final Conflict Soundtrack/09 If You Could Read My Mind.mp3"
Processed "/home/jfroebe/j/Earth Final Conflict Soundtrack/10 Lilli.mp3"
Processed "/home/jfroebe/j/Earth Final Conflict Soundtrack/11 Law and Order.mp3"
Processed "/home/jfroebe/j/Earth Final Conflict Soundtrack/12 Atavus.mp3"
Processed "/home/jfroebe/j/Earth Final Conflict Soundtrack/13 Between Heaven and Hell.mp3"
Processed "/home/jfroebe/j/Earth Final Conflict Soundtrack/14 Sleepers.mp3"
Processed "/home/jfroebe/j/Earth Final Conflict Soundtrack/15 Dimensions.mp3"
Processed "/home/jfroebe/j/Earth Final Conflict Soundtrack/16 Moonscape.mp3"
Processed "/home/jfroebe/j/Earth Final Conflict Soundtrack/17 Isabel.mp3"
Processed "/home/jfroebe/j/Earth Final Conflict Soundtrack/18 The Gauntlet.mp3"
Processed "/home/jfroebe/j/Earth Final Conflict Soundtrack/19 Second Chances.mp3"
Processed "/home/jfroebe/j/Earth Final Conflict Soundtrack/20 One Man's Castle.mp3"
Processed "/home/jfroebe/j/Earth Final Conflict Soundtrack/21 Payback.mp3"
Processed "/home/jfroebe/j/Earth Final Conflict Soundtrack/22 Truth.mp3"
Processed "/home/jfroebe/j/Earth Final Conflict Soundtrack/23 Déjà Vu.mp3"
Processed "/home/jfroebe/j/Earth Final Conflict Soundtrack/24 Crossfire.mp3"
Processed "/home/jfroebe/j/Earth Final Conflict Soundtrack/25 Volunteers-End Credits.mp3"
Share Button

Howto: Convert your mp3 tags (id3v2 to id3v1) so your Playstation 3 can play your MP3s!

  1. Run the converter on your media server: ps3_mp3_converter.pl -d {directory}
  2. Copy your mp3 collection wherever you told ps3_mp3_converter.pl to run in.
#!/usr/bin/perl

use strict;
use warnings;

use File::Basename;
use File::Find ();
use Getopt::Std;
use Linux::Inotify2;
use POE;

$|++;

#######################################
#######################################

our @found_dirs;

sub watch_add_dir {
 my ($heap_ref, $session, $dir_name) = @_;

 $heap_ref->{inotify}->watch($dir_name, IN_CREATE|IN_CLOSE_WRITE, $session->postback("watch_hdlr"));
 print " Watching directory $dir_name\n";
}

sub watch_hdlr {
 my ($heap_ref, $session, $event) = ( $_[HEAP], $_[SESSION], $_[ARG1][0] );

 my $name = $event->fullname;
 my $short_name = $event->name;

 unless ($_[HEAP]{inotify}{files}{$name}) {
  if ($event->IN_CREATE && -d $name) {
   print "New directory: $name\n";
   watch_add_dir($heap_ref, $session, $name);
  } elsif ($event->IN_CLOSE_WRITE) {
   my $ext = ( fileparse($name, '\..*') )[2];

   if (lc($ext) eq '.mp3') {
    print "-"x20 . "\n";
    print "$name:\n";

    my $cmd_output = `eyeD3 --to-v1.1 "$name"`;
    $cmd_output = `eyeD3 --remove-v2 "$name"`;
   }

   $_[HEAP]{inotify}{files}{$name} = 1;
  }
 }

 print "events for $name have been lost\n" if $event->IN_Q_OVERFLOW;
}

sub find_wanted {
 my $object = $File::Find::name;

 if (-d $object) {
  push @found_dirs, $object;
 }
}

#######################################
#######################################
#######################################

my %arg_options;
my $watch_dir;

getopts('d:', \%arg_options);

if ($arg_options{d} && -d $arg_options{d}) {
 $watch_dir = $arg_options{d};
 File::Find::find({wanted => \&find_wanted}, $watch_dir);

 POE::Session->create
  ( inline_states =>
   { _start => sub {
     my $inotify_FH;

     $_[KERNEL]->alias_set('notify');
     $_[HEAP]{inotify} = new Linux::Inotify2
      or die "Unable to create new inotify object: $!";

     foreach my $dir (@found_dirs) {
      watch_add_dir($_[HEAP], $_[SESSION], $dir);
     }

     $_[HEAP]{inotify}{files} = {};

     open $inotify_FH, "< &=" . $_&#91;HEAP&#93;{inotify}->fileno
     or die "Can’t fdopen: $!\n";

     $_[KERNEL]->select_read( $inotify_FH, "inotify_poll" );
   },
   inotify_poll => sub {
    $_[HEAP]{inotify}->poll;
   },
    watch_hdlr => \&watch_hdlr,
   },
 );

 POE::Kernel->run();
}

exit 0;
Share Button

Developing games with Perl and SDL

Andy Bakun over at Ars Technica wrote an excellent “HowTo” on writing games with Perl and the Simple DirectMedia Library:

Developing games with Perl and SDL

ars technicaGet ready to dive into game development! Ars explores the art of SDL game programming with Perl. A dynamic, high-level scripting language and powerful open source SDL bindings make it possible to produce sophisticated games without a lot of effort or overhead.
By Andy Bakun | Last updated February 14, 2006 9:00 PM CT

What is SDL_perl?

SDL_Perl is a perl interface to the Simple DirectMedia Library. It is composed of a both a XS wrapper to the SDL libraries and a series of Perl modules that export SDL functionality in an object-oriented fashion.
One of the biggest benefits of using SDL is that it allows portable media applications to be written without having to be concerned with specific implmentations of media libraries for each target platform. Bringing Perl into the picture takes the portability one step further, allowing media-rich applications to be written in a high-level language that can be targeted to a number of platforms. While programming using SDL requires knowledge of C and access to a C compiler, using SDL_perl does not. This greatly decreases the amount of time it takes to get something up on the screen and working.

Read more

Share Button

Source code for scraping the website of Too Jewish Radio program to create two RSS feeds (audio podcast)

Many of you have asked me for the source code of the Perl application I wrote for creating the two rss feeds ( All Episodes & Last 10 Episodes ) for the Too Jewish Radio program. Well, here ya go! Keep in mind that it was written quickly and really doesn’t have much in the line of robustness (no real error checking code, etc).

#!/usr/bin/perl

use strict;
use warnings;

use utf8;

use Config::Simple;
use Date::Manip qw( ParseDate UnixDate );
use Getopt::Std;
use LWP::Simple;
use Net::FTP;
use XML::LibXML;
use XML::RSS;
use URI;

use vars qw( $opt_h $opt_n $opt_o $opt_u $opt_c );

sub print_usage {
  print "-"x40 . "\n";
  print " "x10 . "too_jewish.pl\n";
  print "-"x40 . "\n";
  print " "x4 . "-n [# episodes] : Number of episodes to list in the RSS feed\n";
  print " "x4 . "-o [filename] : Save RSS feed to file\n";
  print " "x4 . "-u     : Upload RSS feed to ftp server\n";
  print " "x4 . "-c [cfg filename]: Read configuration from filename\n";
  print " "x4 . "-h     : Print help\n";
  print "-"x40 . "\n";
}

sub format_W3CDTF_date {
  my $orig_date = shift;

  my $w3cdtf_format = "%Y-%m-%d";
  my $tmp_date = ParseDate($orig_date);
  $tmp_date = UnixDate($tmp_date, $w3cdtf_format);

  return $tmp_date;
}

sub get_episode_data {
  my $num_episodes = shift;

  my $episode_data_ref;

  # Set up the parser, and set it to recover
  # from errors so that it can handle broken
  # HTML
  my $parser = XML::LibXML->new();
  $parser->recover(1);

  # Parse the page into a DOM tree structure
  my $url = 'http://www.toojewishradio.com/too_jewish_shows.htm';
  my $data = get($url) or die $!;
  my $doc = $parser->parse_html_string($data);

  # Extract the table rows (as an
  # array of referrences to DOM nodes)
  my @table_rows = $doc->findnodes( q{ /html/body/table/tr } );

  @table_rows = @table_rows[1..$#table_rows];

  foreach my $row (@table_rows) {
    my $row_date = $row->find('string(td[1]//font/font)')->value();
    next if $row_date =~ /^\s*$/;

    my $mp3_file = $row->find('string(td[2]/font//a[1]/@href)')->value();
    next if $mp3_file =~ /^\s*$/;

    my $description = $row->find('string(td[2]/font)')->value();
    next if $description =~ /^\s*$/;
    $description =~ s/\s+/ /g;
    $description =~ s/^\s+//;
    $description =~ s/\s+$//;

    my $abs_url_mp3 = URI->new($mp3_file)->abs($url)->as_string;

    push @$episode_data_ref, {
        'pubDate' => $row_date,
        'description' => $description,
        'url' => $abs_url_mp3
      };
  }

  if ($num_episodes) {
    @$episode_data_ref = @$episode_data_ref[0..$num_episodes-1];
  }

  return $episode_data_ref;
}

sub create_rss_feed {
  my ($episode_data_ref, $rss_filename) = @_;

  my $rss = new XML::RSS (version => '2.0');

  $rss->channel(
    title        => 'Too Jewish with Rabbi Cohon',
    link       => 'http://www.toojewishradio.com',
    description  => '"Too Jewish" with Rabbi Sam Cohon and Friends plays every Sunday morning at 7:00 am on radio station KAPR 930 AM in Douglas, Bisbee, and Sierra Vista at 9:00 am, on KJAA 1240 AM in Globe at 9:00 am, and at 9:00 am on radio station KVOI AM 690 in Tucson.

"Too Jewish" is a lively and fast-paced show that highlights everything interesting in contemporary Jewish life and features music, arts, culture, comedy, and inspiration. "Too Jewish" is a blend of information, irreverence, and exploration of all things Jewish in the 21st century. "Too Jewish" makes Judaism accessible, interesting, and fun for listeners of all ages and backgrounds, and brings the best of Jewish experience vividly to life. But on "Too Jewish", Rabbi Cohon also challenges accepted pieties and has fun with anything boring or inauthentic in the way Jews live today in the United States, Israel, and everywhere else.

Since its Tucson debut August 4, 2002, "Too Jewish" has featured such prominent guests as legendary singer and recording artist Neil Sedaka, Kinky Friedman, Elie Wiesel, comedian Lily Tomlin, folksinger Peter Yarrow, NPR Supreme Court Expert Nina Totenberg, Eve Ensler, U.S. Senator Russ Feingold, and many more!

Regular expert commentators of the "Too Jewish" maven section include Tom Price, an educator and former diplomat who offers unique insights into Jewish life around the world, and Amy Hirshberg Lederman, nationally syndicated columnist, who shares stories which speak to the heart of Jewish listeners. Comedy and musical selections drawn by Rabbi Cohon from the remarkable range of great Jewish material help make listening to "Too Jewish" an exciting and fun experience.',
    dc => {
        date     => format_W3CDTF_date('now'),
        subject   => 'Jewish Radio',
        creator   => 'toojewishradio@yahoo.com',
        publisher   => 'toojewishradio@yahoo.com',
        rights   => 'All Rights Reserved, toojewishradio@yahoo.com',
        language  => 'en-us',
      },
    sync => {
        updatePeriod   => 'weekly',
        updateFrequency => '1',
        updateBase      => format_W3CDTF_date('01/01/1901'),
      },
    taxo => [
        'http://www.templeemanueltucson.org',
        'http://www.toojewishradio.com/about_the_rabbi.htm'
      ],
    );

  $rss->image(
    title => 'Too Jewish with Rabbi Cohon',
    url    => 'http://www.toojewishradio.com/Too%20Jewish%20logo_color.jpg',
    link => 'http://www.templeemanueltucson.org',
    dc => {
      creator => 'toojewishradio@yahoo.com'
      },
    );

  foreach my $episode (@$episode_data_ref) {
    $rss->add_item(
      title        => $episode->{description},
      enclosure     => {
        url    => $episode->{url},
        type => "audio/mpeg"
        },
      description => $episode->{description},
      pubDate     => format_W3CDTF_date( $episode->{pubDate} )
      );
  }

  if ($rss_filename) {
    $rss->save($rss_filename);
  }

  return $rss->as_string;
}

sub upload_rss_file {
  my ($ftp_server, $rss_filename) = @_;

  my $ftp = Net::FTP->new( $ftp_server->{server}, Debug => 0)
    or die "Cannot connect to $ftp_server->{server}: $@";
  $ftp->login( $ftp_server->{user}, $ftp_server->{password})
    or die "Cannot login ", $ftp->message;
  $ftp->cwd($ftp_server->{dir})
    or die "Unable to change directory to $ftp_server->{dir}", $ftp->message;
  $ftp->put($rss_filename)
    or die "Cannot upload $rss_filename", $ftp->message;
  $ftp->quit;
}

my $num_episodes;
my $ftp_server;
my $rss_filename;
my $upload;

if (getopts('hc:n:o:u')) {
  if ($opt_h) {
    print_usage;
    exit;
  }

  if ($opt_n) {
    if ($opt_n =~ /^[[:digit:]]+$/) {
      $num_episodes = $opt_n;
    }
  }

  if ($opt_o) {
    $rss_filename = $opt_o;
  }

  if ($opt_u) {
    $upload = 1;

    my $cfg_filename;

    if ($opt_c && -f $opt_c) {
      $cfg_filename = $opt_c;
    } else {
      $cfg_filename = '.too_jewish.ini';
    }

    my $cfg = new Config::Simple($cfg_filename);

    if ($cfg &&
        $cfg->param('RSS.ftp_server') && $cfg->param('RSS.ftp_user') &&
        $cfg->param('RSS.ftp_password') && $cfg->param('RSS.ftp_dir')
      ) {
      $ftp_server = {
        server   => $cfg->param('RSS.ftp_server'),
        user     => $cfg->param('RSS.ftp_user'),
        password  => $cfg->param('RSS.ftp_password'),
        dir        => $cfg->param('RSS.ftp_dir')
        };
    } else {
      print "Configuration file \"$cfg_filename\" does not contain a valid configuration!\n";
      exit;
    }
  }
}

my $rss_string = create_rss_feed( get_episode_data($num_episodes), $rss_filename );

if ($rss_filename && $upload && -f $rss_filename) {
  upload_rss_file($ftp_server, $rss_filename);
} else {
  print "$rss_string\n" unless $rss_filename;
}
Share Button