[ back to toc ]

Editing out flock from a script

Date: 2002/02/09 17:43

Q:
I am trying to set up an Ikonboard forum on my windowsMe system. After
much hassle, I was able to install the forum. I cannot run it. I get an
error message. "flock() unimplemented on this platform" I have looked high
and low. Flock is not used in Win9x, and the only way around it is to
comment out the flock part of my *.pl file. I don't know how to comment
out (insert #) without getting script errors, like 'invalid syntax' or
'package needs name' or some perl error like that. Can you help me please?
I've included the entire script, as I don't know what part of it I need to
edit. If you paste it into word, the flock part is right around where page
5 ends and 6 begins.

package FUNC::ADMIN;
use strict;
#+-----------------------------------------------------------------+
#| Ikonboard v3 by Jarvis Entertainment Group, Inc.
#|
#| No parts of this script can be used outside Ikonboard without prior
consent.
#|
#| More information available from <ib-license@jarvisgroup.net>
#| (c)2001 Jarvis Entertainment Group, Inc.
#|
#| http://www.ikonboard.com
#|
#| Please Read the license for more information
#+-----------------------------------------------------------------+
#
# Standard Ikonboard Routines.
#
#+-----------------------------------------------------------------+

BEGIN {
require 'Boardinfo.pm' or die "Cannot load Module: $!";
require 'Admin/SKIN.pm';
require 'Lib/FUNC.pm';
}

my $INFO = Boardinfo->new();
my $SKIN = Admin::SKIN->new();
my $std = FUNC::STD->new();

sub new {
my $pkg = shift;
my $obj = {};
bless $obj, $pkg;
return $obj;
}

sub Error {
my $obj = shift;
my %IN = ( DB => "",
LEVEL => "",
MSG => "",
@_,
);

my %errors = ( poss_hack => 'Some of the data entered was
of the incorrect format, this is being treated as a hack attempt',
no_guests => 'Guests are NOT allowed
access to the Ikonboard control panel!',
inactive_admin_session => 'Your Control Panel session
has expired, please log in again.',
too_many_logins => 'You have failed to log in
after 5 attempts. Please wait until 15 minutes have expired before
attempting to log in again',
blank_username => 'You must enter a username',
blank_password => 'You must enter a password',
long_password => 'The password you entered was
too long to be valid',
long_username => 'The username you entered was
too long to be valid',
not_admin => 'You are not an
administrator, your posting rights have been removed. Please do not
attempt to relog in.',

);

my $print = exists $errors{ $IN{'MSG'} } ?
KIN->Error( $errors{ $IN{'MSG'} } ) : $SKIN->Error( $IN{'MSG'} );

$obj->Print( DB => $IN{'DB'},
STD => $obj,
OUTPUT => $print
);

}

sub Print {
my $obj = shift;
my $IN =

"DB" => "",
"STD" => "",
"OUTPUT" => "",
"TARGET" => "",
@_,
};

$obj->{'_target'} = $IN->{'TARGET'} || 'BODY';

$obj->print_http_header();

# As the admin link has "AD=1" in it, some firewalls/banner blockers
# will produce a blank page, not what we want.
# As Ikonboard 3 has used AD=1 since day 1, I don't want to have to
weed
# through the code looking for every single instance it's been used,
so
# we merely use perls' excellent reg-ex to turn AD into CP. For those
who
# have bookmarked their adminCP link, we allow AD=1 to be used also.

# In URLs

$IN->{'OUTPUT'} =~ s!([\?;&])AD=1($|&|;)!$1CP=1$2!g;

# In forms

$IN->{'OUTPUT'} =~ s!name=['"]AD["']\s*value=['"]1["']!name='CP'
value='1'!gi;

print $IN->{'OUTPUT'};
iB::exit();

}

