From chris at mkdoc.demon.co.uk Mon Jul 11 12:11:50 2005 From: chris at mkdoc.demon.co.uk (chris@mkdoc.demon.co.uk) Date: Mon Jul 11 12:11:54 2005 Subject: [MKDoc-commit] Patch from Sam to add Descriptions to Image components. Message-ID: <20050711111150.8B9AD2E28E7@mkdoc.demon.co.uk> Log Message: ----------- Patch from Sam to add Descriptions to Image components. Tags: ---- mkdoc-1-6 Modified Files: -------------- mkd/flo/editor: Image.pm mkd/templates/component/image: en.html mkd/templates/editor/image: en.html -------------- next part -------------- Index: en.html =================================================================== RCS file: /var/spool/cvs/mkd/templates/component/image/Attic/en.html,v retrieving revision 1.1.2.6 retrieving revision 1.1.2.7 diff -Ltemplates/component/image/en.html -Ltemplates/component/image/en.html -u -r1.1.2.6 -r1.1.2.7 --- templates/component/image/en.html +++ templates/component/image/en.html @@ -11,11 +11,14 @@ > a beautiful image Index: Image.pm =================================================================== RCS file: /var/spool/cvs/mkd/flo/editor/Image.pm,v retrieving revision 1.7.2.26 retrieving revision 1.7.2.27 diff -Lflo/editor/Image.pm -Lflo/editor/Image.pm -u -r1.7.2.26 -r1.7.2.27 --- flo/editor/Image.pm +++ flo/editor/Image.pm @@ -111,18 +111,12 @@ # if CGI is defined, then we probably want to do some stuff if (defined $cgi) { - # update alt field - if (defined $cgi->param ($param_name . "_alt")) - { - my $alt = $cgi->param ($param_name . "_alt"); - $self->{title} = $alt; - } - else - { - my $empty = ""; - $self->{title} = $empty; - } - + # update fields + $self->{title} = $cgi->param($param_name . "_alt"); + $self->{title} = "" unless defined $self->{title}; + $self->{description} = $cgi->param($param_name . "_description"); + $self->{description} = "" unless defined $self->{description}; + # if the upload field is not empty, then the user # just uploaded a new image if (defined $cgi->param ($param_name . "_upload")) @@ -199,7 +193,7 @@ sub description { my $self = shift; - return $self->{title}; + return $self->{description}; } Index: en.html =================================================================== RCS file: /var/spool/cvs/mkd/templates/editor/image/Attic/en.html,v retrieving revision 1.1.2.9 retrieving revision 1.1.2.10 diff -Ltemplates/editor/image/en.html -Ltemplates/editor/image/en.html -u -r1.1.2.9 -r1.1.2.10 --- templates/editor/image/en.html +++ templates/editor/image/en.html @@ -13,6 +13,7 @@ name_move_down string:${self/block_name}_down; name_delete string:${self/block_name}_delete; name_alt string:${self/block_name}_alt; + name_description string:${self/block_name}_description; name_upload string:${self/block_name}_upload; dir self/direction; align self/align" @@ -127,6 +128,37 @@ lang="en" dir="ltr" > + The description of the image. This may be used to describe + the image to site visitors. + + +
+ +

+ +

+ Use the Browse button to select the file from your computer and the Upload button to upload it. From chris at mkdoc.demon.co.uk Wed Jul 13 15:11:42 2005 From: chris at mkdoc.demon.co.uk (chris@mkdoc.demon.co.uk) Date: Wed Jul 13 15:11:49 2005 Subject: [MKDoc-commit] Patch from Sam to enable external links to open in new windows. Message-ID: <20050713141142.50B452E28E7@mkdoc.demon.co.uk> Log Message: ----------- Patch from Sam to enable external links to open in new windows. Tags: ---- mkdoc-1-6 Modified Files: -------------- mkd/flo: Editor.pm mkd/flo/editor: Link.pm mkd/templates/editor/link: en.html Added Files: ----------- mkd/MKDoc/Util: LinkParser.pm mkd/tools: update_links.pl -------------- next part -------------- Index: Editor.pm =================================================================== RCS file: /var/spool/cvs/mkd/flo/Editor.pm,v retrieving revision 1.12.2.41 retrieving revision 1.12.2.42 diff -Lflo/Editor.pm -Lflo/Editor.pm -u -r1.12.2.41 -r1.12.2.42 --- flo/Editor.pm +++ flo/Editor.pm @@ -31,6 +31,10 @@ use 5.008_000; use utf8; +# Set this to true and external links (as determined by +# MKDoc::Util::LinkParser) will open in a new window. +our $EXTERNAL_LINKS_OPEN_IN_NEW_WINDOW = 1; + use constant BLOCK => 'edit_block'; @@ -149,9 +153,11 @@ ## # $self->links; # ------------- -# This subroutine returns all the links of the current document -# and caches them into $LINKS, these links can then be used by -# MKDoc::XML::Tagger to linkify the whole document. +# This subroutine returns all the links of the current document and +# caches them into $LINKS, these links can then be used by +# MKDoc::XML::Tagger to linkify the whole document. The actual calls +# to MKDoc::XML::Tagger occur in the components which may contain +# links - flo::editor::Text and flo::editor::HTML, for example. # # It may look like a horrible hack (and it is), but since the # component system needs to be redesigned it does not bother @@ -176,12 +182,26 @@ # retrieve the links for that document foreach my $link_component (@links_components) { + my $url = $link_component->render_url; + + # setup class based on whether this is an internal or external link + my $class = "mkdoc-link-" . ( $link_component->is_internal ? + "internal" : "external" ); + + # setup target to open a new window in needed + my @target; + if ($EXTERNAL_LINKS_OPEN_IN_NEW_WINDOW and + not $link_component->is_internal) { + @target = (target => "_blank"); + } + push @links, { - class => "mkdoc-link", - href => $link_component->url, - desc => $link_component->description, - expr => $link_component->title, - } if ($link_component->url ne '' and $link_component->title ne ''); + class => $class, + href => $url, + desc => $link_component->description, + expr => $link_component->title, + @target, + } if ($url ne '' and $link_component->title ne ''); } # plus we want to hyperlink all the children Index: Link.pm =================================================================== RCS file: /var/spool/cvs/mkd/flo/editor/Link.pm,v retrieving revision 1.7.2.20 retrieving revision 1.7.2.21 diff -Lflo/editor/Link.pm -Lflo/editor/Link.pm -u -r1.7.2.20 -r1.7.2.21 --- flo/editor/Link.pm +++ flo/editor/Link.pm @@ -26,12 +26,18 @@ use flo::Standard; use MKDoc::CGI; use MKDoc::Util::Text2HTML; +use MKDoc::Util::LinkParser; use strict; use base qw /flo::Component flo::editor::Mixin::compute_name flo::editor::Mixin::normalize_name/; +# keep a global link parser around +my $link_parser = MKDoc::Util::LinkParser->new(); + +# placeholder for the URL entry field +my $EMPTY_URL = 'http://'; sub preferred_extension { 'link' } @@ -47,11 +53,49 @@ my $self = shift; my $args = $self->cgi_args() || return; - $self->{url} = $args->{'url'} || 'http://'; $self->{title} = $args->{'title'} || ''; $self->{description} = $args->{'description'} || ''; + + if ($args->{url}) { + $self->parse_url($args->{url}); + } else { + $self->{url} = $EMPTY_URL; + } +} + + +sub parse_url { + my ($self, $url) = @_; + $link_parser->parse($url); + + if ($link_parser->is_internal and $link_parser->is_valid) { + # store relevent details for an internal link (invalid + # links are handled by validate_url) + $self->{internal_link} = $link_parser->freeze(); + + # reflect the canonical form in the UI + $self->{url} = $link_parser->as_string; + } else { + # store just the url as entered for external links + delete $self->{internal_link}; + $self->{url} = $url; + } } +# template rendering for the URL +sub render_url { + my $self = shift; + if ($self->{internal_link}) { + $link_parser->thaw($self->{internal_link}); + return $link_parser->as_string; + } else { + return $self->{url}; + } +} + +sub is_internal { + return shift->{internal_link} ? 1 : 0; +} sub validate { @@ -70,10 +114,16 @@ sub validate_url { my $self = shift; - $self->{url} and $self->{url} ne 'http://' or do { + $self->{url} and $self->{url} ne $EMPTY_URL or do { new MKDoc::Ouch 'component/link/url_empty'; return 0; }; + + $link_parser->parse($self->{url}); + if ($link_parser->is_internal and not $link_parser->is_valid) { + new MKDoc::Ouch 'component/link/invalid_internal_url'; + return 0; + } return 1; } Index: en.html =================================================================== RCS file: /var/spool/cvs/mkd/templates/editor/link/Attic/en.html,v retrieving revision 1.1.2.9 retrieving revision 1.1.2.10 diff -Ltemplates/editor/link/en.html -Ltemplates/editor/link/en.html -u -r1.1.2.9 -r1.1.2.10 --- templates/editor/link/en.html +++ templates/editor/link/en.html @@ -50,6 +50,10 @@ >The 'URI' field is empty.

The 'URI' field points to a document which does not exist.

+

The 'Description' field is empty.

@@ -110,7 +114,7 @@ value="http://example.com/" size="35" title="Enter the URI of the link here." - petal:attributes="name name_url; id name_url; value self/url" + petal:attributes="name name_url; id name_url; value self/render_url" />

