File Coverage

blib/lib/Video/TeletextDB/Access.pm

Criterion	Covered	Total	%
statement	13	15	86.6
branch			n/a
condition			n/a
subroutine	5	5	100.0
pod			n/a
total	18	20	90.0

package Video::TeletextDB::Access;
use 5.006001;
use strict;
use warnings;
use Carp;
use DB_File;
use POSIX qw(ENOENT EWOULDBLOCK);
use Fcntl qw(F_GETFL O_CREAT O_RDWR O_RDONLY O_ACCMODE LOCK_NB LOCK_EX);
# use AutoLoader qw(AUTOLOAD);

use Video::TeletextDB::Constants qw(:BdbPrefixes :VTX :VBI DB_VERSION);
use Video::TeletextDB::Page qw(vote $epoch_time);

our $VERSION = "0.02";
use base qw(Video::TeletextDB::Parameters);

use Exporter::Tidy
    functions => [qw(tilde)],
    variables => [qw($default_cache_dir $default_page_versions)];

use constant MIN_STORES	=> 10000; # Must have at least 10000 stores
use constant DB_RO	=> "Video::TeletextDB::DB_RO";
use constant DB_RW	=> "Video::TeletextDB::DB_RW";

our @CARP_NOT = qw(Video::TeletextDB::Options);

our $default_cache_dir = "~/.TeletextDB/cache";
our $default_page_versions = 5;

# Database format:
#  V.	=> a*  (version)
#  s.	=> NNN (start time, number of stores, last store time)
#  S.	=> C   (page_versions)
#  c.nn  (page, subpage) => CN (last_counter, last_time)
#        There is a fake c."\xff"x4 at the end to make scanning easier
#  p.nnC (page, subpage, counter) =>
#           Na* (store time, join \xa, raw rows (without \xa))
#        There is a fake p."\xff"x5 at the end to make scanning easier

