perl to write a file

  This is a simple perl to append a line of text to a file on your server
The features. What it needs to work properly. Example. The script itself. Further info.
A similar thing, only different.
Navigation.





 

Features

  Well, it's really simple. The path and filename of the file to write into are hardcoded. The perl reads parameters whether they come via GET or POST. There is only one parameter supported: you can specify the line to append.
  The perl lives on a server and is accessed via an url. Any programm that can read data from an url can do this, a browser or a director application. When called the perl opens the file, returns all the old lines, the new line and writes them all back into the file. Appending could be done much simpler in perl but the way it is done here makes it simple to insert custom functionality.
 

Needs

  Adapt the path and filename to your situation.  
  Upload the perl with ftp as TEXT to your servers cgi-bin directory.  
  Create a subdirectory /database and upload with ftp the file to write into in that directory.  
  Set the file permission of the script with chmod to 755.  
  Set the file permission of the file to write to with chmod to 666.  
 

The Script:

  *.zip archive.  


#!/usr/bin/perl
##############################################################
# 
#
# 17.12.1998 / 22.01.2003
# --------------------------------
# Daniel Plaenitz
# dp@lingo.de
# www.lingo.de/util/
#
##############################################################
#
# script is supposed to sit in a /cgi-bin and write a line of 
# input data at the end of a single, hardcoded file. 
#
# Input may be GET or POST: 
# tiny_write?line=My+new+line+of+text+to+append
#
# This script offers 2 alternative ways to do this, see  
# comments below. 
#
# I assume you want to take this as a starting point to your own 
# adapted solutions. Drop me a line if you're having difficulties or
# need some custom scripting. 
#
# Have fun!
#
##############################################################
# Define Variables
#

# this is a filepath, NOT an url

    $pathname = "./database/";
    $filename = "highscore.txt";

#
#
#

    $fileexpression = $pathname.$filename;
    
#
############################################################
#
# Constants
#
# for file-locking

$exclusive_lock = 2;
$unlock_lock = 8;
   
#
# Done
##############################################################
# 
# fetch the input / schnapp dir den input
# all the name/value pairs received are stored in a named array  %entry


&Parse;


#
# Since this script is called as a cgi it is expected to give _some
# response, else the app. at the other end might assume it failed.
# We need to send a Header first to standard out
#

# first of all, send a Header
  print "Content-type: text/html\n\n";


#
# If all you really want to do is to
# just append the new data to the file
# then un-comment the following line and comment out the 
# &FileIn / &FileOut lines below
#

#&appendLine ($fileexpression,$entry{'line'});


#
# If, however, you'd like the script to return the file's content
# because i.e. the application at the other end wants to build an 
# highscore table from it, or if you intend to extend this script and
# do some comparison or sorting or something, its more practical to first
#
# read the previous entries in an array 
#

&FileIn( $fileexpression );

# 
# now do something useful with that array of lines
#

#
# and finally
# write the stuff to the file and back to standard out
#


&FileOut( $fileexpression,$entry{'line'} );


exit;

#
# Fertig!
#
################################################################
#
#
# subroutines
#
#

sub Parse {
    local(@pairs,$pair,$val,$pos, $i);

    if ($ENV{'REQUEST_METHOD'} eq "GET") {
        $in = $ENV{'QUERY_STRING'};
    }
    elsif ($ENV{'REQUEST_METHOD'} eq "POST") {
        read(STDIN, $in, $ENV{'CONTENT_LENGTH'}+1);
    }

    $i = 0;
    @pairs = split(/&/, $in);

    foreach $pair (@pairs) {
# do the special character conversion
        $pair =~ tr/+/ /;
        $pair =~ s/%(..)/pack("c",hex($1))/ge;

        $pos = index($pair,"=");
        $name = substr($pair,0,$pos);
        $val = substr($pair,$pos+1);

        $i++;
        $entry{$name} = $val;

    }

    return 1;
}

#
############################################################
#
# appendLine  filename, line
#

sub appendLine {

    my ($filename,$line) = @_;

    # open file for append and lock it 

    open (FILE,">>$filename")|| &returnError (500,"Server error","Could not open file $filename for append");
    flock(FILE,$exclusive_lock);
    # and, in case someone appended
    # while we were waiting...
    seek(FILE, 0, 2);

    # write the line AND add a line end
    print FILE "$line\n";

    #unlock and close the file
    flock(FILE,$unlock_lock);
    close (FILE);

}


############################################################
#

sub FileIn {

    my ($filename) = @_;

#
# read the file content into an array
# zutzel die alten eintraege in eine lange liste
#


  # open file for read and lock it
  open(FILE,"$filename");
  flock(FILE,$exclusive_lock);
  
  @lines = <FILE>;
  
  #unlock and close the file
  flock(FILE,$unlock_lock);
  close(FILE);

  return 1;
}

############################################################
#

sub FileOut {
    my ($filename,$theNewLine) = @_;
	
	
  # we'll print all the lines 1) to the file, 2) to standard out

  # open file for write and lock it
  open (FILE,">$filename");
  flock(FILE,$exclusive_lock);

  # the previous lines
  foreach $line (@lines) {
    print FILE "$line";
    print "$line<br>";
  }


  # here comes the new line

  print FILE "$theNewLine\n"; 
  print  "$theNewLine<br>"; 

  #unlock and close the file
  flock(FILE,$unlock_lock);
  close (FILE);

  return 1;
}


#
############################################################
#
# returnError
#

sub returnError {
 ($status, $keyw, $message) = @_;

    print "Content-type: text/html\n";
    print "Status: ", $status, " ", $keyw, "\n\n";
    print "$keyw";
    print " $message";

    exit;

}
#  finito
#
############################################################






Home
Resume
Bits'n pieces
Lingo
Shock
Shock & cgi
Contact


 


 


 


 


 


 


pageID=tinyWrite


Daniel Plänitz

17.12.98, 21.5.00

1