sub Output {
my $obj = shift;

my %IN = ( WHERE => "", NAV_ONE => "", NAV_TWO => "", PRINT => "",
@_, );

my %IMG = ( OPTIONS => 'options.gif',
WELCOME => 'welcome.gif',
DATABASE => 'database.gif',
LANGUAGES => 'languages.gif',
STYLES => 'styles.gif',
MEMBERS => 'members.gif',
CATS => 'categories.gif',
FORUMS => 'forums.gif',
MAINTAIN => 'maintain.gif',
MODERATE => 'moderate.gif',
SQLCLIENT => 'sqlclient.gif'
);

my $html = $SKIN->std_print();

my $nav = $IN{'NAV_ONE'};

$nav .= ' -> '. $IN{'NAV_TWO'} if $IN{'NAV_TWO'};

# As the admin link has "AD=1" in it, some firewalls/banner blockers
# will produce a blank page, not what we want.
# As Ikonboard 3 has used AD=1 since day 1, I don't want to have to
weed
# through the code looking for every single instance it's been used,
so
# we merely use perls' excellent reg-ex to turn AD into CP. For those
who
# have bookmarked their adminCP link, we allow AD=1 to be used also.

# In URLs

$IN{'PRINT'} =~ s!([\?;&])AD=1($|&|;)!$1CP=1$2!g;

# In forms

$IN{'PRINT'} =~ s!name=['"]AD["']\s*value=['"]1["']!name='CP'
value='1'!gi;

$html =~ s!<#TITLE#>!$IMG{ $IN{'WHERE'} }!;
$html =~ s!<#NAV#>!$nav!;
$html =~ s!<#OUTPUT#>!$IN{'PRINT'}!;

$obj->Print( DB => "", STD => "", OUTPUT => $html );
}

sub static_screen {
my $obj = shift;
my $IN =

"TEXT" => "",
"URL" => "",
"TITLE" => "",
"LINK" => "Back to the last action",
@_,
};

$IN->{'URL'} =
"$iB::INFO->{'BOARD_URL'}/ikonboard.$iB::INFO->{'CGI_EXT'}?s=$iB::SESSION&
AD=1&".$IN->{'URL'};
$obj->Print( DB => "", STD => "", OUTPUT => $SKIN->static( URL =>
$IN->{'URL'}, TEXT => $IN->{'TEXT'}, TITLE => $IN->{'TITLE'}, LINK =>
$IN->{'LINK'}) );
}

sub redirect {
my $obj = shift;
my $IN =

"TEXT" => "",
"URL" => "",
@_,
};

$IN->{'URL'} = "?s=$iB::SESSION&AD=1&".$IN->{'URL'};

$obj->print_http_header();
print $SKIN->Redirect($IN->{'TEXT'}, $IN->{'URL'});
iB::exit();
}

sub pure_redirect {
my $obj = shift;
my $IN = { URL => "", @_, };

$IN->{'URL'} =
"$iB::INFO->{'BOARD_URL'}/ikonboard.$iB::INFO->{'CGI_EXT'}?s=$iB::SESSION&
AD=1&".$IN->{'URL'};
print $iB::CGI->redirect( -url => $IN->{'URL'}, -cookies =>
$iB::COOKIES_OUT, -expires => 'now' );
iB::exit();
}

sub print_http_header {
my $obj = shift;
unless ($iB::CONTENT->{'HTTP'} == 1) {
print $iB::CGI->header( -cookies => $iB::COOKIES_OUT, -expires =>
'Mon, 26 Jul 1997 05:00:00 GMT' );
$iB::CONTENT->{'HTTP'} = 1;
}
return 1;
}

