FTN-JAM

 view release on metacpan or  search on metacpan

lib/FTN/JAM.pm  view on Meta::CPAN

=head2 RemoveMB

Syntax: FTN::JAM::RemoveMB($jampath)

=cut

sub RemoveMB {

    my ($jampath) = @_ or croak 'RemoveMB requires a base file name and path as a parameter.';

    my $hasjdx = ( -e $jampath . ".jdx" );
    my $hasjhr = ( -e $jampath . ".jhr" );
    my $hasjdt = ( -e $jampath . ".jdt" );
    my $hasjlr = ( -e $jampath . ".jlr" );

    if ($hasjdx) {
        if ( !unlink( $jampath . ".jdx" ) ) {
            $Errnum = $FTN::JAM::Errnum::IO_ERROR;
            return;
        }
    }

    if ($hasjhr) {
        if ( !unlink( $jampath . ".jhr" ) ) {
            $Errnum = $FTN::JAM::Errnum::IO_ERROR;
            return;
        }
    }

    if ($hasjdt) {
        if ( !unlink( $jampath . ".jdt" ) ) {
            $Errnum = $FTN::JAM::Errnum::IO_ERROR;
            return;
        }
    }

    if ($hasjlr) {
        if ( !unlink( $jampath . ".jlr" ) ) {
            $Errnum = $FTN::JAM::Errnum::IO_ERROR;
            return;
        }
    }

    return 1;
}

=head2 LockMB

Syntax: $success = FTN::JAM::LockMB($handle,$timeout)

=cut

sub LockMB {
    if ( $#_ != 1 ) {
        croak "Wrong number of arguments for FTN::JAM::LockMB";
    }

    my $handleref = $_[0];
    my $timeout   = $_[1];

    if ( $$handleref{locked} ) {
        return 1;
    }

    if ( flock( $$handleref{jhr}, 6 ) ) {
        $$handleref{locked} = 1;
        return 1;
    }

    for ( my $i = 0 ; $i < $timeout ; $i++ ) {
        sleep(1);

        if ( flock( $$handleref{jhr}, 6 ) ) {
            $$handleref{locked} = 1;
            return 1;
        }
    }

    $Errnum = $FTN::JAM::Errnum::BASE_NOT_LOCKED;
    return;
}

=head2 UnlockMB

Syntax: FTN::JAM::UnlockMB($handle)

=cut

sub UnlockMB {

    my ($handleref) = @_ or croak 'UnlockMB requires a reference to a file hash as a parameter.';

    if ( $$handleref{locked} ) {
        flock( $$handleref{jhr}, 8 );
        delete $$handleref{locked};
    }
    return 1;
}

=head2 ReadMBHeader

Syntax: $success = FTN::JAM::ReadMBHeader($handle,\%header)

=cut

sub ReadMBHeader {
    if ( $#_ != 1 ) {
        croak "Wrong number of arguments for FTN::JAM::ReadMBHeader";
    }

    my $handleref = $_[0];
    my $headerref = $_[1];

    my $buf;
    my @data;

    if ( !seek( $$handleref{jhr}, 0, 0 ) ) {
        $Errnum = $FTN::JAM::Errnum::IO_ERROR;
        return;
    }

    if ( read( $$handleref{jhr}, $buf, 1024 ) != 1024 ) {
        $Errnum = $FTN::JAM::Errnum::IO_ERROR;
        return;
    }

    @data = unpack( "Z[4]LLLLL", $buf );

    if ( $data[0] ne "JAM" ) {
        $Errnum = $FTN::JAM::Errnum::BASEHEADER_CORRUPT;
        return;
    }

    %$headerref = ();

    $$headerref{Signature}   = $data[0];
    $$headerref{DateCreated} = $data[1];
    $$headerref{ModCounter}  = $data[2];
    $$headerref{ActiveMsgs}  = $data[3];
    $$headerref{PasswordCRC} = $data[4];
    $$headerref{BaseMsgNum}  = $data[5];

    return 1;
}

=head2 WriteMBHeader

Syntax: $success = FTN::JAM::WriteMBHeader($handle,\%header) 

=cut

