Connecting Tech Pros Worldwide Forums | Help | Site Map
bytes > topic > perl > answers

PERL Question, very strange one

Newbie
  
Join Date: Jul 2008
Posts: 1
#1: Jul 31 '08
We have moved our Database to another server. The server it was on used SQL 4 and the new one its on now uses SQL5

the only problem we can find is that when you attempt to delete a record from the DB the following happens:

When Deleting a record:

Fatal Error:
Can't call method "fetchrow_arrayref" on an undefined value at GT::SQL::File::delete_records line 275.
Stack Trace:
GT::Base (2704): main::fatal called at GT::SQL::File::delete_records line 275 with arguments
(Can't call method "fetchrow_arrayref" on an undefined value at GT::SQL::File::delete_records line 275.

***Line 275 refers to a file called FILE.PM***

Below is the File.pm:
Expand|Select|Wrap|Line Numbers
  1. package GT::SQL::File;
  2.  
  3. use strict;
  4. use GT::SQL;
  5. use GT::SQL::Base;
  6. use GT::AutoLoader;
  7. use GT::Base;
  8. use vars qw/@ISA $ERRORS $ATTRIBS $LOG $ERROR_MESSAGE $PERMIT_REFS $DEBUG/;
  9. @ISA     = qw/GT::SQL::Base/;
  10. $DEBUG   = 0;
  11. $ATTRIBS = {
  12.     db                => undef,
  13.     connect           => undef,
  14.     def_path          => undef,
  15.     table_name        => '',
  16.     table_object      => undef,
  17.     parent_table      => undef,
  18.     parent_table_name => undef,
  19.     file_save_in      => '',
  20.     file_log_path     => '',
  21.     file_name         => '',
  22.     file_path         => '',
  23.     file_fpath        => '',
  24.  
  25.     File_Name         => '',
  26.     ID                => '',
  27.     ForeignColName    => '',
  28.     ForeignColKey     => '',
  29.     File_Name         => '',
  30.     File_Directory    => '',
  31.     File_MimeType     => '',
  32.     File_Size         => '',
  33.     File_RelativePath => '',
  34.     File_Binary       => undef,
  35.     File_URL          => '',
  36.  
  37.     file_handle       => undef,
  38. };
  39.  
  40. # this allows calls to the individual attribs through GT::SQL::File::Fh method 
  41. $PERMIT_REFS = { map { $_ => 1 } keys %$ATTRIBS };
  42. $LOG = {
  43.     ADDED      => q~Added file %s to %s~,
  44.     REPLACE    => q~Replaced file %s to %s~,
  45.     REMOVED    => q~Deleted file %s~,
  46.     CREATEDDIR => q~Created directory %s~
  47. };
  48.  
  49. $ERROR_MESSAGE = 'GT::SQL';
  50. $ERRORS        = {
  51.     FILE_PARENTTBL   => q~Cannot load parent table! (%s)~,
  52.     FILE_FILETBL     => q~Cannot load file table! (%s)~,
  53.     FILE_NOGLOBREF   => q~Need a file glob reference in (%s)~,
  54.     FILE_FILETOOBIG  => q~File %s size: %i exceeds max file size value: %i~,
  55.     FILE_NOOPEN      => q~Problems opening %s for writing: %s~,
  56.     FILE_NOBINMODE   => q~Could not set %s to binmode: %s~,
  57.     FILE_NOCLOSE     => q~Had problems closing file %s: %s~,
  58.     FILE_NOFILE      => q~Could not find file related by ForeignColName => %s, ForeignColKey => %s: %s~,
  59.     FILE_FDELETE     => q~Problems deleting file %s: %s~,
  60.     FILE_NOUNLINK    => q~Could not unlink file %s: %s~,
  61.     FILE_PKREQ       => q~Primary Key required~,
  62.     FILE_PKSINGLE    => q~Composite Primary Keys not supported~,
  63.     FILE_DBDELETE    => q~Problems deleting record: %s~,
  64.     FILE_DBDELETEALL => q~Problems deleting all records~,
  65.     FILE_DBSELECT    => q~Problems selecting %s~,
  66.     FILE_NOREC       => q~Could not find file record~,
  67.     FILE_DBDROP      => q~Could not drop table %s: %s~,
  68.     FILE_DBEDITOR    => q~Could not get editor object for table %s: %s~,
  69.     FILE_DBUPDATE    => q~Problems updating record: %s~,
  70.     FILE_DBADD       => q~Problems adding record: %s~,
  71.     FILE_ILLEGALCHAR => q~Illegal character found in %s~,
  72.     FILE_NOOPEN      => q~Could not open %s because %s~,
  73.     FILE_NOWRITE     => q~Could not write data into %s because %s~,
  74.     FILE_MKDIRFAIL   => q~Couldn't create directory %s, because %s~,
  75.     FILE_UNKNOWNREF  => q~Reference call '%s' does not refer to a method in GT::SQL::File or an allowed attribute.~
  76. };
  77.  
  78. @$GT::SQL::ERRORS{keys %$ERRORS} = values %$ERRORS;
  79.  
  80. use constant ENCODE => 1;
  81.  
  82. $COMPILE{rescan} = __LINE__ . <<'END_OF_SUB';
  83. sub rescan {
  84. #-------------------------------------------------------------------------------
  85. # $obj->rescan();
  86. #----------
  87. # Rebuilds the database and attempts to ensure that database records are 
  88. # correct. This does not update the parent tables
  89. #
  90.     my ( $self ) = @_;
  91.  
  92.     my %errs  = ();
  93.     my %mods  = ();
  94.     my $tbl   = $self->_tbl()        or return $self->error('FILE_FILETBL', 'WARN', $GT::SQL::error);
  95.     my $ptbl  = $self->_parent_tbl() or return $self->error('FILE_PARENTTBL', 'WARN', $GT::SQL::error);
  96.     my %fcols = $ptbl->_file_cols();
  97.     my $sth   = $tbl->select()       or return $self->error('FILE_DBSELECT', 'WARN', $GT::SQL::error);
  98.     while ( my $href = $sth->fetchrow_hashref() ) {
  99.         my $fpath    = $self->_file_full_path( $href->{File_Name}, $href->{File_Directory}, $href->{ID}, $href->{ForeignColName}, $fcols{$href->{ForeignColName}}->{file_save_scheme});
  100.  
  101. # does this file still exist?
  102.         if ( ! -e $fpath ) {
  103.             $errs{$href->{ID}} = "NOFILE";
  104.             $self->error( 'FILE_NOFILE', 'WARN', $href->{ForeignColName}, $href->{ForeignColKey}, "FILENOEXIST");
  105.             $tbl->delete({ ForeignColName => $href->{ForeignColName}, ForeignColKey => $href->{ForeignColKey} });
  106.         }
  107.  
  108. # is it still the same file size?
  109.         elsif ( -s _ != $href->{File_Size}) {
  110.             $mods{$href->{ID}} = "NEWSIZE";
  111.             $href->{File_Size} = -s _;
  112.             $tbl->modify($href) or $errs{$href->{ID}} = "CANTMODIFY";
  113.         }
  114.     }
  115.  
  116.     return \%errs, \%mods;
  117. }
  118. END_OF_SUB
  119.  
  120. $COMPILE{log} = __LINE__ . <<'END_OF_SUB';
  121. sub log {
  122. #-------------------------------------------------------------------------------
  123. # $obj->log( $code, LIST );
  124. #----------
  125. # puts a log message into the logs file if the path has been set
  126. #
  127.     my $self     = shift;
  128.     my $code     = shift;
  129.     my $logpath  = $self->{file_log_path} or return;
  130.  
  131.     $self->_check_file_chars( $logpath ) or return $self->error( 'FILE_ILLEGALCHAR', 'WARN', $logpath );
  132.     CORE::open( LOG, ">>$logpath" );
  133.     print LOG sprintf($LOG->{$code}, @_);
  134.     close( LOG );
  135. }
  136. END_OF_SUB
  137.  
  138. $COMPILE{add_file} = __LINE__ . <<'END_OF_SUB';
  139. sub add_file {
  140. #-------------------------------------------------------------------------------
  141. # $obj->addfile( $new_record, $new_record_id )
  142. #----------
  143. # puts a file away into the database
  144. #
  145.     my ($self, $rec, $recid ) = @_;
  146.     return $self->replace_file( $rec, $recid );
  147. }
  148. END_OF_SUB
  149.  
  150. $COMPILE{replace_file} = __LINE__ . <<'END_OF_SUB';
  151. sub replace_file {
  152. # -------------------------------------------------------------------------------------- 
  153. # $obj->replace_file( $new_record, $new_record_id )
  154. #----------
  155. # puts a file away into the database, if a file already exists in place, delete it
  156. # 
  157.     my ($self, $rec, $recid ) = @_;
  158.     my $ptable     = $self->_parent_tbl()   or return $self->error( 'FILE_PARENTTBL', 'WARN', $GT::SQL::error );
  159.     my $fcols      = { $ptable->_file_cols() };
  160.     my $ftable     = $self->_tbl()          or return $self->error( 'FILE_FILETBL', 'WARN', $GT::SQL::error );
  161.  
  162.     foreach my $col_name ( keys %$fcols ) {
  163.  
  164. # basic tests
  165.         my $col    = $fcols->{$col_name};
  166.         my $ref    = ref $rec->{$col_name};
  167.         my $fh     = ( ( $ref and $ref !~ /SCALAR|ARRAY|HASH/ ) ? $rec->{$col_name} : $self->get_fh( $col_name, $rec ) ) or next; 
  168.         $col->{file_max_size} and ( ( -s $fh ) <= $col->{file_max_size} or return $self->error( 'FILE_FILETOOBIG', 'WARN', "$fh", -s $fh, $col->{file_max_size} ) );
  169.  
  170. # now, delete the previous entry
  171.         if ( $ftable->count({ ForeignColName => $col_name, ForeignColKey => $recid }) ) {
  172.             ref $fh or $rec->{$col_name."_del"} and $self->delete_file( $col_name, $recid, $col->{file_save_scheme} );
  173.         }
  174.  
  175. # find out if we're simply going to skip the action here
  176.         not ref $fh and not $fh eq 'delete' and next;
  177.  
  178. # get basic information setup
  179.         my @paths  = split m.(/|\\)., "$fh"; #/\
  180.         my $fname  = $rec->{$col_name."_filename"} || pop @paths;
  181.         my $fdir   = $col->{file_save_in};
  182.  
  183. # now that we have saved the information, add the record to the database
  184.         my $new_rec = $self->_file_getstats( $fname, $fdir, $col->{file_save_url}, -s $fh );
  185.  
  186.         $new_rec->{ForeignColName} = $col_name;
  187.         $new_rec->{ForeignColKey}  = $recid;
  188.         my $fid    = $ftable->add($new_rec) or return $self->error( 'FILE_DBADD', 'WARN', $GT::SQL::error );
  189.  
  190. # now try to save
  191.         my $fpath  = $self->_file_full_path( $fname, $fdir, $fid, $col_name, $col->{file_save_scheme}, ENCODE );
  192.  
  193.         $self->_check_file_chars($fpath) or return $self->error( 'FILE_ILLEGALCHAR', 'WARN', $fpath );
  194.         CORE::open( F, ">$fpath" )             or return $self->error( 'FILE_NOOPEN', 'WARN', $fpath, "$!" );
  195.         binmode(F)                       or return $self->error( 'FILE_NOBINMODE', 'WARN', 'output file', "$!" );
  196.         binmode $fh                      or return $self->error( 'FILE_NOBINMODE', 'WARN', 'input file', "$!" );
  197.         { local $/; print F <$fh>        or return $self->error( 'FILE_NOWRITE', 'WARN', $fpath, "$!" ); }
  198.         close F                          or return $self->error( 'FILE_NOCLOSE', 'WARN', $fpath, "$!" );
  199.  
  200.         $self->log( 'ADDED', $fname, $fdir );
  201.  
  202.     }
  203.  
  204.     return 1;
  205. }
  206. END_OF_SUB
  207.  
  208. $COMPILE{delete_file} = __LINE__ . <<'END_OF_SUB';
  209. sub delete_file {
  210. # -------------------------------------------------------------------------------------- 
  211. # $obj->delete_file( $col_name, $recid, $save_scheme );
  212. #----------
  213. # deletes the files and records associated 
  214. # function that is usually used internally
  215. #
  216.     my ( $self, $col_name, $recid, $save_scheme ) = @_;
  217.  
  218. # get the path to the file
  219.     my $tbl     = $self->_tbl();
  220.     my $rec     = $tbl->get({ ForeignColName => $col_name, ForeignColKey => $recid }) or return $self->error( 'FILE_NOFILE', 'WARN', $col_name, $recid, $GT::SQL::error );
  221.     my $fpath   = $self->_file_full_path(
  222.         $rec->{File_Name}, 
  223.         $rec->{File_Directory},
  224.         $rec->{ID},
  225.         $col_name,
  226.         $save_scheme,
  227.     );
  228.  
  229. # nuke the database record
  230.     $tbl->delete({ ForeignColName => $col_name, ForeignColKey => $recid }) or return $self->error( 'FILE_FDELETE', 'WARN', $rec->{File_Name}, $GT::SQL::error);
  231.  
  232. # nuke the file
  233.     unlink $fpath or return $self->error( 'FILE_NOUNLINK', 'WARN', $fpath, "$!" );
  234.  
  235.     $self->log( 'REMOVED', $rec->{File_Name} );
  236.  
  237.     return 1;
  238. }
  239. END_OF_SUB
  240.  
  241. $COMPILE{delete_records} = __LINE__ . <<'END_OF_SUB';
  242. sub delete_records {
  243. # -------------------------------------------------------------------------------------- 
  244. # $obj->delete_records( $condition )
  245. #----------
  246. # deletes all records addressed by the condition.
  247. # usually used in conjunction with a delete of the parent table elements. 
  248. # BUT must be called before parent table is deleted
  249. #
  250.     my ( $self, $where ) = @_;
  251.     my $ptbl  = $self->_parent_tbl() or return $self->error( 'FILE_PARENTTBL', 'WARN', $GT::SQL::error );
  252.     my @pk    = $ptbl->pk() or return $self->error( 'FILE_PKREQ', 'WARN' );
  253.     @pk == 1 or return $self->error( 'FILE_PKSINGLE', 'WARN' );
  254.     my $pk    = $pk[0];
  255.     my %fcols = $ptbl->_file_cols();
  256.     my $sth   = $ptbl->select( [ $pk ], $where );
  257.     my $tbl   = $self->_tbl() or return $self->error( 'FILE_FILETBL', 'WARN', $GT::SQL::error );
  258.  
  259.     while ( my $raref = $sth->fetchrow_arrayref() ) {
  260.         my $col_key = $raref->[0];
  261.         my $fsth = $tbl->select( [qw( ID ForeignColName File_Directory File_Name )], { ForeignColKey => $col_key });
  262.  
  263.         while ( my $aref = $fsth->fetchrow_arrayref() ) {
  264.             my $fpath = $self->_file_full_path( map( {$aref->[$_]} qw( 3 2 0 1 ) ), $fcols{$aref->[1]}->{file_save_scheme} ) or next;
  265.             unlink $fpath or $self->error( 'FILE_NOUNLINK', 'WARN', $fpath, "$!" ), next;
  266.             $self->log( 'REMOVED', $aref->[3] );
  267.  
  268.         }
  269.  
  270.         $tbl->delete({ ForeignColKey => $col_key }) or $self->error( 'FILE_DBDELETE', 'WARN', $GT::SQL::error );
  271.     }
  272.  
  273. }
  274. END_OF_SUB
  275.  
  276. $COMPILE{update_records} = __LINE__ . <<'END_OF_SUB';
  277. sub update_records {
  278. # -------------------------------------------------------------------------------------- 
  279. # $obj->update_records( $set, $condition );
  280. #----------
  281. # treated like $tbl->modify. will update all records with new files if required.
  282. # if multiple records are to receive copies of the file, multiple copies of the files
  283. # will be created on disk
  284. #
  285.     my $self     = shift;
  286.     my $set      = shift or return $self->error ('BADARGS', 'FATAL', "First argument to update_records must be \$set of what was set.");
  287.     my $cond     = shift or return $self->error ('BADARGS', 'FATAL', "Condition object must be passed as second argument.");
  288.  
  289. # init variables
  290.     my $ptbl     = $self->_parent_tbl();
  291.     my @pk       = $ptbl->pk() or return $self->error( 'FILE_PKREQ', 'WARN' );
  292.     @pk == 1                   or return $self->error( 'FILE_PKSINGLE', 'WARN' );
  293.     my %fcols    = $ptbl->_file_cols() or return $self->error ('BADARGS', 'FATAL', "update_records was called when there are no file columns, possibly corrupt def file.");
  294.     my %flocs    = ();
  295.  
  296. # find out which columns need to be updated
  297.     my @rcols    = grep( defined ( $set->{$_} || $set->{$_."_del"} ), keys %fcols ) or return 1; # Nothing to do.
  298.     my $tbl      = $self->_tbl();
  299.  
  300. # find out what records need to be updated
  301.     my $sth      = $ptbl->select( [ $pk[0] ], $cond );
  302.     while ( my $aref = $sth->fetchrow_arrayref() ) {
  303.         my $col_key = $aref->[0];
  304.  
  305. # now for each of the record's columns do what has to be done... delete, update, nothing?
  306.         foreach my $col ( @rcols ) {
  307.  
  308.             my $tmp   = $flocs{$col} ||= {};
  309.             my $fh    = $tmp->{name} ? do { CORE::open SOURCE, "<$tmp->{path}"; \*SOURCE } : $self->get_fh( $col, $set );
  310.  
  311.             ( not ref $fh and not $set->{$col."_del"} ) and ( $self->error( 'FILE_NOGLOBREF', 'WARN', $col ), next );
  312.  
  313.  
  314.             my $fname = $tmp->{name} ||= ( $set->{$col."_filename"} || $self->get_filename( "$fh" ) );
  315.             my $fdir  = $tmp->{dir}  ||= $fcols{$col}->{file_save_in};
  316.  
  317.             my $rec;
  318.             if ( not $rec = $tbl->get({ ForeignColName => $col, ForeignColKey => $col_key }) ) {
  319.                $rec       = $self->_file_getstats( $fname, $fdir, $fcols{$col}->{file_save_url}, ( -s $fh ) );
  320.                $rec->{ForeignColKey}  = $col_key;
  321.                $rec->{ForeignColName} = $col;
  322.                $rec->{ID} = $tbl->add( $rec ) or $self->error( 'FILE_DBADD', 'WARN', $GT::SQL::error ),next;
  323.             }
  324.             else {
  325.  
  326.                 my $fpath = $self->_file_full_path(
  327.                     $rec->{File_Name}, 
  328.                     $rec->{File_Directory},
  329.                     $rec->{ID},
  330.                     $col,
  331.                     $fcols{$col}->{file_save_scheme},
  332.                     ENCODE
  333.                 );
  334.  
  335.                 unlink $fpath or $self->error( 'FILE_NOUNLINK', 'WARN', $fpath, "$!" );
  336.  
  337.                 if ( ref $fh ) {
  338.                     my $trec  = $self->_file_getstats( $fname, $fdir, $fcols{$col}->{file_save_url}, ( -s $fh ) );
  339.                     for ( keys %$trec ) { $rec->{$_} = $trec->{$_} };
  340.                     $tbl->modify($rec) or ( $self->error( 'FILE_DBUPDATE', 'WARN', $GT::SQL::error ),next );
  341.                 }
  342.                 elsif ( $set->{$col."_del"} ) {
  343.                     $tbl->delete({ ForeignColName => $col, ForeignColKey => $col_key }) or $self->error( 'FILE_DBDELETE', 'WARN', $GT::SQL::error );
  344.                     next;
  345.                 };
  346.  
  347.             }
  348.  
  349.             my $fpath = $tmp->{path} ||= $self->_file_full_path(
  350.                 ( $rec->{File_Name} = $tmp->{name} ),
  351.                 $fdir,
  352.                 $rec->{ID},
  353.                 $col,
  354.                 $fcols{$col}->{file_save_scheme},
  355.                 ENCODE
  356.             );
  357.  
  358.             $self->_check_file_chars($fpath) or return $self->error( 'FILE_ILLEGALCHAR', 'WARN', $fpath );
  359.             CORE::open( F, ">$fpath" )             or return $self->error( 'FILE_NOOPEN', 'WARN', $fpath, "$!" );
  360.             binmode $fh                      or return $self->error( 'FILE_NOBINMODE', 'WARN', 'input file', "$!" );
  361.             binmode(F)                       or return $self->error( 'FILE_NOBINMODE', 'WARN', 'output file', "$!" );
  362.             { local $/; print F <$fh>        or return $self->error( 'FILE_NOWRITE', 'WARN', $fpath, "$!" ) }
  363.             close F                          or return $self->error( 'FILE_NOCLOSE', 'WARN', $fpath, "$!" );
  364.             close $fh;
  365.  
  366.             $self->log( 'ADDED', $rec->{File_Name}, $fdir );
  367.         }
  368.     }
  369.  
  370.     return 1;
  371. }
  372. END_OF_SUB
  373.  
  374. $COMPILE{_delete_record} = __LINE__ . <<'END_OF_SUB';
  375. sub _delete_record {
  376. # -------------------------------------------------------------------------------------- 
  377. # $obj->_delete_record( $columnname, $columnkey, $save_scheme );
  378. #----------
  379. # takes the parameters that identify a record in the _File uniquely and deletes 
  380. # record and file
  381. #
  382.     my $self     = shift;
  383.     my $col_name = shift or return;
  384.     my $col_key  = shift or return;
  385.     my $save_scheme = shift or return;;
  386.  
  387.     my $tbl      = $self->_tbl() or return $self->error( 'FILE_FILETBL', 'WARN', $GT::SQL::error );
  388.  
  389. # get the column information
  390.     my $href     = $tbl->get({ 
  391.         ForeignColName => $col_name, 
  392.         ForeignColKey  => $col_key,
  393.     }) or return $self->error( 'FILE_NOREC', 'WARN', $GT::SQL::error );
  394.  
  395.     my $ptbl     = $self->_parent_tbl() or return $self->error( 'FILE_PARENTTBL', 'WARN', $GT::SQL::error );
  396.     my %fcols    = $ptbl->_file_cols() or return;
  397.  
  398. # get the filename of the record
  399.     my $fname    = $self->_file_full_path( $href->{File_Name}, $href->{File_Directory}, $col_key, $col_name, $save_scheme );
  400.  
  401. # delete the file now that we have the file path
  402.     unlink $fname or return $self->error( 'FILE_NOUNLINK', 'WARN', $fname, "$!" );
  403.  
  404. # nuke the record
  405.     $tbl->delete({ 
  406.         ForeignColName => $col_name, 
  407.         ForeignColKey  => $col_key,
  408.     }) or return $self->error( 'FILE_DBDELETE', 'WARN', $GT::SQL::error );
  409.  
  410.     return 1;
  411. }
  412. END_OF_SUB
  413.  
  414. $COMPILE{delete_all} = __LINE__ . <<'END_OF_SUB';
  415. sub delete_all {
  416. # -------------------------------------------------------------------------------------- 
  417. # $obj->delete_call( $col_name )
  418. #----------
  419. # takes the name of a file column from the parent and deletes all files and records 
  420. # associated 
  421. #
  422.     my $self     = shift;
  423.     my $name     = shift;
  424.  
  425.     my $tbl      = $self->_tbl()        or return $self->error( 'FILE_FILETBL', 'WARN', $GT::SQL::error );
  426.     my $ptbl     = $self->_parent_tbl() or return $self->error( 'FILE_PARENTTBL', 'WARN', $GT::SQL::error );
  427.     my %fcols    = $ptbl->_file_cols();
  428.  
  429.     my $sth      = $tbl->select()       or return $self->error( 'FILE_DBSELECT', 'WARN', $GT::SQL::error );
  430.  
  431.     while ( my $href = $sth->fetchrow_hashref() ) {
  432.         my $fpath    = $self->_file_full_path( $href->{File_Name}, $href->{File_Directory}, $href->{ID}, $href->{ForeignColName}, $fcols{$href->{ForeignColName}}->{file_save_scheme});
  433.         unlink $fpath                   or return $self->error( 'FILE_NOUNLINK', 'WARN', $fpath, "$!" );
  434.     }
  435.  
  436.     $tbl->delete_all()                  or return $self->error( 'FILE_DBDELETEALL', 'WARN', $GT::SQL::error );
  437.  
  438.     return 1;
  439. }
  440. END_OF_SUB
  441.  
  442. $COMPILE{drop_col} = __LINE__ . <<'END_OF_SUB';
  443. sub drop_col {
  444. # -------------------------------------------------------------------------------------- 
  445. # $obj->drop_col( $name )
  446. # -----
  447. # $name : name of column to drop
  448. # -----
  449. # Will remove all files associated to that particular column. If there are no more
  450. # file columns, as it is no longer required, drop the file table .
  451. #
  452.     my $self     = shift;
  453.     my $name     = shift;
  454.  
  455.     my $tbl      = $self->_tbl() or return 1;
  456.     my $ptbl     = $self->_parent_tbl();
  457.     my %fcols    = $ptbl->_file_cols();
  458.     my $save_scheme = shift || $fcols{$name}->{file_save_scheme}; 
  459.     my $sth      = $tbl->select({ ForeignColName => $name }) or return $self->error( 'FILE_DBSELECT', 'WARN', $GT::SQL::error );
  460.  
  461.     while ( my $href = $sth->fetchrow_hashref() ) {
  462.         my $fpath    = $self->_file_full_path( $href->{File_Name}, $href->{File_Directory}, $href->{ID}, $name, $save_scheme );
  463.         unlink $fpath or $self->error( 'FILE_NOUNLINK', 'WARN', $fpath, "$!" );
  464.     }
  465.  
  466.     $tbl->delete({ ForeignColName => $name }) or return $self->error( 'FILE_DBDELETE', 'WARN', $GT::SQL::error );
  467.  
  468.     delete $fcols{$name};
  469.  
  470. # if there are no file based columns left, we can drop the file support table
  471.     require GT::SQL::Editor;
  472.     if ( not %fcols ) {
  473.         my $e     = GT::SQL::Editor->new( debug => $self->{_debug}, table => $tbl, connect => $self->{connect}) or return $self->error( 'FILE_DBEDITOR', 'WARN', $tbl->name(), $GT::SQL::error );
  474.         $e->drop_table('remove') or return $self->error( 'FILE_DBDROP', 'WARN', $tbl->name(), $GT::SQL::error );
  475.     }
  476.  
  477.     return 1;
  478. }
  479. END_OF_SUB
  480.  
  481. $COMPILE{drop_table} = __LINE__ . <<'END_OF_SUB';
  482. sub drop_table {
  483. # -------------------------------------------------------------------------------------- 
  484. # $obj->drop_table();
  485. #----------
  486. # deletes all files in the table and drops the table (including records)
  487. #
  488.     my $self    = shift;
  489.  
  490.     my $tbl      = $self->_tbl()  or return $self->error( 'FILE_FILETBL', 'WARN', $GT::SQL::error );
  491.     my %fcols    = $self->_parent_tbl()->_file_cols() or return;
  492.     my $sth      = $tbl->select() or return $self->error( 'FILE_DBSELECT', 'WARN', $GT::SQL::error );
  493.  
  494.     while ( my $href = $sth->fetchrow_hashref() ) {
  495.         my $save_scheme = $fcols{$href->{ForeignColName}}->{file_save_scheme};
  496.         my $fpath    = $self->_file_full_path( $href->{File_Name}, $href->{File_Directory}, $href->{ID}, $href->{ForeignColName}, $save_scheme );
  497.         unlink $fpath or return $self->error( 'FILE_NOUNLINK', 'WARN', $fpath, "$!" );
  498.     }
  499.  
  500.     require GT::SQL::Editor;
  501.     my $e     = GT::SQL::Editor->new( debug => $self->{_debug}, table => $tbl, connect => $self->{connect}) or return $self->error( 'FILE_DBEDITOR', 'WARN', $tbl->name(), $GT::SQL::error );
  502.     $e->drop_table() or return $self->error( 'FILE_DBDROP', 'WARN', $tbl->name(), $GT::SQL::error );
  503.  
  504.     return 1;
  505. }
  506. END_OF_SUB
  507.  
  508. $COMPILE{open} = __LINE__ . <<'END_OF_SUB';
  509. sub open {
  510. # -------------------------------------------------------------------------------------- 
  511. # $obj->open( $path_to_file );
  512. #----------
  513. # creates a GT::SQL::File::Fh Filehandle object
  514. #
  515.     my $self     = shift;
  516.     return GT::SQL::File::Fh->new(@_);
  517. }
  518. END_OF_SUB
  519.  
  520. $COMPILE{file_info} = __LINE__ . <<'END_OF_SUB';
  521. sub file_info {
  522. # -------------------------------------------------------------------------------------- 
  523. # $obj->file_info( $columnname, $primarykeyvalue );
  524. #----------
  525. # returns a filehandle to file stored in database. if there is none, returns 
  526. # undef with an error set in $GT::SQL::error
  527. #
  528.     my $self     = shift;
  529.     my $name     = shift or return;
  530.     my $key      = shift or return;
  531.  
  532.     my $tbl      = $self->_tbl() or return $self->error( 'FILE_PARENTTBL', 'WARN', $GT::SQL::error );
  533.     my $ptable   = $self->_parent_tbl() or return $self->error( 'FILE_FILETBL', 'WARN', $GT::SQL::error );
  534.     my %fcols    = $ptable->_file_cols();
  535.     my $file_rec = $tbl->get({ ForeignColName => $name , ForeignColKey => $key }) or return $self->error( 'FILE_NOFILE', 'WARN', $name, $key, $GT::SQL::error );
  536.  
  537.     my $fpath    = $self->_file_full_path(
  538.         $file_rec->{File_Name},
  539.         $file_rec->{File_Directory},
  540.         $file_rec->{ID},
  541.         $name,
  542.         $fcols{$name}->{file_save_scheme},
  543.         1
  544.     );
  545.     my $relpath  = $self->_file_full_path(
  546.         $file_rec->{File_Name},
  547.         '',
  548.         $file_rec->{ID},
  549.         $name,
  550.         $fcols{$name}->{file_save_scheme},
  551.         1
  552.     );
  553.     $file_rec->{File_RelativePath} = $relpath;
  554.     $file_rec->{File_URL} = $file_rec->{File_URL} . $relpath;
  555.  
  556.     return GT::SQL::File::Fh->new( $fpath, $file_rec );
  557. }
  558. END_OF_SUB
  559.  
  560. $COMPILE{_file_full_path} = __LINE__ . <<'END_OF_SUB';
  561. sub _file_full_path {
  562. # -------------------------------------------------------------------------------------- 
  563. # GT::SQL::File->_file_full_path( $fname, $fdir, $fid, $fcol, $save_scheme, $enc )
  564. #----------
  565. # $fname : filename
  566. # $fdir  : directory of file
  567. # $fid   : id of the parent record
  568. # $save_scheme : hashed or simple
  569. # $enc   : if we should encode the filepath or try to decode it
  570. #----------
  571. # returns the full path to the storeage location and name of the file the record
  572. # points at
  573. # the filename is typically encoded for the sake of special characters
  574. #
  575.     my ( $self, $fname, $fdir, $fid, $fcol, $save_scheme, $enc ) = @_;
  576.  
  577.     $save_scheme ||= 'HASHED';
  578.  
  579. # build paths to which we'll save all the information
  580.     $fdir     = $self->_filepath_munge( $fdir, $fid, $save_scheme );
  581.     $fname    = $self->_filename_munge( $fname, $fid, $fcol, $save_scheme, $enc );
  582.     my $fpath = "$fdir/$fname";
  583.  
  584.     return $fpath;
  585. }
  586. END_OF_SUB
  587.  
  588. $COMPILE{_file_getstats} = __LINE__ . <<'END_OF_SUB';
  589. sub _file_getstats {
  590. # -------------------------------------------------------------------------------------- 
  591. # GT::SQL::File->_file_getstats( $fname, $fpath, $fsize );
  592. #----------
  593. # starts to build a record to be used for inserts/modifies into 
  594. # the _File database table
  595. #
  596.     my ( $self, $fname, $fpath, $furl, $fsize ) = @_;
  597.     require GT::MIMETypes;
  598.     my $rec = {
  599.         File_Name      => $fname || '',
  600.         File_Directory => $fpath || '',
  601.         File_MimeType  => GT::MIMETypes->guess_type($fname),
  602.         File_Size      => defined $fsize ? $fsize : '',
  603.         File_URL       => $furl || ''
  604.     };
  605.  
  606.     return $rec;
  607. }
  608. END_OF_SUB
  609.  
  610. $COMPILE{_filename_munge} = __LINE__ . <<'END_OF_SUB';
  611. sub _filename_munge {
  612. # --------------------------------------------------------------------------------------
  613. # GT::SQL::File->_filename_munge( $fname, $fid, $fcol, $method, $enc )
  614. #----------
  615. # should only be called internally. changes the filename so it can be saved without
  616. # name conflicts
  617. #
  618.     my ( $self, $fname, $fid, $fcol, $method, $enc ) = @_;
  619.  
  620.     $fname = "$fid-$fname";
  621.  
  622.     require GT::CGI;
  623.     $fname = $enc ? GT::CGI->escape( $fname ) : GT::CGI->unescape( $fname );
  624.  
  625.     return $fname;
  626. }
  627. END_OF_SUB
  628.  
  629. $COMPILE{_filepath_munge} = __LINE__ . <<'END_OF_SUB';
  630. sub _filepath_munge {
  631. # --------------------------------------------------------------------------------------
  632. # GT::SQL::File->_filepath_munge();
  633. #----------
  634. # sets up the path directory where the file should be saved.
  635. #
  636.     my ( $self, $fpath, $fid, $method ) = @_;
  637.  
  638.     if ( $method =~ /hashed/i ) {
  639.         my $fletter =  ( reverse split //, $fid )[0];
  640.         my $nfpath  = "$fpath/$fletter";
  641.         if ( $fpath ) {
  642.             -e $nfpath or mkdir $nfpath, 0777 or return warn "Couldn't make directory $nfpath because $!";
  643.         }
  644.         $fpath = $nfpath;
  645.     } 
  646.  
  647.     return $fpath;
  648. }
  649. END_OF_SUB
  650.  
  651. $COMPILE{_check_file_chars} = __LINE__ . <<'END_OF_SUB';
  652. sub _check_file_chars {
  653. #-------------------------------------------------------------------------------
  654. # $obj->_check_file_chars( $fpath );
  655. #----------
  656. # return true if file path is ok
  657. #
  658.     return $_[1] =~ /^[\w\/\\\-\.\:%]+$/;
  659. }
  660. END_OF_SUB
  661.  
  662. $COMPILE{install} = __LINE__ . <<'END_OF_SUB';
  663. sub install {
  664. #-------------------------------------------------------------------------------
  665. # $obj->install( $options );
  666. #----------
  667. # creates the associate file parameter storage table
  668. # $tops is passed into the creation option database
  669. #
  670.     my ( $self, $opts ) = @_;
  671.  
  672. # get the name of the table
  673.     my $ptbl_name       = $opts->{parent_tablename} || $self->{parent_tablename};
  674.     my $tb_name         = $ptbl_name . '_Files';
  675.  
  676. # create the table
  677.     my $c               = $self->creator( $tb_name );
  678.     $c->cols({
  679.                 ID              => { pos => 1, type => 'INT',  not_null => 1, unsigned => 1, regex => '^\d+$' },
  680.                 ForeignColName  => { pos => 2, type => 'CHAR', size     => 50  }, 
  681.                 ForeignColKey   => { pos => 3, type => 'CHAR', size     => 50  }, 
  682.                 File_Name       => { pos => 4, type => 'CHAR', size     => 255 }, 
  683.                 File_Directory  => { pos => 5, type => 'CHAR', size     => 255 }, 
  684.                 File_MimeType   => { pos => 6, type => 'CHAR', size     => 50  }, 
  685.                 File_Size       => { pos => 7, type => 'INT',  not_null => 1, unsigned => 1, regex => '^\d+$' },
  686.                 File_URL        => { pos => 8, type => 'CHAR', size     => 255 },
  687.  
  688. # under consideration....
  689. #                File_Width      => { pos => 8, type => 'INT',  unsigned => 1, regex => '^\d+$' },                 
  690. #                File_Height     => { pos => 9, type => 'INT',  unsigned => 1, regex => '^\d+$' },                 
  691.  
  692.                 });
  693.     $c->pk('ID');
  694.     $c->ai('ID');
  695.     $c->index({ fk_lookup => [ 'ForeignColName', 'ForeignColKey' ] });
  696.     $c->create( $opts->{action} || 'force' ) or return;
  697.  
  698.     return 1;
  699.  
  700. }
  701. END_OF_SUB
  702.  
  703. $COMPILE{_tbl} = __LINE__ . <<'END_OF_SUB';
  704. sub _tbl {
  705. #-------------------------------------------------------------------------------
  706. # $obj->_tbl( $options )
  707. #----------
  708. # returns GT::SQL::Table for _File table
  709. #
  710.     my ( $self, $opts ) = @_;
  711.  
  712.     $self->{table_object} and return $self->{table_object};
  713.  
  714.     my $tbl = eval {
  715.         $self->new_table( $opts->{table} || ( 
  716.                 ( 
  717.                     $opts->{parent_tablename} 
  718.                     || $self->{parent_tablename} 
  719.                     || ( ref $self->{parent_table} ? 
  720.                             do {
  721.                                     my $prefix = $self->{connect}->{PREFIX};
  722.                                     my $name   = $self->{parent_table}->name();
  723.                                     $name      =~ s,^$prefix,,;
  724.                                     $name;
  725.                                 }
  726.                              : 
  727.                             ''  
  728.                        ) ) . '_Files' 
  729.                 ) ); 
  730.     };
  731.  
  732.     return $self->{table_object} = $tbl;
  733. }
  734. END_OF_SUB
  735.  
  736. $COMPILE{_parent_tbl} = __LINE__ . <<'END_OF_SUB';
  737. sub _parent_tbl {
  738. # -------------------------------------------------------------
  739. # $obj->_parent_tbl( $options );
  740. #----------
  741. # return the Table object for the parent table
  742. #
  743.     my ( $self, $opts ) = @_;
  744.     $self->{parent_table} and return $self->{parent_table};
  745.     return $self->_tbl( $self->{parent_table_name} || return );
  746. }
  747. END_OF_SUB
  748.  
  749. $COMPILE{File_Binary} = __LINE__ . <<'END_OF_SUB';
  750. sub File_Binary {
  751. # -------------------------------------------------------------------
  752. # just returns true if the file is of binary type
  753. #
  754.     my $self = shift;
  755.     defined $self->{File_Binary} and return $self->{File_Binary};
  756.     $self->{file_fpath} and return $self->{File_Binary} = -B $self->{file_fpath};
  757.     $self->{file_handle} and return $self->{File_Binary} = -B $self->{file_handle};
  758. }
  759. END_OF_SUB
  760.  
  761. $COMPILE{compare} = __LINE__ . <<'END_OF_SUB';
  762. sub compare {
  763. # -------------------------------------------------------------------
  764. # Do comparisions, uses as_string to get file name first.
  765. #
  766.     my $self  = shift;
  767.     my $value = shift;
  768.     return "$self" cmp $value;
  769. }
  770. END_OF_SUB
  771.  
  772. $COMPILE{get_filename} = __LINE__ . <<'END_OF_SUB';
  773. sub get_filename {
  774. # -------------------------------------------------------------------
  775.     my ($self, $fpath) = @_;
  776.     return +($fpath =~ /([^\\\/]+)$/)[0];
  777. }
  778. END_OF_SUB
  779.  
  780. $COMPILE{get_fh} = __LINE__ . <<'END_OF_SUB';
  781. sub get_fh {
  782. # -------------------------------------------------------------------
  783.     my ($self, $col, $values) = @_;
  784.     $values ||= {};
  785.  
  786.     ref $values->{$col} and ref $values->{$col} ne 'SCALAR' and return $values->{$col};
  787.     ref $values->{$col} eq 'SCALAR' and -f ${$values->{$col}} and -r _ and return GT::SQL::File->open(${$values->{$col}});
  788.     return;
  789. }
  790. END_OF_SUB
  791.  
  792. $COMPILE{pre_file_actions} = __LINE__ . <<'END_OF_SUB';
  793. sub pre_file_actions {
  794. # -------------------------------------------------------------------
  795. # GT::SQL::File->pre_file_actions();
  796. #----------
  797. # called before Table::insert or Table::update to setup all the
  798. # columns and run tests to ensure the file is appropropriate
  799. #
  800.     my ( $package, $fcols, $set, $opts ) = @_;
  801.  
  802. # check to make sure we have records
  803.     foreach my $col_name ( keys %$fcols ) {
  804.         defined $set->{$set} or next;
  805.         ref $set->{$set} and next;
  806.         $set->{$set} and -e $set->{$set} and next;
  807.         delete $set->{$set};
  808.     }
  809.  
  810. # now check to make sure records are of appropriate size
  811.     foreach my $col_name ( grep $set->{$_}, keys %$fcols ) {
  812.         if ( my $max_size = $fcols->{$col_name}->{file_max_size} || 0 ) {
  813.             if ( $max_size < -s $set->{$col_name} ) {
  814.                 return $package->error( 'FILE_FILETOOBIG', 'WARN', "$set->{$col_name}", -s $set->{$col_name}, $max_size );
  815.             }
  816.         }
  817.     }
  818.  
  819. # just make backup files
  820.     my %fset;
  821.     foreach my $key ( keys %$fcols ) {
  822.         if ( $set->{$key} ) {
  823.             my $tmp  = $set->{$key};
  824.             $set->{$key} = $opts->{$key."_filename"} || $package->get_filename("$set->{$key}");
  825.             $fset{$key} = $tmp;
  826.         }
  827.         if ( my $val = $set->{$key."_del"} ) {
  828.             $fset{$key."_del"} = $val;
  829.         }
  830.     };
  831.  
  832. # Remove any that have been deleted.
  833.     foreach my $key ( keys %$fcols ) {
  834.         if ( not $set->{$key."_del"} and exists $set->{$key} and not $set->{$key} ) {
  835.             delete $set->{$key};
  836.         }
  837.         elsif ( $set->{$key."_del"} ) {
  838.             $set->{$key} = '';
  839.             delete $set->{$key."_del"};
  840.         }
  841.     }
  842.  
  843.     return wantarray ? %fset : \%fset;
  844. }
  845. END_OF_SUB
  846.  
  847. package GT::SQL::File::Fh;
  848.  
  849. # ===================================================================
  850. # Magic File Handle, lets you print the file name, but also act like
  851. # a file handle for read, just like CGI.pm.
  852. #
  853. use strict qw/vars subs/;
  854. no strict 'refs';
  855. use vars qw/$FH %FH_Conns $AUTOLOAD/;
  856. use overload
  857.     '""'  => \&as_string,
  858.     'cmp' => \&compare,
  859.     'fallback' => 1;
  860. $FH       = 1;
  861. %FH_Conns = ();
  862.  
  863. sub open {
  864. # -------------------------------------------------------------------
  865. # Create a new filehandle based on a counter, and the filename.
  866. #
  867.     goto &GT::SQL::File::Fh::new;
  868. }
  869.  
  870. sub new {
  871. # -------------------------------------------------------------------
  872. # Create a new filehandle based on a counter, and the filename.
  873. #
  874.     my ( $pkg, $file, $opt ) = @_;
  875.     $file or return;
  876.  
  877.     my $fid     = $FH++;
  878.     my $fname   = sprintf( "FH%05d", $fid );
  879.     my $fh      = \do { local *{$fname}; *{$fname} };
  880.  
  881.     CORE::open ($fh, $file || '') or return;
  882.  
  883.     bless $fh, $pkg; 
  884.  
  885.     my $obj     = GT::SQL::File->new({ 
  886.                                     %{$opt||{}}, 
  887.                                     file_name  => GT::SQL::File->get_filename( $file ),
  888.                                     file_fpath => $file,
  889.                                 }) or return;
  890.  
  891.     $obj->File_Binary() and binmode $fh;
  892.  
  893.     $FH_Conns{$$fh} = $obj;
  894.  
  895.     return $fh;
  896. }
  897.  
  898. sub as_string {
  899. # -------------------------------------------------------------------
  900. # Return the filename, strip off leading junk first.
  901. #
  902.     my $self = shift;
  903.     return $FH_Conns{$$self}->{file_fpath};
  904. }
  905.  
  906. sub compare {
  907. # -------------------------------------------------------------------
  908. # Do comparisions, uses as_string to get file name first.
  909. #
  910.     my $self  = shift;
  911.     my $value = shift;
  912.     return "$self" cmp $value;
  913. }
  914.  
  915.  
  916. sub AUTOLOAD {
  917. # -------------------------------------------------------------------
  918.     my $self         = shift;
  919.     my ($pkg, $what) = $AUTOLOAD =~ /^(.*)::([^:]+)$/;
  920.  
  921.     my $fh_ref = $FH_Conns{$$self} or return;
  922.  
  923.     if ( $fh_ref->can($what) ) {
  924.         return $fh_ref->$what(@_)
  925.     }
  926.     elsif ($GT::SQL::File::PERMIT_REFS->{$what}) {
  927.         $fh_ref->{$what} = shift if @_;
  928.         return $fh_ref->{$what};
  929.     }
  930.     else {
  931.         return $fh_ref->error('FILE_UNKNOWNREF', 'FATAL', $what);
  932.     }
  933. }
  934.  
  935. sub DESTROY {
  936. # -------------------------------------------------------------------
  937. # Close file handle.
  938. #
  939.     my $self = shift;
  940.     delete $FH_Conns{$$self};
  941.     close $self;
  942. }
  943.  
  944. 1;
  945.  
  946. __END__
  947.  
  948.  
Expand|Select|Wrap|Line Numbers
  1. =head1 NAME
  2.  
  3. GT::SQL::File - adds file upload and download abilities to GT::SQL
  4.  
  5. GT::SQL::File::Fh - basic file object
  6.  
  7. =head1 DESCRIPTION
  8.  
  9. GT::SQL::File is not created directly by the user. This module is an
  10. internal module for GT::SQL to provide the abilty to upload/download 
  11. files into a database column (or so it seems).
  12.  
  13. GT::SQL::File::Fh is often accessed by the user as well as created 
  14. by the user whenever the user wants to store a file in the database. 
  15.  
  16. =head2 Creating a new FILE Column
  17.  
  18. When a new table is created or a column is converted into 'FILE' 
  19. type, two things are created. First a column of type text which will 
  20. save the name of the file that is being stored. Secondly, a 
  21. piggy-back table will be greated under the name 
  22. "parent_table_name_File". This new table will store the location of 
  23. the uploaded/stored file and various associated file attributes.
  24.  
  25. To create a new file table, include a column something like the
  26. following.
  27.  
  28.     File_Col_Name => { 
  29.  
  30.                 # common parameters
  31.                        pos  => 2, 
  32.                        type => 'FILE', 
  33.  
  34.                 # location of the directory where
  35.                 # all the files should be saved
  36.                        file_save_in => '/tmp', 
  37.  
  38.                 # the method all the files are saved
  39.                 # 'hashed', or 'simple'
  40.                 #
  41.                 # Defaults to hashed, and stores files in:
  42.                 #   file_save_in/hashed_letter/ID
  43.                 # Simple stores files in:
  44.                 #   file_save_in/ID_OwnName.OwnExt
  45.                        file_save_scheme => 'hashed',
  46.                      } ...
  47.  
  48. =head2 Inserting into the Column
  49.  
  50. Once you have the table created, to insert:
  51.  
  52.     # Include all the modules
  53.     use GT::SQL;
  54.     use GT::SQL::File;
  55.  
  56.     # First create a file object pointing to the file
  57.     $f = GT::SQL::File->open('/path/to/file.txt');
  58.  
  59.     # Then create a table object
  60.     $DB = GT::SQL->new('path/to/defs');
  61.     $tbl = $DB->table();
  62.  
  63.     # Create the record
  64.     # the file field can also be GT::CGI::Fh type
  65.     $rec = {
  66.         File_Column => $f,
  67.         # ... and all the other columns
  68.     };
  69.  
  70. # optionally, if you know the path to the file, you can provide
  71. # a scalar ref of the path and the module will autoload
  72. # the values
  73. # simple scalar values will be dropped
  74.     $rec = {
  75.         File_Column => \"/path/to/file.txt"
  76.         # ... and all the other columns
  77.     };
  78.  
  79.     # Then to store the file
  80.     $id = $tbl->add( $rec );
  81.  
  82. =head2 Retreiving from Column
  83.  
  84. When a file has been stored. A standard select will only return
  85. the name of the file.
  86.  
  87. To get a filehandle, taking the previous example, if we know the
  88. unique id, you can do the following.
  89.  
  90.     $fh = $tbl->file_info( 'File_Column', $id );
  91.  
  92. You can use this file handle just like any other, however hidden
  93. behind are special functions that can be used as follows:
  94.  
  95.     print "Content-type: ", $fh->File_MimeType(), "\n\n";
  96.     print <$fh>;
  97.  
  98. The following is a partial list of special functions you may access.
  99.  
  100.  
  101.     Method             Returns
  102.     ------             -------
  103.     File_Name          the basic filename
  104.     File_Directory     path to the file
  105.     File_MimeType      mimetype of the file
  106.     File_Size          site of the file
  107.     File_RelativePath  the permuted file and directory without root
  108.     File_URL           if possible, the URL to the requested file
  109.  
  110. =head1 COPYRIGHT
  111.  
  112. Copyright (c) 2004 Gossamer Threads Inc.  All Rights Reserved.
  113. http://www.gossamer-threads.com/
  114.  
  115. =head1 VERSION
  116.  
  117. Revision: $Id: File.pm,v 1.60 2004/08/28 03:53:43 jagerman Exp $
  118.  
  119. =cut

numberwhun's Avatar
Site Moderator
  
Join Date: May 2007
Location: New Hampshire
Posts: 2,573
#2: Oct 5 '08

re: PERL Question, very strange one

If you are still having this issue, did the machine that the perl script resides on change as well? If so, is the version of Perl different? And, if that is the case, are all the necessary Perl modules installed or did you just copy over the .pm files?

Regards,

Jeff
Reply

« previous question | next question »

Similar Perl bytes

/bytes/development

/bytes/it

Forums
Visit our community forums for general discussions and latest on Bytes

Our staff and community areas have moved to bytes.com/forums/

/bytes/about

We are a network of experts and professionals in IT and software development that help one another with answers to tough questions and share insights. Get the best answers to your questions from over 226,533 network members.

dev questions:
algorithms | asp | asp.net | c/c++ | coldfusion | c# | flash | html/css | java | javascript |
mobile dev | .net | perl | php | python | ruby | software dev | vb.net | visual basic | xml
it questions:
access | apache | careers | db2 | iis | macosx | mysql | networking | oracle | postgresql | sql server | unix | windows

About Bytes | Copyright 1995-2009 BYTES. All rights Reserved