smeserver/smeserver-formmagick
6
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

initial commit of file from CVS for e-smith-formmagick on Wed 12 Jul 08:54:49 BST 2023

Browse Source
This commit is contained in:
Brian Read
2023-07-12 08:54:49 +01:00
parent 47ba82242b
commit 8bb8161aa1
24 changed files with 3744 additions and 2 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
root/etc/cron.daily/tmpwatch-formmagick Normal file
View File

@@ -0,0 +1 @@
[ -d /var/cache/e-smith/formmagick/sessions ] && /usr/sbin/tmpwatch -f 8 /var/cache/e-smith/formmagick/sessions

0
root/etc/e-smith/events/e-smith-formmagick-update/.gitignore vendored Normal file
View File

719
root/etc/e-smith/locale/en-us/FormMagick/general Normal file
View File

@@ -0,0 +1,719 @@
<lexicon lang="en-us">
<!-- vim: ft=xml:
-->
<entry>
<base>Collaboration</base>
<trans>Collaboration</trans>
</entry>
<entry>
<base>Administration</base>
<trans>Administration</trans>
</entry>
<entry>
<base>Security</base>
<trans>Security</trans>
</entry>
<entry>
<base>Configuration</base>
<trans>Configuration</trans>
</entry>
<entry>
<base>Miscellaneous</base>
<trans>Miscellaneous</trans>
</entry>
<entry>
<base>Your Settings</base>
<trans>Your Settings</trans>
</entry>
<entry>
<base>SAVE</base>
<trans>Save</trans>
</entry>
<entry>
<base>CANCEL</base>
<trans>Cancel</trans>
</entry>
<entry>
<base>ENABLED</base>
<trans>Enabled</trans>
</entry>
<entry>
<base>DISABLED</base>
<trans>Disabled</trans>
</entry>
<entry>
<base>NO</base>
<trans>No</trans>
</entry>
<entry>
<base>YES</base>
<trans>Yes</trans>
</entry>
<entry>
<base>ADD</base>
<trans>Add</trans>
</entry>
<entry>
<base>CREATE</base>
<trans>Create</trans>
</entry>
<entry>
<base>MODIFY</base>
<trans>Modify</trans>
</entry>
<entry>
<base>REMOVE</base>
<trans>Remove</trans>
</entry>
<entry>
<base>COMMENT</base>
<trans>Comment</trans>
</entry>
<entry>
<base>NEXT</base>
<trans>Next</trans>
</entry>
<entry>
<base>SELF</base>
<trans>Self</trans>
</entry>
<entry>
<base>REMOTE</base>
<trans>Remote</trans>
</entry>
<entry>
<base>LOCAL</base>
<trans>Local</trans>
</entry>
<entry>
<base>ACTION</base>
<trans>Action</trans>
</entry>
<entry>
<base>NETWORK</base>
<trans>Network</trans>
</entry>
<entry>
<base>ROUTER</base>
<trans>Router</trans>
</entry>
<entry>
<base>OPERATION_STATUS_REPORT</base>
<trans>Operation status report</trans>
</entry>
<entry>
<base>ACCOUNT</base>
<trans>Account</trans>
</entry>
<entry>
<base>GROUP</base>
<trans>Group</trans>
</entry>
<entry>
<base>DESC_SECTIONBAR</base>
<trans>
<![CDATA[
<hr class="sectionbar"/>
]]>
</trans>
</entry>
<entry>
<base>NO_PIPES_ALLOWED</base>
<trans>Pipe symbols (|) are not permitted in this field</trans>
</entry>
<entry>
<base>ERROR_BELOW</base>
<trans>
ERROR: There was an error in the validation of this page. Please
scroll down and find the specific problem.
</trans>
</entry>
<entry>
<base>ACCESS</base>
<trans>
Access
</trans>
</entry>
<entry>
<base>ACCOUNT_LOCKED</base>
<trans>
Account is locked
</trans>
</entry>
<entry>
<base>GROUP_ADD</base>
<trans>
Add group
</trans>
</entry>
<entry>
<base>NETWORKS_ALLOW_LOCAL</base>
<trans>
Allow access only from local networks
</trans>
</entry>
<entry>
<base>NETWORKS_ALLOW_PUBLIC</base>
<trans>
Allow public access (entire Internet)
</trans>
</entry>
<entry>
<base>ERROR_PASSWORD_CHANGE</base>
<trans>
An error occurred while attempting to change your password. Please make sure that the old password entered is correct.
</trans>
</entry>
<entry>
<base>BACK</base>
<trans>
Back
</trans>
</entry>
<entry>
<base>BACKUP</base>
<trans>
Backup
</trans>
</entry>
<entry>
<base>DESCRIPTION_BRIEF</base>
<trans>
Brief description
</trans>
</entry>
<entry>
<base>PASSWORD_CHANGE</base>
<trans>
Change Password
</trans>
</entry>
<entry>
<base>RESET_PASSWORD_TITLE</base>
<trans>Reset user password</trans>
</entry>
<entry>
<base>ACCOUNT_PASSWORD_CHANGE</base>
<trans>
Change account password
</trans>
</entry>
<entry>
<base>CONTENT</base>
<trans>
Content
</trans>
</entry>
<entry>
<base>CREATE_GROUP</base>
<trans>
Create user group
</trans>
</entry>
<entry>
<base>USER_LIST_CURRENT</base>
<trans>
Current list of users
</trans>
</entry>
<entry>
<base>DESCRIPTION</base>
<trans>
Description
</trans>
</entry>
<entry>
<base>DESTINATION</base>
<trans>
Destination
</trans>
</entry>
<entry>
<base>DOMAIN_NAME</base>
<trans>
Domain name
</trans>
</entry>
<entry>
<base>DOMAIN</base>
<trans>
Domain
</trans>
</entry>
<entry>
<base>DOMAINS</base>
<trans>
Domains
</trans>
</entry>
<entry>
<base>DOWNLOAD</base>
<trans>
Download
</trans>
</entry>
<entry>
<base>ERROR_UPDATING_CONFIGURATION</base>
<trans>
Error occurred while updating system configuration.
</trans>
</entry>
<entry>
<base>GROUP_MEMBERS</base>
<trans>
Group Members
</trans>
</entry>
<entry>
<base>GROUP_NAME</base>
<trans>
Group Name
</trans>
</entry>
<entry>
<base>GROUPS</base>
<trans>
Groups
</trans>
</entry>
<entry>
<base>IP_ADDRESS</base>
<trans>
IP Address
</trans>
</entry>
<entry>
<base>IP_ADDRESS_OR_FQDN</base>
<trans>
IP Address or FQDN
</trans>
</entry>
<entry>
<base>USER_INVALID</base>
<trans>
Invalid user
</trans>
</entry>
<entry>
<base>LOCATION</base>
<trans>
Location
</trans>
</entry>
<entry>
<base>MB</base>
<trans>
Mb
</trans>
</entry>
<entry>
<base>MODIFY_USER_GROUP</base>
<trans>
Modify user group
</trans>
</entry>
<entry>
<base>NAME</base>
<trans>
Name
</trans>
</entry>
<entry>
<base>PASSWORD_VERIFY_NEW</base>
<trans>
New password (verify):
</trans>
</entry>
<entry>
<base>PASSWORD_NEW</base>
<trans>
New password:
</trans>
</entry>
<entry>
<base>OFF</base>
<trans>
Off
</trans>
</entry>
<entry>
<base>OK</base>
<trans>
Ok
</trans>
</entry>
<entry>
<base>PASSWORD_OLD</base>
<trans>
Old password:
</trans>
</entry>
<entry>
<base>ON</base>
<trans>
On
</trans>
</entry>
<entry>
<base>PASSWORD</base>
<trans>
Password
</trans>
</entry>
<entry>
<base>PERFORM</base>
<trans>
Perform
</trans>
</entry>
<entry>
<base>RECONFIGURE</base>
<trans>
Reconfigure
</trans>
</entry>
<entry>
<base>REMOVE_USER_GROUP</base>
<trans>
Remove user group
</trans>
</entry>
<entry>
<base>PASSWORD_RESET</base>
<trans>
Reset password
</trans>
</entry>
<entry>
<base>RESTORE</base>
<trans>
Restore
</trans>
</entry>
<entry>
<base>SHUTDOWN</base>
<trans>
Shutdown
</trans>
</entry>
<entry>
<base>SUCCESS</base>
<trans>
Success
</trans>
</entry>
<entry>
<base>ACCOUNT_NAME_INVALID</base>
<trans>
The account name entered is invalid.
</trans>
</entry>
<entry>
<base>ACCOUNT_NAME_INVALID_CHARS</base>
<trans>
The account name you entered contained invalid characters.
</trans>
</entry>
<entry>
<base>PASSWORD_OLD_INVALID_CHARS</base>
<trans>
The old password you entered contained invalid characters.
</trans>
</entry>
<entry>
<base>PASSWORD_INVALID_CHARS</base>
<trans>
The password you entered contained invalid characters.
</trans>
</entry>
<entry>
<base>PASSWORD_VERIFY_ERROR</base>
<trans>
The passwords you entered did not match.
</trans>
</entry>
<entry>
<base>ACCOUNT_USER_NONE</base>
<trans>
There are no user accounts in the system.
</trans>
</entry>
<entry>
<base>ACCOUNT_GROUP_NONE</base>
<trans>
There are no user groups in the system.
</trans>
</entry>
<entry>
<base>ERROR_INVALID_CHARS</base>
<trans>
Unexpected characters in description.
</trans>
</entry>
<entry>
<base>USER_NAME</base>
<trans>
User Name
</trans>
</entry>
<entry>
<base>YOUR_ACCOUNT</base>
<trans>
Your account:
</trans>
</entry>
<entry>
<base>YOUR_ACCOUNT_INVALID</base>
<trans>The account name entered is invalid.</trans>
</entry>
<entry>
<base>PASSWORD_CHANGE_SUCCESS</base>
<trans>
Your password has been successfully changed.
</trans>
</entry>
<entry>
<base>FM_NONBLANK</base>
<trans>
This field must not be left blank
</trans>
</entry>
<entry>
<base>FM_INTEGER</base>
<trans>
This field must contain a positive integer
</trans>
</entry>
<entry>
<base>FM_NUMBER</base>
<trans>
This field must contain a number
</trans>
</entry>
<entry>
<base>FM_WORD</base>
<trans>
This field must look like a single word.
</trans>
</entry>
<entry>
<base>FM_DATE</base>
<trans>
The data entered could not be parsed as a date
</trans>
</entry>
<entry>
<base>FM_CREDIT_CARD_NUMBER1</base>
<trans>
You must enter a credit card number
</trans>
</entry>
<entry>
<base>FM_CREDIT_CARD_NUMBER2</base>
<trans>
Credit card numbers shouldn't have anything but numbers, spaces or dashes
</trans>
</entry>
<entry>
<base>FM_CREDIT_CARD_NUMBER3</base>
<trans>
Must be at least 14 characters in length
</trans>
</entry>
<entry>
<base>FM_CREDIT_CARD_NUMBER4</base>
<trans>
Doesn't appear to be a valid credit card number
</trans>
</entry>
<entry>
<base>FM_CREDIT_CARD_EXPIRY1</base>
<trans>
No expiry date entered.
</trans>
</entry>
<entry>
<base>FM_CREDIT_CARD_EXPIRY2</base>
<trans>
Expiry date must be in the format MM/YY or MM/YYYY
</trans>
</entry>
<entry>
<base>FM_CREDIT_CARD_EXPIRY3</base>
<trans>
This expiry date appears to have already passed
</trans>
</entry>
<entry>
<base>FM_CREDIT_CARD_EXPIRY4</base>
<trans>
This expiry date appears to be too far in the future
</trans>
</entry>
<entry>
<base>FM_ISO_COUNTRY_CODE1</base>
<trans>
You must provide a country code
</trans>
</entry>
<entry>
<base>FM_ISO_COUNTRY_CODE2</base>
<trans>
This field does not contain an ISO country code
</trans>
</entry>
<entry>
<base>FM_US_STATE</base>
<trans>
This doesn't appear to be a valid 2-letter US state abbreviation
</trans>
</entry>
<entry>
<base>FM_US_ZIPCODE</base>
<trans>
US zip codes must contain 5 or 9 numbers
</trans>
</entry>
<entry>
<base>FM_MINLENGTH1</base>
<trans>
Minimum length has been specified meaninglessly as {$minlength}
</trans>
</entry>
<entry>
<base>FM_MINLENGTH2</base>
<trans>
This field must be at least {$minlength} characters
</trans>
</entry>
<entry>
<base>FM_MAXLENGTH1</base>
<trans>
Maximum length has been specified meaninglessly as {$maxlength}
</trans>
</entry>
<entry>
<base>FM_MAXLENGTH2</base>
<trans>
This field must be no more than {$maxlength} characters
</trans>
</entry>
<entry>
<base>FM_EXACTLENGTH1</base>
<trans>
You must specify the length for the field.
</trans>
</entry>
<entry>
<base>FM_EXACTLENGTH2</base>
<trans>
You must specify the exactlength of the field with an integer
</trans>
</entry>
<entry>
<base>FM_EXACTLENGTH3</base>
<trans>
This field must be exactly {$exactlength} characters
</trans>
</entry>
<entry>
<base>FM_LENGTHRANGE1</base>
<trans>
You must specify the maximum and minimum length for the field.
</trans>
</entry>
<entry>
<base>FM_LENGTHRANGE2</base>
<trans>
You must specify the maximum and minimum lengths of the field with an integer
</trans>
</entry>
<entry>
<base>FM_LENGTHRANGE3</base>
<trans>
This field must be between {$minlength} and {$maxlength} characters
</trans>
</entry>
<entry>
<base>FM_URL</base>
<trans>
This field must contain a URL starting with http:// or ftp://
</trans>
</entry>
<entry>
<base>FM_EMAIL_SIMPLE1</base>
<trans>
You must enter an email address.
</trans>
</entry>
<entry>
<base>FM_EMAIL_SIMPLE2</base>
<trans>
This field doesn't look like an RFC822-compliant email address
</trans>
</entry>
<entry>
<base>FM_DOMAIN_NAME</base>
<trans>
This field doesn't look like a valid Internet domain name or hostname.
</trans>
</entry>
<entry>
<base>FM_IP_NUMBER1</base>
<trans>
This field must contain a valid IP number and can not be left blank.
</trans>
</entry>
<entry>
<base>FM_IP_NUMBER2</base>
<trans>
Invalid IP address format (expected X.X.X.X)
</trans>
</entry>
<entry>
<base>FM_IP_NUMBER3</base>
<trans>
{$octet} is more than 255
</trans>
</entry>
<entry>
<base>FM_USERNAME</base>
<trans>
This field must look like a valid username (3 to 8 letters and numbers)
</trans>
</entry>
<entry>
<base>FM_PASSWORD1</base>
<trans>
You must provide a password.
</trans>
</entry>
<entry>
<base>FM_PASSWORD2</base>
<trans>
The password you provided was not a good password. A good password must
contain all of the following: upper case letter, lower case letter, number,
non-alphanumeric character, be at least 7 characters long.
</trans>
</entry>
<entry>
<base>FM_MAC_ADDRESS1</base>
<trans>
You must provide a MAC address.
</trans>
</entry>
<entry>
<base>FM_MAC_ADDRESS2</base>
<trans>
The MAC address you provided was not valid.
</trans>
</entry>
<entry>
<base>FM_ERR_UNEXPECTED_DESC</base>
<trans>Error: unexpected or missing characters in description</trans>
</entry>
<entry>
<base>CSRF_VALIDATION_FAILURE</base>
<trans>Error: CSRF token is invalid or outdated.</trans>
</entry>
</lexicon>

