[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
SF.net SVN: ledger-smb: [1400] trunk/LedgerSMB/Form.pm
- Subject: SF.net SVN: ledger-smb: [1400] trunk/LedgerSMB/Form.pm
- From: ..hidden..
- Date: Sun, 15 Jul 2007 18:56:56 -0700
Revision: 1400
http://svn.sourceforge.net/ledger-smb/?rev=1400&view=rev
Author: tetragon
Date: 2007-07-15 18:56:56 -0700 (Sun, 15 Jul 2007)
Log Message:
-----------
Partial podification
Modified Paths:
--------------
trunk/LedgerSMB/Form.pm
Modified: trunk/LedgerSMB/Form.pm
===================================================================
--- trunk/LedgerSMB/Form.pm 2007-07-16 00:03:37 UTC (rev 1399)
+++ trunk/LedgerSMB/Form.pm 2007-07-16 01:56:56 UTC (rev 1400)
@@ -1,38 +1,62 @@
-#=====================================================================
-# LedgerSMB
-# Small Medium Business Accounting software
-# http://www.ledgersmb.org/
-#
-# Copyright (C) 2006
-# This work contains copyrighted information from a number of sources all used
-# with permission.
-#
-# This file contains source code included with or based on SQL-Ledger which
-# is Copyright Dieter Simader and DWS Systems Inc. 2000-2005 and licensed
-# under the GNU General Public License version 2 or, at your option, any later
-# version. For a full list including contact information of contributors,
-# maintainers, and copyright holders, see the CONTRIBUTORS file.
-#
-# Original Copyright Notice from SQL-Ledger 2.6.17 (before the fork):
-# Copyright (C) 2000
-#
-# Author: DWS Systems Inc.
-# Web: http://www.sql-ledger.org
-#
-# Contributors: Thomas Bayen <..hidden..>
-# Antti Kaihola <..hidden..>
-# Moritz Bunkus (tex)
-# Jim Rawlings <..hidden..> (DB2)
-#======================================================================
-#
-# This file has undergone whitespace cleanup.
-#
-#======================================================================
-#
-# main package
-#
-#======================================================================
+=head1 NAME
+
+Form
+
+=head1 SYNOPSIS
+
+This module provides general legacy support functions and the central object
+
+=head1 STATUS
+
+Deprecated
+
+=head1 COPYRIGHT
+
+ #====================================================================
+ # LedgerSMB
+ # Small Medium Business Accounting software
+ # http://www.ledgersmb.org/
+ #
+ # Copyright (C) 2006
+ # This work contains copyrighted information from a number of sources
+ # all used with permission.
+ #
+ # This file contains source code included with or based on SQL-Ledger
+ # which is Copyright Dieter Simader and DWS Systems Inc. 2000-2005
+ # and licensed under the GNU General Public License version 2 or, at
+ # your option, any later version. For a full list including contact
+ # information of contributors, maintainers, and copyright holders,
+ # see the CONTRIBUTORS file.
+ #
+ # Original Copyright Notice from SQL-Ledger 2.6.17 (before the fork):
+ # Copyright (C) 2000
+ #
+ # Author: DWS Systems Inc.
+ # Web: http://www.sql-ledger.org
+ #
+ # Contributors: Thomas Bayen <..hidden..>
+ # Antti Kaihola <..hidden..>
+ # Moritz Bunkus (tex)
+ # Jim Rawlings <..hidden..> (DB2)
+ #====================================================================
+ #
+ # This file has undergone whitespace cleanup.
+ #
+ #====================================================================
+ #
+ # main package
+ #
+ #====================================================================
+
+=head1 METHODS
+
+=over
+
+=cut
+
+#inline documentation
+
use Math::BigFloat lib => 'GMP';
use LedgerSMB::Sysconfig;
use List::Util qw(first);
@@ -109,6 +133,13 @@
$self;
}
+=item $form->debug([$file]);
+
+Outputs the sorted contents of $form. If a filename is specified, log to it,
+otherwise output to STDOUT.
+
+=cut
+
sub debug {
my ( $self, $file ) = @_;
@@ -135,6 +166,14 @@
# TODO
}
+=item $form->escape($str[, $beenthere]);
+
+Returns the URI-encoded $str. $beenthere is a boolean that when true forces a
+single encoding run. When false, it escapes the string twice if it detects
+that it is running on a version of Apache 2.0 earlier than 2.0.44.
+
+=cut
+
sub escape {
my ( $self, $str, $beenthere ) = @_;
@@ -151,6 +190,12 @@
}
+=item $form->unescape($str);
+
+Returns the unencoded form of the URI-encoded $str.
+
+=cut
+
sub unescape {
my ( $self, $str ) = @_;
@@ -166,6 +211,13 @@
}
+=item $form->quote($str);
+
+Replaces all double quotes in $str with '"'. Does nothing if $str is a
+reference.
+
+=cut
+
sub quote {
my ( $self, $str ) = @_;
@@ -177,6 +229,13 @@
}
+=item $form->unquote($str);
+
+Replaces all '"' in $str with double quotes. Does nothing if $str is a
+reference.
+
+=cut
+
sub unquote {
my ( $self, $str ) = @_;
@@ -188,6 +247,19 @@
}
+=item $form->hide_form([...]);
+
+Outputs hidden HTML form fields to STDOUT. If values are passed into this
+function, only those $form values are output. If no values are passed in, all
+$form values are output as well as deleting $form->{header}. Values from the
+$form object are run through $form->quote, whereas keys/names are not.
+
+Sample output:
+
+ <input type="hidden" name="login" value="testuser" />
+
+=cut
+
sub hide_form {
my $self = shift;
@@ -211,6 +283,20 @@
}
}
+
+=item $form->error($msg);
+
+Output an error message, $msg. If a CGI environment is detected, this outputs
+an HTTP and HTML header section if required, and displays the message after
+running it through $form->format_string. If it is not a CGI environment and
+$ENV{error_function} is set, call the specified function with $msg as the sole
+argument. Otherwise, this function simply dies with $msg.
+
+This function does not return. Execution is terminated at the end of the
+appropriate path.
+
+=cut
+
sub error {
my ( $self, $msg ) = @_;
@@ -242,6 +328,16 @@
}
}
+=item $form->info($msg);
+
+Output an informational message, $msg. If a CGI environment is detected, this
+outputs an HTTP and HTML header section if required, and displays the message
+in bold tags without escaping. If it is not a CGI environment and
+$ENV{info_function} is set, call the specified function with $msg as the sole
+argument. Otherwise, this function simply prints $msg to STDOUT.
+
+=cut
+
sub info {
my ( $self, $msg ) = @_;
@@ -270,6 +366,15 @@
}
}
+=item $form->numtextrows($str, $cols[, $maxrows]);
+
+Returns the number of rows of $cols columns can be formed by $str. If $maxrows
+is set and the number of rows is greater than $maxrows, this returns $maxrows.
+In the determination of rowcount, newline characters, "\n", are taken into
+account while spaces are not.
+
+=cut
+
sub numtextrows {
my ( $self, $str, $cols, $maxrows ) = @_;
@@ -286,16 +391,46 @@
}
+=item $form->dberror($msg);
+
+Outputs a message as in $form->error but with $DBI::errstr automatically
+appended to $msg.
+
+=cut
+
sub dberror {
my ( $self, $msg ) = @_;
$self->error( "$msg\n" . $DBI::errstr );
}
+=item $form->isblank($name, $msg);
+
+Calls $form->error($msg) if the value of $form->{$name} matches /^\s*$/.
+
+=cut
+
sub isblank {
my ( $self, $name, $msg ) = @_;
$self->error($msg) if $self->{$name} =~ /^\s*$/;
}
+=item $form->header([$init, $headeradd]);
+
+Outputs HTML and HTTP headers and sets $form->{header} to indicate that headers
+have been output. If called with $form->{header} set or in a non-CGI
+environment, does not output anything. $init is ignored. $headeradd is data
+to be added to the <head> portion of the output headers. $form->{stylesheet},
+$form->{title}, $form->{titlebar}, and $form->{pre} all affect the output of
+this function.
+
+If the stylesheet indicated by $form->{stylesheet} exists, output a link tag
+to reference it. If $form->{title} is false, the title text is the value of
+$form->{titlebar}. If $form->{title} is true, the title text takes the form of
+"$form->{title} - $form->{titlebar}". The value of $form->{pre} is output
+immediately after the closing of <head>.
+
+=cut
+
sub header {
my ( $self, $init, $headeradd ) = @_;
@@ -341,6 +476,15 @@
$self->{header} = 1;
}
+=item $form->redirect([$msg]);
+
+If $form->{callback} is set or $msg is not set, call the redirect function in
+common.pl. If main::redirect returns, exit.
+
+Otherwise, output $msg as an informational message with $form->info($msg).
+
+=cut
+
sub redirect {
my ( $self, $msg ) = @_;
@@ -356,6 +500,16 @@
}
}
+=item $form->sort_columns(@columns);
+
+Sorts the list @columns. If $form->{sort} is unset, do nothing. If the value
+of $form->{sort} does not exist in @columns, returns the list formed by the
+value of $form->{sort} followed by the values of @columns. If the value of
+$form->{sort} is in @columns, return the list formed by @columns with the value
+of $form->{sort} moved to the head of the list.
+
+=cut
+
sub sort_columns {
my ( $self, @columns ) = @_;
@@ -370,6 +524,24 @@
@columns;
}
+=item $form->sort_order($columns[, $ordinal]);
+
+Returns a string that contains ordering details for the columns in SQL form.
+$columns is a reference to a list of columns, $ordinal is a reference to a hash
+that maps column names to ordinal positions. This function depends upon the
+values of $form->{direction}, $form->{sort}, and $form->{oldsort}.
+
+If $form->{direction} is false, it becomes 'ASC'. If $form->{direction} is true
+and $form->{sort} and $form->{oldsort} are equal, reverse the order specified by
+$form->{direction}. $form->{oldsort} is set to the same value as $form->{sort}
+
+The actual sorting of $columns happens as in $form->sort_columns(@$columns).
+
+If $ordinal is set, the positions given by it are substituted for the names of
+columns returned.
+
+=cut
+
sub sort_order {
my ( $self, $columns, $ordinal ) = @_;
@@ -416,6 +588,27 @@
$sortorder;
}
+=item $form->format_amount($myconfig, $amount, $places, $dash);
+
+Returns $amount as formatted in the form specified by $form->{numberformat}.
+$places is the number of decimal places to have in the output. $dash indicates
+how to represent conditions surrounding values.
+
+ +-------+----------+---------+------+
+ | $dash | -1.00 | 1.00 | 0.00 |
+ +-------+----------+---------+------+
+ | - | (1.00) | 1.00 | - |
+ | DRCR | 1.00 DR | 1.00 CR | DRCR |
+ | 0 | -1.00 | 1.00 | 0.00 |
+ | x | -1.00 | 1.00 | x |
+ | undef | -1.00 | 1.00 | |
+ +-------+----------+---------+------+
+
+Sample behaviour of the formatted output of various numbers for select $dash
+values.
+
+=cut
+
sub format_amount {
my ( $self, $myconfig, $amount, $places, $dash ) = @_;
@@ -516,6 +709,15 @@
$amount;
}
+=item $form->parse_amount($myconfig, $amount);
+
+Return a Math::BigFloat containing the value of $amount where $amount is
+formatted as $myconfig->{numberformat}. If $amount is '' or undefined, it is
+treated as zero. DRCR and parenthesis notation is accepted in addition to
+negative sign notation.
+
+=cut
+
sub parse_amount {
my ( $self, $myconfig, $amount ) = @_;
@@ -562,6 +764,12 @@
return ( $amount * 1 );
}
+=item rount_amount($amount, $places);
+
+Rounds the provided $amount to $places decimal places.
+
+=cut
+
sub round_amount {
my ( $self, $amount, $places ) = @_;
@@ -583,6 +791,13 @@
return $amount;
}
+=item $form->db_parse_numeric('sth' => $sth, ['arrayref' => $arrayref, 'hashref' => $hashref])
+
+Converts numeric values in the result set $arrayref or $hashref to
+Math::BigFloat using $sth to determine which fields are numeric.
+
+=cut
+
sub db_parse_numeric {
my $self = shift;
my %args = @_;
@@ -637,6 +852,13 @@
$form->{'emp_num'} = $id;
}
+=item $form->format_string(@fields);
+
+Escape the values of $form selected by @fields for the format specified by
+$form->{format}.
+
+=cut
+
sub format_string {
my ( $self, @fields ) = @_;
@@ -691,6 +913,18 @@
}
+=item $form->datetonum($myconfig, $date[, $picture]);
+
+Converts $date from the format $myconfig->{dateformat} to the format 'yyyymmdd'.
+If the year extracted is only two-digits, the year given is assumed to be in the
+range 2000-2099.
+
+If $date does not contain any digits, datetonum does nothing.
+
+$picture is ignored.
+
+=cut
+
sub datetonum {
my ( $self, $myconfig, $date, $picture ) = @_;
@@ -720,6 +954,18 @@
$date;
}
+=item $form->add_date($myconfig, $date, $repeat, $unit);
+
+Returns the date $repeat $units from $date in the input format. $date can
+either be in $myconfig->{dateformat} or 'yyyymmdd' (four digit year required for
+this option). The valid values for $unit are 'days', 'weeks', 'months', and
+'years'.
+
+This function is unreliable for $unit values other than 'days' or 'weeks' and
+can die horribly.
+
+=cut
+
sub add_date {
my ( $self, $myconfig, $date, $repeat, $unit ) = @_;
@@ -804,6 +1050,18 @@
$date;
}
+=item $form->print_button($button, $name);
+
+Outputs a submit button to STDOUT. $button is a hashref that contains data
+about buttons, $name is the key for the element in $button to output. Each
+value in $button is a reference to a hash of two elements, 'key' and 'value'.
+
+$name is the value of the button that gets sent to the server when clicked,
+$button->{$name}{key} is the accesskey, and $button->{$name}{value} is the label
+for the button.
+
+=cut
+
sub print_button {
my ( $self, $button, $name ) = @_;
@@ -978,6 +1236,13 @@
$dbh;
}
+=item $form->dbquote($var);
+
+If $var is an empty string, return NULL, otherwise return $var as quoted by
+$form->{dbh}->quote($var).
+
+=cut
+
sub dbquote {
my ( $self, $var ) = @_;
@@ -1757,6 +2022,15 @@
$sth->finish;
}
+=item $form->current_date($myconfig[, $thisdate, $days]);
+
+If $thisdate is false, get the current date from the database.
+
+If $thisdate is true, get the date $days days from $thisdate in the date
+format specified by $myconfig->{dateformat} from the database.
+
+=cut
+
sub current_date {
my ( $self, $myconfig, $thisdate, $days ) = @_;
@@ -1794,6 +2068,12 @@
$thisdate;
}
+=item $form->like($str);
+
+Returns '%$str%'
+
+=cut
+
sub like {
my ( $self, $str ) = @_;
@@ -2382,6 +2662,18 @@
}
}
+=item $form->split_date($dateformat[, $date]);
+
+Returns ($rv, $yy, $mm, $dd) for the provided $date, or the current date if no
+date is provided. $rv is a seperator-free merging of the fields $yy, $mm, and
+$dd in the ordering supplied by $dateformat. If the supplied $date does not
+contain non-digit characters, $rv is $date and the other return values are
+undefined.
+
+$yy is two digits.
+
+=cut
+
sub split_date {
my ( $self, $dateformat, $date ) = @_;
@@ -2467,6 +2759,17 @@
( $rv, $yy, $mm, $dd );
}
+=item $form->format_date($date);
+
+Returns $date converted from 'yyyy-mm-dd' format to the format specified by
+$form->{db_dateformat}. If the supplied date does not match /^\d{4}\D/,
+return the supplied date.
+
+This function takes a four digit year and returns the date with a four digit
+year.
+
+=cut
+
sub format_date {
# takes an iso date in, and converts it to the date for printing
@@ -2485,6 +2788,17 @@
$datestring;
}
+=item $form->from_to($yyyy, $mm[, $interval]);
+
+Returns the date $yyyy-$mm-01 and the the last day of the month interval - 1
+months from then in the form ($form->format_date(fromdate),
+$form->format_date(later)). If $interval is false but defined, the later date
+is the current date.
+
+This function dies horribly when $mm + $interval > 24
+
+=cut
+
sub from_to {
my ( $self, $yyyy, $mm, $interval ) = @_;
@@ -2655,3 +2969,7 @@
}
1;
+
+=back
+
+
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.