"Fossies" - the Fresh Open Source Software Archive

Member "sendpage-1.001001/lib/Sendpage/Page.pm" (3 Jan 2008, 5390 Bytes) of package /linux/privat/old/sendpage-1.001001.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 "Page.pm" see the Fossies "Dox" file reference documentation.

    1 package Sendpage::Page;
    2 
    3 # this package will encapsulated the data of an actual page to be
    4 # send, including all the recipients.
    5 #
    6 # $Id: Page.pm 218 2006-08-17 00:41:58Z keescook $
    7 #
    8 # Copyright (C) 2000-2004 Kees Cook
    9 # kees@outflux.net, http://outflux.net/
   10 #
   11 # This program is free software; you can redistribute it and/or
   12 # modify it under the terms of the GNU General Public License
   13 # as published by the Free Software Foundation; either version 2
   14 # of the License, or (at your option) any later version.
   15 #
   16 # This program is distributed in the hope that it will be useful,
   17 # but WITHOUT ANY WARRANTY; without even the implied warranty of
   18 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   19 # GNU General Public License for more details.
   20 #
   21 # You should have received a copy of the GNU General Public License
   22 # along with this program; if not, write to the Free Software
   23 # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
   24 # <URL:http://www.gnu.org/copyleft/gpl.html>
   25 
   26 =head1 NAME
   27 
   28 Sendpage::Page - encapsulates the data of an actual page
   29 
   30 =head1 SYNOPSIS
   31 
   32  $page = Sendpage::Page->new(\@recipients, \$text, \%options);
   33 
   34  $data=$page->dump();       # storable dump of page data
   35 
   36  if ($page->deliverable()) {
   37      for ($page->reset(), $page->next();
   38           $recip = $page->recip();
   39           $page->next()) {
   40          $text = $page->text(); # get text of page
   41      $page->drop_recip();   # discard current recipient
   42      }
   43      $page->attempts(1);
   44  }
   45  $anyone_left = $page->has_recips();
   46  $attempts    = $page->attempts();
   47  $age         = $page->age();
   48 
   49  $page->option('from', "someone else"); # set option named 'from'
   50  $from = $page->option('from');     # get option named 'from'
   51 
   52  $page->option('from', $from, 1);       # delete option named 'from'
   53 
   54 =head1 DESCRIPTION
   55 
   56 This module gets used in L<sendpage>.
   57 
   58 =cut
   59 
   60 sub new
   61 {
   62     my $proto = shift;
   63     my $class = ref($proto) || $proto;
   64     my $self  = { };
   65 
   66     my ($o, $w, $t) = @_[0..2];
   67     #warn "Page: 1: $o 2: $w 3: $t\n";
   68 
   69     $self->{RECIPS} = $o;   # deref the recipients reference list
   70     $self->{TEXT}   = ${ $w };  # text of the page
   71     $self->{DATA}   = $t;   # hash of delivery options
   72 
   73     # dump what we just loaded
   74     #warn "loading page with:\n\ttext: '".$self->{TEXT}."'\n";
   75     #foreach $key (sort keys %{ $self->{DATA} }) {
   76     #   warn "\toption: $key -> ".$self->{DATA}->{$key}."\n";   
   77     #}
   78     #foreach $recip (@{$self->{RECIPS}}) {
   79     #   warn "\trecip: $recip\n";   
   80     #}
   81 
   82     # our "internal" counters
   83     $self->{DATA}->{'attempts'} += 0;
   84     $self->{ACTIVE} = undef;    # which recipient is active (array loop)
   85 
   86     return bless $self => $class;
   87 }
   88 
   89 # return the text
   90 sub text
   91 {
   92     my $self = shift;
   93 
   94     return $self->{TEXT};
   95 }
   96 
   97 # we need a way to loop through all the recipients.
   98 # I think I'm going to borrow from the PHP-style of array stepping
   99 sub reset
  100 {
  101     my $self = shift;
  102 
  103     $self->{ACTIVE} = -1;
  104 }
  105 
  106 # which recip is up next?
  107 sub next
  108 {
  109     my $self = shift;
  110 
  111     $self->{ACTIVE} += 1;
  112 }
  113 
  114 # show a recipient
  115 sub recip
  116 {
  117     my $self = shift;
  118 
  119     #warn "returning RECIP: ".$self->{ACTIVE}."\n";
  120     return $self->{RECIPS}->[$self->{ACTIVE}];
  121 }
  122 
  123 # do we have any recips left?
  124 sub has_recips
  125 {
  126     my $self = shift;
  127 
  128     return defined $self->{RECIPS}->[0];
  129 }
  130 
  131 # drop a recipient (total failure or success)
  132 sub drop_recip
  133 {
  134     my $self = shift;
  135 
  136     splice @{ $self->{RECIPS} }, $self->{ACTIVE}, 1;
  137 
  138     # need to drop the ACTIVE counter, don't I, so the next "next"
  139     # will work...
  140     $self->{ACTIVE}--;
  141 }
  142 
  143 # is the page deliverable?
  144 sub deliverable
  145 {
  146     my $self = shift;
  147 
  148     # right now, we can support the "when to schedule" option,
  149     # but in theory, we should be able to extend this to anything
  150     # else we can think of.
  151     return 1 if (time >= $self->{DATA}->{'when'});
  152     return undef;
  153 }
  154 
  155 sub age
  156 {
  157     my $self = shift;
  158 
  159     return (time - $self->{DATA}->{'queued'});
  160 }
  161 
  162 sub option
  163 {
  164     my ($self, $opt, $value, $delete) = @_;
  165 
  166     if (defined $value) {
  167     if (defined($delete) && $value eq $self->{DATA}->{$opt}) {
  168         delete $self->{DATA}->{$opt};
  169     } else {
  170         $self->{DATA}->{$opt} = $value;
  171     }
  172     }
  173     return $self->{DATA}->{$opt};
  174 }
  175 
  176 sub attempts
  177 {
  178     my ($self, $inc) = @_;
  179 
  180     $inc = 0 unless defined $inc;
  181 
  182     return $self->{DATA}->{'attempts'} += $inc;
  183 }
  184 
  185 sub dump
  186 {
  187     my ($self) = @_;
  188 
  189     my ($str, $recip, $key);
  190 
  191     $str="";
  192 
  193     for ($self->reset(), $self->next();
  194      defined($recip = $self->recip());
  195      $self->next()) {
  196 
  197     my @list;
  198     if (defined $recip->data()) {
  199         foreach $key (keys %{ $recip->data() }) {
  200         push @list, "${key}=" . $recip->datum($key);
  201         }
  202     }
  203 
  204     $str .= "to: " . $recip->name()."\n";
  205     $str .= join(",", @list) . "\n"
  206         if (scalar(@list) > 0);
  207     }
  208     foreach $key (sort keys %{ $self->{DATA} }) {
  209     $str .= "$key: " . $self->{DATA}->{$key} . "\n";
  210     }
  211     $str .= "\n" . $self->{TEXT} . "\n";
  212 
  213     return $str;
  214 }
  215 
  216 1;
  217 
  218 __END__
  219 
  220 =head1 AUTHOR
  221 
  222 Kees Cook <kees@outflux.net>
  223 
  224 =head1 BUGS
  225 
  226 This needs more docs.
  227 
  228 =head1 SEE ALSO
  229 
  230 Man pages: L<perl>, L<sendpage>.
  231 
  232 Module documentation: L<Sendpage::KeesConf>, L<Sendpage::KeesLog>,
  233 L<Sendpage::Modem>, L<Sendpage::PagingCentral>, L<Sendpage::PageQueue>,
  234 L<Sendpage::Recipient>, L<Sendpage::Queue>
  235 
  236 =head1 COPYRIGHT
  237 
  238 Copyright 2000 Kees Cook.
  239 
  240 This library is free software; you can redistribute it and/or
  241 modify it under the same terms as Perl itself.
  242 
  243 =cut