sub WriteMBHeader {
    if ( $#_ != 1 ) {
        croak "Wrong number of arguments for FTN::JAM::WriteMBHeader";
    }

    my $handleref = $_[0];
    my $headerref = $_[1];

    if ( !defined( $$headerref{DateCreated} ) ) {
        $$headerref{DateCreated} = 0;
    }
    if ( !defined( $$headerref{ModCounter} ) ) { $$headerref{ModCounter} = 0; }
    if ( !defined( $$headerref{ActiveMsgs} ) ) { $$headerref{ActiveMsgs} = 0; }
    if ( !defined( $$headerref{PasswordCRC} ) ) {
        $$headerref{PasswordCRC} = 0;
    }
    if ( !defined( $$headerref{BaseMsgNum} ) ) { $$headerref{BaseMsgNum} = 0; }

    if ( !$$handleref{locked} ) {
        $Errnum = $FTN::JAM::Errnum::BASE_NOT_LOCKED;
        return;
    }

    $$headerref{Signature} = "JAM";
    $$headerref{ModCounter}++;

    if ( !seek( $$handleref{jhr}, 0, 0 ) ) {
        $Errnum = $FTN::JAM::Errnum::IO_ERROR;
        return;
    }

    my $printres = print { $$handleref{jhr} } pack(
        "Z[4]LLLLLx[1000]",
        $$headerref{Signature},   $$headerref{DateCreated},
        $$headerref{ModCounter},  $$headerref{ActiveMsgs},
        $$headerref{PasswordCRC}, $$headerref{BaseMsgNum}
    );

    if ( !$printres ) {
        $Errnum = $FTN::JAM::Errnum::IO_ERROR;
        return;
    }

    return 1;
}

=head2 GetMBSize

Syntax: $success = FTN::JAM::GetMBSize($handle,\$num)

=cut

sub GetMBSize {
    if ( $#_ != 1 ) {
        croak "Wrong number of arguments for FTN::JAM::GetMBSize";
    }

    my $handleref = $_[0];
    my $numref    = $_[1];

    my $buf;
    my @data;

    if ( !seek( $$handleref{jdx}, 0, 2 ) ) {
        $Errnum = $FTN::JAM::Errnum::IO_ERROR;
        return;
    }

    my $offset = tell( $$handleref{jdx} );

    if ( $offset == -1 ) {
        $Errnum = $FTN::JAM::Errnum::IO_ERROR;
        return;
    }

    $$numref = $offset / 8;

    return 1;
}

lib/FTN/JAM.pm  view on Meta::CPAN

    return 1;
}

=head2 ChangeMessage

Syntax: $success = FTN::JAM::ChangeMessage($handle,$msgnum,\%header)

=cut

