migration from sourceforge

(dirinf).fm

+##!/usr/local/bin/perl
+# FILE .../(dirinf).fm
+#
+# written:       2002-04-20
+# latest update: 2002-04-20 15:23:46
+# $Id: (dirinf).fm,v 1.1 2002/05/02 06:48:28 gonter Exp $
+#
+
+License                1691 f 100644  3222  3000
+README                 2922 f 100644  3222  3000
+app                     512 d 040755  3222  3000
+lib                     512 d 040755  3222  3000

.cvsignore

+GPATH
+GRTAGS
+GSYMS
+GTAGS
+tmp
+typescript
+.git
+@*

.gitignore

+.project
+CVSROOT
+CVS
+tmp
+typescript
+@*

License

+$Id: License,v 1.1 2002/03/25 07:28:07 gonter Exp $
+
+This BSD-style License applies to all files in this repository or
+library, unless otherwise stated.
+
+Authors and contributors, unless otherwise stated:
+
++ Copyright 1986-2002 Gerhard Gonter <g.gonter@ieee.org>. All rights reserved. 
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+
+1. Redistributions of source code must retain the above copyright
+   notice, this list of conditions and the following disclaimer.
+2. Redistributions in binary form must reproduce the above copyright
+   notice, this list of conditions and the following disclaimer in
+   the documentation and/or other materials provided with the
+   distribution.
+
+THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS
+OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE
+LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY,
+OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT
+OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
+BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
+OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
+EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+The views and conclusions contained in the software and documentation
+are those of the authors and should not be interpreted as representing
+official policies, either expressed or implied.
+

Perl/Modules/.cvsignore

+tmp
+*.tar
+*.tar.gz

Perl/Modules/net-freedb/(dirinf).fm

+#!/usr/local/bin/perl
+# FILE %gg/work/sf/hyx-tools/Perl/Modules/net-freedb/(dirinf).fm
+#
+# written:       2002-07-01
+# $Id: (dirinf).fm,v 1.2 2002/07/01 02:42:46 gonter Exp $
+#
+
+Changes         what's new
+MANIFEST        package list
+lib/Net/freedb/ library modules
+

Perl/Modules/net-freedb/Changes

+
+2002-06-30 21:26:06 gg
+
+        imported from private repository and re-organized as net::freedb::*
+

Perl/Modules/net-freedb/MANIFEST

+README
+MANIFEST
+Makefile.PL
+lib/Net/freedb/file.pm
+lib/Net/freedb/track.pm
+lib/Net/freedb/cluster.pm
+lib/Net/freedb/tools.pm
+lib/Net/freedb/catalog.pm
+lib/Net/freedb/catalog_entry.pm

Perl/Modules/net-freedb/Makefile.PL

+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+  'NAME'         => 'net::freedb',
+  'VERSION_FROM' => 'lib/Net/freedb/file.pm',      # finds $VERSION
+  'PREREQ_PM'    => {
+     MD5 => 0,
+  },    # e.g., Module::Name => 1.1
+);
+

Perl/Modules/net-freedb/README

+FILE .../net-freedb/README
+written: 2002-06-30
+$Id: README,v 1.1 2002/06/30 19:45:16 gonter Exp $
+
+collection of modules to handle freedb files
+
+Docu-T2D:
++ mention net::FreeDB module
++ why freedb and not FreeDB (pointer to www.freedb.org FAQ)
+
+
+
+

Perl/Modules/net-freedb/lib/Net/freedb/(dirinf).fm

+#!/usr/local/bin/perl
+# FILE .../net-freedb/lib/Net/freedb/(dirinf).fm
+#
+# written:       2001-01-28
+# re-issued as Net::freedb::* 2002-06-30
+# $Id: (dirinf).fm,v 1.1 2002/07/01 02:42:25 gonter Exp $
+#
+
+file.pm         process freedb files
+track.pm        individual freedb track
+tools.pm        Various utility functions
+catalog.pm      handle a catalog file used from LMD and RCS
+catalog_entry.pm handle a single catalog entry
+
+cluster.pm      clustering of similar entries

