File Coverage

blib/lib/Net/FTPServer/FileHandle.pm
Criterion Covered Total %
statement 21 28 75.0
branch 0 2 0.0
condition n/a
subroutine 6 10 60.0
pod 5 5 100.0
total 32 45 71.1


line stmt bran cond sub pod time code
1             # -*- perl -*-
2              
3             # Net::FTPServer A Perl FTP Server
4             # Copyright (C) 2000 Bibliotech Ltd., Unit 2-3, 50 Carnwath Road,
5             # London, SW6 3EG, United Kingdom.
6             #
7             # This program is free software; you can redistribute it and/or modify
8             # it under the terms of the GNU General Public License as published by
9             # the Free Software Foundation; either version 2 of the License, or
10             # (at your option) any later version.
11             #
12             # This program is distributed in the hope that it will be useful,
13             # but WITHOUT ANY WARRANTY; without even the implied warranty of
14             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15             # GNU General Public License for more details.
16             #
17             # You should have received a copy of the GNU General Public License
18             # along with this program; if not, write to the Free Software
19             # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
20              
21             =pod
22              
23             =head1 NAME
24              
25             Net::FTPServer::FileHandle - A Net::FTPServer file handle.
26              
27             =head1 SYNOPSIS
28              
29             use Net::FTPServer::FileHandle;
30              
31             =head1 METHODS
32              
33             =cut
34              
35             package Net::FTPServer::FileHandle;
36              
37 75     75   1267 use strict;
  75         156  
  75         1957  
38              
39 75     75   328 use vars qw($VERSION);
  75         116  
  75         4694  
40             ( $VERSION ) = '$Revision: 1.1 $ ' =~ /\$Revision:\s+([^\s]+)/;
41              
42 75     75   19788 use Net::FTPServer::Handle;
  75         157  
  75         2006  
43              
44 75     75   418 use Carp qw(confess);
  75         128  
  75         3077  
45              
46 75     75   380 use vars qw(@ISA);
  75         135  
  75         13795  
47              
48             @ISA = qw(Net::FTPServer::Handle);
49              
50             # This function is intentionally undocumented. It is only meant to
51             # be called internally.
52              
53             sub new
54             {
55 131     131 1 229 my $class = shift;
56 131         207 my $ftps = shift;
57 131         218 my $path = shift;
58              
59 131         474 my $self = Net::FTPServer::Handle->new ($ftps);
60 131         300 $self->{_pathname} = $path;
61              
62 131         341 return bless $self, $class;
63             }
64              
65             =pod
66              
67             =over 4
68              
69             =item $filename = $fileh->filename;
70              
71             Return the filename (last) component.
72              
73             =cut
74              
75             sub filename
76             {
77 0     0 1   my $self = shift;
78              
79 0 0         if ($self->{_pathname} =~ m,([^/]*)$,)
80             {
81 0           return $1;
82             }
83              
84 0           confess "incorrect pathname: ", $self->{_pathname};
85             }
86              
87             =pod
88              
89             =item $dirh = $fileh->dir;
90              
91             Return the directory which contains this file.
92              
93             =cut
94              
95             sub dir
96             {
97 0     0 1   confess "virtual function";
98             }
99              
100             =pod
101              
102             =item $fh = $fileh->open (["r"|"w"|"a"]);
103              
104             Open a file handle (derived from C, see
105             C) in either read or write mode.
106              
107             =cut
108              
109             sub open
110             {
111 0     0 1   confess "virtual function";
112             }
113              
114             =item $rv = $fileh->delete;
115              
116             Delete the current file. If the delete command was
117             successful, then return 0, else if there was an error return -1.
118              
119             =cut
120              
121             sub delete
122             {
123 0     0 1   confess "virtual function";
124             }
125              
126             1 # So that the require or use succeeds.
127              
128             __END__