sub ChangeMessage {
    if ( $#_ != 2 ) {
        croak "Wrong number of arguments for FTN::JAM::ChangeMessage";
    }

    my $handleref = $_[0];
    my $msgnum    = $_[1];
    my $headerref = $_[2];

    if ( !defined( $$headerref{Signature} ) ) {
        $$headerref{Signature} = "JAM";
    }
    if ( !defined( $$headerref{Revision} ) ) { $$headerref{Revision} = 1; }
    if ( !defined( $$headerref{ReservedWord} ) ) {
        $$headerref{ReservedWord} = 0;
    }
    if ( !defined( $$headerref{SubfieldLen} ) ) {
        $$headerref{SubfieldLen} = 0;
    }
    if ( !defined( $$headerref{TimesRead} ) ) { $$headerref{TimesRead} = 0; }
    if ( !defined( $$headerref{MsgIdCRC} ) ) {
        $$headerref{MsgIdCRC} = 0xffffffff;
    }
    if ( !defined( $$headerref{ReplyCRC} ) ) {
        $$headerref{ReplyCRC} = 0xffffffff;
    }
    if ( !defined( $$headerref{ReplyTo} ) )   { $$headerref{ReplyTo}   = 0; }
    if ( !defined( $$headerref{Reply1st} ) )  { $$headerref{Reply1st}  = 0; }
    if ( !defined( $$headerref{ReplyNext} ) ) { $$headerref{ReplyNext} = 0; }
    if ( !defined( $$headerref{DateWritten} ) ) {
        $$headerref{DateWritten} = 0;
    }
    if ( !defined( $$headerref{DateReceived} ) ) {
        $$headerref{DateReceived} = 0;
    }
    if ( !defined( $$headerref{DateProcessed} ) ) {
        $$headerref{DateProcessed} = 0;
    }
    if ( !defined( $$headerref{MsgNum} ) )     { $$headerref{MsgNum}     = 0; }
    if ( !defined( $$headerref{Attributes} ) ) { $$headerref{Attributes} = 0; }
    if ( !defined( $$headerref{Attributes2} ) ) {
        $$headerref{Attributes2} = 0;
    }
    if ( !defined( $$headerref{TxtOffset} ) ) { $$headerref{TxtOffset} = 0; }
    if ( !defined( $$headerref{TxtLen} ) )    { $$headerref{TxtLen}    = 0; }
    if ( !defined( $$headerref{PasswordCRC} ) ) {
        $$headerref{PasswordCRC} = 0xffffffff;
    }
    if ( !defined( $$headerref{Cost} ) ) { $$headerref{Cost} = 0; }

    if ( !$$handleref{locked} ) {
        $Errnum = $FTN::JAM::Errnum::BASE_NOT_LOCKED;
        return;
    }

    my $buf;
    my @data;
    my %mbheader;

    if ( !ReadMBHeader( $handleref, \%mbheader ) ) {
        return;
    }

    if ( ( $$headerref{Attributes} & $FTN::JAM::Attr::DELETED ) ) {
        my %oldheader;

        if ( !ReadMessage( $handleref, $msgnum, \%oldheader, 0, 0 ) ) {
            return;
        }

        if ( !( $oldheader{Attributes} & $FTN::JAM::Attr::DELETED ) ) {
            if ( $mbheader{ActiveMsgs} ) {
                $mbheader{ActiveMsgs}--;
            }
        }
    }

    if ( !seek( $$handleref{jdx}, ( $msgnum - $mbheader{BaseMsgNum} ) * 8, 0 ) )
    {
        $Errnum = $FTN::JAM::Errnum::IO_ERROR;
        return;
    }

    if ( read( $$handleref{jdx}, $buf, 8 ) != 8 ) {
        $Errnum = $FTN::JAM::Errnum::IO_ERROR;
        return;
    }

    @data = unpack( "LL", $buf );

    if ( !seek( $$handleref{jhr}, $data[1], 0 ) ) {
        $Errnum = $FTN::JAM::Errnum::IO_ERROR;
        return;
    }

    my $printres = print { $$handleref{jhr} } pack(
        "Z[4]SSLLLLLLLLLLLLLLLLL",
        $$headerref{Signature},     $$headerref{Revision},
        $$headerref{ReservedWord},  $$headerref{SubfieldLen},
        $$headerref{TimesRead},     $$headerref{MsgIdCRC},
        $$headerref{ReplyCRC},      $$headerref{ReplyTo},
        $$headerref{Reply1st},      $$headerref{ReplyNext},
        $$headerref{DateWritten},   $$headerref{DateReceived},
        $$headerref{DateProcessed}, $$headerref{MsgNum},
        $$headerref{Attributes},    $$headerref{Attributes2},
        $$headerref{TxtOffset},     $$headerref{TxtLen},
        $$headerref{PasswordCRC},   $$headerref{Cost}
    );

    if ( !$printres ) {
        $Errnum = $FTN::JAM::Errnum::IO_ERROR;

lib/FTN/JAM.pm  view on Meta::CPAN

        }

        my $jdxoffset = tell( $$handleref{jdx} );

        if ( $jdxoffset == -1 ) {
            $Errnum = $FTN::JAM::Errnum::IO_ERROR;
            return;
        }

        print { $$handleref{jdx} } pack( "LL", 0xffffffff, 0xffffffff );

        if ( !$printres ) {
            $Errnum = $FTN::JAM::Errnum::IO_ERROR;
            return;
        }

        return $jdxoffset / 8 + $mbheader{BaseMsgNum};
    }

    if ( !defined( $$headerref{Signature} ) ) {
        $$headerref{Signature} = "JAM";
    }
    if ( !defined( $$headerref{Revision} ) ) { $$headerref{Revision} = 1; }
    if ( !defined( $$headerref{ReservedWord} ) ) {
        $$headerref{ReservedWord} = 0;
    }
    if ( !defined( $$headerref{SubfieldLen} ) ) {
        $$headerref{SubfieldLen} = 0;
    }
    if ( !defined( $$headerref{TimesRead} ) ) { $$headerref{TimesRead} = 0; }
    if ( !defined( $$headerref{MsgIdCRC} ) ) {
        $$headerref{MsgIdCRC} = 0xffffffff;
    }
    if ( !defined( $$headerref{ReplyCRC} ) ) {
        $$headerref{ReplyCRC} = 0xffffffff;
    }
    if ( !defined( $$headerref{ReplyTo} ) )   { $$headerref{ReplyTo}   = 0; }
    if ( !defined( $$headerref{Reply1st} ) )  { $$headerref{Reply1st}  = 0; }
    if ( !defined( $$headerref{ReplyNext} ) ) { $$headerref{ReplyNext} = 0; }
    if ( !defined( $$headerref{DateWritten} ) ) {
        $$headerref{DateWritten} = 0;
    }
    if ( !defined( $$headerref{DateReceived} ) ) {
        $$headerref{DateReceived} = 0;
    }
    if ( !defined( $$headerref{DateProcessed} ) ) {
        $$headerref{DateProcessed} = 0;
    }
    if ( !defined( $$headerref{MsgNum} ) )     { $$headerref{MsgNum}     = 0; }
    if ( !defined( $$headerref{Attributes} ) ) { $$headerref{Attributes} = 0; }
    if ( !defined( $$headerref{Attributes2} ) ) {
        $$headerref{Attributes2} = 0;
    }
    if ( !defined( $$headerref{TxtOffset} ) ) { $$headerref{TxtOffset} = 0; }
    if ( !defined( $$headerref{TxtLen} ) )    { $$headerref{TxtLen}    = 0; }
    if ( !defined( $$headerref{PasswordCRC} ) ) {
        $$headerref{PasswordCRC} = 0xffffffff;
    }
    if ( !defined( $$headerref{Cost} ) ) { $$headerref{Cost} = 0; }

    if ( !$$handleref{locked} ) {
        $Errnum = $FTN::JAM::Errnum::BASE_NOT_LOCKED;
        return;
    }

    my $buf;
    my @data;

    if ( !ReadMBHeader( $handleref, \%mbheader ) ) {
        return;
    }

    $$headerref{TxtOffset} = 0;
    $$headerref{TxtLen}    = 0;

    if ( $textref and length($$textref) ) {
        if ( !seek( $$handleref{jdt}, 0, 2 ) ) {
            $Errnum = $FTN::JAM::Errnum::IO_ERROR;
            return;
        }

        my $jdtoffset = tell( $$handleref{jdt} );

        if ( $jdtoffset == -1 ) {
            $Errnum = $FTN::JAM::Errnum::IO_ERROR;
            return;
        }

        $$headerref{TxtOffset} = $jdtoffset;
        $$headerref{TxtLen}    = length($$textref);

        $printres = print { $$handleref{jdt} } $$textref;

        if ( !$printres ) {
            $Errnum = $FTN::JAM::Errnum::IO_ERROR;
            return;
        }
    }

    $$headerref{SubfieldLen} = 0;
    $$headerref{MsgIdCRC}    = 0xffffffff;
    $$headerref{ReplyCRC}    = 0xffffffff;
    my $usercrc = 0xffffffff;

    for ( my $i = 0 ; $i <= $#$subfieldsref ; $i = $i + 2 ) {
        if ( $$subfieldsref[$i] == $FTN::JAM::Subfields::RECVRNAME ) {
            $usercrc = Crc32( $$subfieldsref[ $i + 1 ] );
        }

        if ( $$subfieldsref[$i] == $FTN::JAM::Subfields::MSGID ) {
            $$headerref{MsgIdCRC} = Crc32( $$subfieldsref[ $i + 1 ] );
        }

        if ( $$subfieldsref[$i] == $FTN::JAM::Subfields::REPLYID ) {
            $$headerref{ReplyCRC} = Crc32( $$subfieldsref[ $i + 1 ] );
        }

        $$headerref{SubfieldLen} += 8 + length( $$subfieldsref[ $i + 1 ] );
    }

    if ( !seek( $$handleref{jdx}, 0, 2 ) ) {