--- /dev/null +++ MKDoc/Util/LinkParser.pm @@ -0,0 +1,307 @@ +# ---------------------------------------------------------------------------- +# MKDoc::Util::LinkParser +# ---------------------------------------------------------------------------- +# Author: Sam Tregar +# Copyright: (c) MKDoc Holdings Ltd, 2005 +# +# This file is part of MKDoc. +# +# MKDoc 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. +# +# MKDoc 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 MKDoc; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +# +# --------------------------------------------------------------------------- +package MKDoc::Util::LinkParser; +use strict; +use warnings; + +=head1 NAME + +MKDoc::Util::LinkParser - parses links to differentiate internal and external links + +=head1 SYNOPSIS + + use MKDoc::Util::LinkParser; + + # setup a new parser + $parser = MKDoc::Util::LinkParser->new(); + + # parse a link + $parser->parse('http://www.example.com/foo'); + + # deal with results + if ($parser->is_internal) { + if ($parser->is_valid) { + $document_id = $parser->document_id; + print "Found a link to document ID $document_id.\n"; + } else { + die "Invalid internal link found!"; + } + } else { + print "External link found.\n"; + } + +=head1 DESCRIPTION + +This module parses links and determines whether they are internal +(pointing to the site served by MKDoc) or external. For internal +links it determines if they are valid (pointing to an active document). + +=head1 CLASS METHODS + +=head2 new + +Creates a new parser. Accepts no arguments. + +=head2 parse + +Parse a link. Takes a single argument, the link to parse. + +=head2 thaw + +Loads data produced by store() just as though the link had been parsed +with parse(). + +=head1 INSTANCE METHODS + +=head2 is_internal + +Returns true if the last link parsed was internal. + +=head2 is_external + +Returns true if the last link parsed was external. + +=head2 is_valid + +Returns true if the last link was a valid internal link. When this is +true document_id will be available. + +=head2 document_id + +Returns the document_id for the last link parsed. + +=head2 uri + +Returns the URI object for the last link parsed. See L for more +details. + +=head2 as_string + +Produce a string containing a canonical version of the link. + +=head2 operation + +Returns the extra MKDoc-specific operation portion of the URI for +internal links. This is the part of the URI that points to an +operation rather than a documemt. For example, given this link: + + http://example.com/test-doc/.admin.content + +operation() would return '.admin.content'. + +This part of the URI will not be present in the object returned from +uri() and it will not affect is_valid() and document_id() matches. + +=head2 freeze + +Returns a hash-ref representiting all the relevent details of the +link. This is the data which may be passed later to thaw(). + +This method may only be called on valid internal links. + +=head1 AUTHOR + +Sam Tregar + +=cut + +use URI; +use Carp qw(croak); +use lib::sql::DBH; + +sub new { + my $self = bless {}, shift; + + # make sure the environment is properly setup + for my $var qw(PUBLIC_DOMAIN USER_DOMAIN) { + croak("$var not set - needed by " . __PACKAGE__) unless $ENV{$var}; + } + + # setup default base URI + $self->{base} = URI->new($ENV{PUBLIC_DOMAIN})->canonical; + + # setup list of internals base URLs + $self->{internal_bases} = [ $self->{base}, + URI->new($ENV{USER_DOMAIN})->canonical ]; + + # add in foo.com for www.foo.com + my $pub = $ENV{PUBLIC_DOMAIN}; + $pub =~ s!^(\w+://)\w+\.!$1!; + push @{$self->{internal_bases}}, URI->new($pub)->canonical; + + # produce a list of canonical internal prefixes minus scheme for + # fast internal matching + my @prefixes = map { $_->opaque } @{$self->{internal_bases}}; + + # compile a regex from the internal prefixes + my $re = join('|', map { qr/\Q$_\E/ } @prefixes); + $self->{internal_re} = qr/^$re/; + + return $self; +} + +sub parse { + my ($self, $link) = @_; + $self->_clear(); + + my $uri; + if ($link =~ m!^[^:/?#]+:!) { + # if it's a full URI parse it as-is + $uri = URI->new($link)->canonical; + } else { + # otherwise base it off the default base + $uri = URI->new_abs($link, $self->{base})->canonical; + } + $self->{uri} = $uri; + + # pull off the operation part of internal paths + my $path = $uri->path; + if ($self->is_internal and $path =~ s!/(\.[a-z\.]+)$!!) { + $self->{operation} = $1; + $path = '/' unless length $path; + $self->{uri}->path($path); + } +} + +# clear link state +sub _clear { + my $self = shift; + delete $self->{$_} for qw(is_internal document_id operation uri); +} + +sub as_string { + my $self = shift; + my $uri = $self->{uri}->clone; + + # the URI object has everything already unless this is an internal + # link or has an operation + return $uri->as_string + unless $self->{document_id} or $self->{operation}; + + # setup path based on document_id if we've got one + if ($self->{document_id}) { + my $dbh = lib::sql::DBH->get(); + my ($path) = $dbh->selectrow_array('SELECT Full_Path FROM Document WHERE ID = ?', undef, $self->{document_id}); + $uri->path($path); + } + + # add in operation if there is one + if ($self->{operation}) { + my $path = $uri->path(); + $path .= '/' unless $path =~ m!/$!; + $uri->path($path . $self->{operation}); + } + + return $uri->as_string; +} + +sub operation { shift->{operation} } + +sub is_internal { + my $self = shift; + return $self->{is_internal} if defined $self->{is_internal}; + my $uri = $self->uri; + + # only http and https URLs can be internals + my $protocol = $uri->scheme; + return $self->{is_internal} = 0 + unless $protocol eq 'http' or $protocol eq 'https'; + + my $prefix = $self->{uri}->opaque; + if ($prefix =~ $self->{internal_re}) { + return $self->{is_internal} = 1; + } else { + return $self->{is_internal} = 0; + } +} + +sub is_external { + my $self = shift; + return not $self->is_internal; +} + +sub is_valid { + my $self = shift; + return 0 if defined $self->{document_id} and not $self->{document_id}; + return 1 if $self->document_id; +} + +sub document_id { + my $self = shift; + return $self->{document_id} if $self->{document_id}; + + my $uri = $self->uri; + my $dbh = lib::sql::DBH->get(); + + # fix path to end with a / + my $path = $uri->path; + $path .= '/' unless $path =~ m!/$!; + + my ($id) = $dbh->selectrow_array('SELECT ID + FROM Document + WHERE Full_Path = ?', undef, $path); + return $self->{document_id} = $id ? $id : 0; +} + +sub uri { shift->{uri} } + +sub freeze { + my $self = shift; + croak("Called freeze on an external or invalid link!") + unless $self->{is_internal} and $self->{document_id}; + my %return; + + # store relevent details for an internal link + my $uri = $self->{uri}; + $return{is_internal} = $self->{is_internal}; + $return{operation} = $self->{operation}; + $return{document_id} = $self->{document_id}; + + # save necessary URI parts + $return{scheme} = $uri->scheme; + $return{query} = $uri->query; + $return{fragment} = $uri->fragment; + $return{authority} = $uri->authority; + + return \%return; +} + +sub thaw { + my ($self, $data) = @_; + $self->_clear(); + + my $uri = URI->new(); + $uri->scheme($data->{scheme}); + $uri->query($data->{query}); + $uri->fragment($data->{fragment}); + $uri->authority($data->{authority}); + $self->{uri} = $uri; + + $self->{is_internal} = $data->{is_internal}; + $self->{operation} = $data->{operation}; + $self->{document_id} = $data->{document_id}; +} + +1; + --- /dev/null +++ tools/update_links.pl @@ -0,0 +1,104 @@ +# ------------------------------------------------------------------ +# update_links.pl +# ------------------------------------------------------------------ +# Author : Sam Tregar +# Copyright : (c) MKDoc Holdings Ltd, 2005 +# +# This file is part of MKDoc. +# +# MKDoc 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. +# +# MKDoc 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 MKDoc; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +# +# ------------------------------------------------------------------ + +# This script updates links into the new format which differentiates +# between internal and external links. Internal links are matched to +# the documents they point to and stored by ID. The script will +# output a line for each external, internal and invalid internal link +# it finds. +# +# It would be a good idea to make a backup of your database before +# running this script as it has not been extensively tested. + +#!/usr/bin/perl +use strict; +use warnings; +use MKDoc; +use MKDoc::Util::LinkParser; + +# make sure SITE_DIR is set since MKDoc->init needs it +die "SITE_DIR isn't set. Please source mksetenv.sh from an installed MKDoc site ". + "and try again.\n" + unless $ENV{SITE_DIR}; + +# initialize MKDoc, needed for database connection +MKDoc->init; + +# setup global accessors +my $dbh = lib::sql::DBH->get(); +my $doc_t = flo::Standard::table('Document'); +my $parser = MKDoc::Util::LinkParser->new(); + +# step through documents one at a time +my $document_ids = $dbh->selectcol_arrayref('SELECT ID FROM Document'); +foreach my $document_id (@$document_ids) { + my $doc = $doc_t->get($document_id); + + # setup an editor so we can make changes if necessary + my $editor = flo::Editor->_new(); + $editor->parse_xml($doc->{Body}, $document_id); + + my $dirty = 0; + + # look at each link + my @links = grep { $_->isa('flo::editor::Link') } $editor->access(); + foreach my $link (@links) { + # ignore already processed internal links + next if $link->{internal_link}; + + # evaluate plain links, ignoring broken ones + my $url = $link->{url}; + next unless $url; + + $parser->parse($url); + + # external links stay as-is + if (not $parser->is_internal) { + print "=== External Link ($document_id): $url\n"; + next; + } + + # flag invalid internal links + if (not $parser->is_valid) { + print "!!! Invalid Internal Link ($document_id): $url\n"; + next; + } + + # update valid internal links + $link->{internal_link} = $parser->freeze(); + $link->{url} = $parser->as_string; + $dirty++; + print "+++ Valid Internal Link ($document_id): $url\n" + } + + # if changes were made they need to get updated in the DB. (It's + # hard to believe there isn't a better way to do this, but I'm + # pretty sure there isn't.) + if ($dirty) { + print "*** Updating Document $document_id with $dirty new links.\n"; + $doc->{Body} = $editor->generate_xml(); + $doc->save(); + } +} + From chris at mkdoc.demon.co.uk Wed Jul 13 15:32:53 2005 From: chris at mkdoc.demon.co.uk (chris@mkdoc.demon.co.uk) Date: Wed Jul 13 15:32:56 2005 Subject: [MKDoc-commit] Default for external links changed back to NOT open in new windows. Message-ID: <20050713143253.A4B082E28E7@mkdoc.demon.co.uk> Log Message: ----------- Default for external links changed back to NOT open in new windows. Tags: ---- mkdoc-1-6 Modified Files: -------------- mkd/flo: Editor.pm -------------- next part -------------- Index: Editor.pm =================================================================== RCS file: /var/spool/cvs/mkd/flo/Editor.pm,v retrieving revision 1.12.2.42 retrieving revision 1.12.2.43 diff -Lflo/Editor.pm -Lflo/Editor.pm -u -r1.12.2.42 -r1.12.2.43 --- flo/Editor.pm +++ flo/Editor.pm @@ -33,7 +33,7 @@ # Set this to true and external links (as determined by # MKDoc::Util::LinkParser) will open in a new window. -our $EXTERNAL_LINKS_OPEN_IN_NEW_WINDOW = 1; +our $EXTERNAL_LINKS_OPEN_IN_NEW_WINDOW = 0; use constant BLOCK => 'edit_block'; From chris at mkdoc.demon.co.uk Mon Jul 18 11:34:36 2005 From: chris at mkdoc.demon.co.uk (chris@mkdoc.demon.co.uk) Date: Mon Jul 18 11:34:39 2005 Subject: [MKDoc-commit] Patch from Sam - updates the link differentiation code to take into Message-ID: <20050718103436.EA1192E28E7@mkdoc.demon.co.uk> Log Message: ----------- Patch from Sam - updates the link differentiation code to take into account redirects. Tags: ---- mkdoc-1-6 Modified Files: -------------- mkd/MKDoc/Util: LinkParser.pm -------------- next part -------------- Index: LinkParser.pm =================================================================== RCS file: /var/spool/cvs/mkd/MKDoc/Util/Attic/LinkParser.pm,v retrieving revision 1.1.2.1 retrieving revision 1.1.2.2 diff -LMKDoc/Util/LinkParser.pm -LMKDoc/Util/LinkParser.pm -u -r1.1.2.1 -r1.1.2.2 --- MKDoc/Util/LinkParser.pm +++ MKDoc/Util/LinkParser.pm @@ -261,6 +261,15 @@ my ($id) = $dbh->selectrow_array('SELECT ID FROM Document WHERE Full_Path = ?', undef, $path); + return $self->{document_id} = $id if $id; + + # it wasn't in Document, but it might be in Redirect + ($id) = $dbh->selectrow_array('SELECT d.ID + FROM Document d, Redirect r + WHERE d.Full_Path = r.New_Path AND + r.Old_Path = ?', + undef, $path); + return $self->{document_id} = $id ? $id : 0; } From chris at mkdoc.demon.co.uk Mon Jul 18 16:10:14 2005 From: chris at mkdoc.demon.co.uk (chris@mkdoc.demon.co.uk) Date: Mon Jul 18 16:10:22 2005 Subject: [MKDoc-commit] Patch from Sam - implementing the enhanced component move control. Message-ID: <20050718151014.61EF32E28E7@mkdoc.demon.co.uk> Log Message: ----------- Patch from Sam - implementing the enhanced component move control. Tags: ---- mkdoc-1-6 Modified Files: -------------- mkd/flo: Component.pm Editor.pm mkd/templates/editor/discussion: en.html mkd/templates/editor/file: en.html mkd/templates/editor/headlines: en.html mkd/templates/editor/html: en.html mkd/templates/editor/image: en.html mkd/templates/editor/link: en.html mkd/templates/editor/photo: en.html mkd/templates/editor/poll: en.html mkd/templates/editor/rss: en.html mkd/templates/editor/text: en.html mkd/templates/editor/timerange: en.html -------------- next part -------------- Index: en.html =================================================================== RCS file: /var/spool/cvs/mkd/templates/editor/image/Attic/en.html,v retrieving revision 1.1.2.10 retrieving revision 1.1.2.11 diff -Ltemplates/editor/image/en.html -Ltemplates/editor/image/en.html -u -r1.1.2.10 -r1.1.2.11 --- templates/editor/image/en.html +++ templates/editor/image/en.html @@ -9,8 +9,6 @@ class="image-component" xmlns:petal="http://purl.org/petal/1.0/" petal:define="image_img string:${self/block_name}_img; - name_move_up string:${self/block_name}_up; - name_move_down string:${self/block_name}_down; name_delete string:${self/block_name}_delete; name_alt string:${self/block_name}_alt; name_description string:${self/block_name}_description; @@ -49,30 +47,7 @@ >The title field is empty.

