"Fossies" - the Fresh Open Source Software Archive

Member "metadot/metadot/Metadot/AbstractMessage.pm" (1 Jul 2005, 8988 Bytes) of package /linux/www/old/Metadot6.4.5.4.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "AbstractMessage.pm" see the Fossies "Dox" file reference documentation.

    1 ###########################################################################
    2 # <LICENSEINFO>
    3 # Copyright (C) Daniel Guermeur - 1999-2001
    4 # Copyright (C) Metadot Corporation - 2001-2005
    5 #
    6 # This file is part of Metadot Portal Server software $Name: Release_6_4_5_4 $
    7 #
    8 # Metadot Portal Server software is free software; you can
    9 # redistribute it and/or modify it under the terms of the GNU General Public
   10 # License as published by the Free Software Foundation; either version 2 of
   11 # the License, or (at your option) any later version.
   12 #
   13 # Metadot Portal Server software is distributed in the hope that it
   14 # will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty
   15 # of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General
   16 # Public License for more details.
   17 #
   18 # You should have received a copy of the GNU General Public License along with
   19 # Metadot Portal Server; if not, write to the Free Software
   20 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   21 #
   22 # For more information, please contact info@metadot.com.
   23 #</LICENSEINFO>
   24 ############################################################################
   25 package Metadot::AbstractMessage;
   26 use strict;
   27 
   28 use Metadot qw($USER %FORM $SESSION $HTTP_HEADER_SENT $PARAMS $DISPLAY $CGI);
   29 
   30 use Carp;
   31 use vars qw(@ISA $AUTOLOAD);
   32 
   33 use HTML::Parser;
   34 use DBAccess;
   35 use Text::Wrap;
   36 use Portal;
   37 #use Metadot::Utils::Theme;
   38 #use Gizmo;
   39 #use Gizmo::Discussion;
   40 use Metadot::UserFactory;
   41 use Utility;
   42 use Operations;
   43 
   44 # CKIM: testing to see where this breaks
   45 #@ISA = qw(Discussion Portal);
   46 @ISA = qw(Portal);
   47 
   48 
   49 sub get_owner_uid {
   50     my $self = shift;
   51 
   52     return $self->{recipient_uid};
   53 }
   54 
   55 sub get_AC {
   56     my $self = shift;
   57     return $self->get_default_permissions();
   58 }
   59 
   60 sub get_default_permissions {
   61     my $self = shift;
   62 
   63     my $ac;
   64     if (ref($self) && $self->{_default_permissions}) {
   65         $ac = $self->{_default_permissions};
   66     } else {
   67         $ac = Operations->new();
   68         $ac->add_bundle('DISP', 'View', 8, 8);
   69         $ac->add_op('DISP', 'show');
   70     }
   71 
   72     return $ac;
   73 }
   74 
   75 sub initialize {
   76     my $self = shift;
   77 }
   78 
   79 sub new {
   80     my $proto = shift;
   81     my $mid = shift;
   82     my $class = ref($proto) || $proto;
   83 
   84     my $self;
   85 
   86     $mid = undef unless Utility->is_valid_integer($mid); # secu_200401
   87 
   88     $self->{mid}             = undef;
   89     $self->{iid}             = "";
   90     $self->{parent_mid}      = "";
   91     $self->{postuid}         = "";
   92     $self->{name}            = "";
   93     $self->{description}     = "";
   94     $self->{creation_date}   = "";
   95     $self->{update_date}     = "";
   96     $self->{updated_by}      = "";
   97     $self->{status}          = "";
   98     $self->{priority}        = "";
   99     $self->{email}           = "";
  100     $self->{author_name}     = "";
  101     $self->{author_email}    = "";
  102     $self->{recipient_uid}   = "";
  103     $self->{is_a}            = undef;
  104 
  105     # [vadim] runtime flag
  106     $self->{editing}    = undef ;
  107 
  108     if(defined ($mid)){
  109 
  110       ($self->{mid}            ,
  111        $self->{postuid}            ,
  112        $self->{parent_mid}     ,
  113        $self->{iid}            ,
  114        $self->{name}           ,
  115        $self->{description}    ,
  116        $self->{creation_date}  ,
  117        $self->{update_date}    ,
  118        $self->{updated_by}     ,
  119        $self->{status}         ,
  120        $self->{priority}       ,
  121        $self->{email}          ,
  122        $self->{author_name}    ,
  123        $self->{author_email}   ,
  124        $self->{recipient_uid}  ,
  125        $self->{is_a}           ,
  126       )
  127     = DBAccess->sqlSelect(
  128             "mid           ,
  129                     userid         ,
  130             parentmid      ,
  131             iid            ,
  132             name           ,
  133             description    ,
  134             creationdate ,
  135             updatedate ,
  136             updatedby      ,
  137             status         ,
  138             priority       ,
  139             email          ,
  140             authorname     ,
  141             authoremail    ,
  142             recipient_uid  ,
  143             isa",
  144             "message",
  145             "mid=$mid"
  146            );
  147 
  148     }
  149     $self->{creation_date} = Utility->format_datetime($self->{creation_date}, 'b e, Y, r');
  150     $self->{update_date}   = Utility->format_datetime($self->{update_date}, 'b e, Y, r');
  151     unless (defined($self->{is_a}) || $self->{is_a} ne '') {
  152         $self->{is_a} = $class;
  153     }
  154 
  155     bless ($self, $class);
  156     $self->initialize();
  157 
  158     return $self;
  159 }
  160 
  161 # aju 03-9-02
  162 sub get_id {
  163     my $self = shift;
  164     return $self->get_mid();
  165 }
  166 
  167 sub id {
  168     my $self = shift;
  169     return $self->get_mid();
  170 }
  171 
  172 sub get_mid {
  173     my $self = shift;
  174     return $self->{mid};
  175 }
  176 
  177 sub authorname {
  178     my $self = shift;
  179     return $self->{author_name};
  180 }
  181 
  182 sub authoremail {
  183     my $self = shift;
  184     return $self->{author_email};
  185 }
  186 
  187 sub creationdate {
  188     my $self = shift;
  189     return $self->{creation_date};
  190 }
  191 
  192 #####################################################
  193 # WWW FUNCTIONS
  194 
  195 
  196 sub www_delete_message {
  197         my $self = shift;
  198         my $mid = $self->mid();
  199         my $referrer = $SESSION->{referer};
  200         # [vadim] do not forget to escape the URL !
  201          my $target = $CGI->escape($referrer);
  202         #
  203 
  204         $self->debug_msg(3, "Message::www_delete()");
  205         $self->print_http_header;
  206         $self->two_choices("Do you want to delete this Message?",
  207                 "caution",
  208                 "Yes please",
  209                 $self->make_url("index.pl?mid=$mid&isa=Message&op=delete_message_ok&target=$target"), "No!", $referrer);
  210 }
  211 
  212 
  213 #####################################################
  214 # BACKEND FUNCTIONS
  215 
  216 sub tag_open_sub{
  217 
  218     my $not_ok;
  219     my ($tagname, $attr) = @_;
  220 
  221     if(defined($tagname) && $tagname eq 'img') {
  222 
  223         # will remove the img tag altogether if its src attribute
  224         # contains any & and ? characters
  225         #      use this line instead if you want to go all the way to
  226         #      prohibiting all image types but the ones mentioned in
  227         #      the regexp:
  228         #         if( $attr->{src} && ( ($attr->{src} =~ /\&|\?/) ||
  229         #           ($attr->{src} !~ /(gif|jpg|png|jpeg)$/i) ) ) {
  230         if( $attr->{src} &&  ($attr->{src} =~ /\&|\?/) ) {
  231 
  232             $not_ok = 1;
  233 
  234         }
  235 
  236     }
  237 
  238 };
  239 
  240 
  241 
  242 sub add_message {
  243     my $class = shift;
  244     my %args = @_;
  245 
  246     my $db_now = Utility->db_now();
  247     my $isa    = ref($class) || $class;
  248 
  249     my %fields = (
  250                   userid        => $args{userid}        || $USER->uid(),
  251                   authorname    => $args{authorname}    || $USER->fullname(),
  252                   authoremail   => $args{authoremail}   || $USER->{email},
  253                   iid           => $args{iid},
  254                   parentmid     => $args{parentmid}     || 0,
  255                   name          => $args{name},
  256                   description   => $args{description},
  257                   priority      => $args{priority},
  258                   status        => $args{status}        || $class->_get_default_status(),
  259                   creationdate  => $args{creationdate}  || $db_now,
  260                   updatedate    => $args{updatedate}    || $db_now,
  261                   recipient_uid => $args{recipient_uid},
  262                   isa           => $args{is_a}          || $isa,
  263     );
  264 
  265     #use Data::Dumper;
  266     #print STDERR "Inserting new message with args\n",Dumper(\%args),"\nInsert fields are:\n",Dumper(\%fields);
  267 
  268     my $mid = DBAccess->sqlInsert("message", %fields);
  269     #print STDERR "Message was inserted\n";
  270     return $mid;
  271 }
  272 
  273 sub _get_default_status{
  274     return 'OK';
  275 }
  276 
  277 sub _delete_message {
  278   my $self = shift;
  279   my $mid  = shift || $self->mid();
  280   $mid = undef unless Utility->is_valid_integer($mid); # secu_200401
  281   my $iid  = $self->iid();
  282 
  283   # Selecting all messages that mid is parentmid
  284   my ($c)=DBAccess->sqlSelectMany("mid", "message", "iid=$iid AND parentmid=$mid");
  285 
  286   while(my ($childmid) =$c->fetchrow()) {
  287       $self->_delete_message($childmid);
  288   }
  289   DBAccess->sqlDelete("message", "mid=$mid") if defined($mid);
  290 }
  291 
  292 sub user_has_messages_with_status {
  293   my $class = shift;
  294   my $args  = shift;
  295 
  296   my $uid  = $args->{uid};
  297   my $status = $args->{status};
  298 
  299   return unless Utility->is_valid_integer($uid); # secu_200401
  300   return if $status eq '';
  301 
  302   my $isa    = ref($class) || $class;
  303 
  304   my ($count) = DBAccess->sqlSelect("count(*)", "message", "recipient_uid = $uid and isa= '$isa' and status = '$status'");
  305 
  306   return $count;
  307 }
  308 
  309 # modify object attribute for reply
  310 sub prepare_reply {
  311   my $self = shift;
  312   $self->debug_msg(4, "Message::prepare_reply()");
  313 
  314   ### prepare the Re: message
  315   $self->name("Re: ".$self->name) if ($self->name !~ m/^Re: /);
  316 
  317   ### Copy the orginal msg and add > in front of each line.
  318   $Text::Wrap::columns=65;
  319   my $pre1="> ";
  320   my $pre2="> ";
  321   $self->description(wrap($pre1, $pre2, $self->description));
  322 
  323   ### [vadim] Set the new flag (to recognize the difference between editing message and new one)
  324   $self->{editing} = undef ;
  325 }
  326 
  327 #####################################################
  328 
  329 1;
  330 
  331 
  332 __END__