Angel has asked for the wisdom of the Perl Monks concerning the following question:

Dear Monks,

In Perl binary files don't like me. Do not know why I am an aufully nice programmer. :)

So let me begin been messing with some stuff I am sure there are modules for and I am sure could be written better but I am trying to learn. One of the things I am trying to do is upload a set of maps/images and instead of having them all use some sort of naming convention, simply use a random number for them and then keep tabs on the metadata in a database.

What I am also trying to do is learn how to open and manipulate image/binary files in perl and this is a simple start. It opens the file with the test program, the module gets it passed it via a function and then tries to make the new file with the new filename.

Anyway it does this and then when I try to open the image it gives me an error that the format is messed up. So its getting munged somewhere from being opened to being output.

Thank you in advance


#!/usr/local/bin/perl5

# import images based on imput arg[0]
#
# 
#
#use strict;
use DBI;
use Image::Size;
use ImageHoard;

my $file;

my $dsn          = 'NULL';
my $db_user_name = 'NULL';
my $db_password  = 'NULL';

my $dbh = DBI->connect($dsn, $db_user_name, $db_password) || die $dbh-
+>errstr;

my $image = ImageHoard->new;
$image->set_database_handle( $dbh );
$image->set_directory( "./" );


open INF, $ARGV[0] or die "\nCan't open $srcfile for reading: $!\n";


binmode INF;

$file = <INF>;

my ( $imgX , $imgY ) =  imgsize( $ARGV[0] );

$image->create_record( $file,"1",$ARGV[1],$ARGV[2],$imgX,$imgY,"72" );

print "done\n";

[download]

package ImageHoard;


use DBI;
use POSIX;

#  Manages meta data and directory of images. Images are stored on the
+ local
#  file system. Someday it might store the data on a remote filesystem
+ but
#  im not that advanced yet. Meta data is stored in the MYSQL database
+.
#  
#  METHODS
#  
#  new
#      creates a new object
#      
#  set database handle
#      sets the database handle sent to the object to it 
#      can work with the tables it needs to.
#      
#  create_record
#      takes the binary data for the image as well as the associated
#      meta data
#     
#     delete_record
#
#      
#  find_matching_records
#      takes in the metadata field and the value to match
#      returns a list of image id's that match
#      
#  keyword_search
#      takes in the keyword and the value to match
#      returns a list of image id's that match
#  
#  METADATA
#      ID             The unique name of the image for the file system
#      Type           The type of the image so that it can be displaye
+d
#      ReferenceID the user who added it to the system
#      Name            The name of the Image 
#        ImgX
#        ImgY
#      ImgRes
#  
 

sub new
{

     my $self  = {};

     $self->{'dbh'} = undef;               

     #error reporting and update vars
      $self->{error_type}              = undef;
      $self->{error_html_string}       = undef;
           
     bless ($self);

     return $self;


}

sub get_ID
{
    my $a;
    my @results;
    
    my $self = shift;
    
    my $queryString = "SELECT ID
                        FROM IMAGEHOARD_MetaData
                       WHERE ID = \'$_[0]\'";

    my $query = $dbh->prepare($queryString);

    $query->execute() || die $dbh->errstr;

    while( $a  = $query->fetchrow_array() )
    {      
        push( @results, $a );
    }

    return @results;
}

sub get_Type
{
    my $a;
    my @results;
    
    my $self = shift;
    
    my $queryString = "SELECT Type
                        FROM IMAGEHOARD_MetaData
                       WHERE ID = \'$_[0]\'";

    my $query = $dbh->prepare($queryString);

    $query->execute() || die $dbh->errstr;

    while( $a  = $query->fetchrow_array() )
    {      
        push( @results, $a );
    }

    return @results;
}

sub get_referenceID
{
    my $a;
    my @results;
    
    my $self = shift;
    
    my $queryString = "SELECT ReferenceID
                        FROM IMAGEHOARD_MetaData
                       WHERE ID = \'$_[0]\'";

    my $query = $dbh->prepare($queryString);

    $query->execute() || die $dbh->errstr;

    while( $a  = $query->fetchrow_array() )
    {      
        push( @results, $a );
    }

    return @results;
}

sub get_name
{
    my $a;
    my @results;
    
    my $self = shift;
    
    my $queryString = "SELECT Name
                        FROM IMAGEHOARD_MetaData
                       WHERE ID = \'$_[0]\'";

    my $query = $dbh->prepare($queryString);

    $query->execute() || die $dbh->errstr;

    while( $a  = $query->fetchrow_array() )
    {      
        push( @results, $a );
    }

    return @results;
}

