By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
429,589 Members | 1,194 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 429,589 IT Pros & Developers. It's quick & easy.

PERL Question, very strange one

P: 1
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.     my ($self, $rec, $recid ) = @_;
  157.     my $ptable     = $self->_parent_tbl()   or return $self->error( 'FILE_PARENTTBL', 'WARN', $GT::SQL::error );
  158.     my $fcols      = { $ptable->_file_cols() };
  159.     my $ftable     = $self->_tbl()          or return $self->error( 'FILE_FILETBL', 'WARN', $GT::SQL::error );
  160.  
  161.     foreach my $col_name ( keys %$fcols ) {
  162.  
  163. # basic tests
  164.         my $col    = $fcols->{$col_name};
  165.         my $ref    = ref $rec->{$col_name};
  166.         my $fh     = ( ( $ref and $ref !~ /SCALAR|ARRAY|HASH/ ) ? $rec->{$col_name} : $self->get_fh( $col_name, $rec ) ) or next; 
  167.         $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} ) );
  168.  
  169. # now, delete the previous entry
  170.         if ( $ftable->count({ ForeignColName => $col_name, ForeignColKey => $recid }) ) {
  171.             ref $fh or $rec->{$col_name."_del"} and $self->delete_file( $col_name, $recid, $col->{file_save_scheme} );
  172.         }
  173.  
  174. # find out if we're simply going to skip the action here
  175.         not ref $fh and not $fh eq 'delete' and next;
  176.  
  177. # get basic information setup
  178.         my @paths  = split m.(/|\\)., "$fh"; #/\
  179.         my $fname  = $rec->{$col_name."_filename"} || pop @paths;
  180.         my $fdir   = $col->{file_save_in};
  181.  
  182. # now that we have saved the information, add the record to the database
  183.         my $new_rec = $self->_file_getstats( $fname, $fdir, $col->{file_save_url}, -s $fh );
  184.  
  185.         $new_rec->{ForeignColName} = $col_name;
  186.         $new_rec->{ForeignColKey}  = $recid;
  187.         my $fid    = $ftable->add($new_rec) or return $self->error( 'FILE_DBADD', 'WARN', $GT::SQL::error );
  188.  
  189. # now try to save
  190.         my $fpath  = $self->_file_full_path( $fname, $fdir, $fid, $col_name, $col->{file_save_scheme}, ENCODE );
  191.  
  192.         $self->_check_file_chars($fpath) or return $self->error( 'FILE_ILLEGALCHAR', 'WARN', $fpath );
  193.         CORE::open( F, ">$fpath" )             or return $self->error( 'FILE_NOOPEN', 'WARN', $fpath, "$!" );
  194.         binmode(F)                       or return $self->error( 'FILE_NOBINMODE', 'WARN', 'output file', "$!" );
  195.         binmode $fh                      or return $self->error( 'FILE_NOBINMODE', 'WARN', 'input file', "$!" );
  196.         { local $/; print F <$fh>        or return $self->error( 'FILE_NOWRITE', 'WARN', $fpath, "$!" ); }
  197.         close F                          or return $self->error( 'FILE_NOCLOSE', 'WARN', $fpath, "$!" );
  198.  
  199.         $self->log( 'ADDED', $fname, $fdir );
  200.  
  201.     }
  202.  
  203.     return 1;
  204. }
  205. END_OF_SUB
  206.  
  207. $COMPILE{delete_file} = __LINE__ . <<'END_OF_SUB';
  208. sub delete_file {
  209. # -------------------------------------------------------------------------------------- 
  210. # $obj->delete_file( $col_name, $recid, $save_scheme );
  211. #----------
  212. # deletes the files and records associated 
  213. # function that is usually used internally
  214. #
  215.     my ( $self, $col_name, $recid, $save_scheme ) = @_;
  216.  
  217. # get the path to the file
  218.     my $tbl     = $self->_tbl();
  219.     my $rec     = $tbl->get({ ForeignColName => $col_name, ForeignColKey => $recid }) or return $self->error( 'FILE_NOFILE', 'WARN', $col_name, $recid, $GT::SQL::error );
  220.     my $fpath   = $self->_file_full_path(
  221.         $rec->{File_Name}, 
  222.         $rec->{File_Directory},
  223.         $rec->{ID},
  224.         $col_name,
  225.         $save_scheme,
  226.     );
  227.  
  228. # nuke the database record
  229.     $tbl->delete({ ForeignColName => $col_name, ForeignColKey => $recid }) or return $self->error( 'FILE_FDELETE', 'WARN', $rec->{File_Name}, $GT::SQL::error);
  230.  
  231. # nuke the file
  232.     unlink $fpath or return $self->error( 'FILE_NOUNLINK', 'WARN', $fpath, "$!" );
  233.  
  234.     $self->log( 'REMOVED', $rec->{File_Name} );
  235.  
  236.     return 1;
  237. }
  238. END_OF_SUB
  239.  
  240. $COMPILE{delete_records} = __LINE__ . <<'END_OF_SUB';
  241. sub delete_records {
  242. # -------------------------------------------------------------------------------------- 
  243. # $obj->delete_records( $condition )
  244. #----------
  245. # deletes all records addressed by the condition.
  246. # usually used in conjunction with a delete of the parent table elements. 
  247. # BUT must be called before parent table is deleted
  248. #
  249.     my ( $self, $where ) = @_;
  250.     my $ptbl  = $self->_parent_tbl() or return $self->error( 'FILE_PARENTTBL', 'WARN', $GT::SQL::error );
  251.     my @pk    = $ptbl->pk() or return $self->error( 'FILE_PKREQ', 'WARN' );
  252.     @pk == 1 or return $self->error( 'FILE_PKSINGLE', 'WARN' );
  253.     my $pk    = $pk[0];
  254.     my %fcols = $ptbl->_file_cols();
  255.     my $sth   = $ptbl->select( [ $pk ], $where );
  256.     my $tbl   = $self->_tbl() or return $self->error( 'FILE_FILETBL', 'WARN', $GT::SQL::error );
  257.  
  258.     while ( my $raref = $sth->fetchrow_arrayref() ) {
  259.         my $col_key = $raref->[0];
  260.         my $fsth = $tbl->select( [qw( ID ForeignColName File_Directory File_Name )], { ForeignColKey => $col_key });
  261.  
  262.         while ( my $aref = $fsth->fetchrow_arrayref() ) {
  263.             my $fpath = $self->_file_full_path( map( {$aref->[$_]} qw( 3 2 0 1 ) ), $fcols{$aref->[1]}->{file_save_scheme} ) or next;
  264.             unlink $fpath or $self->error( 'FILE_NOUNLINK', 'WARN', $fpath, "$!" ), next;
  265.             $self->log( 'REMOVED', $aref->[3] );
  266.  
  267.         }
  268.  
  269.         $tbl->delete({ ForeignColKey => $col_key }) or $self->error( 'FILE_DBDELETE', 'WARN', $GT::SQL::error );
  270.     }
  271.  
  272. }
  273. END_OF_SUB
  274.  
  275. $COMPILE{update_records} = __LINE__ . <<'END_OF_SUB';
  276. sub update_records {
  277. # -------------------------------------------------------------------------------------- 
  278. # $obj->update_records( $set, $condition );
  279. #----------
  280. # treated like $tbl->modify. will update all records with new files if required.
  281. # if multiple records are to receive copies of the file, multiple copies of the files
  282. # will be created on disk
  283. #
  284.     my $self     = shift;
  285.     my $set      = shift or return $self->error ('BADARGS', 'FATAL', "First argument to update_records must be \$set of what was set.");
  286.     my $cond     = shift or return $self->error ('BADARGS', 'FATAL', "Condition object must be passed as second argument.");
  287.  
  288. # init variables
  289.     my $ptbl     = $self->_parent_tbl();
  290.     my @pk       = $ptbl->pk() or return $self->error( 'FILE_PKREQ', 'WARN' );
  291.     @pk == 1                   or return $self->error( 'FILE_PKSINGLE', 'WARN' );
  292.     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.");
  293.     my %flocs    = ();
  294.  
  295. # find out which columns need to be updated
  296.     my @rcols    = grep( defined ( $set->{$_} || $set->{$_."_del"} ), keys %fcols ) or return 1; # Nothing to do.
  297.     my $tbl      = $self->_tbl();
  298.  
  299. # find out what records need to be updated
  300.     my $sth      = $ptbl->select( [ $pk[0] ], $cond );
  301.     while ( my $aref = $sth->fetchrow_arrayref() ) {
  302.         my $col_key = $aref->[0];
  303.  
  304. # now for each of the record's columns do what has to be done... delete, update, nothing?
  305.         foreach my $col ( @rcols ) {
  306.  
  307.             my $tmp   = $flocs{$col} ||= {};
  308.             my $fh    = $tmp->{name} ? do { CORE::open SOURCE, "<$tmp->{path}"; \*SOURCE } : $self->get_fh( $col, $set );
  309.  
  310.             ( not ref $fh and not $set->{$col."_del"} ) and ( $self->error( 'FILE_NOGLOBREF', 'WARN', $col ), next );
  311.  
  312.  
  313.             my $fname = $tmp->{name} ||= ( $set->{$col."_filename"} || $self->get_filename( "$fh" ) );
  314.             my $fdir  = $tmp->{dir}  ||= $fcols{$col}->{file_save_in};
  315.  
  316.             my $rec;
  317.             if ( not $rec = $tbl->get({ ForeignColName => $col, ForeignColKey => $col_key }) ) {
  318.                $rec       = $self->_file_getstats( $fname, $fdir, $fcols{$col}->{file_save_url}, ( -s $fh ) );
  319.                $rec->{ForeignColKey}  = $col_key;
  320.                $rec->{ForeignColName} = $col;
  321.                $rec->{ID} = $tbl->add( $rec ) or $self->error( 'FILE_DBADD', 'WARN', $GT::SQL::error ),next;
  322.             }
  323.             else {
  324.  
  325.                 my $fpath = $self->_file_full_path(
  326.                     $rec->{File_Name}, 
  327.                     $rec->{File_Directory},
  328.                     $rec->{ID},
  329.                     $col,
  330.                     $fcols{$col}->{file_save_scheme},
  331.                     ENCODE
  332.                 );
  333.  
  334.                 unlink $fpath or $self->error( 'FILE_NOUNLINK', 'WARN', $fpath, "$!" );
  335.  
  336.                 if ( ref $fh ) {
  337.                     my $trec  = $self->_file_getstats( $fname, $fdir, $fcols{$col}->{file_save_url}, ( -s $fh ) );
  338.                     for ( keys %$trec ) { $rec->{$_} = $trec->{$_} };
  339.                     $tbl->modify($rec) or ( $self->error( 'FILE_DBUPDATE', 'WARN', $GT::SQL::error ),next );
  340.                 }
  341.                 elsif ( $set->{$col."_del"} ) {
  342.                     $tbl->delete({ ForeignColName => $col, ForeignColKey => $col_key }) or $self->error( 'FILE_DBDELETE', 'WARN', $GT::SQL::error );
  343.                     next;
  344.                 };
  345.  
  346.             }
  347.  
  348.             my $fpath = $tmp->{path} ||= $self->_file_full_path(
  349.                 ( $rec->{File_Name} = $tmp->{name} ),
  350.                 $fdir,
  351.                 $rec->{ID},
  352.                 $col,
  353.                 $fcols{$col}->{file_save_scheme},
  354.                 ENCODE
  355.             );
  356.  
  357.             $self->_check_file_chars($fpath) or return $self->error( 'FILE_ILLEGALCHAR', 'WARN', $fpath );
  358.             CORE::open( F, ">$fpath" )             or return $self->error( 'FILE_NOOPEN', 'WARN', $fpath, "$!" );
  359.             binmode $fh                      or return $self->error( 'FILE_NOBINMODE', 'WARN', 'input file', "$!" );
  360.             binmode(F)                       or return $self->error( 'FILE_NOBINMODE', 'WARN', 'output file', "$!" );
  361.             { local $/; print F <$fh>        or return $self->error( 'FILE_NOWRITE', 'WARN', $fpath, "$!" ) }
  362.             close F                          or return $self->error( 'FILE_NOCLOSE', 'WARN', $fpath, "$!" );
  363.             close $fh;
  364.  
  365.             $self->log( 'ADDED', $rec->{File_Name}, $fdir );
  366.         }
  367.     }
  368.  
  369.     return 1;
  370. }
  371. END_OF_SUB
  372.  
  373. $COMPILE{_delete_record} = __LINE__ . <<'END_OF_SUB';
  374. sub _delete_record {
  375. # -------------------------------------------------------------------------------------- 
  376. # $obj->_delete_record( $columnname, $columnkey, $save_scheme );
  377. #----------
  378. # takes the parameters that identify a record in the _File uniquely and deletes 
  379. # record and file
  380. #
  381.     my $self     = shift;
  382.     my $col_name = shift or return;
  383.     my $col_key  = shift or return;
  384.     my $save_scheme = shift or return;;
  385.  
  386.     my $tbl      = $self->_tbl() or return $self->error( 'FILE_FILETBL', 'WARN', $GT::SQL::error );
  387.  
  388. # get the column information
  389.     my $href     = $tbl->get({ 
  390.         ForeignColName => $col_name, 
  391.         ForeignColKey  => $col_key,
  392.     }) or return $self->error( 'FILE_NOREC', 'WARN', $GT::SQL::error );
  393.  
  394.     my $ptbl     = $self->_parent_tbl() or return $self->error( 'FILE_PARENTTBL', 'WARN', $GT::SQL::error );
  395.     my %fcols    = $ptbl->_file_cols() or return;
  396.  
  397. # get the filename of the record
  398.     my $fname    = $self->_file_full_path( $href->{File_Name}, $href->{File_Directory}, $col_key, $col_name, $save_scheme );
  399.  
  400. # delete the file now that we have the file path
  401.     unlink $fname or return $self->error( 'FILE_NOUNLINK', 'WARN', $fname, "$!" );
  402.  
  403. # nuke the record
  404.     $tbl->delete({ 
  405.         ForeignColName => $col_name, 
  406.         ForeignColKey  => $col_key,
  407.     }) or return $self->error( 'FILE_DBDELETE', 'WARN', $GT::SQL::error );
  408.  
  409.     return 1;
  410. }
  411. END_OF_SUB
  412.  
  413. $COMPILE{delete_all} = __LINE__ . <<'END_OF_SUB';
  414. sub delete_all {
  415. # -------------------------------------------------------------------------------------- 
  416. # $obj->delete_call( $col_name )
  417. #----------
  418. # takes the name of a file column from the parent and deletes all files and records 
  419. # associated 
  420. #
  421.     my $self     = shift;
  422.     my $name     = shift;
  423.  
  424.     my $tbl      = $self->_tbl()        or return $self->error( 'FILE_FILETBL', 'WARN', $GT::SQL::error );
  425.     my $ptbl     = $self->_parent_tbl() or return $self->error( 'FILE_PARENTTBL', 'WARN', $GT::SQL::error );
  426.     my %fcols    = $ptbl->_file_cols();
  427.  
  428.     my $sth      = $tbl->select()       or return $self->error( 'FILE_DBSELECT', 'WARN', $GT::SQL::error );
  429.  
  430.     while ( my $href = $sth->fetchrow_hashref() ) {
  431.         my $fpath    = $self->_file_full_path( $href->{File_Name}, $href->{File_Directory}, $href->{ID}, $href->{ForeignColName}, $fcols{$href->{ForeignColName}}->{file_save_scheme});
  432.         unlink $fpath                   or return $self->error( 'FILE_NOUNLINK', 'WARN', $fpath, "$!" );
  433.     }
  434.  
  435.     $tbl->delete_all()                  or return $self->error( 'FILE_DBDELETEALL', 'WARN', $GT::SQL::error );
  436.  
  437.     return 1;
  438. }
  439. END_OF_SUB
  440.  
  441. $COMPILE{drop_col} = __LINE__ . <<'END_OF_SUB';
  442. sub drop_col {
  443. # -------------------------------------------------------------------------------------- 
  444. # $obj->drop_col( $name )
  445. # -----
  446. # $name : name of column to drop
  447. # -----
  448. # Will remove all files associated to that particular column. If there are no more
  449. # file columns, as it is no longer required, drop the file table .
  450. #
  451.     my $self     = shift;
  452.     my $name     = shift;
  453.  
  454.     my $tbl      = $self->_tbl() or return 1;
  455.     my $ptbl     = $self->_parent_tbl();
  456.     my %fcols    = $ptbl->_file_cols();
  457.     my $save_scheme = shift || $fcols{$name}->{file_save_scheme}; 
  458.     my $sth      = $tbl->select({ ForeignColName => $name }) or return $self->error( 'FILE_DBSELECT', 'WARN', $GT::SQL::error );
  459.  
  460.     while ( my $href = $sth->fetchrow_hashref() ) {
  461.         my $fpath    = $self->_file_full_path( $href->{File_Name}, $href->{File_Directory}, $href->{ID}, $name, $save_scheme );
  462.         unlink $fpath or $self->error( 'FILE_NOUNLINK', 'WARN', $fpath, "$!" );
  463.     }
  464.  
  465.     $tbl->delete({ ForeignColName => $name }) or return $self->error( 'FILE_DBDELETE', 'WARN', $GT::SQL::error );
  466.  
  467.     delete $fcols{$name};
  468.  
  469. # if there are no file based columns left, we can drop the file support table
  470.     require GT::SQL::Editor;
  471.     if ( not %fcols ) {
  472.         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 );
  473.         $e->drop_table('remove') or return $self->error( 'FILE_DBDROP', 'WARN', $tbl->name(), $GT::SQL::error );
  474.     }
  475.  
  476.     return 1;
  477. }
  478. END_OF_SUB
  479.  
  480. $COMPILE{drop_table} = __LINE__ . <<'END_OF_SUB';
  481. sub drop_table {
  482. # -------------------------------------------------------------------------------------- 
  483. # $obj->drop_table();
  484. #----------
  485. # deletes all files in the table and drops the table (including records)
  486. #
  487.     my $self    = shift;
  488.  
  489.     my $tbl      = $self->_tbl()  or return $self->error( 'FILE_FILETBL', 'WARN', $GT::SQL::error );
  490.     my %fcols    = $self->_parent_tbl()->_file_cols() or return;
  491.     my $sth      = $tbl->select() or return $self->error( 'FILE_DBSELECT', 'WARN', $GT::SQL::error );
  492.  
  493.     while ( my $href = $sth->fetchrow_hashref() ) {
  494.         my $save_scheme = $fcols{$href->{ForeignColName}}->{file_save_scheme};
  495.         my $fpath    = $self->_file_full_path( $href->{File_Name}, $href->{File_Directory}, $href->{ID}, $href->{ForeignColName}, $save_scheme );
  496.         unlink $fpath or return $self->error( 'FILE_NOUNLINK', 'WARN', $fpath, "$!" );
  497.     }
  498.  
  499.     require GT::SQL::Editor;
  500.     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 );
  501.     $e->drop_table() or return $self->error( 'FILE_DBDROP', 'WARN', $tbl->name(), $GT::SQL::error );
  502.  
  503.     return 1;
  504. }
  505. END_OF_SUB
  506.  
  507. $COMPILE{open} = __LINE__ . <<'END_OF_SUB';
  508. sub open {
  509. # -------------------------------------------------------------------------------------- 
  510. # $obj->open( $path_to_file );
  511. #----------
  512. # creates a GT::SQL::File::Fh Filehandle object
  513. #
  514.     my $self     = shift;
  515.     return GT::SQL::File::Fh->new(@_);
  516. }
  517. END_OF_SUB
  518.  
  519. $COMPILE{file_info} = __LINE__ . <<'END_OF_SUB';
  520. sub file_info {
  521. # -------------------------------------------------------------------------------------- 
  522. # $obj->file_info( $columnname, $primarykeyvalue );
  523. #----------
  524. # returns a filehandle to file stored in database. if there is none, returns 
  525. # undef with an error set in $GT::SQL::error
  526. #
  527.     my $self     = shift;
  528.     my $name     = shift or return;
  529.     my $key      = shift or return;
  530.  
  531.     my $tbl      = $self->_tbl() or return $self->error( 'FILE_PARENTTBL', 'WARN', $GT::SQL::error );
  532.     my $ptable   = $self->_parent_tbl() or return $self->error( 'FILE_FILETBL', 'WARN', $GT::SQL::error );
  533.     my %fcols    = $ptable->_file_cols();
  534.     my $file_rec = $tbl->get({ ForeignColName => $name , ForeignColKey => $key }) or return $self->error( 'FILE_NOFILE', 'WARN', $name, $key, $GT::SQL::error );
  535.  
  536.     my $fpath    = $self->_file_full_path(
  537.         $file_rec->{File_Name},
  538.         $file_rec->{File_Directory},
  539.         $file_rec->{ID},
  540.         $name,
  541.         $fcols{$name}->{file_save_scheme},
  542.         1
  543.     );
  544.     my $relpath  = $self->_file_full_path(
  545.         $file_rec->{File_Name},
  546.         '',
  547.         $file_rec->{ID},
  548.         $name,
  549.         $fcols{$name}->{file_save_scheme},
  550.         1
  551.     );
  552.     $file_rec->{File_RelativePath} = $relpath;
  553.     $file_rec->{File_URL} = $file_rec->{File_URL} . $relpath;
  554.  
  555.     return GT::SQL::File::Fh->new( $fpath, $file_rec );
  556. }
  557. END_OF_SUB
  558.  
  559. $COMPILE{_file_full_path} = __LINE__ . <<'END_OF_SUB';
  560. sub _file_full_path {
  561. # -------------------------------------------------------------------------------------- 
  562. # GT::SQL::File->_file_full_path( $fname, $fdir, $fid, $fcol, $save_scheme, $enc )
  563. #----------
  564. # $fname : filename
  565. # $fdir  : directory of file
  566. # $fid   : id of the parent record
  567. # $save_scheme : hashed or simple
  568. # $enc   : if we should encode the filepath or try to decode it
  569. #----------
  570. # returns the full path to the storeage location and name of the file the record
  571. # points at
  572. # the filename is typically encoded for the sake of special characters
  573. #
  574.     my ( $self, $fname, $fdir, $fid, $fcol, $save_scheme, $enc ) = @_;
  575.  
  576.     $save_scheme ||= 'HASHED';
  577.  
  578. # build paths to which we'll save all the information
  579.     $fdir     = $self->_filepath_munge( $fdir, $fid, $save_scheme );
  580.     $fname    = $self->_filename_munge( $fname, $fid, $fcol, $save_scheme, $enc );
  581.     my $fpath = "$fdir/$fname";
  582.  
  583.     return $fpath;
  584. }
  585. END_OF_SUB
  586.  
  587. $COMPILE{_file_getstats} = __LINE__ . <<'END_OF_SUB';
  588. sub _file_getstats {
  589. # -------------------------------------------------------------------------------------- 
  590. # GT::SQL::File->_file_getstats( $fname, $fpath, $fsize );
  591. #----------
  592. # starts to build a record to be used for inserts/modifies into 
  593. # the _File database table
  594. #
  595.     my ( $self, $fname, $fpath, $furl, $fsize ) = @_;
  596.     require GT::MIMETypes;
  597.     my $rec = {
  598.         File_Name      => $fname || '',
  599.         File_Directory => $fpath || '',
  600.         File_MimeType  => GT::MIMETypes->guess_type($fname),
  601.         File_Size      => defined $fsize ? $fsize : '',
  602.         File_URL       => $furl || ''
  603.     };
  604.  
  605.     return $rec;
  606. }
  607. END_OF_SUB
  608.  
  609. $COMPILE{_filename_munge} = __LINE__ . <<'END_OF_SUB';
  610. sub _filename_munge {
  611. # --------------------------------------------------------------------------------------
  612. # GT::SQL::File->_filename_munge( $fname, $fid, $fcol, $method, $enc )
  613. #----------
  614. # should only be called internally. changes the filename so it can be saved without
  615. # name conflicts
  616. #
  617.     my ( $self, $fname, $fid, $fcol, $method, $enc ) = @_;
  618.  
  619.     $fname = "$fid-$fname";
  620.  
  621.     require GT::CGI;
  622.     $fname = $enc ? GT::CGI->escape( $fname ) : GT::CGI->unescape( $fname );
  623.  
  624.     return $fname;
  625. }
  626. END_OF_SUB
  627.  
  628. $COMPILE{_filepath_munge} = __LINE__ . <<'END_OF_SUB';
  629. sub _filepath_munge {
  630. # --------------------------------------------------------------------------------------
  631. # GT::SQL::File->_filepath_munge();
  632. #----------
  633. # sets up the path directory where the file should be saved.
  634. #
  635.     my ( $self, $fpath, $fid, $method ) = @_;
  636.  
  637.     if ( $method =~ /hashed/i ) {
  638.         my $fletter =  ( reverse split //, $fid )[0];
  639.         my $nfpath  = "$fpath/$fletter";
  640.         if ( $fpath ) {
  641.             -e $nfpath or mkdir $nfpath, 0777 or return warn "Couldn't make directory $nfpath because $!";
  642.         }
  643.         $fpath = $nfpath;
  644.     } 
  645.  
  646.     return $fpath;
  647. }
  648. END_OF_SUB
  649.  
  650. $COMPILE{_check_file_chars} = __LINE__ . <<'END_OF_SUB';
  651. sub _check_file_chars {
  652. #-------------------------------------------------------------------------------
  653. # $obj->_check_file_chars( $fpath );
  654. #----------
  655. # return true if file path is ok
  656. #
  657.     return $_[1] =~ /^[\w\/\\\-\.\:%]+$/;
  658. }
  659. END_OF_SUB
  660.  
  661. $COMPILE{install} = __LINE__ . <<'END_OF_SUB';
  662. sub install {
  663. #-------------------------------------------------------------------------------
  664. # $obj->install( $options );
  665. #----------
  666. # creates the associate file parameter storage table
  667. # $tops is passed into the creation option database
  668. #
  669.     my ( $self, $opts ) = @_;
  670.  
  671. # get the name of the table
  672.     my $ptbl_name       = $opts->{parent_tablename} || $self->{parent_tablename};
  673.     my $tb_name         = $ptbl_name . '_Files';
  674.  
  675. # create the table
  676.     my $c               = $self->creator( $tb_name );
  677.     $c->cols({
  678.                 ID              => { pos => 1, type => 'INT',  not_null => 1, unsigned => 1, regex => '^\d+$' },
  679.                 ForeignColName  => { pos => 2, type => 'CHAR', size     => 50  }, 
  680.                 ForeignColKey   => { pos => 3, type => 'CHAR', size     => 50  }, 
  681.                 File_Name       => { pos => 4, type => 'CHAR', size     => 255 }, 
  682.                 File_Directory  => { pos => 5, type => 'CHAR', size     => 255 }, 
  683.                 File_MimeType   => { pos => 6, type => 'CHAR', size     => 50  }, 
  684.                 File_Size       => { pos => 7, type => 'INT',  not_null => 1, unsigned => 1, regex => '^\d+$' },
  685.                 File_URL        => { pos => 8, type => 'CHAR', size     => 255 },
  686.  
  687. # under consideration....
  688. #                File_Width      => { pos => 8, type => 'INT',  unsigned => 1, regex => '^\d+$' },                 
  689. #                File_Height     => { pos => 9, type => 'INT',  unsigned => 1, regex => '^\d+$' },                 
  690.  
  691.                 });
  692.     $c->pk('ID');
  693.     $c->ai('ID');
  694.     $c->index({ fk_lookup => [ 'ForeignColName', 'ForeignColKey' ] });
  695.     $c->create( $opts->{action} || 'force' ) or return;
  696.  
  697.     return 1;
  698.  
  699. }
  700. END_OF_SUB
  701.  
  702. $COMPILE{_tbl} = __LINE__ . <<'END_OF_SUB';
  703. sub _tbl {
  704. #-------------------------------------------------------------------------------
  705. # $obj->_tbl( $options )
  706. #----------
  707. # returns GT::SQL::Table for _File table
  708. #
  709.     my ( $self, $opts ) = @_;
  710.  
  711.     $self->{table_object} and return $self->{table_object};
  712.  
  713.     my $tbl = eval {
  714.         $self->new_table( $opts->{table} || ( 
  715.                 ( 
  716.                     $opts->{parent_tablename} 
  717.                     || $self->{parent_tablename} 
  718.                     || ( ref $self->{parent_table} ? 
  719.                             do {
  720.                                     my $prefix = $self->{connect}->{PREFIX};
  721.                                     my $name   = $self->{parent_table}->name();
  722.                                     $name      =~ s,^$prefix,,;
  723.                                     $name;
  724.                                 }
  725.                              : 
  726.                             ''  
  727.                        ) ) . '_Files' 
  728.                 ) ); 
  729.     };
  730.  
  731.     return $self->{table_object} = $tbl;
  732. }
  733. END_OF_SUB
  734.  
  735. $COMPILE{_parent_tbl} = __LINE__ . <<'END_OF_SUB';
  736. sub _parent_tbl {
  737. # -------------------------------------------------------------
  738. # $obj->_parent_tbl( $options );
  739. #----------
  740. # return the Table object for the parent table
  741. #
  742.     my ( $self, $opts ) = @_;
  743.     $self->{parent_table} and return $self->{parent_table};
  744.     return $self->_tbl( $self->{parent_table_name} || return );
  745. }
  746. END_OF_SUB
  747.  
  748. $COMPILE{File_Binary} = __LINE__ . <<'END_OF_SUB';
  749. sub File_Binary {
  750. # -------------------------------------------------------------------
  751. # just returns true if the file is of binary type
  752. #
  753.     my $self = shift;
  754.     defined $self->{File_Binary} and return $self->{File_Binary};
  755.     $self->{file_fpath} and return $self->{File_Binary} = -B $self->{file_fpath};
  756.     $self->{file_handle} and return $self->{File_Binary} = -B $self->{file_handle};
  757. }
  758. END_OF_SUB
  759.  
  760. $COMPILE{compare} = __LINE__ . <<'END_OF_SUB';
  761. sub compare {
  762. # -------------------------------------------------------------------
  763. # Do comparisions, uses as_string to get file name first.
  764. #
  765.     my $self  = shift;
  766.     my $value = shift;
  767.     return "$self" cmp $value;
  768. }
  769. END_OF_SUB
  770.  
  771. $COMPILE{get_filename} = __LINE__ . <<'END_OF_SUB';
  772. sub get_filename {
  773. # -------------------------------------------------------------------
  774.     my ($self, $fpath) = @_;
  775.     return +($fpath =~ /([^\\\/]+)$/)[0];
  776. }
  777. END_OF_SUB
  778.  
  779. $COMPILE{get_fh} = __LINE__ . <<'END_OF_SUB';
  780. sub get_fh {
  781. # -------------------------------------------------------------------
  782.     my ($self, $col, $values) = @_;
  783.     $values ||= {};
  784.  
  785.     ref $values->{$col} and ref $values->{$col} ne 'SCALAR' and return $values->{$col};
  786.     ref $values->{$col} eq 'SCALAR' and -f ${$values->{$col}} and -r _ and return GT::SQL::File->open(${$values->{$col}});
  787.     return;
  788. }
  789. END_OF_SUB
  790.  
  791. $COMPILE{pre_file_actions} = __LINE__ . <<'END_OF_SUB';
  792. sub pre_file_actions {
  793. # -------------------------------------------------------------------
  794. # GT::SQL::File->pre_file_actions();
  795. #----------
  796. # called before Table::insert or Table::update to setup all the
  797. # columns and run tests to ensure the file is appropropriate
  798. #
  799.     my ( $package, $fcols, $set, $opts ) = @_;
  800.  
  801. # check to make sure we have records
  802.     foreach my $col_name ( keys %$fcols ) {
  803.         defined $set->{$set} or next;
  804.         ref $set->{$set} and next;
  805.         $set->{$set} and -e $set->{$set} and next;
  806.         delete $set->{$set};
  807.     }
  808.  
  809. # now check to make sure records are of appropriate size
  810.     foreach my $col_name ( grep $set->{$_}, keys %$fcols ) {
  811.         if ( my $max_size = $fcols->{$col_name}->{file_max_size} || 0 ) {
  812.             if ( $max_size < -s $set->{$col_name} ) {
  813.                 return $package->error( 'FILE_FILETOOBIG', 'WARN', "$set->{$col_name}", -s $set->{$col_name}, $max_size );
  814.             }
  815.         }
  816.     }
  817.  
  818. # just make backup files
  819.     my %fset;
  820.     foreach my $key ( keys %$fcols ) {
  821.         if ( $set->{$key} ) {
  822.             my $tmp  = $set->{$key};
  823.             $set->{$key} = $opts->{$key."_filename"} || $package->get_filename("$set->{$key}");
  824.             $fset{$key} = $tmp;
  825.         }
  826.         if ( my $val = $set->{$key."_del"} ) {
  827.             $fset{$key."_del"} = $val;
  828.         }
  829.     };
  830.  
  831. # Remove any that have been deleted.
  832.     foreach my $key ( keys %$fcols ) {
  833.         if ( not $set->{$key."_del"} and exists $set->{$key} and not $set->{$key} ) {
  834.             delete $set->{$key};
  835.         }
  836.         elsif ( $set->{$key."_del"} ) {
  837.             $set->{$key} = '';
  838.             delete $set->{$key."_del"};
  839.         }
  840.     }
  841.  
  842.     return wantarray ? %fset : \%fset;
  843. }
  844. END_OF_SUB
  845.  
  846. package GT::SQL::File::Fh;
  847.  
  848. # ===================================================================
  849. # Magic File Handle, lets you print the file name, but also act like
  850. # a file handle for read, just like CGI.pm.
  851. #
  852. use strict qw/vars subs/;
  853. no strict 'refs';
  854. use vars qw/$FH %FH_Conns $AUTOLOAD/;
  855. use overload
  856.     '""'  => \&as_string,
  857.     'cmp' => \&compare,
  858.     'fallback' => 1;
  859. $FH       = 1;
  860. %FH_Conns = ();
  861.  
  862. sub open {
  863. # -------------------------------------------------------------------
  864. # Create a new filehandle based on a counter, and the filename.
  865. #
  866.     goto &GT::SQL::File::Fh::new;
  867. }
  868.  
  869. sub new {
  870. # -------------------------------------------------------------------
  871. # Create a new filehandle based on a counter, and the filename.
  872. #
  873.     my ( $pkg, $file, $opt ) = @_;
  874.     $file or return;
  875.  
  876.     my $fid     = $FH++;
  877.     my $fname   = sprintf( "FH%05d", $fid );
  878.     my $fh      = \do { local *{$fname}; *{$fname} };
  879.  
  880.     CORE::open ($fh, $file || '') or return;
  881.  
  882.     bless $fh, $pkg; 
  883.  
  884.     my $obj     = GT::SQL::File->new({ 
  885.                                     %{$opt||{}}, 
  886.                                     file_name  => GT::SQL::File->get_filename( $file ),
  887.                                     file_fpath => $file,
  888.                                 }) or return;
  889.  
  890.     $obj->File_Binary() and binmode $fh;
  891.  
  892.     $FH_Conns{$$fh} = $obj;
  893.  
  894.     return $fh;
  895. }
  896.  
  897. sub as_string {
  898. # -------------------------------------------------------------------
  899. # Return the filename, strip off leading junk first.
  900. #
  901.     my $self = shift;
  902.     return $FH_Conns{$$self}->{file_fpath};
  903. }
  904.  
  905. sub compare {
  906. # -------------------------------------------------------------------
  907. # Do comparisions, uses as_string to get file name first.
  908. #
  909.     my $self  = shift;
  910.     my $value = shift;
  911.     return "$self" cmp $value;
  912. }
  913.  
  914.  
  915. sub AUTOLOAD {
  916. # -------------------------------------------------------------------
  917.     my $self         = shift;
  918.     my ($pkg, $what) = $AUTOLOAD =~ /^(.*)::([^:]+)$/;
  919.  
  920.     my $fh_ref = $FH_Conns{$$self} or return;
  921.  
  922.     if ( $fh_ref->can($what) ) {
  923.         return $fh_ref->$what(@_)
  924.     }
  925.     elsif ($GT::SQL::File::PERMIT_REFS->{$what}) {
  926.         $fh_ref->{$what} = shift if @_;
  927.         return $fh_ref->{$what};
  928.     }
  929.     else {
  930.         return $fh_ref->error('FILE_UNKNOWNREF', 'FATAL', $what);
  931.     }
  932. }
  933.  
  934. sub DESTROY {
  935. # -------------------------------------------------------------------
  936. # Close file handle.
  937. #
  938.     my $self = shift;
  939.     delete $FH_Conns{$$self};
  940.     close $self;
  941. }
  942.  
  943. 1;
  944.  
  945. __END__
  946.  
  947.  
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
Jul 31 '08 #1
Share this Question
Share on Google+
1 Reply


numberwhun
Expert Mod 2.5K+
P: 3,503
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
Oct 5 '08 #2

Post your reply

Sign in to post your reply or Sign up for a free account.