Perl/Modules/net-freedb/lib/Net/freedb/catalog.pm

+#!/usr/local/bin/perl
+# FILE .../net-freedb/lib/Net/freedb/catalog.pm
+#
+# manage a catalog of freedb database files
+#
+# written: 2001-09-02
+# re-issued as Net::freedb::* 2002-06-30
+# $Id: catalog.pm,v 1.2 2002/07/01 06:56:30 gonter Exp $
+#
+
+use strict;
+package Net::freedb::catalog;
+use Net::freedb::catalog_entry;
+
+my $VERSION= '0.02';
+
+# ----------------------------------------------------------------------------
+sub new
+{
+  my $class= shift;
+  my %pars= @_;
+
+  my $cat=  $pars{'category'} or return undef;
+  my $path= $pars{'path'} or return undef;
+
+  print "new catalog: category=$cat\n";
+  my $obj=
+  {
+    'category' => $cat,
+    'path' => $path,
+    'pars' => \%pars,
+    'updates' => 0,     # > 0 if there are updates
+    'highest_index' => 0,
+
+    # list of catalog entries by ...
+    'entries' => [],    # ... by position
+    'keys' => {},       # ... by freedb id (or relative path?)
+  };
+  bless $obj;
+
+  $obj->load ($pars{'catalog'}) if ($pars{'catalog'});
+  $obj;
+}
+
+# ----------------------------------------------------------------------------
+# reads a catalog file
+# returns the number of entries read or 0 if the file did not exist
+sub load
+{
+  my ($obj, $fnm)= @_;
+
+  $obj->{'catalog'}= $fnm;  # save filename, it is needed for the save method
+
+  local *FI;
+  open (FI, $fnm) or return 0;
+
+  print "reading: $fnm\n";
+  my $array= $obj->{'entries'};
+  my $table= $obj->{'keys'};
+  my $highest_index= $obj->{'highest_index'};
+
+  my $entries= undef;
+  while (<FI>)
+  {
+    chop;
+    if (/^#/)
+    {
+      push (@$array, $_);
+      next;
+    }
+
+    my $entry= new Net::freedb::catalog_entry (split (':', $_, 6));
+    push (@$array, $entry);
+    my $key= $entry->key ();
+    my $index= $entry->index ();
+    $highest_index= $index if ($index > $highest_index);
+
+    # print ">>> entry=$entry key='$key'\n";
+    $table->{$key}= $entry;
+
+    $entries++;
+  }
+  close (FI);
+
+  $obj->{highest_index}= $highest_index;
+
+  return $entries;
+}
+
+# ----------------------------------------------------------------------------
+# writes a catalog file
+# returns the number of entries written or 0 if the file could not be opened
+sub save
+{
+  my $obj= shift;
+  my $fnm= shift || $obj->{'catalog'};
+  return undef unless ($fnm);
+
+  local *FO;
+  open (FO, ">$fnm") or return undef;
+
+  print "saving $fnm\n";
+  my $array= $obj->{'entries'};
+  my $entries= 0;
+  my $comments= 0;
+
+  my $entry;
+  foreach $entry (@$array)
+  {
+    my $r= ref ($entry);
+    # print "entry= $entry, r= $r\n";
+    if ($r eq '') { print FO $entry, "\n"; $comments++; }
+    else { print FO join (':', @$entry), "\n"; $entries++; }
+  }
+  close (FO);
+
+  ($entries, $comments);
+}
+
+# ----------------------------------------------------------------------------
+# add comments to catalog file
+sub comment
+{
+  my $obj= shift;
+  my $array= $obj->{'entries'};
+  foreach (@_)
+  {
+    push (@$array, '# '. $_);
+  }
+}
+
+# ----------------------------------------------------------------------------
+# locate all freedb database files that were updated relative to the
+# timestamps given in the catalog file
+sub updates
+{
+  my $obj= shift;
+  my %opts= @_;
+
+  my $path= $obj->{path} or return undef;
+
+  my $check_lmd= 1;
+  my $check_rcs= 1;
+  my $opt;
+  foreach $opt (keys %opts)
+  {
+    if ($opt eq 'lmd') { $check_lmd= $opts{$opt}; }
+    elsif ($opt eq 'rcs') { $check_rcs= $opts{$opt}; }
+  }
+
+  return undef unless ($check_lmd || $check_rcs); # nothing to do???
+
+  local *DIR;
+  opendir (DIR, $path) or return undef;
+  print "updating $path\n";
+
+  my $table= $obj->{'keys'};
+  my $array= $obj->{'entries'};
+  my $highest_index= $obj->{'highest_index'};
+
+  my (@res, $res, $e);
+  while (defined ($e= readdir (DIR)))
+  {
+    next unless ($e =~ /^[0-9a-fA-F]{8}$/);
+
+    my $f= "$path/$e";
+    my @stat= stat ($f);
+    my $mtime= $stat[9];
+
+    my $entry= $table->{$f};
+
+    $res= undef;
+
+    if (!$entry)
+    {
+      # print "new: $e\n";
+      $res= { 'x' => 'n' };
+
+      $highest_index++;
+      $entry= new Net::freedb::catalog_entry ($highest_index, $mtime, 0, 0, $f, 'unknown');
+
+      # print ">>> entry=$entry key='$f'\n";
+      push (@$array, $entry);
+      $table->{$f}= $entry;
+
+      if ($check_lmd) { $res->{'lmd'}= { 'x' => 'n' }; }
+      if ($check_rcs) { $res->{'rcs'}= { 'x' => 'n' }; }
+
+      $obj->{updates}++;
+    }
+    else
+    {
+      my $o_mtime= $entry->mtime ();
+      my $t_diff= $mtime - $o_mtime;
+
+      if ($t_diff != $0)
+      { # file was modified
+        # t_diff should be positive otherwise the file is now older than
+        # it was last time; we do not care about this, it's updated...
+
+        # print "e: t_diff=$t_diff\n";
+        $res= { 'x' => 'u', 'old_mtime' => $o_mtime };
+        $entry->mtime ($mtime);
+        $obj->{updates}++;
+
+        if ($check_lmd)
+        {
+          my $lmd_update= $entry->lmd_update ();
+          if ($lmd_update == 0)
+          {
+            print "not in lmd!\n";
+            $res->{'lmd'}= { 'x' => 'n' };
+          }
+          else
+          {
+            $res->{'lmd'}= { 'x' => 'u' };
+          }
+        }
+
+        if ($check_rcs)
+        {
+          my $rcs_update= $entry->rcs_update ();
+          if ($rcs_update == 0)
+          {
+            print "not in rcs!\n";
+            $res->{'rcs'}= { 'x' => 'n' };
+          }
+          else
+          {
+            $res->{'rcs'}= { 'x' => 'u' };
+          }
+        }
+      } # t_diff != 0
+    } # entry exists
+
+    if (defined ($res))
+    {
+      $res->{'f'}= $f;
+      $res->{'e'}= $e;
+      $res->{'t'}= $mtime;
+      $res->{'r'}= $entry;
+
+      # print ">>>> push\n";
+      push (@res, $res);
+    }
+  }
+  closedir (DIR);
+
+  $obj->{highest_index}= $highest_index;
+
+  (wantarray) ? @res : \@res;
+}
+
+1;

Perl/Modules/net-freedb/lib/Net/freedb/catalog_entry.pm

+#!/usr/local/bin/perl
+# FILE .../net-freedb/lib/Net/freedb/catalog_entry.pm
+#
+# manage a catalog of freedb database files
+#
+# written: 2001-09-02
+# re-issued as Net::freedb::* 2002-06-30
+# $Id: catalog_entry.pm,v 1.1 2002/07/01 02:42:25 gonter Exp $
+#
+
+use strict;
+
+package Net::freedb::catalog_entry;
+
+# ----------------------------------------------------------------------------
+sub new
+{
+  my $class= shift;
+  my @fields= @_;
+  my $entry= \@fields;
+  bless $entry;
+}
+
+# ----------------------------------------------------------------------------
+sub index       { &get_idx ($_[0], 0, $_[1]); }
+sub mtime       { &get_idx ($_[0], 1, $_[1]); }
+sub lmd_update  { &get_idx ($_[0], 2, $_[1]); }
+sub rcs_update  { &get_idx ($_[0], 3, $_[1]); }
+sub key         { &get_idx ($_[0], 4, $_[1]); }
+sub title       { &get_idx ($_[0], 5, $_[1]); }
+
+# ----------------------------------------------------------------------------
+sub get_idx
+{
+  my $obj= shift;
+  my $idx= shift;
+  my $val= shift;
+
+  my $res= $obj->[$idx];
+  $obj->[$idx]= $val if (defined ($val));
+
+  $res;
+}
+
+1;

Perl/Modules/net-freedb/lib/Net/freedb/cdex/local.pm

+#!/usr/local/bin/perl
+# FILE .../net-freedb/lib/Net/freedb/file.pm
+#
+# written:       2001-01-28
+# re-issued as Net::freedb::* 2002-06-30
+# $Id: local.pm,v 1.1 2012/08/12 16:32:56 gonter Exp $
+#
+
+=head1 NAME
+
+Net::freedb::cdex - Perl module to hande freedb database files
+
+=head1 SYNOPSIS
+
+  use Net::freedb::dex;
+
+  $cdex= new Net::freedb::dex;     create a new freedb object
+  $cdex->read ($filename);          read a given freedb file into object
+
+=head1 DESCRIPTION
+
+Net::freedb::cdex 
+files which represent freedb database files.
+
+=cut
+
+use strict;
+
+package Net::freedb::cdex::local;
+
+use Net::freedb::file;
+
+my $VERSION= '0.03';
+
+my $do_parse= 1;
+
+sub new
+{
+  my $class= shift;
+  my %pars= @_;
+
+  my $obj=
+  {
+  };
+  bless $obj;
+
+  foreach my $par (keys %pars)
+  {
+    if ($par eq 'read')
+    {
+      $obj->read ($pars{$par});
+    }
+    else
+    {
+      $obj->{$par}= $pars{$par};
+    }
+  }
+
+  $obj;
+}
+
+=pod
+
+=head2 $cdex->read ($fnm)
+
+CDex stores multiple freedb files in one file, e.g. classical/aa12b90a
+and classcial/aa11741c end up together in a file called classical/aatoaa .
+
+=cut
+
+# ----------------------------------------------------------------------------
+sub read
+{
+  my $obj= shift;
+  my $fnm= shift;
+
+  local *FI;
+  open (FI, $fnm) || return 0;
+
+  my %items= ();
+  $obj->{'items'}= \%items;
+  my $lines= undef;
+  my $x_filename= undef;
+  my $cnt= 0;
+  while (my $l= <FI>)
+  {
+    chop ($l);
+
+    if ($l =~ m/^#FILENAME=([a-fA-F0-9]{8})$/)
+    {
+      $x_filename= $1;
+      print ">> x_filename=[$x_filename]\n";
+      $lines= [];
+      $items{$x_filename}= { 'filename' => $x_filename, '_' => $lines };
+      $cnt++;
+    }
+    elsif (defined ($lines))
+    {
+      push (@$lines, $l);
+    }
+    else
+    {
+      # TODO: garbage in the file?
+    }
+  }
+  close (FI);
+
+  if ($do_parse)
+  {
+    foreach my $item (sort keys %items)
+    {
+      my $x= $items{$item};
+      my $lines= $x->{'_'};
+  
+      my $fdb= $x->{'freedb'}= new Net::freedb::file;
+  
+      # $fdb->{'_FILENAME_'}= $fnm;
+      $fdb->parse ($lines);
+    }
+  }
+
+  #\%items;
+  $cnt;
+}
+
+1;
+__END__
+# POD Section
+
+=head1 NOTES
+
+=head1 BUGS
+
+This module is work in progres...
+
+=head2 To-Do-List
+
+  How to handle track information
+
+=head1 Copyright
+
+Copyright (c) 2012 Gerhard Gonter.  All rights reserved.
+This is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=head1 AUTHOR
+
+Gerhard Gonter, g.gonter@ieee.org
+
+=head1 SEE ALSO
+
+=cut
+

Perl/Modules/net-freedb/lib/Net/freedb/cluster.pm

+#!/usr/local/bin/perl
+# FILE .../net-freedb/lib/Net/freedb/cluster.pm
+#
+# handle clusters of similar entries
+# re-issued as Net::freedb::* 2002-06-30
+#
+# $Id: cluster.pm,v 1.2 2002/07/01 06:56:30 gonter Exp $
+
+package Net::freedb::cluster;
+
+my $VERSION= '0.02';
+my $cluster_id= 1;
+
+sub new
+{
+  my $class= shift;
+  my $cat= shift;
+
+  my $obj=
+  {
+    'id' => $cluster_id++,
+    'cat' => $cat,
+    'members' => {},
+  };
+  bless $obj;
+}
+
+# add an entry to a cluster
+sub add
+{
+  my $obj= shift;
+  my $id= shift;      # freedb id;
+  my $data= shift;    # some data associated with it, e.g. a Net::freedb::file object
+
+  $obj->{members}->{$id}= $data;
+}
+
+# merge the data of two clusters
+sub merge
+{
+  my $obj1= shift;
+  my $obj2= shift;
+  my $mem;
+  foreach $mem (keys %{$obj2->{members}})
+  {
+    $obj1->{members}->{$mem}= $obj2->{members}->{$mem};
+  }
+}
+
+1;
+

Perl/Modules/net-freedb/lib/Net/freedb/file.pm

+#!/usr/local/bin/perl
+# FILE .../net-freedb/lib/Net/freedb/file.pm
+#
+# written:       2001-01-28
+# re-issued as Net::freedb::* 2002-06-30
+# $Id: file.pm,v 1.3 2012/08/12 16:30:13 gonter Exp $
+#
+
+=head1 NAME
+
+Net::freedb::file - Perl module to handle freedb database files
+
+=head1 SYNOPSIS
+
+  use Net::freedb::file;
+
+  $db= new Net::freedb::file;     create a new freedb object
+  $db->read ($filename);          read a given freedb file into object
+  $db->print (*FILEHANDLE);       print object in freedb file format
+  $db->inc_revision;              increment revision counter
+
+  Methods for field retrieval:
+  $db->program ([<str>]);         retrieve or set program identifier
+  $db->header ([<str>]);          retrieve or set freedb file header
+
+  more functions
+  discids                       all discids (ARRAY reference!)
+  track (idx, <obj>)            track object at that position
+  length                        length in seconds
+  revision                      db file revision number
+  title                         full title
+  ext                           extended information
+  playorder
+
+  methods of a track object:
+  offset                        start of track, counted in frames
+  title                         full title
+  ext                           extended information
+
+=head1 DESCRIPTION
+
+Net::freedb::file and it's sister-modules are used to handle text
+files which represent freedb database files.
+
+=cut
+
+use strict;
+
+package Net::freedb::file;
+
+use Net::freedb::track;
+
+# ----------------------------------------------------------------------------
+my $VERSION= '0.03';
+my $LLNG= 64;   # max. length of a line in the freedb file
+
+my $default_header => <<EOX;
+# xmcd CD database file
+#
+EOX
+
+my %ESCAPE=
+(
+  'n' => "\n", 
+  't' => "\t", 
+);
+
+# ----------------------------------------------------------------------------
+sub new
+{
+  my $class= shift;
+  my %pars= @_;
+
+  my $obj=
+  {
+    'header' => $default_header,
+    'revision' => 0,
+  };
+  bless $obj;
+
+  foreach my $par (keys %pars)
+  {
+    if ($par eq 'read')
+    {
+      $obj->read ($pars{$par});
+    }
+    else
+    {
+      $obj->{$par}= $pars{$par};
+    }
+  }
+
+  $obj;
+}
+
+# ----------------------------------------------------------------------------
+sub read
+{
+  my $obj= shift;
+  my $fnm= shift;
+
+  local *FI;
+  open (FI, $fnm) || return 0;
+  my @lines= <FI>;
+  close (FI);
+  chop (@lines);
+
+  $obj->{'_FILENAME_'}= $fnm;
+  $obj->parse (\@lines);
+}
+
+sub parse
+{
+  my $obj= shift;
+  my $lines= shift;
+
+  my @lines= @$lines;
+
+  my $state= 'header';
+  my @tracks= ();
+  $obj->{tracks}= \@tracks;
+  $obj->{discid}= [];
+  my $hdr= '';
+
+  while (my $l= shift (@lines))
+  {
+    # print ">>> [$l]\n";
+
+    if ($l =~ /^# Track frame offsets:/)
+    {
+      $state= 'track offsets';
+    }
+    elsif ($state eq 'header') { $hdr .= $l. "\n"; }
+    elsif ($state eq 'track offsets' && $l =~ /^#\s*(\d+)/)
+    {
+      my $track= new Net::freedb::track
+      (
+        'offset' => $1,
+      );
+      push (@tracks, $track);
+    }
+    elsif ($l =~ /^#\s*$/) { $state= 'rest'; }
+    elsif ($l =~ /^# Disc length: (\d+) seconds/)     { $obj->{length}= $1; }
+    elsif ($l =~ /^# Revision: (\d+)/)                { $obj->{revision}= $1; }
+    elsif ($l =~ /^# Submitted via: (.+)/)            { $obj->{program}= $1; }
+    elsif ($l =~ /^DISCID=(.*)/)
+    { # see the note about DISCID in the POD section below
+      push (@{$obj->{discid}}, split (/,/, $1));
+    }
+    elsif ($l =~ /^(DTITLE|EXTD|PLAYORDER|DGENRE|DYEAR)=(.*)/)
+    {
+      my ($par, $val)= ($1, $2);
+      $obj->{$par} .= $2;
+    }
+    elsif ($l =~ /^(TTITLE|EXTT)(\d+)=(.*)/)
+    {
+      my ($par, $idx, $val)= ($1, $2, $3);
+      my $t= $obj->{tracks}->[$idx];
+      $t->{$par} .= $3;
+    }
+  }
+  $obj->{header}= $hdr;
+
+  my ($xt, $xf);
+  foreach $xf (qw(DTITLE EXTD PLAYORDER DGENRE DYEAR))
+  {
+    $obj->{$xf}= &decode ($obj->{$xf});
+  }
+  foreach $xt (@{$obj->{tracks}})
+  {
+    $xt->{TTITLE}= &decode ($xt->{TTITLE});
+    $xt->{EXTT}= &decode ($xt->{EXTT});
+  }
+
+  1;
+}
+
+# ----------------------------------------------------------------------------
+sub print
+{
+  my $obj= shift;
+  local *FO= shift;
+
+  print FO $obj->{header};
+  print FO "# Track frame offsets:\n";
+  my $track;
+  foreach $track (@{$obj->{tracks}})
+  {
+    printf FO ("#\t%d\n", $track->{offset});
+  }
+  print FO "#\n# Disc length: ", $obj->{length}, " seconds\n#\n",
+           "# Revision: ", $obj->{revision},
+           "\n# Submitted via: ", $obj->{program}, "\n#\n";
+
+  # print the DISCID
+  # see the note about DISCID in the POD section below
+  my @discids= @{$obj->{discid}};
+  while ($#discids >= 7)
+  {
+    my @x= @discids[0..7];
+    @discids= @discids[8..$#discids];
+    print FO "DISCID=", join (',', @x), "\n";
+  }
+  print FO "DISCID=", join (',', @discids), "\n";
+
+  &print_field (*FO, 'DTITLE', $obj->{DTITLE});
+  &print_field (*FO, 'DYEAR',  $obj->{DYEAR});
+  &print_field (*FO, 'DGENRE', $obj->{DGENRE});
+  my $num= 0;
+  foreach $track (@{$obj->{tracks}})
+  {
+    &print_field (*FO, "TTITLE$num", $track->{TTITLE});
+    $num++;
+  }
+  &print_field (*FO, 'EXTD', $obj->{EXTD});
+  $num= 0;
+  foreach $track (@{$obj->{tracks}})
+  {
+    &print_field (*FO, "EXTT$num", $track->{EXTT});
+    $num++;
+  }
+  &print_field (*FO, 'PLAYORDER', $obj->{PLAYORDER});
+  1;
+}
+
+# ----------------------------------------------------------------------------
+sub inc_revision
+{
+  my $obj= shift;
+  $obj->{revision}++;
+}
+
+# ----------------------------------------------------------------------------
+sub discids     { my $obj= shift; $obj->_field_ ('discid',      @_); }
+sub ext         { my $obj= shift; $obj->_field_ ('EXTD',        @_); }
+sub header      { my $obj= shift; $obj->_field_ ('header',      @_); }
+sub length      { my $obj= shift; $obj->_field_ ('length',      @_); }
+sub program     { my $obj= shift; $obj->_field_ ('program',     @_); }
+sub playorder   { my $obj= shift; $obj->_field_ ('PLAYORDER',   @_); }
+sub revision    { my $obj= shift; $obj->_field_ ('REVISION',    @_); }
+sub title       { my $obj= shift; $obj->_field_ ('DTITLE',      @_); }
+sub dyear       { my $obj= shift; $obj->_field_ ('DYEAR',       @_); }
+sub dgenre      { my $obj= shift; $obj->_field_ ('DGENRE',      @_); }
+
+# ----------------------------------------------------------------------------
+sub _field_
+{
+  my $obj= shift;
+  my $field= shift;
+  my $val= shift;
+  my $old= $obj->{$field};
+  $obj->{$field}= $val if ($val);
+  $old;
+}
+
+# ----------------------------------------------------------------------------
+sub track
+{
+  my $obj= shift;
+  my $idx= shift;
+  my $val= shift;
+
+  my $tr= $obj->{tracks};
+  my $old= $tr->[$idx];
+
+  $tr->[$idx]= $val if ($val);
+  $old;
+}
+
+# ----------------------------------------------------------------------------
+sub track_count
+{
+  my $obj= shift;
+
+  my $tr= $obj->{tracks};
+  $#$tr+1;
+}
+
+# ----------------------------------------------------------------------------
+sub ESCAPE
+{
+  my $c= shift;
+  $c= $ESCAPE{$c} if (exists ($ESCAPE{$c}));
+  $c;
+}
+
+# ----------------------------------------------------------------------------
+sub decode
+{
+  my $str= shift;
+  $str=~ s/\\(.)/&ESCAPE($1)/eg;
+  $str;
+}
+
+# ----------------------------------------------------------------------------
+sub print_field
+{
+  local *FO= shift;
+  my $par= shift;
+  my $val= shift;
+  my $lines= 0;
+  my $v1;
+
+  while (1)
+  {
+    my $l1= length ($val);
+    last if ($l1 <= 0);
+    if ($l1 > $LLNG)
+    {
+      $v1= substr ($val, 0, $LLNG);
+      $val= substr ($val, $LLNG);
+    }
+    else
+    {
+      $v1= $val;
+      $val= undef;
+    }
+
+    $v1=~ s#\\#\\\\#g;
+    $v1=~ s#\n#\\n#g;
+    $v1=~ s#\t#\\t#g;
+    print FO $par, '=', $v1, "\n";
+    $lines++;
+  }
+
+  print FO $par, "=\n" unless ($lines);
+
+  $lines;
+}
+
+# ============================================================================
+1;
+__END__
+# POD Section
+
+=head1 NOTES
+
+=head2 DISCID
+
+There are up to 8 discid codes in a DISCID line, each separated by commas.
+If therer are more such codes, they need to be written into separate
+lines.  There is no comma after the last code, even if there is another
+line following!
+
+  Example:
+  DISCID=b10ca40e,b10ca70e,b00ca50e,ae0ca30e,ab0ca30e,aa0ca40e,a90ca50e,a90ca40e
+  DISCID=a80ca50e
+  DTITLE=Nirvana / Unplugged In New York
+
+=head1 BUGS
+
+This module is work in progres...
+
+=head2 To-Do-List
+
+  How to handle track information
+
+=head1 Copyright
+
+Copyright (c) 2001..2012 Gerhard Gonter.  All rights reserved.
+This is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=head1 AUTHOR
+
+Gerhard Gonter, g.gonter@ieee.org
+
+=head1 SEE ALSO
+
+http://www.freedb.org/
+
+=cut

Perl/Modules/net-freedb/lib/Net/freedb/tools.pm

+#!/usr/local/bin/perl
+# FILE .../net-freedb/lib/Net/freedb/tools.pm
+#
+# written:       2001-05-01
+# re-issued as Net::freedb::* 2002-06-30
+# $Id: tools.pm,v 1.2 2002/07/01 06:56:30 gonter Exp $
+#
+
+use strict;
+use MD5;
+
+package Net::freedb::tools;
+
+my $VERSION= '0.02';
+
+# ----------------------------------------------------------------------------
+sub offset2time
+{
+  my $offset= shift;
+  my $f= $offset % 75; $offset= int ($offset / 75);
+  my $s= $offset % 60;
+  my $m= int ($offset / 60);
+  ($m, $s, $f);
+}
+
+# ----------------------------------------------------------------------------
+# calculate an experimental alternative disc id
+sub get_exp_id
+{
+  my $db= shift;
+
+  my $cnt= $db->track_count;
+
+  my $str= '';
+
+  my ($i, $off0);
+  for ($i= 0; $i < $cnt; $i++)
+  {
+    my $track= $db->track ($i); # returns a Net::freedb::track object
+    my $off= $track->offset;
+    $off0= $off if ($i == 0);
+    $str .= $off . '+';
+  }
+
+  # unfortunately, we do not have disc length in frames!
+  my $tt= 75 * $db->length + $off0;
+  $str .= $tt;
+
+  my $md5= MD5->hexhash ($str);
+
+  $md5;
+}
+
+# ----------------------------------------------------------------------------
+1;

Perl/Modules/net-freedb/lib/Net/freedb/track.pm

+#!/usr/local/bin/perl
+# FILE .../net-freedb/lib/Net/freedb/track.pm
+#
+# written:       2001-03-03
+# re-issued as Net::freedb::* 2002-06-30
+# $Id: track.pm,v 1.2 2002/07/01 06:56:30 gonter Exp $
+#
+
+use strict;
+package Net::freedb::track;
+
+# ----------------------------------------------------------------------------
+my $VERSION= '0.02';
+
+# ----------------------------------------------------------------------------
+sub offset      { my $obj= shift; $obj->_field_ ('offset',      @_); }
+sub title       { my $obj= shift; $obj->_field_ ('TTITLE',      @_); }
+sub ext         { my $obj= shift; $obj->_field_ ('EXTT',        @_); }
+
+# ----------------------------------------------------------------------------
+sub new
+{
+  my $class= shift;
+  my %pars= @_;
+  my $obj=
+  {
+    'offset' => 0,
+    'TITLE' => '',
+    'EXTT' => '',
+  };
+  foreach (keys %pars) { $obj->{$_}= $pars{$_}; }
+  bless $obj;
+}
+
+# ----------------------------------------------------------------------------
+sub _field_
+{
+  my $obj= shift;
+  my $field= shift;
+  my $val= shift;
+  my $old= $obj->{$field};
+  $obj->{$field}= $val if ($val);
+  $old;
+}

Perl/Modules/vdif/(dirinf).fm

+#!/usr/local/bin/perl
+# FILE %usr/unixonly/CPAN/ldif/(dirinf).fm
+#
+# written:       1998-09-13
+# latest update: 1998-09-13  9:09:33
+#
+
+.                       LDIF, vCard, vCalendar hanlding
+Changes                 modifcation log
+MANIFEST                File Listek
+Makefile.PL             generic makefile
+
+LDIF.pm                 Main Module
+VDIF
+
+abook.pl                Address Book Converter
+cookieflt.pl            Cookie Filter
+pl.pl                   test?
+test.pl                 test?

Perl/Modules/vdif/.cvsignore

+@*
+aliases.text