sub make_module {
my $obj = shift;

my %IN = ( FILE => "",
PKG_NAME => "",
PATH => "",
VALUES => {},
INTERPOLATE => '',
@_,
);

my $qq = $IN{'INTERPOLATE'} ? 'qq' : 'q';

my $data = $IN{'VALUES'};
$IN{'PATH'} ||= $iB::INFO->{'IKON_DIR'}.'Data/';
my $file = $IN{'PATH'}.$IN{'FILE'};
my $back = $IN{'PATH'}.'Data/bak.'.$IN{'FILE'};

if (-e $file) {

if ($^O ne 'MacOS' && ($^O ne 'MSWin32' || !Win32::IsWin95())) {
unless (-w $file) {
chmod (0777, $file) || $obj->Error( DB=>"",STD=>"",MSG=>"I
do not have write permissions to change the CHMOD value on :$IN{'FILE'}.
Please use FTP to change the CHMOD value on the file $IN{'FILE'}");
chmod (0777, $iB::INFO->{'IKON_DIR'}.'Data') ||
$obj->Error( DB=>"",STD=>"",MSG=>"I do not have write permissions to
change the CHMOD value on the path :$file. Please use FTP to change the
CHMOD value on the directory 'Data'");
}
} else {
unless (-w $file) {
$obj->Error( DB=>"",STD=>"",MSG=>"I do not have write
permissions to $file");
}
}

# Create Back-up

open BAK, "<" .$file or die "Cannot open $file ($!)";
my @data = <BAK>;
close BAK;

open BAK, ">" . $back;
print BAK @data;
close BAK;
}

# Create Module

open (FH, ">" .$file) or die "Cannot write to $file ($!)";
if ($iB::INFO->{'FLOCK'}) {
flock (FH, 2) or die "Could not lock $file ($!)";
}

print FH <<_END_PRINT_;
package $IN{'PKG_NAME'};

sub new {
my \$pkg = shift;
my \$obj = {
_END_PRINT_

foreach (sort { $a cmp $b } keys %{$data}) {
$_ =~ s!'!\'!g;
my $space = " " x (20 - (length($_)));
if (ref($data->{$_}) eq 'ARRAY') {
print FH qq| '$_' $space => [|;
for my $i (@{ $data->{$_} }) {
print FH qq| "$i",|;
}
print FH qq|],\n|;
} else {
$data->{$_} =~ s|!|!|g;
print FH <<_END_PRINT_;
'$_' $space => $qq!$data->{$_}!,
_END_PRINT_

}
}

print FH <<_END_PRINT_;
};
bless \$obj, \$pkg;
return \$obj;
}

1;
_END_PRINT_

close FH or die $!;

chmod (0644, $file);
}

sub write_log {
my $obj = shift;

return;

###### DEPRECIATED
my %IN = ( TITLE => "", EXTRA => "", @_, );
my $date = $std->get_date( TIME => time, METHOD => 'LONG');

open LOG, ">".$INFO->{'DB_DIR'}.'admin_logs/log-'.time.'.txt';

print LOG <<_UNTIL_BORED;
Adminstration Log Entry
MemberName:\t\t$iB::MEMBER->{'MEMBER_NAME'}
Browser:\t\t$ENV{'HTTP_USER_AGENT'}
IP:\t\t$ENV{'REMOTE_ADDR'}
Date:\t\t$date
$IN{'TITLE'}
$IN{'EXTRA'}

Input Data
=======================
_UNTIL_BORED

for (sort { $a cmp $b } keys %iB::IN) {
next if $_ eq 's';
next if $_ eq 'AD';
if ($_ eq 'f') {
print LOG "FORUM ID (f):\t\t\t $iB::IN{'f'}\n";
next;
} elsif
($_ eq 'c') {
print LOG "CATEGORY ID (c):\t\t\t $iB::IN{'c'}\n";
next;
} elsif
($_ eq 'act') {
print LOG "ACTION:\t\t\t $iB::IN{'act'}\n";
next;
} elsif
($_ eq 'CODE') {
print LOG "ACTION CODE:\t\t\t $iB::IN{'CODE'}\n";
next;
}

if ( ref($iB::IN{$_}) eq 'ARRAY' ) {
my $array = join ",", $iB::CGI->param($_);
print LOG "$_:\t\t\t [ $array ]\n";
} else {
print LOG "$_:\t\t\t $iB::IN{$_}\n";
}
}

print LOG "------END OF REPORT------";
close LOG;

return 1;
}

#+#+# END OF MODULES
1;

A:
You can comment out the flock with putting a # in front of the line. That
means comment in Perl.

# flock (FH, 2) or die "Could not lock $file ($!)";

Be sure that no two instanced of the program run at a time. In other words
do not start the program in two command prompt windows at a time.

Regards,
Peter

[ back to toc ]