Menu
▾
▴
[NetScript CVS] CVS: netscript2/src/perl/NetScript/Libraries FormsLibrary.pm,1.5,1.6
|
From: Jan T. <de...@us...> - 2002-09-18 13:20:13
|
Update of /cvsroot/net-script/netscript2/src/perl/NetScript/Libraries
In directory usw-pr-cvs1:/tmp/cvs-serv3191
Modified Files:
FormsLibrary.pm
Log Message:
* added support for file uploads
Index: FormsLibrary.pm
===================================================================
RCS file: /cvsroot/net-script/netscript2/src/perl/NetScript/Libraries/FormsLibrary.pm,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** FormsLibrary.pm 11 Jul 2002 22:03:10 -0000 1.5
--- FormsLibrary.pm 18 Sep 2002 13:20:09 -0000 1.6
***************
*** 94,101 ****
my $node = $domWalker -> currentSource();
if ( $node -> getNamespaceURI() eq $NetScript::Interpreter::NAMESPACE_URI ) {
! if ($node -> getLocalName() eq "cookie") {
$this -> setCookie( $node, $domWalker );
0; # consume event
}
else {
1; # do not consume event
--- 94,105 ----
my $node = $domWalker -> currentSource();
if ( $node -> getNamespaceURI() eq $NetScript::Interpreter::NAMESPACE_URI ) {
! my $localName = $node -> getLocalName();
! if ($localName eq "cookie") {
$this -> setCookie( $node, $domWalker );
0; # consume event
}
+ if ( $localName eq "upload" ) {
+ $this -> doUpload( $node, $domWalker );
+ }
else {
1; # do not consume event
***************
*** 116,120 ****
my $node = $domWalker -> currentSource();
if ( $node -> getNamespaceURI() eq $NetScript::Interpreter::NAMESPACE_URI ) {
! if ($node -> getLocalName() eq "cookie") {
0; # consume event
}
--- 120,125 ----
my $node = $domWalker -> currentSource();
if ( $node -> getNamespaceURI() eq $NetScript::Interpreter::NAMESPACE_URI ) {
! my $localName = $node -> getLocalName();
! if ($localName eq "cookie" || $localName eq "upload") {
0; # consume event
}
***************
*** 136,140 ****
#*/
sub getParameter {
! my ( $this, $name ) = @_;
my $cgi = $this -> interpreter() -> getCGI();
my $pName = $name;
--- 141,145 ----
#*/
sub getParameter {
! my ( $this, $member, $name ) = @_;
my $cgi = $this -> interpreter() -> getCGI();
my $pName = $name;
***************
*** 155,159 ****
#*/
sub getCookie {
! my ( $this, $name ) = @_;
my $cgi = $this -> interpreter() -> getCGI();
$cgi -> cookie( $name );
--- 160,164 ----
#*/
sub getCookie {
! my ( $this, $member, $name ) = @_;
my $cgi = $this -> interpreter() -> getCGI();
$cgi -> cookie( $name );
***************
*** 179,182 ****
--- 184,296 ----
$this -> interpreter() -> setCookie( $name, $value, $expires );
+ }
+
+ #/**
+ #* Uploads a file to the specified location.Puts the number of written bytes into
+ #* bytes and the filename on the server into file. Number of written bytes is
+ #* -1 if an error occured.
+ #
+ #* Attribute: parameter - name of the parameter, which contains the file
+ #* Attribute: directory - location on the server where the file should be copied to
+ #* Attribute: filename - optional, the name of file as it should be stored on the server
+ #* Attribute: limit - optional, the maximum number of 1k-blocks that should be uploaded
+ #* Attribute: bytes- optional, the name of the variable, where the number of read bytes is stored into
+ #* Attribute: file - optional, the name of the variable, where the filename on the server should be stored into.
+ #* Attribute: mode - optional, one of the following modes:
+ #* DELETE_ON_FAIL - default, if file exceeds the set limit, file is deleted on the server.
+ #* KEEP_ON_FAIL - file is kept, even if it was cut down to the set limit
+ #* Attribute: overwrite - optional, set to yes if existing files should be overwritten, set to no
+ #* if existing files should not be overwritten. If omitted, existing files will
+ #* NOT be overwritten. If file exists and overwrite is set to no, then
+ #* the value in bytes will be set to -2 and the function will return.
+ #*
+ sub doUpload {
+ my ( $this, $node, $domWalker ) = @_;
+ my $se = $this -> interpreter() -> getStatementEvaluator();
+ my $aCGI = $this -> interpreter() -> getCGI();
+ my $limit = $se -> evaluateStatement( $node -> getAttribute( "limit" ) );
+
+ if ($limit ne "") {
+ $limit = $limit * 1024;
+ }
+ else {
+ $limit = 0;
+ }
+
+ my $filename = $se -> evaluateStatement( $node -> getAttribute( "filename" ) );
+ my $parameter = $se -> evaluateStatement( $node -> getAttribute( "parameter" ) );
+ $filename = $aCGI -> param( $parameter ) if $filename eq '';
+ my $upload = $aCGI -> param( $parameter);
+
+ # Apply filename filter to get the filename, and remove drive and path
+
+ if ($filename =~ /([^\\\/]+)$/) {
+ $filename = $1;
+ }
+
+ my $directory = $se -> evaluateStatement( $node -> getAttribute( "directory" ) );
+ $filename = $directory."/".$filename;
+ my $bytes = $se -> evaluateStatement( $node -> getAttribute( "bytes" ) );
+ if (! defined($aCGI->uploadInfo($upload))) {
+ if ( $bytes ne '' ) {
+ $se -> setVariable( $bytes, -3 );
+ }
+ return;
+ }
+
+ my $type = $aCGI -> uploadInfo($upload)->{'Content-Type'};
+ warn("[webfunctions] Info: receiving file: $upload ($type) -> $filename \n");
+ # define a buffer
+ my $buffer;
+ my $bytesread;
+ my $overallsize = 0;
+ my $file = $se -> evaluateStatement( $node -> getAttribute( "file" ) );
+ if ($file ne '') {
+ $se -> setVariable( $file, $filename );
+ }
+ my $overwrite = $se -> evaluateStatement( $node -> getAttribute( "overwrite" ) );
+ if ($overwrite ne 'yes' && -e $filename) {
+ if ($bytes ne '') {
+ warn("[webfunctions] Warning: file ",$filename, " does exist. File upload skipped.\n");
+ $se -> setVariable( $bytes, -2 );
+ return;
+ }
+ }
+ unless( open (OUTFILE,">$filename") ) {
+ $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent(
+ $NetScript::Interpreter::FATAL_EVENT,
+ "Cannot open $filename for writing." );
+
+ }
+ # read in 1024b-steps
+ while ($limit == 0 || $overallsize < $limit) {
+ $bytesread=read($upload, $buffer, 1024);
+ last unless $bytesread;
+ print OUTFILE $buffer;
+ $overallsize += $bytesread;
+ }
+ close (OUTFILE);
+ if ($limit > 0 && $bytesread >= $limit) {
+ $overallsize = -1;
+ warn("[webfunctions] Warning: file upload was cut due to a set limit of $limit.\n");
+ my $mode = $se -> evaluateStatement( $node -> getAttribute( "mode" ) );
+ if ($mode eq 'DELETE_ON_FAIL' || $mode eq '') {
+ unlink $filename;
+ warn("[webfunctions] Info: deleted partial file $filename from server.\n");
+ }
+ elsif ($mode eq 'KEEP_ON_FAIL') {
+ warn("[webfunctions] Info: kept partial file $filename on server.\n");
+ }
+ else {
+ $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent(
+ $NetScript::Interpreter::FATAL_EVENT,
+ "$mode is no valid value for \"mode\". Use DELETE_ON_FAIL or KEEP_ON_FAIL." );
+ }
+ }
+
+ if ( $bytes ne '' ) {
+ $se -> setVariable( $bytes, $overallsize );
+ }
+ warn("[webfunctions] Info: file upload complete. Read $overallsize bytes.\n");
}
|