-

- - -

+

Move to another document

-

- - -

Index: en.html =================================================================== RCS file: /var/spool/cvs/mkd/templates/editor/link/Attic/en.html,v retrieving revision 1.1.2.10 retrieving revision 1.1.2.11 diff -Ltemplates/editor/link/en.html -Ltemplates/editor/link/en.html -u -r1.1.2.10 -r1.1.2.11 --- templates/editor/link/en.html +++ templates/editor/link/en.html @@ -11,8 +11,6 @@ xmlns:petal="http://purl.org/petal/1.0/" petal:define="align self/align; dir self/direction; - name_move_up string:${self/block_name}_up; - name_move_down string:${self/block_name}_down; name_delete string:${self/block_name}_delete; name_url string:${self/block_name}_url; name_title string:${self/block_name}_title; @@ -58,35 +56,7 @@ >The 'Description' field is empty.

- -

- - - - - -

- +

Move to another document

- -

- - -

Index: Component.pm =================================================================== RCS file: /var/spool/cvs/mkd/flo/Component.pm,v retrieving revision 1.3.2.36 retrieving revision 1.3.2.37 diff -Lflo/Component.pm -Lflo/Component.pm -u -r1.3.2.36 -r1.3.2.37 --- flo/Component.pm +++ flo/Component.pm @@ -634,6 +634,48 @@ $@ and warn "== $@ =="; } +# determine contents of the Move button target select list, correcting +# for placement, minimum and maximum +sub move_targets { + my $self = shift; + my $editor = flo::Editor::_ETERNAL_(); + my $count = $editor->component_count(); + my $pos = $editor->component_position($self); + my $last = $count - 1; + + # setup available targets + my @targets; + push @targets, { label => 'to top', + value => 'top' } + if $pos != 0; + push @targets, { label => 'up 3', + value => '-3' } + if $pos > 2; + push @targets, { label => 'up 2', + value => '-2' } + if $pos > 1; + push @targets, { label => 'up', + value => '-1', + is_selected => 1 } + if $pos > 0; + push @targets, { label => 'down', + value => '+1', + ($pos == 0 ? (is_selected => 1) : ()) } + if $pos < $last; + push @targets, { label => 'down 2', + value => '+2' } + if $pos < ($last - 1); + push @targets, { label => 'down 3', + value => '+3' } + if $pos < ($last - 2); + push @targets, { label => 'to bottom', + value => 'bottom' } + if $pos != $last; + + return \@targets; +} + + ## # # ALL THESE DEFAULT TO THE PARENT DOCUMENT METHODS, BUT SHOULD # Index: Editor.pm =================================================================== RCS file: /var/spool/cvs/mkd/flo/Editor.pm,v retrieving revision 1.12.2.43 retrieving revision 1.12.2.44 diff -Lflo/Editor.pm -Lflo/Editor.pm -u -r1.12.2.43 -r1.12.2.44 --- flo/Editor.pm +++ flo/Editor.pm @@ -36,6 +36,7 @@ our $EXTERNAL_LINKS_OPEN_IN_NEW_WINDOW = 0; use constant BLOCK => 'edit_block'; +our $QBLOCK = quotemeta (BLOCK) . "_"; our $IMP = {}; @@ -365,8 +366,7 @@ $self->_initialize_initialize ($cgi); $self->_initialize_delete ($cgi); - $self->_initialize_up ($cgi); - $self->_initialize_down ($cgi); + $self->_initialize_move ($cgi); $self->_initialize_add ($cgi); $self->_initialize_uri_names ($cgi); } @@ -436,12 +436,10 @@ # This loop sets all the components by scanning the CGI parameters foreach my $cgi_param_name ($cgi->param) { - my $qBLOCK = quotemeta (BLOCK) . "_"; - # if this CGI param is appropriate because it starts by BLOCK - if ($cgi_param_name =~ /^$qBLOCK([0-9]+)_([a-zA-Z]+)(?:_.*)?$/) + if ($cgi_param_name =~ /^$QBLOCK([0-9]+)_([a-zA-Z]+)(?:_.*)?$/) { - my ($id, $type) = $cgi_param_name =~ /^$qBLOCK([0-9]+)_([a-zA-Z]+)(?:_.*)?$/; + my ($id, $type) = $cgi_param_name =~ /^$QBLOCK([0-9]+)_([a-zA-Z]+)(?:_.*)?$/; # if $self->{block}->{$id} is already defined, then this component # has been instanciated already and we can safely move on the next @@ -457,7 +455,7 @@ require $file; import $file; - my $param_name = $qBLOCK . $id . '_' . $type; + my $param_name = $QBLOCK . $id . '_' . $type; $self->{block}->{$id} = $class->new ( cgi => $cgi, param_name => $param_name ); } } @@ -479,11 +477,9 @@ # a component is requested foreach my $cgi_param_name ($cgi->param) { - my $qBLOCK = quotemeta (BLOCK) . "_"; - - if ($cgi_param_name =~ /^$qBLOCK([0-9]+)_([a-zA-Z]+)_delete$/) + if ($cgi_param_name =~ /^$QBLOCK([0-9]+)_([a-zA-Z]+)_delete$/) { - my ($id, $type) = $cgi_param_name =~ /^$qBLOCK([0-9]+)_([a-zA-Z]+)_delete$/; + my ($id, $type) = $cgi_param_name =~ /^$QBLOCK([0-9]+)_([a-zA-Z]+)_delete$/; delete $self->{block}->{$id}; } } @@ -504,90 +500,95 @@ } } - ## -# $self->_initialize_up; +# $self->_initialize_move; # ---------------------- # Scans the CGI parameters to check if a component has -# to be moved up +# to be moved ## -sub _initialize_up -{ - my $self = shift; - my $cgi = shift; - - # Then we need to re-scan the cgi parameters to check if a component - # has to move up. - foreach my $cgi_param_name ($cgi->param) - { - my $qBLOCK = quotemeta (BLOCK) . "_"; - - if ($cgi_param_name =~ /^$qBLOCK([0-9]+)_([a-zA-Z]+)_up$/) - { - my ($id, $type) = $cgi_param_name =~ /^$qBLOCK([0-9]+)_([a-zA-Z]+)_up$/; - if ($id > 1) - { - my $id_1 = $id; - my $id_2 = $id - 1, - - my $component_1 = $self->{block}->{$id_1}; - my $component_2 = $self->{block}->{$id_2}; - - my $type_1 = _PAM_()->{ref $component_1}; - my $type_2 = _PAM_()->{ref $component_2}; +sub _initialize_move { + my ($self, $cgi) = @_; - $self->{block}->{$id_1} = $component_2; - $self->{block}->{$id_2} = $component_1; + # look for an indicator that a move button was clicked + foreach my $name ($cgi->param()) { + next unless $name =~ /^$QBLOCK([0-9]+)_([a-zA-Z]+)_move_button$/; + my ($id, $type) = ($1, $2); + + # collect target for this move + my $target = $cgi->param(BLOCK . "_" . $id . "_" . $type . "_move_target"); + + # move the component up or down as requested + if ($target =~ /^\+(\d+)$/) { + my $distance = $1; + $id = $self->_move_component_down($id) + for (1 .. $distance); + + } elsif ($target =~ /^-(\d+)$/) { + my $distance = $1; + $id = $self->_move_component_up($id) + for (1 .. $distance); + + } elsif ($target eq 'top') { + $id = $self->_move_component_up($id) + while ($id != 1); + + } elsif ($target eq 'bottom') { + my $last = scalar keys %{$self->{block}}; + $id = $self->_move_component_down($id) + while ($id != $last); + + } else { + die "Unable to parse move target: $target."; + } - $component_1->{param_name} = BLOCK . "_" . $id_2 . "_" . $type_1; - $component_2->{param_name} = BLOCK . "_" . $id_1 . "_" . $type_2; - } - } } } +# move a component down one +sub _move_component_down { + my ($self, $id) = @_; + return $id unless $id < scalar keys %{$self->{block}}; -## -# $self->_initialize_up; -# ---------------------- -# Scans the CGI parameters to check if a component has -# to be moved down -## -sub _initialize_down -{ - my $self = shift; - my $cgi = shift; + my $id_1 = $id; + my $id_2 = $id + 1; - # Then we need to re-scan the cgi parameters to check if a component - # has to move down - foreach my $cgi_param_name ($cgi->param) - { - my $qBLOCK = quotemeta (BLOCK) . "_"; - - if ($cgi_param_name =~ /^$qBLOCK([0-9]+)_([a-zA-Z]+)_down$/) - { - my ($id, $type) = $cgi_param_name =~ /^$qBLOCK([0-9]+)_([a-zA-Z]+)_down$/; - if ($id < scalar keys %{$self->{block}}) - { - my $id_1 = $id; - my $id_2 = $id + 1, - - my $component_1 = $self->{block}->{$id_1}; - my $component_2 = $self->{block}->{$id_2}; - - my $type_1 = _PAM_()->{ref $component_1}; - my $type_2 = _PAM_()->{ref $component_2}; - - $self->{block}->{$id_1} = $component_2; - $self->{block}->{$id_2} = $component_1; - - $component_1->{param_name} = BLOCK . "_" . $id_2 . "_" . $type_1; - $component_2->{param_name} = BLOCK . "_" . $id_1 . "_" . $type_2; - } - } - } + my $component_1 = $self->{block}->{$id_1}; + my $component_2 = $self->{block}->{$id_2}; + + my $type_1 = _PAM_()->{ref $component_1}; + my $type_2 = _PAM_()->{ref $component_2}; + + $self->{block}->{$id_1} = $component_2; + $self->{block}->{$id_2} = $component_1; + + $component_1->{param_name} = BLOCK . "_" . $id_2 . "_" . $type_1; + $component_2->{param_name} = BLOCK . "_" . $id_1 . "_" . $type_2; + + return $id_2; } +# move a component up one +sub _move_component_up { + my ($self, $id) = @_; + return $id unless $id > 1; + + my $id_1 = $id; + my $id_2 = $id - 1; + + my $component_1 = $self->{block}->{$id_1}; + my $component_2 = $self->{block}->{$id_2}; + + my $type_1 = _PAM_()->{ref $component_1}; + my $type_2 = _PAM_()->{ref $component_2}; + + $self->{block}->{$id_1} = $component_2; + $self->{block}->{$id_2} = $component_1; + + $component_1->{param_name} = BLOCK . "_" . $id_2 . "_" . $type_1; + $component_2->{param_name} = BLOCK . "_" . $id_1 . "_" . $type_2; + + return $id_2; +} ## # $self->_initialize_add; @@ -605,8 +606,7 @@ if (defined $cgi->param ('_new_component_add')) { my $cgi_param_name = $cgi->param ('_new_component'); - my $qBLOCK = quotemeta (BLOCK) . '_'; - my ($id, $type) = $cgi_param_name =~ /^$qBLOCK([0-9]+)_([a-zA-Z]+)$/; + my ($id, $type) = $cgi_param_name =~ /^$QBLOCK([0-9]+)_([a-zA-Z]+)$/; my $nb = $cgi->param ('_new_component_amount'); my $map = _MAP_(); my $class = $map->{$type}; @@ -682,6 +682,25 @@ return $self->{block}->{$id}; } +# returns the current count of live components +sub component_count { + my $self = shift; + return scalar keys %{$self->{block}}; +} + +# working replacement for $component->position which is unreliable for +# some reason +sub component_position { + my $self = shift; + my $component = shift; + my $block = $self->{block}; + my @keys = sort { $a <=> $b } keys %$block; + for (my $i = 0; $i < @keys; $i++) { + return $i + if $component->{param_name} eq $block->{$keys[$i]}->{param_name}; + } + return undef; +} ## # $self->edit; Index: en.html =================================================================== RCS file: /var/spool/cvs/mkd/templates/editor/photo/Attic/en.html,v retrieving revision 1.1.2.13 retrieving revision 1.1.2.14 diff -Ltemplates/editor/photo/en.html -Ltemplates/editor/photo/en.html -u -r1.1.2.13 -r1.1.2.14 --- templates/editor/photo/en.html +++ templates/editor/photo/en.html @@ -9,8 +9,6 @@ class="photo-component" xmlns:petal="http://purl.org/petal/1.0/" petal:define="name_img string:${self/block_name}_img; - name_move_up string:${self/block_name}_up; - name_move_down string:${self/block_name}_down; name_delete string:${self/block_name}_delete; name_alt string:${self/block_name}_alt; name_description string:${self/block_name}_description; @@ -76,32 +74,7 @@ >This date is not valid.