23
root/etc/e-smith/tests/20e-smith-formmagick/data.xml Normal file
View File

@@ -0,0 +1,23 @@
<form title="Checkboxes" header="head.tmpl" footer="foot.tmpl" post-event="done">
<page name="Food">
<title>Food</title>
<field id="fries" type="checkbox" checked="1">
<label>Would you like fries with that?</label>
</field>
<field id="ketchup" type="checkbox">
<label>How about ketchup?</label>
</field>
</page>
<page name="Clothes">
<title>Clothes</title>
<field id="hat" type="checkbox" checked="1">
<label>Hat</label>
</field>
<field id="shoes" type="checkbox">
<label>Shoes</label>
</field>
<field id="gloves" type="checkbox">
<label>Gloves</label>
</field>
</page>
</form>

6
root/etc/e-smith/tests/20e-smith-formmagick/locale/en/FormMagick/general Normal file
View File

@@ -0,0 +1,6 @@
<lexicon lang="en">
<entry>
<base>YES</base>
<trans>Yes</trans>
</entry>
</lexicon>

7
root/etc/e-smith/tests/20e-smith-formmagick/locale/en/test Normal file
View File

@@ -0,0 +1,7 @@
<lexicon lang="en">
<entry>
<base>TEST</base>
<trans>Test</trans>
</entry>
</lexicon>