sub get_imgx
{
    my $a;
    my @results;
    
    my $self = shift;
    
    my $queryString = "SELECT ImgX
                        FROM IMAGEHOARD_MetaData
                       WHERE ID = \'$_[0]\'";

    my $query = $dbh->prepare($queryString);

    $query->execute() || die $dbh->errstr;

    while( $a  = $query->fetchrow_array() )
    {      
        push( @results, $a );
    }

    return @results;
}

sub get_imgy
{
    my $a;
    my @results;
    
    my $self = shift;
    
    my $queryString = "SELECT ImgY
                        FROM IMAGEHOARD_MetaData
                       WHERE ID = \'$_[0]\'";

    my $query = $dbh->prepare($queryString);

    $query->execute() || die $dbh->errstr;

    while( $a  = $query->fetchrow_array() )
    {      
        push( @results, $a );
    }

    return @results;
}

sub get_imgres
{
    my $a;
    my @results;
    
    my $self = shift;
    
    my $queryString = "SELECT IngRes
                        FROM IMAGEHOARD_MetaData
                       WHERE ID = \'$_[0]\'";

    my $query = $dbh->prepare($queryString);

    $query->execute() || die $dbh->errstr;

    while( $a  = $query->fetchrow_array() )
    {      
        push( @results, $a );
    }

    return @results;
}


sub set_database_handle
{
    
     my $self  = shift;

     $self->{dbh} = $_[0];
     
} 


sub set_directory
{
    
     my $self  = shift;

     $self->{directory} = $_[0];
     
} 

# Args: Binary Data, ReferenceID, Name, Type, X, Y, Res 
# Ret : Image code out