- - -

- - -

+

Move to another document

-

- - -

- Index: en.html =================================================================== RCS file: /var/spool/cvs/mkd/templates/editor/poll/Attic/en.html,v retrieving revision 1.1.2.10 retrieving revision 1.1.2.11 diff -Ltemplates/editor/poll/en.html -Ltemplates/editor/poll/en.html -u -r1.1.2.10 -r1.1.2.11 --- templates/editor/poll/en.html +++ templates/editor/poll/en.html @@ -26,8 +26,6 @@ name_hour_start string:${self/block_name}_hour_start; name_date_stop string:${self/block_name}_date_stop; name_hour_stop string:${self/block_name}_hour_stop; - name_move_up string:${self/block_name}_up; - name_move_down string:${self/block_name}_down; name_delete string:${self/block_name}_delete" > The stopping date must be further in time than the starting date...

-

- - -

+

Move to another document

-

- - - -

- Index: en.html =================================================================== RCS file: /var/spool/cvs/mkd/templates/editor/rss/Attic/en.html,v retrieving revision 1.1.2.10 retrieving revision 1.1.2.11 diff -Ltemplates/editor/rss/en.html -Ltemplates/editor/rss/en.html -u -r1.1.2.10 -r1.1.2.11 --- templates/editor/rss/en.html +++ templates/editor/rss/en.html @@ -13,8 +13,6 @@ name_max string:${self/block_name}_max; name_sort string:${self/block_name}_sort; name_template string:${self/block_name}_template; - name_move_up string:${self/block_name}_up; - name_move_down string:${self/block_name}_down; name_delete string:${self/block_name}_delete; align self/align; align_opposite self/align_opposite; @@ -58,30 +56,7 @@ >The template you specified could not be found.

-

- - -

+

Move to another document

-

- - -

- Index: en.html =================================================================== RCS file: /var/spool/cvs/mkd/templates/editor/discussion/Attic/en.html,v retrieving revision 1.1.2.9 retrieving revision 1.1.2.10 diff -Ltemplates/editor/discussion/en.html -Ltemplates/editor/discussion/en.html -u -r1.1.2.9 -r1.1.2.10 --- templates/editor/discussion/en.html +++ templates/editor/discussion/en.html @@ -14,8 +14,6 @@ name_mbox string:${self/block_name}_mbox; name_title string:${self/block_name}_title; name_description string:${self/block_name}_description; - name_move_up string:${self/block_name}_up; - name_move_down string:${self/block_name}_down; name_delete string:${self/block_name}_delete" > @@ -54,31 +52,7 @@ >The 'Description' field is empty.

-

- - -

+

Move to another document

-

- - -

- Index: en.html =================================================================== RCS file: /var/spool/cvs/mkd/templates/editor/text/Attic/en.html,v retrieving revision 1.1.2.10 retrieving revision 1.1.2.11 diff -Ltemplates/editor/text/en.html -Ltemplates/editor/text/en.html -u -r1.1.2.10 -r1.1.2.11 --- templates/editor/text/en.html +++ templates/editor/text/en.html @@ -11,8 +11,6 @@ petal:define="align self/align; align_opposite self/align_opposite; dir self/direction; - name_move_up string:${self/block_name}_up; - name_move_down string:${self/block_name}_down; name_delete string:${self/block_name}_delete" > @@ -22,33 +20,7 @@ dir="ltr" >Text component -

- - - - - -

+

Move to another document

-

- - -

- Index: en.html =================================================================== RCS file: /var/spool/cvs/mkd/templates/editor/file/Attic/en.html,v retrieving revision 1.1.2.10 retrieving revision 1.1.2.11 diff -Ltemplates/editor/file/en.html -Ltemplates/editor/file/en.html -u -r1.1.2.10 -r1.1.2.11 --- templates/editor/file/en.html +++ templates/editor/file/en.html @@ -9,8 +9,6 @@ class="file-component" xmlns:petal="http://purl.org/petal/1.0/" petal:define="name_title string:${self/block_name}_title; - name_move_up string:${self/block_name}_up; - name_move_down string:${self/block_name}_down; name_delete string:${self/block_name}_delete; name_upload string:${self/block_name}_upload; name_file string:${self/block_name}_file; @@ -40,32 +38,7 @@ >The title field is empty.

-

- - - - -

+

Move to another document

-

- - -

- Index: en.html =================================================================== RCS file: /var/spool/cvs/mkd/templates/editor/headlines/Attic/en.html,v retrieving revision 1.1.2.17 retrieving revision 1.1.2.18 diff -Ltemplates/editor/headlines/en.html -Ltemplates/editor/headlines/en.html -u -r1.1.2.17 -r1.1.2.18 --- templates/editor/headlines/en.html +++ templates/editor/headlines/en.html @@ -8,9 +8,7 @@
You must select at least one audience when audience matching is turned on.

-

- - -

+

Move to another document

-

- - -

-
Index: en.html =================================================================== RCS file: /var/spool/cvs/mkd/templates/editor/html/Attic/en.html,v retrieving revision 1.1.2.10 retrieving revision 1.1.2.11 diff -Ltemplates/editor/html/en.html -Ltemplates/editor/html/en.html -u -r1.1.2.10 -r1.1.2.11 --- templates/editor/html/en.html +++ templates/editor/html/en.html @@ -11,8 +11,6 @@ petal:define="dir self/direction; align self/align; align_opposite self/align_opposite; - name_move_up string:${self/block_name}_up; - name_move_down string:${self/block_name}_down; name_delete string:${self/block_name}_delete" > @@ -38,31 +36,7 @@

-

- - - -

+

Move to another document

- -

- - - - - -

- Index: en.html =================================================================== RCS file: /var/spool/cvs/mkd/templates/editor/timerange/Attic/en.html,v retrieving revision 1.1.2.6 retrieving revision 1.1.2.7 diff -Ltemplates/editor/timerange/en.html -Ltemplates/editor/timerange/en.html -u -r1.1.2.6 -r1.1.2.7 --- templates/editor/timerange/en.html +++ templates/editor/timerange/en.html @@ -8,9 +8,7 @@
The Start Date occurs after the End Date.

-

- - -

+

@@ -688,31 +663,5 @@ >Move to another document

-

- - -