sub tilde {
    defined(my $file = shift) || croak "Undefined file";
    my ($user, $rest) = $file =~ m!^~([^/]*)(.*)\z!s or return $file;
    if ($user ne "") {
        my @pw = getpwnam($user) or croak "Could not find user $user";
        $user = $pw[7];
    } elsif (!defined($user = $ENV{HOME})) {
        my @pw = getpwuid($>) or
            croak "Could not determine who you are";
        $user = $pw[7];
    }
    croak "Home directory is the empty string" if $user eq "";
    $user =~ s!/*\z!$rest!;
    $user = "/" if $user eq "";
    # Restore taintedness
    return $user . substr($file, 0, 0);
}

# Prepare a directory to contain databases
sub prepare {
    my ($class, $tele, $params) = @_;

    my $mkpath = exists $params->{mkpath} ?
        delete $params->{mkpath} : !exists $params->{cache_dir};
    my $dir = delete $params->{cache_dir};
    $dir = $default_cache_dir unless defined $dir;
    $dir = tilde($dir);
    if ($dir !~ m!\A/!) {
        require Cwd;
        my $prefix = Cwd::getcwd();
        $dir = $prefix =~ m!/\z! ? $prefix . $dir : "$prefix/$dir";
    }
    $dir .= "/" unless $dir =~ m!/\z!;
    if (!-d $dir) {
        croak "No visible directory named '$dir'" unless $mkpath;
        require File::Path;
        my $old_mask = umask($tele->{umask}) if defined($tele->{umask});
        eval { File::Path::mkpath($dir) };
        my $err = $@;
        umask($old_mask) if defined($tele->{umask});
        die $err if $err;
    }
    $tele->{cache_dir} = $dir;
}

# Opening a db file with O_CREAT can give you RW access even if you didn't
# ask for that. Use this to fix the state.
sub db_maybe_rw {
    my $db = shift->{db};
    open(my $fh, "+<&", $db->fd) || croak "Could not dup db fileno: $!";
    my $flags = fcntl($fh, F_GETFL, 0) ||
        croak "Could not fcntl db handle: $!";
    $flags &= O_ACCMODE;
    return 0 if $flags == O_RDONLY;
    croak "Don't know how to handle a database opened in mode $flags" unless
        $flags == O_RDWR;
    bless $db, DB_RW;
    return 1;
}

sub db_check {
    my $access = shift;
    my $db = $access->{db};

    if (!$db->get(VERSION, my $version)) {
        croak("Wanted version ", DB_VERSION, " differs from current $version for ", $access->db_file) if $version ne DB_VERSION;
    } else {
        $db = $access->upgrade(1);
        croak "Storage problem" if $db->put(VERSION, DB_VERSION);
    }

    my $versions_wanted = $access->page_versions;
    if ($db->get(PAGE_VERSIONS, my $page_versions) == 0) {
        $page_versions = unpack("C", $page_versions);
        croak("Wanted versions $versions_wanted differs from current $page_versions for ", $access->db_file) if defined($versions_wanted) && $versions_wanted != $page_versions;
        $access->{page_versions} = $page_versions;
    } else {
        $db = $access->upgrade(1);
        $access->{page_versions} = $versions_wanted || $default_page_versions;
        croak "Storage problem" if
            $db->put(PAGE_VERSIONS, pack("C", $access->{page_versions}));
    }

    my $value;
    if ($db->get(PAGE . "\xff" x 5, $value)) {
        # No PAGE terminator
        $db = $access->upgrade(1);
        croak "Storage problem" if $db->put(PAGE . "\xff" x 5, "\xff" x 4);
    }

    if ($db->get(COUNTER . "\xff" x 4, $value) ||
        $value ne "\x0" . "\xff" x 4) {
        # No COUNTER terminator
        $db = $access->upgrade(1);
        croak "Storage problem" if $db->put(COUNTER . "\xff" x 4, "\x00" . "\xff" x 4);
    }
}

sub init {
    my ($access, $params) = @_;

    my $acquire = exists $params->{acquire} ? delete $params->{acquire} : 1;
    $access->SUPER::init($params);
    $access->{stores} = 0;
    $access->acquire if $acquire;

    return $access;
}

sub cache_dir {
    return shift->{parent}->cache_dir;
}

sub teletext_db {
    return shift->{parent};
}

sub db {
    return shift->{db};
}

sub stale_period {
    return shift->{stale_period};
}

sub expire_period {
    return shift->{expire_period};
}

sub channel {
    croak "You can't change the channel on a $_[0]" if @_ >= 2;
    return shift->{channel};
}

sub page_versions {
    croak "You can't change the page_versions on a $_[0]" if @_ >= 2;
    return shift->{page_versions};
}

sub delete {
    my ($access, %options) = shift;
    defined($access->{channel}) || croak "No channel";

    # We won't check lockfile unlinks since they are not really
    # part of the semantics of a channel existing, and there actually is no
    # clean way to make things look atomic in that case anyways.
    my $want_file = $access->want_file;
    my $lock_file = $access->lock_file;
    my $want_fh   = $access->{want_fh};
    my $lock_fh   = $access->{lock_fh};

    my $rc;
    my $old_mask = $access->{creat} && defined($access->{umask}) ?
        umask($access->{umask}) : undef;
    eval {
        my $db_file = $access->db_file;
        $want_fh ||= $access->{want} && $access->get_lock($want_file, 1);
        $lock_fh ||= $access->get_lock($lock_file, 1);
        if (unlink($db_file)) {
            $rc = 1;
        } elsif ($! != ENOENT) {
            croak "Could not unlink $db_file: $!";
        }
        if (my $db = delete $access->{db}) {
            # This is pure evil.
            $db->DESTROY;
            bless $db, "Video::TeletextDB::Bug";
        }
        unlink($lock_file);
        delete $access->{lock_fh};
        if ($want_fh) {
            unlink($want_file);
            delete $access->{want_fh};
        }
    };
    umask($old_mask) if defined $old_mask;
    return $rc || () unless $@;

    unlink($lock_file) if $lock_fh && !$access->{lock_fh};
    unlink($want_file) if $want_fh && !$access->{want_fh};
    die $@ if $@;
}

sub unwant {
    my $access = shift;
    croak "You don't have the database"		unless	$access->{db};
    croak "You don't have the database lock"	unless	$access->{lock_fh};
    croak "You don't have the database want"	unless	$access->{want_fh};
    close delete $access->{want_fh};
}

sub rewant {
    my $access = shift;
    croak "You don't have the database"		unless	$access->{db};
    croak "You don't have the database lock"	unless	$access->{lock_fh};
    croak "You already have the database want"	if	$access->{want_fh};

    my $want_file = $access->want_file;
    sysopen(my $fh, $want_file, $access->{creat} ? O_RDWR | O_CREAT : O_RDWR)||
        croak "Could not open/create '$want_file': $!";
    if (flock($fh, LOCK_NB | LOCK_EX)) {
        my $oldfh = select $fh;
        $| = 1;
        print "$$\n";
        truncate $fh, tell($fh);
        select $oldfh;
        $access->{want_fh} = $fh;
        return;
    }
    croak "Could not lock '$want_file': $!" unless $! == EWOULDBLOCK;
    close $fh;

    $access->release;
    local $access->{want} = 1;
    $access->acquire;
    return 1;
}

sub restart {
    my $access = shift;
    delete $access->{start_time};
    delete $access->{end_time};
    $access->{stores} = 0;
}

sub start_time {
    croak 'Too many arguments for start_time method' if @_ > 1;
    return shift->{start_time} || croak "Time doesn't seem to have started";
}

sub end_time {
    croak 'Too many arguments for end_time method' if @_ > 1;
    return shift->{end_time} || croak "Time doesn't seem to have ended";
}

sub stores {
    croak 'Too many arguments for stores method' if @_ > 1;
    return shift->{stores};
}

sub acquire {
    my $access = shift;

    croak "You already have the database"	if $access->{db};
    croak "You already have the database lock"	if $access->{lock_fh};
    croak "You already have the database want"	if $access->{want_fh};

    my $old_mask = $access->{creat} && defined($access->{umask}) ?
        umask($access->{umask}) : undef;
    eval {
        $access->{want_fh} = $access->want(1) if $access->{want};
        $access->{lock_fh} = $access->lock(1);

        $access->{db} = ($access->{RW} ? DB_RW : DB_RO)->TIEHASH
            ($access->db_file,
            ($access->{RW}	? O_RDWR  : O_RDONLY) |
            ($access->{creat}	? O_CREAT : 0), 0666, $DB_BTREE) ||
            croak "Could not db_open ", $access->db_file, ": $!";
        $access->db_maybe_rw if $access->{creat} && !$access->{RW};
        $access->db_check;
        $access->downgrade if !$access->{RW} && defined $access->{RW} &&
            $access->{db}->isa(DB_RW);

        return if $access->{db}->get(STORES, my $stores);
        (my $end, $stores) = unpack("NN", $stores);
        $access->{stale}  = $end - $access->{stale_period};
        $access->{expire} =
            $stores < MIN_STORES ? -9**9**9 : $end - $access->{expire_period};
    };
    umask($old_mask) if defined $old_mask;
    return $access->{db} unless $@;

    my $err = $@;
    $access->release;
    die $err;
}

sub upgrade {
    my $access = shift;

    $access->{db} || croak "You don't have the database";
    return $access->{db} if $access->{db}->isa(DB_RW);
    croak "Can't upgrade pure readonly access" if
        !$access->{RW} && defined $access->{RW} &&
        !($access->{creat} && shift);

    my $db = delete $access->{db};
    # This is pure evil.
    $db->DESTROY;
    bless $db, "Video::TeletextDB::Bug";

    my $old_mask = $access->{creat} && defined($access->{umask}) ?
        umask($access->{umask}) : undef;
    eval {
        $access->{db} = DB_RW->TIEHASH
            ($access->db_file, $access->{creat} ? O_RDWR | O_CREAT : O_RDWR,
             0666, $DB_BTREE) ||
             croak "Could not db_open ", $access->db_file, ": $!";
        $access->db_check;
    };
    umask($old_mask) if defined $old_mask;
    return $access->{db} unless $@;

    my $err = $@;
    $access->release;
    die $err;
}

sub downgrade {
    my $access = shift;

    $access->{db} || croak "You don't have the database";
    return $access->{db} if $access->{db}->isa(DB_RO);

    my $db = delete $access->{db};
    # This is pure evil.
    $db->DESTROY;
    bless $db, "Video::TeletextDB::Bug";

    my $old_mask = $access->{creat} && defined($access->{umask}) ?
        umask($access->{umask}) : undef;
    eval {
        while (1) {
            $access->{db} = DB_RO->TIEHASH
                ($access->db_file,
                 $access->{creat} ? O_CREAT | O_RDONLY : O_RDONLY,
                 0666, $DB_BTREE) ||
                 croak "Could not db_open ", $access->db_file, ": $!";
            $access->db_maybe_rw if $access->{creat};
            $access->db_check;
            last if $access->{db}->isa(DB_RO);

            if ($access->{db} = DB_RO->TIEHASH
                ($access->db_file, O_RDONLY, 0666, $DB_BTREE)) {
                $access->db_check;
                # check may have caused an upgrade again
                last if $access->{db}->isa(DB_RO);
            } elsif ($! != ENOENT) {
                croak "Could not db_open ", $access->db_file, ": $!";
            }
            # Someone must have undone us. Retry.
        }
    };
    umask($old_mask) if defined $old_mask;
    return $access->{db} unless $@;

    my $err = $@;
    $access->release;
    die $err;
}

sub release {
    my $access = shift;
    # Make sure things get closed in the right order
    if (my $db = delete $access->{db}) {
        # This is pure evil.
        $db->DESTROY;
        bless $db, "Video::TeletextDB::Bug";
    }
    my $fh = delete $access->{lock_fh};
    close($fh) if $fh;
    $fh = delete $access->{want_fh};
    close($fh) if $fh;
}

sub cache_status {
    my $access = shift;
    my $db = $access->{db} || croak "You don't have the database";
    return if $db->get(STORES, my $update);
    my ($end, $stores, $start) = unpack("NNN", $update);
    return {
        channel		=> $access->{channel},
        start_time	=> $start+$epoch_time,
        end_time	=> $end  +$epoch_time,
        stores		=> $stores,
    };
}

sub expire {
    my $access = shift;
    my $db = $access->upgrade;
    for my $page (@_) {
        croak "Delete problem" if $db->del($page);
        $db->del(PAGE . substr($page, 1) . pack("C", $_)) for
            0..$access->{page_versions}-1;
    }
    return $db;
}

sub db_subpages {
    my ($access, $page) = @_;

    my $db = $access->{db} || croak "You don't have the database";

    my $key = my $prefix = COUNTER . $page;
    return wantarray ? () : 0 if $db->seq($key, my $counter, R_CURSOR);

    my $updatable = $access->{RW} || !defined $access->{RW};
    my (@good_pages, @bad, $stale);
    my $zero_time = my $non_zero_time = 0;

    while (substr($key, 0, 3) eq $prefix) {
        my ($c, $time) = unpack("CN", $counter);
        if ($time <= $access->{stale}) {
            #print STDERR ("Expiring ",unpack("n", $page),"/",unpack("n", $_),
            #              " (", scalar localtime($time),
            #              ") versus ", scalar localtime($expire), "\n");
            push @bad, $key if $updatable && $time <= $access->{expire};
        } else {
            #print STDERR ("good ", unpack("n", $page),"/",unpack("n", $_),
            #              " with date ",
            #              scalar localtime($time), "\n");
            my $subpage_nr = unpack("x3n", $key);
            if (sprintf("%x", $subpage_nr) !~ /[a-fA-F]/) {
                push @good_pages, $subpage_nr;
                if ($good_pages[-1]) {
                    $non_zero_time = $time if $non_zero_time < $time;
                } else {
                    $zero_time = $time;
                }
            }
        }
        croak "Unexpected sequence end" if $db->seq($key, $counter, R_NEXT);
    }
    # print STDERR "returning @{[unpack('n*', $good_pages)]} instead of @{[unpack('n*', $subpages)]}\n";
    $access->expire(@bad) if @bad;
    return @good_pages unless $zero_time && $non_zero_time;
    # Here we assume that a 0 page and a 1-n page are mutually exclusive
    return wantarray ? 0 : 1 if $zero_time >= $non_zero_time;
    return wantarray ? grep $_, @good_pages : @good_pages - 1;
}

sub subpages {
    my $access = shift;
    my $page	= pack("n", shift);
    return $access->db_subpages($page, @_);
}

sub raw_fetch_page {
    my $access = shift;
    my $page = pack("nn", @_);
    my $db = $access->{db} || croak "You don't have the database";

    return if $db->get(COUNTER . $page, my $counter);
    my $time = unpack("xN", $counter);
    if ($access->{stale} < $time) {
        my $content;
        return sort { $b cmp $a } map
            $db->get(PAGE . $page . pack("C", $_), $content) ? () : $content,
            0..$access->{page_versions}-1;
    }
    return if !$access->{RW} && defined $access->{RW} ||
        $access->{expire} < $time;
    $db = $access->upgrade;
    croak "Delete problem" if $db->del(COUNTER . $page);
    $db->del(PAGE . $page . pack("C", $_)) for 0..$access->{page_versions}-1;
}

sub fetch_page {
    my $access = shift;
    return vote($access->{channel}, @_[0..1], $access->raw_fetch_page(@_));
}

sub fetch_page_versions {
    my $access = shift;
    return map {
        my ($time, @rows) = unpack "N(C/a)*", $_;
        bless {
            time	=> $time+$epoch_time,
            raw_rows	=> \@rows,
            channel	=> $access->{channel},
            page_nr	=> $_[0],
            subpage_nr	=> $_[1],
        }, "Video::TeletextDB::Page";
    } $access->raw_fetch_page(@_);
}

sub scan_page {
    my ($access, $step, $from) = @_;
    my $db = $access->{db} || croak "You don't have the database";
    croak "Zero step" unless $step;
    my $updatable = $access->{RW} || !defined $access->{RW};
    my @bad;
    if ($step >= 0) {
        $from ||= 0;
        croak "Too high page $from" if $from >= 0x900;
        my $base = $from;
        my $end = 0xffff;
        while (1) {
            # print STDERR "from=$from, base=$base, end=$end\n";
            my $key = my $start = COUNTER . pack("n", $base) . "\xffff";
            croak "No followup after $from" if
                $db->seq($key, my $counter, R_CURSOR);
            # One more step if we hit the element itself
            croak "No followup after $from" if
                substr($key, 0, 3) eq $start &&
                $db->seq($key, $counter, R_NEXT);
            while (unpack("xN", $counter) <= $access->{stale}) {
                push @bad, $key if
                    $updatable && unpack("xN", $counter) <= $access->{expire};
                croak "No followup after $from" if
                    $db->seq($key, $counter, R_NEXT);
            }
            my $hex = unpack("xH4", $key);
            # print STDERR "Considering 0x$hex\n";
            unless ($hex =~ s/(\D.*)/"f" x length $1/eg) {
                # We found a non-hex page
                $access->expire(@bad) if @bad;
                return hex $hex > $end ? () : hex $hex;
            }
            $base = hex $hex;
            if ($base == 0xffff) {
                unless ($end == 0xffff) {
                    $access->expire(@bad) if @bad;
                    return;
                }
                # wrap
                $end = $from;
                $base = 0;
            }
        }
    } else {
        $from ||= 0xffff;
        croak "Too low page $from" if $from < 0x100;
        my $base = $from;
        my $end = 0;
      START:
        while (1) {
            # print STDERR "from=$from, base=$base, end=$end\n";
            my $key = my $start = COUNTER . pack("n", $base);
            croak "No followup after $from" if
                $db->seq($key, my $counter, R_CURSOR);
            # print STDERR "found ", unpack("H*", $key), "\n";
            # and step back
            until ($db->seq($key, $counter, R_PREV) ||
                   substr($key, 0, 1) ne COUNTER) {
                if (unpack("xN", $counter) <= $access->{stale}) {
                    push @bad, $key if $updatable &&
                        unpack("xN", $counter) <= $access->{expire};
                    next;
                }

                my $hex = unpack("xH4", $key);
                # print STDERR "Considering 0x$hex\n";
                # We found a non-hex page
                unless ($hex =~ s/(\D.*)/"9" x length $1/eg) {
                    $access->expire(@bad) if @bad;
                    return hex $hex < $end ? () : hex $hex;
                }
                $base = hex($hex)+1;
                next START;
            }
            if ($end) {
                $access->expire(@bad) if @bad;
                return;
            }
            # wrap
            $end = $from;
            $base = 0xffff;
        }
    }
}

sub page_ids {
    my $access = shift;
    my $db = $access->{db} || croak "You don't have the database";
    my $updatable = $access->{RW} || !defined $access->{RW};
    my (@keys, $time, @bad);
    croak "No followup after ", COUNTER if
        $db->seq(my $key = COUNTER, my $value, R_CURSOR);
    while ($key ne COUNTER . "\xff" x 4) {
        $time = unpack("xN", $value);
        if ($access->{stale} < $time) {
            my $page_id = sprintf("%03x/%02x", unpack("xnn", $key));
            push @keys, $page_id unless $page_id =~ /[a-fA-F]/;
        } elsif ($updatable && $time <= $access->{expire}) {
            push @bad, $key;
        }
        croak "No followup" if $db->seq($key, $value, R_NEXT);
    }
    $access->expire(@bad) if @bad;
    return @keys;
}

sub write_pages {
    my ($access, %params) = @_;
    my $time	= exists $params{time} ? delete $params{time} : time;
    defined(my $pages	= delete $params{pages}) ||
        croak "No pages parameter";
    croak("Unknown parameters ", join(", ", keys %params)) if %params;
    return unless @$pages;

    $access->{start_time} = $time if
        !defined $access->{start_time}	|| $time < $access->{start_time};
    $access->{end_time}   = $time if
        !defined $access->{end_time}	|| $time > $access->{end_time};
    $time -= $epoch_time;
    my $t = pack("N", $time);

    my $db = $access->upgrade;

    my $counter;
    for (@$pages) {
        my $main_page = $_->{page};
        # Maybe caller should do this...
        die "Bad page nr $main_page" if $main_page >= 0x800;
        $main_page += 0x800 if $main_page < 0x100;
        $main_page	= pack("n", $main_page);
        my $subpage	= pack("n", $_->{ctrl} & VTX_SUB);
        my $page = $main_page . $subpage;

        $counter = pack("C", $access->{page_versions}-1) if
            $db->get(COUNTER . $page, $counter);
        $counter = pack "C", (1 + unpack "C", $counter) % $access->{page_versions};
        my $rc = $db->put(PAGE . $page . $counter, do {
            no warnings "uninitialized";
            pack "a*(C/a*)*", $t, @{$_->{packet}};
        });
        $rc == 0 || croak "Storage problem (rc=$rc)";
        $db->put(COUNTER . $page, $counter . $t) == 0 ||
            croak "Storage problem";
        ++$access->{stores};
    }

    if ($db->get(STORES, $counter) == 0) {
        my ($old_end, $old_stores, $old_start) = unpack("NNN", $counter);
        if ($old_start <= $time && $time <= $old_end) {
            $db->put(STORES, pack("NNN", $old_end, $old_stores + @$pages,
                                  $old_start)) == 0 || croak "Storage problem";
            return;
        }
        return if $access->{end_time} < $old_end+$epoch_time;
        return if $access->{stores} < MIN_STORES;
    }
    $db->put(STORES, pack("NNN",
                          $access->{end_time} - $epoch_time,
                          $access->{stores},
                          $access->{start_time} - $epoch_time)) == 0 ||
                              croak "Storage problem";
}

sub write_feed {
    my ($access, %params) = @_;
    my $time = exists $params{time} ? delete $params{time} : time;
    defined(my $fields	= delete $params{decoded_fields}) ||
        croak "No decoded_fields parameter";
    croak("Unknown parameters ", join(", ", keys %params)) if %params;
    return unless @$fields;

    my @pages;
    for (@$fields) {
        next unless $_->[0] == VBI_VT;
        # Currently only handle teletext
        my $y = $_->[2];
        if ($y == 0) {
            if ($access->{curpage}{page}) {
                if ($_->[5] & VTX_C11 ||
                    ($access->{curpage}->{page} ^ $_->[4]) & 0xf00) {
                    push @pages, $access->{curpage} unless
                        ($access->{curpage}->{page} & 0xff) == 0xff;
                }
            }
            $access->{curpage} = {
                packet => [$_->[3]],
                page   => $_->[4],
                ctrl   => $_->[5],
            };
        } elsif ($y <= 25) {
            $access->{curpage}{packet}[$y] = $_->[3];
        }
        # We currently ignore packets 26 and higher
    }
    $access->write_pages(time => $time, pages => \@pages) if @pages;
}

sub next_page {
    return shift->scan_page(+1, @_);
}

sub previous_page {
    return shift->scan_page(-1, @_);
}

sub DESTROY {
    shift->release;
}

package Video::TeletextDB::DB_RW;
our @ISA = qw(DB_File);

package Video::TeletextDB::DB_RO;
our @ISA = qw(DB_File);

package Video::TeletextDB::Access;

1;
__END__