sub create_record
{
    
    my $self = shift;
    my $file = shift;
    my @args;
    my $path;
    
   my $dbh = $self->{'dbh'}; 
    my $unique = 'false';

    my $currentStatecode;
    my $duplicateStatecode;



    while( $unique eq 'false' )
    {
        $unique = 'true'; 

        $currentStatecode = rand( 99999999999 );

        $currentStatecode = floor( $currentStatecode );

      my $sqlQuery = "SELECT ID 
                             FROM IMAGEHOARD_MetaData 
                            WHERE ID = $currentStatecode";    


        my $query = $dbh->prepare( $sqlQuery );

        $query->execute() || die $dbh->errstr;

        if( $duplicateStatecode = $query->fetchrow_array() )
        {
            $unique = 'false';
        }

    } 

    
    foreach ( @_ )
    {
        push( @args, format_for_mysql( $_ ));
    }
    
    
    
    $dbh->do("INSERT into IMAGEHOARD_MetaData 
                 ( ID, ReferenceID, NAME, Type, ImgX, ImgY, IngRes ) 
                 values 
                 ($currentStatecode,$args[0],\'$args[1]\', \'$args[2]\
+',
                  \'$args[3]\',\'$args[4]\',\'$args[5]\')")
                 || die $dbh->errstr;

    $path =  $self->{directory} . $currentStatecode . "." . $args[2];

    
    print $path . "\n";
    
    open OUTF, ">$path"
     or die "\nCan't open $destfile for writing: $!\n";

    binmode OUTF;

    print OUTF $file;

    close OUTF
     or die "Can't close $destfile: $!\n";
     
    return( $currentStatecode );

}

sub add_keyword
{
    my $self = shift;
    my $file = shift;
    my @args = @_;
    my $path;
    
   my $dbh = $self->{'dbh'}; 

    foreach ( @_ )
    {
        push( @args, format_for_mysql( $_ ));
    }
    
     
    $dbh->do("INSERT into IMAGEHOARD_keywords 
                 ( ID, ReferenceID, Keyword ) 
                 values 
                 ($args[0],$args[1], \'$args[2]\'")
                 || die $dbh->errstr;   
   
    return 1;
}


sub delete_record
{
    
    
}


#args: metadata name, value to search for 

sub find_matching_records
{
    my $a;
    my @results;
    
    my $self = shift;
    
    my $dbh = $self->{'dbh'}; 
    
    
    my $queryString = "SELECT ID
                        FROM IMAGEHOARD_MetaData
                       WHERE $_[0] = \'$_[1]\'";

    my $query = $dbh->prepare($queryString);

    $query->execute() || die $dbh->errstr;

    while( $a  = $query->fetchrow_array() )
    {      
        push( @results, $a );
    }

    return @results;
}

sub keyword_search
{
    my $a;
    my @results;
    
    my $self = shift;
    
    my $queryString = "SELECT ID
                        FROM IMAGEHOARD_keywords
                       WHERE $_[0] = \'$_[1]\'";

    my $query = $dbh->prepare($queryString);

    $query->execute() || die $dbh->errstr;

    while( $a  = $query->fetchrow_array() )
    {      
        push( @results, $a );
    }

    return @results;
}




sub format_for_mysql( $ )
{
   my $string = $_[0];
    
   $string =~ s/\'/\\\'/g;
   $string =~ s/\"/\\\"/g;
   $string =~ s/\`/\\\`/g;
   $string =~ s/\;//g;

   $string =~ s/\n/ /g; # replace newlines with spaces
   $string =~ s/\r//g;  # remove hard returns
   $string =~ s/\cM//g; # delete ^M's

   
   return( $string );
   
}


1;

[download]

Edited by BazB. Added readmore tag

Replies are listed 'Best First'.
Re: Binary File Handles and Scalars
by gmax (Abbot) on Dec 18, 2003 at 21:29 UTC
    In Perl binary files don't like me.

    Nor do databases, as far as I can see... :)

    Since you are not asking anything specific, let me point out a few things that you should focus on:

    • First, your connection code.

      my $dsn          = 'NULL';
my $db_user_name = 'NULL';
my $db_password  = 'NULL';

my $dbh = DBI->connect($dsn, $db_user_name, $db_password) || die $dbh-
+>errstr;

      [download]
      This code can't possibly work. I can accept that you are using fake parameters for presentation's sake, but 'NULL' is not something you can safely pass to a DBI connection method. But even assuming that your connection syntax is accepted by any driver, (not by MySQL, which you say you're using), your $dbh can't return an error string in case of failure. If connect fails, then $dbh is undefined. You must get the error string from $DBI::errstr.

    • You are using this construct several times:

        $query->execute() || die $dbh->errstr;

    while( $a  = $query->fetchrow_array() )
    {      
        push( @results, $a );
    }
    return @results;

      [download]

      Why not using fetchall_arrayref instead?

      my $records = $query->fetchall_arrayref;
return @$records;

      [download]

      See DBI Recipes for more examples (and for something useful for the next item as well.)

    • Also, several times you are using

      WHERE ID = \'$_[0]\'

      [download]

      Code like this is subject to SQL injection. It can be also the source of some hard-to-catch mistakes. Let me chant one of the Monastery mantras: "Use Placeholders!"

     _  _ _  _  
(_|| | |(_|><
 _|
[reply]
[d/l]
[select]
Re: Binary File Handles and Scalars
by CombatSquirrel (Hermit) on Dec 18, 2003 at 20:55 UTC
    If you intended to slurp the whole file by $file = <INF>;, I think you are mistaken. At least this is what a short test on my computer gave me. binmode appearently does not set $/ (and actually I never expected it to). Try $file = do { local $/; <INF> }; instead. Maybe it works, but there might be other bugs as well. Good luck on your hunt!
    Hope this helped.
    CombatSquirrel.
    Entropy is the tendency of everything going to hell.
[reply]
[d/l]
[select]
Re: Binary File Handles and Scalars
by duff (Parson) on Dec 19, 2003 at 00:38 UTC

    Here's an excerpt from your create_record routine (slightly reformatted):

    while( $unique eq 'false' ) {
   $unique = 'true'; 
   $currentStatecode = rand( 99999999999 );
   $currentStatecode = floor( $currentStatecode );

   my $sqlQuery = "SELECT ID 
                   FROM IMAGEHOARD_MetaData 
                   WHERE ID = $currentStatecode";    

   my $query = $dbh->prepare( $sqlQuery );
   $query->execute() || die $dbh->errstr;

   if( $duplicateStatecode = $query->fetchrow_array() )
   {
      $unique = 'false';
   }
}

    [download]

    In english that would be

    1. Generate a random number
    2. See if that number exists in the database
    3. If so, go to step 1
    There are simpler methods. :-)

    One popular method is to use some sort of auto-increment field in the database. And if your database isn't driving the generation of the numbers, another method is to keep around a file that has the next unique number in it and each time it's used, increment the number and write it back to the file.

    duff

[reply]
[d/l]
[select]

Back to Seekers of Perl Wisdom