-
From chris at mkdoc.demon.co.uk Mon Jul 18 16:13:42 2005 From: chris at mkdoc.demon.co.uk (chris@mkdoc.demon.co.uk) Date: Mon Jul 18 16:13:44 2005 Subject: [MKDoc-commit] New Directory Message-ID: <20050718151342.4FFAE2E28E7@mkdoc.demon.co.uk> Update of /var/spool/cvs/mkd/templates/fragments/move_control In directory devil.webarch.net:/tmp/cvs-serv17823/templates/fragments/move_control Log Message: Directory /var/spool/cvs/mkd/templates/fragments/move_control added to the repository --> Using per-directory sticky tag `mkdoc-1-6' From chris at mkdoc.demon.co.uk Mon Jul 18 16:14:18 2005 From: chris at mkdoc.demon.co.uk (chris@mkdoc.demon.co.uk) Date: Mon Jul 18 16:14:21 2005 Subject: [MKDoc-commit] Added files from Sam which was left out of last commit by mistake. Message-ID: <20050718151418.8CBA12E28E7@mkdoc.demon.co.uk> Log Message: ----------- Added files from Sam which was left out of last commit by mistake. Tags: ---- mkdoc-1-6 Added Files: ----------- mkd/templates/fragments/move_control: en.html -------------- next part -------------- --- /dev/null +++ templates/fragments/move_control/en.html @@ -0,0 +1,58 @@ + + +

+ + + + component + + + +

From chris at mkdoc.demon.co.uk Mon Jul 18 16:44:30 2005 From: chris at mkdoc.demon.co.uk (chris@mkdoc.demon.co.uk) Date: Mon Jul 18 16:44:33 2005 Subject: [MKDoc-commit] Added a label element Message-ID: <20050718154430.64B962E28E7@mkdoc.demon.co.uk> Log Message: ----------- Added a label element Tags: ---- mkdoc-1-6 Modified Files: -------------- mkd/templates/fragments/move_control: en.html -------------- next part -------------- Index: en.html =================================================================== RCS file: /var/spool/cvs/mkd/templates/fragments/move_control/Attic/en.html,v retrieving revision 1.1.2.1 retrieving revision 1.1.2.2 diff -Ltemplates/fragments/move_control/en.html -Ltemplates/fragments/move_control/en.html -u -r1.1.2.1 -r1.1.2.2 --- templates/fragments/move_control/en.html +++ templates/fragments/move_control/en.html @@ -26,18 +26,23 @@ petal:attributes="name name_button; id name_button" /> - component +

From chris at mkdoc.demon.co.uk Mon Jul 25 10:33:41 2005 From: chris at mkdoc.demon.co.uk (chris@mkdoc.demon.co.uk) Date: Mon Jul 25 10:33:47 2005 Subject: [MKDoc-commit] Internal links redirect fix from Sam. Message-ID: <20050725093341.2345E2E28E7@mkdoc.demon.co.uk> Log Message: ----------- Internal links redirect fix from Sam. Tags: ---- mkdoc-1-6 Modified Files: -------------- mkd/MKDoc/Util: LinkParser.pm -------------- next part -------------- Index: LinkParser.pm =================================================================== RCS file: /var/spool/cvs/mkd/MKDoc/Util/Attic/LinkParser.pm,v retrieving revision 1.1.2.2 retrieving revision 1.1.2.3 diff -LMKDoc/Util/LinkParser.pm -LMKDoc/Util/LinkParser.pm -u -r1.1.2.2 -r1.1.2.3 --- MKDoc/Util/LinkParser.pm +++ MKDoc/Util/LinkParser.pm @@ -258,19 +258,51 @@ my $path = $uri->path; $path .= '/' unless $path =~ m!/$!; + # do a look for this path, returning immediately if it was found + my ($id, undef) = $self->lookup_path($path, $dbh); + return $self->{document_id} = $id if $id; + + # walk down path components replacing them with redirects as + # needed. This is necessary to deal with interstitial redirects. + my @old = grep { defined and length } split('/', $path); + my @new; + while (@old) { + # step down one level + push @new, shift @old; + + # lookup this path for redirects + my $this_path = '/' . join('/', @new) . '/'; + ($id, $path) = $self->lookup_path($this_path, $dbh); + + # if we found something and it's not a direct link then base + # the new path off that + if ($path and $path ne $this_path) { + @new = grep { defined and length } split('/', $path); + } + } + + # return what we found, undef if no match was found in the search + # or the ID if one was + return $self->{document_id} = $id; +} + +# lookup a path in Document and Redirect. Returns the ID and +# corrected path, if one was found. +sub lookup_path { + my ($self, $path, $dbh) = @_; + my ($id) = $dbh->selectrow_array('SELECT ID FROM Document WHERE Full_Path = ?', undef, $path); return $self->{document_id} = $id if $id; # it wasn't in Document, but it might be in Redirect - ($id) = $dbh->selectrow_array('SELECT d.ID - FROM Document d, Redirect r - WHERE d.Full_Path = r.New_Path AND - r.Old_Path = ?', - undef, $path); + ($id, $path) = $dbh->selectrow_array('SELECT d.ID, d.Full_Path + FROM Document d, Redirect r + WHERE d.Full_Path = r.New_Path AND + r.Old_Path = ?', undef, $path); - return $self->{document_id} = $id ? $id : 0; + return ($id, $path); } sub uri { shift->{uri} } From chris at mkdoc.demon.co.uk Mon Jul 25 11:01:25 2005 From: chris at mkdoc.demon.co.uk (chris@mkdoc.demon.co.uk) Date: Mon Jul 25 11:01:28 2005 Subject: [MKDoc-commit] Patch from Sam adds group permissions checking to the newsletter code Message-ID: <20050725100125.4144F2E28E7@mkdoc.demon.co.uk> Log Message: ----------- Patch from Sam adds group permissions checking to the newsletter code Tags: ---- mkdoc-1-6 Modified Files: -------------- mkd/tools/cron: 020..newsletter.pl -------------- next part -------------- Index: 020..newsletter.pl =================================================================== RCS file: /var/spool/cvs/mkd/tools/cron/020..newsletter.pl,v retrieving revision 1.1.2.17 retrieving revision 1.1.2.18 diff -Ltools/cron/020..newsletter.pl -Ltools/cron/020..newsletter.pl -u -r1.1.2.17 -r1.1.2.18 --- tools/cron/020..newsletter.pl +++ tools/cron/020..newsletter.pl @@ -12,6 +12,11 @@ sub template_path { '/newsletter' } +# keep caches to avoid repeated lookups of group permissions info. +# These could be disabled if the extra memory used is too much but it +# seems unlikely to get huge. +our %DOCUMENT_GROUP_CACHE; +our %USER_GROUP_CACHE; sub root { @@ -145,7 +150,11 @@ next unless ($h->{Pref_Score} > 0); my $doc = $doc_t->get ( $h->{ID} ); next unless ($doc->is_showable()); - + + # check permissions (this can't go in the SQL above due to the + # tree-walking needed to test a document's group membership) + next unless user_can_see($self->user, $doc); + $Text::Wrap::columns = 72; $Text::Wrap::columns = 72; @@ -183,6 +192,69 @@ return $self->{"_cache_$mode"} = \@res; } +# determine if user should be able to see this document, looking at +# group permissions. Returns 1 if the user has access, 0 if not. +sub user_can_see { + my ($user, $document) = @_; + + # lookup groups for the document, no groups means everyone can see it + my @doc_group_ids = find_groups($document); + return 1 unless @doc_group_ids; + + # get a list of the user's groups + my @groups = user_groups($user); + + # no results means the user wasn't in any of the groups, denied + return 0 unless @groups; + + # allow through if the user is in one of the document's groups + my %groups = map { ($_->{Grp_ID}, 1) } @groups; + return 1 if grep { $groups{$_} } @doc_group_ids; + + # no dice + return 0; +} + +# get a list of groups for a particular user +sub user_groups { + my $user = shift; + return @{$USER_GROUP_CACHE{$user->id}} + if $USER_GROUP_CACHE{$user->id}; + + my $editor_grp_t = flo::Standard::table('Editor_Grp'); + my $con = lib::sql::Condition->new(Editor_ID => $user->id); + my @groups = $editor_grp_t->select(cols => 'Grp_ID', + where => $con)->fetch_all; + + $USER_GROUP_CACHE{$user->id} = \@groups; + return @groups; +} + +# get groups for a document, looking up the tree +sub find_groups { + my $document = shift; + my $document_grp_t = flo::Standard::table('Document_Grp'); + + return @{$DOCUMENT_GROUP_CACHE{$document->id}} + if $DOCUMENT_GROUP_CACHE{$document->id}; + + # get list of all documents to check + my @documents = ($document, $document->ancestors); + + # get results for each document + my %groups; + foreach my $doc (@documents) { + my @res = $document_grp_t->select ( + cols => 'Grp_ID', + where => lib::sql::Condition->new(Document_ID => $doc->id) + )->fetch_all(); + $groups{$_->{Grp_ID}} = 1 for @res; + } + + $DOCUMENT_GROUP_CACHE{$document->id} = [keys %groups]; + return @{$DOCUMENT_GROUP_CACHE{$document->id}}; +} + # translate a time to day-month-year for use with MySQL sub _time2date { my $self = shift; From chris at mkdoc.demon.co.uk Mon Jul 25 15:13:41 2005 From: chris at mkdoc.demon.co.uk (chris@mkdoc.demon.co.uk) Date: Mon Jul 25 15:13:45 2005 Subject: [MKDoc-commit] More deprecated elements and attributes added to the MKDoc default Message-ID: <20050725141341.642352E28E7@mkdoc.demon.co.uk> Log Message: ----------- More deprecated elements and attributes added to the MKDoc default whitelist Modified Files: -------------- MKDoc-XML/lib/MKDoc/XML/Stripper: mkdoc16.txt xhtml10transitional.txt -------------- next part -------------- Index: xhtml10transitional.txt =================================================================== RCS file: /var/spool/cvs/MKDoc-XML/lib/MKDoc/XML/Stripper/xhtml10transitional.txt,v retrieving revision 1.2 retrieving revision 1.3 diff -Llib/MKDoc/XML/Stripper/xhtml10transitional.txt -Llib/MKDoc/XML/Stripper/xhtml10transitional.txt -u -r1.2 -r1.3 --- lib/MKDoc/XML/Stripper/xhtml10transitional.txt +++ lib/MKDoc/XML/Stripper/xhtml10transitional.txt @@ -598,7 +598,6 @@ # definition list dl class -dl compact dl dir dl id dl lang Index: mkdoc16.txt =================================================================== RCS file: /var/spool/cvs/MKDoc-XML/lib/MKDoc/XML/Stripper/mkdoc16.txt,v retrieving revision 1.7 retrieving revision 1.8 diff -Llib/MKDoc/XML/Stripper/mkdoc16.txt -Llib/MKDoc/XML/Stripper/mkdoc16.txt -u -r1.7 -r1.8 --- lib/MKDoc/XML/Stripper/mkdoc16.txt +++ lib/MKDoc/XML/Stripper/mkdoc16.txt @@ -21,6 +21,7 @@ a rev a shape a tabindex +a target a title a type a xml:lang @@ -73,11 +74,13 @@ area nohref area shape area tabindex +area target area title area xml:lang # b +# bold text style b class b dir @@ -99,6 +102,7 @@ # big +# large text style big class big dir @@ -135,6 +139,7 @@ # forced line break br class +br clear br id br title @@ -159,6 +164,7 @@ # caption # table caption +caption align caption class caption dir caption id @@ -167,6 +173,17 @@ caption xml:lang +# center +# shorthand for DIV align=center + +center class +center dir +center id +center lang +center title +center xml:lang + + # cite # citation @@ -192,12 +209,17 @@ # col # table column +col align +col char +col charoff col class col dir col id col lang col span +col style col title +col valign col width col xml:lang @@ -205,12 +227,16 @@ # colgroup # table column group +colgroup align +colgroup char +colgroup charoff colgroup class colgroup dir colgroup id colgroup lang colgroup span colgroup title +colgroup valign colgroup width colgroup xml:lang @@ -306,6 +332,20 @@ fieldset xml:lang +# font +# local change to font + +font class +font color +font dir +font face +font id +font lang +font size +font title +font xml:lang + + # form # interactive form @@ -318,6 +358,7 @@ form id form lang form method +form name form title form xml:lang @@ -325,69 +366,69 @@ # h1 # heading +h1 align h1 class h1 dir h1 id h1 lang h1 title h1 xml:lang -h1 align # h2 # heading +h2 align h2 class h2 dir h2 id h2 lang h2 title h2 xml:lang -h2 align # h3 # heading +h3 align h3 class h3 dir h3 id h3 lang h3 title h3 xml:lang -h3 align # h4 # heading +h4 align h4 class h4 dir h4 id h4 lang h4 title h4 xml:lang -h4 align # h5 # heading +h5 align h5 class h5 dir h5 id h5 lang h5 title h5 xml:lang -h5 align # h6 # heading +h6 align h6 class h6 dir h6 id h6 lang h6 title h6 xml:lang -h6 align # head # document head @@ -402,11 +443,14 @@ # hr # horizontal rule +hr align hr class hr dir hr id hr lang +hr size hr title +hr width hr xml:lang @@ -436,25 +480,29 @@ img align img alt +img border img class img dir img height +img hspace img id img ismap img lang img longdesc +img name img src img title img usemap +img vspace img width img xml:lang -img border # input # form control input accept input accesskey +input align input alt input checked input class @@ -516,6 +564,7 @@ # fieldset legend legend accesskey +legend align legend class legend dir legend id @@ -532,6 +581,8 @@ li id li lang li title +li type +li value li xml:lang @@ -550,7 +601,9 @@ # object # generic embedded object +object align object archive +object border object class object classid object codebase @@ -559,6 +612,7 @@ object declare object dir object height +object hspace object id object lang object name @@ -567,6 +621,7 @@ object title object type object usemap +object vspace object width object xml:lang @@ -575,10 +630,13 @@ # ordered list ol class +ol compact ol dir ol id ol lang +ol start ol title +ol type ol xml:lang @@ -613,13 +671,13 @@ # p # paragraph +p align p class p dir p id p lang p title p xml:lang -p align # param @@ -640,6 +698,7 @@ pre id pre lang pre title +pre width pre xml:lang pre xml:space @@ -656,6 +715,17 @@ q xml:lang +# s +# strike-through text style + +s class +s dir +s id +s lang +s title +s xml:lang + + # samp # sample program output, scripts, etc. @@ -684,6 +754,8 @@ # small +# small text style + small class small dir @@ -704,6 +776,17 @@ span xml:lang +# strike +# strike-through text + +strike class +strike dir +strike id +strike lang +strike title +strike xml:lang + + # strong # strong emphasis @@ -740,6 +823,8 @@ # table # +table align +table bgcolor table border table cellpadding table cellspacing @@ -758,11 +843,15 @@ # tbody # table body +tbody align +tbody char +tbody charoff tbody class tbody dir tbody id tbody lang tbody title +tbody valign tbody xml:lang @@ -770,16 +859,24 @@ # table data cell td abbr +td align td axis +td bgcolor +td char +td charoff td class td colspan td dir td headers +td height td id td lang +td nowrap td rowspan td scope td title +td valign +td width td xml:lang @@ -804,11 +901,15 @@ # tfoot # table footer +tfoot align +tfoot char +tfoot charoff tfoot class tfoot dir tfoot id tfoot lang tfoot title +tfoot valign tfoot xml:lang @@ -816,51 +917,59 @@ # table header cell th abbr +th align th axis +th bgcolor +th char +th charoff th class th colspan th dir th headers +th height th id th lang th rowspan th scope th title +th valign +th width th xml:lang # thead # table header +thead align +thead char +thead charoff thead class thead dir thead id thead lang thead title +thead valign thead xml:lang -# title -# document title - -title dir -title id -title lang -title xml:lang - - # tr # table row +tr align +tr bgcolor +tr char +tr charoff tr class tr dir tr id tr lang tr title +tr valign tr xml:lang # tt +# teletype or monospaced text style tt class tt dir @@ -870,14 +979,27 @@ tt xml:lang +# u +# underlined text style + +u class +u dir +u id +u lang +u title +u xml:lang + + # ul # unordered list ul class +ul compact ul dir ul id ul lang ul title +ul type ul xml:lang From bruno at mkdoc.demon.co.uk Mon Jul 25 15:17:56 2005 From: bruno at mkdoc.demon.co.uk (bruno@mkdoc.demon.co.uk) Date: Mon Jul 25 15:18:01 2005 Subject: [MKDoc-commit] [MKDoc::XML] updated changelog after tag attribute stripping update Message-ID: <20050725141756.B7F462E28E7@mkdoc.demon.co.uk> Log Message: ----------- [MKDoc::XML] updated changelog after tag attribute stripping update Modified Files: -------------- MKDoc-XML: Changes -------------- next part -------------- Index: Changes =================================================================== RCS file: /var/spool/cvs/MKDoc-XML/Changes,v retrieving revision 1.43 retrieving revision 1.44 diff -LChanges -LChanges -u -r1.43 -r1.44 --- Changes +++ Changes @@ -1,5 +1,8 @@ Revision history for MKDoc::XML +0.76 + - mkdoc16 and xmhtmlttansitional tag attribute stripping less enthusiastic + 0.75 Thu Mar 10 15:12:00 2005 - Added tests for tagger bugs when matching numbers and double escaping attribute contents - bugfix for double-encoding attribute-contents bug From bruno at mkdoc.demon.co.uk Mon Jul 25 17:37:46 2005 From: bruno at mkdoc.demon.co.uk (bruno@mkdoc.demon.co.uk) Date: Mon Jul 25 17:37:50 2005 Subject: [MKDoc-commit] [mkd-import] UKAF schema has changed Message-ID: <20050725163746.CB6F42E28E7@mkdoc.demon.co.uk> Log Message: ----------- [mkd-import] UKAF schema has changed Modified Files: -------------- mkd-import/lib/MKDoc/Import/Source: UKAF.pm mkd-import/t: 004_CSV_Parser_UKAF_Area.t mkd-import/t/data/ukaf: Agency.txt Area.txt -------------- next part -------------- Index: UKAF.pm =================================================================== RCS file: /var/spool/cvs/mkd-import/lib/MKDoc/Import/Source/UKAF.pm,v retrieving revision 1.4 retrieving revision 1.5 diff -Llib/MKDoc/Import/Source/UKAF.pm -Llib/MKDoc/Import/Source/UKAF.pm -u -r1.4 -r1.5 --- lib/MKDoc/Import/Source/UKAF.pm +++ lib/MKDoc/Import/Source/UKAF.pm @@ -89,16 +89,16 @@ my @result = @{$self->{'agency_records'}}; - # strip records which have no 'RecordID' - @result = map { $_->{RecordID} ? $_ : () } @result; + # strip records which have no 'RecordId' + @result = map { $_->{RecordId} ? $_ : () } @result; # strip records which have no associated region information out - @result = map { $self->{areas_hash}->{$_->{RecordID}} ? $_ : () } @result; + @result = map { $self->{areas_hash}->{$_->{RecordId}} ? $_ : () } @result; # give an extra 'region' attribute for (@result) { - my $id = $_->{RecordID}; + my $id = $_->{RecordId}; $_->{region} = $self->{areas_hash}->{$id}; $_->{region} = $self->{codes_hash}->{$_->{region}}; $_->{region} = lc ($_->{region}); @@ -126,7 +126,7 @@ my %hash = (); for (@{$self->{'area_records'}}) { - my $key = $_->{RecordID}; + my $key = $_->{RecordId}; my $val = $_->{Code}; next unless (length ($val) == 6); @@ -311,9 +311,9 @@ } @res = map { - $_->{RecordID} || die Dumper ($_); # next; + $_->{RecordId} || die Dumper ($_); # next; my $producer = new MKDoc::Import::Source::UKAF::Agency ( - 'Title' => $_->{RecordID}, + 'Title' => $_->{RecordId}, '.parent' => $doc, 'record' => $_ ); Index: 004_CSV_Parser_UKAF_Area.t =================================================================== RCS file: /var/spool/cvs/mkd-import/t/004_CSV_Parser_UKAF_Area.t,v retrieving revision 1.2 retrieving revision 1.3 diff -Lt/004_CSV_Parser_UKAF_Area.t -Lt/004_CSV_Parser_UKAF_Area.t -u -r1.2 -r1.3 --- t/004_CSV_Parser_UKAF_Area.t +++ t/004_CSV_Parser_UKAF_Area.t @@ -12,39 +12,39 @@ ok (!$@ => 'parse'); is ($res->[0]->{Code}, '01VV05', => 'data check'); -is ($res->[0]->{RecordID}, '11', => 'data check'); +is ($res->[0]->{RecordId}, '11', => 'data check'); is ($res->[0]->{StrongType}, '1', => 'data check'); is ($res->[1]->{Code}, '01VV07', => 'data check'); -is ($res->[1]->{RecordID}, '11', => 'data check'); +is ($res->[1]->{RecordId}, '11', => 'data check'); is ($res->[1]->{StrongType}, '1', => 'data check'); is ($res->[2]->{Code}, '01VV15', => 'data check'); -is ($res->[2]->{RecordID}, '11', => 'data check'); +is ($res->[2]->{RecordId}, '11', => 'data check'); is ($res->[2]->{StrongType}, '1', => 'data check'); is ($res->[3]->{Code}, '01VV01', => 'data check'); -is ($res->[3]->{RecordID}, '19', => 'data check'); +is ($res->[3]->{RecordId}, '19', => 'data check'); is ($res->[3]->{StrongType}, '1', => 'data check'); is ($res->[4]->{Code}, '01SS09', => 'data check'); -is ($res->[4]->{RecordID}, '35', => 'data check'); +is ($res->[4]->{RecordId}, '35', => 'data check'); is ($res->[4]->{StrongType}, '1', => 'data check'); is ($res->[5]->{Code}, '01UU07', => 'data check'); -is ($res->[5]->{RecordID}, '35', => 'data check'); +is ($res->[5]->{RecordId}, '35', => 'data check'); is ($res->[5]->{StrongType}, '1', => 'data check'); is ($res->[6]->{Code}, '01UU16', => 'data check'); -is ($res->[6]->{RecordID}, '35', => 'data check'); +is ($res->[6]->{RecordId}, '35', => 'data check'); is ($res->[6]->{StrongType}, '1', => 'data check'); is ($res->[7]->{Code}, '01QQ03', => 'data check'); -is ($res->[7]->{RecordID}, '103', => 'data check'); +is ($res->[7]->{RecordId}, '103', => 'data check'); is ($res->[7]->{StrongType}, '1', => 'data check'); is ($res->[8]->{Code}, '01QQ02', => 'data check'); -is ($res->[8]->{RecordID}, '145', => 'data check'); +is ($res->[8]->{RecordId}, '145', => 'data check'); is ($res->[8]->{StrongType}, '1', => 'data check'); Index: Agency.txt =================================================================== RCS file: /var/spool/cvs/mkd-import/t/data/ukaf/Agency.txt,v retrieving revision 1.1 retrieving revision 1.2 diff -Lt/data/ukaf/Agency.txt -Lt/data/ukaf/Agency.txt -u -r1.1 -r1.2 --- t/data/ukaf/Agency.txt +++ t/data/ukaf/Agency.txt @@ -1,4 +1,4 @@ -"RecordID","Status","OrgName","Address1","Address2","Address3","Address4","ConfidentialAddress","PostCode","PublicPhone","AdminPhone","Minicom","Email","Website","Monday","Tuesday","Wednesday","Thursday","Friday","Weekends","OfficeHours","TargetGroup","AreaServed","ServiceOffered","HowtoContact","Languages","TypeofOrganisation","Fax","WheelchairAccess","AdaptedToilets","AccessText","PublicTransport","YearEstablished","Staffing","CharityNo","LocalAuthority","LastUpdated" +"RecordId","Status","OrgName","Address1","Address2","Address3","Address4","ConfidentialAddress","PostCode","PublicPhone","AdminPhone","Minicom","Email","Website","Monday","Tuesday","Wednesday","Thursday","Friday","Weekends","OfficeHours","TargetGroup","AreaServed","ServiceOffered","HowtoContact","Languages","TypeofOrganisation","Fax","WheelchairAccess","AdaptedToilets","AccessText","PublicTransport","YearEstablished","Staffing","CharityNo","LocalAuthority","LastUpdated" 11,"09BN","Relate - Shropshire and Herefordshire","The Roy Fletcher Centre","12 - 17 Cross Hill","Shrewsbury","Shropshire",0,"SY1 1JE","01743 344010","01743 344461",,,,"10am - 9pm","10am - 9pm","10am - 9pm","10am - 5pm","10am - 3pm","Saturday 10am -12.30pm",,"Adults experiencing relationship problems.","Shropshire and Herefordshire.","Counselling for adults experiencing relationship problems, provided in 9 towns across the area. Clients are asked to make a payment for counselling - the amount depends on income. Also provide pyschosexual therapy and education and training services. ","Write or phone.","Welsh, Italian, German, Spanish. Access to interpreters.","05A","01743 244362","07AA","08AA","3 offices - access details vary.","Offices based in centres of Telford, Shrewsbury and Hereford.","1965","1 full time and 20 part time staff, 150+ volunteers.","1054670","01VV07",2002-01-03 00:00:00 19,"09BN","Birmingham Women's Advice and Information Centre (BWAIC)","5th Floor","Ruskin Chambers","191 Corporation Street","Birmingham",0,"B4 6RP","0121 212 1881",,,,,"10am - 4pm appointments","10am - 4pm drop-in","10am - 4pm appointments","10am - 4pm drop-in","10am - 4pm appointments",,,"Women.","Birmingham.","Advice, information, support, short term crisis counselling, training and facilitation for women. Training and volunteering opportunities. The service is provided by women for women.","Drop-in Tuesday and Thursday 10am-4pm or phone for an appointment.","French, Urdu. Access to interpreters.","05A","0121 236 5886","07AB","08BB","Ramped entrance. Small lift. Disabled clients can be seen at accessible premises close by on request. Access to signers.","New Street and Snow Hill train stations.","1985","2 paid sessional workers, 6 volunteers.","1002849","01VV01",2002-06-19 00:00:00 35,"09BN","Mediation Salisbury and District","24 St Edmund's Church Street","Salisbury",,,0,"SP1 1EF","01722 332936",,,"fms@swilts.ndo.co.uk",,"9am - 5pm","9am - 5pm","9am - 5pm","9am - 5pm","9am - 1pm",,,"Divorcing couples, separating parents, children, general public.","South Wiltshire, North Dorset and North West Hampshire.","Mediators assist people to resolve conflicts relating to divorce, separation, neighbours or other disputes where people can be helped to find agreed solutions. Special service for children who need help arising from their parents separation. Mediation around finance and property issues arising from divorce.","Phone, email or write for an appointment.","French. Access to interpreters.","05A","01722 332936","07AA","08BB","Parking close by. Ramped entrance. Access to BSL signers.","Very close to Endless Street bus station.","1985","9 part time staff.","288726","01UU16",2002-07-19 00:00:00 Index: Area.txt =================================================================== RCS file: /var/spool/cvs/mkd-import/t/data/ukaf/Area.txt,v retrieving revision 1.1 retrieving revision 1.2 diff -Lt/data/ukaf/Area.txt -Lt/data/ukaf/Area.txt -u -r1.1 -r1.2 --- t/data/ukaf/Area.txt +++ t/data/ukaf/Area.txt @@ -1,4 +1,4 @@ -"RecordID","Code","StrongType" +"RecordId","Code","StrongType" 11,"01VV05",1 11,"01VV07",1 11,"01VV15",1 From bruno at mkdoc.demon.co.uk Mon Jul 25 17:38:28 2005 From: bruno at mkdoc.demon.co.uk (bruno@mkdoc.demon.co.uk) Date: Mon Jul 25 17:38:31 2005 Subject: [MKDoc-commit] [mkd-import] script to validate CSV databases before import Message-ID: <20050725163828.8B1C42E28E7@mkdoc.demon.co.uk> Log Message: ----------- [mkd-import] script to validate CSV databases before import Added Files: ----------- mkd-import/examples/ukaf: ukaf-checker.pl -------------- next part -------------- --- /dev/null +++ examples/ukaf/ukaf-checker.pl @@ -0,0 +1,76 @@ +#!/usr/bin/perl +use strict; +use warnings; +use File::Temp qw/ :POSIX /; + +# take the path to the 'data' directory from the command line + +my $datadir = shift || 'examples/ukaf/data'; + $datadir =~ s/\/+$//; + +my $file = { agency => "$datadir/Agency.txt", + area => "$datadir/Area.txt", + codes => "$datadir/CODES.txt" }; + +print STDERR "\nLooking for CSV database in '$datadir'...\n"; + +# check for existence of exported database. Three files are required called +# Agency.txt, Area.txt and CODES.txt. + +open AGENCY, "<:encoding(utf8)", $file->{agency} or die "Can't find $file->{agency}: $!"; +open AREA, "<:encoding(utf8)", $file->{area} or die "Can't find $file->{area}: $!"; +open CODES, "<:encoding(utf8)", $file->{codes} or die "Can't find $file->{codes}: $!"; + +my @agency = ; close AGENCY; +my @area = ; close AREA; +my @codes = ; close CODES; + +print STDERR "CSV files found OK.\n\n"; + +# check that CSV headers are in place and correct + +print STDERR "Looking for required database fields...\n"; + +my $agency_headers = '"RecordId","Status","OrgName","Address1","Address2","Address3","Address4","ConfidentialAddress","PostCode","PublicPhone","AdminPhone","Minicom","Email","Website","Monday","Tuesday","Wednesday","Thursday","Friday","Weekends","OfficeHours","TargetGroup","AreaServed","ServiceOffered","HowtoContact","Languages","TypeofOrganisation","Fax","WheelchairAccess","AdaptedToilets","AccessText","PublicTransport","YearEstablished","Staffing","CharityNo","LocalAuthority","LastUpdated"'; +my $area_headers = '"RecordId","Code"'; +my $codes_headers = '"CombinedCode","Code","Description","OrderID"'; + +$agency[0] =~ /$agency_headers/ or die "unknown database fields in $file->{agency}"; +print STDERR "'Agency' fields OK.\n"; + +$area[0] =~ /$area_headers/ or die "unknown database fields in $file->{area}"; +print STDERR "'Area' fields OK.\n"; + +$codes[0] =~ /$codes_headers/ or die "unknown database fields in $file->{codes}"; +print STDERR "'CODES' fields OK.\n\n"; + +# check that files are UTF-8 not CP1252 + +print STDERR "Checking that data is Unicode UTF-8...\n"; + +my $pound_sign = "\x{00A3}"; +my $utf8_ok = "FALSE"; + +for (@agency) +{ + $utf8_ok = "TRUE" if $_ =~ /$pound_sign/; +} + +if ($utf8_ok eq "TRUE") +{ + print STDERR "'Agency' table contains UTF-8 characters, OK.\n\n"; +} + +# convert from CP1252 to UTF-8 if necessary + +if ($utf8_ok eq "FALSE") +{ + print STDERR "'Agency' table is not UTF-8. Converting from CP1252...\n"; + my $tempname = tmpnam(); + `iconv -f CP1252 -t utf-8 -o $tempname $file->{agency}`; + `cp $tempname $file->{agency}`; + print STDERR "'Agency' table converted, OK.\n\n"; +} + +1; + From bruno at mkdoc.demon.co.uk Mon Jul 25 17:45:57 2005 From: bruno at mkdoc.demon.co.uk (bruno@mkdoc.demon.co.uk) Date: Mon Jul 25 17:46:00 2005 Subject: [MKDoc-commit] [mkd-import] connect validator to import script Message-ID: <20050725164557.D6EC52E28E7@mkdoc.demon.co.uk> Log Message: ----------- [mkd-import] connect validator to import script Modified Files: -------------- mkd-import/examples/ukaf: ukaf.sh -------------- next part -------------- Index: ukaf.sh =================================================================== RCS file: /var/spool/cvs/mkd-import/examples/ukaf/ukaf.sh,v retrieving revision 1.1 retrieving revision 1.2 diff -Lexamples/ukaf/ukaf.sh -Lexamples/ukaf/ukaf.sh -u -r1.1 -r1.2 --- examples/ukaf/ukaf.sh +++ examples/ukaf/ukaf.sh @@ -1,4 +1,5 @@ export MKDOC_DIR=/opt/mkd +./examples/ukaf/ukaf-checker.pl || exit perl -I ./lib -I $MKDOC_DIR -M"MKDoc::Import" -e slurp \ "ukaf:tmpl=examples/ukaf/tmpl;data=examples/ukaf/data" \ "mkdoc:site=/opt/groucho;path=/ukaf" From bruno at mkdoc.demon.co.uk Mon Jul 25 17:48:33 2005 From: bruno at mkdoc.demon.co.uk (bruno@mkdoc.demon.co.uk) Date: Mon Jul 25 17:48:36 2005 Subject: [MKDoc-commit] [mkd-import] fix path Message-ID: <20050725164833.63AB92E28E7@mkdoc.demon.co.uk> Log Message: ----------- [mkd-import] fix path Modified Files: -------------- mkd-import/examples/ukaf: ukaf.sh -------------- next part -------------- Index: ukaf.sh =================================================================== RCS file: /var/spool/cvs/mkd-import/examples/ukaf/ukaf.sh,v retrieving revision 1.2 retrieving revision 1.3 diff -Lexamples/ukaf/ukaf.sh -Lexamples/ukaf/ukaf.sh -u -r1.2 -r1.3 --- examples/ukaf/ukaf.sh +++ examples/ukaf/ukaf.sh @@ -1,5 +1,5 @@ export MKDOC_DIR=/opt/mkd -./examples/ukaf/ukaf-checker.pl || exit +examples/ukaf/ukaf-checker.pl examples/ukaf/data || exit perl -I ./lib -I $MKDOC_DIR -M"MKDoc::Import" -e slurp \ "ukaf:tmpl=examples/ukaf/tmpl;data=examples/ukaf/data" \ "mkdoc:site=/opt/groucho;path=/ukaf" From bruno at mkdoc.demon.co.uk Thu Jul 28 11:25:46 2005 From: bruno at mkdoc.demon.co.uk (bruno@mkdoc.demon.co.uk) Date: Thu Jul 28 11:25:52 2005 Subject: [MKDoc-commit] [MKDoc-Text-Structured] strip mailto: from displayed email addresses Message-ID: <20050728102546.0CABB2E28E7@mkdoc.demon.co.uk> Log Message: ----------- [MKDoc-Text-Structured] strip mailto: from displayed email addresses Modified Files: -------------- MKDoc-Text-Structured: Changes MKDoc-Text-Structured/lib/MKDoc/Text/Structured: Inline.pm Added Files: ----------- MKDoc-Text-Structured/t: 020_mailto.t -------------- next part -------------- Index: Changes =================================================================== RCS file: /var/spool/cvs/MKDoc-Text-Structured/Changes,v retrieving revision 1.23 retrieving revision 1.24 diff -LChanges -LChanges -u -r1.23 -r1.24 --- Changes +++ Changes @@ -3,6 +3,7 @@ 0.83 - fix for
 indenting bug when first line is more indented than second
     - method to insert spaces into long words
+    - strip mailto: when linking and displaying email addresses
 
 0.82 Thu Mar 31 13:45:00 2005
     - fixed failure to change " to " bug
Index: Inline.pm
===================================================================
RCS file: /var/spool/cvs/MKDoc-Text-Structured/lib/MKDoc/Text/Structured/Inline.pm,v
retrieving revision 1.12
retrieving revision 1.13
diff -Llib/MKDoc/Text/Structured/Inline.pm -Llib/MKDoc/Text/Structured/Inline.pm -u -r1.12 -r1.13
--- lib/MKDoc/Text/Structured/Inline.pm
+++ lib/MKDoc/Text/Structured/Inline.pm
@@ -21,6 +21,7 @@
     my $finder = URI::Find->new (
         sub {
             my ($uri, $orig_uri) = @_;
+            $orig_uri =~ s/^mailto://;
             return qq|$orig_uri|;
         }
     );
@@ -52,7 +53,7 @@
 
 $title is now:
 
-  My © symbol shouldn't be *bold* — or http://example.com/ ‘linked’
+  My © symbol shouldn't be *bold* — or http://example.com/ ‘linked’
 
 =cut
 
--- /dev/null
+++ t/020_mailto.t
@@ -0,0 +1,12 @@
+use warnings;
+use strict;
+use Test::More 'no_plan';
+use lib ('lib', '../lib');
+use MKDoc::Text::Structured;
+
+my $text = undef;
+
+$text = MKDoc::Text::Structured::process ('This is a test: mailto:info@mkdoc.com');
+is ($text, '

This is a test: info@mkdoc.com

'); + +__END__ From bruno at mkdoc.demon.co.uk Thu Jul 28 12:06:53 2005 From: bruno at mkdoc.demon.co.uk (bruno@mkdoc.demon.co.uk) Date: Thu Jul 28 12:06:57 2005 Subject: [MKDoc-commit] [MKDoc-Text-Structured] documented Inline module Message-ID: <20050728110653.7F7BB2E28E7@mkdoc.demon.co.uk> Log Message: ----------- [MKDoc-Text-Structured] documented Inline module Modified Files: -------------- MKDoc-Text-Structured: Changes MKDoc-Text-Structured/lib/MKDoc/Text/Structured: Inline.pm -------------- next part -------------- Index: Changes =================================================================== RCS file: /var/spool/cvs/MKDoc-Text-Structured/Changes,v retrieving revision 1.24 retrieving revision 1.25 diff -LChanges -LChanges -u -r1.24 -r1.25 --- Changes +++ Changes @@ -4,6 +4,7 @@ - fix for
 indenting bug when first line is more indented than second
     - method to insert spaces into long words
     - strip mailto: when linking and displaying email addresses
+    - documented MKDoc::Text::Structured::Inline
 
 0.82 Thu Mar 31 13:45:00 2005
     - fixed failure to change " to " bug
Index: Inline.pm
===================================================================
RCS file: /var/spool/cvs/MKDoc-Text-Structured/lib/MKDoc/Text/Structured/Inline.pm,v
retrieving revision 1.13
retrieving revision 1.14
diff -Llib/MKDoc/Text/Structured/Inline.pm -Llib/MKDoc/Text/Structured/Inline.pm -u -r1.13 -r1.14
--- lib/MKDoc/Text/Structured/Inline.pm
+++ lib/MKDoc/Text/Structured/Inline.pm
@@ -7,6 +7,40 @@
 
 our $LongestWord = 78;
 
+=head1 NAME
+
+MKDoc::Text::Structured::Inline - convert text to HTML without handling block-level tags
+
+=head1 SYNOPSIS
+
+  my $text = some_structured_text();
+  my $this = MKDoc::Text::Structured::Inline::process ($text);
+  my $that = MKDoc::Text::Structured::Inline::process_entities_only ($text);
+
+=head1 SUMMARY
+
+L is used by L to
+generate inline HTML elements such as hyperlinks, emphasis and entities.
+
+This module is also useful directly when the full block-level rendering of
+L is unwanted.
+
+=head1 USAGE
+
+=head2 Processing text and adding HTML tags
+
+For example, when processing text that is going to end up in an 

header, +you wouldn't want any block level tags generated: + + $header = "< My (c) symbol should be *bold* > -- and http://example.com/ 'linked'"; + $header = MKDoc::Text::Structured::Inline::process ($title); + +$header is now: + + < My © symbol should be bold > — and http://example.com/ ‘linked’ + +=cut + sub process { local $Text; @@ -46,14 +80,16 @@ =head2 Processing text without adding tags -Example: +Another example, if you were processing text that will end up in an HTML + tag, this tag should never contain any other tags, so you should use +the MKDoc::Text::Structured::Inline::process_entities_only() method: - $title = "My (c) symbol shouldn't be *bold* -- or http://example.com/ 'linked'"; + $title = "< My (c) symbol shouldn't be *bold* > -- or http://example.com/ 'linked'"; $title = MKDoc::Text::Structured::Inline::process_entities_only ($title); $title is now: - My © symbol shouldn't be *bold* — or <a href="http://example.com/">http://example.com/</a> ‘linked’ + < My © symbol shouldn't be *bold* — > or http://example.com/ ‘linked’ =cut From bruno at mkdoc.demon.co.uk Thu Jul 28 14:21:52 2005 From: bruno at mkdoc.demon.co.uk (bruno@mkdoc.demon.co.uk) Date: Thu Jul 28 14:22:01 2005 Subject: [MKDoc-commit] [mkd-import] found these uncommitted chnages on a live server Message-ID: <20050728132152.E7EA32E28E7@mkdoc.demon.co.uk> Log Message: ----------- [mkd-import] found these uncommitted chnages on a live server Modified Files: -------------- mkd-import/examples/ukaf/tmpl: agency.html language.html region.html root.html -------------- next part -------------- Index: root.html =================================================================== RCS file: /var/spool/cvs/mkd-import/examples/ukaf/tmpl/root.html,v retrieving revision 1.1 retrieving revision 1.2 diff -Lexamples/ukaf/tmpl/root.html -Lexamples/ukaf/tmpl/root.html -u -r1.1 -r1.2 --- examples/ukaf/tmpl/root.html +++ examples/ukaf/tmpl/root.html @@ -8,7 +8,8 @@ <mkdoc:Editor_Created_ID>1</mkdoc:Editor_Created_ID> <mkdoc:Editor_Last_Modified_ID>1</mkdoc:Editor_Last_Modified_ID> <mkdoc:Cache_Control>120</mkdoc:Cache_Control> - <mkdoc:Lang>fr</mkdoc:Lang> - <mkdoc:Keywords>aucun</mkdoc:Keywords> - <mkdoc:Description>Agences fournissant un support en Francais</mkdoc:Description> + <mkdoc:Lang>en</mkdoc:Lang> + <mkdoc:Keywords>agencies</mkdoc:Keywords> + <mkdoc:Description>Agencies</mkdoc:Description> + <mkdoc:Template>agency</mkdoc:Template> </root> Index: agency.html =================================================================== RCS file: /var/spool/cvs/mkd-import/examples/ukaf/tmpl/agency.html,v retrieving revision 1.1 retrieving revision 1.2 diff -Lexamples/ukaf/tmpl/agency.html -Lexamples/ukaf/tmpl/agency.html -u -r1.1 -r1.2 --- examples/ukaf/tmpl/agency.html +++ examples/ukaf/tmpl/agency.html @@ -56,8 +56,17 @@ <mkdoc:Cache_Control>120</mkdoc:Cache_Control> <mkdoc:Lang>en</mkdoc:Lang> <mkdoc:Keywords>none</mkdoc:Keywords> - <mkdoc:Description petal:content="self/record/TargetGroup"></mkdoc:Description> + <mkdoc:Description petal:content="string: ${self/record/OrgName} offers these services: ${self/record/ServiceOffered}"></mkdoc:Description> + <mkdoc:Template>agency</mkdoc:Template> <mkdoc:Body type="flo::editor::Html"> + <h2>Service Offered</h2> + <p petal:content="self/record/ServiceOffered">Service Offered</p> + <h2>Target Group</h2> + <p petal:content="self/record/TargetGroup">Target Group</p> + <h2>Languages</h2> + <p petal:content="self/record/Languages">Languages</p> + <h2>Area Served</h2> + <p petal:content="self/record/AreaServed">Area Served</p> <h2>Contact details</h2> <dl> <dt petal:condition="self/record/PublicPhone">Phone</dt> @@ -82,7 +91,7 @@ </dd> </dl> - <h2>Office Hours</h2> + <h2>Opening Hours</h2> <dl> <dt>Monday</dt> <dd petal:content="self/record/Monday">stuff</dd> @@ -97,5 +106,6 @@ <dt>Weekends</dt> <dd petal:content="self/record/Weekends">stuff</dd> </dl> + </mkdoc:Body> </root> Index: language.html =================================================================== RCS file: /var/spool/cvs/mkd-import/examples/ukaf/tmpl/language.html,v retrieving revision 1.1 retrieving revision 1.2 diff -Lexamples/ukaf/tmpl/language.html -Lexamples/ukaf/tmpl/language.html -u -r1.1 -r1.2 --- examples/ukaf/tmpl/language.html +++ examples/ukaf/tmpl/language.html @@ -12,6 +12,7 @@ <mkdoc:Editor_Last_Modified_ID>1</mkdoc:Editor_Last_Modified_ID> <mkdoc:Cache_Control>120</mkdoc:Cache_Control> <mkdoc:Lang>en</mkdoc:Lang> - <mkdoc:Keywords>aucun</mkdoc:Keywords> + <mkdoc:Keywords petal:content="self/record/0/language"></mkdoc:Keywords> <mkdoc:Description>Agencies providing services in ${self/record/0/language}.</mkdoc:Description> + <mkdoc:Template>agency</mkdoc:Template> </root> Index: region.html =================================================================== RCS file: /var/spool/cvs/mkd-import/examples/ukaf/tmpl/region.html,v retrieving revision 1.1 retrieving revision 1.2 diff -Lexamples/ukaf/tmpl/region.html -Lexamples/ukaf/tmpl/region.html -u -r1.1 -r1.2 --- examples/ukaf/tmpl/region.html +++ examples/ukaf/tmpl/region.html @@ -16,4 +16,5 @@ <mkdoc:Lang>en</mkdoc:Lang> <mkdoc:Keywords>none</mkdoc:Keywords> <mkdoc:Description>Agencies providing services in ${self/record/0/language} in ${self/record/0/region}</mkdoc:Description> + <mkdoc:Template>agency</mkdoc:Template> </root>