6
root/etc/e-smith/tests/20e-smith-formmagick/locale/fr/FormMagick/general Normal file
View File

@@ -0,0 +1,6 @@
<lexicon lang="fr">
<entry>
<base>YES</base>
<trans>Oui</trans>
</entry>
</lexicon>

6
root/etc/e-smith/tests/20e-smith-formmagick/locale/fr/test Normal file
View File

@@ -0,0 +1,6 @@
<lexicon lang="fr">
<entry>
<base>TEST</base>
<trans>Essayer</trans>
</entry>
</lexicon>

16
root/etc/e-smith/tests/20e-smith-formmagick/navigation Normal file
View File

@@ -0,0 +1,16 @@
#
# Junk lines
# More junk lines
#
# The navigation headers we expect to see:
# heading : Test heading
# description : Test description
# navigation : 1000 1200
#
#
#
# And some more navigation headers, to make sure we extract the first ones
# heading : Wrong heading
# description : Wrong description
# navigation : 42 64
#

19
root/etc/e-smith/tests/20e-smith-formmagick/nopipes Normal file
View File

@@ -0,0 +1,19 @@
<form title="Checkboxes" header="head.tmpl" footer="foot.tmpl" post-event="done">
<page name="Food">
<title>Food</title>
<field id="test" type="text" validation="test">
<label>Would you like fries with that?</label>
</field>
<field id="test2" type="text">
<label>Would you like fries with that?</label>
</field>
</page>
<page name="Clothes">
<field id="test3" type="text" validation="test">
<label>Would you like fries with that?</label>
</field>
<field id="test4" type="text">
<label>Would you like fries with that?</label>
</field>
</page>
</form>

BIN
root/etc/e-smith/web/common/checkmark.jpg Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 520 B

BIN
root/etc/e-smith/web/common/tickmark.jpg Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 474 B

995
root/usr/share/perl5/vendor_perl/esmith/FormMagick.pm Normal file
View File

