#!/usr/bin/perl use warnings; use strict; use Test::More tests => 32; BEGIN { use_ok("IkiWiki"); } # Initialize link plugin %config=IkiWiki::defaultconfig(); IkiWiki::loadplugins(); my $prefix_directives; sub linkify ($$$$) { my $lpage=shift; my $page=shift; my $content=shift; my @existing_pages=@{shift()}; # This is what linkify and htmllink need set right now to work. # This could change, if so, update it.. %IkiWiki::pagecase=(); %links=(); foreach my $p (@existing_pages) { $IkiWiki::pagecase{lc $p}=$p; $links{$p}=[]; $renderedfiles{"$p.mdwn"}=[$p]; $destsources{$p}="$p.mdwn"; } %config=IkiWiki::defaultconfig(); $config{cgiurl}="http://somehost/ikiwiki.cgi"; $config{srcdir}=$config{destdir}="/dev/null"; # placate checkconfig # currently coded for non usedirs mode (TODO: check both) $config{usedirs}=0; $config{prefix_directives}=$prefix_directives; IkiWiki::checkconfig(); return IkiWiki::linkify($lpage, $page, $content); } sub links_to ($$) { my $link=shift; my $content=shift; if ($content =~ m!!) { return 1; } else { print STDERR "# expected link to $link in $content\n"; return; } } sub not_links_to ($$) { my $link=shift; my $content=shift; if ($content !~ m!!) { return 1; } else { print STDERR "# expected no link to $link in $content\n"; return; } } sub links_text ($$) { my $text=shift; my $content=shift; if ($content =~ m!>\Q$text\E!) { return 1; } else { print STDERR "# expected link text $text in $content\n"; return; } } # Tests that are the same for both styles of prefix directives. foreach $prefix_directives (0,1) { ok(links_to("bar", linkify("foo", "foo", "link to [[bar]] ok", ["foo", "bar"])), "ok link"); ok(links_to("bar_baz", linkify("foo", "foo", "link to [[bar_baz]] ok", ["foo", "bar_baz"])), "ok link"); ok(not_links_to("bar", linkify("foo", "foo", "link to \\[[bar]] ok", ["foo", "bar"])), "escaped link"); ok(links_to("page=bar", linkify("foo", "foo", "link to [[bar]] ok", ["foo"])), "broken link"); ok(links_to("bar", linkify("foo", "foo", "link to [[baz]] and [[bar]] ok", ["foo", "baz", "bar"])), "dual links"); ok(links_to("baz", linkify("foo", "foo", "link to [[baz]] and [[bar]] ok", ["foo", "baz", "bar"])), "dual links"); ok(links_to("bar", linkify("foo", "foo", "link to [[some_page|bar]] ok", ["foo", "bar"])), "named link"); ok(links_text("some page", linkify("foo", "foo", "link to [[some_page|bar]] ok", ["foo", "bar"])), "named link text"); ok(links_text("0", linkify("foo", "foo", "link to [[0|bar]] ok", ["foo", "bar"])), "named link to 0"); ok(links_text("Some long, & complex page name.", linkify("foo", "foo", "link to [[Some_long,_&_complex_page_name.|bar]] ok, and this is not a link]] here", ["foo", "bar"])), "complex named link text"); ok(links_to("foo/bar", linkify("foo/item", "foo", "link to [[bar]] ok", ["foo", "foo/item", "foo/bar"])), "inline page link"); ok(links_to("bar", linkify("foo", "foo", "link to [[bar]] ok", ["foo", "foo/item", "foo/bar"])), "same except not inline"); ok(links_to("bar#baz", linkify("foo", "foo", "link to [[bar#baz]] ok", ["foo", "bar"])), "anchor link"); } $prefix_directives=0; ok(not_links_to("some_page", linkify("foo", "foo", "link to [[some page]] ok", ["foo", "bar", "some_page"])), "link with whitespace, without prefix_directives"); ok(not_links_to("bar", linkify("foo", "foo", "link to [[some page|bar]] ok", ["foo", "bar"])), "named link, with whitespace, without prefix_directives"); $prefix_directives=1; ok(links_to("some_page", linkify("foo", "foo", "link to [[some page]] ok", ["foo", "bar", "some_page"])), "link with whitespace"); ok(links_to("bar", linkify("foo", "foo", "link to [[some page|bar]] ok", ["foo", "bar"])), "named link, with whitespace"); ok(links_text("some page", linkify("foo", "foo", "link to [[some page|bar]] ok", ["foo", "bar"])), "named link text, with whitespace"); ich

