| 
      
            Lines 59-66
          use base qw(Class::Accessor);
      
      
        Link Here
      
     | 
  
        
          | 59 | 
           | 
          59 | 
           | 
        
        
          | 60 | 
          use C4::Context;  | 
          60 | 
          use C4::Context;  | 
        
        
          | 61 | 
           | 
          61 | 
           | 
        
          
            
              | 62 | 
              __PACKAGE__->mk_ro_accessors( qw| name  | 
              62 | 
              __PACKAGE__->mk_ro_accessors( qw||);  | 
            
            
              | 63 | 
              |);  | 
               | 
               | 
            
        
          | 64 | 
           | 
          63 | 
           | 
        
        
          | 65 | 
          =head2 new  | 
          64 | 
          =head2 new  | 
        
        
          | 66 | 
           | 
          65 | 
           | 
        
  
    | 
      
            Lines 107-112
          sub result {
      
      
        Link Here
      
     | 
  
        
          | 107 | 
              return join ',', @a;  | 
          106 | 
              return join ',', @a;  | 
        
        
          | 108 | 
          }  | 
          107 | 
          }  | 
        
        
          | 109 | 
           | 
          108 | 
           | 
        
            
               | 
               | 
              109 | 
              =head2 err  | 
            
            
              | 110 | 
               | 
            
            
              | 111 | 
                  Returns hash with errors in format { file => err, ... } | 
            
            
              | 112 | 
                  Undefined if there are no errors.  | 
            
            
              | 113 | 
               | 
            
            
              | 114 | 
              =cut  | 
            
            
              | 115 | 
               | 
            
            
              | 116 | 
              sub err { | 
            
            
              | 117 | 
                  my ( $self ) = @_;  | 
            
            
              | 118 | 
                  my $err;  | 
            
            
              | 119 | 
                  foreach my $f ( keys $self->{files} ) { | 
            
            
              | 120 | 
                      my $e = $self->{files}->{$f}->{errcode}; | 
            
            
              | 121 | 
                      $err->{ $f } = $e if $e; | 
            
            
              | 122 | 
                  }  | 
            
            
              | 123 | 
                  return $err;  | 
            
            
              | 124 | 
              }  | 
            
            
              | 125 | 
               | 
            
        
          | 110 | 
          =head2 get  | 
          126 | 
          =head2 get  | 
        
        
          | 111 | 
           | 
          127 | 
           | 
        
        
          | 112 | 
              Returns array  | 
          128 | 
              Returns array  | 
        
  
    | 
      
            Lines 117-129
          sub result {
      
      
        Link Here
      
     | 
  
        
          | 117 | 
          sub get { | 
          133 | 
          sub get { | 
        
        
          | 118 | 
              my ( $self, $params ) = @_;  | 
          134 | 
              my ( $self, $params ) = @_;  | 
        
        
          | 119 | 
              my $temp= $self->_lookup( $params );  | 
          135 | 
              my $temp= $self->_lookup( $params );  | 
        
          
            
              | 120 | 
                  my ( @rv, $res );  | 
              136 | 
                  my ( @rv, $res);  | 
            
        
          | 121 | 
              foreach my $r ( @$temp ) { | 
          137 | 
              foreach my $r ( @$temp ) { | 
        
            
               | 
               | 
              138 | 
                      undef $res;  | 
            
        
          | 122 | 
                  $res->{name} = $r->{filename}; | 
          139 | 
                  $res->{name} = $r->{filename}; | 
        
        
          | 123 | 
                  $res->{path}= $self->_full_fname($r); | 
          140 | 
                  $res->{path}= $self->_full_fname($r); | 
        
          
            
              | 124 | 
                      $res->{fh} = IO::File->new( $res->{path}, "r" ) | 
              141 | 
                      if( $res->{path} && -r $res->{path} ) { | 
            
            
              | 125 | 
                          if $params->{filehandle}; | 
              142 | 
                          $res->{fh} = IO::File->new( $res->{path}, "r" ) | 
            
            
              | 126 | 
                      push @rv, $res;  | 
              143 | 
                              if $params->{filehandle}; | 
            
            
               | 
               | 
              144 | 
                          push @rv, $res;  | 
            
            
              | 145 | 
                      } else { | 
            
            
              | 146 | 
                          $self->{files}->{ $r->{filename} }->{errcode}=5; #not readable | 
            
            
              | 147 | 
                      }  | 
            
        
          | 127 | 
                  last if !wantarray;  | 
          148 | 
                  last if !wantarray;  | 
        
        
          | 128 | 
              }  | 
          149 | 
              }  | 
        
        
          | 129 | 
              return wantarray? @rv: $res;  | 
          150 | 
              return wantarray? @rv: $res;  | 
        
  
    | 
      
            Lines 146-153
          sub _init {
      
      
        Link Here
      
     | 
  
        
          | 146 | 
              } else { | 
          167 | 
              } else { | 
        
        
          | 147 | 
                  $self->{category} = $params->{category}; | 
          168 | 
                  $self->{category} = $params->{category}; | 
        
        
          | 148 | 
              }  | 
          169 | 
              }  | 
        
            
              | 149 | 
               | 
               | 
               | 
            
            
              | 150 | 
                  $self->{errors} = []; | 
            
        
          | 151 | 
              $self->{files} = {}; | 
          170 | 
              $self->{files} = {}; | 
        
        
          | 152 | 
              $self->{uid} = C4::Context->userenv->{number} if C4::Context->userenv; | 
          171 | 
              $self->{uid} = C4::Context->userenv->{number} if C4::Context->userenv; | 
        
        
          | 153 | 
          }  | 
          172 | 
          }  | 
        
  
    | 
      
            Lines 165-182
          sub _create_file {
      
      
        Link Here
      
     | 
  
        
          | 165 | 
              if( $self->{files}->{$filename} && | 
          184 | 
              if( $self->{files}->{$filename} && | 
        
        
          | 166 | 
                      $self->{files}->{$filename}->{errcode} ) { | 
          185 | 
                      $self->{files}->{$filename}->{errcode} ) { | 
        
        
          | 167 | 
                  #skip  | 
          186 | 
                  #skip  | 
        
            
               | 
               | 
              187 | 
                  } elsif( !$self->{temporary} && !$self->{rootdir} ) { | 
            
            
              | 188 | 
                      $self->{files}->{$filename}->{errcode} = 3; #no rootdir | 
            
        
          | 168 | 
              } elsif( $self->{temporary} && !$self->{tmpdir} ) { | 
          189 | 
              } elsif( $self->{temporary} && !$self->{tmpdir} ) { | 
        
          
            
              | 169 | 
                      $self->{files}->{$filename}->{errcode} = 2; | 
              190 | 
                      $self->{files}->{$filename}->{errcode} = 4; #no tempdir | 
            
        
          | 170 | 
              } else { | 
          191 | 
              } else { | 
        
        
          | 171 | 
                  my $dir = $self->_dir;  | 
          192 | 
                  my $dir = $self->_dir;  | 
        
        
          | 172 | 
                  my $fn = $self->{files}->{$filename}->{hash}. '_'. $filename; | 
          193 | 
                  my $fn = $self->{files}->{$filename}->{hash}. '_'. $filename; | 
        
            
               | 
               | 
              194 | 
                      if( -e "$dir/$fn" ) { | 
            
            
              | 195 | 
                          $self->{files}->{$filename}->{errcode} = 1; #already exists | 
            
            
              | 196 | 
                          return;  | 
            
            
              | 197 | 
                      }  | 
            
        
          | 173 | 
                  $fh = IO::File->new( "$dir/$fn", "w");  | 
          198 | 
                  $fh = IO::File->new( "$dir/$fn", "w");  | 
        
        
          | 174 | 
                  if( $fh ) { | 
          199 | 
                  if( $fh ) { | 
        
        
          | 175 | 
                      $fh->binmode;  | 
          200 | 
                      $fh->binmode;  | 
        
        
          | 176 | 
                      $self->{files}->{$filename}->{fh}= $fh; | 
          201 | 
                      $self->{files}->{$filename}->{fh}= $fh; | 
        
        
          | 177 | 
                  } else { | 
          202 | 
                  } else { | 
        
          
            
              | 178 | 
                          $self->{files}->{$filename}->{errcode} = 1; | 
              203 | 
                          $self->{files}->{$filename}->{errcode} = 2; #not writable | 
            
            
              | 179 | 
                          # push @{$self->{errors}}, [ 1, $filename ]; | 
               | 
               | 
            
        
          | 180 | 
                  }  | 
          204 | 
                  }  | 
        
        
          | 181 | 
              }  | 
          205 | 
              }  | 
        
        
          | 182 | 
              return $fh;  | 
          206 | 
              return $fh;  | 
        
  
    | 
      
            Lines 192-201
          sub _dir {
      
      
        Link Here
      
     | 
  
        
          | 192 | 
           | 
          216 | 
           | 
        
        
          | 193 | 
          sub _full_fname { | 
          217 | 
          sub _full_fname { | 
        
        
          | 194 | 
              my ( $self, $rec ) = @_;  | 
          218 | 
              my ( $self, $rec ) = @_;  | 
        
            
               | 
               | 
              219 | 
                  my $p;  | 
            
        
          | 195 | 
              if( ref $rec ) { | 
          220 | 
              if( ref $rec ) { | 
        
          
            
              | 196 | 
                      return ( $rec->{category}? $self->{rootdir}: $self->{tmpdir} ). | 
              221 | 
                      if( $rec->{category} && !$self->{rootdir} ) { | 
            
            
              | 197 | 
                          '/'. $rec->{dir}. '/'. $rec->{hashvalue}. '_'. $rec->{filename}; | 
              222 | 
                      } elsif( !$rec->{category} && !$self->{tmpdir} ) { | 
            
            
               | 
               | 
              223 | 
                      } else { | 
            
            
              | 224 | 
                          $p= $rec->{category}? $self->{rootdir}: $self->{tmpdir}; | 
            
            
              | 225 | 
                          $p.= '/';  | 
            
            
              | 226 | 
                          $p.= $rec->{dir}. '/'. $rec->{hashvalue}. '_'. $rec->{filename}; | 
            
            
              | 227 | 
                      }  | 
            
        
          | 198 | 
              }  | 
          228 | 
              }  | 
        
            
               | 
               | 
              229 | 
                  return $p;  | 
            
        
          | 199 | 
          }  | 
          230 | 
          }  | 
        
        
          | 200 | 
           | 
          231 | 
           | 
        
        
          | 201 | 
          sub _hook { | 
          232 | 
          sub _hook { |