@@ -0,0 +1,995 @@
#----------------------------------------------------------------------
# Copyright 1999-2003 Mitel Networks Corporation
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
# $Id: FormMagick.pm,v 1.69 2005/09/06 05:22:42 apc Exp $
#----------------------------------------------------------------------
package esmith::FormMagick;
our $VERSION = sprintf '%d.%03d', q$Revision: 1.69 $ =~ /: (\d+).(\d+)/;
use CGI::FormMagick;
use Exporter;
use strict;
use esmith::util;
use Carp;
use File::Basename;
use vars qw( @ISA @EXPORT);
use esmith::I18N;
use POSIX qw(strftime);
# use I18N::LangTags qw(super_languages);
use esmith::ConfigDB;
@ISA = qw(CGI::FormMagick Exporter);
@EXPORT = qw(
turn_off_buttons
print_button
print_status_message
set_status_message
validate_password
validate_description
nopipes
gen_locale_date_string
_filename
_lexicon_filename_list
_scriptname_from_filename
_read_lexicons
);
our $configdb = esmith::ConfigDB->open_ro();
=begin _private
The import method is doing some tricky stuff to make sure that when
esmith::FormMagick is subclassed and the subclass is used, the exported
functions for both esmith::FormMagick *and* its subclass are available.
=end _private
=cut
sub import {
my $class = shift;
__PACKAGE__->export_to_level(1, undef, @_);
$class->export_to_level(1, undef, @_) unless __PACKAGE__ eq $class;
}
=pod
=head1 NAME
esmith::FormMagick - esmith wrapper for CGI::FormMagick
=head1 SYNOPSIS
use esmith::FormMagick;
my $f = new esmith::FormMagick();
$f->display();
my $f = new esmith::FormMagick( filename=>'/some/path/to/script' );
$f->display();
=head1 DESCRIPTION
esmith::FormMagick is a wrapper for CGI::FormMagick which automatically
does all the things that we always want to do for the SMEServer manager.
These include:
=over 4
=item *
Turning off unwanted buttons (previous, reset)
=item *
Automatically clearing %ENV for taint-friendliness
=item *
Disabling uploads through CGI.pm and setting the MAX_POST size to 100KB.
=item *
Reading in FormMagick XML from the __DATA__ section of the script
=back
This last point is the most important one. In order to avoid having
XML files littering the filesystem, we have chosen to include them along
with the script which parses them. Your script will therefore look like
this:
my $fm = esmith::FormMagick->new();
$fm->display();
# miscellaneous subroutines, etc
__DATA__
<form ...>
<page ...>
<field ...> ... </field>
<field ...> ... </field>
<field ...> ... </field>
</page>
<page ...>
<field ...> ... </field>
<field ...> ... </field>
<field ...> ... </field>
</page>
</form>
esmith::FormMagick also provides certain convenience functions to assist
in writing FormMagick web panels.
=head1 METHODS
=head2 new()
Creates a new esmith::FormMagick object. Takes an optional hash of
arguments, including:
more_lexicons a list of additional lexicon files to use
charset the character set encoding of the lexicon files
(default is UTF-8).
Notes on lexicon files:
By default, lexicons are read in from
F</etc/e-smith/locale/*/FormMagick> (general FormMagick-internal phrases)
and F</etc/e-smith/locale/*/$scriptpath> (where $scriptpath is
something like F<etc/e-smith/web/functions/useraccounts>. NB: any symlinks
will be traced to their source). You can append
items to this list using the more_lexicons argument. Later lexfiles
override earlier ones.
For debugging purposes, $fm->{lexfiles} will tell you which files were
read in, and $fm->{original_xml} will show you the XML that was
generated by smushing those files together.
The script will also be parsed to look for the following special coments,
which are used to generate the navigation bar:
# heading : Security
# description : Remote access
# navigation : 1000 1200
Note on character set encodings:
Valid character sets are "ISO-8859-1", "US-ASCII", "UTF-8" and "UTF-16".
=begin testing
my $out = `$^X -cw $Original_File 2>&1`;
is( $?, 0, 'compiles' );
is( $out, "$Original_File syntax OK\n", 'no warnings' );
use_ok('CGI::FormMagick');
use_ok('esmith::FormMagick');
use vars qw($fm);
$ENV{ESMITH_LEXPATH} = "20e-smith-formmagick/locale";
ok(open (DATA, "20e-smith-formmagick/data.xml"), "opened data file for input");
ok(esmith::FormMagick->can('new'), "We can call new");
ok($fm = esmith::FormMagick->new(more_lexicons => [ 'test' ]), "create e::fm object");
isa_ok($fm, 'esmith::FormMagick');
is($ENV{PATH}, '/bin:/usr/bin:/usr/local/bin', 'Set $ENV{PATH}');
is($CGI::POST_MAX, 1024 * 100, "Set CGI::POST_MAX");
is($CGI::DISABLE_UPLOADS, 1, "Set CGI::DISABLE_UPLOADS");
is($<, $>, "Set real to effective UID");
is($(, $), "Set real to effective UID");
$ENV{HTTP_ACCEPT_LANGUAGE} = "fr";
$fm->parse_xml(); # suck in lexicons without displaying
is($fm->localise("YES"), "Oui", "Localisation works");
is($fm->localise("TEST"), "Essayer", "more_lexicons works");
# warning avoidance; better ways to do this gratefully accepted
my ($foo, $bar) = ($CGI::POST_MAX, $CGI::DISABLE_UPLOADS);
close DATA;
=end testing
=cut
BEGIN: {
$ENV{'PATH'} = '/usr/sbin:/usr/bin:/usr/local/bin';
$ENV{'SHELL'} = '/bin/bash';
$ENV{'HOME'} = '/root';
delete $ENV{'ENV'};
esmith::util::setRealToEffective();
}
sub new {
my $self = shift;
my $class = ref($self) || $self;
my %args = @_;
my $data;
{
local $/ = undef;
no warnings;
$data = <main::DATA>;
}
my $csrfdelay = $args{csrfdelay} || $configdb->get('httpd-admin')->prop('csrfTimeout') || '180';
$csrfdelay = ($csrfdelay =~ /\D/ )? 180 : $csrfdelay;
$csrfdelay = ( $csrfdelay > 500) ? 500 : $csrfdelay;
my $sessiondir = "/var/cache/e-smith/formmagick/sessions";
my $charset = $args{charset} || 'UTF-8';
$self = CGI::FormMagick::new($class,
type => 'string',
source => $data,
charset => $charset,
sessiondir => $sessiondir,
debug => $args{debug},
csrf => 1,
csrfdelay => $csrfdelay
);
my $fallback = "en-us";
$self->{fallback_language} = $fallback;
my @lexfiles = $self->_lexicon_filename_list(%args);
my $lextext = _read_lexicons(@lexfiles);
$self->{source} =~ s!</form>!$lextext\n</form>!;
if ($self->{debug}) {
$self->{lexfiles} = \@lexfiles;
$self->{original_xml} = $data;
}
$self->{calling_package} = (caller)[0];
$self->previousbutton(0);
$self->startoverlink(0);
$self->resetbutton(0);
$self->fallback_language($fallback);
$self->_navigation_setup(%args);
$CGI::POST_MAX=1024 * 100; # max 100K posts
$CGI::DISABLE_UPLOADS = 1; # no uploads
return $self;
}
=head2 get_languages
Override for CGI::FormMagick::get_languages to only return languages which are
installed on this server
=cut
sub get_languages
{
my $self = shift;
my @languages;
my @missing_languages;
my $lexdir = $ENV{ESMITH_LEXPATH} || "/etc/e-smith/locale";
foreach my $lang ($self->SUPER::get_languages(),$self->fallback_language())
{
if (-d "$lexdir/$lang")
{
push @languages, $lang;
next;
}
push @missing_languages, $lang;
}
warn "get_languages: " .
"Browser asked for missing languages @missing_languages\n"
if (scalar @missing_languages);
return @languages;
}
=head2 page_pre_event
This method overrides the same method in CGI::FormMagick. It adds some
functionality that is not specific to general CGI::FormMagick use,
specifically the big-red error message whenever there are errors in the page.
=cut
sub page_pre_event
{
my $self = shift;
$self->debug_msg("This is the page pre-event in esmith::FormMagick.");
if (my $pre_page_routine = $self->page->{'pre-event'}) {
$self->debug_msg("The pre-routine is $pre_page_routine");
$self->do_external_routine($pre_page_routine);
}
# If any errors occurred, draw the big error box.
if ($self->errors())
{
my $msg = $self->localise('ERROR_BELOW');
$self->{cgi}->param(-name => 'status_message',
-value => $msg);
$self->{cgi}->param(-name => 'status_type',
-value => 'error');
$self->do_external_routine('print_status_message');
}
}
=head2 _filename
Figures out the filename of the script being run, either from the
arguments or by looking at the perl special variable $0.
=for testing
is(_filename(filename => 'foo'), 'foo', "Pick up filename from args");
is(_filename(), $0, "Pick up filename from \$0");
=cut
sub _filename {
my (%args) = @_;
return exists $args{filename} ? $args{filename} : $0;
}
=head2 _scriptname_from_filename
Given a filename such as that found in $0, follows symlinks and figures
out the actual original filename. This is mostly used to turn
F</etc/e-smith/web/panels/manager/cgi-bin/whatever> into
F</etc/e-smith/web/functions/whatever>.
=for testing
# bloody hard to test anywhere other than on a server; not sure how to
# do it. -- Skud
can_ok('main', '_scriptname_from_filename');
=cut
sub _scriptname_from_filename {
my ($filename) = my ($scriptname) = @_;
while (-l $scriptname) {
$scriptname = readlink $scriptname;
}
if ( $scriptname =~ m:^\.\./\.\./\.\./functions: and
$filename =~ m:^/etc/e-smith/web/panels/manager/(cgi-bin|html):)
{
$scriptname = "/etc/e-smith/web/functions/" . basename $filename;
}
return $scriptname;
}
=head2 _lexicon_filename_list
Figures out the full filenames of all required i18n/l10n lexicons, and
returns them as a list.
=begin testing
$ENV{ESMITH_LEXPATH} = "20e-smith-formmagick/locale";
my @expected_lexfiles = qw(
20e-smith-formmagick/locale/en/FormMagick/general
20e-smith-formmagick/locale/fr/FormMagick/general
20e-smith-formmagick/locale/en/test
20e-smith-formmagick/locale/fr/test
);
my @lexfiles = _lexicon_filename_list(more_lexicons => [ 'test' ]);
is_deeply(\@expected_lexfiles, \@lexfiles, "Found the right localisation lexicons");
=end testing
=cut
sub _lexicon_filename_list {
my $self = shift;
my (%args) = @_;
my $filename = _filename(%args);
my $scriptname = _scriptname_from_filename($filename);
my $lexdir = $ENV{ESMITH_LEXPATH} || "/etc/e-smith/locale";
my ($pref_lang) = $self->get_languages();
my @lexfiles = ();
foreach my $pref_lang ($self->get_languages())
{
if (-e "$lexdir/$pref_lang/FormMagick/builtins")
{
push @lexfiles, "$lexdir/$pref_lang/FormMagick/builtins";
last;
}
}
foreach my $pref_lang ($self->get_languages())
{
if (-e "$lexdir/$pref_lang/FormMagick/general")
{
push @lexfiles, "$lexdir/$pref_lang/FormMagick/general";
last;
}
}
foreach my $pref_lang ($self->get_languages())
{
if (-e "$lexdir/$pref_lang/$scriptname")
{
push @lexfiles, "$lexdir/$pref_lang/$scriptname";
last;
}
}
foreach (@{$args{more_lexicons}}) {
push @lexfiles, "$lexdir/$pref_lang/$_";
}
return @lexfiles;
}
=head2 _read_lexicons
Given a list of lexicon filenames, reads each of them in and returns
them as a concatenated string.
=for testing
can_ok('main', '_read_lexicons');
like(_read_lexicons('20e-smith-formmagick/locale/fr/test'), qr'Essayer', "_read_lexicons");
=cut
sub _read_lexicons {
my $lextext = "";
foreach (@_) {
local $/ = undef;
unless (open (LEXIN, $_))
{
warn "Can't open lexicon file $_: $!";
next;
}
$lextext .= <LEXIN>;
}
return $lextext;
}
=head2 $fm->_navigation_setup(%args)
Sets up various properties related to the navigation menu, such as
heading/description/etc. You need to pass it the same args as were
passed to new(). It doesn't return anything.
=for testing
my $nav = esmith::FormMagick->new(filename=>"20e-smith-formmagick/navigation");
can_ok($nav, '_navigation_setup');
$nav->_navigation_setup(filename=>"20e-smith-formmagick/navigation");
is($nav->heading, 'Test heading', "Picked up navigation heading");
=cut
sub _navigation_setup {
my ($self, %args) = @_;
$self->{heading} = undef;
$self->{description} = undef;
$self->{heading_weight} = undef;
$self->{description_weight} = undef;
if (open SCRIPT, _filename(%args))
{
while ( <SCRIPT> )
{
$self->{heading} = $1 if (/^\s*#\s*heading\s*:\s*(.+?)\s*$/);
$self->{description} = $1
if (/^\s*#\s*description\s*:\s*(.+?)\s*$/);
($self->{heading_weight}, $self->{description_weight}) = ($1, $2)
if (/^\s*#\s*navigation\s*:\s*(\d+?)\s+(\d+?)\s*$/);
last if (defined $self->{heading} and
defined $self->{description} and
defined $self->{heading_weight} and
defined $self->{description_weight});
}
}
close SCRIPT;
}
=head2 $fm->get_validation_attribute
This method overrides the one in CGI::FormMagick::Validator to forcibly
add "nopipes" to the list of validations performed. Note that if the
validation string contains "permitpipes", it will be removed, and "nopipes"
will _not_ be added.
=begin testing
my $fm = esmith::FormMagick->new(filename=>"20e-smith-formmagick/nopipes");
can_ok($fm, "get_validation_attribute");
is($fm->get_validation_attribute({validation => "foo"}), "foo, nopipes", "nopipes added to existing validation");
is($fm->get_validation_attribute({validation => undef}), "nopipes", "nopipes added to empty validation");
#$fm->parse_xml();
my $badcgi = CGI->new( { testfield => '|' } );
$fm->{cgi} = $badcgi;
my $field = {
validation => '',
id => 'testfield',
label => 'Test Field',
};
isnt(grep(/PIPE/,$fm->validate_field($field)), undef, "Test a field with a pipe in it");
isnt($fm->validate_field($field), "OK", "Test a field with a pipe in it");
=end testing
=cut
sub get_validation_attribute {
my ($fm, $field) = @_;
my $vfield = $field->{validation};
if ($vfield and ($vfield =~ s/(,\s)?permitpipes//))
{
$vfield =~ s/^\s*,//;
return $vfield;
}
elsif ($vfield)
{
return "$vfield, nopipes";
}
else {
return "nopipes";
}
}
=head2 $fm->props_to_query_string()
Given a hash of properties, turns them into a CGI query string. Useful
for if you need to pre-populate a form based on data from the accounts
or config database. See the table on the first page of the C<useraccounts>
web function for an example.
=for testing
my $test = {a => "b", c => "d"};
is($fm->props_to_query_string($test), "a=b;c=d", "props_to_query_string");
=cut
sub props_to_query_string {
my ($fm, $prophash) = @_;
my $cgi = CGI->new($prophash);
return $cgi->query_string();
}
=head1 EXPORTED FUNCTIONS
The following exported functions may be used in your FormMagick scripts
and XML, for instance as page pre-events, validation routines, etc.
=head2 turn_off_buttons()
Turns off *all* buttons. Useful if you want to replace the Next/Prev
style of navigation with something else.
=for testing
my $fm = esmith::FormMagick->new();
turn_off_buttons($fm);
foreach (qw(nextbutton previousbutton finishbutton resetbutton startoverlink)) {
is($fm->$_, 0, "turn_off_buttons turns off $_");
}
=cut
sub turn_off_buttons {
my $fm = shift;
$fm->nextbutton(0);
$fm->previousbutton(0);
$fm->finishbutton(0);
$fm->resetbutton(0);
$fm->startoverlink(0);
}
=head2 print_button('STRING')
Given a string, prints a submit button with that string localised. For
instance, print_button('SAVE') will localise SAVE and put it onto the
button. This is used to replace the next/prev/etc buttons with custom
buttons.
=cut
sub print_button {
my ($fm, $word) = @_;
$word = $fm->localise($word);
print qq( </table>\n <table width=100%><tr><th class="sme-layout"><input type="submit" name="Next" value="$word"></th></tr></table>);
return undef;
}
=head2 set_status_message($message)
Sets the status message to be displayed at the top of the next page.
=for testing
my $fm = esmith::FormMagick->new();
$fm->{cgi} = CGI->new("");
can_ok('main', 'set_status_message');
set_status_message($fm, "Testing");
is($fm->{cgi}->param("status_message"), "Testing", "Set status message");
=cut
sub set_status_message {
my ($fm, $msg) = @_;
$fm->{cgi}->param(-name => 'status_message', -value => $msg);
return 1;
}
=head2 print_status_message()
Prints an status message on the first page, to give an indication of
success/failure of the previous step. Resets the status message to
blank and turns off all buttons as a side-effect.
=for testing
my $fm = esmith::FormMagick->new();
$fm->{cgi} = CGI->new("");
set_status_message($fm, "test status message");
$fm->nextbutton(1);
print_status_message($fm);
like($_STDOUT_, qr/test status message/, "Saw status message");
is($fm->{cgi}->param("status_message"), "", "Reset status message to blank after printing");
is($fm->nextbutton(), 0, "turn off buttons after status message");
=cut
sub print_status_message
{
my ($fm) = @_;
if ($fm->{cgi}->param("status_message"))
{
my $msg = qq(<h2>) . $fm->localise('OPERATION_STATUS_REPORT') .
qq(</h2>);
$msg .= $fm->localise($fm->{cgi}->param("status_message"));
my $div_class = $fm->{cgi}->param("status_type") || undef;
if (defined $div_class)
{
my $q = $fm->{cgi};
my $img_string;
if ($div_class eq "success")
{
$img_string =
qq(src="/server-common/tickmark.jpg" ALT="SUCCESS");
}
else
{
$img_string =
qq(src="/server-common/checkmark.jpg" ALT="ERROR");
}
print $q->table({-class =>"sme-borders"},
$q->Tr(
$q->td( "<img $img_string>"),
$q->td( $q->div( {-class=>$div_class}, $msg) )
));
}
else
{
print $fm->{cgi}->div($msg);
print $fm->{cgi}->hr({-class => "sectionbar"});
}
$fm->{cgi}->param(-name => "status_message" => value => "");
$fm->{cgi}->param(-name => "status_type" => value => "");
}
turn_off_buttons($fm);
}
=head2 description
Return the description entry read from the script, or "Unknown"
=for testing
my $fm = esmith::FormMagick->new(filename=>"20e-smith-formmagick/navigation");
is($fm->description, "Test description", "Read description header");
=cut
sub description
{
my ($fm) = @_;
my $desc = defined $fm->{description} ? $fm->localise($fm->{description})
: "Unknown";
$desc =~ s/^\s*//;
$desc =~ s/\s*$//;
return $desc;
}
=head2 heading
Return the heading entry read from the script, or "Unknown"
=for testing
my $fm = esmith::FormMagick->new(filename=>"20e-smith-formmagick/navigation");
is($fm->heading, "Test heading", "Read heading header");
=cut
sub heading
{
my ($fm) = @_;
my $head = defined $fm->{heading} ? $fm->localise($fm->{heading})
: "Unknown";
$head =~ s/^\s*//;
$head =~ s/\s*$//;
return $head;
}
=head2 description_weight
Return the description weight entry read from the script, or zero
=for testing
my $fm = esmith::FormMagick->new(filename=>"20e-smith-formmagick/navigation");
is($fm->description_weight, 1200, "Read description weight");
=cut
sub description_weight
{
my ($fm) = @_;
return defined $fm->{description_weight} ? $fm->{description_weight} : 0;
}
=head2 heading_weight
Return the heading weight entry read from the script, or zero
=for testing
my $fm = esmith::FormMagick->new(filename=>"20e-smith-formmagick/navigation");
is($fm->heading_weight, 1000, "Read heading weight");
=cut
sub heading_weight
{
my ($fm) = @_;
return defined $fm->{heading_weight} ? $fm->{heading_weight} : 0;
}
=head2 validate_password ($strength, $password)
Checks the supplied password for security. Strength can be "strong", "normal"
or "none". A "strong" password passes the cracklib tests. A "normal" password
passes the tests in CGI::FormMagick::Validator::Network::password, and "none"
will accept any password. An invalid argument for 'strength' is considered to
be 'normal'.
=for testing
my $fm = esmith::FormMagick->new();
isnt($fm->validate_password('strong','f00'),'OK','validate_password strong');
is($fm->validate_password('strong','f%nn*f2@'),'OK',' ..using strong password');
isnt($fm->validate_password('normal','f00'),'OK','validate_password normal');
is($fm->validate_password('normal','f%00B4r'),'OK',' ..using normal password');
is($fm->validate_password('none','f00'),'OK','validate_password none');
=cut
sub validate_password
{
my ($fm,$strength,$pass) = @_;
use Crypt::Cracklib;
my $reason;
if ($strength eq "none") {
return $fm->localise("Passwords must be at least 7 characters long") unless (length($pass) > 6);
return "OK";
}
$reason = $fm->call_fm_validation('password', $pass, undef);
return $reason unless ($reason eq "OK");
return "OK" unless ($strength eq "strong");
if ( -f '/usr/lib64/cracklib_dict.pwd' ) {
$reason = fascist_check($pass, '/usr/lib64/cracklib_dict');
} else {
$reason = fascist_check($pass, '/usr/lib/cracklib_dict');
}
$reason ||= "Software error: password check failed";
return "OK" if ($reason eq "ok");
return $fm->localise("Bad Password Choice") . ": "
. $fm->localise("The password you have chosen is not a good choice, because")
. " " . $fm->localise($reason) . ".";
}
=pod
=head2 validate_description ($description).
Checks the supplied description. Period is allowed in description
=cut
sub validate_description
{
my ($fm, $description) = @_;
if ( $description =~ /^([\-\'\w][\-\'\w\s\.]*)$/ ) {
return ('OK');
}
else {
return ("FM_ERR_UNEXPECTED_DESC");
}
}
=pod
=head2 nopipes
Validation routine to ensure there are no pipe characters in a field.
This is necessary because we don't want them to end up in the esmith configuration databases.
Note that this validation routine is automatically added to every field, so you do not have to call it explicitly.
=for testing
can_ok('main', 'nopipes');
is(nopipes(undef, 'nopipes in this string!'),'OK','nopipes in this string!');
like(nopipes(undef, 'has|pipe'),qr/NO_PIPES/,' .. no pipes allowed');
=cut
sub nopipes
{
my ($fm, $data) = @_;
if ($data =~ /\|/)
{
return "NO_PIPES_ALLOWED";
}
return "OK";
}
=pod
=head2 gen_locale_date_string
Generates a date string in the preferred format for the locale.
=for testing
can_ok('main', 'gen_locale_date_string');
=cut
sub gen_locale_date_string
{
my $self = shift;
my $i18n = esmith::I18N->new();
$i18n->setLocale('formmagick', $i18n->preferredLanguage());
return strftime "%c", localtime;
}
=head2 success
This method takes a lexicon tag as argument, optionally with a page name as
second argument (defaulting to 'First'), and sets the status message to the
lexicon tag, and sets the next page. To make use of this, the page that the
method is directing FormMagick to should have, as pre-event, the
print_status_message method.
This method simply factor's all of the results of successful operations, and
helps to ensure that all results end up in looping back to the start page.
=cut
sub success {
my $self = shift;
my $msg = shift || 'SUCCESS';
my $page = shift || 'First';
$self->debug_msg("success signalled: nextpage = $page, message = $msg");
$self->wherenext($page);
$self->{cgi}->param(-name => 'status_message',
-value => $msg);
$self->{cgi}->param(-name => 'status_type',
-value => 'success');
return undef;
}
=head2 error
This method is much like the above 'success' method, except it is intended for
display of error messages.
It is currently identical to success(), but can be altered to yield
different results, like addition of red text, or logging of the error, etc.
=cut
sub error {
my $self = shift;
my $msg = shift || 'ERROR';
my $page = shift || 'First';
$self->debug_msg("error signalled: nextpage = $page, message = $msg");
$self->wherenext($page);
$self->{cgi}->param(-name => 'status_message',
-value => $msg);
$self->{cgi}->param(-name => 'status_type',
-value => 'error');
return undef;
}
=head2 display_error
This method displays an error using the sme-error style. This should be
used when displaying a page, and the error() method is not applicable.
=cut
sub display_error
{
my $self = shift;
my $msg = shift;
my $q = $self->{cgi};
print $q->Tr($q->td({ -colspan => 2 },
$q->div({ -class => 'sme-error' },
$self->localise($msg))));
return undef;
}
=head2 display_success
This method displays a success message using the success style. This should be
used when displaying a page, and the success() method is not applicable.
=cut
sub display_success
{
my $self = shift;
my $msg = shift;
my $q = $self->{cgi};
print $q->Tr($q->td({ -colspan => 2 },
$q->div({ -class => 'success' },
$self->localise($msg))));
return undef;
}
=head1 SEE ALSO
L<CGI::FormMagick>
L<esmith::FormMagick::Tester>
L<esmith::FormMagick::LexTester>
=head1 AUTHOR
Mitel Networks Corporation
See http://www.e-smith.org/ for more information
=cut
1;

138
root/usr/share/perl5/vendor_perl/esmith/FormMagick/LexTester.pm Normal file
View File

@@ -0,0 +1,138 @@
#!/usr/bin/perl -w
#----------------------------------------------------------------------
# Copyright 1999-2003 Mitel Networks Corporation
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
# $Id: LexTester.pm,v 1.1 2002/02/26 20:45:27 skud Exp $
#----------------------------------------------------------------------
package esmith::FormMagick::LexTester;
my $VERSION = $VERSION = "0.10";
use esmith::FormMagick;
use strict;
use Carp;
our @ISA = qw(esmith::FormMagick);
#
# TODO
#
# 2002-02-18 Skud Check for twice-translated terms
# 2002-02-18 Skud Check the option labels of select/radio fields
#
=pod
=head1 NAME
esmith::FormMagick::LexTester - test FormMagick lexicon completeness
=head1 SYNOPSIS
use esmith::FormMagick::LexTester;
my $lt = esmith::FormMagick::Lextester->new();
foreach my $lang (qw(en fr de)) {
my $ok = $lt->lextest($lang);
unless ($ok) {
my @untranslated = @{$lt->{untranslated}};
warn "Untranslated terms for $lang: @untranslated\n",
}
}
=head1 DESCRIPTION
esmith::FormMagick::LexTester is a subclass of esmith::FormMagick whose
speciality is checking the completeness of localisation lexicons.
=head2 new();
Exactly as for esmith::FormMagick
=begin testing
BEGIN: {
use lib qw(lib/ ../formmagick/lib/);
use_ok('esmith::FormMagick::LexTester');
use vars qw($lt);
}
ok(esmith::FormMagick::LexTester->can('new'), "We can call new");
ok($lt= esmith::FormMagick::LexTester->new(), "Create lt object");
isa_ok($lt, 'esmith::FormMagick::LexTester');
=end testing
=cut
sub new {
shift;
$ENV{HTTP_ACCEPT_LANGUAGE} = "test value";
my $self = esmith::FormMagick->new();
$self->{calling_package} = (caller)[0];
$self->{untranslated} = [];
bless $self;
return $self;
}
=head2 $lt->lextest($lang)
Given a two-letter language code, checks the completeness of the lexicon
for that language. Returns true on success, false on failure. If it
fails, it sets $lt->{untranslated}, which is an arrayref containing a
list of strings to be translated.
=cut
sub lextest {
my ($self, $lang) = @_;
$ENV{HTTP_ACCEPT_LANGUAGE} = $lang;
# we parse the XML a second time, even though it's wasteful... have to
# do it to reset the lexicon to the language we want now.
$self->parse_xml();
$self->localise($self->{xml}->{title});
foreach my $p (@{$self->{xml}->{pages}}) {
$self->localise($p->{title});
$self->localise($p->{description});
foreach my $f (@{$p->{fields}}) {
$self->localise($f->{label})
}
}
open 0 or die "Can't open perl script for grepping: $!";
LINE: while (my $line = <0>) {
last LINE if $line =~ /^__DATA__/;
while ($line =~ m/([A-Z_]{3,})/g) {
$self->localise($1);
}
}
close 0;
if (@{$self->{untranslated}}) {
return 0;
} else {
return 1;
}
}
sub localise {
my ($self, $string) = @_;
my $result = $self->SUPER::localise($string);
if ($string && $result eq $string) {
$self->{untranslated} = [ @{$self->{untranslated}}, $string ];
}
return $result;
}
1;

156
root/usr/share/perl5/vendor_perl/esmith/FormMagick/Tester.pm Normal file
View File

@@ -0,0 +1,156 @@
#!/usr/bin/perl -w
#----------------------------------------------------------------------
# Copyright 1999-2003 Mitel Networks Corporation
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
# $Id: Tester.pm,v 1.1 2002/02/26 20:45:27 skud Exp $
#----------------------------------------------------------------------
package esmith::FormMagick::Tester;
my $VERSION = $VERSION = "0.10";
use WWW::Automate;
use strict;
use Carp;
our @ISA = qw(WWW::Automate Exporter);
our @EXPORT = qw( mode );
=pod
=head1 NAME
esmith::FormMagick::Tester - test esmith FormMagick applications
=head1 SYNOPSIS
use esmith::FormMagick::Tester;
my $agent = esmith::FormMagick::Tester->new(
password => $admin_password,
host => $hostname_or_ip,
);
$agent->get_panel($panel); # eg 'useraccounts'
$agent->set_language('en');
$agent->set_language(['fr', 'en']);
=head1 DESCRIPTION
esmith::FormMagick::Tester is a subclass of WWW::Automate, which is in
turn a subclass of LWP::UserAgent. Read the documentation for
WWW::Automate to get a better idea of how to use it effectively.
=head2 new($admin_password)
Create a new agent for testing esmith FormMagick applications
(specifically, the web manager). It takes a hash of arguments, which
include:
password administrative password for the manager
(defaults to "default")
host hostname or IP to test against
(defaults to localhost)
=begin testing
BEGIN: {
use_ok('WWW::Automate');
use_ok('esmith::FormMagick::Tester');
use vars qw($agent);
}
ok(esmith::FormMagick::Tester->can('new'), "We can call new");
ok($agent = esmith::FormMagick::Tester->new(), "create agent object");
isa_ok($agent, 'esmith::FormMagick::Tester');
=end testing
=cut
sub new {
shift;
my %args = @_;
my $self = \%args;
$self->{password} ||= "default";
$self->{host} ||= "127.0.0.1";
bless $self;
return $self;
}
=head2 $agent->get_panel($panel)
Gets a panel from the web manager, calling WWW::Automate::get with a URL
built from $agent->{host} and the name of the panel you supply.
=cut
sub get_panel {
my ($self, $panel) = @_;
$self->get("http://$self->{host}/server-manager/cgi-bin/$panel");
}
=head2 $agent->set_language($lang)
Sets the language to use. This sets an the HTTP_ACCEPT_LANGUAGE header
sent by the client to the server manager. You may provide it with a
single language, eg. "en", or with a reference to a list of languages,
eg. [ qw(en de fr) ]
Sets $agent->{language} as a side effect, in case you want it for
anything later.
=begin testing
$agent->set_language("en");
is($WWW::Automate::headers{"Accept-Language"}, "en", "Set lang header in hash");
$agent->get("http://google.com");
is($agent->{req}->header("Accept-Language"), "en", "Set language header");
=end testing
=cut
sub set_language {
my ($self, $language) = @_;
$self->{language} = $language;
$self->add_header("Accept-Language" => $language);
}
=head2 mode($script)
This convenience function is exported for use in testing scripts. For
instance:
use esmith::FormMagick::Tester;
is(mode('useraccounts', 4755, "Setuid and executable");
=cut
sub mode {
return sprintf("%04o", (stat($_[0]))[2] & 07777);
}
=head1 INTERNAL METHODS
The following methods are used internally by this module.
=head2 get_basic_credentials()
Returns the administrative login/password for the esmith manager.
=cut
sub get_basic_credentials {
my $self = shift;
return ("admin", $self->{password});
}
1;