Ready for 7.10.29 development.

lib/WebGUI/ProgressBar.pm

@@ -0,0 +1,265 @@
+package WebGUI::ProgressBar;
+
+=head1 LEGAL
+
+ -------------------------------------------------------------------
+  WebGUI is Copyright 2001-2009 Plain Black Corporation.
+ -------------------------------------------------------------------
+  Please read the legal notices (docs/legal.txt) and the license
+  (docs/license.txt) that came with this distribution before using
+  this software.
+ -------------------------------------------------------------------
+  http://www.plainblack.com                     info@plainblack.com
+ -------------------------------------------------------------------
+
+=cut
+
+use strict;
+
+=head1 NAME
+
+Package WebGUI::ProgressBar
+
+=head1 DESCRIPTION
+
+Render a progress bar for the user inside a nice style.
+
+=head1 SYNOPSIS
+
+ use WebGUI::ProgressBar;
+
+ my $pb = WebGUI::ProgressBar->new($session);
+ $pb->start($title, $iconUrl);
+ $pb->update($message);
+ $pb->finish($redirectUrl); 
+
+=head1 METHODS
+
+These methods are available from this class:
+
+=cut
+
+#-------------------------------------------------------------------
+
+=head2 new ( session )
+
+Constructor.
+
+=head3 session
+
+A reference to the current session.
+
+=cut
+
+sub new {
+	my $class   = shift;
+	my $session = shift;
+    my $recordCount = shift;
+    my $self    = {};
+	$self->{_session}    = $session;
+    $self->{_counter}    = 1;
+	bless $self, $class;
+	return $self;
+}
+
+#-------------------------------------------------------------------
+
+=head2 finish ( $url )
+
+Redirects the user out of the status page.
+
+=head3 $url
+
+The URL to send the user to.
+
+=cut
+
+sub finish {
+	my $self = shift;
+	my $url  = shift;
+    my $text = sprintf(<<EOJS, $url);
+<script>
+parent.location.href='%s';
+</script>
+EOJS
+    local $| = 1;
+    $self->session->output->print($text . $self->{_foot}, 1); # skipMacros
+    return 'chunked';
+}
+
+#-------------------------------------------------------------------
+
+=head2 session ( )
+
+Returns a reference to the current session.
+
+=cut
+
+sub session {
+	my $self = shift;
+	return $self->{_session};
+}
+
+#-------------------------------------------------------------------
+
+=head2 start ( title, icon )
+
+Returns a templated progress bar implemented in CSS and JS.
+
+=head3 title
+
+A title to display above the progress bar.
+
+=head3 icon
+
+The url to the icon you want to display.
+
+=cut
+
+sub start {
+    my ($self, $title, $icon) = @_;
+    $self->session->http->setCacheControl("none");
+    my %var      =  (
+        title   => $title,
+        icon    => $icon
+        );
+    my $template = WebGUI::Asset::Template->new($self->session, 'YP9WaMPJHvCJl-YwrLVcPw');
+    my $output = $self->session->style->process($template->process(\%var).'~~~', "PBtmpl0000000000000137");
+    my ($head, $foot) = split '~~~', $output;
+    local $| = 1; # Tell modperl not to buffer the output
+    $self->session->http->sendHeader;
+    $self->session->output->print($head, 1); #skipMacros
+    $self->{_foot} = $foot;
+    return '';
+}
+
+#-------------------------------------------------------------------
+
+=head2 update ( $message )
+
+Sends a message and increments the status bar.
+
+=head3 $message
+
+A message to be displayed in the status bar.
+
+=cut
+
+{
+
+# Keep the sprintf string short and don't recompute buffer breaker every time
+# update is called
+my $prefix = '<script type="text/javascript">
+/* ' . 'BUFFER BREAKER ' x 1000 . ' */
+updateWgProgressBar(';
+my $format = q"'%dpx', '%s'";
+my $suffix = '); 
+</script>
+';
+
+sub update {
+	my $self    = shift;
+	my $message = shift;
+    $message    =~ s/'/\\'/g; ##Encode single quotes for JSON;
+    $self->session->log->preventDebugOutput;
+    my $counter = $self->{_counter} += 1;
+    
+    my $text = $prefix . sprintf($format, $counter, $message) . $suffix;
+
+    local $| = 1; # Tell modperl not to buffer the output
+    $self->session->output->print($text, 1); #skipMacros
+    if ($self->{_counter} > 600) {
+        $self->{_counter} = 1;
+    }
+    return '';
+}
+
+}
+
+#-------------------------------------------------------------------
+
+=head2 run ( options )
+
+starts and finishes a progress bar, running some code in the middle.  It
+returns 'chunked' for convenience - if you don't use the return value, you
+should return 'chunked' yourself.
+
+The following keyword arguments are accepted (either as a bare hash or a
+hashref).
+
+=head3 code
+
+A coderef to run in between starting and stopping the progress bar.  It is
+passed the progress bar instance as its first and only argument.  It should
+return the url to redirect to with finish(), or a false value.
+
+=head3 arg
+
+An argument (just one) to be passed to code when it is called.
+
+=head3 title
+
+See start().
+
+=head3 icon
+
+See start().
+
+=head3 wrap
+
+A hashref of subroutine names to code references.  While code is being called,
+these subroutines will be wrapped with the provided code references, which
+will be passed the progress bar instance, the original code reference, and any
+arguments it would have received, similiar to a Moose 'around' method, e.g.
+
+    wrap => {
+        'WebGUI::Asset::update' => sub {
+            my $bar      = shift;
+            my $original = shift;
+            $bar->update('some message');
+            $original->(@_);
+        }
+    }
+
+=cut
+
+sub run {
+    my $self = shift;
+    my $args = $_[0];
+    $args = { @_ } unless ref $args eq 'HASH';
+
+    my %original;
+    my $wrap = $args->{wrap};
+
+    $self->start($args->{title}, $args->{icon});
+
+    my $url = eval {
+        for my $name (keys %$wrap) {
+            my $original = $original{$name} = do { no strict 'refs'; \&$name };
+            my $wrapper  = $wrap->{$name};
+            no strict 'refs';
+            *$name = sub {
+                unshift(@_, $self, $original);
+                goto &$wrapper;
+            };
+        }
+
+        $args->{code}->($self, $args->{arg});
+    };
+    my $e = $@;
+
+    # Always, always restore coderefs
+    for my $name (keys %original) {
+        my $c  = $original{$name};
+        if (ref $c eq 'CODE') {
+            no strict 'refs';
+            *$name = $c;
+        }
+    }
+
+    die $e if $e;
+
+    return $self->finish($url || $self->session->url->page);
+}
+
+1;