# 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):

# Author: DWS Systems Inc.

# Web: http://www.sql-ledger.org

# This program is free software; you can redistribute it and/or modify

# it under the terms of the GNU General Public License as published by

# the Free Software Foundation; either version 2 of the License, or

# (at your option) any later version.

# This program is distributed in the hope that it will be useful,

# but WITHOUT ANY WARRANTY; without even the implied warranty of

# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the

# GNU General Public License for more details.

# You should have received a copy of the GNU General Public License

# along with this program; if not, write to the Free Software

# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

#======================================================================

# common routines for gl, ar, ap, is, ir, oe

use LedgerSMB::AA;

# any custom scripts for this one

if (-f "$form->{path}/custom_arap.pl") {

  eval { require "$form->{path}/custom_arap.pl"; };

}

if (-f "$form->{path}/$form->{login}_arap.pl") {

  eval { require "$form->{path}/$form->{login}_arap.pl"; };

}

# end of main

sub check_name {

  my ($name) = @_;

  my ($new_name, $new_id) = split /--/, $form->{$name};

  my $rv = 0;

# if we use a selection

  if ($form->{"select$name"}) {

    if ($form->{"old$name"} ne $form->{$name}) {

# this is needed for is, ir and oe

      for (split / /, $form->{taxaccounts}) { delete $form->{"${_}_rate"} }

# for credit calculations

      $form->{oldinvtotal} = 0;

      $form->{oldtotalpaid} = 0;

      $form->{calctax} = 1;

      $form->{"${name}_id"} = $new_id;

      AA->get_name(\%myconfig, \%$form);

      $form->{$name} = $form->{"old$name"} = "$new_name--$new_id";

      $form->{currency} =~ s/ //g;

# put employee together if there is a new employee_id

      $form->{employee} = "$form->{employee}--$form->{employee_id}" if $form->{employee_id};

      $rv = 1;

}

  } else {

# check name, combine name and id

    if ($form->{"old$name"} ne qq|$form->{$name}--$form->{"${name}_id"}|) {

# this is needed for is, ir and oe

      for (split / /, $form->{taxaccounts}) { delete $form->{"${_}_rate"} }

# for credit calculations

      $form->{oldinvtotal} = 0;

      $form->{oldtotalpaid} = 0;

      $form->{calctax} = 1;

# return one name or a list of names in $form->{name_list}

      if (($rv = $form->get_name(\%myconfig, $name, $form->{transdate})) > 1) {

    &select_name($name);

exit;

}

      if ($rv == 1) {

# we got one name

    $form->{"${name}_id"} = $form->{name_list}[0]->{id};

    $form->{$name} = $form->{name_list}[0]->{name};

    $form->{"old$name"} = qq|$form->{$name}--$form->{"${name}_id"}|;

    AA->get_name(\%myconfig, \%$form);

    $form->{currency} =~ s/ //g;

# put employee together if there is a new employee_id

    $form->{employee} = "$form->{employee}--$form->{employee_id}" if $form->{employee_id};

      } else {

# name is not on file

    $msg = ucfirst $name . " not on file!";

    $form->error($locale->text($msg));

}

$rv;

}

# $locale->text('Customer not on file!')

# $locale->text('Vendor not on file!')

sub select_name {

  my ($table) = @_;

  @column_index = qw(ndx name address);

  $label = ucfirst $table;

  $column_data{ndx} = qq|<th>&nbsp;</th>|;

  $column_data{name} = qq|<th class=listheading>|.$locale->text($label).qq|</th>|;

  $column_data{address} = qq|<th class=listheading colspan=5>|.$locale->text('Address').qq|</th>|;

# list items with radio button on a form

  $form->header;

  $title = $locale->text('Select from one of the names below');

print qq|

<body>

<form method=post action=$form->{script}>

<table width=100%>

<tr>

    <th class=listtop>$title</th>

</tr>

  <tr space=5></tr>

<tr>

<td>

      <table width=100%>

    <tr class=listheading>|;

  for (@column_index) { print "\n$column_data{$_}" }

print qq|

</tr>

  @column_index = qw(ndx name address city state zipcode country);

  my $i = 0;

  foreach $ref (@{ $form->{name_list} }) {

    $checked = ($i++) ? "" : "checked";

    $ref->{name} = $form->quote($ref->{name});

   $column_data{ndx} = qq|<td><input name=ndx class=radio type=radio value=$i $checked></td>|;

   $column_data{name} = qq|<td><input name="new_name_$i" type=hidden value="$ref->{name}">$ref->{name}</td>|;

   $column_data{address} = qq|<td>$ref->{address1} $ref->{address2}</td>|;

   for (qw(city state zipcode country)) { $column_data{$_} = qq|<td>$ref->{$_}&nbsp;</td>| }

    $j++; $j %= 2;

print qq|

    <tr class=listrow$j>|;

    for (@column_index) { print "\n$column_data{$_}" }

print qq|

</tr>

<input name="new_id_$i" type=hidden value=$ref->{id}>

}

print qq|

</table>

</td>

</tr>

<tr>

    <td><hr size=3 noshade></td>

</tr>

</table>

<input name=lastndx type=hidden value=$i>

# delete variables

  for (qw(nextsub name_list)) { delete $form->{$_} }

  $form->{action} = "name_selected";

  $form->hide_form;

print qq|

<input type=hidden name=nextsub value=name_selected>

<input type=hidden name=vc value=$table>

<br>

<input class=submit type=submit name=action value="|.$locale->text('Continue').qq|">

</form>

</body>

</html>

}

sub name_selected {

# replace the variable with the one checked

# index for new item

  $i = $form->{ndx};

  $form->{$form->{vc}} = $form->{"new_name_$i"};

  $form->{"$form->{vc}_id"} = $form->{"new_id_$i"};

  $form->{"old$form->{vc}"} = qq|$form->{$form->{vc}}--$form->{"$form->{vc}_id"}|;

# delete all the new_ variables

  for $i (1 .. $form->{lastndx}) {

    for (qw(id, name)) { delete $form->{"new_${_}_$i"} }

}

  for (qw(ndx lastndx nextsub)) { delete $form->{$_} }

  AA->get_name(\%myconfig, \%$form);

# put employee together if there is a new employee_id

  $form->{employee} = "$form->{employee}--$form->{employee_id}" if $form->{employee_id};

  &update(1);

}

sub rebuild_vc {

  my ($vc, $ARAP, $transdate, $job) = @_;

  ($null, $form->{employee_id}) = split /--/, $form->{employee};

  $form->all_vc(\%myconfig, $vc, $ARAP, undef, $transdate, $job);

  $form->{"select$vc"} = "";

  for (@{ $form->{"all_$vc"} }) { $form->{"select$vc"} .= qq|<option value="$_->{name}--$_->{id}">$_->{name}\n| }

  $form->{selectprojectnumber} = "";

  if (@{ $form->{all_project} }) {

    $form->{selectprojectnumber} = "<option>\n";

    for (@{ $form->{all_project} }) { $form->{selectprojectnumber} .= qq|<option value="$_->{projectnumber}--$_->{id}">$_->{projectnumber}\n| }

}

sub add_transaction {

  my ($module) = @_;

  delete $form->{script};

  $form->{action} = "add";

  $form->{type} = "invoice" if $module =~ /(is|ir)/;

  $form->{callback} = $form->escape($form->{callback},1);

  $argv = "";

  for (keys %$form) { $argv .= "$_=$form->{$_}&" }

  $form->{callback} = "$module.pl?$argv";

  $form->redirect;

}

sub check_project {

  for $i (1 .. $form->{rowcount}) {

    $form->{"project_id_$i"} = "" unless $form->{"projectnumber_$i"};

    if ($form->{"projectnumber_$i"} ne $form->{"oldprojectnumber_$i"}) {

      if ($form->{"projectnumber_$i"}) {

# get new project

    $form->{projectnumber} = $form->{"projectnumber_$i"};

    if (($rows = PE->projects(\%myconfig, $form)) > 1) {

# check form->{project_list} how many there are

      $form->{rownumber} = $i;

&select_project;

exit;

}

    if ($rows == 1) {

      $form->{"project_id_$i"} = $form->{project_list}->[0]->{id};

      $form->{"projectnumber_$i"} = $form->{project_list}->[0]->{projectnumber};

      $form->{"oldprojectnumber_$i"} = $form->{project_list}->[0]->{projectnumber};

    } else {

# not on file

      $form->error($locale->text('Project not on file!'));

}

      } else {

    $form->{"oldprojectnumber_$i"} = "";

}

sub select_project {

  @column_index = qw(ndx projectnumber description);

  $column_data{ndx} = qq|<th>&nbsp;</th>|;

  $column_data{projectnumber} = qq|<th>|.$locale->text('Number').qq|</th>|;

  $column_data{description} = qq|<th>|.$locale->text('Description').qq|</th>|;

# list items with radio button on a form

  $form->header;

  $title = $locale->text('Select from one of the projects below');

print qq|

<body>

<form method=post action=$form->{script}>

<input type=hidden name=rownumber value=$form->{rownumber}>

<table width=100%>

<tr>

    <th class=listtop>$title</th>

</tr>

  <tr space=5></tr>

<tr>

<td>

      <table width=100%>

    <tr class=listheading>|;

  for (@column_index) { print "\n$column_data{$_}" }

print qq|

</tr>

  my $i = 0;

  foreach $ref (@{ $form->{project_list} }) {

    $checked = ($i++) ? "" : "checked";

    $ref->{name} = $form->quote($ref->{name});

   $column_data{ndx} = qq|<td><input name=ndx class=radio type=radio value=$i $checked></td>|;

   $column_data{projectnumber} = qq|<td><input name="new_projectnumber_$i" type=hidden value="$ref->{projectnumber}">$ref->{projectnumber}</td>|;

   $column_data{description} = qq|<td>$ref->{description}</td>|;

    $j++; $j %= 2;

print qq|

        <tr class=listrow$j>|;

    for (@column_index) { print "\n$column_data{$_}" }

print qq|

</tr>

<input name="new_id_$i" type=hidden value=$ref->{id}>

}

print qq|

</table>

</td>

</tr>

<tr>

    <td><hr size=3 noshade></td>

</tr>

</table>

<input name=lastndx type=hidden value=$i>

# delete list variable

  for (qw(nextsub project_list)) { delete $form->{$_} }

  $form->{action} = "project_selected";

  $form->hide_form;

print qq|

<input type=hidden name=nextsub value=project_selected>

<br>

<input class=submit type=submit name=action value="|.$locale->text('Continue').qq|">

</form>

</body>

</html>

}

sub project_selected {

# replace the variable with the one checked

# index for new item

  $i = $form->{ndx};

  $form->{"projectnumber_$form->{rownumber}"} = $form->{"new_projectnumber_$i"};

  $form->{"oldprojectnumber_$form->{rownumber}"} = $form->{"new_projectnumber_$i"};

  $form->{"project_id_$form->{rownumber}"} = $form->{"new_id_$i"};

# delete all the new_ variables

  for $i (1 .. $form->{lastndx}) {

    for (qw(id projectnumber description)) { delete $form->{"new_${_}_$i"} }

}

  for (qw(ndx lastndx nextsub)) { delete $form->{$_} }

  if ($form->{update}) {

    &{ $form->{update} };

  } else {

&update;

}

sub post_as_new {

  for (qw(id printed emailed queued)) { delete $form->{$_} }

&post;

}

sub print_and_post_as_new {

  for (qw(id printed emailed queued)) { delete $form->{$_} }

&print_and_post;

}

sub repost {

  if ($form->{type} =~ /_order/) {

    if ($form->{print_and_save}) {

      $form->{nextsub} = "print_and_save";

      $msg = $locale->text('You are printing and saving an existing order');

    } else {

      $form->{nextsub} = "save";

      $msg = $locale->text('You are saving an existing order');

}

  } elsif ($form->{type} =~ /_quotation/) {

    if ($form->{print_and_save}) {

      $form->{nextsub} = "print_and_save";

      $msg = $locale->text('You are printing and saving an existing quotation');

    } else {

      $form->{nextsub} = "save";

      $msg = $locale->text('You are saving an existing quotation');

}

  } else {

    if ($form->{print_and_post}) {

      $form->{nextsub} = "print_and_post";

      $msg = $locale->text('You are printing and posting an existing transaction!');

    } else {

      $form->{nextsub} = "post";

      $msg = $locale->text('You are posting an existing transaction!');

}

  delete $form->{action};

  $form->{repost} = 1;

  $form->header;

print qq|

<body>

<form method=post action=$form->{script}>

  $form->hide_form;

print qq|

<h2 class=confirm>|.$locale->text('Warning!').qq|</h2>

<h4>$msg</h4>

<input name=action class=submit type=submit value="|.$locale->text('Continue').qq|">

</form>

</body>

</html>

}

sub schedule {

  ($form->{recurringreference}, $form->{recurringstartdate}, $form->{recurringrepeat}, $form->{recurringunit}, $form->{recurringhowmany}, $form->{recurringpayment}, $form->{recurringprint}, $form->{recurringemail}, $form->{recurringmessage}) = split /,/, $form->{recurring};

  $form->{recurringreference} = $form->quote($form->unescape($form->{recurringreference}));

  $form->{recurringmessage} = $form->quote($form->unescape($form->{recurringmessage}));

  $form->{recurringstartdate} ||= $form->{transdate};

  $recurringpayment = "checked" if $form->{recurringpayment};

  if ($form->{paidaccounts}) {

    $postpayment = qq|

<tr>

      <th align=right nowrap>|.$locale->text('Include Payment').qq|</th>

      <td><input name=recurringpayment type=checkbox class=checkbox value=1 $recurringpayment></td>

</tr>

}

  if ($form->{recurringnextdate}) {

    $nextdate = qq|

<tr>

        <th align=right nowrap>|.$locale->text('Next Date').qq|</th>

        <td><input name=recurringnextdate size=11 title="($myconfig{'dateformat'})" value=$form->{recurringnextdate}></td>

</tr>

}

  @a = split /<option/, $form->unescape($form->{selectformname});

%formname = ();

  for ($i = 1; $i <= $#a; $i++) {

    $a[$i] =~ /"(.*)"/;

    $v = $1;

    $a[$i] =~ />(.*)/;

    $formname{$v} = $1;

}

  for (qw(check receipt)) { delete $formname{$_} }

  $selectformat = $form->unescape($form->{selectformat});

  if ($form->{type} !~ /transaction/ && %formname) {

    $email = qq|

<table>

<tr>

        <th colspan=2 class=listheading>|.$locale->text('E-mail').qq|</th>

</tr>

<tr>

<td>

<table>

# formname:format

    @p = split /:/, $form->{recurringemail};

%p = ();

    for ($i = 0; $i <= $#p; $i += 2) {

      $p{$p[$i]}{format} = $p[$i+1];

}

    foreach $item (keys %formname) {

      $checked = ($p{$item}{format}) ? "checked" : "";

      $selectformat =~ s/ selected//;

      $p{$item}{format} ||= "pdf";

      $selectformat =~ s/(<option value="\Q$p{$item}{format}\E")/$1 selected/;

      $email .= qq|

<tr>

          <td><input name="email$item" type=checkbox class=checkbox value=1 $checked></td>

          <th align=left>$formname{$item}</th>

          <td><select name="emailformat$item">$selectformat</select></td>

</tr>

}

    $email .= qq|

</table>

</td>

</tr>

</table>

    $message = qq|

<table>

<tr>

        <th class=listheading>|.$locale->text('E-mail message').qq|</th>

</tr>

<tr>

        <td><textarea name="recurringmessage" rows=10 cols=60 wrap=soft>$form->{recurringmessage}</textarea></td>

</tr>

</table>

}

  if (%printer && $latex && %formname) {

    $selectprinter = qq|<option>\n|;

    for (sort keys %printer) { $selectprinter .= qq|<option value="$_">$_\n| }

# formname:format:printer

    @p = split /:/, $form->{recurringprint};

%p = ();

    for ($i = 0; $i <= $#p; $i += 3) {

      $p{$p[$i]}{formname} = $p[$i];

      $p{$p[$i]}{format} = $p[$i+1];

      $p{$p[$i]}{printer} = $p[$i+2];

}

    $print = qq|

<table>

<tr>